ScaLAPACK  2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
psnepdriver.f
Go to the documentation of this file.
00001       PROGRAM PSNEPDRIVER
00002 *
00003 *  -- ScaLAPACK testing driver (version 1.7) --
00004 *     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
00005 *     and University of California, Berkeley.
00006 *     May 1, 1997
00007 *
00008 *  Purpose
00009 *  =======
00010 *
00011 *  PSNEPDRIVER is the main test program for the REAL            
00012 *  SCALAPACK NEP routines.  This test driver performs a Schur
00013 *  decomposition followed by residual check of a Hessenberg matrix.
00014 *
00015 *  The program must be driven by a short data file.  An annotated
00016 *  example of a data file can be obtained by deleting the first 3
00017 *  characters from the following 18 lines:
00018 *  'SCALAPACK, Version 1.4, NEP (Nonsymmetric EigenProblem) input file'
00019 *  'Intel iPSC/860 hypercube, gamma model.'
00020 *  'NEP.out'            output file name (if any)
00021 *  6                    device out
00022 *  8                    number of problems sizes
00023 *  1 2 3 4 6 10 100 200 vales of N
00024 *  3                    number of NB's
00025 *  6 20 40              values of NB
00026 *  4                    number of process grids (ordered pairs of P & Q)
00027 *  1 2 1 4              values of P
00028 *  1 2 4 1              values of Q
00029 *  20.0                 threshold
00030 *
00031 *  Internal Parameters
00032 *  ===================
00033 *
00034 *  TOTMEM   INTEGER, default = 2000000
00035 *           TOTMEM is a machine-specific parameter indicating the
00036 *           maximum amount of available memory in bytes.
00037 *           The user should customize TOTMEM to his platform.  Remember
00038 *           to leave room in memory for the operating system, the BLACS
00039 *           buffer, etc.  For example, on a system with 8 MB of memory
00040 *           per process (e.g., one processor on an Intel iPSC/860), the
00041 *           parameters we use are TOTMEM=6200000 (leaving 1.8 MB for OS,
00042 *           code, BLACS buffer, etc).  However, for PVM, we usually set
00043 *           TOTMEM = 2000000.  Some experimenting with the maximum value
00044 *           of TOTMEM may be required.
00045 *
00046 *  REALSZ   INTEGER, default = 4 bytes.
00047 *           REALSZ indicate the length in bytes on the given platform
00048 *           for a real element.
00049 *  MEM      REAL array, dimension ( TOTMEM / REALSZ )
00050 *
00051 *           All arrays used by SCALAPACK routines are allocated from
00052 *           this array and referenced by pointers.  The integer IPA,
00053 *           for example, is a pointer to the starting element of MEM for
00054 *           the matrix A.
00055 *
00056 *  =====================================================================
00057 *
00058 *     .. Parameters ..
00059       INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DT_,
00060      $                   LLD_, MB_, M_, NB_, N_, RSRC_
00061       PARAMETER          ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DT_ = 1,
00062      $                     CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
00063      $                     RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
00064       INTEGER            REALSZ, TOTMEM, MEMSIZ, NTESTS
00065       REAL               PADVAL, ZERO, ONE
00066       PARAMETER          ( REALSZ = 4, TOTMEM = 2000000,
00067      $                   MEMSIZ = TOTMEM / REALSZ, NTESTS = 20,
00068      $                   PADVAL = -9923.0E+0, ZERO = 0.0E+0,
00069      $                   ONE = 1.0E+0 )
00070 *     ..
00071 *     .. Local Scalars ..
00072       LOGICAL            CHECK
00073       CHARACTER*6        PASSED
00074       CHARACTER*80       OUTFILE
00075       INTEGER            I, IAM, IASEED, ICTXT, III, IMIDPAD, INFO, IPA,
00076      $                   IPOSTPAD, IPREPAD, IPW, IPWI, IPWR, IPZ, J, K,
00077      $                   KFAIL, KPASS, KSKIP, KTESTS, LDA, LDZ, LWORK,
00078      $                   MYCOL, MYROW, N, NB, NGRIDS, NMAT, NNB, NOUT,
00079      $                   NP, NPCOL, NPROCS, NPROW, NQ, WORKSIZ
00080       REAL               THRESH
00081       REAL               ANORM, FRESID, QRESID, ZNORM
00082       DOUBLE PRECISION   NOPS, TMFLOPS
00083 *     ..
00084 *     .. Local Arrays ..
00085       INTEGER            DESCA( DLEN_ ), DESCZ( DLEN_ ), IERR( 2 ),
00086      $                   IDUM( 1 ), NBVAL( NTESTS ), NVAL( NTESTS ),
00087      $                   PVAL( NTESTS ), QVAL( NTESTS )
00088       REAL               MEM ( MEMSIZ ) 
00089       DOUBLE PRECISION   CTIME( 1 ), WTIME( 1 )
00090 *     ..
00091 *     .. External Subroutines ..
00092       EXTERNAL           BLACS_BARRIER, BLACS_EXIT, BLACS_GET,
00093      $                   BLACS_GRIDEXIT, BLACS_GRIDINFO, BLACS_GRIDINIT,
00094      $                   BLACS_PINFO, DESCINIT, IGSUM2D, PSCHEKPAD,
00095      $                   PSFILLPAD, PSGEMM, PSLAHQR, PSLASET, PSMATGEN,
00096      $                   PSNEPFCHK, PSNEPINFO, SLBOOT, SLCOMBINE,
00097      $                   SLTIMER
00098 *     ..
00099 *     .. External Functions ..
00100       INTEGER            ILCM, NUMROC
00101       REAL               PSLAMCH, PSLANGE, PSLANHS
00102       EXTERNAL           ILCM, NUMROC, PSLAMCH, PSLANGE, PSLANHS
00103 *     ..
00104 *     .. Intrinsic Functions ..
00105       INTRINSIC          DBLE, MAX, MIN, REAL
00106 *     ..
00107 *     .. Data statements ..
00108       DATA               KFAIL, KPASS, KSKIP, KTESTS / 4*0 /
00109 *     ..
00110 *     .. Executable Statements ..
00111 *
00112 *     Get starting information
00113 *
00114       CALL BLACS_PINFO( IAM, NPROCS )
00115       IASEED = 100
00116       CALL PSNEPINFO( OUTFILE, NOUT, NMAT, NVAL, NTESTS, NNB, NBVAL,
00117      $                NTESTS, NGRIDS, PVAL, NTESTS, QVAL, NTESTS,
00118      $                THRESH, MEM, IAM, NPROCS )
00119       CHECK = ( THRESH.GE.0.0E+0 )
00120 *
00121 *     Print headings
00122 *
00123       IF( IAM.EQ.0 ) THEN
00124          WRITE( NOUT, FMT = * )
00125          WRITE( NOUT, FMT = 9995 )
00126          WRITE( NOUT, FMT = 9994 )
00127          WRITE( NOUT, FMT = * )
00128       END IF
00129 *
00130 *     Loop over different process grids
00131 *
00132       DO 30 I = 1, NGRIDS
00133 *
00134          NPROW = PVAL( I )
00135          NPCOL = QVAL( I )
00136 *
00137 *        Make sure grid information is correct
00138 *
00139          IERR( 1 ) = 0
00140          IF( NPROW.LT.1 ) THEN
00141             IF( IAM.EQ.0 )
00142      $         WRITE( NOUT, FMT = 9999 )'GRID', 'nprow', NPROW
00143             IERR( 1 ) = 1
00144          ELSE IF( NPCOL.LT.1 ) THEN
00145             IF( IAM.EQ.0 )
00146      $         WRITE( NOUT, FMT = 9999 )'GRID', 'npcol', NPCOL
00147             IERR( 1 ) = 1
00148          ELSE IF( NPROW*NPCOL.GT.NPROCS ) THEN
00149             IF( IAM.EQ.0 )
00150      $         WRITE( NOUT, FMT = 9998 )NPROW*NPCOL, NPROCS
00151             IERR( 1 ) = 1
00152          END IF
00153 *
00154          IF( IERR( 1 ).GT.0 ) THEN
00155             IF( IAM.EQ.0 )
00156      $         WRITE( NOUT, FMT = 9997 )'grid'
00157             KSKIP = KSKIP + 1
00158             GO TO 30
00159          END IF
00160 *
00161 *        Define process grid
00162 *
00163          CALL BLACS_GET( -1, 0, ICTXT )
00164          CALL BLACS_GRIDINIT( ICTXT, 'Row-major', NPROW, NPCOL )
00165          CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
00166 *
00167 *        Go to bottom of process grid loop if this case doesn't use my
00168 *        process
00169 *
00170          IF( MYROW.GE.NPROW .OR. MYCOL.GE.NPCOL )
00171      $      GO TO 30
00172 *
00173          DO 20 J = 1, NMAT
00174 *
00175             N = NVAL( J )
00176 *
00177 *           Make sure matrix information is correct
00178 *
00179             IERR( 1 ) = 0
00180             IF( N.LT.1 ) THEN
00181                IF( IAM.EQ.0 )
00182      $            WRITE( NOUT, FMT = 9999 )'MATRIX', 'N', N
00183                IERR( 1 ) = 1
00184             END IF
00185 *
00186 *           Check all processes for an error
00187 *
00188             CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1, 0 )
00189 *
00190             IF( IERR( 1 ).GT.0 ) THEN
00191                IF( IAM.EQ.0 )
00192      $            WRITE( NOUT, FMT = 9997 )'matrix'
00193                KSKIP = KSKIP + 1
00194                GO TO 20
00195             END IF
00196 *
00197             DO 10 K = 1, NNB
00198 *
00199                NB = NBVAL( K )
00200 *
00201 *              Make sure nb is legal
00202 *
00203                IERR( 1 ) = 0
00204                IF( NB.LT.6 ) THEN
00205                   IERR( 1 ) = 1
00206                   IF( IAM.EQ.0 )
00207      $               WRITE( NOUT, FMT = 9999 )'NB', 'NB', NB
00208                END IF
00209 *
00210 *              Check all processes for an error
00211 *
00212                CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1, 0 )
00213 *
00214                IF( IERR( 1 ).GT.0 ) THEN
00215                   IF( IAM.EQ.0 )
00216      $               WRITE( NOUT, FMT = 9997 )'NB'
00217                   KSKIP = KSKIP + 1
00218                   GO TO 10
00219                END IF
00220 *
00221 *              Padding constants
00222 *
00223                NP = NUMROC( N, NB, MYROW, 0, NPROW )
00224                NQ = NUMROC( N, NB, MYCOL, 0, NPCOL )
00225                IF( CHECK ) THEN
00226                   IPREPAD = MAX( NB, NP )
00227                   IMIDPAD = NB
00228                   IPOSTPAD = MAX( NB, NQ )
00229                   IPREPAD = IPREPAD + 1000
00230                   IMIDPAD = IMIDPAD + 1000
00231                   IPOSTPAD = IPOSTPAD + 1000                  
00232                ELSE
00233                   IPREPAD = 0
00234                   IMIDPAD = 0
00235                   IPOSTPAD = 0
00236                END IF
00237 *
00238 *              Initialize the array descriptor for the matrix A
00239 *
00240                CALL DESCINIT( DESCA, N, N, NB, NB, 0, 0, ICTXT,
00241      $                        MAX( 1, NP )+IMIDPAD, IERR( 1 ) )
00242 *
00243 *              Initialize the array descriptor for the matrix Z
00244 *
00245                CALL DESCINIT( DESCZ, N, N, NB, NB, 0, 0, ICTXT,
00246      $                        MAX( 1, NP )+IMIDPAD, IERR( 2 ) )
00247 *
00248                LDA = DESCA( LLD_ )
00249                LDZ = DESCZ( LLD_ )
00250 *
00251 *              Check all processes for an error
00252 *
00253                CALL IGSUM2D( ICTXT, 'All', ' ', 2, 1, IERR, 2, -1, 0 )
00254 *
00255                IF( IERR( 1 ).LT.0 .OR. IERR( 2 ).LT.0 ) THEN
00256                   IF( IAM.EQ.0 )
00257      $               WRITE( NOUT, FMT = 9997 )'descriptor'
00258                   KSKIP = KSKIP + 1
00259                   GO TO 10
00260                END IF
00261 *
00262 *              Assign pointers into MEM for SCALAPACK arrays, A is
00263 *              allocated starting at position MEM( IPREPAD+1 )
00264 *
00265                IPA = IPREPAD + 1
00266                IPZ = IPA + DESCA( LLD_ )*NQ + IPOSTPAD + IPREPAD
00267                IPWR = IPZ + DESCZ( LLD_ )*NQ + IPOSTPAD + IPREPAD
00268                IPWI = IPWR + N + IPOSTPAD + IPREPAD
00269                IPW = IPWI + N + IPOSTPAD + IPREPAD
00270                III = N / NB
00271                IF( III*NB.LT.N )
00272      $            III = III + 1
00273                III = 7*III / ILCM( NPROW, NPCOL )
00274 *
00275 *
00276                LWORK = 3*N + MAX( 2*MAX( LDA, LDZ )+2*NQ, III )
00277                LWORK = LWORK + MAX(2*N, (8*ILCM(NPROW,NPCOL)+2)**2 )
00278 *
00279                IF( CHECK ) THEN
00280 *
00281 *                 Figure the amount of workspace required by the
00282 *                 checking routines PSNEPFCHK and PSLANHS
00283 *
00284                   WORKSIZ = LWORK + MAX( NP*DESCA( NB_ ),
00285      $                      DESCA( MB_ )*NQ ) + IPOSTPAD
00286 *
00287                ELSE
00288 *
00289                   WORKSIZ = LWORK + IPOSTPAD
00290 *
00291                END IF
00292 *
00293 *              Check for adequate memory for problem size
00294 *
00295                IERR( 1 ) = 0
00296                IF( IPW+WORKSIZ.GT.MEMSIZ ) THEN
00297                   IF( IAM.EQ.0 )
00298      $               WRITE( NOUT, FMT = 9996 )'Schur reduction',
00299      $               ( IPW+WORKSIZ )*REALSZ
00300                   IERR( 1 ) = 1
00301                END IF
00302 *
00303 *              Check all processes for an error
00304 *
00305                CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1, 0 )
00306 *
00307                IF( IERR( 1 ).GT.0 ) THEN
00308                   IF( IAM.EQ.0 )
00309      $               WRITE( NOUT, FMT = 9997 )'MEMORY'
00310                   KSKIP = KSKIP + 1
00311                   GO TO 10
00312                END IF
00313 *
00314 *              Generate matrix Z = In
00315 *
00316                CALL PSLASET( 'All', N, N, ZERO, ONE, MEM( IPZ ), 1, 1,
00317      $                       DESCZ )
00318 *
00319 *              Generate matrix A upper Hessenberg
00320 *
00321                CALL PSMATGEN( ICTXT, 'No transpose', 'No transpose',
00322      $                        DESCA( M_ ), DESCA( N_ ), DESCA( MB_ ),
00323      $                        DESCA( NB_ ), MEM( IPA ), DESCA( LLD_ ),
00324      $                        DESCA( RSRC_ ), DESCA( CSRC_ ), IASEED, 0,
00325      $                        NP, 0, NQ, MYROW, MYCOL, NPROW, NPCOL )
00326                CALL PSLASET( 'Lower', MAX( 0, N-2 ), MAX( 0, N-2 ),
00327      $                       ZERO, ZERO, MEM( IPA ), MIN( N, 3 ), 1,
00328      $                       DESCA )
00329 *
00330 *              Calculate inf-norm of A for residual error-checking
00331 *
00332                IF( CHECK ) THEN
00333                   CALL PSFILLPAD( ICTXT, NP, NQ, MEM( IPA-IPREPAD ),
00334      $                            DESCA( LLD_ ), IPREPAD, IPOSTPAD,
00335      $                            PADVAL )
00336                   CALL PSFILLPAD( ICTXT, NP, NQ, MEM( IPZ-IPREPAD ),
00337      $                            DESCZ( LLD_ ), IPREPAD, IPOSTPAD,
00338      $                            PADVAL )
00339                   CALL PSFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
00340      $                            MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
00341      $                            IPREPAD, IPOSTPAD, PADVAL )
00342                   ANORM = PSLANHS( 'I', N, MEM( IPA ), 1, 1, DESCA,
00343      $                    MEM( IPW ) )
00344                   CALL PSCHEKPAD( ICTXT, 'PSLANHS', NP, NQ,
00345      $                            MEM( IPA-IPREPAD ), DESCA( LLD_ ),
00346      $                            IPREPAD, IPOSTPAD, PADVAL )
00347                   CALL PSCHEKPAD( ICTXT, 'PSLANHS', WORKSIZ-IPOSTPAD, 1,
00348      $                            MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
00349      $                            IPREPAD, IPOSTPAD, PADVAL )
00350 *
00351                   CALL PSFILLPAD( ICTXT, N, 1, MEM( IPWR-IPREPAD ), N,
00352      $                            IPREPAD, IPOSTPAD, PADVAL )
00353                   CALL PSFILLPAD( ICTXT, N, 1, MEM( IPWI-IPREPAD ), N,
00354      $                            IPREPAD, IPOSTPAD, PADVAL )
00355                   CALL PSFILLPAD( ICTXT, LWORK, 1, MEM( IPW-IPREPAD ),
00356      $                            LWORK, IPREPAD, IPOSTPAD, PADVAL )
00357 *
00358                END IF
00359 *
00360                CALL SLBOOT( )
00361                CALL BLACS_BARRIER( ICTXT, 'All' )
00362                CALL SLTIMER( 1 )
00363 *
00364 *              Perform NEP factorization
00365 *
00366                CALL PSLAHQR( .TRUE., .TRUE., N, 1, N, MEM( IPA ), DESCA,
00367      $                       MEM( IPWR ), MEM( IPWI ), 1, N, MEM( IPZ ),
00368      $                       DESCZ, MEM( IPW ), LWORK, IDUM, 0, INFO )
00369 *
00370                CALL SLTIMER( 1 )
00371 *
00372                IF( INFO.NE.0 ) THEN
00373                   IF( IAM.EQ.0 )
00374      $               WRITE( NOUT, FMT = * )'PSLAHQR INFO=', INFO
00375                   KFAIL = KFAIL + 1
00376                   GO TO 10
00377                END IF
00378 *
00379                IF( CHECK ) THEN
00380 *
00381 *                 Check for memory overwrite in NEP factorization
00382 *
00383                   CALL PSCHEKPAD( ICTXT, 'PSLAHQR (A)', NP, NQ,
00384      $                            MEM( IPA-IPREPAD ), DESCA( LLD_ ),
00385      $                            IPREPAD, IPOSTPAD, PADVAL )
00386                   CALL PSCHEKPAD( ICTXT, 'PSLAHQR (Z)', NP, NQ,
00387      $                            MEM( IPZ-IPREPAD ), DESCZ( LLD_ ),
00388      $                            IPREPAD, IPOSTPAD, PADVAL )
00389                   CALL PSCHEKPAD( ICTXT, 'PSLAHQR (WR)', N, 1,
00390      $                            MEM( IPWR-IPREPAD ), N, IPREPAD,
00391      $                            IPOSTPAD, PADVAL )
00392                   CALL PSCHEKPAD( ICTXT, 'PSLAHQR (WI)', N, 1,
00393      $                            MEM( IPWI-IPREPAD ), N, IPREPAD,
00394      $                            IPOSTPAD, PADVAL )
00395                   CALL PSCHEKPAD( ICTXT, 'PSLAHQR (WORK)', LWORK, 1,
00396      $                            MEM( IPW-IPREPAD ), LWORK, IPREPAD,
00397      $                            IPOSTPAD, PADVAL )
00398 *
00399                   CALL PSFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
00400      $                            MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
00401      $                            IPREPAD, IPOSTPAD, PADVAL )
00402 *
00403 *                 Compute || Z * H * Z**T - H0 || / ( N*|| H0 ||*EPS )
00404 *
00405                   CALL PSNEPFCHK( N, MEM( IPA ), 1, 1, DESCA, IASEED,
00406      $                            MEM( IPZ ), 1, 1, DESCZ, ANORM,
00407      $                            FRESID, MEM( IPW ) )
00408 *
00409                   CALL PSCHEKPAD( ICTXT, 'PSNEPFCHK (A)', NP, NQ,
00410      $                            MEM( IPA-IPREPAD ), DESCA( LLD_ ),
00411      $                            IPREPAD, IPOSTPAD, PADVAL )
00412                   CALL PSCHEKPAD( ICTXT, 'PSNEPFCHK (Z)', NP, NQ,
00413      $                            MEM( IPZ-IPREPAD ), DESCZ( LLD_ ),
00414      $                            IPREPAD, IPOSTPAD, PADVAL )
00415                   CALL PSCHEKPAD( ICTXT, 'PSNEPFCHK (WORK)',
00416      $                            WORKSIZ-IPOSTPAD, 1,
00417      $                            MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
00418      $                            IPREPAD, IPOSTPAD, PADVAL )
00419 *
00420 *                 Compute || (Z**T)*Z - In ||_1
00421 *
00422                   CALL PSLASET( 'All', N, N, ZERO, ONE, MEM( IPA ), 1,
00423      $                          1, DESCA )
00424                   CALL PSGEMM( 'Transpose', 'No transpose', N, N, N,
00425      $                         -ONE, MEM( IPZ ), 1, 1, DESCZ,
00426      $                         MEM( IPZ ), 1, 1, DESCZ, ONE, MEM( IPA ),
00427      $                         1, 1, DESCA )
00428                   ZNORM = PSLANGE( '1', N, N, MEM( IPA ), 1, 1, DESCA,
00429      $                    MEM( IPW ) )
00430                   QRESID = ZNORM / ( REAL( N )*PSLAMCH( ICTXT, 'P' ) )
00431 *
00432 *                 Test residual and detect NaN result
00433 *
00434                   IF( ( FRESID.LE.THRESH ) .AND.
00435      $                ( ( FRESID-FRESID ).EQ.0.0E+0 ) .AND.
00436      $                ( QRESID.LE.THRESH ) .AND.
00437      $                ( ( QRESID-QRESID ).EQ.0.0E+0 ) ) THEN
00438                      KPASS = KPASS + 1
00439                      PASSED = 'PASSED'
00440                   ELSE
00441                      KFAIL = KFAIL + 1
00442                      PASSED = 'FAILED'
00443                      IF( IAM.EQ.0 ) THEN
00444                         WRITE( NOUT, FMT = 9986 )FRESID
00445                         WRITE( NOUT, FMT = 9985 )QRESID
00446                      END IF
00447                   END IF
00448 *
00449                ELSE
00450 *
00451 *                 Don't perform the checking, only timing
00452 *
00453                   KPASS = KPASS + 1
00454                   FRESID = FRESID - FRESID
00455                   QRESID = QRESID - QRESID
00456                   PASSED = 'BYPASS'
00457 *
00458                END IF
00459 *
00460 *              Gather maximum of all CPU and WALL clock timings
00461 *
00462                CALL SLCOMBINE( ICTXT, 'All', '>', 'W', 1, 1, WTIME )
00463                CALL SLCOMBINE( ICTXT, 'All', '>', 'C', 1, 1, CTIME )
00464 *
00465 *              Print results
00466 *
00467                IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
00468 *
00469 *                 18 N^3 flops for PxLAHQR
00470 *
00471                   NOPS = 18.0D+0*DBLE( N )**3
00472 *
00473 *                 Calculate total megaflops -- factorization only,
00474 *                 -- for WALL and CPU time, and print output
00475 *
00476 *                 Print WALL time if machine supports it
00477 *
00478                   IF( WTIME( 1 ).GT.0.0D+0 ) THEN
00479                      TMFLOPS = NOPS / ( WTIME( 1 )*1.0D+6 )
00480                   ELSE
00481                      TMFLOPS = 0.0D+0
00482                   END IF
00483                   IF( WTIME( 1 ).GE.0.0D+0 )
00484      $               WRITE( NOUT, FMT = 9993 )'WALL', N, NB, NPROW,
00485      $               NPCOL, WTIME( 1 ), TMFLOPS, PASSED
00486 *
00487 *                 Print CPU time if machine supports it
00488 *
00489                   IF( CTIME( 1 ).GT.0.0D+0 ) THEN
00490                      TMFLOPS = NOPS / ( CTIME( 1 )*1.0D+6 )
00491                   ELSE
00492                      TMFLOPS = 0.0D+0
00493                   END IF
00494 *
00495                   IF( CTIME( 1 ).GE.0.0D+0 )
00496      $               WRITE( NOUT, FMT = 9993 )'CPU ', N, NB, NPROW,
00497      $               NPCOL, CTIME( 1 ), TMFLOPS, PASSED
00498                END IF
00499 *
00500    10       CONTINUE
00501 *
00502    20    CONTINUE
00503 *
00504          CALL BLACS_GRIDEXIT( ICTXT )
00505 *
00506    30 CONTINUE
00507 *
00508 *     Print ending messages and close output file
00509 *
00510       IF( IAM.EQ.0 ) THEN
00511          KTESTS = KPASS + KFAIL + KSKIP
00512          WRITE( NOUT, FMT = * )
00513          WRITE( NOUT, FMT = 9992 )KTESTS
00514          IF( CHECK ) THEN
00515             WRITE( NOUT, FMT = 9991 )KPASS
00516             WRITE( NOUT, FMT = 9989 )KFAIL
00517          ELSE
00518             WRITE( NOUT, FMT = 9990 )KPASS
00519          END IF
00520          WRITE( NOUT, FMT = 9988 )KSKIP
00521          WRITE( NOUT, FMT = * )
00522          WRITE( NOUT, FMT = * )
00523          WRITE( NOUT, FMT = 9987 )
00524          IF( NOUT.NE.6 .AND. NOUT.NE.0 )
00525      $      CLOSE ( NOUT )
00526       END IF
00527 *
00528       CALL BLACS_EXIT( 0 )
00529 *
00530  9999 FORMAT( 'ILLEGAL ', A6, ': ', A5, ' = ', I3,
00531      $      '; It should be at least 1' )
00532  9998 FORMAT( 'ILLEGAL GRID: nprow*npcol = ', I4, '. It can be at most',
00533      $      I4 )
00534  9997 FORMAT( 'Bad ', A6, ' parameters: going on to next test case.' )
00535  9996 FORMAT( 'Unable to perform ', A, ': need TOTMEM of at least',
00536      $      I11 )
00537  9995 FORMAT( 'TIME     N  NB    P    Q NEP Time   MFLOPS  CHECK' )
00538  9994 FORMAT( '---- ----- --- ---- ---- -------- -------- ------' )
00539  9993 FORMAT( A4, 1X, I5, 1X, I3, 1X, I4, 1X, I4, 1X, F8.2, 1X, F8.2,
00540      $      1X, A6 )
00541  9992 FORMAT( 'Finished ', I6, ' tests, with the following results:' )
00542  9991 FORMAT( I5, ' tests completed and passed residual checks.' )
00543  9990 FORMAT( I5, ' tests completed without checking.' )
00544  9989 FORMAT( I5, ' tests completed and failed residual checks.' )
00545  9988 FORMAT( I5, ' tests skipped because of illegal input values.' )
00546  9987 FORMAT( 'END OF TESTS.' )
00547  9986 FORMAT( '||H - Q*S*Q^T|| / (||H|| * N * eps) = ', G25.7 )
00548  9985 FORMAT( '||Q^T*Q - I|| / ( N * eps ) ', G25.7 )
00549 *
00550       STOP
00551 *
00552 *     End of PSNEPDRIVER
00553 *
00554       END