adjust_a_u_g.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Module name: ADJUST_A_U_g(A_m, B_m, IER)                            C
!  Purpose: Handle the special case of the center coefficient in       C
!  U_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_u_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 usr       !just to ensure that this module gets compiled early on
      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          I, IP, IJK, IJKE, IMJK
!
!                      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_x_eq(0)) RETURN
!
!!!!$omp parallel do private(I,IP,IJK,IJKE,IMJK)
      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
               ijke = east_of(ijk)
               ip = ip1(i_of(ijk))
               IF (rop_g(ijke)*ayz_u(ijk) > small_number) THEN
                  b_m(ijk,m) = sqrt((-b_m(ijk,m)/(rop_g(ijke)*avg_x_e(one,zero,&
                     ip)*ayz_u(ijk))))
               ELSE
                  b_m(ijk,m) = zero
               ENDIF
            ELSE IF (b_m(ijk,m) > zero) THEN
               i = i_of(ijk)
               imjk = im_of(ijk)
               IF (rop_g(ijk)*ayz_u(imjk) > small_number) THEN
                  b_m(ijk,m) = sqrt(b_m(ijk,m)/(rop_g(ijk)*avg_x_e(zero,one,i)*&
                     ayz_u(imjk)))
               ELSE
                  b_m(ijk,m) = zero
               ENDIF
            ENDIF
         ENDIF
      END DO

      RETURN
      END SUBROUTINE adjust_a_u_g

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