gradient_limitation.F File Reference

#include "implicit_f.inc"
#include "vect01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	gradient_limitation (ixs, x, trimat)

Function/Subroutine Documentation

gradient_limitation()

subroutine gradient_limitation	(	integer, dimension(nixs,numels), intent(in)	ixs,
		dimension(3,numnod), intent(in)	x,
		integer, intent(in)	trimat )

Definition at line 30 of file gradient_limitation.F.

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
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
         !!! Element centroid
         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-----------------------------------------------