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