End of file
Contents
Index

      SUBROUTINE SESSPM (AZ,N,KPVT,B)
C
C*****************************************************************
C     SESSPM solves the symmetric system of equations A*X = B    *
C     by using the factorization of A produced by SUBROUTINE     *
C     CEPSPM, ZSPMOK or ZSPMMK.                                  *
C     Since the right-hand side B has already been updated in    *
C     SUBROUTINE ZSPM.., only a backsubstitution is required     *
C     here.                                                      *
C                                                                *
C                                                                *
C     INPUT PARAMETERS:                                          *
C     =================                                          *
C     AZ    DOUBLE PRECISION vector AZ(1:N*(N+1)/2) containing   *
C           the matrix A that was factored by CEPSPM or ZSPM.. . *
C           If SESSPM is called after CEPSPM or ZSPMMK, AZ       *
C           is the decomposed matrix WK from ZSPMMK.             *
C           If SESSPM is called after ZSPMOK, AZ denotes the     *
C           factored matrix AP from ZSPMOK.                      *
C     N     dimension of the matrix A.                           *
C     B     vector B(1:N) containing the right-hand side B of    *
C           the system of equations  A*X = B.                    *
C           Output of SUBROUTINE CEPSPM or ZSPM.. .              *
C     KPVT  INTEGER vector KPVT(1:N) containing the PIVOT        *
C           indices for the factorization.                       *
C                                                                *
C                                                                *
C     OUTPUT PARAMETERS:                                         *
C     ==================                                         *
C     B     DOUBLE PRECISION vector B(1:N), the solution         *
C           vector X                                             *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C     subroutines required: SCAPRO                               *
C                                                                *
C                                                                *
C     source  : Linpack User's Guide , SIAM Philadelphia, 1979   *
C                                                                *
C               the source, available in FORTRAN 4, was          *
C               converted to FORTRAN 77. Some details were       *
C               modified and adjusted for the requirements of    *
C               our calling programs.                            *
C               This program and the related subroutines are     *
C               not compatible with the original ones from the   *
C               Linpack User's Guide.                            *
C                                                                *
C*****************************************************************
C                                                                *
C     authors  :  Michael Groenheim, Ina Hinze                   *
C     date     :  10.25.1989                                     *
C     source   :  FORTRAN 77                                     *
C                                                                *
C*****************************************************************
C
      INTEGER N,KPVT(N)
      DOUBLE PRECISION AZ(1:N*(N+1)/2),B(N),D,D1,D2,TEMP,SCAPRO
      INTEGER IK,IKP1,K,KK,KP
      K = 1
      IK = 0
      KK = 1
10    IF (K .GT. N) RETURN
      IF (KPVT(K) .LT. 0) THEN
C
C        2 x 2 PIVOT block
C
         IF (K .EQ. 1) GOTO 20
         B(K) = B(K) - SCAPRO (K-1,AZ(IK+1),B(1))
         IKP1 = IK + K
         B(K+1) = B(K+1) - SCAPRO (K-1,AZ(IKP1+1),B(1))
C
C        determine the determinants
C
20       D  = AZ(KK) * AZ(KK+K+1) - AZ(KK+K) * AZ(KK+K)
         D1 = B(K) * AZ(KK+K+1) - B(K+1) * AZ(KK+K)
         D2 = AZ(KK) * B(K+1) - AZ(KK+K) * B(K)
         B(K) = D1 / D
         B(K+1) = D2 / D
         KP = IABS (KPVT(K))
         IF (KP .NE. K) THEN
C
C           swap
C
            TEMP  = B(K)
            B(K)  = B(KP)
            B(KP) = TEMP
         ENDIF
         IK = IK + K + K + 1
         K = K + 2
         KK = IK + K
         GOTO 10
      ELSE
C
C        1 x 1 PIVOT block
C
         IF (K .EQ. 1) THEN
            B(K) = B(K) / AZ(K)
         ELSE
            B(K) = (B(K) - SCAPRO(K-1,AZ(IK+1),B(1))) / AZ(KK)
            KP = KPVT(K)
            IF (KP .NE. K) THEN
C
C              swap
C
               TEMP  = B(K)
               B(K)  = B(KP)
               B(KP) = TEMP
            ENDIF
         ENDIF
      ENDIF
      IK = IK + K
      K  = K + 1
      KK = IK + K
      GOTO 10
      END


Begin of file
Contents
Index