weight.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/.
!||====================================================================
!||    weight0        ../engine/source/elements/sph/weight.F
!||--- called by ------------------------------------------------------
!||    spcompl        ../engine/source/elements/sph/spcompl.F
!||    spgauge        ../engine/source/elements/sph/spgauge.F
!||    splissv        ../engine/source/elements/sph/splissv.F
!||    spmd_sphgetd   ../engine/source/mpi/elements/spmd_sph.F
!||    sponfv         ../engine/source/elements/sph/sponfv.F
!||    spstabw        ../engine/source/elements/sph/spstab.F
!||====================================================================
      SUBROUTINE weight0(XI,YI,ZI,XJ,YJ,ZJ,H,W)
C-------------------------------------------------------------------------
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C----------------------------------------------------------
C   D u m m y   A r g u m e n t s   a n d   F u n c t i o n
C----------------------------------------------------------
      my_real
     .   xi,yi,zi,xj,yj,zj,h,w
C----------------------------------------------------------
      my_real
     .   r,rh,rh2,rh3,rhm,rhm3
C=======================================================================
      IF (h==zero) stop
C-----
      r =sqrt((xi-xj)*(xi-xj)+(yi-yj)*(yi-yj)+(zi-zj)*(zi-zj))
C-----
      IF (r<=h) THEN
        rh  =r/h
        rh2 =rh*rh
        rh3 =rh2*rh
        w   =(one - three_half*rh2+three_over_4*rh3)*invpi/(h*h*h)
      ELSEIF (r<=two*h) THEN
        rhm =two-r/h
        rhm =rhm/h
        rhm3=rhm*rhm*rhm
        w   =fourth*rhm3*invpi
      ELSE
        w   =zero
      ENDIF
      RETURN
      END
!||====================================================================
!||    weight1        ../engine/source/elements/sph/weight.F
!||--- called by ------------------------------------------------------
!||    spcompl        ../engine/source/elements/sph/spcompl.f
!||    spdens         ../engine/source/elements/sph/spdens.F
!||    spforcp        ../engine/source/elements/sph/spforcp.F
!||    spgradt        ../engine/source/elements/sph/sptemp.F
!||    splaplt        ../engine/source/elements/sph/sptemp.F
!||    spmd_sphgetd   ../engine/source/mpi/elements/spmd_sph.F
!||    sponfv         ../engine/source/elements/sph/sponfv.F
!||====================================================================
      SUBROUTINE weight1(XI,YI,ZI,XJ,YJ,ZJ,H,W,WGRAD)
C-------------------------------------------------------------------------
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C----------------------------------------------------------
C   D u m m y   A r g u m e n t s   a n d   F u n c t i o n
C----------------------------------------------------------
      my_real
     .   xi,yi,zi,xj,yj,zj,h,w,wgrad(3)
C----------------------------------------------------------
      my_real
     .   r,rh,rh2,rh3,ih3,rhm,rhm2,rhm3,wprimr
C=======================================================================
      IF (h==zero) stop
C-----
      r =sqrt((xi-xj)*(xi-xj)+(yi-yj)*(yi-yj)+(zi-zj)*(zi-zj))
C-----
      IF (r<=h) THEN
        rh  =r/h
        rh2 =rh*rh
        rh3 =rh2*rh
        ih3 =invpi/(h*h*h)
        w      =(one - three_half*rh2+three_over_4*rh3)*ih3
        wprimr =(-three+twop25*rh)*ih3/(h*h)
      ELSEIF (r<=two*h) THEN
        rhm =two - r/h
        rhm =rhm/h
        rhm2=rhm*rhm*invpi
        rhm3=rhm2*rhm
        w      = fourth*rhm3
        wprimr =-three_over_4*rhm2/(h*h*r)
      ELSE
        w      =zero
        wprimr =zero
      ENDIF
      wgrad(1)=wprimr*(xi-xj)
      wgrad(2)=wprimr*(yi-yj)
      wgrad(3)=wprimr*(zi-zj)
      RETURN
      END