File: RELATIVE:/../../../mfix.git/model/get_eq.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23 SUBROUTINE GET_EQ(A, B, VEL, DTXFA, IJK1)
24
25
26
27
28
29
30
31
32 USE param
33 USE param1
34 USE physprop
35 USE geometry
36 USE fldvar
37 USE indices
38 IMPLICIT NONE
39
40
41
42
43
44
45
46
47 INTEGER L, M
48
49
50 INTEGER IJK1
51
52
53 DOUBLE PRECISION DTxFA(0:DIMENSION_M, 0:DIMENSION_M)
54
55
56
57 DOUBLE PRECISION A(0:DIMENSION_M, 0:DIMENSION_M), B(0:DIMENSION_M)
58
59
60 DOUBLE PRECISION VEL (DIMENSION_3, DIMENSION_M)
61
62
63
64
65
66
67 DO M = 1, MMAX
68 IF (A(M,M) /= ZERO) THEN
69 A(0,M) = -DTXFA(0,M)
70 A(M,0) = -DTXFA(0,M)
71 DO L = M + 1, MMAX
72 IF (A(L,L) /= ZERO) THEN
73 A(L,M) = -DTXFA(L,M)
74 A(M,L) = -DTXFA(L,M)
75 ELSE
76 A(L,M) = ZERO
77 A(M,L) = ZERO
78 ENDIF
79 END DO
80 ELSE
81 A(0,M) = ZERO
82 A(M,0) = ZERO
83 L = M + 1
84 IF (MMAX - M > 0) THEN
85 A(M+1:MMAX,M) = ZERO
86 A(M,M+1:MMAX) = ZERO
87 L = MMAX + 1
88 ENDIF
89 IF (B(M) == UNDEFINED) THEN
90 A(0,0) = A(0,0) + DTXFA(0,M)
91 B(0) = B(0) + DTXFA(0,M)*VEL(IJK1,M)
92 DO L = 1, MMAX
93 IF (L/=M .AND. A(L,L)/=ZERO) THEN
94 A(L,L) = A(L,L) + DTXFA(L,M)
95 B(L) = B(L) + DTXFA(L,M)*VEL(IJK1,M)
96 ENDIF
97 END DO
98 ENDIF
99 ENDIF
100 END DO
101 DO M = 0, MMAX
102 DO L = 0, MMAX
103 IF (L /= M) A(M,M) = A(M,M) - A(M,L)
104 END DO
105 END DO
106 RETURN
107 END SUBROUTINE GET_EQ
108