c3dt3.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/.
!||====================================================================
!||    c3dt3         ../engine/source/elements/sh3n/coque3n/c3dt3.f
!||--- called by ------------------------------------------------------
!||    c3forc3       ../engine/source/elements/sh3n/coque3n/c3forc3.F
!||    c3forc3_crk   ../engine/source/elements/xfem/c3forc3_crk.F
!||--- calls      -----------------------------------------------------
!||    cssp2a11      ../engine/source/elements/sh3n/coque3n/cssp2a11.F
!||====================================================================
      SUBROUTINE c3dt3(JFT   ,JLT    ,PM     ,OFF    ,DT2T   ,
     2                 NELTST,ITYPTST,STI    ,STIR   ,OFFG   ,
     3                 SSP   ,VISCMX ,ISMSTR ,NFT    ,IOFC   ,
     4                 ALPE  ,MSTG   ,DMELTG ,JSMS   ,PTG    ,
     5                 SHF   ,IGTYP  ,IGMAT  ,G      ,A1     ,
     6                 A11R  ,G_DT   ,DTEL   ,ALDT   ,THK0   ,
     7                 AREA  ,NGL    ,IMAT   ,MTN    ,NEL   ,
     8                 ZOFFSET)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.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      "param_c.inc"
#include      "com08_c.inc"
#include      "scr02_c.inc"
#include      "scr07_c.inc"
#include      "scr17_c.inc"
#include      "scr18_c.inc"
#include      "sms_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JFT, JLT,NELTST,ITYPTST,ISMSTR,NFT,IOFC, JSMS,IGTYP,
     .        IGMAT,IMAT,MTN
      INTEGER NGL(MVSIZ)
      my_real
     .   PM(NPROPM,*), OFF(*),STI(*),STIR(*),OFFG(*),SSP(MVSIZ),
     .   VISCMX(MVSIZ),DT2T, MSTG(*), DMELTG(*), PTG(3,*),SHF(*), G(MVSIZ),
     .   A11R(MVSIZ),A1(MVSIZ),ALDT(MVSIZ),THK0(MVSIZ),AREA(MVSIZ),ALPE(MVSIZ)
      INTEGER,INTENT(IN)    :: G_DT, NEL
      my_real,DIMENSION(JLT), INTENT(INOUT) :: DTEL
      my_real,DIMENSION(NEL),INTENT(IN)  :: zoffset
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER INDX(MVSIZ),I, II, NINDX,IDT
      my_real dt(mvsiz)
      my_real athk, mmin,fac
C=======================================================================       
      DO i=jft,jlt
        viscmx(i) = sqrt(one + viscmx(i)*viscmx(i)) - viscmx(i)
        aldt(i)   = aldt(i)*viscmx(i) / sqrt(alpe(i))
      ENDDO
c---------------------------------------------------
C
      IF (nodadt/=0) THEN
        IF(igtyp == 52 .OR. 
     .   ((igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51)
     .                                   .AND. igmat > 0 )) THEN
           DO  i=jft,jlt
               IF (off(i)==zero) THEN
                 sti(i) = zero
                 stir(i) = zero
               ELSE
                 athk   = area(i) * thk0(i)
                 sti(i) = athk * a1(i) / aldt(i)**2
                 fac =a11r(i)*area(i)/ aldt(i)**2
                 stir(i) = fac*(one_over_12* thk0(i)**3 + thk0(i)*zoffset(i)*zoffset(i)
     .                        + thk0(i)*half * shf(i) * area(i) * g(i)/a1(i))
                ENDIF
          ENDDO       
        ELSE
           DO  i=jft,jlt
            a1(i) = pm(24,imat)
            g(i)  = pm(22,imat)
           ENDDO
           IF (mtn == 58  .or. mtn == 158) CALL cssp2a11(pm   ,imat  ,ssp  ,a1   ,jlt   )
           DO  i=jft,jlt
               IF (off(i)==zero) THEN
                 sti(i) = zero
                 stir(i) = zero
               ELSE
                 athk   = area(i) * thk0(i)
                 sti(i) = athk * a1(i) / aldt(i)**2
                 stir(i) = sti(i) * (thk0(i) * thk0(i) * one_over_12 
     .                   + half * shf(i) * area(i) * g(i)/a1(i))
c                 STI(I) = 0.5 * ATHK * A1(I) / ALDT(I)**2
c                 STIR(I) = STI(I) * (THK0(I) * THK0(I) / 12. 
c     .                   + AREA(I) /9.) 
               ENDIF
          ENDDO
        ENDIF 
C
      ELSEIF(idtmins == 2)THEN
       IF(igtyp == 52 .OR. 
     .    ((igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51)
     .                                   .AND. igmat > 0 )) THEN
          DO i=jft,jlt
              IF (off(i)==zero) THEN
                sti(i) = zero
                stir(i) = zero
              ELSE
                athk   = area(i) * thk0(i)
                sti(i) = athk * a1(i) / aldt(i)**2
                fac = a11r(i)*area(i)/ aldt(i)**2 
                stir(i) = fac * (one_over_12* (thk0(i)**3) + thk0(i)*zoffset(i)*zoffset(i)
     .                 + half * thk0(i)*shf(i) * area(i) * g(i)/a1(i))
              ENDIF
           END DO 
        ELSE
           DO  i=jft,jlt
            a1(i) = pm(24,imat)
            g(i)  = pm(22,imat)
           ENDDO
           DO i=jft,jlt
              IF (off(i)==zero) THEN
                sti(i) = zero
                stir(i) = zero
              ELSE
                athk   = area(i) * thk0(i)
                sti(i) = athk * a1(i) / aldt(i)**2
                stir(i) = sti(i) * (thk0(i) * thk0(i) * one_over_12 
     .                 + half * shf(i) * area(i) * g(i)/a1(i))
              ENDIF
           END DO
        ENDIF  
C
        IF(jsms /= 0)THEN
         DO i=jft,jlt
          IF(offg(i) < zero .OR. off(i) == zero) cycle
c
          mmin=mstg(i)*min(ptg(1,i),ptg(2,i),ptg(3,i))
c
c dmelc = 2*dmelc !!   
c w^2 < 2k / (m+dmelc+dmelc/2) < 2k / (m+dmelc)
c dt = 2/w = sqrt( 2*(m+dmelc)/k)
          dmeltg(i)=max(dmeltg(i),
     .             (dtmins/dtfacs)**2 * sti(i) - two*mmin)
          dt(i)  = dtfacs*
     .              sqrt((two*mmin+dmeltg(i))/max(em20,sti(i)))
          IF(dt(i)<dt2t)THEN
            dt2t    = dt(i)
            neltst  = ngl(i)
            ityptst = 7
          END  IF
         END DO
        ENDIF
C
      ENDIF
C
      DO i=jft,jlt
        dt(i)=dtfac1(7)*aldt(i)/ssp(i)
      END DO
      IF(g_dt/=zero)THEN
         DO i=jft,jlt
           dtel(i) = dt(i)
         ENDDO
      ENDIF
C
      IF (idtmin(7)==0) RETURN 
C
      nindx=iofc
      IF(idtmin(7)==1)THEN
        DO 100 i=jft,jlt
        IF(dt(i)>dtmin1(7).OR.off(i)<one
     .       .OR.offg(i)==two.OR.offg(i)<zero) GO TO 100
         tstop = tt
C
#include "lockon.inc"
         WRITE(iout,1000)  ngl(i)
         WRITE(istdo,1000) ngl(i)
#include "lockoff.inc"
  100   CONTINUE
      ELSEIF(idtmin(7)==2)THEN
        DO 120 i=jft,jlt
        IF(dt(i)>dtmin1(7).OR.off(i)<one
     .       .OR.offg(i)<zero) GO TO 120
         off(i)=zero
 
         ii=i+nft
         nindx=nindx+1
         indx(nindx)=i
         idel7nok = 1
C
#include "lockon.inc"
         WRITE(iout,1200)  ngl(i)
         WRITE(istdo,1300) ngl(i),tt
#include "lockoff.inc"
  120   CONTINUE
        iofc = nindx
      ELSEIF(ismstr==2.AND.idtmin(7)==3)THEN
        DO 140 i=jft,jlt
        IF(dt(i)>dtmin1(7).OR.
     .   off(i)<one.OR.offg(i)==two.OR.offg(i)<zero) GO TO 140
         offg(i)=two
C
#include "lockon.inc"
         WRITE(iout,1400)  ngl(i)
         WRITE(istdo,1400) ngl(i)
#include "lockoff.inc"
  140   CONTINUE
      ELSEIF(idtmin(7)==5)THEN
        DO 150 i=jft,jlt
        IF(dt(i)>dtmin1(7).OR.off(i)<one.
     .     or.offg(i)==two.OR.offg(i)<zero) GO TO 150
         mstop = 2
C
#include "lockon.inc"
         WRITE(iout,1000)  ngl(i)
         WRITE(istdo,1000) ngl(i)
#include "lockoff.inc"
  150   CONTINUE
      ENDIF
C
      IF(nodadt/=0.OR.(idtmins==2.AND.jsms/=0))RETURN
C
C- VECTOR
      idt=0
      DO i=jft,jlt
        IF(offg(i)>zero.AND.off(i)/=zero.AND.dt(i)<dt2t) idt=1
      ENDDO
C- NON VECTOR
      IF(idt==1)THEN
       DO i=jft,jlt
       IF(offg(i)>zero.AND.off(i)/=zero.AND.dt(i)<dt2t)THEN
         dt2t    = dt(i)
         neltst  = ngl(i)
         ityptst = 7
       ENDIF
       ENDDO
      ENDIF
C
      IF(idtmins==2)RETURN
C
      DO i=jft,jlt
         sti(i) = area(i) * thk0(i) * a1(i) / aldt(i)**2
         sti(i) = zep81 * zep81 * sti(i) * off(i)
         stir(i)= zero
      ENDDO
C-----------
 1000 FORMAT(1x,'-- MINIMUM TIME STEP 3N SHELL ELEMENT NUMBER ',i10)
 1200 FORMAT(1x,'-- DELETE 3N SHELL ELEMENT NUMBER ',i10)
 1300 FORMAT(1x,'-- DELETE 3N SHELL ELEMENT :',i10,' AT TIME :',g11.4)
 1400 FORMAT(1x,'-- CONSTANT TIME STEP 3N SHELL ELEMENT NUMBER ',i10)
C-----------
      RETURN
      END