End of file
Contents
Index

      SUBROUTINE NCYFSY (N,DM,DU1,DU2,RS,X,DML,DL1L,DL2L,RL2L,
     +                   RL1L,DU1U,DU2U,RC2U,RC1U,IERR)
C
C*****************************************************************
C                                                                *
C  NCYFSY computes the solution X of a linear system of equations*
C  A*X=RS  for a symmetric, almost cyclic five-diagonal matrix A.*
C  The matrix A is defined by the three vectors DM, DU1 and DU2  *
C  which give its diagonal and first and second co-diagonal      *
C  entries. The linear system has the form:                      *
C                                                                *
C  DM(1)*X(1) + DU1(1)*X(2) + DU2(1)*X(3) +                      *
C                       + DU2(N-1)*X(N-1) + DU1(N)*X(N) = RS(1)  *
C                                                                *
C  DU1(1)*X(1) + DM(2)*X(2) + DU1(2)*X(3)                        *
C                           + DU2(2)*X(4) + DU2(N)*X(N) = RS(2)  *
C                                                                *
C  DU2(I-2)*X(I-2) + DU1(I-1)*X(I-1) + DM(I)*X(I) +              *
C                       + DU1(I)*X(I+1) + DU2(I)*X(I+2) = RS(I), *
C                                 für I=3(1)N-2                  *
C                                                                *
C  DU2(N-1)*X(1) + DU2(N-3)*X(N-3) +                             *
C   + DU1(N-2)*X(N-2) + DM(N-1)*X(N-1) + DU1(N-1)*X(N) = RS(N-1) *
C                                                                *
C  DU1(N)*X(1) + DU2(N)*X(2) +                                   *
C      + DU2(N-2)*X(N-2) + DU1(N-1)*X(N-1) + DM(N)*X(N) = RS(N)  *
C                                                                *
C                                                                *
C  ASSUMPTION:    N > 5                                          *
C  ===========                                                   *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  N   :  Number of equations, size of the system matrix A       *
C                                                                *
C  DM  :]   vectors DM(1:N), DU1(1:N), DU2(1:N),                 *
C  DU1 :]   representing the diagonal, first and second          *
C  DU2 :]   co-diagonal of A, respectively                       *
C                                                                *
C  RS  : vector RS(1:N); the right hand side                     *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  DML  :  vector DML(1:N)    ]   describing the entries of the  *
C  DL1L :  vector DL1L(1:N)   ]   lower tringular matrix C in the*
C  DL2L :  vector DL2L(1:N)   ]   factorization A=C*B            *
C  RL2L :  vector RL2L(1:N-4) ]   (refer to NCYFSP)              *
C  RL1L :  vector RL1L(1:N-3) ]                                  *
C                                                                *
C  DU1U :  vector DU1U(1:N)    ]   describing the entries of the *
C  DU2U :  vector DU2U(1:N)    ]   upper tringular matrix B in   *
C  RC2U :  vector RC2U(1:N-4)  ]   the factorization A=C*B       *
C  RC1U :  vector RC1U(1:N-3)  ]   (refer to NCYFSP)             *
C                                                                *
C  X    :  vector X(1:N) ;  the solution                         *
C                                                                *
C  IERR :  error parameter                                       *
C          =  0 :  All is o.k.                                   *
C          = -1 :  N < 6                                         *
C          =  1 :  default in NCYFSP (system matrix singular)    *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: NCYFSP, NCYFSS                          *
C                                                                *
C*****************************************************************
C                                                                *
C  Author  : Günter Palm                                         *
C  Date    : 04.18.1988                                          *
C  Source  : FORTRAN 77                                          *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION DM(N), DU1(N), DU2(N), RS(N), X(N), DML(N),
     +                 DL1L(N), DL2L(N), RL2L(N-4), RL1L(N-3),
     +                 DU1U(N), DU2U(N), RC2U(N-4), RC1U(N-3)
C
C-----Checking the input
C
      IERR = -1
      IF (N .LT. 6) RETURN
C
C-----Factoring the system matrix into a lower
C     times an upper triangular matrix
C
      CALL NCYFSP (N,DM,DU1,DU2,DML,DL1L,DL2L,RL2L,RL1L,DU1U,
     +             DU2U,RC2U,RC1U,IERR)
