      SUBROUTINE PDSVDTST( M, N, NPROW, NPCOL, NB, ISEED, THRESH, WORK,
     $                     RESULT, LWORK, NOUT )
*
*  -- ScaLAPACK routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      INTEGER            LWORK, M, N, NB, NOUT, NPCOL, NPROW
      DOUBLE PRECISION   THRESH
*     ..
*     .. Array Arguments ..
      INTEGER            ISEED( 4 ), RESULT( 9 )
      DOUBLE PRECISION   WORK( * )
*     ..
*
*  Purpose
*  =======
*
*  PDSVDTST checks the singular value decomposition (SVD) routine
*  PDGESVD. PDGESVD factors A = U diag(S) VT, where U and VT are
*  orthogonal and diag(S) is diagonal with the entries of the array
*  S on its diagonal. The entries of S are the singular values, stored 
*  in decreasing order. U and VT can be optionally not computed,
*  computed and overwritten on A, or computed partially.
*
*  A is M by N. Let SIZE = min( M, N ). S has dimension SIZE by SIZE.
*  U is M by SIZE and VT is SIZE by  N. PDGESVD optionally calculates
*  U and VT, depending on the values of its parameters JOBU and JOBVT.
*  There are four possible  combinations of "job" parameters for a call
*  to PDGESVD, that correspond to four values of internal index JOBTYPE.
*  The table below shows the mapping between "job" parameters of 
*  PDGESVD and respective values of the index JOBTYPE together 
*  with matrices computed for each type of the job.
*
*
*              |   JOBU = 'V'     |       JOBU = 'N'
*   ---------- -------------------------------------------
*   JOBVT = 'V'|  JOBTYPE = 1     |   JOBTYPE = 3
*              |  U1, S1, VT1     |   S3, VT3
*   ---------- ------------------------------------------
*   JOBVT = 'N'|  JOBTYPE = 2     |   JOBTYPE = 4
*              |  U2, S2          |   S4
*
*
*  When PDSVDTST is called, a number of matrix "types" are specified.
*  For each type of matrix, and for the minimal workspace as well as
*  for larger than minimal workspace an M x N matrix "A" with known
*  singular values is generated and used to test the SVD routines.
*  For each matrix, A will be factored as A = U diag(S) VT and the
*  following 9 tests computed:
*
*  (1)   | A - U1 diag(S1) VT1 | / ( |A| max(M,N) ulp )
*
*  (2)   | I - U1'U1 | / ( M ulp )
*
*  (3)   | I - VT1 VT1' | / ( N ulp ),
*
*  (4)   S1 contains SIZE  nonnegative values in decreasing order.
*        (Return 0 if true, 1/ULP if false.)
*
*  (5)   | S1 - S2 | / ( SIZE ulp |S| )
*
*  (6)   | U1 - U2 | / ( M ulp )
*
*  (7)   | S1 - S3 | / ( SIZE ulp |S| )
*
*  (8)   | VT1 - VT3 | / ( N ulp )
*
*  (9)   | S1 - S4 | / (  SIZE ulp |S| )
*
*  Currently, the list of possible  matrix types is:
*
*  (1)  The zero matrix.
*
*  (2)  The identity matrix.
*
*  (3)  A diagonal matrix with evenly spaced entries
*       1, ..., ULP.
*       (ULP = (first number larger than 1) - 1 )
*
*  (4)  A matrix of the form  U D VT, where U, VT are orthogonal and
*       D has evenly spaced entries 1, ..., ULP.
*
*  (5) Same as (4), but multiplied by SQRT( overflow threshold )
*
*  (6) Same as (4), but multiplied by SQRT( underflow threshold )
*
*
*  Notes
*  =====
*
*  Each global data object is described by an associated description
*  vector.  This vector stores the information required to establish
*  the mapping between an object element and its corresponding process
*  and memory location.
*
*  Let A be a generic term for any 2D block cyclicly distributed array.
*  Such a global array has an associated description vector DESCA.
*  In the following comments, the character _ should be read as
*  "of the global array".
*
*  NOTATION        STORED IN      EXPLANATION
*  --------------- -------------- --------------------------------------
*  DTYPE_A(global) DESCA( DTYPE_ )The descriptor type.  In this case,
*                                 DTYPE_A = 1.
*  CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
*                                 the BLACS process grid A is distribu-
*                                 ted over. The context itself is glo-
*                                 bal, but the handle (the integer
*                                 value) may vary.
*  M_A    (global) DESCA( M_ )    The number of rows in the global
*                                 array A.
*  N_A    (global) DESCA( N_ )    The number of columns in the global
*                                 array A.
*  MB_A   (global) DESCA( MB_ )   The blocking factor used to distribute
*                                 the rows of the array.
*  NB_A   (global) DESCA( NB_ )   The blocking factor used to distribute
*                                 the columns of the array.
*  RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
*                                 row of the array A is distributed.
*  CSRC_A (global) DESCA( CSRC_ ) The process column over which the
*                                 first column of the array A is
*                                 distributed.
*  LLD_A  (local)  DESCA( LLD_ )  The leading dimension of the local
*                                 array.  LLD_A >= MAX(1,LOCr(M_A)).
*
*  Let K be the number of rows or columns of a distributed matrix,
*  and assume that its process grid has dimension p x q.
*  LOCr( K ) denotes the number of elements of K that a process
*  would receive if K were distributed over the p processes of its
*  process column.
*  Similarly, LOCc( K ) denotes the number of elements of K that a
*  process would receive if K were distributed over the q processes of
*  its process row.
*  The values of LOCr() and LOCc() may be determined via a call to the
*  ScaLAPACK tool function, NUMROC:
*          LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
*          LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
*  An upper bound for these quantities may be computed by:
*          LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
*          LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
*
*  Arguments
*  ==========
*
*  M      (global input) INTEGER dimension
*         The value of the matrix row dimension.
*
*  N      (global input) INTEGER dimension
*         The value of the matrix column dimension.
*
*  NPROW  (global input) INTEGER
*         Number of process rows
*
*  NPCOL  (global input) INTEGER
*         Number of process columns
*
*  NB     (global input) INTEGER
*         The block size of the matrix A. NB >=1.
*
*  ISEED  (global input/local output) INTEGER array, dimension (4)
*         On entry, the seed of the random number generator.  The array
*         elements should be between 0 and 4095; if not they will be
*         reduced mod 4096.  Also, ISEED(4) must be odd.
*         On exit, ISEED is changed and can be used in the next call to
*         SDRVBD to continue the same random number sequence.
*
*  THRESH (global input) DOUBLE PRECISION
*         The threshold value for the test ratios.  A result is
*         included in the output file if RESULT >= THRESH.  The test
*         ratios are scaled to be O(1), so THRESH should be a small
*         multiple of 1, e.g., 10 or 100.  To have every test ratio
*         printed, use THRESH = 0.
*
*  RESULT (global input/output) INTEGER array of dimension 9. Initially
*         RESULT( I ) = 0. On the output, RESULT ( I ) = 1 if test I
*         ( see above ) wasn't passed.
*
*  WORK   (local workspace) DOUBLE PRECISION array, dimension (LWORK)
*
*  LWORK  (local input) INTEGER
*         Dimension of the array WORK. It is defined as follows
*         LWORK = 1 + 2*LDA*NQ + 3*SIZE +
*         MAX(WPDLAGGE, LDU*SIZEQ + LDVT*NQ + MAX(LDU*SIZEQ, LDVT*NQ)
*         + WPDGESVD + MAX( WPDSVDCHK, WPDSVDCMP)),
*         where WPDLAGGE, WPDGESVD, WPDSVDCHK,  WPDSVDCMP are amounts
*         of workspace required respectively by PDLAGGE, PDGESVD,
*         PDSVDCHK, PDSVDCMP.
*         Here
*         LDA = NUMROC( M, NB, MYROW, 0, NPROW ), LDU = LDA,
*         LDVT = NUMROC( SIZE, NB, MYROW, 0, NPROW ),
*         NQ = NUMROC( N, NB, MYCOL, 0, NPCOL ),
*         SIZEQ = NUMROC( SIZE, NB, MYCOL, 0, NPCOL ).
*         Values of the variables WPDLAGGE, WPDGESVD, WPDSVDCHK,
*         WPDSVDCMP are found by "dummy" calls to
*         the respective routines. In every "dummy" call, variable
*         LWORK is set to -1, thus causing respective routine
*         immediately return required workspace in WORK(1) without
*         executing any calculations
*
*  NOUT   (local input) INTEGER
*         The unit number for output file.  Only used on node 0.
*         NOUT = 6, output to screen,
*         NOUT = 0, output to stderr.
*  =====================================================================
*
*     .. Parameters ..
      INTEGER             BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
     $                    MB_, NB_, RSRC_, CSRC_, LLD_, NTYPES
      PARAMETER           ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
     $                    CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
     $                    RSRC_ = 7, CSRC_ = 8, LLD_ = 9, NTYPES = 6 )
      DOUBLE PRECISION   ZERO, ONE
      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
