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