ScaLAPACK 2.1  2.1 ScaLAPACK: Scalable Linear Algebra PACKage
chk1mat.f
Go to the documentation of this file.
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
max
#define max(A, B)
Definition: pcgemr.c:180
chk1mat
subroutine chk1mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, INFO)
Definition: chk1mat.f:3
min
#define min(A, B)
Definition: pcgemr.c:181