ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pssepinfo.f
Go to the documentation of this file.
1 *
2 *
3  SUBROUTINE pssepinfo( 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 * PSSEPINFO 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 PSSEPTST 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) REAL
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 ("PSSTEIN"),
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 * PSLAMCH( '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  REAL 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  REAL TWO, TEN, TWENTY
141  parameter( two = 2.0e0, ten = 10.0e0, twenty = 20.0e0 )
142 * ..
143 * .. Local Scalars ..
144  CHARACTER*80 TESTSUMMRY
145  INTEGER I, ISUBTESTS
146 * ..
147 * .. External Functions ..
148  LOGICAL LSAME
149  REAL PSLAMCH
150  EXTERNAL LSAME, PSLAMCH
151 * ..
152 *
153 * .. External Subroutines ..
154  EXTERNAL igebr2d, igebs2d, sgebr2d, sgebs2d
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  IF( iam.EQ.0 ) THEN
166  READ( nin, fmt = 9997 )testsummry
167  testsummry = ' '
168  READ( nin, fmt = 9997 )testsummry
169  WRITE( nout, fmt = 9997 )testsummry
170  END IF
171 *
172 * assign a default
173  info = 0
174 *
175  IF( iam.EQ.0 ) THEN
176  READ( nin, fmt = * )nmatsizes
177  CALL igebs2d( context, 'All', ' ', 1, 1, nmatsizes, 1 )
178  ELSE
179  CALL igebr2d( context, 'All', ' ', 1, 1, nmatsizes, 1, 0, 0 )
180  END IF
181  IF( nmatsizes.EQ.-1 ) THEN
182  info = -1
183  GO TO 70
184  END IF
185  IF( nmatsizes.LT.1 .OR. nmatsizes.GT.maxsetsize ) THEN
186  IF( iam.EQ.0 ) THEN
187  WRITE( nout, fmt = 9999 )'Matrix size', nmatsizes, 1,
188  $ maxsetsize
189  END IF
190  info = -2
191  GO TO 70
192  END IF
193 *
194 *
195  IF( iam.EQ.0 ) THEN
196  READ( nin, fmt = * )( matsizes( i ), i = 1, nmatsizes )
197  CALL igebs2d( context, 'All', ' ', 1, nmatsizes, matsizes, 1 )
198  ELSE
199  CALL igebr2d( context, 'All', ' ', 1, nmatsizes, matsizes, 1,
200  $ 0, 0 )
201  END IF
202 *
203  IF( iam.EQ.0 ) THEN
204  READ( nin, fmt = * )nuplos
205  CALL igebs2d( context, 'All', ' ', 1, 1, nuplos, 1 )
206  ELSE
207  CALL igebr2d( context, 'All', ' ', 1, 1, nuplos, 1, 0, 0 )
208  END IF
209  IF( nuplos.LT.1 .OR. nuplos.GT.2 ) THEN
210  IF( iam.EQ.0 ) THEN
211  WRITE( nout, fmt = 9999 )'# of UPLOs', nuplos, 1, 2
212  END IF
213  info = -2
214  GO TO 70
215  END IF
216 *
217  IF( iam.EQ.0 ) THEN
218  READ( nin, fmt = * )( uplos( i ), i = 1, nuplos )
219  DO 10 i = 1, nuplos
220  IF( lsame( uplos( i ), 'L' ) ) THEN
221  iuplos( i ) = 1
222  ELSE
223  iuplos( i ) = 2
224  END IF
225  10 CONTINUE
226  CALL igebs2d( context, 'All', ' ', 1, nuplos, iuplos, 1 )
227  ELSE
228  CALL igebr2d( context, 'All', ' ', 1, nuplos, iuplos, 1, 0, 0 )
229  END IF
230  DO 20 i = 1, nuplos
231  IF( iuplos( i ).EQ.1 ) THEN
232  uplos( i ) = 'L'
233  ELSE
234  uplos( i ) = 'U'
235  END IF
236  20 CONTINUE
237 *
238  IF( iam.EQ.0 ) THEN
239  READ( nin, fmt = * )npconfigs
240  CALL igebs2d( context, 'All', ' ', 1, 1, npconfigs, 1 )
241  ELSE
242  CALL igebr2d( context, 'All', ' ', 1, 1, npconfigs, 1, 0, 0 )
243  END IF
244  IF( npconfigs.LT.1 .OR. npconfigs.GT.maxsetsize ) THEN
245  IF( iam.EQ.0 ) THEN
246  WRITE( nout, fmt = 9999 )'# proc configs', npconfigs, 1,
247  $ maxsetsize
248  END IF
249  info = -2
250  GO TO 70
251  END IF
252 *
253  IF( iam.EQ.0 ) THEN
254  READ( nin, fmt = * )( nprows( i ), i = 1, npconfigs )
255  CALL igebs2d( context, 'All', ' ', 1, npconfigs, nprows, 1 )
256  ELSE
257  CALL igebr2d( context, 'All', ' ', 1, npconfigs, nprows, 1, 0,
258  $ 0 )
259  END IF
260  DO 30 i = 1, npconfigs
261  IF( nprows( i ).LE.0 )
262  $ info = -2
263  30 CONTINUE
264  IF( info.EQ.-2 ) THEN
265  IF( iam.EQ.0 ) THEN
266  WRITE( nout, fmt = 9996 )' NPROW'
267  END IF
268  GO TO 70
269  END IF
270 *
271  IF( iam.EQ.0 ) THEN
272  READ( nin, fmt = * )( npcols( i ), i = 1, npconfigs )
273  CALL igebs2d( context, 'All', ' ', 1, npconfigs, npcols, 1 )
274  ELSE
275  CALL igebr2d( context, 'All', ' ', 1, npconfigs, npcols, 1, 0,
276  $ 0 )
277  END IF
278  DO 40 i = 1, npconfigs
279  IF( npcols( i ).LE.0 )
280  $ info = -2
281  40 CONTINUE
282  IF( info.EQ.-2 ) THEN
283  IF( iam.EQ.0 ) THEN
284  WRITE( nout, fmt = 9996 )' NPCOL'
285  END IF
286  GO TO 70
287  END IF
288 *
289 *
290  IF( iam.EQ.0 ) THEN
291  READ( nin, fmt = * )( nbs( i ), i = 1, npconfigs )
292  CALL igebs2d( context, 'All', ' ', 1, npconfigs, nbs, 1 )
293  ELSE
294  CALL igebr2d( context, 'All', ' ', 1, npconfigs, nbs, 1, 0, 0 )
295  END IF
296  DO 50 i = 1, npconfigs
297  IF( nbs( i ).LE.0 )
298  $ info = -2
299  50 CONTINUE
300  IF( info.EQ.-2 ) THEN
301  IF( iam.EQ.0 ) THEN
302  WRITE( nout, fmt = 9996 )' NB'
303  END IF
304  GO TO 70
305  END IF
306 *
307 *
308  IF( iam.EQ.0 ) THEN
309  READ( nin, fmt = * )nmattypes
310  CALL igebs2d( context, 'All', ' ', 1, 1, nmattypes, 1 )
311  ELSE
312  CALL igebr2d( context, 'All', ' ', 1, 1, nmattypes, 1, 0, 0 )
313  END IF
314  IF( nmattypes.LT.1 .OR. nmattypes.GT.maxsetsize ) THEN
315  IF( iam.EQ.0 ) THEN
316  WRITE( nout, fmt = 9999 )'matrix types', nmattypes, 1,
317  $ maxsetsize
318  END IF
319  info = -2
320  GO TO 70
321  END IF
322 *
323  IF( iam.EQ.0 ) THEN
324  READ( nin, fmt = * )( mattypes( i ), i = 1, nmattypes )
325  CALL igebs2d( context, 'All', ' ', 1, nmattypes, mattypes, 1 )
326  ELSE
327  CALL igebr2d( context, 'All', ' ', 1, nmattypes, mattypes, 1,
328  $ 0, 0 )
329  END IF
330 *
331  DO 60 i = 1, nmattypes
332  IF( mattypes( i ).LT.1 .OR. mattypes( i ).GT.maxtype ) THEN
333  IF( iam.EQ.0 ) THEN
334  WRITE( nout, fmt = 9999 )'matrix type', mattypes( i ),
335  $ 1, maxtype
336  END IF
337  mattypes( i ) = 1
338  END IF
339  60 CONTINUE
340 *
341  IF( iam.EQ.0 ) THEN
342  READ( nin, fmt = * )subtests
343  IF( lsame( subtests, 'Y' ) ) THEN
344  isubtests = 2
345  ELSE
346  isubtests = 1
347  END IF
348  CALL igebs2d( context, 'All', ' ', 1, 1, isubtests, 1 )
349  ELSE
350  CALL igebr2d( context, 'All', ' ', 1, 1, isubtests, 1, 0, 0 )
351  END IF
352  IF( isubtests.EQ.2 ) THEN
353  subtests = 'Y'
354  ELSE
355  subtests = 'N'
356  END IF
357 *
358  IF( iam.EQ.0 ) THEN
359  READ( nin, fmt = * )thresh
360  IF( nout.EQ.13 )
361  $ thresh = thresh / ten
362  IF( nout.EQ.14 )
363  $ thresh = thresh / twenty
364  CALL sgebs2d( context, 'All', ' ', 1, 1, thresh, 1 )
365  ELSE
366  CALL sgebr2d( context, 'All', ' ', 1, 1, thresh, 1, 0, 0 )
367  END IF
368 *
369  order = 0
370 *
371  IF( iam.EQ.0 ) THEN
372  READ( nin, fmt = * )abstol
373  CALL sgebs2d( context, 'All', ' ', 1, 1, abstol, 1 )
374  ELSE
375  CALL sgebr2d( context, 'All', ' ', 1, 1, abstol, 1, 0, 0 )
376  END IF
377  IF( abstol.LT.0 )
378  $ abstol = two*pslamch( context, 'U' )
379 *
380  info = 0
381 *
382  70 CONTINUE
383  RETURN
384 *
385  9999 FORMAT( a20, ' is:', i5, ' must be between:', i5, ' and', i5 )
386  9998 FORMAT( a20, ' is:', i5, ' must be:', i5, ' or', i5 )
387  9997 FORMAT( a )
388  9996 FORMAT( a20, ' must be positive' )
389 *
390 * End of PSSEPINFO
391 *
392  END
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