pdgrptseptst.f

Go to the documentation of this file.

*
*
      PROGRAM pdrptgseptst
*
*  -- ScaLAPACK routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     November 15, 1997
*
*     Repeat generalized parallel symmetric eigenproblem test
*     .. Parameters ..
*
      INTEGER            dlen_
      parameter( dlen_ = 9 )
      INTEGER            maxn, lwork, liwork
      parameter( maxn = 200, lwork = 500000,
     $                   liwork = 6*maxn+4 )
*     ..
*     .. Local Scalars ..
      CHARACTER          subtests, uplo
      INTEGER            context, iam, ibtype, info, ipostpad, iprepad,
     $                   lda, mattype, n, nb, npcol, nprocs, nprow
      DOUBLE PRECISION   abstol, thresh
*     ..
*     .. Local Arrays ..
      INTEGER            desca( dlen_ ), iclustr( maxn ), ifail( maxn ),
     $                   iseed( 4 ), iwork( liwork )
      DOUBLE PRECISION   a( maxn*maxn ), b( maxn, maxn ),
     $                   copya( maxn*maxn ), copyb( maxn, maxn ),
     $                   gap( maxn ), win( maxn ), wnew( maxn ),
     $                   work( lwork ), z( maxn*maxn )
*     ..
*
*
*     .. External Subroutines ..
*
      EXTERNAL           blacs_exit, blacs_get, blacs_gridinit,
     $                   blacs_pinfo, blacs_setup, descinit, pdgseptst
*     ..
*     .. Executable Statements ..
*
      iprepad = 3
      ipostpad = 3
      lda = maxn
*
*     These lines should be replaced by the output from pxGSEPdriver
*
*
      iseed( 1 ) = 2312
      iseed( 2 ) = 3709
      iseed( 3 ) = 666
      iseed( 4 ) = 3371
      uplo = 'u'
      SUBTESTS = 'y'
      N = 33
      NPROW = 2
      NPCOL = 2
      NB = 4
      MATTYPE = 9
      IBTYPE = 1
*  note: the printout often makes a mess of ABSTOL
      ABSTOL = 0.1175494351D-37
      THRESH = .350000D+01
*
      CALL BLACS_PINFO( IAM, NPROCS )
.LT.      IF( NPROCS1 ) THEN
*
         NPROCS = NPROW*NPCOL
         CALL BLACS_SETUP( IAM, NPROCS )
      END IF
      CALL BLACS_GET( -1, 0, CONTEXT )
      CALL BLACS_GRIDINIT( CONTEXT, 'r', NPROW, NPCOL )
*
      CALL DESCINIT( DESCA, N, N, NB, NB, 0, 0, CONTEXT, LDA, INFO )
*
      CALL PDGSEPTST( DESCA, UPLO, N, MATTYPE, IBTYPE, SUBTESTS, THRESH,
     $                N, ABSTOL, ISEED, A, COPYA, B, COPYB, Z, LDA, WIN,
     $                WNEW, IFAIL, ICLUSTR, GAP, IPREPAD, IPOSTPAD,
     $                WORK, LWORK-IPREPAD-IPOSTPAD, IWORK,
     $                LIWORK-IPREPAD-IPOSTPAD, 6, INFO )
*
*
*
*     Uncomment this line on SUN systems to avoid the useless print out
*
*      CALL IEEE_FLAGS( 'clear', 'exception', 'underflow', '')
*
*
*
*
      CALL BLACS_EXIT( 0 )
      STOP
*
*
*
*     End of PDRPTGSEPTST
*
      END