*     ..
*     .. Local Scalars ..
      CHARACTER          HETERO, JOBU, JOBVT
      INTEGER            CONTEXT, DINFO, I, IA, IAM, INFO, ITYPE, IU,
     $                   IVT, JA, JOBTYPE, JU, JVT, LDA, LDU, LDVT,
     $                   LLWORK, LWMIN, MYCOL, MYROW, NNODES, NQ, PASS,
     $                   PTRA, PTRAC, PTRD, PTRWORK, PTRS, PTRSC, PTRU,
     $                   PTRUC, PTRVT, PTRVTC, SETHET, SIZE, SIZEQ,
     $                   WPDGESVD, WPDLAGGE, WPDSVDCHK, WPDSVDCMP
      DOUBLE PRECISION   CHK, DELTA, H, MTM, OVFL, RTOVFL, RTUNFL, ULP,
     $                   UNFL
*     ..
*     .. External Subroutines ..
      EXTERNAL           BLACS_BARRIER, BLACS_GET, BLACS_GRIDEXIT,
     $                   BLACS_GRIDINFO, BLACS_GRIDINIT, BLACS_PINFO,
     $                   BLACS_SET,
     $                   DESCINIT, DGAMN2D, DGAMX2D, DLABAD, DSCAL,
     $                   IGAMN2D, IGAMX2D, IGEBR2D, IGEBS2D, PDELSET,
     $                   PDGESVD, PDLACPY, PDLAGGE, PDLASET, PDSVDCHK,
     $                   PDSVDCMP, PXERBLA, SLBOOT, SLCOMBINE, SLTIMER
