psblas1tim.f File Reference

Go to the source code of this file.

Functions/Subroutines
program	psbla1tim
subroutine	psbla1timinfo (summry, nout, nmat, nval, mxval, nxval, imbxval, mbxval, inbxval, nbxval, rscxval, cscxval, ixval, jxval, incxval, myval, nyval, imbyval, mbyval, inbyval, nbyval, rscyval, cscyval, iyval, jyval, incyval, ldval, ngrids, pval, ldpval, qval, ldqval, ltest, iam, nprocs, alpha, work)

Function/Subroutine Documentation

psbla1tim()

program psbla1tim

Definition at line 11 of file psblas1tim.f.

psbla1timinfo()

subroutine psbla1timinfo	(	character*( * )	summry,
		integer	nout,
		integer	nmat,
		integer, dimension( ldval )	nval,
		integer, dimension( ldval )	mxval,
		integer, dimension( ldval )	nxval,
		integer, dimension( ldval )	imbxval,
		integer, dimension( ldval )	mbxval,
		integer, dimension( ldval )	inbxval,
		integer, dimension( ldval )	nbxval,
		integer, dimension( ldval )	rscxval,
		integer, dimension( ldval )	cscxval,
		integer, dimension( ldval )	ixval,
		integer, dimension( ldval )	jxval,
		integer, dimension( ldval )	incxval,
		integer, dimension( ldval )	myval,
		integer, dimension( ldval )	nyval,
		integer, dimension( ldval )	imbyval,
		integer, dimension( ldval )	mbyval,
		integer, dimension( ldval )	inbyval,
		integer, dimension( ldval )	nbyval,
		integer, dimension( ldval )	rscyval,
		integer, dimension( ldval )	cscyval,
		integer, dimension( ldval )	iyval,
		integer, dimension( ldval )	jyval,
		integer, dimension( ldval )	incyval,
		integer	ldval,
		integer	ngrids,
		integer, dimension( ldpval )	pval,
		integer	ldpval,
		integer, dimension( ldqval )	qval,
		integer	ldqval,
		logical, dimension( * )	ltest,
		integer	iam,
		integer	nprocs,
		real	alpha,
		integer, dimension( * )	work )

Definition at line 543 of file psblas1tim.f.

*
*  -- PBLAS test routine (version 2.0) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     April 1, 1998
*
*     .. Scalar Arguments ..
      INTEGER            IAM, LDPVAL, LDQVAL, LDVAL, NGRIDS, NMAT, NOUT,
     $                   NPROCS
      REAL               ALPHA
*     ..
*     .. Array Arguments ..
      CHARACTER*( * )    SUMMRY
      LOGICAL            LTEST( * )
      INTEGER            CSCXVAL( LDVAL ), CSCYVAL( LDVAL ),
     $                   IMBXVAL( LDVAL ), IMBYVAL( LDVAL ),
     $                   INBXVAL( LDVAL ), INBYVAL( LDVAL ),
     $                   INCXVAL( LDVAL ), INCYVAL( LDVAL ),
     $                   IXVAL( LDVAL ), IYVAL( LDVAL ), JXVAL( LDVAL ),
     $                   JYVAL( LDVAL ), MBXVAL( LDVAL ),
     $                   MBYVAL( LDVAL ), MXVAL( LDVAL ),
     $                   MYVAL( LDVAL ), NBXVAL( LDVAL ),
     $                   NBYVAL( LDVAL ), NVAL( LDVAL ), NXVAL( LDVAL ),
     $                   NYVAL( LDVAL ), PVAL( LDPVAL ), QVAL( LDQVAL ),
     $                   RSCXVAL( LDVAL ), RSCYVAL( LDVAL ), WORK( * )
