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

◆ psseprreq()

subroutine psseprreq ( 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 1 of file psseprreq.f.

3*
4* -- ScaLAPACK routine (@(MODE)version *TBA*) --
5* University of California, Berkeley and
6* University of Tennessee, Knoxville.
7* October 21, 2006
8*
9 IMPLICIT NONE
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* Purpose
21* =======
22*
23* PSSEPRREQ performs one request from the input file 'SEPR.dat'
24* A request is the cross product of the specifications in the
25* input file. It prints one line per test.
26*
27* Arguments
28* =========
29*
30* NIN (local input) INTEGER
31* The unit number for the input file 'SEPR.dat'
32*
33* MEM (local input ) REAL 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* INFO (global output) INTEGER
66* 0 = test request ran
67* -1 = end of file
68* -2 = incorrect .dat file
69*
70* .. Parameters ..
71*
72 INTEGER DLEN_
73 parameter( dlen_ = 9 )
74 INTEGER REALSZ, INTGSZ
75 parameter( realsz = 4, intgsz = 4 )
76 INTEGER MAXSETSIZE
77 parameter( maxsetsize = 50 )
78* ..
79* .. Local Scalars ..
80 CHARACTER SUBTESTS
81 INTEGER CONTEXT, IAM, IMIDPAD, INITCON, IPOSTPAD,
82 $ IPREPAD, ISIZESUBTST, ISIZEEVR, ISIZETST,
83 $ LDA, LLWORK, MATSIZE, MATTYPE, MYCOL, MYROW, N,
84 $ NB, NMATSIZES, NMATTYPES, NNODES, NP, NPCOL,
85 $ NPCONFIGS, NPROW, NQ, NUPLOS, ORDER, PCONFIG,
86 $ PTRA, PTRCOPYA, PTRGAP, PTRICLUS, PTRIFAIL,
87 $ PTRIWRK, PTRW, PTRW2, PTRWORK, PTRZ, RES,
88 $ SIZECHK, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF,
89 $ SIZEQTQ, SIZESUBTST, SIZEEVR,
90 $ SIZETMS, SIZETST, UPLO
91*
92 REAL ABSTOL, THRESH
93* ..
94* .. Local Arrays ..
95 CHARACTER UPLOS( 2 )
96 INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
97 $ MATTYPES( MAXSETSIZE ), NBS( MAXSETSIZE ),
98 $ NPCOLS( MAXSETSIZE ), NPROWS( MAXSETSIZE )
99* ..
100* .. External Functions ..
101 INTEGER ICEIL, NUMROC
102 EXTERNAL iceil, numroc
103* ..
104* .. External Subroutines ..
105 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
106 $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
107 $ descinit, pslasizesepr, pssepinfo, psseprtst
108* ..
109* .. Intrinsic Functions ..
110 INTRINSIC max
111* ..
112* .. Executable Statements ..
113*
114 CALL blacs_pinfo( iam, nnodes )
115 CALL blacs_get( -1, 0, initcon )
116 CALL blacs_gridinit( initcon, 'R', 1, nnodes )
117*
118 CALL pssepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
119 $ matsizes, nuplos, uplos, npconfigs, nprows,
120 $ npcols, nbs, nmattypes, mattypes, 22, subtests,
121 $ thresh, order, abstol, info )
122*
123 CALL blacs_gridexit( initcon )
124*
125 IF( info.EQ.0 ) THEN
126*
127 DO 40 matsize = 1, nmatsizes
128*
129 DO 30 pconfig = 1, npconfigs
130*
131 DO 20 mattype = 1, nmattypes
132*
133 DO 10 uplo = 1, nuplos
134*
135 n = matsizes( matsize )
136 order = n
137*
138 nprow = nprows( pconfig )
139 npcol = npcols( pconfig )
140 nb = nbs( pconfig )
141*
142 np = numroc( n, nb, 0, 0, nprow )
143 nq = numroc( n, nb, 0, 0, npcol )
144 iprepad = max( nb, np )
145 imidpad = nb
146 ipostpad = max( nb, nq )
147*
148 lda = max( np, 1 ) + imidpad
149*
150 CALL blacs_get( -1, 0, context )
151 CALL blacs_gridinit( context, 'R', nprow, npcol )
152 CALL blacs_gridinfo( context, nprow, npcol, myrow,
153 $ mycol )
154*
155 IF( myrow.GE.0 ) THEN
156 CALL descinit( desca, n, n, nb, nb, 0, 0,
157 $ context, lda, info )
158 CALL pslasizesepr( desca, iprepad, ipostpad,
159 $ sizemqrleft, sizemqrright,
160 $ sizeqrf, sizetms, sizeqtq,
161 $ sizechk, sizeevr, isizeevr,
162 $ sizesubtst, isizesubtst,
163 $ sizetst, isizetst )
164*
165 ptra = 1
166 ptrz = ptra + lda*nq + iprepad + ipostpad
167 ptrcopya = ptrz + lda*nq + iprepad + ipostpad
168 ptrw = ptrcopya + lda*nq + iprepad + ipostpad
169 ptrw2 = ptrw + max( n, 1 ) + iprepad + ipostpad
170 ptrgap = ptrw2 + max( n, 1 ) + iprepad +
171 $ ipostpad
172 ptrifail = ptrgap + nprow*npcol + iprepad +
173 $ ipostpad
174 ptriclus = ptrifail + iceil( n+iprepad+ipostpad,
175 $ realsz / intgsz )
176 ptriwrk = ptriclus + iceil( 2*nprow*npcol+
177 $ iprepad+ipostpad, realsz / intgsz )
178 ptrwork = ptriwrk + iceil( isizetst+iprepad+
179 $ ipostpad, realsz / intgsz )
180 llwork = memsize - ptrwork + 1
181
182 ntests = ntests + 1
183 IF( llwork.LT.sizetst ) THEN
184 nskipped = nskipped + 1
185 ELSE
186 CALL psseprtst( desca, uplos( uplo ), n,
187 $ mattypes( mattype ), subtests,
188 $ thresh, n, abstol, iseed,
189 $ mem( ptra ), mem( ptrcopya ),
190 $ mem( ptrz ), lda, mem( ptrw ),
191 $ mem( ptrw2 ), mem( ptrifail ),
192 $ mem( ptriclus ),
193 $ mem( ptrgap ), iprepad,
194 $ ipostpad, mem( ptrwork ),
195 $ llwork, mem( ptriwrk ),
196 $ isizetst, hetero, nout, res )
197*
198 IF( res.EQ.0 ) THEN
199 npassed = npassed + 1
200 ELSE IF( res.EQ.2 ) THEN
201 nnocheck = nnocheck + 1
202 ELSE IF( res.EQ.3 ) THEN
203 nskipped = nskipped + 1
204 WRITE( nout, fmt = * )' PSSEPRREQ failed'
205 CALL blacs_abort( context, -1 )
206 END IF
207 END IF
208 CALL blacs_gridexit( context )
209 END IF
210 10 CONTINUE
211 20 CONTINUE
212 30 CONTINUE
213 40 CONTINUE
214 END IF
215*
216 RETURN
217*
218* End of PSSEPRREQ
219*
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
pslasizesepr
subroutine pslasizesepr(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, sizeqtq, sizechk, sizesyevr, isizesyevr, sizesubtst, isizesubtst, sizetst, isizetst)
Definition pslasizesepr.f:6
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
psseprtst
subroutine psseprtst(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 psseprtst.f:6
Here is the call graph for this function:
Here is the caller graph for this function: