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