OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s16forc3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "vect01_c.inc"
#include "parit_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine s16forc3 (timers, output, elbuf_tab, ng, pm, geo, ixs, x, a, v, ms, w, flux, flu1, veul, fv, ale_connect, iparg, tf, npf, bufmat, partsav, nloc_dmg, dt2t, neltst, ityptst, stifn, fsky, iads, offset, eani, iparts, ixs16, iads16, nel, fx, fy, fz, volnp, sigs, rx, ry, rz, sx, sy, sz, tx, ty, tz, stig, stin, ul, xx, yy, zz, vx, vy, vz, vdxx, vdyy, vdzz, dnidr, dnids, dnidt, px, py, pz, icp, icsig, ipm, istrain, temp, fthe, fthesky, iexpan, gresav, grth, igrth, table, igeo, voln, condn, condnsky, itask, ioutprt, mat_elem, h3d_strain, dt, snpc, stf, sbufmat, svis, nsvois, idtmins, iresp, idel7ng, idel7nok, idtmin, maxfunc, imon_mat, userl_avail, glob_therm, impl_s, idyna, sensors)

Function/Subroutine Documentation

◆ s16forc3()

subroutine s16forc3 ( type(timer_), intent(inout) timers,
type(output_), intent(inout) output,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer ng,
pm,
geo,
integer, dimension(nixs,*) ixs,
x,
a,
v,
ms,
w,
flux,
flu1,
veul,
fv,
type(t_ale_connectivity), intent(in) ale_connect,
integer, dimension(nparg,ngroup) iparg,
tf,
integer, dimension(*) npf,
bufmat,
partsav,
type (nlocal_str_), target nloc_dmg,
dt2t,
integer neltst,
integer ityptst,
stifn,
fsky,
integer, dimension(8,*) iads,
integer offset,
eani,
integer, dimension(*) iparts,
integer, dimension(8,*) ixs16,
integer, dimension(8,*) iads16,
integer nel,
fx,
fy,
fz,
volnp,
sigs,
rx,
ry,
rz,
sx,
sy,
sz,
tx,
ty,
tz,
stig,
stin,
ul,
xx,
yy,
zz,
vx,
vy,
vz,
vdxx,
vdyy,
vdzz,
dnidr,
dnids,
dnidt,
px,
py,
pz,
integer icp,
integer icsig,
integer, dimension(*) ipm,
integer istrain,
temp,
fthe,
fthesky,
integer iexpan,
gresav,
integer, dimension(*) grth,
integer, dimension(*) igrth,
type (ttable), dimension(*) table,
integer, dimension(*) igeo,
voln,
condn,
condnsky,
integer itask,
integer ioutprt,
type (mat_elem_), intent(inout) mat_elem,
integer h3d_strain,
type(dt_), intent(inout) dt,
integer, intent(in) snpc,
integer, intent(in) stf,
integer, intent(in) sbufmat,
intent(inout) svis,
integer, intent(in) nsvois,
integer, intent(in) idtmins,
integer, intent(in) iresp,
integer, intent(in) idel7ng,
integer, intent(inout) idel7nok,
integer, dimension(102) idtmin,
integer, intent(in) maxfunc,
integer, intent(in) imon_mat,
integer, intent(in) userl_avail,
type (glob_therm_), intent(inout) glob_therm,
integer, intent(in) impl_s,
integer, intent(in) idyna,
type (sensors_), intent(inout) sensors )

Definition at line 63 of file s16forc3.F.

