tdlen3.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/.
!||====================================================================
!||    tdlen3   ../engine/source/elements/truss/tdlen3.f
!||--- called by ------------------------------------------------------
!||    tforc3   ../engine/source/elements/truss/tforc3.F
!||====================================================================
      SUBROUTINE tdlen3(
     1   JFT,     JLT,     PM,      OFFG,
     2   OFF,     DT2T,    NELTST,  ITYPTST,
     3   MSTR,    DMELTR,  DTEL,    NEL,
     4   G_DT,    MAT,     NGL,     AL,
     5   JSMS)
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      "com08_c.inc"
#include      "param_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, INTENT(IN) :: JSMS
      INTEGER MAT(MVSIZ),NGL(MVSIZ)
      INTEGER, INTENT(IN)    :: NEL
      my_real, INTENT(INOUT) :: DTEL(NEL)
      INTEGER, INTENT(IN)    :: G_DT
      INTEGER JFT,JLT,NELTST,ITYPTST
      my_real dt2t,
     .   pm(npropm,*), off(*),offg(mvsiz), mstr(*), dmeltr(*),
     .   al(mvsiz)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
      my_real
     .   SSP(MVSIZ), DT(MVSIZ)
C-----------------------------------------------      
      DO I=jft,jlt
        ssp(i)=pm(27,mat(i))
      ENDDO
 
      IF(idtmins/=2.OR.jsms==0)THEN
 
       DO i=jft,jlt
         dt(i)=dtfac1(4)*al(i)/ssp(i)
       ENDDO
       
       IF(nodadt/=0.AND.idtmin(4)==0)RETURN
 
       DO i=jft,jlt
         IF(off(i)<one.OR.offg(i)<zero) cycle
         IF(idtmin(4)==1.AND.dt(i)<dtmin1(4))THEN
           tstop = tt
#include "lockon.inc"
           WRITE(iout,*) ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR TRUSS ELEMENT'
           WRITE(istdo,*)' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR TRUSS ELEMENT'
#include "lockoff.inc"
         ELSEIF(idtmin(4)==5.AND.dt(i)<dtmin1(4))THEN
           mstop = 2
#include "lockon.inc"
           WRITE(iout,*) ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR TRUSS ELEMENT'
           WRITE(istdo,*)' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR TRUSS ELEMENT'
#include "lockoff.inc"
         ELSEIF(idtmin(4)==2.AND.dt(i)<dtmin1(4))THEN
           off(i) = zero
#include "lockon.inc"
           WRITE(iout,*) '-- DELETE  OF TRUSS ELEMENT NUMBER',ngl(i)
#include "lockoff.inc"
           idel7nok = 1
         ENDIF
         IF(nodadt/=0.OR.dt(i)>=dt2t) cycle
         dt2t=dt(i)
         neltst =ngl(i)
         ityptst=4
       enddo!next I
C----
      else!(IDTMINS==2.AND.JSMS/=0)
       !IDTMINS=2 & JSMS=1 <=> AMS & elementary time step
       DO i=jft,jlt
         dt(i)=al(i)/ssp(i)
       END DO
       DO i=jft,jlt
         IF(off(i)<one.OR.offg(i)<zero) cycle
          dmeltr(i) = max(dmeltr(i) , mstr(i)*((dtmins/(dtfacs*dt(i)))**2 - one))
          dt(i)     = dtfacs*sqrt(one+dmeltr(i)/mstr(i))*dt(i)
       END DO
       DO i=jft,jlt
         IF(off(i)<one.OR.offg(i)<zero) cycle
          IF(dt(i)<dt2t)THEN
            dt2t    = dt(i)
            neltst  = ngl(i)
            ityptst = 4
          END  IF
        END DO         
      END if!(IDTMINS/=2.OR.JSMS==0)
C-----------------------------------------------           
      IF(g_dt/=zero)THEN
        DO i=1,nel
          dtel(i) = dt(i)
        ENDDO
      ENDIF
C-----------------------------------------------      
      
      RETURN
      END