OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pcevcinfo.f
Go to the documentation of this file.
1 SUBROUTINE pcevcinfo( SUMMRY, NOUT, NMAT, NVAL, LDNVAL, NNB,
2 $ NBVAL, LDNBVAL, NGRIDS, PVAL, LDPVAL, QVAL,
3 $ LDQVAL, THRESH, WORK, IAM, NPROCS )
4*
5* -- ScaLAPACK routine (version 1.7) --
6* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
7* and University of California, Berkeley.
8* March, 2000
9*
10* .. Scalar Arguments ..
11 CHARACTER*( * ) SUMMRY
12 INTEGER IAM, LDNBVAL, LDNVAL, LDPVAL, LDQVAL, NGRIDS,
13 $ nmat, nnb, nout, nprocs
14 REAL THRESH
15* ..
16* .. Array Arguments ..
17 INTEGER NBVAL( LDNBVAL ), NVAL( LDNVAL ),
18 $ PVAL( LDPVAL ), QVAL( LDQVAL ), WORK( * )
19* ..
20*
21* Purpose
22* =======
23*
24* PCEVCINFO gets needed startup information for PCTREVC driver
25* and transmits it to all processes.
26*
27* Arguments
28* =========
29*
30* SUMMRY (global output) CHARACTER*(*)
31* Name of output (summary) file (if any). Only defined for
32* process 0.
33*
34* NOUT (global output) INTEGER
35* The unit number for output file. NOUT = 6, ouput to screen,
36* NOUT = 0, output to stderr. Only defined for process 0.
37*
38* NMAT (global output) INTEGER
39* The number of different values that can be used for N.
40*
41* NVAL (global output) INTEGER array, dimension (LDNVAL)
42* The values of N (the order of the matrix) to run the code
43* with.
44*
45* LDNVAL (global input) INTEGER
46* The maximum number of different values that can be used for
47* N, LDNVAL > = NMAT.
48*
49* NNB (global output) INTEGER
50* The number of different values that can be used for NB.
51*
52* NBVAL (global output) INTEGER array, dimension (LDNBVAL)
53* The values of NB (blocksize) to run the code with.
54*
55* LDNBVAL (global input) INTEGER
56* The maximum number of different values that can be used for
57* NB, LDNBVAL >= NNB.
58*
59* NGRIDS (global output) INTEGER
60* The number of different values that can be used for P & Q.
61*
62* PVAL (global output) INTEGER array, dimension (LDPVAL)
63* The values of P (number of process rows) to run the code
64* with.
65*
66* LDPVAL (global input) INTEGER
67* The maximum number of different values that can be used for
68* P, LDPVAL >= NGRIDS.
69*
70* QVAL (global output) INTEGER array, dimension (LDQVAL)
71* The values of Q (number of process columns) to run the code
72* with.
73*
74* LDQVAL (global input) INTEGER
75* The maximum number of different values that can be used for
76* Q, LDQVAL >= NGRIDS.
77*
78* THRESH (global output) REAL
79* Indicates what error checks shall be run and printed out:
80* < 0 : Perform no error checking
81* > 0 : report all residuals greater than THRESH
82*
83* WORK (local workspace) INTEGER array of dimension >=
84* MAX( 3, LDNVAL+LDNBVAL+LDPVAL+LDQVAL ), used to pack all
85* input arrays in order to send info in one message.
86*
87* IAM (local input) INTEGER
88* My process number.
89*
90* NPROCS (global input) INTEGER
91* The total number of processes.
92*
93* Further Details
94* ===============
95*
96* Implemented by: M. Fahey, June 2000
97*
98* ======================================================================
99*
100* Note: For packing the information we assumed that the length in bytes
101* ===== of an integer is equal to the length in bytes of a real single
102* precision.
103*
104* ======================================================================
105*
106* .. Parameters ..
107 INTEGER NIN
108 PARAMETER ( NIN = 11 )
109* ..
110* .. Local Scalars ..
111 CHARACTER*79 USRINFO
112 INTEGER I, ICTXT
113 REAL EPS
114* ..
115* .. External Subroutines ..
116 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
117 $ blacs_gridinit, blacs_setup, icopy, igebr2d,
118 $ igebs2d, sgebr2d, sgebs2d
119* ..
120* .. External Functions ..
121 REAL PSLAMCH
122 EXTERNAL PSLAMCH
123* ..
124* .. Intrinsic Functions ..
125 INTRINSIC max, min
126* ..
127* .. Executable Statements ..
128*
129* Process 0 reads the input data, broadcasts to other processes and
130* writes needed information to NOUT
131*
132 IF( iam.EQ.0 ) THEN
133*
134* Open file and skip data file header
135*
136 OPEN( nin, file = 'EVC.dat', status = 'OLD' )
137 READ( nin, fmt = * )summry
138 summry = ' '
139*
140* Read in user-supplied info about machine type, compiler, etc.
141*
142 READ( nin, fmt = 9999 )usrinfo
143*
144* Read name and unit number for summary output file
145*
146 READ( nin, fmt = * )summry
147 READ( nin, fmt = * )nout
148 IF( nout.NE.0 .AND. nout.NE.6 )
149 $ OPEN( nout, file = summry, status = 'UNKNOWN' )
150*
151* Read and check the parameter values for the tests.
152*
153* Get number of matrices and their dimensions
154*
155 READ( nin, fmt = * )nmat
156 IF( nmat.LT.1 .OR. nmat.GT.ldnval ) THEN
157 WRITE( nout, fmt = 9994 )'N', ldnval
158 GO TO 30
159 END IF
160 READ( nin, fmt = * )( nval( i ), i = 1, nmat )
161*
162* Get values of NB
163*
164 READ( nin, fmt = * )nnb
165 IF( nnb.GT.ldnbval ) THEN
166 WRITE( nout, fmt = 9994 )'NB', ldnbval
167 GO TO 30
168 END IF
169 READ( nin, fmt = * )( nbval( i ), i = 1, nnb )
170*
171 DO 10 i = 1, nnb
172 IF( nbval( i ).LT.6 ) THEN
173 WRITE( nout, fmt = 9992 )nbval( i )
174 GO TO 30
175 END IF
176 10 CONTINUE
177*
178* Get number of grids
179*
180 READ( nin, fmt = * )ngrids
181 IF( ngrids.LT.1 .OR. ngrids.GT.ldpval ) THEN
182 WRITE( nout, fmt = 9994 )'Grids', ldpval
183 GO TO 30
184 ELSE IF( ngrids.GT.ldqval ) THEN
185 WRITE( nout, fmt = 9994 )'grids', LDQVAL
186 GO TO 30
187 END IF
188*
189* Get values of P and Q
190*
191 READ( NIN, FMT = * )( PVAL( I ), I = 1, NGRIDS )
192 READ( NIN, FMT = * )( QVAL( I ), I = 1, NGRIDS )
193*
194* Get level of checking
195*
196 READ( NIN, FMT = * )THRESH
197*
198* Close input file
199*
200 CLOSE ( NIN )
201*
202* For pvm only: if virtual machine not set up, allocate it and
203* spawn the correct number of processes.
204*
205.LT. IF( NPROCS1 ) THEN
206 NPROCS = 0
207 DO 20 I = 1, NGRIDS
208 NPROCS = MAX( NPROCS, PVAL( I )*QVAL( I ) )
209 20 CONTINUE
210 CALL BLACS_SETUP( IAM, NPROCS )
211 END IF
212*
213* Temporarily define blacs grid to include all processes so
214* information can be broadcast to all processes
215*
216 CALL BLACS_GET( -1, 0, ICTXT )
217 CALL BLACS_GRIDINIT( ICTXT, 'row-major', 1, NPROCS )
218*
219* Compute machine epsilon
220*
221 EPS = PSLAMCH( ICTXT, 'eps' )
222*
223* Pack information arrays and broadcast
224*
225 CALL SGEBS2D( ICTXT, 'all', ' ', 1, 1, THRESH, 1 )
226*
227 WORK( 1 ) = NMAT
228 WORK( 2 ) = NNB
229 WORK( 3 ) = NGRIDS
230 CALL IGEBS2D( ICTXT, 'all', ' ', 3, 1, WORK, 3 )
231*
232 I = 1
233 CALL ICOPY( NMAT, NVAL, 1, WORK( I ), 1 )
234 I = I + NMAT
235 CALL ICOPY( NNB, NBVAL, 1, WORK( I ), 1 )
236 I = I + NNB
237 CALL ICOPY( NGRIDS, PVAL, 1, WORK( I ), 1 )
238 I = I + NGRIDS
239 CALL ICOPY( NGRIDS, QVAL, 1, WORK( I ), 1 )
240 I = I + NGRIDS - 1
241 CALL IGEBS2D( ICTXT, 'all', ' ', I, 1, WORK, I )
242*
243* regurgitate input
244*
245 WRITE( NOUT, FMT = 9999 )
246 $ 'scalapack nonsymmetric eigenvector calculation.'
247 WRITE( NOUT, FMT = 9999 )USRINFO
248 WRITE( NOUT, FMT = * )
249 WRITE( NOUT, FMT = 9999 )'tests of the parallel ' //
250 $ 'complex single precision eigenvector calculation.'
251 WRITE( NOUT, FMT = 9999 )'The following scaled residual ' //
252 $ 'checks will be computed:'
253 WRITE( NOUT, FMT = 9999 )
254 $ ' Residual = max( ||t*r-r*d||/(||h||*eps*n)' //
255 $ ' , ||t^h*l-l*d^h||/(||h||*eps*n) )'
256 WRITE( NOUT, FMT = 9999 )
257 $ ' normalization residual = max(max_j(max|r(j)|-1),' //
258 $ ' max_j(max|l(j)|-1))/(eps*n)'
259 WRITE( NOUT, FMT = 9999 )'the matrix a is randomly ' //
260 $ 'generated for each test.'
261 WRITE( NOUT, FMT = * )
262 WRITE( NOUT, FMT = 9999 )'an explanation of the input/output '
263 $ // 'parameters follows:'
264 WRITE( NOUT, FMT = 9999 )
265 $ 'time : indicates whether wall or ' //
266 $ 'cpu time was used.'
267*
268 WRITE( NOUT, FMT = 9999 )
269 $ 'n : the number of columns in the ' // 'matrix a.'
270 WRITE( NOUT, FMT = 9999 )
271 $ 'nb : the size of the square blocks the' //
272 $ ' matrix a is split into.'
273 WRITE( NOUT, FMT = 9999 )
274 $ 'p : the number of process rows.'
275 WRITE( NOUT, FMT = 9999 )
276 $ 'q : the number of process columns.'
277 WRITE( NOUT, FMT = 9999 )
278 $ 'thresh : If a residual value is less than' //
279 $ ' thresh, check is flagged as passed'
280 WRITE( NOUT, FMT = 9999 )
281 $ 'nep time : time in seconds to decompose the ' // ' matrix'
282 WRITE( NOUT, FMT = 9999 )'mflops : rate of execution '
283 WRITE( NOUT, FMT = * )
284 WRITE( NOUT, FMT = 9999 )
285 $ 'the following parameter values will be used:'
286 WRITE( NOUT, FMT = 9996 )'n ',
287 $ ( NVAL( I ), I = 1, MIN( NMAT, 10 ) )
288.GT. IF( NMAT10 )
289 $ WRITE( NOUT, FMT = 9997 )( NVAL( I ), I = 11, NMAT )
290 WRITE( NOUT, FMT = 9996 )'nb ',
291 $ ( NBVAL( I ), I = 1, MIN( NNB, 10 ) )
292.GT. IF( NNB10 )
293 $ WRITE( NOUT, FMT = 9997 )( NBVAL( I ), I = 11, NNB )
294 WRITE( NOUT, FMT = 9996 )'p ',
295 $ ( PVAL( I ), I = 1, MIN( NGRIDS, 10 ) )
296.GT. IF( NGRIDS10 )
297 $ WRITE( NOUT, FMT = 9997 )( PVAL( I ), I = 11, NGRIDS )
298 WRITE( NOUT, FMT = 9996 )'q ',
299 $ ( QVAL( I ), I = 1, MIN( NGRIDS, 10 ) )
300.GT. IF( NGRIDS10 )
301 $ WRITE( NOUT, FMT = 9997 )( QVAL( I ), I = 11, NGRIDS )
302 WRITE( NOUT, FMT = * )
303 WRITE( NOUT, FMT = 9995 )EPS
304 WRITE( NOUT, FMT = 9998 )THRESH
305*
306 ELSE
307*
308* If in pvm, must participate setting up virtual machine
309*
310.LT. IF( NPROCS1 )
311 $ CALL BLACS_SETUP( IAM, NPROCS )
312*
313* Temporarily define blacs grid to include all processes so
314* information can be broadcast to all processes
315*
316 CALL BLACS_GET( -1, 0, ICTXT )
317 CALL BLACS_GRIDINIT( ICTXT, 'row-major', 1, NPROCS )
318*
319* Compute machine epsilon
320*
321 EPS = PSLAMCH( ICTXT, 'eps' )
322*
323 CALL SGEBR2D( ICTXT, 'all', ' ', 1, 1, THRESH, 1, 0, 0 )
324 CALL IGEBR2D( ICTXT, 'all', ' ', 3, 1, WORK, 3, 0, 0 )
325 NMAT = WORK( 1 )
326 NNB = WORK( 2 )
327 NGRIDS = WORK( 3 )
328*
329 I = NMAT + NNB + 2*NGRIDS
330 CALL IGEBR2D( ICTXT, 'all', ' ', I, 1, WORK, I, 0, 0 )
331 I = 1
332 CALL ICOPY( NMAT, WORK( I ), 1, NVAL, 1 )
333 I = I + NMAT
334 CALL ICOPY( NNB, WORK( I ), 1, NBVAL, 1 )
335 I = I + NNB
336 CALL ICOPY( NGRIDS, WORK( I ), 1, PVAL, 1 )
337 I = I + NGRIDS
338 CALL ICOPY( NGRIDS, WORK( I ), 1, QVAL, 1 )
339*
340 END IF
341*
342 CALL BLACS_GRIDEXIT( ICTXT )
343*
344 RETURN
345*
346 30 CONTINUE
347 WRITE( NOUT, FMT = 9993 )
348 CLOSE ( NIN )
349.NE..AND..NE. IF( NOUT6 NOUT0 )
350 $ CLOSE ( NOUT )
351 CALL BLACS_ABORT( ICTXT, 1 )
352*
353 STOP
354*
355 9999 FORMAT( A )
356 9998 FORMAT( 'routines pass computational tests if scaled residual ',
357 $ 'is less than ', G12.5 )
358 9997 FORMAT( ' ', 10I6 )
359 9996 FORMAT( 2X, A5, ' : ', 10I6 )
360 9995 FORMAT( 'relative machine precision(eps) is taken to be ',
361 $ E18.6 )
362 9994 FORMAT( ' number of values of ', 5A,
363 $ ' is less than 1 or greater ', 'than ', I2 )
364 9993 FORMAT( ' illegal input in file ', 40A, '. aborting run.' )
365 9992 FORMAT( ' blocking size too small at ', I2, ' must be >=6.' )
366*
367* End of PCEVCINFO
368*
369 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
pcevcinfo
subroutine pcevcinfo(summry, nout, nmat, nval, ldnval, nnb, nbval, ldnbval, ngrids, pval, ldpval, qval, ldqval, thresh, work, iam, nprocs)
Definition pcevcinfo.f:4
split
void split(mapping_t *, PORD_INT, PORD_INT, PORD_INT, PORD_INT *, PORD_INT *, FLOAT *, PORD_INT)