OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pdsepinfo.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine pdsepinfo (context, iam, nin, nout, maxsetsize, nmatsizes, matsizes, nuplos, uplos, npconfigs, nprows, npcols, nbs, nmattypes, mattypes, maxtype, subtests, thresh, order, abstol, info)

Function/Subroutine Documentation

◆ pdsepinfo()

subroutine pdsepinfo ( integer context,
integer iam,
integer nin,
integer nout,
integer maxsetsize,
integer nmatsizes,
integer, dimension( maxsetsize ) matsizes,
integer nuplos,
character, dimension( 2 ) uplos,
integer npconfigs,
integer, dimension( maxsetsize ) nprows,
integer, dimension( maxsetsize ) npcols,
integer, dimension( maxsetsize ) nbs,
integer nmattypes,
integer, dimension( maxsetsize ) mattypes,
integer maxtype,
character subtests,
double precision thresh,
integer order,
double precision abstol,
integer info )

Definition at line 3 of file pdsepinfo.f.

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.EQ. IF( ISUBTESTS2 ) 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*
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53
dgebs2d
subroutine dgebs2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1082
dgebr2d
subroutine dgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1123
pdlamch
double precision function pdlamch(ictxt, cmach)
Definition pdblastst.f:6769