File: N:\mfix\model\adjust_a_w_g.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: ADJUST_A_W_g(A_m, B_m, IER)                            C
4     !  Purpose: Handle the special case of the center coefficient in       C
5     !  W_g momentum eq. becoming zero.                                     C
6     !                                                                      C
7     !                                                                      C
8     !  Author: M. Syamlal                                 Date:  2-AUG-96  C
9     !  Reviewer:                                          Date:            C
10     !                                                                      C
11     !                                                                      C
12     !  Literature/Document References:                                     C
13     !                                                                      C
14     !  Variables referenced:                                               C
15     !  Variables modified:                                                 C
16     !                                                                      C
17     !  Local variables:                                                    C
18     !                                                                      C
19     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
20     !
21           SUBROUTINE ADJUST_A_W_G(A_M, B_M)
22     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
23     !...Switches: -xf
24     !
25     !  Include param.inc file to specify parameter values
26     !
27     !-----------------------------------------------
28     !   M o d u l e s
29     !-----------------------------------------------
30           USE param
31           USE param1
32           USE parallel
33           USE fldvar
34           USE geometry
35           USE run
36           USE indices
37           USE compar
38           USE sendrecv
39           USE fun_avg
40           USE functions
41     
42           IMPLICIT NONE
43     !-----------------------------------------------
44     !   G l o b a l   P a r a m e t e r s
45     !-----------------------------------------------
46     !-----------------------------------------------
47     !   D u m m y   A r g u m e n t s
48     !-----------------------------------------------
49     !
50     !                      Indices
51           INTEGER          IJK, IJKT, IJKM
52     !
53     !                      Phase index
54           INTEGER          M
55     !
56     !                      Septadiagonal matrix A_m
57           DOUBLE PRECISION A_m(DIMENSION_3, -3:3, 0:DIMENSION_M)
58     !
59     !                      Vector b_m
60           DOUBLE PRECISION B_m(DIMENSION_3, 0:DIMENSION_M)
61     !!-----------------------------------------------
62     
63           M = 0
64           IF (.NOT.MOMENTUM_Z_EQ(0)) RETURN
65     !
66     !!!!$omp$ parallel do private(IJK,IJKT,IJKM)
67           DO IJK = ijkstart3, ijkend3
68              IF (ABS(A_M(IJK,0,M)) < SMALL_NUMBER) THEN
69                 A_M(IJK,east,M) = ZERO
70                 A_M(IJK,west,M) = ZERO
71                 A_M(IJK,north,M) = ZERO
72                 A_M(IJK,south,M) = ZERO
73                 A_M(IJK,top,M) = ZERO
74                 A_M(IJK,bottom,M) = ZERO
75                 A_M(IJK,0,M) = -ONE
76                 IF (B_M(IJK,M) < ZERO) THEN
77                    IJKT = TOP_OF(IJK)
78                    IF (ROP_G(IJKT)*AXY_W(IJK) > SMALL_NUMBER) THEN
79                       B_M(IJK,M) = SQRT((-B_M(IJK,M)/(ROP_G(IJKT)*AVG_Z_T(ONE,ZERO)&
80                          *AXY_W(IJK))))
81                    ELSE
82                       B_M(IJK,M) = ZERO
83                    ENDIF
84                 ELSE IF (B_M(IJK,M) > ZERO) THEN
85                    IJKM = KM_OF(IJK)
86                    IF (ROP_G(IJK)*AXY_W(IJKM) > SMALL_NUMBER) THEN
87                       B_M(IJK,M) = SQRT(B_M(IJK,M)/(ROP_G(IJK)*AVG_Z_T(ZERO,ONE)*&
88                          AXY_W(IJKM)))
89                    ELSE
90                       B_M(IJK,M) = ZERO
91                    ENDIF
92                 ENDIF
93              ENDIF
94           END DO
95           RETURN
96           END SUBROUTINE ADJUST_A_W_G
97     
98     !// Comments on the modifications for DMP version implementation
99     !// 350 Changed do loop limits: 1,ijkmax2-> ijkstart3, ijkend3
100     !// 400 Added sendrecv module for COMMunication
101