C
C-----If IERR = 0, we can update and backsubstitute
C
      IF (IERR .EQ. 0) THEN
         CALL NCYFSS (N,RS,X,DML,DL1L,DL2L,RL2L,RL1L,DU1U,DU2U,
     +                RC2U,RC1U)
      ENDIF
      RETURN
      END
C
C

      SUBROUTINE NCYFSP (N,DM,DU1,DU2,DML,DL1L,DL2L,RL2L,RL1L,
     +                   DU1U,DU2U,RC2U,RC1U,IERR)
C
C*****************************************************************
C                                                                *
C  Factorization of a symmetric, almost cyclic five-diagonal     *
C  matrix A into a product of a lower triangular matrix C and an *
C  upper triangular matrix B.                                    *
C  The matrix A is represented by                                *
C  three vectors DM, DU1 and DU2, as described in SUBROUTINE     *
C  NCYFSY.                                                       *
C                                                                *
C                                                                *
C  ASSUMPTIONS:    N > 5  (this is not checked again)            *
C  ============                                                  *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  N   : size of the system matrix                               *
C                                                                *
C  DM  :]   vectors representing the diagonal and co-diagonals   *
C  DU1 :]   of A, dimensioned as ..(1:N)                         *
C  DU2 :]                                                        *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  DML  :  vector DML(1:N)    ]   describing the entries of the  *
C  DL1L :  vector DL1L(1:N)   ]   lower tringular matrix C in the*
C  DL2L :  vector DL2L(1:N)   ]   factorization A=C*B            *
C  RL2L :  vector RL2L(1:N-4) ]                                  *
C  RL1L :  vector RL1L(1:N-3) ]                                  *
C                                                                *
C  DU1U :  vector DU1U(1:N)    ]   describing the entries of the *
C  DU2U :  vector DU2U(1:N)    ]   upper tringular matrix B in   *
C  RC2U :  vector RC2U(1:N-4)  ]   the factorization A=C*B       *
C  RC1U :  vector RC1U(1:N-3)  ]                                 *
C                                                                *
C      In particular we use the following notation:              *
C      DML  :  main diagonal of C,      DML(I),  I=1, ..., N     *
C      DL1L :  first co-diagonal of C,  DL1L(I), I=2, ..., N     *
C      DL2L :  second co-diagonal of C, DL2L(I), I=3, ..., N     *
C      RL2L :  second to last row of C, except for the elements  *
C              labelled N-3, ..., N,    RL2L(I), I=1, ..., N-4   *
C      RL1L :  last row of C, except for elements labelled       *
C              N-2,...,N,               RL1L(I), I=1, ..., N-3   *
C      DU1U :  first co-diagonal of B,  DU1U(I), I=1, ..., N-1   *
C      DU2U :  second co-diagonal of B, DU2U(I), I=1, ..., N-2   *
C      RC2U :  last but one column of B, except for the elements *
C              labelled N-3,...,N,      RC2U(I), I=1, ..., N-4   *
C      RC1U :  last column of B, except for the elements labelled*
C              N-2,...,N,               RC1U(I), I=1, ..., N-3   *
C                                                                *
C  IERR :  error parameter                                       *
C          =  0 :  All is o.k.                                   *
C          =  1 :  default, because of intended division by an   *
C                  element DML(I), whose magnitude does not      *
C                  excced 4 * machine constant.                  *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: MACHPD                                  *
C                                                                *
C*****************************************************************
C                                                                *
C  Author  : Günter Palm                                         *
C  Date    : 04.18.1988                                          *
C  Source  : FORTRAN 77                                          *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION DM(N), DU1(N), DU2(N), DML(N), DL1L(N),
     +                 DL2L(N), RL2L(N-4), RL1L(N-3), DU1U(N),
     +                 DU2U(N), RC2U(N-4), RC1U(N-3)
      LOGICAL FLAG
      SAVE FLAG, FMACHP
C
C-----Initializing
C
      DATA FLAG /.TRUE./
      IERR = 1
C
C-----Compute the machine constant (upon first call only)
C
      IF (FLAG) THEN
        FMACHP = 1.0D0
    5   FMACHP = 0.5D0*FMACHP
        IF (MACHPD(1.0D0+FMACHP) .EQ. 1) GOTO 5
        FMACHP = 8.0D0*FMACHP
        FLAG = .FALSE.
      ENDIF
