SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ pdchkarg1()

subroutine pdchkarg1 ( integer  ictxt,
integer  nout,
character*(*)  sname,
integer  n,
double precision  alpha,
integer  ix,
integer  jx,
integer, dimension( * )  descx,
integer  incx,
integer  iy,
integer  jy,
integer, dimension( * )  descy,
integer  incy,
integer  info 
)

Definition at line 1732 of file pdblas1tst.f.

1734*
1735* -- PBLAS test routine (version 2.0) --
1736* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
1737* and University of California, Berkeley.
1738* April 1, 1998
1739*
1740* .. Scalar Arguments ..
1741 INTEGER ICTXT, INCX, INCY, INFO, IX, IY, JX, JY, N,
1742 $ NOUT
1743 DOUBLE PRECISION ALPHA
1744* ..
1745* .. Array Arguments ..
1746 CHARACTER*(*) SNAME
1747 INTEGER DESCX( * ), DESCY( * )
1748* ..
1749*
1750* Purpose
1751* =======
1752*
1753* PDCHKARG1 checks the input-only arguments of the Level 1 PBLAS. When
1754* INFO = 0, this routine makes a copy of its arguments (which are INPUT
1755* only arguments to PBLAS routines). Otherwise, it verifies the values
1756* of these arguments against the saved copies.
1757*
1758* Notes
1759* =====
1760*
1761* A description vector is associated with each 2D block-cyclicly dis-
1762* tributed matrix. This vector stores the information required to
1763* establish the mapping between a matrix entry and its corresponding
1764* process and memory location.
1765*
1766* In the following comments, the character _ should be read as
1767* "of the distributed matrix". Let A be a generic term for any 2D
1768* block cyclicly distributed matrix. Its description vector is DESCA:
1769*
1770* NOTATION STORED IN EXPLANATION
1771* ---------------- --------------- ------------------------------------
1772* DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
1773* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
1774* the NPROW x NPCOL BLACS process grid
1775* A is distributed over. The context
1776* itself is global, but the handle
1777* (the integer value) may vary.
1778* M_A (global) DESCA( M_ ) The number of rows in the distribu-
1779* ted matrix A, M_A >= 0.
1780* N_A (global) DESCA( N_ ) The number of columns in the distri-
1781* buted matrix A, N_A >= 0.
1782* IMB_A (global) DESCA( IMB_ ) The number of rows of the upper left
1783* block of the matrix A, IMB_A > 0.
1784* INB_A (global) DESCA( INB_ ) The number of columns of the upper
1785* left block of the matrix A,
1786* INB_A > 0.
1787* MB_A (global) DESCA( MB_ ) The blocking factor used to distri-
1788* bute the last M_A-IMB_A rows of A,
1789* MB_A > 0.
1790* NB_A (global) DESCA( NB_ ) The blocking factor used to distri-
1791* bute the last N_A-INB_A columns of
1792* A, NB_A > 0.
1793* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
1794* row of the matrix A is distributed,
1795* NPROW > RSRC_A >= 0.
1796* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
1797* first column of A is distributed.
1798* NPCOL > CSRC_A >= 0.
1799* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
1800* array storing the local blocks of
1801* the distributed matrix A,
1802* IF( Lc( 1, N_A ) > 0 )
1803* LLD_A >= MAX( 1, Lr( 1, M_A ) )
1804* ELSE
1805* LLD_A >= 1.
1806*
1807* Let K be the number of rows of a matrix A starting at the global in-
1808* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
1809* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
1810* receive if these K rows were distributed over NPROW processes. If K
1811* is the number of columns of a matrix A starting at the global index
1812* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
1813* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
1814* these K columns were distributed over NPCOL processes.
1815*
1816* The values of Lr() and Lc() may be determined via a call to the func-
1817* tion PB_NUMROC:
1818* Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
1819* Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
1820*
1821* Arguments
1822* =========
1823*
1824* ICTXT (local input) INTEGER
1825* On entry, ICTXT specifies the BLACS context handle, indica-
1826* ting the global context of the operation. The context itself
1827* is global, but the value of ICTXT is local.
1828*
1829* NOUT (global input) INTEGER
1830* On entry, NOUT specifies the unit number for the output file.
1831* When NOUT is 6, output to screen, when NOUT is 0, output to
1832* stderr. NOUT is only defined for process 0.
1833*
1834* SNAME (global input) CHARACTER*(*)
1835* On entry, SNAME specifies the subroutine name calling this
1836* subprogram.
1837*
1838* N (global input) INTEGER
1839* On entry, N specifies the length of the subvector operands.
1840*
1841* ALPHA (global input) DOUBLE PRECISION
1842* On entry, ALPHA specifies the scalar alpha.
1843*
1844* IX (global input) INTEGER
1845* On entry, IX specifies X's global row index, which points to
1846* the beginning of the submatrix sub( X ).
1847*
1848* JX (global input) INTEGER
1849* On entry, JX specifies X's global column index, which points
1850* to the beginning of the submatrix sub( X ).
1851*
1852* DESCX (global and local input) INTEGER array
1853* On entry, DESCX is an integer array of dimension DLEN_. This
1854* is the array descriptor for the matrix X.
1855*
1856* INCX (global input) INTEGER
1857* On entry, INCX specifies the global increment for the
1858* elements of X. Only two values of INCX are supported in
1859* this version, namely 1 and M_X. INCX must not be zero.
1860*
1861* IY (global input) INTEGER
1862* On entry, IY specifies Y's global row index, which points to
1863* the beginning of the submatrix sub( Y ).
1864*
1865* JY (global input) INTEGER
1866* On entry, JY specifies Y's global column index, which points
1867* to the beginning of the submatrix sub( Y ).
1868*
1869* DESCY (global and local input) INTEGER array
1870* On entry, DESCY is an integer array of dimension DLEN_. This
1871* is the array descriptor for the matrix Y.
1872*
1873* INCY (global input) INTEGER
1874* On entry, INCY specifies the global increment for the
1875* elements of Y. Only two values of INCY are supported in
1876* this version, namely 1 and M_Y. INCY must not be zero.
1877*
1878* INFO (global input/global output) INTEGER
1879* When INFO = 0 on entry, the values of the arguments which are
1880* INPUT only arguments to a PBLAS routine are copied into sta-
1881* tic variables and INFO is unchanged on exit. Otherwise, the
1882* values of the arguments are compared against the saved co-
1883* pies. In case no error has been found INFO is zero on return,
1884* otherwise it is non zero.
1885*
1886* -- Written on April 1, 1998 by
1887* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
1888*
1889* =====================================================================
1890*
1891* .. Parameters ..
1892 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
1893 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
1894 $ RSRC_
1895 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
1896 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
1897 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
1898 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
1899* ..
1900* .. Local Scalars ..
1901 INTEGER I, INCXREF, INCYREF, IXREF, IYREF, JXREF,
1902 $ JYREF, MYCOL, MYROW, NPCOL, NPROW, NREF
1903 DOUBLE PRECISION ALPHAREF
1904* ..
1905* .. Local Arrays ..
1906 CHARACTER*15 ARGNAME
1907 INTEGER DESCXREF( DLEN_ ), DESCYREF( DLEN_ )
1908* ..
1909* .. External Subroutines ..
1910 EXTERNAL blacs_gridinfo, igsum2d
1911* ..
1912* .. Save Statements ..
1913 SAVE
1914* ..
1915* .. Executable Statements ..
1916*
1917* Get grid parameters
1918*
1919 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
1920*
1921* Check if first call. If yes, then save.
1922*
1923 IF( info.EQ.0 ) THEN
1924*
1925 nref = n
1926 ixref = ix
1927 jxref = jx
1928 DO 10 i = 1, dlen_
1929 descxref( i ) = descx( i )
1930 10 CONTINUE
1931 incxref = incx
1932 iyref = iy
1933 jyref = jy
1934 DO 20 i = 1, dlen_
1935 descyref( i ) = descy( i )
1936 20 CONTINUE
1937 incyref = incy
1938 alpharef = alpha
1939*
1940 ELSE
1941*
1942* Test saved args. Return with first mismatch.
1943*
1944 argname = ' '
1945 IF( n.NE.nref ) THEN
1946 WRITE( argname, fmt = '(A)' ) 'N'
1947 ELSE IF( ix.NE.ixref ) THEN
1948 WRITE( argname, fmt = '(A)' ) 'IX'
1949 ELSE IF( jx.NE.jxref ) THEN
1950 WRITE( argname, fmt = '(A)' ) 'JX'
1951 ELSE IF( descx( dtype_ ).NE.descxref( dtype_ ) ) THEN
1952 WRITE( argname, fmt = '(A)' ) 'DESCX( DTYPE_ )'
1953 ELSE IF( descx( m_ ).NE.descxref( m_ ) ) THEN
1954 WRITE( argname, fmt = '(A)' ) 'DESCX( M_ )'
1955 ELSE IF( descx( n_ ).NE.descxref( n_ ) ) THEN
1956 WRITE( argname, fmt = '(A)' ) 'DESCX( N_ )'
1957 ELSE IF( descx( imb_ ).NE.descxref( imb_ ) ) THEN
1958 WRITE( argname, fmt = '(A)' ) 'DESCX( IMB_ )'
1959 ELSE IF( descx( inb_ ).NE.descxref( inb_ ) ) THEN
1960 WRITE( argname, fmt = '(A)' ) 'DESCX( INB_ )'
1961 ELSE IF( descx( mb_ ).NE.descxref( mb_ ) ) THEN
1962 WRITE( argname, fmt = '(A)' ) 'DESCX( MB_ )'
1963 ELSE IF( descx( nb_ ).NE.descxref( nb_ ) ) THEN
1964 WRITE( argname, fmt = '(A)' ) 'DESCX( NB_ )'
1965 ELSE IF( descx( rsrc_ ).NE.descxref( rsrc_ ) ) THEN
1966 WRITE( argname, fmt = '(A)' ) 'DESCX( RSRC_ )'
1967 ELSE IF( descx( csrc_ ).NE.descxref( csrc_ ) ) THEN
1968 WRITE( argname, fmt = '(A)' ) 'DESCX( CSRC_ )'
1969 ELSE IF( descx( ctxt_ ).NE.descxref( ctxt_ ) ) THEN
1970 WRITE( argname, fmt = '(A)' ) 'DESCX( CTXT_ )'
1971 ELSE IF( descx( lld_ ).NE.descxref( lld_ ) ) THEN
1972 WRITE( argname, fmt = '(A)' ) 'DESCX( LLD_ )'
1973 ELSE IF( incx.NE.incxref ) THEN
1974 WRITE( argname, fmt = '(A)' ) 'INCX'
1975 ELSE IF( iy.NE.iyref ) THEN
1976 WRITE( argname, fmt = '(A)' ) 'IY'
1977 ELSE IF( jy.NE.jyref ) THEN
1978 WRITE( argname, fmt = '(A)' ) 'JY'
1979 ELSE IF( descy( dtype_ ).NE.descyref( dtype_ ) ) THEN
1980 WRITE( argname, fmt = '(A)' ) 'DESCY( DTYPE_ )'
1981 ELSE IF( descy( m_ ).NE.descyref( m_ ) ) THEN
1982 WRITE( argname, fmt = '(A)' ) 'DESCY( M_ )'
1983 ELSE IF( descy( n_ ).NE.descyref( n_ ) ) THEN
1984 WRITE( argname, fmt = '(A)' ) 'DESCY( N_ )'
1985 ELSE IF( descy( imb_ ).NE.descyref( imb_ ) ) THEN
1986 WRITE( argname, fmt = '(A)' ) 'DESCY( IMB_ )'
1987 ELSE IF( descy( inb_ ).NE.descyref( inb_ ) ) THEN
1988 WRITE( argname, fmt = '(A)' ) 'DESCY( INB_ )'
1989 ELSE IF( descy( mb_ ).NE.descyref( mb_ ) ) THEN
1990 WRITE( argname, fmt = '(A)' ) 'DESCY( MB_ )'
1991 ELSE IF( descy( nb_ ).NE.descyref( nb_ ) ) THEN
1992 WRITE( argname, fmt = '(A)' ) 'DESCY( NB_ )'
1993 ELSE IF( descy( rsrc_ ).NE.descyref( rsrc_ ) ) THEN
1994 WRITE( argname, fmt = '(A)' ) 'DESCY( RSRC_ )'
1995 ELSE IF( descy( csrc_ ).NE.descyref( csrc_ ) ) THEN
1996 WRITE( argname, fmt = '(A)' ) 'DESCY( CSRC_ )'
1997 ELSE IF( descy( ctxt_ ).NE.descyref( ctxt_ ) ) THEN
1998 WRITE( argname, fmt = '(A)' ) 'DESCY( CTXT_ )'
1999 ELSE IF( descy( lld_ ).NE.descyref( lld_ ) ) THEN
2000 WRITE( argname, fmt = '(A)' ) 'DESCY( LLD_ )'
2001 ELSE IF( incy.NE.incyref ) THEN
2002 WRITE( argname, fmt = '(A)' ) 'INCY'
2003 ELSE IF( alpha.NE.alpharef ) THEN
2004 WRITE( argname, fmt = '(A)' ) 'ALPHA'
2005 ELSE
2006 info = 0
2007 END IF
2008*
2009 CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
2010*
2011 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
2012*
2013 IF( info.GT.0 ) THEN
2014 WRITE( nout, fmt = 9999 ) argname, sname
2015 ELSE
2016 WRITE( nout, fmt = 9998 ) sname
2017 END IF
2018*
2019 END IF
2020*
2021 END IF
2022*
2023 9999 FORMAT( 2x, ' ***** Input-only parameter check: ', a,
2024 $ ' FAILED changed ', a, ' *****' )
2025 9998 FORMAT( 2x, ' ***** Input-only parameter check: ', a,
2026 $ ' PASSED *****' )
2027*
2028 RETURN
2029*
2030* End of PDCHKARG1
2031*
Here is the caller graph for this function: