1 SUBROUTINE CHK1MAT( MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, 2 $ DESCAPOS0, INFO ) 3* 4* -- ScaLAPACK tools routine (version 1.7) -- 5* University of Tennessee, Knoxville, Oak Ridge National Laboratory, 6* and University of California, Berkeley. 7* May 1, 1997 8* 9* .. Scalar Arguments .. 10 INTEGER DESCAPOS0, IA, INFO, JA, MA, MAPOS0, NA, NAPOS0 11* .. 12* .. Array Arguments .. 13 INTEGER DESCA( * ) 14* .. 15* 16* Purpose 17* ======= 18* 19* CHK1MAT checks that the values associated with one distributed matrix 20* make sense from a local viewpoint 21* 22* Arguments 23* ========= 24* 25* MA (global input) INTEGER 26* The number or matrix rows of A being operated on. 27* 28* MAPOS0 (global input) INTEGER 29* Where in the calling routine's parameter list MA appears. 30* 31* NA (global input) INTEGER 32* The number of matrix columns of A being operated on. 33* 34* NAPOS0 (global input) INTEGER 35* Where in the calling routine's parameter list NA appears. 36* 37* IA (global input) INTEGER 38* The row index in the global array A indicating the first 39* row of sub( A ). 40* 41* JA (global input) INTEGER 42* The column index in the global array A indicating the 43* first column of sub( A ). 44* 45* DESCA (global and local input) INTEGER array of dimension DLEN_. 46* The array descriptor for the distributed matrix A. 47* 48* DESCAPOS0 (global input) INTEGER 49* Where in the calling routine's parameter list DESCA 50* appears. Note that we assume IA and JA are respectively 2 51* and 1 entries behind DESCA. 52* 53* INFO (local input/local output) INTEGER 54* = 0: successful exit 55* < 0: If the i-th argument is an array and the j-entry had 56* an illegal value, then INFO = -(i*100+j), if the i-th 57* argument is a scalar and had an illegal value, then 58* INFO = -i. 59* 60* ===================================================================== 61* 62* .. Parameters .. 63 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, 64 $ LLD_, MB_, M_, NB_, N_, RSRC_ 65 PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, 66 $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, 67 $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) 68 INTEGER DESCMULT, BIGNUM 69 PARAMETER ( DESCMULT = 100, BIGNUM = DESCMULT*DESCMULT ) 70* .. 71* .. Local Scalars .. 72 INTEGER DESCAPOS, IAPOS, JAPOS, MAPOS, NAPOS, MYCOL, 73 $ MYROW, NPCOL, NPROW 74* .. 75* .. External Subroutines .. 76 EXTERNAL BLACS_GRIDINFO 77* .. 78* .. External Functions .. 79 INTEGER NUMROC 80 EXTERNAL NUMROC 81* .. 82* .. Intrinsic Functions .. 83 INTRINSIC MIN, MAX 84* .. 85* .. Executable Statements .. 86* 87* Want to find errors with MIN( ), so if no error, set it to a big 88* number. If there already is an error, multiply by the the des- 89* criptor multiplier 90* 91 IF( INFO.GE.0 ) THEN 92 INFO = BIGNUM 93 ELSE IF( INFO.LT.-DESCMULT ) THEN 94 INFO = -INFO 95 ELSE 96 INFO = -INFO * DESCMULT 97 END IF 98* 99* Figure where in parameter list each parameter was, factoring in 100* descriptor multiplier 101* 102 MAPOS = MAPOS0 * DESCMULT 103 NAPOS = NAPOS0 * DESCMULT 104 IAPOS = (DESCAPOS0-2) * DESCMULT 105 JAPOS = (DESCAPOS0-1) * DESCMULT 106 DESCAPOS = DESCAPOS0 * DESCMULT 107* 108* Get grid parameters 109* 110 CALL BLACS_GRIDINFO( DESCA( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) 111* 112* Check that matrix values make sense from local viewpoint 113* 114 IF( DESCA( DTYPE_ ) .NE. BLOCK_CYCLIC_2D ) THEN 115 INFO = MIN( INFO, DESCAPOS+DTYPE_ ) 116 ELSE IF( MA.LT.0 ) THEN 117 INFO = MIN( INFO, MAPOS ) 118 ELSE IF( NA.LT.0 ) THEN 119 INFO = MIN( INFO, NAPOS ) 120 ELSE IF( IA.LT.1 ) THEN 121 INFO = MIN( INFO, IAPOS ) 122 ELSE IF( JA.LT.1 ) THEN 123 INFO = MIN( INFO, JAPOS ) 124 ELSE IF( DESCA( MB_ ).LT.1 ) THEN 125 INFO = MIN( INFO, DESCAPOS+MB_ ) 126 ELSE IF( DESCA( NB_ ).LT.1 ) THEN 127 INFO = MIN( INFO, DESCAPOS+NB_ ) 128 ELSE IF( DESCA( RSRC_ ).LT.0 .OR. DESCA( RSRC_ ).GE.NPROW ) THEN 129 INFO = MIN( INFO, DESCAPOS+RSRC_ ) 130 ELSE IF( DESCA( CSRC_ ).LT.0 .OR. DESCA( CSRC_ ).GE.NPCOL ) THEN 131 INFO = MIN( INFO, DESCAPOS+CSRC_ ) 132 ELSE IF( DESCA( LLD_ ).LT.1 ) THEN 133 INFO = MIN( INFO, DESCAPOS+LLD_ ) 134 ELSE IF( DESCA( LLD_ ) .LT. 135 $ NUMROC( DESCA( M_ ), DESCA( MB_ ), MYROW, DESCA(RSRC_), 136 $ NPROW ) ) THEN 137 IF( NUMROC( DESCA( N_ ), DESCA( NB_ ), MYCOL, DESCA( CSRC_ ), 138 $ NPCOL ) .GT. 0 ) 139 $ INFO = MIN( INFO, DESCAPOS+LLD_ ) 140 END IF 141* 142 IF( MA.EQ.0 .OR. NA.EQ.0 ) THEN 143* 144* NULL matrix, relax some checks 145* 146 IF( DESCA(M_).LT.0 ) 147 $ INFO = MIN( INFO, DESCAPOS+M_ ) 148 IF( DESCA(N_).LT.0 ) 149 $ INFO = MIN( INFO, DESCAPOS+N_ ) 150* 151 ELSE 152* 153* more rigorous checks for non-degenerate matrices 154* 155 IF( DESCA( M_ ).LT.1 ) THEN 156 INFO = MIN( INFO, DESCAPOS+M_ ) 157 ELSE IF( DESCA( N_ ).LT.1 ) THEN 158 INFO = MIN( INFO, DESCAPOS+N_ ) 159 ELSE 160 IF( IA.GT.DESCA( M_ ) ) THEN 161 INFO = MIN( INFO, IAPOS ) 162 ELSE IF( JA.GT.DESCA( N_ ) ) THEN 163 INFO = MIN( INFO, JAPOS ) 164 ELSE 165 IF( IA+MA-1.GT.DESCA( M_ ) ) 166 $ INFO = MIN( INFO, MAPOS ) 167 IF( JA+NA-1.GT.DESCA( N_ ) ) 168 $ INFO = MIN( INFO, NAPOS ) 169 END IF 170 END IF 171* 172 END IF 173* 174* Prepare output: set info = 0 if no error, and divide by 175* DESCMULT if error is not in a descriptor entry 176* 177 IF( INFO.EQ.BIGNUM ) THEN 178 INFO = 0 179 ELSE IF( MOD( INFO, DESCMULT ).EQ.0 ) THEN 180 INFO = -INFO / DESCMULT 181 ELSE 182 INFO = -INFO 183 END IF 184* 185 RETURN 186* 187* End CHK1MAT 188* 189 END 190