ScaLAPACK  2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
pzinvdriver.f
Go to the documentation of this file.
00001       PROGRAM PZINVDRIVER
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 *  PZINVDRIVER is the main test program for the COMPLEX*16
00012 *  SCALAPACK matrix inversion routines.  This test driver computes the
00013 *  inverse of different kind of matrix and tests the results.
00014 *
00015 *  The program must be driven by a short data file. An annotated example
00016 *  of a data file can be obtained by deleting the first 3 characters
00017 *  from the following 14 lines:
00018 *  'ScaLAPACK Matrix Inversion Testing input file'
00019 *  'PVM machine.'
00020 *  'INV.out'                   output file name (if any)
00021 *  6                           device out
00022 *  5                           number of matrix types (next line)
00023 *  'GEN' 'UTR' 'LTR' 'UPD' LPD' GEN, UTR, LTR, UPD, LPD
00024 *  4                           number of problems sizes
00025 *  1000 2000 3000 4000         values of N
00026 *  3                           number of NB's
00027 *  4 30 35                     values of NB
00028 *  2                           number of process grids (ordered P & Q)
00029 *  4 2                         values of P
00030 *  4 4                         values of Q
00031 *  1.0                         threshold
00032 *
00033 *  Internal Parameters
00034 *  ===================
00035 *
00036 *  TOTMEM   INTEGER, default = 2000000
00037 *           TOTMEM is a machine-specific parameter indicating the
00038 *           maximum amount of available memory in bytes.
00039 *           The user should customize TOTMEM to his platform.  Remember
00040 *           to leave room in memory for the operating system, the BLACS
00041 *           buffer, etc.  For example, on a system with 8 MB of memory
00042 *           per process (e.g., one processor on an Intel iPSC/860), the
00043 *           parameters we use are TOTMEM=6200000 (leaving 1.8 MB for OS,
00044 *           code, BLACS buffer, etc).  However, for PVM, we usually set
00045 *           TOTMEM = 2000000.  Some experimenting with the maximum value
00046 *           of TOTMEM may be required.
00047 *
00048 *  INTGSZ   INTEGER, default = 4 bytes.
00049 *  DBLESZ   INTEGER, default = 8 bytes.
00050 *  ZPLXSZ   INTEGER, default = 16 bytes.
00051 *           INTGSZ, DBLESZ and ZPLXSZ indicate the length in bytes on
00052 *           the given platform for an integer, a double precision real
00053 *           and a double precision complex.
00054 *  MEM      COMPLEX*16 array, dimension ( TOTMEM / ZPLXSZ )
00055 *
00056 *           All arrays used by SCALAPACK routines are allocated from
00057 *           this array and referenced by pointers.  The integer IPA,
00058 *           for example, is a pointer to the starting element of MEM for
00059 *           the matrix A.
00060 *
00061 *  =====================================================================
00062 *
00063 *     .. Parameters ..
00064       INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
00065      $                   LLD_, MB_, M_, NB_, N_, RSRC_
00066       PARAMETER          ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
00067      $                     CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
00068      $                     RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
00069       INTEGER            DBLESZ, INTGSZ, MEMSIZ, NTESTS, TOTMEM, ZPLXSZ
00070       COMPLEX*16         PADVAL, ZERO
00071       PARAMETER          ( DBLESZ = 8, INTGSZ = 4, TOTMEM = 2000000,
00072      $                     ZPLXSZ = 16, MEMSIZ = TOTMEM / ZPLXSZ,
00073      $                     NTESTS = 20,
00074      $                     PADVAL = ( -9923.0D+0, -9923.0D+0 ),
00075      $                     ZERO = ( 0.0D+0, 0.0D+0 ) )
00076 *     ..
00077 *     .. Local Scalars ..
00078       CHARACTER          UPLO
00079       CHARACTER*3        MTYP
00080       CHARACTER*6        PASSED
00081       CHARACTER*80       OUTFILE
00082       LOGICAL            CHECK
00083       INTEGER            I, IAM, IASEED, ICTXT, IMIDPAD, INFO, IPA,
00084      $                   IPPIV, IPREPAD, IPOSTPAD, IPIW, IPW, ITEMP, J,
00085      $                   K, KTESTS, KPASS, KFAIL, KSKIP, L, LCM, LIPIV,
00086      $                   LIWORK, LWORK, MYCOL, MYROW, N, NB, NGRIDS,
00087      $                   NMAT, NMTYP, NNB, NOUT, NP, NPCOL, NPROCS,
00088      $                   NPROW, NQ, WORKIINV, WORKINV, WORKSIZ
00089       REAL               THRESH
00090       DOUBLE PRECISION   ANORM, FRESID, NOPS, RCOND, TMFLOPS
00091 *     ..
00092 *     .. Local Arrays ..
00093       CHARACTER*3        MATTYP( NTESTS )
00094       INTEGER            DESCA( DLEN_ ), IERR( 1 ), NBVAL( NTESTS ),
00095      $                   NVAL( NTESTS ), PVAL( NTESTS ),
00096      $                   QVAL( NTESTS )
00097       DOUBLE PRECISION   CTIME( 2 ), WTIME( 2 )
00098       COMPLEX*16         MEM( MEMSIZ )
00099 *     ..
00100 *     .. External Subroutines ..
00101       EXTERNAL           BLACS_BARRIER, BLACS_EXIT, BLACS_GET,
00102      $                   BLACS_GRIDEXIT, BLACS_GRIDINFO, BLACS_GRIDINIT,
00103      $                   BLACS_PINFO, DESCINIT, IGSUM2D, PZCHEKPAD,
00104      $                   PZFILLPAD, PZGETRF, PZGETRI,
00105      $                   PZINVCHK, PZINVINFO, PZLASET,
00106      $                   PZMATGEN, PZPOTRF, PZPOTRI,
00107      $                   PZTRTRI, SLBOOT, SLCOMBINE, SLTIMER
00108 *     ..
00109 *     .. External Functions ..
00110       LOGICAL            LSAMEN
00111       INTEGER            ICEIL, ILCM, NUMROC
00112       DOUBLE PRECISION   PZLANGE, PZLANHE, PZLANSY, PZLANTR
00113       EXTERNAL           ICEIL, ILCM, LSAMEN, NUMROC, PZLANGE,
00114      $                   PZLANHE, PZLANSY, PZLANTR
00115 *     ..
00116 *     .. Intrinsic Functions ..
00117       INTRINSIC          DBLE, MAX
00118 *     ..
00119 *     .. Data Statements ..
00120       DATA               KTESTS, KPASS, KFAIL, KSKIP /4*0/
00121 *     ..
00122 *     .. Executable Statements ..
00123 *
00124 *     Get starting information
00125 *
00126       CALL BLACS_PINFO( IAM, NPROCS )
00127       IASEED = 100
00128       CALL PZINVINFO( OUTFILE, NOUT, NMTYP, MATTYP, NTESTS, NMAT, NVAL,
00129      $                NTESTS, NNB, NBVAL, NTESTS, NGRIDS, PVAL, NTESTS,
00130      $                QVAL, NTESTS, THRESH, MEM, IAM, NPROCS )
00131       CHECK = ( THRESH.GE.0.0E+0 )
00132 *
00133 *     Loop over the different matrix types
00134 *
00135       DO 40 I = 1, NMTYP
00136 *
00137          MTYP = MATTYP( I )
00138 *
00139 *        Print headings
00140 *
00141          IF( IAM.EQ.0 ) THEN
00142             WRITE( NOUT, FMT = * )
00143             IF( LSAMEN( 3, MTYP, 'GEN' ) ) THEN
00144                WRITE( NOUT, FMT = 9986 )
00145      $                'A is a general matrix.'
00146             ELSE IF( LSAMEN( 3, MTYP, 'UTR' ) ) THEN
00147                WRITE( NOUT, FMT = 9986 )
00148      $               'A is an upper triangular matrix.'
00149             ELSE IF( LSAMEN( 3, MTYP, 'LTR' ) ) THEN
00150                WRITE( NOUT, FMT = 9986 )
00151      $               'A is a lower triangular matrix.'
00152             ELSE IF( LSAMEN( 3, MTYP, 'UPD' ) ) THEN
00153                WRITE( NOUT, FMT = 9986 )
00154      $               'A is a Hermitian positive definite matrix.'
00155                WRITE( NOUT, FMT = 9986 )
00156      $               'Only the upper triangular part will be '//
00157      $               'referenced.'
00158             ELSE IF( LSAMEN( 3, MTYP, 'LPD' ) ) THEN
00159                WRITE( NOUT, FMT = 9986 )
00160      $               'A is a Hermitian positive definite matrix.'
00161                WRITE( NOUT, FMT = 9986 )
00162      $               'Only the lower triangular part will be '//
00163      $               'referenced.'
00164             END IF
00165             WRITE( NOUT, FMT = * )
00166             WRITE( NOUT, FMT = 9995 )
00167             WRITE( NOUT, FMT = 9994 )
00168             WRITE( NOUT, FMT = * )
00169          END IF
00170 *
00171 *        Loop over different process grids
00172 *
00173          DO 30 J = 1, NGRIDS
00174 *
00175             NPROW = PVAL( J )
00176             NPCOL = QVAL( J )
00177 *
00178 *           Make sure grid information is correct
00179 *
00180             IERR( 1 ) = 0
00181             IF( NPROW.LT.1 ) THEN
00182                IF( IAM.EQ.0 )
00183      $            WRITE( NOUT, FMT = 9999 ) 'GRID', 'nprow', NPROW
00184                IERR( 1 ) = 1
00185             ELSE IF( NPCOL.LT.1 ) THEN
00186                IF( IAM.EQ.0 )
00187      $            WRITE( NOUT, FMT = 9999 ) 'GRID', 'npcol', NPCOL
00188                IERR( 1 ) = 1
00189             ELSE IF( NPROW*NPCOL.GT.NPROCS ) THEN
00190                IF( IAM.EQ.0 )
00191      $            WRITE( NOUT, FMT = 9998 ) NPROW*NPCOL, NPROCS
00192                IERR( 1 ) = 1
00193             END IF
00194 *
00195             IF( IERR( 1 ).GT.0 ) THEN
00196                IF( IAM.EQ.0 )
00197      $            WRITE( NOUT, FMT = 9997 ) 'grid'
00198                KSKIP = KSKIP + 1
00199                GO TO 30
00200             END IF
00201 *
00202 *           Define process grid
00203 *
00204             CALL BLACS_GET( -1, 0, ICTXT )
00205             CALL BLACS_GRIDINIT( ICTXT, 'Row-major', NPROW, NPCOL )
00206             CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
00207 *
00208 *           Go to bottom of loop if this case doesn't use my process
00209 *
00210             IF( MYROW.GE.NPROW .OR. MYCOL.GE.NPCOL )
00211      $         GO TO 30
00212 *
00213             DO 20 K = 1, NMAT
00214 *
00215                N = NVAL( K )
00216 *
00217 *              Make sure matrix information is correct
00218 *
00219                IERR( 1 ) = 0
00220                IF( N.LT.1 ) THEN
00221                   IF( IAM.EQ.0 )
00222      $               WRITE( NOUT, FMT = 9999 ) 'MATRIX', 'N', N
00223                   IERR( 1 ) = 1
00224                END IF
00225 *
00226 *              Make sure no one had error
00227 *
00228                CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1, 0 )
00229 *
00230                IF( IERR( 1 ).GT.0 ) THEN
00231                   IF( IAM.EQ.0 )
00232      $               WRITE( NOUT, FMT = 9997 ) 'matrix'
00233                   KSKIP = KSKIP + 1
00234                   GO TO 20
00235                END IF
00236 *
00237 *              Loop over different blocking sizes
00238 *
00239                DO 10 L = 1, NNB
00240 *
00241                   NB = NBVAL( L )
00242 *
00243 *                 Make sure nb is legal
00244 *
00245                   IERR( 1 ) = 0
00246                   IF( NB.LT.1 ) THEN
00247                      IERR( 1 ) = 1
00248                      IF( IAM.EQ.0 )
00249      $                  WRITE( NOUT, FMT = 9999 ) 'NB', 'NB', NB
00250                   END IF
00251 *
00252 *                 Check all processes for an error
00253 *
00254                   CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1,
00255      $                          0 )
00256 *
00257                   IF( IERR( 1 ).GT.0 ) THEN
00258                      IF( IAM.EQ.0 )
00259      $                  WRITE( NOUT, FMT = 9997 ) 'NB'
00260                      KSKIP = KSKIP + 1
00261                      GO TO 10
00262                   END IF
00263 *
00264 *                 Padding constants
00265 *
00266                   NP = NUMROC( N, NB, MYROW, 0, NPROW )
00267                   NQ = NUMROC( N, NB, MYCOL, 0, NPCOL )
00268                   IF( CHECK ) THEN
00269                      IPREPAD  = MAX( NB, NP )
00270                      IMIDPAD  = NB
00271                      IPOSTPAD = MAX( NB, NQ )
00272                   ELSE
00273                      IPREPAD  = 0
00274                      IMIDPAD  = 0
00275                      IPOSTPAD = 0
00276                   END IF
00277 *
00278 *                 Initialize the array descriptor for the matrix A
00279 *
00280                   CALL DESCINIT( DESCA, N, N, NB, NB, 0, 0, ICTXT,
00281      $                           MAX( 1, NP ) + IMIDPAD, IERR( 1 ) )
00282 *
00283 *                 Check all processes for an error
00284 *
00285                   CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1,
00286      $                          0 )
00287 *
00288                   IF( IERR( 1 ).LT.0 ) THEN
00289                      IF( IAM.EQ.0 )
00290      $                  WRITE( NOUT, FMT = 9997 ) 'descriptor'
00291                      KSKIP = KSKIP + 1
00292                      GO TO 10
00293                   END IF
00294 *
00295 *                 Assign pointers into MEM for ScaLAPACK arrays, A is
00296 *                 allocated starting at position MEM( IPREPAD+1 )
00297 *
00298                   IPA = IPREPAD+1
00299 *
00300                   LCM = ILCM( NPROW, NPCOL )
00301                   IF( LSAMEN( 3, MTYP, 'GEN' ) ) THEN
00302 *
00303 *                    Pivots are needed by LU factorization
00304 *
00305                      IPPIV = IPA + DESCA( LLD_ ) * NQ + IPOSTPAD +
00306      $                       IPREPAD
00307                      LIPIV = ICEIL( INTGSZ * ( NP + NB ), ZPLXSZ )
00308                      IPW = IPPIV + LIPIV + IPOSTPAD + IPREPAD
00309 *
00310                      LWORK = MAX( 1, NP * DESCA( NB_ ) )
00311                      WORKINV = LWORK + IPOSTPAD
00312 *
00313 *                    Figure the amount of workspace required by the
00314 *                    general matrix inversion
00315 *
00316                      IF( NPROW.EQ.NPCOL ) THEN
00317                         LIWORK = NQ + DESCA( NB_ )
00318                      ELSE
00319 *
00320 * change the integer workspace needed for PDGETRI
00321 *                        LIWORK = MAX( DESCA( NB_ ), DESCA( MB_ ) *
00322 *     $                           ICEIL( ICEIL( DESCA( LLD_ ),
00323 *     $                                  DESCA( MB_ ) ), LCM / NPROW ) )
00324 *     $                                  + NQ
00325                          LIWORK = NUMROC( DESCA( M_ ) +
00326      $                  DESCA( MB_ ) * NPROW
00327      $                  + MOD ( 1 - 1, DESCA( MB_ ) ), DESCA ( NB_ ),
00328      $                  MYCOL, DESCA( CSRC_ ), NPCOL ) +
00329      $                  MAX ( DESCA( MB_ ) * ICEIL ( ICEIL(
00330      $                  NUMROC( DESCA( M_ ) + DESCA( MB_ ) * NPROW,
00331      $                  DESCA( MB_ ), MYROW, DESCA( RSRC_ ), NPROW ),
00332      $                  DESCA( MB_ ) ), LCM / NPROW ), DESCA( NB_ ) )
00333 *
00334                      END IF
00335                      WORKIINV = ICEIL( LIWORK*INTGSZ, ZPLXSZ ) +
00336      $                          IPOSTPAD
00337                      IPIW = IPW + WORKINV + IPREPAD
00338                      WORKSIZ = WORKINV + IPREPAD + WORKIINV
00339 *
00340                   ELSE
00341 *
00342 *                    No pivots or workspace needed for triangular or
00343 *                    Hermitian positive definite matrices.
00344 *
00345                      IPW = IPA + DESCA( LLD_ ) * NQ + IPOSTPAD + IPREPAD
00346                      WORKSIZ = 1 + IPOSTPAD
00347 *
00348                   END IF
00349 *
00350                   IF( CHECK ) THEN
00351 *
00352 *                    Figure amount of work space for the norm
00353 *                    computations
00354 *
00355                      IF( LSAMEN( 3, MTYP, 'GEN'       ).OR.
00356      $                   LSAMEN( 2, MTYP( 2:3 ), 'TR' ) ) THEN
00357                         ITEMP = NQ
00358                      ELSE
00359                         ITEMP = 2 * NQ + NP
00360                         IF( NPROW.NE.NPCOL ) THEN
00361                            ITEMP = ITEMP +
00362      $                             NB * ICEIL( ICEIL( NP, NB ),
00363      $                                         LCM / NPROW )
00364                         END IF
00365                      END IF
00366                      WORKSIZ = MAX( WORKSIZ-IPOSTPAD,
00367      $                              ICEIL( DBLESZ * ITEMP, ZPLXSZ ) )
00368 *
00369 *                    Figure the amount of workspace required by the
00370 *                    checking routine
00371 *
00372                      WORKSIZ = MAX( WORKSIZ, 2 * NB * MAX( 1, NP ) ) +
00373      $                         IPOSTPAD
00374 *
00375                   END IF
00376 *
00377 *                 Check for adequate memory for problem size
00378 *
00379                   IERR( 1 ) = 0
00380                   IF( IPW+WORKSIZ.GT.MEMSIZ ) THEN
00381                      IF( IAM.EQ.0 )
00382      $                  WRITE( NOUT, FMT = 9996 ) 'inversion',
00383      $                         ( IPW + WORKSIZ ) * ZPLXSZ
00384                      IERR( 1 ) = 1
00385                   END IF
00386 *
00387 *                 Check all processes for an error
00388 *
00389                   CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1,
00390      $                          0 )
00391 *
00392                   IF( IERR( 1 ).GT.0 ) THEN
00393                      IF( IAM.EQ.0 )
00394      $                  WRITE( NOUT, FMT = 9997 ) 'MEMORY'
00395                      KSKIP = KSKIP + 1
00396                      GO TO 10
00397                   END IF
00398 *
00399                   IF( LSAMEN( 3, MTYP, 'GEN'       ).OR.
00400      $                LSAMEN( 2, MTYP( 2:3 ), 'TR' ) ) THEN
00401 *
00402 *                    Generate a general diagonally dominant matrix A
00403 *
00404                      CALL PZMATGEN( ICTXT, 'N', 'D', DESCA( M_ ),
00405      $                              DESCA( N_ ), DESCA( MB_ ),
00406      $                              DESCA( NB_ ), MEM( IPA ),
00407      $                              DESCA( LLD_ ), DESCA( RSRC_ ),
00408      $                              DESCA( CSRC_ ), IASEED, 0, NP, 0,
00409      $                              NQ, MYROW, MYCOL, NPROW, NPCOL )
00410 *
00411                   ELSE IF( LSAMEN( 2, MTYP( 2:3 ), 'PD' ) ) THEN
00412 *
00413 *                    Generate a Hermitian positive definite matrix A
00414 *
00415                      CALL PZMATGEN( ICTXT, 'H', 'D', DESCA( M_ ),
00416      $                              DESCA( N_ ), DESCA( MB_ ),
00417      $                              DESCA( NB_ ), MEM( IPA ),
00418      $                              DESCA( LLD_ ), DESCA( RSRC_ ),
00419      $                              DESCA( CSRC_ ), IASEED, 0, NP, 0,
00420      $                              NQ, MYROW, MYCOL, NPROW, NPCOL )
00421 *
00422                   END IF
00423 *
00424 *                 Zeros not-referenced part of A, if any.
00425 *
00426                   IF( LSAMEN( 1, MTYP, 'U' ) ) THEN
00427 *
00428                      UPLO = 'U'
00429                      CALL PZLASET( 'Lower', N-1, N-1, ZERO, ZERO,
00430      $                             MEM( IPA ), 2, 1, DESCA )
00431 *
00432                   ELSE IF( LSAMEN( 1, MTYP, 'L' ) ) THEN
00433 *
00434                      UPLO = 'L'
00435                      CALL PZLASET( 'Upper', N-1, N-1, ZERO, ZERO,
00436      $                             MEM( IPA ), 1, 2, DESCA )
00437 *
00438                   ELSE
00439 *
00440                      UPLO = 'G'
00441 *
00442                   END IF
00443 *
00444 *                 Need 1-norm of A for checking
00445 *
00446                   IF( CHECK ) THEN
00447 *
00448                      CALL PZFILLPAD( ICTXT, NP, NQ, MEM( IPA-IPREPAD ),
00449      $                               DESCA( LLD_ ), IPREPAD, IPOSTPAD,
00450      $                               PADVAL )
00451                      CALL PZFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
00452      $                               MEM( IPW-IPREPAD ),
00453      $                               WORKSIZ-IPOSTPAD, IPREPAD,
00454      $                               IPOSTPAD, PADVAL )
00455 *
00456                      IF( LSAMEN( 3, MTYP, 'GEN' ) ) THEN
00457 *
00458                         CALL PZFILLPAD( ICTXT, LIPIV, 1,
00459      $                                 MEM( IPPIV-IPREPAD ), LIPIV,
00460      $                                 IPREPAD, IPOSTPAD, PADVAL )
00461                         ANORM = PZLANGE( '1', N, N, MEM( IPA ), 1, 1,
00462      $                                   DESCA, MEM( IPW ) )
00463                         CALL PZCHEKPAD( ICTXT, 'PZLANGE', NP, NQ,
00464      $                                  MEM( IPA-IPREPAD ),
00465      $                                  DESCA( LLD_ ),
00466      $                                  IPREPAD, IPOSTPAD, PADVAL )
00467                         CALL PZCHEKPAD( ICTXT, 'PZLANGE',
00468      $                                  WORKSIZ-IPOSTPAD, 1,
00469      $                                  MEM( IPW-IPREPAD ),
00470      $                                  WORKSIZ-IPOSTPAD,
00471      $                                  IPREPAD, IPOSTPAD, PADVAL )
00472                         CALL PZFILLPAD( ICTXT, WORKINV-IPOSTPAD, 1,
00473      $                                  MEM( IPW-IPREPAD ),
00474      $                                  WORKINV-IPOSTPAD,
00475      $                                  IPREPAD, IPOSTPAD, PADVAL )
00476                         CALL PZFILLPAD( ICTXT, WORKIINV-IPOSTPAD, 1,
00477      $                                 MEM( IPIW-IPREPAD ),
00478      $                                 WORKIINV-IPOSTPAD, IPREPAD,
00479      $                                 IPOSTPAD, PADVAL )
00480                      ELSE IF( LSAMEN( 2, MTYP( 2:3 ), 'TR' ) ) THEN
00481 *
00482                         ANORM = PZLANTR( '1', UPLO, 'Non unit', N, N,
00483      $                                   MEM( IPA ), 1, 1, DESCA,
00484      $                                   MEM( IPW ) )
00485                         CALL PZCHEKPAD( ICTXT, 'PZLANTR', NP, NQ,
00486      $                                  MEM( IPA-IPREPAD ),
00487      $                                  DESCA( LLD_ ),
00488      $                                  IPREPAD, IPOSTPAD, PADVAL )
00489                         CALL PZCHEKPAD( ICTXT, 'PZLANTR',
00490      $                                  WORKSIZ-IPOSTPAD, 1,
00491      $                                  MEM( IPW-IPREPAD ),
00492      $                                  WORKSIZ-IPOSTPAD,
00493      $                                  IPREPAD, IPOSTPAD, PADVAL )
00494 *
00495                      ELSE IF( LSAMEN( 2, MTYP( 2:3 ), 'PD' ) ) THEN
00496 *
00497                         ANORM = PZLANHE( '1', UPLO, N, MEM( IPA ), 1, 1,
00498      $                                   DESCA, MEM( IPW ) )
00499                         CALL PZCHEKPAD( ICTXT, 'PZLANHE', NP, NQ,
00500      $                                  MEM( IPA-IPREPAD ),
00501      $                                  DESCA( LLD_ ),
00502      $                                  IPREPAD, IPOSTPAD, PADVAL )
00503                         CALL PZCHEKPAD( ICTXT, 'PZLANHE',
00504      $                                  WORKSIZ-IPOSTPAD, 1,
00505      $                                  MEM( IPW-IPREPAD ),
00506      $                                  WORKSIZ-IPOSTPAD,
00507      $                                  IPREPAD, IPOSTPAD, PADVAL )
00508 *
00509                      ELSE IF( LSAMEN( 2, MTYP( 2:3 ), 'SY' ) ) THEN
00510 *
00511                         CALL PZFILLPAD( ICTXT, LIPIV, 1,
00512      $                                  MEM( IPPIV-IPREPAD ), LIPIV,
00513      $                                  IPREPAD, IPOSTPAD, PADVAL )
00514                         ANORM = PZLANSY( '1', UPLO, N, MEM( IPA ), 1, 1,
00515      $                                   DESCA, MEM( IPW ) )
00516                         CALL PZCHEKPAD( ICTXT, 'PZLANSY', NP, NQ,
00517      $                                  MEM( IPA-IPREPAD ),
00518      $                                  DESCA( LLD_ ),
00519      $                                  IPREPAD, IPOSTPAD, PADVAL )
00520                         CALL PZCHEKPAD( ICTXT, 'PZLANSY',
00521      $                                  WORKSIZ-IPOSTPAD, 1,
00522      $                                  MEM( IPW-IPREPAD ),
00523      $                                  WORKSIZ-IPOSTPAD,
00524      $                                  IPREPAD,IPOSTPAD, PADVAL )
00525 *
00526                      ELSE IF( LSAMEN( 2, MTYP( 2:3 ), 'HE' ) ) THEN
00527                         CALL PZFILLPAD( ICTXT, LIPIV, 1,
00528      $                                  MEM( IPPIV-IPREPAD ), LIPIV,
00529      $                                  IPREPAD, IPOSTPAD, PADVAL )
00530                         ANORM = PZLANHE( '1', UPLO, N, MEM( IPA ), 1, 1,
00531      $                                   DESCA, MEM( IPW ) )
00532                         CALL PZCHEKPAD( ICTXT, 'PZLANHE', NP, NQ,
00533      $                                  MEM( IPA-IPREPAD ),
00534      $                                  DESCA( LLD_ ),
00535      $                                  IPREPAD, IPOSTPAD, PADVAL )
00536                         CALL PZCHEKPAD( ICTXT, 'PZLANHE',
00537      $                                  WORKSIZ-IPOSTPAD, 1,
00538      $                                  MEM( IPW-IPREPAD ),
00539      $                                  WORKSIZ-IPOSTPAD,
00540      $                                  IPREPAD, IPOSTPAD, PADVAL )
00541 *
00542                      END IF
00543 *
00544                   END IF
00545 *
00546                   CALL SLBOOT()
00547                   CALL BLACS_BARRIER( ICTXT, 'All' )
00548 *
00549                   IF( LSAMEN( 3, MTYP, 'GEN' ) ) THEN
00550 *
00551 *                    Perform LU factorization
00552 *
00553                      CALL SLTIMER( 1 )
00554                      CALL PZGETRF( N, N, MEM( IPA ), 1, 1, DESCA,
00555      $                             MEM( IPPIV ), INFO )
00556                      CALL SLTIMER( 1 )
00557 *
00558                      IF( CHECK ) THEN
00559 *
00560 *                       Check for memory overwrite
00561 *
00562                         CALL PZCHEKPAD( ICTXT, 'PZGETRF', NP, NQ,
00563      $                                  MEM( IPA-IPREPAD ),
00564      $                                  DESCA( LLD_ ),
00565      $                                  IPREPAD, IPOSTPAD, PADVAL )
00566                         CALL PZCHEKPAD( ICTXT, 'PZGETRF', LIPIV, 1,
00567      $                                  MEM( IPPIV-IPREPAD ), LIPIV,
00568      $                                  IPREPAD, IPOSTPAD, PADVAL )
00569                      END IF
00570 *
00571 *                    Perform the general matrix inversion
00572 *
00573                      CALL SLTIMER( 2 )
00574                      CALL PZGETRI( N, MEM( IPA ), 1, 1, DESCA,
00575      $                             MEM( IPPIV ), MEM( IPW ), LWORK,
00576      $                             MEM( IPIW ), LIWORK, INFO )
00577                      CALL SLTIMER( 2 )
00578 *
00579                      IF( CHECK ) THEN
00580 *
00581 *                       Check for memory overwrite
00582 *
00583                         CALL PZCHEKPAD( ICTXT, 'PZGETRI', NP, NQ,
00584      $                                  MEM( IPA-IPREPAD ),
00585      $                                  DESCA( LLD_ ),
00586      $                                  IPREPAD, IPOSTPAD, PADVAL )
00587                         CALL PZCHEKPAD( ICTXT, 'PZGETRI', LIPIV, 1,
00588      $                                  MEM( IPPIV-IPREPAD ), LIPIV,
00589      $                                  IPREPAD, IPOSTPAD, PADVAL )
00590                         CALL PZCHEKPAD( ICTXT, 'PZGETRI',
00591      $                                  WORKIINV-IPOSTPAD, 1,
00592      $                                  MEM( IPIW-IPREPAD ),
00593      $                                  WORKIINV-IPOSTPAD,
00594      $                                  IPREPAD, IPOSTPAD, PADVAL )
00595                         CALL PZCHEKPAD( ICTXT, 'PZGETRI',
00596      $                                  WORKINV-IPOSTPAD, 1,
00597      $                                  MEM( IPW-IPREPAD ),
00598      $                                  WORKINV-IPOSTPAD,
00599      $                                  IPREPAD, IPOSTPAD, PADVAL )
00600                      END IF
00601 *
00602                   ELSE IF( LSAMEN( 2, MTYP( 2:3 ), 'TR' ) ) THEN
00603 *
00604 *                    Perform the general matrix inversion
00605 *
00606                      CALL SLTIMER( 2 )
00607                      CALL PZTRTRI( UPLO, 'Non unit', N, MEM( IPA ), 1,
00608      $                             1, DESCA, INFO )
00609                      CALL SLTIMER( 2 )
00610 *
00611                      IF( CHECK ) THEN
00612 *
00613 *                       Check for memory overwrite
00614 *
00615                         CALL PZCHEKPAD( ICTXT, 'PZTRTRI', NP, NQ,
00616      $                                  MEM( IPA-IPREPAD ),
00617      $                                  DESCA( LLD_ ),
00618      $                                  IPREPAD, IPOSTPAD, PADVAL )
00619                      END IF
00620 *
00621                   ELSE IF( LSAMEN( 2, MTYP( 2:3 ), 'PD' ) ) THEN
00622 *
00623 *                    Perform Cholesky factorization
00624 *
00625                      CALL SLTIMER( 1 )
00626                      CALL PZPOTRF( UPLO, N, MEM( IPA ), 1, 1, DESCA,
00627      $                             INFO )
00628                      CALL SLTIMER( 1 )
00629 *
00630                      IF( CHECK ) THEN
00631 *
00632 *                       Check for memory overwrite
00633 *
00634                         CALL PZCHEKPAD( ICTXT, 'PZPOTRF', NP, NQ,
00635      $                                  MEM( IPA-IPREPAD ),
00636      $                                  DESCA( LLD_ ),
00637      $                                  IPREPAD, IPOSTPAD, PADVAL )
00638                      END IF
00639 *
00640 *                    Perform the Hermitian positive definite matrix
00641 *                    inversion
00642 *
00643                      CALL SLTIMER( 2 )
00644                      CALL PZPOTRI( UPLO, N, MEM( IPA ), 1, 1, DESCA,
00645      $                             INFO )
00646                      CALL SLTIMER( 2 )
00647 *
00648                      IF( CHECK ) THEN
00649 *
00650 *                       Check for memory overwrite
00651 *
00652                         CALL PZCHEKPAD( ICTXT, 'PZPOTRI', NP, NQ,
00653      $                                  MEM( IPA-IPREPAD ),
00654      $                                  DESCA( LLD_ ),
00655      $                                  IPREPAD, IPOSTPAD, PADVAL )
00656                      END IF
00657 *
00658                   END IF
00659 *
00660                   IF( CHECK ) THEN
00661 *
00662                      CALL PZFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
00663      $                               MEM( IPW-IPREPAD ),
00664      $                               WORKSIZ-IPOSTPAD, IPREPAD,
00665      $                               IPOSTPAD, PADVAL )
00666 *
00667 *                    Compute fresid = || inv(A)*A-I ||
00668 *
00669                      CALL PZINVCHK( MTYP, N, MEM( IPA ), 1, 1, DESCA,
00670      $                              IASEED, ANORM, FRESID, RCOND,
00671      $                              MEM( IPW ) )
00672 *
00673 *                    Check for memory overwrite
00674 *
00675                      CALL PZCHEKPAD( ICTXT, 'PZINVCHK', NP, NQ,
00676      $                               MEM( IPA-IPREPAD ),
00677      $                               DESCA( LLD_ ),
00678      $                               IPREPAD, IPOSTPAD, PADVAL )
00679                      CALL PZCHEKPAD( ICTXT, 'PZINVCHK',
00680      $                               WORKSIZ-IPOSTPAD, 1,
00681      $                               MEM( IPW-IPREPAD ),
00682      $                               WORKSIZ-IPOSTPAD, IPREPAD,
00683      $                               IPOSTPAD, PADVAL )
00684 *
00685 *                    Test residual and detect NaN result
00686 *
00687                      IF( FRESID.LE.THRESH .AND. INFO.EQ.0 .AND.
00688      $                   ( (FRESID-FRESID) .EQ. 0.0D+0 ) ) THEN
00689                         KPASS = KPASS + 1
00690                         PASSED = 'PASSED'
00691                      ELSE
00692                         KFAIL = KFAIL + 1
00693                         IF( INFO.GT.0 ) THEN
00694                            PASSED = 'SINGUL'
00695                         ELSE
00696                            PASSED = 'FAILED'
00697                         END IF
00698                      END IF
00699 *
00700                   ELSE
00701 *
00702 *                    Don't perform the checking, only the timing
00703 *                    operation
00704 *
00705                      KPASS = KPASS + 1
00706                      FRESID = FRESID - FRESID
00707                      PASSED = 'BYPASS'
00708 *
00709                   END IF
00710 *
00711 *                 Gather maximum of all CPU and WALL clock timings
00712 *
00713                   CALL SLCOMBINE( ICTXT, 'All', '>', 'W', 2, 1, WTIME )
00714                   CALL SLCOMBINE( ICTXT, 'All', '>', 'C', 2, 1, CTIME )
00715 *
00716 *                 Print results
00717 *
00718                   IF( MYROW.EQ.0 .AND. MYCOL.EQ.0  ) THEN
00719 *
00720                      IF( LSAMEN( 3, MTYP, 'GEN' ) ) THEN
00721 *
00722 *                       8/3 N^3 - N^2 flops for LU factorization
00723 *
00724                         NOPS = ( 8.0D+0 / 3.0D+0 ) * ( DBLE( N )**3 ) -
00725      $                         DBLE( N )**2
00726 *
00727 *                       16/3 N^3 for matrix inversion
00728 *
00729                         NOPS = NOPS +
00730      $                         ( 16.0D+0 / 3.0D+0 ) * ( DBLE( N )**3 )
00731 *
00732                      ELSE IF( LSAMEN( 2, MTYP( 2:3 ), 'TR' ) ) THEN
00733 *
00734 *                       4/3 N^3 + 2 N^2 for triangular matrix inversion
00735 *
00736                         CTIME(1) = 0.0D+0
00737                         WTIME(1) = 0.0D+0
00738                         NOPS = ( 4.0D+0 / 3.0D+0 ) * ( DBLE( N )**3 ) +
00739      $                         2.0D+0 * ( DBLE( N )**2 )
00740 *
00741                      ELSE IF( LSAMEN( 2, MTYP( 2:3 ), 'PD' ) ) THEN
00742 *
00743 *                       4/3 N^3 + 3 N^2 flops for Cholesky factorization
00744 *
00745                         NOPS = ( 4.0D+0 / 3.0D+0 ) * ( DBLE( N )**3 ) +
00746      $                         2.0D+0 * ( DBLE( N )**2 )
00747 *
00748 *                       8/3 N^3  + 5 N^2 flops for Cholesky inversion
00749 *
00750                         NOPS = NOPS +
00751      $                         ( 8.0D+0 / 3.0D+0 ) * ( DBLE( N )**3 ) +
00752      $                         5.0D+0 * ( DBLE( N )**2 )
00753 *
00754                      END IF
00755 *
00756 *                    Figure total megaflops -- factorization and
00757 *                    inversion, for WALL and CPU time, and print
00758 *                    output.
00759 *
00760 *                    Print WALL time if machine supports it
00761 *
00762                      IF( WTIME( 1 ) + WTIME( 2 ) .GT. 0.0D+0 ) THEN
00763                         TMFLOPS = NOPS /
00764      $                            ( ( WTIME( 1 )+WTIME( 2 ) ) * 1.0D+6 )
00765                      ELSE
00766                         TMFLOPS = 0.0D+0
00767                      END IF
00768 *
00769                      IF( WTIME( 2 ) .GE. 0.0D+0 )
00770      $                  WRITE( NOUT, FMT = 9993 ) 'WALL', N, NB, NPROW,
00771      $                         NPCOL, WTIME( 1 ), WTIME( 2 ), TMFLOPS,
00772      $                         RCOND, FRESID, PASSED
00773 *
00774 *                    Print CPU time if machine supports it
00775 *
00776                      IF( CTIME( 1 ) + CTIME( 2 ) .GT. 0.0D+0 ) THEN
00777                         TMFLOPS = NOPS /
00778      $                            ( ( CTIME( 1 )+CTIME( 2 ) ) * 1.0D+6 )
00779                      ELSE
00780                         TMFLOPS = 0.0D+0
00781                      END IF
00782 *
00783                      IF( CTIME( 2 ) .GE. 0.0D+0 )
00784      $                  WRITE( NOUT, FMT = 9993 ) 'CPU ', N, NB, NPROW,
00785      $                         NPCOL, CTIME( 1 ), CTIME( 2 ), TMFLOPS,
00786      $                         RCOND, FRESID, PASSED
00787                   END IF
00788 *
00789    10          CONTINUE
00790 *
00791    20       CONTINUE
00792 *
00793             CALL BLACS_GRIDEXIT( ICTXT )
00794 *
00795    30    CONTINUE
00796 *
00797    40 CONTINUE
00798 *
00799 *     Print out ending messages and close output file
00800 *
00801       IF( IAM.EQ.0 ) THEN
00802          KTESTS = KPASS + KFAIL + KSKIP
00803          WRITE( NOUT, FMT = * )
00804          WRITE( NOUT, FMT = 9992 ) KTESTS
00805          IF( CHECK ) THEN
00806             WRITE( NOUT, FMT = 9991 ) KPASS
00807             WRITE( NOUT, FMT = 9989 ) KFAIL
00808          ELSE
00809             WRITE( NOUT, FMT = 9990 ) KPASS
00810          END IF
00811          WRITE( NOUT, FMT = 9988 ) KSKIP
00812          WRITE( NOUT, FMT = * )
00813          WRITE( NOUT, FMT = * )
00814          WRITE( NOUT, FMT = 9987 )
00815          IF( NOUT.NE.6 .AND. NOUT.NE.0 )
00816      $      CLOSE ( NOUT )
00817       END IF
00818 *
00819       CALL BLACS_EXIT( 0 )
00820 *
00821  9999 FORMAT( 'ILLEGAL ', A6, ': ', A5, ' = ', I3,
00822      $        '; It should be at least 1' )
00823  9998 FORMAT( 'ILLEGAL GRID: nprow*npcol = ', I4, '. It can be at most',
00824      $        I4 )
00825  9997 FORMAT( 'Bad ', A6, ' parameters: going on to next test case.' )
00826  9996 FORMAT( 'Unable to perform ', A, ': need TOTMEM of at least',
00827      $        I11 )
00828  9995 FORMAT( 'TIME     N  NB     P     Q Fct Time Inv Time ',
00829      $        '     MFLOPS    Cond   Resid  CHECK' )
00830  9994 FORMAT( '---- ----- --- ----- ----- -------- -------- ',
00831      $        '----------- ------- ------- ------' )
00832  9993 FORMAT( A4, 1X, I5, 1X, I3, 1X, I5, 1X, I5, 1X, F8.2, 1X, F8.2,
00833      $        1X, F11.2, 1X, F7.1, 1X, F7.2, 1X, A6 )
00834  9992 FORMAT( 'Finished ', I6, ' tests, with the following results:' )
00835  9991 FORMAT( I5, ' tests completed and passed residual checks.' )
00836  9990 FORMAT( I5, ' tests completed without checking.' )
00837  9989 FORMAT( I5, ' tests completed and failed residual checks.' )
00838  9988 FORMAT( I5, ' tests skipped because of illegal input values.' )
00839  9987 FORMAT( 'END OF TESTS.' )
00840  9986 FORMAT( A )
00841 *
00842       STOP
00843 *
00844 *     End of PZINVDRIVER
00845 *
00846       END