MULTDS Subroutine

subroutine MULTDS(Y, AA, X, MAXA, NN, LENAA)

Uses

  • proc~~multds~~UsesGraph proc~multds MULTDS module~real_precision REAL_PRECISION proc~multds->module~real_precision

Arguments

Type IntentOptional Attributes Name
real(kind=R8), intent(out) :: Y(NN)
real(kind=R8), intent(in) :: AA(LENAA)
real(kind=R8), intent(in) :: X(NN)
integer, intent(in) :: MAXA(NN+1)
integer, intent(in) :: NN
integer, intent(in) :: LENAA

Variables

Type Visibility Attributes Name Initial
integer, public :: I
integer, public :: II
integer, public :: KK
integer, public :: KL
integer, public :: KU
real(kind=R8), public :: B
real(kind=R8), public :: CC

Source Code

      SUBROUTINE MULTDS(Y,AA,X,MAXA,NN,LENAA)
C
C     This subroutine accepts a matrix, AA, in packed skyline storage form and
C       a vector, x, and returns the product AA*x in y.
C
C     Input Variables:
C
C       AA -- one dimensional real array containing the NN x NN matrix in 
C             packed skyline storage form.
C
C       x -- real vector of length NN to be multiplied by AA.
C
C       MAXA -- integer array used for specifying information about AA.
C               MAXA has length NN+1, and stores the indices of the 
C               diagonal elements of the matrix packed in AA.  By 
C               convention, MAXA(NN+1) = LENAA + 1 .
C
C       NN -- dimension of the matrix packed in AA .
C
C       LENAA -- number of elements in AA.
C
C
C     Output Variables:
C
C       y -- real vector of length NN containing the product  AA*x .
C
C
C
      USE REAL_PRECISION
      INTEGER, INTENT(IN):: LENAA,NN,MAXA(NN+1)
      REAL (KIND=R8), INTENT(IN):: AA(LENAA),X(NN)
      REAL (KIND=R8), INTENT(OUT):: Y(NN)
      INTEGER:: I,II,KK,KL,KU
      REAL (KIND=R8):: B,CC
      IF (LENAA .LE. NN) THEN
        DO I=1,NN
          Y(I)=AA(I)*X(I)
        END DO
        RETURN
      END IF
      DO I=1,NN
        Y(I)=0.00
      END DO
      DO I=1,NN
        KL=MAXA(I)
        KU=MAXA(I+1)-1
        II=I+1
        CC=X(I)
        DO KK=KL,KU
          II=II-1
          Y(II)=Y(II)+AA(KK)*CC
        END DO
      END DO
      IF (NN .EQ. 1) RETURN
      DO I=2,NN
        KL=MAXA(I)+1
        KU=MAXA(I+1)-1
        IF (KU-KL .LT. 0) CYCLE
        II=I
        B=0.00
        DO KK=KL,KU
          II=II-1
          B=B+AA(KK)*X(II)
        END DO
        Y(I)=Y(I)+B
      END DO
      RETURN
      END SUBROUTINE MULTDS