rdcomb()

subroutine rdcomb	(	integer	memused,
		integer, dimension(memlen)	mem,
		integer	memlen,
		integer	cmemused,
		character*1, dimension(cmemlen)	cmem,
		integer	cmemlen,
		integer	outnum
	)

Definition at line 5996 of file blacstest.f.

*
*  -- BLACS tester (version 1.0) --
*  University of Tennessee
*  December 15, 1994
*
*
*     .. Scalar Arguments ..
      INTEGER MEMUSED, MEMLEN, CMEMUSED, CMEMLEN, OUTNUM
*     ..
*     .. Array Arguments ..
      CHARACTER*1 CMEM(CMEMLEN)
      INTEGER MEM(MEMLEN)
*     ..
*
*     Purpose
*     =======
*     RDCOMB:  Read and process the input file COMB.dat.
*
*     Arguments
*     =========
*     MEMUSED  (output) INTEGER
*              Number of elements in MEM that this subroutine ends up using.
*
*     MEM      (output) INTEGER array of dimension memlen
*              On output, holds information read in from sdrv.dat.
*
*     MEMLEN   (input) INTEGER
*              Number of elements of MEM that this subroutine
*              may safely write into.
*
*     CMEMUSED (output) INTEGER
*              Number of elements in CMEM that this subroutine ends up using.
*
*     CMEM     (output) CHARACTER*1 array of dimension cmemlen
*              On output, holds the values for UPLO and DIAG.
*
*     CMEMLEN  (input) INTEGER
*              Number of elements of CMEM that this subroutine
*              may safely write into.
*
*     OUTNUM   (input) INTEGER
*              Unit number of the output file.
*
*     =================================================================
*
*     .. Parameters ..
      INTEGER SDIN
      parameter( sdin = 12 )
*     ..
*     .. External Functions ..
      LOGICAL  LSAME
      EXTERNAL lsame
*     ..
*     .. Local Scalars ..
      INTEGER TOPSREPEAT, TOPSCOHRNT, NOPS, NSCOPE, NTOP, NMAT, NDEST
      INTEGER NGRID, I, J, OPPTR, SCOPEPTR, TOPPTR, MPTR, NPTR
      INTEGER LDSPTR, LDDPTR, LDIPTR, RDESTPTR, CDESTPTR, PPTR, QPTR
*     ..
*     .. Executable Statements
*
*     Open and read the file comb.dat.  The expected format is
*     below.
*
*------
*integer                         Number of operations
*array of CHAR*1's               OPs: '+', '>', '<'
*integer                         Number of scopes
*array of CHAR*1's               Values for Scopes
*HAR*1                           Repeatability flag ('R', 'N', 'B')
*HAR*1                           Coherency flag ('C', 'N', 'B')
*integer                         Number of topologies
*array of CHAR*1's               Values for TOP
*integer                         number of nmat
*array of integers               M: number of rows in matrix
*array of integers               N: number of columns in matrix
*integer                         LDA: leading dimension on source proc
*integer                         LDA: leading dimension on dest proc
*integer                         number of source/dest pairs
*array of integers               RDEST: process row of msg. dest.
*array of integers               CDEST: process column of msg. dest.
*integer                         Number of grids
*array of integers               NPROW: number of rows in process grid
*array of integers               NPCOL: number of col's in proc. grid
*------
*  note: the text descriptions as shown above are present in
*             the sample comb.dat included with this distribution,
*             but are not required.
*
*     Read input file
*
      memused = 1
      cmemused = 1
      OPEN(unit = sdin, file = 'comb.dat', status = 'OLD')
*
*     Get what operations to test (+, >, <)
*
      READ(sdin, *) nops
      opptr = cmemused
      cmemused = opptr + nops
      IF ( cmemused .GT. cmemlen ) THEN
         WRITE(outnum, 1000) cmemlen, nops, 'OPERATIONS.'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
         stop
      ELSE IF( nops .LT. 1 ) THEN
         WRITE(outnum, 2000) 'OPERATIONS.'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
         stop
      END IF
*
      READ(sdin, *) ( cmem(opptr+i), i = 0, nops-1 )
      DO 10 i = 0, nops-1
         IF( (cmem(opptr+i).NE.'+') .AND. (cmem(opptr+i).NE.'>') .AND.
     $       (cmem(opptr+i).NE.'<') ) THEN
            WRITE(outnum,5000) cmem(opptr+i)
            IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
            stop
         END IF
   10 CONTINUE
*
*     Read in scopes and topologies
*
      READ(sdin, *) nscope
      scopeptr = cmemused
      cmemused = scopeptr + nscope
      IF ( cmemused .GT. cmemlen ) THEN
         WRITE(outnum, 1000) cmemlen, nscope, 'SCOPES.'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
         stop
      ELSE IF( nscope .LT. 1 ) THEN
         WRITE(outnum, 2000) 'SCOPE.'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
         stop
      END IF
