ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pdsepreq.f
Go to the documentation of this file.
1 *
2 *
3  SUBROUTINE pdsepreq( HETERO, NIN, MEM, MEMSIZE, NOUT, ISEED,
4  $ NTESTS, 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  CHARACTER HETERO
13  INTEGER INFO, MEMSIZE, NIN, NNOCHECK, NOUT, NPASSED,
14  $ nskipped, ntests
15 * ..
16 * .. Array Arguments ..
17  INTEGER ISEED( 4 )
18  DOUBLE PRECISION MEM( MEMSIZE )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * PDSEPREQ performs one request from the input file 'SEP.dat'
25 * A request is the cross product of the specifications in the
26 * input file. PDSEPREQ prints one line per test.
27 *
28 * Arguments
29 * =========
30 *
31 * NIN (local input) INTEGER
32 * The unit number for the input file 'SEP.dat'
33 *
34 * MEM (local input ) DOUBLE PRECISION ARRAY, dimension MEMSIZE
35 * Array encompassing the available single precision memory
36 *
37 * MEMSIZE (local input) INTEGER
38 * Size of MEM array
39 *
40 * NOUT (local input) INTEGER
41 * The unit number for output file.
42 * NOUT = 6, output to screen,
43 * NOUT = 0, output to stderr.
44 * NOUT = 13, output to file, divide thresh by 10
45 * NOUT = 14, output to file, divide thresh by 20
46 * Only used on node 0.
47 * NOUT = 13, 14 allow the threshold to be tighter for our
48 * internal testing which means that when a user reports
49 * a threshold error, it is more likely to be significant.
50 *
51 * ISEED (global input/output) INTEGER array, dimension 4
52 * Random number generator seed
53 *
54 * NTESTS (global input/output) INTEGER
55 * NTESTS = NTESTS + tests requested
56 *
57 * NSKIPPED (global input/output) INTEGER
58 * NSKIPPED = NSKIPPED + tests skipped
59 *
60 * NNOCHECK (global input/output) INTEGER
61 * NNOCHECK = NNOCHECK + tests completed but not checked
62 *
63 * NPASSED (global input/output) INTEGER
64 * NPASSED = NPASSED + tests which passed all checks
65 *
66 *
67 *
68 * INFO (global output) INTEGER
69 * 0 = test request ran
70 * -1 = end of file
71 * -2 = incorrect .dat file
72 *
73 *
74 * .. Parameters ..
75 *
76  INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
77  $ mb_, nb_, rsrc_, csrc_, lld_
78  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
79  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
80  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
81  INTEGER DBLESZ, INTGSZ
82  parameter( dblesz = 8, intgsz = 4 )
83  INTEGER MAXSETSIZE
84  parameter( maxsetsize = 50 )
85 * ..
86 * .. Local Scalars ..
87  CHARACTER SUBTESTS
88  INTEGER CONTEXT, IAM, IMIDPAD, INITCON, IPOSTPAD,
89  $ iprepad, isizesubtst, isizesyevx, isizetst,
90  $ lda, llwork, matsize, mattype, mycol, myrow, n,
91  $ nb, nmatsizes, nmattypes, nnodes, np, npcol,
92  $ npconfigs, nprow, nq, nuplos, order, pconfig,
93  $ ptra, ptrcopya, ptrgap, ptriclus, ptrifail,
94  $ ptriwrk, ptrw, ptrw2, ptrwork, ptrz, res,
95  $ sizechk, sizemqrleft, sizemqrright, sizeqrf,
96  $ sizeqtq, sizesubtst, sizesyev, sizesyevx,
97  $ sizetms, sizetst, uplo, isizesyevd, sizesyevd
98 
99  DOUBLE PRECISION ABSTOL, THRESH
100 * ..
101 * .. Local Arrays ..
102  CHARACTER UPLOS( 2 )
103  INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
104  $ mattypes( maxsetsize ), nbs( maxsetsize ),
105  $ npcols( maxsetsize ), nprows( maxsetsize )
106 * ..
107 * .. External Functions ..
108  INTEGER ICEIL, NUMROC
109  EXTERNAL iceil, numroc
110 * ..
111 * .. External Subroutines ..
112  EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
113  $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
114  $ descinit, pdlasizesqp, pdsepinfo, pdseptst
115 * ..
116 * .. Intrinsic Functions ..
117  INTRINSIC max
118 * ..
119 * .. Executable Statements ..
120 * This is just to keep ftnchek happy
121  IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
122  $ rsrc_.LT.0 )RETURN
123 *
124  CALL blacs_pinfo( iam, nnodes )
125  CALL blacs_get( -1, 0, initcon )
126  CALL blacs_gridinit( initcon, 'R', 1, nnodes )
127 *
128  CALL pdsepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
129  $ matsizes, nuplos, uplos, npconfigs, nprows,
130  $ npcols, nbs, nmattypes, mattypes, 22, subtests,
131  $ thresh, order, abstol, info )
132 *
133  CALL blacs_gridexit( initcon )
134 *
135  IF( info.EQ.0 ) THEN
136 *
137 *
138  DO 40 matsize = 1, nmatsizes
139 *
140  DO 30 pconfig = 1, npconfigs
141 *
142  DO 20 mattype = 1, nmattypes
143 *
144  DO 10 uplo = 1, nuplos
145 *
146  n = matsizes( matsize )
147  order = n
148 *
149  nprow = nprows( pconfig )
150  npcol = npcols( pconfig )
151  nb = nbs( pconfig )
152 *
153  np = numroc( n, nb, 0, 0, nprow )
154  nq = numroc( n, nb, 0, 0, npcol )
155  iprepad = max( nb, np )
156  imidpad = nb
157  ipostpad = max( nb, nq )
158 *
159  lda = max( np, 1 ) + imidpad
160 *
161  CALL blacs_get( -1, 0, context )
162  CALL blacs_gridinit( context, 'R', nprow, npcol )
163  CALL blacs_gridinfo( context, nprow, npcol, myrow,
164  $ mycol )
165 *
166  IF( myrow.GE.0 ) THEN
167  CALL descinit( desca, n, n, nb, nb, 0, 0,
168  $ context, lda, info )
169  CALL pdlasizesqp( desca, iprepad, ipostpad,
170  $ sizemqrleft, sizemqrright,
171  $ sizeqrf, sizetms, sizeqtq,
172  $ sizechk, sizesyevx,
173  $ isizesyevx, sizesyev,
174  $ sizesyevd, isizesyevd,
175  $ sizesubtst, isizesubtst,
176  $ sizetst, isizetst )
177 *
178  ptra = 1
179  ptrz = ptra + lda*nq + iprepad + ipostpad
180  ptrcopya = ptrz + lda*nq + iprepad + ipostpad
181  ptrw = ptrcopya + lda*nq + iprepad + ipostpad
182  ptrw2 = ptrw + max( n, 1 ) + iprepad + ipostpad
183  ptrgap = ptrw2 + max( n, 1 ) + iprepad +
184  $ ipostpad
185  ptrifail = ptrgap + nprow*npcol + iprepad +
186  $ ipostpad
187  ptriclus = ptrifail + iceil( n+iprepad+ipostpad,
188  $ dblesz / intgsz )
189  ptriwrk = ptriclus + iceil( 2*nprow*npcol+
190  $ iprepad+ipostpad, dblesz / intgsz )
191  ptrwork = ptriwrk + iceil( isizetst+iprepad+
192  $ ipostpad, dblesz / intgsz )
193  llwork = memsize - ptrwork + 1
194 C LLWORK = MEMSIZE - PTRWORK - IPREPAD -
195 C $ IPOSTPAD + 1
196  ntests = ntests + 1
197  IF( llwork.LT.sizetst ) THEN
198  nskipped = nskipped + 1
199  ELSE
200  CALL pdseptst( desca, uplos( uplo ), n,
201  $ mattypes( mattype ), subtests,
202  $ thresh, n, abstol, iseed,
203  $ mem( ptra ), mem( ptrcopya ),
204  $ mem( ptrz ), lda, mem( ptrw ),
205  $ mem( ptrw2 ), mem( ptrifail ),
206  $ mem( ptriclus ),
207  $ mem( ptrgap ), iprepad,
208  $ ipostpad, mem( ptrwork ),
209  $ llwork, mem( ptriwrk ),
210  $ isizetst, hetero, nout, res )
211 *
212  IF( res.EQ.0 ) THEN
213  npassed = npassed + 1
214  ELSE IF( res.EQ.2 ) THEN
215  nnocheck = nnocheck + 1
216  ELSE IF( res.EQ.3 ) THEN
217  nskipped = nskipped + 1
218  WRITE( nout, fmt = * )' PDSEPREQ failed'
219  CALL blacs_abort( context, -1 )
220  END IF
221  END IF
222  CALL blacs_gridexit( context )
223  END IF
224  10 CONTINUE
225  20 CONTINUE
226  30 CONTINUE
227  40 CONTINUE
228  END IF
229 *
230 *
231  RETURN
232 *
233 * End of PDDSEPREQ
234 *
235  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
pdlasizesqp
subroutine pdlasizesqp(DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZETMS, SIZEQTQ, SIZECHK, SIZESYEVX, ISIZESYEVX, SIZESYEV, SIZESYEVD, ISIZESYEVD, SIZESUBTST, ISIZESUBTST, SIZETST, ISIZETST)
Definition: pdlasizesqp.f:7
pdseptst
subroutine pdseptst(DESCA, UPLO, N, MATTYPE, SUBTESTS, THRESH, ORDER, ABSTOL, ISEED, A, COPYA, Z, LDA, WIN, WNEW, IFAIL, ICLUSTR, GAP, IPREPAD, IPOSTPAD, WORK, LWORK, IWORK, LIWORK, HETERO, NOUT, INFO)
Definition: pdseptst.f:6
descinit
subroutine descinit(DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, LLD, INFO)
Definition: descinit.f:3
pdsepreq
subroutine pdsepreq(HETERO, NIN, MEM, MEMSIZE, NOUT, ISEED, NTESTS, NSKIPPED, NNOCHECK, NPASSED, INFO)
Definition: pdsepreq.f:5