SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dpadmat()

subroutine dpadmat ( character*1  uplo,
character*1  diag,
integer  m,
integer  n,
double precision, dimension( * )  mem,
integer  lda,
integer  ipre,
integer  ipost,
double precision  checkval 
)

Definition at line 8634 of file blacstest.f.

8636*
8637* -- BLACS tester (version 1.0) --
8638* University of Tennessee
8639* December 15, 1994
8640*
8641* .. Scalar Arguments ..
8642 CHARACTER*1 UPLO, DIAG
8643 INTEGER M, N, LDA, IPRE, IPOST
8644 DOUBLE PRECISION CHECKVAL
8645* ..
8646* .. Array Arguments ..
8647 DOUBLE PRECISION MEM( * )
8648* ..
8649*
8650* Purpose
8651* =======
8652*
8653* DPADMAT: Pad Matrix.
8654* This routines surrounds a matrix with a guardzone initialized to the
8655* value CHECKVAL. There are three distinct guardzones:
8656* - A contiguous zone of size IPRE immediately before the start
8657* of the matrix.
8658* - A contiguous zone of size IPOST immedately after the end of the
8659* matrix.
8660* - Interstitial zones within each column of the matrix, in the
8661* elements A( M+1:LDA, J ).
8662*
8663* Arguments
8664* =========
8665* UPLO (input) CHARACTER*1
8666* Is the matrix A 'U'pper or 'L'ower trapezoidal, or 'G'eneral
8667* rectangular?
8668*
8669* DIAG (input) CHARACTER*1
8670* For trapezoidal matrices, is the main diagonal included
8671* ('N') or not ('U')?
8672*
8673* M (input) INTEGER
8674* The number of rows of the matrix A. M >= 0.
8675*
8676* N (input) INTEGER
8677* The number of columns of the matrix A. N >= 0.
8678*
8679* MEM (output) double precision array, dimension (IPRE+IPOST+LDA*N)
8680* The address IPRE elements ahead of the matrix A you want to
8681* pad, which is then of dimension (LDA,N).
8682*
8683* IPRE (input) INTEGER
8684* The size of the guard zone ahead of the matrix A.
8685*
8686* IPOST (input) INTEGER
8687* The size of the guard zone behind the matrix A.
8688*
8689* CHECKVAL (input) double precision
8690* The value to insert into the guard zones.
8691*
8692* ====================================================================
8693*
8694* .. Local Scalars ..
8695 INTEGER I, J, K
8696* ..
8697* .. Executable Statements ..
8698*
8699* Put check buffer in front of A
8700*
8701 IF( ipre .GT. 0 ) THEN
8702 DO 10 i = 1, ipre
8703 mem( i ) = checkval
8704 10 CONTINUE
8705 END IF
8706*
8707* Put check buffer in back of A
8708*
8709 IF( ipost .GT. 0 ) THEN
8710 j = ipre + lda*n + 1
8711 DO 20 i = j, j+ipost-1
8712 mem( i ) = checkval
8713 20 CONTINUE
8714 END IF
8715*
8716* Put check buffer in all (LDA-M) gaps
8717*
8718 IF( lda .GT. m ) THEN
8719 k = ipre + m + 1
8720 DO 40 j = 1, n
8721 DO 30 i = k, k+lda-m-1
8722 mem( i ) = checkval
8723 30 CONTINUE
8724 k = k + lda
8725 40 CONTINUE
8726 END IF
8727*
8728* If the matrix is upper or lower trapezoidal, calculate the
8729* additional triangular area which needs to be padded, Each
8730* element referred to is in the Ith row and the Jth column.
8731*
8732 IF( uplo .EQ. 'U' ) THEN
8733 IF( m .LE. n ) THEN
8734 IF( diag .EQ. 'U' ) THEN
8735 DO 41 i = 1, m
8736 DO 42 j = 1, i
8737 k = ipre + i + (j-1)*lda
8738 mem( k ) = checkval
8739 42 CONTINUE
8740 41 CONTINUE
8741 ELSE
8742 DO 43 i = 2, m
8743 DO 44 j = 1, i-1
8744 k = ipre + i + (j-1)*lda
8745 mem( k ) = checkval
8746 44 CONTINUE
8747 43 CONTINUE
8748 END IF
8749 ELSE
8750 IF( diag .EQ. 'U' ) THEN
8751 DO 45 i = m-n+1, m
8752 DO 46 j = 1, i-(m-n)
8753 k = ipre + i + (j-1)*lda
8754 mem( k ) = checkval
8755 46 CONTINUE
8756 45 CONTINUE
8757 ELSE
8758 DO 47 i = m-n+2, m
8759 DO 48 j = 1, i-(m-n)-1
8760 k = ipre + i + (j-1)*lda
8761 mem( k ) = checkval
8762 48 CONTINUE
8763 47 CONTINUE
8764 END IF
8765 END IF
8766 ELSE IF( uplo .EQ. 'L' ) THEN
8767 IF( m .LE. n ) THEN
8768 IF( diag .EQ. 'U' ) THEN
8769 DO 49 i = 1, m
8770 DO 50 j = n-m+i, n
8771 k = ipre + i + (j-1)*lda
8772 mem( k ) = checkval
8773 50 CONTINUE
8774 49 CONTINUE
8775 ELSE
8776 DO 51 i = 1, m-1
8777 DO 52 j = n-m+i+1, n
8778 k = ipre + i + (j-1)*lda
8779 mem( k ) = checkval
8780 52 CONTINUE
8781 51 CONTINUE
8782 END IF
8783 ELSE
8784 IF( uplo .EQ. 'U' ) THEN
8785 DO 53 i = 1, n
8786 DO 54 j = i, n
8787 k = ipre + i + (j-1)*lda
8788 mem( k ) = checkval
8789 54 CONTINUE
8790 53 CONTINUE
8791 ELSE
8792 DO 55 i = 1, n-1
8793 DO 56 j = i+1, n
8794 k = ipre + i + (j-1)*lda
8795 mem( k ) = checkval
8796 56 CONTINUE
8797 55 CONTINUE
8798 END IF
8799 END IF
8800 END IF
8801*
8802* End of DPADMAT.
8803*
8804 RETURN
Here is the caller graph for this function: