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
101#include "implicit_f.inc"
105#include "mvsiz_p.inc"
109#include "param_c.inc"
110#include "com01_c.inc"
111#include "com04_c.inc"
112#include "com_xfem1.inc"
113#include "vect01_c.inc"
114#include "scr03_c.inc"
116#include "scr17_c.inc"
120 INTEGER NVC,NEL,ITHK,IHBE,ISIGSH,IXFEM,NSIGSH,IUSER,IYLDINI,
121 . ISUBSTACK,NG,IDRAPE
122 INTEGER IXC(NIXC,*),IPART(*),PTSHEL(*),ITAG(*),ITAGEL(*),
123 . IGEO(NPROPGI,*), IPM(NPROPMI,*), NSHNOD(*),(*),
124 . SH4TREE(*),IPARG(*),CPT_ELTENS,ITAGN(*),ITAGE(*),
125 . IGEO_STACK(*),PERTURB(NPERTURB)
126 INTEGER ,
INTENT(IN) :: IDDLEVEL
129 . PM(NPROPM,*), X(3,*), GEO(NPROPG,*), XMAS(*), IN(*),
130 . DTELEM(*), XREFC(4,3,*),THKE(*), SIGSH(NSIGSH,*),
131 . STIFN(*),STIFR(*),PARTSAV(20,*), V(*) ,MSC(*) ,INC(*),
132 . (LSKEW,*), ETNOD(*), STC(*),BUFMAT(*),MCP(*),MCPS(*),
133 . TEMP(*),MS_LAYER(*),ZI_LAYER(*),MS_LAYERC(*),ZI_LAYERC(*),
134 . PART_AREA(*),MSZ2C(*),ZPLY(*),TF(*),RNOISE(*),
135 . SH4ANG(*),GEO_STACK(*),STRC(*),ELE_AREA(*)
136 TYPE (ELBUF_STRUCT_),
TARGET :: ELBUF_STR
137 TYPE (ELBUF_STRUCT_),
TARGET ,
DIMENSION(NGROUP,*):: XFEM_STR
139 TYPE (STACK_PLY) :: STACK
141TYPE (GROUP_PARAM_) ::
142 TYPE (DRAPE_) :: DRAPE(NUMELC_DRAPE + NUMELTG_DRAPE)
143 TYPE (DRAPEG_) :: DRAPEG
144 TYPE (MATPARAM_STRUCT_) ,
DIMENSION(NUMMAT) ,
INTENT(INOUT) :: MAT_PARAM
145 TYPE (FAIL_FRACTAL_) ,
INTENT(IN) :: FAIL_FRACTAL
146 TYPE (FAIL_BROKMANN_) ,
INTENT(IN) :: FAIL_BROKMANN
147 TYPE(glob_therm_) ,
intent(in) :: glob_therm
149 TYPE (GROUP_) ,
DIMENSION(NGRSHEL) :: IGRSH4N
150 TYPE (GROUP_) ,
DIMENSION(NGRSH3N) :: IGRSH3N
154 INTEGER I,,K,N,II,IUN,NDEPAR,IGTYP,IGMAT,NUVAR,IMAT,IPROP,PROPID,
155 . ipg,npg,ptf,ptm,pts,ixel,irep,nlay,nptr,npts,nptt,ifail,
156 . il,ir,is,it,lenf,lenm,lens,
157 . lenfp,lenmp,lenepinchxz,lenepinchyz,lenepinchzz,
158 . ipang,ipthk,ippos, ilay,i4,mpt,laynpt_max,lay_max,npt_all
160 INTEGER ,
DIMENSION(MVSIZ) :: IX1,IX2,IX3,IX4,IORTHLOC,MAT,PID,NGL
162 my_real ,
DIMENSION(MVSIZ) ::
area,aldt,
dtel,px1g,px2g,py1g,py2g,
163 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,
164 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,
165 . x2s,y2s,x3s,y3s,x4s,y4s,
166 . x2l,x3l,x4l,y2l,y3l,y4l
167 CHARACTER(LEN=NCHARTITLE)::TITR
169 my_real,
ALLOCATABLE,
DIMENSION(:) :: DIR_A,DIR_B
170 my_real ,
DIMENSION(:) ,
POINTER :: uvar
171 parameter(laynpt_max = 10)
172 parameter(lay_max = 100)
173 INTEGER,
DIMENSION(:),
ALLOCATABLE::MATLY
174 my_real,
DIMENSION(:,:),
ALLOCATABLE :: POSLY
176 TYPE(buf_lay_) ,
POINTER :: BUFLY
177 TYPE(L_BUFEL_) ,
POINTER :: LBUF
178 TYPE(g_bufel_) ,
POINTER :: GBUF
181 CALL MY_ALLOC(MATLY,MVSIZ*LAY_MAX)
182 CALL MY_ALLOC(POSLY,MVSIZ,LAY_MAX*LAYNPT_MAX)
184 gbuf => elbuf_str%GBUF
187 iprop = ixc(nixc-1,1+nft)
188 propid= igeo(1 ,iprop)
189 igtyp = igeo(11,iprop)
190 igmat = igeo(98,iprop)
197 pid(i) = ixc(6,n) ! iprop = mxg
200 CALL fretitl2(titr,igeo(npropgi-ltitr+1,iprop),ltitr)
203 nlay = elbuf_str%NLAY
204 nptr = elbuf_str%NPTR
205 npts = elbuf_str%NPTS
206 nptt = elbuf_str%NPTT
207 nxel = elbuf_str%NXEL
209 lenf = nel*gbuf%G_FORPG/npg
210 lenm = nel*gbuf%G_MOMPG/npg
212 lenfp = nel*gbuf%G_FORPGPINCH/npg
213 lenmp = nel*gbuf%G_MOMPGPINCH/npg
214 lenepinchxz = nel*gbuf%G_EPGPINCHXZ/npg
215 lenepinchyz = nel*gbuf%G_EPGPINCHYZ/npg
216 lenepinchzz = nel*gbuf%G_EPGPINCHZZ/npg
218 lens = nel*gbuf%G_STRPG/npg
222 npt_all = npt_all + elbuf_str%BUFLY(il)%NPTT
225 IF(npt_all == 0 ) npt_all = nlay
226 IF (iparg(6) == 0.OR.npt==0) mpt=0
227 IF((igtyp == 51 .OR. igtyp == 52) .AND. idrape > 0)
THEN
228 ALLOCATE(dir_a(npt_all*nel*2))
229 ALLOCATE(dir_b(npt_all*nel*2))
233 ALLOCATE(dir_a(nlay*nel*2))
234 ALLOCATE(dir_b(nlay*nel*2))
243 npt_all =
max(nlay, npt_all)
246 IF (ishxfem_ply > 0)
THEN
268 CALL ccoori(x,xrefc(1,1,nft+1),ixc(1,nft+1),
269 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
270 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
273 CALL cveok3(nvc,4,ix1,ix2,ix3,ix4)
276 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
277 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
278 . 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)
294 IF (jthe == 0 .and. glob_therm%NINTEMP > 0)
THEN
295 CALL initemp_shell(elbuf_str,temp,nel,numnod,numelc,4,nixc,ixc)
298 CALL cinmas(x,xrefc(1,1,nft+1),ixc,geo,pm,
299 . xmas,in,thke,ihbe,partsav,
300 . v,ipart(nft+1),msc(nft+1),inc(nft+1),
area ,
301 . i8mi ,igeo ,etnod ,imat ,iprop,nshnod ,stc(nft+1),
302 . sh4tree ,mcp , mcps(nft+1) ,temp ,
303 . ms_layer, zi_layer,ms_layerc,zi_layerc,
304 . msz2c,zply,isubstack,nlay,elbuf_str,stack,
305 . gbuf%THK_I,rnoise ,drape ,glob_therm%NINTEMP,
306 . perturb,ix1 ,ix2 ,ix3 ,ix4 ,
307 . idrape ,drapeg%INDX)
309 IF (mtn == 1 .OR. mtn == 3 .OR. mtn == 23 .OR. mtn == 91) npt = 0
311 CALL cderii(px1g,px2g,py1g,py2g,
312 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
313 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
314 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
315 . x2l ,x3l ,x4l ,y2l ,y3l ,y4l )
316 CALL cndleni(pm ,geo ,stifn ,stifr ,ixc(1,nft+1),
317 . thke ,ihbe ,igeo ,sh4tree ,aldt ,
318 . bufmat ,ipm ,nlay ,stack%PM,isubstack,
319 . strc(nft+1),
area ,imat ,iprop ,
dtel ,
320 . x2l ,x3l ,x4l ,y2l ,y3l ,y4l ,
321 . stack%IGEO ,group_param)
322 CALL c1buf3(geo,gbuf%THK,gbuf%OFF,thke,ksh4tree,sh4tree)
326 CALL c1buf3(geo,xfem_str(ng,ixel)%GBUF%THK,
327 . xfem_str(ng,ixel)%GBUF%OFF,thke,ksh4tree,sh4tree)
329 xfem_str(ng,ixel)%GBUF%THK(i) = thke(i)
330 xfem_str(ng,ixel)%GBUF%OFF(i) = -one
337 . nptr,npts,nptt,igtyp)
340 IF (( isigsh/=0 .OR. ithkshel == 2) .and. mpt>0)
THEN
342 . elbuf_str ,lft ,llt ,geo ,igeo ,
343 . mat ,pid ,matly ,posly ,igtyp ,
344 . nlay ,mpt ,isubstack ,stack ,drape ,
345 . nft ,gbuf%THK ,nel ,idrape ,
scdrape ,
353 ipg = nptr*(is-1) + ir
359 CALL cmaini3(elbuf_str,pm ,geo ,nel ,nlay ,
360 . skew ,igeo ,ixc(1,nft+1),nixc ,numelc ,
361 . nsigsh ,sigsh ,ptshel ,igtyp ,iorthloc ,
362 . ipm ,propid ,aldt ,mat_param,
363 . ir ,is ,isubstack,stack ,irep ,
364 . drape ,sh4ang(nft+1),geo_stack,igeo_stack,
365 . igmat ,imat ,iprop ,nummat,
366 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
367 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
368 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,x ,
369 . npt_all,idrape ,
scdrape , drapeg%INDX)
371 IF (( isigsh/=0 .OR. ithkshel == 2) .and. ihbe == 11)
THEN
373 .
CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
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 1 lft ,llt ,nft ,mpt ,istrain,
381 2 gbuf%THK ,gbuf%EINT,gbuf%STRPG(pts+1),gbuf%HOURG,
382 3 gbuf%FORPG(ptf+1),gbuf%MOMPG(ptm+1),sigsh ,nsigsh ,numelc ,
383 4 ixc ,nixc ,numshel ,ptshel ,igeo ,
384 5 ir ,is ,ipg ,npg ,gbuf%G_PLA,
385 6 gbuf%PLA,thke ,igtyp ,nel ,isigsh ,
386 7 e1x ,e2x ,e3x ,e1y ,e2y ,e3y,
387 8 e1z ,e2z ,e3z ,dir_a ,dir_b,posly )
388 IF (ithkshel == 2)
THEN
390 gbuf%STRA(i+jj(1:8))=gbuf%STRA(i+jj(1:8))+
391 . fourth*gbuf%STRPG(pts+i+jj(1:8))
394 ELSEIF ( ithkshel == 1 .AND. ihbe == 11 )
THEN
395 CALL thickini(lft ,llt ,nft ,ptshel,numelc,
396 2 gbuf%THK,thke ,ixc ,nixc ,nsigsh,
400 IF (iuser == 1. and. mtn>=28 .AND. ihbe == 11)
THEN
403 1 lft ,llt ,nft ,nel ,istrain ,
404 2 sigsh ,nsigsh ,numelc,ixc ,nixc ,
405 3 numshel ,ptshel ,ir ,is ,npt ,
406 4 igtyp ,igeo ,nlay ,npg ,ipg )
409 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87).AND. ihbe == 11)
THEN
412 1 lft ,llt ,nft ,nel ,istrain ,
413 2 sigsh ,nsigsh ,numelc,ixc ,nixc ,
414 3 numshel ,ptshel ,ir ,is ,npt ,
415 4 igtyp ,igeo ,nlay ,npg ,ipg )
424 IF (fail_fractal%NFAIL > 0)
THEN
425 CALL fractal_dmg_init(elbuf_str,mat_param,fail_fractal,
426 . nummat ,numelc ,nel ,nft ,ngl ,ity )
429 IF (ifail > 0 .and. iddlevel == 1)
THEN
431 . nel ,nft ,ity ,igrsh4n ,igrsh3n ,
437 CALL cfailini4(elbuf_str,nptr ,npts ,nptt ,nlay ,
438 . sigsh ,nsigsh ,ptshel ,rnoise ,perturb ,
439 . mat_param,aldt ,thke )
440 ELSEIF (ihbe > 20 .AND. ihbe < 29)
THEN
443 . nptt ,nlay ,sigsh ,nsigsh ,ptshel ,
444 . rnoise ,perturb ,aldt ,thke )
450 IF (ihbe > 20 .AND. ihbe < 29)
THEN
456 IF (istrain == 1 .AND. nxref > 0)
THEN
459 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR
460 CALL cnepsini(elbuf_str,mat_param(imat),
461 . lft ,llt ,ismstr ,mtn ,ithk ,
462 . pm ,geo ,ixc(1,nft+1),x ,xrefc(1,1,nft+1),
463 . nlay ,gbuf%FOR ,gbuf%THK,gbuf%EINT ,gbuf%STRA,
464 . px1g ,px2g ,py1g ,py2g ,x2s ,
465 . y2s ,x3s ,y3s ,x4s ,y4s ,
466 . gbuf%OFF ,uvar ,ipm ,imat ,
467 . igeo ,nel ,dir_a ,dir_b ,gbuf%SIGI,
470 CALL cepschk(lft, llt,nft, pm, geo,ixc(1,nft+1),
471 . gbuf%STRA,thke,nel ,cpt_eltens)
472 IF (ismstr == 1 .AND. mtn==19) iparg(9)=11
473 IF (mtn==58 .AND. npt_all==1)
THEN
478 elbuf_str%GBUF%HOURG(jj(1)+i) = xrefc(2,1,ii)-xrefc(1,1,ii)
479 elbuf_str%GBUF%HOURG(jj(2)+i) = xrefc(2,2,ii)-xrefc(1,2,ii)
480 elbuf_str%GBUF%HOURG(jj(3)+i) = xrefc(2,3,ii)-xrefc(1,3,ii)
481 elbuf_str%GBUF%HOURG(jj(4)+i) = xrefc(3,1,ii)-xrefc(1,1,ii)
482 elbuf_str%GBUF%HOURG(jj(5)+i) = xrefc(3,2,ii)-xrefc(1,2,ii)
483 elbuf_str%GBUF%HOURG(jj(6)+i) = xrefc(3,3,ii)-xrefc(1,3,ii)
484 elbuf_str%GBUF%HOURG(jj(7)+i) = xrefc(4,1,ii)-xrefc(1,1,ii)
485 elbuf_str%GBUF%HOURG(jj(8)+i) = xrefc(4,2,ii)-xrefc(1,2,ii)
486 elbuf_str%GBUF%HOURG(jj(9)+i) = xrefc(4,3,ii)-xrefc(1,3,ii)
490 ELSEIF (ismstr == 11 .OR. (ismstr==1 .AND. mtn==19) )
THEN
493 . lft ,llt ,ixc(1,nft+1),x ,
494 . x2s,y2s,x3s,y3s,x4s,y4s)
497 IF (ismstr == 10 )
THEN
500 elbuf_str%GBUF%SMSTR(jj(1)+i) = x(1,ixc(3,ii))-x(1,ixc(2,ii))
501 elbuf_str%GBUF%SMSTR(jj(2)+i) = x(2,ixc(3,ii))-x(2,ixc(2,ii))
502 elbuf_str%GBUF%SMSTR(jj(3)+i) = x(3,ixc(3,ii))-x(3,ixc(2,ii))
503 elbuf_str%GBUF%SMSTR(jj(4)+i) = x(1,ixc(4,ii))-x(1,ixc(2,ii))
504 elbuf_str%GBUF%SMSTR(jj(5)+i) = x(2,ixc(4,ii))-x(2,ixc(2,ii))
505 elbuf_str%GBUF%SMSTR(jj(6)+i) = x(3,ixc(4,ii))-x(3,ixc(2,ii))
506 elbuf_str%GBUF%SMSTR(jj(7)+i) = x(1,ixc(5,ii))-x(1,ixc(2,ii))
507 elbuf_str%GBUF%SMSTR(jj(8)+i) = x(2,ixc(5,ii))-x(2,ixc(2,ii))
508 elbuf_str%GBUF%SMSTR(jj(9)+i) = x(3,ixc(5,ii))-x(3,ixc(2,ii))
510 ELSEIF (ismstr == 11 .OR. (ismstr==1 .AND. mtn==19) )
THEN
512 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
513 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
514 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
515 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
516 elbuf_str%GBUF%SMSTR(jj(5)+i) = x4s(i)
517 elbuf_str%GBUF%SMSTR(jj(6)+i) = y4s(i)
521 IF (isigsh/=0 .OR. ithkshel == 2)
THEN
524 .
CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
526 . x1 ,x2 ,x3 ,x4 ,y1 ,y2
527 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
528 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
531 1 lft ,llt ,nft ,mpt ,istrain,
532 2 gbuf%THK,gbuf%EINT,gbuf%STRA,gbuf%HOURG,
533 3 gbuf%FOR,gbuf%MOM,sigsh ,nsigsh ,numelc ,
534 4 ixc ,nixc ,numshel ,ptshel ,igeo ,
535 5 ir ,is ,ipg ,npg ,gbuf%G_PLA,
536 6 gbuf%PLA,thke ,igtyp ,nel ,isigsh ,
537 7 e1x ,e2x ,e3x ,e1y ,e2y ,e3y,
538 8 e1z ,e2z ,e3z ,dir_a ,dir_b,posly )
540 IF (ithkshel == 2.AND.gbuf%G_STRPG>gbuf%G_STRA)
541 1
CALL cstraini4(lft ,llt ,nft ,nel ,numshel,
542 2 istrain,gbuf%STRPG,sigsh ,nsigsh ,numelc ,
543 4 ixc ,nixc ,ptshel ,thke ,gbuf%STRA,
544 7 e1x ,e2x ,e3x ,e1y ,e2y ,e3y,
546 ELSEIF ( ithkshel == 1 )
THEN
547 CALL thickini(lft ,llt ,nft ,ptshel,numelc,
548 2 gbuf%THK,thke ,ixc ,nixc ,nsigsh,
551 IF (iuser == 1 .AND. mtn >= 29)
THEN
553 1 lft ,llt ,nft ,nel , npt ,
554 2 istrain,sigsh ,numelc ,ixc ,nixc ,
555 3 nsigsh ,numshel,ptshel ,ir ,is ,
559 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87))
THEN
561 1 lft ,llt ,nft ,nel , npt ,
562 2 istrain,sigsh ,numelc ,ixc ,nixc ,
563 3 nsigsh ,numshel,ptshel ,ir ,is ,
568 ELSEIF (ihbe == 11)
THEN
571 IF (istrain == 1 .AND. nxref > 0)
THEN
577 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR
579 CALL cnepsini(elbuf_str,mat_param(imat),
580 . lft ,llt ,ismstr ,mtn ,ithk ,
581 . pm ,geo ,ixc(1,nft+1),x ,xrefc(1,1,nft+1),
582 . nlay ,gbuf%FOR ,gbuf%THK ,gbuf%EINT,gbuf%STRA ,
583 . px1g ,px2g ,py1g ,py2g ,x2s ,
584 . y2s ,x3s ,y3s ,x4s ,y4s ,
585 . gbuf%OFF,uvar ,ipm ,imat ,
586 . igeo ,nel ,dir_a ,dir_b ,gbuf%SIGI ,
589 IF (ismstr /= 4)
THEN
591 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
592 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
593 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
594 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
595 elbuf_str%GBUF%SMSTR(jj(5)+i) = x4s(i)
596 elbuf_str%GBUF%SMSTR(jj(6)+i) = y4s(i)
600 CALL cepschk(lft, llt,nft, pm, geo,ixc(1,nft+1),
601 . gbuf%STRA,thke,nel ,cpt_eltens)
602 IF (ismstr == 1 .AND. mtn==19) iparg(9)=11
606 ipg = nptr*(is-1) + ir
611 gbuf%FORPG(ptf+jj(1)+i) = gbuf%FOR(jj(1)+i)
612 gbuf%FORPG(ptf+jj(2)+i) = gbuf%FOR(jj(2)+i)
613 gbuf%FORPG(ptf+jj(3)+i) = gbuf%FOR(jj(3)+i)
615 gbuf%MOMPG(ptm+jj(1)+i) = gbuf%MOM(jj(1)+i
616 gbuf%MOMPG(ptm+jj(2)+i) = gbuf%MOM
617 gbuf%MOMPG(ptm+jj(3)+i) = gbuf%MOM(jj(3)+i)
619 gbuf%STRPG(pts+jj(1)+i) = gbuf%STRA(jj(1)+i)
620 gbuf%STRPG(pts+jj(2)+i) = gbuf%STRA(jj(2)+i)
621 gbuf%STRPG(pts+jj(3)+i) = gbuf%STRA(jj(3)+i)
624 IF (elbuf_str%BUFLY(j)%ILAW == 58)
THEN
625 DO k = 1,elbuf_str%BUFLY(j)%NPTT
626 uvar => elbuf_str%BUFLY(j)%MAT(ir,is,k)%VAR
627 nuvar = elbuf_str%BUFLY(j)%NVAR_MAT
629 uvar(i) = elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR(i)
638 ELSEIF (ismstr == 10 )
THEN
641 elbuf_str%GBUF%SMSTR(jj(1)+i) = x(1,ixc(3,ii))-x(1,ixc(2,ii))
642 elbuf_str%GBUF%SMSTR(jj(2)+i) = x(2,ixc(3,ii))-x(2,ixc(2,ii))
643 elbuf_str%GBUF%SMSTR(jj(3)+i) = x(3,ixc(3,ii))-x(3,ixc(2,ii))
644 elbuf_str%GBUF%SMSTR(jj(4)+i) = x(1,ixc(4,ii))-x(1,ixc(2,ii))
645 elbuf_str%GBUF%SMSTR(jj(5)+i) = x(2,ixc(4,ii))-x(2,ixc(2,ii))
646 elbuf_str%GBUF%SMSTR(jj(6)+i) = x(3,ixc(4,ii))-x(3,ixc(2,ii))
647 elbuf_str%GBUF%SMSTR(jj(7)+i) = x(1,ixc(5,ii))-x(1,ixc(2,ii))
648 elbuf_str%GBUF%SMSTR(jj(8)+i) = x(2,ixc(5,ii))-x(2,ixc(2,ii))
649 elbuf_str%GBUF%SMSTR(jj(9)+i) = x(3,ixc(5,ii))-x(3,ixc(2,ii))
651 ELSEIF (ismstr == 11 .OR. (ismstr==1 .AND. mtn==19) )
THEN
654 . lft ,llt ,ixc(1,nft+1),x ,x2s ,
655 . y2s ,x3s ,y3s ,x4s ,y4s )
657 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
658 elbuf_str%GBUF%SMSTR(jj(2)+i) = y2s(i)
659 elbuf_str%GBUF%SMSTR(jj(3)+i) = x3s(i)
660 elbuf_str%GBUF%SMSTR(jj(4)+i) = y3s(i)
661 elbuf_str%GBUF%SMSTR(jj(5)+i) = x4s(i)
662 elbuf_str%GBUF%SMSTR(jj(6)+i) = y4s(i)
670 IF (igtyp /= 1 .AND. igtyp /= 7 .AND.
671 . igtyp /= 9 .AND. igtyp /= 10 .AND.
672 . igtyp /= 11 .AND. igtyp /= 0 .AND.
673 . igtyp /= 16 .AND. igtyp /= 17 .AND.
674 . igtyp /= 51 .AND. igtyp /= 52 )
THEN
685 dtelem(ndepar+i) =
dtel(i)
689 CALL cbufxfe(elbuf_str,xfem_str ,isubstack,stack ,
690 . igeo ,geo ,lft ,llt ,mat ,
691 . pid ,npt ,nptt ,nlay ,ir ,
692 . is ,ixfem ,mtn ,ng)
697 IF (gbuf%G_VOL > 0) gbuf%VOL(i) =
area(i)*gbuf%THK(i)
702 IF (xfem_str(ng,ixel)%GBUF%G_VOL > 0)
703 . xfem_str(ng,ixel)%GBUF%VOL(i) =
area(i)*gbuf%THK(i)