adjust_eps_ghd.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Module name: ADJUST_EPS_GHD                                         C
!  Purpose: Eliminate the solids phases that occupy only very small    C
!           fractions of the computational cell volume for GHD theory  C
!                                                                      C
!  Author: M. Syamlal                                 Date: 28-JAN-92  C
!  Reviewer: P. Nicoletti, W. Rogers, S. Venkatesan   Date: 29-JAN-92  C
!                                                                      C
!  Revision Number: 1                                                  C
!  Purpose: Include CONSTANTS.INC                                      C
!  Author: M. Syamlal                                 Date: 7-FEB-92   C
!  Reviewer: P. Nicoletti                             Date: 11-DEC-92  C
!                                                                      C
!  Literature/Document References: None                                C
!                                                                      C
!  Variables referenced: FLAG, RO_s, ROP_s, U_s, V_s, W_s, EP_g        C
!                        IMAX1, JMAX1, KMAX1, MMAX, IMIN1, JMIN1, KMIN1C
!  Variables modified: ROP_s, U_s, V_s, W_s, EP_g, ROP_g, I, J, K, IJK,C
!                      RO_s                                            C
!                                                                      C
!  Local variables: EPSUM                                              C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
!
      SUBROUTINE adjust_eps_ghd
!...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
!...Switches: -xf
!
!-----------------------------------------------
!   M o d u l e s
!-----------------------------------------------
      USE param
      USE param1
      USE toleranc
      USE constant
      USE fldvar
      USE geometry
      USE indices
      USE physprop
      USE run
      USE compar
      USE sendrecv
      USE ghdtheory
      USE fun_avg
      USE functions
      IMPLICIT NONE
!-----------------------------------------------
!   G l o b a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   L o c a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   L o c a l   V a r i a b l e s
!-----------------------------------------------
!
!                      Indices
      INTEGER          I, J, K, IJK, IJKE, IJKN, IJKT
!
!                      Solids phase
      INTEGER          M
!                      Sum of (very small) solids volume fractions that
!                      are set to zero.
      DOUBLE PRECISION epsMixE, epsMixN, epsMixT, epSolid, epSolidE(smax), epSolidN(smax), epSolidT(smax)
      LOGICAL          DiluteCellE, DiluteCellN, DiluteCellT
!
! First set solids cell-center density in very dilute cells to zero
!
      DO ijk = ijkstart3, ijkend3
               IF (fluid_at(ijk)) THEN
                  DO m = 1, smax
                     epsolid = rop_s(ijk,m)/ro_s(ijk,m)
                     IF (epsolid < zero_ep_s) THEN

!  Remove solids in very small quantities and set solids velocity to zero
!  if there is outflow from the present cell.

                        rop_s(ijk,mmax) = rop_s(ijk,mmax) - rop_s(ijk,m) ! mmax = mixture phase
                        ep_g(ijk) = ep_g(ijk) + epsolid
                        rop_g(ijk) = ro_g(ijk)*ep_g(ijk)
                        rop_s(ijk,m) = zero
                     ENDIF
                  END DO
               ENDIF
      END DO
