File: N:\mfix\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 fldvar
24           USE physprop
25           USE geometry
26           USE run
27           USE indices
28           USE compar
29           USE sendrecv
30           USE fun_avg
31           USE functions
32           IMPLICIT NONE
33     !-----------------------------------------------
34     ! Dummy Arguments
35     !-----------------------------------------------
36     ! Septadiagonal matrix A_m
37           DOUBLE PRECISION, INTENT(INOUT) :: A_m(DIMENSION_3, -3:3, 0:DIMENSION_M)
38     ! Vector b_m
39           DOUBLE PRECISION, INTENT(INOUT) :: B_m(DIMENSION_3, 0:DIMENSION_M)
40     !-----------------------------------------------
41     ! Local Variables
42     !-----------------------------------------------
43     ! Indices
44           INTEGER :: IJK, IJKT, IJKM
45     ! Phase index
46           INTEGER :: M
47     !-----------------------------------------------
48     
49           DO M = 1, MMAX
50              IF (DRAG_TYPE_ENUM == GHD_2007 .AND. M /= MMAX) CYCLE
51              IF (MOMENTUM_Z_EQ(M)) THEN
52     
53     !!$omp  parallel do private(IJK,IJKT,IJKM)
54                 DO IJK = ijkstart3, ijkend3
55                    IF (ABS(A_M(IJK,0,M)) < SMALL_NUMBER) THEN
56                       A_M(IJK,east,M) = ZERO
57                       A_M(IJK,west,M) = ZERO
58                       A_M(IJK,north,M) = ZERO
59                       A_M(IJK,south,M) = ZERO
60                       A_M(IJK,top,M) = ZERO
61                       A_M(IJK,bottom,M) = ZERO
62                       A_M(IJK,0,M) = -ONE
63                       IF (B_M(IJK,M) < ZERO) THEN
64                          IJKT = TOP_OF(IJK)
65                          IF (ROP_S(IJKT,M)*AXY_W(IJK) > SMALL_NUMBER) THEN
66                             B_M(IJK,M) = SQRT((-B_M(IJK,M)/(ROP_S(IJKT,M)*&
67                                AVG_Z_T(ONE,ZERO)*AXY_W(IJK))))
68                          ELSE
69                             B_M(IJK,M) = ZERO
70                          ENDIF
71                       ELSE IF (B_M(IJK,M) > ZERO) THEN
72                          IJKM = KM_OF(IJK)
73                          IF (ROP_S(IJK,M)*AXY_W(IJKM) > SMALL_NUMBER) THEN
74                             B_M(IJK,M) = SQRT(B_M(IJK,M)/(ROP_S(IJK,M)*&
75                                AVG_Z_T(ZERO,ONE)*AXY_W(IJKM)))
76                          ELSE
77                             B_M(IJK,M) = ZERO
78                          ENDIF
79                       ENDIF
80                    ENDIF    ! end if (abs(a_m(ijk,0,m))<small_number)
81                 ENDDO    ! end do loop (ijk=ijkstart3,ijkend3)
82     
83              ENDIF   ! end if (momentum_z_eq(m))
84           ENDDO   ! end do loop (m=1,mmax)
85     
86           RETURN
87           END SUBROUTINE ADJUST_A_W_S
88