86C-----------------------------------------------
87C M o d u l e s
88C-----------------------------------------------
89 USE timer_mod
90 USE output_mod, only : output_
91 USE mmain_mod
92 USE table_mod
93 USE mat_elem_mod
94 USE nlocal_reg_mod
95 USE ale_connectivity_mod
96 USE dt_mod
97 USE elbufdef_mod
98 use glob_therm_mod
99 USE sensor_mod
100 use element_mod , only : nixs
101C-----------------------------------------------
102C I m p l i c i t T y p e s
103C-----------------------------------------------
104#include "implicit_f.inc"
105C-----------------------------------------------
106C G l o b a l P a r a m e t e r s
107C-----------------------------------------------
108#include "mvsiz_p.inc"
109C-----------------------------------------------
110C C o m m o n B l o c k s
111C-----------------------------------------------
112#include "com01_c.inc"
113#include "com04_c.inc"
114#include "com08_c.inc"
115#include "vect01_c.inc"
116#include "parit_c.inc"
117#include "param_c.inc"
118C-----------------------------------------------
119C l o c a l P a r a m e t e r s
120C-----------------------------------------------
121 INTEGER NIPMAX,NPE
122 parameter(nipmax=81)
123 parameter(npe=16)
124C-----------------------------------------------
125C D u m m y A r g u m e n t s
126C-----------------------------------------------
127 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
128 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
129 INTEGER,INTENT(IN) :: SNPC
130 INTEGER,INTENT(IN) :: STF
131 INTEGER, INTENT(IN) :: SBUFMAT
132 INTEGER, INTENT(IN) :: IDTMINS
133 INTEGER, INTENt(IN) :: NSVOIS
134 INTEGER ,INTENT(IN) :: IRESP
135 INTEGER ,INTENT(IN) :: IDEL7NG
136 INTEGER ,INTENT(INOUT) :: IDEL7NOK
137 integer,dimension(102) :: IDTMIN
138 INTEGER ,INTENT(IN) :: MAXFUNC
139 INTEGER, INTENT(IN) :: IMPL_S
140 INTEGER, INTENT(IN) :: IDYNA
141 INTEGER, INTENT(IN) :: USERL_AVAIL
142 INTEGER, INTENT(IN) :: IMON_MAT
143 INTEGER IXS(NIXS,*), IPARG(NPARG,NGROUP),NPF(*),
144 . IPARTS(*),IXS16(8,*),IADS16(8,*),IPM(*),GRTH(*),IGRTH(*),
145 . IGEO(*),IADS(8,*),ITASK,IOUTPRT
146 INTEGER NELTST,ITYPTST,OFFSET,NEL,ICP,ICSIG,ISTRAIN,IEXPAN,NG,H3D_STRAIN
147 my_real
148 . dt2t
149 my_real
150 . pm(npropm,*), geo(npropg,*), x(*), a(*), v(*), ms(*), w(*),
151 . flux(6,*),flu1(*), veul(*), fv(*), tf(*),
152 . bufmat(*),partsav(*),stifn(*), fsky(*),eani(*)
153 my_real
154 . fx(mvsiz,npe),fy(mvsiz,npe),fz(mvsiz,npe),
155 . volnp(mvsiz,nipmax),sigs(mvsiz,nipmax),
156 . rx(mvsiz,nipmax) , ry(mvsiz,nipmax) , rz(mvsiz,nipmax) ,
157 . sx(mvsiz,nipmax) , sy(mvsiz,nipmax) , sz(mvsiz,nipmax) ,
158 . tx(mvsiz,nipmax) , ty(mvsiz,nipmax) , tz(mvsiz,nipmax) ,
159 . stig(mvsiz,npe),stin(mvsiz,npe),ul(mvsiz,npe),
160 . xx(mvsiz,npe), yy(mvsiz,npe), zz(mvsiz,npe),
161 . vx(mvsiz,npe), vy(mvsiz,npe), vz(mvsiz,npe),
162 . vdxx(mvsiz,npe), vdyy(mvsiz,npe), vdzz(mvsiz,npe),
163 . dnidr(mvsiz,npe),dnids(mvsiz,npe),dnidt(mvsiz,npe),
164 . px(mvsiz,npe,nipmax),py(mvsiz,npe,nipmax),pz(mvsiz,npe,nipmax),
165 . temp(*), fthe(*), fthesky(*), gresav(*),voln(mvsiz),condn(*),
166 . condnsky(*)
167 my_real, DIMENSION(MVSIZ,6), INTENT(INOUT) :: svis
168 TYPE (TTABLE) TABLE(*)
169 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
170 TYPE (NLOCAL_STR_) , TARGET :: NLOC_DMG
171 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
172 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
173 TYPE(DT_), INTENT(INOUT) :: DT
174 type (glob_therm_) ,intent(inout) :: glob_therm
175 type (sensors_),INTENT(INOUT) :: SENSORS
176C-----------------------------------------------
177C L o c a l V a r i a b l e s
178C-----------------------------------------------
179 INTEGER I,N, NF1, IFLAG, IL, IR, IS, IT, NF2,L_PLA,IMAT,
180 . IP,NLAY,NPTT,NPTS,NPTR,IBID,IBIDON(1),II(6),PID,CURRENT_LAYER
181
182 INTEGER MXT(MVSIZ),NGL(MVSIZ),NGEO(MVSIZ),IPERM1(NPE),IPERM2(NPE)
183 my_real
184 . vd2(mvsiz) , dvol(mvsiz),deltax(mvsiz),
185 . vis(mvsiz) , qvis(mvsiz), cxx(mvsiz) ,
186 . s1(mvsiz) , s2(mvsiz) , s3(mvsiz) ,
187 . s4(mvsiz) , s5(mvsiz) , s6(mvsiz) ,
188 . dxx(mvsiz) , dyy(mvsiz) , dzz(mvsiz) ,
189 . d4(mvsiz) , d5(mvsiz) , d6(mvsiz) ,
190 . vdx(mvsiz),vdy(mvsiz),vdz(mvsiz),ssp_eq(mvsiz),
191 . aire(mvsiz),conde(mvsiz),condeg(mvsiz,npe),divde(mvsiz)
192
193 ! variables used as arguments by the materials.
194 my_real
195 . sti(mvsiz), wxx(mvsiz) , wyy(mvsiz) , wzz(mvsiz)
196 ! Variables used in argument by materials if SPH only.
197 my_real
198 . muvoid(mvsiz)
199
200 ! Variables void MMAIN
201 my_real
202 . sigy(mvsiz),et(mvsiz),gama(mvsiz,6),
203 . r1_free(mvsiz),r3_free(mvsiz),
204 . tempel(mvsiz),die(mvsiz),them(mvsiz,npe),area(mvsiz),llsh(mvsiz)
205 my_real, dimension(mvsiz) :: fheat
206
207 ! variables used only in solid routines (as arguments).
208 INTEGER NC(MVSIZ,NPE),NN_DEL,IPRES,SZ_IX
209 my_real
210 . off(mvsiz) , rhoo(mvsiz),ni(npe,nipmax),
211 . sigsm(mvsiz),volsm(mvsiz),
212 . dxy(mvsiz),dyx(mvsiz),
213 . dyz(mvsiz),dzy(mvsiz),volg(mvsiz),
214 . dzx(mvsiz),dxz(mvsiz), wi,bid(mvsiz),aa,bb, mbid(1),amu(mvsiz)
215 my_real varnl(nel)
216 DOUBLE PRECISION
217 . VOLDP(MVSIZ,NIPMAX)
218C-----------------------------------------------
219 TYPE(L_BUFEL_) ,POINTER :: LBUF
220 TYPE(G_BUFEL_) ,POINTER :: GBUF
221C-----------------------------------------------
222 my_real
223 . w_gauss(9,9),a_gauss(9,9),w_lobatto(9,9),a_lobatto(9,9),
224 . w_newton(9,9),a_newton(9,9)
225C-----------------------------------------------
226 DATA w_gauss /
227 1 2. ,0. ,0. ,
228 1 0. ,0. ,0. ,
229 1 0. ,0. ,0. ,
230 2 1. ,1. ,0. ,
231 2 0. ,0. ,0. ,
232 2 0. ,0. ,0. ,
233 3 0.555555555555556,0.888888888888889,0.555555555555556,
234 3 0. ,0. ,0. ,
235 3 0. ,0. ,0. ,
236 4 0.347854845137454,0.652145154862546,0.652145154862546,
237 4 0.347854845137454,0. ,0. ,
238 4 0. ,0. ,0. ,
239 5 0.236926885056189,0.478628670499366,0.568888888888889,
240 5 0.478628670499366,0.236926885056189,0. ,
241 5 0. ,0. ,0. ,
242 6 0.171324492379170,0.360761573048139,0.467913934572691,
243 6 0.467913934572691,0.360761573048139,0.171324492379170,
244 6 0. ,0. ,0. ,
245 7 0.129484966168870,0.279705391489277,0.381830050505119,
246 7 0.417959183673469,0.381830050505119,0.279705391489277,
247 7 0.129484966168870,0. ,0. ,
248 8 0.101228536290376,0.222381034453374,0.313706645877887,
249 8 0.362683783378362,0.362683783378362,0.313706645877887,
250 8 0.222381034453374,0.101228536290376,0. ,
251 9 0.081274388361574,0.180648160694857,0.260610696402935,
252 9 0.312347077040003,0.330239355001260,0.312347077040003,
253 9 0.260610696402935,0.180648160694857,0.081274388361574/
254 DATA a_gauss /
255 1 0. ,0. ,0. ,
256 1 0. ,0. ,0. ,
257 1 0. ,0. ,0. ,
258 2 -.577350269189626,0.577350269189626,0. ,
259 2 0. ,0. ,0. ,
260 2 0. ,0. ,0. ,
261 3 -.774596669241483,0. ,0.774596669241483,
262 3 0. ,0. ,0. ,
263 3 0. ,0. ,0. ,
264 4 -.861136311594053,-.339981043584856,0.339981043584856,
265 4 0.861136311594053,0. ,0. ,
266 4 0. ,0. ,0. ,
267 5 -.906179845938664,-.538469310105683,0. ,
268 5 0.538469310105683,0.906179845938664,0. ,
269 5 0. ,0. ,0. ,
270 6 -.932469514203152,-.661209386466265,-.238619186083197,
271 6 0.238619186083197,0.661209386466265,0.932469514203152,
272 6 0. ,0. ,0. ,
273 7 -.949107912342759,-.741531185599394,-.405845151377397,
274 7 0. ,0.405845151377397,0.741531185599394,
275 7 0.949107912342759,0. ,0. ,
276 8 -.960289856497536,-.796666477413627,-.525532409916329,
277 8 -.183434642495650,0.183434642495650,0.525532409916329,
278 8 0.796666477413627,0.960289856497536,0. ,
279 9 -.968160239507626,-.836031107326636,-.613371432700590,
280 9 -.324253423403809,0. ,0.324253423403809,
281 9 0.613371432700590,0.836031107326636,0.968160239507626/
282C-----
283 DATA w_lobatto /
284 1 2. ,0. ,0. ,
285 1 0. ,0. ,0. ,
286 1 0. ,0. ,0. ,
287 2 1. ,1. ,0. ,
288 2 0. ,0. ,0. ,
289 2 0. ,0. ,0. ,
290 3 0.333333333333333,1.333333333333333,0.333333333333333,
291 3 0. ,0. ,0. ,
292 3 0. ,0. ,0. ,
293 4 0.166666666666667,0.833333333333333,0.833333333333333,
294 4 0.166666666666667,0. ,0. ,
295 4 0. ,0. ,0. ,
296 5 0.1 ,0.544444444444444,0.711111111111111,
297 5 0.544444444444444,0.1 ,0. ,
298 5 0. ,0. ,0. ,
299 6 0.066666666666667,0.37847496 ,0.55485838 ,
300 6 0.55485838 ,0.37847496 ,0.066666666666667,
301 6 0. ,0. ,0. ,
302 7 0.04761904 ,0.27682604 ,0.43174538 ,
303 7 0.48761904 ,0.43174538 ,0.27682604 ,
304 7 0.04761904 ,0. ,0. ,
305 8 0.03571428 ,0.21070422 ,0.34112270 ,
306 8 0.41245880 ,0.41245880 ,0.34112270 ,
307 8 0.21070422 ,0.03571428 ,0. ,
308 9 0.027777777777778,0.1654953616 ,0.2745387126 ,
309 9 0.3464285110 ,0.3715192744 ,0.3464285110 ,
310 9 0.2745387126 ,0.1654953616 ,0.027777777777778/
311 DATA a_lobatto /
312 1 0. ,0. ,0. ,
313 1 0. ,0. ,0. ,
314 1 0. ,0. ,0. ,
315 2 -1. ,1. ,0. ,
316 2 0. ,0. ,0. ,
317 2 0. ,0. ,0. ,
318 3 -1. ,0. ,1. ,
319 3 0. ,0. ,0. ,
320 3 0. ,0. ,0. ,
321 4 -1. ,-.44721360 ,0.44721360 ,
322 4 1. ,0. ,0. ,
323 4 0. ,0. ,0. ,
324 5 -1. ,-.65465367 ,0. ,
325 5 0.65465367 , 1. ,0. ,
326 5 0. ,0. ,0. ,
327 6 -1. ,-.76505532 ,-.28523152 ,
328 6 0.28523152 ,0.76505532 , 1. ,
329 6 0. ,0. ,0. ,
330 7 -1. ,-.83022390 ,-.46884879 ,
331 7 0. ,0.46884879 ,0.83022390 ,
332 7 1. ,0. ,0. ,
333 8 -1. ,-.87174015 ,-.59170018 ,
334 8 -.20929922 ,0.20929922 ,0.59170018 ,
335 8 0.87174015 , 1. ,0. ,
336 9 -1. ,-.8997579954 ,-.6771862795 ,
337 9 -.3631174638 ,0. ,0.3631174638 ,
338 9 0.6771862795 ,0.8997579954 , 1. /
339C-----
340C-----
341 DATA w_newton /
342 1 2. ,0. ,0. ,
343 1 0. ,0. ,0. ,
344 1 0. ,0. ,0. ,
345 2 1. ,1. ,0. ,
346 2 0. ,0. ,0. ,
347 2 0. ,0. ,0. ,
348 3 0.5 ,1. ,0.5 ,
349 3 0. ,0. ,0. ,
350 3 0. ,0. ,0. ,
351 4 0.166666666666667,0.833333333333333,0.833333333333333,
352 4 0.166666666666667,0. ,0. ,
353 4 0. ,0. ,0. ,
354 5 0.25 ,0.5 ,0.5 ,
355 5 0.5 ,0.25 ,0. ,
356 5 0. ,0. ,0. ,
357 6 0.066666666666667,0.37847496 ,0.55485838 ,
358 6 0.55485838 ,0.37847496 ,0.066666666666667,
359 6 0. ,0. ,0. ,
360 7 0.04761904 ,0.27682604 ,0.43174538 ,
361 7 0.48761904 ,0.43174538 ,0.27682604 ,
362 7 0.04761904 ,0. ,0. ,
363 8 0.03571428 ,0.21070422 ,0.34112270 ,
364 8 0.41245880 ,0.41245880 ,0.34112270 ,
365 8 0.21070422 ,0.03571428 ,0. ,
366 9 0.027777777777778,0.1654953616 ,0.2745387126 ,
367 9 0.3464285110 ,0.3715192744 ,0.3464285110 ,
368 9 0.2745387126 ,0.1654953616 ,0.027777777777778/
369 DATA a_newton /
370 1 0. ,0. ,0. ,
371 1 0. ,0. ,0. ,
372 1 0. ,0. ,0. ,
373 2 -1. ,1. ,0. ,
374 2 0. ,0. ,0. ,
375 2 0. ,0. ,0. ,
376 3 -1. ,0. ,1. ,
377 3 0. ,0. ,0. ,
378 3 0. ,0. ,0. ,
379 4 -1. ,-.44721360 ,0.44721360 ,
380 4 1. ,0. ,0. ,
381 4 0. ,0. ,0. ,
382 5 -1. ,-.5 ,0. ,
383 5 0.5 , 1. ,0. ,
384 5 0. ,0. ,0. ,
385 6 -1. ,-.76505532 ,-.28523152 ,
386 6 0.28523152 ,0.76505532 , 1. ,
387 6 0. ,0. ,0. ,
388 7 -1. ,-.83022390 ,-.46884879 ,
389 7 0. ,0.46884879 ,0.83022390 ,
390 7 1. ,0. ,0. ,
391 8 -1. ,-.87174015 ,-.59170018 ,
392 8 -.20929922 ,0.20929922 ,0.59170018 ,
393 8 0.87174015 , 1. ,0. ,
394 9 -1. ,-.8997579954 ,-.6771862795 ,
395 9 -.3631174638 ,0. ,0.3631174638 ,
396 9 0.6771862795 ,0.8997579954 , 1. /
397C-----
398 DATA iperm1/0,0,0,0,0,0,0,0,1,2,3,4,5,6,7,8/
399 DATA iperm2/0,0,0,0,0,0,0,0,2,3,4,1,6,7,8,5/
400C-----------------------------------------------
401C S o u r c e L i n e s
402C=======================================================================
403 gbuf =>elbuf_tab(ng)%GBUF
404 nptr = elbuf_tab(ng)%NPTR
405 npts = elbuf_tab(ng)%NPTS
406 nptt = elbuf_tab(ng)%NPTT
407 nlay = elbuf_tab(ng)%NLAY
408 is = 1
409 isorth = 0
410 tempel(:) = zero
411 fheat(:) = zero
412 nf1 = nft+1
413 nf2 = nf1-(numels8+numels10+numels20)
414 IF (nptr*npts*nptt*nlay > nipmax) stop 933
415 ibid = 0
416 ibidon(1)= 0
417 sz_ix=numelq+numels+nsvois
418!
419 DO i=1,6
420 ii(i) = nel*(i-1)
421 ENDDO
422!
423 CALL s20coor3(
424 1 x, ixs(1,nf1), ixs16(1,nf2),v,
425 2 w, iperm1, iperm2, npe,
426 3 xx, yy, zz, vx,
427 4 vy, vz, vdxx, vdyy,
428 5 vdzz, vdx, vdy, vdz,
429 6 vd2, vis, gbuf%OFF, off,
430 7 gbuf%SMSTR, nc, ngl, mxt,
431 8 ngeo, fx, fy, fz,
432 9 stig, gbuf%SIG, gbuf%EINT, gbuf%RHO,
433 a gbuf%QVIS, gbuf%PLA, gbuf%EPSD, gbuf%G_PLA,
434 b gbuf%G_EPSD, nel, condeg, jale,
435 c ismstr, jeul, jlag)
436
437 nn_del = 0
438 pid = ngeo(1)
439 IF (geo(190,pid)+geo(191,pid)+geo(192,pid)+geo(192,pid)>zero)
440 . nn_del=8
441 IF (nn_del ==0 .AND. dt%IDEL_BRICK>0) nn_del=16
442 ipres = mat_elem%MAT_PARAM(mxt(1))%IPRES
443C
444 DO n=1,npe
445 DO i=1,nel
446 ul(i,n) = zero
447 ENDDO
448 ENDDO
449 IF (jthe < 0) them(1:nel,1:npe) = zero
450 DO i=1,nel
451 volg(i) = zero
452 ENDDO
453C-----------------------------
454C POINTS D' INTEGRATION - SIGS
455C-----------------------------
456 DO it=1,nptt
457 DO ir=1,nptr
458 DO i=1,nel
459 sigsm(i) = zero
460 volsm(i) = zero
461 ENDDO
462C-----------
463 DO il=1,nlay
464 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
465 ip = ir + ( (il-1) + (it-1)*nlay )*nptr
466 IF (iint == 1) THEN
467 !---GAUSS
468 wi = w_gauss(ir,nptr)*w_gauss(il,nlay)*w_gauss(it,nptt)
469 CALL s16rst(
470 1 a_gauss(ir,nptr),a_gauss(il,nlay),a_gauss(it,nptt),ni(1,ip),
471 2 dnidr ,dnids ,dnidt )
472
473 CALL s16deri3(
474 1 ngl, off, a_gauss(ir,nptr),a_gauss(il,nlay),
475 2 a_gauss(it,nptt),wi, dnidr, dnids,
476 3 dnidt, rx(1,ip), ry(1,ip), rz(1,ip),
477 4 sx(1,ip), sy(1,ip), sz(1,ip), tx(1,ip),
478 5 ty(1,ip), tz(1,ip), xx, yy,
479 6 zz, px(1,1,ip), py(1,1,ip), pz(1,1,ip),
480 7 volnp(1,ip), deltax, stin, ni(1,ip),
481 8 volg, ul, ir, il,
482 9 it, voldp(1,ip), nel)
483 ELSEIF (iint == 2) THEN
484 !---LOBATTO
485 wi = w_gauss(ir,nptr)*w_lobatto(il,nlay)*w_gauss(it,nptt)
486 CALL s16rst(
487 1 a_gauss(ir,nptr),a_lobatto(il,nlay),a_gauss(it,nptt),ni(1,ip),
488 2 dnidr ,dnids ,dnidt )
489
490 CALL s16deri3(
491 1 ngl, off, a_gauss(ir,nptr), a_lobatto(il,nlay),
492 2 a_gauss(it,nptt), wi, dnidr, dnids,
493 3 dnidt, rx(1,ip), ry(1,ip), rz(1,ip),
494 4 sx(1,ip), sy(1,ip), sz(1,ip), tx(1,ip),
495 5 ty(1,ip), tz(1,ip), xx, yy,
496 6 zz, px(1,1,ip), py(1,1,ip), pz(1,1,ip),
497 7 volnp(1,ip), deltax, stin, ni(1,ip),
498 8 volg, ul, ir, il,
499 9 it, voldp(1,ip), nel)
500 ENDIF
501 !--------------------------
502 ! SUB-INTEGRATION OF SIGS
503 !-------------------------
504 DO i=1,nel
505 aa = one / sqrt(sx(i,ip)*sx(i,ip) + sy(i,ip)*sy(i,ip) +sz(i,ip)*sz(i,ip))
506 sx(i,ip) = sx(i,ip) * aa
507 sy(i,ip) = sy(i,ip) * aa
508 sz(i,ip) = sz(i,ip) * aa
509 rx(i,ip) = sy(i,ip) * tz(i,ip) - sz(i,ip) * ty(i,ip)
510 ry(i,ip) = sz(i,ip) * tx(i,ip) - sx(i,ip) * tz(i,ip)
511 rz(i,ip) = sx(i,ip) * ty(i,ip) - sy(i,ip) * tx(i,ip)
512 aa = one / sqrt(rx(i,ip)*rx(i,ip)+ry(i,ip)*ry(i,ip)+rz(i,ip)*rz(i,ip))
513 rx(i,ip) = rx(i,ip) * aa
514 ry(i,ip) = ry(i,ip) * aa
515 rz(i,ip) = rz(i,ip) * aa
516 tx(i,ip) = ry(i,ip) * sz(i,ip) - rz(i,ip) * sy(i,ip)
517 ty(i,ip) = rz(i,ip) * sx(i,ip) - rx(i,ip) * sz(i,ip)
518 tz(i,ip) = rx(i,ip) * sy(i,ip) - ry(i,ip) * sx(i,ip)
519 sigs(i,ip) = sx(i,ip)*sx(i,ip)*lbuf%SIG(ii(1)+i)
520 . +sy(i,ip)*sy(i,ip)*lbuf%SIG(ii(2)+i)
521 . +sz(i,ip)*sz(i,ip)*lbuf%SIG(ii(3)+i)
522 . +sx(i,ip)*sy(i,ip)*lbuf%SIG(ii(4)+i)*two
523 . +sy(i,ip)*sz(i,ip)*lbuf%SIG(ii(5)+i)*two
524 . +sz(i,ip)*sx(i,ip)*lbuf%SIG(ii(6)+i)*two
525 sigsm(i) = sigsm(i) + sigs(i,ip)*lbuf%VOL(i)
526 volsm(i) = volsm(i) + lbuf%VOL(i)
527 enddo!next I
528 enddo!next ILAY
529 DO i=1,nel
530 sigsm(i) = sigsm(i) / volsm(i)
531 ENDDO
532 DO il=1,nlay
533 ip = ir + ( (il-1) + (it-1)*nlay ) * nptr
534 DO i = 1,nel
535 sigs(i,ip) = sigs(i,ip)-sigsm(i)
536 ENDDO
537 enddo!IL=1,NLAY
538 enddo!IR=1,NPTR
539 enddo!IT=1,NPTT
540C-------------------------
541 DO i=1,nel
542 aa = max(ul(i,1),ul(i,2),ul(i,3),ul(i,4),
543 . ul(i,5),ul(i,6),ul(i,7),ul(i,8))
544 bb = max(ul(i,9) ,ul(i,10),ul(i,11),ul(i,12),ul(i,13),ul(i,14),
545 . ul(i,15),ul(i,16))
546 aa = aa*thirty2
547 bb = bb*thirty2*third
548 deltax(i) = sqrt(two*volg(i)/max(aa,bb))
549 ENDDO
550 IF (icp == 1 .OR. icp == 2 .AND. ipres==1 ) THEN
551 CALL s16sigp3(1,nel,nel,nptr,nlay,
552 . nptt,icp,mtn,npe,nipmax,
553 . px, py, pz, vx, vy, vz,
554 . w_gauss,gbuf%PLA,pm,mxt,gbuf%SIG,dt1,
555 . elbuf_tab(ng))
556 ENDIF
557 !-----------------------------
558 ! POINTS D' INTEGRATION - MMAIN
559 !-----------------------------
560 DO it=1,nptt
561 DO ir=1,nptr
562 DO il=1,nlay
563C
564 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
565 ip = ir + ( (il-1) + (it-1)*nlay )*nptr
566c
567 CALL s20defo3(
568 1 npe, px(1,1,ip), py(1,1,ip), pz(1,1,ip),
569 2 vx, vy, vz, dxx,
570 3 dxy, dxz, dyx, dyy,
571 4 dyz, dzx, dzy, dzz,
572 5 d4, d5, d6, wxx,
573 6 wyy, wzz, lbuf%RHO, rhoo,
574 7 volnp(1,ip),voln, nel)
575C
576 IF(dt1/=zero .AND. ipres==1 )CALL s16sigs3(
577 1 dxx, dyy, dzz, d4,
578 2 d5, d6, rx(1,ip), ry(1,ip),
579 3 rz(1,ip), sx(1,ip), sy(1,ip), sz(1,ip),
580 4 tx(1,ip), ty(1,ip), tz(1,ip), gbuf%EINT,
581 5 lbuf%VOL, sigs(1,ip), mxt, pm,
582 6 dt1, lbuf%VOL0DP,nel)
583C
584 divde(1:nel) = dt1*(dxx(1:nel)+ dyy(1:nel)+ dzz(1:nel))
585 CALL srho3(
586 1 pm, lbuf%VOL, lbuf%RHO, lbuf%EINT,
587 2 divde, flux(1,nf1),flu1(nf1), voln,
588 3 dvol, ngl, mxt, off,
589 4 0, gbuf%TAG22, voldp(1,ip),lbuf%VOL0DP,
590 5 amu, gbuf%OFF, nel, mtn,
591 6 jale, ismstr, jeul, jlag)
592
593 CALL srota3(
594 1 lbuf%SIG,s1, s2, s3,
595 2 s4, s5, s6, wxx,
596 3 wyy, wzz, nel, mtn,
597 4 ismstr)
598 !-----------------------------
599 ! SMALL STRAIN
600 !-----------------------------
601 CALL smalla3(
602 1 gbuf%SMSTR,gbuf%OFF, off, wxx,
603 2 wyy, wzz, nel, ismstr,
604 3 jlag)
605C
606C for heat transfert
607C
608 IF (jthe < 0 ) THEN
609 CALL s20tempcg(1,nel,npe, nc,ni(1,ip), temp,tempel)
610 ENDIF
611
612 current_layer=il
613 !------------------------------------------------------
614 ! CALCUL DES CONTRAINTES SUIVANT LOIS CONSTITUTIVES
615 !------------------------------------------------------
616 CALL mmain(timers, output,
617 1 elbuf_tab, ng, pm, geo,
618 2 ale_connect, ixs, iparg,
619 3 v, tf, npf, bufmat,
620 4 sti, x, dt2t, neltst,
621 5 ityptst, offset, nel, w,
622 6 off, ngeo, mxt, ngl,
623 7 voln, vd2, dvol, deltax,
624 8 vis, qvis, cxx, s1,
625 9 s2, s3, s4, s5,
626 a s6, dxx, dyy, dzz,
627 b d4, d5, d6, wxx,
628 c wyy, wzz, rx(1,ip), ry(1,ip),
629 d rz(1,ip), sx(1,ip), sy(1,ip), sz(1,ip),
630 e vdx, vdy, vdz, muvoid,
631 f ssp_eq, aire, sigy, et,
632 g r1_free, lbuf%PLA, r3_free, amu,
633 h dxx, dxy, dxz, dyx,
634 i dyy, dyz, dzx, dzy,
635 j dzz, ipm, gama, bid,
636 k bid, bid, bid, bid,
637 l bid, bid, istrain, tempel,
638 m die, iexpan, current_layer,mbid,
639 n mbid, ir, is, it,
640 o table, bid, bid, bid,
641 p bid, iparg(1,ng), igeo, conde,
642 q itask, nloc_dmg, varnl, mat_elem,
643 r h3d_strain, jplasol, jsph, mvsiz,
644 * snpc, stf, sbufmat, glob_therm,
645 * svis, sz_ix, iresp,
646 * n2d, th_strain, ngroup, tt,
647 . dt1, ntable, numelq, nummat,
648 . numgeo, numnod, numels,
649 . idel7nok, idtmin, maxfunc,
650 . imon_mat, userl_avail, impl_s,
651 . idyna, dt, fheat , sensors, opt_mtn=mtn, opt_jcvt=jcvt,
652 . opt_isorth=isorth,opt_isorthg=isorthg)
653c
654 IF (istrain == 1)THEN
655 CALL sstra3(
656 1 dxx, dyy, dzz, d4,
657 2 d5, d6, lbuf%STRA,wxx,
658 3 wyy, wzz, off, nel,
659 4 jcvt)
660 ENDIF
661 !-----------------------------
662 ! SMALL STRAIN
663 !-----------------------------
664 CALL smallb3(
665 1 gbuf%OFF,off, nel, ismstr)
666 !-------------------------
667 ! ASSEMBLE
668 !-------------------------
669 !----------------------------
670 ! INTERNAL FORCES
671 !----------------------------
672 IF (iint == 1) THEN
673 wi = w_gauss(ir,nptr)*w_gauss(il,nlay)*w_gauss(it,nptt)
674 ELSEIF (iint == 2) THEN
675 wi = w_gauss(ir,nptr)*w_lobatto(il,nlay)*w_gauss(it,nptt)
676 ENDIF
677C
678 l_pla = elbuf_tab(ng)%BUFLY(il)%L_PLA
679 CALL s20fint3(
680 1 npe, lbuf%SIG, px(1,1,ip),py(1,1,ip),
681 2 pz(1,1,ip),ssp_eq, fx, fy,
682 3 fz, voln, qvis, stig,
683 4 stin, lbuf%EINT, lbuf%RHO, lbuf%QVIS,
684 5 lbuf%PLA, lbuf%EPSD, gbuf%EPSD, gbuf%SIG,
685 6 gbuf%EINT, gbuf%RHO, gbuf%QVIS, gbuf%PLA,
686 7 wi, volg, lbuf%VOL, gbuf%VOL,
687 8 l_pla, nel, conde, deltax,
688 9 condeg, israt, svis ,glob_therm%NODADT_THERM,
689 a gbuf%WPLA, lbuf%WPLA, gbuf%G_WPLA )
690 !-------------------------
691 ! finite element heat transfert
692 !--------------------------
693
694 IF (jthe < 0) THEN
695 imat = mxt(1)
696 IF (mat_elem%MAT_PARAM(imat)%HEAT_FLAG == 1) THEN
697 CALL s20therm(
698 1 npe, pm, imat, nc,
699 2 voln, px(1,1,ip),py(1,1,ip),pz(1,1,ip),
700 3 ni(1,ip), dt1, temp, tempel,
701 4 fheat, them, gbuf%OFF, lbuf%OFF,
702 5 nel ,glob_therm%THEACCFACT)
703 ELSE
704 CALL s20therm(
705 1 npe, pm, imat, nc,
706 2 voln, px(1,1,ip),py(1,1,ip),pz(1,1,ip),
707 3 ni(1,ip), dt1, temp, tempel,
708 4 die, them, gbuf%OFF, lbuf%OFF,
709 5 nel ,glob_therm%THEACCFACT)
710 END IF
711 ENDIF
712 ENDDO ! IL=1,NLAY
713 ENDDO ! IR=1,NPTR
714 ENDDO ! IT=1,NPTT
715C
716 IF ( nn_del> 0) THEN
717 CALL sdlensh2(volg,llsh,area ,
718 . xx(1,1), xx(1,2), xx(1,3), xx(1,4),
719 . xx(1,5), xx(1,6), xx(1,7), xx(1,8),
720 . yy(1,1), yy(1,2), yy(1,3), yy(1,4),
721 . yy(1,5), yy(1,6), yy(1,7), yy(1,8),
722 . zz(1,1), zz(1,2), zz(1,3), zz(1,4),
723 . zz(1,5), zz(1,6), zz(1,7), zz(1,8), nel)
724 CALL tshgeodel3(ngl,gbuf%OFF,volg,area,gbuf%VOL,
725 . llsh,geo(1,pid),nn_del,dt ,nel )
726 ENDIF
727 !--------------------------
728 ! balances by material
729 !--------------------------
730 iflag=mod(ncycle,ncpri)
731 IF(ioutprt>0)THEN
732 CALL s16bilan(partsav,gbuf%EINT,gbuf%RHO,volg ,gbuf%VOL,
733 . vx ,vy ,vz ,iparts ,gresav ,
734 . grth ,igrth ,iexpan ,gbuf%EINTTH, gbuf%FILL,
735 . xx ,yy ,zz ,itask ,iparg(1,ng),
736 . gbuf%OFF,sensors,nel,gbuf%G_WPLA,gbuf%WPLA)
737 ENDIF
738C
739c-----------------------------
740 IF(nfilsol/=0) CALL sxfillopt(
741 1 npe, gbuf%FILL,stig, fx,
742 2 fy, fz, nel)
743c-----------------------------
744 IF (iparit == 0)THEN
745 CALL s20cumu3(
746 1 gbuf%OFF,a, nc, stifn,
747 2 stig, fx, fy, fz,
748 3 iperm1, iperm2, npe, them,
749 4 fthe, condn, condeg, nel,
750 5 jthe, glob_therm%NODADT_THERM)
751 ELSE
752 CALL s20cumu3p(
753 1 gbuf%OFF, stig, fsky, fsky,
754 2 iads(1,nf1), fx, fy, fz,
755 3 iads16(1,nf2),nc, iperm1, iperm2,
756 4 npe, them, fthesky, condnsky,
757 5 condeg, nel, nft, jthe,
758 6 glob_therm%NODADT_THERM)
759 ENDIF
760C-----------
761 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
max
#define max(a, b)
Definition macros.h:21
mmain
subroutine mmain(pm, elbuf_str, ix, nix, x, geo, iparg, nel, skew, bufmat, ipart, ipartel, nummat, matparam, imat, ipm, ngl, pid, npf, tf, mfxx, mfxy, mfxz, mfyx, mfyy, mfyz, mfzx, mfzy, mfzz, rx, ry, rz, sx, sy, sz, gama, voln, dvol, s1, s2, s3, s4, s5, s6, dxx, dyy, dzz, d4, d5, d6, wxx, wyy, wzz)
Definition mmain.F:43
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
dt_mod
Definition dt_mod.F:80
nlocal_reg_mod
Definition nlocal_reg_mod.F:119
table_mod
Definition table_mod.F:113
s16bilan
subroutine s16bilan(partsav, eintg, rhog, volg, vol0g, vx, vy, vz, iparts, gresav, grth, igrth, iexpan, eintth, fill, x, y, z, itask, iparg, offg, sensors, nel, g_wpla, wpla)
Definition s16bilan.F:38
s16sigp3
subroutine s16sigp3(lft, llt, nel, nptr, nlay, nptt, icp, mtn, npe, nipmax, px, py, pz, vx, vy, vz, w_gauss, defp, pm, mxt, sig, dt1, elbuf_str)
Definition s16sigp3.F:36
s16sigs3
subroutine s16sigs3(dxx, dyy, dzz, d4, d5, d6, rx, ry, rz, sx, sy, sz, tx, ty, tz, eint, vol0, sigs, mxt, pm, dt1, vol0dp, nel)
Definition s16sigs3.F:35
s20cumu3
subroutine s20cumu3(offg, a, nc, stifn, stig, fx, fy, fz, iperm1, iperm2, npe, them, fthe, condn, condeg, nel, jthe, nodadt_therm)
Definition s20cumu3.F:35
s20cumu3p
subroutine s20cumu3p(offg, stig, fsky, fskyv, iads, fx, fy, fz, iadsp, nc, iperm1, iperm2, npe, them, fthesky, condnsky, condeg, nel, nft, jthe, nodadt_therm)
Definition s20cumu3p.F:36
s20defo3
subroutine s20defo3(npe, px, py, pz, vx, vy, vz, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz, d4, d5, d6, wxx, wyy, wzz, rho, rhoo, volnp, voln, nel)
Definition s20defo3.F:37
s20fint3
subroutine s20fint3(npe, sig, px, py, pz, ssp_eq, fx, fy, fz, vol, qvis, stig, stin, eint, rho, q, eplas, epsd, epsdg, sigg, eintg, rhog, qg, eplasg, wi, volg, vol0, vol0g, g_pla, nel, conde, deltax, condeg, israt, svis, nodadt_therm, g_wpla, l_wpla, g_wpla_flag)
Definition s20fint3.F:40
s20tempcg
subroutine s20tempcg(jft, jlt, npe, nc, ni, temp, tempel)
Definition s20tempcg.F:30
s20therm
subroutine s20therm(npe, pm, imat, nc, vol, px, py, pz, ni, dt1, tempnc, tempel, heat, fphi, offg, off, nel, theaccfact)
Definition s20therm.F:35
sdlensh2
subroutine sdlensh2(voln, llsh, area, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, nel)
Definition sdlensh2.F:37
smalla3
subroutine smalla3(sav, offg, off, wxx, wyy, wzz, nel, ismstr, jlag)
Definition smalla3.F:35
smallb3
subroutine smallb3(offg, off, nel, ismstr)
Definition smallb3.F:45
srota3
subroutine srota3(sig, s1, s2, s3, s4, s5, s6, wxx, wyy, wzz, nel, mtn, ismstr)
Definition srota3.F:43
sstra3
subroutine sstra3(dxx, dyy, dzz, d4, d5, d6, strain, wxx, wyy, wzz, off, nel, jcvt)
Definition sstra3.F:47
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
srho3
subroutine srho3(pm, volo, rhon, eint, dxx, dyy, dzz, voln, dvol, mat)
Definition srho3.F:31
s16rst
subroutine s16rst(r, s, t, ni, dnidr, dnids, dnidt)
Definition s16deri3.F:495
s16deri3
subroutine s16deri3(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, kxx, ni, volg, ul, voldp)
Definition s16deri3.F:37
sxfillopt
subroutine sxfillopt(npe, fill, sti, fx, fy, fz, nel)
Definition sxfillopt.F:33
tshgeodel3
subroutine tshgeodel3(ngl, offg, volg, area, volg0, l_sh, geo, nnod, dt, nel)
Definition tshgeodel3.F:36