File: /nfs/home/0/users/jenkins/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 run, only: SOLVE_ROs
29
30 use physprop, only: RO_s0
31
32 use toleranc, only: DIL_EP_s
33
34
35 use eos, only: EOSS
36
37
38 use compar
39 use geometry
40 use indices
41 use functions
42
43 implicit none
44
45
46
47
48 INTEGER :: M
49
50 INTEGER :: IJK
51
52 INTEGER :: IIS
53
54 LOGICAL, parameter :: dbgMode = .FALSE.
55
56 DOUBLE PRECISION :: minROPs
57
58
59 DO M=1,MMAX
60
61
62 IF (SOLVE_ROs(M)) THEN
63
64 = INERT_SPECIES(M)
65
66 = BASE_ROs(M)*DIL_EP_s
67
68 IF(dbgMode) CALL CHECK_SET_ROs(M)
69
70
71 DO IJK = ijkStart3, ijkEnd3
72 IF(WALL_AT(IJK)) CYCLE
73 IF(ROP_s(IJK,M) > minROPs) THEN
74 RO_S(IJK,M) = EOSS(BASE_ROs(M), X_s0(M,IIS), &
75 X_s(IJK,M,IIS))
76 ELSE
77 RO_s(IJK,M) = BASE_ROs(M)
78 ENDIF
79 ENDDO
80 ELSE
81
82 DO IJK = ijkstart3, ijkend3
83 IF (WALL_AT(IJK)) CYCLE
84 RO_S(IJK,M) = RO_S0(M)
85 ENDDO
86 ENDIF
87 ENDDO
88
89 RETURN
90
91 CONTAINS
92
93
94
95
96
97
98
99
100
101
102
103
104 SUBROUTINE CHECK_SET_ROs(lM)
105
106
107 use funits, only: UNIT_LOG
108
109 use funits, only: DMP_LOG
110
111 use fldvar, only: X_s
112
113 use physprop, only: NMAX
114
115 use physprop, only: INERT_SPECIES
116
117 use toleranc
118
119 implicit none
120
121
122 INTEGER, INTENT(IN) :: lM
123
124
125 DOUBLE PRECISION :: SUM_Xs
126
127 INTEGER :: INERT
128
129 INTEGER :: IER(2)
130
131
132 INTEGER, parameter :: lUnit = 8454
133 LOGICAL :: lExists
134 CHARACTER(LEN=64) :: lFName
135
136
137 = 0
138
139
140 = INERT_SPECIES(M)
141
142
143 DO IJK = ijkStart3, ijkEnd3
144
145 IF (WALL_AT(IJK)) CYCLE
146
147 = sum(X_s(IJK,M,:NMAX(M)))
148
149 IF(.NOT.compare(ONE,SUM_Xs)) IER(1) = IER(1)+1
150
151 IF(X_s(IJK,M,INERT) <= ZERO) IER(2) = IER(2)+1
152
153 ENDDO
154
155
156 IF(sum(IER) /= 0) THEN
157 lFName=''
158 IF(numPEs == 1) THEN
159 WRITE(lFName,"('setROs.log')")
160 ELSE
161 WRITE(lFName,"('setROs_',I6.6,'.log')") myPE
162 ENDIF
163 inquire(file=trim(lFName),exist=lExists)
164 IF(lExists) THEN
165 OPEN(unit=lUnit,file=trim(lFName),status='replace')
166 ELSE
167 OPEN(unit=lUnit,file=trim(lFName),status='new')
168 ENDIF
169 ENDIF
170
171
172
173 IF(IER(1) /= 0)THEN
174 WRITE(lUnit,1100) myPE
175
176 DO IJK = ijkStart3, ijkEnd3
177 IF (WALL_AT(IJK)) CYCLE
178
179 = sum(X_s(IJK,M,:NMAX(M)))
180
181 IF(.NOT.compare(ONE,SUM_Xs)) WRITE(lUnit,1101) IJK, SUM_Xs
182 ENDDO
183 WRITE(lUnit,9999)
184 ENDIF
185
186
187 IF(IER(2) /= 0)THEN
188 WRITE(lUnit,1200) myPE
189 WRITE(lUnit,1201) M
190 WRITE(lUnit,1202) INERT
191
192 DO IJK = ijkStart3, ijkEnd3
193 IF (WALL_AT(IJK)) CYCLE
194
195
196 IF(X_s(IJK,M,INERT) <= ZERO) WRITE(lUnit,1203) &
197 IJK, X_s(IJK,M,INERT)
198 ENDDO
199 WRITE(lUnit,9999)
200 ENDIF
201
202
203 IF(sum(IER) /= 0) THEN
204 CLOSE(lUnit)
205 IF(DMP_LOG) THEN
206 ENDIF
207 CALL MFIX_EXIT(myPE)
208 ENDIF
209
210
211 RETURN
212
213 1000 FORMAT(//1X,70('*')/' From: CHECK_SET_ROs',/,' Error 1000:', &
214 ' Error 1000: One or more errors were detected. Please see', &
215 ' setROs.log',/' for specifics.',1x,70('*')/)
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