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"
#include "vectorize.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, ipart, lipart1)

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,
integer, dimension(lipart1, npart ), intent(in) ipart,
integer, intent(in) lipart1 )

Definition at line 63 of file cdkforc3.F.

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