OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pinit3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine pinit3 (elbuf_str, stp, ic, pm, x, geo, dtelem, nft, nel, stifn, stifr, partsav, v, ipart, msp, inp, igeo, strp, nsigbeam, sigbeam, ptbeam, iuser, mcpp, temp, preload_a, ipreld, npreload_a, glob_therm, ibeam_vector, rbeam_vector)

Function/Subroutine Documentation

◆ pinit3()

subroutine pinit3 ( type(elbuf_struct_), target elbuf_str,
stp,
integer, dimension(nixp,*) ic,
pm,
x,
geo,
dtelem,
integer nft,
integer nel,
stifn,
stifr,
partsav,
v,
integer, dimension(*) ipart,
msp,
inp,
integer, dimension(npropgi,*) igeo,
strp,
integer nsigbeam,
sigbeam,
integer, dimension(*) ptbeam,
integer iuser,
mcpp,
temp,
type(prel1d_), dimension(npreload_a), target preload_a,
integer, intent(in) ipreld,
integer, intent(in) npreload_a,
type (glob_therm_), intent(in) glob_therm,
integer, dimension(numelp), intent(in) ibeam_vector,
dimension(3,numelp), intent(in) rbeam_vector )

Definition at line 40 of file pinit3.F.

48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE elbufdef_mod
52 USE message_mod
53 USE bpreload_mod
54 use glob_therm_mod
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C G l o b a l P a r a m e t e r s
61C-----------------------------------------------
62#include "mvsiz_p.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "param_c.inc"
67#include "com01_c.inc"
68#include "com04_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER :: NEL,NSIGBEAM,IUSER,NFT
73 INTEGER :: IC(NIXP,*),IPART(*),IGEO(NPROPGI,*),PTBEAM(*)
74 INTEGER , INTENT (IN ) :: IPRELD,NPRELOAD_A
75 INTEGER , INTENT (IN ) :: IBEAM_VECTOR(NUMELP)
77 . pm(*),x(*),geo(npropg,*),
78 . dtelem(*),stifn(*),stifr(*),partsav(20,*),v(*),msp(*),inp(*),
79 . stp(*),strp(*),sigbeam(nsigbeam,*),mcpp(*),
80 . temp(*)
81 my_real , INTENT (IN ) :: rbeam_vector(3,numelp)
82C
83 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
84 TYPE(PREL1D_) ,DIMENSION(NPRELOAD_A), TARGET :: PRELOAD_A
85 type (glob_therm_) ,intent(in) :: glob_therm
86C-----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
89 INTEGER I,IPT,IGTYP,NDEPAR,IPID,IMAT,NIP
90 INTEGER NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),MXT(MVSIZ),MXG(MVSIZ),
91 . IREL(6,MVSIZ),IVECT(MVSIZ)
92 my_real :: temp0
94 . x1(mvsiz),x2(mvsiz),x3(mvsiz),
95 . y1(mvsiz),y2(mvsiz),y3(mvsiz),
96 . z1(mvsiz),z2(mvsiz),z3(mvsiz),
97 . area(mvsiz) ,
98 . deltax(mvsiz),dtx(mvsiz),
99 . vect(3,mvsiz)
100 INTEGER IDMIN,IDMAX
101 DATA idmin /-1/,idmax /-1/
102 my_real :: lgthmin,lgthmax,cc1,undamp
103 DATA lgthmin /-1/,lgthmax /-1/
104C
105 TYPE(G_BUFEL_),POINTER :: GBUF
106C-----------------------------------------------
107 gbuf => elbuf_str%GBUF
108 ipid = ic(5,1+nft)
109 igtyp = igeo(11,ipid)
110
111C
112 CALL pcoori(x,ic(1,nft+1),
113 . mxt,mxg ,nc1,nc2,nc3,deltax,
114 . x1,x2,x3,y1,y2,y3,z1,z2,z3,
115 . ibeam_vector(nft+1),rbeam_vector(1,nft+1),ivect,vect)
116
117 imat = mxt(1)
118c
119 CALL peveci(gbuf%SKEW,x1,x3,y1,y3,z1,z3,x2,y2,z2,nc2,nc3,
120 . ivect,vect)
121C
122 IF (glob_therm%NINTEMP > 0) THEN
123 IF (igtyp == 18) THEN
124 IF (elbuf_str%BUFLY(1)%L_TEMP > 0) THEN
125 nip = igeo(3,mxg(1))
126 DO i = 1,nel
127 temp0 = half * (temp(nc1(i)) + temp(nc2(i)))
128 DO ipt=1,nip
129 elbuf_str%BUFLY(1)%LBUF(1,1,ipt)%TEMP(i) = temp0
130 ENDDO
131 ENDDO
132 END IF
133 ELSE IF (igtyp == 3 .and. elbuf_str%GBUF%G_TEMP > 0) THEN
134 DO i = 1,nel
135 elbuf_str%GBUF%TEMP(i) = half * (temp(nc1(i)) + temp(nc2(i)))
136 ENDDO
137 END IF
138 END IF
139!
140 CALL pmass(geo,pm,
141 . stifn,stifr,partsav,v,ipart(nft+1),
142 . msp(nft+1),inp(nft+1),igeo , stp(nft+1),
143 . x1,x2, y1,y2, z1,z2,
144 . nc1,nc2,imat,mxg,area,deltax,strp(nft+1),
145 . mcpp(nft+1) , temp ,glob_therm%NINTEMP)
146 CALL pibuf3(geo,gbuf%OFF,gbuf%LENGTH,deltax,mxg,irel)
147C------------------------------------------
148C Beam initialization
149C------------------------------------------
150 ipid = ic(5,1+nft)
151 igtyp = igeo(11,ipid)
152C
153 IF (isigi /= 0)
154 . CALL bsigini(elbuf_str,
155 . igtyp ,nel ,nsigbeam ,sigbeam ,ptbeam,
156 . ic(1,nft+1),igeo )
157 IF (iuser /= 0)
158 . CALL buserini(elbuf_str,
159 . ic(1,nft+1),sigbeam ,nsigbeam ,ptbeam ,igeo ,
160 . nel )
161C------------------------------------------
162C Compute beam element time step
163C------------------------------------------
164 DO i=1,nel
165 IF (igtyp /= 3 .AND. igtyp /= 18) THEN
166 CALL ancmsg(msgid=225,
167 . msgtype=msgerror,
168 . anmode=aninfo_blind_1,
169 . i1=igtyp)
170 ENDIF
171 IF (lgthmin == -1 .OR. deltax(i) < lgthmin) THEN
172 lgthmin = deltax(i)
173 idmin = ic(5,i+nft)
174 ENDIF
175 IF (lgthmax == -1 .OR. deltax(i) > lgthmax) THEN
176 lgthmax = deltax(i)
177 idmax = ic(5,i+nft)
178 ENDIF
179 ENDDO
180C-----------
181 CALL dt1lawp(pm,geo,mxt,mxg,deltax,dtx,igtyp)
182 ndepar=numels+numelc+numelt+nft
183C-----------
184 DO i=1,nel
185 dtelem(ndepar+i)=dtx(i)
186 ENDDO
187!--- /PRELOAD/AXIAL
188 IF (ipreld>0) THEN
189 cc1 =two*sqrt(two)
190 DO i=1,nel
191 undamp = cc1*msp(nft+i)*gbuf%LENGTH(i)/dtx(i)
192 gbuf%BPRELD(i) = preload_a(ipreld)%preload
193 gbuf%BPRELD(i+nel) = undamp*preload_a(ipreld)%damp
194 ENDDO
195 END IF
196C-----------
197 RETURN
subroutine bsigini(elbuf_str, igtyp, nel, nsigbeam, sigbeam, ptbeam, ixp, igeo)
Definition bsigini.F:36
subroutine buserini(elbuf_str, ixp, sigbeam, nsigbeam, ptbeam, igeo, nel)
Definition buserini.F:36
#define my_real
Definition cppsort.cpp:32
subroutine dt1lawp(pm, geo, mat, mxg, deltax, dtx, igtyp)
Definition dt1lawp.F:29
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine pcoori(x, ncp, mxt, mxg, nc1, nc2, nc3, deltax, x1, x2, x3, y1, y2, y3, z1, z2, z3, ibeam_vector, rbeam_vector, ivect, vect)
Definition pcoori.F:37
subroutine peveci(rloc, x1, x3, y1, y3, z1, z3, x2, y2, z2, nc2, nc3, ivect, vect)
Definition peveci.F:30
subroutine pibuf3(geo, off, tl, deltax, mxg, irel)
Definition pibuf3.F:29
subroutine pmass(geo, pm, stifn, stifr, partsav, v, ipart, msp, inp, igeo, stp, x1, x2, y1, y2, z1, z2, nc1, nc2, imat, mxg, area, al, strp, mcpp, temp, nintemp)
Definition pmass.F:35
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889