65 1 IXTG ,PM ,X ,GEO ,IGRSH4N ,
66 2 XMAS ,IN ,NVC ,DTELEM ,IGRSH3N ,
67 3 XREFTG ,OFFSET ,NEL ,ITHK ,THK ,
68 4 ISIGSH ,SIGSH ,STIFN ,STIFR ,PARTSAV ,
69 5 V ,IPART ,MSTG ,INTG ,PTG ,
70 8 SKEW ,IPARG ,NSIGSH ,IGEO ,IUSER ,
71 9 ETNOD ,NSHNOD ,STTG ,PTSH3N ,IPM ,
72 A BUFMAT ,SH3TREE,MCP ,MCPTG ,TEMP ,
73 B CPT_ELTENS,PART_AREA,ITAGE,ITAGN,IXFEM ,
74 C NPF , TF ,SH3TRIM ,XFEM_STR,ISUBSTACK,
75 D STACK ,RNOISE ,DRAPE ,SH3ANG ,IDDLEVEL,
76 E GEO_STACK,IGEO_STACK,STRTG,PERTURB ,ISH3N,
77 F IYLDINI ,ELE_AREA,NLOC_DMG,NG,GROUP_PARAM,
78 G IDRAPE , DRAPEG,MAT_PARAM,FAIL_FRACTAL,FAIL_BROKMANN,GLOB_THERM)
90 USE random_walk_def_mod
91 USE fractal_dmg_init_mod
93 use brokmann_random_def_mod
99#include "implicit_f.inc"
103#include "mvsiz_p.inc"
107#include "com01_c.inc"
108#include "com04_c.inc"
109#include "com_xfem1.inc"
110#include "param_c.inc"
111#include "scr03_c.inc"
112#include "scr17_c.inc"
113#include "vect01_c.inc"
118 INTEGER NDDIM,OFFSET,NEL,ITHK,ISIGSH,NSIGSH,IUSER,
119 . CPT_ELTENS,ISUBSTACK,IYLDINI,ISH3N,NG,IDRAPE
120 INTEGER IXTG(NIXTG,*),IPART(*),IGEO(NPROPGI,*),IPM(,*),
121 . IPARG(*),NSHNOD(*), (*),NPF(*),
122 . SH3TREE(*),(*),ITAGN(*),IXFEM,IAD0,SH3TRIM(*),
123 . IGEO_STACK(*),PERTURB(NPERTURB)
124 INTEGER ,
INTENT(IN) :: IDDLEVEL
127 . PM(*),X(3,*),GEO(NPROPG,*),XMAS(*),XREFTG(3,3,*),
128 . IN(*),(*),THK(*),SIGSH(NSIGSH,*),
129 . STIFN(*),STIFR(*),PARTSAV(20,*), V(*), SKEW(LSKEW,*),
130 . MSTG(*),INTG(*),PTG(3,*),
131 . ETNOD(*), STTG(*),BUFMAT(*),MCP(*),MCPTG(*),TEMP(*),
132 . part_area(*),tf(*),rnoise(*),sh3ang(*),
133 . geo_stack(*),strtg(*),ele_area(*)
134 TYPE(elbuf_struct_),
TARGET :: ELBUF_STR
135 TYPE(ELBUF_STRUCT_),
TARGET ,
DIMENSION(NGROUP,*):: XFEM_STR
137 TYPE (STACK_PLY) :: STACK
138 TYPE (NLOCAL_STR_) :: NLOC_DMG
139 TYPE (GROUP_PARAM_) :: GROUP_PARAM
140 TYPE (DRAPE_) :: DRAPE(NUMELC_DRAPE + NUMELTG_DRAPE)
142 TYPE (MATPARAM_STRUCT_) ,
DIMENSION(NUMMAT) ,
INTENT(INOUT) :: MAT_PARAM
143 TYPE (FAIL_FRACTAL_) ,
INTENT(IN) :: FAIL_FRACTAL
144 TYPE (FAIL_BROKMANN_) ,
INTENT(IN) ::
145 TYPE (glob_therm_) ,
intent(in) :: glob_therm
147 TYPE (GROUP_) ,
DIMENSION(NGRSHEL) :: IGRSH4N
148 TYPE (GROUP_) ,
DIMENSION(NGRSH3N) :: IGRSH3N
152 INTEGER I,J,NDEPAR,IGTYP,NVC,NUVAR,NLAY,IR,IS,IL,IFAIL
154 . ifram_old,npt_all,mpt,laynpt_max,lay_max
155 INTEGER IORTHLOC(MVSIZ),MAT(MVSIZ),PID(MVSIZ),NGL(MVSIZ),JJ(6),
156 . ix1(mvsiz),ix2(mvsiz),ix3(mvsiz)
158 . vx(mvsiz),vy(mvsiz),vz(mvsiz),aldt(mvsiz),
area(mvsiz)
160 .
DIMENSION(MVSIZ) :: px1g,py1g,py2g,x2s,x3s,y3s,dt
161 my_real x1(mvsiz), x2(mvsiz), x3(mvsiz)
162 . y1(mvsiz), y2(mvsiz), y3(mvsiz),y4
163 . z1(mvsiz), z2(mvsiz), z3(mvsiz),z4(mvsiz),
164 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
165 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
166 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
167 . x31(mvsiz), y31(mvsiz), z31(mvsiz),
168 . x2l(mvsiz), x3l(mvsiz), y3l(mvsiz)
170 CHARACTER(LEN=NCHARTITLE)::
172 .
ALLOCATABLE,
DIMENSION(:) :: dir_a,dir_b,phi1,phi2,
173 . coor1,coor2,coor3,coor4
174 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: INDX
175 parameter(laynpt_max = 10)
176 parameter(lay_max = 100)
177 INTEGER,
DIMENSION(:),
ALLOCATABLE::MATLY
178 my_real,
DIMENSION(:,:),
ALLOCATABLE :: POSLY
181 .
DIMENSION(:) ,
POINTER :: UVAR,DIR1,DIR2
182 TYPE(G_BUFEL_) ,
POINTER :: GBUF
183 TYPE(l_bufel_) ,
POINTER :: LBUF
184 TYPE(buf_lay_) ,
POINTER :: BUFLY
187 CALL my_alloc(matly,mvsiz*lay_max)
188 CALL my_alloc(posly,mvsiz,lay_max*laynpt_max)
190 gbuf => elbuf_str%GBUF
191 bufly => elbuf_str%BUFLY(1)
194 iprop = ixtg(nixtg-1,1+nft)
195 igtyp = nint(geo(12,iprop))
197 igmat = igeo(98,iprop)
201 IF (ish3n==3.AND.ish3nfram==0)
THEN
207 CALL fretitl2(titr,igeo(npropgi-ltitr+1,iprop),ltitr)
217 nlay = elbuf_str%NLAY
218 nxel = elbuf_str%NXEL
219 nptt = elbuf_str%NPTT
223 npt_all = npt_all + elbuf_str%BUFLY(il)%NPTT
226 IF(npt_all == 0) npt_all = nlay
227 IF (iparg(6) == 0.OR.npt==0) mpt=0
228 IF((igtyp == 51 .OR. igtyp == 52) .AND. idrape > 0)
THEN
229 ALLOCATE(dir_a(npt_all*nel*2))
230 ALLOCATE(dir_b(npt_all*nel*2))
233 ALLOCATE(phi1(mvsiz*npt_all))
234 ALLOCATE(phi2(nvsiz*npt_all))
237 ALLOCATE(coor1(npt_all*mvsiz
238 ALLOCATE(coor2(npt_all*mvsiz))
239 ALLOCATE(coor3(npt_all*mvsiz))
240 ALLOCATE(coor4(npt_all*mvsiz))
246 ALLOCATE(dir_a(nlay*nel*2))
247 ALLOCATE(dir_b(nlay*nel*2))
250 ALLOCATE(phi1(nlay*mvsiz))
251 ALLOCATE(phi2(nlay*mvsiz))
254 ALLOCATE(coor1(nlay*mvsiz))
255 ALLOCATE(coor2(nlay*mvsiz))
256 ALLOCATE(coor3(nlay*mvsiz))
257 ALLOCATE(coor4(nlay*mvsiz))
278 itagn(ixtg(3,i+nft)) =1
279 itagn(ixtg(4,i+nft)) =1
284 CALL c3coori(x,xreftg(1,1,nft+1),ixtg(1,nft+1),ngl,
285 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
286 . z1 ,z2 ,z3 ,ix1 ,ix2 ,ix3 )
287 CALL c3veok3(nvc ,ix1 ,ix2 ,ix3 )
289 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
290 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
291 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
292 . x31, y31, z31 ,x2l ,x3l ,y3l )
296 IF ((imasadd > 0).OR.(nloc_dmg%IMOD > 0))
THEN
300 ele_area(numelc+i+nft) =
area(i)
301 IF (gbuf%G_AREA > 0) gbuf%AREA(i) =
area(i)
307 IF (jthe == 0 .and. glob_therm%NINTEMP > 0)
THEN
308 CALL initemp_shell(elbuf_str,temp,nel,numnod,numeltg,3,nixtg,ixtg)
312 ALLOCATE(indx(numeltg))
314 indx(1:numeltg) = drapeg%INDX(numelc + 1 : numelc + numeltg)
318 CALL c3inmas(x,xreftg(1,1,nft+1),ixtg,geo,pm,xmas,in,thk,
319 . partsav,v,ipart(nft+1),mstg(nft+1),intg(nft+1),
320 . ptg(1,nft+1),igeo ,imat ,iprop ,
area ,
321 . etnod,nshnod,sttg(nft+1) ,sh3tree ,mcp ,
322 . mcptg(nft+1),temp ,sh3trim,isubstack,nlay ,
323 . elbuf_str ,stack ,gbuf%THK_I,rnoise,drape,
324 . perturb,ix1 ,ix2 ,ix3 ,glob_therm%NINTEMP,
325 . x2l ,x3l ,y3l ,idrape,indx)
327 CALL c3derii(lft,llt,pm,geo,px1g,py1g,py2g,
328 . stifn ,stifr ,ixtg(1,nft+1),
329 . thk,sh3tree,aldt ,bufmat , ipm ,igeo,
330 . stack%PM,isubstack,strtg(nft+1),imat,iprop,
331 .
area ,dt ,x31 ,y31 ,z31 ,
333 . e1z ,e2z ,e3z ,x2l ,x3l ,y3l ,
336 CALL c1buf3(geo,gbuf%THK,gbuf%OFF,thk,ksh3tree,sh3tree)
341 xfem_str(ng,ixel)%GBUF%THK(i
342 xfem_str(ng,ixel)%GBUF%OFF(i) = -one
349 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
350 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
351 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
356 . lft ,llt ,nft ,nlay ,numeltg ,
357 . nsigsh ,nixtg ,ixtg(1,nft+1),igeo ,geo ,
358 . skew ,sigsh ,ptsh3n
359 . vx ,vy ,vz ,coor1 ,coor2 ,
360 . coor3 ,coor4 ,iorthloc ,isubstack ,stack ,
361 . irep ,elbuf_str ,drape ,sh3ang(nft+1),x ,
362 . geo_stack ,e3x ,e3y ,e3z ,
363 . gbuf%BETAORTH,x1 ,x2 ,y1 ,y2 ,
364 . z1 ,z2 ,nel ,gbuf%G_ADD_NODE,gbuf%ADD_NODE,
365 . npt_all ,idrape ,indx)
367 IF(igtyp == 51 .OR. igtyp == 52 .OR. igmat > 0)
THEN
370 . igeo ,geo ,vx ,vy ,vz ,
371 . phi1 ,phi2 ,coor1 ,coor2 ,coor3 ,
372 . coor4 ,iorthloc ,nlay ,irep ,isubstack,
373 . stack ,geo_stack ,igeo_stack ,ir ,is ,
375 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
376 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
377 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
380 ELSEIF (mtn == 27)
THEN
382 . geo ,igeo ,pm ,ipm ,ixtg(1,1+nft) ,nixtg,
383 . nlay,ir ,is ,imat )
384 ELSEIF (mtn == 35)
THEN
385 nptr = elbuf_str%NPTR
386 npts = elbuf_str%NPTS
387 nptt = elbuf_str%NPTT
389 . nptr,npts,nptt,igtyp)
390 ELSEIF (mtn == 15 .or. mtn == 19 .or. mtn == 25 .or. mtn >= 28)
THEN
391 IF (mtn == 19 .AND. igtyp /= 9)
THEN
395 . i1=igeo(1,ixtg(nixtg-1,nft+1)))
399 . igeo ,geo ,vx ,vy ,vz ,
400 . phi1 ,phi2 ,coor1 ,coor2 ,coor3
401 . coor4 ,iorthloc ,nlay ,irep ,isubstack,
402 . stack ,geo_stack ,igeo_stack ,ir ,is ,
404 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
405 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
406 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
410 IF ((mtn == 58 .or. mtn == 158) .AND.
411 . igtyp /= 16 .AND. igtyp /= 51 .AND. igtyp /= 52)
THEN
414 . anmode=aninfo_blind_1,
419 ELSEIF (mtn == 58 .or. mtn == 158 .OR. igtyp
THEN
420 IF (idrape == 0 )
THEN
422 nptt = elbuf_str%BUFLY(il)%NPTT
423 imat = elbuf_str%BUFLY(il)%IMAT
424 ilaw = elbuf_str%BUFLY(il)%ILAW
425 nuvar = elbuf_str%BUFLY(il)%NVAR_MAT
426 dir1 => elbuf_str%BUFLY(il)%DIRA
427 dir2 => elbuf_str%BUFLY(il)%DIRB
428 nuparam = mat_param(imat)%NUPARAM
432 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
433 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
435 . irep ,dir1 ,dir2 ,mat_param(imat)%UPARAM,
436 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
437 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
438 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
439 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z, e3z )
441 ELSE IF (ilaw == 158)
THEN
443 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
444 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
446 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
447 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
448 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
449 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z, e3z )
456 nptt = elbuf_str%BUFLY(il)%NPTT
457 imat = elbuf_str%BUFLY(il)%IMAT
458 ilaw = elbuf_str%BUFLY(il)%ILAW
459 nuvar = elbuf_str%BUFLY(il)%NVAR_MAT
460 nuparam = mat_param(imat)%NUPARAM
464 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
465 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
466 dir1 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRA
467 dir2 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRB
469 . irep ,dir1 ,dir2 ,mat_param(imat)%UPARAM,
470 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
471 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
472 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
473 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z
475 ELSE IF (ilaw == 158)
THEN
477 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
478 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
479 dir1 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRA
480 dir2 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRB
482 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
483 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
484 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
485 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z, e3z )
495 IF (isigsh /= 0 .OR. ithkshel == 2)
THEN
499 . elbuf_str ,lft ,llt ,geo ,igeo ,
500 . mat ,pid ,matly ,posly ,igtyp ,
501 . nlay ,mpt ,isubstack ,stack ,drape ,
502 . nft ,gbuf%THK ,nel ,idrape ,
stdrape ,
504 CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
506 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
507 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
508 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
512 1 lft ,llt ,nft ,mpt ,istrain ,
513 2 gbuf%THK,gbuf%EINT,gbuf%STRA,gbuf%HOURG,gbuf%PLA ,
514 3 gbuf%FOR,gbuf%MOM ,sigsh ,nlay ,gbuf%G_HOURG,
515 4 numeltg ,ixtg ,nixtg ,nsigsh ,numsh3n ,
516 5 ptsh3n ,igeo ,thk ,nel ,e1x ,
517 6 e2x ,e3x ,e1y ,e2y ,e3y ,
518 7 e1z ,e2z ,e3z ,isigsh ,dir_a ,
519 8 dir_b ,posly ,igtyp )
520 ELSEIF ( ithkshel == 1 )
THEN
521 CALL thickini(lft ,llt ,nft ,ptsh3n,numeltg,
522 2 gbuf%THK,thk ,ixtg ,nixtg ,nsigsh ,
529 IF (fail_fractal%NFAIL > 0)
THEN
530 CALL fractal_dmg_init(elbuf_str,mat_param,fail_fractal,
531 . nummat ,numeltg ,nel ,nft ,ngl ,ity )
534 IF (ifail > 0 .and. iddlevel == 1)
THEN
536 . nel ,nft ,ity ,igrsh4n ,igrsh3n ,
543 . nptt ,nlay ,sigsh ,nsigsh ,ptsh3n ,
544 . rnoise ,perturb ,aldt ,thk )
549 IF (istrain == 1 .AND. nxref > 0)
THEN
550 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR
551 imat = elbuf_str%BUFLY(1)%IMAT
553 CALL c3epsini(elbuf_str,mat_param(imat),
554 . lft ,llt ,ismstr ,mtn ,ithk ,
555 . pm ,geo ,ixtg(1,nft+1),x ,xreftg(1,1,nft+1),
556 . gbuf%FOR,gbuf%THK ,gbuf%EINT ,gbuf%STRA,nlay ,
557 . px1g ,py1g ,py2g ,x2s ,x3s ,
559 . nel ,dir_a ,dir_b ,gbuf%SIGI,npf
560 . tf ,irep ,ifram_old ,imat )
562 CALL c3epschk(lft, llt,nft, pm, geo,ixtg(1,nft+1), gbuf%STRA,thk,
565 IF (ismstr == 1 .AND. mtn==19) iparg(9) = 11
567 ELSEIF (ismstr == 11 .OR. (ismstr==1 .AND. mtn==19))
THEN
570 . lft ,llt ,ixtg(1,nft+1),x ,x2s ,
574 IF (ismstr == 10)
THEN
577 elbuf_str%GBUF%SMSTR(jj(1)+i) = x(1,ixtg(3,ii))-x(1,ixtg(2,ii))
578 elbuf_str%GBUF%SMSTR(jj(2)+i) = x(2,ixtg(3,ii))-x(2,ixtg(2,ii))
579 elbuf_str%GBUF%SMSTR(jj(3)+i) = x(3,ixtg(3,ii))-x(3,ixtg(2,ii))
580 elbuf_str%GBUF%SMSTR(jj(4)+i) = x(1,ixtg(4,ii))-x(1,ixtg(2,ii))
581 elbuf_str%GBUF%SMSTR(jj(5)+i) = x(2,ixtg(4,ii))-x(2,ixtg(2,ii))
582 elbuf_str%GBUF%SMSTR(jj(6)+i) = x(3,ixtg(4,ii))-x(3,ixtg(2,ii))
584 ELSEIF (ismstr == 11 .OR.(ismstr==1 .AND. mtn==19))
THEN
586 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
587 elbuf_str%GBUF%SMSTR(jj(2)+i) = x3s(i)
588 elbuf_str%GBUF%SMSTR(jj(3)+i) = y3s(i)
592 IF (iuser == 1 .and. mtn > 28)
THEN
595 1 lft ,llt ,nft ,nel ,npt ,
596 2 istrain,sigsh ,numeltg ,ixtg ,nixtg ,
597 3 nsigsh ,numsh3n,ptsh3n ,ir ,is ,
601 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn
THEN
603 1 lft ,llt ,nft ,nel ,npt ,
604 2 istrain,sigsh ,numeltg
605 3 nsigsh ,numsh3n,ptsh3n ,ir ,is ,
612 IF (igtyp /= 0 .AND. igtyp /= 1 .AND.
613 . igtyp /= 9 .AND. igtyp /= 1
614 . igtyp /= 11 .AND. igtyp /= 16 .AND.
615 . igtyp /= 17 .AND. igtyp /= 51 .AND.
624 ndepar=numels+numelc+numelt+numelp+numelr+nft
626 dtelem(ndepar+i) = dt(i)
630 CALL cbufxfe(elbuf_str,xfem_str,isubstack,stack ,
631 . igeo ,geo ,lft ,llt ,mat,
632 . pid ,npt ,nptt ,nlay,ir ,
638 IF (gbuf%G_VOL > 0) gbuf%VOL(i) =
area(i)*gbuf%THK(i)
643 IF (xfem_str(ng,ixel)%GBUF%G_VOL > 0)
644 . xfem_str(ng,ixel)%GBUF%VOL(i) =
area(i)*gbuf%THK(i)
649 IF (
ALLOCATED(dir_b))
DEALLOCATE(dir_b)
650 IF (
ALLOCATED(dir_a))
DEALLOCATE(dir_a)
651 IF (
ALLOCATED(indx))
DEALLOCATE(indx)