64 SUBROUTINE cinit3(ELBUF_STR,IXC ,PM ,X ,GEO ,
65 2 XMAS ,IN ,NVC ,DTELEM ,IGRSH4N ,
66 3 XREFC ,NEL ,ITHK ,IHBE ,IGRSH3N ,
67 4 THK ,ISIGSH ,SIGSH ,STIFN ,STIFR ,
68 5 PARTSAV ,V ,IPART ,MSC ,INC ,
69 8 SKEW ,IPARG ,I8MI ,NSIGSH ,IGEO ,
70 9 IUSER ,ETNOD ,NSHNOD ,STC ,PTSHEL ,
71 A IPM ,BUFMAT ,SH4TREE ,MCP ,MCPS ,
72 B TEMP ,CPT_ELTENS,PART_AREA,ITAGN,ITAGE ,
73 C IXFEM ,NPF ,TF ,XFEM_STR,ISUBSTACK,
74 D STACK ,RNOISE ,DRAPE ,SH4ANG ,IDDLEVEL,
75 E GEO_STACK,IGEO_STACK,STRC ,PERTURB ,IYLDINI ,
76 F ELE_AREA ,NG ,GROUP_PARAM ,NLOC_DMG,
77 G IDRAPE ,DRAPEG ,MAT_PARAM,FAIL_FRACTAL,FAIL_BROKMANN,
91 USE random_walk_def_mod
92 USE fractal_dmg_init_mod
94 use brokmann_random_def_mod
100#include "implicit_f.inc"
104#include "mvsiz_p.inc"
108#include "vect01_c.inc"
109#include "param_c.inc"
110#include "com01_c.inc"
111#include "com04_c.inc"
112#include "scr03_c.inc"
113#include "scr17_c.inc"
115#include "com_xfem1.inc"
119 INTEGER NVC,NEL,ITHK,IHBE,ISIGSH,IXFEM,NSIGSH,IUSER,IYLDINI
120 INTEGER IXC(NIXC,*),IPART(*),IPARG(*),IGEO(NPROPGI,*), NSHNOD(*),
121 . PTSHEL(*),IPM(NPROPMI,*), SH4TREE(*),ITAGN(*),ITAGE(*),NPF(*),
122 . ISUBSTACK,IGEO_STACK(*),PERTURB(NPERTURB),NG,IDRAPE
124 INTEGER ,
INTENT(IN) :: IDDLEVEL
126 . PM(NPROPM,*), X(3,*), GEO(NPROPG,*), XMAS(*), IN(*),
127 . DTELEM(*), XREFC(4,3,*),THK(*), (NSIGSH,*),
128 . STIFN(*),STIFR(*),PARTSAV(20,*), V(*) ,MSC(*) ,INC(*),
129 . SKEW(LSKEW,*), ETNOD(*), STC(*),BUFMAT(*),MCP(*),MCPS(*),
130 . TEMP(*),PART_AREA(*),TF(*),RNOISE(*),
131 . SH4ANG(*),GEO_STACK(*),STRC(*),ELE_AREA(*)
132 TYPE(ELBUF_STRUCT_),
TARGET :: ELBUF_STR
133 TYPE(elbuf_struct_),
TARGET ,
DIMENSION(NGROUP,*):: XFEM_STR
136 TYPE (GROUP_PARAM_) :: GROUP_PARAM
137 TYPE (NLOCAL_STR_) :: NLOC_DMG
138 TYPE (DRAPE_) :: DRAPE(NUMELC_DRAPE + NUMELTG_DRAPE)
139 TYPE (DRAPEG_) :: DRAPEG
140 TYPE (MATPARAM_STRUCT_) ,
DIMENSION(NUMMAT) ,
INTENT(INOUT) :: MAT_PARAM
141 TYPE (FAIL_FRACTAL_) ,
INTENT(IN) :: FAIL_FRACTAL
142 TYPE (FAIL_BROKMANN_) ,
INTENT(IN) :: FAIL_BROKMANN
143 TYPE (glob_therm_) ,
intent(in) :: glob_therm
145 TYPE (GROUP_) ,
DIMENSION(NGRSHEL) :: IGRSH4N
146 TYPE (GROUP_) ,
DIMENSION(NGRSH3N) :: IGRSH3N
150 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
151 INTEGER I,J,N,IP,NDEPAR,IGTYP,NUVAR,ID,NLAY,II,IREP,IPROP,NUPARAM,
152 . il,ir,is,it,cpt_eltens,iun,nptr,npts,nptt,ixel,ilaw,imat,ifail,
153 . igmat,jj(9),npt_all,mpt,laynpt_max,lay_max
154 INTEGER,
DIMENSION(MVSIZ) :: IX1
156 my_real,
DIMENSION(MVSIZ) :: px1g,px2g,py1g,py2g,
area,aldt,
158 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,
159 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,
160 . x2s,y2s,x3s,y3s,x4s,y4s,
161 . x2l,x3l,x4l,y2l,y3l,y4l
162 my_real,
DIMENSION(NEL) :: tempel
163 my_real,
DIMENSION(:) ,
POINTER :: uvar,dir1,dir2
164 my_real,
ALLOCATABLE,
DIMENSION(:) :: dir_a,dir_b
165 my_real,
DIMENSION(:),
ALLOCATABLE :: phi1,phi2,coor1,coor2,coor3,coor4
166 parameter(laynpt_max = 10)
167 parameter(lay_max = 100)
168 INTEGER,
DIMENSION(:),
ALLOCATABLE :: MATLY
169 my_real,
DIMENSION(:,:),
ALLOCATABLE :: posly
171 TYPE(g_bufel_) ,
POINTER :: GBUF
172 TYPE(L_BUFEL_) ,
POINTER :: LBUF
174 MY_ALLOC(MATLY,MVSIZ*LAY_MAX)
175 CALL MY_ALLOC(POSLY,MVSIZ,LAY_MAX*LAYNPT_MAX)
176 gbuf => elbuf_str%GBUF
179 iprop = ixc(nixc-1,1+nft)
180 igtyp = igeo(11,iprop)
182 igmat = igeo(98,ixc(6,1+nft))
186 CALL fretitl2(titr,igeo(npropgi-ltitr+1,iprop),ltitr)
196 nlay = elbuf_str%NLAY
197 nxel = elbuf_str%NXEL
198 nptt = elbuf_str%NPTT
199 idrape = elbuf_str%IDRAPE
202 npt_all = npt_all + elbuf_str%BUFLY(il)%NPTT
205 IF(npt_all == 0 ) npt_all = nlay
207 IF((igtyp == 51 .OR. igtyp == 52) .AND. idrape > 0)
THEN
208 ALLOCATE(phi1(mvsiz*npt_all))
209 ALLOCATE(phi2(nvsiz*npt_all))
210 ALLOCATE(dir_a(npt_all*nel*2))
211 ALLOCATE(dir_b(npt_all*nel*2))
216 ALLOCATE(coor1(npt_all*mvsiz))
217 ALLOCATE(coor2(npt_all*mvsiz))
218 ALLOCATE(coor3(npt_all*mvsiz))
219 ALLOCATE(coor4(npt_all*mvsiz))
225 ALLOCATE(phi1(nlay*mvsiz))
226 ALLOCATE(phi2(nlay*mvsiz))
227 ALLOCATE(dir_a(nlay*nel*2))
228 ALLOCATE(dir_b(nlay*nel*2))
233 ALLOCATE(coor1(nlay*mvsiz))
234 ALLOCATE(coor2(nlay*mvsiz))
235 ALLOCATE(coor3(nlay*mvsiz))
236 ALLOCATE(coor4(nlay*mvsiz))
244 IF (iparg(6) == 0.OR.npt==0) mpt=0
268 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
269 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
270 . ix1 ,ix2 ,ix3 ,ix4 ,ngl )
272 CALL cveok3(nvc,4,ix1,ix2,ix3,ix4)
275 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
276 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
277 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
282 IF ((imasadd > 0).OR.(nloc_dmg%IMOD > 0))
THEN
286 ele_area(i+nft) =
area(i)
287 IF (gbuf%G_AREA > 0) gbuf%AREA(i) =
area(i)
291! initialize element temperature from /initemp
293 IF (jthe == 0 .and. glob_therm%NINTEMP > 0)
THEN
294 CALL initemp_shell(elbuf_str,temp,nel,numnod,numelc,4,nixc,ixc)
297 CALL cinmas(x ,xrefc(1,1,nft+1),ixc ,geo ,pm,
298 . xmas ,in ,thk ,ihbe ,partsav,
299 . v ,ipart(nft+1) ,msc(nft+1),inc(nft+1) ,
area ,
300 . i8mi ,igeo ,etnod ,imat ,iprop ,
301 . nshnod ,stc(nft+1) ,sh4tree ,mcp ,mcps(nft+1),
302 . temp ,bid ,bid ,bid ,bid,
303 . bid ,bid ,isubstack ,nlay ,elbuf_str
304 . stack ,gbuf%THK_I ,rnoise ,drape ,glob_therm%NINTEMP,
305 . perturb,ix1 ,ix2 ,ix3 ,ix4 ,
306 . idrape ,drapeg%INDX)
308 CALL cderii(px1g,px2g,py1g,py2g,
309 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
310 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
311 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
312 . x2l ,x3l ,x4l ,y2l ,y3l ,y4l )
313 CALL cdleni(pm ,geo ,stifn
314 . px1g ,px2g ,py1g ,py2g
315 . igeo ,dt ,sh4tree ,aldt ,bufmat ,
316 . ipm ,nlay ,stack%PM,isubstack,strc(nft+1),
317 .
area ,imat ,iprop ,
318 . x2l ,x3l ,x4l ,y2l ,y3l ,y4l ,
319 . stack%IGEO,group_param)
320 CALL c1buf3(geo,gbuf%THK,gbuf%OFF,thk,ksh4tree,sh4tree)
325 xfem_str(ng,ixel)%GBUF%THK(i) = thk(i)
326 xfem_str(ng,ixel)%GBUF%OFF(i) = -one
333 . lft ,llt ,nft ,nlay ,numelc ,
334 . nsigsh ,nixc ,ixc(1,nft+1),igeo ,geo ,
335 . skew ,sigsh ,ptshel ,phi1
336 . vx ,vy ,vz ,coor1 ,coor2 ,
337 . coor3 ,coor4 ,iorthloc ,isubstack ,stack ,
338 . irep ,elbuf_str ,drape ,sh4ang(nft+1),x ,
339 . geo_stack ,e3x ,e3y ,e3z ,
340 . gbuf%BETAORTH,x1 ,x2 ,y1 ,y2 ,
341 . z1 ,z2 ,nel ,gbuf%G_ADD_NODE,gbuf%ADD_NODE,
342 . npt_all ,idrape ,drapeg%INDX)
345 IF(igtyp == 51 .OR. igtyp == 52 .AND. igmat > 0)
THEN
348 . igeo ,geo ,vx ,vy ,vz ,
349 . phi1 ,phi2 ,coor1 ,coor2 ,coor3 ,
350 . coor4 ,iorthloc ,nlay ,irep ,isubstack,
351 . stack ,geo_stack ,igeo_stack ,ir ,is ,
353 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
354 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
355 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z
358 ELSEIF (mtn == 27)
THEN
360 . geo ,igeo ,pm ,ipm ,ixc(1,1+nft) ,nixc,
361 . nlay,ir ,is ,imat )
362 ELSEIF (mtn == 35)
THEN
363 nptr = elbuf_str%NPTR
364 npts = elbuf_str%NPTS
365 nptt = elbuf_str%NPTT
367 . nptr,npts,nptt,igtyp)
368 ELSEIF (mtn==15 .or. mtn==19 .or. mtn==25 .or. mtn>=28)
THEN
369 IF (mtn == 19 .AND. igtyp /= 9)
THEN
373 . i1=igeo(1,ixc(nixc-1,nft+1)))
378 . phi1 ,phi2 ,coor1 ,coor2 ,coor3 ,
379 . coor4 ,iorthloc ,nlay ,irep ,isubstack,
380 . stack ,geo_stack ,igeo_stack ,ir ,is ,
382 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
383 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
384 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z, e3z ,
388 IF ((mtn == 58 .or. mtn == 158) .AND.
389 . igtyp /= 16 .AND. igtyp /= 51 .AND. igtyp /= 52)
THEN
392 . anmode=aninfo_blind_1,
397 ELSEIF (mtn == 58 .or. mtn == 158 .OR. igtyp == 51 .OR. igtyp == 52)
THEN
399 IF (idrape == 0)
THEN
401 nptt = elbuf_str%BUFLY(il)%NPTT
402 imat = elbuf_str%BUFLY(il)%IMAT
403 ilaw = elbuf_str%BUFLY(il)%ILAW
404 nuvar = elbuf_str%BUFLY(il)%NVAR_MAT
405 dir1 => elbuf_str%BUFLY(il)%DIRA
406 dir2 => elbuf_str%BUFLY(il)%DIRB
407 nuparam = mat_param(imat)%NUPARAM
411 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
412 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
414 . irep ,dir1 ,dir2 ,mat_param(imat)%UPARAM,
415 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
416 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
417 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
418 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
420 ELSE IF (ilaw == 158)
THEN
422 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
423 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
425 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
426 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
427 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
428 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
434 nptt = elbuf_str%BUFLY(il)%NPTT
435 imat = elbuf_str%BUFLY(il)%IMAT
436 ilaw = elbuf_str%BUFLY(il)%ILAW
437 nuvar = elbuf_str%BUFLY(il)%NVAR_MAT
438 nuparam = mat_param(imat)%NUPARAM
442 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
443 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
444 dir1 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRA
445 dir2 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRB
447 . irep ,dir1 ,dir2 ,mat_param(imat)%UPARAM,
448 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
449 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
450 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
451 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
453 ELSE IF (ilaw == 158)
THEN
455 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
456 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
457 dir1 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRA
458 dir2 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRB
460 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
461 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
462 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
463 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
472 IF (isigsh/=0 .OR. ithkshel == 2)
THEN
476 . elbuf_str ,lft ,llt ,geo ,igeo ,
477 . mat ,pid ,matly ,posly ,igtyp ,
478 . nlay ,mpt ,isubstack ,stack ,drape ,
479 . nft ,gbuf%THK ,nel ,idrape ,
scdrape ,
481 CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
483 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
484 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
490 1 lft ,llt ,nft ,mpt ,istrain ,
491 2 gbuf%THK,gbuf%EINT,gbuf%STRA,gbuf%HOURG,gbuf%PLA ,
492 3 gbuf%FOR,gbuf%MOM ,sigsh ,nlay ,gbuf%G_HOURG,
493 4 numelc ,ixc ,nixc ,nsigsh ,numshel ,
494 5 ptshel ,igeo ,thk ,nel ,e1x ,
495 6 e2x ,e3x ,e1y ,e2y ,e3y ,
496 7 e1z ,e2z ,e3z ,isigsh ,dir_a ,
497 8 dir_b ,posly ,igtyp )
498 ELSEIF ( ithkshel == 1 )
THEN
499 CALL thickini(lft ,llt ,nft ,ptshel,numelc,
500 2 gbuf%THK,thk ,ixc ,nixc ,nsigsh,
506 IF (istrain == 1 .AND. nxref
THEN
507 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR
508 imat = elbuf_str%BUFLY(1)%IMAT
509 CALL cepsini(elbuf_str ,mat_param(imat),
511 . pm ,geo ,ixc(1,nft+1),x ,xrefc(1,1,nft+1),
512 . gbuf%FOR ,gbuf%THK ,gbuf%EINT ,gbuf%STRA ,nlay ,
513 . px1g ,px2g ,py1g ,py2g ,x2s ,
514 . y2s ,x3s ,y3s ,x4s ,y4s ,
519 CALL cepschk(lft, llt,nft, pm, geo,ixc(1,nft+1),gbuf%STRA,thk,
521 IF (ismstr == 1 .AND. mtn==19) iparg(9)=11
523 ELSEIF (ismstr == 11 .OR.(ismstr==1 .AND. mtn==19))
THEN
526 . x2s ,y2s ,x3s ,y3s ,x4s ,y4s )
529 IF (ismstr == 10 )
THEN
532 elbuf_str%GBUF%SMSTR(jj(1)+i) = x(1,ixc(3,ii))-x(1,ixc(2,ii))
533 elbuf_str%GBUF%SMSTR(jj(2)+i) = x(2,ixc(3,ii))-x(2,ixc(2,ii))
534 elbuf_str%GBUF%SMSTR(jj(3)+i) = x(3,ixc(3,ii))-x(3,ixc(2,ii))
535 elbuf_str%GBUF%SMSTR(jj(4)+i) = x(1,ixc(4,ii))-x(1,ixc(2,ii))
536 elbuf_str%GBUF%SMSTR(jj(5)+i) = x(2,ixc(4,ii))-x(2,ixc(2,ii))
537 elbuf_str%GBUF%SMSTR(jj(6)+i) = x(3,ixc(4,ii))-x(3,ixc(2,ii))
538 elbuf_str%GBUF%SMSTR(jj(7)+i) = x(1,ixc(5,ii))-x(1,ixc(2,ii))
539 elbuf_str%GBUF%SMSTR(jj(8)+i) = x(2,ixc(5,ii))-x(2,ixc(2,ii))
540 elbuf_str%GBUF%SMSTR(jj(9)+i) = x(3,ixc(5,ii))-x(3,ixc(2,ii))
542 ELSEIF (ismstr == 11 .OR.(ismstr==1 .AND. mtn==19))
THEN
544 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
545 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
546 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
547 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
548 elbuf_str%GBUF%SMSTR(jj(5)+i) = x4s(i)
549 elbuf_str%GBUF%SMSTR(jj(6)+i) = y4s(i)
553 IF (iuser == 1 .AND. mtn > 28)
THEN
556 1 lft ,llt ,nft ,nel ,npt ,
557 2 istrain,sigsh ,numelc ,ixc ,nixc ,
558 3 nsigsh ,numshel,ptshel ,iun ,iun ,
562 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87))
THEN
564 1 lft ,llt ,nft ,nel ,npt ,
565 2 istrain,sigsh ,numelc ,ixc ,nixc ,
566 3 nsigsh ,numshel,ptshel ,iun ,iun ,
574 IF (fail_fractal%NFAIL > 0)
THEN
575 CALL fractal_dmg_init(elbuf_str,mat_param,fail_fractal,
576 . nummat ,numelc ,nel ,nft ,ngl ,ity )
579 IF (ifail > 0 .and. iddlevel == 1)
THEN
581 . nel ,nft ,ity ,igrsh4n ,igrsh3n ,
586 . nptt ,nlay ,sigsh ,nsigsh ,ptshel ,
587 . rnoise ,perturb ,aldt ,thk )
592 IF (igtyp /= 0 .AND. igtyp /= 1 .AND.
593 . igtyp /= 9 .AND. igtyp /= 10 .AND.
594 . igtyp /= 11 .AND. igtyp /= 16 .AND.
595 . igtyp /= 17 .AND. igtyp /= 51 .AND.
606 dtelem(ndepar+i)=dt(i)
610 CALL cbufxfe(elbuf_str,xfem_str,isubstack,stack ,
611 . igeo ,geo ,lft ,llt ,mat,
612 . pid ,npt ,nptt ,nlay,ir ,
618 IF (gbuf%G_VOL > 0) gbuf%VOL(i) =
area(i)*gbuf%THK(i)
623 IF (xfem_str(ng,ixel)%GBUF%G_VOL > 0)
624 . xfem_str(ng,ixel)%GBUF%VOL(i) =
area(i)*gbuf%THK(i)
629 IF (
ALLOCATED(dir_b))
DEALLOCATE(dir_b)
630 IF (
ALLOCATED(dir_a))
DEALLOCATE(dir_a)
631 DEALLOCATE(phi1,phi2,coor1,coor2,coor3,coor4)