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