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