ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pznepinfo.f
Go to the documentation of this file.
1  SUBROUTINE pznepinfo( SUMMRY, NOUT, NMAT, NVAL, LDNVAL, NNB,
2  $ NBVAL, LDNBVAL, NGRIDS, PVAL, LDPVAL, QVAL,
3  $ LDQVAL, THRESH, WORK, IAM, NPROCS )
4 *
5 * -- ScaLAPACK testing 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 * PZNEPINFO gets needed startup information for PZHSEQR drivers
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 complex
102 * single 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  DOUBLE PRECISION 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  DOUBLE PRECISION PDLAMCH
122  EXTERNAL PDLAMCH
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 = 'NEP.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 = pdlamch( 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 QSQ^H by Schur Decomposition.'
247  WRITE( nout, fmt = 9999 )usrinfo
248  WRITE( nout, fmt = * )
249  WRITE( nout, fmt = 9999 )'Tests of the parallel ' //
250  $ 'complex double precision Schur decomposition.'
251  WRITE( nout, fmt = 9999 )'The following scaled residual ' //
252  $ 'checks will be computed:'
253  WRITE( nout, fmt = 9999 )
254  $ ' Residual = ||H-QSQ^H|| / ' //
255  $ '(||H|| * eps * N )'
256  WRITE( nout, fmt = 9999 )
257  $ ' Orthogonality residual = ||I - Q^HQ|| / ' // '( eps * N )'
258  WRITE( nout, fmt = 9999 )'The matrix A is randomly ' //
259  $ 'generated for each test.'
260  WRITE( nout, fmt = * )
261  WRITE( nout, fmt = 9999 )'An explanation of the input/output '
262  $ // 'parameters follows:'
263  WRITE( nout, fmt = 9999 )
264  $ 'TIME : Indicates whether WALL or ' //
265  $ 'CPU time was used.'
266 *
267  WRITE( nout, fmt = 9999 )
268  $ 'N : The number of columns in the ' // 'matrix A.'
269  WRITE( nout, fmt = 9999 )
270  $ 'NB : The size of the square blocks the' //
271  $ ' matrix A is split into.'
272  WRITE( nout, fmt = 9999 )
273  $ 'P : The number of process rows.'
274  WRITE( nout, fmt = 9999 )
275  $ 'Q : The number of process columns.'
276  WRITE( nout, fmt = 9999 )
277  $ 'THRESH : If a residual value is less than' //
278  $ ' THRESH, CHECK is flagged as PASSED'
279  WRITE( nout, fmt = 9999 )
280  $ 'NEP time : Time in seconds to decompose the ' // ' matrix'
281  WRITE( nout, fmt = 9999 )'MFLOPS : Rate of execution '
282  WRITE( nout, fmt = * )
283  WRITE( nout, fmt = 9999 )
284  $ 'The following parameter values will be used:'
285  WRITE( nout, fmt = 9996 )'N ',
286  $ ( nval( i ), i = 1, min( nmat, 10 ) )
287  IF( nmat.GT.10 )
288  $ WRITE( nout, fmt = 9997 )( nval( i ), i = 11, nmat )
289  WRITE( nout, fmt = 9996 )'NB ',
290  $ ( nbval( i ), i = 1, min( nnb, 10 ) )
291  IF( nnb.GT.10 )
292  $ WRITE( nout, fmt = 9997 )( nbval( i ), i = 11, nnb )
293  WRITE( nout, fmt = 9996 )'P ',
294  $ ( pval( i ), i = 1, min( ngrids, 10 ) )
295  IF( ngrids.GT.10 )
296  $ WRITE( nout, fmt = 9997 )( pval( i ), i = 11, ngrids )
297  WRITE( nout, fmt = 9996 )'Q ',
298  $ ( qval( i ), i = 1, min( ngrids, 10 ) )
299  IF( ngrids.GT.10 )
300  $ WRITE( nout, fmt = 9997 )( qval( i ), i = 11, ngrids )
301  WRITE( nout, fmt = * )
302  WRITE( nout, fmt = 9995 )eps
303  WRITE( nout, fmt = 9998 )thresh
304 *
305  ELSE
306 *
307 * If in pvm, must participate setting up virtual machine
308 *
309  IF( nprocs.LT.1 )
310  $ CALL blacs_setup( iam, nprocs )
311 *
312 * Temporarily define blacs grid to include all processes so
313 * information can be broadcast to all processes
314 *
315  CALL blacs_get( -1, 0, ictxt )
316  CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
317 *
318 * Compute machine epsilon
319 *
320  eps = pdlamch( ictxt, 'eps' )
321 *
322  CALL sgebr2d( ictxt, 'All', ' ', 1, 1, thresh, 1, 0, 0 )
323  CALL igebr2d( ictxt, 'All', ' ', 3, 1, work, 3, 0, 0 )
324  nmat = work( 1 )
325  nnb = work( 2 )
326  ngrids = work( 3 )
327 *
328  i = nmat + nnb + 2*ngrids
329  CALL igebr2d( ictxt, 'All', ' ', i, 1, work, i, 0, 0 )
330  i = 1
331  CALL icopy( nmat, work( i ), 1, nval, 1 )
332  i = i + nmat
333  CALL icopy( nnb, work( i ), 1, nbval, 1 )
334  i = i + nnb
335  CALL icopy( ngrids, work( i ), 1, pval, 1 )
336  i = i + ngrids
337  CALL icopy( ngrids, work( i ), 1, qval, 1 )
338 *
339  END IF
340 *
341  CALL blacs_gridexit( ictxt )
342 *
343  RETURN
344 *
345  30 CONTINUE
346  WRITE( nout, fmt = 9993 )
347  CLOSE ( nin )
348  IF( nout.NE.6 .AND. nout.NE.0 )
349  $ CLOSE ( nout )
350  CALL blacs_abort( ictxt, 1 )
351 *
352  stop
353 *
354  9999 FORMAT( a )
355  9998 FORMAT( 'Routines pass computational tests if scaled residual ',
356  $ 'is less than ', g12.5 )
357  9997 FORMAT( ' ', 10i6 )
358  9996 FORMAT( 2x, a5, ' : ', 10i6 )
359  9995 FORMAT( 'Relative machine precision (eps) is taken to be ',
360  $ e18.6 )
361  9994 FORMAT( ' Number of values of ', 5a,
362  $ ' is less than 1 or greater ', 'than ', i2 )
363  9993 FORMAT( ' Illegal input in file ', 40a, '. Aborting run.' )
364  9992 FORMAT( ' Blocking size too small at ', i2, ' must be >=6.' )
365 *
366 * End of PZNEPINFO
367 *
368  END
max
#define max(A, B)
Definition: pcgemr.c:180
icopy
subroutine icopy(N, SX, INCX, SY, INCY)
Definition: pblastst.f:1525
pznepinfo
subroutine pznepinfo(SUMMRY, NOUT, NMAT, NVAL, LDNVAL, NNB, NBVAL, LDNBVAL, NGRIDS, PVAL, LDPVAL, QVAL, LDQVAL, THRESH, WORK, IAM, NPROCS)
Definition: pznepinfo.f:4
min
#define min(A, B)
Definition: pcgemr.c:181