C
C-----Factor the matrix A into a lower and an upper triangular
C     matrix. The computations are stopped if one of the diagonal
C     entries in the lower triangular factor C does not exceed
C     4 * machine constant in magnitude.
C
      DML(1)  = DM(1)
      IF (DML(1) .LE. FMACHP) RETURN
      DU1U(1) = DU1(1)/DML(1)
      RC2U(1) = DU2(N-1)/DML(1)
      RC1U(1) = DU1(N)/DML(1)
      DL1L(2) = DU1(1)
      DML(2)  = DM(2) - DL1L(2)*DU1U(1)
      IF (DML(2) .LE. FMACHP) RETURN
      RC2U(2) = -(RC2U(1)*DL1L(2))/DML(2)
      RC1U(2) = (DU2(N) - DL1L(2)*RC1U(1))/DML(2)
C
      DO 10 I=3,N-2,1
        K = I-1
        J = I-2
        DL2L(I) = DU2(I-2)
        DU2U(J) = DU2(J)/DML(J)
        DU1U(K) = (DU1(K) - DL1L(K)*DU2U(J))/DML(K)
        DL1L(I) = DU1(I-1) - DL2L(I)*DU1U(J)
        DML(I)  = DM(I) - DL1L(I)*DU1U(K) - DL2L(I)*DU2U(J)
        IF (DML(I) .LE. FMACHP) RETURN
   10 CONTINUE
C
      DO 20 I=3,N-4,1
        RC2U(I) = -(DL2L(I)*RC2U(I-2) + DL1L(I)*RC2U(I-1))/DML(I)
   20 CONTINUE
C
      DO 30 I=3,N-3,1
        RC1U(I) = -(DL2L(I)*RC1U(I-2) + DL1L(I)*RC1U(I-1))/DML(I)
   30 CONTINUE
C
      DU2U(N-3) = (DU2(N-3) - DL1L(N-3)*RC2U(N-4) -
     +             DL2L(N-3)*RC2U(N-5))/DML(N-3)
      DU2U(N-2) = (DU2(N-2) - DL1L(N-2)*RC1U(N-3) -
     +             DL2L(N-2)*RC1U(N-4))/DML(N-2)
      DU1U(N-2) = (DU1(N-2) - DL1L(N-2)*DU2U(N-3) -
     +             DL2L(N-2)*RC2U(N-4))/DML(N-2)
C
      RL2L(1) = DU2(N-1)
      RL2L(2) = -RL2L(1)*DU1U(1)
      DO 40 I=3,N-4,1
        RL2L(I) = -(RL2L(I-2)*DU2U(I-2) + RL2L(I-1)*DU1U(I-1))
   40 CONTINUE
      RL1L(1) = DU1(N)
      RL1L(2) = DU2(N) - RL1L(1)*DU1U(1)
C
      DO 50 I=3,N-3,1
        RL1L(I) = -(RL1L(I-2)*DU2U(I-2) + RL1L(I-1)*DU1U(I-1))
   50 CONTINUE
C
      DL2L(N-1) = DU2(N-3) - (RL2L(N-5)*DU2U(N-5) +
     +            RL2L(N-4)*DU1U(N-4))
      DL2L(N)   = DU2(N-2) - (RL1L(N-4)*DU2U(N-4) +
     +            RL1L(N-3)*DU1U(N-3))
      DL1L(N-1) = DU1(N-2) - (RL2L(N-4)*DU2U(N-4) +
     +            DL2L(N-1)*DU1U(N-3))
      DUMMY1 = 0.0D0
      DUMMY2 = 0.0D0
      DUMMY3 = 0.0D0
      DO 60 K=1,N-4,1
        DUMMY1 = DUMMY1 + RL1L(K)*RC2U(K)
        DUMMY2 = DUMMY2 + RL2L(K)*RC2U(K)
        DUMMY3 = DUMMY3 + RL2L(K)*RC1U(K)
   60 CONTINUE
C
      DL1L(N)   = DU1(N-1) - DUMMY1 - RL1L(N-3)*DU2U(N-3) -
     +            DL2L(N)*DU1U(N-2)
C
      DML(N-1)  = DM(N-1) - DUMMY2 - DL2L(N-1)*DU2U(N-3) -
     +            DL1L(N-1)*DU1U(N-2)
      IF (DML(N-1) .LE. FMACHP) RETURN
