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

◆ pcseprreq()

subroutine pcseprreq ( character  hetero,
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 1 of file pcseprreq.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 COMPLEX MEM( MEMSIZE )
19*
20* Purpose
21* =======
22*
23* PCSEPRREQ 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 ) 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* 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 KMPXSZ
77 parameter( kmpxsz = 8 )
78 INTEGER MAXSETSIZE
79 parameter( maxsetsize = 50 )
80* ..
81* .. Local Scalars ..
82 CHARACTER SUBTESTS
83 INTEGER CONTEXT, IAM, IMIDPAD, INITCON, IPOSTPAD,
84 $ IPREPAD, ISIZESUBTST, ISIZEEVR, ISIZETST,
85 $ LDA, LLWORK, MATSIZE, MATTYPE, MYCOL, MYROW, N,
86 $ NB, NMATSIZES, NMATTYPES, NNODES, NP, NPCOL,
87 $ NPCONFIGS, NPROW, NQ, NUPLOS, ORDER, PCONFIG,
88 $ PTRA, PTRCOPYA, PTRGAP, PTRICLUS, PTRIFAIL,
89 $ PTRIWRK, PTRW, PTRW2, PTRWORK, PTRZ, RES,
90 $ SIZECHK, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF,
91 $ SIZEQTQ, SIZESUBTST, SIZEEVR,
92 $ SIZETMS, SIZETST, UPLO
93 INTEGER PTRRWORK, RSIZEEVR, RSIZESUBTST, RSIZETST
94*
95 REAL ABSTOL, THRESH
96* ..
97* .. Local Arrays ..
98 CHARACTER UPLOS( 2 )
99 INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
100 $ MATTYPES( MAXSETSIZE ), NBS( MAXSETSIZE ),
101 $ NPCOLS( MAXSETSIZE ), NPROWS( MAXSETSIZE )
102* ..
103* .. External Functions ..
104 INTEGER ICEIL, NUMROC
105 EXTERNAL iceil, numroc
106* ..
107* .. External Subroutines ..
108 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
109 $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
110 $ descinit, pclasizesepr, pssepinfo, pcseprtst
111* ..
112* .. Intrinsic Functions ..
113 INTRINSIC max
114* ..
115* .. Executable Statements ..
116*
117 CALL blacs_pinfo( iam, nnodes )
118 CALL blacs_get( -1, 0, initcon )
119 CALL blacs_gridinit( initcon, 'R', 1, nnodes )
120*
121 CALL pssepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
122 $ matsizes, nuplos, uplos, npconfigs, nprows,
123 $ npcols, nbs, nmattypes, mattypes, 22, subtests,
124 $ thresh, order, abstol, info )
125*
126 CALL blacs_gridexit( initcon )
127*
128 IF( info.EQ.0 ) THEN
129*
130 DO 40 matsize = 1, nmatsizes
131*
132 DO 30 pconfig = 1, npconfigs
133*
134 DO 20 mattype = 1, nmattypes
135*
136 DO 10 uplo = 1, nuplos
137*
138 n = matsizes( matsize )
139 order = n
140*
141 nprow = nprows( pconfig )
142 npcol = npcols( pconfig )
143 nb = nbs( pconfig )
144*
145 np = numroc( n, nb, 0, 0, nprow )
146 nq = numroc( n, nb, 0, 0, npcol )
147 iprepad = max( nb, np )
148 imidpad = nb
149 ipostpad = max( nb, nq )
150*
151 lda = max( np, 1 ) + imidpad
152*
153 CALL blacs_get( -1, 0, context )
154 CALL blacs_gridinit( context, 'R', nprow, npcol )
155 CALL blacs_gridinfo( context, nprow, npcol, myrow,
156 $ mycol )
157*
158 IF( myrow.GE.0 ) THEN
159 CALL descinit( desca, n, n, nb, nb, 0, 0,
160 $ context, lda, info )
161 CALL pclasizesepr( desca, iprepad, ipostpad,
162 $ sizemqrleft, sizemqrright,
163 $ sizeqrf, sizetms, sizeqtq,
164 $ sizechk, sizeevr, rsizeevr,
165 $ isizeevr, sizesubtst,
166 $ rsizesubtst, isizesubtst,
167 $ sizetst, rsizetst, isizetst )
168*
169 ptra = 1
170 ptrz = ptra + lda*nq + iprepad + ipostpad
171 ptrcopya = ptrz + lda*nq + iprepad + ipostpad
172 ptrw = ptrcopya + lda*nq + iprepad + ipostpad
173 ptrw2 = ptrw + iceil( max( n, 1 )+iprepad+
174 $ ipostpad, kmpxsz / realsz )
175 ptrwork = ptrw2 + iceil( max( n, 1 )+iprepad+
176 $ ipostpad, kmpxsz / realsz )
177 ptrgap = ptrwork + sizetst + iprepad + ipostpad
178 ptrifail = ptrgap + iceil( nprow*npcol+iprepad+
179 $ ipostpad, kmpxsz / realsz )
180 ptriclus = ptrifail + iceil( n+iprepad+ipostpad,
181 $ kmpxsz / intgsz )
182 ptriwrk = ptriclus + iceil( 2*nprow*npcol+
183 $ iprepad+ipostpad, kmpxsz / intgsz )
184 ptrrwork = ptriwrk + iceil( isizetst+iprepad+
185 $ ipostpad, kmpxsz / intgsz )
186 llwork = ( memsize-ptrrwork+1 )*kmpxsz / realsz
187
188 ntests = ntests + 1
189 IF( llwork.LT.rsizetst ) THEN
190 nskipped = nskipped + 1
191 ELSE
192 CALL pcseprtst( desca, uplos( uplo ), n,
193 $ mattypes( mattype ), subtests,
194 $ thresh, n, abstol, iseed,
195 $ mem( ptra ), mem( ptrcopya ),
196 $ mem( ptrz ), lda, mem( ptrw ),
197 $ mem( ptrw2 ), mem( ptrifail ),
198 $ mem( ptriclus ),
199 $ mem( ptrgap ), iprepad,
200 $ ipostpad, mem( ptrwork ),
201 $ sizetst, mem( ptrrwork ),
202 $ llwork, mem( ptriwrk ),
203 $ isizetst, hetero, nout, res )
204*
205 IF( res.EQ.0 ) THEN
206 npassed = npassed + 1
207 ELSE IF( res.EQ.2 ) THEN
208 nnocheck = nnocheck + 1
209 ELSE IF( res.EQ.3 ) THEN
210 nskipped = nskipped + 1
211 WRITE( nout, fmt = * )' PCSEPRREQ failed'
212 CALL blacs_abort( context, -1 )
213 END IF
214 END IF
215 CALL blacs_gridexit( context )
216 END IF
217 10 CONTINUE
218 20 CONTINUE
219 30 CONTINUE
220 40 CONTINUE
221 END IF
222*
223 RETURN
224*
225* End of PCSEPRREQ
226*
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
pclasizesepr
subroutine pclasizesepr(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, sizeqtq, sizechk, sizeheevr, rsizeheevr, isizeheevr, sizesubtst, rsizesubtst, isizesubtst, sizetst, rsizetst, isizetst)
Definition pclasizesepr.f:7
pcseprtst
subroutine pcseprtst(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, hetero, nout, info)
Definition pcseprtst.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
Here is the call graph for this function:
Here is the caller graph for this function: