ScaLAPACK  2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
pdtrdinfo.f
Go to the documentation of this file.
00001       SUBROUTINE PDTRDINFO( SUMMRY, NOUT, UPLO, 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 *     May 1, 1997
00009 *
00010 *     .. Scalar Arguments ..
00011       CHARACTER          UPLO
00012       INTEGER            IAM, LDNBVAL, LDNVAL, LDPVAL, LDQVAL,
00013      $                   NGRIDS, NMAT, NNB, NPROCS, NOUT
00014       REAL               THRESH
00015 *     ..
00016 *     .. Array Arguments ..
00017       CHARACTER*( * )    SUMMRY*(*)
00018       INTEGER            NBVAL( LDNBVAL ), NVAL( LDNVAL ),
00019      $                   PVAL( LDPVAL ), QVAL( LDQVAL ), WORK( * )
00020 *     ..
00021 *
00022 *  Purpose
00023 *  =======
00024 *
00025 *  PDTRDINFO gets needed startup information for the symmetric
00026 *  tridiagonal reduction and transmits it to all processes.
00027 *
00028 *  Arguments
00029 *  =========
00030 *
00031 *  SUMMRY   (global output) CHARACTER*(*)
00032 *           Name of output (summary) file (if any). Only defined for
00033 *           process 0.
00034 *
00035 *  NOUT     (global output) INTEGER
00036 *           The unit number for output file. NOUT = 6, ouput to screen,
00037 *           NOUT = 0, output to stderr.  Only defined for process 0.
00038 *
00039 *  UPLO     (global output) CHARACTER
00040 *           Specifies whether the upper or lower triangular part of the
00041 *           symmetric matrix A is stored.
00042 *             = 'U':  Upper triangular
00043 *             = 'L':  Lower triangular
00044 *
00045 *  NMAT     (global output) INTEGER
00046 *           The number of different values that can be used for N.
00047 *
00048 *  NVAL     (global output) INTEGER array, dimension (LDNVAL)
00049 *           The values of N (number of columns in matrix) to run the
00050 *           code with.
00051 *
00052 *  LDNVAL   (global input) INTEGER
00053 *           The maximum number of different values that can be used for
00054 *           N, LDNVAL > =  NMAT.
00055 *
00056 *  NNB      (global output) INTEGER
00057 *           The number of different values that can be used for NB.
00058 *
00059 *  NBVAL    (global output) INTEGER array, dimension (LDNBVAL)
00060 *           The values of NB (blocksize) to run the code with.
00061 *
00062 *  LDNBVAL  (global input) INTEGER
00063 *           The maximum number of different values that can be used for
00064 *           NB, LDNBVAL >= NNB.
00065 *
00066 *  NGRIDS   (global output) INTEGER
00067 *           The number of different values that can be used for P & Q.
00068 *
00069 *  PVAL     (global output) INTEGER array, dimension (LDPVAL)
00070 *           The values of P (number of process rows) to run the code
00071 *           with.
00072 *
00073 *  LDPVAL   (global input) INTEGER
00074 *           The maximum number of different values that can be used for
00075 *           P, LDPVAL >= NGRIDS.
00076 *
00077 *  QVAL     (global output) INTEGER array, dimension (LDQVAL)
00078 *           The values of Q (number of process columns) to run the code
00079 *           with.
00080 *
00081 *  LDQVAL   (global input) INTEGER
00082 *           The maximum number of different values that can be used for
00083 *           Q, LDQVAL >= NGRIDS.
00084 *
00085 *  THRESH   (global output) REAL
00086 *           Indicates what error checks shall be run and printed out:
00087 *           = 0 : Perform no error checking
00088 *           > 0 : report all residuals greater than THRESH.
00089 *
00090 *  WORK     (local workspace) INTEGER array, dimension >=
00091 *           MAX( 5, LDNVAL+LDNBVAL+LDPVAL+LDQVAL ).  Used to pack all
00092 *           input arrays in order to send info in one message.
00093 *
00094 *  IAM      (local input) INTEGER
00095 *           My process number.
00096 *
00097 *  NPROCS   (global input) INTEGER
00098 *           The total number of processes.
00099 *
00100 *  Note
00101 *  ====
00102 *
00103 *  For packing the information we assumed that the length in bytes of an
00104 *  integer is equal to the length in bytes of a real single precision.
00105 *
00106 *  =====================================================================
00107 *
00108 *     .. Parameters ..
00109       INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
00110      $                   LLD_, MB_, M_, NB_, N_, RSRC_
00111       PARAMETER          ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
00112      $                     CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
00113      $                     RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
00114       INTEGER            NIN
00115       PARAMETER          ( NIN = 11 )
00116 *     ..
00117 *     .. Local Scalars ..
00118       CHARACTER*79       USRINFO
00119       INTEGER            I, ICTXT
00120       DOUBLE PRECISION   EPS
00121 *     ..
00122 *     .. External Subroutines ..
00123       EXTERNAL           BLACS_ABORT, BLACS_GET, BLACS_GRIDEXIT,
00124      $                   BLACS_GRIDINIT, BLACS_SETUP, ICOPY, IGEBR2D,
00125      $                   IGEBS2D, SGEBR2D, SGEBS2D
00126 *     ..
00127 *     .. External Functions ..
00128       LOGICAL            LSAME
00129       DOUBLE PRECISION   PDLAMCH
00130       EXTERNAL           PDLAMCH, LSAME
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( NIN, FILE='TRD.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 = 9999 ) 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( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
00158 *
00159 *        Read and check the parameter values for the tests.
00160 *
00161 *        Get UPLO
00162 *
00163          READ( NIN, FMT = * ) UPLO
00164 *
00165 *        Get number of matrices and their dimensions
00166 *
00167          READ( NIN, FMT = * ) NMAT
00168          IF( NMAT.LT.1 .OR. NMAT.GT.LDNVAL ) THEN
00169             WRITE( NOUT, FMT = 9994 ) 'N', LDNVAL
00170             GOTO 20
00171          END IF
00172          READ( NIN, FMT = * ) ( NVAL( I ), I = 1, NMAT )
00173 *
00174 *        Get values of NB
00175 *
00176          READ( NIN, FMT = * ) NNB
00177          IF( NNB.LT.1 .OR. NNB.GT.LDNBVAL ) THEN
00178             WRITE( NOUT, FMT = 9994 ) 'NB', LDNBVAL
00179             GOTO 20
00180          END IF
00181          READ( NIN, FMT = * ) ( NBVAL( I ), I = 1, NNB )
00182 *
00183 *        Get number of grids
00184 *
00185          READ( NIN, FMT = * ) NGRIDS
00186          IF( NGRIDS.LT.1 .OR. NGRIDS.GT.LDPVAL ) THEN
00187             WRITE( NOUT, FMT = 9994 ) 'Grids', LDPVAL
00188             GOTO 20
00189          ELSE IF( NGRIDS.GT.LDQVAL ) THEN
00190             WRITE( NOUT, FMT = 9994 ) 'Grids', LDQVAL
00191             GOTO 20
00192          END IF
00193 *
00194 *        Get values of P and Q
00195 *
00196          READ( NIN, FMT = * ) ( PVAL( I ), I = 1, NGRIDS )
00197          READ( NIN, FMT = * ) ( QVAL( I ), I = 1, NGRIDS )
00198 *
00199 *        Get level of checking
00200 *
00201          READ( NIN, FMT = * ) THRESH
00202 *
00203 *        Close input file
00204 *
00205          CLOSE( NIN )
00206 *
00207 *        For pvm only: if virtual machine not set up, allocate it and
00208 *        spawn the correct number of processes.
00209 *
00210          IF( NPROCS.LT.1 ) THEN
00211             NPROCS = 0
00212             DO 10 I = 1, NGRIDS
00213                NPROCS = MAX( NPROCS, PVAL( I )*QVAL( I ) )
00214    10       CONTINUE
00215             CALL BLACS_SETUP( IAM, NPROCS )
00216          END IF
00217 *
00218 *        Temporarily define blacs grid to include all processes so
00219 *        information can be broadcast to all processes
00220 *
00221          CALL BLACS_GET( -1, 0, ICTXT )
00222          CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS )
00223 *
00224 *        Compute machine epsilon
00225 *
00226          EPS = PDLAMCH( ICTXT, 'eps' )
00227 *
00228 *        Pack information arrays and broadcast
00229 *
00230          CALL SGEBS2D( ICTXT, 'All', ' ', 1, 1, THRESH, 1 )
00231 *
00232          WORK( 1 ) = NMAT
00233          WORK( 2 ) = NNB
00234          WORK( 3 ) = NGRIDS
00235          IF( LSAME( UPLO, 'L' ) ) THEN
00236             WORK( 4 ) = 1
00237          ELSE
00238             WORK( 4 ) = 2
00239          END IF
00240          CALL IGEBS2D( ICTXT, 'All', ' ', 4, 1, WORK, 4 )
00241 *
00242          I = 1
00243          CALL ICOPY( NMAT, NVAL, 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', ' ', I, 1, WORK, I )
00252 *
00253 *        regurgitate input
00254 *
00255          WRITE( NOUT, FMT = 9999 )
00256      $               'ScaLAPACK Reduction Routine to symmetric '//
00257      $               'tridiagonal form.'
00258          WRITE( NOUT, FMT = 9999 ) USRINFO
00259          WRITE( NOUT, FMT = * )
00260          WRITE( NOUT, FMT = 9999 )
00261      $               'Tests of the parallel '//
00262      $               'real double precision symmetric '//
00263      $               'tridiagonal'
00264          WRITE( NOUT, FMT = 9999 ) 'reduction routines.'
00265          WRITE( NOUT, FMT = 9999 )
00266      $               'The following scaled residual '//
00267      $               'checks will be computed:'
00268          WRITE( NOUT, FMT = 9999 )
00269      $               ' ||A - QTQ''|| / (||A|| * eps * N)'
00270          WRITE( NOUT, FMT = 9999 )
00271      $               'The matrix A is randomly '//
00272      $               'generated for each test.'
00273          WRITE( NOUT, FMT = * )
00274          WRITE( NOUT, FMT = 9999 )
00275      $               'An explanation of the input/output '//
00276      $               'parameters follows:'
00277          WRITE( NOUT, FMT = 9999 )
00278      $               'UPLO     : Whether the ''Upper'' or ''Low'//
00279      $               'er'' part of A is to be referenced.'
00280          WRITE( NOUT, FMT = 9999 )
00281      $               'TIME     : Indicates whether WALL or '//
00282      $               'CPU time was used.'
00283          WRITE( NOUT, FMT = 9999 )
00284      $               'N        : The number of rows and columns '//
00285      $               'of the matrix A.'
00286          WRITE( NOUT, FMT = 9999 )
00287      $               'NB       : The size of the square blocks'//
00288      $               ' the matrix A is split into.'
00289          WRITE( NOUT, FMT = 9999 )
00290      $               'P        : The number of process rows.'
00291          WRITE( NOUT, FMT = 9999 )
00292      $               'Q        : The number of process columns.'
00293          WRITE( NOUT, FMT = 9999 )
00294      $               'THRESH   : If a residual value is less'//
00295      $               'than THRESH, CHECK is flagged as PASSED.'
00296          WRITE( NOUT, FMT = 9999 )
00297      $               'TRD time : Time in seconds to reduce the'//
00298      $               ' matrix to tridiagonal form.'
00299          WRITE( NOUT, FMT = 9999 )
00300      $               'MFLOPS   : Rate of execution for '//
00301      $               'symmetric tridiagonal reduction.'
00302          WRITE( NOUT, FMT = * )
00303          WRITE( NOUT, FMT = 9999 )
00304      $               'The following parameter values will be used:'
00305          WRITE( NOUT, FMT = 9999 )
00306      $                   '  UPLO :           '//UPLO
00307          WRITE( NOUT, FMT = 9996 )
00308      $               'N    ', ( NVAL( I ), I = 1, MIN( NMAT, 10 ) )
00309          IF( NMAT.GT.10 )
00310      $      WRITE( NOUT, FMT = 9997 ) ( NVAL( I ), I = 11, NMAT )
00311          WRITE( NOUT, FMT = 9996 )
00312      $               'NB   ', ( NBVAL( I ), I = 1, MIN( NNB, 10 ) )
00313          IF( NNB.GT.10 )
00314      $      WRITE( NOUT, FMT = 9997 ) ( NBVAL( I ), I = 11, NNB )
00315          WRITE( NOUT, FMT = 9996 )
00316      $               'P    ', ( PVAL( I ), I = 1, MIN( NGRIDS, 10 ) )
00317          IF( NGRIDS.GT.10 )
00318      $      WRITE( NOUT, FMT = 9997 ) ( PVAL( I ), I = 11, NGRIDS )
00319          WRITE( NOUT, FMT = 9996 )
00320      $               'Q    ', ( QVAL( I ), I = 1, MIN( NGRIDS, 10 ) )
00321          IF( NGRIDS.GT.10 )
00322      $      WRITE( NOUT, FMT = 9997 ) ( QVAL( I ), I = 11, NGRIDS )
00323          WRITE( NOUT, FMT = * )
00324          WRITE( NOUT, FMT = 9995 ) EPS
00325          WRITE( NOUT, FMT = 9998 ) THRESH
00326 *
00327       ELSE
00328 *
00329 *        If in pvm, must participate setting up virtual machine
00330 *
00331          IF( NPROCS.LT.1 )
00332      $      CALL BLACS_SETUP( IAM, NPROCS )
00333 *
00334 *        Temporarily define blacs grid to include all processes so
00335 *        all processes have needed startup information
00336 *
00337          CALL BLACS_GET( -1, 0, ICTXT )
00338          CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS )
00339 *
00340 *        Compute machine epsilon
00341 *
00342          EPS = PDLAMCH( ICTXT, 'eps' )
00343 *
00344          CALL SGEBR2D( ICTXT, 'All', ' ', 1, 1, THRESH, 1, 0, 0 )
00345          CALL IGEBR2D( ICTXT, 'All', ' ', 4, 1, WORK, 4, 0, 0 )
00346          NMAT   = WORK( 1 )
00347          NNB    = WORK( 2 )
00348          NGRIDS = WORK( 3 )
00349          IF( WORK( 4 ).EQ.1 ) THEN
00350             UPLO = 'L'
00351          ELSE
00352             UPLO = 'U'
00353          END IF
00354 *
00355          I = NMAT + NNB + 2*NGRIDS
00356          CALL IGEBR2D( ICTXT, 'All', ' ', I, 1, WORK, I, 0, 0 )
00357          I = 1
00358          CALL ICOPY( NMAT, WORK( I ), 1, NVAL, 1 )
00359          I = I + NMAT
00360          CALL ICOPY( NNB, WORK( I ), 1, NBVAL, 1 )
00361          I = I + NNB
00362          CALL ICOPY( NGRIDS, WORK( I ), 1, PVAL, 1 )
00363          I = I + NGRIDS
00364          CALL ICOPY( NGRIDS, WORK( I ), 1, QVAL, 1 )
00365 *
00366       END IF
00367 *
00368       CALL BLACS_GRIDEXIT( ICTXT )
00369 *
00370       RETURN
00371 *
00372    20 WRITE( NOUT, FMT = 9993 )
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( 'Routines pass computational tests if scaled residual ',
00382      $        'is less than ', G12.5 )
00383  9997 FORMAT( '              ', 10I6 )
00384  9996 FORMAT( 2X, A5, '  :    ', 10I6 )
00385  9995 FORMAT( 'Relative machine precision (eps) is taken to be ',
00386      $        E18.6 )
00387  9994 FORMAT( ' Number of values of ',5A, ' is less than 1 or greater ',
00388      $        'than ', I2 )
00389  9993 FORMAT( ' Illegal input in file ',40A,'.  Aborting run.' )
00390 *
00391 *     End of PDTRDINFO
00392 *
00393       END