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