pzsepdriver.f

Go to the documentation of this file.

*
*
      PROGRAM pzsepdriver
*
*  -- ScaLAPACK routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     Parallel COMPLEX*16 Hermitian eigenproblem test driver
*
*     The user should modify TOTMEM to indicate the maximum amount of
*     memory in bytes her system has.  Remember to leave room in memory
*     for operating system, the BLACS buffer, etc.  INTSIZ and DBLSIZ
*     indicate the length in bytes on the given platform for an integer
*     and a double precision real.
*     For example, on our system with 8 MB of memory, TOTMEM=6500000
*     (leaves 1.5 MB for OS, code, BLACS buffer, etc), the length of a
*     DOUBLE is 8, and an integer takes up 4 bytes.  Some playing around
*     to discover what the maximum value you can set MEMSIZ to may be
*     required.
*     All arrays used by factorization and solve are allocated out of
*     big array called MEM.
*
*     The full tester requires approximately (5 n + 5 n^2/p + slop)
*     COMPLEX*16 words and 6*n integer words.
*     So, TOTMEM should be set to at least 1.1 * 8 * (5n + 5n^2/p)
*
*     WHAT WE TEST
*     ============
*
*     This routine tests PZHEEVX, the expert driver for the parallel
*     Hermitian eigenvalue problem.  We would like to cover all
*     possible combinations of:  matrix size, process configuration
*     (nprow and npcol), block size (nb), matrix type (??), range
*     of eigenvalue (all, by value, by position), sorting options,
*     and upper vs. lower storage.
*
*     We intend to provide two types of test input files, an
*     installation test and a thorough test.
*
*     We also intend that the reports be meaningful.  Our input file
*     will allow multiple requests where each request is a cross product
*     of the following sets:
*       matrix sizes:                     n
*       process configuration triples:  nprow, npcol, nb
*       matrix types:
*       eigenvalue requests:              all, by value, by position
*       storage (upper vs. lower):        uplo
*
*     TERMS:
*       Request - means a set of tests, which is the cross product of
*       a set of specifications from the input file.
*       Test - one element in the cross product, i.e. a specific input
*       size and type, process configuration, etc.
*
*     .. Parameters ..
*
      INTEGER            TOTMEM, zplxsz, nin
      parameter( totmem = 2000000, zplxsz = 16, nin = 11 )
      INTEGER            memsiz
      parameter( memsiz = totmem / zplxsz )
*     ..
*     .. Local Scalars ..
      CHARACTER          hetero
      CHARACTER*80       summry, usrinfo
      INTEGER            context, iam, info, ISIEEE, maxnodes, nnocheck,
     $                   nout, npassed, nprocs, nskipped, ntests
*     ..
*     .. Local Arrays ..
*
      INTEGER            iseed( 4 )
      COMPLEX*16         mem( memsiz )
*     ..
*     .. External Functions ..
      DOUBLE PRECISION   dlamch
      EXTERNAL           dlamch
*     ..
*     .. External Subroutines ..
*
      EXTERNAL           blacs_exit, blacs_get, blacs_gridexit,
     $                   blacs_gridinit, blacs_pinfo, blacs_setup,
     $                   igamn2d, pdlachkieee, pdlasnbt, pzsepreq
*     ..
*     .. Executable Statements ..
*
*     Get starting information
*
      CALL blacs_pinfo( iam, nprocs )
*
*
      IF( iam.EQ.0 ) THEN
*
*        Open file and skip data file header
*
         OPEN( unit = nin, file = 'SEP.dat', status = 'OLD' )
         READ( nin, fmt = * )summry
         summry = ' '
*
*        Read in user-supplied info about machine type, compiler, etc.
*
         READ( nin, fmt = 9999 )usrinfo
*
*        Read name and unit number for summary output file
*
         READ( nin, fmt = * )summry
         READ( nin, fmt = * )nout
         IF( nout.NE.0 .AND. nout.NE.6 )
     $      OPEN( nout, file = summry, status = 'UNKNOWN' )
         READ( nin, fmt = * )maxnodes
         READ( nin, fmt = * )hetero
      END IF
