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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Subroutine: ADJUST_A_W_s                                            C
4     !  Purpose: Handle the special case of the center coefficient in       C
5     !           W_s momentum eq. becoming zero.                            C
6     !                                                                      C
7     !  Author: M. Syamlal                                 Date:  2-AUG-96  C
8     !  Reviewer:                                          Date:            C
9     !                                                                      C
10     !  Literature/Document References:                                     C
11     !                                                                      C
12     !                                                                      C
13     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
14     
15           SUBROUTINE ADJUST_A_W_S(A_M, B_M)
16     
17     !-----------------------------------------------
18     ! Modules
19     !-----------------------------------------------
20           USE param
21           USE param1
22           USE parallel
23           USE matrix
24           USE fldvar
25           USE physprop
26           USE geometry
27           USE run
28           USE indices
29           USE compar
30           USE sendrecv
31           USE fun_avg
32           USE functions
33           IMPLICIT NONE
34     !-----------------------------------------------
35     ! Dummy Arguments
36     !-----------------------------------------------
37     ! Septadiagonal matrix A_m
38           DOUBLE PRECISION, INTENT(INOUT) :: A_m(DIMENSION_3, -3:3, 0:DIMENSION_M)
39     ! Vector b_m
40           DOUBLE PRECISION, INTENT(INOUT) :: B_m(DIMENSION_3, 0:DIMENSION_M)
41     !-----------------------------------------------
42     ! Local Variables
43     !-----------------------------------------------
44     ! Indices
45           INTEGER :: IJK, IJKT, IJKM
46     ! Phase index
47           INTEGER :: M
48     !-----------------------------------------------
49     
50           DO M = 1, MMAX
51              IF (DRAG_TYPE_ENUM == GHD_2007 .AND. M /= MMAX) CYCLE
52              IF (MOMENTUM_Z_EQ(M)) THEN
53     
54     !!$omp  parallel do private(IJK,IJKT,IJKM)
55                 DO IJK = ijkstart3, ijkend3
56                    IF (ABS(A_M(IJK,0,M)) < SMALL_NUMBER) THEN
57                       A_M(IJK,E,M) = ZERO
58                       A_M(IJK,W,M) = ZERO
59                       A_M(IJK,N,M) = ZERO
60                       A_M(IJK,S,M) = ZERO
61                       A_M(IJK,T,M) = ZERO
62                       A_M(IJK,B,M) = ZERO
63                       A_M(IJK,0,M) = -ONE
64                       IF (B_M(IJK,M) < ZERO) THEN
65                          IJKT = TOP_OF(IJK)
66                          IF (ROP_S(IJKT,M)*AXY_W(IJK) > SMALL_NUMBER) THEN
67                             B_M(IJK,M) = SQRT((-B_M(IJK,M)/(ROP_S(IJKT,M)*&
68                                AVG_Z_T(ONE,ZERO)*AXY_W(IJK))))
69                          ELSE
70                             B_M(IJK,M) = ZERO
71                          ENDIF
72                       ELSE IF (B_M(IJK,M) > ZERO) THEN
73                          IJKM = KM_OF(IJK)
74                          IF (ROP_S(IJK,M)*AXY_W(IJKM) > SMALL_NUMBER) THEN
75                             B_M(IJK,M) = SQRT(B_M(IJK,M)/(ROP_S(IJK,M)*&
76                                AVG_Z_T(ZERO,ONE)*AXY_W(IJKM)))
77                          ELSE
78                             B_M(IJK,M) = ZERO
79                          ENDIF
80                       ENDIF
81                    ENDIF    ! end if (abs(a_m(ijk,0,m))<small_number)
82                 ENDDO    ! end do loop (ijk=ijkstart3,ijkend3)
83     
84              ENDIF   ! end if (momentum_z_eq(m))
85           ENDDO   ! end do loop (m=1,mmax)
86     
87           RETURN
88           END SUBROUTINE ADJUST_A_W_S
89