OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
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.LE. IF( NPCOLS( I )0 )
280 $ INFO = -2
281 40 CONTINUE
282.EQ. IF( INFO-2 ) THEN
283.EQ. IF( IAM0 ) THEN
284 WRITE( NOUT, FMT = 9996 )' npcol'
285 END IF
286 GO TO 70
287 END IF
288*
289*
290.EQ. IF( IAM0 ) 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.LE. IF( NBS( I )0 )
298 $ INFO = -2
299 50 CONTINUE
300.EQ. IF( INFO-2 ) THEN
301.EQ. IF( IAM0 ) THEN
302 WRITE( NOUT, FMT = 9996 )' nb'
303 END IF
304 GO TO 70
305 END IF
306*
307*
308.EQ. IF( IAM0 ) 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.LT..OR..GT. IF( NMATTYPES1 NMATTYPESMAXSETSIZE ) THEN
315.EQ. IF( IAM0 ) 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.EQ. IF( IAM0 ) 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.LT..OR..GT. IF( MATTYPES( I )1 MATTYPES( I )MAXTYPE ) THEN
333.EQ. IF( IAM0 ) 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.EQ. IF( IAM0 ) 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.EQ. IF( ISUBTESTS2 ) THEN
353 SUBTESTS = 'y'
354 ELSE
355 SUBTESTS = 'n'
356 END IF
357*
358.EQ. IF( IAM0 ) THEN
359 READ( NIN, FMT = * )THRESH
360.EQ. IF( NOUT13 )
361 $ THRESH = THRESH / TEN
362.EQ. IF( NOUT14 )
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.EQ. IF( IAM0 ) 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.LT. IF( ABSTOL0 )
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
sgebs2d
subroutine sgebs2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1072
sgebr2d
subroutine sgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1113
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