ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pzseprreq.f
Go to the documentation of this file.
1  SUBROUTINE pzseprreq( HETERO, NIN, MEM, MEMSIZE, NOUT, ISEED,
2  $ NTESTS, NSKIPPED, NNOCHECK, NPASSED, INFO )
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*16 MEM( MEMSIZE )
19 *
20 * Purpose
21 * =======
22 *
23 * PZSEPRREQ 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*16 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 DBLESZ, INTGSZ
75  parameter( dblesz = 8, intgsz = 4 )
76  INTEGER KMPXSZ
77  parameter( kmpxsz = 16 )
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  DOUBLE PRECISION 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, pzlasizesepr, pdsepinfo, pzseprtst
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 pdsepinfo( 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 pzlasizesepr( 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 / dblesz )
175  ptrwork = ptrw2 + iceil( max( n, 1 )+iprepad+
176  $ ipostpad, kmpxsz / dblesz )
177  ptrgap = ptrwork + sizetst + iprepad + ipostpad
178  ptrifail = ptrgap + iceil( nprow*npcol+iprepad+
179  $ ipostpad, kmpxsz / dblesz )
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 / dblesz
187 
188  ntests = ntests + 1
189  IF( llwork.LT.rsizetst ) THEN
190  nskipped = nskipped + 1
191  ELSE
192  CALL pzseprtst( 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 = * )' PZSEPRREQ 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 PZSEPRREQ
226 *
227  END
max
#define max(A, B)
Definition: pcgemr.c:180
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
pzseprreq
subroutine pzseprreq(HETERO, NIN, MEM, MEMSIZE, NOUT, ISEED, NTESTS, NSKIPPED, NNOCHECK, NPASSED, INFO)
Definition: pzseprreq.f:3
descinit
subroutine descinit(DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, LLD, INFO)
Definition: descinit.f:3
pzlasizesepr
subroutine pzlasizesepr(DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZETMS, SIZEQTQ, SIZECHK, SIZEHEEVR, RSIZEHEEVR, ISIZEHEEVR, SIZESUBTST, RSIZESUBTST, ISIZESUBTST, SIZETST, RSIZETST, ISIZETST)
Definition: pzlasizesepr.f:7
pzseprtst
subroutine pzseprtst(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: pzseprtst.f:6