OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s4init3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr12_c.inc"
#include "scr17_c.inc"
#include "scry_c.inc"
#include "vect01_c.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine s4init3 (elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg_gr, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, msnf, iparg, mssf, ipm, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, iuser, sigsp, nsigi, mssa, xrefs, strsglob, straglob, fail_ini, spbuf, sol2sph, iloadp, facload, rnoise, perturb, mat_param, defaults_solid, nintemp)

Function/Subroutine Documentation

◆ s4init3()

subroutine s4init3 ( type(elbuf_struct_), target elbuf_str,
mas,
integer, dimension(nixs,*) ixs,
pm,
x,
type(detonators_struct_) detonators,
geo,
veul,
type(t_ale_connectivity), intent(inout) ale_connectivity,
integer, dimension(nparg) iparg_gr,
dtelem,
sigi,
integer nel,
skew,
integer, dimension(npropgi,*) igeo,
stifn,
partsav,
v,
integer, dimension(*) iparts,
mss,
integer, dimension(lipart1,*) ipart,
msnf,
integer, dimension(nparg,ngroup) iparg,
mssf,
integer, dimension(npropmi,*) ipm,
integer nsigs,
volnod,
bvolnod,
vns,
bns,
wma,
integer, dimension(*) ptsol,
bufmat,
mcp,
mcps,
temp,
integer, dimension(*) npf,
tf,
integer iuser,
sigsp,
integer nsigi,
mssa,
xrefs,
integer, dimension(*) strsglob,
integer, dimension(*) straglob,
integer, dimension(*) fail_ini,
spbuf,
integer, dimension(2,*) sol2sph,
integer, dimension(sizloadp,*), intent(in) iloadp,
dimension(lfacload,*), intent(in) facload,
rnoise,
integer, dimension(nperturb) perturb,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param,
type(solid_defaults_), intent(in) defaults_solid,
integer, intent(in) nintemp )

Definition at line 53 of file s4init3.F.

