65 1 ELBUF_STR,IXC ,PM ,X ,GEO ,
66 2 XMAS ,IN ,NVC ,DTELEM ,IGRSH4N ,
67 3 XREFC ,NEL ,ITHK ,IHBE ,IGRSH3N ,
68 4 THKE ,ISIGSH ,SIGSH ,STIFN ,STIFR ,
69 5 PARTSAV ,V ,IPART ,MSC ,INC ,
70 6 SKEW ,I8MI ,NSIGSH ,IGEO ,IPM ,
71 7 IUSER ,ETNOD ,NSHNOD ,STC ,PTSHEL ,
72 8 BUFMAT ,SH4TREE ,MCP ,MCPS ,TEMP ,
73 9 MS_LAYER ,ZI_LAYER ,ITAG ,ITAGEL ,IPARG ,
74 A MS_LAYERC,ZI_LAYERC,PART_AREA,CPT_ELTENS,
75 B MSZ2C ,ZPLY ,ITAGN ,ITAGE ,IXFEM ,
76 C NPF ,TF ,XFEM_STR ,ISUBSTACK,STACK ,
77 D RNOISE ,DRAPE ,SH4ANG ,IDDLEVEL,GEO_STACK,
78 E IGEO_STACK,STRC ,PERTURB ,IYLDINI ,ELE_AREA,
79 F NLOC_DMG ,NG ,GROUP_PARAM, IDRAPE , DRAPEG,
80 G MAT_PARAM,FAIL_FRACTAL,FAIL_BROKMANN,GLOB_THERM)
92 USE random_walk_def_mod
93 USE fractal_dmg_init_mod
95 use brokmann_random_def_mod
98 use element_mod ,
only : nixc
102#include "implicit_f.inc"
106#include "mvsiz_p.inc"
110#include "param_c.inc"
111#include "com01_c.inc"
112#include "com04_c.inc"
113#include "com_xfem1.inc"
114#include "vect01_c.inc"
115#include "scr03_c.inc"
117#include "scr17_c.inc"
121 INTEGER NVC,NEL,ITHK,IHBE,ISIGSH,IXFEM,NSIGSH,IUSER,IYLDINI,
122 . ISUBSTACK,NG,IDRAPE
123 INTEGER IXC(NIXC,*),IPART(*),PTSHEL(*),ITAG(*),ITAGEL(*),
124 . IGEO(NPROPGI,*), IPM(NPROPMI,*), NSHNOD(*),NPF(*),
125 . SH4TREE(*),IPARG(*),CPT_ELTENS,ITAGN(*),ITAGE(*),
126 . IGEO_STACK(*),PERTURB(NPERTURB)
127 INTEGER ,
INTENT(IN) :: IDDLEVEL
130 . PM(NPROPM,*), X(3,*), GEO(NPROPG,*), XMAS(*), IN(*),
131 . DTELEM(*), XREFC(4,3,*),THKE(*), SIGSH(NSIGSH,*),
132 . STIFN(*),STIFR(*),PARTSAV(20,*), V(*) ,MSC(*) ,INC(*),
133 . SKEW(LSKEW,*), ETNOD(*), STC(*),BUFMAT(*),MCP(*),MCPS(*),
134 . TEMP(*),MS_LAYER(*),ZI_LAYER(*),MS_LAYERC(*),ZI_LAYERC(*),
135 . PART_AREA(*),MSZ2C(*),ZPLY(*),TF(*),RNOISE(*),
136 . SH4ANG(*),GEO_STACK(*),STRC(*),ELE_AREA(*)
137 TYPE (ELBUF_STRUCT_),
TARGET :: ELBUF_STR
138 TYPE (ELBUF_STRUCT_),
TARGET ,
DIMENSION(NGROUP,*):: XFEM_STR
140 TYPE (STACK_PLY) :: STACK
141 TYPE (NLOCAL_STR_) :: NLOC_DMG
142 TYPE (GROUP_PARAM_) :: GROUP_PARAM
143 TYPE (DRAPE_) :: DRAPE(NUMELC_DRAPE + NUMELTG_DRAPE)
144 TYPE (DRAPEG_) :: DRAPEG
145 TYPE (MATPARAM_STRUCT_) ,
DIMENSION(NUMMAT) ,
INTENT(INOUT) :: MAT_PARAM
146 TYPE (FAIL_FRACTAL_) ,
INTENT(IN) :: FAIL_FRACTAL
147 TYPE (FAIL_BROKMANN_) ,
INTENT(IN) :: FAIL_BROKMANN
148 TYPE(glob_therm_) ,
intent(in) :: glob_therm
150 TYPE (GROUP_) ,
DIMENSION(NGRSHEL) :: IGRSH4N
151 TYPE (GROUP_) ,
DIMENSION(NGRSH3N) :: IGRSH3N
155 INTEGER I,J,K,N,II,IUN,NDEPAR,IGTYP,IGMAT,NUVAR,IMAT,IPROP,PROPID,
156 . ipg,npg,ptf,ptm,pts,ixel,irep,nlay,nptr,npts,nptt,ifail,
157 . il,ir,is,it,lenf,lenm,lens,
158 . lenfp,lenmp,lenepinchxz,lenepinchyz,lenepinchzz,
159 . ipang,ipthk,ippos, ilay,i4,mpt,laynpt_max,lay_max,npt_all
161 INTEGER ,
DIMENSION(MVSIZ) :: IX1,IX2,IX3,IX4,IORTHLOC,MAT,PID,
163 my_real ,
DIMENSION(MVSIZ) ::
area,aldt,
dtel,px1g,px2g,py1g,py2g,
164 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,
165 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,
166 . x2s,y2s,x3s,y3s,x4s,y4s,
167 . x2l,x3l,x4l,y2l,y3l,y4l
168 CHARACTER(LEN=NCHARTITLE)::TITR
170 my_real,
ALLOCATABLE,
DIMENSION(:) :: DIR_A,DIR_B
171 my_real ,
DIMENSION(:) ,
POINTER :: uvar
172 parameter(laynpt_max = 10)
173 parameter(lay_max = 100)
174 INTEGER,
DIMENSION(:),
ALLOCATABLE::MATLY
175 my_real,
DIMENSION(:,:),
ALLOCATABLE :: POSLY
177 TYPE() ,
POINTER :: BUFLY
178 TYPE(L_BUFEL_) ,
POINTER :: LBUF
179 TYPE(g_bufel_) ,
POINTER :: GBUF
182 CALL MY_ALLOC(MATLY,MVSIZ*LAY_MAX)
183 CALL MY_ALLOC(POSLY,MVSIZ,LAY_MAX*LAYNPT_MAX)
185 gbuf => elbuf_str%GBUF
188 iprop = ixc(nixc-1,1+nft)
189 propid= igeo(1 ,iprop)
190 igtyp = igeo(11,iprop)
191 igmat = igeo(98,iprop)
201 CALL fretitl2(titr,igeo(npropgi-ltitr+1,iprop),ltitr)
204 nlay = elbuf_str%NLAY
205 nptr = elbuf_str%NPTR
206 npts = elbuf_str%NPTS
207 nptt = elbuf_str%NPTT
208 nxel = elbuf_str%NXEL
211 lenm = nel*gbuf%G_MOMPG/npg
213 lenfp = nel*gbuf%G_FORPGPINCH/npg
214 lenmp = nel*gbuf%G_MOMPGPINCH/npg
215 lenepinchxz = nel*gbuf%G_EPGPINCHXZ/npg
216 lenepinchyz = nel*gbuf%G_EPGPINCHYZ/npg
217 lenepinchzz = nel*gbuf%G_EPGPINCHZZ/npg
219 lens = nel*gbuf%G_STRPG/npg
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))
234 ALLOCATE(dir_a(nlay*nel*2))
235 ALLOCATE(dir_b(nlay*nel*2))
244 npt_all =
max(nlay, npt_all)
247 IF (ishxfem_ply > 0)
THEN
269 CALL ccoori(x,xrefc(1,1,nft+1),ixc(1,nft+1),
270 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
271 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
272 . ix1 ,ix2 ,ix3 ,ix4 ,ngl )
274 CALL cveok3(nvc,4,ix1,ix2,ix3,ix4)
277 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
278 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
279 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z, e3z )
283 IF ((imasadd > 0).OR.(nloc_dmg%IMOD > 0))
THEN
287 ele_area(i+nft) =
area(i)
288 IF (gbuf%G_AREA > 0) gbuf%AREA(i) =
area(i)
295 IF (jthe == 0 .and. glob_therm%NINTEMP > 0)
THEN
296 CALL initemp_shell(elbuf_str,temp,nel,numnod,numelc,4,nixc,ixc)
299 CALL cinmas(x,xrefc(1,1,nft+1),ixc,geo,pm,
300 . xmas,in,thke,ihbe,partsav,
301 . v,ipart(nft+1),msc(nft+1),inc(nft+1),
area ,
302 . i8mi ,igeo ,etnod ,imat ,iprop,nshnod ,stc(nft+1),
303 . sh4tree ,mcp , mcps(nft+1) ,temp ,
304 . ms_layer, zi_layer,ms_layerc,zi_layerc,
305 . msz2c,zply,isubstack,nlay,elbuf_str,stack,
306 . gbuf%THK_I,rnoise ,drape ,glob_therm%NINTEMP,
307 . perturb,ix1 ,ix2 ,ix3 ,ix4 ,
308 . idrape ,drapeg%INDX)
310 IF (mtn == 1 .OR. mtn == 91 .AND. npt/=1) npt = 0
312 CALL cderii(px1g,px2g,py1g,py2g,
313 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
314 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
315 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
316 . x2l ,x3l ,x4l ,y2l ,y3l ,y4l )
317 CALL cndleni(pm ,geo ,stifn ,stifr ,ixc(1,nft+1),
318 . thke ,ihbe ,igeo ,sh4tree ,aldt ,
319 . bufmat ,ipm ,nlay ,stack%PM,isubstack,
320 . strc(nft+1),
area ,imat ,iprop ,
dtel ,
321 . x2l ,x3l ,x4l ,y2l ,y3l ,y4l ,
322 . stack%IGEO ,group_param)
323 CALL c1buf3(geo,gbuf%THK,gbuf%OFF,thke,ksh4tree,sh4tree)
327 CALL c1buf3(geo,xfem_str(ng,ixel)%GBUF%THK,
328 . xfem_str(ng,ixel)%GBUF%OFF,thke,ksh4tree,sh4tree)
330 xfem_str(ng,ixel)%GBUF%THK(i) = thke(i)
331 xfem_str(ng,ixel)%GBUF%OFF(i) = -one
338 . nptr,npts,nptt,igtyp)
341 IF (( isigsh/=0 .OR. ithkshel == 2) .and. mpt>0)
THEN
343 . elbuf_str ,lft ,llt ,geo ,igeo ,
344 . mat ,pid ,matly ,posly ,igtyp ,
345 . nlay ,mpt ,isubstack ,stack ,drape ,
346 . nft ,gbuf%THK ,nel ,idrape ,
scdrape ,
354 ipg = nptr*(is-1) + ir
360 CALL cmaini3(elbuf_str,pm ,geo ,nel ,nlay ,
361 . skew ,igeo ,ixc(1,nft+1),nixc ,numelc ,
362 . nsigsh ,sigsh ,ptshel ,igtyp ,iorthloc ,
363 . ipm ,propid ,aldt ,mat_param,
364 . ir ,is ,isubstack,stack ,irep ,
365 . drape ,sh4ang(nft+1),geo_stack,igeo_stack,
366 . igmat ,imat ,iprop ,nummat,
367 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
368 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
369 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,x ,
370 . npt_all,idrape ,
scdrape , drapeg%INDX)
372 IF (( isigsh/=0 .OR. ithkshel == 2) .and. ihbe == 11)
THEN
374 .
CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
376 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
377 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
378 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
381 1 lft ,llt ,nft ,mpt ,istrain,
382 2 gbuf%THK ,gbuf%EINT,gbuf%STRPG(pts+1),gbuf%HOURG,
383 3 gbuf%FORPG(ptf+1),gbuf%MOMPG(ptm+1),sigsh ,nsigsh ,numelc ,
384 4 ixc ,nixc ,numshel ,ptshel ,igeo ,
385 5 ir ,is ,ipg ,npg ,gbuf%G_PLA,
386 6 gbuf%PLA,thke ,igtyp ,nel ,isigsh ,
387 7 e1x ,e2x ,e3x ,e1y ,e2y ,e3y,
388 8 e1z ,e2z ,e3z ,dir_a ,dir_b,posly )
391 gbuf%FORPG_G(ptf+i+jj(1:5))=gbuf%FORPG(ptf+i+jj(1:5))
394 IF (ithkshel == 2)
THEN
396 gbuf%STRA(i+jj(1:8))=gbuf%STRA(i+jj(1:8))+
397 . fourth*gbuf%STRPG(pts+i+jj(1:8))
400 ELSEIF ( ithkshel == 1 .AND. ihbe == 11 )
THEN
401 CALL thickini(lft ,llt ,nft ,ptshel,numelc,
402 2 gbuf%THK,thke ,ixc ,nixc ,nsigsh,
406 IF (iuser == 1. and. mtn>=28 .AND. ihbe == 11)
THEN
409 1 lft ,llt ,nft ,nel ,istrain ,
410 2 sigsh ,nsigsh ,numelc,ixc ,nixc ,
411 3 numshel ,ptshel ,ir ,is ,npt ,
412 4 igtyp ,igeo ,nlay ,npg ,ipg )
415 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87).AND. ihbe == 11)
THEN
418 1 lft ,llt ,nft ,nel ,istrain ,
419 2 sigsh ,nsigsh ,numelc,ixc ,nixc ,
420 3 numshel ,ptshel ,ir ,is ,npt ,
421 4 igtyp ,igeo ,nlay ,npg ,ipg )
430 IF (fail_fractal%NFAIL > 0)
THEN
431 CALL fractal_dmg_init(elbuf_str,mat_param,fail_fractal,
432 . nummat ,numelc ,nel ,nft ,ngl ,ity )
435 IF (ifail > 0 .and. iddlevel == 1)
THEN
437 . nel ,nft ,ity ,igrsh4n ,igrsh3n ,
443 CALL cfailini4(elbuf_str,nptr ,npts ,nptt ,nlay ,
444 . sigsh ,nsigsh ,ptshel ,rnoise ,perturb ,
445 . mat_param,aldt ,thke )
446 ELSEIF (ihbe > 20 .AND. ihbe < 29)
THEN
449 . nptt ,nlay ,sigsh ,nsigsh ,ptshel ,
450 . rnoise ,perturb ,aldt ,thke )
456 IF (ihbe > 20 .AND. ihbe < 29)
THEN
462 IF (istrain == 1 .AND. nxref > 0)
THEN
465 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR
466 CALL cnepsini(elbuf_str,mat_param(imat),
467 . lft ,llt ,ismstr ,mtn ,ithk ,
468 . pm ,geo ,ixc(1,nft+1),x ,xrefc(1,1,nft+1),
469 . nlay ,gbuf%FOR ,gbuf%THK,gbuf%EINT ,gbuf%STRA,
470 . px1g ,px2g ,py1g ,py2g ,x2s ,
471 . y2s ,x3s ,y3s ,x4s ,y4s ,
472 . gbuf%OFF ,uvar ,ipm ,imat ,
473 . igeo ,nel ,dir_a ,dir_b ,gbuf%SIGI,
476 CALL cepschk(lft, llt,nft, pm, geo,ixc(1,nft+1),
477 . gbuf%STRA,thke,nel ,cpt_eltens)
478 IF (ismstr == 1 .AND. mtn==19) iparg(9)=11
479 IF (mtn==58 .AND. npt_all==1)
THEN
484 elbuf_str%GBUF%HOURG(jj(1)+i) = xrefc(2,1,ii)-xrefc(1,1,ii)
485 elbuf_str%GBUF%HOURG(jj(2)+i) = xrefc(2,2,ii)-xrefc(1,2,ii)
486 elbuf_str%GBUF%HOURG(jj(3)+i
487 elbuf_str%GBUF%HOURG(jj(4)+i) = xrefc(3,1,ii)-xrefc(1,1,ii)
488 elbuf_str%GBUF%HOURG(jj(5)+i) = xrefc(3,2,ii)-xrefc(1,2,ii)
489 elbuf_str%GBUF%HOURG(jj(6)+i) = xrefc(3,3,ii)-xrefc(1,3,ii)
490 elbuf_str%GBUF%HOURG(jj(7)+i) = xrefc(4,1,ii)-xrefc(1,1,ii)
491 elbuf_str%GBUF%HOURG(jj(8)+i) = xrefc(4,2,ii)-xrefc(1,2,ii)
492 elbuf_str%GBUF%HOURG(jj(9)+i) = xrefc(4,3,ii)-xrefc(1,3,ii)
496 ELSEIF (ismstr == 11 .OR. (ismstr==1 .AND. mtn==19) )
THEN
499 . lft ,llt ,ixc(1,nft+1),x ,
500 . x2s,y2s,x3s,y3s,x4s,y4s)
503 IF (ismstr == 10 )
THEN
506 elbuf_str%GBUF%SMSTR(jj(1)+i) = x(1,ixc(3,ii))-x(1,ixc(2,ii))
507 elbuf_str%GBUF%SMSTR(jj(2)+i) = x(2,ixc(3,ii))-x(2,ixc(2,ii))
508 elbuf_str%GBUF%SMSTR(jj(3)+i) = x(3,ixc(3,ii))-x(3,ixc(2,ii))
509 elbuf_str%GBUF%SMSTR(jj(4)+i) = x(1,ixc(4,ii))-x(1,ixc(2,ii))
510 elbuf_str%GBUF%SMSTR(jj(5)+i) = x(2,ixc(4,ii))-x(2,ixc(2,ii))
511 elbuf_str%GBUF%SMSTR(jj(6)+i) = x(3,ixc(4,ii))-x(3,ixc(2,ii))
512 elbuf_str%GBUF%SMSTR(jj(7)+i) = x(1,ixc(5,ii))-x(1,ixc(2,ii))
513 elbuf_str%GBUF%SMSTR(jj(8)+i) = x(2,ixc(5,ii))-x(2,ixc(2,ii))
514 elbuf_str%GBUF%SMSTR(jj(9)+i) = x(3,ixc(5,ii))-x(3,ixc(2,ii))
516 ELSEIF (ismstr == 11 .OR. (ismstr==1 .AND. mtn==19) )
THEN
518 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
519 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
520 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
521 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
522 elbuf_str%GBUF%SMSTR(jj(5)+i) = x4s(i)
523 elbuf_str%GBUF%SMSTR(jj(6)+i) = y4s(i)
527 IF (isigsh/=0 .OR. ithkshel == 2)
THEN
530 .
CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
532 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
533 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
534 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
537 1 lft ,llt ,nft ,mpt ,istrain,
538 2 gbuf%THK,gbuf%EINT,gbuf%STRA,gbuf%HOURG,
539 3 gbuf%FOR,gbuf%MOM,sigsh ,nsigsh ,numelc ,
540 4 ixc ,nixc ,numshel ,ptshel ,igeo ,
541 5 ir ,is ,ipg ,npg ,gbuf%G_PLA,
542 6 gbuf%PLA,thke ,igtyp ,nel ,isigsh ,
543 7 e1x ,e2x ,e3x ,e1y ,e2y ,e3y,
544 8 e1z ,e2z ,e3z ,dir_a ,dir_b,posly )
547 gbuf%FOR_G(i+jj(1:5))=gbuf%FOR(i+jj(1:5))
551 IF (ithkshel == 2.AND.gbuf%G_STRPG>gbuf%G_STRA)
552 1
CALL cstraini4(lft ,llt ,nft ,nel ,numshel,
553 2 istrain,gbuf%STRPG,sigsh ,nsigsh ,numelc ,
554 4 ixc ,nixc ,ptshel ,thke ,gbuf%STRA,
555 7 e1x ,e2x ,e3x ,e1y ,e2y ,e3y,
557 ELSEIF ( ithkshel == 1 )
THEN
558 CALL thickini(lft ,llt ,nft ,ptshel,numelc,
559 2 gbuf%THK,thke ,ixc ,nixc ,nsigsh,
562 IF (iuser == 1 .AND. mtn >= 29)
THEN
564 1 lft ,llt ,nft ,nel , npt ,
565 2 istrain,sigsh ,numelc ,ixc ,nixc ,
566 3 nsigsh ,numshel,ptshel ,ir ,is ,
570 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87))
THEN
572 1 lft ,llt ,nft ,nel , npt ,
573 2 istrain,sigsh ,numelc ,ixc ,nixc ,
574 3 nsigsh ,numshel,ptshel ,ir ,is ,
579 ELSEIF (ihbe == 11)
THEN
582 IF (istrain == 1 .AND. nxref > 0)
THEN
588 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR
590 CALL cnepsini(elbuf_str,mat_param(imat),
591 . lft ,llt ,ismstr ,mtn ,ithk ,
592 . pm ,geo ,ixc(1,nft+1),x ,xrefc(1,1,nft+1),
593 . nlay ,gbuf%FOR ,gbuf%THK ,gbuf%EINT,gbuf%STRA ,
594 . px1g ,px2g ,py1g ,py2g ,x2s ,
595 . y2s ,x3s ,y3s ,x4s ,y4s ,
596 . gbuf%OFF,uvar ,ipm ,imat ,
597 . igeo ,nel ,dir_a ,dir_b ,gbuf%SIGI ,
600 IF (ismstr /= 4)
THEN
602 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
603 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
604 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
605 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
606 elbuf_str%GBUF%SMSTR(jj(5)+i) = x4s(i)
607 elbuf_str%GBUF%SMSTR(jj(6)+i) = y4s(i)
611 CALL cepschk(lft, llt,nft, pm, geo,ixc(1,nft+1),
612 . gbuf%STRA,thke,nel ,cpt_eltens)
613 IF (ismstr == 1 .AND. mtn==19) iparg(9)=11
617 ipg = nptr*(is-1) + ir
622 gbuf%FORPG(ptf+jj(1)+i) = gbuf%FOR(jj(1)+i)
623 gbuf%FORPG(ptf+jj(2)+i) = gbuf%FOR(jj(2)+i)
624 gbuf%FORPG(ptf+jj(3)+i) = gbuf%FOR(jj(3)+i)
626 gbuf%MOMPG(ptm+jj(1)+i) = gbuf%MOM(jj(1)+i)
627 gbuf%MOMPG(ptm+jj(2)+i) = gbuf%MOM(jj(2)+i)
628 gbuf%MOMPG(ptm+jj(3)+i) = gbuf%MOM(jj(3)+i)
630 gbuf%STRPG(pts+jj(1)+i) = gbuf%STRA(jj(1)+i)
631 gbuf%STRPG(pts+jj(2)+i) = gbuf%STRA(jj(2)+i)
632 gbuf%STRPG(pts+jj(3)+i) = gbuf%STRA(jj(3)+i)
635 IF (elbuf_str%BUFLY(j)%ILAW == 58)
THEN
636 DO k = 1,elbuf_str%BUFLY(j)%NPTT
637 uvar => elbuf_str%BUFLY(j)%MAT(ir,is,k)%VAR
638 nuvar = elbuf_str%BUFLY(j)%NVAR_MAT
640 uvar(i) = elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR(i)
649 ELSEIF (ismstr == 10 )
THEN
652 elbuf_str%GBUF%SMSTR(jj(1)+i) = x(1,ixc(3,ii))-x(1,ixc(2,ii))
653 elbuf_str%GBUF%SMSTR(jj(2)+i) = x(2,ixc(3,ii))-x(2,ixc(2,ii))
654 elbuf_str%GBUF%SMSTR(jj(3)+i) = x(3,ixc(3,ii))-x(3,ixc(2,ii))
655 elbuf_str%GBUF%SMSTR(jj(4)+i) = x(1,ixc(4,ii))-x
656 elbuf_str%GBUF%SMSTR(jj(5)+i) = x(2,ixc(4,ii))-x(2,ixc
657 elbuf_str%GBUF%SMSTR(jj(6)+i) = x(3,ixc(4,ii))-x(3,ixc
658 elbuf_str%GBUF%SMSTR(jj(7)+i) = x(1,ixc(5,ii))-x(1,ixc(2,ii))
659 elbuf_str%GBUF%SMSTR(jj(8)+i) = x(2,ixc(5,ii))-x(2,ixc(2,ii))
660 elbuf_str%GBUF%SMSTR(jj(9)+i) = x(3,ixc(5,ii))-x(3,ixc(2,ii))
662 ELSEIF (ismstr == 11 .OR. (ismstr==1 .AND. mtn==19) )
THEN
665 . lft ,llt ,ixc(1,nft+1),x ,x2s ,
666 . y2s ,x3s ,y3s ,x4s ,y4s )
668 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
669 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
670 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
671 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
672 elbuf_str%GBUF%SMSTR(jj(5)+i) = x4s(i)
673 elbuf_str%GBUF%SMSTR(jj(6)+i) = y4s(i)
681 IF (igtyp /= 1 .AND. igtyp /= 7 .AND.
682 . igtyp /= 9 .AND. igtyp /= 10 .AND.
683 . igtyp /= 11 .AND. igtyp /= 0 .AND.
684 . igtyp /= 16 .AND. igtyp /= 17 .AND.
685 . igtyp /= 51 .AND. igtyp /= 52 )
THEN
696 dtelem(ndepar+i) =
dtel(i)
700 CALL cbufxfe(elbuf_str,xfem_str ,isubstack,stack ,
701 . igeo ,geo ,lft ,llt ,mat ,
702 . pid ,npt ,nptt ,nlay ,ir ,
703 . is ,ixfem ,mtn ,ng)
708 IF (gbuf%G_VOL > 0) gbuf%VOL(i) =
area(i)*gbuf%THK(i
713 IF (xfem_str(ng,ixel)%GBUF%G_VOL > 0)
714 . xfem_str(ng,ixel)%GBUF%VOL(i) =
area(i)*gbuf%THK(i)