spadmat()

subroutine spadmat	(	character*1	uplo,
		character*1	diag,
		integer	m,
		integer	n,
		real, dimension( * )	mem,
		integer	lda,
		integer	ipre,
		integer	ipost,
		real	checkval
	)

Definition at line 7570 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, IPRE, IPOST
      REAL CHECKVAL
*     ..
*     .. Array Arguments ..
      REAL MEM( * )
*     ..
*
*  Purpose
*  =======
*
*  SPADMAT: Pad Matrix.
*  This routines surrounds a matrix with a guardzone initialized to the
*  value CHECKVAL.  There are three distinct guardzones:
*  - A contiguous zone of size IPRE immediately before the start
*    of the matrix.
*  - A contiguous zone of size IPOST immedately after the end of the
*    matrix.
*  - Interstitial zones within each column of the matrix, in the
*    elements A( M+1:LDA, J ).
*
*  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      (output) real array, dimension (IPRE+IPOST+LDA*N)
*           The address IPRE elements ahead of the matrix A you want to
*           pad, which is then of dimension (LDA,N).
*
*  IPRE     (input) INTEGER
*           The size of the guard zone ahead of the matrix A.
*
*  IPOST    (input) INTEGER
*           The size of the guard zone behind the matrix A.
*
*  CHECKVAL (input) real
*           The value to insert into the guard zones.
*
*  ====================================================================
*
*     .. Local Scalars ..
      INTEGER I, J, K
*     ..
*     .. Executable Statements ..
*
*     Put check buffer in front of A
*
      IF( ipre .GT. 0 ) THEN
         DO 10 i = 1, ipre
            mem( i ) = checkval
   10    CONTINUE
      END IF
*
*     Put check buffer in back of A
*
      IF( ipost .GT. 0 ) THEN
         j = ipre + lda*n + 1
         DO 20 i = j, j+ipost-1
            mem( i ) = checkval
   20    CONTINUE
      END IF
*
*     Put check buffer in all (LDA-M) gaps
*
      IF( lda .GT. m ) THEN
         k = ipre + m + 1
         DO 40 j = 1, n
            DO 30 i = k, k+lda-m-1
               mem( i ) = checkval
   30       CONTINUE
            k = k + lda
   40    CONTINUE
      END IF
*
*     If the matrix is upper or lower trapezoidal, calculate the
*     additional triangular area which needs to be padded,  Each
*     element referred to is in the Ith row and the Jth column.
*
      IF( uplo .EQ. 'U' ) THEN
         IF( m .LE. n ) THEN
            IF( diag .EQ. 'U' ) THEN
               DO 41 i = 1, m
                  DO 42 j = 1, i
                     k = ipre + i + (j-1)*lda
                     mem( k ) = checkval
   42             CONTINUE
   41          CONTINUE
            ELSE
               DO 43 i = 2, m
                  DO 44 j = 1, i-1
                     k = ipre + i + (j-1)*lda
                     mem( k ) = checkval
   44             CONTINUE
   43          CONTINUE
            END IF
         ELSE
            IF( diag .EQ. 'U' ) THEN
               DO 45 i = m-n+1, m
                  DO 46 j = 1, i-(m-n)
                     k = ipre + i + (j-1)*lda
                     mem( k ) = checkval
   46             CONTINUE
   45          CONTINUE
            ELSE
               DO 47 i = m-n+2, m
                  DO 48 j = 1, i-(m-n)-1
                     k = ipre + i + (j-1)*lda
                     mem( k ) = checkval
   48             CONTINUE
   47          CONTINUE
            END IF
         END IF
      ELSE IF( uplo .EQ. 'L' ) THEN
         IF( m .LE. n ) THEN
            IF( diag .EQ. 'U' ) THEN
               DO 49 i = 1, m
                  DO 50 j = n-m+i, n
                     k = ipre + i + (j-1)*lda
                     mem( k ) = checkval
   50             CONTINUE
   49          CONTINUE
            ELSE
               DO 51 i = 1, m-1
                  DO 52 j = n-m+i+1, n
                     k = ipre + i + (j-1)*lda
                     mem( k ) = checkval
   52             CONTINUE
   51          CONTINUE
            END IF
         ELSE
            IF( uplo .EQ. 'U' ) THEN
               DO 53 i = 1, n
                  DO 54 j = i, n
                     k = ipre + i + (j-1)*lda
                     mem( k ) = checkval
   54             CONTINUE
   53          CONTINUE
            ELSE
               DO 55 i = 1, n-1
                  DO 56 j = i+1, n
                     k = ipre + i + (j-1)*lda
                     mem( k ) = checkval
   56             CONTINUE
   55          CONTINUE
            END IF
         END IF
      END IF
*
*     End of SPADMAT.
*
      RETURN

Here is the caller graph for this function: