dchkpad()

subroutine dchkpad	(	character*1	uplo,
		character*1	diag,
		integer	m,
		integer	n,
		double precision, dimension(*)	mem,
		integer	lda,
		integer	rsrc,
		integer	csrc,
		integer	myrow,
		integer	mycol,
		integer	ipre,
		integer	ipost,
		double precision	checkval,
		integer	testnum,
		integer	maxerr,
		integer	nerr,
		integer, dimension(6, maxerr)	erribuf,
		double precision, dimension(2, maxerr)	errdbuf
	)

Definition at line 8807 of file blacstest.f.

*
*  -- BLACS tester (version 1.0) --
*  University of Tennessee
*  December 15, 1994
*
*
*     .. Scalar Arguments ..
      CHARACTER*1 UPLO, DIAG
      INTEGER M, N, LDA, RSRC, CSRC, MYROW, MYCOL, IPRE, IPOST
      INTEGER TESTNUM, MAXERR, NERR
      DOUBLE PRECISION CHECKVAL
*     ..
*     .. Array Arguments ..
      INTEGER ERRIBUF(6, MAXERR)
      DOUBLE PRECISION MEM(*), ERRDBUF(2, MAXERR)
*     ..
*
*  Purpose
*  =======
*  DCHKPAD: Check padding put in by PADMAT.
*  Checks that padding around target matrix has not been overwritten
*  by the previous point-to-point or broadcast send.
*
*  Arguments
*  =========
*  UPLO     (input) CHARACTER*1
*           Is the matrix A 'U'pper or 'L'ower trapezoidal, or 'G'eneral
*           rectangular?
*
*  DIAG     (input) CHARACTER*1
*           For trapezoidal matrices, is the main diagonal included
*           ('N') or not ('U')?
*
*   M       (input) INTEGER
*           The number of rows of the matrix A.  M >= 0.
*
*   N       (input) INTEGER
*           The number of columns of the matrix A.  N >= 0.
*
*  MEM       (input) double precision array, dimension(IPRE+IPOST+LDA*N).
*            Memory location IPRE elements in front of the matrix A.
*
*   LDA     (input) INTEGER
*           The leading dimension of the array A.  LDA >= max(1, M).
*
*  RSRC     (input) INTEGER
*           The process row of the source of the matrix.
*
*  CSRC     (input) INTEGER
*           The process column of the source of the matrix.
*
*  MYROW    (input) INTEGER
*           Row of this process in the process grid.
*
*  MYCOL    (input) INTEGER
*           Column of this process in the process grid.
*
*  IPRE     (input) INTEGER
*           The size of the guard zone before the start of A.
*
*  IPOST    (input) INTEGER
*           The size of guard zone after A.
*
*  CHECKVAL (input) double precision
*           The value to pad matrix with.
*
*  TESTNUM  (input) INTEGER
*           The number of the test being checked.
*
*  MAXERR   (input) INTEGER
*           Max number of errors that can be stored in ERRIBUFF or
*           ERRDBUFF
*
*  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}
*
*  ===================================================================
*
*     .. Parameters ..
      INTEGER ERR_PRE, ERR_POST, ERR_GAP, ERR_TRI, ERR_MAT
      parameter( err_pre = 1, err_post = 2, err_gap = 3, err_tri = 4 )
      parameter( err_mat = 5 )
*     ..
*     .. External Functions ..
      INTEGER IBTNPROCS
      EXTERNAL ibtnprocs
*     ..
*     .. Local Scalars ..
      LOGICAL ISTRAP
      INTEGER I, J, K, IRST, IRND, ICST, ICND, SRC, DEST
      INTEGER NPROCS
*     ..
*     .. Executable Statements ..
*
      nprocs = ibtnprocs()
      src = rsrc * nprocs + csrc
      dest = myrow * nprocs + mycol