*
      IF( nprocs.LT.1 ) THEN
         CALL blacs_setup( iam, maxnodes )
         nprocs = maxnodes
      END IF
*
      CALL blacs_get( -1, 0, context )
      CALL blacs_gridinit( context, 'R', 1, nprocs )
*
      CALL pdlasnbt( isieee )
*
      CALL igamn2d( context, 'a', ' ', 1, 1, isieee, 1, 1, 1, -1, -1,
     $              0 )
*
      IF( ( isieee.NE.0 ) ) THEN
         IF( iam.EQ.0 ) THEN
            WRITE( nout, fmt = 9998 )
            WRITE( nout, fmt = 9997 )
            WRITE( nout, fmt = 9996 )
            WRITE( nout, fmt = 9995 )
            WRITE( nout, fmt = 9994 )
            WRITE( nout, fmt = 9993 )
            WRITE( nout, fmt = 9992 )
            WRITE( nout, fmt = 9991 )
            WRITE( nout, fmt = 9990 )
         END IF
*
         CALL pdlachkieee( isieee, dlamch( 'O' ), dlamch( 'U' ) )
*
         CALL igamn2d( context, 'a', ' ', 1, 1, isieee, 1, 1, 1, -1, -1,
     $                 0 )
*
         IF( isieee.EQ.0 ) THEN
            IF( iam.EQ.0 ) THEN
               WRITE( nout, fmt = 9989 )
               WRITE( nout, fmt = 9988 )
               WRITE( nout, fmt = 9987 )
            END IF
            GO TO 20
         END IF
*
         IF( iam.EQ.0 ) THEN
            WRITE( nout, fmt = 9986 )
         END IF
*
      END IF
      IF( iam.EQ.0 ) THEN
         WRITE( nout, fmt = 9999 )
     $      'SCALAPACK Hermitian Eigendecomposition routines.'
         WRITE( nout, fmt = 9999 )usrinfo
         WRITE( nout, fmt = 9999 )' '
         WRITE( NOUT, FMT = 9999 )'running tests of the parallel ' //
     $      'hermitian eigenvalue routine:  pzheevx.'
         WRITE( NOUT, FMT = 9999 )'the following scaled residual ' //
     $      'checks will be computed:'
         WRITE( NOUT, FMT = 9999 )' ||aq - ql|| ' //
     $      '/ ((abstol + ||a|| * eps) * n)'
         WRITE( NOUT, FMT = 9999 )' ||q^t*q - i|| ' // '/ (n * eps)'
         WRITE( NOUT, FMT = 9999 )
         WRITE( NOUT, FMT = 9999 )'an explanation of the ' //
     $      'input/output parameters follows:'
         WRITE( NOUT, FMT = 9999 )'result   : passed; or ' //
     $      'an indication of which eigen request test failed'
         WRITE( NOUT, FMT = 9999 )
     $      'n        : the number of rows and columns ' //
     $      'of the matrix a.'
         WRITE( NOUT, FMT = 9999 )
     $      'p        : the number of process rows.'
         WRITE( NOUT, FMT = 9999 )
     $      'q        : the number of process columns.'
         WRITE( NOUT, FMT = 9999 )
     $      'nb       : the size of the square blocks' //
     $      ' the matrix a is split into.'
         WRITE( NOUT, FMT = 9999 )
     $      'thresh   : If a residual value is less ' //
     $      'than thresh, result is flagged as passed.'
         WRITE( NOUT, FMT = 9999 )
     $      '         : the qtq norm is allowed to exceed thresh' //
     $      ' for those eigenvectors'
         WRITE( NOUT, FMT = 9999 )'         :  which could not be ' //
     $      'reorthogonalized for lack of workspace.'
         WRITE( NOUT, FMT = 9999 )
     $      'typ      : matrix type (see pzseptst.f).'
         WRITE( NOUT, FMT = 9999 )'sub      : subtests ' //
     $      '(see pzseptst).f'
         WRITE( NOUT, FMT = 9999 )'chk      : ||aq - ql|| ' //
     $      '/ ((abstol + ||a|| * eps) * n)'
         WRITE( NOUT, FMT = 9999 )'qtq      : ||q^t*q - i||/ (n * eps)'
         WRITE( NOUT, FMT = 9999 )
     $      '         : when the adjusted qtq exceeds thresh',
     $      ' the adjusted qtq norm is printed'
         WRITE( NOUT, FMT = 9999 )
     $      '         : otherwise the true qtq norm is printed'
         WRITE( NOUT, FMT = 9999 )
     $      'if nt>1, chk and qtq are the max over all ' //
     $      'eigen request tests'
         WRITE( NOUT, FMT = 9999 )' '
      END IF
