OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s8zinit3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr03_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 s8zinit3 (elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, glob_therm, sigsp, nsigi, msnf, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, xrefs, mssa, strsglob, straglob, fail_ini, spbuf, kxsp, ipartsp, nod2sp, sol2sph, irst, iloadp, facload, perturb, rnoise, mat_param)

Function/Subroutine Documentation

◆ s8zinit3()

subroutine s8zinit3 ( 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(lipart1,*) ipart,
type (glob_therm_), intent(in) glob_therm,
sigsp,
integer nsigi,
msnf,
mssf,
integer, dimension(npropmi,*) ipm,
integer iuser,
integer nsigs,
volnod,
bvolnod,
vns,
bns,
wma,
integer, dimension(*) ptsol,
bufmat,
mcp,
mcps,
temp,
integer, dimension(*) npf,
tf,
xrefs,
mssa,
integer, dimension(*) strsglob,
integer, dimension(*) straglob,
integer, dimension(*) fail_ini,
spbuf,
integer, dimension(nisp,*) kxsp,
integer, dimension(*) ipartsp,
integer, dimension(*) nod2sp,
integer, dimension(2,*) sol2sph,
integer, dimension(3,*) irst,
integer, dimension(sizloadp,*), intent(in) iloadp,
dimension(lfacload,*), intent(in) facload,
integer, dimension(nperturb) perturb,
rnoise,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param )

Definition at line 58 of file s8zinit3.F.

