SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ pssepinfo()

subroutine pssepinfo ( 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,
real  thresh,
integer  order,
real  abstol,
integer  info 
)

Definition at line 3 of file pssepinfo.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* 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*
pslamch
real function pslamch(ictxt, cmach)
Definition pcblastst.f:7455
lsame
logical function lsame(ca, cb)
Definition tools.f:1724
Here is the caller graph for this function: