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

◆ pzchkarg1()

subroutine pzchkarg1 ( integer  ictxt,
integer  nout,
character*(*)  sname,
integer  n,
complex*16  alpha,
integer  ix,
integer  jx,
integer, dimension( * )  descx,
integer  incx,
integer  iy,
integer  jy,
integer, dimension( * )  descy,
integer  incy,
integer  info 
)

Definition at line 1776 of file pzblas1tst.f.

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