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