ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pzsepchk.f
Go to the documentation of this file.
1 *
2 *
3  SUBROUTINE pzsepchk( MS, NV, A, IA, JA, DESCA, EPSNORMA, THRESH,
4  $ Q, IQ, JQ, DESCQ, C, IC, JC, DESCC, W, WORK,
5  $ LWORK, TSTNRM, RESULT )
6 *
7 * -- ScaLAPACK routine (version 2.0.2) --
8 * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver
9 * May 1 2012
10 *
11 * .. Scalar Arguments ..
12  INTEGER IA, IC, IQ, JA, JC, JQ, LWORK, MS, NV, RESULT
13  DOUBLE PRECISION EPSNORMA, THRESH, TSTNRM
14 * ..
15 * .. Array Arguments ..
16 *
17  INTEGER DESCA( * ), DESCC( * ), DESCQ( * )
18  DOUBLE PRECISION W( * ), WORK( * )
19  COMPLEX*16 A( * ), C( * ), Q( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * Compute |AQ- QL| / (EPSNORMA * N)
26 * where EPSNORMA = (abstol + eps)*norm(A) when called by pdsqpsubtst.
27 *
28 * Notes
29 * =====
30 *
31 *
32 * Each global data object is described by an associated description
33 * vector. This vector stores the information required to establish
34 * the mapping between an object element and its corresponding process
35 * and memory location.
36 *
37 * Let A be a generic term for any 2D block cyclicly distributed array.
38 * Such a global array has an associated description vector DESCA.
39 * In the following comments, the character _ should be read as
40 * "of the global array".
41 *
42 * NOTATION STORED IN EXPLANATION
43 * --------------- -------------- --------------------------------------
44 * DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
45 * DTYPE_A = 1.
46 * CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
47 * the BLACS process grid A is distribu-
48 * ted over. The context itself is glo-
49 * bal, but the handle (the integer
50 * value) may vary.
51 * M_A (global) DESCA( M_ ) The number of rows in the global
52 * array A.
53 * N_A (global) DESCA( N_ ) The number of columns in the global
54 * array A.
55 * MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
56 * the rows of the array.
57 * NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
58 * the columns of the array.
59 * RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
60 * row of the array A is distributed.
61 * CSRC_A (global) DESCA( CSRC_ ) The process column over which the
62 * first column of the array A is
63 * distributed.
64 * LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
65 * array. LLD_A >= MAX(1,LOCr(M_A)).
66 *
67 * Let K be the number of rows or columns of a distributed matrix,
68 * and assume that its process grid has dimension p x q.
69 * LOCr( K ) denotes the number of elements of K that a process
70 * would receive if K were distributed over the p processes of its
71 * process column.
72 * Similarly, LOCc( K ) denotes the number of elements of K that a
73 * process would receive if K were distributed over the q processes of
74 * its process row.
75 * The values of LOCr() and LOCc() may be determined via a call to the
76 * ScaLAPACK tool function, NUMROC:
77 * LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
78 * LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
79 * An upper bound for these quantities may be computed by:
80 * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
81 * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
82 *
83 *
84 * Arguments
85 * =========
86 *
87 * MP = number of local rows in A, C and Q
88 * MQ = number of local columns in A
89 * NQ = number of local columns in C and Q
90 *
91 * MS (global input) INTEGER
92 * Matrix size.
93 * The number of global rows in A, C and Q
94 * Also, the number of global columns in A
95 *
96 * NV (global input) INTEGER
97 * Number of eigenvectors
98 * The number of global columns in C and Q.
99 *
100 * A (local input) COMPLEX*16 pointer to an
101 * array in local memory of dimension (LLD_A, LOCc(JA+N-1)).
102 * This array contains the local pieces of the MS-by-MS
103 * distributed test matrix A
104 *
105 * IA (global input) INTEGER
106 * A's global row index, which points to the beginning of the
107 * submatrix which is to be operated on.
108 *
109 * JA (global input) INTEGER
110 * A's global column index, which points to the beginning of
111 * the submatrix which is to be operated on.
112 *
113 * DESCA (global and local input) INTEGER array of dimension DLEN_.
114 * The array descriptor for the distributed matrix A.
115 *
116 * EPSNORMA (input) DOUBLE PRECISION
117 * abstol + eps * inf.norm(A)
118 * Abstol is absolute tolerence for the eigenvalues and is set
119 * in the calling routines, pdsepsubtst and pdsqpsubtst.
120 *
121 * THRESH (input) DOUBLE PRECISION
122 * A test will count as "failed" if the "error", computed as
123 * described below, exceeds THRESH. Note that the error
124 * is scaled to be O(1), so THRESH should be a reasonably
125 * small multiple of 1, e.g., 10 or 100. In particular,
126 * it should not depend on the precision (single vs. double)
127 * or the size of the matrix. It must be at least zero.
128 *
129 * Q (local input) COMPLEX*16 array
130 * global dimension (MS, NV), local dimension (DESCA(DLEN_), NQ)
131 *
132 * Contains the eigenvectors as computed by PZHEEVX
133 *
134 * IQ (global input) INTEGER
135 * Q's global row index, which points to the beginning of the
136 * submatrix which is to be operated on.
137 *
138 * JQ (global input) INTEGER
139 * Q's global column index, which points to the beginning of
140 * the submatrix which is to be operated on.
141 *
142 * DESCQ (global and local input) INTEGER array of dimension DLEN_.
143 * The array descriptor for the distributed matrix Q.
144 *
145 * C (local workspace) COMPLEX*16 array,
146 * global dimension (NV, NV), local dimension (DESCA(DLEN_), MQ)
147 *
148 * Accumulator for computing AQ -QL
149 *
150 * IC (global input) INTEGER
151 * C's global row index, which points to the beginning of the
152 * submatrix which is to be operated on.
153 *
154 * JC (global input) INTEGER
155 * C's global column index, which points to the beginning of
156 * the submatrix which is to be operated on.
157 *
158 * DESCC (global and local input) INTEGER array of dimension DLEN_.
159 * The array descriptor for the distributed matrix C.
160 *
161 * W (global input) DOUBLE PRECISION array, dimension (NV)
162 *
163 * Contains the computed eigenvalues
164 *
165 * WORK (local workspace) DOUBLE PRECISION array,
166 * dimension (LWORK)
167 *
168 * LWORK (local input) INTEGER
169 * The length of the array WORK.
170 * LWORK >= NUMROC( NV, DESCA( NB_ ), MYCOL, 0, NPCOL )
171 *
172 * TSTNRM (global output) DOUBLE PRECISION
173 * |AQ- QL| / ( EPSNROMA * MS )
174 *
175 * RESULT (global output) INTEGER
176 * 0 if the test passes i.e.
177 * |AQ -QL| / (abstol + eps * norm(A) ) <= n* THRESH
178 * 1 if the test fails i.e.
179 * |AQ -QL| / (abstol + eps * norm(A) ) > n * THRESH
180 *
181 * .. Local Scalars ..
182 *
183  INTEGER INFO, J, LOCALCOL, MP, MYCOL, MYROW, NPCOL,
184  $ NPROW, NQ, PCOL
185  DOUBLE PRECISION NORM
186 * ..
187 * .. Parameters ..
188  INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
189  $ MB_, NB_, RSRC_, CSRC_, LLD_
190  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
191  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
192  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
193  COMPLEX*16 ONE, NEGONE
194  PARAMETER ( ONE = 1.0d+0, negone = -1.0d+0 )
195 * ..
196 * .. External Functions ..
197  INTEGER INDXG2L, INDXG2P, NUMROC
198  DOUBLE PRECISION PZLANGE
199  EXTERNAL indxg2l, indxg2p, numroc, pzlange
200 * ..
201 * .. External Subroutines ..
202  EXTERNAL blacs_gridinfo, chk1mat, pxerbla, pzgemm,
203  $ zdscal, zlacpy
204 * ..
205 * .. Intrinsic Functions ..
206  INTRINSIC max
207 * ..
208 * .. Executable Statements ..
209 * This is just to keep ftnchek happy
210  IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
211  $ rsrc_.LT.0 )RETURN
212 *
213  result = 0
214 *
215  CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
216 *
217  info = 0
218  CALL chk1mat( ms, 1, ms, 1, ia, ja, desca, 6, info )
219  CALL chk1mat( ms, 1, nv, 2, iq, jq, descq, 12, info )
220  CALL chk1mat( ms, 1, nv, 2, ic, jc, descc, 16, info )
221 *
222  IF( info.EQ.0 ) THEN
223 *
224  mp = numroc( ms, desca( mb_ ), myrow, 0, nprow )
225  nq = numroc( nv, desca( nb_ ), mycol, 0, npcol )
226 *
227  IF( iq.NE.1 ) THEN
228  info = -10
229  ELSE IF( jq.NE.1 ) THEN
230  info = -11
231  ELSE IF( ia.NE.1 ) THEN
232  info = -4
233  ELSE IF( ja.NE.1 ) THEN
234  info = -5
235  ELSE IF( ic.NE.1 ) THEN
236  info = -14
237  ELSE IF( jc.NE.1 ) THEN
238  info = -15
239  ELSE IF( lwork.LT.nq ) THEN
240  info = -19
241  END IF
242  END IF
243 *
244  IF( info.NE.0 ) THEN
245  CALL pxerbla( desca( ctxt_ ), 'PZSEPCHK', -info )
246  RETURN
247  END IF
248 *
249 * C = Q * W
250 *
251  CALL zlacpy( 'A', mp, nq, q, descq( lld_ ), c, descc( lld_ ) )
252 *
253 *
254  DO 10 j = 1, nv
255  pcol = indxg2p( j, descc( nb_ ), 0, 0, npcol )
256  localcol = indxg2l( j, descc( nb_ ), 0, 0, npcol )
257 *
258  IF( mycol.EQ.pcol ) THEN
259  CALL zdscal( mp, w( j ), c( ( localcol-1 )*descc( lld_ )+
260  $ 1 ), 1 )
261  END IF
262  10 CONTINUE
263 *
264 *
265 * C = C - A * Q
266 *
267  CALL pzgemm( 'N', 'N', ms, nv, ms, negone, a, 1, 1, desca, q, 1,
268  $ 1, descq, one, c, 1, 1, descc )
269 *
270 * Compute the norm of C
271 *
272 *
273  norm = pzlange( 'M', ms, nv, c, 1, 1, descc, work )
274 *
275 *
276  tstnrm = norm / epsnorma / max( ms, 1 )
277 *
278  IF( tstnrm.GT.thresh .OR. ( tstnrm-tstnrm.NE.0.0d0 ) ) THEN
279  result = 1
280  END IF
281 *
282 *
283  RETURN
284 *
285 * End of PZSEPCHK
286 *
287  END
max
#define max(A, B)
Definition: pcgemr.c:180
pzsepchk
subroutine pzsepchk(MS, NV, A, IA, JA, DESCA, EPSNORMA, THRESH, Q, IQ, JQ, DESCQ, C, IC, JC, DESCC, W, WORK, LWORK, TSTNRM, RESULT)
Definition: pzsepchk.f:6
chk1mat
subroutine chk1mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, INFO)
Definition: chk1mat.f:3
pxerbla
subroutine pxerbla(ICTXT, SRNAME, INFO)
Definition: pxerbla.f:2