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

◆ pssepreq()

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