File: RELATIVE:/../../../mfix.git/model/adjust_a_u_g.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: ADJUST_A_U_g(A_m, B_m, IER)                            C
4     !  Purpose: Handle the special case of the center coefficient in       C
5     !  U_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_U_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 usr       !just to ensure that this module gets compiled early on
39           USE compar
40           USE sendrecv
41           USE fun_avg
42           USE functions
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          I, IP, IJK, IJKE, IMJK
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_X_EQ(0)) RETURN
66     !
67     !!!!$omp parallel do private(I,IP,IJK,IJKE,IMJK)
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                    IJKE = EAST_OF(IJK)
79                    IP = IP1(I_OF(IJK))
80                    IF (ROP_G(IJKE)*AYZ_U(IJK) > SMALL_NUMBER) THEN
81                       B_M(IJK,M) = SQRT((-B_M(IJK,M)/(ROP_G(IJKE)*AVG_X_E(ONE,ZERO,&
82                          IP)*AYZ_U(IJK))))
83                    ELSE
84                       B_M(IJK,M) = ZERO
85                    ENDIF
86                 ELSE IF (B_M(IJK,M) > ZERO) THEN
87                    I = I_OF(IJK)
88                    IMJK = IM_OF(IJK)
89                    IF (ROP_G(IJK)*AYZ_U(IMJK) > SMALL_NUMBER) THEN
90                       B_M(IJK,M) = SQRT(B_M(IJK,M)/(ROP_G(IJK)*AVG_X_E(ZERO,ONE,I)*&
91                          AYZ_U(IMJK)))
92                    ELSE
93                       B_M(IJK,M) = ZERO
94                    ENDIF
95                 ENDIF
96              ENDIF
97           END DO
98     
99           RETURN
100           END SUBROUTINE ADJUST_A_U_G
101     
102     !// Comments on the modifications for DMP version implementation
103     !// 350 Changed do loop limits: 1,ijkmax2-> ijkstart3, ijkend3
104     !// 400 Added sendrecv module for COMMunication
105