File: RELATIVE:/../../../mfix.git/model/physical_prop.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29 SUBROUTINE PHYSICAL_PROP(IER, LEVEL)
30
31 use compar
32 use funits
33 use geometry
34 use indices
35 use mpi_utility
36 use param, only: dimension_m
37 use param1
38 use physprop
39
40 use coeff, only: DENSITY
41 use coeff, only: SP_HEAT
42 use coeff, only: PSIZE
43
44 implicit none
45
46
47
48
49 INTEGER, intent(inout) :: IER
50 INTEGER, intent(in) :: LEVEL
51
52
53
54
55
56
57
58
59 INTEGER :: Err_l(0:numPEs-1)
60 INTEGER :: Err_g(0:numPEs-1)
61
62
63 = 0
64
65
66
67 if(LEVEL == 0) then
68 if(DENSITY(0)) CALL PHYSICAL_PROP_ROg
69 if(any(DENSITY(1:DIMENSION_M))) CALL PHYSICAL_PROP_ROs
70
71
72
73 elseif(LEVEL == 1) then
74 if(SP_HEAT(0)) CALL PHYSICAL_PROP_CPg
75
76 if(any(SP_HEAT(1:DIMENSION_M))) CALL PHYSICAL_PROP_CPs
77 if(any(PSIZE(1:DIMENSION_M))) CALL PHYSICAL_PROP_Dp
78
79
80
81
82
83 elseif(LEVEL == 2) then
84 if(DENSITY(0)) CALL PHYSICAL_PROP_ROg
85 if(SP_HEAT(0)) CALL PHYSICAL_PROP_CPg
86 if(any(DENSITY(1:DIMENSION_M))) CALL PHYSICAL_PROP_ROs
87 if(any(SP_HEAT(1:DIMENSION_M))) CALL PHYSICAL_PROP_CPs
88 if(any(PSIZE(1:DIMENSION_M))) CALL PHYSICAL_PROP_Dp
89 endif
90
91
92
93
94 CALL global_all_sum(Err_l, Err_g)
95 IER = maxval(Err_g)
96 if(IER == 0) return
97
98
99
100
101
102
103 IF(IER == 901 .OR. IER == 902) then
104 if(myPE == PE_IO) then
105 write(*,2000) IER
106 write(UNIT_LOG,2000) IER
107 endif
108 CALL MFIX_EXIT(myPE)
109 ENDIF
110
111 return
112
113 2000 FORMAT(/1X,70('*')/' From: PHYSICAL_PROP',/' Fatal Error 2000:', &
114 ' calc_CpoR reporetd an invalid temperature: 0x0', I3/, &
115 'See Cp.log for details. Calling MFIX_EXIT.',/1X,70('*')/)
116
117 contains
118
119
120
121
122
123
124
125
126
127
128 SUBROUTINE PHYSICAL_PROP_ROg
129
130
131
132
133
134 use fldvar, only: X_g
135
136 use fldvar, only: T_g
137
138 use fldvar, only: RO_g
139
140 use fldvar, only: P_g
141
142 use fldvar, only: EP_g
143
144 use fldvar, only: ROP_g
145
146 use toleranc, only: OMW_MAX
147
148 use run, only: REPORT_NEG_DENSITY
149
150 use eos, only: EOSG
151
152 use run, only: USR_ROg
153
154 use functions
155
156 implicit none
157
158
159
160
161 DOUBLE PRECISION :: MW
162
163 INTEGER :: IJK
164
165 LOGICAL :: wHeader
166
167
168
169 IF(USR_ROg) THEN
170 CALL USR_PHYSICAL_PROP_ROg
171 RETURN
172 ENDIF
173
174
175 = .TRUE.
176
177
178 IF(.NOT.database_read) call read_database0(IER)
179
180 IJK_LP: DO IJK = IJKSTART3, IJKEND3
181 IF(WALL_AT(IJK)) cycle IJK_LP
182 IF (MW_AVG == UNDEFINED) THEN
183
184 = SUM(X_G(IJK,:NMAX(0))/MW_G(:NMAX(0)))
185 MW = ONE/MAX(MW,OMW_MAX)
186 MW_MIX_G(IJK) = MW
187
188 (IJK) = EOSG(MW,P_G(IJK),T_G(IJK))
189 ROP_G(IJK) = RO_G(IJK)*EP_G(IJK)
190 ELSE
191 RO_G(IJK) = EOSG(MW_AVG,P_G(IJK),T_G(IJK))
192 ROP_G(IJK) = RO_G(IJK)*EP_G(IJK)
193 ENDIF
194
195 IF(RO_G(IJK) < ZERO) THEN
196 Err_l(myPE) = 100
197 IF(REPORT_NEG_DENSITY)CALL ROgErr_LOG(IJK, wHeader)
198 ENDIF
199 ENDDO IJK_LP
200
201
202 RETURN
203 END SUBROUTINE PHYSICAL_PROP_ROg
204
205
206
207
208
209
210
211
212
213
214
215 SUBROUTINE PHYSICAL_PROP_ROs
216
217
218
219
220 use fldvar, only: X_s
221
222 use fldvar, only: ROP_s, RO_s
223
224 use physprop, only: BASE_ROs
225
226 use physprop, only: X_S0
227
228 use physprop, only: INERT_SPECIES
229
230 use physprop, only: DIL_INERT_X_VSD
231
232 use physprop, only: DIL_FACTOR_VSD
233
234 use run, only: SOLVE_ROs
235
236 use run, only: REPORT_NEG_DENSITY
237
238 use toleranc, only: DIL_EP_s
239
240 use eos, only: EOSS
241
242 use run, only: USR_ROs
243
244 use functions
245
246 implicit none
247
248
249
250
251 INTEGER :: IJK, M
252
253 INTEGER :: IIS
254
255 LOGICAL :: wHeader
256
257 DOUBLE PRECISION :: minROPs
258
259
260
261 IF(USR_ROs) THEN
262 CALL USR_PHYSICAL_PROP_ROs
263 RETURN
264 ENDIF
265
266 M_LP: DO M=1, MMAX
267 IF(.NOT.SOLVE_ROs(M)) cycle M_LP
268
269 = .TRUE.
270
271 = INERT_SPECIES(M)
272
273 = BASE_ROs(M)*(DIL_FACTOR_VSD*DIL_EP_s)
274
275
276 IJK_LP: DO IJK = IJKSTART3, IJKEND3
277 IF(WALL_AT(IJK)) cycle IJK_LP
278 IF(ROP_s(IJK,M) > minROPs) THEN
279 RO_S(IJK,M) = EOSS(BASE_ROs(M), X_s0(M,IIS), &
280 X_s(IJK,M,IIS))
281 ELSE
282
283 (IJK,M) = EOSS(BASE_ROs(M), X_s0(M,IIS), &
284 DIL_INERT_X_VSD(M))
285 ENDIF
286
287
288 IF(RO_S(IJK,M) <= ZERO) THEN
289 Err_l(myPE) = 101
290 IF(REPORT_NEG_DENSITY) CALL ROsErr_LOG(IJK, M, wHeader)
291 ENDIF
292 ENDDO IJK_LP
293 ENDDO M_LP
294
295
296 RETURN
297 END SUBROUTINE PHYSICAL_PROP_ROs
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312 SUBROUTINE PHYSICAL_PROP_CPg
313
314
315
316
317 use constant, only: RGAS => GAS_CONST_cal
318
319 use toleranc, only: OMW_MAX
320
321 use fldvar, only: X_g
322
323 use fldvar, only: T_g
324
325 use run, only: UNITS
326
327 use read_thermochemical, only: calc_CpoR
328
329 use run, only: USR_CPg
330
331 use functions
332
333 implicit none
334
335
336
337
338 DOUBLE PRECISION :: lCp
339
340 INTEGER :: lCP_Err
341 INTEGER :: gCP_Err
342
343 INTEGER :: IJK, N
344
345
346
347 IF(USR_CPg) THEN
348 CALL USR_PHYSICAL_PROP_CPg
349 RETURN
350 ENDIF
351
352
353
354
355
356 IF(.NOT.database_read) CALL read_database0(IER)
357
358 gCP_Err = 0
359 lCP_Err = 0
360
361 IJK_LP: DO IJK = IJKSTART3, IJKEND3
362 IF(WALL_AT(IJK)) CYCLE IJK_LP
363
364 (IJK) = ZERO
365 DO N = 1, NMAX(0)
366 lCp = calc_CpoR(T_G(IJK), 0, N, lCP_Err)
367 C_PG(IJK) = C_PG(IJK) + X_g(IJK,N) * lCp * RGAS / MW_g(N)
368 gCP_Err = max(gCP_Err, lCP_Err)
369 ENDDO
370 ENDDO IJK_LP
371
372
373
374
375
376
377 IF(UNITS == 'SI') THEN
378 DO IJK = IJKSTART3, IJKEND3
379 C_PG(IJK) = 4.183925d3 * C_PG(IJK)
380 ENDDO
381 ENDIF
382
383
384 IF(gCP_Err /= 0) Err_l(myPE) = 800 + gCP_Err
385
386 RETURN
387 END SUBROUTINE PHYSICAL_PROP_CPg
388
389
390
391
392
393
394
395
396
397
398
399
400
401 SUBROUTINE PHYSICAL_PROP_CPs
402
403
404 use constant, only: RGAS => GAS_CONST_cal
405
406 use run, only: UNITS
407
408 use toleranc, only: OMW_MAX
409
410 use fldvar, only: T_s
411
412 use fldvar, only: X_s
413
414 use read_thermochemical, only: calc_CpoR
415
416 use run, only: USR_CPs
417
418 use functions
419
420 implicit none
421
422
423
424
425 DOUBLE PRECISION :: lCp
426
427 INTEGER :: IJK, M, N
428
429 INTEGER :: lCP_Err
430
431
432
433 IF(USR_CPs) THEN
434 CALL USR_PHYSICAL_PROP_CPs
435 RETURN
436 ENDIF
437
438
439
440 IF(.NOT.database_read) CALL read_database0(IER)
441
442 lCP_Err = 0
443
444 M_LP: DO M=1, MMAX
445 IJK_LP: DO IJK = IJKSTART3, IJKEND3
446 IF(WALL_AT(IJK)) CYCLE IJK_LP
447
448 (IJK, M) = ZERO
449
450 DO N = 1, NMAX(M)
451 lCp = calc_CpoR(T_S(IJK,M), M, N, lCP_Err)
452 C_PS(IJK,M) = C_PS(IJK,M) + X_s(IJK,M,N) * &
453 (lCp * RGAS / MW_s(M,N))
454 ENDDO
455
456 ENDDO IJK_LP
457 ENDDO M_LP
458
459
460
461
462
463
464
465 IF(UNITS == 'SI') THEN
466 DO M=1, MMAX
467 DO IJK = IJKSTART3, IJKEND3
468 C_PS(IJK,M) = 4.183925d3 * C_PS(IJK,M)
469 ENDDO
470 ENDDO
471 ENDIF
472 END SUBROUTINE PHYSICAL_PROP_CPs
473
474
475
476
477
478
479
480
481
482
483 SUBROUTINE PHYSICAL_PROP_Dp
484
485 use run, only: CALL_DQMOM
486
487 use fldvar, only: scalar
488 use scalars, only: phase4scalar
489
490 use fldvar, only: D_p, EP_S
491 use functions
492
493 implicit none
494
495
496 INTEGER :: IJK
497 INTEGER :: M
498
499
500 INTEGER :: lM
501
502 IF(.NOT.CALL_DQMOM) return
503
504 M_LP: DO M=1, MMAX
505
506 lM = phase4scalar(M)
507
508 IF(.NOT.PSIZE(M)) CYCLE M_LP
509 IJK_LP: DO IJK = IJKSTART3, IJKEND3
510 IF(WALL_AT(IJK)) CYCLE IJK_LP
511
512 IF(EP_s(IJK,lM) > small_number) D_p(IJK,M)= Scalar(IJK,lM)
513
514 ENDDO IJK_LP
515 ENDDO M_LP
516
517 return
518 END SUBROUTINE PHYSICAL_PROP_Dp
519
520
521
522
523
524
525
526
527
528
529
530
531
532 SUBROUTINE ROgErr_LOG(IJK, tHeader)
533
534
535 use run, only: TIME
536
537 use fldvar, only: T_g
538
539 use fldvar, only: RO_g
540
541 use fldvar, only: P_g
542 use cutcell
543
544 INTEGER, intent(in) :: IJK
545 LOGICAL, intent(inout) :: tHeader
546
547 LOGICAL :: lExists
548 CHARACTER(LEN=255) :: lFile
549 INTEGER, parameter :: lUnit = 4868
550 LOGICAL, save :: fHeader = .TRUE.
551
552
553 lFile = '';
554 if(numPEs > 1) then
555 write(lFile,"('ROgErr_',I4.4,'.log')") myPE
556 else
557 write(lFile,"('ROgErr.log')")
558 endif
559 inquire(file=trim(lFile),exist=lExists)
560 if(lExists) then
561 open(lUnit,file=trim(adjustl(lFile)), &
562 status='old', position='append', convert='big_endian')
563 else
564 open(lUnit,file=trim(adjustl(lFile)), status='new', convert='big_endian')
565 endif
566
567 if(fHeader) then
568 write(lUnit,1000)
569 fHeader = .FALSE.
570 endif
571
572 if(tHeader) then
573 write(lUnit,"(/2x,'Simulation time: ',g12.5)") TIME
574 tHeader = .FALSE.
575 endif
576
577 write(lUnit,1001) IJK, I_OF(IJK), J_OF(IJK), K_OF(IJK)
578 write(lUnit,"(6x,A,1X,g12.5)",ADVANCE='NO') 'RO_g:', RO_g(IJK)
579 write(lUnit,"(2x,A,1X,g12.5)",ADVANCE='NO') 'P_g:', P_g(IJK)
580 write(lUnit,"(2x,A,1X,g12.5)") 'T_g:', T_g(IJK)
581 if(CARTESIAN_GRID) then
582 write(lUnit,"(6x,A,1X,L1)",ADVANCE='NO') 'Cut Cell:', CUT_CELL_AT(IJK)
583 write(lUnit,"(6x,A,1X,L1)") 'Small Cell:', SMALL_CELL_AT(IJK)
584 write(lUnit,"(6x,'Coordinates (E/N/T): ',1X,3(2x, g17.8))") &
585 xg_e(I_OF(IJK)), yg_n(J_of(ijk)), zg_t(k_of(ijk))
586 endif
587
588 close(lUnit)
589
590 RETURN
591
592 1000 FORMAT(2X,'One or more cells have reported a negative gas', &
593 ' density (RO_g(IJK)). If',/2x,'this is a persistent issue,', &
594 ' lower UR_FAC(1) in mfix.dat.')
595
596 1001 FORMAT(/4X,'IJK: ',I8,7X,'I: ',I4,' J: ',I4,' K: ',I4)
597
598 END SUBROUTINE ROgErr_LOG
599
600
601
602
603
604
605
606
607
608
609
610
611 SUBROUTINE ROsErr_LOG(IJK, M, tHeader)
612
613
614
615
616 use run, only: TIME
617
618 use fldvar, only: X_s
619
620 use fldvar, only: RO_s
621
622 use physprop, only: BASE_ROs
623
624 use physprop, only: X_S0
625
626 use physprop, only: INERT_SPECIES
627
628
629 use cutcell
630
631
632
633
634
635 INTEGER, intent(in) :: IJK, M
636
637 LOGICAL, intent(inout) :: tHeader
638
639 INTEGER :: N
640
641 LOGICAL :: lExists
642 CHARACTER(LEN=255) :: lFile
643 INTEGER, parameter :: lUnit = 4868
644 LOGICAL, save :: fHeader = .TRUE.
645
646
647 lFile = '';
648 if(numPEs > 1) then
649 write(lFile,"('ROsErr_',I4.4,'.log')") myPE
650 else
651 write(lFile,"('ROsErr.log')")
652 endif
653 inquire(file=trim(lFile),exist=lExists)
654 if(lExists) then
655 open(lUnit,file=trim(adjustl(lFile)), &
656 status='old', position='append',convert='big_endian')
657 else
658 open(lUnit,file=trim(adjustl(lFile)), status='new',convert='big_endian')
659 endif
660
661 if(fHeader) then
662 write(lUnit,1000)
663 fHeader = .FALSE.
664 endif
665
666 if(tHeader) then
667 write(lUnit,"(/2x,'Simulation time: ',g12.5,' Phase: ',I2)")&
668 TIME, M
669 tHeader = .FALSE.
670 endif
671
672 N = INERT_SPECIES(M)
673 write(lUnit,1001) IJK, I_OF(IJK), J_OF(IJK), K_OF(IJK)
674 write(lUnit,"(6x,A,1X,g12.5)",advance='no') 'RO_s:', RO_s(IJK,M)
675 write(lUnit,"(2x,A,1X,g12.5)",advance='no') 'Base:', BASE_ROs(M)
676 write(lUnit,"(2x,A,1X,g12.5)",advance='no') 'X_s0:', X_s0(M,N)
677 write(lUnit,"(2x,A,1X,g12.5)") 'X_s:', X_s(IJK,M,N)
678
679 if(CARTESIAN_GRID) then
680 write(lUnit,"(6x,A,1X,L1)",ADVANCE='NO') 'Cut Cell:', CUT_CELL_AT(IJK)
681 write(lUnit,"(6x,A,1X,L1)") 'Small Cell:', SMALL_CELL_AT(IJK)
682 write(lUnit,"(6x,'Coordinates (E/N/T): ',1X,3(2x, g17.8))") &
683 xg_e(I_OF(IJK)), yg_n(J_of(ijk)), zg_t(k_of(ijk))
684 endif
685
686 close(lUnit)
687
688 RETURN
689
690 1000 FORMAT(2X,'One or more cells have reported a negative gas', &
691 ' density (RO_g(IJK)). If',/2x,'this is a persistent issue,', &
692 ' lower UR_FAC(1) in mfix.dat.')
693
694 1001 FORMAT( 4X,'IJK: ',I8,7X,'I: ',I4,' J: ',I4,' K: ',I4)
695
696 END SUBROUTINE ROsErr_LOG
697
698 END SUBROUTINE PHYSICAL_PROP
699