File: RELATIVE:/../../../mfix.git/model/check_ab_m.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 SUBROUTINE CHECK_AB_M(A_M, B_M, M, SRC, IER)
21
22
23
24
25
26
27
28
29 USE param
30 USE param1
31 USE matrix
32 USE geometry
33 USE indices
34 USE compar
35 USE functions
36 IMPLICIT NONE
37
38
39
40
41
42
43
44
45 INTEGER IER
46
47
48 INTEGER M
49
50
51
52
53 LOGICAL SRC
54
55
56 CHARACTER(LEN=80) :: LINE(1)
57
58
59 INTEGER IJK
60
61
62 DOUBLE PRECISION A_m(DIMENSION_3, -3:3, 0:DIMENSION_M)
63
64
65 DOUBLE PRECISION b_m(DIMENSION_3, 0:DIMENSION_M)
66
67
68 = 0
69 DO IJK = ijkstart3, ijkend3
70 IF (.NOT.WALL_AT(IJK)) THEN
71 IF (A_M(IJK,B,M) < ZERO) THEN
72 IF (ABS(A_M(IJK,B,M)) > SMALL_NUMBER) THEN
73 WRITE (LINE(1), *) 'Error: Diagonal-b < 0. Phase = ', M, &
74 ' IJK = ', IJK
75 CALL WRITE_ERROR ('CHECK_Ab_m', LINE, 1)
76 GO TO 500
77 ELSE
78 A_M(IJK,B,M) = ZERO
79 ENDIF
80 ENDIF
81 IF (A_M(IJK,S,M) < ZERO) THEN
82 IF (ABS(A_M(IJK,S,M)) > SMALL_NUMBER) THEN
83 WRITE (LINE(1), *) 'Error: Diagonal-s < 0. Phase = ', M, &
84 ' IJK = ', IJK
85 CALL WRITE_ERROR ('CHECK_Ab_m', LINE, 1)
86 GO TO 500
87 ELSE
88 A_M(IJK,S,M) = ZERO
89 ENDIF
90 ENDIF
91 IF (A_M(IJK,W,M) < ZERO) THEN
92 IF (ABS(A_M(IJK,W,M)) > SMALL_NUMBER) THEN
93 WRITE (LINE(1), *) 'Error: Diagonal-w < 0. Phase = ', M, &
94 ' IJK = ', IJK
95 CALL WRITE_ERROR ('CHECK_Ab_m', LINE, 1)
96 GO TO 500
97 ELSE
98 A_M(IJK,W,M) = ZERO
99 ENDIF
100 ENDIF
101 IF (A_M(IJK,E,M) < ZERO) THEN
102 IF (ABS(A_M(IJK,E,M)) > SMALL_NUMBER) THEN
103 WRITE (LINE(1), *) 'Error: Diagonal-e < 0. Phase = ', M, &
104 ' IJK = ', IJK
105 CALL WRITE_ERROR ('CHECK_Ab_m', LINE, 1)
106 GO TO 500
107 ELSE
108 A_M(IJK,E,M) = ZERO
109 ENDIF
110 ENDIF
111 IF (A_M(IJK,N,M) < ZERO) THEN
112 IF (ABS(A_M(IJK,N,M)) > SMALL_NUMBER) THEN
113 WRITE (LINE(1), *) 'Error: Diagonal-n < 0. Phase = ', M, &
114 ' IJK = ', IJK
115 CALL WRITE_ERROR ('CHECK_Ab_m', LINE, 1)
116 GO TO 500
117 ELSE
118 A_M(IJK,N,M) = ZERO
119 ENDIF
120 ENDIF
121 IF (A_M(IJK,T,M) < ZERO) THEN
122 IF (ABS(A_M(IJK,T,M)) > SMALL_NUMBER) THEN
123 WRITE (LINE(1), *) 'Error: Diagonal-t < 0. Phase = ', M, &
124 ' IJK = ', IJK
125 CALL WRITE_ERROR ('CHECK_Ab_m', LINE, 1)
126 GO TO 500
127 ELSE
128 A_M(IJK,T,M) = ZERO
129 ENDIF
130 ENDIF
131 IF (A_M(IJK,0,M) >= ZERO) THEN
132 WRITE (LINE(1), *) 'Error: Main Diagonal >= 0. Phase = ', M, &
133 ' IJK = ', IJK
134 CALL WRITE_ERROR ('CHECK_Ab_m', LINE, 1)
135 GO TO 500
136 ENDIF
137 IF (SRC) THEN
138 IF (B_M(IJK,M) > ZERO) THEN
139 IF (B_M(IJK,M) > SMALL_NUMBER) THEN
140 WRITE (LINE(1), *) 'Error: Source term >0. Phase = ', M, &
141 ' IJK = ', IJK
142 CALL WRITE_ERROR ('CHECK_Ab_m', LINE, 1)
143 GO TO 500
144 ELSE
145 B_M(IJK,M) = ZERO
146 ENDIF
147 ENDIF
148 ENDIF
149 ENDIF
150 END DO
151 RETURN
152
153
154 CONTINUE
155 IER = 1
156 CALL WRITE_AB_M (A_M, B_M, IJKMAX2, M, IER)
157 call mfix_exit(myPE)
158 END SUBROUTINE CHECK_AB_M
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178 SUBROUTINE CHECK_symmetry(A_M, M, IER)
179
180
181
182
183 USE param
184 USE param1
185 USE matrix
186 USE geometry
187 USE indices
188 USE compar
189 USE functions
190 IMPLICIT NONE
191
192
193
194
195
196
197
198
199 INTEGER IER
200
201
202 INTEGER M
203
204
205 INTEGER IJK, ipjk, ijpk, ijkp, i, j, k
206
207
208 DOUBLE PRECISION A_m(DIMENSION_3, -3:3, 0:DIMENSION_M)
209
210 = 0
211 DO IJK = ijkstart3, ijkend3
212
213
214 if(.not. cyclic_at(ijk))then
215 ipjk = ip_of(ijk)
216 ijpk = jp_of(ijk)
217 ijkp = kp_of(ijk)
218 i = i_of(ijk)
219 j = j_of(ijk)
220 k = k_of(ijk)
221 IF(A_m(ijk, e, M) .ne. A_m(ipjk, w, M))then
222 print *, i,j,k, 'east-west asymmetry', A_m(ijk,e,M), A_m(ipjk,w,M)
223 IER = IER + 1
224 endif
225 IF(A_m(ijk, n, M) .ne. A_m(ijpk, s, M))then
226 print *, i,j,k, 'north-south asymmetry', A_m(ijk,n,M), A_m(ijpk,s,M)
227 IER = IER + 1
228 endif
229 IF(A_m(ijk, t, M) .ne. A_m(ijkp, b, M))then
230 print *, i,j,k, 'top-bottom asymmetry', A_m(ijk,t,M), A_m(ijkp,b,M)
231 IER = IER + 1
232 endif
233 endif
234 enddo
235 if(IER > 0) print *, 'Asymmetry in ', IER, ' instances'
236 RETURN
237 END SUBROUTINE CHECK_Symmetry
238