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