*     ..
*     .. External Functions ..
      INTEGER            NUMROC
      DOUBLE PRECISION   PDLAMCH
      EXTERNAL           NUMROC, PDLAMCH
*     ..
*     .. Local Arrays ..
      INTEGER            DESCA( DLEN_ ), DESCU( DLEN_ ),
     $                   DESCVT( DLEN_ ), ITMP( 2 )
      DOUBLE PRECISION   CTIME( 1 ), WTIME( 1 )
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          ABS, INT, MAX, MIN, SQRT
*     ..
*     .. Executable Statements ..
*     This is just to keep ftnchek happy
      IF( BLOCK_CYCLIC_2D*CSRC_*DTYPE_*LLD_*MB_*M_*NB_*N_*RSRC_.LT.0 )
     $   RETURN
*
      CALL BLACS_PINFO( IAM, NNODES )
      CALL BLACS_GET( -1, 0, CONTEXT )
      CALL BLACS_GRIDINIT( CONTEXT, 'R', NPROW, NPCOL )
      CALL BLACS_GRIDINFO( CONTEXT, NPROW, NPCOL, MYROW, MYCOL )
*
*     If this process is not a part of the contex, bail out now.
*
      IF( ( MYROW.GE.NPROW ) .OR. ( MYROW.LT.0 ) .OR.
     $    ( MYCOL.GE.NPCOL ) .OR. ( MYCOL.LT.0 ) )GO TO 110
      CALL BLACS_SET( CONTEXT, 15, 1 )
      INFO = 0
