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
55 use element_mod , only : nixp
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C G l o b a l P a r a m e t e r s
62C-----------------------------------------------
63#include "mvsiz_p.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "param_c.inc"
68#include "com01_c.inc"
69#include "com04_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER :: NEL,NSIGBEAM,IUSER,NFT
74 INTEGER :: IC(NIXP,*),IPART(*),IGEO(NPROPGI,*),PTBEAM(*)
75 INTEGER , INTENT (IN ) :: IPRELD,NPRELOAD_A
76 INTEGER , INTENT (IN ) :: IBEAM_VECTOR(NUMELP)
78 . pm(*),x(*),geo(npropg,*),
79 . dtelem(*),stifn(*),stifr(*),partsav(20,*),v(*),msp(*),inp(*),
80 . stp(*),strp(*),sigbeam(nsigbeam,*),mcpp(*),
81 . temp(*)
82 my_real , INTENT (IN ) :: rbeam_vector(3,numelp)
83C
84 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
85 TYPE(PREL1D_) ,DIMENSION(NPRELOAD_A), TARGET :: PRELOAD_A
86 type (glob_therm_) ,intent(in) :: glob_therm
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER I,IPT,IGTYP,NDEPAR,IPID,IMAT,NIP
91 INTEGER NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),MXT(MVSIZ),MXG(MVSIZ),
92 . IREL(6,MVSIZ),IVECT(MVSIZ)
93 my_real :: temp0
95 . x1(mvsiz),x2(mvsiz),x3(mvsiz),
96 . y1(mvsiz),y2(mvsiz),y3(mvsiz),
97 . z1(mvsiz),z2(mvsiz),z3(mvsiz),
98 . area(mvsiz) ,
99 . deltax(mvsiz),dtx(mvsiz),
100 . vect(3,mvsiz)
101 INTEGER IDMIN,IDMAX
102 DATA idmin /-1/,idmax /-1/
103 my_real :: lgthmin,lgthmax,cc1,undamp
104 DATA lgthmin /-1/,lgthmax /-1/
105C
106 TYPE(G_BUFEL_),POINTER :: GBUF
107C-----------------------------------------------
108 gbuf => elbuf_str%GBUF
109 ipid = ic(5,1+nft)
110 igtyp = igeo(11,ipid)
111
112C
113 CALL pcoori(x,ic(1,nft+1),
114 . mxt,mxg ,nc1,nc2,nc3,deltax,
115 . x1,x2,x3,y1,y2,y3,z1,z2,z3,
116 . ibeam_vector(nft+1),rbeam_vector(1,nft+1),ivect,vect)
117
118 imat = mxt(1)
119c
120 CALL peveci(gbuf%SKEW,x1,x3,y1,y3,z1,z3,x2,y2,z2,nc2,nc3,
121 . ivect,vect)
122C
123 IF (glob_therm%NINTEMP > 0) THEN
124 IF (igtyp == 18) THEN
125 IF (elbuf_str%BUFLY(1)%L_TEMP > 0) THEN
126 nip = igeo(3,mxg(1))
127 DO i = 1,nel
128 temp0 = half * (temp(nc1(i)) + temp(nc2(i)))
129 DO ipt=1,nip
130 elbuf_str%BUFLY(1)%LBUF(1,1,ipt)%TEMP(i) = temp0
131 ENDDO
132 ENDDO
133 END IF
134 ELSE IF (igtyp == 3 .and. elbuf_str%GBUF%G_TEMP > 0) THEN
135 DO i = 1,nel
136 elbuf_str%GBUF%TEMP(i) = half * (temp(nc1(i)) + temp(nc2(i)))
137 ENDDO
138 END IF
139 END IF
140!
141 CALL pmass(geo,pm,
142 . stifn,stifr,partsav,v,ipart(nft+1),
143 . msp(nft+1),inp(nft+1),igeo , stp(nft+1),
144 . x1,x2, y1,y2, z1,z2,
145 . nc1,nc2,imat,mxg,area,deltax,strp(nft+1),
146 . mcpp(nft+1) , temp ,glob_therm%NINTEMP)
147 CALL pibuf3(geo,gbuf%OFF,gbuf%LENGTH,deltax,mxg,irel)
148C------------------------------------------
149C Beam initialization
150C------------------------------------------
151 ipid = ic(5,1+nft)
152 igtyp = igeo(11,ipid)
153C
154 IF (isigi /= 0)
155 . CALL bsigini(elbuf_str,
156 . igtyp ,nel ,nsigbeam ,sigbeam ,ptbeam,
157 . ic(1,nft+1),igeo )
158 IF (iuser /= 0)
159 . CALL buserini(elbuf_str,
160 . ic(1,nft+1),sigbeam ,nsigbeam ,ptbeam ,igeo ,
161 . nel )
162C------------------------------------------
163C Compute beam element time step
164C------------------------------------------
165 DO i=1,nel
166 IF (igtyp /= 3 .AND. igtyp /= 18) THEN
167 CALL ancmsg(msgid=225,
168 . msgtype=msgerror,
169 . anmode=aninfo_blind_1,
170 . i1=igtyp)
171 ENDIF
172 IF (lgthmin == -1 .OR. deltax(i) < lgthmin) THEN
173 lgthmin = deltax(i)
174 idmin = ic(5,i+nft)
175 ENDIF
176 IF (lgthmax == -1 .OR. deltax(i) > lgthmax) THEN
177 lgthmax = deltax(i)
178 idmax = ic(5,i+nft)
179 ENDIF
180 ENDDO
181C-----------
182 CALL dt1lawp(pm,geo,mxt,mxg,deltax,dtx,igtyp)
183 ndepar=numels+numelc+numelt+nft
184C-----------
185 DO i=1,nel
186 dtelem(ndepar+i)=dtx(i)
187 ENDDO
188!--- /PRELOAD/AXIAL
189 IF (ipreld>0) THEN
190 cc1 =two*sqrt(two)
191 DO i=1,nel
192 undamp = cc1*msp(nft+i)*gbuf%LENGTH(i)/dtx(i)
193 gbuf%BPRELD(i) = preload_a(ipreld)%preload
194 gbuf%BPRELD(i+nel) = undamp*preload_a(ipreld)%damp
195 ENDDO
196 END IF
197C-----------
198 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:895