ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
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  IF( nprocs.LT.1 ) 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  IF( nmat.GT.10 )
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  IF( nnb.GT.10 )
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  IF( ngrids.GT.10 )
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  IF( ngrids.GT.10 )
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  IF( nprocs.LT.1 )
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  IF( nout.NE.6 .AND. nout.NE.0 )
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
pcevcinfo
subroutine pcevcinfo(SUMMRY, NOUT, NMAT, NVAL, LDNVAL, NNB, NBVAL, LDNBVAL, NGRIDS, PVAL, LDPVAL, QVAL, LDQVAL, THRESH, WORK, IAM, NPROCS)
Definition: pcevcinfo.f:4
max
#define max(A, B)
Definition: pcgemr.c:180
icopy
subroutine icopy(N, SX, INCX, SY, INCY)
Definition: pblastst.f:1525
min
#define min(A, B)
Definition: pcgemr.c:181