*
*     Check input parameters.
*
      IF( M.LE.0 ) THEN
         INFO = -1
      ELSE IF( N.LE.0 ) THEN
         INFO = -2
      ELSE IF( NPROW.LE.0 ) THEN
         INFO = -3
      ELSE IF( NPCOL.LE.0 ) THEN
         INFO = -4
      ELSE IF( NB.LE.0 ) THEN
         INFO = -5
      ELSE IF( THRESH.LE.0 ) THEN
         INFO = -7
      END IF
*
      SIZE = MIN( M, N )
*
*     Initialize matrix descriptors.
*
      IA  = 1
      JA  = 1
      IU  = 1
      JU  = 1
      IVT = 1
      JVT = 1
*
      LDA = NUMROC( M, NB, MYROW, 0, NPROW )
      LDA = MAX( 1, LDA )
      NQ = NUMROC( N, NB, MYCOL, 0, NPCOL )
      LDU = LDA
      SIZEQ = NUMROC( SIZE, NB, MYCOL, 0, NPCOL )
      LDVT = NUMROC( SIZE, NB, MYROW, 0, NPROW )
      LDVT = MAX( 1, LDVT )
      CALL DESCINIT( DESCA, M, N, NB, NB, 0, 0, CONTEXT, LDA, DINFO )
      CALL DESCINIT( DESCU, M, SIZE, NB, NB, 0, 0, CONTEXT, LDU, DINFO )
      CALL DESCINIT( DESCVT, SIZE, N, NB, NB, 0, 0, CONTEXT, LDVT,
     $               DINFO )
*
*     Set some pointers to work array in order to do "dummy" calls.
*
      PTRA = 2
      PTRAC = PTRA + LDA*NQ
      PTRD = PTRAC + LDA*NQ
      PTRS = PTRD + SIZE
      PTRSC = PTRS + SIZE
      PTRWORK = PTRSC + SIZE
*
      PTRU = PTRWORK
      PTRVT = PTRWORK
      PTRUC = PTRWORK
      PTRVTC = PTRWORK
*
*     "Dummy" calls -- return required workspace in work(1) without
*     any calculation. 
*
      CALL PDLAGGE( M, N, WORK( PTRD ), WORK( PTRA ), IA, JA, DESCA,
     $              ISEED, SIZE, WORK( PTRWORK ), -1, DINFO )
      WPDLAGGE = INT( WORK( PTRWORK ) )
*
      CALL PDGESVD( 'V', 'V', M, N, WORK( PTRA ), IA, JA, DESCA, 
     $              WORK( PTRS ), WORK( PTRU ), IU, JU, DESCU, 
     $              WORK( PTRVT ), IVT, JVT, DESCVT,
     $              WORK( PTRWORK ), -1, DINFO )
      WPDGESVD = INT( WORK( PTRWORK ) )
*
      CALL PDSVDCHK( M, N, WORK( PTRAC ), IA, JA, DESCA, WORK( PTRUC ),
     $               IU, JU, DESCU, WORK( PTRVT ), IVT, JVT, DESCVT, 
     $               WORK( PTRS ), THRESH, WORK( PTRWORK ), -1, 
     $               RESULT, CHK, MTM )
      WPDSVDCHK = INT( WORK( PTRWORK ) )
*
      CALL PDSVDCMP( M, N, 1, WORK( PTRS ), WORK( PTRSC ), WORK( PTRU ),
     $               WORK( PTRUC ), IU, JU, DESCU, WORK( PTRVT ),
     $               WORK( PTRVTC ), IVT, JVT, DESCVT, THRESH, 
     $               RESULT, DELTA, WORK( PTRWORK ), -1 )
      WPDSVDCMP = INT( WORK( PTRWORK ) )
*
*     Calculation of workspace at last.
*
      LWMIN = 1 + 2*LDA*NQ + 3*SIZE +
     $        MAX( WPDLAGGE, LDU*SIZEQ+LDVT*NQ+MAX( LDU*SIZEQ,
     $        LDVT*NQ )+WPDGESVD+MAX( WPDSVDCHK, WPDSVDCMP ) )
      WORK( 1 ) = LWMIN