*     ..
*
*  Purpose
*  =======
*
*  PSBLA1TIMINFO  get  the needed startup information for timing various
*  Level 1 PBLAS routines, and transmits it to all processes.
*
*  Notes
*  =====
*
*  For packing the information we assumed that the length in bytes of an
*  integer is equal to the length in bytes of a real single precision.
*
*  Arguments
*  =========
*
*  SUMMRY  (global output) CHARACTER*(*)
*          On  exit,  SUMMRY  is  the  name of output (summary) file (if
*          any). SUMMRY is only defined for process 0.
*
*  NOUT    (global output) INTEGER
*          On exit, NOUT  specifies the unit number for the output file.
*          When NOUT is 6, output to screen,  when  NOUT is 0, output to
*          stderr. NOUT is only defined for process 0.
*
*  NMAT    (global output) INTEGER
*          On exit,  NMAT  specifies the number of different test cases.
*
*  NVAL    (global output) INTEGER array
*          On entry, NVAL is an array of dimension LDVAL.  On exit, this
*          array contains the values of N to run the code with.
*
*  MXVAL   (global output) INTEGER array
*          On entry, MXVAL is an array of dimension LDVAL. On exit, this
*          array  contains  the values  of  DESCX( M_ )  to run the code
*          with.
*
*  NXVAL   (global output) INTEGER array
*          On entry, NXVAL is an array of dimension LDVAL. On exit, this
*          array  contains  the values  of  DESCX( N_ )  to run the code
*          with.
*
*  IMBXVAL (global output) INTEGER array
*          On entry,  IMBXVAL  is an array of  dimension LDVAL. On exit,
*          this  array  contains  the values of DESCX( IMB_ ) to run the
*          code with.
*
*  MBXVAL  (global output) INTEGER array
*          On entry,  MBXVAL  is an array of  dimension  LDVAL. On exit,
*          this  array  contains  the values of DESCX( MB_ ) to  run the
*          code with.
*
*  INBXVAL (global output) INTEGER array
*          On entry,  INBXVAL  is an array of  dimension LDVAL. On exit,
*          this  array  contains  the values of DESCX( INB_ ) to run the
*          code with.
*
*  NBXVAL  (global output) INTEGER array
*          On entry,  NBXVAL  is an array of  dimension  LDVAL. On exit,
*          this  array  contains  the values of DESCX( NB_ ) to  run the
*          code with.
*
*  RSCXVAL (global output) INTEGER array
*          On entry, RSCXVAL  is an array of  dimension  LDVAL. On exit,
*          this  array  contains the values of DESCX( RSRC_ ) to run the
*          code with.
*
*  CSCXVAL (global output) INTEGER array
*          On entry, CSCXVAL  is an array of  dimension  LDVAL. On exit,
*          this  array  contains the values of DESCX( CSRC_ ) to run the
*          code with.
*
*  IXVAL   (global output) INTEGER array
*          On entry, IXVAL is an array of dimension LDVAL. On exit, this
*          array  contains the values of IX to run the code with.
*
*  JXVAL   (global output) INTEGER array
*          On entry, JXVAL is an array of dimension LDVAL. On exit, this
*          array  contains the values of JX to run the code with.
*
*  INCXVAL (global output) INTEGER array
*          On entry,  INCXVAL  is  an array of dimension LDVAL. On exit,
*          this array  contains the values of INCX to run the code with.
*
*  MYVAL   (global output) INTEGER array
*          On entry, MYVAL is an array of dimension LDVAL. On exit, this
*          array  contains  the values  of  DESCY( M_ )  to run the code
*          with.
*
*  NYVAL   (global output) INTEGER array
*          On entry, NYVAL is an array of dimension LDVAL. On exit, this
*          array  contains  the values  of  DESCY( N_ )  to run the code
*          with.
*
*  IMBYVAL (global output) INTEGER array
*          On entry,  IMBYVAL  is an array of  dimension LDVAL. On exit,
*          this  array  contains  the values of DESCY( IMB_ ) to run the
*          code with.
*
*  MBYVAL  (global output) INTEGER array
*          On entry,  MBYVAL  is an array of  dimension  LDVAL. On exit,
*          this  array  contains  the values of DESCY( MB_ ) to  run the
*          code with.
*
*  INBYVAL (global output) INTEGER array
*          On entry,  INBYVAL  is an array of  dimension LDVAL. On exit,
*          this  array  contains  the values of DESCY( INB_ ) to run the
*          code with.
*
*  NBYVAL  (global output) INTEGER array
*          On entry,  NBYVAL  is an array of  dimension  LDVAL. On exit,
*          this  array  contains  the values of DESCY( NB_ ) to  run the
*          code with.
*
*  RSCYVAL (global output) INTEGER array
*          On entry, RSCYVAL  is an array of  dimension  LDVAL. On exit,
*          this  array  contains the values of DESCY( RSRC_ ) to run the
*          code with.
*
*  CSCYVAL (global output) INTEGER array
*          On entry, CSCYVAL  is an array of  dimension  LDVAL. On exit,
*          this  array  contains the values of DESCY( CSRC_ ) to run the
*          code with.
*
*  IYVAL   (global output) INTEGER array
*          On entry, IYVAL is an array of dimension LDVAL. On exit, this
*          array  contains the values of IY to run the code with.
*
*  JYVAL   (global output) INTEGER array
*          On entry, JYVAL is an array of dimension LDVAL. On exit, this
*          array  contains the values of JY to run the code with.
*
*  INCYVAL (global output) INTEGER array
*          On entry,  INCYVAL  is  an array of dimension LDVAL. On exit,
*          this array  contains the values of INCY to run the code with.
*
*  LDVAL   (global input) INTEGER
*          On entry, LDVAL specifies the maximum number of different va-
*          lues that can be used for  DESCX(:),  IX, JX, INCX, DESCY(:),
*          IY,  JY  and  INCY.  This  is also the maximum number of test
*          cases.
*
*  NGRIDS  (global output) INTEGER
*          On exit, NGRIDS specifies the number of different values that
*          can be used for P and Q.
*
*  PVAL    (global output) INTEGER array
*          On entry, PVAL is an array of dimension LDPVAL. On exit, this
*          array contains the values of P to run the code with.
*
*  LDPVAL  (global input) INTEGER
*          On entry,  LDPVAL  specifies  the maximum number of different
*          values that can be used for P.
*
*  QVAL    (global output) INTEGER array
*          On entry, QVAL is an array of dimension LDQVAL. On exit, this
*          array contains the values of Q to run the code with.
*
*  LDQVAL  (global input) INTEGER
*          On entry,  LDQVAL  specifies  the maximum number of different
*          values that can be used for Q.
*
*  LTEST   (global output) LOGICAL array
*          On entry,  LTEST  is an array of dimension at least eight. On
*          exit, if LTEST( i ) is .TRUE., the i-th Level 1 PBLAS routine
*          will be tested.  See  the  input file for the ordering of the
*          routines.
*
*  IAM     (local input) INTEGER
*          On entry,  IAM  specifies the number of the process executing
*          this routine.
*
*  NPROCS  (global input) INTEGER
*          On entry, NPROCS specifies the total number of processes.
*
*  ALPHA   (global output) REAL
*          On exit, ALPHA specifies the value of alpha to be used in all
*          the test cases.
*
*  WORK    (local workspace) INTEGER array
*          On   entry,   WORK   is   an  array  of  dimension  at  least
*          MAX( 2, 2*NGRIDS+23*NMAT+NSUBS ) with NSUBS = 8.  This  array
*          is  used  to  pack all output arrays in order to send info in
*          one message.
*
*  -- Written on April 1, 1998 by
*     Antoine Petitet, University  of  Tennessee, Knoxville 37996, USA.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            NIN, NSUBS
      parameter( nin = 11, nsubs = 8 )
