ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pzsepreq.f
Go to the documentation of this file.
1 *
2 *
3  SUBROUTINE pzsepreq( NIN, MEM, MEMSIZE, NOUT, ISEED, NTESTS,
4  $ NSKIPPED, NNOCHECK, NPASSED, INFO )
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  INTEGER INFO, MEMSIZE, NIN, NNOCHECK, NOUT, NPASSED,
13  $ nskipped, ntests
14 * ..
15 * .. Array Arguments ..
16  INTEGER ISEED( 4 )
17  COMPLEX*16 MEM( MEMSIZE )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * PZSEPREQ performs one request from the input file 'SEP.dat'
24 * A request is the cross product of the specifications in the
25 * input file. PZSEPREQ prints one line per test.
26 *
27 * Arguments
28 * =========
29 *
30 * NIN (local input) INTEGER
31 * The unit number for the input file 'SEP.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 *
66 *
67 * INFO (global output) INTEGER
68 * 0 = test request ran
69 * -1 = end of file
70 * -2 = incorrect .dat file
71 *
72 *
73 * .. Parameters ..
74 *
75  INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
76  $ mb_, nb_, rsrc_, csrc_, lld_
77  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
78  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
79  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
80  INTEGER ZPLXSZ, INTGSZ
81  parameter( zplxsz = 16, intgsz = 4 )
82  INTEGER DBLESZ
83  parameter( dblesz = 8 )
84  INTEGER MAXSETSIZE
85  parameter( maxsetsize = 50 )
86 * ..
87 * .. Local Scalars ..
88  CHARACTER SUBTESTS
89  INTEGER CONTEXT, IAM, IMIDPAD, INITCON, IPOSTPAD,
90  $ iprepad, isizeheevx, isizesubtst, isizetst,
91  $ lda, llrwork, matsize, mattype, mycol, myrow,
92  $ n, nb, nmatsizes, nmattypes, nnodes, np, npcol,
93  $ npconfigs, nprow, nq, nuplos, order, pconfig,
94  $ ptra, ptrcopya, ptrgap, ptriclus, ptrifail,
95  $ ptriwrk, ptrrwork, ptrw, ptrw2, ptrwork, ptrz,
96  $ res, rsizechk, rsizeheevx, rsizeqtq,
97  $ rsizesubtst, rsizetst, sizeheevx, sizemqrleft,
98  $ sizemqrright, sizeqrf, sizesubtst, sizetms,
99  $ sizetst, uplo, sizeheevd, rsizeheevd,
100  $ isizeheevd
101  DOUBLE PRECISION ABSTOL, THRESH
102 * ..
103 * .. Local Arrays ..
104  CHARACTER UPLOS( 2 )
105  INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
106  $ mattypes( maxsetsize ), nbs( maxsetsize ),
107  $ npcols( maxsetsize ), nprows( maxsetsize )
108 * ..
109 * .. External Functions ..
110  INTEGER ICEIL, NUMROC
111  EXTERNAL iceil, numroc
112 * ..
113 * .. External Subroutines ..
114  EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
115  $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
116  $ descinit, pdsepinfo, pzlasizesep, pzseptst
117 * ..
118 * .. Intrinsic Functions ..
119  INTRINSIC max
120 * ..
121 * .. Executable Statements ..
122 * This is just to keep ftnchek happy
123  IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
124  $ rsrc_.LT.0 )RETURN
125 *
126  CALL blacs_pinfo( iam, nnodes )
127  CALL blacs_get( -1, 0, initcon )
128  CALL blacs_gridinit( initcon, 'R', 1, nnodes )
129 *
130  CALL pdsepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
131  $ matsizes, nuplos, uplos, npconfigs, nprows,
132  $ npcols, nbs, nmattypes, mattypes, 22, subtests,
133  $ thresh, order, abstol, info )
134 *
135  CALL blacs_gridexit( initcon )
136 *
137  IF( info.EQ.0 ) THEN
138 *
139 *
140  DO 40 matsize = 1, nmatsizes
141 *
142  DO 30 pconfig = 1, npconfigs
143 *
144  DO 20 mattype = 1, nmattypes
145 *
146  DO 10 uplo = 1, nuplos
147 *
148  n = matsizes( matsize )
149  order = n
150 *
151  nprow = nprows( pconfig )
152  npcol = npcols( pconfig )
153  nb = nbs( pconfig )
154 *
155  np = numroc( n, nb, 0, 0, nprow )
156  nq = numroc( n, nb, 0, 0, npcol )
157  iprepad = max( nb, np )
158  imidpad = nb
159  ipostpad = max( nb, nq )
160 *
161  lda = max( np, 1 ) + imidpad
162 *
163  CALL blacs_get( -1, 0, context )
164  CALL blacs_gridinit( context, 'R', nprow, npcol )
165  CALL blacs_gridinfo( context, nprow, npcol, myrow,
166  $ mycol )
167  IF( myrow.GE.0 ) THEN
168  CALL descinit( desca, n, n, nb, nb, 0, 0,
169  $ context, lda, info )
170  CALL pzlasizesep( desca, iprepad, ipostpad,
171  $ sizemqrleft, sizemqrright,
172  $ sizeqrf, sizetms, rsizeqtq,
173  $ rsizechk, sizeheevx,
174  $ rsizeheevx, isizeheevx,
175  $ sizeheevd, rsizeheevd,
176  $ isizeheevd,
177  $ sizesubtst, rsizesubtst,
178  $ isizesubtst, sizetst,
179  $ rsizetst, isizetst )
180 *
181  ptra = 1
182  ptrz = ptra + lda*nq + iprepad + ipostpad
183  ptrcopya = ptrz + lda*nq + iprepad + ipostpad
184  ptrw = ptrcopya + lda*nq + iprepad + ipostpad
185  ptrw2 = ptrw + iceil( max( n, 1 )+iprepad+
186  $ ipostpad, zplxsz / dblesz )
187  ptrwork = ptrw2 + iceil( max( n, 1 )+iprepad+
188  $ ipostpad, zplxsz / dblesz )
189  ptrgap = ptrwork + sizetst + iprepad + ipostpad
190  ptrifail = ptrgap + iceil( nprow*npcol+iprepad+
191  $ ipostpad, zplxsz / dblesz )
192  ptriclus = ptrifail + iceil( n+iprepad+ipostpad,
193  $ zplxsz / intgsz )
194  ptriwrk = ptriclus + iceil( 2*nprow*npcol+
195  $ iprepad+ipostpad, zplxsz / intgsz )
196  ptrrwork = ptriwrk + iceil( isizetst+iprepad+
197  $ ipostpad, zplxsz / intgsz )
198  llrwork = ( memsize-ptrrwork+1 )*zplxsz / dblesz
199 C LLRWORK = ( MEMSIZE-PTRRWORK-IPREPAD-IPOSTPAD+1)
200 C $ *ZPLXSZ / DBLESZ
201  ntests = ntests + 1
202  IF( llrwork.LT.rsizetst ) THEN
203  nskipped = nskipped + 1
204  ELSE
205  CALL pzseptst( desca, uplos( uplo ), n,
206  $ mattypes( mattype ), subtests,
207  $ thresh, n, abstol, iseed,
208  $ mem( ptra ), mem( ptrcopya ),
209  $ mem( ptrz ), lda, mem( ptrw ),
210  $ mem( ptrw2 ), mem( ptrifail ),
211  $ mem( ptriclus ),
212  $ mem( ptrgap ), iprepad,
213  $ ipostpad, mem( ptrwork ),
214  $ sizetst, mem( ptrrwork ),
215  $ llrwork, mem( ptriwrk ),
216  $ isizetst, nout, res )
217 *
218  IF( res.EQ.0 ) THEN
219  npassed = npassed + 1
220  ELSE IF( res.EQ.2 ) THEN
221  nnocheck = nnocheck + 1
222  ELSE IF( res.EQ.3 ) THEN
223  nskipped = nskipped + 1
224  WRITE( nout, fmt=* )' PZSEPREQ failed'
225  CALL blacs_abort( context, -1 )
226  END IF
227  END IF
228  CALL blacs_gridexit( context )
229  END IF
230  10 CONTINUE
231  20 CONTINUE
232  30 CONTINUE
233  40 CONTINUE
234  END IF
235 *
236 *
237  RETURN
238 *
239 * End of PZDSEPREQ
240 *
241  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
pzseptst
subroutine pzseptst(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, NOUT, INFO)
Definition: pzseptst.f:8
pzsepreq
subroutine pzsepreq(NIN, MEM, MEMSIZE, NOUT, ISEED, NTESTS, NSKIPPED, NNOCHECK, NPASSED, INFO)
Definition: pzsepreq.f:5
descinit
subroutine descinit(DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, LLD, INFO)
Definition: descinit.f:3
pzlasizesep
subroutine pzlasizesep(DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZETMS, RSIZEQTQ, RSIZECHK, SIZEHEEVX, RSIZEHEEVX, ISIZEHEEVX, SIZEHEEVD, RSIZEHEEVD, ISIZEHEEVD, SIZESUBTST, RSIZESUBTST, ISIZESUBTST, SIZETST, RSIZETST, ISIZETST)
Definition: pzlasizesep.f:7