File: RELATIVE:/../../../mfix.git/model/read_database.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 SUBROUTINE READ_DATABASE(lM, lN, lName, lMW)
21
22 USE param
23 USE param1
24 USE physprop
25 USE constant
26 USE compar
27 USE rxns
28 USE funits
29 USE discretelement
30 USE des_rxns
31 USE read_thermochemical, only: read_therm, calc_ICpoR, THERM
32 use run, only: REINITIALIZING
33 use error_manager
34
35 IMPLICIT NONE
36
37
38 INTEGER, INTENT(IN) :: lM, lN
39
40 CHARACTER(len=*), INTENT(IN) :: lName
41
42 DOUBLE PRECISION, INTENT(INOUT) :: lMW
43
44
45 DOUBLE PRECISION dbMW
46
47
48 INTEGER IER
49
50 INTEGER FUNIT
51
52 INTEGER FILE
53
54 INTEGER IOS
55
56
57 LOGICAL ErrorFlag
58
59
60
61
62 DOUBLE PRECISION :: xTc
63
64
65 DOUBLE PRECISION :: ICpoR_TrL
66 DOUBLE PRECISION :: ICpoR_TcL
67 DOUBLE PRECISION :: ICpoR_TcH
68
69 LOGICAL :: testCp = .FALSE.
70
71 CHARACTER(len=256) :: DB
72
73 #ifdef BURCAT_THR
74 THERM = BURCAT_THR
75 #endif
76
77 CALL INIT_ERR_MSG('READ_DATABASE')
78
79
80 = UNIT_DAT
81
82
83 = 0
84 DB_LP: DO
85 FILE = FILE + 1
86
87 IF(FILE == 1) THEN
88 OPEN(CONVERT='BIG_ENDIAN',UNIT=FUNIT, FILE='mfix.dat', STATUS='OLD', IOSTAT= IOS)
89 IF(IOS /= 0) CYCLE DB_LP
90 DB=''; WRITE(DB,1000) 'mfix.dat'
91
92
93 ELSEIF(FILE == 2) THEN
94 OPEN(CONVERT='BIG_ENDIAN',UNIT=FUNIT,FILE=TRIM(THERM), STATUS='OLD', IOSTAT= IOS)
95 IF(IOS /= 0) CYCLE DB_LP
96 DB=''; WRITE(DB,1000) TRIM(THERM)
97 ELSE
98 EXIT DB_LP
99 ENDIF
100
101 REWIND(UNIT=funit)
102
103
104 = 0
105
106 CALL READ_THERM(FUNIT, lName, Thigh(lM,lN), Tlow(lM,lN), &
107 Tcom(lM,lN), dbMW, Ahigh(:,lM,lN), Alow(:,lM,lN), &
108 HfrefoR(lM,lN), IER)
109
110 IF(IER == 0) THEN
111
112
113 IF(lMW == UNDEFINED) lMW = dbMW
114
115
116
117 IF(ABS(Tlow(lM,lN)-T_ref)<=2.0D0 .AND. &
118 Tlow(lM,lN) > T_ref) Tlow(lM,lN) = T_ref
119
120
121 (lM,lN) = ZERO
122 ICpoR_h(lM,lN) = ZERO
123
124
125
126 = calc_ICpoR(T_ref, lM, lN, IER)
127
128
129 = Tcom(lM,lN)-SMALL_NUMBER
130 ICpoR_TcL = calc_ICpoR(xTc, lM, lN, IER)
131
132
133 = Tcom(lM,lN)+SMALL_NUMBER
134 ICpoR_TcH = calc_ICpoR(xTc, lM, lN, IER)
135
136 (lM,lN) = ICpoR_TrL
137 ICpoR_h(lM,lN) = ICpoR_TcH - (ICpoR_TcL - ICpoR_TrL)
138 ENDIF
139
140 ErrorFlag = .TRUE.
141 IF(IER == 0) THEN
142 IF(.NOT.REINITIALIZING)THEN
143 WRITE(ERR_MSG,1001) trim(adjustl(DB)), 'Found!'
144 CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
145 ENDIF
146 if(testCP) CALL writeCp(lM, lN, lName, lMW)
147 ErrorFlag = .FALSE.
148 EXIT DB_LP
149 ELSEIF(.NOT.REINITIALIZING) THEN
150 WRITE(ERR_MSG,1001) trim(adjustl(DB)), 'Not found.'
151 CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
152 ENDIF
153
154 ENDDO DB_LP
155
156
157
158
159 IF(ErrorFlag) THEN
160 CALL FLUSH_ERR_MSG(HEADER=.FALSE.)
161 WRITE(ERR_MSG,1010) trim(lName), trim(THERM)
162 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
163 ENDIF
164
165 CALL FINL_ERR_MSG
166
167 RETURN
168
169
170
171
172 FORMAT('Checking ',A)
173 1001 FORMAT(8X,A,1X,' :: ',A)
174
175
176
177 FORMAT('Message 1010: Species "',A,'" was not matched to any ', &
178 'entry in the',/'thermochemical databases.',2/,'SUGGESTION: ',&
179 'Search the database for the exact species name. The ',/ &
180 'species names are case sensitive and should match the names',&
181 ' in',/'BURCAT.THR exactly excluding trailing blanks and ', &
182 'tabs. Also verify',/'that the data section in the mfix.dat ',&
183 'file (if any) is below a line',/'that starts with THERMO ', &
184 'DATA.',2/'Database location:', /A)
185
186 END SUBROUTINE READ_DATABASE
187
188
189
190
191
192
193
194
195
196 SUBROUTINE READ_DATABASE0()
197
198 USE param
199 USE param1
200 USE physprop
201 USE constant
202 USE compar
203 USE rxns
204 USE funits
205 USE discretelement
206 USE des_rxns
207
208 IMPLICIT NONE
209
210
211 INTEGER M, N
212
213 INTEGER Nsp, DES_Nsp
214
215
216 IF(database_read)RETURN
217
218
219 = .TRUE.
220
221
222 = 0
223 DES_Nsp = 0
224
225
226
227 DO N = 1, NMAX(0)
228 Nsp = Nsp + 1
229
230 IF(SPECIES_NAME(Nsp) == UNDEFINED_C) THEN
231 WRITE(*,1010) N
232 IF(DMP_LOG) WRITE(UNIT_LOG,1010) N
233 CALL MFIX_EXIT(mypE)
234 ENDIF
235
236 CALL READ_DATABASE(0, N, SPECIES_NAME(Nsp), MW_g(N))
237 ENDDO
238
239
240
241
242
243 IF(.NOT.DISCRETE_ELEMENT .OR. DES_CONTINUUM_HYBRID)THEN
244 DO M = 1, MMAX
245 DO N = 1, NMAX(M)
246 Nsp = Nsp + 1
247
248 IF(SPECIES_NAME(Nsp) == UNDEFINED_C)THEN
249 WRITE(*,1011)'continuum', M, N
250 IF(DMP_LOG) WRITE(UNIT_LOG,1011)'continuum', M, N
251 CALL MFIX_EXIT(mypE)
252 ENDIF
253 CALL READ_DATABASE(M, N, SPECIES_NAME(Nsp), MW_s(M,N))
254 ENDDO
255 ENDDO
256 ENDIF
257
258 RETURN
259
260
261
262 FORMAT(/1X,70('*')/, ' From: READ_DATABASE0',/, ' Message: ', &
263 'No SPECIES_NAME provided for gas phase species ',I3,'.',/' ',&
264 'Check mfix.dat.',/1X,70('*')/)
265 1011 FORMAT(/1X,70('*')/, ' From: READ_DATABASE0',/, ' Message: ', &
266 'No SPECIES_NAME provided for ',A,' solids phase ',I2,', ',/ &
267 ' species ',I3,'.',/' Check mfix.dat.',/1X,70('*')/)
268
269 END SUBROUTINE READ_DATABASE0
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291 SUBROUTINE writeCp(lM, lN, lName, lMW)
292
293 use param1
294 USE physprop
295 USE compar
296 USE read_thermochemical, only: calc_CpoR, calc_ICpoR, calc_ICpoR0
297
298
299 use constant, only: RGAS => GAS_CONST_cal
300
301 IMPLICIT NONE
302
303
304 INTEGER, INTENT(IN) :: lM, lN
305
306 CHARACTER(len=*), INTENT(IN) :: lName
307
308 DOUBLE PRECISION, INTENT(in) :: lMW
309
310 INTEGER :: IER1, IER2, lc
311
312 DOUBLE PRECISION :: T
313 DOUBLE PRECISION :: lCP, lICP
314
315 write(*,"(2/,3x,'Specific Heat report for ',A)")trim(lName)
316
317 write(*,"(/12x,'Low',9x,'High')")
318 write(*,"(6x,'T',3x,g12.5,2x,g12.5)") Tlow(lM,lN), Thigh(lM,lN)
319 DO lc=1,5
320 write(*,"(4x,'A(',I1,')',2(2x,g12.5))") lc, &
321 Alow(lc,lM,lN), Ahigh(lc,lM,lN)
322 ENDDO
323 write(*,"('')")
324 write(*,"(5x,'Tcom: ',g12.5)")Tcom(lM,lN)
325 write(*,"('')")
326
327 write(*,"(5x,'Temperature',8x,'Cp',11x,'ICp')")
328
329 T = Tcom(lM,lN) - 100.0
330 DO WHILE(T <= Tcom(lM,lN) - SMALL_NUMBER)
331
332 IER1 = 0
333 IER2 = 0
334
335 write(*,"(7x,g12.5)",ADVANCE="NO") T
336 lCP = calc_CpoR(T, lM, lN, IER1) * RGAS / lMW
337 lICP = calc_ICpoR(T, lM, lN, IER2) * RGAS / lMW
338 write(*,"(2(3x,g12.5))",ADVANCE="NO")lCP, lICP
339
340 IF(IER1 /= 0) write(*,"(3x,'Cp Error!')",ADVANCE="NO")
341 IF(IER2 /= 0) write(*,"(3x,'ICp Error!')",ADVANCE="NO")
342 write(*,"('')")
343
344 T = T + 5.0
345 ENDDO
346
347
348 T = Tcom(lM,lN) + SMALL_NUMBER
349 DO WHILE(T <= Tcom(lM,lN) + 100.0)
350
351 IER1 = 0
352 IER2 = 0
353
354 write(*,"(7x,g12.5)",ADVANCE="NO") T
355 lCP = calc_CpoR(T, lM, lN, IER1) * RGAS / lMW
356 lICP = calc_ICpoR(T, lM, lN, IER2) * RGAS / lMW
357 write(*,"(2(3x,g12.5))",ADVANCE="NO")lCP, lICP
358
359 IF(IER1 /= 0) write(*,"(3x,'Cp Error!')",ADVANCE="NO")
360 IF(IER2 /= 0) write(*,"(3x,'ICp Error!')",ADVANCE="NO")
361 write(*,"('')")
362
363 T = T + 5.0
364 ENDDO
365
366 write(*,"('')")
367 END SUBROUTINE writeCp
368