*
*     Check buffer in front of A
*
      IF( ipre .GT. 0 ) THEN
         DO 10 i = 1, ipre
            IF( mem(i) .NE. checkval ) THEN
               nerr = nerr + 1
               IF( nerr .LE. maxerr ) THEN
                  erribuf(1, nerr) = testnum
                  erribuf(2, nerr) = src
                  erribuf(3, nerr) = dest
                  erribuf(4, nerr) = i
                  erribuf(5, nerr) = ipre - i + 1
                  erribuf(6, nerr) = err_pre
                  errdbuf(1, nerr) = mem(i)
                  errdbuf(2, nerr) = checkval
               END IF
            END IF
   10    CONTINUE
      END IF
*
*     Check buffer behind A
*
      IF( ipost .GT. 0 ) THEN
         j = ipre + lda*n + 1
         DO 20 i = j, j+ipost-1
            IF( mem(i) .NE. checkval ) THEN
               nerr = nerr + 1
               IF( nerr .LE. maxerr ) THEN
                  erribuf(1, nerr) = testnum
                  erribuf(2, nerr) = src
                  erribuf(3, nerr) = dest
                  erribuf(4, nerr) = i - j + 1
                  erribuf(5, nerr) = j
                  erribuf(6, nerr) = err_post
                  errdbuf(1, nerr) = mem(i)
                  errdbuf(2, nerr) = checkval
               END IF
            END IF
   20    CONTINUE
      END IF
*
*     Check all (LDA-M) gaps
*
      IF( lda .GT. m ) THEN
         DO 40 j = 1, n
            DO 30 i = m+1, lda
               k = ipre + (j-1)*lda + i
               IF( mem(k) .NE. checkval) THEN
                  nerr = nerr + 1
                  IF( nerr .LE. maxerr ) THEN
                     erribuf(1, nerr) = testnum
                     erribuf(2, nerr) = src
                     erribuf(3, nerr) = dest
                     erribuf(4, nerr) = i
                     erribuf(5, nerr) = j
                     erribuf(6, nerr) = err_gap
                     errdbuf(1, nerr) = mem(k)
                     errdbuf(2, nerr) = checkval
                  END IF
               END IF
   30       CONTINUE
   40    CONTINUE
      END IF
*
*     Determine limits of trapezoidal matrix
*
      istrap = .false.
      IF( uplo .EQ. 'U' ) THEN
         istrap = .true.
         IF( m .LE. n ) THEN
            irst = 2
            irnd = m
            icst = 1
            icnd = m - 1
         ELSEIF( m .GT. n ) THEN
            irst = ( m-n ) + 2
            irnd = m
            icst = 1
            icnd = n - 1
         ENDIF
         IF( diag .EQ. 'U' ) THEN
            irst = irst - 1
            icnd = icnd + 1
         ENDIF
      ELSE IF( uplo .EQ. 'L' ) THEN
         istrap = .true.
         IF( m .LE. n ) THEN
            irst = 1
            irnd = 1
            icst = ( n-m ) + 2
            icnd = n
         ELSEIF( m .GT. n ) THEN
            irst = 1
            irnd = 1
            icst = 2
            icnd = n
         ENDIF
         IF( diag .EQ. 'U' ) THEN
            icst = icst - 1
         ENDIF
      ENDIF
*
*     Check elements and report any errors
*
      IF( istrap ) THEN
         DO 100 j = icst, icnd
            DO 105 i = irst, irnd
               IF( mem( ipre + (j-1)*lda + i ) .NE. checkval ) THEN
                  nerr = nerr + 1
                  IF( nerr .LE. maxerr ) THEN
                     erribuf(1, nerr) = testnum
                     erribuf(2, nerr) = src
                     erribuf(3, nerr) = dest
                     erribuf(4, nerr) = i
                     erribuf(5, nerr) = j
                     erribuf(6, nerr) = err_tri
                     errdbuf(1, nerr) = mem( ipre + (j-1)*lda + i )
                     errdbuf(2, nerr) = checkval
                  END IF
               END IF
  105       CONTINUE
*
*           Update the limits to allow filling in padding
*
            IF( uplo .EQ. 'U' ) THEN
               irst = irst + 1
            ELSE
               irnd = irnd + 1
            ENDIF
  100    CONTINUE
      END IF
*
      RETURN
*
*     End of DCHKPAD.
*

Here is the caller graph for this function: