ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
psseprreq.f
Go to the documentation of this file.
1  SUBROUTINE psseprreq( HETERO, NIN, MEM, MEMSIZE, NOUT, ISEED,
2  $ NTESTS, NSKIPPED, NNOCHECK, NPASSED, INFO )
3 *
4 * -- ScaLAPACK routine (@(MODE)version *TBA*) --
5 * University of California, Berkeley and
6 * University of Tennessee, Knoxville.
7 * October 21, 2006
8 *
9  IMPLICIT NONE
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 * Purpose
21 * =======
22 *
23 * PSSEPRREQ performs one request from the input file 'SEPR.dat'
24 * A request is the cross product of the specifications in the
25 * input file. It prints one line per test.
26 *
27 * Arguments
28 * =========
29 *
30 * NIN (local input) INTEGER
31 * The unit number for the input file 'SEPR.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 * INFO (global output) INTEGER
66 * 0 = test request ran
67 * -1 = end of file
68 * -2 = incorrect .dat file
69 *
70 * .. Parameters ..
71 *
72  INTEGER DLEN_
73  parameter( dlen_ = 9 )
74  INTEGER REALSZ, INTGSZ
75  parameter( realsz = 4, intgsz = 4 )
76  INTEGER MAXSETSIZE
77  parameter( maxsetsize = 50 )
78 * ..
79 * .. Local Scalars ..
80  CHARACTER SUBTESTS
81  INTEGER CONTEXT, IAM, IMIDPAD, INITCON, IPOSTPAD,
82  $ iprepad, isizesubtst, isizeevr, isizetst,
83  $ lda, llwork, matsize, mattype, mycol, myrow, n,
84  $ nb, nmatsizes, nmattypes, nnodes, np, npcol,
85  $ npconfigs, nprow, nq, nuplos, order, pconfig,
86  $ ptra, ptrcopya, ptrgap, ptriclus, ptrifail,
87  $ ptriwrk, ptrw, ptrw2, ptrwork, ptrz, res,
88  $ sizechk, sizemqrleft, sizemqrright, sizeqrf,
89  $ sizeqtq, sizesubtst, sizeevr,
90  $ sizetms, sizetst, uplo
91 *
92  REAL ABSTOL, THRESH
93 * ..
94 * .. Local Arrays ..
95  CHARACTER UPLOS( 2 )
96  INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
97  $ mattypes( maxsetsize ), nbs( maxsetsize ),
98  $ npcols( maxsetsize ), nprows( maxsetsize )
99 * ..
100 * .. External Functions ..
101  INTEGER ICEIL, NUMROC
102  EXTERNAL iceil, numroc
103 * ..
104 * .. External Subroutines ..
105  EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
106  $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
107  $ descinit, pslasizesepr, pssepinfo, psseprtst
108 * ..
109 * .. Intrinsic Functions ..
110  INTRINSIC max
111 * ..
112 * .. Executable Statements ..
113 *
114  CALL blacs_pinfo( iam, nnodes )
115  CALL blacs_get( -1, 0, initcon )
116  CALL blacs_gridinit( initcon, 'R', 1, nnodes )
117 *
118  CALL pssepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
119  $ matsizes, nuplos, uplos, npconfigs, nprows,
120  $ npcols, nbs, nmattypes, mattypes, 22, subtests,
121  $ thresh, order, abstol, info )
122 *
123  CALL blacs_gridexit( initcon )
124 *
125  IF( info.EQ.0 ) THEN
126 *
127  DO 40 matsize = 1, nmatsizes
128 *
129  DO 30 pconfig = 1, npconfigs
130 *
131  DO 20 mattype = 1, nmattypes
132 *
133  DO 10 uplo = 1, nuplos
134 *
135  n = matsizes( matsize )
136  order = n
137 *
138  nprow = nprows( pconfig )
139  npcol = npcols( pconfig )
140  nb = nbs( pconfig )
141 *
142  np = numroc( n, nb, 0, 0, nprow )
143  nq = numroc( n, nb, 0, 0, npcol )
144  iprepad = max( nb, np )
145  imidpad = nb
146  ipostpad = max( nb, nq )
147 *
148  lda = max( np, 1 ) + imidpad
149 *
150  CALL blacs_get( -1, 0, context )
151  CALL blacs_gridinit( context, 'R', nprow, npcol )
152  CALL blacs_gridinfo( context, nprow, npcol, myrow,
153  $ mycol )
154 *
155  IF( myrow.GE.0 ) THEN
156  CALL descinit( desca, n, n, nb, nb, 0, 0,
157  $ context, lda, info )
158  CALL pslasizesepr( desca, iprepad, ipostpad,
159  $ sizemqrleft, sizemqrright,
160  $ sizeqrf, sizetms, sizeqtq,
161  $ sizechk, sizeevr, isizeevr,
162  $ sizesubtst, isizesubtst,
163  $ sizetst, isizetst )
164 *
165  ptra = 1
166  ptrz = ptra + lda*nq + iprepad + ipostpad
167  ptrcopya = ptrz + lda*nq + iprepad + ipostpad
168  ptrw = ptrcopya + lda*nq + iprepad + ipostpad
169  ptrw2 = ptrw + max( n, 1 ) + iprepad + ipostpad
170  ptrgap = ptrw2 + max( n, 1 ) + iprepad +
171  $ ipostpad
172  ptrifail = ptrgap + nprow*npcol + iprepad +
173  $ ipostpad
174  ptriclus = ptrifail + iceil( n+iprepad+ipostpad,
175  $ realsz / intgsz )
176  ptriwrk = ptriclus + iceil( 2*nprow*npcol+
177  $ iprepad+ipostpad, realsz / intgsz )
178  ptrwork = ptriwrk + iceil( isizetst+iprepad+
179  $ ipostpad, realsz / intgsz )
180  llwork = memsize - ptrwork + 1
181 
182  ntests = ntests + 1
183  IF( llwork.LT.sizetst ) THEN
184  nskipped = nskipped + 1
185  ELSE
186  CALL psseprtst( desca, uplos( uplo ), n,
187  $ mattypes( mattype ), subtests,
188  $ thresh, n, abstol, iseed,
189  $ mem( ptra ), mem( ptrcopya ),
190  $ mem( ptrz ), lda, mem( ptrw ),
191  $ mem( ptrw2 ), mem( ptrifail ),
192  $ mem( ptriclus ),
193  $ mem( ptrgap ), iprepad,
194  $ ipostpad, mem( ptrwork ),
195  $ llwork, mem( ptriwrk ),
196  $ isizetst, hetero, nout, res )
197 *
198  IF( res.EQ.0 ) THEN
199  npassed = npassed + 1
200  ELSE IF( res.EQ.2 ) THEN
201  nnocheck = nnocheck + 1
202  ELSE IF( res.EQ.3 ) THEN
203  nskipped = nskipped + 1
204  WRITE( nout, fmt = * )' PSSEPRREQ failed'
205  CALL blacs_abort( context, -1 )
206  END IF
207  END IF
208  CALL blacs_gridexit( context )
209  END IF
210  10 CONTINUE
211  20 CONTINUE
212  30 CONTINUE
213  40 CONTINUE
214  END IF
215 *
216  RETURN
217 *
218 * End of PSSEPRREQ
219 *
220  END
max
#define max(A, B)
Definition: pcgemr.c:180
pslasizesepr
subroutine pslasizesepr(DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZETMS, SIZEQTQ, SIZECHK, SIZESYEVR, ISIZESYEVR, SIZESUBTST, ISIZESUBTST, SIZETST, ISIZETST)
Definition: pslasizesepr.f:6
psseprreq
subroutine psseprreq(HETERO, NIN, MEM, MEMSIZE, NOUT, ISEED, NTESTS, NSKIPPED, NNOCHECK, NPASSED, INFO)
Definition: psseprreq.f:3
descinit
subroutine descinit(DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, LLD, INFO)
Definition: descinit.f:3
psseprtst
subroutine psseprtst(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: psseprtst.f:6
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