dchkmat()

subroutine dchkmat	(	character*1	uplo,
		character*1	diag,
		integer	m,
		integer	n,
		double precision, dimension(lda,n)	a,
		integer	lda,
		integer	rsrc,
		integer	csrc,
		integer	myrow,
		integer	mycol,
		integer	testnum,
		integer	maxerr,
		integer	nerr,
		integer, dimension(6, maxerr)	erribuf,
		double precision, dimension(2, maxerr)	errdbuf
	)

Definition at line 9068 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, TESTNUM
      INTEGER MAXERR, NERR
*     ..
*     .. Array Arguments ..
      INTEGER ERRIBUF(6, MAXERR)
      DOUBLE PRECISION A(LDA,N), ERRDBUF(2, MAXERR)
*     ..
*
*  Purpose
*  =======
*  dCHKMAT:  Check matrix to see whether there were any transmission
*            errors.
*
*  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.
*
*   A       (input) @up@(doctype) array, dimension (LDA,N)
*           The m by n matrix A.  Fortran77 (column-major) storage
*           assumed.
*
*   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.
*
*
*  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}
*
*  ===================================================================
*
*     .. Local Scalars ..
      INTEGER I, J, NPROCS, SRC, DEST
      LOGICAL USEIT
      DOUBLE PRECISION COMPVAL
*     ..
*     .. Local Arrays ..
      INTEGER ISEED(4)
*     ..
*     .. External Functions ..
      INTEGER IBTNPROCS
      DOUBLE PRECISION DBTRAN
      EXTERNAL dbtran, ibtnprocs
*     ..
*     .. Executable Statements ..
*
      nprocs = ibtnprocs()
      src = rsrc * nprocs + csrc
      dest = myrow * nprocs + mycol
*
*     Initialize ISEED with the same values as used in DGENMAT.
*
      iseed(1) = mod( 1002 + testnum*5 + src*3, 4096 )
      iseed(2) = mod( 2027 + testnum*7 + src, 4096 )
      iseed(3) = mod( 1234 + testnum + src*3, 4096 )
      iseed(4) = mod( 4311 + testnum*10 + src*2, 4096 )
*
*     Generate the elements randomly with the same method used in GENMAT.
*     Note that for trapezoidal matrices, we generate all elements in the
*     enclosing rectangle and then ignore the complementary triangle.
*
      DO 100 j = 1, n
         DO 105 i = 1, m
            compval = dbtran( iseed )
*
*           Now determine whether we actually need this value.  The
*           strategy is to chop out the proper triangle based on what
*           particular kind of trapezoidal matrix we're dealing with.
*
            useit = .true.
            IF( uplo .EQ. 'U' ) THEN
               IF( m .LE. n ) THEN
                  IF( diag .EQ. 'U' ) THEN
                     IF( i .GE. j ) THEN
                        useit = .false.
                     END IF
                  ELSE
                     IF( i .GT. j ) THEN
                        useit = .false.
                     END IF
                  END IF
               ELSE
                  IF( diag .EQ. 'U' ) THEN
                     IF( i .GE. m-n+j ) THEN
                        useit = .false.
                     END IF
                  ELSE
                     IF( i .GT. m-n+j ) THEN
                        useit = .false.
                     END IF
                  END IF
               END IF
            ELSE IF( uplo .EQ. 'L' ) THEN
               IF( m .LE. n ) THEN
                  IF( diag .EQ. 'U' ) THEN
                     IF( j. ge. i+(n-m) ) THEN
                        useit = .false.
                     END IF
                  ELSE
                     IF( j .GT. i+(n-m) ) THEN
                        useit = .false.
                     END IF
                  END IF
               ELSE
                  IF( diag .EQ. 'U' ) THEN
                     IF( j .GE. i ) THEN
                        useit = .false.
                     END IF
                  ELSE
                     IF( j .GT. i ) THEN
                        useit = .false.
                     END IF
                  END IF
               END IF
            END IF
*
*           Compare the generated value to the one that's in the
*           received matrix.  If they don't match, tack another
*           error record onto what's already there.
*
            IF( useit ) THEN
               IF( a(i,j) .NE. compval ) 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) = 5
                     errdbuf(1, nerr) = a(i, j)
                     errdbuf(2, nerr) = compval
                  END IF
               END IF
            END IF
  105    CONTINUE
  100 CONTINUE
      RETURN
*
*     End of DCHKMAT.
*