schkpad()

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

Definition at line 7743 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
      REAL CHECKVAL
*     ..
*     .. Array Arguments ..
      INTEGER ERRIBUF(6, MAXERR)
      REAL MEM(*), ERRDBUF(2, MAXERR)
*     ..
*
*  Purpose
*  =======
*  SCHKPAD: 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) real 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) real
*           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
*           ERRSBUFF
*
*  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 SCHKPAD.
*

Here is the caller graph for this function: