File: /nfs/home/0/users/jenkins/mfix.git/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 matrix
34           USE fldvar
35           USE geometry
36           USE run
37           USE indices
38           USE compar
39           USE sendrecv
40           USE fun_avg
41           USE functions
42     
43           IMPLICIT NONE
44     !-----------------------------------------------
45     !   G l o b a l   P a r a m e t e r s
46     !-----------------------------------------------
47     !-----------------------------------------------
48     !   D u m m y   A r g u m e n t s
49     !-----------------------------------------------
50     !
51     !                      Indices
52           INTEGER          IJK, IJKT, IJKM
53     !
54     !                      Phase index
55           INTEGER          M
56     !
57     !                      Septadiagonal matrix A_m
58           DOUBLE PRECISION A_m(DIMENSION_3, -3:3, 0:DIMENSION_M)
59     !
60     !                      Vector b_m
61           DOUBLE PRECISION B_m(DIMENSION_3, 0:DIMENSION_M)
62     !!-----------------------------------------------
63     
64           M = 0
65           IF (.NOT.MOMENTUM_Z_EQ(0)) RETURN
66     !
67     !!!!$omp$ parallel do private(IJK,IJKT,IJKM)
68           DO IJK = ijkstart3, ijkend3
69              IF (ABS(A_M(IJK,0,M)) < SMALL_NUMBER) THEN
70                 A_M(IJK,E,M) = ZERO
71                 A_M(IJK,W,M) = ZERO
72                 A_M(IJK,N,M) = ZERO
73                 A_M(IJK,S,M) = ZERO
74                 A_M(IJK,T,M) = ZERO
75                 A_M(IJK,B,M) = ZERO
76                 A_M(IJK,0,M) = -ONE
77                 IF (B_M(IJK,M) < ZERO) THEN
78                    IJKT = TOP_OF(IJK)
79                    IF (ROP_G(IJKT)*AXY_W(IJK) > SMALL_NUMBER) THEN
80                       B_M(IJK,M) = SQRT((-B_M(IJK,M)/(ROP_G(IJKT)*AVG_Z_T(ONE,ZERO)&
81                          *AXY_W(IJK))))
82                    ELSE
83                       B_M(IJK,M) = ZERO
84                    ENDIF
85                 ELSE IF (B_M(IJK,M) > ZERO) THEN
86                    IJKM = KM_OF(IJK)
87                    IF (ROP_G(IJK)*AXY_W(IJKM) > SMALL_NUMBER) THEN
88                       B_M(IJK,M) = SQRT(B_M(IJK,M)/(ROP_G(IJK)*AVG_Z_T(ZERO,ONE)*&
89                          AXY_W(IJKM)))
90                    ELSE
91                       B_M(IJK,M) = ZERO
92                    ENDIF
93                 ENDIF
94              ENDIF
95           END DO
96           RETURN
97           END SUBROUTINE ADJUST_A_W_G
98     
99     !// Comments on the modifications for DMP version implementation
100     !// 350 Changed do loop limits: 1,ijkmax2-> ijkstart3, ijkend3
101     !// 400 Added sendrecv module for COMMunication
102