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