SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
pcgsepreq.f
Go to the documentation of this file.
1*
2*
3 SUBROUTINE pcgsepreq( NIN, MEM, MEMSIZE, NOUT, ISEED, NTESTS,
4 $ NSKIPPED, NNOCHECK, NPASSED, INFO )
5*
6* -- ScaLAPACK test routine (version 1.7) --
7* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
8* and University of California, Berkeley.
9* October 15, 1999
10*
11* .. Scalar Arguments ..
12 INTEGER INFO, MEMSIZE, NIN, NNOCHECK, NOUT, NPASSED,
13 $ nskipped, ntests
14* ..
15* .. Array Arguments ..
16 INTEGER ISEED( 4 )
17 COMPLEX MEM( MEMSIZE )
18* ..
19*
20* Purpose
21* =======
22*
23* PCGSEPREQ performs one request from the input file 'SEP.dat'
24* A request is the cross product of the specifications in the
25* input file. PCGSEPREQ prints one line per test.
26*
27* Arguments
28* =========
29*
30* NIN (local input) INTEGER
31* The unit number for the input file 'SEP.dat'
32*
33* MEM (local input) COMPLEX ARRAY, dimension MEMSIZE
34* Array encompassing the available single precision memory
35*
36* MEMSIZE (local input) INTEGER
37* Size of MEM array
38*
39* NOUT (local input) INTEGER
40* The unit number for output file.
41* NOUT = 6, output to screen,
42* NOUT = 0, output to stderr.
43* NOUT = 13, output to file, divide thresh by 10
44* NOUT = 14, output to file, divide thresh by 20
45* Only used on node 0.
46* NOUT = 13, 14 allow the threshold to be tighter for our
47* internal testing which means that when a user reports
48* a threshold error, it is more likely to be significant.
49*
50* ISEED (global input/output) INTEGER array, dimension 4
51* Random number generator seed
52*
53* NTESTS (global input/output) INTEGER
54* NTESTS = NTESTS + tests requested
55*
56* NSKIPPED (global input/output) INTEGER
57* NSKIPPED = NSKIPPED + tests skipped
58*
59* NNOCHECK (global input/output) INTEGER
60* NNOCHECK = NNOCHECK + tests completed but not checked
61*
62* NPASSED (global input/output) INTEGER
63* NPASSED = NPASSED + tests which passed all checks
64*
65*
66*
67* INFO (global output) INTEGER
68* 0 = test request ran
69* -1 = end of file
70* -2 = incorrect .dat file
71*
72*
73* .. Parameters ..
74*
75 INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
76 $ mb_, nb_, rsrc_, csrc_, lld_
77 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
78 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
79 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
80 REAL FIVE
81 parameter( five = 5.0e+0 )
82 INTEGER CPLXSZ, INTGSZ
83 parameter( cplxsz = 8, intgsz = 4 )
84 INTEGER REALSZ
85 parameter( realsz = 4 )
86 INTEGER MAXSETSIZE
87 parameter( maxsetsize = 50 )
88* ..
89* .. Local Scalars ..
90 CHARACTER SUBTESTS
91 INTEGER CONTEXT, IAM, IBTYPE, IMIDPAD, INITCON,
92 $ ipostpad, iprepad, isizeheevx, isizesubtst,
93 $ isizetst, lda, llrwork, matsize, mattype,
94 $ mycol, myrow, n, nb, nibtypes, nmatsizes,
95 $ nmattypes, nnodes, np, npcol, npconfigs, nprow,
96 $ nq, nuplos, order, pconfig, ptra, ptrb,
97 $ ptrcopya, ptrcopyb, ptrgap, ptriclus, ptrifail,
98 $ ptriwrk, ptrrwork, ptrw, ptrw2, ptrwork, ptrz,
99 $ res, rsizechk, rsizeheevx, rsizeqtq,
100 $ rsizesubtst, rsizetst, sizeheevx, sizemqrleft,
101 $ sizemqrright, sizeqrf, sizesubtst, sizetms,
102 $ sizetst, uplo
103 REAL ABSTOL, THRESH
104* ..
105* .. Local Arrays ..
106 CHARACTER UPLOS( 2 )
107 INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
108 $ mattypes( maxsetsize ), nbs( maxsetsize ),
109 $ npcols( maxsetsize ), nprows( maxsetsize )
110* ..
111* .. External Functions ..
112 LOGICAL LSAME
113 INTEGER ICEIL, NUMROC
114 EXTERNAL lsame, iceil, numroc
115* ..
116* .. External Subroutines ..
117 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
118 $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
119 $ descinit, pcgseptst, pclasizegsep, pssepinfo
120* ..
121* .. Intrinsic Functions ..
122 INTRINSIC max
123* ..
124* .. Executable Statements ..
125* This is just to keep ftnchek happy
126 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
127 $ rsrc_.LT.0 )RETURN
128*
129 CALL blacs_pinfo( iam, nnodes )
130 CALL blacs_get( -1, 0, initcon )
131 CALL blacs_gridinit( initcon, 'R', 1, nnodes )
132*
133 CALL pssepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
134 $ matsizes, nuplos, uplos, npconfigs, nprows,
135 $ npcols, nbs, nmattypes, mattypes, 22, subtests,
136 $ thresh, order, abstol, info )
137*
138 CALL blacs_gridexit( initcon )
139*
140 IF( info.EQ.0 ) THEN
141*
142* Thresholds must be bigger for the generalized problem.
143*
144 thresh = thresh*five
145*
146 DO 50 matsize = 1, nmatsizes
147*
148 DO 40 pconfig = 1, npconfigs
149*
150 DO 30 mattype = 1, nmattypes
151*
152 DO 20 uplo = 1, nuplos
153 IF( lsame( subtests, 'Y' ) ) THEN
154 nibtypes = 3
155 ELSE
156 nibtypes = 1
157 END IF
158 DO 10 ibtype = 1, nibtypes
159*
160 n = matsizes( matsize )
161 order = n
162*
163 nprow = nprows( pconfig )
164 npcol = npcols( pconfig )
165 nb = nbs( pconfig )
166*
167 np = numroc( n, nb, 0, 0, nprow )
168 nq = numroc( n, nb, 0, 0, npcol )
169 iprepad = max( nb, np )
170 imidpad = nb
171 ipostpad = max( nb, nq )
172*
173 lda = max( np, 1 ) + imidpad
174*
175 CALL blacs_get( -1, 0, context )
176 CALL blacs_gridinit( context, 'R', nprow,
177 $ npcol )
178 CALL blacs_gridinfo( context, nprow, npcol,
179 $ myrow, mycol )
180 IF( myrow.GE.0 ) THEN
181 CALL descinit( desca, n, n, nb, nb, 0, 0,
182 $ context, lda, info )
183 CALL pclasizegsep( desca, iprepad, ipostpad,
184 $ sizemqrleft, sizemqrright,
185 $ sizeqrf, sizetms,
186 $ rsizeqtq, rsizechk,
187 $ sizeheevx, rsizeheevx,
188 $ isizeheevx, sizesubtst,
189 $ rsizesubtst, isizesubtst,
190 $ sizetst, rsizetst,
191 $ isizetst )
192*
193 ptra = 1
194 ptrz = ptra + lda*nq + iprepad + ipostpad
195 ptrcopyb = ptrz + lda*nq + iprepad + ipostpad
196 ptrb = ptrcopyb + lda*nq + iprepad + ipostpad
197 ptrcopya = ptrb + lda*nq + iprepad + ipostpad
198 ptrw = ptrcopya + lda*nq + iprepad + ipostpad
199 ptrw2 = ptrw + iceil( max( n, 1 )+iprepad+
200 $ ipostpad, cplxsz / realsz )
201 ptrwork = ptrw2 + iceil( max( n, 1 )+iprepad+
202 $ ipostpad, cplxsz / realsz )
203 ptrgap = ptrwork + sizetst + iprepad +
204 $ ipostpad
205 ptrifail = ptrgap + iceil( nprow*npcol+
206 $ iprepad+ipostpad,
207 $ cplxsz / realsz )
208 ptriclus = ptrifail +
209 $ iceil( n+iprepad+ipostpad,
210 $ cplxsz / intgsz )
211 ptriwrk = ptriclus + iceil( 2*nprow*npcol+
212 $ iprepad+ipostpad, cplxsz / intgsz )
213 ptrrwork = ptriwrk + iceil( isizetst+iprepad+
214 $ ipostpad, cplxsz / intgsz )
215 llrwork = ( memsize - ptrrwork - ipostpad -
216 $ iprepad + 1 )* ( cplxsz / realsz )
217 ntests = ntests + 1
218 IF( llrwork.LT.rsizetst ) THEN
219 nskipped = nskipped + 1
220 ELSE
221 CALL pcgseptst( desca, uplos( uplo ), n,
222 $ mattypes( mattype ),
223 $ ibtype, subtests, thresh,
224 $ n, abstol, iseed,
225 $ mem( ptra ),
226 $ mem( ptrcopya ),
227 $ mem( ptrb ),
228 $ mem( ptrcopyb ),
229 $ mem( ptrz ), lda,
230 $ mem( ptrw ), mem( ptrw2 ),
231 $ mem( ptrifail ),
232 $ mem( ptriclus ),
233 $ mem( ptrgap ), iprepad,
234 $ ipostpad, mem( ptrwork ),
235 $ sizetst, mem( ptrrwork ),
236 $ llrwork, mem( ptriwrk ),
237 $ isizetst, nout, res )
238*
239 IF( res.EQ.0 ) THEN
240 npassed = npassed + 1
241 ELSE IF( res.EQ.2 ) THEN
242 nnocheck = nnocheck + 1
243 ELSE IF( res.EQ.3 ) THEN
244 nskipped = nskipped + 1
245 WRITE( nout, fmt = * )
246 $ ' pCGSEPREQ failed'
247 CALL blacs_abort( context, -1 )
248 END IF
249 CALL blacs_gridexit( context )
250 END IF
251 END IF
252 10 CONTINUE
253 20 CONTINUE
254 30 CONTINUE
255 40 CONTINUE
256 50 CONTINUE
257 END IF
258*
259*
260 RETURN
261*
262* End of PCDGSEPREQ
263*
264 END
descinit
subroutine descinit(desc, m, n, mb, nb, irsrc, icsrc, ictxt, lld, info)
Definition descinit.f:3
max
#define max(A, B)
Definition pcgemr.c:180
pcgsepreq
subroutine pcgsepreq(nin, mem, memsize, nout, iseed, ntests, nskipped, nnocheck, npassed, info)
Definition pcgsepreq.f:5
pcgseptst
subroutine pcgseptst(desca, uplo, n, mattype, ibtype, subtests, thresh, order, abstol, iseed, a, copya, b, copyb, z, lda, win, wnew, ifail, iclustr, gap, iprepad, ipostpad, work, lwork, rwork, lrwork, iwork, liwork, nout, info)
Definition pcgseptst.f:8
pclasizegsep
subroutine pclasizegsep(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, rsizeqtq, rsizechk, sizeheevx, rsizeheevx, isizeheevx, sizesubtst, rsizesubtst, isizesubtst, sizetst, rsizetst, isizetst)
Definition pclasizegsep.f:7
pssepinfo
subroutine pssepinfo(context, iam, nin, nout, maxsetsize, nmatsizes, matsizes, nuplos, uplos, npconfigs, nprows, npcols, nbs, nmattypes, mattypes, maxtype, subtests, thresh, order, abstol, info)
Definition pssepinfo.f:8