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

Go to the source code of this file.

Functions/Subroutines

subroutine cdkforc3 (timers, elbuf_str, jft, jlt, pm, ixtg, x, f, m, v, r, failwave, nvc, mtn, geo, tf, npf, bufmat, pmsav, dt2t, neltst, ityptst, stifn, stifr, fsky, iadtg, itab, epsdot, iparttg, thke, group_param, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, mat_elem, nel, istrain, ihbe, ithk, iofc, ipla, nft, ismstr, npt, kfts, igeo, ipm, ifailure, gresav, grth, igrth, mstg, dmeltg, jsms, table, iparg, sensors, ptg, jthe, condn, condnsky, isubstack, stack, itask, drape_sh3n, ipri, nloc_dmg, indx_drape, igre, jtur, dt, ncycle, snpc, stf, glob_therm, nxlaymax, idel7nok, userl_avail, maxfunc, sbufmat)

Function/Subroutine Documentation

◆ cdkforc3()

subroutine cdkforc3 ( type(timer_), intent(inout) timers,
type(elbuf_struct_), target elbuf_str,
integer jft,
integer jlt,
pm,
integer, dimension(nixtg,*) ixtg,
x,
f,
m,
v,
r,
type (failwave_str_), target failwave,
integer nvc,
integer mtn,
geo,
tf,
integer, dimension(*) npf,
bufmat,
pmsav,
dt2t,
integer neltst,
integer ityptst,
stifn,
stifr,
fsky,
integer, dimension(3,*) iadtg,
integer, dimension(*) itab,
epsdot,
integer, dimension(*) iparttg,
thke,
type (group_param_) group_param,
f11,
f12,
f13,
f21,
f22,
f23,
f31,
f32,
f33,
m11,
m12,
m13,
m21,
m22,
m23,
m31,
m32,
m33,
type (mat_elem_), intent(inout) mat_elem,
integer nel,
integer istrain,
integer ihbe,
integer ithk,
integer iofc,
integer ipla,
integer nft,
integer ismstr,
integer npt,
integer kfts,
integer, dimension(npropgi,*) igeo,
integer, dimension(npropmi,*) ipm,
integer ifailure,
gresav,
integer, dimension(*) grth,
integer, dimension(*) igrth,
mstg,
dmeltg,
integer jsms,
type(ttable), dimension(*) table,
integer, dimension(*) iparg,
type (sensors_), intent(inout) sensors,
ptg,
integer jthe,
condn,
condnsky,
integer isubstack,
type (stack_ply) stack,
integer itask,
type (drape_), dimension (numeltg_drape) drape_sh3n,
integer ipri,
type (nlocal_str_), target nloc_dmg,
integer, dimension(scdrape) indx_drape,
integer, intent(in) igre,
integer, intent(in) jtur,
type (dt_), intent(in) dt,
integer, intent(in) ncycle,
integer, intent(in) snpc,
integer, intent(in) stf,
type (glob_therm_), intent(inout) glob_therm,
integer, intent(in) nxlaymax,
integer, intent(inout) idel7nok,
integer, intent(in) userl_avail,
integer, intent(in) maxfunc,
integer, intent(in) sbufmat )

Definition at line 62 of file cdkforc3.F.

