OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s20init3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.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"

Go to the source code of this file.

Functions/Subroutines

subroutine s20init3 (elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ixs20, ipart, mssx, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, vnsx, bnsx, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, strsglob, straglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, glob_therm)

Function/Subroutine Documentation

◆ s20init3()

subroutine s20init3 ( 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(*) iparg,
dtelem,
sigi,
integer nel,
skew,
integer, dimension(npropgi,*) igeo,
stifn,
partsav,
v,
integer, dimension(*) iparts,
mss,
integer, dimension(12,*) ixs20,
integer, dimension(lipart1,*) ipart,
mssx,
sigsp,
integer nsigi,
integer, dimension(npropmi,*) ipm,
integer iuser,
integer nsigs,
volnod,
bvolnod,
vns,
bns,
vnsx,
bnsx,
integer, dimension(*) ptsol,
bufmat,
mcp,
mcps,
mcpsx,
temp,
integer, dimension(*) npf,
tf,
integer, dimension(*) strsglob,
integer, dimension(*) straglob,
integer, dimension(*) fail_ini,
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 (glob_therm_), intent(in) glob_therm )

Definition at line 47 of file s20init3.F.

59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 USE elbufdef_mod
63 USE detonators_mod
64 USE ale_connectivity_mod
65 USE matparam_def_mod
66 USE names_and_titles_mod , ONLY : nchartitle
67 USE message_mod
68 use glob_therm_mod
69 use s20temp_mod
70 use element_mod , only : nixs
71C-----------------------------------------------
72C I m p l i c i t T y p e s
73C-----------------------------------------------
74#include "implicit_f.inc"
75C-----------------------------------------------
76C G l o b a l P a r a m e t e r s
77C-----------------------------------------------
78#include "mvsiz_p.inc"
79C-----------------------------------------------
80C C o m m o n B l o c k s
81C-----------------------------------------------
82#include "com04_c.inc"
83#include "param_c.inc"
84#include "scr12_c.inc"
85#include "scr17_c.inc"
86#include "scry_c.inc"
87#include "vect01_c.inc"
88C-----------------------------------------------
89C D u m m y A r g u m e n t s
90C-----------------------------------------------
91 INTEGER IXS(NIXS,*),IPARG(*),IPARTS(*),IGEO(NPROPGI,*),
92 . IXS20(12,*), IPART(LIPART1,*), IPM(NPROPMI,*), PTSOL(*),
93 . NPF(*),STRSGLOB(*),STRAGLOB(*),FAIL_INI(*),PERTURB(NPERTURB)
94 INTEGER NEL,NSIGI,IUSER,NSIGS
95 my_real
96 . mas(*), pm(npropm,*), x(*), geo(npropg,*),
97 . veul(lveul,*), dtelem(*),sigi(nsigs,*),skew(lskew,*),stifn(*),
98 . partsav(20,*), v(*), mss(8,*), mssx(12,*), sigsp(nsigi,*),
99 . volnod(*),bvolnod(*), vns(8,*), bns(8,*),rnoise(nperturb,*),
100 . vnsx(12,*), bnsx(12,*),bufmat(*),mcp(*), mcps(8,*),mcpsx(12,*),
101 . temp(*), tf(*)
102 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
103 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
104 my_real,INTENT(IN) :: facload(lfacload,*)
105 TYPE(DETONATORS_STRUCT_)::DETONATORS
106 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
107 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
108 type (glob_therm_) ,intent(in) :: glob_therm
109C-----------------------------------------------
110C L o c a l V a r i a b l e s
111C-----------------------------------------------
112 INTEGER NF1, I, IGTYP, IP, NF2,NPTR,NPTS,NPTT,IR,IS,IT,
113 . NUVAR,IDEF,
114 . JHBE, IPID1,NLAY,L_PLA,L_SIGB
115 INTEGER NC(MVSIZ,20),MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ), NCC
116 CHARACTER(LEN=NCHARTITLE)::TITR1
117 my_real
118 . fv(1),
119 . mass(mvsiz),
120 . sti(mvsiz),deltax(mvsiz),deltax2(mvsiz),
121 . xx(mvsiz,20), yy(mvsiz,20), zz(mvsiz,20),
122 . vx(mvsiz,20), vy(mvsiz,20), vz(mvsiz,20),
123 . px(mvsiz,20), py(mvsiz,20), pz(mvsiz,20),
124 . rx(mvsiz),ry(mvsiz),rz(mvsiz),
125 . sx(mvsiz),sy(mvsiz),sz(mvsiz),
126 . tx(mvsiz),ty(mvsiz),tz(mvsiz),ul(mvsiz,20),
127 . ni(mvsiz,20),dnidr(mvsiz,20),dnids(mvsiz,20),dnidt(mvsiz,20),
128 . dtx(mvsiz), wi,rhocp(mvsiz),temp0(mvsiz), aire(mvsiz)
129 my_real :: tempel(nel)
130 INTEGER ,PARAMETER :: NPE=20
131C-----------------------------------------------
132 TYPE(L_BUFEL_) ,POINTER :: LBUF
133 TYPE(G_BUFEL_) ,POINTER :: GBUF
134 TYPE(BUF_MAT_) ,POINTER :: MBUF
135C-----------------------------------------------
136 my_real
137 . w_gauss(9,9),a_gauss(9,9)
138 DATA w_gauss /
139c---
140 1 2.d0 ,0.d0 ,0.d0 ,
141 1 0.d0 ,0.d0 ,0.d0 ,
142 1 0.d0 ,0.d0 ,0.d0 ,
143 2 1.d0 ,1.d0 ,0.d0 ,
144 2 0.d0 ,0.d0 ,0.d0 ,
145 2 0.d0 ,0.d0 ,0.d0 ,
146 3 0.555555555555556d0,0.888888888888889d0,0.555555555555556d0,
147 3 0.d0 ,0.d0 ,0.d0 ,
148 3 0.d0 ,0.d0 ,0.d0 ,
149 4 0.347854845137454d0,0.652145154862546d0,0.652145154862546d0,
150 4 0.347854845137454d0,0.d0 ,0.d0 ,
151 4 0.d0 ,0.d0 ,0.d0 ,
152 5 0.236926885056189d0,0.478628670499366d0,0.568888888888889d0,
153 5 0.478628670499366d0,0.236926885056189d0,0.d0 ,
154 5 0.d0 ,0.d0 ,0.d0 ,
155 6 0.171324492379170d0,0.360761573048139d0,0.467913934572691d0,
156 6 0.467913934572691d0,0.360761573048139d0,0.171324492379170d0,
157 6 0.d0 ,0.d0 ,0.d0 ,
158 7 0.129484966168870d0,0.279705391489277d0,0.381830050505119d0,
159 7 0.417959183673469d0,0.381830050505119d0,0.279705391489277d0,
160 7 0.129484966168870d0,0.d0 ,0.d0 ,
161 8 0.101228536290376d0,0.222381034453374d0,0.313706645877887d0,
162 8 0.362683783378362d0,0.362683783378362d0,0.313706645877887d0,
163 8 0.222381034453374d0,0.101228536290376d0,0.d0 ,
164 9 0.081274388361574d0,0.180648160694857d0,0.260610696402935d0,
165 9 0.312347077040003d0,0.330239355001260d0,0.312347077040003d0,
166 9 0.260610696402935d0,0.180648160694857d0,0.081274388361574d0/
167c------------------------------------------------------------
168 DATA a_gauss /
169 1 0.d0 ,0.d0 ,0.d0 ,
170 1 0.d0 ,0.d0 ,0.d0 ,
171 1 0.d0 ,0.d0 ,0.d0 ,
172 2 -.577350269189625d0,0.577350269189625d0,0.d0 ,
173 2 0.d0 ,0.d0 ,0.d0 ,
174 2 0.d0 ,0.d0 ,0.d0 ,
175 3 -.774596669241483d0,0.d0 ,0.774596669241483d0,
176 3 0.d0 ,0.d0 ,0.d0 ,
177 3 0.d0 ,0.d0 ,0.d0 ,
178 4 -.861136311594053d0,-.339981043584856d0,0.339981043584856d0,
179 4 0.861136311594053d0,0.d0 ,0.d0 ,
180 4 0.d0 ,0.d0 ,0.d0 ,
181 5 -.906179845938664d0,-.538469310105683d0,0.d0 ,
182 5 0.538469310105683d0,0.906179845938664d0,0.d0 ,
183 5 0.d0 ,0.d0 ,0.d0 ,
184 6 -.932469514203152d0,-.661209386466265d0,-.238619186083197d0,
185 6 0.238619186083197d0,0.661209386466265d0,0.932469514203152d0,
186 6 0.d0 ,0.d0 ,0.d0 ,
187 7 -.949107912342759d0,-.741531185599394d0,-.405845151377397d0,
188 7 0.d0 ,0.405845151377397d0,0.741531185599394d0,
189 7 0.949107912342759d0,0.d0 ,0.d0 ,
190 8 -.960289856497536d0,-.796666477413627d0,-.525532409916329d0,
191 8 -.183434642495650d0,0.183434642495650d0,0.525532409916329d0,
192 8 0.796666477413627d0,0.960289856497536d0,0.d0 ,
193 9 -.968160239507626d0,-.836031107326636d0,-.613371432700590d0,
194 9 -.324253423403809d0,0.d0 ,0.324253423403809d0,
195 9 0.613371432700590d0,0.836031107326636d0,0.968160239507626d0/
196C
197C-----------------------------------------------
198C S o u r c e L i n e s
199C=======================================================================
200 gbuf => elbuf_str%GBUF
201 igtyp = iparg(38)
202 jhbe = iparg(23)
203 nf1 = nft+1
204 nf2 = nf1-(numels8+numels10)
205c
206 DO i=lft,llt
207 rhocp(i) = pm(69,ixs(1,nft+i))
208 temp0(i) = pm(79,ixs(1,nft+i))
209 ENDDO
210C
211 CALL s20coor3(
212 1 x ,v ,ixs(1,nf1),ixs20(1,nf2),xx ,
213 2 yy ,zz ,vx ,vy ,vz ,
214 3 nc ,ngl ,mat ,pid ,mass ,
215 4 dtelem(nf1),sti ,gbuf%SIG ,gbuf%EINT ,gbuf%RHO,
216 5 gbuf%QVIS ,temp0 ,temp ,nel ,glob_therm%NINTEMP)
217C----------------------------------------
218C initialization of thermal
219C----------------------------------------
220 IF(jthe /=0) CALL atheri(mat,pm,gbuf%TEMP)
221C-----------------------------
222C POINTS D' INTEGRATION
223C-----------------------------
224 nptr = elbuf_str%NPTR
225 npts = elbuf_str%NPTS
226 nptt = elbuf_str%NPTT
227 nlay = elbuf_str%NLAY
228c
229 DO it=1,nptt
230 DO is=1,npts
231 DO ir=1,nptr
232c
233 lbuf => elbuf_str%BUFLY(1)%LBUF(ir,is,it)
234 mbuf => elbuf_str%BUFLY(1)%MAT(ir,is,it)
235 l_pla = elbuf_str%BUFLY(1)%L_PLA
236 l_sigb = elbuf_str%BUFLY(1)%L_SIGB
237 ip = ir + ( (is-1) + (it-1)*npts )*nptr
238 wi = w_gauss(ir,nptr)*w_gauss(is,npts)*w_gauss(it,nptt)
239C
240 CALL s20rst(
241 1 a_gauss(ir,nptr),a_gauss(is,npts),a_gauss(it,nptt),ni ,
242 2 dnidr ,dnids ,dnidt )
243c
244 CALL s20deri3(ngl,lbuf%OFF,
245 1 a_gauss(ir,nptr),a_gauss(is,npts),a_gauss(it,nptt),wi,
246 2 dnidr ,dnids ,dnidt ,rx ,ry ,rz ,
247 3 sx ,sy ,sz ,tx ,ty ,tz ,
248 4 xx ,yy ,zz ,px ,py ,pz ,
249 5 lbuf%VOL,deltax ,deltax2,ir*is*it,nptr*npts*nptt,ul ,
250 6 gbuf%VOL,lbuf%VOL0DP)
251C
252 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
253 CALL s20temp(nel,numnod,mvsiz,npe, nc,ni(1,ip),temp,tempel)
254 ELSE
255 tempel(1:nel) = temp0(1:nel)
256 ENDIF
257!
258 CALL matini(pm ,ixs ,nixs ,x ,
259 . geo ,ale_connectivity ,detonators,iparg ,
260 . sigi ,nel ,skew ,igeo ,
261 . ipart ,iparts ,
262 . mat ,ipm ,nsigs ,numsol ,ptsol ,
263 . ip ,ngl ,npf ,tf ,bufmat ,
264 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
265 . facload, deltax ,tempel ,mat_param )
266C----------------------------------------
267 aire(:) = zero
268 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
269 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
270 . gbuf%VOL, dtx , igeo,igtyp)
271C----------------------------------------
272c initialization of masses
273C
274 CALL s20msi(lbuf%RHO, mass , lbuf%VOL , dtelem(nf1), sti ,
275 . lbuf%OFF, lbuf%SIG, lbuf%EINT, dtx , nel ,
276 . gbuf%OFF, gbuf%SIG, gbuf%EINT, gbuf%RHO , wi/eight)
277C----------------------------------------
278 IF (mtn>=28)THEN
279 nuvar = ipm(8,ixs(1,nf1))
280 idef =1
281 ELSE
282 nuvar = 0
283 IF(mtn == 14 .OR. mtn == 12)THEN
284 idef =1
285 ELSEIF(mtn == 24)THEN
286 idef =1
287 ELSEIF(istrain == 1)THEN
288 IF(mtn == 1)THEN
289 idef =1
290 ELSEIF(mtn == 2)THEN
291 idef =1
292 ELSEIF(mtn == 4)THEN
293 idef =1
294 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn ==10.OR.
295 . mtn == 21.OR.mtn == 22.OR.
296 . mtn == 23.OR.mtn == 49)THEN
297 idef =1
298 ENDIF
299 ENDIF
300 ENDIF
301 CALL sigin20b(lbuf%SIG,pm ,lbuf%VOL,sigsp ,
302 . sigi ,lbuf%EINT,lbuf%RHO,mbuf%VAR ,lbuf%STRA,
303 . ixs ,nixs ,nsigi ,ip ,nuvar ,
304 . nel ,iuser ,idef ,nsigs ,strsglob ,
305 . straglob,jhbe ,igtyp ,x ,lbuf%GAMA,
306 . mat ,lbuf%PLA ,l_pla ,ptsol ,lbuf%SIGB,
307 . l_sigb ,ipm ,bufmat ,lbuf%VOL0DP)
308 ENDDO
309 ENDDO
310 ENDDO ! Points d'integration
311C------------------------------------------
312 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
313 aire(:) = zero
314 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
315 . gbuf%EINT ,gbuf%TEMP ,gbuf%DELTAX ,gbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
316 . gbuf%VOL, dtx , igeo,igtyp )
317c
318 CALL s20mass3(
319 1 mass ,mas,partsav,iparts(nf1),mss(1,nf1),gbuf%VOL ,
320 2 xx ,yy ,zz ,vx ,vy ,vz ,
321 3 nc ,sti,stifn ,deltax2 ,gbuf%RHO ,dtx ,
322 4 dtelem(nf1) ,mssx(1,nf1),rhocp ,mcp ,mcps(1,nf1),
323 5 mcpsx(1,nf1),gbuf%FILL)
324C----------------------------------------
325c Failure model initialisation
326C----------------------------------------
327 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
328 . ipm,sigsp,nsigi,fail_ini,
329 . sigi,nsigs,ixs,nixs,ptsol,
330 . rnoise,perturb,mat_param)
331C------------------------------------------
332C assembly of nodal volumes and nodal modules
333C (for interface stiffnesses)
334C------------------------------------------
335 IF(i7stifs/=0)THEN
336 ncc=20
337 CALL sbulk3(gbuf%VOL ,nc ,ncc ,mat ,pm ,
338 2 volnod ,bvolnod,vns(1,nf1),bns(1,nf1),vnsx(1,nf1),
339 3 bnsx(1,nf1),gbuf%FILL)
340 ENDIF
341C------------------------------------------
342 DO i=lft,llt
343 IF(ixs(10,i+nft)/=0) THEN
344 IF( igtyp/=0 .AND.igtyp/=6
345 . .AND.igtyp/=14.AND.igtyp/=15)THEN
346 ipid1=ixs(nixs-1,i+nft)
347 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
348 CALL ancmsg(msgid=226,
349 . msgtype=msgerror,
350 . anmode=aninfo_blind_1,
351 . i1=igeo(1,ipid1),
352 . c1=titr1,
353 . i2=igtyp)
354 ENDIF
355 ENDIF
356 ENDDO
357C-----------
358 RETURN
atheri
subroutine atheri(mat, pm, temp)
Definition atheri.F:42
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
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
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
s20msi
subroutine s20msi(rho, mass, volu, dtelem, sti, off, sig, eint, dtx, nel, offg, sigg, eintg, rhog, wip)
Definition s20mass3.F:281
s20mass3
subroutine s20mass3(mass, ms, partsav, ipart, mss, volg, xx, yy, zz, vx, vy, vz, nc, sti, stifn, deltax2, rho, dtx, dtelem, mssx, rhocp, mcp, mcps, mcpsx, fill)
Definition s20mass3.F:34
sigin20b
subroutine sigin20b(sig, pm, vol, sigsp, sigi, eint, rho, uvar, eps, ix, nix, nsigi, ipt, nuvar, nel, iuser, idef, nsigs, strsglob, straglob, jhbe, igtyp, x, bufgama, mat, epsp, l_pla, pt, sigb, l_sigb, ipm, bufmat, voldp)
Definition s20mass3.F:351
sbulk3
subroutine sbulk3(volu, nc, nnc, mat, pm, volnod, bvolnod, vns, bns, vnsx, bnsx, fill)
Definition sbulk3.F:43
s20coor3
subroutine s20coor3(x, v, ixs, ixs20, xx, yy, zz, vx, vy, vz, nc, ngl, mxt, ngeo, mass, dtelem, sti, sigg, eintg, rhog, qg, temp0, temp, nel, nintemp)
Definition s20coor3.F:38
s20deri3
subroutine s20deri3(ngl, off, r, s, t, w, dnidr, dnids, dnidt, dxdr, dydr, dzdr, dxds, dyds, dzds, dxdt, dydt, dzdt, xx, yy, zz, px, py, pz, vol, deltax, deltax2, ip, nip, ul, volg, voldp)
Definition s20deri3.F:38
s20rst
subroutine s20rst(r, s, t, ni, dnidr, dnids, dnidt)
Definition s20deri3.F:505
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