81
82
83
84 USE my_alloc_mod
85 USE mat_elem_mod
90 USE group_param_mod
92 USE random_walk_def_mod
93 USE fractal_dmg_init_mod
95 use brokmann_random_def_mod
96 use glob_therm_mod
97 use initemp_shell_mod
98 use element_mod , only : nixtg
99 use law42c_ini_mod
100
101
102
103#include "implicit_f.inc"
104
105
106
107#include "mvsiz_p.inc"
108
109
110
111#include "com01_c.inc"
112#include "com04_c.inc"
113#include "com_xfem1.inc"
114#include "param_c.inc"
115#include "scr03_c.inc"
116#include "scr17_c.inc"
117#include "vect01_c.inc"
118#include "scry_c.inc"
119
120
121
122 INTEGER OFFSET,NEL,ITHK,ISIGSH,NSIGSH,IUSER,
123 . CPT_ELTENS,ISUBSTACK,IYLDINI,ISH3N,NG,IDRAPE
124 INTEGER IXTG(NIXTG,*),IPART(*),IGEO(NPROPGI,*),IPM(NPROPMI,*),
125 . IPARG(*),NSHNOD(*), PTSH3N(*),NPF(*),
126 . SH3TREE(*),ITAGE(*),ITAGN(*),IXFEM,SH3TRIM(*),
127 . IGEO_STACK(*),PERTURB(NPERTURB)
128 INTEGER ,INTENT(IN) :: IDDLEVEL
129
131 . pm(*),x(3,*),geo(npropg,*),xmas(*),xreftg(3,3,*),
132 . in(*),dtelem(*),thk(*),sigsh(nsigsh,*),
133 . stifn(*),stifr(*),partsav(20,*), v(*), skew(lskew,*),
134 . mstg(*),intg(*),ptg(3,*),
135 . etnod(*), sttg(*),bufmat(*),mcp(*),mcptg(*),temp(*),
136 . part_area(*),tf(*),rnoise(*),sh3ang(*),
137 . geo_stack(*),strtg(*),ele_area(*)
138 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
139 TYPE(ELBUF_STRUCT_), TARGET ,DIMENSION(NGROUP,*):: XFEM_STR
140
141 TYPE (STACK_PLY) :: STACK
142 TYPE (NLOCAL_STR_) :: NLOC_DMG
143 TYPE (GROUP_PARAM_) :: GROUP_PARAM
144 TYPE (DRAPE_) :: DRAPE(NUMELC_DRAPE + NUMELTG_DRAPE)
145 TYPE (DRAPEG_) :: DRAPEG
146 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
147 TYPE (FAIL_FRACTAL_) ,INTENT(IN) :: FAIL_FRACTAL
148 TYPE (FAIL_BROKMANN_) ,INTENT(IN) :: FAIL_BROKMANN
149 TYPE (glob_therm_) ,intent(in) :: glob_therm
150
151 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
152 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
153
154
155
156 INTEGER I,J,NDEPAR,IGTYP,NVC,NUVAR,NLAY,IR,IS,IL,IFAIL,NUPARAM,
157 . NPTR,NPTS,NPTT,IXEL,II,IT,ILAW,IMAT,IPROP,IREP,ITG,IGMAT,
158 . IFRAM_OLD,NPT_ALL,MPT,LAYNPT_MAX,LAY_MAX
159 INTEGER IORTHLOC(MVSIZ),MAT(MVSIZ),PID(MVSIZ),NGL(MVSIZ),JJ(6),
160 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ)
162 . vx(mvsiz),vy(mvsiz),vz(mvsiz),aldt(mvsiz),
area(mvsiz)
164 . DIMENSION(MVSIZ) :: px1g,py1g,py2g,x2s,x3s,y3s,dt
165 my_real x1(mvsiz), x2(mvsiz), x3(mvsiz) ,x4(mvsiz),
166 . y1(mvsiz), y2(mvsiz), y3(mvsiz),y4(mvsiz),
167 . z1(mvsiz), z2(mvsiz), z3(mvsiz),z4(mvsiz),
168 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
169 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
170 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
171 . x31(mvsiz), y31(mvsiz), z31(mvsiz),
172 . x2l(mvsiz), x3l(mvsiz), y3l(mvsiz)
173 INTEGER ID
174 CHARACTER(LEN=NCHARTITLE)::TITR
176 . ALLOCATABLE, DIMENSION(:) :: dir_a,dir_b,phi1,phi2,
177 . coor1,coor2,coor3,coor4
178 INTEGER, ALLOCATABLE, DIMENSION(:) :: INDX
179 parameter(laynpt_max = 10)
180 parameter(lay_max = 100)
181 INTEGER, DIMENSION(:),ALLOCATABLE::MATLY
182 my_real,
DIMENSION(:,:),
ALLOCATABLE ::
183
185 . DIMENSION(:) ,POINTER :: uvar,dir1,dir2
186 TYPE(G_BUFEL_) ,POINTER :: GBUF
187 TYPE(L_BUFEL_) ,POINTER :: LBUF
188 TYPE(BUF_LAY_) ,POINTER :: BUFLY
189
190
191 CALL my_alloc(matly,mvsiz*lay_max)
192 CALL my_alloc(posly,mvsiz,lay_max*laynpt_max)
193
194 gbuf => elbuf_str%GBUF
195 bufly => elbuf_str%BUFLY(1)
196
197 imat = ixtg(1,1+nft)
198 iprop = ixtg(nixtg-1,1+nft)
199 igtyp = nint(geo(12,iprop))
201 igmat = igeo(98,iprop)
202 irep = iparg(35)
203 ifail = iparg(43)
204
205 IF (ish3n==3.AND.ish3nfram==0) THEN
206 ifram_old =0
207 ELSE
208 ifram_old =1
209 END IF
210
211 CALL fretitl2(titr,igeo(npropgi-ltitr+1,iprop),ltitr
212 nuvar = ipm(8,ixtg(1,1+nft))
213 vx = zero
214 vy = zero
215 vz = zero
216 iorthloc = 0
217 itg = 1+numelc
218
219 ir = 1
220 is = 1
221 nlay = elbuf_str%NLAY
222 nxel = elbuf_str%NXEL
223 nptt = elbuf_str%NPTT
224
225 npt_all = 0
226 DO il=1,nlay
227 npt_all = npt_all + elbuf_str%BUFLY(il)%NPTT
228 ENDDO
230 IF(npt_all == 0) npt_all = nlay
231 IF (iparg(6) == 0.OR.npt==0) mpt=0
232 IF((igtyp == 51 .OR. igtyp == 52) .AND. idrape > 0) THEN
233 ALLOCATE(dir_a(npt_all*nel*2))
234 ALLOCATE(dir_b(npt_all*nel*2))
235 dir_a = zero
236 dir_b = zero
237 ALLOCATE(phi1(mvsiz*npt_all))
238 ALLOCATE(phi2(nvsiz*npt_all))
239 phi1 = zero
240 phi2 = zero
241 ALLOCATE(coor1(npt_all*mvsiz))
242 ALLOCATE(coor2(npt_all*mvsiz))
243 ALLOCATE(coor3(npt_all*mvsiz))
244 ALLOCATE(coor4(npt_all*mvsiz))
245 coor1 = zero
246 coor2 = zero
247 coor3 = zero
248 coor4 = zero
249 ELSE
250 ALLOCATE(dir_a(nlay*nel*2))
251 ALLOCATE(dir_b(nlay*nel*2))
252 dir_a = zero
253 dir_b = zero
254 ALLOCATE(phi1(nlay*mvsiz))
255 ALLOCATE(phi2(nlay*mvsiz))
256 phi1 = zero
257 phi2 = zero
258 ALLOCATE(coor1(nlay*mvsiz))
259 ALLOCATE(coor2(nlay*mvsiz))
260 ALLOCATE(coor3(nlay*mvsiz))
261 ALLOCATE(coor4(nlay*mvsiz))
262 coor1 = zero
263 coor2 = zero
264 coor3 = zero
265 coor4 = zero
266 npt_all = nlay
267 ENDIF
268
269
270 DO j=1,6
271 jj(j) = nel*(j-1)
272 ENDDO
273
274 DO i=lft,llt
275 mat(i) = imat
276 pid(i) = iprop
277 ENDDO
278
279 IF (ixfem > 0) THEN
280 DO i=lft,llt
281 itagn(ixtg(2,i+nft)) =1
282 itagn(ixtg(3,i+nft)) =1
283 itagn(ixtg(4,i+nft)) =1
284 itage(i+nft) = 1
285 ENDDO
286 ENDIF
287
288 CALL c3coori(x,xreftg(1,1,nft+1),ixtg(1,nft+1),ngl,
289 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
290 . z1 ,z2 ,z3 ,ix1 ,ix2 ,ix3 )
291 CALL c3veok3(nvc ,ix1 ,ix2 ,ix3 )
293 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
294 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
295 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
296 . x31, y31, z31 ,x2l ,x3l ,y3l )
297
298
299
300 IF ((imasadd > 0).OR.(nloc_dmg%IMOD > 0)) THEN
301 DO i=lft,llt
302 j = ipart(i+nft)
303
304 ele_area(numelc+i+nft) =
area(i)
305 IF (gbuf%G_AREA > 0) gbuf%AREA(i) =
area(i)
306 ENDDO
307 ENDIF
308
309
310
311 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
312 CALL initemp_shell(elbuf_str,temp,nel,numnod,numeltg,3,nixtg,ixtg)
313 END IF
314
315 IF(idrape > 0 ) THEN
316 ALLOCATE(indx(numeltg))
317 indx = 0
318 indx(1:numeltg) = drapeg%INDX(numelc + 1 : numelc + numeltg)
319 ELSE
320 ALLOCATE(indx(0))
321 ENDIF
322 CALL c3inmas(x,xreftg(1,1,nft+1),ixtg,geo,pm,xmas,in,thk,
323 . partsav,v,ipart(nft+1),mstg(nft+1),intg(nft+1),
324 . ptg(1,nft+1),igeo ,imat ,iprop ,
area ,
325 . etnod,nshnod,sttg(nft+1) ,sh3tree ,mcp ,
326 . mcptg(nft+1),temp ,sh3trim,isubstack,nlay ,
327 . elbuf_str ,stack ,gbuf%THK_I,rnoise,drape,
328 . perturb,ix1 ,ix2 ,ix3 ,glob_therm%NINTEMP,
329 . x2l ,x3l ,y3l ,idrape,indx)
330
332 . stifn ,stifr ,ixtg(1,nft+1),
333 . thk,sh3tree,aldt ,bufmat , ipm ,igeo,
334 . stack%PM,isubstack,strtg(nft+1),imat,iprop,
335 .
area ,dt ,x31 ,y31 ,z31 ,
336 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,
337 . e1z ,e2z ,e3z ,x2l ,x3l ,y3l ,
338 . group_param)
339
340 CALL c1buf3(geo,gbuf%THK,gbuf%OFF,thk,ksh3tree,sh3tree)
341
342 IF (ixfem > 0) THEN
343 DO ixel=1,nxel
344 DO i=lft,llt
345 xfem_str(ng,ixel)%GBUF%THK(i) = thk(i)
346 xfem_str(ng,ixel)%GBUF%OFF(i) = -one
347 END DO
348 ENDDO
349 ENDIF
350
351 IF (ifram_old ==0 )
353 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
354 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
355 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
356
357
358
360 . lft ,llt ,nft ,nlay ,numeltg ,
361 . nsigsh ,nixtg ,ixtg(1,nft+1),igeo ,geo ,
362 . skew ,sigsh ,ptsh3n ,phi1 ,phi2 ,
363 . vx ,vy ,vz ,coor1 ,coor2 ,
364 . coor3 ,coor4 ,iorthloc ,isubstack ,stack ,
365 . irep ,elbuf_str ,drape ,sh3ang(nft+1),x ,
366 . geo_stack ,e3x ,e3y ,e3z ,
367 . gbuf%BETAORTH,x1 ,x2 ,y1 ,y2 ,
368 . z1 ,z2 ,nel ,gbuf%G_ADD_NODE,gbuf%ADD_NODE,
369 . npt_all ,idrape ,indx)
370
371 IF(igtyp == 51 .OR. igtyp == 52 .OR. igmat > 0) THEN
372
374 . igeo ,geo ,vx ,vy ,vz ,
375 . phi1 ,phi2 ,coor1 ,coor2 ,coor3 ,
376 . coor4 ,iorthloc ,nlay ,irep ,isubstack,
377 . stack ,geo_stack ,igeo_stack ,ir ,is ,
378 . nel ,imat ,iprop ,
379 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
380 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
381 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
382 . npt_all ,idrape)
383
384 ELSEIF (mtn == 27) THEN
386 . geo ,igeo ,pm ,ipm ,ixtg(1,1+nft) ,nixtg,
387 . nlay,ir ,is ,imat )
388 ELSEIF (mtn == 35) THEN
389 nptr = elbuf_str%NPTR
390 npts = elbuf_str%NPTS
391 nptt = elbuf_str%NPTT
393 . nptr,npts,nptt,igtyp)
394 ELSEIF (mtn == 15 .or. mtn == 19 .or. mtn == 25 .or. mtn >= 28)THEN
395 IF (mtn == 19 .AND. igtyp /= 9) THEN
397 . anmode=aninfo,
398 . msgtype=msgerror,
399 . i1=igeo(1,ixtg(nixtg-1,nft+1)))
400 ENDIF
401
403 . igeo ,geo ,vx ,vy ,vz ,
404 . phi1 ,phi2 ,coor1 ,coor2 ,coor3 ,
405 . coor4 ,iorthloc ,nlay ,irep ,isubstack,
406 . stack ,geo_stack ,igeo_stack ,ir ,is ,
407 . nel ,imat ,iprop ,
408 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
409 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
410 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
411 . npt_all ,idrape)
412 ENDIF
413
414 IF ((mtn == 58 .or. mtn == 158) .AND.
415 . igtyp /= 16 .AND. igtyp /= 51 .AND. igtyp /= 52) THEN
417 . msgtype=msgerror,
418 . anmode=aninfo_blind_1,
420 . c1=titr,
421 . i2=mtn,
422 . i3=igtyp)
423 ELSEIF (mtn == 58 .or. mtn == 158 .OR. igtyp == 51 .OR. igtyp == 52) THEN
424 IF (idrape == 0 ) THEN
425 DO il = 1,nlay
426 nptt = elbuf_str%BUFLY(il)%NPTT
427 imat = elbuf_str%BUFLY(il)%IMAT
428 ilaw = elbuf_str%BUFLY(il)%ILAW
429 nuvar = elbuf_str%BUFLY(il)%NVAR_MAT
430 dir1 => elbuf_str%BUFLY(il)%DIRA
431 dir2 => elbuf_str%BUFLY(il)%DIRB
432 nuparam = mat_param(imat)%NUPARAM
433
434 IF (ilaw == 58) THEN
435 DO it=1,nptt
436 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
437 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
439 . irep ,dir1 ,dir2 ,mat_param(imat)%UPARAM,
440 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
441 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
442 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
443 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z, e3z )
444 ENDDO
445 ELSE IF (ilaw == 158) THEN
446 DO it=1,nptt
447 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
448 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
450 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
451 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
452 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
453 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z, e3z )
454 ENDDO
455 ENDIF
456
457 ENDDO
458 ELSE
459 DO il = 1,nlay
460 nptt = elbuf_str%BUFLY(il)%NPTT
461 imat = elbuf_str%BUFLY(il)%IMAT
462 ilaw = elbuf_str%BUFLY(il)%ILAW
463 nuvar = elbuf_str%BUFLY(il)%NVAR_MAT
464 nuparam = mat_param(imat)%NUPARAM
465
466 IF (ilaw == 58) THEN
467 DO it=1,nptt
468 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
469 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
470 dir1 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRA
471 dir2 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRB
473 . irep ,dir1 ,dir2 ,mat_param(imat)%UPARAM,
474 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
475 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
476 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
477 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z
478 ENDDO
479 ELSE IF (ilaw == 158) THEN
480 DO it=1,nptt
481 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
482 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
483 dir1 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRA
484 dir2 => elbuf_str%BUFLY(il)%LBUF_DIR(it)%DIRB
486 . uvar ,aldt ,nel ,nuvar ,lbuf%ANG ,
487 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
488 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
489 . e1x, e2x, e3x, e1y, e2y, e3y ,e1z, e2z, e3z )
490 ENDDO
491 ENDIF
492
493 ENDDO
494 ENDIF
495 ENDIF
496 IF (mtn == 42 .OR. mtn == 69 .OR. igtyp == 51 .OR. igtyp == 52) THEN
497 DO il = 1,nlay
498 nptt = elbuf_str%BUFLY(il)%NPTT
499 ilaw = elbuf_str%BUFLY(il)%ILAW
500 nuvar = elbuf_str%BUFLY(il)%NVAR_MAT
501
502 IF (ilaw == 42 .OR. mtn == 69) THEN
503 DO it=1,nptt
504 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
505 uvar => elbuf_str%BUFLY(il)%MAT(ir,is,it)%VAR
506 CALL law42c_ini(nuvar,uvar,llt)
507 ENDDO
508 ENDIF
509 ENDDO
510 ENDIF
511
512
513
514 IF (isigsh /= 0 .OR. ithkshel == 2) THEN
515
516 IF (mpt>0) THEN
518 . elbuf_str ,lft ,llt ,geo ,igeo ,
519 . mat ,pid ,matly ,posly ,igtyp ,
520 . nlay ,mpt ,isubstack ,stack ,drape ,
521 . nft ,gbuf%THK ,nel ,idrape ,
stdrape ,
522 . indx)
523 CALL corth3(elbuf_str,dir_a ,dir_b ,lft ,llt ,
524 . nlay ,irep ,nel ,
525 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
526 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
527 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
528 . idrape , igtyp)
529 END IF
531 1 lft ,llt ,nft ,mpt ,istrain ,
532 2 gbuf%THK,gbuf%EINT,gbuf%STRA,gbuf%HOURG
533 3 gbuf%FOR,gbuf%MOM ,sigsh ,nlay ,gbuf%G_HOURG,
534 4 numeltg ,ixtg ,nixtg ,nsigsh ,numsh3n ,
535 5 ptsh3n ,igeo ,thk ,nel ,e1x ,
536 6 e2x ,e3x ,e1y ,e2y ,e3y
537 7 e1z ,e2z ,e3z ,isigsh ,dir_a ,
538 8 dir_b ,posly ,igtyp )
539 IF (mpt == 0) THEN
540 DO i=lft,llt
541 gbuf%FOR_G(i+jj(1:5))=gbuf%FOR(i+jj(1:5))
542 END DO
543 END IF
544 ELSEIF ( ithkshel == 1 ) THEN
545 CALL thickini(lft ,llt ,nft ,ptsh3n,numeltg,
546 2 gbuf%THK,thk ,ixtg ,nixtg ,nsigsh ,
547 3 sigsh )
548 ENDIF
549
550
551
552
553 IF (fail_fractal%NFAIL > 0) THEN
554 CALL fractal_dmg_init(elbuf_str,mat_param,fail_fractal,
555 . nummat ,numeltg ,nel ,nft ,ngl ,ity )
556 ENDIF
557
558 IF (ifail > 0 .and. iddlevel == 1) THEN
560 . nel ,nft ,ity ,igrsh4n ,igrsh3n ,
561 . aldt ,thk ,ngl )
562 ENDIF
563
564
565
567 . nptt ,nlay ,sigsh ,nsigsh ,ptsh3n ,
568 . rnoise ,perturb ,aldt ,thk )
569
570
571
572
573 IF (istrain == 1 .AND. nxref > 0) THEN
574 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR
575 imat = elbuf_str%BUFLY(1)%IMAT
576
577 CALL c3epsini(elbuf_str,mat_param(imat),
578 . lft ,llt ,ismstr ,mtn ,ithk ,
579 . pm ,geo ,ixtg(1,nft+1),x ,xreftg(1,1,nft+1),
580 . gbuf%FOR,gbuf%THK ,gbuf%EINT ,gbuf%STRA,nlay ,
581 . px1g ,py1g ,py2g ,x2s ,x3s ,
582 . y3s ,uvar ,ipm ,
583 . nel ,dir_a ,dir_b ,gbuf%SIGI,npf ,
584 . tf ,irep ,ifram_old ,imat )
585
586 CALL c3epschk(lft, llt,nft, pm, geo,ixtg(1,nft+1), gbuf%STRA,thk,
587 . nel,cpt_eltens)
588
589 IF (ismstr == 1 .AND. mtn==19) iparg(9) = 11
590
591 ELSEIF (ismstr == 11 .OR. (ismstr==1 .AND. mtn==19)) THEN
592
594 . lft ,llt ,ixtg(1,nft+1),x ,x2s ,
595 . x3s ,y3s )
596 ENDIF
597
598 IF (ismstr == 10) THEN
599 DO i=lft,llt
600 ii = nft + i
601 elbuf_str%GBUF%SMSTR(jj(1)+i) = x(1,ixtg(3,ii))-x(1,ixtg(2,ii))
602 elbuf_str%GBUF%SMSTR(jj(2)+i) = x(2,ixtg(3,ii))-x(2,ixtg(2,ii))
603 elbuf_str%GBUF%SMSTR(jj(3)+i) = x(3,ixtg(3,ii))-x(3,ixtg(2,ii))
604 elbuf_str%GBUF%SMSTR(jj(4)+i) = x(1,ixtg(4,ii))-x(1,ixtg(2,ii))
605 elbuf_str%GBUF%SMSTR(jj(5)+i) = x(2,ixtg(4,ii))-x(2,ixtg(2,ii))
606 elbuf_str%GBUF%SMSTR(jj(6)+i) = x(3,ixtg(4,ii))-x(3,ixtg(2,ii))
607 ENDDO
608 ELSEIF (ismstr == 11 .OR.(ismstr==1 .AND. mtn==19)) THEN
609 DO i=lft,llt
610 elbuf_str%GBUF%SMSTR(jj(1)+i) = x2s(i)
611 elbuf_str%GBUF%SMSTR(jj(2)+i) = x3s(i)
612 elbuf_str%GBUF%SMSTR(jj(3)+i) = y3s(i)
613 ENDDO
614 ENDIF
615
616 IF (iuser == 1 .and. mtn > 28) THEN
617
619 1 lft ,llt ,nft ,nel ,npt ,
620 2 istrain,sigsh ,numeltg ,ixtg ,nixtg ,
621 3 nsigsh ,numsh3n,ptsh3n ,ir ,is ,
622 4 nlay )
623 ENDIF
624
625 IF (iyldini == 1 .AND. (mtn== 36.OR. mtn==87))THEN
627 1 lft ,llt ,nft ,nel ,npt ,
628 2 istrain,sigsh ,numeltg ,ixtg ,nixtg ,
629 3 nsigsh ,numsh3n,ptsh3n ,ir ,is ,
630 4 nlay )
631 ENDIF
632
633
634
635
636 IF (igtyp /= 0 .AND. igtyp /= 1 .AND.
637 . igtyp /= 9 .AND. igtyp /= 10 .AND.
638 . igtyp /= 11 .AND. igtyp /= 16 .AND.
639 . igtyp /= 17 .AND. igtyp /= 51 .AND.
640 . igtyp /= 52 ) THEN
642 . anmode=aninfo,
643 . msgtype=msgerror,
645 . c1=titr,
646 . i2=iprop)
647 ENDIF
648 ndepar=numels+numelc+numelt+numelp+numelr+nft
649 DO i=lft,llt
650 dtelem(ndepar+i) = dt(i)
651 END DO
652
653 IF (ixfem > 0) THEN
654 CALL cbufxfe(elbuf_str,xfem_str,isubstack,stack ,
655 . igeo ,geo ,lft ,llt ,mat,
656 . pid ,npt ,nptt ,nlay,ir ,
657 . is ,ixfem,mtn ,ng)
658 ENDIF
659
660
661 DO i=lft,llt
662 IF (gbuf%G_VOL > 0) gbuf%VOL(i) =
area(i)*gbuf%THK(i)
663 ENDDO
664 IF (ixfem > 0) THEN
665 DO ixel=1,nxel
666 DO i=lft,llt
667 IF (xfem_str(ng,ixel)%GBUF%G_VOL > 0)
668 . xfem_str(ng,ixel)%GBUF%VOL(i) =
area(i)*gbuf%THK(i)
669 END DO
670 ENDDO
671 ENDIF
672
673 IF (ALLOCATED(dir_b)) DEALLOCATE(dir_b)
674 IF (ALLOCATED(dir_a)) DEALLOCATE(dir_a)
675 IF (ALLOCATED(indx)) DEALLOCATE(indx)
676
677 DEALLOCATE(matly)
678 DEALLOCATE(posly)
679
680 RETURN
subroutine c1buf3(geo, thk, off, thke, kshtree, shtree)
subroutine c3coori(x, xreftg, ixp, ngl, x1, x2, x3, y1, y2, y3, z1, z2, z3, ix1, ix2, ix3)
subroutine c3derii(jft, jlt, pm, geo, px1, py1, py2, stifn, stifr, ixtg, thk, sh3tree, aldt, uparam, ipm, igeo, pm_stack, isubstack, strtg, imat, iprop, area, dt, x31g, y31g, z31g, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, x2, x3, y3, group_param)
subroutine c3epsini(elbuf_str, mat_param, jft, jlt, ismstr, mtn, ithk, pm, geo, ixtg, x, xreftg, for, thk, eint, gstr, nlay, px1g, py1g, py2g, x2s, x3s, y3s, uvar, ipm, nel, dir_a, dir_b, sigi, npf, tf, irep, ish3nfr, imat)
subroutine c3epschk(jft, jlt, nft, pm, geo, ixtg, gstr, thk, nel, cpt_eltens)
subroutine c3eps11_ini(jft, jlt, ixtg, x, x2s, x3s, y3s)
subroutine c3inmas(x, xreftg, ixtg, geo, pm, ms, tiner, thke, partsav, v, ipart, mstg, intg, ptg, igeo, imat, iprop, area, etnod, nshnod, sttg, sh3tree, mcp, mcptg, temp, sh3trim, isubstack, nlay, elbuf_str, stack, thki, rnoise, drape, perturb, ix1, ix2, ix3, nintemp, x2, x3, y3, idrape, indx)
subroutine c3veok3(nvc, ix1, ix2, ix3)
subroutine cbufxfe(elbuf_str, xfem_str, isubstack, stack, igeo, geo, lft, llt, mat, pid, npt, nptt, nlay, ir, is, ixfem, mtn, ng)
subroutine cdkevec3(jft, jlt, area, x1, x2, x3, y1, y2, y3, z1, z2, z3, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine cfailini(elbuf_str, mat_param, nptt, nlay, sigsh, nsigsh, ptsh, rnoise, perturb, aldt, thk)
subroutine cm27in3(elbuf_str, geo, igeo, pm, ipm, ix, nix, nlay, ir, is, imat)
subroutine cm35in3(elbuf_str, thk, area, nel, nlay, nptr, npts, nptt, igtyp)
subroutine cm58in3(irep, dir1, dir2, uparam, uvar, aldt, nel, nuvar, tan_phi, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine cmatini(elbuf_str, jft, jlt, nft, nel, npt, istrain, sigsh, numel, ix, nix, nsigsh, numsh, ptsh, ir, is, nlay)
subroutine corth3(elbuf_str, dir_a, dir_b, jft, jlt, nlay, irep, nel, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, idrape, igtyp)
subroutine corthdir(elbuf_str, igeo, geo, vx, vy, vz, phi1, phi2, coor1, coor2, coor3, coor4, iorthloc, nlay, irep, isubstack, stack, geo_stack, igeo_stack, ir, is, nel, imat, iprop, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, npt_all, idrape)
subroutine corthini(jft, jlt, nft, nlay, numel, nsigsh, nix, ix, igeo, geo, skew, sigsh, ptsh, phi1, phi2, vx, vy, vz, coor1, coor2, coor3, coor4, iorthloc, isubstack, stack, irep, elbuf_str, drape, angle, x, geo_stack, e3x, e3y, e3z, betaorth, x1, x2, y1, y2, z1, z2, nel, g_add_node, add_node, npt_all, idrape, indx)
subroutine csigini(elbuf_str, jft, jlt, nft, npt, istrain, thk, eint, gstr, hh, plas, for, mom, sigsh, nlay, g_hourg, numel, ix, nix, nsigsh, numsh, ptsh, igeo, thke, nel, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, isigsh, dir_a, dir_b, posly, igtyp)
subroutine cuserini(elbuf_str, jft, jlt, nft, nel, npt, istrain, sigsh, numel, ix, nix, nsigsh, numsh, ptsh, ir, is, nlay)
subroutine fail_brokmann(nel, nuparam, nuvar, time, timestep, uparam, ngl, signxx, signyy, signxy, uvar, off, ipt, nindxf, indxf, tdel)
subroutine fail_windshield_init(elbuf_str, mat_param, fail_brokmann, nel, nft, ity, igrsh4n, igrsh3n, aldt, thk, ngl)
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine law158_init(dir1, dir2, uvar, aldt, nel, nuvar, tan_phi, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine layini1(elbuf_str, jft, jlt, geo, igeo, mat, pid, matly, posly, igtyp, nlay, npt, isubstack, stack, drape, nft, thk, nel, idrape, numel_drape, indx)
integer, parameter nchartitle
subroutine c3evec3(jft, jlt, area, x1, x2, x3, y1, y2, y3, z1, z2, z3, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, x31, y31, z31, x2l, x3l, y3l)
subroutine thickini(jft, jlt, nft, ptsh, numel, thk, thke, ix, nix, nsigsh, sigsh)