psgrptseptst.f

Go to the documentation of this file.

      PROGRAM psrptgseptst
*
*  -- ScaLAPACK routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     August 14, 2001 
*
*     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
      REAL               abstol, thresh
*     ..
*     .. Local Arrays ..
      INTEGER            desca( dlen_ ), iclustr( maxn ), ifail( maxn ),
     $                   iseed( 4 ), iwork( liwork )
      REAL               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, psgseptst
*     ..
*     .. 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.1175494351e-37
      thresh = .350000e+01
*
      CALL blacs_pinfo( iam, nprocs )
      IF( nprocs.LT.1 ) 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 psgseptst( 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 PSRPTGSEPTST
*
      END