63 1 ELBUF_STR, JFT, JLT, PM,
65 3 V, R, FAILWAVE, NVC,
67 5 BUFMAT, PMSAV, DT2T, NELTST,
68 6 ITYPTST, STIFN, STIFR, FSKY,
69 7 IADTG, ITAB, EPSDOT, IPARTTG,
70 8 THKE, GROUP_PARAM, F11, F12,
75 D MAT_ELEM, NEL, ISTRAIN, IHBE,
76 E ITHK, IOFC, IPLA, NFT,
77 F ISMSTR, NPT, KFTS, IGEO,
78 G IPM, IFAILURE, GRESAV, GRTH,
79 H IGRTH, MSTG, DMELTG, JSMS,
80 I TABLE, IPARG, SENSORS, PTG,
81 J JTHE, CONDN, CONDNSKY, ISUBSTACK,
82 K STACK, ITASK, DRAPE_SH3N, IPRI,
83 L NLOC_DMG, INDX_DRAPE, IGRE, JTUR,
84 M DT, NCYCLE, SNPC, STF,
85 M GLOB_THERM, NXLAYMAX, IDEL7NOK, USERL_AVAIL,
105#include "implicit_f.inc"
109#include "mvsiz_p.inc"
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"
121 TYPE(timer_) ,
INTENT(INOUT) :: TIMERS
122 INTEGER,
INTENT(IN) :: USERL_AVAIL
123 INTEGER,
INTENT(IN) ::
124 INTEGER,
INTENT(INOUT) :: IDEL7NOK
125 INTEGER,
INTENT(IN) :: NXLAYMAX
126 INTEGER,
INTENT(IN) :: SBUFMAT
127 INTEGER,
INTENT(IN) :: STF
128 INTEGER,
INTENT(IN) :: SNPC
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 (*),IXTG(NIXTG,*),IADTG(3,*),IGEO(NPROPGI,*),ITAB(*),
135 . IPM(NPROPMI,*),IPARTTG(*),GRTH(*),IGRTH(*),IPARG(*),INDX_DRAPE(SCDRAPE)
138 . (NPROPM,*), X(*), F(*), M(*), (*), 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(*)
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
163 INTEGER (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,,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
171 my_real,
dimension(mvsiz) :: epsd_pg,epsd_glob
172 my_real :: dtinv,asrate,eps_m2,eps_k2
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)
194 .
DIMENSION(1),
TARGET :: bid
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
202 :
ALLOCATABLE,
DIMENSION(:),
TARGET :: dira,dirb
204 .
DIMENSION(:) ,
POINTER :: dir_a,dir_b,crkdir,dadv
206 my_real,
dimension(mvsiz) :: fheat
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
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
223 1 0.166666666666667,0.666666666666667,0.166666666666667,
226 gbuf => elbuf_str%GBUF
232 igtyp = igeo(11,ixtg(5,1))
234 actifxfem = iparg(70)
247 nlay = elbuf_str%NLAY
252 npttot = npttot + elbuf_str%BUFLY(ilay)%NPTT
254 IF (npt == 0) npttot = npt
256 ALLOCATE(var_reg(nel,nddl))
260 ifailwave = iparg(79)
261 IF (ifailwave > 0)
THEN
263 offly(:) = elbuf_str%BUFLY(1)%OFF(:)
266 offly(j) =
max(offly(j), elbuf_str%BUFLY(i)%OFF(j))
271 . nel ,ixtg ,itab ,ngl ,offly )
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
282 ELSEIF (irep == 0)
THEN
285 nptt = elbuf_str%BUFLY(ilay)%NPTT
288 lbuf_dir => elbuf_str%BUFLY(ilay)%LBUF_DIR(it)
289 j1 = 1+(j-1)*l_dira*nel
291 dira(j1:j2) = lbuf_dir%DIRA(1:nel*l_dira)
293 npttot = npttot + nptt
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)
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))
307 IF (l_dira == 0)
THEN
309 ELSEIF (irep == 0)
THEN
311 j1 = 1+(j-1)*l_dira*nel
313 dira(j1:j2) = elbuf_str%BUFLY(j)%DIRA(1:nel*l_dira)
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)
323 igtyp = igeo(11,ixtg(5,1))
324 igmat = igeo(98 ,ixtg(5,1))
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 ,
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,
349 CALL cdkderic3(jft ,jlt, x2l,y2l,x3l,y3l,area2,alpe,aldt,
350 1 px2,py2,px3,py3,px,py,pxy,pyy,vol0,vol00,
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)
358 lenf = nel*gbuf%G_FORPG/npg
359 lenm = nel*gbuf%G_MOMPG/npg
360 lens = nel*gbuf%G_STRPG/npg
362 epsd_glob(1:nel) = zero
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)
382 l_nloc = nloc_dmg%L_NLOC
383 dnl => nloc_dmg%DNL(1:l_nloc)
384 unl => nloc_dmg%UNL(1:l_nloc)
387 var_reg(1:nel,1:nddl) = zero
394#include
"vectorize.inc"
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)
408!-------------------------------------------------------------------------------
416 dtinv = dt1 /
max(dt1**2,em20)
417#include "vectorize.inc"
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
422 epsd_pg(i) = sqrt(eps_k2 + eps_m2)*dtinv
423 epsd_glob(i) = epsd_glob(i) + epsd_pg(i) / npg
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
434 8 gbuf%FORPG(ptf),gbuf%MOMPG
435 9 gbuf%THK ,gbuf%EINT ,iofc
436 a g ,a11 ,a12 ,vol0 ,indx ,
437 b ngl ,zcfac ,shf ,gs ,epsd_pg ,
440 e ipm ,ifailure ,npg ,fheat
441 f tempel ,die ,ibid ,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,
453 q ncycle ,snpc , stf ,
454 s nxlaymax ,idel7nok ,userl_avail ,maxfunc ,npttot,
455 t sbufmat ,sdir_a ,sdir_b, gbuf%FORPG_G(ptf))
461 gbuf%THK(i) = gbuf%THK(i) - two_third*(gbuf%THK(i)-thk0(i))
462 thk0(i) = gbuf%THK(i)
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 )
476 CALL cdkfint3(jft,jlt,vol0,thk0,gbuf%FORPG(ptf),gbuf%MOMPG(ptm),
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,
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)
504 gbuf%epsd(1:nel) = asrate * epsd_glob(1:nel) + (one - asrate) * gbuf%epsd(1:nel)
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))
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))
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
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 )
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 )
561 CALL dtcdk_reg(nloc_dmg,thk0 ,nel ,gbuf%OFF,
562 . aldt ,ixtg(1,jft),nddl ,dt2t )
572 2 gbuf%THK, gbuf%EINT, pmsav, iparttg,
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)
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 )
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)
605 IF (ifailwave > 0)
THEN
606 crkdir => elbuf_str%BUFLY(1)%CRKDIR
609 . nel ,ixtg ,itab ,crkdir ,dir_a ,
610 . l_dira ,x2l ,x3l ,y2l ,y3l )
613 IF (
ALLOCATED(dirb))
DEALLOCATE(dirb)
614 IF (
ALLOCATED(dira))
DEALLOCATE(dira)
615 IF (
ALLOCATED(var_reg))
DEALLOCATE(var_reg)
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)