!
! now set velocities at cell faces to zero
!
      DO ijk = ijkstart3, ijkend3
               i = i_of(ijk)
               j = j_of(ijk)
               k = k_of(ijk)
               ijke = east_of(ijk)
               ijkn = north_of(ijk)
               ijkt = top_of(ijk)
               IF (fluid_at(ijk)) THEN
                  epsmixe = zero
                  epsmixn = zero
                  epsmixt = zero
                  dilutecelle = .false.
                  dilutecelln = .false.
                  dilutecellt = .false.
                  DO m = 1, smax
                     epsolide(m) = avg_x(ep_s(ijk,m),ep_s(ijke,m),i)
                     epsolidn(m) = avg_y(ep_s(ijk,m),ep_s(ijkn,m),j)
                     epsolidt(m) = avg_z(ep_s(ijk,m),ep_s(ijkt,m),k)

                     epsmixe = epsmixe + epsolide(m)*ro_s(ijk,m)
                     epsmixn = epsmixn + epsolidn(m)*ro_s(ijk,m)
                     epsmixt = epsmixt + epsolidt(m)*ro_s(ijk,m)

                     IF (epsolide(m) < zero_ep_s) THEN
                        epsmixe = epsmixe - epsolide(m)*ro_s(ijk,m)
                        epsolide(m) = zero
                        u_s(ijk,m) = zero
                        joix(ijk,m) = zero
                        dilutecelle = .true. ! to make sure at least one species is very dilute before
                                             ! re-calculating mixture velocity
                     ENDIF

                     IF (epsolidn(m) < zero_ep_s) THEN
                        epsmixn = epsmixn - epsolidn(m)*ro_s(ijk,m)
                        epsolidn(m) = zero
                        v_s(ijk,m) = zero
                        joiy(ijk,m) = zero
                        dilutecelln = .true.
                     ENDIF

                     IF (epsolidt(m) < zero_ep_s) THEN
                        epsmixt = epsmixt - epsolidt(m)*ro_s(ijk,m)
                        epsolidt(m) = zero
                        w_s(ijk,m) = zero
                        joiz(ijk,m) = zero
                        dilutecellt = .true.
                     ENDIF
                  END DO
!
! compute corrected mixture velcoity and species mass fluxes based on their definition.
!
                     IF (epsmixe > zero .AND. dilutecelle) THEN
                       u_s(ijk,mmax) = zero
                       DO m = 1, smax
                         u_s(ijk,mmax) = u_s(ijk,mmax) + u_s(ijk,m)*epsolide(m)*ro_s(ijk,m)
                       ENDDO
                       u_s(ijk,mmax) = u_s(ijk,mmax)/epsmixe
                       DO m = 1, smax
                         joix(ijk,m) = epsolide(m)*ro_s(ijk,m)*(u_s(ijk,m)-u_s(ijk,mmax))
                       ENDDO
                     ELSEIF(epsmixe == zero) THEN
                       u_s(ijk,mmax) = zero
                     ENDIF

                     IF (epsmixn > zero .AND. dilutecelln) THEN
                       v_s(ijk,mmax) = zero
                       DO m = 1, smax
                         v_s(ijk,mmax) = v_s(ijk,mmax) + v_s(ijk,m)*epsolidn(m)*ro_s(ijk,m)
                       ENDDO
                       v_s(ijk,mmax) = v_s(ijk,mmax)/epsmixn
                       DO m = 1, smax
                         joiy(ijk,m) = epsolidn(m)*ro_s(ijk,m)*(v_s(ijk,m)-v_s(ijk,mmax))
                       ENDDO
                     ELSEIF(epsmixn == zero) THEN
                       v_s(ijk,mmax) = zero
                     ENDIF

                     IF(.NOT.no_k) THEN  ! for 3D cases only
                       IF (epsmixt > zero .AND. dilutecellt) THEN
                         w_s(ijk,mmax) = zero
                         DO m = 1, smax
                           w_s(ijk,mmax) = w_s(ijk,mmax) + w_s(ijk,m)*epsolidt(m)*ro_s(ijk,m)
                         ENDDO
                         w_s(ijk,mmax) = w_s(ijk,mmax)/epsmixt
                         DO m = 1, smax
                           joiz(ijk,m) = epsolidt(m)*ro_s(ijk,m)*(w_s(ijk,m)-w_s(ijk,mmax))
                         ENDDO
                       ELSEIF(epsmixt == zero) THEN
                         w_s(ijk,mmax) = zero
                       ENDIF
                     ENDIF
               ENDIF
      END DO

      RETURN
      END SUBROUTINE adjust_eps_ghd

!// Comments on the modifications for DMP version implementation
!// 001 Include header file and common declarations for parallelization
!// 200 1119 Changed the limits for the triple loop, do k=kmin1,kmax1=>kstart1,kend1
!// 400 Added sendrecv module and send_recv calls for COMMunication