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