pcrptseptst.f

Go to the documentation of this file.

      PROGRAM pcrptseptst
*
*  -- ScaLAPACK routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     August 14, 2001
*
*     Repeat parallel Hermitian 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, 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               gap( maxn ), rwork( lwork ), win( maxn ),
     $                   wnew( maxn )
      COMPLEX            a( MAXN*maxn ), copya( maxn*maxn ),
     $                   work( lwork ), z( maxn*maxn )
*     ..
*
*
*     .. External Subroutines ..
*
      EXTERNAL           blacs_exit, blacs_get, blacs_gridinit,
     $                   blacs_pinfo, blacs_setup, descinit, pcseptst
*     ..
*     .. Executable Statements ..
*
      iprepad = 3
      ipostpad = 3
      lda = maxn
*
*     These lines should be replaced by the output from pxSEPdriver
*
*
      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
*  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 pcseptst( desca, uplo, n, mattype, subtests, thresh, n,
     $               abstol, iseed, a, copya, z, lda, win, wnew, ifail,
     $               iclustr, gap, iprepad, ipostpad, work,
     $               lwork-iprepad-ipostpad, rwork,
     $               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 PCRPTSEPTST
*
      END