File: RELATIVE:/../../../mfix.git/model/set_ro_s.f
1
2
3
4
5
6
7
8
9
10
11 SUBROUTINE SET_RO_S
12
13
14
15
16 use physprop, only: MMAX
17
18 use fldvar, only: RO_s, ROP_s
19
20 use physprop, only: BASE_ROs
21
22 use fldvar, only: X_s
23
24 use physprop, only: X_S0
25
26 use physprop, only: INERT_SPECIES
27
28 use physprop, only: DIL_INERT_X_VSD
29
30 use physprop, only: DIL_FACTOR_VSD
31
32 use run, only: SOLVE_ROs
33
34 use physprop, only: RO_s0
35
36 use toleranc, only: DIL_EP_s
37
38
39 use eos, only: EOSS
40
41
42 use compar
43 use geometry
44 use indices
45 use functions
46
47 implicit none
48
49
50
51
52 INTEGER :: M
53
54 INTEGER :: IJK
55
56 INTEGER :: IIS
57
58 LOGICAL, parameter :: dbgMode = .FALSE.
59
60 DOUBLE PRECISION :: minROPs
61
62
63 DO M=1,MMAX
64
65
66 IF (SOLVE_ROs(M)) THEN
67
68 = INERT_SPECIES(M)
69
70
71 = BASE_ROs(M)*(DIL_FACTOR_VSD*DIL_EP_s)
72
73 IF(dbgMode) CALL CHECK_SET_ROs()
74
75
76 DO IJK = ijkStart3, ijkEnd3
77 IF(WALL_AT(IJK)) CYCLE
78 IF(ROP_s(IJK,M) > minROPs) THEN
79 RO_S(IJK,M) = EOSS(BASE_ROs(M), X_s0(M,IIS), &
80 X_s(IJK,M,IIS))
81 ELSE
82
83 (IJK,M) = EOSS(BASE_ROs(M), X_s0(M,IIS), &
84 DIL_INERT_X_VSD(M))
85 ENDIF
86 ENDDO
87 ELSE
88
89 DO IJK = ijkstart3, ijkend3
90 IF (WALL_AT(IJK)) CYCLE
91 RO_S(IJK,M) = RO_S0(M)
92 ENDDO
93 ENDIF
94 ENDDO
95
96 RETURN
97
98 CONTAINS
99
100
101
102
103
104
105
106
107
108
109
110
111 SUBROUTINE CHECK_SET_ROs()
112
113
114 use funits, only: DMP_LOG
115
116 use fldvar, only: X_s
117
118 use param1, only: zero
119
120 use physprop, only: NMAX
121
122 use physprop, only: INERT_SPECIES
123
124 use toleranc
125
126 implicit none
127
128
129 DOUBLE PRECISION :: SUM_Xs
130
131 INTEGER :: INERT
132
133 INTEGER :: IER(2)
134
135
136 INTEGER, parameter :: lUnit = 8454
137 LOGICAL :: lExists
138 CHARACTER(LEN=64) :: lFName
139
140
141 = 0
142
143
144 = INERT_SPECIES(M)
145
146
147 DO IJK = ijkStart3, ijkEnd3
148
149 IF (WALL_AT(IJK)) CYCLE
150
151 = sum(X_s(IJK,M,:NMAX(M)))
152
153 IF(.NOT.compare(ONE,SUM_Xs)) IER(1) = IER(1)+1
154
155 IF(X_s(IJK,M,INERT) <= ZERO) IER(2) = IER(2)+1
156
157 ENDDO
158
159
160 IF(sum(IER) /= 0) THEN
161 lFName=''
162 IF(numPEs == 1) THEN
163 WRITE(lFName,"('setROs.log')")
164 ELSE
165 WRITE(lFName,"('setROs_',I6.6,'.log')") myPE
166 ENDIF
167 inquire(file=trim(lFName),exist=lExists)
168 IF(lExists) THEN
169 OPEN(CONVERT='BIG_ENDIAN',unit=lUnit,file=trim(lFName),status='replace')
170 ELSE
171 OPEN(CONVERT='BIG_ENDIAN',unit=lUnit,file=trim(lFName),status='new')
172 ENDIF
173 ENDIF
174
175
176
177 IF(IER(1) /= 0)THEN
178 WRITE(lUnit,1100) myPE
179
180 DO IJK = ijkStart3, ijkEnd3
181 IF (WALL_AT(IJK)) CYCLE
182
183 = sum(X_s(IJK,M,:NMAX(M)))
184
185 IF(.NOT.compare(ONE,SUM_Xs)) WRITE(lUnit,1101) IJK, SUM_Xs
186 ENDDO
187 WRITE(lUnit,9999)
188 ENDIF
189
190
191 IF(IER(2) /= 0)THEN
192 WRITE(lUnit,1200) myPE
193 WRITE(lUnit,1201) M
194 WRITE(lUnit,1202) INERT
195
196 DO IJK = ijkStart3, ijkEnd3
197 IF (WALL_AT(IJK)) CYCLE
198
199
200 IF(X_s(IJK,M,INERT) <= ZERO) WRITE(lUnit,1203) &
201 IJK, X_s(IJK,M,INERT)
202 ENDDO
203 WRITE(lUnit,9999)
204 ENDIF
205
206
207 IF(sum(IER) /= 0) THEN
208 CLOSE(lUnit)
209 IF(DMP_LOG) THEN
210 ENDIF
211 CALL MFIX_EXIT(myPE)
212 ENDIF
213
214
215 RETURN
216
217 1100 FORMAT(//1X,70('*')/' From: CHECK_SET_ROs',/,' Error 1100:', &
218 ' One or more fluid cells contain invalid species mass',/ &
219 ' fractions which do NOT sum to one.'/,' > myPE = ',I6)
220
221 1101 FORMAT(' > sum(X_s(',I6,')) = ',g12.5)
222
223 1200 FORMAT(//1X,70('*')/' From: CHECK_SET_ROs',/,' Error 1200:', &
224 ' One or more fluid cells contain an invalid species mass',/ &
225 ' fraction for the inert material.'/,' > myPE = ',I6)
226
227 1201 FORMAT(' > Solid Phase: ',I2)
228
229 1202 FORMAT(' > Inert species index: ',I4)
230
231 1203 FORMAT(' > X_s(',I6,',INERT) = ',g12.5)
232
233 9999 FORMAT(1x,70('*')/)
234
235 END SUBROUTINE CHECK_SET_ROs
236
237 END SUBROUTINE SET_RO_S
238