e4d_mat_inv.F90 coverage: 100.00 %func 95.31 %block
1) module e4d_mat_inv_module
2)
3) public :: MIGS, ELGS
4)
5) contains
6)
7) ! Updated 10/24/2001.
8) !
9) !cccccccccccccccccccccccc Program 4.4 cccccccccccccccccccccccccc
10) !
11) !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
12) ! c
13) ! Please Note: c
14) ! c
15) ! (1) This computer program is part of the book, "An Introduction to c
16) ! Computational Physics," written by Tao Pang and published and c
17) ! copyrighted by Cambridge University Press in 1997. c
18) ! c
19) ! (2) No warranties, express or implied, are made for this program. c
20) ! c
21) !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
22) !
23) SUBROUTINE MIGS(A,N,X,INDX)
24) !
25) ! Subroutine to invert matrix A(N,N) with the inverse stored
26) ! in X(N,N) in the output.
27)
28) !
29) DIMENSION A(N,N),X(N,N),INDX(N),B(N,N)
30) !
31)
32) DO I = 1, N
33) DO J = 1, N
34) B(I,J) = 0.0
35) ENDDO
36) ENDDO
37) DO I = 1, N
38) B(I,I) = 1.0
39) ENDDO
40) !
41) CALL ELGS(A,N,INDX)
42) !
43) DO I = 1, N-1
44) DO J = I+1, N
45) DO K = 1, N
46) B(INDX(J),K) = B(INDX(J),K) &
47) -A(INDX(J),I)*B(INDX(I),K)
48) ENDDO
49) ENDDO
50) ENDDO
51) !
52) DO I = 1, N
53) X(N,I) = B(INDX(N),I)/A(INDX(N),N)
54) DO J = N-1, 1, -1
55) X(J,I) = B(INDX(J),I)
56) DO K = J+1, N
57) X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
58) ENDDO
59) X(J,I) = X(J,I)/A(INDX(J),J)
60) ENDDO
61) ENDDO
62) !
63) RETURN
64) END SUBROUTINE
65) !
66) SUBROUTINE ELGS(A,N,INDX)
67) !
68) ! Subroutine to perform the partial-pivoting Gaussian elimination.
69) ! A(N,N) is the original matrix in the input and transformed
70) ! matrix plus the pivoting element ratios below the diagonal in
71) ! the output. INDX(N) records the pivoting order.
72)
73) !
74) DIMENSION A(N,N),INDX(N),C(N)
75) !
76) ! Initialize the index
77) !
78) DO I = 1, N
79) INDX(I) = I
80) ENDDO
81) !
82) ! Find the rescaling factors, one from each row
83) !
84) DO I = 1, N
85) C1= 0.0
86) DO J = 1, N
87) C1 = AMAX1(C1,ABS(A(I,J)))
88) ENDDO
89) C(I) = C1
90) ENDDO
91) !
92) ! Search the pivoting (largest) element from each column
93) !
94) DO J = 1, N-1
95) PI1 = 0.0
96) DO I = J, N
97) PI = ABS(A(INDX(I),J))/C(INDX(I))
98) IF (PI.GT.PI1) THEN
99) PI1 = PI
100) K = I
101) ELSE
102) ENDIF
103) ENDDO
104) !
105) ! Interchange the rows via INDX(N) to record pivoting order
106) !
107) ITMP = INDX(J)
108) INDX(J) = INDX(K)
109) INDX(K) = ITMP
110) DO I = J+1, N
111) PJ = A(INDX(I),J)/A(INDX(J),J)
112) !
113) ! Record pivoting ratios below the diagonal
114) !
115) A(INDX(I),J) = PJ
116) !
117) ! Modify other elements accordingly
118) !
119) DO K = J+1, N
120) A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
121) ENDDO
122) ENDDO
123) ENDDO
124) !
125) RETURN
126) END SUBROUTINE
127)
128) end module e4d_mat_inv_module