ibtcheckin()

subroutine ibtcheckin	(	integer	nftests,
		integer	outnum,
		integer	maxerr,
		integer	nerr,
		integer, dimension(*)	ierr,
		integer, dimension(*)	ival,
		integer, dimension(*)	tfailed
	)

Definition at line 6270 of file blacstest.f.

      INTEGER NFTESTS, OUTNUM, MAXERR, NERR
      INTEGER IERR(*), TFAILED(*)
      INTEGER IVAL(*)
*
*  Purpose
*  =======
*  IBTCHECKIN: Process 0 receives error report from all processes.
*
*  Arguments
*  =========
*  NFTESTS  (input/output) INTEGER
*           if NFTESTS is <= 0 upon entry, NFTESTS is not written to.
*           Otherwise, on entry it specifies the total number of tests
*           run, and on exit it is the number of tests which failed.
*
*  OUTNUM   (input) INTEGER
*           Device number for output.
*
*  MAXERR   (input) INTEGER
*           Max number of errors that can be stored in ERRIBUFF or
*           ERRIBUFF
*
*  NERR     (output) INTEGER
*           The number of errors that have been found.
*
*  ERRIBUF  (output) INTEGER array, dimension (6,MAXERRS)
*           Buffer in which to store integer error information.  It will
*           be built up in the following format for the call to TSEND.
*           All integer information is recorded in the following 6-tuple
*           {TESTNUM, SRC, DEST, I, J, WHAT}. These values are figured:
*             SRC = RSRC * NPROCS + CSRC
*             DEST = RDEST * NPROCS + CDEST
*             WHAT
*              = 1 : Error in pre-padding
*              = 2 : Error in post-padding
*              = 3 : Error in LDA-M gap
*              = 4 : Error in complementory triangle
*              ELSE: Error in matrix
*           If there are more errors than can fit in the error buffer,
*           the error number will indicate the actual number of errors
*           found, but the buffer will be truncated to the maximum
*           number of errors which can fit.
*
*  ERRDBUF  (output) @(doctype) array, dimension (2, MAXERRS)
*           Buffer in which to store error data information.
*           {Incorrect, Predicted}
*
*  TFAILED (workspace) INTEGER array, dimension NFTESTS
*          Workspace used to keep track of which tests failed.
*          If input of NFTESTS < 1, this array not accessed.
*
*  ===================================================================
*
*     .. External Functions ..
      INTEGER  IBTMYPROC, IBTNPROCS, IBTMSGID
      EXTERNAL ibtmyproc, ibtnprocs, ibtmsgid
*     ..
*     .. Local Scalars ..
      LOGICAL COUNTING
      INTEGER K, NERR2, IAM, NPROCS, NTESTS
*
*     Proc 0 collects error info from everyone
*
      iam = ibtmyproc()
      nprocs = ibtnprocs()
*
      IF( iam .EQ. 0 ) THEN
*
*        If we are finding out how many failed tests there are, initialize
*        the total number of tests (NTESTS), and zero the test failed array
*
         counting = nftests .GT. 0
         IF( counting ) THEN
            ntests = nftests
            DO 10 k = 1, ntests
               tfailed(k) = 0
   10       CONTINUE
         END IF
*
         CALL iprinterrs(outnum, maxerr, nerr, ierr, ival, counting,
     $                   tfailed)
*
         DO 20 k = 1, nprocs-1
            CALL btsend(3, 0, k, k, ibtmsgid()+50)
            CALL btrecv(3, 1, nerr2, k, ibtmsgid()+50)
            IF( nerr2 .GT. 0 ) THEN
               nerr = nerr + nerr2
               CALL btrecv(3, nerr2*6, ierr, k, ibtmsgid()+51)
               CALL btrecv(3, nerr2*2, ival, k, ibtmsgid()+51)
               CALL iprinterrs(outnum, maxerr, nerr2, ierr, ival,
     $                         counting, tfailed)
            END IF
   20    CONTINUE
*
*        Count up number of tests that failed
*
         IF( counting ) THEN
            nftests = 0
            DO 30 k = 1, ntests
               nftests = nftests + tfailed(k)
   30       CONTINUE
         END IF
*
*     Send my error info to proc 0
*
      ELSE
         CALL btrecv(3, 0, k, 0, ibtmsgid()+50)
         CALL btsend(3, 1, nerr, 0, ibtmsgid()+50)
         IF( nerr .GT. 0 ) THEN
            CALL btsend(3, nerr*6, ierr, 0, ibtmsgid()+51)
            CALL btsend(3, nerr*2, ival, 0, ibtmsgid()+51)
         END IF
      ENDIF
*
      RETURN
*
*     End of IBTCHECKIN
*

Here is the call graph for this function:

Here is the caller graph for this function: