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