gradient_limitation.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/.
!||====================================================================
!||    gradient_limitation             ../engine/source/ale/alemuscl/gradient_limitation.F
!||--- called by ------------------------------------------------------
!||    ale51_gradient_reconstruction   ../engine/source/ale/alemuscl/ale51_gradient_reconstruction.f
!||--- uses       -----------------------------------------------------
!||    alemuscl_mod                    ../common_source/modules/ale/alemuscl_mod.F
!||    element_mod                     ../common_source/modules/elements/element_mod.F90
!||====================================================================
      SUBROUTINE gradient_limitation(IXS, X, TRIMAT)
C-----------------------------------------------
C  D e s c r i p t i o n   
C        limits the amplitude of this gradient in such a way that 
C        extrapolated values on the nodes of the element lie between
C        local minimum and maximum values from the neighboring elements
C        -> maximum principle purpose
C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE alemuscl_mod
      use element_mod , only :nixs
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 "vect01_c.inc"
#include "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: IXS(NIXS,NUMELS), TRIMAT
      my_real, INTENT(IN) :: x(3,numnod)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: I, II, JJ
      INTEGER :: NODE_ID
      my_real :: reduc_factor(trimat), nodal_reduc_factor, xn, yn, zn, valnode
      INTEGER :: ITRIMAT
      INTEGER :: NNUM
      my_real :: xk, yk, zk
C-----------------------------------------------
C   S o u r c e   L i n e s 
C-----------------------------------------------  
      !!! Limiting process for the computed gradient -> maximum principle
      !!! and stability purposes
      DO i = lft, llt
         ii = i + nft
         !!!centroid element
         xk = alemuscl_buffer%ELCENTER(ii,1) ; 
         yk = alemuscl_buffer%ELCENTER(ii,2) ; 
         zk = alemuscl_buffer%ELCENTER(ii,3) ;
         reduc_factor = ep30
         nnum = 0
         DO itrimat = 1, trimat
            IF(abs(alemuscl_buffer%GRAD(ii,1,itrimat)) + 
     .         abs(alemuscl_buffer%GRAD(ii,2,itrimat)) + 
     .         abs(alemuscl_buffer%GRAD(ii,3,itrimat)) > zero) THEN
               nnum = nnum + 1
               !!! Check the nodes of the element
               DO jj = 1, 8
                  node_id = ixs(jj+1, ii)
                  !!! Get the node coordinates
                  xn = x(1, node_id) ; yn = x(2, node_id) ; zn = x(3, node_id) 
                  !!! Interpolate the function at the node
                  valnode = alemuscl_buffer%VOLUME_FRACTION(ii,itrimat) 
     .                 + alemuscl_buffer%GRAD(ii,1,itrimat) * (xn - xk)  
     .                 + alemuscl_buffer%GRAD(ii,2,itrimat) * (yn - yk)
     .                 + alemuscl_buffer%GRAD(ii,3,itrimat) * (zn - zk)
                  nodal_reduc_factor = one
                  IF (valnode - alemuscl_buffer%VOLUME_FRACTION(ii,itrimat) > zero) THEN
                     nodal_reduc_factor = 
     .                    min((alemuscl_buffer%NODE_MAX_VALUE(node_id,itrimat) - alemuscl_buffer%VOLUME_FRACTION(ii,itrimat))
     .                    / (valnode - alemuscl_buffer%VOLUME_FRACTION(ii,itrimat)), alemuscl_param%BETA)
                  ELSE IF (valnode - alemuscl_buffer%VOLUME_FRACTION(ii,itrimat) < zero) THEN
                     nodal_reduc_factor = 
     .                    min((alemuscl_buffer%NODE_MIN_VALUE(node_id,itrimat) - alemuscl_buffer%VOLUME_FRACTION(ii,itrimat)) 
     .                    / (valnode - alemuscl_buffer%VOLUME_FRACTION(ii,itrimat)), alemuscl_param%BETA)
                  ENDIF
                  reduc_factor(itrimat) = min(reduc_factor(itrimat), nodal_reduc_factor)
               ENDDO  ! JJ = 1, 8
            ELSE
               reduc_factor(itrimat) = zero
            ENDIF 
         ENDDO  ! ITRIMAT = 1, TRIMAT
         !!!IF (NNUM >= 3) THEN
         !!!   reduc_factor = 0.
         !!!ENDIF
         DO itrimat = 1, trimat
            IF(abs(alemuscl_buffer%GRAD(ii,1,itrimat)) + 
     .         abs(alemuscl_buffer%GRAD(ii,2,itrimat)) + 
     .         abs(alemuscl_buffer%GRAD(ii,3,itrimat)) > zero) THEN
            !!!   Limitation of the gradient
               alemuscl_buffer%GRAD(ii,1,itrimat) = reduc_factor(itrimat) * alemuscl_buffer%GRAD(ii,1,itrimat)
               alemuscl_buffer%GRAD(ii,2,itrimat) = reduc_factor(itrimat) * alemuscl_buffer%GRAD(ii,2,itrimat)
               alemuscl_buffer%GRAD(ii,3,itrimat) = reduc_factor(itrimat) * alemuscl_buffer%GRAD(ii,3,itrimat)
            ENDIF
         ENDDO
      ENDDO  ! I = LFT, LLT
 
C-----------------------------------------------      
      END SUBROUTINE gradient_limitation