*     ..
*     .. Local Scalars ..
      LOGICAL            LTESTT
      INTEGER            I, ICTXT, J
*     ..
*     .. Local Arrays ..
      CHARACTER*7        SNAMET
      CHARACTER*79       USRINFO
*     ..
*     .. External Subroutines ..
      EXTERNAL           blacs_abort, blacs_get, blacs_gridexit,
     $                   blacs_gridinit, blacs_setup, icopy, igebr2d,
     $                   igebs2d, sgebr2d, sgebs2d
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          max, min
*     ..
*     .. Common Blocks ..
      CHARACTER*7        SNAMES( NSUBS )
      COMMON             /snamec/snames
*     ..
*     .. Executable Statements ..
*
*
*     Process 0 reads the input data, broadcasts to other processes and
*     writes needed information to NOUT
*
      IF( iam.EQ.0 ) THEN
*
*        Open file and skip data file header
*
         OPEN( nin, file='PSBLAS1TIM.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 and check the parameter values for the tests.
*
*        Get number of grids
*
         READ( nin, fmt = * ) ngrids
         IF( ngrids.LT.1 .OR. ngrids.GT.ldpval ) THEN
            WRITE( nout, fmt = 9998 ) 'Grids', ldpval
            GO TO 100
         ELSE IF( ngrids.GT.ldqval ) THEN
            WRITE( nout, fmt = 9998 ) 'Grids', ldqval
            GO TO 100
         END IF
*
*        Get values of P and Q
*
         READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
         READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
*
*        Read ALPHA
*
         READ( nin, fmt = * ) alpha
*
*        Read number of tests.
*
         READ( nin, fmt = * ) nmat
         IF( nmat.LT.1 .OR. nmat.GT.ldval ) THEN
            WRITE( nout, fmt = 9998 ) 'Tests', ldval
            GO TO 100
         END IF
*
*        Read in input data into arrays.
*
         READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( mxval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( nxval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( imbxval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( inbxval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( mbxval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( nbxval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( rscxval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( cscxval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( ixval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( jxval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( incxval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( myval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( nyval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( imbyval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( inbyval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( mbyval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( nbyval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( rscyval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( cscyval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( iyval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( jyval( i ), i = 1, nmat )
         READ( nin, fmt = * ) ( incyval( i ), i = 1, nmat )
*
*        Read names of subroutines and flags which indicate
*        whether they are to be tested.
*
         DO 10 i = 1, nsubs
            ltest( i ) = .false.
   10    CONTINUE
   20    CONTINUE
         READ( nin, fmt = 9996, END = 50 ) SNAMET, ltestt
         DO 30 i = 1, nsubs
            IF( snamet.EQ.snames( i ) )
     $         GO TO 40
   30    CONTINUE
*
         WRITE( nout, fmt = 9995 )snamet
         GO TO 100
*
   40    CONTINUE
         ltest( i ) = ltestt
         GO TO 20
*
   50    CONTINUE
*
*        Close input file
*
         CLOSE ( nin )
*
*        For pvm only: if virtual machine not set up, allocate it and
*        spawn the correct number of processes.
*
         IF( nprocs.LT.1 ) THEN
            nprocs = 0
            DO 60 i = 1, ngrids
               nprocs = max( nprocs, pval( i )*qval( i ) )
   60       CONTINUE
            CALL blacs_setup( iam, nprocs )
         END IF
*
*        Temporarily define blacs grid to include all processes so
*        information can be broadcast to all processes
*
         CALL blacs_get( -1, 0, ictxt )
         CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
*
*        Pack information arrays and broadcast
*
         CALL sgebs2d( ictxt, 'All', ' ', 1, 1, alpha, 1 )
*
         work( 1 ) = ngrids
         work( 2 ) = nmat
         CALL igebs2d( ictxt, 'All', ' ', 2, 1, work, 2 )
*
         i = 1
         CALL icopy( ngrids, pval,     1, work( i ), 1 )
         i = i + ngrids
         CALL icopy( ngrids, qval,     1, work( i ), 1 )
         i = i + ngrids
         CALL icopy( nmat,   nval,     1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   mxval,    1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   nxval,    1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   imbxval,  1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   inbxval,  1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   mbxval,   1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   nbxval,   1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   rscxval,  1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   cscxval,  1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   ixval,    1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   jxval,    1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   incxval,  1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   myval,    1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   nyval,    1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   imbyval,  1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   inbyval,  1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   mbyval,   1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   nbyval,   1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   rscyval,  1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   cscyval,  1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   iyval,    1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   jyval,    1, work( i ), 1 )
         i = i + nmat
         CALL icopy( nmat,   incyval,  1, work( i ), 1 )
         i = i + nmat
*
         DO 70 j = 1, nsubs
            IF( ltest( j ) ) THEN
               work( i ) = 1
            ELSE
               work( i ) = 0
            END IF
            i = i + 1
   70    CONTINUE
         i = i - 1
         CALL igebs2d( ictxt, 'All', ' ', i, 1, work, i )
*
*        regurgitate input
*
         WRITE( nout, fmt = 9999 )
     $               'Level 1 PBLAS timing program.'
         WRITE( nout, fmt = 9999 ) usrinfo
         WRITE( nout, fmt = * )
         WRITE( nout, fmt = 9999 )
     $               'Timing of the real single precision '//
     $               'Level 1 PBLAS'
         WRITE( nout, fmt = * )
         WRITE( nout, fmt = 9999 )
     $               'The following parameter values will be used:'
         WRITE( nout, fmt = * )
         WRITE( nout, fmt = 9993 ) nmat
         WRITE( nout, fmt = 9992 ) ngrids
         WRITE( nout, fmt = 9990 )
     $               'P', ( pval(i), i = 1, min(ngrids, 5) )
         IF( ngrids.GT.5 )
     $      WRITE( nout, fmt = 9991 ) ( pval(i), i = 6,
     $                                  min( 10, ngrids ) )
         IF( ngrids.GT.10 )
     $      WRITE( nout, fmt = 9991 ) ( pval(i), i = 11,
     $                                  min( 15, ngrids ) )
         IF( ngrids.GT.15 )
     $      WRITE( nout, fmt = 9991 ) ( pval(i), i = 16, ngrids )
         WRITE( nout, fmt = 9990 )
     $               'Q', ( qval(i), i = 1, min(ngrids, 5) )
         IF( ngrids.GT.5 )
     $      WRITE( nout, fmt = 9991 ) ( qval(i), i = 6,
     $                                  min( 10, ngrids ) )
         IF( ngrids.GT.10 )
     $      WRITE( nout, fmt = 9991 ) ( qval(i), i = 11,
     $                                  min( 15, ngrids ) )
         IF( ngrids.GT.15 )
     $      WRITE( nout, fmt = 9991 ) ( qval(i), i = 16, ngrids )
         WRITE( nout, fmt = 9994 ) alpha
         IF( ltest( 1 ) ) THEN
            WRITE( nout, fmt = 9989 ) snames( 1 ), ' ... Yes'
         ELSE
            WRITE( nout, fmt = 9989 ) snames( 1 ), ' ... No '
         END IF
         DO 80 i = 2, nsubs
            IF( ltest( i ) ) THEN
               WRITE( nout, fmt = 9988 ) snames( i ), ' ... Yes'
            ELSE
               WRITE( nout, fmt = 9988 ) snames( i ), ' ... No '
            END IF
   80    CONTINUE
         WRITE( nout, fmt = * )
*
      ELSE
*
*        If in pvm, must participate setting up virtual machine
*
         IF( nprocs.LT.1 )
     $      CALL blacs_setup( iam, nprocs )
*
*        Temporarily define blacs grid to include all processes so
*        information can be broadcast to all processes
*
         CALL blacs_get( -1, 0, ictxt )
         CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
*
         CALL sgebr2d( ictxt, 'All', ' ', 1, 1, alpha, 1, 0, 0 )
*
         CALL igebr2d( ictxt, 'All', ' ', 2, 1, work, 2, 0, 0 )
         ngrids = work( 1 )
         nmat   = work( 2 )
*
         i = 2*ngrids + 23*nmat + nsubs
         CALL igebr2d( ictxt, 'All', ' ', i, 1, work, i, 0, 0 )
*
         i = 1
         CALL icopy( ngrids, work( i ), 1, pval,     1 )
         i = i + ngrids
         CALL icopy( ngrids, work( i ), 1, qval,     1 )
         i = i + ngrids
         CALL icopy( nmat,   work( i ), 1, nval,     1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, mxval,    1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, nxval,    1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, imbxval,  1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, inbxval,  1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, mbxval,   1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, nbxval,   1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, rscxval,  1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, cscxval,  1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, ixval,    1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, jxval,    1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, incxval,  1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, myval,    1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, nyval,    1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, imbyval,  1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, inbyval,  1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, mbyval,   1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, nbyval,   1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, rscyval,  1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, cscyval,  1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, iyval,    1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, jyval,    1 )
         i = i + nmat
         CALL icopy( nmat,   work( i ), 1, incyval,  1 )
         i = i + nmat
*
         DO 90 j = 1, nsubs
            IF( work( i ).EQ.1 ) THEN
               ltest( j ) = .true.
            ELSE
               ltest( j ) = .false.
            END IF
            i = i + 1
   90    CONTINUE
*
      END IF
*
      CALL blacs_gridexit( ictxt )
*
      RETURN
*
  100 WRITE( nout, fmt = 9997 )
      CLOSE( nin )
      IF( nout.NE.6 .AND. nout.NE.0 )
     $   CLOSE( nout )
      CALL blacs_abort( ictxt, 1 )
*
      stop
*
 9999 FORMAT( a )
 9998 FORMAT( ' Number of values of ',5a, ' is less than 1 or greater ',
     $        'than ', i2 )
 9997 FORMAT( ' Illegal input in file ',40a,'.  Aborting run.' )
 9996 FORMAT( a7, l2 )
 9995 FORMAT( '  Subprogram name ', a7, ' not recognized',
     $        /' ******* TESTS ABANDONED *******' )
 9994 FORMAT( 2x, 'Alpha                     : ', g16.6 )
 9993 FORMAT( 2x, 'Number of Tests           : ', i6 )
 9992 FORMAT( 2x, 'Number of process grids   : ', i6 )
 9991 FORMAT( 2x, '                          : ', 5i6 )
 9990 FORMAT( 2x, a1, '                         : ', 5i6 )
 9989 FORMAT( 2x, 'Routines to be tested     :      ', a, a8 )
 9988 FORMAT( 2x, '                                 ', a, a8 )
*
*     End of PSBLA1TIMINFO
*