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

◆ pdgsepreq()

subroutine pdgsepreq ( integer  nin,
double precision, 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 pdgsepreq.f.

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 DOUBLE PRECISION MEM( MEMSIZE )
18* ..
19*
20* Purpose
21* =======
22*
23* PDGSEPREQ performs one request from the input file 'SEP.dat'
24* A request is the cross product of the specifications in the
25* input file. PDGSEPREQ 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) DOUBLE PRECISION 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 DOUBLE PRECISION FIVE
81 parameter( five = 5.0d+0 )
82 INTEGER DBLESZ, INTGSZ
83 parameter( dblesz = 8, intgsz = 4 )
84 INTEGER MAXSETSIZE
85 parameter( maxsetsize = 50 )
86* ..
87* .. Local Scalars ..
88 CHARACTER SUBTESTS
89 INTEGER CONTEXT, IAM, IBTYPE, IMIDPAD, INITCON,
90 $ IPOSTPAD, IPREPAD, ISIZESUBTST, ISIZESYEVX,
91 $ ISIZETST, LDA, LLWORK, MATSIZE, MATTYPE, MYCOL,
92 $ MYROW, N, NB, NIBTYPES, NMATSIZES, NMATTYPES,
93 $ NNODES, NP, NPCOL, NPCONFIGS, NPROW, NQ,
94 $ NUPLOS, ORDER, PCONFIG, PTRA, PTRB, PTRCOPYA,
95 $ PTRCOPYB, PTRGAP, PTRICLUS, PTRIFAIL, PTRIWRK,
96 $ PTRW, PTRW2, PTRWORK, PTRZ, RES, SIZECHK,
97 $ SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZEQTQ,
98 $ SIZESUBTST, SIZESYEVX, SIZETMS, SIZETST, UPLO
99 DOUBLE PRECISION ABSTOL, THRESH
100* ..
101* .. Local Arrays ..
102 CHARACTER UPLOS( 2 )
103 INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
104 $ MATTYPES( MAXSETSIZE ), NBS( MAXSETSIZE ),
105 $ NPCOLS( MAXSETSIZE ), NPROWS( MAXSETSIZE )
106* ..
107* .. External Functions ..
108 LOGICAL LSAME
109 INTEGER ICEIL, NUMROC
110 EXTERNAL lsame, iceil, numroc
111* ..
112* .. External Subroutines ..
113 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
114 $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
115 $ descinit, pdgseptst, pdlasizegsep, pdsepinfo
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 pdsepinfo( 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* Thresholds must be bigger for the generalized problem.
139*
140 thresh = thresh*five
141*
142 DO 50 matsize = 1, nmatsizes
143*
144 DO 40 pconfig = 1, npconfigs
145*
146 DO 30 mattype = 1, nmattypes
147*
148 DO 20 uplo = 1, nuplos
149 IF( lsame( subtests, 'Y' ) ) THEN
150 nibtypes = 3
151 ELSE
152 nibtypes = 1
153 END IF
154 DO 10 ibtype = 1, nibtypes
155*
156 n = matsizes( matsize )
157 order = n
158*
159 nprow = nprows( pconfig )
160 npcol = npcols( pconfig )
161 nb = nbs( pconfig )
162*
163 np = numroc( n, nb, 0, 0, nprow )
164 nq = numroc( n, nb, 0, 0, npcol )
165 iprepad = max( nb, np )
166 imidpad = nb
167 ipostpad = max( nb, nq )
168*
169 lda = max( np, 1 ) + imidpad
170*
171 CALL blacs_get( -1, 0, context )
172 CALL blacs_gridinit( context, 'R', nprow,
173 $ npcol )
174 CALL blacs_gridinfo( context, nprow, npcol,
175 $ myrow, mycol )
176 IF( myrow.GE.0 ) THEN
177 CALL descinit( desca, n, n, nb, nb, 0, 0,
178 $ context, lda, info )
179 CALL pdlasizegsep( desca, iprepad, ipostpad,
180 $ sizemqrleft, sizemqrright,
181 $ sizeqrf, sizetms, sizeqtq,
182 $ sizechk, sizesyevx,
183 $ isizesyevx, sizesubtst,
184 $ isizesubtst, sizetst,
185 $ isizetst )
186*
187 ptra = 1
188 ptrz = ptra + lda*nq + iprepad + ipostpad
189 ptrcopyb = ptrz + lda*nq + iprepad + ipostpad
190 ptrb = ptrcopyb + lda*nq + iprepad + ipostpad
191 ptrcopya = ptrb + lda*nq + iprepad + ipostpad
192 ptrw = ptrcopya + lda*nq + iprepad + ipostpad
193 ptrw2 = ptrw + max( n, 1 ) + iprepad +
194 $ ipostpad
195 ptrgap = ptrw2 + max( n, 1 ) + iprepad +
196 $ ipostpad
197 ptrifail = ptrgap + nprow*npcol + iprepad +
198 $ ipostpad
199 ptriclus = ptrifail +
200 $ iceil( n+iprepad+ipostpad,
201 $ dblesz / intgsz )
202 ptriwrk = ptriclus + iceil( 2*nprow*npcol+
203 $ iprepad+ipostpad, dblesz / intgsz )
204 ptrwork = ptriwrk + iceil( isizetst+iprepad+
205 $ ipostpad, dblesz / intgsz )
206 llwork = memsize - ptrwork - ipostpad -
207 $ iprepad + 1
208 ntests = ntests + 1
209 IF( llwork.LT.sizetst ) THEN
210 nskipped = nskipped + 1
211 ELSE
212 CALL pdgseptst( desca, uplos( uplo ), n,
213 $ mattypes( mattype ),
214 $ ibtype, subtests, thresh,
215 $ n, abstol, iseed,
216 $ mem( ptra ),
217 $ mem( ptrcopya ),
218 $ mem( ptrb ),
219 $ mem( ptrcopyb ),
220 $ mem( ptrz ), lda,
221 $ mem( ptrw ), mem( ptrw2 ),
222 $ mem( ptrifail ),
223 $ mem( ptriclus ),
224 $ mem( ptrgap ), iprepad,
225 $ ipostpad, mem( ptrwork ),
226 $ llwork, mem( ptriwrk ),
227 $ isizetst, nout, res )
228*
229 IF( res.EQ.0 ) THEN
230 npassed = npassed + 1
231 ELSE IF( res.EQ.2 ) THEN
232 nnocheck = nnocheck + 1
233 ELSE IF( res.EQ.3 ) THEN
234 nskipped = nskipped + 1
235 WRITE( nout, fmt = * )
236 $ ' pDGSEPREQ failed'
237 CALL blacs_abort( context, -1 )
238 END IF
239 CALL blacs_gridexit( context )
240 END IF
241 END IF
242 10 CONTINUE
243 20 CONTINUE
244 30 CONTINUE
245 40 CONTINUE
246 50 CONTINUE
247 END IF
248*
249*
250 RETURN
251*
252* End of PDDGSEPREQ
253*
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
pdgseptst
subroutine pdgseptst(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, iwork, liwork, nout, info)
Definition pdgseptst.f:8
pdlasizegsep
subroutine pdlasizegsep(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, sizeqtq, sizechk, sizesyevx, isizesyevx, sizesubtst, isizesubtst, sizetst, isizetst)
Definition pdlasizegsep.f:8
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
lsame
logical function lsame(ca, cb)
Definition tools.f:1724
Here is the call graph for this function:
Here is the caller graph for this function: