dt51law.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/.
!||====================================================================
!||    dt51law   ../starter/source/materials/time_step/dt51law.F
!||--- called by ------------------------------------------------------
!||    dtmain    ../starter/source/materials/time_step/dtmain.F
!||--- calls      -----------------------------------------------------
!||    dtel      ../starter/source/materials/time_step/dtel.F
!||    dtsph     ../starter/source/materials/time_step/dtsph.F
!||====================================================================
      SUBROUTINE dt51law (PM,GEO,PID,MAT, BUFMAT, IPM, DELTAX, AIRE, VOL, DTX)
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C     ELEMENTARY TIME STEPS FOR ALE MULTI MATERIAL LAW 51 (/MAT/MULTIMAT)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "vect01_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real, INTENT(IN) :: pm(npropm, *), geo(npropg, *), aire(*), vol(*)
      my_real, INTENT(INOUT) :: dtx(*)
      my_real, INTENT(IN), DIMENSION(:), TARGET :: bufmat(*), deltax(*)
      INTEGER, INTENT(IN) :: PID(*),MAT(*),IPM(NPROPMI, *)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: I, IADBUF,IFLG(MVSIZ), BIJ(4)
      my_real,DIMENSION(:),POINTER :: uparam
      my_real :: ssp(mvsiz)  , rho0(mvsiz) , bulk(mvsiz) ,
     .           av1(mvsiz)  , av2(mvsiz)  , av3(mvsiz)  , av4(mvsiz)  ,
     .           rho10(mvsiz), rho20(mvsiz), rho30(mvsiz), rho40(mvsiz),
     .           ssp1(mvsiz) , ssp2(mvsiz) , ssp3(mvsiz) , ssp4(mvsiz),
     .           vis(mvsiz)  , rho0_bak(mvsiz)
      INTEGER :: IAV(4),IRHO(4),ISSP(4),NUPARAM
 
c-----------------------------------------------
       iav(1:4)  = (/ 4,5,6,46 /)
       irho(1:4) = (/ 9,10,11,47 /)
       issp(1:4)  = (/ 124,174,224,273 /)
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      iflg(1) = 0
      DO i=1,llt
        iadbuf   = ipm(7,mat(i))
        nuparam  = ipm(9,mat(i))
        uparam   =>bufmat(iadbuf:iadbuf+nuparam-1)
        bij(1:4) = nint(uparam(277:280))
        av1(i)   = uparam(iav(bij(1)))
        av2(i)   = uparam(iav(bij(2)))
        av3(i)   = uparam(iav(bij(3)))
        av4(i)   = uparam(iav(bij(4)))
        rho10(i) = uparam(irho(bij(1)))
        rho20(i) = uparam(irho(bij(2)))
        rho30(i) = uparam(irho(bij(3)))
        rho40(i) = uparam(irho(bij(4)))
        iflg(i)  = nint(uparam(31))
        vis(i)   = zero
        ssp1(i)  = uparam(issp(bij(1)))
        ssp2(i)  = uparam(issp(bij(2)))
        ssp3(i)  = uparam(issp(bij(3)))
        ssp4(i)  = uparam(issp(bij(4)))
      enddo!next I
 
      IF (iflg(1) == 6) THEN
        DO i=lft,llt
          dtx(i)=ep20
        ENDDO
        RETURN 
      ENDIF
 
      DO i=lft,llt
        rho0(i) = av1(i)*rho10(i) + av2(i)*rho20(i) + av3(i)*rho30(i) + av4(i)*rho40(i)
      ENDDO
 
      DO i=lft,llt
        bulk(i) =   av1(i)*rho10(i)*ssp1(i)**2 
     .            + av2(i)*rho20(i)*ssp2(i)**2 
     .            + av3(i)*rho30(i)*ssp3(i)**2 
     .            + av4(i)*rho40(i)*ssp4(i)**2
        IF (rho0(i) > zero) THEN
           ssp(i)  = sqrt(bulk(i)/rho0(i))
           rho0_bak(i)=rho0(i)
        ELSE
           ssp(i) = em20
           rho0_bak(i)=em20
        ENDIF
      enddo!next I
 
      !----------------------------------------------!
      !  ELEMENTARY TIME STEP (ARTIFICIAL VISCOSITY) !
      !----------------------------------------------!
      IF(jsph==0)THEN
       CALL dtel(ssp,pm,geo,pid,mat, rho0_bak, vis, deltax, aire, vol, dtx)
      ELSE
       CALL dtsph(ssp,pm,geo,pid,mat, rho0_bak, vis, deltax, vol, dtx)
      ENDIF
C-----------
      RETURN
      END