*
      READ(sdin, *) ( cmem(scopeptr+i), i = 0, nscope-1 )
      DO 20 i = 0, nscope-1
         IF( lsame(cmem(scopeptr+i), 'R') ) THEN
            cmem(scopeptr+i) = 'R'
         ELSE IF( lsame(cmem(scopeptr+i), 'C') ) THEN
            cmem(scopeptr+i) = 'C'
         ELSE IF( lsame(cmem(scopeptr+i), 'A') ) THEN
            cmem(scopeptr+i) = 'A'
         ELSE
            WRITE(outnum, 3000) 'SCOPE', cmem(scopeptr+i)
            IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
            stop
         END IF
   20 CONTINUE
*
      READ(sdin, *) topsrepeat
      READ(sdin, *) topscohrnt
*
      READ(sdin, *) ntop
      topptr = cmemused
      cmemused = topptr + ntop
      IF ( cmemused .GT. cmemlen ) THEN
         WRITE(outnum, 1000) cmemlen, ntop, 'TOPOLOGIES.'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
         stop
      ELSE IF( ntop .LT. 1 ) THEN
         WRITE(outnum, 2000) 'TOPOLOGY.'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
         stop
      END IF
      READ(sdin, *) ( cmem(topptr+i), i = 0, ntop-1 )
*
*
*     Read in number of matrices, and values for M, N, LDASRC, and LDADEST
*
      READ(sdin, *) nmat
      mptr = memused
      nptr = mptr + nmat
      ldsptr = nptr + nmat
      lddptr = ldsptr + nmat
      ldiptr = lddptr + nmat
      memused = ldiptr + nmat
      IF( memused .GT. memlen ) THEN
         WRITE(outnum, 1000) memlen, nmat, 'MATRICES.'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
         stop
      ELSE IF( nmat .LT. 1 ) THEN
         WRITE(outnum, 2000) 'MATRIX.'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
         stop
      END IF
      READ(sdin, *) ( mem( mptr+i ), i = 0, nmat-1 )
      READ(sdin, *) ( mem( nptr+i ), i = 0, nmat-1 )
      READ(sdin, *) ( mem( ldsptr+i ), i = 0, nmat-1 )
      READ(sdin, *) ( mem( lddptr+i ), i = 0, nmat-1 )
      READ(sdin, *) ( mem( ldiptr+i ), i = 0, nmat-1 )
*
*     Make sure matrix values are legal
*
      CALL chkmatdat( outnum, 'COMB.dat', .true., nmat, mem(mptr),
     $                mem(nptr), mem(ldsptr), mem(lddptr), mem(ldiptr) )
*
*     Read in number of dest pairs, and values of dest
*
      READ(sdin, *) ndest
      rdestptr  = memused
      cdestptr  = rdestptr  + ndest
      memused  = cdestptr + ndest
      IF( memused .GT. memlen ) THEN
         WRITE(outnum, 1000) memlen, nmat, 'DEST.'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
         stop
      ELSE IF( ndest .LT. 1 ) THEN
         WRITE(outnum, 2000) 'DEST.'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
         stop
      END IF
      READ(sdin, *) ( mem(rdestptr+i), i = 0, ndest-1 )
      READ(sdin, *) ( mem(cdestptr+i), i = 0, ndest-1 )
*
*     Read in number of grids pairs, and values of P (process rows) and
*     Q (process columns)
*
      READ(sdin, *) ngrid
      pptr = memused
      qptr = pptr + ngrid
      memused = qptr + ngrid
      IF( memused .GT. memlen ) THEN
         WRITE(outnum, 1000) memlen, ngrid, 'PROCESS GRIDS.'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
         stop
      ELSE IF( ngrid .LT. 1 ) THEN
         WRITE(outnum, 2000) 'PROCESS GRID'
         IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE( outnum )
         stop
      END IF
*
      READ(sdin, *) ( mem(pptr+i), i = 0, ngrid-1 )
      READ(sdin, *) ( mem(qptr+i), i = 0, ngrid-1 )
      IF( sdin .NE. 6 .AND. sdin .NE. 0 ) CLOSE( sdin )
*
*     Fatal error if we've got an illegal grid
*
      DO 70 j = 0, ngrid-1
         IF( mem(pptr+j).LT.1 .OR. mem(qptr+j).LT.1 ) THEN
            WRITE(outnum, 4000) mem(pptr+j), mem(qptr+j)
            IF( outnum .NE. 6 .AND. outnum .NE. 0 ) CLOSE(outnum)
            stop
         END IF
   70 CONTINUE
*
*     Prepare output variables
*
      mem(memused)   = nops
      mem(memused+1) = nscope
      mem(memused+2) = topsrepeat
      mem(memused+3) = topscohrnt
      mem(memused+4) = ntop
      mem(memused+5) = nmat
      mem(memused+6) = ndest
      mem(memused+7) = ngrid
      memused = memused + 7
      cmemused = cmemused - 1
*
 1000 FORMAT('Mem too short (',i4,') to handle',i4,' ',a20)
 2000 FORMAT('Must have at least one ',a20)
 3000 FORMAT('UNRECOGNIZABLE ',a5,' ''', a1, '''.')
 4000 FORMAT('Illegal process grid: {',i3,',',i3,'}.')
 5000 FORMAT('Illegal OP value ''',a1,''':, expected ''+'' (SUM),',
     $       ' ''>'' (MAX), or ''<'' (MIN).')
*
      RETURN
*
*     End of RDCOMB.
*

Here is the call graph for this function:

Here is the caller graph for this function: