btinfo()

subroutine btinfo	(	character*1	test,
		integer	memused,
		integer, dimension(memlen)	mem,
		integer	memlen,
		integer	cmemused,
		character*1, dimension(cmemlen)	cmem,
		integer	cmemlen,
		integer	outnum,
		integer	nop,
		integer	nscope,
		integer	trep,
		integer	tcoh,
		integer	ntop,
		integer	nshape,
		integer	nmat,
		integer	nsrc,
		integer	ngrid,
		integer	opptr,
		integer	scopeptr,
		integer	topptr,
		integer	uploptr,
		integer	diagptr,
		integer	mptr,
		integer	nptr,
		integer	ldsptr,
		integer	lddptr,
		integer	ldiptr,
		integer	rsrcptr,
		integer	csrcptr,
		integer	rdestptr,
		integer	cdestptr,
		integer	pptr,
		integer	qptr
	)

Definition at line 1057 of file blacstest.f.

*
*     .. Scalar Arguments ..
      CHARACTER*1 TEST
      INTEGER CDESTPTR, CMEMLEN, CMEMUSED, CSRCPTR, DIAGPTR, LDDPTR,
     $        LDIPTR, LDSPTR, MEMLEN, MEMUSED, MPTR, NGRID, NMAT, NOP,
     $        NPTR, NSCOPE, NSHAPE, NSRC, NTOP, OPPTR, OUTNUM, PPTR,
     $        QPTR, RDESTPTR, RSRCPTR, SCOPEPTR, TCOH, TOPPTR, TREP,
     $        UPLOPTR
*     ..
*     .. Array Arguments ..
      CHARACTER*1 CMEM(CMEMLEN)
      INTEGER MEM(MEMLEN)
*     ..
*     .. External Functions ..
      INTEGER  IBTMYPROC, IBTMSGID, IBTSIZEOF
      EXTERNAL ibtmyproc, ibtmsgid, ibtsizeof
*     ..
*     .. Local Scalars ..
      INTEGER IAM, ISIZE, DSIZE
*     ..
*     .. Local Arrays ..
      INTEGER ITMP(2)
*     ..
*     .. Executable Statements ..
*
      iam = ibtmyproc()
      IF( iam .EQ. 0 ) THEN
         IF( test .EQ. 'S' ) THEN
            CALL rdsdrv( memused, mem, memlen, cmemused, cmem, cmemlen,
     $                   outnum )
         ELSE IF( test .EQ. 'B' ) THEN
            CALL rdbsbr( memused, mem, memlen, cmemused, cmem, cmemlen,
     $                   outnum )
         ELSE
            CALL rdcomb( memused, mem, memlen, cmemused, cmem, cmemlen,
     $                   outnum )
         END IF
         itmp(1) = memused
         itmp(2) = cmemused
         CALL btsend( 3, 2, itmp, -1, ibtmsgid()+3 )
         IF( memlen .GE. memused + cmemused ) THEN
            CALL bttranschar( 'I', cmemused, cmem, mem(memused+1) )
         ELSE
            isize = ibtsizeof('I')
            dsize = ibtsizeof('D')
            WRITE(outnum,1000) ( (memused+cmemused)*isize + dsize-1 )
     $                         / dsize
            CALL blacs_abort(-1, -1)
         END IF
         CALL btsend( 3, memused+cmemused, mem, -1, ibtmsgid()+4 )
      ELSE
         CALL btrecv( 3, 2, itmp, 0, ibtmsgid()+3 )
         memused = itmp(1)
         cmemused = itmp(2)
         IF( memlen .GE. memused + cmemused ) THEN
            CALL btrecv( 3, memused+cmemused, mem, 0, ibtmsgid()+4 )
            CALL bttranschar( 'C', cmemused, cmem, mem(memused+1) )
         ELSE
            isize = ibtsizeof('I')
            dsize = ibtsizeof('D')
            WRITE(outnum,1000) ( (memused+cmemused)*isize + dsize-1 )
     $                         / dsize
            CALL blacs_abort(-1, -1)
         END IF
      END IF
      CALL btunpack( test, mem, memused, nop, nscope, trep, tcoh, ntop,
     $               nshape, nmat, nsrc, ngrid, opptr, scopeptr, topptr,
     $               uploptr, diagptr, mptr, nptr, ldsptr, lddptr,
     $               ldiptr, rsrcptr, csrcptr, rdestptr, cdestptr, pptr,
     $               qptr)
*
 1000 FORMAT('MEM array too short to pack CMEM; increase to at least',
     $       i7)
*
      RETURN
*
*     End BTINFO
*

Here is the call graph for this function:

Here is the caller graph for this function: