130
131
132
133 USE timer_mod
137 USE mat_elem_mod
141 USE sensor_mod
142 USE elbufdef_mod
144 use glob_therm_mod
145 use dttherm_mod
146
147
148
149#include "implicit_f.inc"
150
151
152
153#include "mvsiz_p.inc"
154
155
156
157#include "scr14_c.inc"
158#include "scr18_c.inc"
159#include "parit_c.inc"
160#include "param_c.inc"
161#include "timeri_c.inc"
162#include "com04_c.inc"
163
164
165
166 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
167 INTEGER,INTENT(IN) :: USERL_AVAIL
168 INTEGER,INTENT(IN) :: MAXFUNC
169 INTEGER,INTENT(INOUT) :: IDEL7NOK
170 INTEGER,INTENT(IN) :: SBUFMAT
171 INTEGER,INTENT(IN) :: STF
172 INTEGER,INTENT(IN) :: SNPC
173 INTEGER, INTENT(IN) :: NXLAYMAX
174 INTEGER, INTENT(IN) :: IGRE,JTUR,NCYCLE
175 INTEGER JFT,JLT,NFT,NPT,MTN,IPRI,ITHK,NELTST,
176 . ITYPTST ,ISTRAIN,IPLA ,OFFSET,NVC,
177 . IOFC ,IHBE ,KFTS,ISMSTR,IFAILURE,
178 . IEXPAN, ISHPLYXFEM,ITASK,JTHE,IBID,JSMS,ISUBSTACK,NEL
179 INTEGER IXC(NIXC,*), IADC(4,*), IPARTC(*), NPF(*),IGEO(NPROPGI,*),
180 . IPM(*),INDXOF(MVSIZ),INOD_PXFEM(*),IEL_PXFEM(*),ITAB(*),
181 . IADC_PXFEM(4,*),GRTH(*),IGRTH(*),IPARG(*),IPARI(NPARI,*),
182 . INDX_DRAPE(SCDRAPE)
183
185 . f11(mvsiz), f12(mvsiz), f13(mvsiz), f14(mvsiz),
186 . f21(mvsiz), f22(mvsiz), f23(mvsiz), f24(mvsiz),
187 . f31(mvsiz), f32(mvsiz), f33(mvsiz), f34(mvsiz),
188 . m11(mvsiz), m12(mvsiz), m13(mvsiz), m14(mvsiz),
189 . m21(mvsiz), m22(mvsiz), m23(mvsiz), m24(mvsiz),
190 . m31(mvsiz), m32(mvsiz), m33(mvsiz), m34(mvsiz),
191 . tf(*), pm(npropm,*),geo(npropg,*),partsav(*),
192 . bufmat(*), x(3,*), d(*), dr(*),
193 . v(3,*),vr(3,*),f(3,*),m(3,*),stifn(*),
194 . stifr(*),fsky(*),tani(6,*),eani(*),thke(*),temp(*),
195 . fthe(*),fthesky(*),in(*),ms(*),ms_ply(*), zi_ply(*),
196 . gresav(*), msc(*), dmelc(*),msz2(*),
197 . condn(*),condnsky(*),
198 . fpinch(3,*),stifpinch(*),vpinch(3,*)
200 . tt, dt1, dt2t
201 TYPE(TTABLE) TABLE(*)
202 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
203 TYPE (STACK_PLY) :: STACK
204 TYPE (FAILWAVE_STR_) :: FAILWAVE
205 TYPE (GROUP_PARAM_) :: GROUP_PARAM
206 TYPE (NLOCAL_STR_), TARGET :: NLOC_DMG
207 TYPE (DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE)
208 TYPE (MAT_ELEM_),INTENT(INOUT) :: MAT_ELEM
209 TYPE (SENSORS_) ,INTENT(INOUT) :: SENSORS
210 TYPE (DT_) ,INTENT(IN) :: DT
211 type (glob_therm_) ,intent(inout) :: glob_therm
212
213
214
215 INTEGER
216 . I,II,J,JJ,JG,IR,IS,IT,IPT,NPTR,NPTS,NPTT,NLAY,MX,
217 . NPLAT,IDRIL,LENE,LENF,LENM,LENS,NNOD,N1,N2,N3,N4,
218 . NG,NPG,PT1,PT2,PT3,PT4,PTF,PTM,PTE,PTS,L_DIRA,L_DIRB,
219 . IPPID,JPID,IPTHK,IPPOS,IPMAT,IPMAT_IPLY,MATLY,IFAILWAVE,
220 . J1,J2,IIGEO,IADI ,IADR,IPANG,IGTYP,IGMAT,ILAY,NPTTOT,IREP,KK(5),K,
221 . LENFPINCH,LENMPINCH,LENEPINCHXZ,LENEPINCHYZ,LENEPINCHZZ,
222 . PTFP,PTMP,PTEPXZ,PTEPYZ,PTEPZZ,MT,NPINCH,IDRAPE,ACTIFXFEM,
223 . SEDRAPE,NUMEL_DRAPE
224 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),MAT_IPLY(MVSIZ,NPT),
225 . IPLAT(MVSIZ),ISTACK(MVSIZ,NPT),FWAVE_EL(NEL)
226 parameter(npg = 4)
227 parameter(nnod = 4)
229 . rxyz(mvsiz,2*nnod),
230 . vcore(mvsiz,3*nnod),vxyz(mvsiz,3*nnod),off(mvsiz),
231 . vqn(mvsiz,9*nnod),vqg(mvsiz,9*nnod),vnrm(mvsiz,3*nnod),
232 . bm(mvsiz,9*nnod),bmf(mvsiz,9*nnod),bf(mvsiz,6*nnod),
233 . bc(mvsiz,10*nnod),vq(mvsiz,9),vjfi(mvsiz,6,4),
234 . tc(mvsiz,4),jac(mvsiz,npg),hx(mvsiz,npg),hy(mvsiz,npg),
235 . veta(4,npg),vksi(4,npg),vf(mvsiz,12),vm(mvsiz,8),
236 . vastn(mvsiz,4*nnod),
area(mvsiz),
237 . lc(mvsiz),vdef(mvsiz,8),cdet(mvsiz),thk2(mvsiz),
238 . exx(mvsiz) ,eyy(mvsiz) ,exy(mvsiz) ,exz(mvsiz) ,eyz(mvsiz),
239 . kxx(mvsiz) ,kyy(mvsiz) ,kxy(mvsiz) ,sigy(mvsiz),
240 . dt1c(mvsiz),ssp(mvsiz) ,viscmx(mvsiz),rho(mvsiz) ,
241 . nu(mvsiz) ,g(mvsiz) ,a11(mvsiz) ,a12(mvsiz) ,vol0(mvsiz),
242 . thk0(mvsiz),sti(mvsiz) ,stir(mvsiz) ,shf(mvsiz) ,
243 . gs(mvsiz) ,alpe(mvsiz),ym(mvsiz) ,bid,zcfac(mvsiz,2),
244 . x13(mvsiz) ,y13(mvsiz), x24(mvsiz) ,amu(mvsiz),
245 . dd(mvsiz,6),volg(mvsiz),y24(mvsiz),facn(mvsiz,2),die(mvsiz),
246 . tempel(mvsiz),them(mvsiz,4),
247 . zl(mvsiz),ply_f(mvsiz,5, npt), ply_vxyz(mvsiz,3*nnod
248 . fly11(mvsiz, npt), fly21(mvsiz, npt), fly31(mvsiz, npt),
249 . fly12(mvsiz, npt), fly22(mvsiz, npt), fly32(mvsiz, npt),
250 . fly13(mvsiz, npt), fly23(mvsiz, npt), fly33(mvsiz, npt),
251 . fly14(mvsiz, npt), fly24(mvsiz, npt), fly34(mvsiz, npt),
252 . ply_exx(mvsiz,npt), ply_eyy(mvsiz,npt), ply_exy(mvsiz,npt),
253 . ply_ezx(mvsiz,npt), ply_eyz(mvsiz,npt), ply_fn(mvsiz,12,npt),
254 . thkly(mvsiz,npt),vol0_ly(mvsiz,npt),posly(mvsiz,npt),
255 . del_ply(mvsiz,12,npt),th_iply(mvsiz,npt),
256 . sig_iply(mvsiz,3,npt),vni(4,4),
257 . vfi(mvsiz,12,npt),delg_ply(mvsiz,3,npt),amom(mvsiz
258 . r11(mvsiz),r12(mvsiz),r13(mvsiz),
259 . r21(mvsiz),r22(mvsiz),r23(mvsiz),
260 . r31(mvsiz),r32(mvsiz),r33(mvsiz),
261 . a11_ply(mvsiz,npt),a11_iply(mvsiz,npt),sti_ply(mvsiz,npt),
262 . offi(mvsiz,npt),rlz(mvsiz,nnod),vrlz(mvsiz),
263 . bm0rz(mvsiz,4,nnod),bmkrz(mvsiz,4,nnod),bmerz(mvsiz,4,nnod),
264 . bmrz(mvsiz,3,nnod),brz(mvsiz,4,nnod),krz(mvsiz),
265 . vmz(mvsiz,nnod),ux1(mvsiz),ux2(mvsiz),ux3(mvsiz),ux4(mvsiz),
266 . uy1(mvsiz),uy2(mvsiz),uy3(mvsiz),uy4(mvsiz),
267 . conde(mvsiz),a11r(mvsiz),
268 . vl1(mvsiz,3),vl2(mvsiz,3),vl3(mvsiz,3),vl4(mvsiz,3),
269 . xl2(mvsiz),xl3(mvsiz),xl4(mvsiz),yl2(mvsiz),yl3(mvsiz),yl4(mvsiz),
270 . vdefpinch(mvsiz,3), vpinchxyz(mvsiz,nnod), bcp(mvsiz,2*nnod),
271 . bp(mvsiz,nnod), tnpg(mvsiz,nnod,npg), vfpinch(mvsiz,4), facp(mvsiz),
272 . e, anu, a11pinch
273 . vpincht1(mvsiz,nnod),vpincht2(mvsiz,nnod),dbetadxy(mvsiz,3),
274 . bpinchdamp(mvsiz,8),vfpinchdampx(mvsiz,4),vfpinchdampy(mvsiz,4),
275 . ezzavg(mvsiz),areapinch(mvsiz),zla(mvsiz)
276 INTEGER
277 . NPLATT,PTW ,LENW,PTT,IPOUT,IMAT
278 INTEGER IPLATT(MVSIZ)
280 . vcoret(mvsiz,3*nnod),bmt(mvsiz,9*nnod),vqgt(mvsiz,9*nnod),
281 . vjfit(mvsiz,6,4),jact(mvsiz
282 . areat(mvsiz),x13t(mvsiz
283 . bm0rzt(mvsiz,4,nnod),bmkrzt(mvsiz,4,nnod),bmerzt(mvsiz,4,nnod),
284 . bmrzt(mvsiz,4,nnod),f_def(mvsiz,8,npg),
285 . x1g(mvsiz), x2g(mvsiz), x3g(mvsiz), x4g(mvsiz),
286 . y1g(mvsiz), y2g(mvsiz), y3g(mvsiz), y4g(mvsiz),
287 . z1g(mvsiz), z2g(mvsiz), z3g(mvsiz), z4g(mvsiz),
288 . vrl1(mvsiz,3),vrl2(mvsiz,3),vrl3(mvsiz,3),vrl4(mvsiz,3),
289 . uxyz(mvsiz,12),axyz(mvsiz,4),wxy(mvsiz),xlcore(mvsiz,2*(nnod-1))
290 my_real ,
DIMENSION(NEL) :: zoffset
291
292 my_real,
dimension(mvsiz) :: fheat
293 my_real,
dimension(mvsiz) :: epsd_pg,epsd_glob
294 my_real :: dtinv,asrate,eps_m2,eps_k2
295
296
297 INTEGER, DIMENSION(NEL) :: OFFLY
298 my_real,
DIMENSION(:) ,
POINTER :: dir_a, dir_b,crkdir,dadv
299 my_real,
ALLOCATABLE,
DIMENSION(:) :: dir1_crk,dir2_crk,dira,dirb
301 . ezzpg(mvsiz,4)
302 TARGET :: dira,dirb
303 INTEGER :: NDDL, NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), NC4(MVSIZ),
304 . INLOC
306 . DIMENSION(:,:), ALLOCATABLE :: var_reg
307
308 TYPE(BUF_LAY_) ,POINTER :: BUFLY
309 TYPE() ,POINTER :: LBUF1,LBUF2,LBUF3,LBUF4
310 TYPE(G_BUFEL_) ,POINTER :: GBUF
311 TYPE(L_BUFEL_) ,POINTER :: LBUF
312 TYPE(L_BUFEL_DIR_) ,POINTER :: LBUF_DIR
313 TYPE(PINCH_LOCAL_STRUCT_) :: PINCH_LOCAL
314 INTEGER SDIR_A
315 INTEGER SDIR_B
316
317
318
319 istack = 0
320 gbuf => elbuf_str%GBUF
321 idrape = elbuf_str%IDRAPE
322 ibid = 0
323 bid = zero
324 idril = iparg(41)
325 irep = iparg(35)
326 inloc = iparg(78)
327 actifxfem = iparg(70)
328 npinch= iparg(90)
331 tempel(:) = zero
332 fheat(: ) = zero
333 imat = mat(1)
334
335
336 nlay = elbuf_str%NLAY
337 nptr = elbuf_str%NPTR
338 npts = elbuf_str%NPTS
339
340
341 DO j=1,5
342 kk(j) = nel*(j-1)
343 ENDDO
344
345
346 DO i=jft,jlt
347 mat(i) = ixc(1,i)
348 pid(i) = ixc(6,i)
349 ngl
350 ENDDO
351
352 npttot = 0
353 DO ilay=1,nlay
354 npttot = npttot + elbuf_str%BUFLY(ilay)%NPTT
355 ENDDO
356 IF (npt == 0) npttot = npt
357
358
359
360 nddl = npttot
361 ALLOCATE(var_reg(nel,nddl))
362
363
364
365
366
367 ifailwave = iparg(79)
368 IF (ifailwave > 0) THEN
369 fwave_el(:) = zero
370 offly(:) = elbuf_str%BUFLY(1)%OFF(:)
371 DO i=2,nlay
372 DO j=1,nel
373 offly(j) =
max(offly(j), elbuf_str%BUFLY(i)%OFF(j))
374 ENDDO
375 ENDDO
376 dadv => gbuf%DMG
378 . nel ,ixc ,itab ,ngl ,offly )
379 ENDIF
380
381 l_dira = elbuf_str%BUFLY(1)%LY_DIRA
382 l_dirb = elbuf_str%BUFLY(1)%LY_DIRB
383 igtyp = igeo(11,pid(1))
384 IF(idrape > 0 .AND. (igtyp == 51 .OR. igtyp == 52)) THEN
385 ALLOCATE(dira(npttot*nel*l_dira))
386 ALLOCATE(dirb(npttot*nel*l_dirb))
387 dira = zero
388 dirb = zero
389 IF (l_dira == 0) THEN
390 CONTINUE
391 ELSEIF (irep == 0) THEN
392 npttot = 0
393 DO ilay=1,nlay
394 nptt = elbuf_str%BUFLY(ilay)%NPTT
395 DO it=1,nptt
396 j = npttot + it
397 lbuf_dir => elbuf_str%BUFLY(ilay)%LBUF_DIR(it)
398 j1 = 1+(j-1)*l_dira*nel
399 j2 = j*l_dira*nel
400 dira(j1:j2) = lbuf_dir%DIRA(1:nel*l_dira)
401 ENDDO
402 npttot = npttot + nptt
403 ENDDO
404 ENDIF
405 sdir_a = npttot*nel*l_dira
406 sdir_b = npttot*nel*l_dirb
407 dir_a => dira(1:npttot*nel*l_dira)
408 dir_b => dirb(1:npttot*nel*l_dirb)
409 ELSE
410 sdir_a=nlay*nel*l_dira
411 sdir_b=nlay*nel*l_dirb
412 ALLOCATE(dira(nlay*nel*l_dira))
413 ALLOCATE(dirb(nlay*nel*l_dirb))
414 dira=zero
415 dirb=zero
416 IF (l_dira == 0) THEN
417 CONTINUE
418 ELSEIF (irep == 0) THEN
419 DO j=1,nlay
420 j1 = 1+(j-1)*l_dira*nel
421 j2 = j*l_dira*nel
422 dira(j1:j2) = elbuf_str%BUFLY(j)%DIRA(1:nel*l_dira)
423 ENDDO
424 ENDIF
425 sdir_a=nlay*nel*l_dira
426 sdir_b=nlay*nel*l_dirb
427 dir_a => dira(1:nlay*nel*l_dira)
428 dir_b => dirb(1:nlay*nel*l_dirb)
429 ENDIF
430
431 ALLOCATE(dir1_crk(0))
432 ALLOCATE(dir2_crk(0))
433
434 DO i=jft,jlt
435 DO j=1,8
436 vm(i,j) = zero
437 ENDDO
438 DO j=1,12
439 vf(i,j) = zero
440 ENDDO
441 DO j=1,4
442 vfpinch(i,j) = zero
443 ezzpg(i,j) = zero
444 vfpinchdampx(i,j) = zero
445 vfpinchdampy(i,j) = zero
446 ENDDO
447 alpe(i) = one
448 a11r(i) = zero
449 ENDDO
450
451
452
453 igtyp = igeo(11,ixc(6,1))
454 igmat = igeo(98 ,ixc(6,1))
455
456
457 DO i=jft,jlt
458 them(i,1) = zero
459 them(i,2) = zero
460 them(i,3) = zero
461 them(i,4) = zero
462 ENDDO
463
464 IF(npinch > 0) THEN
465 ALLOCATE(pinch_local%EPINCHXZ(mvsiz))
466 ALLOCATE(pinch_local%EPINCHYZ(mvsiz))
467 ALLOCATE(pinch_local%EPINCHZZ(mvsiz))
468 ENDIF
469
470
471
472
473 CALL cbacoor(elbuf_str ,jft,jlt,x,v,
474 . vr,ixc,pm,gbuf%OFF,lc,
475 1
area,vxyz, rxyz,vcore,jac,hx,hy,vksi,veta,
476 2 vqn,vqg,vq,vjfi,vnrm,vastn,nplat,iplat,
477 3 x13 ,x24 ,y13,y24,off, dd,nlay,
478 4 irep,npttot,ismstr,nel ,idril ,
479 5 gbuf%SMSTR,dir_a,dir_b,facn,zl,
480 6 r11 ,r12 ,r13 ,r21 ,r22 ,r23 ,
481 7 r31 ,r32 ,r33 ,inod_pxfem ,rlz ,
482 8 thke ,ishplyxfem ,ux1 ,ux2 ,ux3 ,
483 9 ux4 ,uy1 ,uy2 ,uy3 ,uy4 ,
484 a vl1 ,vl2 ,vl3 ,vl4 ,xl2 ,
485 b xl3 ,xl4 ,yl2 ,yl3 ,yl4 ,xlcore,npinch)
486
487 CALL cncoef3(jft ,jlt ,pm ,mat ,geo ,
488 2 pid ,off ,
area ,shf ,thk0 ,
489 3 thk2 ,nu ,g ,ym ,
490 4 a11 ,a12 ,gbuf%THK,thke ,ssp ,
491 5 rho ,volg ,gs ,mtn ,ithk ,
492 6 npttot ,dt1c ,dt1 ,ihbe ,amu ,
493 7 krz ,igeo ,a11r ,isubstack, stack%PM,
494 8 nel ,zoffset)
495
496 IF(npinch > 0) THEN
498 1 tnpg ,vpinchxyz ,vpinch ,
499 2 vq ,vqn ,ixc ,jft ,jlt ,
500 3 nplat ,iplat ,gbuf%THK ,dt1c ,
501 4 facp ,lc ,
502 5 vpincht1,vpincht2)
503
504 DO i=jft,jlt
505 ezzavg(i) = fourth*(vpinchxyz(i,1)+vpinchxyz(i,2)+vpinchxyz(i,3)+vpinchxyz(i,4))*dt1c(i)
506 areapinch(i) =
area(i)
507 ENDDO
508 ENDIF
509
510 IF(ishplyxfem > 0) THEN
511 DO j=1,npt
512 DO i=jft,jlt
513 ply_fn(i,1:12,j) = zero
514 vfi(i,1:12,j) = zero
515 offi(i,j) = one
516 ENDDO
517 ENDDO
518 ippid = 2
519 ipmat = ippid + npt
520 ipmat_iply = ipmat + npt
521 ipang = 1
522 ipthk = ipang + npt
523 ippos = ipthk + npt
524 DO j=1,npt
525 DO i=jft,jlt
526 thkly(i,j) = stack%GEO(ipthk + j ,isubstack)*thk0(i)
527 matly = stack%IGEO(ipmat + j ,isubstack)
528 jpid = stack%IGEO(ippid + j, isubstack)
529 istack(i,j) = igeo(102 ,jpid)
530 posly(i,j) = stack%GEO(ippos + j ,isubstack)*thk0(i)
531 a11_ply(i,j) = pm(24,matly)
532 ENDDO
533 ENDDO
534 DO j=1,npt -1
535 DO i=jft,jlt
536 th_iply(i,j) = half*(thkly(i,j) + thkly(i,j +1 ))
537 mat_iply(i,j) = stack%IGEO(ipmat_iply + j ,isubstack)
538 ENDDO
539 ENDDO
540
541 CALL cbavit_ply(jft,jlt,ixc,gbuf%OFF,off,nplat,iplat,npt,
542 1 vcore,dd,zl,vq , ply_vxyz,x13 ,x24 ,
543 2 y13,y24,
area ,inod_pxfem ,del_ply,vni,istack,vr)
544
545 ENDIF
546
547 IF (idril > 0) THEN
549 2 y13 ,y24 ,bm0rz,bmkrz,bmerz,
550 3 vcore,nplat,iplat
551 DO i=jft,jlt
552 DO j=1,4
553 vmz(i,j) = zero
554 ENDDO
555 END DO
556 ELSE
557
558 CALL cbadefsh(jft,jlt,x13,x24,y13,y24,bm,vdef,vxyz,nplat,iplat)
560 . vdef ,gbuf%FOR ,gbuf%EINT ,dt1 ,nel )
561 END IF
562
563 IF(ishplyxfem > 0)
564 .
CALL cbadefsh_ply(jft,jlt,npt,nplat,iplat,x13,x24,y13,y24,
565 . ply_vxyz,dt1c ,ply_exy)
566
567 lenf = nel*gbuf%G_FORPG/npg
568 lenm = nel*gbuf%G_MOMPG/npg
569
570 IF (npinch > 0) THEN
571 lenfpinch = nel*gbuf%G_FORPGPINCH/npg
572 lenmpinch = nel*gbuf%G_MOMPGPINCH/npg
573 lenepinchxz = nel*gbuf%G_EPGPINCHXZ/npg
574 lenepinchyz = nel*gbuf%G_EPGPINCHYZ/npg
575 lenepinchzz = nel*gbuf%G_EPGPINCHZZ/npg
576 ENDIF
577
578 lens = nel*gbuf%G_STRPG/npg
579 lenw = nel*gbuf%G_STRWPG/npg
580
581 IF (ismstr == 10 ) THEN
582
583 CALL cbacoort(elbuf_str,jft,jlt,x,v,
584 . vr,dr,ixc,pm,gbuf%OFF,areat,
585 1 uxyz, axyz,vcoret,jact,hxt,
586 2 hyt,vq,vqgt,vjfit,nplatt,iplatt,
587 3 x13t ,x24t ,y13t,y24t,npttot ,
588 4 gbuf%SMSTR , idril ,xlcore,zl,vqn,nel)
589
590 IF (idril > 0) THEN
591 CALL cbaderirz(jft ,jlt ,areat,x13t,x24t ,
592 2 y13t ,y24t ,bm0rzt,bmkrzt,bmerzt,
593 3 vcoret,nplatt,iplatt,ismstr)
594
595 END IF
596
597
598 DO is = 1,npts
599 DO ir = 1,nptr
600 ng = nptr
601 ptf = (ng-1)*lenf+1
602 ptm = (ng-1)*lenm+1
603 pts = (ng-1)*lens+1
604
605 DO i=jft,jlt
606 cdet(i) = jact(i,ng)
607 vol0(i) = thk0(i)*cdet(i)
608 ENDDO
609
610
611
612 IF (idril > 0) THEN
613 CALL cbaderirzt(jft,jlt,ng,bm0rzt,bmkrzt,bmerzt,bmrzt)
614 END IF
615
616 IF (npttot == 1) THEN
617 CALL cbadeft1(jft,jlt,ng,vcoret,uxyz,f_def(1,1,ng),
618 1 hxt,hyt,bmt,nplatt,iplatt,idril,
619 2 bmrzt,axyz,wxy )
620 ELSE
621 CALL cbaderit1(jft,jlt,ng,vcoret,vqgt,vjfit,
622 2 hxt,hyt,veta,vksi,bmt,nplatt,iplatt,
623 3 idril)
624 CALL cbadeft(jft,jlt,uxyz,axyz,f_def(1,1,ng),
625 2 bmt,nplatt,iplatt,idril,bmrzt )
626 END IF
627
628 ENDDO
629 ENDDO
630 END IF
631
632 IF (npttot == 1 .AND. mtn==58) THEN
633 zla(jft:jlt)= zl(jft:jlt)*zl(jft:jlt)/
area(jft:jlt)
634 CALL cbal58warp(elbuf_str,nel,x,ixc,r13,r23,r33,gbuf%OFF,zla )
635 END IF
636
637
638
639 epsd_glob(1:nel) = zero
640
641 DO is = 1,npts
642 DO ir = 1,nptr
643 ng = nptr*(is-1) + ir
644 ptf = (ng-1)*lenf+1
645 ptm = (ng-1)*lenm+1
646 pts = (ng-1)*lens+1
647 ptw = (ng-1)*lenw+1
648 ptt = (ng-1)*nel + 1
649
650 DO i=jft,jlt
651 cdet(i) = jac(i,ng)
652 vol0(i) = thk0(i)*cdet(i)
653 ENDDO
654 IF(ishplyxfem > 0) THEN
655 DO j=1,npt
656 DO i=jft,jlt
657 offi(i,j) = one
658 ENDDO
659 ENDDO
660 ENDIF
661
662
663
664 IF (npttot == 1) THEN
665 CALL cbadef1(jft,jlt,ng,vcore,vxyz,vdef,
666 1 hx,hy,bm,nplat,iplat,idril)
667
668 ELSE
669 CALL cbadef(jft,jlt,ng,vcore,
area,cdet,vqn,vqg,vjfi,
670 1 vxyz,rxyz,vdef,vnrm,vastn,
671 2 hx,hy,veta,vksi,bm,bmf,bf,bc,tc,nplat,iplat,
672 3 idril,brz )
673 IF (ismstr == 10 )
675 2 bm,bmf,bf,nplat,iplat,
676 3 wxy )
677 END IF
678 IF (idril > 0) THEN
680 1 vxyz ,bm0rz,bmkrz,bmerz ,vrlz ,
681 2 bmrz ,brz ,bm ,nplat ,iplat,
682 3 ng )
683 END IF
684
685 IF (npinch > 0) THEN
687 1 jft ,jlt ,ng ,vqg ,vdef ,
688 2 veta ,vksi ,tc ,nplat ,iplat ,
689 3 bcp ,bp ,vpinchxyz ,vdefpinch ,tnpg,
690 4 dbetadxy ,vpincht1 ,vpincht2 ,bpinchdamp)
691 ENDIF
692
693
694
695
696 CALL cbastra3(gbuf%STRA,gbuf%STRPG(pts),
697 1 jft, jlt, nft, npg,vdef,
698 2 exx, eyy, exy, exz, eyz,
699 3 kxx, kyy, kxy, dt1c, tani,
700 4 iepsdot, istrain,ux1 ,ux2 ,ux3 ,
701 6 ux4 ,uy1 ,uy2 ,uy3 ,uy4 ,
702 7 x13, x24, y13, y24, bm ,
703 8 ismstr ,mtn ,nplat,iplat,idril,
704 9 wxy ,f_def(1,1,ng),gbuf%STRWPG(ptw),nel)
705
706 IF (idril == 0) THEN
707 CALL cbaener(gbuf%FORPG(ptf),gbuf%EINT,jft ,jlt ,off ,
708 . vol0 ,exy ,nel )
709 ENDIF
710
711 IF (ishplyxfem > 0 ) THEN
712 DO j=1,npt
713 jg = (ng - 1)*3
714 DO i=jft,jlt
715 delg_ply(i,1,j) = del_ply(i,1 + jg ,j)
716 delg_ply(i,2,j) = del_ply(i,2 + jg ,j)
717 delg_ply(i,3,j) = del_ply(i,3 + jg ,j)
718 ENDDO
719 ENDDO
720
721 CALL cbadef_ply(jft,jlt,ng,npt,nplat,iplat, vqg,
722 . ply_vxyz,veta,vksi,bm,bc,tc,dt1c,
723 . ply_exx, ply_eyy, ply_eyz, ply_ezx )
724 ENDIF
725
726 IF(npinch > 0) THEN
727
728 ng = nptr*(is-1) + ir
729 ptfp = (ng-1)*lenfpinch + 1
730 ptmp = (ng-1)*lenmpinch + 1
731 ptepxz = (ng-1)*lenepinchxz + 1
732 ptepyz = (ng-1)*lenepinchyz + 1
733 ptepzz = (ng-1)*lenepinchzz + 1
734
736 1 jft ,jlt ,nplat ,iplat ,
737 2 vdefpinch ,pinch_local%EPINCHXZ
738 3 pinch_local%EPINCHYZ ,pinch_local%EPINCHZZ,
739 4 dt1c ,ng ,ezzpg ,
740 5 gbuf%EPGPINCHXZ(ptepxz),
741 6 gbuf%EPGPINCHYZ(ptepyz),
742 7 gbuf%EPGPINCHZZ(ptepzz) )
743
744 ENDIF
745
746! global element strain rate(shell energy equivalent) - by gauss points
747
748
749
750
751
752 dtinv = dt1 /
max(dt1**2,em20)
753#include "vectorize.inc"
754 do i = 1,nel
755 eps_k2 = (kxx(i)**2+kyy(i)**2+kxx(i
756 . * one_over_9*gbuf%thk(i)**2
757 eps_m2 = four_over_3*(exx(i)**2+eyy(i)**2+exx(i)*eyy(i) + fourth*exy(i)**2)
758 epsd_pg(i) = sqrt(eps_k2 + eps_m2)*dtinv
759 epsd_glob(i) = epsd_glob(i) + epsd_pg(i) / npg
760 end do
761
762 IF (jthe > 0 ) THEN
763 CALL cbatempel(jft ,jlt ,ng ,ixc ,temp ,tempel)
764 ENDIF
765
766 IF (inloc>0) THEN
767 CALL cbavarnl(jft ,jlt ,ng ,ixc ,nloc_dmg ,
768 . var_reg ,nddl ,nc1 ,nc2 ,nc3
769 . nc4 ,nel )
770 ENDIF
771
772
773
774 IF ((itask==0).AND.(imon_mat
CALL startime(timers
775
776 IF (npinch > 0) THEN
778 1 elbuf_str ,jft ,jlt ,nft ,iparg ,
779 2 nel ,mtn ,ipla ,ithk ,group_param,
780 3 pm ,geo ,npf ,tf ,bufmat ,
781 4 ssp ,rho ,viscmx ,dt1c ,sigy ,
782 5 cdet ,exx ,eyy ,exy ,exz ,
783 6 eyz ,kxx ,kyy ,kxy ,nu ,
784 7 off ,thk0 ,mat ,pid ,
785 8 gbuf%FORPG(ptf),gbuf%MOMPG(ptm) ,gbuf%STRPG(pts),failwave,fwave_el,
786 9 gbuf%THK ,gbuf%EINT ,iofc
787 a g ,a11 ,a12 ,vol0 ,indxof ,
788 b ngl ,zcfac ,shf ,gs ,epsd_pg ,
789 c kfts ,ihbe ,alpe ,
790 d dir_a ,dir_b ,igeo ,
791 e ipm ,ifailure ,npg ,
792 f tempel ,die ,jthe ,iexpan ,gbuf%TEMPG(ptt) ,
793 g ishplyxfem,ply_exx ,
794 h ply_eyy ,ply_exy ,ply_ezx ,ply_eyz ,ply_f ,
795 i delg_ply ,th_iply ,sig_iply ,r11 ,r12 ,
796 j r13 ,r21 ,r22 ,r23 ,r31 ,
797 k r32 ,r33 ,ng ,table ,ibid ,
798 l offi ,a11_iply ,ibid ,
799 m dir1_crk ,dir2_crk ,lc ,
800 n ismstr ,ir ,is ,nlay ,npt ,
801 o ibid ,ibid ,isubstack ,stack ,
802 p f_def(1,1,ng),itask ,drape_sh4n ,var_reg(1,1),
803 q pinch_local , gbuf%FORPGPINCH(ptfp), gbuf%MOMPGPINCH(ptmp),ezzavg ,
804 r areapinch )
805 ELSE
807 1 elbuf_str ,jft ,jlt ,nft ,iparg ,
808 2 nel ,mtn ,ipla ,ithk ,group_param,
809 3 pm ,geo ,npf ,tf ,bufmat ,
810 4 ssp ,rho ,viscmx ,dt1c ,sigy ,
811 5 cdet ,exx ,eyy ,exy ,exz ,
812 6 eyz ,kxx ,kyy ,kxy ,nu ,
813 7 off ,thk0 ,mat ,pid ,mat_elem ,
814 8 gbuf%FORPG(ptf),gbuf%MOMPG(ptm) ,gbuf%STRPG(pts),failwave,fwave_el,
815 9 gbuf%THK ,gbuf%EINT ,iofc ,
816 a g ,a11 ,a12 ,vol0 ,indxof ,
817 b ngl ,zcfac ,shf ,gs ,epsd_pg ,
818 c kfts ,ihbe ,alpe ,
819 d dir_a ,dir_b ,igeo ,
820 e ipm ,ifailure ,npg ,fheat ,
821 f tempel ,die ,jthe ,iexpan ,gbuf%TEMPG(ptt) ,
822 g ishplyxfem,ply_exx ,
823 h ply_eyy ,ply_exy ,ply_ezx ,ply_eyz ,ply_f ,
824 i delg_ply ,th_iply ,sig_iply ,r11 ,r12 ,
825 j r13 ,r21 ,r22 ,r23 ,r31 ,
826 k r32 ,r33 ,ng ,table ,ibid ,
827 l offi ,sensors ,a11_iply ,ibid ,
828 m dir1_crk ,dir2_crk ,lc ,glob_therm%IDT_THERM ,glob_therm%THEACCFACT,
829 n ismstr ,ir ,is ,nlay ,npt ,
830 o ibid ,ibid ,isubstack ,stack ,
831 p f_def(1,1,ng),itask ,drape_sh4n,var_reg(1,1),nloc_dmg ,
832 r indx_drape ,thke ,sedrape ,numel_drape ,dt ,
833 q ncycle ,snpc ,stf ,nxlaymax, idel7nok ,
834 s userl_avail ,maxfunc ,npttot ,sbufmat, sdir_a ,
835 t sdir_b ,gbuf%FORPG_G(ptf))
836 ENDIF
837
838 IF ((itask==0).AND.(imon_mat == 1))
CALL stoptime(timers,35)
839
840 IF (idril == 0) THEN
841 CALL cbaener(gbuf%FORPG(ptf),gbuf%EINT,jft ,jlt ,off ,
842 . vol0 ,exy ,nel )
843 ENDIF
844
845
846
847 IF(npinch == 0) THEN
848 IF (ithk > 0) THEN
849 DO i=jft,jlt
850 gbuf%THK(i) = gbuf%THK(i) - three_over_4*(gbuf%THK(i)-thk0(i))
851 thk0(i) = gbuf%THK(i)
852 ENDDO
853 ENDIF
854 ENDIF
855
856
857
858 CALL cbavisc(jft ,jlt ,vdef ,amu ,off ,
859 2 shf ,nu ,rho ,ssp ,cdet,
860 3 thk0 ,gbuf%FORPG(ptf),gbuf%MOMPG(ptm),npttot,mtn ,
861 4 ipartc ,partsav ,dt1 ,nel )
862
863
864
865 IF (npttot == 1) THEN
866 CALL cbafori1(jft ,jlt ,gbuf%FORPG(ptf),bm ,vf ,
867 . nplat ,iplat ,vol0 ,nel )
868 ELSE
869 CALL cbafori(jft ,jlt ,ng ,cdet ,thk0,
870 2 thk2 ,gbuf%FORPG(ptf),gbuf%MOMPG(ptm),nel ,bm ,
871 3 bmf ,bf ,bc ,tc ,vf ,
872 4 vm ,nplat ,iplat ,vol0 )
873 END IF
874
875 IF (idril > 0) THEN
876 CALL cbaforrz(jft ,jlt ,vol0 ,gbuf%FORPG(ptf),gbuf%HOURG,
877 2 vf ,vmz ,bm ,bmrz ,brz ,
878 3 krz ,vrlz ,gbuf%EINT,off ,dt1c ,
879 4 nplat,iplat,ng ,nel)
880 END IF
881
882 IF (ishplyxfem > 0)
883 .
CALL cbafint_ply(jft,jlt,npt,ng,nplat,iplat,cdet,thkly,thk2,
884 1 vol0, ply_f,bm,bc,tc,sig_iply,vni,
area,
885 2 ply_fn ,vfi,ixc)
886
887 IF (npinch > 0) THEN
889 1 jft ,jlt ,ng ,nel ,nplat ,iplat ,
890 2 cdet ,thk0 ,thk2 ,vol0 ,
891 3 gbuf%FORPGPINCH(ptfp) , gbuf%MOMPGPINCH(ptmp),
892 4 bcp ,bp ,vfpinch ,dbetadxy,
893 5 rho ,lc ,ssp ,bpinchdamp,
894 6 vfpinchdampx ,vfpinchdampy)
895 ENDIF
896
897
898
899
900 IF (jthe /= 0) THEN
901 IF (mat_elem%MAT_PARAM(mat(1))%HEAT_FLAG == 1) THEN
902 CALL cbatherm(jft ,jlt ,pm(1,mat(1)) ,thk0 ,ixc ,
903 . bm ,
area ,dt1c(1) ,temp ,tempel,fheat ,
904 . nplat ,iplat,them ,glob_therm%THEACCFACT)
905 ELSE
906 CALL cbatherm(jft ,jlt ,pm(1,mat(1)) ,thk0 ,ixc ,
907 . bm ,
area ,dt1c(1) ,temp ,tempel,die ,
908 . nplat ,iplat,them ,glob_therm%THEACCFACT)
909 END IF
910 ENDIF
911
912
913
914 IF (inloc > 0) THEN
916 1 nloc_dmg, var_reg(1,1), thk0, nel,
917 2 gbuf%OFF,
area, nc1, nc2
918 3 nc3, nc4, elbuf_str%NLOC(ir,is), ixc(1,jft),
919 4 nddl, itask, ng, jft,
920 5 jlt, x13, y13, x24,
921 6 y24, dt2t, gbuf%THK_I, gbuf%AREA,
922 7 nft)
923 ENDIF
924 ENDDO
925 ENDDO
926
927
928
929
930
931 asrate = one
932 gbuf%epsd(1:nel) = asrate * epsd_glob(1:nel) + (one - asrate) * gbuf%epsd(1:nel)
933
934
935 IF (npinch > 0) THEN
937 1 jft ,jlt ,nplat ,iplat ,
938 2 dt1c ,gbuf%THK ,thk0 ,ezzpg)
939 ENDIF
940
941
942
943
944
945
946
947
948 pt1 = 0
949 pt2 = pt1 + lenf
950 pt3 = pt2 + lenf
951 pt4 = pt3 + lenf
952 DO i=jft,jlt
953 DO j=1,5
954 gbuf%FOR(kk(j)+i) = fourth*(gbuf%FORPG(pt1+kk(j)+i)
955 . + gbuf%FORPG(pt2+kk(j)+i)
956 . + gbuf%FORPG(pt3+kk(j)+i)
957 . + gbuf%FORPG(pt4+kk(j)+i))
958 ENDDO
959 ENDDO
960
961 pt2 = pt1 + lenm
962 pt3 = pt2 + lenm
963 pt4 = pt3 + lenm
964 DO i=jft,jlt
965 DO j=1,3
966 gbuf%MOM(kk(j)+i) = fourth*(gbuf%MOMPG(pt1+kk(j)+i)
967 . + gbuf%MOMPG(pt2+kk(j)+i)
968 . + gbuf%MOMPG(pt3+kk(j)+i)
969 . + gbuf%MOMPG(pt4+kk(j)+i))
970 ENDDO
971 ENDDO
972
973
974 IF (idril == 0) THEN
975 CALL cbaforct(jft ,jlt ,volg ,x13 ,x24 ,
976 2 y13 ,y24 ,gbuf%FOR,vf ,nplat,
977 3 iplat ,off ,nel )
978
980 . vdef ,gbuf%FOR ,gbuf%EINT ,dt1 ,nel )
981 END IF
982
983 IF (npttot == 1) THEN
985 2 amu, off,rho ,ssp ,
area,thk0 ,
986 3 g ,dt1 ,vf ,
987 4 ipartc,partsav,kfts)
988 ENDIF
989
990
991
993 1 jft ,jlt ,vqn ,vq ,vf ,
994 2 vm ,nplat ,iplat ,
995 3 f11 ,f12 ,f13 ,f14 ,f21 ,
996 4 f22 ,f23 ,f24 ,f31 ,f32 ,
997 5 f33 ,f34 ,m11 ,m12 ,m13 ,
998 6 m14 ,m21 ,m22 ,m23 ,m24 ,
999 7 m31 ,m32 ,m33 ,m34 ,vcore ,
1000 8 dd ,vmz ,idril ,off )
1002 1 jft ,jlt ,npt ,nplat ,iplat ,vqn,
1003 2 vq ,ply_fn ,vfi ,vcore ,dd ,
1004 6 fly11 ,fly12 ,fly13 ,fly14 ,fly21 ,
1005 7 fly22 ,fly23 ,fly24 ,fly31 ,fly32 ,
1006 8 fly33 ,fly34 ,off)
1007 IF (npinch > 0) THEN
1009 1 jft ,jlt ,vqn ,vq ,vfpinch,
1010 2 nplat ,iplat ,fp ,vcore ,dd ,thk0,
1011 3 vfpinchdampx,vfpinchdampy)
1012 ENDIF
1013
1014
1015
1016 ipout=2
1017 IF(ipri == 1)
1019 1 jft, jlt, pm, v,
1020 2 ixc, gbuf%THK, gbuf%EINT, partsav,
1021 3
area, mat, ipartc, x,
1022 4 vr, bid, bid, bid,
1023 5 thk2, ipout, off, nft,
1024 6 gresav, grth, igrth, vl1,
1025 7 vl2, vl3, vl4, vrl1,
1026 8 vrl2, vrl3, vrl4, x1g,
1027 9 x2g, x3g, x4g, y1g,
1028 a y2g, y3g, y4g, z1g,
1029 b z2g, z3g, z4g, ibid,
1030 c iexpan, gbuf%EINTTH,itask, gbuf%VOL,
1031 d actifxfem, igre, sensors, nel,
1032 e gbuf%G_WPLA, gbuf%WPLA )
1033
1034
1035
1036 IF(npinch > 0) THEN
1037
1038 IF(mtn == 1) THEN
1039 mx = mat(jft)
1040 e = pm(20,mx)
1041 anu = pm(21,mx)
1042 a11pinch = e / (one-two*anu)
1043 ELSEIF(mtn == 91) THEN
1044 mx = mat(jft)
1045 e = pm(20,mx)
1046 anu = pm(21,mx)
1047 a11pinch = e / (one-two*anu)
1048 ENDIF
1049
1051 1 jft ,jlt ,off , dt2t ,amu ,
1052 2 neltst ,ityptst,sti , stir ,gbuf%OFF,
1053 3 ssp ,viscmx ,rho , volg ,thk0,thk2,
1054 4 a11 ,lc ,alpe , ngl ,ismstr,
1055 5 iofc ,nnod ,
area , g ,shf ,
1056 6 msc ,dmelc ,jsms , bid ,igtyp ,
1057 7 igmat ,a11r ,gbuf%G_DT, gbuf%DT, a11pinch)
1058
1059 ELSE
1060
1062 1 jft ,jlt ,off , dt2t ,amu ,
1063 2 neltst ,ityptst,sti , stir ,gbuf%OFF,
1064 3 ssp ,viscmx ,rho , volg ,thk0,thk2,
1065 4 a11 ,lc ,alpe , ngl ,ismstr,
1066 5 iofc ,nnod ,
area , g ,shf ,
1067 6 msc ,dmelc ,jsms , bid ,igtyp ,
1068 7 igmat ,a11r ,gbuf%G_DT, gbuf%DT,mtn ,
1069 8 pm ,mat(jft) , nel ,zoffset)
1070
1071 ENDIF
1072
1073
1074
1075 IF (jthe > 0.AND. glob_therm%IDT_THERM == 1)THEN
1076 call dttherm(nel ,pm(1,mat(1)) ,npropm ,glob_therm ,
1077 . jtur ,tempel ,vol0 ,rho ,
1078 . lc ,off ,conde ,gbuf%re ,gbuf%rk )
1079 ENDIF
1080
1081 IF(ishplyxfem > 0) THEN
1083 . jft ,jlt ,npt,off , lc ,
area ,thkly,
1084 . th_iply ,a11_ply ,a11_iply,sti_ply , offi,viscmx)
1085 ENDIF
1086
1087
1088
1089 IF (inloc > 0) THEN
1090 CALL dtcba_reg(nloc_dmg,thk0 ,nel ,gbuf%OFF,
1091 . lc ,ixc(1,jft) ,nddl ,dt2t )
1092 ENDIF
1093
1094
1095
1096 IF(iparit == 3)THEN
1097 CALL cupdt3f(jft ,jlt ,f ,m ,nvc ,
1098 2 gbuf%OFF,off ,sti ,stir,stifn,
1099 3 stifr ,ixc ,pm ,
area ,gbuf%THK,
1100 4 f11 ,f12 ,f13 ,f14 ,f21 ,
1101 5 f22 ,f23 ,f24 ,f31 ,f32 ,
1102 6 f33 ,f34 ,m11 ,m12 ,m13 ,
1103 7 m14 ,m21 ,m22 ,m23 ,m24 ,
1104 8 m31 ,m32 ,m33 ,m34 ,gbuf%EINT,
1105 9 partsav,mat ,ipartc,glob_therm%NODADT_THERM)
1106 ELSEIF(iparit == 0)THEN
1107 CALL cupdtn3(jft ,jlt ,f ,m ,nvc ,
1108 2 gbuf%OFF,off ,sti ,stir,stifn,
1109 3 stifr ,ixc ,pm ,
area ,gbuf%THK,
1110 4 f11 ,f12 ,f13 ,f14 ,f21 ,
1111 5 f22 ,f23 ,f24 ,f31 ,f32 ,
1112 6 f33 ,f34 ,m11 ,m12 ,m13 ,
1113 7 m14 ,m21 ,m22 ,m23 ,m24 ,
1114 8 m31 ,m32 ,m33 ,m34 ,gbuf%EINT,
1115 a partsav,mat ,ipartc ,facn ,jthe,
1116 b them , fthe ,condn ,conde,glob_therm%NODADT_THERM)
1117
1118 IF(npinch > 0) THEN
1120 1 jft ,jlt ,nvc ,ixc ,
1121 2 fp ,fpinch ,sti ,stifpinch ,facp )
1122 ENDIF
1123
1124 ELSE
1125 CALL cupdtn3p(jft ,jlt ,gbuf%OFF,off ,sti,
1126 2 stir ,fsky ,fsky ,iadc ,
1127 4 f11 ,f12 ,f13 ,f14 ,f21,
1128 5 f22 ,f23 ,f24 ,f31 ,f32,
1129 6 f33 ,f34 ,m11 ,m12 ,m13,
1130 7 m14 ,m21 ,m22 ,m23 ,m24,
1131 8 m31 ,m32 ,m33 ,m34 ,ixc,
1132 a gbuf%EINT,partsav,mat,ipartc,pm ,
1133 b
area ,gbuf%THK,facn ,jthe,them ,
1134 c fthesky,condnsky,conde,glob_therm%NODADT_THERM )
1135 ENDIF
1136
1137 IF(ishplyxfem > 0) THEN
1139 1 jft, jlt, nvc, gbuf%OFF,
1140 2 off, iadc_pxfem,iel_pxfem, inod_pxfem,
1141 3 ixc, ms, in, ms_ply,
1142 4 zi_ply, istack, posly, fly11,
1143 5 fly12, fly13, fly14, fly21,
1144 6 fly22, fly23, fly24, fly31,
1145 7 fly32, fly33, fly34, facn,
1146 8 sti_ply, msz2, nft, npt)
1147 ENDIF
1148
1149 IF (ALLOCATED(dirb)) DEALLOCATE(dirb)
1150 IF (ALLOCATED(dira)) DEALLOCATE(dira)
1151 IF (ALLOCATED(var_reg)) DEALLOCATE(var_reg)
1152
1153 IF(npinch > 0) THEN
1154 DEALLOCATE(pinch_local%EPINCHXZ)
1155 DEALLOCATE(pinch_local%EPINCHYZ)
1156 DEALLOCATE(pinch_local%EPINCHZZ)
1157 ENDIF
1158
1159
1160 RETURN
subroutine cbacoor(elbuf_str, jft, jlt, x, v, vr, ixc, pm, offg, ll, area, vxyz, rxyz, vcore, jac, hx, hy, vksi, veta, vqn, vqg, vq, vjfi, vnrm, vastn, nplat, iplat, x13_t, x24_t, y13_t, y24_t, off, di, nlay, irep, npt, ismstr, nel, isrot, smstr, dir_a, dir_b, facn, zl1, r11, r12, r13, r21, r22, r23, r31, r32, r33, inod, rlz, thk, iplycxfem, ux1, ux2, ux3, ux4, uy1, uy2, uy3, uy4, vl1, vl2, vl3, vl4, xl2, xl3, xl4, yl2, yl3, yl4, xlcor, npinch)
subroutine cbacoort(elbuf_str, jft, jlt, x, v, vr, dr, ixc, pm, offg, area, vxyz, rlz, vcore, jac, hx, hy, vq, vqg, vjfi, nplat, iplat, x13_t, x24_t, y13_t, y24_t, npt, smstr, isrot, xlcor, zl, vqn, nel)
subroutine cbacoorpinch(tnpg, vpinchxyz, vpinch, vq, vqn, ixc, jft, jlt, nplat, iplat, thk, dt1c, facp, lc, vpincht1, vpincht2)
subroutine cbadefrz(jft, jlt, area, rlz, vdef, vxyz, bm0rz, bmkrz, bmerz, vrlz, bmrz, brz, bm, nplat, iplat, ng)
subroutine cbaderirz(jft, jlt, area, x13, x24, y13, y24, bm0rz, bmkrz, bmerz, vcore, nplat, iplat, ismstr)
subroutine cbadeft1(jft, jlt, ng, vcore, vxyz, vdef, hx, hy, bm, nplat, iplat, isrot, bmrz, rxyz, wxy)
subroutine cbaderirzt(jft, jlt, ng, bm0rz, bmkrz, bmerz, bmrz)
subroutine cbadeftw(jft, jlt, vxyz, rxyz, bm, bmf, bf, nplat, iplat, wxy)
subroutine cbadef1(jft, jlt, ng, vcore, vxyz, vdef, hx, hy, bm, nplat, iplat, isrot)
subroutine cbadef(jft, jlt, ng, vcore, area, cdet, vqn, vq, vjfi, vxyz, rxyz, vdef, vnrm, vastn, hx, hy, veta, vksi, bm, bmf, bf, bc, tc, nplat, iplat, isrot, brz)
subroutine cbadefsh(jft, jlt, x13, x24, y13, y24, bm, vdef, vxyz, nplat, iplat)
subroutine cbaderit1(jft, jlt, ng, vcore, vq, vjfi, hx, hy, veta, vksi, bm, nplat, iplat, isrot)
subroutine cbadeft(jft, jlt, vxyz, rlz, vdef, bm, nplat, iplat, isrot, bmrz)
subroutine cbadefsh_ply(jft, jlt, npt, nplat, iplat, x13, x24, y13, y24, vxyz, dt1c, exy)
subroutine cbadef_ply(jft, jlt, ng, npt, nplat, iplat, vq, vxyz, veta, vksi, bm, bc, tc, dt1c, exx, eyy, eyz, ezx)
subroutine cbadefpinch(jft, jlt, ng, vqg, vdef, veta, vksi, tc, nplat, iplat, bcp, bp, vpinchxyz, vdefpinch, tnpg, dbetadxy, vpincht1, vpincht2, bpinchdamp)
subroutine cbaeners(jft, jlt, off, area, thk0, def, forpg, eint, dt, nel)
subroutine cbaener(forpg, eint, jft, jlt, off, vol, exy, nel)
subroutine cbafint_ply(jft, jlt, npt, ng, nplat, iplat, cdet, thkly, th12, vol, ff0, bm, bc, tc, sig_iply, vni, area, vf, vfi, ixc)
subroutine cbafint_reg(nloc_dmg, var_reg, thk, nel, off, area, nc1, nc2, nc3, nc4, bufnl, imat, nddl, itask, ng, jft, jlt, x13, y13, x24, y24, dt2t, thk0, area0, nft)
subroutine cbafori1(jft, jlt, ff, bm, vf, nplat, iplat, vol, nel)
subroutine cbaforct(jft, jlt, vol, x13, x24, y13, y24, vstre, vf, nplat, iplat, off, nel)
subroutine cbaforrz(jft, jlt, vol, ff, vsrz, vf, vmz, bm, bmrz, brz, krz, vrlz, eint, off, dt1c, nplat, iplat, ng, nel)
subroutine cbafori(jft, jlt, ng, cdet, thk0, th12, ff0, mm0, nel, bm, bmf, bf, bc, tc, vf, vm, nplat, iplat, vol)
subroutine cbaforipinch(jft, jlt, ng, nel, nplat, iplat, cdet, thk0, th12, vol, ff, mm, bcp, bp, vfpinch, dbetadxy, rho, lc, ssp, bpinchdamp, vfpinchdampx, vfpinchdampy)
subroutine cbapinchproj(jft, jlt, vqn, vq, vfpinch, nplat, iplat, fp, corel, di, thk0, vfpinchdampx, vfpinchdampy)
subroutine cbapinchthk(jft, jlt, nplat, iplat, dt1c, thk, thk0, ezzpg)
subroutine cbaproj(jft, jlt, vqn, vq, vf, vm, nplat, iplat, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, corel, di, vmz, isrot, off)
subroutine cbaproj_ply(jft, jlt, npt, nplat, iplat, vqn, vq, vf, vfi, corel, di, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, off)
subroutine cbastra3(gstr, gstrpg, jft, jlt, nft, npg, vdef, exx, eyy, exy, exz, eyz, kxx, kyy, kxy, dt1c, epsdot, iepsdot, istrain, ux1, ux2, ux3, ux4, uy1, uy2, uy3, uy4, x13, x24, y13, y24, bm, ismstr, mtn, nplat, iplat, isrot, wxy, f_def, gstrwpg, nel)
subroutine cbastra3pinch(jft, jlt, nplat, iplat, vdefpinch, epinchxz, epinchyz, ezz, dt1c, ng, ezzpg, epgpinchxz, epgpinchyz, epgpinchzz)
subroutine cbatempel(jft, jlt, ng, ixc, temp, tempel)
subroutine cbatherm(jft, jlt, pm, thk, ixc, bm, area, dtime, tempnc, tel, dheat, nplat, iplat, fphi, theaccfact)
subroutine cbavarnl(jft, jlt, ng, ixc, nloc_dmg, varnl, nddl, nc1, nc2, nc3, nc4, nel)
subroutine cbavisnp1(jft, jlt, vxyz, rxyz, vcore, amu, off, rho, ssp, area, thk, g, dt1, vf, ipartc, evis, kfts)
subroutine cbavisc(jft, jlt, vdef, amu, off, shf, nu, rho, ssp, area, thk, for, mom, npt, mtn, ipartc, evis, dt1, nel)
subroutine cbavit_ply(jft, jlt, ixc, offg, off, nplat, iplat, npt, vcore, di, zl, vq, vxyz, x13_t, x24_t, y13_t, y24_t, area, inod, del_ply, vni, istack, vr)
subroutine cbal58warp(elbuf_str, nel, x, ixc, e3x, e3y, e3z, offg, zllc2)
subroutine cbilan(jft, jlt, pm, v, ixc, thk, eint, partsav, area, mat, ipartc, x, vr, vol0, vol00, thk0, thk02, ifla, off, nft1, gresav, grth, igrth, vl1, vl2, vl3, vl4, vrl1, vrl2, vrl3, vrl4, x1g, x2g, x3g, x4g, y1g, y2g, y3g, y4g, z1g, z2g, z3g, z4g, ixfem, iexpan, eintth, itask, gvol, actifxfem, igre, sensors, nel, g_wpla, wpla)
subroutine cmain3(timers, elbuf_str, jft, jlt, nft, iparg, nel, mtn, ipla, ithk, group_param, pm, geo, npf, tf, bufmat, ssp, rho, viscmx, dt1c, sigy, area, exx, eyy, exy, exz, eyz, kxx, kyy, kxy, nu, off, thk0, mat, pid, mat_elem, for, mom, gstr, failwave, fwave_el, thk, eint, iofc, g, a11, a12, vol0, indxdel, ngl, zcfac, shf, gs, epsd_pg, kfts, jhbe, alpe, dir_a, dir_b, igeo, ipm, ifailure, npg, fheat, tempel, die, jthe, iexpan, tempel0, ishplyxfem, ply_exx, ply_eyy, ply_exy, ply_exz, ply_eyz, ply_f, del_ply, th_iply, sig_iply, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, ng, table, ixfem, offi, sensors, a11_iply, elcrkini, dir1_crk, dir2_crk, aldt, idt_therm, theaccfact, ismstr, ir, is, nlay, npt, ixlay, ixel, isubstack, stack, f_def, itask, drape, varnl, nloc_dmg, indx_drape, thke, sedrape, numel_drape, dt, ncycle, snpc, stf, nxlaymax, idel7nok, userl_avail, maxfunc, varnl_npttot, sbufmat, sdir_a, sdir_b, for_g)
subroutine cmain3pinch(elbuf_str, jft, jlt, nft, iparg, nel, mtn, ipla, ithk, group_param, pm, geo, npf, tf, bufmat, ssp, rho, viscmx, dt1c, sigy, area, exx, eyy, exy, exz, eyz, kxx, kyy, kxy, nu, off, thk0, mat, pid, for, mom, gstr, failwave, fwave_el, thk, eint, iofc, g, a11, a12, vol0, indxdel, ngl, zcfac, shf, gs, epsp, kfts, jhbe, alpe, dir_a, dir_b, igeo, ipm, ifailure, npg, tempel, die, jthe, iexpan, tempel0, ishplyxfem, ply_exx, ply_eyy, ply_exy, ply_exz, ply_eyz, ply_f, del_ply, th_iply, sig_iply, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, ng, table, ixfem, offi, a11_iply, elcrkini, dir1_crk, dir2_crk, aldt, ismstr, ir, is, nlay, npt, ixlay, ixel, isubstack, stack, f_def, itask, drape, varnl, pinch_local, forp, momp, ezzavg, areapinch)
subroutine cncoef3(jft, jlt, pm, mat, geo, pid, off, area, shf, thk0, thk02, nu, g, ym, a11, a12, thk, thke, ssp, rho, volg, gs, mtn, ithk, npt, dt1c, dt1, ihbe, amu, krz, igeo, a11r, isubstack, pm_stack, nel, zoffset)
subroutine cndt3(jft, jlt, off, dt2t, amu, neltst, ityptst, sti, stir, offg, ssp, viscmx, rho, vol0, thk0, thk02, a1, aldt, alpe, ngl, ismstr, iofc, nne, area, g, shf, msc, dmelc, jsms, ptg, igtyp, igmat, a11r, g_dt, dtel, mtn, pm, imat, nel, zoffset)
subroutine cndt3pinch(jft, jlt, off, dt2t, amu, neltst, ityptst, sti, stir, offg, ssp, viscmx, rho, vol0, thk0, thk02, a1, aldt, alpe, ngl, ismstr, iofc, nne, area, g, shf, msc, dmelc, jsms, ptg, igtyp, igmat, a11r, g_dt, dtel, a11pinch)
subroutine cndt_ply(jft, jlt, npt, off, aldt, area, thk, thk_iply, a1, a1_iply, sti, offi, viscmx)
subroutine cupdt3f(jft, jlt, i8f, i8m, nvc, offg, off, sti, stir, i8stifn, i8stifr, ixc, pm, area, thk, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, eint, partsav, mat, ipartc, nodadt_therm)
subroutine cupdt_ply(jft, jlt, nvc, offg, off, iadc, iel, inod, ixc, ms, in, ms_ply, zi_ply, istack, posly, fly11, fly12, fly13, fly14, fly21, fly22, fly23, fly24, fly31, fly32, fly33, fly34, fac, sti, msz2, nft, npt)
subroutine cupdtn3p(jft, jlt, offg, off, sti, stir, fsky, fskyv, iadc, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, ixc, eint, partsav, mat, ipartc, pm, area, thk, fac, jthe, them, fthesky, condnsky, conde, nodadt_therm)
subroutine cupdtn3(jft, jlt, f, m, nvc, offg, off, sti, stir, stifn, stifr, ixc, pm, area, thk, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, eint, partsav, mat, ipartc, fac, jthe, them, fthe, condn, conde, nodadt_therm)
subroutine cupdtn3pinch(jft, jlt, nvc, ixc, fp, fpinch, sti, stifpinch, facp)
subroutine dtcba_reg(nloc_dmg, thk, nel, off, le, imat, nddl, dt2t)
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine startime(event, itask)
subroutine stoptime(event, itask)
subroutine set_failwave_sh4n(failwave, fwave_el, dadv, nel, ixc, itab, ngl, offly)
1.15.0