ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
psgsepreq.f
Go to the documentation of this file.
1 *
2 *
3  SUBROUTINE psgsepreq( 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  REAL MEM( MEMSIZE )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * PSGSEPREQ performs one request from the input file 'SEP.dat'
24 * A request is the cross product of the specifications in the
25 * input file. PSGSEPREQ 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) REAL 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 REALSZ, INTGSZ
83  parameter( realsz = 4, intgsz = 4 )
84  INTEGER MAXSETSIZE
85  parameter( maxsetsize = 50 )
86 * ..
87 * .. Local Scalars ..
88  CHARACTER SUBTESTS
89  INTEGER CONTEXT, IAM, IBTYPE, IMIDPAD, INITCON,
90  $ ipostpad, iprepad, isizesubtst, isizesyevx,
91  $ isizetst, lda, llwork, matsize, mattype, mycol,
92  $ myrow, n, nb, nibtypes, nmatsizes, nmattypes,
93  $ nnodes, np, npcol, npconfigs, nprow, nq,
94  $ nuplos, order, pconfig, ptra, ptrb, ptrcopya,
95  $ ptrcopyb, ptrgap, ptriclus, ptrifail, ptriwrk,
96  $ ptrw, ptrw2, ptrwork, ptrz, res, sizechk,
97  $ sizemqrleft, sizemqrright, sizeqrf, sizeqtq,
98  $ sizesubtst, sizesyevx, sizetms, sizetst, uplo
99  REAL 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  LOGICAL LSAME
109  INTEGER ICEIL, NUMROC
110  EXTERNAL lsame, iceil, numroc
111 * ..
112 * .. External Subroutines ..
113  EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
114  $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
115  $ descinit, psgseptst, pslasizegsep, pssepinfo
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 * Thresholds must be bigger for the generalized problem.
139 *
140  thresh = thresh*five
141 *
142  DO 50 matsize = 1, nmatsizes
143 *
144  DO 40 pconfig = 1, npconfigs
145 *
146  DO 30 mattype = 1, nmattypes
147 *
148  DO 20 uplo = 1, nuplos
149  IF( lsame( subtests, 'Y' ) ) THEN
150  nibtypes = 3
151  ELSE
152  nibtypes = 1
153  END IF
154  DO 10 ibtype = 1, nibtypes
155 *
156  n = matsizes( matsize )
157  order = n
158 *
159  nprow = nprows( pconfig )
160  npcol = npcols( pconfig )
161  nb = nbs( pconfig )
162 *
163  np = numroc( n, nb, 0, 0, nprow )
164  nq = numroc( n, nb, 0, 0, npcol )
165  iprepad = max( nb, np )
166  imidpad = nb
167  ipostpad = max( nb, nq )
168 *
169  lda = max( np, 1 ) + imidpad
170 *
171  CALL blacs_get( -1, 0, context )
172  CALL blacs_gridinit( context, 'R', nprow,
173  $ npcol )
174  CALL blacs_gridinfo( context, nprow, npcol,
175  $ myrow, mycol )
176  IF( myrow.GE.0 ) THEN
177  CALL descinit( desca, n, n, nb, nb, 0, 0,
178  $ context, lda, info )
179  CALL pslasizegsep( desca, iprepad, ipostpad,
180  $ sizemqrleft, sizemqrright,
181  $ sizeqrf, sizetms, sizeqtq,
182  $ sizechk, sizesyevx,
183  $ isizesyevx, sizesubtst,
184  $ isizesubtst, sizetst,
185  $ isizetst )
186 *
187  ptra = 1
188  ptrz = ptra + lda*nq + iprepad + ipostpad
189  ptrcopyb = ptrz + lda*nq + iprepad + ipostpad
190  ptrb = ptrcopyb + lda*nq + iprepad + ipostpad
191  ptrcopya = ptrb + lda*nq + iprepad + ipostpad
192  ptrw = ptrcopya + lda*nq + iprepad + ipostpad
193  ptrw2 = ptrw + max( n, 1 ) + iprepad +
194  $ ipostpad
195  ptrgap = ptrw2 + max( n, 1 ) + iprepad +
196  $ ipostpad
197  ptrifail = ptrgap + nprow*npcol + iprepad +
198  $ ipostpad
199  ptriclus = ptrifail +
200  $ iceil( n+iprepad+ipostpad,
201  $ realsz / intgsz )
202  ptriwrk = ptriclus + iceil( 2*nprow*npcol+
203  $ iprepad+ipostpad, realsz / intgsz )
204  ptrwork = ptriwrk + iceil( isizetst+iprepad+
205  $ ipostpad, realsz / intgsz )
206  llwork = memsize - ptrwork - ipostpad -
207  $ iprepad + 1
208  ntests = ntests + 1
209  IF( llwork.LT.sizetst ) THEN
210  nskipped = nskipped + 1
211  ELSE
212  CALL psgseptst( desca, uplos( uplo ), n,
213  $ mattypes( mattype ),
214  $ ibtype, subtests, thresh,
215  $ n, abstol, iseed,
216  $ mem( ptra ),
217  $ mem( ptrcopya ),
218  $ mem( ptrb ),
219  $ mem( ptrcopyb ),
220  $ mem( ptrz ), lda,
221  $ mem( ptrw ), mem( ptrw2 ),
222  $ mem( ptrifail ),
223  $ mem( ptriclus ),
224  $ mem( ptrgap ), iprepad,
225  $ ipostpad, mem( ptrwork ),
226  $ llwork, mem( ptriwrk ),
227  $ isizetst, nout, res )
228 *
229  IF( res.EQ.0 ) THEN
230  npassed = npassed + 1
231  ELSE IF( res.EQ.2 ) THEN
232  nnocheck = nnocheck + 1
233  ELSE IF( res.EQ.3 ) THEN
234  nskipped = nskipped + 1
235  WRITE( nout, fmt = * )
236  $ ' pSGSEPREQ failed'
237  CALL blacs_abort( context, -1 )
238  END IF
239  CALL blacs_gridexit( context )
240  END IF
241  END IF
242  10 CONTINUE
243  20 CONTINUE
244  30 CONTINUE
245  40 CONTINUE
246  50 CONTINUE
247  END IF
248 *
249 *
250  RETURN
251 *
252 * End of PSDGSEPREQ
253 *
254  END
pslasizegsep
subroutine pslasizegsep(DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZETMS, SIZEQTQ, SIZECHK, SIZESYEVX, ISIZESYEVX, SIZESUBTST, ISIZESUBTST, SIZETST, ISIZETST)
Definition: pslasizegsep.f:8
max
#define max(A, B)
Definition: pcgemr.c:180
psgsepreq
subroutine psgsepreq(NIN, MEM, MEMSIZE, NOUT, ISEED, NTESTS, NSKIPPED, NNOCHECK, NPASSED, INFO)
Definition: psgsepreq.f:5
descinit
subroutine descinit(DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, LLD, INFO)
Definition: descinit.f:3
psgseptst
subroutine psgseptst(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, IWORK, LIWORK, NOUT, INFO)
Definition: psgseptst.f:8
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