psbla1tstinfo()

subroutine psbla1tstinfo	(	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,
		logical	sof,
		logical	tee,
		integer	iam,
		integer	igap,
		integer	iverb,
		integer	nprocs,
		real	alpha,
		integer, dimension( * )	work
	)

Definition at line 768 of file psblas1tst.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 ..
      LOGICAL            SOF, TEE
      INTEGER            IAM, IGAP, IVERB, 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
*  =======
*
*  PSBLA1TSTINFO  get the needed startup information for testing 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.
*
*  SOF     (global output) LOGICAL
*          On exit, if SOF is .TRUE., the tester will  stop on the first
*          detected failure. Otherwise, it won't.
*
*  TEE     (global output) LOGICAL
*          On exit, if TEE is .TRUE., the tester will  perform the error
*          exit tests. These tests won't be performed otherwise.
*
*  IAM     (local input) INTEGER
*          On entry,  IAM  specifies the number of the process executing
*          this routine.
*
*  IGAP    (global output) INTEGER
*          On exit, IGAP  specifies the user-specified gap used for pad-
*          ding. IGAP must be at least zero.
*
*  IVERB   (global output) INTEGER
*          On exit,  IVERB  specifies  the output verbosity level: 0 for
*          pass/fail, 1, 2 or 3 for matrix dump on errors.
*
*  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+4 )  with  NSUBS  equal  to 8.
*          This array is used to pack all output arrays in order to send
*          the information 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
      REAL               EPS
*     ..
*     .. 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
*     ..
*     .. External Functions ..
      REAL               PSLAMCH
      EXTERNAL           pslamch
*     ..
*     .. 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='PSBLAS1TST.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.
*
*        Read the flag that indicates if Stop on Failure
*
         READ( nin, fmt = * ) sof
*
*        Read the flag that indicates if Test Error Exits
*
         READ( nin, fmt = * ) tee
*
*        Read the verbosity level
*
         READ( nin, fmt = * ) iverb
         IF( iverb.LT.0 .OR. iverb.GT.3 )
     $      iverb = 0
*
*        Read the leading dimension gap
*
         READ( nin, fmt = * ) igap
         IF( igap.LT.0 )
     $      igap = 0
*
*        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 )
*
*        Compute machine epsilon
*
         eps = pslamch( ictxt, 'eps' )
*
*        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
         IF( sof ) THEN
            work( i ) = 1
         ELSE
            work( i ) = 0
         END IF
         i = i + 1
         IF( tee ) THEN
            work( i ) = 1
         ELSE
            work( i ) = 0
         END IF
         i = i + 1
         work( i ) = iverb
         i = i + 1
         work( i ) = igap
         i = 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 testing program.'
         WRITE( nout, fmt = 9999 ) usrinfo
         WRITE( nout, fmt = * )
         WRITE( nout, fmt = 9999 )
     $               'Tests 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 = 9988 ) sof
         WRITE( nout, fmt = 9987 ) tee
         WRITE( nout, fmt = 9983 ) igap
         WRITE( nout, fmt = 9986 ) iverb
         WRITE( nout, fmt = 9982 ) alpha
         IF( ltest( 1 ) ) THEN
            WRITE( nout, fmt = 9985 ) snames( 1 ), ' ... Yes'
         ELSE
            WRITE( nout, fmt = 9985 ) snames( 1 ), ' ... No '
         END IF
         DO 80 i = 2, nsubs
            IF( ltest( i ) ) THEN
               WRITE( nout, fmt = 9984 ) snames( i ), ' ... Yes'
            ELSE
               WRITE( nout, fmt = 9984 ) snames( i ), ' ... No '
            END IF
   80    CONTINUE
         WRITE( nout, fmt = 9994 ) eps
         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 )
*
*        Compute machine epsilon
*
         eps = pslamch( ictxt, 'eps' )
*
         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 + 4
         CALL igebr2d( ictxt, 'All', ' ', i, 1, work, i, 0, 0 )
*
         i = 1
         IF( work( i ).EQ.1 ) THEN
            sof = .true.
         ELSE
            sof = .false.
         END IF
         i = i + 1
         IF( work( i ).EQ.1 ) THEN
            tee = .true.
         ELSE
            tee = .false.
         END IF
         i = i + 1
         iverb = work( i )
         i = i + 1
         igap = work( i )
         i = 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, 'Relative machine precision (eps) is taken to be ',
     $        e18.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 )
 9988 FORMAT( 2x, 'Stop on failure flag      : ', l6 )
 9987 FORMAT( 2x, 'Test for error exits flag : ', l6 )
 9986 FORMAT( 2x, 'Verbosity level           : ', i6 )
 9985 FORMAT( 2x, 'Routines to be tested     :      ', a, a8 )
 9984 FORMAT( 2x, '                                 ', a, a8 )
 9983 FORMAT( 2x, 'Leading dimension gap     : ', i6 )
 9982 FORMAT( 2x, 'Alpha                     : ', g16.6 )
*
*     End of PSBLA1TSTINFO
*

Here is the call graph for this function:

Here is the caller graph for this function: