ScaLAPACK  2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
pdblas1tim.f
Go to the documentation of this file.
00001       BLOCK DATA
00002       INTEGER NSUBS
00003       PARAMETER (NSUBS = 8)
00004       CHARACTER*7        SNAMES( NSUBS )
00005       COMMON             /SNAMEC/SNAMES
00006       DATA               SNAMES/'PDSWAP ', 'PDSCAL ', 'PDCOPY ',
00007      $                   'PDAXPY ', 'PDDOT  ', 'PDNRM2 ',
00008      $                   'PDASUM ', 'PDAMAX '/
00009       END BLOCK DATA
00010       
00011       PROGRAM PDBLA1TIM
00012 *
00013 *  -- PBLAS timing driver (version 2.0.2) --
00014 *     Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver
00015 *     May 1 2012
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  PDBLA1TIM  is the main timing program for the Level 1 PBLAS routines.
00021 *
00022 *  The program must be driven by a short data file.  An  annotated exam-
00023 *  ple of a data file can be obtained by deleting the first 3 characters
00024 *  from the following 40 lines:
00025 *  'Level 1 PBLAS, Timing input file'
00026 *  'Intel iPSC/860 hypercube, gamma model.'
00027 *  'PDBLAS1TIM.SUMM'          output file name (if any)
00028 *  6       device out
00029 *  1       number of process grids (ordered pairs of P & Q)
00030 *  2 2 1 4 2 3 8        values of P
00031 *  2 2 4 1 3 2 1        values of Q
00032 *  1.0D0                value of ALPHA
00033 *  2                    number of tests problems
00034 *  3  4                 values of N
00035 *  6 10                 values of M_X
00036 *  6 10                 values of N_X
00037 *  2  5                 values of IMB_X
00038 *  2  5                 values of INB_X
00039 *  2  5                 values of MB_X
00040 *  2  5                 values of NB_X
00041 *  0  1                 values of RSRC_X
00042 *  0  0                 values of CSRC_X
00043 *  1  1                 values of IX
00044 *  1  1                 values of JX
00045 *  1  1                 values of INCX
00046 *  6 10                 values of M_Y
00047 *  6 10                 values of N_Y
00048 *  2  5                 values of IMB_Y
00049 *  2  5                 values of INB_Y
00050 *  2  5                 values of MB_Y
00051 *  2  5                 values of NB_Y
00052 *  0  1                 values of RSRC_Y
00053 *  0  0                 values of CSRC_Y
00054 *  1  1                 values of IY
00055 *  1  1                 values of JY
00056 *  6  1                 values of INCY
00057 *  PDSWAP  T            put F for no test in the same column
00058 *  PDSCAL  T            put F for no test in the same column
00059 *  PDCOPY  T            put F for no test in the same column
00060 *  PDAXPY  T            put F for no test in the same column
00061 *  PDDOT   T            put F for no test in the same column
00062 *  PDNRM2  T            put F for no test in the same column
00063 *  PDASUM  T            put F for no test in the same column
00064 *  PDAMAX  T            put F for no test in the same column
00065 *
00066 *  Internal Parameters
00067 *  ===================
00068 *
00069 *  TOTMEM  INTEGER
00070 *          TOTMEM  is  a machine-specific parameter indicating the maxi-
00071 *          mum  amount  of  available  memory per  process in bytes. The
00072 *          user  should  customize TOTMEM to his  platform.  Remember to
00073 *          leave  room  in  memory  for the  operating system, the BLACS
00074 *          buffer, etc.  For  example,  on  a system with 8 MB of memory
00075 *          per process (e.g., one processor  on an Intel iPSC/860),  the
00076 *          parameters we use are TOTMEM=6200000  (leaving 1.8 MB for OS,
00077 *          code, BLACS buffer, etc).  However,  for PVM,  we usually set
00078 *          TOTMEM = 2000000.  Some experimenting  with the maximum value
00079 *          of TOTMEM may be required. By default, TOTMEM is 2000000.
00080 *
00081 *  DBLESZ  INTEGER
00082 *          DBLESZ  indicates  the  length in bytes on the given platform
00083 *          for  a  double  precision  real. By default, DBLESZ is set to
00084 *          eight.
00085 *
00086 *  MEM     DOUBLE PRECISION array
00087 *          MEM is an array of dimension TOTMEM / DBLESZ.
00088 *          All arrays used by SCALAPACK routines are allocated from this
00089 *          array MEM and referenced by pointers. The  integer  IPA,  for
00090 *          example, is a pointer to the starting element of MEM for  the
00091 *          matrix A.
00092 *
00093 *  -- Written on April 1, 1998 by
00094 *     Antoine Petitet, University  of  Tennessee, Knoxville 37996, USA.
00095 *
00096 *  =====================================================================
00097 *
00098 *     .. Parameters ..
00099       INTEGER            MAXTESTS, MAXGRIDS, DBLESZ, TOTMEM, MEMSIZ,
00100      $                   NSUBS
00101       PARAMETER          ( MAXTESTS = 20, MAXGRIDS = 20, DBLESZ = 8,
00102      $                   TOTMEM = 2000000, NSUBS = 8,
00103      $                   MEMSIZ = TOTMEM / DBLESZ )
00104       INTEGER            BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
00105      $                   DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
00106      $                   RSRC_
00107       PARAMETER          ( BLOCK_CYCLIC_2D_INB = 2, DLEN_ = 11,
00108      $                   DTYPE_ = 1, CTXT_ = 2, M_ = 3, N_ = 4,
00109      $                   IMB_ = 5, INB_ = 6, MB_ = 7, NB_ = 8,
00110      $                   RSRC_ = 9, CSRC_ = 10, LLD_ = 11 )
00111 *     ..
00112 *     .. Local Scalars ..
00113       INTEGER            CSRCX, CSRCY, I, IAM, ICTXT, IMBX, IMBY, IMIDX,
00114      $                   IMIDY, INBX, INBY, INCX, INCY, IPOSTX, IPOSTY,
00115      $                   IPREX, IPREY, IPX, IPY, IX, IXSEED, IY, IYSEED,
00116      $                   J, JX, JY, K, MBX, MBY, MEMREQD, MPX, MPY, MX,
00117      $                   MY, MYCOL, MYROW, N, NBX, NBY, NGRIDS, NOUT,
00118      $                   NPCOL, NPROCS, NPROW, NQX, NQY, NTESTS, NX, NY,
00119      $                   PISCLR, RSRCX, RSRCY
00120       DOUBLE PRECISION   ADDS, ALPHA, CFLOPS, MULTS, NOPS, PSCLR,
00121      $                   PUSCLR, WFLOPS
00122 *     ..
00123 *     .. Local Arrays ..
00124       CHARACTER*80       OUTFILE
00125       LOGICAL            LTEST( NSUBS ), YCHECK( NSUBS )
00126       INTEGER            CSCXVAL( MAXTESTS ), CSCYVAL( MAXTESTS ),
00127      $                   DESCX( DLEN_ ), DESCY( DLEN_ ), IERR( 2 ),
00128      $                   IMBXVAL( MAXTESTS ), IMBYVAL( MAXTESTS ),
00129      $                   INBXVAL( MAXTESTS ), INBYVAL( MAXTESTS ),
00130      $                   INCXVAL( MAXTESTS ), INCYVAL( MAXTESTS ),
00131      $                   IXVAL( MAXTESTS ), IYVAL( MAXTESTS ),
00132      $                   JXVAL( MAXTESTS ), JYVAL( MAXTESTS ),
00133      $                   MBXVAL( MAXTESTS ), MBYVAL( MAXTESTS ),
00134      $                   MXVAL( MAXTESTS ), MYVAL( MAXTESTS ),
00135      $                   NBXVAL( MAXTESTS ), NBYVAL( MAXTESTS ),
00136      $                   NVAL( MAXTESTS ), NXVAL( MAXTESTS ),
00137      $                   NYVAL( MAXTESTS ), PVAL( MAXTESTS ),
00138      $                   QVAL( MAXTESTS ), RSCXVAL( MAXTESTS ),
00139      $                   RSCYVAL( MAXTESTS )
00140       DOUBLE PRECISION   CTIME( 1 ), MEM( MEMSIZ ), WTIME( 1 )
00141 *     ..
00142 *     .. External Subroutines ..
00143       EXTERNAL           BLACS_BARRIER, BLACS_EXIT, BLACS_GET,
00144      $                   BLACS_GRIDEXIT, BLACS_GRIDINFO, BLACS_GRIDINIT,
00145      $                   BLACS_PINFO, IGSUM2D, PB_BOOT, PB_COMBINE,
00146      $                   PB_TIMER, PDAMAX, PDASUM, PDAXPY,
00147      $                   PDBLA1TIMINFO, PDCOPY, PDDOT, PDLAGEN, PDNRM2,
00148      $                   PDSCAL, PDSWAP, PVDESCCHK, PVDIMCHK
00149 *     ..
00150 *     .. Intrinsic Functions ..
00151       INTRINSIC          DBLE
00152 *     ..
00153 *     .. Common Blocks ..
00154       CHARACTER*7        SNAMES( NSUBS )
00155       LOGICAL            ABRTFLG
00156       INTEGER            INFO, NBLOG
00157       COMMON             /SNAMEC/SNAMES
00158       COMMON             /INFOC/INFO, NBLOG
00159       COMMON             /PBERRORC/NOUT, ABRTFLG
00160 *     ..
00161 *     .. Data Statements ..
00162       DATA               YCHECK/.TRUE., .FALSE., .TRUE., .TRUE., .TRUE.,
00163      $                   .FALSE., .FALSE., .FALSE./
00164 *     ..
00165 *     .. Executable Statements ..
00166 *
00167 *     Initialization
00168 *
00169 *     Set flag so that the PBLAS error handler won't abort on errors, so
00170 *     that the tester will detect unsupported operations.
00171 *
00172       ABRTFLG = .FALSE.
00173 *
00174 *     Seeds for random matrix generations.
00175 *
00176       IXSEED = 100
00177       IYSEED = 200
00178 *
00179 *     Get starting information
00180 *
00181       CALL BLACS_PINFO( IAM, NPROCS )
00182       CALL PDBLA1TIMINFO( OUTFILE, NOUT, NTESTS, NVAL, MXVAL, NXVAL,
00183      $                    IMBXVAL, MBXVAL, INBXVAL, NBXVAL, RSCXVAL,
00184      $                    CSCXVAL, IXVAL, JXVAL, INCXVAL, MYVAL,
00185      $                    NYVAL, IMBYVAL, MBYVAL, INBYVAL, NBYVAL,
00186      $                    RSCYVAL, CSCYVAL, IYVAL, JYVAL, INCYVAL,
00187      $                    MAXTESTS, NGRIDS, PVAL, MAXGRIDS, QVAL,
00188      $                    MAXGRIDS, LTEST, IAM, NPROCS, ALPHA, MEM )
00189 *
00190       IF( IAM.EQ.0 )
00191      $   WRITE( NOUT, FMT = 9986 )
00192 *
00193 *     Loop over different process grids
00194 *
00195       DO 60 I = 1, NGRIDS
00196 *
00197          NPROW = PVAL( I )
00198          NPCOL = QVAL( I )
00199 *
00200 *        Make sure grid information is correct
00201 *
00202          IERR( 1 ) = 0
00203          IF( NPROW.LT.1 ) THEN
00204             IF( IAM.EQ.0 )
00205      $         WRITE( NOUT, FMT = 9999 ) 'GRID SIZE', 'NPROW', NPROW
00206             IERR( 1 ) = 1
00207          ELSE IF( NPCOL.LT.1 ) THEN
00208             IF( IAM.EQ.0 )
00209      $         WRITE( NOUT, FMT = 9999 ) 'GRID SIZE', 'NPCOL', NPCOL
00210             IERR( 1 ) = 1
00211          ELSE IF( NPROW*NPCOL.GT.NPROCS ) THEN
00212             IF( IAM.EQ.0 )
00213      $         WRITE( NOUT, FMT = 9998 ) NPROW*NPCOL, NPROCS
00214             IERR( 1 ) = 1
00215          END IF
00216 *
00217          IF( IERR( 1 ).GT.0 ) THEN
00218             IF( IAM.EQ.0 )
00219      $         WRITE( NOUT, FMT = 9997 ) 'GRID'
00220             GO TO 60
00221          END IF
00222 *
00223 *        Define process grid
00224 *
00225          CALL BLACS_GET( -1, 0, ICTXT )
00226          CALL BLACS_GRIDINIT( ICTXT, 'Row-major', NPROW, NPCOL )
00227          CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
00228 *
00229 *        Go to bottom of process grid loop if this case doesn't use my
00230 *        process
00231 *
00232          IF( MYROW.GE.NPROW .OR. MYCOL.GE.NPCOL )
00233      $      GO TO 60
00234 *
00235 *        Loop over number of tests
00236 *
00237          DO 50 J = 1, NTESTS
00238 *
00239 *           Get the test parameters
00240 *
00241             N     = NVAL( J )
00242             MX    = MXVAL( J )
00243             NX    = NXVAL( J )
00244             IMBX  = IMBXVAL( J )
00245             MBX   = MBXVAL( J )
00246             INBX  = INBXVAL( J )
00247             NBX   = NBXVAL( J )
00248             RSRCX = RSCXVAL( J )
00249             CSRCX = CSCXVAL( J )
00250             IX    = IXVAL( J )
00251             JX    = JXVAL( J )
00252             INCX  = INCXVAL( J )
00253             MY    = MYVAL( J )
00254             NY    = NYVAL( J )
00255             IMBY  = IMBYVAL( J )
00256             MBY   = MBYVAL( J )
00257             INBY  = INBYVAL( J )
00258             NBY   = NBYVAL( J )
00259             RSRCY = RSCYVAL( J )
00260             CSRCY = CSCYVAL( J )
00261             IY    = IYVAL( J )
00262             JY    = JYVAL( J )
00263             INCY  = INCYVAL( J )
00264 *
00265             IF( IAM.EQ.0 ) THEN
00266                WRITE( NOUT, FMT = * )
00267                WRITE( NOUT, FMT = 9996 ) J, NPROW, NPCOL
00268                WRITE( NOUT, FMT = * )
00269 *
00270                WRITE( NOUT, FMT = 9995 )
00271                WRITE( NOUT, FMT = 9994 )
00272                WRITE( NOUT, FMT = 9995 )
00273                WRITE( NOUT, FMT = 9993 ) N, IX, JX, MX, NX, IMBX, INBX,
00274      $                                   MBX, NBX, RSRCX, CSRCX, INCX
00275 *
00276                WRITE( NOUT, FMT = 9995 )
00277                WRITE( NOUT, FMT = 9992 )
00278                WRITE( NOUT, FMT = 9995 )
00279                WRITE( NOUT, FMT = 9993 ) N, IY, JY, MY, NY, IMBY, INBY,
00280      $                                   MBY, NBY, RSRCY, CSRCY, INCY
00281                WRITE( NOUT, FMT = 9995 )
00282                WRITE( NOUT, FMT = 9983 )
00283             END IF
00284 *
00285 *           Check the validity of the input and initialize DESC_
00286 *
00287             CALL PVDESCCHK( ICTXT, NOUT, 'X', DESCX,
00288      $                      BLOCK_CYCLIC_2D_INB, MX, NX, IMBX, INBX,
00289      $                      MBX, NBX, RSRCX, CSRCX, INCX, MPX, NQX,
00290      $                      IPREX, IMIDX, IPOSTX, 0, 0, IERR( 1 ) )
00291             CALL PVDESCCHK( ICTXT, NOUT, 'Y', DESCY,
00292      $                      BLOCK_CYCLIC_2D_INB, MY, NY, IMBY, INBY,
00293      $                      MBY, NBY, RSRCY, CSRCY, INCY, MPY, NQY,
00294      $                      IPREY, IMIDY, IPOSTY, 0, 0, IERR( 2 ) )
00295 *
00296             IF( IERR( 1 ).GT.0 .OR. IERR( 2 ).GT.0 )
00297      $         GO TO 40
00298 *
00299 *           Assign pointers into MEM for matrices corresponding to
00300 *           vectors X and Y. Ex: IPX starts at position MEM( 1 ).
00301 *
00302             IPX = 1
00303             IPY = IPX + DESCX( LLD_ ) * NQX
00304 *
00305 *           Check if sufficient memory.
00306 *
00307             MEMREQD = IPY + DESCY( LLD_ ) * NQY - 1
00308             IERR( 1 ) = 0
00309             IF( MEMREQD.GT.MEMSIZ ) THEN
00310                IF( IAM.EQ.0 )
00311      $            WRITE( NOUT, FMT = 9990 ) MEMREQD*DBLESZ
00312                IERR( 1 ) = 1
00313             END IF
00314 *
00315 *           Check all processes for an error
00316 *
00317             CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1, 0 )
00318 *
00319             IF( IERR( 1 ).GT.0 ) THEN
00320                IF( IAM.EQ.0 )
00321      $            WRITE( NOUT, FMT = 9991 )
00322                GO TO 40
00323             END IF
00324 *
00325 *           Loop over all PBLAS 1 routines
00326 *
00327             DO 30 K = 1, NSUBS
00328 *
00329 *              Continue only if this sub has to be tested.
00330 *
00331                IF( .NOT.LTEST( K ) )
00332      $            GO TO 30
00333 *
00334 *              Check the validity of the operand sizes
00335 *
00336                CALL PVDIMCHK( ICTXT, NOUT, N, 'X', IX, JX, DESCX, INCX,
00337      $                        IERR( 1 ) )
00338                CALL PVDIMCHK( ICTXT, NOUT, N, 'Y', IY, JY, DESCY, INCY,
00339      $                        IERR( 2 ) )
00340 *
00341                IF( IERR( 1 ).NE.0 .OR. IERR( 2 ).NE.0 )
00342      $            GO TO 30
00343 *
00344 *              Generate distributed matrices X and Y
00345 *
00346                CALL PDLAGEN( .FALSE., 'None', 'No diag', 0, MX, NX, 1,
00347      $                       1, DESCX, IXSEED, MEM( IPX ),
00348      $                       DESCX( LLD_ ) )
00349                IF( YCHECK( K ) )
00350      $            CALL PDLAGEN( .FALSE., 'None', 'No diag', 0, MY, NY,
00351      $                          1, 1, DESCY, IYSEED, MEM( IPY ),
00352      $                          DESCY( LLD_ ) )
00353 *
00354                INFO = 0
00355                CALL PB_BOOT()
00356                CALL BLACS_BARRIER( ICTXT, 'All' )
00357 *
00358 *              Call the PBLAS routine
00359 *
00360                IF( K.EQ.1 ) THEN
00361 *
00362 *                 Test PDSWAP
00363 *
00364                   ADDS  = 0.0D+0
00365                   MULTS = 0.0D+0
00366                   CALL PB_TIMER( 1 )
00367                   CALL PDSWAP( N, MEM( IPX ), IX, JX, DESCX, INCX,
00368      $                         MEM( IPY ), IY, JY, DESCY, INCY )
00369                   CALL PB_TIMER( 1 )
00370 *
00371                ELSE IF( K.EQ.2 ) THEN
00372 *
00373 *                 Test PDSCAL
00374 *
00375                   ADDS  = 0.0D+0
00376                   MULTS = DBLE( N )
00377                   CALL PB_TIMER( 1 )
00378                   CALL PDSCAL( N, ALPHA, MEM( IPX ), IX, JX, DESCX,
00379      $                         INCX )
00380                   CALL PB_TIMER( 1 )
00381 *
00382                ELSE IF( K.EQ.3 ) THEN
00383 *
00384 *                 Test PDCOPY
00385 *
00386                   ADDS  = 0.0D+0
00387                   MULTS = 0.0D+0
00388                   CALL PB_TIMER( 1 )
00389                   CALL PDCOPY( N, MEM( IPX ), IX, JX, DESCX, INCX,
00390      $                         MEM( IPY ), IY, JY, DESCY, INCY )
00391                   CALL PB_TIMER( 1 )
00392 *
00393                ELSE IF( K.EQ.4 ) THEN
00394 *
00395 *                 Test PDAXPY
00396 *
00397                   ADDS  = DBLE( N )
00398                   MULTS = DBLE( N )
00399                   CALL PB_TIMER( 1 )
00400                   CALL PDAXPY( N, ALPHA, MEM( IPX ), IX, JX, DESCX,
00401      $                         INCX, MEM( IPY ), IY, JY, DESCY, INCY )
00402                   CALL PB_TIMER( 1 )
00403 *
00404                ELSE IF( K.EQ.5 ) THEN
00405 *
00406 *                 Test PDDOT
00407 *
00408                   ADDS = DBLE( N-1 )
00409                   MULTS = DBLE( N )
00410                   CALL PB_TIMER( 1 )
00411                   CALL PDDOT( N, PSCLR, MEM( IPX ), IX, JX, DESCX, INCX,
00412      $                        MEM( IPY ), IY, JY, DESCY, INCY )
00413                   CALL PB_TIMER( 1 )
00414 *
00415                ELSE IF( K.EQ.6 ) THEN
00416 *
00417 *                 Test PDNRM2
00418 *
00419                   ADDS  = DBLE( N-1 )
00420                   MULTS = DBLE( N )
00421                   CALL PB_TIMER( 1 )
00422                   CALL PDNRM2( N, PUSCLR, MEM( IPX ), IX, JX, DESCX,
00423      $                         INCX )
00424                   CALL PB_TIMER( 1 )
00425 *
00426                ELSE IF( K.EQ.7 ) THEN
00427 *
00428 *                 Test PDASUM
00429 *
00430                   ADDS  = DBLE( N - 1 )
00431                   MULTS = 0.0D+0
00432                   CALL PB_TIMER( 1 )
00433                   CALL PDASUM( N, PUSCLR, MEM( IPX ), IX, JX, DESCX,
00434      $                         INCX )
00435                   CALL PB_TIMER( 1 )
00436 *
00437                ELSE IF( K.EQ.8 ) THEN
00438 *
00439                   ADDS  = 0.0D+0
00440                   MULTS = 0.0D+0
00441                   CALL PB_TIMER( 1 )
00442                   CALL PDAMAX( N, PSCLR, PISCLR, MEM( IPX ), IX, JX,
00443      $                         DESCX, INCX )
00444                   CALL PB_TIMER( 1 )
00445 *
00446                END IF
00447 *
00448 *              Check if the operation has been performed.
00449 *
00450                IF( INFO.NE.0 ) THEN
00451                   IF( IAM.EQ.0 )
00452      $               WRITE( NOUT, FMT = 9985 ) INFO
00453                   GO TO 30
00454                END IF
00455 *
00456                CALL PB_COMBINE( ICTXT, 'All', '>', 'W', 1, 1, WTIME )
00457                CALL PB_COMBINE( ICTXT, 'All', '>', 'C', 1, 1, CTIME )
00458 *
00459 *              Only node 0 prints timing test result
00460 *
00461                IF( IAM.EQ.0 ) THEN
00462 *
00463 *                 Calculate total flops
00464 *
00465                   NOPS = ADDS + MULTS
00466 *
00467 *                 Print WALL time if machine supports it
00468 *
00469                   IF( WTIME( 1 ).GT.0.0D+0 ) THEN
00470                      WFLOPS = NOPS / ( WTIME( 1 ) * 1.0D+6 )
00471                   ELSE
00472                      WFLOPS = 0.0D+0
00473                   END IF
00474 *
00475 *                 Print CPU time if machine supports it
00476 *
00477                   IF( CTIME( 1 ).GT.0.0D+0 ) THEN
00478                      CFLOPS = NOPS / ( CTIME( 1 ) * 1.0D+6 )
00479                   ELSE
00480                      CFLOPS = 0.0D+0
00481                   END IF
00482 *
00483                   WRITE( NOUT, FMT = 9984 ) SNAMES( K ), WTIME( 1 ),
00484      $                                      WFLOPS, CTIME( 1 ), CFLOPS
00485 *
00486                END IF
00487 *
00488    30       CONTINUE
00489 *
00490    40       IF( IAM.EQ.0 ) THEN
00491                WRITE( NOUT, FMT = 9995 )
00492                WRITE( NOUT, FMT = * )
00493                WRITE( NOUT, FMT = 9988 ) J
00494             END IF
00495 *
00496    50   CONTINUE
00497 *
00498         IF( IAM.EQ.0 ) THEN
00499            WRITE( NOUT, FMT = * )
00500            WRITE( NOUT, FMT = 9987 )
00501            WRITE( NOUT, FMT = * )
00502         END IF
00503 *
00504         CALL BLACS_GRIDEXIT( ICTXT )
00505 *
00506    60 CONTINUE
00507 *
00508       CALL BLACS_EXIT( 0 )
00509 *
00510  9999 FORMAT( 'ILLEGAL ', A, ': ', A, ' = ', I10,
00511      $        ' should be at least 1' )
00512  9998 FORMAT( 'ILLEGAL GRID: NPROW*NPCOL = ', I4,
00513      $        '. It can be at most', I4 )
00514  9997 FORMAT( 'Bad ', A, ' parameters: going on to next test case.' )
00515  9996 FORMAT( 2X, 'Test number ', I2 , ' started on a ', I4, ' x ',
00516      $        I4, ' process grid.' )
00517  9995 FORMAT( 2X, '---------------------------------------------------',
00518      $        '--------------------------' )
00519  9994 FORMAT( 2X, '     N     IX     JX     MX     NX  IMBX  INBX',
00520      $        '   MBX   NBX RSRCX CSRCX   INCX' )
00521  9993 FORMAT( 2X,I6,1X,I6,1X,I6,1X,I6,1X,I6,1X,I5,1X,I5,1X,I5,1X,I5,1X,
00522      $        I5,1X,I5,1X,I6 )
00523  9992 FORMAT( 2X, '     N     IY     JY     MY     NY  IMBY  INBY',
00524      $        '   MBY   NBY RSRCY CSRCY   INCY' )
00525  9991 FORMAT( 'Not enough memory for this test: going on to',
00526      $        ' next test case.' )
00527  9990 FORMAT( 'Not enough memory. Need: ', I12 )
00528  9988 FORMAT( 2X, 'Test number ', I2, ' completed.' )
00529  9987 FORMAT( 2X, 'End of Tests.' )
00530  9986 FORMAT( 2X, 'Tests started.' )
00531  9985 FORMAT( 2X, '   ***** Operation not supported, error code: ',
00532      $        I5, ' *****' )
00533  9984 FORMAT( 2X, '|  ', A, 2X, F13.3, 2X, F13.3, 2X, F13.3, 2X, F13.3 )
00534  9983 FORMAT( 2X, '            WALL time (s)    WALL Mflops ',
00535      $        '  CPU time (s)     CPU Mflops' )
00536 *
00537       STOP
00538 *
00539 *     End of PDBLA1TIM
00540 *
00541       END
00542       SUBROUTINE PDBLA1TIMINFO( SUMMRY, NOUT, NMAT, NVAL, MXVAL, NXVAL,
00543      $                          IMBXVAL, MBXVAL, INBXVAL, NBXVAL,
00544      $                          RSCXVAL, CSCXVAL, IXVAL, JXVAL,
00545      $                          INCXVAL, MYVAL, NYVAL, IMBYVAL, MBYVAL,
00546      $                          INBYVAL, NBYVAL, RSCYVAL, CSCYVAL,
00547      $                          IYVAL, JYVAL, INCYVAL, LDVAL, NGRIDS,
00548      $                          PVAL, LDPVAL, QVAL, LDQVAL, LTEST, IAM,
00549      $                          NPROCS, ALPHA, WORK )
00550 *
00551 *  -- PBLAS test routine (version 2.0) --
00552 *     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
00553 *     and University of California, Berkeley.
00554 *     April 1, 1998
00555 *
00556 *     .. Scalar Arguments ..
00557       INTEGER            IAM, LDPVAL, LDQVAL, LDVAL, NGRIDS, NMAT, NOUT,
00558      $                   NPROCS
00559       DOUBLE PRECISION   ALPHA
00560 *     ..
00561 *     .. Array Arguments ..
00562       CHARACTER*( * )    SUMMRY
00563       LOGICAL            LTEST( * )
00564       INTEGER            CSCXVAL( LDVAL ), CSCYVAL( LDVAL ),
00565      $                   IMBXVAL( LDVAL ), IMBYVAL( LDVAL ),
00566      $                   INBXVAL( LDVAL ), INBYVAL( LDVAL ),
00567      $                   INCXVAL( LDVAL ), INCYVAL( LDVAL ),
00568      $                   IXVAL( LDVAL ), IYVAL( LDVAL ), JXVAL( LDVAL ),
00569      $                   JYVAL( LDVAL ), MBXVAL( LDVAL ),
00570      $                   MBYVAL( LDVAL ), MXVAL( LDVAL ),
00571      $                   MYVAL( LDVAL ), NBXVAL( LDVAL ),
00572      $                   NBYVAL( LDVAL ), NVAL( LDVAL ), NXVAL( LDVAL ),
00573      $                   NYVAL( LDVAL ), PVAL( LDPVAL ), QVAL( LDQVAL ),
00574      $                   RSCXVAL( LDVAL ), RSCYVAL( LDVAL ), WORK( * )
00575 *     ..
00576 *
00577 *  Purpose
00578 *  =======
00579 *
00580 *  PDBLA1TIMINFO  get  the needed startup information for timing various
00581 *  Level 1 PBLAS routines, and transmits it to all processes.
00582 *
00583 *  Notes
00584 *  =====
00585 *
00586 *  For packing the information we assumed that the length in bytes of an
00587 *  integer is equal to the length in bytes of a real single precision.
00588 *
00589 *  Arguments
00590 *  =========
00591 *
00592 *  SUMMRY  (global output) CHARACTER*(*)
00593 *          On  exit,  SUMMRY  is  the  name of output (summary) file (if
00594 *          any). SUMMRY is only defined for process 0.
00595 *
00596 *  NOUT    (global output) INTEGER
00597 *          On exit, NOUT  specifies the unit number for the output file.
00598 *          When NOUT is 6, output to screen,  when  NOUT is 0, output to
00599 *          stderr. NOUT is only defined for process 0.
00600 *
00601 *  NMAT    (global output) INTEGER
00602 *          On exit,  NMAT  specifies the number of different test cases.
00603 *
00604 *  NVAL    (global output) INTEGER array
00605 *          On entry, NVAL is an array of dimension LDVAL.  On exit, this
00606 *          array contains the values of N to run the code with.
00607 *
00608 *  MXVAL   (global output) INTEGER array
00609 *          On entry, MXVAL is an array of dimension LDVAL. On exit, this
00610 *          array  contains  the values  of  DESCX( M_ )  to run the code
00611 *          with.
00612 *
00613 *  NXVAL   (global output) INTEGER array
00614 *          On entry, NXVAL is an array of dimension LDVAL. On exit, this
00615 *          array  contains  the values  of  DESCX( N_ )  to run the code
00616 *          with.
00617 *
00618 *  IMBXVAL (global output) INTEGER array
00619 *          On entry,  IMBXVAL  is an array of  dimension LDVAL. On exit,
00620 *          this  array  contains  the values of DESCX( IMB_ ) to run the
00621 *          code with.
00622 *
00623 *  MBXVAL  (global output) INTEGER array
00624 *          On entry,  MBXVAL  is an array of  dimension  LDVAL. On exit,
00625 *          this  array  contains  the values of DESCX( MB_ ) to  run the
00626 *          code with.
00627 *
00628 *  INBXVAL (global output) INTEGER array
00629 *          On entry,  INBXVAL  is an array of  dimension LDVAL. On exit,
00630 *          this  array  contains  the values of DESCX( INB_ ) to run the
00631 *          code with.
00632 *
00633 *  NBXVAL  (global output) INTEGER array
00634 *          On entry,  NBXVAL  is an array of  dimension  LDVAL. On exit,
00635 *          this  array  contains  the values of DESCX( NB_ ) to  run the
00636 *          code with.
00637 *
00638 *  RSCXVAL (global output) INTEGER array
00639 *          On entry, RSCXVAL  is an array of  dimension  LDVAL. On exit,
00640 *          this  array  contains the values of DESCX( RSRC_ ) to run the
00641 *          code with.
00642 *
00643 *  CSCXVAL (global output) INTEGER array
00644 *          On entry, CSCXVAL  is an array of  dimension  LDVAL. On exit,
00645 *          this  array  contains the values of DESCX( CSRC_ ) to run the
00646 *          code with.
00647 *
00648 *  IXVAL   (global output) INTEGER array
00649 *          On entry, IXVAL is an array of dimension LDVAL. On exit, this
00650 *          array  contains the values of IX to run the code with.
00651 *
00652 *  JXVAL   (global output) INTEGER array
00653 *          On entry, JXVAL is an array of dimension LDVAL. On exit, this
00654 *          array  contains the values of JX to run the code with.
00655 *
00656 *  INCXVAL (global output) INTEGER array
00657 *          On entry,  INCXVAL  is  an array of dimension LDVAL. On exit,
00658 *          this array  contains the values of INCX to run the code with.
00659 *
00660 *  MYVAL   (global output) INTEGER array
00661 *          On entry, MYVAL is an array of dimension LDVAL. On exit, this
00662 *          array  contains  the values  of  DESCY( M_ )  to run the code
00663 *          with.
00664 *
00665 *  NYVAL   (global output) INTEGER array
00666 *          On entry, NYVAL is an array of dimension LDVAL. On exit, this
00667 *          array  contains  the values  of  DESCY( N_ )  to run the code
00668 *          with.
00669 *
00670 *  IMBYVAL (global output) INTEGER array
00671 *          On entry,  IMBYVAL  is an array of  dimension LDVAL. On exit,
00672 *          this  array  contains  the values of DESCY( IMB_ ) to run the
00673 *          code with.
00674 *
00675 *  MBYVAL  (global output) INTEGER array
00676 *          On entry,  MBYVAL  is an array of  dimension  LDVAL. On exit,
00677 *          this  array  contains  the values of DESCY( MB_ ) to  run the
00678 *          code with.
00679 *
00680 *  INBYVAL (global output) INTEGER array
00681 *          On entry,  INBYVAL  is an array of  dimension LDVAL. On exit,
00682 *          this  array  contains  the values of DESCY( INB_ ) to run the
00683 *          code with.
00684 *
00685 *  NBYVAL  (global output) INTEGER array
00686 *          On entry,  NBYVAL  is an array of  dimension  LDVAL. On exit,
00687 *          this  array  contains  the values of DESCY( NB_ ) to  run the
00688 *          code with.
00689 *
00690 *  RSCYVAL (global output) INTEGER array
00691 *          On entry, RSCYVAL  is an array of  dimension  LDVAL. On exit,
00692 *          this  array  contains the values of DESCY( RSRC_ ) to run the
00693 *          code with.
00694 *
00695 *  CSCYVAL (global output) INTEGER array
00696 *          On entry, CSCYVAL  is an array of  dimension  LDVAL. On exit,
00697 *          this  array  contains the values of DESCY( CSRC_ ) to run the
00698 *          code with.
00699 *
00700 *  IYVAL   (global output) INTEGER array
00701 *          On entry, IYVAL is an array of dimension LDVAL. On exit, this
00702 *          array  contains the values of IY to run the code with.
00703 *
00704 *  JYVAL   (global output) INTEGER array
00705 *          On entry, JYVAL is an array of dimension LDVAL. On exit, this
00706 *          array  contains the values of JY to run the code with.
00707 *
00708 *  INCYVAL (global output) INTEGER array
00709 *          On entry,  INCYVAL  is  an array of dimension LDVAL. On exit,
00710 *          this array  contains the values of INCY to run the code with.
00711 *
00712 *  LDVAL   (global input) INTEGER
00713 *          On entry, LDVAL specifies the maximum number of different va-
00714 *          lues that can be used for  DESCX(:),  IX, JX, INCX, DESCY(:),
00715 *          IY,  JY  and  INCY.  This  is also the maximum number of test
00716 *          cases.
00717 *
00718 *  NGRIDS  (global output) INTEGER
00719 *          On exit, NGRIDS specifies the number of different values that
00720 *          can be used for P and Q.
00721 *
00722 *  PVAL    (global output) INTEGER array
00723 *          On entry, PVAL is an array of dimension LDPVAL. On exit, this
00724 *          array contains the values of P to run the code with.
00725 *
00726 *  LDPVAL  (global input) INTEGER
00727 *          On entry,  LDPVAL  specifies  the maximum number of different
00728 *          values that can be used for P.
00729 *
00730 *  QVAL    (global output) INTEGER array
00731 *          On entry, QVAL is an array of dimension LDQVAL. On exit, this
00732 *          array contains the values of Q to run the code with.
00733 *
00734 *  LDQVAL  (global input) INTEGER
00735 *          On entry,  LDQVAL  specifies  the maximum number of different
00736 *          values that can be used for Q.
00737 *
00738 *  LTEST   (global output) LOGICAL array
00739 *          On entry,  LTEST  is an array of dimension at least eight. On
00740 *          exit, if LTEST( i ) is .TRUE., the i-th Level 1 PBLAS routine
00741 *          will be tested.  See  the  input file for the ordering of the
00742 *          routines.
00743 *
00744 *  IAM     (local input) INTEGER
00745 *          On entry,  IAM  specifies the number of the process executing
00746 *          this routine.
00747 *
00748 *  NPROCS  (global input) INTEGER
00749 *          On entry, NPROCS specifies the total number of processes.
00750 *
00751 *  ALPHA   (global output) DOUBLE PRECISION
00752 *          On exit, ALPHA specifies the value of alpha to be used in all
00753 *          the test cases.
00754 *
00755 *  WORK    (local workspace) INTEGER array
00756 *          On   entry,   WORK   is   an  array  of  dimension  at  least
00757 *          MAX( 2, 2*NGRIDS+23*NMAT+NSUBS ) with NSUBS = 8.  This  array
00758 *          is  used  to  pack all output arrays in order to send info in
00759 *          one message.
00760 *
00761 *  -- Written on April 1, 1998 by
00762 *     Antoine Petitet, University  of  Tennessee, Knoxville 37996, USA.
00763 *
00764 *  =====================================================================
00765 *
00766 *     .. Parameters ..
00767       INTEGER            NIN, NSUBS
00768       PARAMETER          ( NIN = 11, NSUBS = 8 )
00769 *     ..
00770 *     .. Local Scalars ..
00771       LOGICAL            LTESTT
00772       INTEGER            I, ICTXT, J
00773 *     ..
00774 *     .. Local Arrays ..
00775       CHARACTER*7        SNAMET
00776       CHARACTER*79       USRINFO
00777 *     ..
00778 *     .. External Subroutines ..
00779       EXTERNAL           BLACS_ABORT, BLACS_GET, BLACS_GRIDEXIT,
00780      $                   BLACS_GRIDINIT, BLACS_SETUP, DGEBR2D, DGEBS2D,
00781      $                   ICOPY, IGEBR2D, IGEBS2D, SGEBR2D, SGEBS2D
00782 *     ..
00783 *     .. Intrinsic Functions ..
00784       INTRINSIC          MAX, MIN
00785 *     ..
00786 *     .. Common Blocks ..
00787       CHARACTER*7        SNAMES( NSUBS )
00788       COMMON             /SNAMEC/SNAMES
00789 *     ..
00790 *     .. Executable Statements ..
00791 *
00792 *
00793 *     Process 0 reads the input data, broadcasts to other processes and
00794 *     writes needed information to NOUT
00795 *
00796       IF( IAM.EQ.0 ) THEN
00797 *
00798 *        Open file and skip data file header
00799 *
00800          OPEN( NIN, FILE='PDBLAS1TIM.dat', STATUS='OLD' )
00801          READ( NIN, FMT = * ) SUMMRY
00802          SUMMRY = ' '
00803 *
00804 *        Read in user-supplied info about machine type, compiler, etc.
00805 *
00806          READ( NIN, FMT = 9999 ) USRINFO
00807 *
00808 *        Read name and unit number for summary output file
00809 *
00810          READ( NIN, FMT = * ) SUMMRY
00811          READ( NIN, FMT = * ) NOUT
00812          IF( NOUT.NE.0 .AND. NOUT.NE.6 )
00813      $      OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
00814 *
00815 *        Read and check the parameter values for the tests.
00816 *
00817 *        Get number of grids
00818 *
00819          READ( NIN, FMT = * ) NGRIDS
00820          IF( NGRIDS.LT.1 .OR. NGRIDS.GT.LDPVAL ) THEN
00821             WRITE( NOUT, FMT = 9998 ) 'Grids', LDPVAL
00822             GO TO 100
00823          ELSE IF( NGRIDS.GT.LDQVAL ) THEN
00824             WRITE( NOUT, FMT = 9998 ) 'Grids', LDQVAL
00825             GO TO 100
00826          END IF
00827 *
00828 *        Get values of P and Q
00829 *
00830          READ( NIN, FMT = * ) ( PVAL( I ), I = 1, NGRIDS )
00831          READ( NIN, FMT = * ) ( QVAL( I ), I = 1, NGRIDS )
00832 *
00833 *        Read ALPHA
00834 *
00835          READ( NIN, FMT = * ) ALPHA
00836 *
00837 *        Read number of tests.
00838 *
00839          READ( NIN, FMT = * ) NMAT
00840          IF( NMAT.LT.1 .OR. NMAT.GT.LDVAL ) THEN
00841             WRITE( NOUT, FMT = 9998 ) 'Tests', LDVAL
00842             GO TO 100
00843          END IF
00844 *
00845 *        Read in input data into arrays.
00846 *
00847          READ( NIN, FMT = * ) ( NVAL   ( I ), I = 1, NMAT )
00848          READ( NIN, FMT = * ) ( MXVAL  ( I ), I = 1, NMAT )
00849          READ( NIN, FMT = * ) ( NXVAL  ( I ), I = 1, NMAT )
00850          READ( NIN, FMT = * ) ( IMBXVAL( I ), I = 1, NMAT )
00851          READ( NIN, FMT = * ) ( INBXVAL( I ), I = 1, NMAT )
00852          READ( NIN, FMT = * ) ( MBXVAL ( I ), I = 1, NMAT )
00853          READ( NIN, FMT = * ) ( NBXVAL ( I ), I = 1, NMAT )
00854          READ( NIN, FMT = * ) ( RSCXVAL( I ), I = 1, NMAT )
00855          READ( NIN, FMT = * ) ( CSCXVAL( I ), I = 1, NMAT )
00856          READ( NIN, FMT = * ) ( IXVAL  ( I ), I = 1, NMAT )
00857          READ( NIN, FMT = * ) ( JXVAL  ( I ), I = 1, NMAT )
00858          READ( NIN, FMT = * ) ( INCXVAL( I ), I = 1, NMAT )
00859          READ( NIN, FMT = * ) ( MYVAL  ( I ), I = 1, NMAT )
00860          READ( NIN, FMT = * ) ( NYVAL  ( I ), I = 1, NMAT )
00861          READ( NIN, FMT = * ) ( IMBYVAL( I ), I = 1, NMAT )
00862          READ( NIN, FMT = * ) ( INBYVAL( I ), I = 1, NMAT )
00863          READ( NIN, FMT = * ) ( MBYVAL ( I ), I = 1, NMAT )
00864          READ( NIN, FMT = * ) ( NBYVAL ( I ), I = 1, NMAT )
00865          READ( NIN, FMT = * ) ( RSCYVAL( I ), I = 1, NMAT )
00866          READ( NIN, FMT = * ) ( CSCYVAL( I ), I = 1, NMAT )
00867          READ( NIN, FMT = * ) ( IYVAL  ( I ), I = 1, NMAT )
00868          READ( NIN, FMT = * ) ( JYVAL  ( I ), I = 1, NMAT )
00869          READ( NIN, FMT = * ) ( INCYVAL( I ), I = 1, NMAT )
00870 *
00871 *        Read names of subroutines and flags which indicate
00872 *        whether they are to be tested.
00873 *
00874          DO 10 I = 1, NSUBS
00875             LTEST( I ) = .FALSE.
00876    10    CONTINUE
00877    20    CONTINUE
00878          READ( NIN, FMT = 9996, END = 50 ) SNAMET, LTESTT
00879          DO 30 I = 1, NSUBS
00880             IF( SNAMET.EQ.SNAMES( I ) )
00881      $         GO TO 40
00882    30    CONTINUE
00883 *
00884          WRITE( NOUT, FMT = 9995 )SNAMET
00885          GO TO 100
00886 *
00887    40    CONTINUE
00888          LTEST( I ) = LTESTT
00889          GO TO 20
00890 *
00891    50    CONTINUE
00892 *
00893 *        Close input file
00894 *
00895          CLOSE ( NIN )
00896 *
00897 *        For pvm only: if virtual machine not set up, allocate it and
00898 *        spawn the correct number of processes.
00899 *
00900          IF( NPROCS.LT.1 ) THEN
00901             NPROCS = 0
00902             DO 60 I = 1, NGRIDS
00903                NPROCS = MAX( NPROCS, PVAL( I )*QVAL( I ) )
00904    60       CONTINUE
00905             CALL BLACS_SETUP( IAM, NPROCS )
00906          END IF
00907 *
00908 *        Temporarily define blacs grid to include all processes so
00909 *        information can be broadcast to all processes
00910 *
00911          CALL BLACS_GET( -1, 0, ICTXT )
00912          CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS )
00913 *
00914 *        Pack information arrays and broadcast
00915 *
00916          CALL DGEBS2D( ICTXT, 'All', ' ', 1, 1, ALPHA, 1 )
00917 *
00918          WORK( 1 ) = NGRIDS
00919          WORK( 2 ) = NMAT
00920          CALL IGEBS2D( ICTXT, 'All', ' ', 2, 1, WORK, 2 )
00921 *
00922          I = 1
00923          CALL ICOPY( NGRIDS, PVAL,     1, WORK( I ), 1 )
00924          I = I + NGRIDS
00925          CALL ICOPY( NGRIDS, QVAL,     1, WORK( I ), 1 )
00926          I = I + NGRIDS
00927          CALL ICOPY( NMAT,   NVAL,     1, WORK( I ), 1 )
00928          I = I + NMAT
00929          CALL ICOPY( NMAT,   MXVAL,    1, WORK( I ), 1 )
00930          I = I + NMAT
00931          CALL ICOPY( NMAT,   NXVAL,    1, WORK( I ), 1 )
00932          I = I + NMAT
00933          CALL ICOPY( NMAT,   IMBXVAL,  1, WORK( I ), 1 )
00934          I = I + NMAT
00935          CALL ICOPY( NMAT,   INBXVAL,  1, WORK( I ), 1 )
00936          I = I + NMAT
00937          CALL ICOPY( NMAT,   MBXVAL,   1, WORK( I ), 1 )
00938          I = I + NMAT
00939          CALL ICOPY( NMAT,   NBXVAL,   1, WORK( I ), 1 )
00940          I = I + NMAT
00941          CALL ICOPY( NMAT,   RSCXVAL,  1, WORK( I ), 1 )
00942          I = I + NMAT
00943          CALL ICOPY( NMAT,   CSCXVAL,  1, WORK( I ), 1 )
00944          I = I + NMAT
00945          CALL ICOPY( NMAT,   IXVAL,    1, WORK( I ), 1 )
00946          I = I + NMAT
00947          CALL ICOPY( NMAT,   JXVAL,    1, WORK( I ), 1 )
00948          I = I + NMAT
00949          CALL ICOPY( NMAT,   INCXVAL,  1, WORK( I ), 1 )
00950          I = I + NMAT
00951          CALL ICOPY( NMAT,   MYVAL,    1, WORK( I ), 1 )
00952          I = I + NMAT
00953          CALL ICOPY( NMAT,   NYVAL,    1, WORK( I ), 1 )
00954          I = I + NMAT
00955          CALL ICOPY( NMAT,   IMBYVAL,  1, WORK( I ), 1 )
00956          I = I + NMAT
00957          CALL ICOPY( NMAT,   INBYVAL,  1, WORK( I ), 1 )
00958          I = I + NMAT
00959          CALL ICOPY( NMAT,   MBYVAL,   1, WORK( I ), 1 )
00960          I = I + NMAT
00961          CALL ICOPY( NMAT,   NBYVAL,   1, WORK( I ), 1 )
00962          I = I + NMAT
00963          CALL ICOPY( NMAT,   RSCYVAL,  1, WORK( I ), 1 )
00964          I = I + NMAT
00965          CALL ICOPY( NMAT,   CSCYVAL,  1, WORK( I ), 1 )
00966          I = I + NMAT
00967          CALL ICOPY( NMAT,   IYVAL,    1, WORK( I ), 1 )
00968          I = I + NMAT
00969          CALL ICOPY( NMAT,   JYVAL,    1, WORK( I ), 1 )
00970          I = I + NMAT
00971          CALL ICOPY( NMAT,   INCYVAL,  1, WORK( I ), 1 )
00972          I = I + NMAT
00973 *
00974          DO 70 J = 1, NSUBS
00975             IF( LTEST( J ) ) THEN
00976                WORK( I ) = 1
00977             ELSE
00978                WORK( I ) = 0
00979             END IF
00980             I = I + 1
00981    70    CONTINUE
00982          I = I - 1
00983          CALL IGEBS2D( ICTXT, 'All', ' ', I, 1, WORK, I )
00984 *
00985 *        regurgitate input
00986 *
00987          WRITE( NOUT, FMT = 9999 )
00988      $               'Level 1 PBLAS timing program.'
00989          WRITE( NOUT, FMT = 9999 ) USRINFO
00990          WRITE( NOUT, FMT = * )
00991          WRITE( NOUT, FMT = 9999 )
00992      $               'Timing of the real double precision '//
00993      $               'Level 1 PBLAS'
00994          WRITE( NOUT, FMT = * )
00995          WRITE( NOUT, FMT = 9999 )
00996      $               'The following parameter values will be used:'
00997          WRITE( NOUT, FMT = * )
00998          WRITE( NOUT, FMT = 9993 ) NMAT
00999          WRITE( NOUT, FMT = 9992 ) NGRIDS
01000          WRITE( NOUT, FMT = 9990 )
01001      $               'P', ( PVAL(I), I = 1, MIN(NGRIDS, 5) )
01002          IF( NGRIDS.GT.5 )
01003      $      WRITE( NOUT, FMT = 9991 ) ( PVAL(I), I = 6,
01004      $                                  MIN( 10, NGRIDS ) )
01005          IF( NGRIDS.GT.10 )
01006      $      WRITE( NOUT, FMT = 9991 ) ( PVAL(I), I = 11,
01007      $                                  MIN( 15, NGRIDS ) )
01008          IF( NGRIDS.GT.15 )
01009      $      WRITE( NOUT, FMT = 9991 ) ( PVAL(I), I = 16, NGRIDS )
01010          WRITE( NOUT, FMT = 9990 )
01011      $               'Q', ( QVAL(I), I = 1, MIN(NGRIDS, 5) )
01012          IF( NGRIDS.GT.5 )
01013      $      WRITE( NOUT, FMT = 9991 ) ( QVAL(I), I = 6,
01014      $                                  MIN( 10, NGRIDS ) )
01015          IF( NGRIDS.GT.10 )
01016      $      WRITE( NOUT, FMT = 9991 ) ( QVAL(I), I = 11,
01017      $                                  MIN( 15, NGRIDS ) )
01018          IF( NGRIDS.GT.15 )
01019      $      WRITE( NOUT, FMT = 9991 ) ( QVAL(I), I = 16, NGRIDS )
01020          WRITE( NOUT, FMT = 9994 ) ALPHA
01021          IF( LTEST( 1 ) ) THEN
01022             WRITE( NOUT, FMT = 9989 ) SNAMES( 1 ), ' ... Yes'
01023          ELSE
01024             WRITE( NOUT, FMT = 9989 ) SNAMES( 1 ), ' ... No '
01025          END IF
01026          DO 80 I = 2, NSUBS
01027             IF( LTEST( I ) ) THEN
01028                WRITE( NOUT, FMT = 9988 ) SNAMES( I ), ' ... Yes'
01029             ELSE
01030                WRITE( NOUT, FMT = 9988 ) SNAMES( I ), ' ... No '
01031             END IF
01032    80    CONTINUE
01033          WRITE( NOUT, FMT = * )
01034 *
01035       ELSE
01036 *
01037 *        If in pvm, must participate setting up virtual machine
01038 *
01039          IF( NPROCS.LT.1 )
01040      $      CALL BLACS_SETUP( IAM, NPROCS )
01041 *
01042 *        Temporarily define blacs grid to include all processes so
01043 *        information can be broadcast to all processes
01044 *
01045          CALL BLACS_GET( -1, 0, ICTXT )
01046          CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS )
01047 *
01048          CALL DGEBR2D( ICTXT, 'All', ' ', 1, 1, ALPHA, 1, 0, 0 )
01049 *
01050          CALL IGEBR2D( ICTXT, 'All', ' ', 2, 1, WORK, 2, 0, 0 )
01051          NGRIDS = WORK( 1 )
01052          NMAT   = WORK( 2 )
01053 *
01054          I = 2*NGRIDS + 23*NMAT + NSUBS
01055          CALL IGEBR2D( ICTXT, 'All', ' ', I, 1, WORK, I, 0, 0 )
01056 *
01057          I = 1
01058          CALL ICOPY( NGRIDS, WORK( I ), 1, PVAL,     1 )
01059          I = I + NGRIDS
01060          CALL ICOPY( NGRIDS, WORK( I ), 1, QVAL,     1 )
01061          I = I + NGRIDS
01062          CALL ICOPY( NMAT,   WORK( I ), 1, NVAL,     1 )
01063          I = I + NMAT
01064          CALL ICOPY( NMAT,   WORK( I ), 1, MXVAL,    1 )
01065          I = I + NMAT
01066          CALL ICOPY( NMAT,   WORK( I ), 1, NXVAL,    1 )
01067          I = I + NMAT
01068          CALL ICOPY( NMAT,   WORK( I ), 1, IMBXVAL,  1 )
01069          I = I + NMAT
01070          CALL ICOPY( NMAT,   WORK( I ), 1, INBXVAL,  1 )
01071          I = I + NMAT
01072          CALL ICOPY( NMAT,   WORK( I ), 1, MBXVAL,   1 )
01073          I = I + NMAT
01074          CALL ICOPY( NMAT,   WORK( I ), 1, NBXVAL,   1 )
01075          I = I + NMAT
01076          CALL ICOPY( NMAT,   WORK( I ), 1, RSCXVAL,  1 )
01077          I = I + NMAT
01078          CALL ICOPY( NMAT,   WORK( I ), 1, CSCXVAL,  1 )
01079          I = I + NMAT
01080          CALL ICOPY( NMAT,   WORK( I ), 1, IXVAL,    1 )
01081          I = I + NMAT
01082          CALL ICOPY( NMAT,   WORK( I ), 1, JXVAL,    1 )
01083          I = I + NMAT
01084          CALL ICOPY( NMAT,   WORK( I ), 1, INCXVAL,  1 )
01085          I = I + NMAT
01086          CALL ICOPY( NMAT,   WORK( I ), 1, MYVAL,    1 )
01087          I = I + NMAT
01088          CALL ICOPY( NMAT,   WORK( I ), 1, NYVAL,    1 )
01089          I = I + NMAT
01090          CALL ICOPY( NMAT,   WORK( I ), 1, IMBYVAL,  1 )
01091          I = I + NMAT
01092          CALL ICOPY( NMAT,   WORK( I ), 1, INBYVAL,  1 )
01093          I = I + NMAT
01094          CALL ICOPY( NMAT,   WORK( I ), 1, MBYVAL,   1 )
01095          I = I + NMAT
01096          CALL ICOPY( NMAT,   WORK( I ), 1, NBYVAL,   1 )
01097          I = I + NMAT
01098          CALL ICOPY( NMAT,   WORK( I ), 1, RSCYVAL,  1 )
01099          I = I + NMAT
01100          CALL ICOPY( NMAT,   WORK( I ), 1, CSCYVAL,  1 )
01101          I = I + NMAT
01102          CALL ICOPY( NMAT,   WORK( I ), 1, IYVAL,    1 )
01103          I = I + NMAT
01104          CALL ICOPY( NMAT,   WORK( I ), 1, JYVAL,    1 )
01105          I = I + NMAT
01106          CALL ICOPY( NMAT,   WORK( I ), 1, INCYVAL,  1 )
01107          I = I + NMAT
01108 *
01109          DO 90 J = 1, NSUBS
01110             IF( WORK( I ).EQ.1 ) THEN
01111                LTEST( J ) = .TRUE.
01112             ELSE
01113                LTEST( J ) = .FALSE.
01114             END IF
01115             I = I + 1
01116    90    CONTINUE
01117 *
01118       END IF
01119 *
01120       CALL BLACS_GRIDEXIT( ICTXT )
01121 *
01122       RETURN
01123 *
01124   100 WRITE( NOUT, FMT = 9997 )
01125       CLOSE( NIN )
01126       IF( NOUT.NE.6 .AND. NOUT.NE.0 )
01127      $   CLOSE( NOUT )
01128       CALL BLACS_ABORT( ICTXT, 1 )
01129 *
01130       STOP
01131 *
01132  9999 FORMAT( A )
01133  9998 FORMAT( ' Number of values of ',5A, ' is less than 1 or greater ',
01134      $        'than ', I2 )
01135  9997 FORMAT( ' Illegal input in file ',40A,'.  Aborting run.' )
01136  9996 FORMAT( A7, L2 )
01137  9995 FORMAT( '  Subprogram name ', A7, ' not recognized',
01138      $        /' ******* TESTS ABANDONED *******' )
01139  9994 FORMAT( 2X, 'Alpha                     : ', G16.6 )
01140  9993 FORMAT( 2X, 'Number of Tests           : ', I6 )
01141  9992 FORMAT( 2X, 'Number of process grids   : ', I6 )
01142  9991 FORMAT( 2X, '                          : ', 5I6 )
01143  9990 FORMAT( 2X, A1, '                         : ', 5I6 )
01144  9989 FORMAT( 2X, 'Routines to be tested     :      ', A, A8 )
01145  9988 FORMAT( 2X, '                                 ', A, A8 )
01146 *
01147 *     End of PDBLA1TIMINFO
01148 *
01149       END