66C-----------------------------------------------
67C M o d u l e s
68C-----------------------------------------------
69 USE elbufdef_mod
70 USE message_mod
71 USE bpreload_mod
72 USE detonators_mod
73 USE ale_connectivity_mod
74 USE matparam_def_mod
75 USE defaults_mod
76 USE names_and_titles_mod , ONLY : nchartitle
77 use element_mod , only : nixs
78C-----------------------------------------------
79C I m p l i c i t T y p e s
80C-----------------------------------------------
81#include "implicit_f.inc"
82C-----------------------------------------------
83C G l o b a l P a r a m e t e r s
84C-----------------------------------------------
85#include "mvsiz_p.inc"
86C-----------------------------------------------
87C C o m m o n B l o c k s
88C-----------------------------------------------
89#include "com01_c.inc"
90#include "com04_c.inc"
91#include "param_c.inc"
92#include "scr12_c.inc"
93#include "scr17_c.inc"
94#include "scry_c.inc"
95#include "vect01_c.inc"
96#include "sphcom.inc"
97C-----------------------------------------------
98C D u m m y A r g u m e n t s
99C-----------------------------------------------
100 INTEGER IXS(NIXS,*),IPARG_GR(NPARG),IPARG(NPARG,NGROUP),
101 . IPARTS(*),IPART(LIPART1,*),IGEO(NPROPGI,*),PTSOL(*),NPF(*),
102 . IPM(NPROPMI,*),STRSGLOB(*),STRAGLOB(*),FAIL_INI(*),SOL2SPH(2,*),
103 . PERTURB(NPERTURB)
104 INTEGER NEL, NSIGS, IUSER, NSIGI
105 INTEGER ,INTENT(IN) :: NINTEMP
106 my_real
107 . mas(*), pm(npropm,*), x(*), geo(npropg,*),
108 . veul(lveul,*), dtelem(*),sigi(nsigs,*),skew(lskew,*),stifn(*),
109 . partsav(20,*), v(*), mss(8,*) ,
110 . msnf(*), mssf(8,*),wma(*),xrefs(8,3,*),
111 . volnod(*), bvolnod(*), vns(8,*), bns(8,*),bufmat(*),
112 . mcp(*), mcps(8,*), temp(*), tf(*),sigsp(nsigi,*), mssa(*),
113 . spbuf(nspbuf,*),rnoise(nperturb,*)
114 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
115 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
116 my_real,INTENT(IN) :: facload(lfacload,*)
117 TYPE(DETONATORS_STRUCT_)::DETONATORS
118 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
119 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
120 TYPE(SOLID_DEFAULTS_), INTENT(IN) :: DEFAULTS_SOLID
121C-----------------------------------------------
122C L o c a l V a r i a b l e s
123C-----------------------------------------------
124 INTEGER NF1,I,IGTYP,IREP,NCC,IP,NUVAR,IDEF,JHBE,IPID1,NPTR,NPTS,NPTT,NLAY,L_SIGB,L_PLA,IMAS_DS
125 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ), IXT4(MVSIZ,4)
126 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
127 INTEGER NSPHDIR,NCELF,NCELL,IBOLTP
128 double precision
129 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),y1(mvsiz),y2(mvsiz),
130 . y3(mvsiz),y4(mvsiz),z1(mvsiz),z2(mvsiz),z3(mvsiz),z4(mvsiz)
131 CHARACTER(LEN=NCHARTITLE)::TITR1
132 my_real
133 . bid, fv, sti
134 my_real
135 . rx(mvsiz),ry(mvsiz),rz(mvsiz),
136 . sx(mvsiz),sy(mvsiz),sz(mvsiz),
137 . tx(mvsiz),ty(mvsiz),tz(mvsiz),
138 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
139 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
140 . px1(mvsiz),px2(mvsiz),px3(mvsiz),px4(mvsiz),
141 . py1(mvsiz),py2(mvsiz),py3(mvsiz),py4(mvsiz),
142 . pz1(mvsiz),pz2(mvsiz),pz3(mvsiz),pz4(mvsiz),
143 . volu(mvsiz), dtx(mvsiz),rhocp(mvsiz),
144 . temp0(mvsiz), deltax(mvsiz), aire(mvsiz)
145 my_real :: tempel(nel)
146C-----------------------------------------------
147 TYPE(L_BUFEL_) ,POINTER :: LBUF
148 TYPE(G_BUFEL_) ,POINTER :: GBUF
149 TYPE(BUF_MAT_) ,POINTER :: MBUF
150C-----------------------------------------------
151C S o u r c e L i n e s
152C=======================================================================*
153 gbuf => elbuf_str%GBUF
154 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
155 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
156c
157 jhbe = iparg_gr(23)
158 irep = iparg_gr(35)
159 igtyp = iparg_gr(38)
160 nptr = elbuf_str%NPTR
161 npts = elbuf_str%NPTS
162 nptt = elbuf_str%NPTT
163 nlay = elbuf_str%NLAY
164 l_sigb= elbuf_str%BUFLY(1)%L_SIGB
165 l_pla = elbuf_str%BUFLY(1)%L_PLA
166 nf1=nft+1
167 IF(mtn>=28)THEN
168 nuvar = ipm(8,ixs(1,nf1))
169 ELSE
170 nuvar = 0
171 ENDIF
172C
173 imas_ds = defaults_solid%IMAS
174 iboltp = iparg_gr(72) !Bolt preloading
175 jcvt = iparg_gr(37)
176C
177 DO i=lft,llt
178 rhocp(i) = pm(69,ixs(1,nft+i))
179 temp0(i) = pm(79,ixs(1,nft+i))
180 ENDDO
181C
182 CALL s4coor3(x ,xrefs(1,1,nf1),ixs(1,nf1),ngl ,
183 . mat ,pid ,ix1 ,ix2 ,ix3 ,ix4 ,
184 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
185 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 )
186 CALL s4deri3(gbuf%VOL,veul(1,nf1),geo ,igeo ,rx ,
187 . ry ,rz ,sx ,sy ,
188 . sz ,tx ,ty ,tz ,
189 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
190 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
191 . px1 ,px2 ,px3 ,px4 ,
192 . py1 ,py2 ,py3 ,py4 ,
193 . pz1 ,pz2 ,pz3 ,pz4 ,gbuf%JAC_I,
194 . deltax ,volu ,ngl ,pid ,mat ,
195 . pm ,lbuf%VOL0DP)
196 irep = iparg_gr(35)
197 CALL sreploc3(
198 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
199 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
200 IF (igtyp == 6 .OR. igtyp == 21)
201 . CALL smorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
202 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
203 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
204 . rx ,ry ,rz ,sx ,sy ,sz ,nsigi,sigsp,nsigs,
205 . sigi ,ixs ,x ,jhbe ,ptsol,nel ,iparg_gr(28))
206!
207! Initialize element temperature from /initemp
208!
209 IF (jthe == 0 .and. nintemp > 0) THEN
210 DO i=1,nel
211 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
212 . + temp(ixs(4,i)) + temp(ixs(5,i))
213 . + temp(ixs(6,i)) + temp(ixs(7,i))
214 . + temp(ixs(8,i)) + temp(ixs(9,i)))
215 ENDDO
216 ELSE
217 tempel(1:nel) = temp0(1:nel)
218 END IF
219!
220 ip=1
221 CALL matini(pm ,ixs ,nixs ,x ,
222 . geo ,ale_connectivity ,detonators ,iparg_gr ,
223 . sigi ,nel ,skew ,igeo ,
224 . ipart ,iparts ,
225 . mat ,ipm ,nsigs ,numsol ,ptsol ,
226 . ip ,ngl ,npf ,tf ,bufmat ,
227 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
228 . facload, deltax ,tempel ,mat_param )
229C
230 ! Density perturbation for /MAT/LAW115
231 IF (mtn == 115) THEN
232 CALL m115_perturb(pm ,mat ,gbuf%RHO ,perturb ,rnoise )
233 ENDIF
234C
235 IF (iboltp /=0) THEN
236 CALL sboltini(e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
237 1 gbuf%BPRELD,nel ,ixs ,nixs ,vpreload, iflag_bpreload)
238 ENDIF
239C----------------------------------------
240C initialization of thermal and turbulence
241C----------------------------------------
242 IF(jthe /=0) CALL atheri(mat ,pm ,gbuf%TEMP)
243 IF(jtur /=0) CALL aturi3(iparg ,gbuf%RHO,pm ,ixs ,x ,
244 . gbuf%RK ,gbuf%RE ,volu )
245C----------------------------------------
246C initialization of masses
247C----------------------------------------
248 IF(jlag+jale+jeul/=0) THEN
249C-------- case /INIBRIS/STRS_FGLO missed
250 IF (isigi /= 0 .AND. (jcvt/=0.OR.isorth/=0))
251 . CALL ustrsin3(
252 . sigi ,lbuf%SIG ,ixs ,nixs ,nsigs ,
253 . nel ,strsglob ,jhbe ,igtyp ,x ,
254 . gbuf%GAMA,ptsol ,lbuf%VOL0DP,rhocp,gbuf%RHO)
255C
256 idef = 0
257 IF(mtn >= 28.AND. mtn /= 49)THEN
258 idef = 1
259 ELSEIF(mtn == 14 .OR. mtn == 12) THEN
260 idef = 1
261 ELSEIF(istrain == 1)THEN
262 IF(mtn == 1)THEN
263 idef = 1
264 ELSEIF(mtn == 2)THEN
265 idef = 1
266 ELSEIF(mtn == 4)THEN
267 idef = 1
268 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn == 10.OR.
269 . mtn == 21.OR.mtn == 22.OR.mtn == 23)THEN
270 idef = 1
271 ENDIF
272 ENDIF
273C
274 IF (isigi /= 0 .AND. ((mtn >= 28 .AND. iuser == 1).OR.
275 . (nvsolid2 /= 0 .and .idef /=0)))
276 . CALL userin3(
277 . sigsp ,sigi ,mbuf%VAR ,lbuf%STRA,
278 . ixs ,nixs ,nsigi ,nuvar ,nel ,
279 . nsigs ,iuser ,idef ,straglob ,jhbe ,
280 . igtyp ,x ,gbuf%GAMA,ptsol ,lbuf%SIGB,
281 . l_sigb ,mat(1) ,ipm ,bufmat ,lbuf%PLA,
282 . l_pla )
283c
284 CALL s4mass3(
285 1 gbuf%RHO ,mas ,partsav,x ,v,
286 2 iparts(nf1),mss(1,nf1),msnf ,mssf(1,nf1),wma,
287 3 rhocp ,mcp ,mcps(1,nf1),temp0,temp ,
288 4 mssa ,ix1 ,ix2 ,ix3 ,ix4 ,
289 5 gbuf%FILL, volu ,imas_ds ,nintemp )
290C------------------------------------------
291C assembly of nodal volumes and nodal modules
292C (for interface stiffnesses)
293C------------------------------------------
294C Please note: IX1, IX2 ... IX4 are in the form NC (MVSIZ, 4)
295 IF(i7stifs/=0)THEN
296 ncc=4
297 ixt4(1:mvsiz,1) = ix1(1:mvsiz)
298 ixt4(1:mvsiz,2) = ix2(1:mvsiz)
299 ixt4(1:mvsiz,3) = ix3(1:mvsiz)
300 ixt4(1:mvsiz,4) = ix4(1:mvsiz)
301 CALL sbulk3(volu ,ixt4 ,ncc,mat,pm ,
302 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
303 3 bid ,gbuf%FILL)
304 ENDIF
305 ENDIF
306C----------------------------------------
307c Initialization of stress tensor in case of Orthotropic properties
308C----------------------------------------
309 IF (isigi /= 0 .AND. isorth/=0) THEN
310 lbuf%SIGL = lbuf%SIG
311 ENDIF
312C----------------------------------------
313c Failure model initialisation
314C----------------------------------------
315 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
316 . ipm,sigsp,nsigi,fail_ini ,
317 . sigi,nsigs,ixs,nixs,ptsol,rnoise,perturb,mat_param)
318C----------------------------------------
319c initialisation inibri/eref
320C----------------------------------------
321 IF (nsigi > 0.AND.(ismstr==10.OR.ismstr==12)) THEN
322 CALL s4jaci3(gbuf%SMSTR,gbuf%JAC_I, gbuf%VOL,nel )
323 END IF
324C------------------------------------------
325C calculation of elementary timesteps
326c
327 aire(:) = zero
328 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
329 . gbuf%EINT ,gbuf%TEMP ,gbuf%DELTAX ,gbuf%RK ,gbuf%RE ,bufmat, deltax, aire,
330 . volu, dtx ,igeo,igtyp)
331C------------------------------------------
332c
333 DO 10 i=lft,llt
334 IF(ixs(10,i+nft)/=0) THEN
335 IF( igtyp/=0 .AND.igtyp/=6
336 . .AND.igtyp/=14.AND.igtyp/=15)THEN
337 ipid1=ixs(nixs-1,i+nft)
338 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
339 CALL ancmsg(msgid=226,
340 . msgtype=msgerror,
341 . anmode=aninfo_blind_1,
342 . i1=igeo(1,ipid1),
343 . c1=titr1,
344 . i2=igtyp)
345 ENDIF
346 ENDIF
347 dtelem(nft+i)=dtx(i)
348C STI = 2 * (MASS/4) /dt^2
349 sti = half * gbuf%FILL(i)* gbuf%RHO(i) * volu(i) /
350 . max(em20,dtx(i)*dtx(i))
351 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
352 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
353 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
354 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
355 10 CONTINUE
356C------------------------------------------
357C SOLID TO SPH, COMPUTE INITIAL VOLUME & MASS OF PARTICLES
358C------------------------------------------
359 IF(nsphsol/=0)THEN
360 DO i=lft,llt
361 IF(sol2sph(1,nft+i) < sol2sph(2,nft+i))THEN
362C SOL2SPH(1,N)+1<=I<=SOLSPH(2,N) <=> N==SPH2SOL(I)
363 nsphdir=igeo(37,ixs(10,nft+i))
364 ncelf =sol2sph(1,nft+i)+1
365 ncell =sol2sph(2,nft+i)-sol2sph(1,nft+i)
366 CALL soltosphv4(
367 . nsphdir ,gbuf%RHO(i) ,ncell ,x ,spbuf(1,ncelf),
368 . ixs(1,i+nft))
369 END IF
370 ENDDO
371 END IF
372C-----------
373 RETURN
atheri
subroutine atheri(mat, pm, temp)
Definition atheri.F:42
aturi3
subroutine aturi3(iparg, rho, pm, ix, x, rk, re, volu)
Definition aturi3.F:33
my_real
#define my_real
Definition cppsort.cpp:32
dtmain
subroutine dtmain(geo, pm, ipm, pid, mat, fv, eint, temp, deltax, rk, re, bufmat, ddeltax, aire, vol, dtx, igeo, igtyp)
Definition dtmain.F:68
failini
subroutine failini(elbuf_str, nptr, npts, nptt, nlay, ipm, sigsp, nsigi, fail_ini, sigi, nsigs, ix, nix, pt, rnoise, perturb, mat_param)
Definition failini.F:44
m115_perturb
subroutine m115_perturb(pm, mat, rho, perturb, rnoise)
Definition m115_perturb.F:30
max
#define max(a, b)
Definition macros.h:21
matini
subroutine matini(pm, ix, nix, x, geo, ale_connectivity, detonators, iparg, sigi, nel, skew, igeo, ipart, ipartel, mat, ipm, nsig, nums, pt, ipt, ngl, npf, tf, bufmat, gbuf, lbuf, mbuf, elbuf_str, iloadp, facload, ddeltax, tempel, mat_param)
Definition matini.F:83
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
bpreload_mod
Definition bpreload_mod.F:40
bpreload_mod::iflag_bpreload
integer, dimension(:), allocatable iflag_bpreload
Definition bpreload_mod.F:48
detonators_mod
Definition detonators_mod.F:80
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
s4jaci3
subroutine s4jaci3(sav, jac_i, vol, nel)
Definition s4jaci3.F:29
s4mass3
subroutine s4mass3(rho, ms, partsav, x, v, ipart, mss, msnf, mssf, wma, rhocp, mcp, mcps, temp0, temp, mssa, ix1, ix2, ix3, ix4, fill, volu, imas_ds, nintemp)
Definition s4mass3.F:41
sboltini
subroutine sboltini(e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, bpreld, nel, ix, nix, vpreload, iflag_bpreload)
Definition sboltini.F:33
sbulk3
subroutine sbulk3(volu, nc, nnc, mat, pm, volnod, bvolnod, vns, bns, vnsx, bnsx, fill)
Definition sbulk3.F:43
smorth3
subroutine smorth3(pid, geo, igeo, skew, irep, gama, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, nsigi, sigsp, nsigs, sigi, ixs, x, jhbe, pt, nel, isolnod)
Definition smorth3.F:43
s4coor3
subroutine s4coor3(x, xrefs, ixs, ngl, mxt, ngeo, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4)
Definition s4coor3.F:40
s4deri3
subroutine s4deri3(vol, veul, geo, igeo, rx, ry, rz, sx, sy, sz, tx, ty, tz, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, jac_i, deltax, det, ngl, ngeo, mxt, pm, voldp)
Definition s4deri3.F:47
sreploc3
subroutine sreploc3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition sreploc3.F:32
soltosphv4
subroutine soltosphv4(nsphdir, rho, ncell, x, spbuf, ixs)
Definition soltosph.F:591
ancmsg
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
userin3
subroutine userin3(sigsp, sigi, uvar, eps, ix, nix, nsigi, nuvar, nel, nsigs, iuser, idef, straglob, jhbe, igtyp, x, bufgama, pt, sigb, l_sigb, imat, ipm, bufmat, pla, l_pla)
Definition userin3.F:38
ustrsin3
subroutine ustrsin3(sigi, sig, ix, nix, nsigi, nel, strsglob, jhbe, igtyp, x, bufgama, pt, voldp, rho0, rho)
Definition userin3.F:168