*
      NTESTS = 0
      NPASSED = 0
      NSKIPPED = 0
      NNOCHECK = 0
*
.EQ.      IF( IAM0 ) THEN
         WRITE( NOUT, FMT = 9979 )
         WRITE( NOUT, FMT = 9978 )
      END IF
*
   10 CONTINUE
*
      ISEED( 1 ) = 139
      ISEED( 2 ) = 1139
      ISEED( 3 ) = 2139
      ISEED( 4 ) = 3139
*
      CALL PZSEPREQ( NIN, MEM, MEMSIZ, NOUT, ISEED, NTESTS, NSKIPPED,
     $               NNOCHECK, NPASSED, INFO )
.EQ.      IF( INFO0 )
     $   GO TO 10
*
.EQ.      IF( IAM0 ) THEN
         WRITE( NOUT, FMT = 9985 )NTESTS
         WRITE( NOUT, FMT = 9984 )NPASSED
         WRITE( NOUT, FMT = 9983 )NNOCHECK
         WRITE( NOUT, FMT = 9982 )NSKIPPED
         WRITE( NOUT, FMT = 9981 )NTESTS - NPASSED - NSKIPPED -
     $      NNOCHECK
         WRITE( NOUT, FMT = * )
         WRITE( NOUT, FMT = * )
         WRITE( NOUT, FMT = 9980 )
      END IF
*
*     Uncomment this line on SUN systems to avoid the useless print out
*
*      CALL IEEE_FLAGS( 'clear', 'exception', 'underflow', '')
*
*
*
   20 CONTINUE
.EQ.      IF( IAM0 ) THEN
         CLOSE ( NIN )
.NE..AND..NE.         IF( NOUT6  NOUT0 )
     $      CLOSE ( NOUT )
      END IF
*
      CALL BLACS_GRIDEXIT( CONTEXT )
*
      CALL BLACS_EXIT( 0 )
      STOP
*
*
 9999 FORMAT( A )
 9998 FORMAT( ' i am about to check to make sure that overflow' )
 9997 FORMAT( ' is handled in the ieee default manner.  if this' )
 9996 FORMAT( ' is the last output you see, you should assume' )
 9995 FORMAT( ' that overflow caused a floating point exception.' )
 9994 FORMAT( ' in that case, we recommend that you add -dno_ieee' )
 9993 FORMAT( ' to the cdefs line in slmake.inc.' )
 9992 FORMAT( ' alternatively, you could set cdefs in slmake.inc ' )
 9991 FORMAT( ' to enable the default ieee behaviour, however, this' )
 9990 FORMAT( ' may result in good or very bad performance.' )
 9989 FORMAT( ' either signed zeroes or signed infinities ' )
 9988 FORMAT( ' work incorrectly or your system.  change your' )
 9987 FORMAT( ' slmake.inc as suggested above.' )
*
 9986 FORMAT( ' your system appears to handle ieee overflow.' )
*
 9985 FORMAT( 'finished ', I6, ' tests, with the following results:' )
 9984 FORMAT( I5, ' tests completed and passed residual checks.' )
 9983 FORMAT( I5, ' tests completed without checking.' )
 9982 FORMAT( I5, ' tests skipped for lack of memory.' )
 9981 FORMAT( I5, ' tests completed and failed.' )
 9980 FORMAT( 'end of tests.' )
 9979 FORMAT( '     n  nb   p   q typ sub   wall      cpu  ',
     $      '    chk       qtq    check' )
 9978 FORMAT( ' ----- --- --- --- --- --- -------- --------',
     $      ' --------- --------- -----' )
*
*     End of PZSEPDRIVER
*
      END