69 1 XFEM_STR, JFT, JLT, PM,
71 3 V, R, FAILWAVE, NVC,
73 5 BUFMAT, PMSAV, DT2T, NELTST,
74 6 ITYPTST, STIFN, STIFR, FSKY,
75 7 CRKSKY, IADTG, EPSDOT, OFFSET,
76 8 IPARTTG, THKE, F11, F12,
81 D KFTS, GROUP_PARAM, MAT_ELEM, NEL,
82 E ISTRAIN, ISH3N, ITHK, IOFC,
83 F IPLA, NFT, ISMSTR, FZERO,
84 G IGEO, IPM, IFAILURE, ITASK,
85 H JTHE, TEMP, FTHE, FTHESKY,
86 I IEXPAN, GRESAV, GRTH, IGRTH,
87 J MSTG, DMELTG, JSMS, TABLE,
88 K IPARG, SENSORS, PTG, IXFEM,
89 L INOD_CRK, IEL_CRK, IADTG_CRK, ELCUTC,
90 M IXEL, STACK, ISUBSTACK, UXINT_MEAN,
91 N UYINT_MEAN, UZINT_MEAN, NLEVXF, NODEDGE,
92 O CRKEDGE, DRAPE_SH3N, IPRI, NLOC_DMG,
93 P INDX_DRAPE, IGRE, DT, NCYCLE ,
94 R SNPC, STF, GLOB_THERM, IDEL7NOK,
95 Q USERL_AVAIL, MAXFUNC, SBUFMAT,IPART ,LIPART1 )
109 use element_mod ,
only : nixtg
113#include "implicit_f.inc"
117#include "mvsiz_p.inc"
121#include "param_c.inc"
122#include "com04_c.inc"
123#include "com_xfem1.inc"
124#include "parit_c.inc"
125#include "timeri_c.inc"
129 TYPE(timer_) :: TIMERS
130 INTEGER,
INTENT(IN) :: USERL_AVAIL
131 INTEGER,
INTENT(IN) :: MAXFUNC
132 INTEGER,
INTENT(INOUT) :: IDEL7NOK
133 INTEGER,
INTENT(IN) :: SBUFMAT ! size of bufmat
134 INTEGER,
INTENT(IN) :: STF
135 INTEGER,
INTENT(IN) :: SNPC
136 INTEGER,
INTENT(IN) :: IGRE,
137 INTEGER JFT,JLT,NVC,MTN,NELTST,ITYPTST,OFFSET,
138 . NEL,ISTRAIN,ISH3N,ICSEN,
139 . ITHK,IOFC,IPLA,NFT,ISMSTR,KFTS,IFAILURE,
140 . JSMS,IXEL,ISUBSTACK,NLEVXF,IPRI
141 INTEGER NPF(*),IXTG(NIXTG,*),IADTG(3,*),IGEO(NPROPGI,*),IPM(*),
142 . IPARTTG(*),ITASK,JTHE,IEXPAN,GRTH(*),IGRTH(*),IPARG(*),
143 . IXFEM,INOD_CRK(*),IEL_CRK(*),IADTG_CRK(3,*),
144 . ELCUTC(2,*),NODEDGE(2,*),INDX_DRAPE(STDRAPE)
146 . PM(NPROPM,*),F(*),M(*),V(*),R(*),
147 . GEO(NPROPG,*),TF(*),BUFMAT(*),PMSAV(*),STIFN(*),
148 . STIFR(*),FSKY(*),EPSDOT(6,*),THKE(*),DT2T,
149 . F11(MVSIZ),F12(MVSIZ),F13(MVSIZ),
150 . F21(MVSIZ),F22(MVSIZ),F23(MVSIZ),
151 . F31(MVSIZ),F32(MVSIZ),F33(MVSIZ),
152 . M11(MVSIZ),M12(MVSIZ),M13(MVSIZ),
153 . M21(MVSIZ),M22(MVSIZ),M23(MVSIZ),
154 . M31(MVSIZ),M32(MVSIZ),M33(MVSIZ),
155 . FZERO(3,3,*),TEMP(*),FTHE(*),FTHESKY(*),GRESAV(
157 . uxint_mean(nlevxf,mvsiz),uyint_mean(nlevxf,mvsiz),
158 . uzint_mean(nlevxf,mvsiz)
160 REAL(kind=8), dimension(*),
INTENT(in) :: x
162 TYPE (elbuf_struct_),
TARGET :: XFEM_STR
163 TYPE (XFEM_EDGE_) ,
DIMENSION(*) :: CRKEDGE
164 TYPE (XFEM_SKY_) ,
DIMENSION(*) :: CRKSKY
165 TYPE (STACK_PLY) :: STACK
166 TYPE (FAILWAVE_STR_) :: FAILWAVE
167 TYPE (GROUP_PARAM_) ::
168 TYPE (DRAPE_) :: DRAPE_SH3N(NUMELTG_DRAPE)
169 TYPE (MAT_ELEM_) ,
INTENT(INOUT) :: MAT_ELEM
170 TYPE (NLOCAL_STR_) :: NLOC_DMG
171 TYPE (SENSORS_) ,
INTENT(INOUT) :: SENSORS
172 TYPE (DT_),
INTENT(IN) :: DT
173 type (glob_therm_) ,
intent(inout) :: glob_therm
174 integer,
intent(in) :: LIPART1
175 INTEGER,
DIMENSION(LIPART1,NPART),
INTENT(IN) :: IPART
182 . I,J1,J2,IR,IS,IT,IGTYP,IXFEM2,IREP,IMAT,
183 . IUN,NPG,IBID,IDRIL,NG,IXLAY,NXLAY,NLAYER,NPTT,
184 . L_DIRA,L_DIRB,ILEV,IGMAT,IPTHK,ISH3NFR,ACTIFXFEM,
185 . SEDRAPE, NUMEL_DRAPE
186 INTEGER MAT(MVSIZ),PID(MVSIZ),NGL(MVSIZ),INDX(MVSIZ),FWAVE(MVSIZ)
187 my_real sti(mvsiz),stir(mvsiz),rho(mvsiz),
188 . ssp(mvsiz),viscmx(mvsiz),
area(mvsiz),
191 . exx(mvsiz),eyy(mvsiz),exy(mvsiz),eyz(mvsiz),ezx(mvsiz),
192 . kxx(mvsiz),kyy(mvsiz),kxy(mvsiz),
193 . px1(mvsiz),py1(mvsiz),py2(mvsiz),
194 . x2(mvsiz), x3(mvsiz), y2(mvsiz), y3(mvsiz),
195 . x21g(mvsiz), y21g(mvsiz), z21g(mvsiz),
196 . x31g(mvsiz), y31g(mvsiz), z31g(mvsiz),
197 . off(mvsiz),sigy(mvsiz),thk0(mvsiz),
198 . nu(mvsiz),shf(mvsiz),dt1c(mvsiz),
199 . g(mvsiz),ym(mvsiz),a11(mvsiz),a12(mvsiz),
200 . vol0(mvsiz),thk02(mvsiz),zcfac(mvsiz,2),gs(mvsiz),
201 . vol00(mvsiz),alpe(mvsiz),die(mvsiz),tempel(mvsiz),
202 . e1x0(mvsiz), e1y0(mvsiz), e1z0(mvsiz), e2x0(mvsiz),
203 . e2y0(mvsiz), e2z0(mvsiz), e3x0(mvsiz), e3y0(mvsiz), e3z0(mvsiz),
204 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
205 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
206 . vl1(mvsiz,3),vl2(mvsiz,3),vl3(mvsiz,3),
207 . vrl1(mvsiz,3),vrl2(mvsiz,3),vrl3(mvsiz,3),them(mvsiz,3),
208 . ux1(mvsiz),ux2(mvsiz),ux3(mvsiz),
209 . uy1(mvsiz),uy2(mvsiz),uy3(mvsiz),
210 . vx13(mvsiz), vx23(mvsiz),vy12(mvsiz),
211 . rlz(mvsiz,3),wxy(mvsiz),mlz(mvsiz,3),krz(mvsiz),
212 . b0rz(mvsiz,3),bkrz(mvsiz,2),berz(mvsiz,2),bm0rz(mvsiz,3,2),
213 . ecos(mvsiz),esin(mvsiz),a11r(mvsiz),thke0(mvsiz),aldt(mvsiz)
215 my_real ,
DIMENSIOn(NEL) :: zoffset
217 . bid,thkr,f_def(mvsiz,8),wkxy(mvsiz)
219 REAL(kind=8), dimension(mvsiz) ::x1g,x2g,x3g
220 REAL(kind=8), dimension(mvsiz) ::y1g,y2g,y3g
221 REAL(kind=8), dimension(mvsiz) ::z1g,z2g,z3g
223 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: ELCRKINI
225 .
ALLOCATABLE,
DIMENSION(:) :: DIRA,DIRB,DIR1_CRK,DIR2_CRK
227 .
DIMENSION(:) ,
POINTER :: DIR_A,DIR_B
230 TYPE(BUF_LAY_) ,
POINTER :: BUFLY
231 TYPE(G_BUFEL_) ,
POINTER :: GBUF
232 TYPE(L_BUFEL_) ,
POINTER :: LBUF
235 my_real,
dimension(mvsiz) :: fheat
236 my_real,
dimension(mvsiz) :: ssp_eq
239 .
DIMENSION(:) ,
POINTER :: OFFG,THKG,STRAG,FORG,MOMG,
240 . EINTG,EPSDG,TEMPG,EINTTH,HOURGG
242 .
DIMENSION(:) ,
POINTER :: smstrg
244 .
DIMENSION(:,:),
ALLOCATABLE :: varnl
260 numel_drape = numeltg_drape
262 ALLOCATE(varnl(nel,1))
266 IF (ismstr>=10) ismstr=4
275 icsen = igeo(3,pid(1))
276 igtyp = igeo(11,pid(1))
279 actifxfem = iparg(70)
281 gbuf => xfem_str%GBUF
282 nxlay = xfem_str%NLAY
291 ALLOCATE(elcrkini(nxlaymax*nel))
292 ALLOCATE(dir1_crk(nxlaymax*nel))
293 ALLOCATE(dir2_crk(nxlaymax*nel))
298 l_dira = xfem_str%BUFLY(1)%LY_DIRA
299 l_dirb = xfem_str%BUFLY(1)%LY_DIRB
301 ALLOCATE(dira(nxlay*nel*l_dira))
302 ALLOCATE(dirb(nxlay*nel*l_dirb))
305 sdir_a=nxlay*nel*l_dira
306 sdir_b=nxlay*nel*l_dirb
307 dir_a => dira(1:nxlay*nel*l_dira)
308 dir_b => dirb(1:nxlay*nel*l_dirb)
311 nptt = xfem_str%BUFLY(ixlay)%NPTT
312 IF (l_dira == 0)
THEN
314 ELSEIF (irep == 0)
THEN
315 j1 = 1+(ixlay-1)*l_dira*nel
316 j2 = ixlay*l_dira*nel
317 dira(j1:j2) = xfem_str%BUFLY(ixlay)%DIRA(1:nel*l_dira)
328 ilev = nxel*(ixlay-1) + ixel
330 IF (igtyp == 1 .or. igtyp == 9)
THEN
334 ELSEIF (igtyp == 51 .OR. igtyp == 52)
THEN
336 thkr = stack%GEO(ipthk+ixlay,isubstack)
338 thke0(i) = thke(i) * thkr
343 thke0(i) = thke(i) * geo(ipthk+ixlay,ixtg(5,1))
348 lbuf => xfem_str%BUFLY(ixlay)%LBUF(ir,is,1)
349 bufly => xfem_str%BUFLY(ixlay)
359 eintth => lbuf%EINTTH
360 hourgg => bufly%HOURG
361 ELSEIF (nxlay == 1)
THEN
371 eintth => gbuf%EINTTH
376 . dt1c ,thke0 ,vl1 ,vl2 ,vl3 ,
377 . vrl1 ,vrl2 ,vrl3 ,x1g ,x2g ,
378 . x3g ,y1g ,y2g ,y3g ,z1g ,
379 . z2g ,z3g ,ilev ,iel_crk ,iadtg_crk,
383 CALL c3evec3(xfem_str ,dir_a ,dir_b ,jft ,jlt ,
384 . irep ,e1x0 ,e1y0 ,e1z0 ,e2x0 ,
385 . e2y0 ,e2z0 ,e3x0 ,e3y0 ,e3z0 ,
386 . e1x ,e1y ,e1z ,e2x ,
387 . e2y ,e2z ,e3x ,e3y ,e3z ,
388 . nxlay ,gbuf%OFF,ecos ,esin ,ish3nfr ,
389 . nel ,
area ,x21g ,y21g ,z21g ,
391 . x1g ,x2g ,x3g ,y1g ,y2g ,
392 . y3g ,z1g ,z2g ,z3g )
393 IF (ismstr /= 3)
THEN
394 CALL c3deri3(jft ,jlt ,px1 ,py1 ,py2 ,
395 . smstrg ,offg ,ismstr ,alpe ,aldt ,
396 . ux1 ,ux2 ,ux3 ,uy1 ,uy2 ,
397 . uy3 ,nel ,
area ,x21g ,y21g ,
398 . z21g ,x31g ,y31g ,z31g ,x2 ,
400 . e1x ,e1y ,e1z ,e2x ,
401 . e2y ,e2z ,e3x ,e3y ,e3z )
404 CALL c3pxpy3(jft ,jlt ,pm ,sti ,stir,
405 2 smstrg ,px1 ,py1 ,py2 ,mat ,
409 IF (idril > 0)
CALL c3brz3(jft ,jlt ,
area ,x2 ,x3 ,
410 . y3 ,bm0rz,b0rz ,bkrz ,berz )
412 CALL c3coef3(jft ,jlt ,pm ,mat ,geo ,
413 2 pid ,off ,
area ,sti ,stir ,
414 3 shf ,thk0 ,thk02 ,nu ,
415 4 g ,ym ,a11 ,a12 ,thkg ,
416 5 ssp ,rho ,vol0 ,gs ,mtn ,
417 6 ithk ,nptt ,ismstr ,vol00 ,igeo ,
418 7 a11r , isubstack, stack%PM, nel ,zoffset)
420 CALL c3defo3(jft ,jlt ,vl1 ,vl2 ,vl3 ,
421 . ixtg ,ish3n,px1 ,py1 ,py2 ,
422 . exx ,eyy ,exy ,eyz ,ezx ,
424 . e1x ,e1y ,e1z ,e2x ,
425 . e2y ,e2z ,e3x ,e3y ,e3z )
428 CALL c3defrz(jft ,jlt ,rlz ,bm0rz ,b0rz,
429 1 bkrz ,berz ,e3x0 ,e3y0 ,e3z0 ,
430 2 vrl1 ,vrl2 ,vrl3 ,exx ,eyy ,
431 3 exy ,px1 ,py1 ,py2 ,wxy ,
432 4
area ,vx13 ,vx23 ,vy12 )
436 CALL c3curv3(jft,jlt,vrl1,vrl2,vrl3,
437 . ixtg,wkxy ,ismstr,kxx,kyy,
438 . kxy ,px1 ,py1 ,py2 ,eyz ,ezx ,
439 . e1x ,e1y ,e1z ,e2x ,e2y ,
440 . e2z ,e3x ,e3y ,e3z )
443 2 mat ,
area ,exx ,eyy ,exy ,
444 3 ezx ,eyz ,kxx ,kyy ,kxy ,
445 4 geo ,pid ,nu ,shf ,strag ,
447 6 nft ,istrain ,ismstr ,
448 7 ux1 ,ux2 ,ux3 ,uy1 ,uy2
449 8 uy3 ,px1 ,py1 ,py2 ,mtn ,
450 9 f_def ,wkxy ,gbuf%STRW,nel )
453 IF (jthe > 0 )
CALL temp3cg(jft ,jlt ,pm ,mat ,ixtg,
456 IF ((itask==0).AND.(imon_mat==1))
CALL startime(timers,35)
459 1 xfem_str ,jft ,jlt ,nft ,iparg ,
460 2 nel ,mtn ,ipla ,ithk ,group_param,
461 3 pm ,geo ,npf ,tf ,bufmat ,
462 4 ssp ,rho ,viscmx ,dt1c ,sigy ,
463 5
area ,exx ,eyy ,exy ,ezx ,
464 6 eyz ,kxx ,kyy ,kxy ,nu ,
465 7 off ,thk0 ,mat ,pid ,mat_elem ,
466 8 forg ,momg ,strag ,failwave ,fwave ,
467 9 thkg ,eintg ,iofc ,
468 a g ,a11 ,a12 ,vol0 ,indx ,
469 b ngl ,zcfac ,shf ,gs ,epsdg ,
470 c kfts ,ish3n ,alpe ,
471 d dir_a ,dir_b ,igeo ,
472 e ipm ,ifailure ,npg ,fheat ,
473 f tempel ,die ,jthe ,iexpan ,tempg ,
475 h bid ,bid ,bid ,bid ,bid ,
476 i bid ,bid ,bid ,e1x ,e1y ,
477 j e1z ,e2x ,e2y ,e2z ,e3x ,
478 k e3y ,e3z ,ng ,table ,ixfem ,
479 l bid ,sensors ,bid ,elcrkini ,
480 m dir1_crk ,dir2_crk ,aldt ,glob_therm%IDT_THERM ,glob_therm%THEACCFACT,
481 p ismstr ,ir ,is ,nlayer ,nptt ,
482 q ixlay ,ixel ,isubstack ,stack ,
483 p bid ,itask ,drape_sh3n ,varnl ,nloc_dmg ,
485 q ncycle ,snpc , stf ,nxlaymax ,idel7nok ,
486 s userl_avail, maxfunc, npttot,bufmat ,sdir_a ,
487 t sdir_b ,gbuf%FOR_G,ssp_eq,
488 x ipart ,lipart1 ,iparttg )
491 IF ((itask==0).AND.(imon_mat==1))
CALL stoptime(timers,35)
495 IF (ismstr /= 3)
CALL c3dt3(
496 1 jft ,jlt ,pm ,off ,dt2t ,
497 2 neltst ,ityptst ,sti ,stir ,offg ,
498 3 ssp ,viscmx ,ismstr ,nft ,iofc ,
499 4 alpe ,mstg ,dmeltg ,jsms ,ptg ,
500 5 shf ,igtyp ,igmat ,g ,a11 ,
502 7
area ,ngl ,imat ,mtn ,nel ,
512 2 thkg, eintg, pmsav, iparttg,
513 3 rho, vol00, ixtg, x,
514 4 r, thk02,
area, gresav,
515 5 grth, igrth, off, ixfem2,
516 6 ilev, iel_crk, iadtg_crk,nft,
517 7 iexpan, eintth, itask, mat,
518 8 gbuf%VOL, actifxfem,igre,sensors,
519 9 nel, gbuf%G_WPLA,gbuf%WPLA)
523 CALL c3fint3(jft ,jlt ,forg ,momg ,thk0,
524 2 px1 ,py1 ,py2 ,f11 ,f12 ,
525 3 f13 ,f21 ,f22 ,f23 ,f31 ,
526 4 f32 ,f33 ,m11 ,m12 ,m13 ,
527 5 m21 ,m22 ,m23 ,nel )
531 2 py1 ,py2 ,f11 ,f12 ,f13 ,
532 3 f21 ,f22 ,f23 ,wxy ,forg ,
533 4 hourgg ,mlz ,bm0rz,b0rz ,bkrz ,
534 5 berz ,krz ,rlz ,dt1c ,eintg ,
541 IF (mat_elem%MAT_PARAM(imat)%HEAT_FLAG == 1)
THEN
542 CALL therm3c(nel ,pm(1,imat) ,thk0 ,ixtg,
543 . px1 ,py1 ,py2 ,
area ,dtime ,
544 . temp ,tempel,fheat ,them ,glob_therm%THEACCFACT)
546 CALL therm3c(nel ,pm(1,imat) ,thk0 ,ixtg,
547 . px1 ,py1 ,py2 ,
area ,dtime ,
548 . temp ,tempel,die ,them ,glob_therm%THEACCFACT)
558 . f11,f12,f13,f21,f22,f23,
560 . e1x ,e1y ,e1z ,e2x ,e2y ,
561 . e2z ,e3x ,e3y ,e3z )
563 CALL c3mcum3(jft,jlt,m,m11,m12,
564 . m13,m21,m22,m23,m31,m32,m33,
565 . e1x ,e1y ,e1z ,e2x ,e2y ,
566 . e2z ,e3x ,e3y ,e3z )
568 CALL c3mzcum3(jft ,jlt ,mlz ,e3x ,e3y,
569 . e3z ,m11 ,m12 ,m13 ,m21,
570 . m22 ,m23 ,m31 ,m32 ,m33)
576 . jft ,jlt ,nft ,ixtg ,off ,iadtg ,
577 . f11 ,f21 ,f31 ,f12 ,f22 ,f32 ,
579 . m11 ,m21 ,m31 ,m12 ,m22 ,m32 ,
581 . sti ,stir ,fsky ,elcutc,iadtg_crk,iel_crk
582 . ilev ,ixlay ,offg ,crksky)
584 IF (icsen > 0)
CALL csens3(jft ,jlt ,pid ,igeo ,epsdg)
588 IF (
ALLOCATED(dira))
DEALLOCATE(dira)
589 IF (
ALLOCATED(dirb))
DEALLOCATE(dirb)
590 IF (
ALLOCATED(elcrkini))
DEALLOCATE(elcrkini)
591 IF (
ALLOCATED(dir1_crk))
DEALLOCATE(dir1_crk)
592 IF (
ALLOCATED(dir2_crk))
DEALLOCATE(dir2_crk)
593 IF (
ALLOCATED(varnl))
DEALLOCATE(varnl)
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)