70C-----------------------------------------------
71C M o d u l e s
72C-----------------------------------------------
73 USE elbufdef_mod
74 USE message_mod
75 USE bpreload_mod
76 USE detonators_mod
77 USE ale_connectivity_mod
78 USE matparam_def_mod
79 USE names_and_titles_mod , ONLY : nchartitle
80 use glob_therm_mod
81 use element_mod , only : nixs
82C-----------------------------------------------
83C I m p l i c i t T y p e s
84C-----------------------------------------------
85#include "implicit_f.inc"
86C-----------------------------------------------
87C G l o b a l P a r a m e t e r s
88C-----------------------------------------------
89#include "mvsiz_p.inc"
90C-----------------------------------------------
91C C o m m o n B l o c k s
92C-----------------------------------------------
93#include "com01_c.inc"
94#include "com04_c.inc"
95#include "param_c.inc"
96#include "scr03_c.inc"
97#include "scr12_c.inc"
98#include "scr17_c.inc"
99#include "scry_c.inc"
100#include "vect01_c.inc"
101#include "sphcom.inc"
102C-----------------------------------------------
103C D u m m y A r g u m e n t s
104C-----------------------------------------------
105 INTEGER IXS(NIXS,*), IPARG(*),IPARTS(*),
106 . NEL, IPART(LIPART1,*),IPM(NPROPMI,*), PTSOL(*),
107 . NSIGI, IUSER, NSIGS, NPF(*),
108 . KXSP(NISP,*), IPARTSP(*), NOD2SP(*), SOL2SPH(2,*), IRST(3,*)
109 INTEGER IGEO(NPROPGI,*),STRSGLOB(*),STRAGLOB(*),FAIL_INI(*),PERTURB(NPERTURB)
110 my_real
111 . mas(*),pm(npropm,*), x(*), geo(npropg,*),
112 . veul(lveul,*), dtelem(*),sigi(nsigs,*),skew(lskew,*),stifn(*),
113 . partsav(20,*), v(*), mss(8,*),
114 . sigsp(nsigi,*),msnf(*), mssf(8,*), wma(*),
115 . volnod(*), bvolnod(*), vns(8,*), bns(8,*),bufmat(*),
116 . mcp(*), mcps(8,*),temp(*), tf(*),xrefs(8,3,*), mssa(*),
117 . spbuf(nspbuf,*),rnoise(nperturb,*)
118 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
119 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
120 my_real,INTENT(IN) :: facload(lfacload,*)
121 TYPE(DETONATORS_STRUCT_)::DETONATORS
122 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
123 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
124 type (glob_therm_) ,intent(in) :: glob_therm
125C-----------------------------------------------
126C L o c a l V a r i a b l e s
127C-----------------------------------------------
128 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ)
129 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
130 . IX5(MVSIZ), IX6(MVSIZ), IX7(MVSIZ), IX8(MVSIZ)
131 INTEGER NF1, I, IL, IGTYP,IPID1,NCC,IDEF,NREFSTA,
132 . IP,IR, IS, IT,JHBE,IREP,MPT,NLAY,NPTR,NPTS,NPTT,NUVAR,
133 . L_PLA,L_SIGB,NSPHDIR, NCELF, NCELL,IBOLTP,NNPT
134 CHARACTER(LEN=NCHARTITLE)::TITR1
135 my_real
136 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),x5(mvsiz),x6(mvsiz),
137 . x7(mvsiz),x8(mvsiz),y1(mvsiz),y2(mvsiz),y3(mvsiz),y4(mvsiz),
138 . y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
139 . z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
140 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
141 . sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
142 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
143 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
144 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,
145 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz) ,
146 . ajc1(mvsiz) , ajc2(mvsiz) , ajc3(mvsiz) ,
147 . ajc4(mvsiz) , ajc5(mvsiz) , ajc6(mvsiz) ,
148 . ajc7(mvsiz) , ajc8(mvsiz) , ajc9(mvsiz) ,
149 . hx(4,mvsiz) , hy(4,mvsiz), hz(4,mvsiz),
150 . smax(mvsiz) , volu(mvsiz), dtx(mvsiz), deltax(mvsiz),
151 . pxc1(mvsiz),pxc2(mvsiz),pxc3(mvsiz),pxc4(mvsiz),
152 . pyc1(mvsiz),pyc2(mvsiz),pyc3(mvsiz),pyc4(mvsiz),
153 . pzc1(mvsiz),pzc2(mvsiz),pzc3(mvsiz),pzc4(mvsiz),
154 . rhocp(mvsiz),temp0(mvsiz),aire(mvsiz),nu(mvsiz)
155 my_real
156 . bid(mvsiz), fv, sti, wi
157 INTEGER NLYMAX, IPANG, IPMAT
158 INTEGER LLPIJ
159 parameter(nlymax = 200,ipmat = 100,ipang = 200)
160 my_real
161 . ajp1(mvsiz,8) , ajp2(mvsiz,8) , ajp3(mvsiz,8) ,
162 . ajp4(mvsiz,8) , ajp5(mvsiz,8) , ajp6(mvsiz,8) ,
163 . ajp7(mvsiz,8) , ajp8(mvsiz,8) , ajp9(mvsiz,8) ,
164 . dtx0(mvsiz),wt,zr,zs,zt
165 DOUBLE PRECISION
166 . XD1(MVSIZ), XD2(MVSIZ), XD3(MVSIZ), XD4(MVSIZ),
167 . XD5(MVSIZ), XD6(MVSIZ), XD7(MVSIZ), XD8(MVSIZ),
168 . YD1(MVSIZ), YD2(MVSIZ), YD3(MVSIZ), YD4(MVSIZ),
169 . YD5(MVSIZ), YD6(MVSIZ), YD7(MVSIZ), YD8(MVSIZ),
170 . ZD1(MVSIZ), ZD2(MVSIZ), ZD3(MVSIZ), ZD4(MVSIZ),
171 . ZD5(MVSIZ), ZD6(MVSIZ), ZD7(MVSIZ), ZD8(MVSIZ)
172 my_real :: tempel(nel)
173C-----------------------------------------------
174 TYPE(L_BUFEL_) ,POINTER :: LBUF
175 TYPE(G_BUFEL_) ,POINTER :: GBUF
176 TYPE(BUF_MAT_) ,POINTER :: MBUF
177C-----------------------------------------------
178 my_real
179 . w_gauss(9,9),a_gauss(9,9)
180 DATA w_gauss /
181c---
182 1 2.d0 ,0.d0 ,0.d0 ,
183 1 0.d0 ,0.d0 ,0.d0 ,
184 1 0.d0 ,0.d0 ,0.d0 ,
185 2 1.d0 ,1.d0 ,0.d0 ,
186 2 0.d0 ,0.d0 ,0.d0 ,
187 2 0.d0 ,0.d0 ,0.d0 ,
188 3 0.555555555555556d0,0.888888888888889d0,0.555555555555556d0,
189 3 0.d0 ,0.d0 ,0.d0 ,
190 3 0.d0 ,0.d0 ,0.d0 ,
191 4 0.347854845137454d0,0.652145154862546d0,0.652145154862546d0,
192 4 0.347854845137454d0,0.d0 ,0.d0 ,
193 4 0.d0 ,0.d0 ,0.d0 ,
194 5 0.236926885056189d0,0.478628670499366d0,0.568888888888889d0,
195 5 0.478628670499366d0,0.236926885056189d0,0.d0 ,
196 5 0.d0 ,0.d0 ,0.d0 ,
197 6 0.171324492379170d0,0.360761573048139d0,0.467913934572691d0,
198 6 0.467913934572691d0,0.360761573048139d0,0.171324492379170d0,
199 6 0.d0 ,0.d0 ,0.d0 ,
200 7 0.129484966168870d0,0.279705391489277d0,0.381830050505119d0,
201 7 0.417959183673469d0,0.381830050505119d0,0.279705391489277d0,
202 7 0.129484966168870d0,0.d0 ,0.d0 ,
203 8 0.101228536290376d0,0.222381034453374d0,0.313706645877887d0,
204 8 0.362683783378362d0,0.362683783378362d0,0.313706645877887d0,
205 8 0.222381034453374d0,0.101228536290376d0,0.d0 ,
206 9 0.081274388361574d0,0.180648160694857d0,0.260610696402935d0,
207 9 0.312347077040003d0,0.330239355001260d0,0.312347077040003d0,
208 9 0.260610696402935d0,0.180648160694857d0,0.081274388361574d0/
209c------------------------------------------------------------
210 DATA a_gauss /
211 1 0.d0 ,0.d0 ,0.d0 ,
212 1 0.d0 ,0.d0 ,0.d0 ,
213 1 0.d0 ,0.d0 ,0.d0 ,
214 2 -.577350269189625d0,0.577350269189625d0,0.d0 ,
215 2 0.d0 ,0.d0 ,0.d0 ,
216 2 0.d0 ,0.d0 ,0.d0 ,
217 3 -.774596669241483d0,0.d0 ,0.774596669241483d0,
218 3 0.d0 ,0.d0 ,0.d0 ,
219 3 0.d0 ,0.d0 ,0.d0 ,
220 4 -.861136311594053d0,-.339981043584856d0,0.339981043584856d0,
221 4 0.861136311594053d0,0.d0 ,0.d0 ,
222 4 0.d0 ,0.d0 ,0.d0 ,
223 5 -.906179845938664d0,-.538469310105683d0,0.d0 ,
224 5 0.538469310105683d0,0.906179845938664d0,0.d0 ,
225 5 0.d0 ,0.d0 ,0.d0 ,
226 6 -.932469514203152d0,-.661209386466265d0,-.238619186083197d0,
227 6 0.238619186083197d0,0.661209386466265d0,0.932469514203152d0,
228 6 0.d0 ,0.d0 ,0.d0 ,
229 7 -.949107912342759d0,-.741531185599394d0,-.405845151377397d0,
230 7 0.d0 ,0.405845151377397d0,0.741531185599394d0,
231 7 0.949107912342759d0,0.d0 ,0.d0 ,
232 8 -.960289856497536d0,-.796666477413627d0,-.525532409916329d0,
233 8 -.183434642495650d0,0.183434642495650d0,0.525532409916329d0,
234 8 0.796666477413627d0,0.960289856497536d0,0.d0 ,
235 9 -.968160239507626d0,-.836031107326636d0,-.613371432700590d0,
236 9 -.324253423403809d0,0.d0 ,0.324253423403809d0,
237 9 0.613371432700590d0,0.836031107326636d0,0.968160239507626d0/
238C
239C-----------------------------------------------
240C S o u r c e L i n e s
241C=======================================================================
242 dtx(1:mvsiz) = zero
243 dtx0(1:mvsiz) = zero
244 il = 1
245 gbuf => elbuf_str%GBUF
246 mbuf => elbuf_str%BUFLY(il)%MAT(1,1,1)
247 lbuf => elbuf_str%BUFLY(il)%LBUF(1,1,1)
248 nptr = elbuf_str%NPTR
249 npts = elbuf_str%NPTS
250 nptt = elbuf_str%NPTT
251c
252 bid(:) = zero
253 nrefsta = nxref
254 nxref = 0
255 mpt =iabs(npt)
256 DO i=lft,llt
257 deltax(i)=ep30
258 ENDDO
259 jhbe = iparg(23)
260 IF (jhbe == 17) mpt = 222
261 irep = iparg(35)
262 igtyp = iparg(38)
263 IF (jhbe == 17) jcvt=iparg(37)
264C
265 IF (jcvt==1.AND.isorth/=0) jcvt=2
266C
267 nf1=nft+1
268 idef =0
269C
270 iboltp = iparg(72) !Bolt preloading
271C
272 DO i=lft,llt
273 rhocp(i) = pm(69,ixs(1,nft+i))
274 temp0(i) = pm(79,ixs(1,nft+i))
275 ENDDO
276
277C-----JAC_I [J]^-1 is calculated in global system
278 IF (ismstr==10.OR.ismstr==12) THEN
279C cas GBUF%JAC_I for all case
280 CALL scoor3(x ,bid(1) ,ixs(1,nf1) ,geo ,mat ,pid ,ngl ,
281 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
282 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
283 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
284 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
285 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
286 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
287 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0, temp,glob_therm%NINTEMP,
288 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
289 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
290 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
291 IF (nsigi > 0 ) THEN
292 CALL s8erefcoor3(gbuf%SMSTR,8,nel,
293 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
294 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
295 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
296 END IF
297 CALL s8zjac_ic(
298 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
299 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
300 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 ,
301 . ajc1 ,ajc2 ,ajc3 ,
302 . ajc4 ,ajc5 ,ajc6 ,
303 . ajc7 ,ajc8 ,ajc9 ,
304 . hx, hy, hz,
305 . gbuf%JAC_I)
306 llpij = elbuf_str%BUFLY(il)%L_PIJ
307 IF (llpij<=24) THEN
308 DO ir=1,nptr
309 DO is=1,npts
310 DO it=1,nptt
311C-----------
312 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
313c
314 zr = a_gauss(ir,nptr)
315 zs = a_gauss(is,npts)
316 zt = a_gauss(it,nptt)
317 wt = w_gauss(it,nptt)
318 ip = ir + ( (is-1) + (it-1)*npts )*nptr
319 wi = w_gauss(ir,nptr)*w_gauss(is,npts)*wt
320C
321C cas LBUF%L_PIJ=24 global system w/o assumed strain for Isolid=17,18 only
322 CALL s8zjac_i3(
323 . zr,zs,zt,wi,
324 . hx, hy, hz,
325 . ajc1,ajc2,ajc3,
326 . ajc4,ajc5,ajc6,
327 . ajc7,ajc8,ajc9,lbuf%JAC_I,llpij,lbuf%PIJ,llt)
328c
329 ENDDO
330 ENDDO
331 ENDDO
332C cas LBUF%L_PIJ>24 local system w/ assumed strain and return to global only for Isolid=18
333!
334 ELSE
335!
336 CALL srcoor3(x,bid(1),ixs(1,nf1) ,geo ,mat ,pid ,ngl ,jhbe ,
337 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
338 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
339 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
340 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
341 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
342 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
343 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0,temp,glob_therm%NINTEMP,
344 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
345 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
346 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
347 CALL s8zpij_ic(
348 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
349 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
350 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 ,
351 . ajc1 ,ajc2 ,ajc3 ,
352 . ajc4 ,ajc5 ,ajc6 ,
353 . ajc7 ,ajc8 ,ajc9 ,
354 . hx, hy, hz,
355 . pxc1, pxc2, pxc3, pxc4,
356 . pyc1, pyc2, pyc3, pyc4,
357 . pzc1, pzc2, pzc3, pzc4)
358C-----------Begin integrating points-----
359 DO ir=1,nptr
360 DO is=1,npts
361 DO it=1,nptt
362C-----------
363 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
364c
365 zr = a_gauss(ir,nptr)
366 zs = a_gauss(is,npts)
367 zt = a_gauss(it,nptt)
368 wt = w_gauss(it,nptt)
369 ip = ir + ( (is-1) + (it-1)*npts )*nptr
370 wi = w_gauss(ir,nptr)*w_gauss(is,npts)*wt
371C
372 CALL s8zjac_i3(
373 . zr,zs,zt,wi,
374 . hx, hy, hz,
375 . ajc1,ajc2,ajc3,
376 . ajc4,ajc5,ajc6,
377 . ajc7,ajc8,ajc9,lbuf%JAC_I,llpij,lbuf%PIJ,llt)
378c
379 ENDDO
380 ENDDO
381 ENDDO
382!
383 nnpt = 8
384 DO i=lft,llt
385 nu(i)=min(half,pm(21,mat(i)))
386 ENDDO
387 CALL s8e_pij(nptr,npts,nptt,nnpt,llt,
388 . pxc1, pxc2, pxc3, pxc4,
389 . pyc1, pyc2, pyc3, pyc4,
390 . pzc1, pzc2, pzc3, pzc4,
391 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
392 . nu ,elbuf_str)
393 END IF !(LLPIJ<=24) THEN
394 END IF !(ISMSTR==10.OR.ISMSTR==12)
395 IF (jcvt == 0) THEN
396 CALL scoor3(x ,bid(1),ixs(1,nf1) ,geo ,mat ,pid ,ngl ,
397 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
398 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
399 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
400 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
401 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
402 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
403 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0, temp,glob_therm%NINTEMP,
404 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
405 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
406 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
407 ELSE
408 CALL srcoor3(x,bid(1),ixs(1,nf1) ,geo ,mat ,pid ,ngl ,jhbe ,
409 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
410 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
411 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
412 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
413 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
414 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
415 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0,temp,glob_therm%NINTEMP,
416 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
417 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
418 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
419 ENDIF
420
421!
422! Initialize element temperature from /initemp
423!
424 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
425 DO i=1,nel
426 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
427 . + temp(ixs(4,i)) + temp(ixs(5,i))
428 . + temp(ixs(6,i)) + temp(ixs(7,i))
429 . + temp(ixs(8,i)) + temp(ixs(9,i)))
430 ENDDO
431 ELSE
432 tempel(1:nel) = temp0(1:nel)
433 END IF
434!
435 IF (igtyp == 6) THEN
436 CALL smorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
437 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
438 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
439 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,nsigi,sigsp,nsigs,
440 . sigi ,ixs ,x ,jhbe ,ptsol,nel ,iparg(28))
441 ENDIF
442 CALL s8zderic3(gbuf%VOL,hx, hy, hz,
443 . ajc1,ajc2,ajc3,
444 . ajc4,ajc5,ajc6,
445 . ajc7,ajc8,ajc9,smax, volu, ngl,
446 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
447 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
448 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
449C
450 ip=8
451 DO ir=1,nptr
452 DO is=1,npts
453 DO it=1,nptt
454 lbuf => elbuf_str%BUFLY(1)%LBUF(ir,is,it)
455 mbuf => elbuf_str%BUFLY(1)%MAT(ir,is,it)
456 CALL matini(pm ,ixs ,nixs ,x ,
457 . geo ,ale_connectivity ,detonators ,iparg ,
458 . sigi ,nel ,skew ,igeo ,
459 . ipart ,iparts ,
460 . mat ,ipm ,nsigs ,numsol ,ptsol ,
461 . ip ,ngl ,npf ,tf ,bufmat ,
462 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
463 . facload, deltax ,tempel ,mat_param )
464 ENDDO
465 ENDDO
466 ENDDO
467C
468 IF (iboltp /=0) THEN
469 CALL sboltini(e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
470 1 gbuf%BPRELD,nel ,ixs ,nixs ,vpreload, iflag_bpreload)
471 ENDIF
472C----------------------------------------
473C initialization of thermal
474C----------------------------------------
475 IF(jthe /=0) CALL atheri(mat,pm,gbuf%TEMP)
476C
477 CALL sczero3(gbuf%RHO,gbuf%SIG,gbuf%EINT,nel)
478 IF (jhbe == 17) THEN
479C---------necessary for SP (to get the same LBUF%VOL)
480 CALL s8ejacip3(
481 . hx, hy, hz,
482 . ajc1,ajc2,ajc3,
483 . ajc4,ajc5,ajc6,
484 . ajc7,ajc8,ajc9,
485 . ajp1,ajp2,ajp3,
486 . ajp4,ajp5,ajp6,
487 . ajp7,ajp8,ajp9)
488 END IF
489C------------------------
490C INTEGRATION POINTS
491C------------------------
492 nlay = elbuf_str%NLAY
493 nptr = elbuf_str%NPTR
494 npts = elbuf_str%NPTS
495 nptt = elbuf_str%NPTT
496C-----------Begin integrating points-----
497
498 DO ir=1,nptr
499 DO is=1,npts
500 DO it=1,nptt
501C-----------
502 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
503 mbuf => elbuf_str%BUFLY(il)%MAT(ir,is,it)
504 l_pla = elbuf_str%BUFLY(il)%L_PLA
505 l_sigb= elbuf_str%BUFLY(il)%L_SIGB
506C
507 zr = a_gauss(ir,nptr)
508 zs = a_gauss(is,npts)
509 zt = a_gauss(it,nptt)
510 wt = w_gauss(it,nptt)
511 ip = ir + ( (is-1) + (it-1)*npts )*nptr
512 wi = w_gauss(ir,nptr)*w_gauss(is,npts)*wt
513C
514 IF (jhbe == 17) THEN
515C---------necessary for SP (to get the same LBUF%VOL)
516 CALL s8ederi3(lbuf%VOL,veul(1,nf1),geo,wi,
517 . ajp1(1,ip),ajp2(1,ip),ajp3(1,ip),
518 . ajp4(1,ip),ajp5(1,ip),ajp6(1,ip),
519 . ajp7(1,ip),ajp8(1,ip),ajp9(1,ip),
520 . smax, deltax, ngl,lbuf%VOL0DP)
521 ELSE
522 CALL s8zderi3(lbuf%VOL,veul(1,nf1),geo,
523 . zr,zs,zt,wi,
524 . hx, hy, hz,
525 . ajc1,ajc2,ajc3,
526 . ajc4,ajc5,ajc6,
527 . ajc7,ajc8,ajc9,smax, deltax, ngl,lbuf%VOL0DP)
528 END IF !(JHBE == 17) THEN
529c
530 CALL matini(pm ,ixs ,nixs ,x ,
531 . geo ,ale_connectivity ,detonators ,iparg ,
532 . sigi ,nel ,skew ,igeo ,
533 . ipart ,iparts ,
534 . mat ,ipm ,nsigs ,numsol ,ptsol ,
535 . ip ,ngl ,npf ,tf ,bufmat ,
536 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
537 . facload, deltax,tempel ,mat_param)
538C
539 IF(jthe /=0) CALL atheri(mat,pm,lbuf%TEMP)
540C
541 IF(mtn>=28)THEN
542 nuvar = ipm(8,ixs(1,nft+1))
543 idef =1
544 ELSE
545 nuvar = 0
546 IF(mtn == 14 .OR. mtn == 12)THEN
547 idef =1
548 ELSEIF(mtn == 24)THEN
549 idef =1
550 ELSEIF(istrain == 1)THEN
551 IF(mtn == 1)THEN
552 idef =1
553 ELSEIF(mtn == 2)THEN
554 idef =1
555 ELSEIF(mtn == 4)THEN
556 idef =1
557 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn ==10.OR.
558 . mtn == 21.OR.mtn == 22.OR.
559 . mtn == 23.OR.mtn == 49)THEN
560 idef =1
561 ENDIF
562 ENDIF
563 ENDIF
564 CALL sigin20b(
565 . lbuf%SIG ,pm ,lbuf%VOL ,sigsp ,
566 . sigi ,lbuf%EINT,lbuf%RHO ,mbuf%VAR ,lbuf%STRA,
567 . ixs ,nixs ,nsigi ,ip ,nuvar ,
568 . nel ,iuser ,idef ,nsigs ,strsglob ,
569 . straglob ,jhbe ,igtyp ,x ,gbuf%GAMA,
570 . mat ,lbuf%PLA ,l_pla ,ptsol ,lbuf%SIGB,
571 . l_sigb ,ipm ,bufmat ,lbuf%VOL0DP)
572c
573 CALL svalue0(
574 . lbuf%RHO,lbuf%VOL,lbuf%OFF,lbuf%SIG,lbuf%EINT,dtx,
575 . gbuf%RHO,gbuf%VOL,gbuf%OFF,gbuf%SIG,gbuf%EINT,dtx0,
576 . nel )
577c
578C----------------------------------------
579c Initialization of stress tensor in case of Orthotropic properties
580C----------------------------------------
581 IF (isigi /= 0 .AND. isorth/=0) THEN
582 lbuf%SIGL = lbuf%SIG
583 ENDIF
584c
585 ENDDO
586 ENDDO
587 ENDDO
588C----------------------------------------
589C initialization of masses
590C----------------------------------------
591 CALL smass3(
592 . gbuf%RHO,mas,partsav,x,v,
593 . iparts(nf1),mss(1,nf1),volu ,
594 . msnf ,mssf(1,nf1) ,bid(1) ,
595 . bid(1) ,bid(1) ,wma ,rhocp ,mcp ,
596 . mcps(1,nf1) ,mssa ,bid(1) ,bid(1),gbuf%FILL,
597 . ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
598C----------------------------------------
599c Failure model initialisation
600C----------------------------------------
601 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
602 . ipm,sigsp,nsigi,fail_ini ,
603 . sigi,nsigs,ixs,nixs,ptsol,rnoise,perturb,mat_param)
604C------------------------------------------
605C assembly of nodal volumes and nodal modules
606C (for interface stiffnesses)
607C------------------------------------------
608C Please note: IX1, IX2 ... IX8 are in the form NC (MVSIZ, 8)
609 IF(i7stifs/=0)THEN
610 ncc=8
611 CALL sbulk3(volu ,ix1 ,ncc,mat,pm ,
612 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid(1),
613 3 bid(1) ,gbuf%FILL)
614 ENDIF
615C------------------------------------------
616C calculation of elementary timesteps
617C------------------------------------------
618 aire(:) = zero
619 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
620 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
621 . volu, dtx,igeo,igtyp)
622c
623 DO 10 i=lft,llt
624 IF(ixs(10,i+nft)/=0.AND.invers>14) THEN
625 IF (igtyp/=0.AND.igtyp/=6.AND.igtyp/=14.AND.igtyp/=15)
626 . THEN
627 ipid1=ixs(nixs-1,i+nft)
628 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
629 CALL ancmsg(msgid=226,
630 . msgtype=msgerror,
631 . anmode=aninfo_blind_1,
632 . i1=igeo(1,ipid1),
633 . c1=titr1,
634 . i2=igtyp)
635 ENDIF
636 ENDIF
637 dtelem(nft+i)=dtx(i)
638C STI = 0.25 * RHO * VOL / (DT*DT)
639 sti = fourth * gbuf%FILL(i) * gbuf%RHO(i) * volu(i) /
640 . max(em20,dtx(i)*dtx(i))
641 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
642 stifn(ixs(3,i+nft))=stifn(ixs(3,i+nft))+sti
643 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
644 stifn(ixs(5,i+nft))=stifn(ixs(5,i+nft))+sti
645 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
646 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
647 stifn(ixs(8,i+nft))=stifn(ixs(8,i+nft))+sti
648 stifn(ixs(9,i+nft))=stifn(ixs(9,i+nft))+sti
649 10 CONTINUE
650C------------------------------------------
651C SOLID TO SPH, COMPUTE INITIAL VOLUME & MASS OF PARTICLES
652C------------------------------------------
653 IF(nsphsol/=0)THEN
654 DO i=lft,llt
655 IF(sol2sph(1,nft+i) < sol2sph(2,nft+i))THEN
656C SOL2SPH(1,N)+1<=I<=SOLSPH(2,N) <=> N==SPH2SOL(I)
657 nsphdir=igeo(37,ixs(10,nft+i))
658 ncelf =sol2sph(1,nft+i)+1
659 ncell =sol2sph(2,nft+i)-sol2sph(1,nft+i)
660 CALL soltosphv8(
661 . nsphdir ,gbuf%RHO(i) ,ncell ,x ,spbuf(1,ncelf),
662 . ixs(1,i+nft),kxsp(1,ncelf),ipartsp(ncelf),
663 . irst(1,ncelf-first_sphsol+1))
664 END IF
665 ENDDO
666 END IF
667 nxref = nrefsta
668C-----------
669 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
min
#define min(a, b)
Definition macros.h:20
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
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
s8erefcoor3
subroutine s8erefcoor3(sav, npe, nel, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition s8erefcoor3.F:33
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
sczero3
subroutine sczero3(rhog, sigg, eintg, nel)
Definition scinit3.F:535
svalue0
subroutine svalue0(rho, vol, off, sig, eint, dtx, rhog, volg, offg, sigg, eintg, dtxg, nel)
Definition scinit3.F:490
smass3
subroutine smass3(rho, ms, partsav, x, v, ipart, mss, volu, msnf, mssf, in, vr, ins, wma, rhocp, mcp, mcps, mssa, rhof, frac, fill, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
Definition smass3.F:44
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
s8zpij_ic
subroutine s8zpij_ic(xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, jac1, jac2, jac3, jac4, jac5, jac6, jac7, jac8, jac9, hx, hy, hz, pxc1, pxc2, pxc3, pxc4, pyc1, pyc2, pyc3, pyc4, pzc1, pzc2, pzc3, pzc4)
Definition s8zderi3.F:485
s8ederi3
subroutine s8ederi3(vol, veul, geo, wi, jacp1, jacp2, jacp3, jacp4, jacp5, jacp6, jacp7, jacp8, jacp9, smax, deltax, ngl, voldp)
Definition s8zderi3.F:2370
s8zderi3
subroutine s8zderi3(vol, veul, geo, ksi, eta, zeta, wi, hx, hy, hz, cj1, cj2, cj3, cj4, cj5, cj6, cj7, cj8, cj9, smax, deltax, ngl, voldp)
Definition s8zderi3.F:40
s8ejacip3
subroutine s8ejacip3(hx, hy, hz, cj1, cj2, cj3, cj4, cj5, cj6, cj7, cj8, cj9, jac1, jac2, jac3, jac4, jac5, jac6, jac7, jac8, jac9)
Definition s8zderi3.F:2180
s8zderic3
subroutine s8zderic3(vol, hx, hy, hz, jac1, jac2, jac3, jac4, jac5, jac6, jac7, jac8, jac9, smax, det, ngl, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition s8zderi3.F:142
s8zjac_ic
subroutine s8zjac_ic(xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, jac1, jac2, jac3, jac4, jac5, jac6, jac7, jac8, jac9, hx, hy, hz, jac_i)
Definition s8zderi3.F:319
s8zjac_i3
subroutine s8zjac_i3(ksi, eta, zeta, wi, hx, hy, hz, cj1, cj2, cj3, cj4, cj5, cj6, cj7, cj8, cj9, jac_i, l_pij, pij, nel)
Definition s8zderi3.F:669
s8e_pij
subroutine s8e_pij(nptr, npts, nptt, nnpt, nel, pxc1, pxc2, pxc3, pxc4, pyc1, pyc2, pyc3, pyc4, pzc1, pzc2, pzc3, pzc4, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, nu, elbuf_str)
Definition s8zderi3.F:935
scoor3
subroutine scoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition scoor3.F:52
srcoor3
subroutine srcoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, jhbe, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition srcoor3.F:52
soltosphv8
subroutine soltosphv8(nsphdir, rho, ncell, x, spbuf, ixs, kxsp, ipartsp, irst)
Definition soltosph.F:338
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