ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pdsepinfo.f
Go to the documentation of this file.
1 *
2 *
3  SUBROUTINE pdsepinfo( CONTEXT, IAM, NIN, NOUT, MAXSETSIZE,
4  $ NMATSIZES, MATSIZES, NUPLOS, UPLOS,
5  $ NPCONFIGS, NPROWS, NPCOLS, NBS, NMATTYPES,
6  $ MATTYPES, MAXTYPE, SUBTESTS, THRESH, ORDER,
7  $ ABSTOL, INFO )
8 *
9 * -- ScaLAPACK routine (version 1.7) --
10 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
11 * and University of California, Berkeley.
12 * May 1, 1997
13 *
14 * Purpose
15 * =======
16 *
17 * PDSEPINFO reads the input test data file (INFILE), copies the
18 * information therein to all processes and returns this information
19 * in the corresponding parameters.
20 *
21 * Arguments
22 * =========
23 *
24 * CONTEXT (global input) INTEGER
25 * BLACS Context
26 *
27 * IAM (local input) INTEGER
28 * process number.
29 * IAM.EQ.0 on the proceesor that performs I/O
30 *
31 * NIN (global input) INTEGER
32 * The unit number of the input file.
33 *
34 * NOUT (global output) INTEGER
35 * The unit number for output file.
36 * if NOUT = 6, ouput to screen,
37 * if NOUT = 0, output to stderr
38 * Only defined for process 0.
39 *
40 * MAXSETSIZE (global output) INTEGER
41 * Maximum set size. Size of the following arrays:
42 * MATSIZES, MATTYPES, NBS, NPCOLS, NPROWS
43 *
44 * NMATSIZES (global output) INTEGER
45 * Number of matrix sizes to test
46 *
47 * MATSIZES (global output) INTEGER array dimension MAXSETSIZE
48 * Matrix sizes to test
49 *
50 * NUPLOS (global output) INTEGER
51 * Number of UPLO values to test
52 *
53 * UPLOS (global output) CHARACTER*1 array dimension 2
54 * Values of UPLO to test
55 *
56 * NPCONFIGS (global output) INTEGER
57 * Number of process configuratins (NPROW, NPCOL, NB)
58 *
59 * NPROWS (global output) INTEGER array dimension MAXSETSIZE
60 * Values of NPROW to test
61 *
62 * NPCOLS (global output) INTEGER array dimension MAXSETSIZE
63 * Values of NPCOL to test
64 *
65 * NBS (global output) INTEGER array dimension MAXSETSIZE
66 * Values of NB to test
67 *
68 * NMATTYPES (global output) INTEGER
69 * Number of matrix types to test
70 *
71 * MATTYPES (global output) INTEGER array dimension MAXSETSIZE
72 * Matrix types to test
73 * Refer to PDSEPTST for a complete description of the
74 * supported matrix types.
75 *
76 * MAXTYPE (global input) INTEGER
77 * Maximum allowed matrix type
78 *
79 * SUBTESTS (global output) CHARACTER
80 * 'N' = Do not perform subtests
81 * 'Y' = Perfrom subtests
82 *
83 *
84 * THRESH (global output) @(tupc)
85 * A test will count as "failed" if the "error", computed as
86 * described below, exceeds THRESH. Note that the error
87 * is scaled to be O(1), so THRESH should be a reasonably
88 * small multiple of 1, e.g., 10 or 100. In particular,
89 * it should not depend on the precision (single vs. double)
90 * or the size of the matrix. It must be at least zero.
91 * ( THRESH is set to 1/10 of the value defined in the .dat
92 * file when NOUT = 13. THRESH is set to 1/20 of the value
93 * defined in the .dat file when NOUT = 14. This allows us
94 * to specify more stringent criteria for our internal testing )
95 *
96 * ORDER (global output) INTEGER
97 * Number of reflectors used in test matrix creation.
98 * If ORDER is large, it will
99 * take more time to create the test matrices but they will
100 * be closer to random.
101 * ORDER .lt. N not implemented
102 *
103 * ABSTOL (global output) DOUBLE PRECISION
104 * The absolute tolerance for the eigenvalues. An
105 * eigenvalue is considered to be located if it has
106 * been determined to lie in an interval whose width
107 * is "abstol" or less. If "abstol" is less than or equal
108 * to zero, then ulp*|T| will be used, where |T| is
109 * the 1-norm of the matrix. If eigenvectors are
110 * desired later by inverse iteration ("PDSTEIN"),
111 * "abstol" MUST NOT be bigger than ulp*|T|.
112 *
113 * If ( ABSTOL .EQ. 0 in SEP.dat, it is set to
114 * 2.0 * PDLAMCH( 'u' ) in this routine.
115 *
116 * INFO (global output) INTEGER
117 * 0 = normal return
118 * -1 = end of file
119 * -2 = incorrrect data specification
120 *
121 * .. Scalar Arguments ..
122  CHARACTER SUBTESTS
123  INTEGER CONTEXT, IAM, INFO, MAXSETSIZE, MAXTYPE, NIN,
124  $ NMATSIZES, NMATTYPES, NOUT, NPCONFIGS, NUPLOS,
125  $ ORDER
126  DOUBLE PRECISION ABSTOL, THRESH
127 * ..
128 * .. Array Arguments ..
129  CHARACTER UPLOS( 2 )
130  INTEGER MATSIZES( MAXSETSIZE ), MATTYPES( MAXSETSIZE ),
131  $ NBS( MAXSETSIZE ), NPCOLS( MAXSETSIZE ),
132  $ NPROWS( MAXSETSIZE )
133 * ..
134 * .. Parameters ..
135  INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
136  $ MB_, NB_, RSRC_, CSRC_, LLD_
137  PARAMETER ( BLOCK_CYCLIC_2D = 1, dlen_ = 9, dtype_ = 1,
138  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
139  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
140  DOUBLE PRECISION TWO, TEN, TWENTY
141  parameter( two = 2.0d0, ten = 10.0d0, twenty = 20.0d0 )
142 * ..
143 * .. Local Scalars ..
144  CHARACTER*80 TESTSUMMRY
145  INTEGER I, ISUBTESTS
146 * ..
147 * .. External Functions ..
148  LOGICAL LSAME
149  DOUBLE PRECISION PDLAMCH
150  EXTERNAL LSAME, PDLAMCH
151 * ..
152 *
153 * .. External Subroutines ..
154  EXTERNAL dgebr2d, dgebs2d, igebr2d, igebs2d
155 * ..
156 *
157 * .. Local Arrays ..
158  INTEGER IUPLOS( 2 )
159 * ..
160 * .. Executable Statements ..
161 * This is just to keep ftnchek happy
162  IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
163  $ rsrc_.LT.0 )RETURN
164 *
165  info = 0
166  IF( iam.EQ.0 ) THEN
167  READ( nin, fmt = 9997 )testsummry
168  testsummry = ' '
169  READ( nin, fmt = 9997 )testsummry
170  WRITE( nout, fmt = 9997 )testsummry
171  END IF
172 *
173  IF( iam.EQ.0 ) THEN
174  READ( nin, fmt = * )nmatsizes
175  CALL igebs2d( context, 'All', ' ', 1, 1, nmatsizes, 1 )
176  ELSE
177  CALL igebr2d( context, 'All', ' ', 1, 1, nmatsizes, 1, 0, 0 )
178  END IF
179  IF( nmatsizes.EQ.-1 ) THEN
180  info = -1
181  GO TO 70
182  END IF
183  IF( nmatsizes.LT.1 .OR. nmatsizes.GT.maxsetsize ) THEN
184  IF( iam.EQ.0 ) THEN
185  WRITE( nout, fmt = 9999 )'Matrix size', nmatsizes, 1,
186  $ maxsetsize
187  END IF
188  info = -2
189  GO TO 70
190  END IF
191 *
192 *
193  IF( iam.EQ.0 ) THEN
194  READ( nin, fmt = * )( matsizes( i ), i = 1, nmatsizes )
195  CALL igebs2d( context, 'All', ' ', 1, nmatsizes, matsizes, 1 )
196  ELSE
197  CALL igebr2d( context, 'All', ' ', 1, nmatsizes, matsizes, 1,
198  $ 0, 0 )
199  END IF
200 *
201  IF( iam.EQ.0 ) THEN
202  READ( nin, fmt = * )nuplos
203  CALL igebs2d( context, 'All', ' ', 1, 1, nuplos, 1 )
204  ELSE
205  CALL igebr2d( context, 'All', ' ', 1, 1, nuplos, 1, 0, 0 )
206  END IF
207  IF( nuplos.LT.1 .OR. nuplos.GT.2 ) THEN
208  IF( iam.EQ.0 ) THEN
209  WRITE( nout, fmt = 9999 )'# of UPLOs', nuplos, 1, 2
210  END IF
211  info = -2
212  GO TO 70
213  END IF
214 *
215  IF( iam.EQ.0 ) THEN
216  READ( nin, fmt = * )( uplos( i ), i = 1, nuplos )
217  DO 10 i = 1, nuplos
218  IF( lsame( uplos( i ), 'L' ) ) THEN
219  iuplos( i ) = 1
220  ELSE
221  iuplos( i ) = 2
222  END IF
223  10 CONTINUE
224  CALL igebs2d( context, 'All', ' ', 1, nuplos, iuplos, 1 )
225  ELSE
226  CALL igebr2d( context, 'All', ' ', 1, nuplos, iuplos, 1, 0, 0 )
227  END IF
228  DO 20 i = 1, nuplos
229  IF( iuplos( i ).EQ.1 ) THEN
230  uplos( i ) = 'L'
231  ELSE
232  uplos( i ) = 'U'
233  END IF
234  20 CONTINUE
235 *
236  IF( iam.EQ.0 ) THEN
237  READ( nin, fmt = * )npconfigs
238  CALL igebs2d( context, 'All', ' ', 1, 1, npconfigs, 1 )
239  ELSE
240  CALL igebr2d( context, 'All', ' ', 1, 1, npconfigs, 1, 0, 0 )
241  END IF
242  IF( npconfigs.LT.1 .OR. npconfigs.GT.maxsetsize ) THEN
243  IF( iam.EQ.0 ) THEN
244  WRITE( nout, fmt = 9999 )'# proc configs', npconfigs, 1,
245  $ maxsetsize
246  END IF
247  info = -2
248  GO TO 70
249  END IF
250 *
251  IF( iam.EQ.0 ) THEN
252  READ( nin, fmt = * )( nprows( i ), i = 1, npconfigs )
253  CALL igebs2d( context, 'All', ' ', 1, npconfigs, nprows, 1 )
254  ELSE
255  CALL igebr2d( context, 'All', ' ', 1, npconfigs, nprows, 1, 0,
256  $ 0 )
257  END IF
258  DO 30 i = 1, npconfigs
259  IF( nprows( i ).LE.0 )
260  $ info = -2
261  30 CONTINUE
262  IF( info.EQ.-2 ) THEN
263  IF( iam.EQ.0 ) THEN
264  WRITE( nout, fmt = 9996 )' NPROW'
265  END IF
266  GO TO 70
267  END IF
268 *
269  IF( iam.EQ.0 ) THEN
270  READ( nin, fmt = * )( npcols( i ), i = 1, npconfigs )
271  CALL igebs2d( context, 'All', ' ', 1, npconfigs, npcols, 1 )
272  ELSE
273  CALL igebr2d( context, 'All', ' ', 1, npconfigs, npcols, 1, 0,
274  $ 0 )
275  END IF
276  DO 40 i = 1, npconfigs
277  IF( npcols( i ).LE.0 )
278  $ info = -2
279  40 CONTINUE
280  IF( info.EQ.-2 ) THEN
281  IF( iam.EQ.0 ) THEN
282  WRITE( nout, fmt = 9996 )' NPCOL'
283  END IF
284  GO TO 70
285  END IF
286 *
287 *
288  IF( iam.EQ.0 ) THEN
289  READ( nin, fmt = * )( nbs( i ), i = 1, npconfigs )
290  CALL igebs2d( context, 'All', ' ', 1, npconfigs, nbs, 1 )
291  ELSE
292  CALL igebr2d( context, 'All', ' ', 1, npconfigs, nbs, 1, 0, 0 )
293  END IF
294  DO 50 i = 1, npconfigs
295  IF( nbs( i ).LE.0 )
296  $ info = -2
297  50 CONTINUE
298  IF( info.EQ.-2 ) THEN
299  IF( iam.EQ.0 ) THEN
300  WRITE( nout, fmt = 9996 )' NB'
301  END IF
302  GO TO 70
303  END IF
304 *
305 *
306  IF( iam.EQ.0 ) THEN
307  READ( nin, fmt = * )nmattypes
308  CALL igebs2d( context, 'All', ' ', 1, 1, nmattypes, 1 )
309  ELSE
310  CALL igebr2d( context, 'All', ' ', 1, 1, nmattypes, 1, 0, 0 )
311  END IF
312  IF( nmattypes.LT.1 .OR. nmattypes.GT.maxsetsize ) THEN
313  IF( iam.EQ.0 ) THEN
314  WRITE( nout, fmt = 9999 )'matrix types', nmattypes, 1,
315  $ maxsetsize
316  END IF
317  info = -2
318  GO TO 70
319  END IF
320 *
321  IF( iam.EQ.0 ) THEN
322  READ( nin, fmt = * )( mattypes( i ), i = 1, nmattypes )
323  CALL igebs2d( context, 'All', ' ', 1, nmattypes, mattypes, 1 )
324  ELSE
325  CALL igebr2d( context, 'All', ' ', 1, nmattypes, mattypes, 1,
326  $ 0, 0 )
327  END IF
328 *
329  DO 60 i = 1, nmattypes
330  IF( mattypes( i ).LT.1 .OR. mattypes( i ).GT.maxtype ) THEN
331  IF( iam.EQ.0 ) THEN
332  WRITE( nout, fmt = 9999 )'matrix type', mattypes( i ),
333  $ 1, maxtype
334  END IF
335  mattypes( i ) = 1
336  END IF
337  60 CONTINUE
338 *
339  IF( iam.EQ.0 ) THEN
340  READ( nin, fmt = * )subtests
341  IF( lsame( subtests, 'Y' ) ) THEN
342  isubtests = 2
343  ELSE
344  isubtests = 1
345  END IF
346  CALL igebs2d( context, 'All', ' ', 1, 1, isubtests, 1 )
347  ELSE
348  CALL igebr2d( context, 'All', ' ', 1, 1, isubtests, 1, 0, 0 )
349  END IF
350  IF( isubtests.EQ.2 ) THEN
351  subtests = 'Y'
352  ELSE
353  subtests = 'N'
354  END IF
355 *
356  IF( iam.EQ.0 ) THEN
357  READ( nin, fmt = * )thresh
358  IF( nout.EQ.13 )
359  $ thresh = thresh / ten
360  IF( nout.EQ.14 )
361  $ thresh = thresh / twenty
362  CALL dgebs2d( context, 'All', ' ', 1, 1, thresh, 1 )
363  ELSE
364  CALL dgebr2d( context, 'All', ' ', 1, 1, thresh, 1, 0, 0 )
365  END IF
366 *
367  order = 0
368 *
369  IF( iam.EQ.0 ) THEN
370  READ( nin, fmt = * )abstol
371  CALL dgebs2d( context, 'All', ' ', 1, 1, abstol, 1 )
372  ELSE
373  CALL dgebr2d( context, 'All', ' ', 1, 1, abstol, 1, 0, 0 )
374  END IF
375  IF( abstol.LT.0 )
376  $ abstol = two*pdlamch( context, 'U' )
377 *
378  info = 0
379 *
380  70 CONTINUE
381  RETURN
382 *
383  9999 FORMAT( a20, ' is:', i5, ' must be between:', i5, ' and', i5 )
384  9998 FORMAT( a20, ' is:', i5, ' must be:', i5, ' or', i5 )
385  9997 FORMAT( a )
386  9996 FORMAT( a20, ' must be positive' )
387 *
388 * End of PDSEPINFO
389 *
390  END
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