tinit3.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/.
!||====================================================================
!||    tinit3                 ../starter/source/elements/truss/tinit3.f
!||--- called by ------------------------------------------------------
!||    initia                 ../starter/source/elements/initia/initia.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    dt1lawt                ../starter/source/elements/truss/dt1lawt.F
!||    fretitl2               ../starter/source/starter/freform.F
!||    tcoori                 ../starter/source/elements/truss/tcoori.F
!||    tibuf3                 ../starter/source/elements/truss/tibuf3.F
!||    tmass                  ../starter/source/elements/truss/tmass.F
!||    tsigini                ../starter/source/elements/truss/tsigini.F
!||--- uses       -----------------------------------------------------
!||    bpreload_mod           ../starter/share/modules1/bpreload_mod.F
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE tinit3(ELBUF_STR,
     1                  IC     ,PM         ,X        ,GEO    ,XMAS   ,
     2                  DTELEM ,NFT        ,NEL      ,STIFN  ,PARTSAV,
     3                  V      ,IPART      ,MST      ,STIFINT,STT    ,
     4                  IGEO   ,NSIGTRUSS  ,SIGTRUSS ,PTTRUSS,
     5                  PRELOAD_A,IPRELD   ,NPRELOAD_A)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod
      USE message_mod
      USE bpreload_mod
      USE names_and_titles_mod , ONLY : nchartitle
      use element_mod , only : nixt
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      "param_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "scr03_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IC(NIXT,*),IPART(*),IGEO(NPROPGI,*),PTTRUSS(*)
      INTEGER NFT,NEL,NSIGTRUSS
      INTEGER , INTENT (IN   )  :: IPRELD,NPRELOAD_A
      my_real
     .   PM(*),X(*), GEO(NPROPG,*),XMAS(*),DTELEM(*),
     .   stifn(*),partsav(20,*),v(*),mst(*),stifint(*),stt(*),
     .   sigtruss(nsigtruss,*)
C
      TYPE(elbuf_struct_), TARGET :: ELBUF_STR
      TYPE(PREL1D_) , DIMENSION(NPRELOAD_A), TARGET :: PRELOAD_A
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IGTYP,NDEPAR,IPID1
      INTEGER MAT(MVSIZ), MXG(MVSIZ), NC1(MVSIZ), NC2(MVSIZ)
      my_real
     .     X1(MVSIZ), X2(MVSIZ),
     .     Y1(MVSIZ), Y2(MVSIZ),
     .     z1(mvsiz), z2(mvsiz)
      my_real
     .   deltax(mvsiz),xx,yy,zz, dtx(mvsiz)
      INTEGER IDMIN,IDMAX
      INTEGER ID
      CHARACTER(LEN=NCHARTITLE)::TITR
      DATA idmin /-1/, idmax /-1/
      my_real
     .     lgthmin, lgthmax,xnor,undamp,cc1
      DATA lgthmin /-1/, lgthmax /-1/
C
      TYPE(g_bufel_),POINTER :: GBUF
C=======================================================================
      gbuf => elbuf_str%GBUF
C
      ipid1=ic(nixt-1,nft+1)
      id=igeo(1,ipid1)
      CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid1),ltitr)
C
      CALL tcoori(x,ic(1,nft+1),mat, mxg, nc1, nc2, 
     .     x1, x2, y1, y2, z1, z2)
C-----------------------------
C     Check here (change TCOORI for called by /MAT/VOID)
C-----------------------------
      CALL tibuf3(gbuf%OFF,gbuf%AREA,geo, mxg)
      DO i=1,nel
        xnor=(x1(i)-x2(i))**2+(y1(i)-y2(i))**2+(z1(i)-z2(i))**2
        IF (xnor <= 1.e-20) THEN
           CALL ancmsg(msgid=269, msgtype=msgerror, anmode=aninfo, i1=id, c1=titr, i2=ic(5,i+nft))
        ENDIF
        gbuf%LENGTH(i) = sqrt(xnor)
      END DO
!------------------------------------------
! Truss initialization
!------------------------------------------
      IF (isigi /= 0)
     .  CALL tsigini(nsigtruss  ,sigtruss  ,pttruss   , gbuf%EINT ,gbuf%FOR,
     .               gbuf%G_PLA ,gbuf%PLA  ,gbuf%AREA )
      CALL tmass(x         ,ic      ,geo      ,pm          ,xmas      ,
     .     stifn     ,partsav ,v        ,ipart(nft+1),mst(nft+1),
     .     stifint,stt(nft+1) ,gbuf%AREA, mat, nc1, nc2,
     .     x1, x2, y1, y2, z1, z2)
!------------------------------------------
C------------------------------------------
C Compute truss time step 22/4/90 
C------------------------------------------
      DO i=1,nel
        igtyp=geo(12,ic(4,i+nft))
        IF (igtyp /= 2 .AND. invers > 14) THEN
          CALL ancmsg(msgid=270, msgtype=msgerror, anmode=aninfo_blind_1, i1=id, c1=titr, i2=ic(nixt,i),i3=igtyp)
        ENDIF
        xx = (x1(i) - x2(i))*(x1(i) - x2(i))
        yy = (y1(i) - y2(i))*(y1(i) - y2(i))
        zz = (z1(i) - z2(i))*(z1(i) - z2(i))
        deltax(i)=sqrt(xx+yy+zz)
        IF (lgthmin == -1 .OR. deltax(i) < lgthmin) THEN
          lgthmin = deltax(i)
          idmin = ic(5,i+nft)
        ENDIF
        IF (lgthmax == -1 .OR. deltax(i) > lgthmax) THEN
          lgthmax = deltax(i)
          idmax = ic(5,i+nft)
        ENDIF         
      ENDDO ! I=1,NEL
C
      CALL dt1lawt(pm, deltax, mat, mxg, dtx)
      ndepar=numels+numelc+nft
      DO i=1,nel
        dtelem(ndepar + i) = dtx(i)
      ENDDO
!---  /PRELOAD/AXIAL     
      IF (ipreld>0) THEN
          cc1 =two*sqrt(two)
          DO i=1,nel
            undamp = cc1*mst(nft+i)*gbuf%LENGTH(i)/dtx(i)
            gbuf%BPRELD(i)     = preload_a(ipreld)%preload
            gbuf%BPRELD(i+nel) = undamp*preload_a(ipreld)%damp
          ENDDO
      END IF
C---
      RETURN
      END