tinit3.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr03_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	tinit3 (elbuf_str, ic, pm, x, geo, xmas, dtelem, nft, nel, stifn, partsav, v, ipart, mst, stifint, stt, igeo, nsigtruss, sigtruss, pttruss, preload_a, ipreld, npreload_a)

Function/Subroutine Documentation

tinit3()

subroutine tinit3	(	type(elbuf_struct_), target	elbuf_str,
		integer, dimension(nixt,*)	ic,
			pm,
			x,
			geo,
			xmas,
			dtelem,
		integer	nft,
		integer	nel,
			stifn,
			partsav,
			v,
		integer, dimension(*)	ipart,
			mst,
			stifint,
			stt,
		integer, dimension(npropgi,*)	igeo,
		integer	nsigtruss,
			sigtruss,
		integer, dimension(*)	pttruss,
		type(prel1d_), dimension(npreload_a), target	preload_a,
		integer, intent(in)	ipreld,
		integer, intent(in)	npreload_a )

Definition at line 39 of file tinit3.F.

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