ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pcsepreq.f
Go to the documentation of this file.
1 *
2 *
3  SUBROUTINE pcsepreq( 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 MEM( MEMSIZE )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * PCSEPREQ performs one request from the input file 'SEP.dat'
24 * A request is the cross product of the specifications in the
25 * input file. PCSEPREQ 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 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 CPLXSZ, INTGSZ
81  parameter( cplxsz = 8, intgsz = 4 )
82  INTEGER REALSZ
83  parameter( realsz = 4 )
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, isizeheevd
100  REAL ABSTOL, THRESH
101 * ..
102 * .. Local Arrays ..
103  CHARACTER UPLOS( 2 )
104  INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
105  $ mattypes( maxsetsize ), nbs( maxsetsize ),
106  $ npcols( maxsetsize ), nprows( maxsetsize )
107 * ..
108 * .. External Functions ..
109  INTEGER ICEIL, NUMROC
110  EXTERNAL iceil, numroc
111 * ..
112 * .. External Subroutines ..
113  EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
114  $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
116 * ..
117 * .. Intrinsic Functions ..
118  INTRINSIC max
119 * ..
120 * .. Executable Statements ..
121 * This is just to keep ftnchek happy
122  IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
123  $ rsrc_.LT.0 )RETURN
124 *
125  CALL blacs_pinfo( iam, nnodes )
126  CALL blacs_get( -1, 0, initcon )
127  CALL blacs_gridinit( initcon, 'R', 1, nnodes )
128 *
129  CALL pssepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
130  $ matsizes, nuplos, uplos, npconfigs, nprows,
131  $ npcols, nbs, nmattypes, mattypes, 22, subtests,
132  $ thresh, order, abstol, info )
133 *
134  CALL blacs_gridexit( initcon )
135 *
136  IF( info.EQ.0 ) THEN
137 *
138 *
139  DO 40 matsize = 1, nmatsizes
140 *
141  DO 30 pconfig = 1, npconfigs
142 *
143  DO 20 mattype = 1, nmattypes
144 *
145  DO 10 uplo = 1, nuplos
146 *
147  n = matsizes( matsize )
148  order = n
149 *
150  nprow = nprows( pconfig )
151  npcol = npcols( pconfig )
152  nb = nbs( pconfig )
153 *
154  np = numroc( n, nb, 0, 0, nprow )
155  nq = numroc( n, nb, 0, 0, npcol )
156  iprepad = max( nb, np )
157  imidpad = nb
158  ipostpad = max( nb, nq )
159 *
160  lda = max( np, 1 ) + imidpad
161 *
162  CALL blacs_get( -1, 0, context )
163  CALL blacs_gridinit( context, 'R', nprow, npcol )
164  CALL blacs_gridinfo( context, nprow, npcol, myrow,
165  $ mycol )
166  IF( myrow.GE.0 ) THEN
167  CALL descinit( desca, n, n, nb, nb, 0, 0,
168  $ context, lda, info )
169  CALL pclasizesep( desca, iprepad, ipostpad,
170  $ sizemqrleft, sizemqrright,
171  $ sizeqrf, sizetms, rsizeqtq,
172  $ rsizechk, sizeheevx,
173  $ rsizeheevx, isizeheevx,
174  $ sizeheevd, rsizeheevd, isizeheevd,
175  $ sizesubtst, rsizesubtst,
176  $ isizesubtst, sizetst,
177  $ rsizetst, isizetst )
178 *
179  ptra = 1
180  ptrz = ptra + lda*nq + iprepad + ipostpad
181  ptrcopya = ptrz + lda*nq + iprepad + ipostpad
182  ptrw = ptrcopya + lda*nq + iprepad + ipostpad
183  ptrw2 = ptrw + iceil( max( n, 1 )+iprepad+
184  $ ipostpad, cplxsz / realsz )
185  ptrwork = ptrw2 + iceil( max( n, 1 )+iprepad+
186  $ ipostpad, cplxsz / realsz )
187  ptrgap = ptrwork + sizetst + iprepad + ipostpad
188  ptrifail = ptrgap + iceil( nprow*npcol+iprepad+
189  $ ipostpad, cplxsz / realsz )
190  ptriclus = ptrifail + iceil( n+iprepad+ipostpad,
191  $ cplxsz / intgsz )
192  ptriwrk = ptriclus + iceil( 2*nprow*npcol+
193  $ iprepad+ipostpad, cplxsz / intgsz )
194  ptrrwork = ptriwrk + iceil( isizetst+iprepad+
195  $ ipostpad, cplxsz / intgsz )
196  llrwork = ( memsize-ptrrwork+1 )*cplxsz / realsz
197 C LLRWORK = ( MEMSIZE-PTRRWORK-IPREPAD-IPOSTPAD+1)
198 C $ *CPLXSZ / REALSZ
199  ntests = ntests + 1
200  IF( llrwork.LT.rsizetst ) THEN
201  nskipped = nskipped + 1
202  ELSE
203  CALL pcseptst( desca, uplos( uplo ), n,
204  $ mattypes( mattype ), subtests,
205  $ thresh, n, abstol, iseed,
206  $ mem( ptra ), mem( ptrcopya ),
207  $ mem( ptrz ), lda, mem( ptrw ),
208  $ mem( ptrw2 ), mem( ptrifail ),
209  $ mem( ptriclus ),
210  $ mem( ptrgap ), iprepad,
211  $ ipostpad, mem( ptrwork ),
212  $ sizetst, mem( ptrrwork ),
213  $ llrwork, mem( ptriwrk ),
214  $ isizetst, nout, res )
215 *
216  IF( res.EQ.0 ) THEN
217  npassed = npassed + 1
218  ELSE IF( res.EQ.2 ) THEN
219  nnocheck = nnocheck + 1
220  ELSE IF( res.EQ.3 ) THEN
221  nskipped = nskipped + 1
222  WRITE( nout, fmt=*)'pCSEPREQ failed'
223  CALL blacs_abort( context, -1 )
224  END IF
225  END IF
226  CALL blacs_gridexit( context )
227  END IF
228  10 CONTINUE
229  20 CONTINUE
230  30 CONTINUE
231  40 CONTINUE
232  END IF
233 *
234 *
235  RETURN
236 *
237 * End of PCDSEPREQ
238 *
239  END
max
#define max(A, B)
Definition: pcgemr.c:180
pcseptst
subroutine pcseptst(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: pcseptst.f:8
pclasizesep
subroutine pclasizesep(DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZETMS, RSIZEQTQ, RSIZECHK, SIZEHEEVX, RSIZEHEEVX, ISIZEHEEVX, SIZEHEEVD, RSIZEHEEVD, ISIZEHEEVD, SIZESUBTST, RSIZESUBTST, ISIZESUBTST, SIZETST, RSIZETST, ISIZETST)
Definition: pclasizesep.f:7
descinit
subroutine descinit(DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, LLD, INFO)
Definition: descinit.f:3
pcsepreq
subroutine pcsepreq(NIN, MEM, MEMSIZE, NOUT, ISEED, NTESTS, NSKIPPED, NNOCHECK, NPASSED, INFO)
Definition: pcsepreq.f:5
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