*
*     If this is a "dummy" call, return.
*
      IF( LWORK.EQ.-1 )
     $   GO TO 120
      IF( INFO.EQ.0 ) THEN
         IF( LWORK.LT.LWMIN ) THEN
            INFO = -10
         END IF
      END IF
*
      IF( INFO.NE.0 ) THEN
         CALL PXERBLA( DESCA( CTXT_ ), 'PDSVDTST', -INFO )
         RETURN
      END IF
*
      ULP = PDLAMCH( CONTEXT, 'P' )
      UNFL = PDLAMCH( CONTEXT, 'Safe min' )
      OVFL = ONE / UNFL
      CALL DLABAD( UNFL, OVFL )
      RTUNFL = SQRT( UNFL )
      RTOVFL = SQRT( OVFL )
*
*     This ensures that everyone starts out with the same seed.
*
      IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
         CALL IGEBS2D( CONTEXT, 'a', ' ', 4, 1, ISEED, 4 )
      ELSE
         CALL IGEBR2D( CONTEXT, 'a', ' ', 4, 1, ISEED, 4, 0, 0 )
      END IF
*
*     Loop over matrix types.
*
      DO 100 ITYPE = 1, NTYPES
*
         PASS = 0
         SETHET = 0
         PTRWORK = PTRSC + SIZE
         LLWORK = LWORK - PTRWORK + 1
*
*        Compute A.
*
         IF( ITYPE.EQ.1 ) THEN
*
*           Zero Matrix.
*
            DO 10 I = 1, SIZE
               WORK( PTRD+I-1 ) = ZERO
   10       CONTINUE
*
            CALL PDLASET( 'All', M, N, ZERO, ZERO, WORK( PTRA ), 
     $                    IA, JA, DESCA )
*
         ELSE IF( ITYPE.EQ.2 ) THEN
*
*           Identity Matrix.
*
            DO 20 I = 1, SIZE
               WORK( PTRD+I-1 ) = ONE
   20       CONTINUE
*
            CALL PDLASET( 'All', M, N, ZERO, ONE, WORK( PTRA ), 
     $                    IA, JA, DESCA )
*
         ELSE IF( ITYPE.GT.2 ) THEN
*
*           Preset Singular Values.
*
            IF( SIZE.NE.1 ) THEN
               H = ( ULP-1 ) / ( SIZE-1 )
               DO 30 I = 1, SIZE
                  WORK( PTRD+I-1 ) = 1 + H*( I-1 )
   30          CONTINUE
            ELSE
               WORK( PTRD ) = 1
            END IF
*
            IF( ITYPE.EQ.3 ) THEN
*
*              Diagonal Matrix with specified singular values.
*
               CALL PDLASET( 'All', M, N, ZERO, ZERO, WORK( PTRA ), 
     $                       IA, JA, DESCA )
*
               DO 40 I = 1, SIZE
                  CALL PDELSET( WORK( PTRA ), I, I, DESCA,
     $                          WORK( PTRD+I-1 ) )
   40          CONTINUE
*
            ELSE IF( ITYPE.EQ.4 ) THEN
*
*              General matrix with specified singular values.
*
               CALL PDLAGGE( M, N, WORK( PTRD ), WORK( PTRA ), IA, JA,
     $                       DESCA, ISEED, SIZE, WORK( PTRWORK ),
     $                       LLWORK, INFO )
*
            ELSE IF( ITYPE.EQ.5 ) THEN
*
*              Singular values scaled by overflow.
*
               CALL DSCAL( SIZE, RTOVFL, WORK( PTRD ), 1 )
*
               CALL PDLAGGE( M, N, WORK( PTRD ), WORK( PTRA ), IA, JA,
     $                       DESCA, ISEED, SIZE, WORK( PTRWORK ),
     $                       LLWORK, INFO )
*
            ELSE IF( ITYPE.EQ.6 ) THEN
