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