SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ pzsepreq()

subroutine pzsepreq ( integer  nin,
complex*16, dimension( memsize )  mem,
integer  memsize,
integer  nout,
integer, dimension( 4 )  iseed,
integer  ntests,
integer  nskipped,
integer  nnocheck,
integer  npassed,
integer  info 
)

Definition at line 3 of file pzsepreq.f.

5*
6* -- ScaLAPACK routine (version 1.7) --
7* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
8* and University of California, Berkeley.
9* May 1, 1997
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*16 MEM( MEMSIZE )
18* ..
19*
20* Purpose
21* =======
22*
23* PZSEPREQ performs one request from the input file 'SEP.dat'
24* A request is the cross product of the specifications in the
25* input file. PZSEPREQ 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*16 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 INTEGER ZPLXSZ, INTGSZ
81 parameter( zplxsz = 16, intgsz = 4 )
82 INTEGER DBLESZ
83 parameter( dblesz = 8 )
84 INTEGER MAXSETSIZE
85 parameter( maxsetsize = 50 )
86* ..
87* .. Local Scalars ..
88 CHARACTER SUBTESTS
89 INTEGER CONTEXT, IAM, IMIDPAD, INITCON, IPOSTPAD,
90 $ IPREPAD, ISIZEHEEVX, ISIZESUBTST, ISIZETST,
91 $ LDA, LLRWORK, MATSIZE, MATTYPE, MYCOL, MYROW,
92 $ N, NB, NMATSIZES, NMATTYPES, NNODES, NP, NPCOL,
93 $ NPCONFIGS, NPROW, NQ, NUPLOS, ORDER, PCONFIG,
94 $ PTRA, PTRCOPYA, PTRGAP, PTRICLUS, PTRIFAIL,
95 $ PTRIWRK, PTRRWORK, PTRW, PTRW2, PTRWORK, PTRZ,
96 $ RES, RSIZECHK, RSIZEHEEVX, RSIZEQTQ,
97 $ RSIZESUBTST, RSIZETST, SIZEHEEVX, SIZEMQRLEFT,
98 $ SIZEMQRRIGHT, SIZEQRF, SIZESUBTST, SIZETMS,
99 $ SIZETST, UPLO, SIZEHEEVD, RSIZEHEEVD,
100 $ ISIZEHEEVD
101 DOUBLE PRECISION ABSTOL, THRESH
102* ..
103* .. Local Arrays ..
104 CHARACTER UPLOS( 2 )
105 INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
106 $ MATTYPES( MAXSETSIZE ), NBS( MAXSETSIZE ),
107 $ NPCOLS( MAXSETSIZE ), NPROWS( MAXSETSIZE )
108* ..
109* .. External Functions ..
110 INTEGER ICEIL, NUMROC
111 EXTERNAL iceil, numroc
112* ..
113* .. External Subroutines ..
114 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
115 $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
116 $ descinit, pdsepinfo, pzlasizesep, pzseptst
117* ..
118* .. Intrinsic Functions ..
119 INTRINSIC max
120* ..
121* .. Executable Statements ..
122* This is just to keep ftnchek happy
123 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
124 $ rsrc_.LT.0 )RETURN
125*
126 CALL blacs_pinfo( iam, nnodes )
127 CALL blacs_get( -1, 0, initcon )
128 CALL blacs_gridinit( initcon, 'R', 1, nnodes )
129*
130 CALL pdsepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
131 $ matsizes, nuplos, uplos, npconfigs, nprows,
132 $ npcols, nbs, nmattypes, mattypes, 22, subtests,
133 $ thresh, order, abstol, info )
134*
135 CALL blacs_gridexit( initcon )
136*
137 IF( info.EQ.0 ) THEN
138*
139*
140 DO 40 matsize = 1, nmatsizes
141*
142 DO 30 pconfig = 1, npconfigs
143*
144 DO 20 mattype = 1, nmattypes
145*
146 DO 10 uplo = 1, nuplos
147*
148 n = matsizes( matsize )
149 order = n
150*
151 nprow = nprows( pconfig )
152 npcol = npcols( pconfig )
153 nb = nbs( pconfig )
154*
155 np = numroc( n, nb, 0, 0, nprow )
156 nq = numroc( n, nb, 0, 0, npcol )
157 iprepad = max( nb, np )
158 imidpad = nb
159 ipostpad = max( nb, nq )
160*
161 lda = max( np, 1 ) + imidpad
162*
163 CALL blacs_get( -1, 0, context )
164 CALL blacs_gridinit( context, 'R', nprow, npcol )
165 CALL blacs_gridinfo( context, nprow, npcol, myrow,
166 $ mycol )
167 IF( myrow.GE.0 ) THEN
168 CALL descinit( desca, n, n, nb, nb, 0, 0,
169 $ context, lda, info )
170 CALL pzlasizesep( desca, iprepad, ipostpad,
171 $ sizemqrleft, sizemqrright,
172 $ sizeqrf, sizetms, rsizeqtq,
173 $ rsizechk, sizeheevx,
174 $ rsizeheevx, isizeheevx,
175 $ sizeheevd, rsizeheevd,
176 $ isizeheevd,
177 $ sizesubtst, rsizesubtst,
178 $ isizesubtst, sizetst,
179 $ rsizetst, isizetst )
180*
181 ptra = 1
182 ptrz = ptra + lda*nq + iprepad + ipostpad
183 ptrcopya = ptrz + lda*nq + iprepad + ipostpad
184 ptrw = ptrcopya + lda*nq + iprepad + ipostpad
185 ptrw2 = ptrw + iceil( max( n, 1 )+iprepad+
186 $ ipostpad, zplxsz / dblesz )
187 ptrwork = ptrw2 + iceil( max( n, 1 )+iprepad+
188 $ ipostpad, zplxsz / dblesz )
189 ptrgap = ptrwork + sizetst + iprepad + ipostpad
190 ptrifail = ptrgap + iceil( nprow*npcol+iprepad+
191 $ ipostpad, zplxsz / dblesz )
192 ptriclus = ptrifail + iceil( n+iprepad+ipostpad,
193 $ zplxsz / intgsz )
194 ptriwrk = ptriclus + iceil( 2*nprow*npcol+
195 $ iprepad+ipostpad, zplxsz / intgsz )
196 ptrrwork = ptriwrk + iceil( isizetst+iprepad+
197 $ ipostpad, zplxsz / intgsz )
198 llrwork = ( memsize-ptrrwork+1 )*zplxsz / dblesz
199C LLRWORK = ( MEMSIZE-PTRRWORK-IPREPAD-IPOSTPAD+1)
200C $ *ZPLXSZ / DBLESZ
201 ntests = ntests + 1
202 IF( llrwork.LT.rsizetst ) THEN
203 nskipped = nskipped + 1
204 ELSE
205 CALL pzseptst( desca, uplos( uplo ), n,
206 $ mattypes( mattype ), subtests,
207 $ thresh, n, abstol, iseed,
208 $ mem( ptra ), mem( ptrcopya ),
209 $ mem( ptrz ), lda, mem( ptrw ),
210 $ mem( ptrw2 ), mem( ptrifail ),
211 $ mem( ptriclus ),
212 $ mem( ptrgap ), iprepad,
213 $ ipostpad, mem( ptrwork ),
214 $ sizetst, mem( ptrrwork ),
215 $ llrwork, mem( ptriwrk ),
216 $ isizetst, nout, res )
217*
218 IF( res.EQ.0 ) THEN
219 npassed = npassed + 1
220 ELSE IF( res.EQ.2 ) THEN
221 nnocheck = nnocheck + 1
222 ELSE IF( res.EQ.3 ) THEN
223 nskipped = nskipped + 1
224 WRITE( nout, fmt=* )' PZSEPREQ failed'
225 CALL blacs_abort( context, -1 )
226 END IF
227 END IF
228 CALL blacs_gridexit( context )
229 END IF
230 10 CONTINUE
231 20 CONTINUE
232 30 CONTINUE
233 40 CONTINUE
234 END IF
235*
236*
237 RETURN
238*
239* End of PZDSEPREQ
240*
descinit
subroutine descinit(desc, m, n, mb, nb, irsrc, icsrc, ictxt, lld, info)
Definition descinit.f:3
iceil
integer function iceil(inum, idenom)
Definition iceil.f:2
numroc
integer function numroc(n, nb, iproc, isrcproc, nprocs)
Definition numroc.f:2
max
#define max(A, B)
Definition pcgemr.c:180
pdsepinfo
subroutine pdsepinfo(context, iam, nin, nout, maxsetsize, nmatsizes, matsizes, nuplos, uplos, npconfigs, nprows, npcols, nbs, nmattypes, mattypes, maxtype, subtests, thresh, order, abstol, info)
Definition pdsepinfo.f:8
pzlasizesep
subroutine pzlasizesep(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, rsizeqtq, rsizechk, sizeheevx, rsizeheevx, isizeheevx, sizeheevd, rsizeheevd, isizeheevd, sizesubtst, rsizesubtst, isizesubtst, sizetst, rsizetst, isizetst)
Definition pzlasizesep.f:7
pzseptst
subroutine pzseptst(desca, uplo, n, mattype, subtests, thresh, order, abstol, iseed, a, copya, z, lda, win, wnew, ifail, iclustr, gap, iprepad, ipostpad, work, lwork, rwork, lrwork, iwork, liwork, nout, info)
Definition pzseptst.f:8
Here is the call graph for this function:
Here is the caller graph for this function: