PROGRAM SIMLUTANEOUS
C==================================================================
C SOLUTION OF AX=B BY LDLT DECOMPOSITION
C [A]=[L][D][L]T
C INPUT [A]
C OUTPUT [A] = UPPER TRIANGLE
C DIAGONAL OF [A] IS [D]
C [A]-[D] = [L]TRANSPOSE
C SUBROUTINE LLDECOMP3 HAND MADE
C
CXXXXX
CXXXXX
CXXXX
CXXX
CXX
CX
C AUGUST 01, 2008 EIJI FUKUMORI
C==================================================================
IMPLICIT REAL*8(A-H,O-Z)
C
PARAMETER ( MXN=200, MXW=50 )
DIMENSION A(MXN,MXW), B(MXN)
C-----------------------------------------------------------------
CALL INPUT ( MXW, MXN, NNODE, IBAND, A , B )
C-----------------------------------------------------------------
OPEN ( 21, FILE='SOLUTION-CRUSHVT.SIM', STATUS='UNKNOWN' )
WRITE (21,*) 'SOLUTION OF SIMULTANEOUS EQUATIONS BY LDL'
WRITE (21,*) 'NUMBER OF DIMENSIONS=', NNODE
WRITE (21,*) 'MATRIX OF SIMULTANEOUS EQUATIONS'
WRITE (21,*) 'GIVEN MATRIX: UPPER HALF OF [A]'
DO I = 1,NNODE
WRITE (21,*) ( A(I,J), J = 1 ,IBAND )
END DO
WRITE (21,*) 'RIGHT HAND SIDE OF EQUATION {B}'
DO I = 1 , NNODE
WRITE (21,*) B(I)
END DO
C------- COMPUTATION OF RLT(I,J)
C-----------------------------------------------------------------
CALL LLDECOMPVT ( A, NNODE, IBAND, MXW, MXN )
C-----------------------------------------------------------------
CALL SYSLDLVT ( MXN, MXW, NNODE, IBAND, A, B )
C-----------------------------------------------------------------
C
WRITE (21,*) 'SOLUTION OF {X} BY [L][D][L]T DECOMPOSITION'
WRITE (21,*) 'HALF BAND MATRIX CASE'
DO I = 1 , NNODE
WRITE (21,*) B(I)
END DO
C
CLOSE (21)
STOP 'NORMAL TERMINATION'
END
C
C
SUBROUTINE LLDECOMPVT ( A, NNODE, IBAND, MXW, MXN )
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(MXN,MXW)
C-------I = 1
DO J = 2, IBAND
A(1,J) = A(1,J)/A(1,1)
END DO
C------ I >= 2
DO I = 2 , NNODE
SUM = 0.D0
DO M = 2, MIN0(I,IBAND)
II = I - M + 1
SUM = SUM + A(II,M)**2*A(II,1)
END DO
A(I,1) = A(I,1) - SUM
DO J = 2, MIN0(IBAND,NNODE-I+1)
SUM = 0.D0
DO M = 2, MIN0( I,IBAND, IBAND-J+1 )
II = I - M + 1
L = J + M - 1
SUM = SUM + A(II,1)*A(II,M)*A(II,L)
END DO
A(I,J) = (A(I,J)-SUM)/A(I,1)
END DO
END DO
RETURN
END
C
C
SUBROUTINE INPUT ( MXW, MXN, NNODE, IBAND, A, B )
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(MXN,MXW), B(MXN)
OPEN ( 2, FILE='MTRIXLDLVT.DAT', STATUS='UNKNOWN' )
READ (2,*) NNODE, IBAND
DO I = 1,NNODE
READ (2,*) ( A(I,J), J=1,IBAND )
END DO
READ (2,*) ( B(I), I= 1, NNODE )
CLOSE (2)
RETURN
END
C
C
SUBROUTINE SYSLDLVT ( MXN, MXW, NNODE, NBWDTH, GSMTX, V1 )
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION GSMTX(MXN,MXW), V1(MXN)
C------- SOLUTION OF [A]{X}={B} --------
C----- SEQUENCE 1: [L]{X'}={B}
DO I=2,NNODE
DO J = 2, MIN0(I,NBWDTH)
V1(I) = V1(I) - GSMTX(I-J+1,J)*V1(I-J+1)
END DO
END DO
C------ SEQUENCE 2 [D]{X"'}={X"}
DO I = 1 , NNODE
V1(I) = V1(I) / GSMTX(I,1)
END DO
C------ SEQUENCE 3 [L]TRANSPOSE{X'}={X"'} NOTE THAT L(I,I) = 1
DO I = NNODE-1 , 1 , -1
DO J = 2 , MIN0(NNODE-I+1,NBWDTH)
V1(I) = V1(I) - GSMTX(I,J)*V1(I+J-1)
END DO
END DO
RETURN
END