OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pcluinfo.f
Go to the documentation of this file.
1 SUBROUTINE pcluinfo( SUMMRY, NOUT, NMAT, MVAL, NVAL, LDNVAL, NNB,
2 $ NBVAL, LDNBVAL, NNR, NRVAL, LDNRVAL, NNBR,
3 $ NBRVAL, LDNBRVAL, NGRIDS, PVAL, LDPVAL, QVAL,
4 $ LDQVAL, THRESH, EST, WORK, IAM, NPROCS )
5*
6* -- ScaLAPACK routine (version 1.7) --
7* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
8* and University of California, Berkeley.
9* May 1, 1997
10*
11* .. Scalar Arguments ..
12 LOGICAL EST
13 CHARACTER*( * ) SUMMRY
14 INTEGER IAM, LDNBRVAL, LDNBVAL, LDNRVAL, LDNVAL,
15 $ ldpval, ldqval, ngrids, nmat, nnb, nnbr,
16 $ nprocs, nnr, nout
17 REAL THRESH
18* ..
19* .. Array Arguments ..
20 INTEGER MVAL( LDNVAL ), NBRVAL( LDNBRVAL ),
21 $ NBVAL( LDNBVAL ), NRVAL( LDNRVAL ),
22 $ NVAL( LDNVAL ), PVAL( LDPVAL ), QVAL( LDQVAL ),
23 $ work( * )
24* ..
25*
26* Purpose
27* =======
28*
29* PCLUINFO gets needed startup information for LU factorization
30* and transmits it to all processes.
31*
32* Arguments
33* =========
34*
35* SUMMRY (global output) CHARACTER*(*)
36* Name of output (summary) file (if any). Only defined for
37* process 0.
38*
39* NOUT (global output) INTEGER
40* The unit number for output file. NOUT = 6, ouput to screen,
41* NOUT = 0, output to stderr. Only defined for process 0.
42*
43* NMAT (global output) INTEGER
44* The number of different values that can be used for M and N.
45*
46* MVAL (global output) INTEGER array, dimension (LDNVAL)
47* The values of M (number of rows in matrix) to run the code
48* with.
49*
50* NVAL (global output) INTEGER array, dimension (LDNVAL)
51* The values of N (number of columns in matrix) to run the
52* code with.
53*
54* LDNVAL (global input) INTEGER
55* The maximum number of different values that can be used for
56* M and N, LDNVAL > = NMAT.
57*
58* NNB (global output) INTEGER
59* The number of different values that can be used for NB.
60*
61* NBVAL (global output) INTEGER array, dimension (LDNBVAL)
62* The values of NB (blocksize) to run the code with.
63*
64* LDNBVAL (global input) INTEGER
65* The maximum number of different values that can be used for
66* NB, LDNBVAL >= NNB.
67*
68* NNR (global output) INTEGER
69* The number of different values that can be used for NRHS.
70*
71* NRVAL (global output) INTEGER array, dimension(LDNRVAL)
72* The values of NRHS (# of Right Hand Sides) to run the code
73* with.
74*
75* LDNRVAL (global input) INTEGER
76* The maximum number of different values that can be used for
77* NRHS, LDNRVAL >= NNR.
78*
79* NNBR (global output) INTEGER
80* The number of different values that can be used for NBRHS.
81*
82* NBRVAL (global output) INTEGER array, dimension (LDNBRVAL)
83* The values of NBRHS (RHS blocksize) to run the code with.
84*
85* LDNBRVAL (global input) INTEGER
86* The maximum number of different values that can be used for
87* NBRHS, LDNBRVAL >= NBRVAL.
88*
89* NGRIDS (global output) INTEGER
90* The number of different values that can be used for P & Q.
91*
92* PVAL (global output) INTEGER array, dimension (LDPVAL)
93* The values of P (number of process rows) to run the code
94* with.
95*
96* LDPVAL (global input) INTEGER
97* The maximum number of different values that can be used for
98* P, LDPVAL >= NGRIDS.
99*
100* QVAL (global output) INTEGER array, dimension (LDQVAL)
101* The values of Q (number of process columns) to run the code
102* with.
103*
104* LDQVAL (global input) INTEGER
105* The maximum number of different values that can be used for
106* Q, LDQVAL >= NGRIDS.
107*
108* THRESH (global output) REAL
109* Indicates what error checks shall be run and printed out:
110* < 0 : Perform no error checking
111* > 0 : report all residuals greater than THRESH, perform
112* factor check only if solve check fails
113*
114* EST (global output) LOGICAL
115* Flag indicating if condition estimation and iterative
116* refinement routines are to be exercised.
117*
118* WORK (local workspace) INTEGER array of dimension >=
119* MAX( 6, 2*LDNVAL+LDNBVAL+LDNRVAL+LDNBRVAL+LDPVAL+LDQVAL )
120* Used to pack all input arrays in order to send info in one
121* message.
122*
123* IAM (local input) INTEGER
124* My process number.
125*
126* NPROCS (global input) INTEGER
127* The total number of processes.
128*
129* ======================================================================
130*
131* Note: For packing the information we assumed that the length in bytes
132* ===== of an integer is equal to the length in bytes of a real single
133* precision.
134*
135* ======================================================================
136*
137* .. Parameters ..
138 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
139 $ LLD_, MB_, M_, NB_, N_, RSRC_
140 PARAMETER ( BLOCK_CYCLIC_2D = 1, dlen_ = 9, dtype_ = 1,
141 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
142 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
143 INTEGER NIN
144 PARAMETER ( NIN = 11 )
145* ..
146* .. Local Scalars ..
147 CHARACTER*79 USRINFO
148 INTEGER I, ICTXT
149 REAL EPS
150* ..
151* .. External Subroutines ..
152 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
153 $ blacs_gridinit, blacs_setup, icopy, igebr2d,
154 $ igebs2d, sgebr2d, sgebs2d
155* ..
156* .. External Functions ..
157 REAL PSLAMCH
158 EXTERNAL PSLAMCH
159* ..
160* .. Intrinsic Functions ..
161 INTRINSIC max, min
162* ..
163* .. Executable Statements ..
164*
165* Process 0 reads the input data, broadcasts to other processes and
166* writes needed information to NOUT
167*
168 IF( iam.EQ.0 ) THEN
169*
170* Open file and skip data file header
171*
172 OPEN( nin, file='LU.dat', status='OLD' )
173 READ( nin, fmt = * ) summry
174 summry = ' '
175*
176* Read in user-supplied info about machine type, compiler, etc.
177*
178 READ( nin, fmt = 9999 ) usrinfo
179*
180* Read name and unit number for summary output file
181*
182 READ( nin, fmt = * ) summry
183 READ( nin, fmt = * ) nout
184 IF( nout.NE.0 .AND. nout.NE.6 )
185 $ OPEN( nout, file = summry, status = 'unknown' )
186*
187* Read and check the parameter values for the tests.
188*
189* Get number of matrices and their dimensions
190*
191 READ( NIN, FMT = * ) NMAT
192.LT..OR..GT. IF( NMAT1 NMATLDNVAL ) THEN
193 WRITE( NOUT, FMT = 9994 ) 'n', LDNVAL
194 GO TO 20
195 END IF
196 READ( NIN, FMT = * ) ( MVAL( I ), I = 1, NMAT )
197 READ( NIN, FMT = * ) ( NVAL( I ), I = 1, NMAT )
198*
199* Get values of NB
200*
201 READ( NIN, FMT = * ) NNB
202.LT..OR..GT. IF( NNB1 NNBLDNBVAL ) THEN
203 WRITE( NOUT, FMT = 9994 ) 'nb', LDNBVAL
204 GO TO 20
205 END IF
206 READ( NIN, FMT = * ) ( NBVAL( I ), I = 1, NNB )
207*
208* Get values of NRHS
209*
210 READ( NIN, FMT = * ) NNR
211.LT..OR..GT. IF( NNR1 NNRLDNRVAL ) THEN
212 WRITE( NOUT, FMT = 9994 ) 'nrhs', LDNRVAL
213 GO TO 20
214 END IF
215 READ( NIN, FMT = * ) ( NRVAL( I ), I = 1, NNR )
216*
217* Get values of NBRHS
218*
219 READ( NIN, FMT = * ) NNBR
220.LT..OR..GT. IF( NNBR1 NNBRLDNBRVAL ) THEN
221 WRITE( NOUT, FMT = 9994 ) 'nbrhs', LDNBRVAL
222 GO TO 20
223 END IF
224 READ( NIN, FMT = * ) ( NBRVAL( I ), I = 1, NNBR )
225*
226* Get number of grids
227*
228 READ( NIN, FMT = * ) NGRIDS
229.LT..OR..GT. IF( NGRIDS1 NGRIDSLDPVAL ) THEN
230 WRITE( NOUT, FMT = 9994 ) 'grids', LDPVAL
231 GO TO 20
232.GT. ELSE IF( NGRIDSLDQVAL ) THEN
233 WRITE( NOUT, FMT = 9994 ) 'grids', LDQVAL
234 GO TO 20
235 END IF
236*
237* Get values of P and Q
238*
239 READ( NIN, FMT = * ) ( PVAL( I ), I = 1, NGRIDS )
240 READ( NIN, FMT = * ) ( QVAL( I ), I = 1, NGRIDS )
241*
242* Get level of checking
243*
244 READ( NIN, FMT = * ) THRESH
245*
246* Read the flag that indicates whether to test the condition
247* estimation and iterative refinement routines.
248*
249 READ( NIN, FMT = * ) EST
250*
251* Close input file
252*
253 CLOSE( NIN )
254*
255* For pvm only: if virtual machine not set up, allocate it and
256* spawn the correct number of processes.
257*
258.LT. IF( NPROCS1 ) THEN
259 NPROCS = 0
260 DO 10 I = 1, NGRIDS
261 NPROCS = MAX( NPROCS, PVAL( I )*QVAL( I ) )
262 10 CONTINUE
263 CALL BLACS_SETUP( IAM, NPROCS )
264 END IF
265*
266* Temporarily define blacs grid to include all processes so
267* information can be broadcast to all processes
268*
269 CALL BLACS_GET( -1, 0, ICTXT )
270 CALL BLACS_GRIDINIT( ICTXT, 'row-major', 1, NPROCS )
271*
272* Compute machine epsilon
273*
274 EPS = PSLAMCH( ICTXT, 'eps' )
275*
276* Pack information arrays and broadcast
277*
278 CALL SGEBS2D( ICTXT, 'all', ' ', 1, 1, THRESH, 1 )
279*
280 WORK( 1 ) = NMAT
281 WORK( 2 ) = NNB
282 WORK( 3 ) = NNR
283 WORK( 4 ) = NNBR
284 WORK( 5 ) = NGRIDS
285 IF( EST ) THEN
286 WORK( 6 ) = 1
287 ELSE
288 WORK( 6 ) = 0
289 END IF
290 CALL IGEBS2D( ICTXT, 'all', ' ', 6, 1, WORK, 6 )
291*
292 I = 1
293 CALL ICOPY( NMAT, MVAL, 1, WORK( I ), 1 )
294 I = I + NMAT
295 CALL ICOPY( NMAT, NVAL, 1, WORK( I ), 1 )
296 I = I + NMAT
297 CALL ICOPY( NNB, NBVAL, 1, WORK( I ), 1 )
298 I = I + NNB
299 CALL ICOPY( NNR, NRVAL, 1, WORK( I ), 1 )
300 I = I + NNR
301 CALL ICOPY( NNBR, NBRVAL, 1, WORK( I ), 1 )
302 I = I + NNBR
303 CALL ICOPY( NGRIDS, PVAL, 1, WORK( I ), 1 )
304 I = I + NGRIDS
305 CALL ICOPY( NGRIDS, QVAL, 1, WORK( I ), 1 )
306 I = I + NGRIDS - 1
307 CALL IGEBS2D( ICTXT, 'all', ' ', I, 1, WORK, I )
308*
309* regurgitate input
310*
311 WRITE( NOUT, FMT = 9999 )
312 $ 'scalapack ax=b by lu factorization.'
313 WRITE( NOUT, FMT = 9999 ) USRINFO
314 WRITE( NOUT, FMT = * )
315 WRITE( NOUT, FMT = 9999 )
316 $ 'tests of the parallel '//
317 $ 'complex single precision LU factorization '//
318 $ 'and solve.'
319 WRITE( NOUT, FMT = 9999 )
320 $ 'The following scaled residual '//
321 $ 'checks will be computed:'
322 WRITE( NOUT, FMT = 9999 )
323 $ ' Solve residual = ||ax - b|| / '//
324 $ '(||x|| * ||a|| * eps * n)'
325 WRITE( NOUT, FMT = 9999 )
326 $ ' factorization residual = ||a - lu|| / '//
327 $ '(||a|| * eps * n)'
328 WRITE( NOUT, FMT = 9999 )
329 $ 'the matrix a is randomly '//
330 $ 'generated for each test.'
331 WRITE( NOUT, FMT = * )
332 WRITE( NOUT, FMT = 9999 )
333 $ 'an explanation of the input/output '//
334 $ 'parameters follows:'
335 WRITE( NOUT, FMT = 9999 )
336 $ 'time : indicates whether wall or '//
337 $ 'cpu time was used.'
338*
339 WRITE( NOUT, FMT = 9999 )
340 $ 'm : the number of rows in the '//
341 $ 'matrix a.'
342 WRITE( NOUT, FMT = 9999 )
343 $ 'n : the number of columns in the '//
344 $ 'matrix a.'
345 WRITE( NOUT, FMT = 9999 )
346 $ 'nb : the size of the square blocks the'//
347 $ ' matrix a is split into.'
348 WRITE( NOUT, FMT = 9999 )
349 $ 'nrhs : the total number of rhs to solve'//
350 $ ' for.'
351 WRITE( NOUT, FMT = 9999 )
352 $ 'nbrhs : the number of rhs to be put on '//
353 $ 'a column of processes before going'
354 WRITE( NOUT, FMT = 9999 )
355 $ ' on to the next column of processes.'
356 WRITE( NOUT, FMT = 9999 )
357 $ 'p : the number of process rows.'
358 WRITE( NOUT, FMT = 9999 )
359 $ 'q : the number of process columns.'
360 WRITE( NOUT, FMT = 9999 )
361 $ 'thresh : If a residual value is less than'//
362 $ ' thresh, check is flagged as passed'
363 WRITE( NOUT, FMT = 9999 )
364 $ 'lu time : time in seconds to factor the'//
365 $ ' matrix'
366 WRITE( NOUT, FMT = 9999 )
367 $ 'sol time: time in seconds to solve the'//
368 $ ' system.'
369 WRITE( NOUT, FMT = 9999 )
370 $ 'mflops : rate of execution for factor '//
371 $ 'and solve.'
372 WRITE( NOUT, FMT = * )
373 WRITE( NOUT, FMT = 9999 )
374 $ 'the following parameter values will be used:'
375 WRITE( NOUT, FMT = 9996 )
376 $ 'm ', ( MVAL(I), I = 1, MIN(NMAT, 10) )
377.GT. IF( NMAT10 )
378 $ WRITE( NOUT, FMT = 9997 ) ( MVAL(I), I = 11, NMAT )
379 WRITE( NOUT, FMT = 9996 )
380 $ 'n ', ( NVAL(I), I = 1, MIN(NMAT, 10) )
381.GT. IF( NMAT10 )
382 $ WRITE( NOUT, FMT = 9997 ) ( NVAL(I), I = 11, NMAT )
383 WRITE( NOUT, FMT = 9996 )
384 $ 'nb ', ( NBVAL(I), I = 1, MIN(NNB, 10) )
385.GT. IF( NNB10 )
386 $ WRITE( NOUT, FMT = 9997 ) ( NBVAL(I), I = 11, NNB )
387 WRITE( NOUT, FMT = 9996 )
388 $ 'nrhs ', ( NRVAL(I), I = 1, MIN(NNR, 10) )
389.GT. IF( NNR10 )
390 $ WRITE( NOUT, FMT = 9997 ) ( NRVAL(I), I = 11, NNR )
391 WRITE( NOUT, FMT = 9996 )
392 $ 'nbrhs', ( NBRVAL(I), I = 1, MIN(NNBR, 10) )
393.GT. IF( NNBR10 )
394 $ WRITE( NOUT, FMT = 9997 ) ( NBRVAL(I), I = 11, NNBR )
395 WRITE( NOUT, FMT = 9996 )
396 $ 'p ', ( PVAL(I), I = 1, MIN(NGRIDS, 10) )
397.GT. IF( NGRIDS10 )
398 $ WRITE( NOUT, FMT = 9997) ( PVAL(I), I = 11, NGRIDS )
399 WRITE( NOUT, FMT = 9996 )
400 $ 'q ', ( QVAL(I), I = 1, MIN(NGRIDS, 10) )
401.GT. IF( NGRIDS10 )
402 $ WRITE( NOUT, FMT = 9997 ) ( QVAL(I), I = 11, NGRIDS )
403 WRITE( NOUT, FMT = * )
404 WRITE( NOUT, FMT = 9995 ) EPS
405 WRITE( NOUT, FMT = 9998 ) THRESH
406*
407 ELSE
408*
409* If in pvm, must participate setting up virtual machine
410*
411.LT. IF( NPROCS1 )
412 $ CALL BLACS_SETUP( IAM, NPROCS )
413*
414* Temporarily define blacs grid to include all processes so
415* information can be broadcast to all processes
416*
417 CALL BLACS_GET( -1, 0, ICTXT )
418 CALL BLACS_GRIDINIT( ICTXT, 'row-major', 1, NPROCS )
419*
420* Compute machine epsilon
421*
422 EPS = PSLAMCH( ICTXT, 'eps' )
423*
424 CALL SGEBR2D( ICTXT, 'all', ' ', 1, 1, THRESH, 1, 0, 0 )
425 CALL IGEBR2D( ICTXT, 'all', ' ', 6, 1, WORK, 6, 0, 0 )
426 NMAT = WORK( 1 )
427 NNB = WORK( 2 )
428 NNR = WORK( 3 )
429 NNBR = WORK( 4 )
430 NGRIDS = WORK( 5 )
431.EQ. IF( WORK( 6 )1 ) THEN
432 EST = .TRUE.
433 ELSE
434 EST = .FALSE.
435 END IF
436*
437 I = 2*NMAT + NNB + NNR + NNBR + 2*NGRIDS
438 CALL IGEBR2D( ICTXT, 'all', ' ', I, 1, WORK, I, 0, 0 )
439 I = 1
440 CALL ICOPY( NMAT, WORK( I ), 1, MVAL, 1 )
441 I = I + NMAT
442 CALL ICOPY( NMAT, WORK( I ), 1, NVAL, 1 )
443 I = I + NMAT
444 CALL ICOPY( NNB, WORK( I ), 1, NBVAL, 1 )
445 I = I + NNB
446 CALL ICOPY( NNR, WORK( I ), 1, NRVAL, 1 )
447 I = I + NNR
448 CALL ICOPY( NNBR, WORK( I ), 1, NBRVAL, 1 )
449 I = I + NNBR
450 CALL ICOPY( NGRIDS, WORK( I ), 1, PVAL, 1 )
451 I = I + NGRIDS
452 CALL ICOPY( NGRIDS, WORK( I ), 1, QVAL, 1 )
453*
454 END IF
455*
456 CALL BLACS_GRIDEXIT( ICTXT )
457*
458 RETURN
459*
460 20 WRITE( NOUT, FMT = 9993 )
461 CLOSE( NIN )
462.NE..AND..NE. IF( NOUT6 NOUT0 )
463 $ CLOSE( NOUT )
464 CALL BLACS_ABORT( ICTXT, 1 )
465*
466 STOP
467*
468 9999 FORMAT( A )
469 9998 FORMAT( 'routines pass computational tests if scaled residual ',
470 $ 'is less than ', G12.5 )
471 9997 FORMAT( ' ', 10I6 )
472 9996 FORMAT( 2X, A5, ' : ', 10I6 )
473 9995 FORMAT( 'relative machine precision(eps) is taken to be ',
474 $ E18.6 )
475 9994 FORMAT( ' number of values of ',5A, ' is less than 1 or greater ',
476 $ 'than ', I2 )
477 9993 FORMAT( ' illegal input in file ',40A,'. aborting run.' )
478*
479* End of PCLUINFO
480*
481 END
the
end diagonal values have been computed in the(sparse) matrix id.SOL
icopy
subroutine icopy(n, sx, incx, sy, incy)
ICOPY
Definition icopy.f:75
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
sgebs2d
subroutine sgebs2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1072
blacs_gridinit
subroutine blacs_gridinit(cntxt, c, nprow, npcol)
Definition mpi.f:745
sgebr2d
subroutine sgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1113
blacs_gridexit
subroutine blacs_gridexit(cntxt)
Definition mpi.f:762
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
pcluinfo
subroutine pcluinfo(summry, nout, nmat, mval, nval, ldnval, nnb, nbval, ldnbval, nnr, nrval, ldnrval, nnbr, nbrval, ldnbrval, ngrids, pval, ldpval, qval, ldqval, thresh, est, work, iam, nprocs)
Definition pcluinfo.f:5
split
void split(mapping_t *, PORD_INT, PORD_INT, PORD_INT, PORD_INT *, PORD_INT *, FLOAT *, PORD_INT)