*
*              Singular values scaled by underflow.
*
               CALL DSCAL( SIZE, RTUNFL, WORK( PTRD ), 1 )
               CALL PDLAGGE( M, N, WORK( PTRD ), WORK( PTRA ), IA, JA,
     $                       DESCA, ISEED, SIZE, WORK( PTRWORK ),
     $                       LLWORK, INFO )
*
            END IF
*
         END IF
*
*        Set mapping between JOBTYPE and calling parameters of
*        PDGESVD, reset pointers to WORK array to save space.
*
         DO 80 JOBTYPE = 1, 4
*
            IF( JOBTYPE.EQ.1 ) THEN
               JOBU = 'V'
               JOBVT = 'V'
               PTRVT = PTRU + LDU*SIZEQ
               PTRUC = PTRVT + LDVT*NQ
               PTRWORK = PTRUC + LDU*SIZEQ
               LLWORK = LWORK - PTRWORK + 1
            ELSE IF( JOBTYPE.EQ.2 ) THEN
               JOBU = 'V'
               JOBVT = 'N'
            ELSE IF( JOBTYPE.EQ.3 ) THEN
               JOBU = 'N'
               JOBVT = 'V'
               PTRVTC = PTRUC
               PTRWORK = PTRVTC + LDVT*NQ
               LLWORK = LWORK - PTRWORK + 1
            ELSE IF( JOBTYPE.EQ.4 ) THEN
               JOBU = 'N'
               JOBVT = 'N'
               PTRWORK = PTRUC
               LLWORK = LWORK - PTRWORK + 1
            END IF
*
*           Duplicate matrix A.
*
            CALL PDLACPY( 'A', M, N, WORK( PTRA ), IA, JA, DESCA,
     $                    WORK( PTRAC ), IA, JA, DESCA )
*
*           Test SVD calculation with minimum amount of workspace
*           calculated earlier.
*
            IF( JOBTYPE.EQ.1 ) THEN
*
*              Run SVD.
*
               CALL SLBOOT
               CALL BLACS_BARRIER( CONTEXT, 'All' )
               CALL SLTIMER( 1 )
*
               CALL PDGESVD( JOBU, JOBVT, M, N, WORK( PTRAC ), IA, JA,
     $                       DESCA, WORK( PTRS ), WORK( PTRU ), IU, JU,
     $                       DESCU, WORK( PTRVT ), IVT, JVT, DESCVT,
     $                       WORK( PTRWORK ), WPDGESVD, INFO )
*
               CALL SLTIMER( 1 )
               CALL SLCOMBINE( CONTEXT, 'All', '>', 'W', 1, 1, WTIME )
               CALL SLCOMBINE( CONTEXT, 'All', '>', 'C', 1, 1, CTIME )
*
*              Check INFO. Different INFO for different processes mean
*              something went wrong.
*
               ITMP( 1 ) = INFO
               ITMP( 2 ) = INFO
*
               CALL IGAMN2D( DESCA( CTXT_ ), 'a', ' ', 1, 1, ITMP, 1, 1,
     $                       1, -1, -1, 0 )
               CALL IGAMX2D( DESCA( CTXT_ ), 'a', ' ', 1, 1, ITMP( 2 ),
     $                       1, 1, 1, -1, -1, 0 )
*
               IF( ITMP( 1 ).NE.ITMP( 2 ) ) THEN
                  IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
                     WRITE( NOUT, FMT = * )
     $                  'Different processes return different INFO'
                     GO TO 120
                  END IF
               END IF
*
*              If INFO is  negative PXERBLA tells you. So the only thing
*              is to check for positive INFO -- detected heterogeneous
*              system.
*
               IF( INFO.EQ.( SIZE+1 ) ) THEN
                  HETERO = 'P'
                  SETHET = 1
               END IF
*
*              If INFO was fine do more exhaustive check.
*
               IF( INFO.EQ.ZERO ) THEN
*
                  DO 50 I = 1, SIZE
                     WORK( I+PTRWORK ) = WORK( I+PTRS-1 )
                     WORK( I+SIZE+PTRWORK ) = WORK( I+PTRS-1 )
   50             CONTINUE
