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