C
      DU1U(N-1) = (DU1(N-1) - DUMMY3 - DL2L(N-1)*RC1U(N-3) -
     +             DL1L(N-1)*DU2U(N-2))/DML(N-1)
C
      DUMMY1 = 0.0D0
      DO 70 K=1,N-3,1
        DUMMY1 = DUMMY1 + RL1L(K)*RC1U(K)
   70 CONTINUE
      DML(N) = DM(N) - DUMMY1 - DL2L(N)*DU2U(N-2) -
     +         DL1L(N)*DU1U(N-1)
      IF (DML(N) .LE. FMACHP) RETURN
C
      IERR = 0
      RETURN
      END
C
C

      SUBROUTINE NCYFSS (N,RS,X,DML,DL1L,DL2L,RL2L,RL1L,DU1U,
     +                   DU2U,RC2U,RC1U)
C
C*****************************************************************
C                                                                *
C  Find the solution of a linear system of equations A*X=RS for  *
C  a symmetric, cyclic five-diagonal matrix A, once the factor   *
C  matrizes C and B have been determind in SUBROUTINE NCYFSP.    *
C  C and B are input parameters and are represented by the       *
C  vectors DML, ... , RC1U as described in SUBROUTINE NCYFSY.    *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  N    :  size of the matrix A                                  *
C  RS   :  vector RS(1:N); the right hand side                   *
C                                                                *
C  DML  :  vector DML(1:N)    ]   describing the entries of the  *
C  DL1L :  vector DL1L(1:N)   ]   lower tringular matrix C in the*
C  DL2L :  vector DL2L(1:N)   ]   factorization A=C*B            *
C  RL2L :  vector RL2L(1:N-4) ]   (refer to NCYFSP)              *
C  RL1L :  vector RL1L(1:N-3) ]                                  *
C                                                                *
C  DU1U :  vector DU1U(1:N)    ]   describing the entries of the *
C  DU2U :  vector DU2U(1:N)    ]   upper tringular matrix B in   *
C  RC2U :  vector RC2U(1:N-4)  ]   the factorization A=C*B       *
C  RC1U :  vector RC1U(1:N-3)  ]   (refer to NCYFSP)             *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  X :  vector  X(1:N); the solution vector                      *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  Author  : Günter Palm                                         *
C  Date    : 04.18.1988                                          *
C  Source  : FORTRAN 77                                          *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION RS(N), X(N), DML(N), DL1L(N), DL2L(N),
     +                 RL2L(N-4), RL1L(N-3), DU1U(N), DU2U(N),
     +                 RC2U(N-4), RC1U(N-3)
C
C-----Solving the system by updating and
C     backsubstitution
C
C     1. Updating the right hand side
C
      X(1) = RS(1)/DML(1)
      X(2) = (RS(2) -X(1)*DL1L(2))/DML(2)
      DO 80 I=3,N-2,1
        X(I) = (RS(I) - X(I-2)*DL2L(I) - X(I-1)*DL1L(I))/DML(I)
   80 CONTINUE
      DUMMY1 = 0.0D0
      DO 90 K=1,N-4,1
        DUMMY1 = DUMMY1 + X(K)*RL2L(K)
   90 CONTINUE
      X(N-1) = (RS(N-1)-DUMMY1-X(N-3)*DL2L(N-1)-X(N-2)*DL1L(N-1))
     +          / DML(N-1)
      DUMMY1 = 0.0D0
      DO 100 K=1,N-3,1
        DUMMY1 = DUMMY1 + X(K)*RL1L(K)
  100 CONTINUE
      X(N) = (RS(N) - DUMMY1 - X(N-2)*DL2L(N) - X(N-1)*DL1L(N))
     +        / DML(N)
C
C     2. Backsubstitution
C
      X(N-1) = X(N-1) - DU1U(N-1)*X(N)
      X(N-2) = X(N-2) - DU1U(N-2)*X(N-1) - DU2U(N-2)*X(N)
      X(N-3) = X(N-3) - DU1U(N-3)*X(N-2) - DU2U(N-3)*X(N-1) -
     +         RC1U(N-3)*X(N)
      DO 110 I=N-4,1,-1
        X(I) = X(I) - DU1U(I)*X(I+1) - DU2U(I)*X(I+2) -
     +         RC2U(I)*X(N-1) - RC1U(I)*X(N)
  110 CONTINUE
      RETURN
      END


Begin of file
Contents
Index