*
                  CALL DGAMN2D( DESCA( CTXT_ ), 'a', ' ', SIZE, 1,
     $                          WORK( 1+PTRWORK ), SIZE, 1, 1, -1, -1,
     $                          0 )
                  CALL DGAMX2D( DESCA( CTXT_ ), 'a', ' ', SIZE, 1,
     $                          WORK( 1+SIZE+PTRWORK ), SIZE, 1, 1, -1,
     $                          -1, 0 )
*
                  DO 60 I = 1, SIZE
                     IF( ABS( WORK( I+PTRWORK )-WORK( SIZE+I+
     $                   PTRWORK ) ).GT.ZERO ) THEN
                        WRITE( NOUT, FMT = * )'I= ', I, ' MIN=',
     $                     WORK( I+PTRWORK ), ' MAX=',
     $                     WORK( SIZE+I+PTRWORK )
                        HETERO = 'T'
                        SETHET = 1
                        GO TO 70
                     END IF
*
   60             CONTINUE
   70             CONTINUE
*
               END IF
*
               IF( SETHET.NE.1 )
     $            HETERO = 'N'
*
*              Need to copy A again since AC was overwritten by PDGESVD.
*
               CALL PDLACPY( 'A', M, N, WORK( PTRA ), IA, JA, DESCA,
     $                       WORK( PTRAC ), IA, JA, DESCA )
*
*              PDSVDCHK overwrites U. So before the call to PDSVDCHK
*              U is copied to UC and a pointer to UC is passed to
*              PDSVDCHK.
*
               CALL PDLACPY( 'A', M, SIZE, WORK( PTRU ), IU, JU, DESCU,
     $                       WORK( PTRUC ), IU, JU, DESCU )
*
*              Run tests 1 - 4.
*
               CALL PDSVDCHK( M, N, WORK( PTRAC ), IA, JA, DESCA,
     $                        WORK( PTRUC ), IU, JU, DESCU, 
     $                        WORK( PTRVT ), IVT, JVT, DESCVT, 
     $                        WORK( PTRS ), THRESH, WORK( PTRWORK ), 
     $                        LLWORK, RESULT, CHK, MTM )
*
            ELSE
*
*              Once again test PDGESVD with min workspace.
*
               CALL PDGESVD( JOBU, JOBVT, M, N, WORK( PTRAC ), IA, JA,
     $                       DESCA, WORK( PTRSC ), WORK( PTRUC ), IU,
     $                       JU, DESCU, WORK( PTRVTC ), IVT, JVT, 
     $                       DESCVT, WORK( PTRWORK ), WPDGESVD, INFO )
*
               CALL PDSVDCMP( M, N, JOBTYPE, WORK( PTRS ),
     $                        WORK( PTRSC ), WORK( PTRU ),
     $                        WORK( PTRUC ), IU, JU, DESCU, 
     $                        WORK( PTRVT ), WORK( PTRVTC ), IVT, JVT,
     $                        DESCVT, THRESH, RESULT, DELTA,
     $                        WORK( PTRWORK ), LLWORK )
*
            END IF
*
   80    CONTINUE
*
         IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
            DO 90 I = 1, 9
               IF( RESULT( I ).EQ.1 ) THEN
                  PASS = 1
                  WRITE( NOUT, FMT = * )'Test I = ', I, 'has failed'
                  WRITE( NOUT, FMT = * )' '
               END IF
   90       CONTINUE
            IF( PASS.EQ.0 ) THEN
               WRITE( NOUT, FMT = 9999 )'Passed', WTIME( 1 ),
     $            CTIME( 1 ), M, N, NPROW, NPCOL, NB, ITYPE, CHK, MTM,
     $            DELTA, HETERO
            END IF
         END IF
  100 CONTINUE
      CALL BLACS_GRIDEXIT( CONTEXT )
  110 CONTINUE
*
 9999 FORMAT( A6, 2E10.3, 2I6, 2I4, I5, I6, 3F6.2, 4X, A1 )
  120 CONTINUE
*
*     End of PDSVDTST
*
      RETURN
      END
