ale51_antidiff2.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    ale51_antidiff2        ../engine/source/ale/ale51/ale51_antidiff2.F
!||--- called by ------------------------------------------------------
!||    afluxt                 ../engine/source/ale/ale51/afluxt.F
!||--- uses       -----------------------------------------------------
!||    ale_connectivity_mod   ../common_source/modules/ale/ale_connectivity_mod.F
!||    ale_mod                ../common_source/modules/ale/ale_mod.F
!||    segvar_mod             ../engine/share/modules/segvar_mod.F
!||====================================================================
      SUBROUTINE ale51_antidiff2(FLUX,ALE_CONNECT,ALPH,VOL,IXQ,FLUX_VOIS,
     .                   N4_VOIS,ITAB,ITRIMAT,
     .                   SEGVAR)
C-----------------------------------------------
C   D e c r i p t i o n
C-----------------------------------------------
C
C ** Warning, this formulation (for volume fractions) using \eta_3 parameter from /UPWIND option is not conservative. 
C It was marked as OBSOLETE. Forget it and use MUSCL instead
C
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
       USE segvar_mod     
       USE ale_connectivity_mod
       USE ale_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "spmd_c.inc"
#include      "com04_c.inc"
#include      "com08_c.inc"
#include      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXQ(NIXQ,NUMELQ),N4_VOIS(NUMELQ+NQVOIS,4),ITAB(NUMNOD)
      INTEGER,INTENT(IN) :: ITRIMAT
      my_real flux(4,*),alph(*),vol(*),flux_vois(numelq+nqvois,6)
      TYPE(t_segvar),INTENT(IN) :: SEGVAR     
      TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,II,K,JV(6),KV(6),IAD2,IAD3
      my_real
     .   vol0,av0,uav0,alphi,ualphi,aaa,ff(6),udt,phi0
C-----------------------------------------------
C   S o u r c e   L i n e s 
C-----------------------------------------------  
      jv = -huge(jv(1))
      kv = -huge(kv(1))
      ff = -huge(ff(1))
C-----------------------------------------------
C     WET SURFACE
C-----------------------------------------------
      IF(dt1 > zero)THEN
        udt = one/dt1
      ELSE
        udt = zero
      ENDIF
C
      DO i=lft,llt
        ii   = i + nft
        iad2 = ale_connect%ee_connect%iad_connect(ii)
        vol0 = vol(i)*udt
        av0  = alph(ii) * vol0
        uav0 = vol0 - av0
        alphi  = zero
        ualphi = zero 
        phi0 = zero  
C-----------------------------------------------
C       adjacent face & total outgoing volume flux 
C-----------------------------------------------
        DO k=1,4
          IF(flux(k,ii) > zero)THEN
            jv(k) = ale_connect%ee_connect%connected(iad2 + k - 1)
            kv(k) = k
            IF(jv(k) == 0)THEN
              jv(k)  = ii
              ff(k)  = alph(ii)*flux(k,ii)
            ELSEIF(jv(k) < 0)THEN
              !case <0 : ebcs (-IVOIS is then segment identifier)               
              ff(k)  = segvar%PHASE_ALPHA(itrimat,-jv(k))  *flux(k,ii)         
            ELSEIF(jv(k) <= numelq)THEN
               iad3 = ale_connect%ee_connect%iad_connect(jv(k))
              IF(ale_connect%ee_connect%connected(iad3 + 1 - 1) == ii) kv(k) = 1
              IF(ale_connect%ee_connect%connected(iad3 + 2 - 1) == ii) kv(k) = 2
              IF(ale_connect%ee_connect%connected(iad3 + 3 - 1) == ii) kv(k) = 3
              IF(ale_connect%ee_connect%connected(iad3 + 4 - 1) == ii) kv(k) = 4
              ff(k)  = alph(jv(k))*flux(k,ii)
            ELSE
              !spmd
              ff(k)  = alph(jv(k))*flux(k,ii)              
            ENDIF
c           outgoing volume flux (estimation)
            alphi  = alphi  + ff(k)
c           initial outgoing flux
            phi0 = phi0 + flux(k,ii) 
          ENDIF
        ENDDO
c       outgoing rest
        ualphi = phi0 - alphi 
C-----------------------------------------------
C       outgoing volume flux by face
C-----------------------------------------------
        IF(alphi > av0.AND.av0 > zero)THEN
C-----------------------------------------------
C         outgoing volume flux > volume
C-----------------------------------------------
          aaa = av0 / alphi
          DO k=1,4
            IF(flux(k,ii) > zero)THEN
              ff(k) = ff(k) * aaa
            ENDIF
          ENDDO
       ELSEIF(ualphi > uav0.AND.uav0 > zero)THEN
 
C-----------------------------------------------
C         outgoing rest > available volume
C-----------------------------------------------
          aaa = uav0/ualphi
          DO k=1,4
            IF(flux(k,ii) > zero)THEN
              ff(k) = flux(k,ii) + (ff(k)-flux(k,ii))*aaa
            ENDIF
          ENDDO
c        ELSE
        ENDIF
C-----------------------------------------------
C         outgoing flux
C-----------------------------------------------
          DO k=1,4
            IF(flux(k,ii) > zero)THEN
              ff(k) = 0.5* (ff(k)*(1.-ale%UPWIND%UPWSM)
     .                    + alph(ii)*flux(k,ii)*(1.+ale%UPWIND%UPWSM))
              flux(k,ii) = ff(k)
              IF(jv(k) < 0)THEN
                !nothing to do
              ELSEIF(jv(k) <= numelq)THEN
                flux(kv(k),jv(k)) = -flux(k,ii)
              ELSE
                flux_vois(ii,k) = flux(k,ii)
                n4_vois(ii,1) = itab(ixq(2,ii))
                n4_vois(ii,2) = itab(ixq(3,ii))
                n4_vois(ii,3) = itab(ixq(4,ii))
                n4_vois(ii,4) = itab(ixq(5,ii))
              ENDIF
            ENDIF
          ENDDO
C-----------------------------------------------
C         incoming volume flux from EBCS
C-----------------------------------------------
          IF(nsegflu > 0)THEN
             iad2 = ale_connect%ee_connect%iad_connect(ii)
            DO k=1,4
              IF(flux(k,ii) < zero .AND. ale_connect%ee_connect%connected(iad2 + k - 1) < 0)THEN
                flux(k,ii) = segvar%PHASE_ALPHA(itrimat,-ale_connect%ee_connect%connected(iad2 + k - 1))*flux(k,ii)
              ENDIF
            ENDDO       
          ENDIF   
C-------------
      enddo! next I
C-----------------------------------------------
      RETURN
      END
C