ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pcgsepreq.f
Go to the documentation of this file.
1 *
2 *
3  SUBROUTINE pcgsepreq( NIN, MEM, MEMSIZE, NOUT, ISEED, NTESTS,
4  $ NSKIPPED, NNOCHECK, NPASSED, INFO )
5 *
6 * -- ScaLAPACK test routine (version 1.7) --
7 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
8 * and University of California, Berkeley.
9 * October 15, 1999
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 * PCGSEPREQ performs one request from the input file 'SEP.dat'
24 * A request is the cross product of the specifications in the
25 * input file. PCGSEPREQ 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  REAL FIVE
81  parameter( five = 5.0e+0 )
82  INTEGER CPLXSZ, INTGSZ
83  parameter( cplxsz = 8, intgsz = 4 )
84  INTEGER REALSZ
85  parameter( realsz = 4 )
86  INTEGER MAXSETSIZE
87  parameter( maxsetsize = 50 )
88 * ..
89 * .. Local Scalars ..
90  CHARACTER SUBTESTS
91  INTEGER CONTEXT, IAM, IBTYPE, IMIDPAD, INITCON,
92  $ ipostpad, iprepad, isizeheevx, isizesubtst,
93  $ isizetst, lda, llrwork, matsize, mattype,
94  $ mycol, myrow, n, nb, nibtypes, nmatsizes,
95  $ nmattypes, nnodes, np, npcol, npconfigs, nprow,
96  $ nq, nuplos, order, pconfig, ptra, ptrb,
97  $ ptrcopya, ptrcopyb, ptrgap, ptriclus, ptrifail,
98  $ ptriwrk, ptrrwork, ptrw, ptrw2, ptrwork, ptrz,
99  $ res, rsizechk, rsizeheevx, rsizeqtq,
100  $ rsizesubtst, rsizetst, sizeheevx, sizemqrleft,
101  $ sizemqrright, sizeqrf, sizesubtst, sizetms,
102  $ sizetst, uplo
103  REAL ABSTOL, THRESH
104 * ..
105 * .. Local Arrays ..
106  CHARACTER UPLOS( 2 )
107  INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
108  $ mattypes( maxsetsize ), nbs( maxsetsize ),
109  $ npcols( maxsetsize ), nprows( maxsetsize )
110 * ..
111 * .. External Functions ..
112  LOGICAL LSAME
113  INTEGER ICEIL, NUMROC
114  EXTERNAL lsame, iceil, numroc
115 * ..
116 * .. External Subroutines ..
117  EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
118  $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
119  $ descinit, pcgseptst, pclasizegsep, pssepinfo
120 * ..
121 * .. Intrinsic Functions ..
122  INTRINSIC max
123 * ..
124 * .. Executable Statements ..
125 * This is just to keep ftnchek happy
126  IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
127  $ rsrc_.LT.0 )RETURN
128 *
129  CALL blacs_pinfo( iam, nnodes )
130  CALL blacs_get( -1, 0, initcon )
131  CALL blacs_gridinit( initcon, 'R', 1, nnodes )
132 *
133  CALL pssepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
134  $ matsizes, nuplos, uplos, npconfigs, nprows,
135  $ npcols, nbs, nmattypes, mattypes, 22, subtests,
136  $ thresh, order, abstol, info )
137 *
138  CALL blacs_gridexit( initcon )
139 *
140  IF( info.EQ.0 ) THEN
141 *
142 * Thresholds must be bigger for the generalized problem.
143 *
144  thresh = thresh*five
145 *
146  DO 50 matsize = 1, nmatsizes
147 *
148  DO 40 pconfig = 1, npconfigs
149 *
150  DO 30 mattype = 1, nmattypes
151 *
152  DO 20 uplo = 1, nuplos
153  IF( lsame( subtests, 'Y' ) ) THEN
154  nibtypes = 3
155  ELSE
156  nibtypes = 1
157  END IF
158  DO 10 ibtype = 1, nibtypes
159 *
160  n = matsizes( matsize )
161  order = n
162 *
163  nprow = nprows( pconfig )
164  npcol = npcols( pconfig )
165  nb = nbs( pconfig )
166 *
167  np = numroc( n, nb, 0, 0, nprow )
168  nq = numroc( n, nb, 0, 0, npcol )
169  iprepad = max( nb, np )
170  imidpad = nb
171  ipostpad = max( nb, nq )
172 *
173  lda = max( np, 1 ) + imidpad
174 *
175  CALL blacs_get( -1, 0, context )
176  CALL blacs_gridinit( context, 'R', nprow,
177  $ npcol )
178  CALL blacs_gridinfo( context, nprow, npcol,
179  $ myrow, mycol )
180  IF( myrow.GE.0 ) THEN
181  CALL descinit( desca, n, n, nb, nb, 0, 0,
182  $ context, lda, info )
183  CALL pclasizegsep( desca, iprepad, ipostpad,
184  $ sizemqrleft, sizemqrright,
185  $ sizeqrf, sizetms,
186  $ rsizeqtq, rsizechk,
187  $ sizeheevx, rsizeheevx,
188  $ isizeheevx, sizesubtst,
189  $ rsizesubtst, isizesubtst,
190  $ sizetst, rsizetst,
191  $ isizetst )
192 *
193  ptra = 1
194  ptrz = ptra + lda*nq + iprepad + ipostpad
195  ptrcopyb = ptrz + lda*nq + iprepad + ipostpad
196  ptrb = ptrcopyb + lda*nq + iprepad + ipostpad
197  ptrcopya = ptrb + lda*nq + iprepad + ipostpad
198  ptrw = ptrcopya + lda*nq + iprepad + ipostpad
199  ptrw2 = ptrw + iceil( max( n, 1 )+iprepad+
200  $ ipostpad, cplxsz / realsz )
201  ptrwork = ptrw2 + iceil( max( n, 1 )+iprepad+
202  $ ipostpad, cplxsz / realsz )
203  ptrgap = ptrwork + sizetst + iprepad +
204  $ ipostpad
205  ptrifail = ptrgap + iceil( nprow*npcol+
206  $ iprepad+ipostpad,
207  $ cplxsz / realsz )
208  ptriclus = ptrifail +
209  $ iceil( n+iprepad+ipostpad,
210  $ cplxsz / intgsz )
211  ptriwrk = ptriclus + iceil( 2*nprow*npcol+
212  $ iprepad+ipostpad, cplxsz / intgsz )
213  ptrrwork = ptriwrk + iceil( isizetst+iprepad+
214  $ ipostpad, cplxsz / intgsz )
215  llrwork = ( memsize - ptrrwork - ipostpad -
216  $ iprepad + 1 )* ( cplxsz / realsz )
217  ntests = ntests + 1
218  IF( llrwork.LT.rsizetst ) THEN
219  nskipped = nskipped + 1
220  ELSE
221  CALL pcgseptst( desca, uplos( uplo ), n,
222  $ mattypes( mattype ),
223  $ ibtype, subtests, thresh,
224  $ n, abstol, iseed,
225  $ mem( ptra ),
226  $ mem( ptrcopya ),
227  $ mem( ptrb ),
228  $ mem( ptrcopyb ),
229  $ mem( ptrz ), lda,
230  $ mem( ptrw ), mem( ptrw2 ),
231  $ mem( ptrifail ),
232  $ mem( ptriclus ),
233  $ mem( ptrgap ), iprepad,
234  $ ipostpad, mem( ptrwork ),
235  $ sizetst, mem( ptrrwork ),
236  $ llrwork, mem( ptriwrk ),
237  $ isizetst, nout, res )
238 *
239  IF( res.EQ.0 ) THEN
240  npassed = npassed + 1
241  ELSE IF( res.EQ.2 ) THEN
242  nnocheck = nnocheck + 1
243  ELSE IF( res.EQ.3 ) THEN
244  nskipped = nskipped + 1
245  WRITE( nout, fmt = * )
246  $ ' pCGSEPREQ failed'
247  CALL blacs_abort( context, -1 )
248  END IF
249  CALL blacs_gridexit( context )
250  END IF
251  END IF
252  10 CONTINUE
253  20 CONTINUE
254  30 CONTINUE
255  40 CONTINUE
256  50 CONTINUE
257  END IF
258 *
259 *
260  RETURN
261 *
262 * End of PCDGSEPREQ
263 *
264  END
pclasizegsep
subroutine pclasizegsep(DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZETMS, RSIZEQTQ, RSIZECHK, SIZEHEEVX, RSIZEHEEVX, ISIZEHEEVX, SIZESUBTST, RSIZESUBTST, ISIZESUBTST, SIZETST, RSIZETST, ISIZETST)
Definition: pclasizegsep.f:7
max
#define max(A, B)
Definition: pcgemr.c:180
pcgseptst
subroutine pcgseptst(DESCA, UPLO, N, MATTYPE, IBTYPE, SUBTESTS, THRESH, ORDER, ABSTOL, ISEED, A, COPYA, B, COPYB, Z, LDA, WIN, WNEW, IFAIL, ICLUSTR, GAP, IPREPAD, IPOSTPAD, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, NOUT, INFO)
Definition: pcgseptst.f:8
pcgsepreq
subroutine pcgsepreq(NIN, MEM, MEMSIZE, NOUT, ISEED, NTESTS, NSKIPPED, NNOCHECK, NPASSED, INFO)
Definition: pcgsepreq.f:5
descinit
subroutine descinit(DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, LLD, INFO)
Definition: descinit.f:3
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