File: /nfs/home/0/users/jenkins/mfix.git/model/b_m_p_star.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 SUBROUTINE B_M_P_STAR_E(B_M, IJK)
21
22
23
24
25
26
27
28
29 USE param
30 USE param1
31 USE scales
32 USE constant
33 USE physprop
34 USE fldvar
35 USE run
36 USE rxns
37 USE toleranc
38 USE geometry
39 USE indices
40 USE compar
41 USE bodyforce
42 USE fun_avg
43 USE functions
44 IMPLICIT NONE
45
46
47
48
49
50
51
52
53 INTEGER I, J, K, IJK, IJKE
54
55
56 INTEGER M
57
58
59 DOUBLE PRECISION EPGA
60
61
62 DOUBLE PRECISION ROPGA
63
64
65 DOUBLE PRECISION A
66
67
68 DOUBLE PRECISION B
69
70
71 DOUBLE PRECISION b_m
72
73
74 DOUBLE PRECISION Eps
75
76
77 DOUBLE PRECISION Sdp, Sdps
78
79
80 DOUBLE PRECISION V0, Vmt, Vbf
81
82
83 = I_OF(IJK)
84 J = J_OF(IJK)
85 K = K_OF(IJK)
86 IJKE = EAST_OF(IJK)
87
88 = ZERO
89 B = ZERO
90 EPS = ZERO
91
92 DO M = 1, MMAX
93 IF (CLOSE_PACKED(M)) THEN
94 EPGA = AVG_X(EP_S(IJK,M),EP_S(IJKE,M),I)
95
96
97
98
99 = -P_SCALE*EPGA*(P_G(IJKE)-P_G(IJK))*AYZ(IJK)
100 SDPS = -EPGA*(P_S(IJKE,M)-P_S(IJK,M))*AYZ(IJK)
101
102
103
104
105 = AVG_X(ROP_S(IJK,M),ROP_S(IJKE,M),I)
106
107
108 = AVG_X(ROP_SO(IJK,M),ROP_SO(IJKE,M),I)*ODT
109
110
111 = AVG_X(SUM_R_S(IJK,M),SUM_R_S(IJKE,M),I)
112
113
114 = ROPGA*BFX_S(IJK,M)
115
116
117 = A - ((V0 + ZMAX(VMT))*VOL_U(IJK))
118 B=B-(SDP+SDPS+((V0+ZMAX((-VMT)))*U_SO(IJK,M)+VBF)*VOL_U(IJK))
119 EPS = EPS + EPGA
120 ENDIF
121 END DO
122 B_M = -((B - A)/(EPS*AYZ(IJK))-P_STAR(IJK))
123
124 RETURN
125 END SUBROUTINE B_M_P_STAR_E
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147 SUBROUTINE B_M_P_STAR_N(B_M, IJK)
148
149
150
151
152
153
154
155
156 USE param
157 USE param1
158 USE scales
159 USE constant
160 USE physprop
161 USE fldvar
162 USE run
163 USE rxns
164 USE toleranc
165 USE geometry
166 USE indices
167 USE compar
168 USE bodyforce
169 USE fun_avg
170 USE functions
171 IMPLICIT NONE
172
173
174
175
176
177
178
179
180 INTEGER I, J, K, IJK, IJKN
181
182
183 INTEGER M
184
185
186 DOUBLE PRECISION EPGA
187
188
189 DOUBLE PRECISION ROPGA
190
191
192 DOUBLE PRECISION A
193
194
195 DOUBLE PRECISION B
196
197
198 DOUBLE PRECISION b_m
199
200
201 DOUBLE PRECISION Eps
202
203
204 DOUBLE PRECISION Sdp, Sdps
205
206
207 DOUBLE PRECISION V0, Vmt, Vbf
208
209
210
211 = I_OF(IJK)
212 J = J_OF(IJK)
213 K = K_OF(IJK)
214 IJKN = NORTH_OF(IJK)
215
216 = ZERO
217 B = ZERO
218 EPS = ZERO
219
220 DO M = 1, MMAX
221 IF (CLOSE_PACKED(M)) THEN
222 EPGA = AVG_Y(EP_S(IJK,M),EP_S(IJKN,M),J)
223
224
225
226
227 = -P_SCALE*EPGA*(P_G(IJKN)-P_G(IJK))*AXZ(IJK)
228 SDPS = -EPGA*(P_S(IJKN,M)-P_S(IJK,M))*AXZ(IJK)
229
230
231
232
233 = AVG_Y(ROP_S(IJK,M),ROP_S(IJKN,M),J)
234
235
236 = AVG_Y(ROP_SO(IJK,M),ROP_SO(IJKN,M),J)*ODT
237
238
239 = AVG_Y(SUM_R_S(IJK,M),SUM_R_S(IJKN,M),J)
240
241
242 = ROPGA*BFY_S(IJK,M)
243
244
245 = A - ((V0 + ZMAX(VMT))*VOL_V(IJK))
246 B=B-(SDP+SDPS+((V0+ZMAX((-VMT)))*V_SO(IJK,M)+VBF)*VOL_V(IJK))
247 EPS = EPS + EPGA
248 ENDIF
249 END DO
250 B_M = -((B - A)/(EPS*AXZ(IJK))-P_STAR(IJK))
251
252 RETURN
253 END SUBROUTINE B_M_P_STAR_N
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275 SUBROUTINE B_M_P_STAR_T(B_M, IJK)
276
277
278
279
280
281
282
283
284 USE param
285 USE param1
286 USE scales
287 USE constant
288 USE physprop
289 USE fldvar
290 USE run
291 USE rxns
292 USE toleranc
293 USE geometry
294 USE indices
295 USE compar
296 USE bodyforce
297 USE fun_avg
298 USE functions
299 IMPLICIT NONE
300
301
302
303
304
305
306
307
308 INTEGER I, J, K, IJK, IJKT
309
310
311 INTEGER M
312
313
314 DOUBLE PRECISION EPGA
315
316
317 DOUBLE PRECISION ROPGA
318
319
320 DOUBLE PRECISION A
321
322
323 DOUBLE PRECISION B
324
325
326 DOUBLE PRECISION b_m
327
328
329 DOUBLE PRECISION Eps
330
331
332 DOUBLE PRECISION Sdp, Sdps
333
334
335 DOUBLE PRECISION V0, Vmt, Vbf
336
337
338
339 = I_OF(IJK)
340 J = J_OF(IJK)
341 K = K_OF(IJK)
342 IJKT = TOP_OF(IJK)
343
344 = ZERO
345 B = ZERO
346 EPS = ZERO
347
348 DO M = 1, MMAX
349 IF (CLOSE_PACKED(M)) THEN
350 EPGA = AVG_Z(EP_S(IJK,M),EP_S(IJKT,M),K)
351
352
353
354
355 = -P_SCALE*EPGA*(P_G(IJKT)-P_G(IJK))*AXY(IJK)
356 SDPS = -EPGA*(P_S(IJKT,M)-P_S(IJK,M))*AXY(IJK)
357
358
359
360
361 = AVG_Z(ROP_S(IJK,M),ROP_S(IJKT,M),K)
362
363
364 = AVG_Z(ROP_SO(IJK,M),ROP_SO(IJKT,M),K)*ODT
365
366
367 = AVG_Z(SUM_R_S(IJK,M),SUM_R_S(IJKT,M),K)
368
369
370 = ROPGA*BFZ_S(IJK,M)
371
372
373 = A - ((V0 + ZMAX(VMT))*VOL_W(IJK))
374 B=B-(SDP+SDPS+((V0+ZMAX((-VMT)))*W_SO(IJK,M)+VBF)*VOL_W(IJK))
375 EPS = EPS + EPGA
376 ENDIF
377 END DO
378 B_M = -((B - A)/(EPS*AXY(IJK))-P_STAR(IJK))
379
380 RETURN
381 END SUBROUTINE B_M_P_STAR_T
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402 SUBROUTINE B_M_P_STAR_W(B_M, IJK)
403
404
405
406
407
408
409
410
411 USE param
412 USE param1
413 USE scales
414 USE constant
415 USE physprop
416 USE fldvar
417 USE run
418 USE rxns
419 USE toleranc
420 USE geometry
421 USE indices
422 USE compar
423 USE bodyforce
424 USE fun_avg
425 USE functions
426 IMPLICIT NONE
427
428
429
430
431
432
433
434
435 INTEGER IM, J, K, IJK, IJKW, IMJK
436
437
438 INTEGER M
439
440
441 DOUBLE PRECISION EPGA
442
443
444 DOUBLE PRECISION ROPGA
445
446
447 DOUBLE PRECISION A
448
449
450 DOUBLE PRECISION B
451
452
453 DOUBLE PRECISION b_m
454
455
456 DOUBLE PRECISION Eps
457
458
459 DOUBLE PRECISION Sdp, Sdps
460
461
462 DOUBLE PRECISION V0, Vmt, Vbf
463
464
465
466 = IM1(I_OF(IJK))
467 J = J_OF(IJK)
468 K = K_OF(IJK)
469 IJKW = WEST_OF(IJK)
470 IMJK = IM_OF(IJK)
471
472 = ZERO
473 B = ZERO
474 EPS = ZERO
475
476 DO M = 1, MMAX
477 IF (CLOSE_PACKED(M)) THEN
478 EPGA = AVG_X(EP_S(IJKW,M),EP_S(IJK,M),IM)
479
480
481
482
483 = -P_SCALE*EPGA*(P_G(IJK)-P_G(IJKW))*AYZ(IMJK)
484 SDPS = -EPGA*(P_S(IJK,M)-P_S(IJKW,M))*AYZ(IMJK)
485
486
487
488
489 = AVG_X(ROP_S(IJKW,M),ROP_S(IJK,M),IM)
490
491
492 = AVG_X(ROP_SO(IJKW,M),ROP_SO(IJK,M),IM)*ODT
493
494
495 = AVG_X(SUM_R_S(IJKW,M),SUM_R_S(IJK,M),IM)
496
497
498 = ROPGA*BFX_S(IJKW,M)
499
500
501 = A - ((V0 + ZMAX(VMT))*VOL_U(IJKW))
502 B=B-(SDP+SDPS+((V0+ZMAX((-VMT)))*U_SO(IMJK,M)+VBF)*VOL_U(IJKW))
503 EPS = EPS + EPGA
504 ENDIF
505 END DO
506 B_M = -(((-(B - A)/(EPS*AYZ(IMJK))))-P_STAR(IJK))
507
508 RETURN
509 END SUBROUTINE B_M_P_STAR_W
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530 SUBROUTINE B_M_P_STAR_S(B_M, IJK)
531
532
533
534
535
536
537
538
539 USE param
540 USE param1
541 USE scales
542 USE constant
543 USE physprop
544 USE fldvar
545 USE run
546 USE rxns
547 USE toleranc
548 USE geometry
549 USE indices
550 USE compar
551 USE bodyforce
552 USE fun_avg
553 USE functions
554 IMPLICIT NONE
555
556
557
558
559
560
561
562
563
564 INTEGER I, JM, K, IJK, IJKS, IJMK
565
566
567 INTEGER M
568
569
570 DOUBLE PRECISION EPGA
571
572
573 DOUBLE PRECISION ROPGA
574
575
576 DOUBLE PRECISION A
577
578
579 DOUBLE PRECISION B
580
581
582 DOUBLE PRECISION b_m
583
584
585 DOUBLE PRECISION Eps
586
587
588 DOUBLE PRECISION Sdp, Sdps
589
590
591 DOUBLE PRECISION V0, Vmt, Vbf
592
593
594 = I_OF(IJK)
595 JM = JM1(J_OF(IJK))
596 K = K_OF(IJK)
597 IJKS = SOUTH_OF(IJK)
598 IJMK = JM_OF(IJK)
599
600 = ZERO
601 B = ZERO
602 EPS = ZERO
603
604 DO M = 1, MMAX
605 IF (CLOSE_PACKED(M)) THEN
606 EPGA = AVG_Y(EP_S(IJKS,M),EP_S(IJK,M),JM)
607
608
609
610
611 = -P_SCALE*EPGA*(P_G(IJK)-P_G(IJKS))*AXZ(IJK)
612 SDPS = -EPGA*(P_S(IJK,M)-P_S(IJKS,M))*AXZ(IJK)
613
614
615
616
617 = AVG_Y(ROP_S(IJKS,M),ROP_S(IJK,M),JM)
618
619
620 = AVG_Y(ROP_SO(IJKS,M),ROP_SO(IJK,M),JM)*ODT
621
622
623 = AVG_Y(SUM_R_S(IJKS,M),SUM_R_S(IJK,M),JM)
624
625
626 = ROPGA*BFY_S(IJKS,M)
627
628
629 = A - ((V0 + ZMAX(VMT))*VOL_V(IJKS))
630 B=B-(SDP+SDPS+((V0+ZMAX((-VMT)))*V_SO(IJMK,M)+VBF)*VOL_V(IJKS))
631 EPS = EPS + EPGA
632 ENDIF
633 END DO
634 B_M = -(((-(B - A)/(EPS*AXZ(IJK))))-P_STAR(IJK))
635
636 RETURN
637 END SUBROUTINE B_M_P_STAR_S
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658 SUBROUTINE B_M_P_STAR_B(B_M, IJK)
659
660
661
662
663
664
665
666
667 USE param
668 USE param1
669 USE scales
670 USE constant
671 USE physprop
672 USE fldvar
673 USE run
674 USE rxns
675 USE toleranc
676 USE geometry
677 USE indices
678 USE compar
679 USE bodyforce
680 USE fun_avg
681 USE functions
682 IMPLICIT NONE
683
684
685
686
687
688
689
690
691 INTEGER I, J, KM, IJK, IJKB, IJKM
692
693
694 INTEGER M
695
696
697 DOUBLE PRECISION EPGA
698
699
700 DOUBLE PRECISION ROPGA
701
702
703 DOUBLE PRECISION A
704
705
706 DOUBLE PRECISION B
707
708
709 DOUBLE PRECISION b_m
710
711
712 DOUBLE PRECISION Eps
713
714
715 DOUBLE PRECISION Sdp, Sdps
716
717
718 DOUBLE PRECISION V0, Vmt, Vbf
719
720
721 = I_OF(IJK)
722 J = J_OF(IJK)
723 KM = KM1(K_OF(IJK))
724 IJKB = BOTTOM_OF(IJK)
725 IJKM = KM_OF(IJK)
726
727 = ZERO
728 B = ZERO
729 EPS = ZERO
730
731 DO M = 1, MMAX
732 IF (CLOSE_PACKED(M)) THEN
733 EPGA = AVG_Z(EP_S(IJKB,M),EP_S(IJK,M),KM)
734
735
736
737
738 = -P_SCALE*EPGA*(P_G(IJK)-P_G(IJKB))*AXY(IJK)
739 SDPS = -EPGA*(P_S(IJK,M)-P_S(IJKB,M))*AXY(IJK)
740
741
742
743
744 = AVG_Z(ROP_S(IJKB,M),ROP_S(IJK,M),KM)
745
746
747 = AVG_Z(ROP_SO(IJKB,M),ROP_SO(IJK,M),KM)*ODT
748
749
750 = AVG_Z(SUM_R_S(IJKB,M),SUM_R_S(IJK,M),KM)
751
752
753 = ROPGA*BFZ_S(IJKB,M)
754
755
756 = A - ((V0 + ZMAX(VMT))*VOL_W(IJKB))
757 B=B-(SDP+SDPS+((V0+ZMAX((-VMT)))*W_SO(IJKM,M)+VBF)*VOL_W(IJKB))
758 EPS = EPS + EPGA
759 ENDIF
760 END DO
761 B_M = -(((-(B - A)/(EPS*AXY(IJK))))-P_STAR(IJK))
762
763 RETURN
764 END SUBROUTINE B_M_P_STAR_B
765
766