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

◆ pdsepreq()

subroutine pdsepreq ( character  hetero,
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 pdsepreq.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 CHARACTER HETERO
13 INTEGER INFO, MEMSIZE, NIN, NNOCHECK, NOUT, NPASSED,
14 $ NSKIPPED, NTESTS
15* ..
16* .. Array Arguments ..
17 INTEGER ISEED( 4 )
18 DOUBLE PRECISION MEM( MEMSIZE )
19* ..
20*
21* Purpose
22* =======
23*
24* PDSEPREQ performs one request from the input file 'SEP.dat'
25* A request is the cross product of the specifications in the
26* input file. PDSEPREQ prints one line per test.
27*
28* Arguments
29* =========
30*
31* NIN (local input) INTEGER
32* The unit number for the input file 'SEP.dat'
33*
34* MEM (local input ) DOUBLE PRECISION ARRAY, dimension MEMSIZE
35* Array encompassing the available single precision memory
36*
37* MEMSIZE (local input) INTEGER
38* Size of MEM array
39*
40* NOUT (local input) INTEGER
41* The unit number for output file.
42* NOUT = 6, output to screen,
43* NOUT = 0, output to stderr.
44* NOUT = 13, output to file, divide thresh by 10
45* NOUT = 14, output to file, divide thresh by 20
46* Only used on node 0.
47* NOUT = 13, 14 allow the threshold to be tighter for our
48* internal testing which means that when a user reports
49* a threshold error, it is more likely to be significant.
50*
51* ISEED (global input/output) INTEGER array, dimension 4
52* Random number generator seed
53*
54* NTESTS (global input/output) INTEGER
55* NTESTS = NTESTS + tests requested
56*
57* NSKIPPED (global input/output) INTEGER
58* NSKIPPED = NSKIPPED + tests skipped
59*
60* NNOCHECK (global input/output) INTEGER
61* NNOCHECK = NNOCHECK + tests completed but not checked
62*
63* NPASSED (global input/output) INTEGER
64* NPASSED = NPASSED + tests which passed all checks
65*
66*
67*
68* INFO (global output) INTEGER
69* 0 = test request ran
70* -1 = end of file
71* -2 = incorrect .dat file
72*
73*
74* .. Parameters ..
75*
76 INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
77 $ MB_, NB_, RSRC_, CSRC_, LLD_
78 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
79 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
80 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
81 INTEGER DBLESZ, INTGSZ
82 parameter( dblesz = 8, intgsz = 4 )
83 INTEGER MAXSETSIZE
84 parameter( maxsetsize = 50 )
85* ..
86* .. Local Scalars ..
87 CHARACTER SUBTESTS
88 INTEGER CONTEXT, IAM, IMIDPAD, INITCON, IPOSTPAD,
89 $ IPREPAD, ISIZESUBTST, ISIZESYEVX, ISIZETST,
90 $ LDA, LLWORK, MATSIZE, MATTYPE, MYCOL, MYROW, N,
91 $ NB, NMATSIZES, NMATTYPES, NNODES, NP, NPCOL,
92 $ NPCONFIGS, NPROW, NQ, NUPLOS, ORDER, PCONFIG,
93 $ PTRA, PTRCOPYA, PTRGAP, PTRICLUS, PTRIFAIL,
94 $ PTRIWRK, PTRW, PTRW2, PTRWORK, PTRZ, RES,
95 $ SIZECHK, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF,
96 $ SIZEQTQ, SIZESUBTST, SIZESYEV, SIZESYEVX,
97 $ SIZETMS, SIZETST, UPLO, ISIZESYEVD, SIZESYEVD
98
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 INTEGER ICEIL, NUMROC
109 EXTERNAL iceil, numroc
110* ..
111* .. External Subroutines ..
112 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
113 $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
114 $ descinit, pdlasizesqp, pdsepinfo, pdseptst
115* ..
116* .. Intrinsic Functions ..
117 INTRINSIC max
118* ..
119* .. Executable Statements ..
120* This is just to keep ftnchek happy
121 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
122 $ rsrc_.LT.0 )RETURN
123*
124 CALL blacs_pinfo( iam, nnodes )
125 CALL blacs_get( -1, 0, initcon )
126 CALL blacs_gridinit( initcon, 'R', 1, nnodes )
127*
128 CALL pdsepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
129 $ matsizes, nuplos, uplos, npconfigs, nprows,
130 $ npcols, nbs, nmattypes, mattypes, 22, subtests,
131 $ thresh, order, abstol, info )
132*
133 CALL blacs_gridexit( initcon )
134*
135 IF( info.EQ.0 ) THEN
136*
137*
138 DO 40 matsize = 1, nmatsizes
139*
140 DO 30 pconfig = 1, npconfigs
141*
142 DO 20 mattype = 1, nmattypes
143*
144 DO 10 uplo = 1, nuplos
145*
146 n = matsizes( matsize )
147 order = n
148*
149 nprow = nprows( pconfig )
150 npcol = npcols( pconfig )
151 nb = nbs( pconfig )
152*
153 np = numroc( n, nb, 0, 0, nprow )
154 nq = numroc( n, nb, 0, 0, npcol )
155 iprepad = max( nb, np )
156 imidpad = nb
157 ipostpad = max( nb, nq )
158*
159 lda = max( np, 1 ) + imidpad
160*
161 CALL blacs_get( -1, 0, context )
162 CALL blacs_gridinit( context, 'R', nprow, npcol )
163 CALL blacs_gridinfo( context, nprow, npcol, myrow,
164 $ mycol )
165*
166 IF( myrow.GE.0 ) THEN
167 CALL descinit( desca, n, n, nb, nb, 0, 0,
168 $ context, lda, info )
169 CALL pdlasizesqp( desca, iprepad, ipostpad,
170 $ sizemqrleft, sizemqrright,
171 $ sizeqrf, sizetms, sizeqtq,
172 $ sizechk, sizesyevx,
173 $ isizesyevx, sizesyev,
174 $ sizesyevd, isizesyevd,
175 $ sizesubtst, isizesubtst,
176 $ sizetst, isizetst )
177*
178 ptra = 1
179 ptrz = ptra + lda*nq + iprepad + ipostpad
180 ptrcopya = ptrz + lda*nq + iprepad + ipostpad
181 ptrw = ptrcopya + lda*nq + iprepad + ipostpad
182 ptrw2 = ptrw + max( n, 1 ) + iprepad + ipostpad
183 ptrgap = ptrw2 + max( n, 1 ) + iprepad +
184 $ ipostpad
185 ptrifail = ptrgap + nprow*npcol + iprepad +
186 $ ipostpad
187 ptriclus = ptrifail + iceil( n+iprepad+ipostpad,
188 $ dblesz / intgsz )
189 ptriwrk = ptriclus + iceil( 2*nprow*npcol+
190 $ iprepad+ipostpad, dblesz / intgsz )
191 ptrwork = ptriwrk + iceil( isizetst+iprepad+
192 $ ipostpad, dblesz / intgsz )
193 llwork = memsize - ptrwork + 1
194C LLWORK = MEMSIZE - PTRWORK - IPREPAD -
195C $ IPOSTPAD + 1
196 ntests = ntests + 1
197 IF( llwork.LT.sizetst ) THEN
198 nskipped = nskipped + 1
199 ELSE
200 CALL pdseptst( desca, uplos( uplo ), n,
201 $ mattypes( mattype ), subtests,
202 $ thresh, n, abstol, iseed,
203 $ mem( ptra ), mem( ptrcopya ),
204 $ mem( ptrz ), lda, mem( ptrw ),
205 $ mem( ptrw2 ), mem( ptrifail ),
206 $ mem( ptriclus ),
207 $ mem( ptrgap ), iprepad,
208 $ ipostpad, mem( ptrwork ),
209 $ llwork, mem( ptriwrk ),
210 $ isizetst, hetero, nout, res )
211*
212 IF( res.EQ.0 ) THEN
213 npassed = npassed + 1
214 ELSE IF( res.EQ.2 ) THEN
215 nnocheck = nnocheck + 1
216 ELSE IF( res.EQ.3 ) THEN
217 nskipped = nskipped + 1
218 WRITE( nout, fmt = * )' PDSEPREQ failed'
219 CALL blacs_abort( context, -1 )
220 END IF
221 END IF
222 CALL blacs_gridexit( context )
223 END IF
224 10 CONTINUE
225 20 CONTINUE
226 30 CONTINUE
227 40 CONTINUE
228 END IF
229*
230*
231 RETURN
232*
233* End of PDDSEPREQ
234*
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
pdlasizesqp
subroutine pdlasizesqp(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, sizeqtq, sizechk, sizesyevx, isizesyevx, sizesyev, sizesyevd, isizesyevd, sizesubtst, isizesubtst, sizetst, isizetst)
Definition pdlasizesqp.f:7
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
pdseptst
subroutine pdseptst(desca, uplo, n, mattype, subtests, thresh, order, abstol, iseed, a, copya, z, lda, win, wnew, ifail, iclustr, gap, iprepad, ipostpad, work, lwork, iwork, liwork, hetero, nout, info)
Definition pdseptst.f:6
Here is the call graph for this function:
Here is the caller graph for this function: