zchksum()

subroutine zchksum	(	character*1	scope,
		integer	ictxt,
		integer	m,
		integer	n,
		double complex, dimension(lda,*)	a,
		integer	lda,
		integer	testnum,
		integer	maxerr,
		integer	nerr,
		integer, dimension(6, maxerr)	erribuf,
		double complex, dimension(2, maxerr)	errdbuf,
		integer, dimension(*)	iseed
	)

Definition at line 14262 of file blacstest.f.

*
*     .. Scalar Arguments ..
      CHARACTER*1 SCOPE
      INTEGER ICTXT, M, N, LDA, TESTNUM, MAXERR, NERR
*     ..
*     .. Array Arguments ..
      INTEGER ERRIBUF(6, MAXERR), ISEED(*)
      DOUBLE COMPLEX A(LDA,*), ERRDBUF(2, MAXERR)
*     ..
*     .. External Functions ..
      INTEGER IBTMYPROC, IBTNPROCS
      DOUBLE PRECISION DBTEPS
      DOUBLE COMPLEX ZBTRAN
      EXTERNAL ibtmyproc, ibtnprocs, dbteps, zbtran
*     ..
*     .. Local Scalars ..
      LOGICAL NUMOK
      INTEGER NPROCS, NPROW, NPCOL, MYROW, MYCOL, NODE, NNODES, DEST
      INTEGER I, J, K
      DOUBLE COMPLEX ANS, TMP
      DOUBLE PRECISION EPS, ERRBND, RPOSNUM, RNEGNUM, IPOSNUM, INEGNUM
*     ..
*     .. Executable Statements ..
*
      nprocs = ibtnprocs()
      eps = dbteps()
      CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
      dest = myrow*nprocs + mycol
*
*     Set up seeds to match those used by each proc's genmat call
*
      IF( scope .EQ. 'R' ) THEN
         nnodes = npcol
         DO 10 i = 0, nnodes-1
            node = myrow * nprocs + i
            iseed(i*4+1) = mod( 1002 + testnum*5 + node*3, 4096 )
            iseed(i*4+2) = mod( 2027 + testnum*7 + node, 4096 )
            iseed(i*4+3) = mod( 1234 + testnum + node*3, 4096 )
            iseed(i*4+4) = mod( 4311 + testnum*10 + node*2, 4096 )
   10    CONTINUE
      ELSE IF( scope .EQ. 'C' ) THEN
         nnodes = nprow
         DO 20 i = 0, nnodes-1
            node = i * nprocs + mycol
            iseed(i*4+1) = mod( 1002 + testnum*5 + node*3, 4096 )
            iseed(i*4+2) = mod( 2027 + testnum*7 + node, 4096 )
            iseed(i*4+3) = mod( 1234 + testnum + node*3, 4096 )
            iseed(i*4+4) = mod( 4311 + testnum*10 + node*2, 4096 )
   20    CONTINUE
      ELSE
         nnodes = nprow * npcol
         DO 30 i = 0, nnodes-1
            node = (i / npcol) * nprocs + mod(i, npcol)
            iseed(i*4+1) = mod( 1002 + testnum*5 + node*3, 4096 )
            iseed(i*4+2) = mod( 2027 + testnum*7 + node, 4096 )
            iseed(i*4+3) = mod( 1234 + testnum + node*3, 4096 )
            iseed(i*4+4) = mod( 4311 + testnum*10 + node*2, 4096 )
   30    CONTINUE
      END IF
*
      DO 100 j = 1, n
         DO 90 i = 1, m
            ans = 0
            rposnum = 0
            rnegnum = 0
            iposnum = 0
            inegnum = 0
            DO 40 k = 0, nnodes-1
               tmp = zbtran( iseed(k*4+1) )
               IF( dble( tmp ) .LT. 0 ) THEN
                  rnegnum = rnegnum + dble( tmp )
               ELSE
                  rposnum = rposnum + dble( tmp )
               END IF
               IF( dimag( tmp ) .LT. 0 ) THEN
                  inegnum = inegnum + dimag( tmp )
               ELSE
                  iposnum = iposnum + dimag( tmp )
               END IF
               ans = ans + tmp
   40       CONTINUE
*
*           The error bound is figured by
*           2 * eps * (nnodes-1) * max(|max element|, |ans|).
*           The 2 allows for errors in the distributed _AND_ local result.
*           The eps is machine epsilon.  The number of floating point adds
*           is (nnodes - 1).  We use the fact that 0.5 is the maximum element
*           in order to save ourselves some computation.
*
            tmp = ans - a(i,j)
            errbnd = 2 * eps * nnodes * max( rposnum, -rnegnum )
            numok = ( dble(tmp) .LE. errbnd )
            errbnd = 2 * eps * nnodes * max( iposnum, -inegnum )
            numok = numok .AND. ( dimag(tmp) .LE. errbnd )
            IF( .NOT.numok ) THEN
               nerr = nerr + 1
               IF( nerr .LE. maxerr ) THEN
                  erribuf(1, nerr) = testnum
                  erribuf(2, nerr) = nnodes
                  erribuf(3, nerr) = dest
                  erribuf(4, nerr) = i
                  erribuf(5, nerr) = j
                  erribuf(6, nerr) = 5
                  errdbuf(1, nerr) = a(i,j)
                  errdbuf(2, nerr) = ans
               END IF
            END IF
   90    CONTINUE
  100 CONTINUE
*
      RETURN
*
*     End of ZCHKSUM
*

Here is the caller graph for this function: