adjust_a_w_g.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Module name: ADJUST_A_W_g(A_m, B_m, IER)                            C
!  Purpose: Handle the special case of the center coefficient in       C
!  W_g momentum eq. becoming zero.                                     C
!                                                                      C
!                                                                      C
!  Author: M. Syamlal                                 Date:  2-AUG-96  C
!  Reviewer:                                          Date:            C
!                                                                      C
!                                                                      C
!  Literature/Document References:                                     C
!                                                                      C
!  Variables referenced:                                               C
!  Variables modified:                                                 C
!                                                                      C
!  Local variables:                                                    C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
!
      SUBROUTINE adjust_a_w_g(A_M, B_M)
!...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
!...Switches: -xf
!
!  Include param.inc file to specify parameter values
!
!-----------------------------------------------
!   M o d u l e s
!-----------------------------------------------
      USE param
      USE param1
      USE parallel
      USE fldvar
      USE geometry
      USE run
      USE indices
      USE compar
      USE sendrecv
      USE fun_avg
      USE functions

      IMPLICIT NONE
!-----------------------------------------------
!   G l o b a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   D u m m y   A r g u m e n t s
!-----------------------------------------------
!
!                      Indices
      INTEGER          IJK, IJKT, IJKM
!
!                      Phase index
      INTEGER          M
!
!                      Septadiagonal matrix A_m
      DOUBLE PRECISION A_m(dimension_3, -3:3, 0:dimension_m)
!
!                      Vector b_m
      DOUBLE PRECISION B_m(dimension_3, 0:dimension_m)
!!-----------------------------------------------

      m = 0
      IF (.NOT.momentum_z_eq(0)) RETURN
!
!!!!$omp$ parallel do private(IJK,IJKT,IJKM)
      DO ijk = ijkstart3, ijkend3
         IF (abs(a_m(ijk,0,m)) < small_number) THEN
            a_m(ijk,east,m) = zero
            a_m(ijk,west,m) = zero
            a_m(ijk,north,m) = zero
            a_m(ijk,south,m) = zero
            a_m(ijk,top,m) = zero
            a_m(ijk,bottom,m) = zero
            a_m(ijk,0,m) = -one
            IF (b_m(ijk,m) < zero) THEN
               ijkt = top_of(ijk)
               IF (rop_g(ijkt)*axy_w(ijk) > small_number) THEN
                  b_m(ijk,m) = sqrt((-b_m(ijk,m)/(rop_g(ijkt)*avg_z_t(one,zero)&
                     *axy_w(ijk))))
               ELSE
                  b_m(ijk,m) = zero
               ENDIF
            ELSE IF (b_m(ijk,m) > zero) THEN
               ijkm = km_of(ijk)
               IF (rop_g(ijk)*axy_w(ijkm) > small_number) THEN
                  b_m(ijk,m) = sqrt(b_m(ijk,m)/(rop_g(ijk)*avg_z_t(zero,one)*&
                     axy_w(ijkm)))
               ELSE
                  b_m(ijk,m) = zero
               ENDIF
            ENDIF
         ENDIF
      END DO
      RETURN
      END SUBROUTINE adjust_a_w_g

!// Comments on the modifications for DMP version implementation
!// 350 Changed do loop limits: 1,ijkmax2-> ijkstart3, ijkend3
!// 400 Added sendrecv module for COMMunication