forked from mikedurand/EnKFYampa
-
Notifications
You must be signed in to change notification settings - Fork 0
/
invert_matrix.f90
85 lines (70 loc) · 1.57 KB
/
invert_matrix.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
! -------------------------------------------------------------------------
!
SUBROUTINE INVERT_MATRIX(MA,INV,N)
!
! -------------------------------------------------------------------------
!
! MATRIX INVERSION ALGORITHM OBTAINED FROM GOTOP FORTRAN 90 TEXT,
! ISBN:957-566-172-9
!
! COPIED FROM THE COMPANION CD TO THAT TEXT BY MIKE, 1 APRIL 2005
IMPLICIT NONE
INTEGER,INTENT(IN) :: N
REAL,INTENT(IN) :: MA(N,N)
REAL,INTENT(OUT) :: INV(N,N)
REAL,dimension(:,:),allocatable :: temp
INTEGER I,J
allocate(temp(n,n))
DO I=1,N
DO J=1,N
TEMP(I,J)=MA(I,J)
INV(I,J)=0.
END DO
INV(I,I)=1.
END DO
!print *, 'before upper call'
CALL UPPER(TEMP,INV,N)
!print *, 'before lower call'
CALL LOWER(TEMP,INV,N)
!print *, 'before inv calc'
DO I=1,N
DO J=1,N
INV(I,J)=INV(I,J)/TEMP(I,I)
END DO
END DO
!print *, 'before deallocation'
deallocate(temp)
CONTAINS
SUBROUTINE UPPER(M,S,N)
INTEGER,INTENT(IN):: N
INTEGER I,J,K
REAL E
REAL,INTENT(INOUT):: M(N,N)
REAL,INTENT(INOUT):: S(N,N)
DO I=1,N-1
DO J=I+1,N
E=M(J,I)/M(I,I)
DO K=1,N
M(J,K)=M(J,K)-M(I,K)*E
S(J,K)=S(J,K)-S(I,K)*E
END DO
END DO
END DO
END SUBROUTINE UPPER
SUBROUTINE LOWER(M,S,N)
INTEGER,INTENT(IN):: N
REAL,INTENT(INOUT):: M(N,N)
REAL,INTENT(INOUT):: S(N,N)
INTEGER I,J,K
REAL E
DO I=N,2,-1
DO J=I-1,1,-1
E=M(J,I)/M(I,I)
DO K=1,N
M(J,K)=M(J,K)-M(I,K)*E
S(J,K)=S(J,K)-S(I,K)*E
END DO
END DO
END DO
END SUBROUTINE LOWER
END SUBROUTINE INVERT_MATRIX