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

◆ pcsepreq()

subroutine pcsepreq ( integer  nin,
complex, 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 pcsepreq.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 MEM( MEMSIZE )
18* ..
19*
20* Purpose
21* =======
22*
23* PCSEPREQ performs one request from the input file 'SEP.dat'
24* A request is the cross product of the specifications in the
25* input file. PCSEPREQ 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 INTEGER CPLXSZ, INTGSZ
81 parameter( cplxsz = 8, intgsz = 4 )
82 INTEGER REALSZ
83 parameter( realsz = 4 )
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, ISIZEHEEVD
100 REAL ABSTOL, THRESH
101* ..
102* .. Local Arrays ..
103 CHARACTER UPLOS( 2 )
104 INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
105 $ MATTYPES( MAXSETSIZE ), NBS( MAXSETSIZE ),
106 $ NPCOLS( MAXSETSIZE ), NPROWS( MAXSETSIZE )
107* ..
108* .. External Functions ..
109 INTEGER ICEIL, NUMROC
110 EXTERNAL iceil, numroc
111* ..
112* .. External Subroutines ..
113 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
114 $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
115 $ descinit, pclasizesep, pcseptst, pssepinfo
116* ..
117* .. Intrinsic Functions ..
118 INTRINSIC max
119* ..
120* .. Executable Statements ..
121* This is just to keep ftnchek happy
122 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
123 $ rsrc_.LT.0 )RETURN
124*
125 CALL blacs_pinfo( iam, nnodes )
126 CALL blacs_get( -1, 0, initcon )
127 CALL blacs_gridinit( initcon, 'R', 1, nnodes )
128*
129 CALL pssepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
130 $ matsizes, nuplos, uplos, npconfigs, nprows,
131 $ npcols, nbs, nmattypes, mattypes, 22, subtests,
132 $ thresh, order, abstol, info )
133*
134 CALL blacs_gridexit( initcon )
135*
136 IF( info.EQ.0 ) THEN
137*
138*
139 DO 40 matsize = 1, nmatsizes
140*
141 DO 30 pconfig = 1, npconfigs
142*
143 DO 20 mattype = 1, nmattypes
144*
145 DO 10 uplo = 1, nuplos
146*
147 n = matsizes( matsize )
148 order = n
149*
150 nprow = nprows( pconfig )
151 npcol = npcols( pconfig )
152 nb = nbs( pconfig )
153*
154 np = numroc( n, nb, 0, 0, nprow )
155 nq = numroc( n, nb, 0, 0, npcol )
156 iprepad = max( nb, np )
157 imidpad = nb
158 ipostpad = max( nb, nq )
159*
160 lda = max( np, 1 ) + imidpad
161*
162 CALL blacs_get( -1, 0, context )
163 CALL blacs_gridinit( context, 'R', nprow, npcol )
164 CALL blacs_gridinfo( context, nprow, npcol, myrow,
165 $ mycol )
166 IF( myrow.GE.0 ) THEN
167 CALL descinit( desca, n, n, nb, nb, 0, 0,
168 $ context, lda, info )
169 CALL pclasizesep( desca, iprepad, ipostpad,
170 $ sizemqrleft, sizemqrright,
171 $ sizeqrf, sizetms, rsizeqtq,
172 $ rsizechk, sizeheevx,
173 $ rsizeheevx, isizeheevx,
174 $ sizeheevd, rsizeheevd, isizeheevd,
175 $ sizesubtst, rsizesubtst,
176 $ isizesubtst, sizetst,
177 $ rsizetst, isizetst )
178*
179 ptra = 1
180 ptrz = ptra + lda*nq + iprepad + ipostpad
181 ptrcopya = ptrz + lda*nq + iprepad + ipostpad
182 ptrw = ptrcopya + lda*nq + iprepad + ipostpad
183 ptrw2 = ptrw + iceil( max( n, 1 )+iprepad+
184 $ ipostpad, cplxsz / realsz )
185 ptrwork = ptrw2 + iceil( max( n, 1 )+iprepad+
186 $ ipostpad, cplxsz / realsz )
187 ptrgap = ptrwork + sizetst + iprepad + ipostpad
188 ptrifail = ptrgap + iceil( nprow*npcol+iprepad+
189 $ ipostpad, cplxsz / realsz )
190 ptriclus = ptrifail + iceil( n+iprepad+ipostpad,
191 $ cplxsz / intgsz )
192 ptriwrk = ptriclus + iceil( 2*nprow*npcol+
193 $ iprepad+ipostpad, cplxsz / intgsz )
194 ptrrwork = ptriwrk + iceil( isizetst+iprepad+
195 $ ipostpad, cplxsz / intgsz )
196 llrwork = ( memsize-ptrrwork+1 )*cplxsz / realsz
197C LLRWORK = ( MEMSIZE-PTRRWORK-IPREPAD-IPOSTPAD+1)
198C $ *CPLXSZ / REALSZ
199 ntests = ntests + 1
200 IF( llrwork.LT.rsizetst ) THEN
201 nskipped = nskipped + 1
202 ELSE
203 CALL pcseptst( desca, uplos( uplo ), n,
204 $ mattypes( mattype ), subtests,
205 $ thresh, n, abstol, iseed,
206 $ mem( ptra ), mem( ptrcopya ),
207 $ mem( ptrz ), lda, mem( ptrw ),
208 $ mem( ptrw2 ), mem( ptrifail ),
209 $ mem( ptriclus ),
210 $ mem( ptrgap ), iprepad,
211 $ ipostpad, mem( ptrwork ),
212 $ sizetst, mem( ptrrwork ),
213 $ llrwork, mem( ptriwrk ),
214 $ isizetst, nout, res )
215*
216 IF( res.EQ.0 ) THEN
217 npassed = npassed + 1
218 ELSE IF( res.EQ.2 ) THEN
219 nnocheck = nnocheck + 1
220 ELSE IF( res.EQ.3 ) THEN
221 nskipped = nskipped + 1
222 WRITE( nout, fmt=*)'pCSEPREQ failed'
223 CALL blacs_abort( context, -1 )
224 END IF
225 END IF
226 CALL blacs_gridexit( context )
227 END IF
228 10 CONTINUE
229 20 CONTINUE
230 30 CONTINUE
231 40 CONTINUE
232 END IF
233*
234*
235 RETURN
236*
237* End of PCDSEPREQ
238*
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
pclasizesep
subroutine pclasizesep(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, rsizeqtq, rsizechk, sizeheevx, rsizeheevx, isizeheevx, sizeheevd, rsizeheevd, isizeheevd, sizesubtst, rsizesubtst, isizesubtst, sizetst, rsizetst, isizetst)
Definition pclasizesep.f:7
pcseptst
subroutine pcseptst(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 pcseptst.f:8
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
Here is the call graph for this function:
Here is the caller graph for this function: