ScaLAPACK  2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
pcevcinfo.f
Go to the documentation of this file.
00001       SUBROUTINE PCEVCINFO( SUMMRY, NOUT, NMAT, NVAL, LDNVAL, NNB,
00002      $                      NBVAL, LDNBVAL, NGRIDS, PVAL, LDPVAL, QVAL,
00003      $                      LDQVAL, THRESH, WORK, IAM, NPROCS )
00004 *
00005 *  -- ScaLAPACK routine (version 1.7) --
00006 *     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
00007 *     and University of California, Berkeley.
00008 *     March, 2000
00009 *
00010 *     .. Scalar Arguments ..
00011       CHARACTER*( * )    SUMMRY
00012       INTEGER            IAM, LDNBVAL, LDNVAL, LDPVAL, LDQVAL, NGRIDS,
00013      $                   NMAT, NNB, NOUT, NPROCS
00014       REAL               THRESH
00015 *     ..
00016 *     .. Array Arguments ..
00017       INTEGER            NBVAL( LDNBVAL ), NVAL( LDNVAL ),
00018      $                   PVAL( LDPVAL ), QVAL( LDQVAL ), WORK( * )
00019 *     ..
00020 *
00021 *  Purpose
00022 *  =======
00023 *
00024 *  PCEVCINFO gets needed startup information for PCTREVC driver
00025 *  and transmits it to all processes.
00026 *
00027 *  Arguments
00028 *  =========
00029 *
00030 *  SUMMRY   (global output) CHARACTER*(*)
00031 *           Name of output (summary) file (if any). Only defined for
00032 *           process 0.
00033 *
00034 *  NOUT     (global output) INTEGER
00035 *           The unit number for output file. NOUT = 6, ouput to screen,
00036 *           NOUT = 0, output to stderr.  Only defined for process 0.
00037 *
00038 *  NMAT     (global output) INTEGER
00039 *           The number of different values that can be used for N.
00040 *
00041 *  NVAL     (global output) INTEGER array, dimension (LDNVAL)
00042 *           The values of N (the order of the matrix) to run the code
00043 *           with.
00044 *
00045 *  LDNVAL   (global input) INTEGER
00046 *           The maximum number of different values that can be used for
00047 *           N, LDNVAL > =  NMAT.
00048 *
00049 *  NNB      (global output) INTEGER
00050 *           The number of different values that can be used for NB.
00051 *
00052 *  NBVAL    (global output) INTEGER array, dimension (LDNBVAL)
00053 *           The values of NB (blocksize) to run the code with.
00054 *
00055 *  LDNBVAL  (global input) INTEGER
00056 *           The maximum number of different values that can be used for
00057 *           NB, LDNBVAL >= NNB.
00058 *
00059 *  NGRIDS   (global output) INTEGER
00060 *           The number of different values that can be used for P & Q.
00061 *
00062 *  PVAL     (global output) INTEGER array, dimension (LDPVAL)
00063 *           The values of P (number of process rows) to run the code
00064 *           with.
00065 *
00066 *  LDPVAL   (global input) INTEGER
00067 *           The maximum number of different values that can be used for
00068 *           P, LDPVAL >= NGRIDS.
00069 *
00070 *  QVAL     (global output) INTEGER array, dimension (LDQVAL)
00071 *           The values of Q (number of process columns) to run the code
00072 *           with.
00073 *
00074 *  LDQVAL   (global input) INTEGER
00075 *           The maximum number of different values that can be used for
00076 *           Q, LDQVAL >= NGRIDS.
00077 *
00078 *  THRESH   (global output) REAL
00079 *           Indicates what error checks shall be run and printed out:
00080 *           < 0 : Perform no error checking
00081 *           > 0 : report all residuals greater than THRESH
00082 *
00083 *  WORK     (local workspace) INTEGER array of dimension >=
00084 *           MAX( 3, LDNVAL+LDNBVAL+LDPVAL+LDQVAL ), used to pack all
00085 *           input arrays in order to send info in one message.
00086 *
00087 *  IAM      (local input) INTEGER
00088 *           My process number.
00089 *
00090 *  NPROCS   (global input) INTEGER
00091 *           The total number of processes.
00092 *
00093 *  Further Details
00094 *  ===============
00095 *
00096 *  Implemented by:  M. Fahey, June 2000
00097 *
00098 * ======================================================================
00099 *
00100 * Note: For packing the information we assumed that the length in bytes
00101 * ===== of an integer is equal to the length in bytes of a real single
00102 *       precision.
00103 *
00104 * ======================================================================
00105 *
00106 *     .. Parameters ..
00107       INTEGER            NIN
00108       PARAMETER          ( NIN = 11 )
00109 *     ..
00110 *     .. Local Scalars ..
00111       CHARACTER*79       USRINFO
00112       INTEGER            I, ICTXT
00113       REAL   EPS
00114 *     ..
00115 *     .. External Subroutines ..
00116       EXTERNAL           BLACS_ABORT, BLACS_GET, BLACS_GRIDEXIT,
00117      $                   BLACS_GRIDINIT, BLACS_SETUP, ICOPY, IGEBR2D,
00118      $                   IGEBS2D, SGEBR2D, SGEBS2D
00119 *     ..
00120 *     .. External Functions ..
00121       REAL               PSLAMCH
00122       EXTERNAL           PSLAMCH
00123 *     ..
00124 *     .. Intrinsic Functions ..
00125       INTRINSIC          MAX, MIN
00126 *     ..
00127 *     .. Executable Statements ..
00128 *
00129 *     Process 0 reads the input data, broadcasts to other processes and
00130 *     writes needed information to NOUT
00131 *
00132       IF( IAM.EQ.0 ) THEN
00133 *
00134 *        Open file and skip data file header
00135 *
00136          OPEN( NIN, FILE = 'EVC.dat', STATUS = 'OLD' )
00137          READ( NIN, FMT = * )SUMMRY
00138          SUMMRY = ' '
00139 *
00140 *        Read in user-supplied info about machine type, compiler, etc.
00141 *
00142          READ( NIN, FMT = 9999 )USRINFO
00143 *
00144 *        Read name and unit number for summary output file
00145 *
00146          READ( NIN, FMT = * )SUMMRY
00147          READ( NIN, FMT = * )NOUT
00148          IF( NOUT.NE.0 .AND. NOUT.NE.6 )
00149      $      OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
00150 *
00151 *        Read and check the parameter values for the tests.
00152 *
00153 *        Get number of matrices and their dimensions
00154 *
00155          READ( NIN, FMT = * )NMAT
00156          IF( NMAT.LT.1 .OR. NMAT.GT.LDNVAL ) THEN
00157             WRITE( NOUT, FMT = 9994 )'N', LDNVAL
00158             GO TO 30
00159          END IF
00160          READ( NIN, FMT = * )( NVAL( I ), I = 1, NMAT )
00161 *
00162 *        Get values of NB
00163 *
00164          READ( NIN, FMT = * )NNB
00165          IF( NNB.GT.LDNBVAL ) THEN
00166             WRITE( NOUT, FMT = 9994 )'NB', LDNBVAL
00167             GO TO 30
00168          END IF
00169          READ( NIN, FMT = * )( NBVAL( I ), I = 1, NNB )
00170 *
00171          DO 10 I = 1, NNB
00172             IF( NBVAL( I ).LT.6 ) THEN
00173                WRITE( NOUT, FMT = 9992 )NBVAL( I )
00174                GO TO 30
00175             END IF
00176    10    CONTINUE
00177 *
00178 *        Get number of grids
00179 *
00180          READ( NIN, FMT = * )NGRIDS
00181          IF( NGRIDS.LT.1 .OR. NGRIDS.GT.LDPVAL ) THEN
00182             WRITE( NOUT, FMT = 9994 )'Grids', LDPVAL
00183             GO TO 30
00184          ELSE IF( NGRIDS.GT.LDQVAL ) THEN
00185             WRITE( NOUT, FMT = 9994 )'Grids', LDQVAL
00186             GO TO 30
00187          END IF
00188 *
00189 *        Get values of P and Q
00190 *
00191          READ( NIN, FMT = * )( PVAL( I ), I = 1, NGRIDS )
00192          READ( NIN, FMT = * )( QVAL( I ), I = 1, NGRIDS )
00193 *
00194 *        Get level of checking
00195 *
00196          READ( NIN, FMT = * )THRESH
00197 *
00198 *        Close input file
00199 *
00200          CLOSE ( NIN )
00201 *
00202 *        For pvm only: if virtual machine not set up, allocate it and
00203 *        spawn the correct number of processes.
00204 *
00205          IF( NPROCS.LT.1 ) THEN
00206             NPROCS = 0
00207             DO 20 I = 1, NGRIDS
00208                NPROCS = MAX( NPROCS, PVAL( I )*QVAL( I ) )
00209    20       CONTINUE
00210             CALL BLACS_SETUP( IAM, NPROCS )
00211          END IF
00212 *
00213 *        Temporarily define blacs grid to include all processes so
00214 *        information can be broadcast to all processes
00215 *
00216          CALL BLACS_GET( -1, 0, ICTXT )
00217          CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS )
00218 *
00219 *        Compute machine epsilon
00220 *
00221          EPS = PSLAMCH( ICTXT, 'eps' )
00222 *
00223 *        Pack information arrays and broadcast
00224 *
00225          CALL SGEBS2D( ICTXT, 'All', ' ', 1, 1, THRESH, 1 )
00226 *
00227          WORK( 1 ) = NMAT
00228          WORK( 2 ) = NNB
00229          WORK( 3 ) = NGRIDS
00230          CALL IGEBS2D( ICTXT, 'All', ' ', 3, 1, WORK, 3 )
00231 *
00232          I = 1
00233          CALL ICOPY( NMAT, NVAL, 1, WORK( I ), 1 )
00234          I = I + NMAT
00235          CALL ICOPY( NNB, NBVAL, 1, WORK( I ), 1 )
00236          I = I + NNB
00237          CALL ICOPY( NGRIDS, PVAL, 1, WORK( I ), 1 )
00238          I = I + NGRIDS
00239          CALL ICOPY( NGRIDS, QVAL, 1, WORK( I ), 1 )
00240          I = I + NGRIDS - 1
00241          CALL IGEBS2D( ICTXT, 'All', ' ', I, 1, WORK, I )
00242 *
00243 *        regurgitate input
00244 *
00245          WRITE( NOUT, FMT = 9999 )
00246      $      'ScaLAPACK nonsymmetric eigenvector calculation.'
00247          WRITE( NOUT, FMT = 9999 )USRINFO
00248          WRITE( NOUT, FMT = * )
00249          WRITE( NOUT, FMT = 9999 )'Tests of the parallel ' //
00250      $      'complex single precision eigenvector calculation.'
00251          WRITE( NOUT, FMT = 9999 )'The following scaled residual ' //
00252      $      'checks will be computed:'
00253          WRITE( NOUT, FMT = 9999 )
00254      $      ' Residual  = max( ||T*R-R*D||/(||H||*eps*N)' //
00255      $      ' , ||T^H*L-L*D^H||/(||H||*eps*N) )'
00256          WRITE( NOUT, FMT = 9999 )
00257      $      ' Normalization residual = max(max_j(max|R(j)|-1),' //
00258      $      ' max_j(max|L(j)|-1))/(eps*N)'
00259          WRITE( NOUT, FMT = 9999 )'The matrix A is randomly ' //
00260      $      'generated for each test.'
00261          WRITE( NOUT, FMT = * )
00262          WRITE( NOUT, FMT = 9999 )'An explanation of the input/output '
00263      $       // 'parameters follows:'
00264          WRITE( NOUT, FMT = 9999 )
00265      $      'TIME    : Indicates whether WALL or ' //
00266      $      'CPU time was used.'
00267 *
00268          WRITE( NOUT, FMT = 9999 )
00269      $      'N       : The number of columns in the ' // 'matrix A.'
00270          WRITE( NOUT, FMT = 9999 )
00271      $      'NB      : The size of the square blocks the' //
00272      $      ' matrix A is split into.'
00273          WRITE( NOUT, FMT = 9999 )
00274      $      'P       : The number of process rows.'
00275          WRITE( NOUT, FMT = 9999 )
00276      $      'Q       : The number of process columns.'
00277          WRITE( NOUT, FMT = 9999 )
00278      $      'THRESH  : If a residual value is less than' //
00279      $      ' THRESH, CHECK is flagged as PASSED'
00280          WRITE( NOUT, FMT = 9999 )
00281      $      'NEP time : Time in seconds to decompose the ' // ' matrix'
00282          WRITE( NOUT, FMT = 9999 )'MFLOPS  : Rate of execution '
00283          WRITE( NOUT, FMT = * )
00284          WRITE( NOUT, FMT = 9999 )
00285      $      'The following parameter values will be used:'
00286          WRITE( NOUT, FMT = 9996 )'N    ',
00287      $      ( NVAL( I ), I = 1, MIN( NMAT, 10 ) )
00288          IF( NMAT.GT.10 )
00289      $      WRITE( NOUT, FMT = 9997 )( NVAL( I ), I = 11, NMAT )
00290          WRITE( NOUT, FMT = 9996 )'NB   ',
00291      $      ( NBVAL( I ), I = 1, MIN( NNB, 10 ) )
00292          IF( NNB.GT.10 )
00293      $      WRITE( NOUT, FMT = 9997 )( NBVAL( I ), I = 11, NNB )
00294          WRITE( NOUT, FMT = 9996 )'P    ',
00295      $      ( PVAL( I ), I = 1, MIN( NGRIDS, 10 ) )
00296          IF( NGRIDS.GT.10 )
00297      $      WRITE( NOUT, FMT = 9997 )( PVAL( I ), I = 11, NGRIDS )
00298          WRITE( NOUT, FMT = 9996 )'Q    ',
00299      $      ( QVAL( I ), I = 1, MIN( NGRIDS, 10 ) )
00300          IF( NGRIDS.GT.10 )
00301      $      WRITE( NOUT, FMT = 9997 )( QVAL( I ), I = 11, NGRIDS )
00302          WRITE( NOUT, FMT = * )
00303          WRITE( NOUT, FMT = 9995 )EPS
00304          WRITE( NOUT, FMT = 9998 )THRESH
00305 *
00306       ELSE
00307 *
00308 *        If in pvm, must participate setting up virtual machine
00309 *
00310          IF( NPROCS.LT.1 )
00311      $      CALL BLACS_SETUP( IAM, NPROCS )
00312 *
00313 *        Temporarily define blacs grid to include all processes so
00314 *        information can be broadcast to all processes
00315 *
00316          CALL BLACS_GET( -1, 0, ICTXT )
00317          CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS )
00318 *
00319 *        Compute machine epsilon
00320 *
00321          EPS = PSLAMCH( ICTXT, 'eps' )
00322 *
00323          CALL SGEBR2D( ICTXT, 'All', ' ', 1, 1, THRESH, 1, 0, 0 )
00324          CALL IGEBR2D( ICTXT, 'All', ' ', 3, 1, WORK, 3, 0, 0 )
00325          NMAT = WORK( 1 )
00326          NNB = WORK( 2 )
00327          NGRIDS = WORK( 3 )
00328 *
00329          I = NMAT + NNB + 2*NGRIDS
00330          CALL IGEBR2D( ICTXT, 'All', ' ', I, 1, WORK, I, 0, 0 )
00331          I = 1
00332          CALL ICOPY( NMAT, WORK( I ), 1, NVAL, 1 )
00333          I = I + NMAT
00334          CALL ICOPY( NNB, WORK( I ), 1, NBVAL, 1 )
00335          I = I + NNB
00336          CALL ICOPY( NGRIDS, WORK( I ), 1, PVAL, 1 )
00337          I = I + NGRIDS
00338          CALL ICOPY( NGRIDS, WORK( I ), 1, QVAL, 1 )
00339 *
00340       END IF
00341 *
00342       CALL BLACS_GRIDEXIT( ICTXT )
00343 *
00344       RETURN
00345 *
00346    30 CONTINUE
00347       WRITE( NOUT, FMT = 9993 )
00348       CLOSE ( NIN )
00349       IF( NOUT.NE.6 .AND. NOUT.NE.0 )
00350      $   CLOSE ( NOUT )
00351       CALL BLACS_ABORT( ICTXT, 1 )
00352 *
00353       STOP
00354 *
00355  9999 FORMAT( A )
00356  9998 FORMAT( 'Routines pass computational tests if scaled residual ',
00357      $      'is less than ', G12.5 )
00358  9997 FORMAT( '                 ', 10I6 )
00359  9996 FORMAT( 2X, A5, '   :        ', 10I6 )
00360  9995 FORMAT( 'Relative machine precision (eps) is taken to be ',
00361      $      E18.6 )
00362  9994 FORMAT( ' Number of values of ', 5A,
00363      $      ' is less than 1 or greater ', 'than ', I2 )
00364  9993 FORMAT( ' Illegal input in file ', 40A, '.  Aborting run.' )
00365  9992 FORMAT( ' Blocking size too small at ', I2, ' must be >=6.' )
00366 *
00367 *     End of PCEVCINFO
00368 *
00369       END