87C-----------------------------------------------
88C M o d u l e s
89C-----------------------------------------------
90 USE mat_elem_mod
91 USE table_mod
92 USE stack_mod
93 USE failwave_mod
94 USE nlocal_reg_mod
95 USE drape_mod
96 USE sensor_mod
97 USE elbufdef_mod
98 USE dt_mod
99 use glob_therm_mod
100 use dttherm_mod
101 USE timer_mod
102C-----------------------------------------------
103C I m p l i c i t T y p e s
104C-----------------------------------------------
105#include "implicit_f.inc"
106C-----------------------------------------------
107C G l o b a l P a r a m e t e r s
108C-----------------------------------------------
109#include "mvsiz_p.inc"
110C-----------------------------------------------
111C C o m m o n B l o c k s
112C-----------------------------------------------
113#include "param_c.inc"
114#include "com04_c.inc"
115#include "com08_c.inc"
116#include "scr18_c.inc"
117#include "parit_c.inc"
118C-----------------------------------------------
119C D u m m y A r g u m e n t s
120C-----------------------------------------------
121 TYPE(TIMER_) ,INTENT(INOUT) :: TIMERS
122 INTEGER,INTENT(IN) :: USERL_AVAIL ! Flag for User libraries availability
123 INTEGER,INTENT(IN) :: MAXFUNC ! Maximum number of functions
124 INTEGER,INTENT(INOUT) :: IDEL7NOK ! Element deletion flag for IDEL flag in contact interfaces
125 INTEGER, INTENT(IN) :: NXLAYMAX ! XFEM Max layer
126 INTEGER, INTENT(IN) :: SBUFMAT ! Size of bufmat
127 INTEGER, INTENT(IN) :: STF ! Size of TF
128 INTEGER, INTENT(IN) :: SNPC ! Size of NPC
129 INTEGER, INTENT(IN) :: JTUR, NCYCLE
130 INTEGER, INTENT(IN) :: IGRE
131 INTEGER JFT, JLT, NVC, MTN,NELTST,ITYPTST,IUN,
132 . NEL,ISTRAIN,IHBE ,ITHK,IOFC,IPLA,NFT,ISMSTR ,
133 . NPT,KFTS,IFAILURE,JSMS,JTHE,ISUBSTACK,ITASK,IPRI
134 INTEGER NPF(*),IXTG(NIXTG,*),IADTG(3,*),IGEO(NPROPGI,*),ITAB(*),
135 . IPM(NPROPMI,*),IPARTTG(*),GRTH(*),IGRTH(*),IPARG(*),INDX_DRAPE(SCDRAPE)
136C REAL
137 my_real
138 . pm(npropm,*), x(*), f(*), m(*), v(*), r(*),
139 . geo(npropg,*), tf(*), bufmat(*), pmsav(*),stifn(*),
140 . stifr(*),fsky(*),epsdot(6,*),thke(*),dt2t,
141 . f11(mvsiz), f12(mvsiz), f13(mvsiz),
142 . f21(mvsiz), f22(mvsiz), f23(mvsiz),
143 . f31(mvsiz), f32(mvsiz), f33(mvsiz),
144 . m11(mvsiz), m12(mvsiz), m13(mvsiz),
145 . m21(mvsiz), m22(mvsiz), m23(mvsiz),
146 . m31(mvsiz), m32(mvsiz), m33(mvsiz),
147 . gresav(*),mstg(*), dmeltg(*),ptg(3,*),condn(*),condnsky(*)
148 TYPE(TTABLE) TABLE(*)
149 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
150 TYPE (STACK_PLY) :: STACK
151 TYPE (FAILWAVE_STR_) ,TARGET :: FAILWAVE
152 TYPE (GROUP_PARAM_) :: GROUP_PARAM
153 TYPE (NLOCAL_STR_), TARGET :: NLOC_DMG
154 TYPE (DRAPE_), DIMENSION (NUMELTG_DRAPE):: DRAPE_SH3N
155 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
156 TYPE (SENSORS_) ,INTENT(INOUT) :: SENSORS
157 TYPE (DT_), INTENT(IN) :: DT
158 type (glob_therm_) ,intent(inout) :: glob_therm
159C-----------------------------------------------
160C L o c a l V a r i a b l e s
161C-----------------------------------------------
162c indx utilise localement contrairement aux coques 4n
163 INTEGER MAT(MVSIZ),PID(MVSIZ),NGL(MVSIZ),INDX(MVSIZ),FWAVE_EL(NEL),
164 . IFLAG,LENF,LENM,LENS,IR,IS,IT,IPT,NPTT,N1,N2,N3,
165 . I,II,J,JJ,NG,NPG,NNOD,NPTR,NPTS,NLAY,L_DIRA,L_DIRB,IFAILWAVE,
166 . PT0,PT1,PT2,PT3,PTF,PTM,PTE,PTEP,PTS,IGTYP,IBID,J1,J2,
167 . IGMAT,ILAY,NPTTOT,IREP,KK(5),K,IDRAPE,ACTIFXFEM,SEDRAPE,NUMEL_DRAPE
168 INTEGER, DIMENSION(NEL) :: OFFLY
169 parameter(npg = 3)
170 parameter(nnod = 3)
171 my_real, dimension(mvsiz) :: epsd_pg,epsd_glob
172 my_real :: dtinv,asrate,eps_m2,eps_k2
173 my_real
174 . sti(mvsiz),stir(mvsiz),rho(mvsiz),
175 . ssp(mvsiz),viscmx(mvsiz),area(mvsiz),area2(mvsiz),
176 . exx(mvsiz), eyy(mvsiz), exy(mvsiz), exz(mvsiz), eyz(mvsiz),
177 . kxx(mvsiz), kyy(mvsiz), kxy(mvsiz),
178 . px2(mvsiz),py2(mvsiz), px3(mvsiz), py3(mvsiz),
179 . off(mvsiz), sigy(mvsiz),thk0(mvsiz),
180 . nu(mvsiz) , shf(mvsiz), dt1c(mvsiz),
181 . g(mvsiz) , ym(mvsiz) , a11(mvsiz) , a12(mvsiz),
182 . vol0(mvsiz),thk02(mvsiz),zcfac(mvsiz,2), gs(mvsiz),
183 . vol00(mvsiz),alpe(mvsiz),a_hammer(3,2),one_over_3,o2_3th,
184 . r11(mvsiz),r12(mvsiz),r13(mvsiz),r21(mvsiz),r22(mvsiz),
185 . r23(mvsiz),r31(mvsiz),r32(mvsiz),r33(mvsiz),aldt(mvsiz),
186 . vlx(mvsiz,2),vly(mvsiz,2),vlz(mvsiz,2),rlx(mvsiz,3),rly(mvsiz,3),
187 . px(mvsiz,3),py(mvsiz,3),pxy(mvsiz,3), pyy(mvsiz,3),
188 . bz1(mvsiz,2),bz2(mvsiz,2),bz3(mvsiz,2), brx1(mvsiz,3),
189 . brx2(mvsiz,3),brx3(mvsiz,3),bry1(mvsiz,3),bry2(mvsiz,3),
190 . bry3(mvsiz,3),amu(mvsiz),cdet(mvsiz),vdef(mvsiz,8),die(mvsiz),
191 . tempel(mvsiz),krz(mvsiz),dir1_crk(npt,mvsiz),
192 . dir2_crk(npt,mvsiz),conde(mvsiz),a11r(mvsiz)
193 my_real,
194 . DIMENSION(1),TARGET :: bid
195 my_real
196 . x1g(mvsiz), x2g(mvsiz), x3g(mvsiz),
197 . y1g(mvsiz), y2g(mvsiz), y3g(mvsiz),
198 . z1g(mvsiz), z2g(mvsiz), z3g(mvsiz),
199 . x2l(mvsiz),y2l(mvsiz),x3l(mvsiz),y3l(mvsiz)
200 my_real , DIMENSION(NEL) :: zoffset
201 my_real,
202 : ALLOCATABLE, DIMENSION(:), TARGET :: dira,dirb
203 my_real,
204 . DIMENSION(:) ,POINTER :: dir_a,dir_b,crkdir,dadv
205! variables for heat transfer
206 my_real, dimension(mvsiz) :: fheat
207!
208C--- Variables pour le non-local
209 INTEGER :: NDDL, INOD(3),NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), L_NLOC, IPOS(3),INLOC
210 my_real, DIMENSION(:,:), ALLOCATABLE :: var_reg
211 my_real, DIMENSION(:), POINTER :: dnl,unl
212 my_real
213 . ksi,eta
214 INTEGER SDIR_A ! Size of DIR_A
215 INTEGER SDIR_B ! Size of DIR_B
216C-----
217 TYPE(BUF_LAY_) ,POINTER :: BUFLY
218 TYPE(G_BUFEL_) ,POINTER :: GBUF
219 TYPE(L_BUFEL_) ,POINTER :: LBUF1,LBUF2,LBUF3 ,LBUF
220 TYPE(L_BUFEL_DIR_) ,POINTER :: LBUF_DIR
221C-----------------------------------------------
222 DATA a_hammer /
223 1 0.166666666666667,0.666666666666667,0.166666666666667,
224 2 0.166666666666667,0.166666666666667,0.666666666666667/
225C=======================================================================
226 gbuf => elbuf_str%GBUF
227 idrape = elbuf_str%IDRAPE
228C---
229 iun = 1
230 ibid = 0
231 bid = zero
232 igtyp = igeo(11,ixtg(5,1))
233 irep = iparg(35)
234 actifxfem = iparg(70)
235 inloc= iparg(78)
236 sedrape = stdrape
237 numel_drape = numeltg_drape
238 ! thermal transfert for 3n shells type cdkforc is not available
239 tempel(:) = zero
240 fheat(: ) = zero
241!
242 DO j=1,5
243 kk(j) = nel*(j-1)
244 ENDDO
245!
246C
247 nlay = elbuf_str%NLAY
248c NPT --> set to = IPARG(6) , keeping it original to allow for NPT = 0 (global LAW_3
249C
250 npttot = 0
251 DO ilay=1,nlay
252 npttot = npttot + elbuf_str%BUFLY(ilay)%NPTT
253 ENDDO
254 IF (npt == 0) npttot = npt ! compatibility with global integration
255 nddl = npttot
256 ALLOCATE(var_reg(nel,nddl))
257c--------------------------------------------
258c Front wave
259c--------------------------------------------
260 ifailwave = iparg(79)
261 IF (ifailwave > 0) THEN
262 fwave_el(:) = zero
263 offly(:) = elbuf_str%BUFLY(1)%OFF(:)
264 DO i=2,nlay
265 DO j=1,nel
266 offly(j) = max(offly(j), elbuf_str%BUFLY(i)%OFF(j))
267 ENDDO
268 ENDDO
269 dadv => gbuf%DMG
270 CALL set_failwave_sh3n(failwave ,fwave_el ,dadv ,
271 . nel ,ixtg ,itab ,ngl ,offly )
272c
273 ENDIF
274c-------------------------------------
275 l_dira = elbuf_str%BUFLY(1)%LY_DIRA
276 l_dirb = elbuf_str%BUFLY(1)%LY_DIRB
277 IF(idrape > 0 .AND. (igtyp == 51 .OR. igtyp == 52)) THEN
278 ALLOCATE(dira(npttot*nel*l_dira))
279 ALLOCATE(dirb(npttot*nel*l_dirb))
280 IF (l_dira == 0) THEN
281 CONTINUE
282 ELSEIF (irep == 0) THEN
283 npttot = 0
284 DO ilay=1,nlay
285 nptt = elbuf_str%BUFLY(ilay)%NPTT
286 DO it=1,nptt
287 j = npttot + it
288 lbuf_dir => elbuf_str%BUFLY(ilay)%LBUF_DIR(it)
289 j1 = 1+(j-1)*l_dira*nel
290 j2 = j*l_dira*nel
291 dira(j1:j2) = lbuf_dir%DIRA(1:nel*l_dira)
292 ENDDO
293 npttot = npttot + nptt
294 ENDDO
295 ENDIF
296 sdir_a=npttot*nel*l_dira
297 sdir_b=npttot*nel*l_dirb
298 dir_a => dira(1:npttot*nel*l_dira)
299 dir_b => dirb(1:npttot*nel*l_dirb)
300 ELSE ! idrape
301 sdir_a=nlay*nel*l_dira
302 sdir_b=nlay*nel*l_dirb
303 ALLOCATE(dira(nlay*nel*l_dira))
304 ALLOCATE(dirb(nlay*nel*l_dirb))
305 dira=zero
306 dirb=zero
307 IF (l_dira == 0) THEN
308 CONTINUE
309 ELSEIF (irep == 0) THEN
310 DO j=1,nlay
311 j1 = 1+(j-1)*l_dira*nel
312 j2 = j*l_dira*nel
313 dira(j1:j2) = elbuf_str%BUFLY(j)%DIRA(1:nel*l_dira)
314 ENDDO
315 ENDIF
316 sdir_a=nlay*nel*l_dira
317 sdir_b=nlay*nel*l_dirb
318 dir_a => dira(1:nlay*nel*l_dira)
319 dir_b => dirb(1:nlay*nel*l_dirb)
320 ENDIF ! IDRAPE
321C
322c-------------------------------------
323 igtyp = igeo(11,ixtg(5,1))
324 igmat = igeo(98 ,ixtg(5,1))
325
326C Initialize MAT and PID (because they are used in CMATBUF3
327 DO i=jft,jlt
328 mat(i) = ixtg(1,i)
329 pid(i) = ixtg(5,i)
330 a11r(i) = zero
331 ENDDO
332C---
333 CALL cdkcoor3(elbuf_str,
334 . jft,jlt,mat,pid,ngl,x,v,r,ixtg,gbuf%OFF,
335 . off,r11,r12,r13,r21,r22,r23,r31,r32,r33,
336 . x2l,y2l,x3l,y3l,gbuf%SMSTR,
337 . area,area2,cdet,vlx,vly,vlz,rlx,rly,
338 . ismstr,irep,nlay,dir_a,dir_b,
339 . f11,f12,f13,f21,f22,f23,f32,f33,
340 . m11,m12,m13,m21,m22,m23,nel)
341 CALL cncoef3(jft ,jlt ,pm ,mat ,geo ,
342 2 pid ,off ,area ,shf ,thk0 ,
343 3 thk02 ,nu ,g ,ym ,
344 4 a11 ,a12 ,gbuf%THK,thke ,ssp ,
345 5 rho ,vol00 ,gs ,mtn ,ithk ,
346 6 npttot ,dt1c ,dt1 ,ihbe ,amu ,
347 7 krz ,igeo ,a11r ,isubstack, stack%PM,
348 8 nel ,zoffset )
349 CALL cdkderic3(jft ,jlt, x2l,y2l,x3l,y3l,area2,alpe,aldt,
350 1 px2,py2,px3,py3,px,py,pxy,pyy,vol0,vol00,
351 2 nu,thk02)
352C
353 CALL cdkdefo3(jft,jlt,vlx,vly,px2,py2,px3,py3,exx,eyy,exy,
354 1 exz, eyz,dt1,epsdot,nft,istrain,gbuf%STRA,vdef,nel)
355C-----------------------------------------------
356C BOUCLE SUR POINTS D'INTEGRATION DE GAUSS
357C-----------------------------------------------
358 lenf = nel*gbuf%G_FORPG/npg
359 lenm = nel*gbuf%G_MOMPG/npg
360 lens = nel*gbuf%G_STRPG/npg
361 it = 1
362 epsd_glob(1:nel) = zero
363c
364 DO ng =1,npg
365 ir = ng
366 is = 1
367 ptf = (ng-1)*lenf+1
368 ptm = (ng-1)*lenm+1
369 pts = (ng-1)*lens+1
370c
371 CALL cdkderi3(jft ,jlt,px2,py2,px3,py3,px,py,pxy,pyy,
372 1 bz1,bz2,bz3,brx1,brx2,brx3,bry1,bry2,bry3,
373 2 a_hammer(ng,1),a_hammer(ng,2))
374 CALL cdkcurv3(jft,jlt,bz1,bz2,bz3,brx1,brx2,brx3,bry1,
375 1 bry2,bry3,vlz,rlx,rly,kxx, kyy, kxy)
376 CALL cdkstra3(jft,jlt,gbuf%STRA,exx,eyy,exy,kxx, kyy, kxy,
377 1 epsdot,nft,istrain,dt1,gbuf%STRPG(pts),nel)
378c-------------------------------------------
379c COMPUTE Regularized non local variable in Gauss point
380c-------------------------------------------
381 IF (inloc > 0) THEN
382 l_nloc = nloc_dmg%L_NLOC
383 dnl => nloc_dmg%DNL(1:l_nloc) ! DNL = non local variable increment
384 unl => nloc_dmg%UNL(1:l_nloc)
385 eta = a_hammer(ng,1)
386 ksi = a_hammer(ng,2)
387 var_reg(1:nel,1:nddl) = zero
388 DO i = jft,jlt
389 nc1(i) = ixtg(2,i)
390 nc2(i) = ixtg(3,i)
391 nc3(i) = ixtg(4,i)
392 ENDDO
393 DO k = 1,nddl
394#include "vectorize.inc"
395 DO i = jft,jlt
396 inod(1) = nloc_dmg%IDXI(nc1(i))
397 inod(2) = nloc_dmg%IDXI(nc2(i))
398 inod(3) = nloc_dmg%IDXI(nc3(i))
399 ipos(1) = nloc_dmg%POSI(inod(1))
400 ipos(2) = nloc_dmg%POSI(inod(2))
401 ipos(3) = nloc_dmg%POSI(inod(3))
402 var_reg(i,k) = (one-eta-ksi)*dnl(ipos(1)+k-1) +
403 . eta*dnl(ipos(2)+k-1) +
404 . ksi*dnl(ipos(3)+k-1)
405 ENDDO
406 ENDDO
407 ENDIF
408!-------------------------------------------------------------------------------
409! global element strain rate (shell energy equivalent) - by Gauss points
410!-----------------------------------------------------------
411! e = 1/t integ[1/2 e (eps_m + k z)^2 dz ]
412! e = 1/2 e eps_eq^2
413! eps_eq = sqrt[ eps_m^2 + 1/12 k^2t^2 ]
414!-------------------------------------------------------------------------------
415 dt1 = dt1c(1)
416 dtinv = dt1 / max(dt1**2,em20) ! inverse of dt
417#include "vectorize.inc"
418 do i = 1,nel
419 eps_k2 = (kxx(i)**2+kyy(i)**2+kxx(i)*kyy(i)+fourth*kxy(i)**2)
420 . * one_over_9*gbuf%thk(i)**2
421 eps_m2 = four_over_3*(exx(i)**2+eyy(i)**2+exx(i)*eyy(i) + fourth*exy(i)**2)
422 epsd_pg(i) = sqrt(eps_k2 + eps_m2)*dtinv
423 epsd_glob(i) = epsd_glob(i) + epsd_pg(i) / npg
424 end do
425C----------------------------------------------------------------------------
426 CALL cmain3(timers,
427 1 elbuf_str ,jft ,jlt ,nft ,iparg ,
428 2 nel ,mtn ,ipla ,ithk ,group_param,
429 3 pm ,geo ,npf ,tf ,bufmat ,
430 4 ssp ,rho ,viscmx ,dt1c ,sigy ,
431 5 cdet ,exx ,eyy ,exy ,exz ,
432 6 eyz ,kxx ,kyy ,kxy ,nu ,
433 7 off ,thk0 ,mat ,pid ,mat_elem ,
434 8 gbuf%FORPG(ptf),gbuf%MOMPG(ptm) ,gbuf%STRPG(pts),failwave,fwave_el,
435 9 gbuf%THK ,gbuf%EINT ,iofc ,
436 a g ,a11 ,a12 ,vol0 ,indx ,
437 b ngl ,zcfac ,shf ,gs ,epsd_pg ,
438 c kfts ,ihbe ,alpe ,
439 d dir_a ,dir_b ,igeo ,
440 e ipm ,ifailure ,npg ,fheat ,
441 f tempel ,die ,ibid ,ibid ,bid ,
442 g ibid ,bid ,
443 h bid ,bid ,bid ,bid ,bid ,
444 i bid ,bid ,bid ,r11 ,r12 ,
445 j r13 ,r21 ,r22 ,r23 ,r31 ,
446 k r32 ,r33 ,ng ,table ,ibid ,
447 l bid ,sensors ,ibid ,ibid ,
448 m bid ,bid ,aldt ,glob_therm%IDT_THERM ,glob_therm%THEACCFACT,
449 n ismstr ,ir ,is ,nlay ,npt ,
450 o ibid ,ibid ,isubstack ,stack ,
451 p bid ,itask ,drape_sh3n ,var_reg ,nloc_dmg,
452 r indx_drape ,thke ,sedrape ,numel_drape ,dt ,
453 q ncycle ,snpc , stf ,
454 s nxlaymax ,idel7nok ,userl_avail ,maxfunc ,npttot,
455 t sbufmat ,sdir_a ,sdir_b, gbuf%FORPG_G(ptf))
456C----------------------------------------------------------------------------
457C THICKNESS CORRECTION
458C----------------------------
459 IF (ithk > 0) THEN
460 DO i=jft,jlt
461 gbuf%THK(i) = gbuf%THK(i) - two_third*(gbuf%THK(i)-thk0(i))
462 thk0(i) = gbuf%THK(i)
463 ENDDO
464 ENDIF
465C----------------------------------------------------------------------------
466C FORCES VISCOCITE
467C----------------------------
468C uniquement membranaire pour l'instant--------
469 CALL cbavisc(jft ,jlt ,vdef ,amu ,off ,
470 2 shf ,nu ,rho ,ssp ,cdet,
471 3 thk0 ,gbuf%FORPG(ptf),gbuf%MOMPG(ptm),iun ,mtn ,
472 4 iparttg ,pmsav ,dt1 ,nel )
473C----------------------------
474C FORCES INTERNES
475C----------------------------
476 CALL cdkfint3(jft,jlt,vol0,thk0,gbuf%FORPG(ptf),gbuf%MOMPG(ptm),
477 1 px2,py2,px3,py3,
478 2 bz1,bz2,bz3,
479 3 brx1,brx2,brx3,bry1,bry2,bry3,
480 4 f11,f12,f13,f21,f22,f23,f32,f33,
481 5 m11,m12,m13,m21,m22,m23,
482 6 nel)
483c-------------------------
484c Virtual internal forces of regularized non local ddl
485c--------------------------
486 IF (inloc > 0) THEN
487 CALL cdkfint_reg(
488 1 nloc_dmg, var_reg, thk0, nel,
489 2 gbuf%OFF, area, nc1, nc2,
490 3 nc3, px2, py2, px3,
491 4 py3, ksi, eta, elbuf_str%NLOC(ir,is),
492 5 ixtg(1,jft), nddl, itask, ng,
493 6 dt2t, gbuf%THK_I, gbuf%AREA, nft)
494 ENDIF
495c-------------------------------
496 ENDDO ! NG = 1,NPG
497C----
498C----------------------------------------------------------------------------
499C FIN DE BOUCLE DE 3 POINTS DE INTEGRATION------------
500C----------------------------------------------------------------------------
501! global element strain rate filtering for output
502
503 asrate = one ! to be changed for default value
504 gbuf%epsd(1:nel) = asrate * epsd_glob(1:nel) + (one - asrate) * gbuf%epsd(1:nel)
505!-------------------------------------------------------------------------------
506C POST-TRAITEMENT - valeurs moyennes
507C----------------------------
508C---
509C = FOR, MOM =
510C---
511 pt1 = 0
512 pt2 = pt1 + lenf
513 pt3 = pt2 + lenf
514 DO i=jft,jlt
515 DO j=1,5
516 gbuf%FOR(kk(j)+i) = third*(gbuf%FORPG(pt1+kk(j)+i)
517 . + gbuf%FORPG(pt2+kk(j)+i)
518 . + gbuf%FORPG(pt3+kk(j)+i))
519 ENDDO
520 ENDDO
521 pt2 = pt1 + lenm
522 pt3 = pt2 + lenm
523 DO i=jft,jlt
524 DO j=1,3
525 gbuf%MOM(kk(j)+i) = third*(gbuf%MOMPG(pt1+kk(j)+i)
526 . + gbuf%MOMPG(pt2+kk(j)+i)
527 . + gbuf%MOMPG(pt3+kk(j)+i))
528 ENDDO
529 ENDDO
530C-------------------------
531C ASSEMBLE
532C-------------------------
533 CALL cdkfcum3(jft,jlt,px2,py2,px3,py3,
534 1 r11,r12,r13,r21,r22,r23,r31,r32,r33,
535 2 f11,f12,f13,f21,f22,f23,f31,f32,f33,
536 3 m11,m12,m13,m21,m22,m23,m31,m32,m33)
537C
538C--------------------------
539C PAS DE TEMPS
540C--------------------------
541 CALL cndt3(
542 1 jft ,jlt ,off ,dt2t ,amu ,
543 2 neltst ,ityptst,sti ,stir ,gbuf%OFF,
544 3 ssp ,viscmx ,rho ,vol00 ,thk0 ,thk02,
545 4 a11 ,aldt ,alpe ,ngl , ismstr,
546 5 iofc ,nnod ,area ,g ,shf ,
547 6 mstg ,dmeltg ,jsms ,ptg ,igtyp ,
548 7 igmat ,a11r ,gbuf%G_DT, gbuf%DT,mtn ,
549 8 pm ,mat(jft),nel ,zoffset )
550C--------------------------
551C THERMAL TIME STEP
552C--------------------------
553 IF (jthe /= 0 .AND. glob_therm%IDT_THERM == 1) THEN
554 call dttherm(nel ,pm(1,mat(1)) ,npropm ,glob_therm ,
555 . jtur ,tempel ,vol0 ,rho ,
556 . aldt ,off ,conde ,gbuf%re ,gbuf%rk )
557 ENDIF
558C--------------------------
559C NON-LOCAL TIME STEP
560 IF (inloc > 0) THEN
561 CALL dtcdk_reg(nloc_dmg,thk0 ,nel ,gbuf%OFF,
562 . aldt ,ixtg(1,jft),nddl ,dt2t )
563 ENDIF
564C--------------------------
565C--------------------------
566C BILANS PAR MATERIAU
567C--------------------------
568c IFLAG=MOD(NCYCLE,NCPRI)
569 IF(ipri>0)
570 1 CALL c3bilan(
571 1 jft, jlt, pm, v,
572 2 gbuf%THK, gbuf%EINT, pmsav, iparttg,
573 3 rho, vol00, ixtg, x,
574 4 r, thk02, area, gresav,
575 5 grth, igrth, off, ibid,
576 6 ibid, ibid, ibid, ibid,
577 7 ibid, gbuf%EINTTH,itask, mat,
578 8 gbuf%VOL, actifxfem, igre, sensors,
579 9 nel, gbuf%G_WPLA,gbuf%WPLA)
580c
581 IF (iparit == 0) THEN
582 CALL c3updt3(jft ,jlt ,f ,m ,nvc ,
583 2 gbuf%OFF ,off ,sti ,stir ,stifn ,
584 3 stifr ,ixtg ,glob_therm%NODADT_THERM,
585 4 f11 ,f12 ,f13 ,f21 ,f22 ,f23 ,
586 5 f31 ,f32 ,f33 ,m11 ,m12 ,
587 7 m13 ,m21 ,m22 ,m23 ,m31 ,
588 8 m32 ,m33 ,ibid ,bid ,bid ,
589 9 gbuf%EINT,pm ,area ,gbuf%THK,
590 a pmsav ,mat ,iparttg ,condn ,conde )
591 ELSE
592 CALL c3updt3p(jft ,jlt ,gbuf%OFF ,off ,sti ,
593 2 stir ,fsky ,fsky,iadtg ,f11,
594 4 f12 ,f13 ,f21 ,f22 ,f23 ,
595 5 f31 ,f32 ,f33 ,m11 ,m12 ,
596 7 m13 ,m21 ,m22 ,m23 ,m31 ,
597 8 m32 ,m33 ,ibid,bid ,bid,
598 8 gbuf%EINT,pm ,area ,gbuf%THK,
599 b pmsav ,mat ,iparttg,condnsky,
600 c conde,glob_therm%NODADT_THERM)
601 ENDIF
602c--------------------------------------------
603c Front wave
604c--------------------------------------------
605 IF (ifailwave > 0) THEN
606 crkdir => elbuf_str%BUFLY(1)%CRKDIR
607c
608 CALL set_failwave_nod3(failwave ,fwave_el ,ngl ,
609 . nel ,ixtg ,itab ,crkdir ,dir_a ,
610 . l_dira ,x2l ,x3l ,y2l ,y3l )
611 ENDIF
612C------------
613 IF (ALLOCATED(dirb)) DEALLOCATE(dirb)
614 IF (ALLOCATED(dira)) DEALLOCATE(dira)
615 IF (ALLOCATED(var_reg)) DEALLOCATE(var_reg)
616C------------
617 RETURN
c3bilan
subroutine c3bilan(jft, jlt, pm, v, thk, eint, partsav, iparttg, rho, vol00, ixtg, x, vr, thk02, area, gresav, grth, igrth, off, ixfem, ilev, iel_crk, iadtg_crk, nft1, iexpan, eintth, itask, mat, gvol, actifxfem, igre, sensors, nel, g_wpla, wpla)
Definition c3bilan.F:47
c3updt3
subroutine c3updt3(jft, jlt, f, m, nvc, offg, off, sti, stir, stifn, stifr, ixtg, nodadt_therm, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, jthe, them, fthe, eint, pm, area, thk, partsav, mat, iparttg, condn, conde)
Definition c3updt3.F:38
c3updt3p
subroutine c3updt3p(jft, jlt, offg, off, sti, stir, fsky, fskyv, iadtg, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, jthe, them, fthesky, eint, pm, area, thk, partsav, mat, iparttg, condnsky, conde, nodadt_therm)
Definition c3updt3.F:408
cbavisc
subroutine cbavisc(jft, jlt, vdef, amu, off, shf, nu, rho, ssp, area, thk, for, mom, npt, mtn, ipartc, evis, dt1, nel)
Definition cbavisc.F:34
cdkcoor3
subroutine cdkcoor3(elbuf_str, jft, jlt, mat, pid, ngl, x, v, r, ixtg, offg, off, r11, r12, r13, r21, r22, r23, r31, r32, r33, xl2, yl2, xl3, yl3, smstr, area, area2, cdet, vlx, vly, vlz, rlx, rly, ismstr, irep, nlay, dir_a, dir_b, f11, f12, f13, f21, f22, f23, f32, f33, m11, m12, m13, m21, m22, m23, nel)
Definition cdkcoor3.F:41
cdkdefo3
subroutine cdkdefo3(jft, jlt, vlx, vly, px2, py2, px3, py3, exx, eyy, exy, exz, eyz, dt1, epsdot, nft, istrain, gstr, vdef, nel)
Definition cdkdefo3.F:31
cdkcurv3
subroutine cdkcurv3(jft, jlt, bz1, bz2, bz3, brx1, brx2, brx3, bry1, bry2, bry3, vlz, rlx, rly, kxx, kyy, kxy)
Definition cdkdefo3.F:105
cdkderic3
subroutine cdkderic3(jft, jlt, x2, y2, x3, y3, area2, alpe, aldt, px2, py2, px3, py3, px, py, pxy, pyy, vol, volg, nu, thk2)
Definition cdkderi3.F:31
cdkderi3
subroutine cdkderi3(jft, jlt, px2, py2, px3, py3, px, py, pxy, pyy, bz1, bz2, bz3, brx1, brx2, brx3, bry1, bry2, bry3, ksi, eta)
Definition cdkderi3.F:107
cdkfcum3
subroutine cdkfcum3(jft, jlt, px2, py2, px3, py3, r11, r12, r13, r21, r22, r23, r31, r32, r33, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33)
Definition cdkfcum3.F:32
cdkfint3
subroutine cdkfint3(jft, jlt, vol, thk0, for, mom, px2, py2, px3, py3, bz1, bz2, bz3, brx1, brx2, brx3, bry1, bry2, bry3, f11, f12, f13, f21, f22, f23, f32, f33, m11, m12, m13, m21, m22, m23, nel)
Definition cdkfint3.F:35
cdkfint_reg
subroutine cdkfint_reg(nloc_dmg, var_reg, thk, nel, off, area, nc1, nc2, nc3, px2, py2, px3, py3, ksi, eta, bufnl, imat, nddl, itask, ng, dt2t, thk0, area0, nft)
Definition cdkfint_reg.F:38
cdkstra3
subroutine cdkstra3(jft, jlt, gstr, exx, eyy, exy, kxx, kyy, kxy, epsdot, nft, istrain, dt1, gstrpg, nel)
Definition cdkstra3.F:30
cmain3
subroutine cmain3(timers, elbuf_str, jft, jlt, nft, iparg, nel, mtn, ipla, ithk, group_param, pm, geo, npf, tf, bufmat, ssp, rho, viscmx, dt1c, sigy, area, exx, eyy, exy, exz, eyz, kxx, kyy, kxy, nu, off, thk0, mat, pid, mat_elem, for, mom, gstr, failwave, fwave_el, thk, eint, iofc, g, a11, a12, vol0, indxdel, ngl, zcfac, shf, gs, epsd_pg, kfts, jhbe, alpe, dir_a, dir_b, igeo, ipm, ifailure, npg, fheat, tempel, die, jthe, iexpan, tempel0, ishplyxfem, ply_exx, ply_eyy, ply_exy, ply_exz, ply_eyz, ply_f, del_ply, th_iply, sig_iply, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, ng, table, ixfem, offi, sensors, a11_iply, elcrkini, dir1_crk, dir2_crk, aldt, idt_therm, theaccfact, ismstr, ir, is, nlay, npt, ixlay, ixel, isubstack, stack, f_def, itask, drape, varnl, nloc_dmg, indx_drape, thke, sedrape, numel_drape, dt, ncycle, snpc, stf, nxlaymax, idel7nok, userl_avail, maxfunc, varnl_npttot, sbufmat, sdir_a, sdir_b, for_g)
Definition cmain3.F:87
cncoef3
subroutine cncoef3(jft, jlt, pm, mat, geo, pid, off, area, shf, thk0, thk02, nu, g, ym, a11, a12, thk, thke, ssp, rho, volg, gs, mtn, ithk, npt, dt1c, dt1, ihbe, amu, krz, igeo, a11r, isubstack, pm_stack, nel, zoffset)
Definition cncoef3.F:303
cndt3
subroutine cndt3(jft, jlt, off, dt2t, amu, neltst, ityptst, sti, stir, offg, ssp, viscmx, rho, vol0, thk0, thk02, a1, aldt, alpe, ngl, ismstr, iofc, nne, area, g, shf, msc, dmelc, jsms, ptg, igtyp, igmat, a11r, g_dt, dtel, mtn, pm, imat, nel, zoffset)
Definition cndt3.F:42
my_real
#define my_real
Definition cppsort.cpp:32
dtcdk_reg
subroutine dtcdk_reg(nloc_dmg, thk, nel, off, le, imat, nddl, dt2t)
Definition dtcdk_reg.F: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
drape_mod
Definition drape_mod.F:54
drape_mod::numeltg_drape
integer numeltg_drape
Definition drape_mod.F:92
drape_mod::stdrape
integer stdrape
Definition drape_mod.F:92
dt_mod
Definition dt_mod.F:79
failwave_mod
Definition failwave_mod.F:61
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
stack_mod
Definition stack_mod.F:72
table_mod
Definition table_mod.F:112
set_failwave_nod3
subroutine set_failwave_nod3(failwave, fwave_el, ngl, nel, ixtg, itab, crkdir, dir_a, nrot, xl2, xl3, yl2, yl3)
Definition set_failwave_nod3.F:36
set_failwave_sh3n
subroutine set_failwave_sh3n(failwave, fwave_el, dadv, nel, ixtg, itab, ngl, offly)
Definition upd_failwave_sh3n.F:33