239
240
241
242 USE checksum_output_option_mod
246 USE elbufdef_mod
253 USE multi_fvm_mod
256 USE matparam_def_mod
257 use glob_therm_mod
258 use my_alloc_mod
260 USE output_mod , ONLY : output_, noda_surf, noda_pext, anim_has_noda_pext
261 USE anim_monvol_mod
262
263
264
265#include "implicit_f.inc"
266
267
268
269#include "com01_c.inc"
270#include "com04_c.inc"
271#include "com08_c.inc"
272#include "com09_c.inc"
273#include "com_xfem1.inc"
274#include "sphcom.inc"
275#include "param_c.inc"
276#include "units_c.inc"
277#include "scr03_c.inc"
278#include "scr06_c.inc"
279#include "scr14_c.inc"
280#include "scr16_c.inc"
281#include "scr17_c.inc"
282#include "scr23_c.inc"
283#include "scr25_c.inc"
284#include "chara_c.inc"
285#include "scrcut_c.inc"
286#include "task_c.inc"
287#include "spmd_c.inc"
288#include "flowcom.inc"
289#include "impl1_c.inc"
290#include "sms_c.inc"
291#include "filescount_c.inc"
292#include "intstamp_c.inc"
293
294
295
296 INTEGER SWAFT,SMAS,SXNORM,SIAD,SINVERT,SMATER,,SWA4,
297 . SIADG,NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),
298 . LESDVOIS(*),SPH2SOL(*)
299 integer
300 . suix, sxusr ,sfacptx,sixedge,sixfacet,sixsolid,snumx1,
301 . snumx2,snumx3,soffx1,soffx2,soffx3,smass1,smass2,
302 .
smass3,sfunc1,sfunc2,sfunc3,sfin,snfacptx
303
304 INTEGER IGEO(NPROPGI,*),IPM(NPROPMI,*),INDX_CRK(*),
305 . LRBE2(*),LRBE3(*),FR_RBE2(
306
307
308
309 . x(3*numnod), d(3*numnod), v(3*numnod), a(3,numnod), bufel(*),
310 . pm(npropm,nummat), geo(npropg,*),cont(*),
311 . xcut(*) , fint(3,*),ms(*),rwbuf(nrwlp,*),skew(lskew,*),
312 . rby(nrby,*),fext(3,*) ,fopt(6,*),anin(*),tani(6,*),eani(*),
313 . tors(15,*),bufsf(*), rdata(*),
314 . bufmat(*),bufgeo(*),
315 . spbuf(*), vr(*),volmon(*), rflow(*), fncont(3,*), ftcont(3,*),
316 . temp(*), thke(*), err_thk_sh4(*), err_thk_sh3(*), diag_sms(*),
317 . fncont2(3,*), dr(3,*),dxancg(3,*),zi_ply(*),vgaz(*),
318 . fcontg(*), fncontg(*), ftcontg(*),fanreac(6,*),pdama2(2,*),
319 . res_sms(*),fcluster(3,*),mcluster(3,*),w(*),
320 . wige(*),knot(*),stifn(*),stifr(*),knotlocpc(*),knotlocel(*),
321 . fcont_max(*),fncontp2(3,*) ,ftcontp2(3,*)
322 INTEGER IPARG(NPARG,*),NSTRF(*),LPBY(*),
323 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXTG(NIXTG,*),
324 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),MONVOL(*) ,
325 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,
326 . ICUT(*), ITAB(*),NPBY(NNPBY,*),NPRW(*),
327 . WEIGHT(*),IPART(LIPART1,*),IPARTS(*),IPARTQ(*),IPARTC(*),
328 . IPARTT(*),IPARTP(*),IPARTR(*),IPARTUR(*),IPARTTG(*),
329 . NOM_OPT(*),
330 . IDATA(*),KXX(NIXX,*), IXX(*), IPARTX(*),
331 . KXSP(NISP,*), IXSP(KVOISPH,*), NOD2SP(*), IPARTSP(*),
332 . NODGLOB(*),IAD_ELEM(2,*),FR_ELEM(*),FR_WALL(*), IFLOW(*),
333 . IPARI(NPARI,*),IRBE2(NRBE2L,*),IRBE3(NRBE3L,*),
334 . WEIGHT_MD(*),NODGLOBXFE(*),IPARTIG3D(*)
335 INTEGER CTEXT(2159), IB
336 INTEGER DD_IAD(NSPMD+1,*),
337 . NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
338 . N1,N2,N3
339 INTEGER FR_SEC(NSPMD+1,*),FR_RBY2(3,*),IAD_RBY2(4,*),
340 . NERBT(NRBODY),LOC_PROC,PROC,NERBE2T(NRBE2G),
341 . NERBE3T(NRBE3G),IAD_RBE2(4,*),NV46,KXIG3D(*),
342 . IXIG3D(*),SIG3DSOLID
343 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
344 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP,NXEL) :: XFEM_TAB
345 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTER
346 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
347 TYPE (STACK_PLY) :: STACK
348 TYPE(H3D_DATABASE) :: H3D_DATA
349 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
350
351 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
352 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
353 TYPE(MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
354 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
355 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
356 type (glob_therm_) ,intent(in) :: glob_therm
357 TYPE (DRAPE_) ,INTENT(IN) :: DRAPE_SH4N(NUMELC_DRAPE)
358 TYPE (DRAPE_) ,INTENT(IN) :: DRAPE_SH3N(NUMELTG_DRAPE)
359 TYPE (DRAPEG_) ,INTENT(IN) :: DRAPEG
360 TYPE(OUTPUT_),INTENT(INOUT) :: OUTPUT
361
362
363
364 INTEGER ANIMSIZE
365 my_real,
DIMENSION(:),
ALLOCATABLE :: waft , mas , xnorm,
366 . xmass1, xmass2, xmass3,
367 . xfunc1, xfunc2, xfunc3,
368 . xusr
369 INTEGER,DIMENSION(:),ALLOCATABLE :: IAD
370 INTEGER,DIMENSION(:),ALLOCATABLE :: INVERT
371 INTEGER,DIMENSION(:),ALLOCATABLE :: MATER
372 INTEGER,DIMENSION(:),ALLOCATABLE :: EL2FA
373 INTEGER,DIMENSION(:,:),ALLOCATABLE :: IADG
374 INTEGER,DIMENSION(:,:),ALLOCATABLE :: IADG_TPR
375
376 INTEGER,DIMENSION(:),ALLOCATABLE :: UIX
377 INTEGER,DIMENSION(:,:),ALLOCATABLE :: NFACPTX
378 INTEGER,DIMENSION(:),ALLOCATABLE :: IXEDGE
379 INTEGER,DIMENSION(:),ALLOCATABLE :: IXFACET
380 INTEGER,DIMENSION(:),ALLOCATABLE :: IXSOLID
381 INTEGER,DIMENSION(:),ALLOCATABLE :: INUMX1
382 INTEGER,DIMENSION(:),ALLOCATABLE :: INUMX2
383 INTEGER,DIMENSION(:),ALLOCATABLE :: INUMX3
384 INTEGER,DIMENSION(:),ALLOCATABLE :: IOFFX1
385 INTEGER,DIMENSION(:),ALLOCATABLE :: IOFFX2
386 INTEGER,DIMENSION(:),ALLOCATABLE :: IOFFX3
387 INTEGER,DIMENSION(:),ALLOCATABLE :: IG3DSOLID
388 INTEGER SZ16,SHFT16,IADGPS,NSN,IADISO,FIRST_NODE_IG3D,IADCHKSUM
389
390 real
391 . , DIMENSION(:), ALLOCATABLE :: wa4, mas4, wa4_fvm
393 . x_temp(3,64*numelig3d),d_temp(3,64*numelig3d),
394 . v_temp(3,64*numelig3d),a_temp(3,64*numelig3d),tabstresl(6,64*numelig3d),
395 . bid_temp(3,64*numelig3d),cont_temp(3,64*numelig3d),fint_temp(3,64*numelig3d),
396 . fext_temp(3,64*numelig3d),fanreact_temp(3,64*numelig3d)
397
398
399 my_real ,
DIMENSION (:),
ALLOCATABLE :: cbuf
400 INTEGER ,DIMENSION (:), ALLOCATABLE :: ICBUF
401 SAVE cbuf,icbuf
402
403 CHARACTER*80 STR, MES*30, CAUX,TITL*100
404 CHARACTER CHANIM*9,FILNAM*100, CHANIM1*4
405 INTEGER I, IDX,NBF, NBPART, MAGIC, J, IFUNC, FILEN, NPSOL,
406 . NODCUT,NELCUT,LENR,LENI,LENCUT,LENCUTO,IXEL,
407 . MIC1,MIC2,MIC3,MIC4,MIC5,MAC1,MAC2,MAC3,NPSPR,N,K,
408 . I3000, NESCT,NERBY,NERWL,NNWL,TMPNBF,ISK(6),
409 . NESBW2,NEL,NFT,ITY,NG,OUI,IPT
410 INTEGER II,II_L,INC,P,NSLARB_L,NDMA2,NUMELS_T,NSKEWA,NB1D,
411 . M1,M2,M3,M,M01,NB1D_T, NBF_L, LEN, NUMELT_T,
412 . NUMELR_T, NUMELP_T
413 INTEGER ISECT,NESCT1,IRBY,NERBY1,IRWL,NERWL1,NERBE2,NERBE3,
414 . NERBE2_1,NERBE3_1
415 INTEGER NSURG,NESRG, NNSRG, NESRG1, NNSRG1,ISRG,ISRF,ISRK
416 INTEGER NSMAD,NESMD, NNSMD, NESMD1, NNSMD1,ISMD
417 INTEGER NENT,OFFSI,OFFSRF,OFFSRV
418 INTEGER NESPH,NNSPH,INSPH,NESPHG,NNSPHG,SNNSPHG,SZNNSPH,SHFTSPH
419 INTEGER I161,I16A,I16B,I16C,I16D,I16E,I16F,I16G,I16H,I16I,I16J,
420 . I16K,I16L,I16M,I16N
421 INTEGER MXSUBS,NSECTSA
422 INTEGER IPRT, IAUX
423 INTEGER IFLAG1D,NNNSRG,NNN,BUF
424 INTEGER NANIM1D_L,IUS,NANIM3D_L
425 INTEGER ISPH3D,M4,N0
426 INTEGER LTITL
427 INTEGER LRBUF,BUFL,BUFFERP(NPART),SBUFSPM,SBUFRECVM,SBUFSPO,
428 . SPORBY,NUMSPH_T,NUMELS16_T,LRBUFG,NNNG
430 . cdg(3), s3000,xmin,ymin,zmin,xmax,
ymax,zmax, scale,
431 . rval
432 INTEGER , KK1, K2, KIBJET, KIBHOL, IADHOL, KK2, KRBJET, KRBHOL,
433 . RADHOL, ITYP, KI1, KR1, NCA, NTG, NJET, NVENT, NTGI
435 . , DIMENSION(:,:), ALLOCATABLE :: vflu , vvar1 , aflu,
436 . vflu_ale, fanreact, fanreacr
437
438 INTEGER IADI, IADR, NINOUT, NNO, II1, II2, IR1, NNO_L, NNN_L,
439 . II3, II4
440 INTEGER NNS, NNI, NNT, NNA, NBA, KI2, KR2
441 INTEGER FVOFF(2,NFVBAG), INOD(4), INORM(3), NFVTR, NFVNOD,
442 . NFVPART, NFVSUBS, IDMAX, KK, NN, FVIAD, JJ, OFFPART,
443 . ELOFF, IDCMAX, NND, NBID1, NBID2, NBID3, NFVNODT, IDP,
444 . NBPART2D,NRBE2T,NRBE3T,EMPSIZPL
446 . gama, ssp, fac
447 INTEGER, DIMENSION(:), ALLOCATABLE :: OFFTR, ITAGT, FVEL2FA,
448 . FVINUM, FVPBUF,EL2FA_PLY,
449 . IAD_PLY,ITAB_PLY
450
452 . , DIMENSION(:), ALLOCATABLE :: fvmass, fvpres, fvqx, fvqy,
453 . fvqz, fvrho, fvener, fvcson,
454 . fvgama, fvvisu,waft_ply,
455 . waft_crk
456
457 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_PLYG
458 INTEGER IUL,IAD_GP2,IFIRST,
459 . NEL_PLY, NFNOD_PXFEM,IDPLY,NBF_PXFEM_L,
460 . IPLY,NPLYSUBS,ID_PART,NBF_PXFEM,SWAFT_PXFEM,MAXPART,
461 . NBF_PXFEMG,NFNOD_PXFEMG,PLYNUMC,
462 . SEL2FA_PLY,IADPC,IFV,IAD_GP3,IAD_ISO,IAD_GP4
463 INTEGER, DIMENSION(:), ALLOCATABLE :: NFSHSZ
464 INTEGER, DIMENSION(:), ALLOCATABLE :: NFNODSZ
465 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGPS
467 . , DIMENSION(:), ALLOCATABLE :: wgps , vgps
468
469 REAL R4
470 SAVE lencuto
471 DATA lencuto/0/
472 INTEGER IERROR
473 INTEGER ITG,NPLYPARTW,ILAY,ILEV,IANIM_TMP,CPT,KKT
474
475 INTEGER NFNOD_CRKXFEM,IDCRK,ICRK,NCRKSUBS,
476 . NBF_CRKXFEM,LEN_CRKX,NBF_CRKXFEMG,NFNOD_CRKXFEMG,
477 . NFSHSZCRK(NLEVMAX),SEL2FA_CRK,NCRKPARTW,NXFENODG2(NLEVMAX),
478 . IDMAXNOD,SWAFT_CRK
479 INTEGER, DIMENSION(:), ALLOCATABLE :: EL2FA_CRK,IAD_CRK,ITAB_CRK,
480 . IAD_LAY
481 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_CRKG
482
483 INTEGER :: LEN_TMP_NAME
484 CHARACTER(len=2048),TARGET :: TMP_NAME
485 LOGICAL :: CONDITION
486 INTEGER :: IS_WRITTEN_NODE_FVM(AIRBAGS_TOTAL_FVM_IN_H3D)
487 INTEGER,DIMENSION(:),ALLOCATABLE :: IS_WRITTEN_NODE
488 INTEGER :: DEFAULT_OUTPUT
489
490 ALLOCATE(waft(swaft) , mas(smas) , xnorm(sxnorm) ,
491 . xmass1(smass1), xmass2(smass2), xmass3(
smass3),
492 . xfunc1(sfunc1), xfunc2(sfunc2), xfunc3(sfunc3),
493 . xusr(sxusr) )
494 waft(1:swaft) = zero
495
496 ALLOCATE (wa4(swa4), mas4(smas))
498
499 ALLOCATE(vflu(3,numnod), vvar1(3,numnod), aflu(3,numnod),
500 . vflu_ale(3,numnod),fanreact(3,numnod),fanreacr(3,numnod))
501
502 ALLOCATE(wgps(numnod), vgps(numnod), itagps(numnod))
503
504 CALL my_alloc(is_written_node,numnod)
505 CALL my_alloc(iad,siad)
506 IF(siad >0) iad(1:siad) = -huge(iad(1))
507 CALL my_alloc(
invert,sinvert)
508 CALL my_alloc(mater,smater)
509 CALL my_alloc(el2fa,sel2fa)
510 CALL my_alloc(iadg,nspmd,siadg)
511 CALL my_alloc(iadg_tpr,nspmd,siadg)
512 CALL my_alloc(nfshsz,nplymax)
513 CALL my_alloc(nfnodsz,nplymax)
514 CALL my_alloc(uix,suix)
515 CALL my_alloc(nfacptx,3,snfacptx)
516 CALL my_alloc(ixedge,sixedge)
517 CALL my_alloc(ixfacet,sixfacet)
518 CALL my_alloc(ixsolid,sixsolid)
519 CALL my_alloc(inumx1,snumx1)
520 CALL my_alloc(inumx2,snumx2)
521 CALL my_alloc(inumx3,snumx3)
522 CALL my_alloc(ioffx1,soffx1)
523 CALL my_alloc(ioffx2,soffx2)
524 CALL my_alloc(ioffx3,soffx3)
525 CALL my_alloc(ig3dsolid,sig3dsolid)
526
527 iadg(1:nspmd,1:siadg) = 0
528 IF (anim_ply > 0)THEN
530 ELSE
531 nplypartw=0
532 ENDIF
533 IF (anim_crk > 0 .and. icrack3d > 0 .and. nxel > 0) THEN
534 ncrkpartw = int(ncrkpart/nxel)
535 ELSE
536 ncrkpartw = 0
537 ENDIF
538 nrbe2t = nrbe2g
539 nrbe3t = nrbe3g
540
541 loc_proc = ispmd+1
542 IF(anim_vers>=47)THEN
543 ltitl = 80
544 ELSE
545 ltitl = 40
546 ENDIF
547 IF(anim_vers<44)THEN
548 isph3d=1
549 ELSE
550 isph3d=0
551 ENDIF
552 i161=1
553 i16a=i161+lnopt1*nrbody0
554 i16b=i16a+lnopt1*naccelm
555 i16c=i16b+lnopt1*nvolu
556 i16d=i16c+lnopt1*(ninter+nintsub)
557 i16e=i16d+lnopt1*nrwall
558 i16f=i16e
559 i16g=i16f+lnopt1*njoint
560 i16h=i16g+lnopt1*nsect
561 i16i=i16h+lnopt1*nlink
562 i16j=i16i+lnopt1*(numskw+1+numfram+1)
563 i16k=i16j+lnopt1*nfxbody
564 i16l=i16k+lnopt1*nflow
565 i16m=i16l+lnopt1*nrbe2t
566 i16n=i16m+lnopt1*nrbe3t
567
568 s3000 = three1000
569 i3000 = s3000
570
571
572
573 IF(ispmd==0) THEN
574 IF(anim_vers<50)THEN
575 IF(ianim>=1000)THEN
576 ianim_tmp = ianim
577 cpt = 1
578 DO WHILE(ianim_tmp /= 0)
579 ianim_tmp = ianim_tmp / 10
580 cpt = cpt + 1
581 ENDDO
582 IF (cpt == 5)THEN
583 WRITE(chanim,'(I4.4)')ianim
584 filnam=rootnam(1:rootlen)//'a'//CHANIM
585 FILEN = ROOTLEN + 5
586 ELSEIF (CPT == 6)THEN
587 WRITE(CHANIM,'(i5.5)')IANIM
588 FILNAM=ROOTNAM(1:ROOTLEN)//'a'//CHANIM
589 FILEN = ROOTLEN + 6
590 ELSEIF (CPT == 7)THEN
591 WRITE(CHANIM,'(i6.6)')IANIM
592 FILNAM=ROOTNAM(1:ROOTLEN)//'a'//CHANIM
593 FILEN = ROOTLEN + 7
594 ELSEIF (CPT == 8)THEN
595 WRITE(CHANIM,'(i7.7)')IANIM
596 FILNAM=ROOTNAM(1:ROOTLEN)//'a'//CHANIM
597 FILEN = ROOTLEN + 8
598 ELSEIF (CPT == 9)THEN
599 WRITE(CHANIM,'(i8.8)')IANIM
600 FILNAM=ROOTNAM(1:ROOTLEN)//'a'//CHANIM
601 FILEN = ROOTLEN + 9
602 ELSE
603 IANIM = 1
604 WRITE(CHANIM,'(i3.3)')IANIM
605 FILNAM=ROOTNAM(1:ROOTLEN)//'a'//CHANIM
606 FILEN = ROOTLEN + 4
607 ENDIF
608 ELSE
609 WRITE(CHANIM,'(i3.3)')IANIM
610 FILNAM=ROOTNAM(1:ROOTLEN)//'a'//CHANIM
611 FILEN = ROOTLEN + 4
612 ENDIF
613 ENDIF
614 IF(ANIM_VERS>=50)THEN
615 IF(IANIM>=10000)IANIM=1
616 WRITE(CHANIM1,'(i4.4)')ianim
617 filnam=rootnam(1:rootlen)//'_'//chanim1//'.ani'
618 filen = rootlen + 9
619 ENDIF
620
623 DO i=1,len_tmp_name
624 ctext(i)=ichar(tmp_name(i:i))
625 ENDDO
627 IF(izip==0)THEN
628 CALL open_c(ctext,len_tmp_name,0)
629 ELSEIF(izip==1)THEN
630 CALL open_c(ctext,len_tmp_name,3)
631 ELSEIF(izip==2)THEN
632 CALL open_c(ctext,len_tmp_name,6)
633 ENDIF
634 ENDIF
635
636
637
638
639 nanim1d_l = 0
640 IF (numelxg>0) THEN
641
642 DO i=1,npart
643 nfacptx(1,i)=0
644 nfacptx(2,i)=0
645 nfacptx(3,i)=0
646 ENDDO
647 CALL animx(elbuf_tab,
648 . iparg ,itab ,x ,kxx ,ixx ,
649 . ipartx ,pm ,geo ,bufmat ,bufgeo ,
650 . uix ,xusr ,nfacptx ,ixedge ,ixfacet,
651 . ixsolid ,inumx1 ,inumx2 ,inumx3 ,ioffx1 ,
652 . ioffx2 ,ioffx3 ,xmass1 ,xmass2 ,xmass3 ,
653 . xfunc1 ,xfunc2 ,xfunc3 ,nanim1d_l)
654 ENDIF
655
656
657
658 nanim3d_l = 0
659 IF (numelig3d>0) THEN
660 bid_temp(:,:) = zero
661 first_node_ig3d = 1000000000
662 CALL animig3d(elbuf_tab,iparg ,x ,d ,v ,a ,
663 . wige ,kxig3d ,ixig3d,ig3dsolid,nanim3d_l,
664 . x_temp ,d_temp ,v_temp,a_temp, tabstresl,igeo ,
665 . knot ,itab ,ipartig3d,ipart ,cont, cont_temp,
666 . fint ,fint_temp,fext ,fext_temp, fanreac, fanreact_temp,
667 . knotlocpc,knotlocel)
668 ENDIF
669
670
671
672
673 nskewa=numelp + numelt + numskw
674 nb1d =numelp + numelt + numelr
675
676 DO i=1,numelr
677 IF(igeo(11,ixr(1,i))==12)THEN
678 nb1d = nb1d+1
679 ENDIF
680 ENDDO
681 nskewa = nskewag
684
685 IF (anim_v(10)>0) THEN
686 DO i=1,3
687 DO j=1,numnod
688 vflu_ale(i,j)=zero
689 ENDDO
690 ENDDO
691 k1=1
692 kk1=1
693 k2=1+nimv*nvolu
694 kibjet=k2+licbag
695 kibhol=kibjet+libagjet
696 iadhol=kibhol+libaghol
697 kk2=1+nrvolu*nvolu
698 krbjet=kk2+lrcbag
699 krbhol=krbjet+lrbagjet
700 radhol=krbhol+lrbaghol
701 ifv=0
702 DO i=1,nvolu
703 ityp=monvol(k1+1)
704 nca=monvol(k1+2)
705 njet=monvol(k1+7)
706 nvent=monvol(k1+10)
707 IF (ityp==6.OR.ityp==8) THEN
708 ifv=monvol(k1-1+45)
709 nns=monvol(k1-1+32)
710 ntg=monvol(k1-1+33)
711 nba=monvol(k1-1+62)
712 nna=monvol(k1-1+64)
713 nni =monvol(k1-1+68)
714 ntgi=monvol(k1-1+69)
715 nnt =nns+nni
716 ki1=iadhol+monvol(k1-1+31)
717 ki2=ki1+monvol(k1-1+20)-1
718 kr1=radhol+monvol(k1-1+34)+3*nnt
719 kr2=kr1+3*nnt+4*(ntg+ntgi)+3*nna
720 CALL alevflu(
721 . vflu_ale, nnt, volmon(kr1), nna,
722 . volmon(kr2), ifv,nspmd)
723 ENDIF
724 k1=k1+nimv
725 kk1=kk1+nrvolu
726 k2=k2+nicbag*nca
727 kk2=kk2+nrcbag*nca
728 ENDDO
729 ENDIF
730 DO i=1,3
731 DO j=1,numnod
732 vflu(i,j)=zero
733 ENDDO
734 ENDDO
735 iadi=0
736 iadr=0
737 DO i=1,nflow
738 ityp=iflow(iadi+2)
739 IF (ityp==1) THEN
740 ninout=iflow(iadi+4)
741 nno=iflow(iadi+5)
742 nel=iflow(iadi+6)
743 nnn=iflow(iadi+7)
744 nno_l=iflow(iadi+16)
745 nnn_l=iflow(iadi+22)
746 ii1=1+niflow
747 ii2=ii1+nno+3*nel+ninout*niioflow
748 IF(nspmd == 1) THEN
749 ii3=ii2+nnn+nel
750 ii4=ii3+nno
751 ELSE
752 ii3=ii2+nnn+nel+2*nno
753 ii4=ii3+2*nno
754 ENDIF
755 ir1=1+nrflow+2*(nno+nnn)
756 CALL anivflowp(
757 . vflu, nno, nno_l, nnn_l,
758 . iflow(ii1), iflow(ii2), iflow(ii3), iflow(ii4), rflow
759 ENDIF
760
761 iadr=iadr+iflow(iadi+15)
762 iadi=iadi+iflow(iadi+14)
763 ENDDO
764
765
766
767
768
769
770
771
772 DO i=1,npart
773 mater(i)=0
774 ENDDO
775 DO ng = 1, ngroup
776 nel =iparg(2,ng)
777 nft =iparg(3,ng)
778 ity =iparg(5,ng)
779 IF(ity==2)THEN
780 DO i = 1, nel
781 n = i + nft
782 mater(ipartq(n)) = 1
783 ENDDO
784 ELSEIF(ity==3)THEN
785 DO i = 1, nel
786 n = i + nft
787 mater(ipartc(n)) = 1
788 ENDDO
789 ELSEIF(ity==7)THEN
790 DO i = 1, nel
791 n = i + nft
792 mater(iparttg(n)) = 1
793 ENDDO
794 ELSEIF(ity==50)THEN
795 DO i = 1, nel
796 n = i + nft
797 mater
798 ENDDO
799 ENDIF
800
801 ENDDO
802
804 DO i=1,npart
805 IF(mater(i)>1)mater(i) = 1
806 ENDDO
807 IF(nspmd > 1)
CALL spmd_ibcast(mater,mater,npart,1,0,2)
808
809 nbpart = 0
810 DO i=1,npart
811 nbpart = nbpart + mater(i)
812 ENDDO
813
814 nbf = numelq + numelc + numeltg
815 nbf_l = nbf
816 nbf = numelqg+numelcg+numeltgg
817 DO i=1,numelq + numelc + numeltg + 1
818 el2fa(i)=0
819 ENDDO
820
821
822
823 nbf_pxfem = 0
824 nfnod_pxfem = 0
825
826 nbf_pxfemg = 0
827 nfnod_pxfemg = 0
828
829 IF (anim_ply > 0 ) THEN
830
831 IF (nspmd > 1) THEN
832
833
834
835 DO i=1,nplymax
837 ENDDO
839 IF (ispmd == 0)THEN
840 DO i=1,nplymax
841 nbf_pxfemg = nbf_pxfemg + nfshsz(i)
842 ENDDO
843 nfnod_pxfemg = nplynodg
844 swaft_pxfem =
max(3*nfnod_pxfemg,3*nbf_pxfemg)
845 sel2fa_ply = nbf_pxfemg
846
847 ELSE
848 DO i=1,nplymax
849 nfnod_pxfem = nfnod_pxfem +
plynod(i)%PLYNUMNODS
850 nbf_pxfem = nbf_pxfem +
plyshell(i)%PLYNUMSHELL
851 ENDDO
852 swaft_pxfem =
max(3*nfnod_pxfem,3*nbf_pxfem)
853 sel2fa_ply = nbf_pxfem
854 ENDIF
855 ALLOCATE(el2fa_ply(sel2fa_ply), waft_ply(swaft_pxfem),
856 . iad_ply(nplymax),iad_plyg(nspmd,nplymax))
857 el2fa_ply = 0
858 waft_ply = zero
859 iad_ply = 0
860 iad_plyg = 0
861 ELSE
862
863
864
865 DO i=1,nplymax
866 nfnod_pxfem = nfnod_pxfem +
plynod(i)%PLYNUMNODS
868 ENDDO
869
870 swaft_pxfem =
max(3*nfnod_pxfem,3*nbf_pxfem)
871 ALLOCATE(el2fa_ply(nbf_pxfem), waft_ply(swaft_pxfem),
872 . iad_ply(nplymax),iad_plyg(nspmd,nplymax))
873 el2fa_ply = 0
874 waft_ply = zero
875 iad_ply = 0
876 iad_plyg = 0
877
878
879 nfnod_pxfemg = nfnod_pxfem
880 nbf_pxfemg = nbf_pxfem
881 ENDIF
882 ENDIF
883
884
885
886
887 nbf_crkxfem = 0
888 nfnod_crkxfem = 0
889 nbf_crkxfemg = 0
890 nfnod_crkxfemg = 0
891 nxfenodg = 0
892
893 IF (anim_crk > 0) THEN
894 IF (nspmd > 1) THEN
895 DO i=1,nlevmax
896 nfshszcrk(i) =
crkshell(i)%CRKNUMSHELL
897 ENDDO
899 CALL spmd_ibcast(nfshszcrk,nfshszcrk,nlevmax,1,0,2)
900
901 DO i=1,nlevmax
902 nxfenodg2(i) =
crknod(i)%CRKNUMNODS
903 ENDDO
905
906 IF (ispmd == 0) THEN
907 DO i=1,nlevmax
908 nbf_crkxfemg = nbf_crkxfemg + nfshszcrk(i)
909 ENDDO
910
911 DO i=1,nlevmax
912 nxfenodg = nxfenodg + nxfenodg2(i)
913 nbf_crkxfem = nbf_crkxfem +
crkshell(i)%CRKNUMSHELL
914 ENDDO
915
916 nfnod_crkxfemg = nxfenodg
917 len_crkx =
max(nfnod_crkxfemg,nbf_crkxfemg)
918 sel2fa_crk = nbf_crkxfemg + 1
919 swaft_crk =
max(3*nfnod_crkxfemg,3*nbf_crkxfemg)
920 ELSE
921 DO i=1,nlevmax
922 nfnod_crkxfem = nfnod_crkxfem +
crknod(i)%CRKNUMNODS
923 nbf_crkxfem = nbf_crkxfem +
crkshell(i)%CRKNUMSHELL
924 ENDDO
925 len_crkx =
max(nfnod_crkxfem,nbf_crkxfem)
926 sel2fa_crk = nbf_crkxfem + 1
927 swaft_crk =
max(3*nfnod_crkxfem,3*nbf_crkxfem)
928 ENDIF
929 ALLOCATE(el2fa_crk(sel2fa_crk),waft_crk(swaft_crk),
930 . iad_crk(nlevmax),iad_crkg(nspmd,nlevmax))
931 IF (nxel > 0) THEN
932 ALLOCATE(iad_lay(int(nlevmax/nxel)))
933 ELSE
934 ALLOCATE(iad_lay(0))
935 ENDIF
936 el2fa_crk = 0
937 iad_crk = 0
938 iad_crkg = 0
939 iad_lay = 0
940 waft_crk = zero
941 ELSE
942 DO i=1,nlevmax
943 nfnod_crkxfem = nfnod_crkxfem +
crknod(i)%CRKNUMNODS
944 nbf_crkxfem = nbf_crkxfem +
crkshell(i)%CRKNUMSHELL
945 ENDDO
946
947 len_crkx =
max(nfnod_crkxfem,nbf_crkxfem)
948 swaft_crk =
max(3*nfnod_crkxfem,3*nbf_crkxfem)
949 ALLOCATE(el2fa_crk(nbf_crkxfem))
950 ALLOCATE(waft_crk(swaft_crk))
951 ALLOCATE(iad_crk(nlevmax))
952 ALLOCATE(iad_crkg(nspmd,nlevmax))
953 ALLOCATE(iad_lay(int(nlevmax/nxel)))
954 el2fa_crk = 0
955 iad_crk = 0
956 iad_crkg = 0
957 iad_lay = 0
958 waft_crk = zero
959
960 nfnod_crkxfemg = nfnod_crkxfem
961 nbf_crkxfemg = nbf_crkxfem
962 ENDIF
963 ELSE
964 ALLOCATE(el2fa_crk(0),iad_crk(0),iad_crkg(0,0),iad_lay(0),
965 . waft_crk(0))
966 ENDIF
967
968
969
970 nodcut=0
971 nelcut=0
972 mic1=1
973 mic2=1
974 mic3=1
975 mic4=1
976 mic5=1
977 mac1=1
978 mac2=1
979 mac3=1
980 IF(ncuts>0)THEN
981 CALL cutcnt (icut,xcut,ixs,x,d,lencut)
982 lencut =
max(lencut,ncuts)
983 IF(lencut>lencuto)THEN
984 IF(ALLOCATED(cbuf))THEN
985 DEALLOCATE(cbuf)
986 DEALLOCATE(icbuf)
987 ENDIF
988 lenr=42*lencut
989 leni=28*lencut+2*ncuts
990 ALLOCATE(cbuf(lenr),stat=oui)
991 ALLOCATE(icbuf(leni),stat=oui)
992 IF(oui/=0) THEN
993 CALL ancmsg(msgid=29,anmode=aninfo)
995 ENDIF
996 lencuto=lencut
997 ENDIF
998 CALL cutmain(icut ,xcut ,ixs ,x ,d ,
999 . nodcut,nelcut,icbuf,cbuf,lencuto,nbf)
1000 mic1=1
1001 mic2=mic1+10*lencuto
1002 mic3=mic2+12*lencuto
1003 mic4=mic3+6*lencuto
1004 mic5=mic4+ncuts
1005 mac1=1
1006 mac2=mac1+18*lencuto
1007 mac3=mac2+6*lencuto
1008 ENDIF
1009
1010
1011
1012
1013
1014 numsph_t = numsphg
1015
1016 nesct = 0
1017 nerwl = 0
1018 nnwl = 0
1019 nesbw2= 0
1020 IF(nsect+nrwall>0) THEN
1021 CALL dseccnt(nesct,nerwl,nesbw2,nstrf,
1022 1 rwbuf ,nprw,nnwl,ixs)
1023 END IF
1024
1025 nesrg=0
1026 nnsrg=0
1027 nsurg=0
1028 IF (nsurf>0)
1029 .
CALL dsrgcnt(igrsurf, nsurg,nesrg,nnsrg,nesbw2)
1030 nesmd=0
1031 nnsmd=0
1032 nsmad=0
1033 nesph=0
1034 nnsph=0
1035 nnsphg = 0
1036 IF (isph3d==1.AND.numsph_t+maxpjet>0)
1037 .
CALL dsphcnt(nesph,nnsph,nesphg,nnsphg)
1038
1039
1040
1041 idmax=0
1042 nfvnod=0
1043 nfvtr=0
1044 nfvpart=0
1045 nfvsubs=0
1046
1047 IF (anim_ply > 0) THEN
1048 idmax=0
1049 DO i=1,numnod
1050 idmax=
max(idmax,itab(i))
1051 ENDDO
1053 ENDIF
1054
1055 IF (nspmd == 1) THEN
1056 IF (
nfvbag>0.OR. anim_ply > 0)
THEN
1057 idmax=0
1058 DO i=1,numnod
1059 idmax=
max(idmax,itab(i))
1060 ENDDO
1061 ENDIF
1062
1063 IF (ifvani==1) THEN
1065 nfvtr=nfvtr+
fvdata(i)%NNTR
1066 fvoff(1,i)=numnod+nodcut+nsect+nrwall+nnwl
1067 . +nnsrg+nnsmd+nnsph+2*numels16+nfvnod
1068 fvoff(2,i)=idmax+nfvnod
1069 nfvnod=nfvnod+
fvdata(i)%NNS_ANIM
1070 nfvpart=nfvpart+
fvdata(i)%NPOLH_ANIM
1071 nfvsubs=nfvsubs+1
1072 ENDDO
1073 ENDIF
1074 ELSE
1075 IF (ifvani==1)
1076 .
CALL spmd_fvb_adim(nfvtr, fvoff, nfvnod, nfvpart, nfvsubs,
1077 . idmax, itab
1078 . nnsmd, nnsphg)
1079 ENDIF
1080 IF (ispmd==0.AND.nfvtr>0)
1081 . ALLOCATE(fvel2fa(nfvtr), fvinum(nfvtr))
1082
1083
1084
1085 IF (anim_crk > 0) THEN
1086 IF (nspmd == 1) THEN
1087 DO i=1,numnod
1088 idmax =
max(idmax,itab(i))
1089 ENDDO
1090 ELSE
1093 ENDIF
1094 ENDIF
1095 idmaxnod = idmax
1096
1097
1098
1099
1100 numels_t = numelsg
1101 numels16_t = numels16g
1102 numelt_t = numeltrg
1103 numelr_t = numelrg
1104 numelp_t = numelpg
1105
1106 IF (ispmd==0) THEN
1107
1108 magic = 21548
1110
1111 r4 = tt
1112 IF (neig==0) THEN
1115 kkt=0
1116 DO k=1,nltitle
1117 IF(ntitletab(k)==ianim) THEN
1118 kkt=k
1119 titl = titletab(k)
1120 ENDIF
1121 ENDDO
1122 IF(kkt/= 0) THEN
1124 ELSE
1126 ENDIF
1127 ELSE
1128 IF (r4>=zero) THEN
1132 ELSE
1135 CALL ani_txt(
'Static mode',11)
1136 ENDIF
1137 ENDIF
1138 CALL ani_txt(
'Radioss Run=',12)
1139
1142
1143 IF(numels_t+isph3d*(numsph_t+maxpjet)+numelig3d==0) THEN
1145 ELSE
1147 ENDIF
1148
1149 iflag1d = numelt_t+numelp_t+numelr_t+nanim1d+nrbody+
1150 . nrbe2t+nrbe3t
1151 IF (iflag1d/=0) iflag1d = 1
1153
1154
1156
1158
1159
1160 IF(ishfram==1)THEN
1162 ELSE
1164 ENDIF
1165
1166 IF(isph3d==0.AND.
1167 . (numsph_t+maxpjet/=0))THEN
1169 ELSE
1171 ENDIF
1172
1173 IF(anim_vers>=47)THEN
1175 ELSE
1177 ENDIF
1179 IF (nfvnod>0) THEN
1180 nfvnodt=nfvnod+3
1181 ELSE
1182 nfvnodt=0
1183 ENDIF
1184 CALL write_i_c(numnodg+nodcut+nsect+nrwall+nnwl
1185 . +nnsrg+nnsmd+nnsphg+2*numels16g+nfvnodt+nfnod_pxfemg
1186 . +nfnod_crkxfemg+64*numelig3d
1187
1188 CALL write_i_c(nbf+nelcut+nesbw2+nfvtr+nbf_pxfemg
1189 . +nbf_crkxfemg,1)
1190 nbpart2d=nbpart+ncuts+nsect+nrwall+nsurg+nsmad
1191
1192 nbpart2d = nbpart2d + nplypartw
1193
1194 nbpart2d = nbpart2d + ncrkpartw
1196 . +nsect+nrwall+nsurg+nsmad+nfvpart+nplypartw
1197 . +ncrkpartw,1)
1199 IF(nbf+nelcut+nesbw2+nfvtr+nbf_pxfemg
1200 . +nbf_crkxfemg==0)THEN
1202 ELSE
1204 ENDIF
1206 IF(nbf+nelcut+nesbw2+nfvtr+nbf_pxfemg
1207 . +nbf_crkxfemg==0)THEN
1209 ELSE
1211 ENDIF
1213 ENDIF
1214
1215
1216
1217
1218 IF (ispmd==0) THEN
1219 bufl = nb1dg*6
1220 ELSE
1221 bufl = nb1d
1222 ENDIF
1223 CALL aniskew(elbuf_tab,skew ,iparg,x ,ixt ,
1224 2 ixp ,ixr ,geo ,dd_iad,bufl)
1225
1226
1227
1228 CALL scanor(x,d,cdg,xmin,ymin,zmin,xmax,
ymax,zmax,scale,
1229 . weight)
1230
1231 CALL xyznod(x,x_temp,nodglob,weight)
1232
1233 IF(nodcut>0)
CALL xyzcut(cbuf,nodcut)
1234
1236 2 nstrf,rwbuf,nprw ,x,xmin,
1237 3 ymin,zmin,xmax,
ymax,zmax,
1238 4 fr_sec,fr_wall,weight,itab)
1239
1240 IF (nsurg>0)
CALL dxyzsrg(nesrg,igrsurf,bufsf)
1241
1242 snnsphg = nnsphg
1243 IF (isph3d*(numsph_t+maxpjet)>0)
1244 .
CALL dxyzsph(nesph,kxsp,x,spbuf,snnsphg,nnsph)
1245 sz16 = numels16g
1246 IF (sz16>0)
CALL xyz16(ixs,ixs16,x,ispmd,nspmd,numels16,numels8,numels10,
1247 . numels20,numels16g)
1248
1249
1250 IF(anim_ply > 0)THEN
1251 idply = numnodg+nodcut+nsect+nrwall+nnwl
1252 . +nnsrg+nnsmd+nnsphg+2*sz16
1253
1254 empsizpl=0
1257 CALL xyznod_ply(iply,idply,nod_pxfem,x,zi_ply,nodglob,
1258 * empsizpl )
1259 ENDDO
1260 ENDIF
1261
1262
1263 IF (anim_crk > 0) THEN
1264 idcrk = numnodg+nodcut+nsect+nrwall+nnwl
1265 . +nnsrg+nnsmd+nnsphg+2*sz16
1267 DO i = 1,ncrkpart
1268 icrk = indx_crk(i)
1270 CALL xfecut(iparg ,ixc ,ixtg ,icrk ,elcutc ,
1271 . iel_crk ,iadc_crk ,nodedge,crkedge,xedge4n,
1272 . xedge3n )
1273 CALL xyznod_crk(icrk,nfnod_crkxfemg,nodglobxfe)
1274 ENDDO
1275 ENDIF
1276
1277
1278 IF (nfvnod>0) THEN
1279
1280 IF (nspmd == 1) THEN
1282 DO j=1,
fvdata(i)%NNS_ANIM
1283 r4=
fvdata(i)%NOD_ANIM(1,j)
1285 r4=
fvdata(i)%NOD_ANIM(2,j)
1287 r4=
fvdata(i)%NOD_ANIM(3,j)
1289 ENDDO
1290 ENDDO
1291 ELSE
1293 ENDIF
1294 IF (ispmd==0) THEN
1295 r4=em10
1297 r4=zero
1299 r4=zero
1301 r4=zero
1303 r4=em10
1305 r4=zero
1307 r4=zero
1309 r4=zero
1311 r4=em10
1313 nbid1=numnodg+nodcut+nsect+nrwall+nnwl
1314 . +nnsrg+nnsmd+nnsphg
1315 . +nfnod_crkxfemg+1
1316 nbid2=nbid1+1
1317 nbid3=nbid2+1
1318 ENDIF
1319 ENDIF
1320
1321
1322
1323 CALL parsorc(x ,d ,xnorm,iad ,cdg ,
1324 . bufel,iparg,ixq ,ixc ,ixtg ,
1325 . elbuf_tab,
invert,el2fa,iadg ,
1326 . mater,ipartq,ipartc,ipartur,iparttg,
1327 . nodglob)
1328
1329
1330
1331
1332 IF (nspmd>1) THEN
1333 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
1335 ENDIF
1336
1337 buf = sectiom*4
1338
1339 IF(ncuts>0)
CALL parcut(icbuf,nelcut)
1340
1341 IF(nsect+nrwall>0)
CALL dparrws(
1342 1 nesbw2,nstrf, ixc ,
1343 2 ixtg ,x ,nodcut,rwbuf,nprw,
1344 3 nodglob,buf,ixs)
1345
1346 IF (nsurg>0)
CALL dparsrg(nsurg,nnwl,nodcut)
1347
1348
1349 IF (anim_ply > 0) THEN
1350 plynumc = 0
1351 DO i=1,nplymax
1352 plynumc=plynumc+
plyshell(i)%PLYNUMSHELL
1353 ENDDO
1355 . iparg, ixc, ixtg,
invert, el2fa_ply,
1356 . mater, ipartc, nodglob, idply, iad_ply,
1357 . iad_plyg, plynumc, nbf_pxfemg )
1358 ENDIF
1359
1360
1361 IF (anim_crk > 0) THEN
1363 . iparg ,ixc ,ixtg ,el2fa_crk ,idcrk ,
1364 . iad_crk,iad_crkg,nbf_crkxfem,nbf_crkxfemg,iel_crk ,
1365 . nodglobxfe,indx_crk,itab )
1366 ENDIF
1367
1368
1369 IF (nspmd == 1) THEN
1370 ii=0
1371 IF (ifvani==1) THEN
1374 ALLOCATE(itagt(
fvdata(i)%NNTR))
1376 itagt(j)=0
1377 ENDDO
1378
1379 DO j=1,
fvdata(i)%NPOLH_ANIM
1380 DO k=
fvdata(i)%IFVPADR_ANIM(j),
1381 .
fvdata(i)%IFVPADR_ANIM(j+1)-1
1382 kk=
fvdata(i)%IFVPOLH_ANIM(k)
1383 DO n=
fvdata(i)%IFVTADR_ANIM(kk),
1384 .
fvdata(i)%IFVTADR_ANIM(kk+1)-1
1385 nn=
fvdata(i)%IFVPOLY_ANIM(n)
1386 IF (itagt(nn)==1) cycle
1387 inod(1)=fvoff(1,i)+
fvdata(i)%IFVTRI_ANIM(1,nn)-1
1388 inod(2)=fvoff(1,i)+
fvdata(i)%IFVTRI_ANIM(2,nn)-1
1389 inod(3)=fvoff(1,i)+
fvdata(i)%IFVTRI_ANIM(3,nn)-1
1390 inod(4)=inod(3)
1391 ii=ii+1
1392
1393 nnd=1
1394 IF (inod(2)/=inod(1)) nnd=nnd+1
1395 IF (inod(3)/=inod(1).AND.
1396 . inod(3)/=inod(2)) nnd=nnd+1
1397 IF (nnd/=3) THEN
1398 inod(1)=nbid1-1
1399 inod(2)=nbid2-1
1400 inod(3)=nbid3-1
1401 inod(4)=inod(3)
1402 ENDIF
1403
1405 itagt(nn)=1
1406 fvel2fa(
eloff+nn)=ii
1408 ENDDO
1409 ENDDO
1410 ENDDO
1412 DEALLOCATE(itagt)
1413 ENDDO
1414 ENDIF
1415 ELSE
1416 IF (ifvani==1)
1417 .
CALL spmd_fvb_atr(nbid1, nbid2, nbid3, fvel2fa, fvinum,
1418 . fvoff)
1419 ENDIF
1420
1421
1422
1423 CALL anioffc(elbuf_tab,iparg,waft ,el2fa,nbf ,
1424 . iad ,nbf_l,nbpart,iadg,nodglob ,
1425 . ipart,ipartc,iparttg)
1426
1427 IF (ispmd==0) THEN
1428 DO j=1,nesbw2+nelcut
1430 ENDDO
1431 ENDIF
1432
1433 nel_ply = 0
1434 IF(anim_ply > 0) THEN
1435 CALL anioffc_ply( iply, nel_ply, elbuf_tab, iparg,
1436 . waft_ply, el2fa_ply, nbf_pxfem, iad_ply,
1437 . plynumc, nbpart, iad_plyg, nodglob,
1438 . ipart, ipartc, iparttg, nbf_pxfemg,
1439 . ipm, igeo, ixc , stack )
1440 ENDIF
1441
1442
1443 IF (anim_crk > 0) THEN
1445 . xfem_tab ,iparg ,ipart ,ipartc ,iparttg ,
1446 . waft_crk ,el2fa_crk ,nbf_crkxfemg,nbf_crkxfem,iad_crkg,
1447 . iel_crk ,indx_crk)
1448 ENDIF
1449
1450 IF (nspmd == 1) THEN
1451 IF (ifvani==1) THEN
1452 ALLOCATE(offtr(nfvtr))
1453 DO i=1,nfvtr
1454 offtr(i)=0
1455 ENDDO
1461 DO n=
fvdata(i)%IFVTADR(kk),
1462 .
fvdata(i)%IFVTADR(kk+1)-1
1464 IF (nn>0) THEN
1465 n1=
fvdata(i)%IFVTRI_ANIM(1,nn)
1466 n2=
fvdata(i)%IFVTRI_ANIM(2,nn)
1467 n3=
fvdata(i)%IFVTRI_ANIM(3,nn)
1468 nnd=1
1469 IF (n2/=n1) nnd=nnd+1
1470 IF (n3/=n2.AND.n3/=n1) nnd=nnd+1
1471
1472 nn=fvel2fa(
eloff+nn)
1473 IF (nnd==3) offtr(nn)=1
1474 ENDIF
1475 ENDDO
1476 ENDDO
1477 ENDDO
1479 ENDDO
1480
1482 DEALLOCATE(offtr)
1483 ENDIF
1484 ELSE
1486 ENDIF
1487
1488
1489
1490 IF (ispmd==0) THEN
1491 DO i = 1, nbpart
1492 bufferp(i) = 0
1493 DO k = 1, nspmd
1494 bufferp(i) = bufferp(i) + iadg(k,i)
1495 ENDDO
1496 ENDDO
1498 ENDIF
1499 IF (ispmd==0) THEN
1500 IF(ncuts>0)THEN
1502 ENDIF
1503 ENDIF
1504
1505
1506
1507 nesct1=0
1508 DO isect=1,nsect
1509 CALL donesec(isect,nesct1,nstrf
1510
1511 IF (ispmd==0) THEN
1513 endif
1514 END DO
1515 IF (nfvpart>0) THEN
1516 IF (ispmd==0) ALLOCATE(fvpbuf(nfvpart))
1517 nesmd1=0
1518 IF(nspmd > 1)
1520 . nesmd1, fvpbuf)
1521 ENDIF
1522
1523 IF (ispmd==0) THEN
1524 nerwl1=0
1525 DO irwl=1,nrwall
1526 CALL donerwl(irwl,nerwl1,nprw)
1527 CALL write_i_c(nelcut+nbf+nesct+nerwl1,1)
1528 END DO
1529 nesrg1=0
1530
1531 DO isrg=1,nsurg
1533 CALL write_i_c(nelcut+nbf+nesct+nerwl+nesrg1,1)
1534 END DO
1535 nesmd1=0
1536
1537 IF(anim_ply > 0 )THEN
1538 IF (nspmd==1)THEN
1541 iad_ply(iply) = iad_ply(iply)
1542 . + nelcut+nbf+nesct+nerwl+nesrg+nesmd1
1544 ENDDO
1545
1546 ELSE
1549 iadpc=0
1550 DO p=1,nspmd
1551 iadpc = iadpc + iad_plyg(p,i)
1552 ENDDO
1553 iadpc = iadpc
1554 * + nelcut+nbf+nesct+nerwl+nesrg+nesmd1
1556 ENDDO
1557 ENDIF
1558 DEALLOCATE(iad_ply)
1559 ENDIF
1560
1561
1562
1563 IF (anim_crk > 0) THEN
1564 IF(nspmd==1)THEN
1565 DO ilay = 1,nxlaymax
1566 ilev = ilay*nxel
1567 icrk = indx_crk(ilev)
1568 iad_lay(ilay) = iad_lay(ilay) + iad_crk(icrk)
1569 END DO
1570 DO ilay=1,ncrkpartw
1571 iad_lay(ilay) = iad_lay(ilay)
1572 . + nelcut+nbf+nesct+nerwl+nesrg+nesmd1
1574 ENDDO
1575
1576 ELSE
1577 DO ilay = 1,nxlaymax
1578 ilev = ilay*nxel
1579 icrk = indx_crk(ilev)
1580 DO p=1,nspmd
1581 iad_lay(ilay) = iad_lay(ilay) + iad_crkg(p,icrk)
1582 ENDDO
1583 END DO
1584 DO ilay=1,ncrkpartw
1585 iad_lay(ilay) = iad_lay(ilay)
1586 . + nelcut+nbf+nesct+nerwl+nesrg+nesmd1
1588 ENDDO
1589 ENDIF
1590
1591 ENDIF
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616 IF (nspmd == 1 ) THEN
1617 IF (ifvani==1) THEN
1618 fviad=nelcut+nbf+nesct+nerwl+nesrg+nesmd1
1620 ALLOCATE(itagt(
fvdata(i)%NNTR))
1622 itagt(j)=0
1623 ENDDO
1624
1625 DO j=1,
fvdata(i)%NPOLH_ANIM
1626 DO k=
fvdata(i)%IFVPADR_ANIM(j),
1627 .
fvdata(i)%IFVPADR_ANIM(j+1)-1
1628 kk=
fvdata(i)%IFVPOLH_ANIM(k)
1629 DO n=
fvdata(i)%IFVTADR_ANIM(kk),
1630 .
fvdata(i)%IFVTADR_ANIM(kk+1)-1
1631 nn=
fvdata(i)%IFVPOLY_ANIM(n)
1632 IF (itagt(nn)==0) THEN
1633 fviad=fviad+1
1634 itagt(nn)=1
1635 ENDIF
1636 ENDDO
1637 ENDDO
1639 ENDDO
1640 DEALLOCATE(itagt)
1641 ENDDO
1642 DEALLOCATE(fvpbuf)
1643 ENDIF
1644 ELSE
1645 IF (ifvani==1.AND.nfvpart>0) THEN
1646 DO i=1,nfvpart
1647 fviad=fvpbuf(i)
1649 ENDDO
1650 DEALLOCATE(fvpbuf)
1651 ENDIF
1652 ENDIF
1653
1654
1655
1656 maxpart = 0
1657 DO i=1,npart
1658 IF(mater(i)/=0)THEN
1659 WRITE(str,'(I9,A1)')ipart(4,i),':'
1660 DO j=1,10
1661 ctext(j)=ichar(str(j:j))
1662 ENDDO
1663 ib = 10
1664 CALL fretitl2(titl,ipart(lipart1-ltitr+1,i),40)
1665 DO j=1,ltitl
1666 IF(titl(j:j)/=' ') ib = j+10
1667 ctext(j+10)=ichar(titl(j:j))
1668 ENDDO
1669 ctext(ib+1)=0
1671 ENDIF
1672 maxpart =
max(maxpart,ipart(4,i))
1673 ENDDO
1674
1675
1676
1677 IF(ncuts>0)THEN
1678 DO i=1,ncuts
1679 WRITE(str,'(9H CUT:)')
1680 DO j=1,9
1681 ctext(j)=ichar(str(j:j))
1682 ENDDO
1683 ib=9
1684 DO j=1,40
1685 iaux = icut(44*(i-1)+j)
1686 caux(1:1) = char(iaux)
1687 IF(caux(1:1)/=' ') ib = j+9
1688 ctext(j+9)=icut(44*(i-1)+4+j)
1689 ENDDO
1690 ctext(ib+1)=0
1692 ENDDO
1693 ENDIF
1694 IF (invstr<40) THEN
1695 DO isect=1,nsect
1696 WRITE(str,'(I9,A2,A7)') isect,': ','Section'
1697 DO j=1,18
1698 ctext(j)=ichar(str(j:j))
1699 ENDDO
1700 ib = 18
1701 ctext(ib+1)=0
1703 END DO
1704 ELSE
1705 DO isect=1,nsect
1706 WRITE(str,'(I9,A2)') nom_opt(i16g+lnopt1*(isect-1)),': '
1707 DO j=1,11
1708 ctext(j)=ichar(str(j:j))
1709 ENDDO
1710 CALL fretitl2(titl,nom_opt(i16g+lnopt1*(isect-1)
1711 & +lnopt1-ltitr),40)
1712 ib = ltitl+10
1713 DO j=1,ltitl
1714 ctext(j+11)=ichar(titl(j:j))
1715 ENDDO
1716 ctext(ib+1)=0
1718 END DO
1719 END IF
1720 IF (invstr<40) THEN
1721 DO irwl=1,nrwall
1722 WRITE(str,'(I9,A2,A10)') irwl,': ','Rigid Wall'
1723 DO j=1,21
1724 ctext(j)=ichar(str(j:j))
1725 ENDDO
1726 ib = 21
1727 ctext(ib+1)=0
1729 END DO
1730 ELSE
1731 DO irwl=1,nrwall
1732 WRITE(str,'(I9,A2)') nom_opt(i16d+lnopt1*(irwl-1)),': '
1733 DO j=1,11
1734 ctext(j)=ichar(str(j:j))
1735 ENDDO
1736 ib = ltitl+10
1737 CALL fretitl2(titl,nom_opt(i16d+lnopt1*(irwl-1)
1738 & +lnopt1-ltitr),40)
1739 DO j=1,ltitl
1740 ctext(j+11)=ichar(titl(j:j))
1741 END DO
1742 ctext(ib+1)=0
1744 END DO
1745 ENDIF
1746
1747 isrg=1
1748 DO isrf=1,nsurf
1749 IF (igrsurf(isrf)%TYPE==101) THEN
1750
1751 WRITE(str,'(I9,A1)') isrg,':'
1752 DO j=1,10
1753 ctext(j)=ichar(str(j:j))
1754 ENDDO
1755 ib=10
1756 titl = igrsurf(isrf)%TITLE
1757 DO j=1,ltitl
1758 IF(titl(j:j)/=' ') ib = j+10
1759 ctext(j+10)=ichar(titl(j:j))
1760 END DO
1761 ctext(ib+1)=0
1763 isrg=isrg+1
1764 END IF
1765 END DO
1766
1767 ENDIF
1768
1769 maxpart = maxpart + nsect + nrwall + nsurf + ncuts
1770 IF(anim_ply > 0 ) THEN
1771 IF (ispmd==0)THEN
1773 WRITE(str,
'(I8,A15)')
idpid_ply(i),
': PLY COMPOSITE'
1774 DO j=1,24
1775 ctext(j)=ichar(str(j:j))
1776 ENDDO
1777 ib=24
1778 ctext(ib+1)=0
1780 END DO
1782 ENDIF
1783 ENDIF
1784
1785 IF(anim_crk > 0) THEN
1786 IF (ispmd==0)THEN
1787 DO i=1,ncrkpartw
1788 ilay = i
1789 WRITE(str,'(I9,A1)') maxpart + i,':'
1790 DO k=1,10
1791 ctext(k)=ichar(str(k:k))
1792 ENDDO
1793 titl=' '
1794 WRITE(titl,'(A20,I9)') 'CRACKED SHELL LAYER ',ilay
1795 DO k=1,ltitl
1796 ctext(k+10)=ichar(titl(k:k))
1797 ENDDO
1798 ctext(40)=0
1800 END DO
1801 maxpart = maxpart + ncrkpartw
1802 ENDIF
1803 ENDIF
1804
1805 IF (nspmd == 1) THEN
1806 IF (ifvani==1) THEN
1808 DO j=1,
fvdata(i)%NPOLH_ANIM
1809 WRITE(str,'(I9,A1)') maxpart + j,':'
1810 DO k=1,10
1811 ctext(k)=ichar(str(k:k))
1812 ENDDO
1813 titl=' '
1814 WRITE(titl,'(A11,I9)') 'POLYHEDRON ',j
1815 DO k=1,ltitl
1816 ctext(k+10)=ichar(titl(k:k))
1817 ENDDO
1818 ctext(31)=0
1820 ENDDO
1821 ENDDO
1822 ENDIF
1823 ELSE
1825 * maxpart )
1826 ENDIF
1827
1828
1829
1830
1831 CALL xyznor(xnorm,nodglob,weight)
1832
1833 IF(nodcut>0)THEN
1834 CALL norcut(xcut,icbuf(mic5))
1835 ENDIF
1837 IF (nsurg>0)
CALL dsrgnor(igrsurf,bufsf)
1838
1839 IF (ispmd==0) THEN
1840 snnsphg= nnsphg
1841 ELSE
1842 snnsphg= nnsph
1843 ENDIF
1844
1845 IF (isph3d*(numsph_t+maxpjet)>0)
1846 .
CALL dsphnor(kxsp,x,spbuf,nnsphg)
1847 IF (ispmd==0.AND.numels16g>0)
1849
1850 IF(anim_ply > 0) THEN
1851 empsizpl=0
1854 CALL xyznor_ply(iply,xnorm,nodglob,weight,empsizpl)
1855 ENDDO
1856 ENDIF
1857
1858 IF (anim_crk > 0) THEN
1859 DO i = 1,ncrkpart
1860 icrk = indx_crk(i)
1862 ENDDO
1863 END IF
1864
1865 IF (ispmd==0) THEN
1866 IF (ifvani==1) THEN
1867 DO i=1,nfvnod
1868 inorm(1) = 0
1869 inorm(2) = 0
1870 inorm(3) = 0
1872 ENDDO
1873 IF (nfvnod>0) THEN
1874 DO i=1,3
1875 inorm(1) = 0
1876 inorm(2) = 0
1877 inorm(3) = 0
1879 ENDDO
1880 ENDIF
1881 ENDIF
1882 ENDIF
1883
1884
1885
1886 IF(anim_m==1.OR.anim_ce(3)==1.OR.
1887 . anim_ce(25)==1)THEN
1888 CALL dmasanic(elbuf_tab,x ,d ,geo ,iparg,
1889 . ixq ,ixc ,ixtg ,mas ,pm ,
1890 . el2fa,nbf ,igeo , stack )
1891 ENDIF
1892
1893
1894
1895
1896 iadchksum = iad_gps+500
1897 DO i=1,output%CHECKSUM%CHECKSUM_COUNT
1898 anim_n(iadchksum+i) = 1
1899 ENDDO
1900
1901 IF (ispmd==0) THEN
1902 ctext(81)=0
1903 IF(anim_n(01)==1)
CALL ani_txt(
'Time Step',9)
1904 IF(anim_n(02)==1)
CALL ani_txt(
'Mass Change',11)
1905 IF(anim_n(03)==1)
CALL ani_txt(
'Nodal Pressure',14)
1906 IF(anim_n(04)==1)
CALL ani_txt(
'Nodal Density',13)
1907 IF(anim_n(05)==1)
CALL ani_txt(
'Nodal Specific Energy',21)
1908 IF(anim_n(06)==1)
CALL ani_txt(
'Nodal Temperature',17)
1909 IF(anim_n(07)==1)
CALL ani_txt(
'Nodal Variable 1',16)
1910 IF(anim_n(08)==1)
CALL ani_txt(
'Nodal Variable 2',16)
1911 IF(anim_n(09)==1)
CALL ani_txt(
'Nodal Variable 3',16)
1912 IF(anim_n(10)==1)
CALL ani_txt(
'Nodal Variable 4',16)
1913 IF(anim_n(11)==1)
CALL ani_txt(
'Nodal Variable 5',16)
1914 IF(anim_n(12)==1)
CALL ani_txt(
'Inertia Change',14)
1915 IF(anim_n(13)==1)
CALL ani_txt(
'Nodal Potential',15)
1916 IF(anim_n(14)==1)
CALL ani_txt(
'Non Diagonal Mass Change',24)
1917 IF(anim_n(15)==1)
CALL ani_txt(
'%damage(type2 interface) / Normal',33)
1918 IF(anim_n(16)==1)
CALL ani_txt(
'%damage(type2 interface) / Tangent',34)
1919 IF(anim_n(17)==1)
CALL ani_txt(
'Nodal Schlieren',15)
1920 IF(anim_n(18)==1)
CALL ani_txt(
'Nodal Rotational Stiffness',26)
1921 IF(anim_n(19)==1)
CALL ani_txt(
'Nodal Stiffness',15)
1922 IF(anim_n(20)==1)
CALL ani_txt(
'Nodal Volumetric Fraction - 1',29)
1923 IF(anim_n(21)==1)
CALL ani_txt(
'Nodal Volumetric Fraction - 2',29)
1924 IF(anim_n(22)==1)
CALL ani_txt(
'Nodal Volumetric Fraction - 3',29)
1925 IF(anim_n(23)==1)
CALL ani_txt(
'Nodal Volumetric Fraction - 4',29)
1926 IF(anim_n(24)==1)
CALL ani_txt(
'Centroid Volumetric Fraction - 1',32)
1927 IF(anim_n(25)==1)
CALL ani_txt(
'Centroid Volumetric Fraction - 2',32)
1928 IF(anim_n(26)==1)
CALL ani_txt(
'Centroid Volumetric Fraction - 3',32)
1929 IF(anim_n(27)==1)
CALL ani_txt(
'Centroid Volumetric Fraction - 4',32)
1930 IF(anim_n(28)==1)
CALL ani_txt(
'Centroid New Volume',19)
1931 IF(anim_n(29)==1)
CALL ani_txt(
'Centroid Old Volume',19)
1932 IF(anim_n(30)==1)
CALL ani_txt(
'Nodal Sound Speed',17)
1933 IF(anim_n(31)==1)
CALL ani_txt(
'Nodal External Pressure',23)
1934
1935
1936
1937 iadgps = iad_gps
1938 IF(anim_n(iadgps+1)==1)
CALL ani_txt(
'GPS1 Pressure',13)
1939 IF(anim_n(iadgps+2)==1)
CALL ani_txt(
'GPS1 Von Mises',14)
1940 IF(anim_n(iadgps+3)==1)
CALL ani_txt(
'GPS1 SIGXX',10)
1941 IF(anim_n(iadgps+4)==1)
CALL ani_txt(
'GPS1 SIGYY',10)
1942 IF(anim_n(iadgps+5)==1)
CALL ani_txt(
'GPS1 SIGZZ',10)
1943 IF(anim_n(iadgps+6)==1)
CALL ani_txt(
'GPS1 SIGXY',10)
1944 IF(anim_n(iadgps+7)==1)
CALL ani_txt(
'GPS1 SIGZY',10)
1945 IF(anim_n(iadgps+8)==1)
CALL ani_txt(
'GPS1 SIGXZ',10)
1946 IF(anim_n(iadgps+9)==1)
CALL ani_txt(
'GPS1 SIGXX_U',12)
1947 IF(anim_n(iadgps+10)==1)
CALL ani_txt(
'GPS1 SIGYY_U',12)
1948 IF(anim_n(iadgps+11)==1)
CALL ani_txt(
'GPS1 SIGZZ_U',12)
1949 IF(anim_n(iadgps+12)==1)
CALL ani_txt(
'GPS1 SIGXY_U',12)
1950 IF(anim_n(iadgps+13)==1)
CALL ani_txt(
'GPS1 SIGZY_U',12)
1951 IF(anim_n(iadgps+14)==1)
CALL ani_txt(
'GPS1 SIGXZ_U',12)
1952 IF(anim_n(iadgps+15)==1)
CALL ani_txt(
'GPS1 SIGXX_L',12)
1953 IF(anim_n(iadgps+16)==1)
CALL ani_txt(
'GPS1 SIGYY_L',12)
1954 IF(anim_n(iadgps+17)==1)
CALL ani_txt(
'GPS1 SIGZZ_L',12)
1955 IF(anim_n(iadgps+18)==1)
CALL ani_txt(
'GPS1 SIGXY_L',12)
1956 IF(anim_n(iadgps+19)==1)
CALL ani_txt(
'GPS1 SIGZY_L',12)
1957 IF(anim_n(iadgps+20)==1)
CALL ani_txt(
'GPS1 SIGXZ_L',12)
1958 iadgps = iad_gps+100
1959 IF(anim_n(iadgps+1)==1)
CALL ani_txt(
'GPS2 Pressure',13)
1960 IF(anim_n(iadgps+2)==1)
CALL ani_txt(
'GPS2 Von Mises',14)
1961 IF(anim_n(iadgps+3)==1)
CALL ani_txt(
'GPS2 SIGXX',10)
1962 IF(anim_n(iadgps+4)==1)
CALL ani_txt(
'GPS2 SIGYY',10)
1963 IF(anim_n(iadgps+5)==1)
CALL ani_txt(
'GPS2 SIGZZ',10)
1964 IF(anim_n(iadgps+6)==1)
CALL ani_txt(
'GPS2 SIGXY',10)
1965 IF(anim_n(iadgps+7)==1)
CALL ani_txt(
'GPS2 SIGZY',10)
1966 IF(anim_n(iadgps+8)==1)
CALL ani_txt(
'GPS2 SIGXZ',10)
1967 IF(anim_n(iadgps+9)==1)
CALL ani_txt(
'GPS2 SIGXX_U',12)
1968 IF(anim_n(iadgps+10)==1)
CALL ani_txt(
'GPS2 SIGYY_U'
1969 IF(anim_n(iadgps+11)==1)
CALL ani_txt(
'GPS2 SIGZZ_U',12)
1970 IF(anim_n(iadgps+12)==1)
CALL ani_txt(
'GPS2 SIGXY_U',12)
1971 IF(anim_n(iadgps+13)==1)
CALL ani_txt(
'GPS2 SIGZY_U',12)
1972 IF(anim_n(iadgps+14)==1)
CALL ani_txt(
'GPS2 SIGXZ_U',12)
1973 IF(anim_n(iadgps+15)==1)
CALL ani_txt(
'GPS2 SIGXX_L',12)
1974 IF(anim_n(iadgps+16)==1)
CALL ani_txt(
'GPS2 SIGYY_L',12)
1975 IF(anim_n(iadgps+17)==1)
CALL ani_txt(
'GPS2 SIGZZ_L',12)
1976 IF(anim_n(iadgps+18)==1)
CALL ani_txt(
'GPS2 SIGXY_L',12)
1977 IF(anim_n(iadgps+19)==1)
CALL ani_txt(
'GPS2 SIGZY_L',12)
1978 IF(anim_n(iadgps+20)==1)
CALL ani_txt(
'GPS2 SIGXZ_L',12)
1979
1980 iadgps = iad_gps+200
1981 IF(anim_n(iadgps+1)==1)
CALL ani_txt(
'GPS SIGXX',9)
1982 IF(anim_n(iadgps+2)==1)
CALL ani_txt(
'GPS SIGYY',9)
1983 IF(anim_n(iadgps+3)==1)
CALL ani_txt(
'GPS SIGZZ',9)
1984 IF(anim_n(iadgps+4)==1)
CALL ani_txt(
'GPS SIGXY',9)
1985 IF(anim_n(iadgps+5)==1)
CALL ani_txt(
'GPS SIGZY',9)
1986 IF(anim_n(iadgps+6)==1)
CALL ani_txt(
'GPS SIGXZ',9)
1987
1988 iadiso = iad_gps+300
1989 IF(anim_n(iadiso+1)==1)
CALL ani_txt(
'STRESS ISOGEO SIGXX',19)
1990 IF(anim_n(iadiso+2)==1)
CALL ani_txt(
'STRESS ISOGEO SIGYY',19)
1991 IF(anim_n(iadiso+3)==1)
CALL ani_txt(
'STRESS ISOGEO SIGZZ',19)
1992 IF(anim_n(iadiso+4)==1)
CALL ani_txt(
'STRESS ISOGEO SIGXY',19)
1993 IF(anim_n(iadiso+5)==1)
CALL ani_txt(
'STRESS ISOGEO SIGZY',19)
1994 IF(anim_n(iadiso+6)==1)
CALL ani_txt(
'STRESS ISOGEO SIGXZ',19)
1995
1996 iadgps = iad_gps+400
1997 IF(anim_n(iadgps+1)==1)
CALL ani_txt(
'GPSTRAIN EPSXX',14)
1998 IF(anim_n(iadgps+2)==1)
CALL ani_txt(
'GPSTRAIN EPSYY',14)
1999 IF(anim_n(iadgps+3)==1)
CALL ani_txt(
'GPSTRAIN EPSZZ',14)
2000 IF(anim_n(iadgps+4)==1)
CALL ani_txt(
'GPSTRAIN EPSXY',14)
2001 IF(anim_n(iadgps+5)==1)
CALL ani_txt(
'GPSTRAIN EPSZY',14)
2002 IF(anim_n(iadgps+6)==1)
CALL ani_txt(
'GPSTRAIN EPSXZ',14)
2003
2004 iadchksum = iad_gps+500
2005 IF(output%CHECKSUM%CHECKSUM_COUNT > 0) THEN
2006
2007 DO i=1,output%CHECKSUM%CHECKSUM_COUNT
2008 CALL ani_txt(
'ZCHKSM_'//output%CHECKSUM%CHECKSUMS(i), 7+len_trim(output%CHECKSUM%CHECKSUMS(i)))
2009
2010
2011 ENDDO
2012 ENDIF
2013
2014
2015
2016 IF(nbf+nelcut+nesbw2/=0)THEN
2017 IF(anim_ce(1)==1)
CALL ani_txt(
'Plastic Strain',14)
2018 IF(anim_ce(2)==1)
CALL ani_txt(
'Density',7)
2019 IF(anim_ce(3)==1)
CALL ani_txt(
'Specific Energy',15)
2020 IF(anim_ce(4)==1)
CALL ani_txt(
'Temperature',11)
2021 IF(anim_ce(5)==1)
CALL ani_txt(
'Thickness',9)
2022 IF(anim_ce(6)==1)
CALL ani_txt(
'Pressure',8)
2023 IF(anim_ce(7)==1)
CALL ani_txt(
'Von Mises',9)
2024 IF(anim_ce(8)==1)
CALL ani_txt(
'Turbulent Energy',16)
2025 IF(anim_ce(9)==1)
CALL ani_txt(
'Turbulent Viscosity',19)
2026 IF(anim_ce(10)==1)
CALL ani_txt(
'Vorticity-X',11)
2027 IF(anim_ce(11)==1)
CALL ani_txt(
'Damage 1',8)
2028 IF(anim_ce(12)==1)
CALL ani_txt(
'Damage 2',8)
2029 IF(anim_ce(13)==1)
CALL ani_txt(
'Damage 3',8)
2030 IF(anim_ce(14)==1)
CALL ani_txt(
'Stress X ',9)
2031 IF(anim_ce(15)==1)
CALL ani_txt(
'Stress Y ',9)
2032 IF(anim_ce(16)==1)
CALL ani_txt(
'Stress Z ',9)
2033 IF(anim_ce(17)==1)
CALL ani_txt(
'Stress XY',9)
2034 IF(anim_ce(18)==1)
CALL ani_txt(
'Stress YZ',9)
2035 IF(anim_ce(19)==1)
CALL ani_txt(
'Stress ZX',9)
2036 IF(anim_ce(20)==1)
CALL ani_txt(
'User Var 1',10)
2037 IF(anim_ce(21)==1)
CALL ani_txt(
'User Var 2',10)
2038 IF(anim_ce(22)==1)
CALL ani_txt(
'User Var 3',10)
2039 IF(anim_ce(23)==1)
CALL ani_txt(
'User Var 4',10)
2040 IF(anim_ce(24)==1)
CALL ani_txt(
'User Var 5',10)
2041 IF(anim_ce(25)==1)
CALL ani_txt(
'Hourglass Energy per unit mass',30)
2042 IF(anim_ce(26)==1)
CALL ani_txt(
'Strain Rate',11)
2043 IF(anim_ce(27)==1)
CALL ani_txt(
'User Var 6',10)
2044 IF(anim_ce(28)==1)
CALL ani_txt(
'User Var 7',10)
2045 IF(anim_ce(29)==1)
CALL ani_txt(
'User Var 8',10)
2046 IF(anim_ce(30)==1)
CALL ani_txt(
'User Var 9',10)
2047 IF(anim_ce(31)==1)
CALL ani_txt(
'User Var 10',11)
2048 IF(anim_ce(32)==1)
CALL ani_txt(
'User Var 11',11)
2049 IF(anim_ce(33)==1)
CALL ani_txt(
'User Var 12',11)
2050 IF(anim_ce(34)==1)
CALL ani_txt(
'User Var 13',11)
2051 IF(anim_ce(35)==1)
CALL ani_txt(
'User Var 14',11)
2052 IF(anim_ce(36)==1)
CALL ani_txt(
'User Var 15',11)
2053 IF(anim_ce(37)==1)
CALL ani_txt(
'User Var 16',11)
2054 IF(anim_ce(38)==1)
CALL ani_txt(
'User Var 17',11)
2055 IF(anim_ce(39)==1)
CALL ani_txt(
'User Var 18',11)
2056 DO i=40,2039
2057 IF(anim_ce(i)==1)THEN
2058 ii = (i - 39)/100 + 1
2059 ius = mod((i - 39), 100)
2060 IF(ius==0)THEN
2061 ius = 100
2062 ii = ii -1
2063 ENDIF
2064 WRITE(mes,'(A,I2,A,I3,A)')
2065 . 'User Var',ii,'(Layer',ius,')'
2067 ENDIF
2068 ENDDO
2069 IF(anim_ce(2040)==1)
CALL ani_txt(
'Plastic Strain Upper',20)
2070 IF(anim_ce(2041)==1)
CALL ani_txt(
'Plastic Strain Lower',20)
2071 DO i=2042,2141
2072 IF(anim_ce(i)==1)THEN
2073 ius = mod((i - 2041), 100)
2074 IF(ius==0)ius = 100
2075 WRITE(mes,'(A,I3,A)')
2076 . 'Plast Strn Layer ',ius, ' '
2078 END IF
2079 END DO
2080 IF(anim_ce(2142)==1)
CALL ani_txt(
'Nb of Failed layers',19)
2081 IF(anim_ce(2143)==1)
CALL ani_txt(
'Airbag crossing mass',20)
2082 IF(anim_ce(2144)==1)
2083 .
CALL ani_txt(
'Airbag crossing velocity',24)
2084 IF(anim_ce(2145)==1)
CALL ani_txt(
'FVMBAG - Mass',13)
2085 IF(anim_ce(2146)==1)
CALL ani_txt(
'FVMBAG - Pressure',17)
2086 IF(anim_ce(2147)==1)
2087 .
CALL ani_txt(
'FVMBAG - Fluid velocity X',25)
2088 IF(anim_ce(2148)==1)
2089 .
CALL ani_txt(
'FVMBAG - Fluid velocity Y',25)
2090 IF(anim_ce(2149)==1)
2091 .
CALL ani_txt(
'FVMBAG - Fluid velocity Z',25)
2092 IF(anim_ce(2150)==1)
CALL ani_txt(
'FVMBAG - Density',16)
2093 IF(anim_ce(2151)==1)
2094 .
CALL ani_txt(
'FVMBAG - Specific Energy',24)
2095 IF(anim_ce(2152)==1)
CALL ani_txt(
'FVMBAG - Sound Speed',20)
2096 IF(anim_ce(2153)==1)
CALL ani_txt(
'FVMBAG - Gama',13)
2097 IF(anim_ce(2154)==1)
2098 .
CALL ani_txt(
'FVMBAG - Visu Polyhedra',23)
2099 IF(anim_ce(2155)==1)
CALL ani_txt(
'Thinning Percentage',19)
2100 IF(anim_ce(2156)==1)
2101 .
CALL ani_txt(
'Estimated Error on Thickness',28)
2102 DO i=2240,10139
2103 IF(anim_ce(i)==1)THEN
2104 ii = (i - 2239)/100 + 21
2105 ius = mod((i - 2239), 100)
2106 IF(ius==0)THEN
2107 ius = 100
2108 ii = ii -1
2109 ENDIF
2110 WRITE(mes,'(A,I2,A,I3,A)')
2111 . 'User Var',ii,'(Layer',ius,')'
2112 CALL ANI_TXT(MES,20)
2113 ENDIF
2114 ENDDO
2115
2116 DO I=10140,10239
2117 IF(ANIM_CE(I)==1)THEN
2118 II = I - 10139
2119 WRITE(MES,'(a,i3,a)')
2120 . 'phi,(layer ',II,')'
2121 CALL ANI_TXT(MES,16)
2122 ENDIF
2123 ENDDO
2124 IF(ANIM_CE(10240)==1) CALL ANI_TXT('inter
ply -
min-damage
',22)
2125 IF(ANIM_CE(10241)==1) CALL ANI_TXT('inter
ply -sigzz
',16)
2126 IF(ANIM_CE(10242)==1) CALL ANI_TXT('inter
ply -sigyz
',16)
2127 IF(ANIM_CE(10243)==1) CALL ANI_TXT('inter
ply -sigxz
',16)
2128 IF(ANIM_CE(10244)==1) CALL ANI_TXT('inter
ply -epszz
',16)
2129 IF(ANIM_CE(10245)==1) CALL ANI_TXT('inter
ply -epsyz
',16)
2130 IF(ANIM_CE(10246)==1) CALL ANI_TXT('inter
ply -epsxz
',16)
2131 IF(ANIM_CE(10247)==1) CALL ANI_TXT('inter
ply -eint
',15)
2132 IF(ANIM_CE(10248)==1) CALL ANI_TXT('volumetric fraction 1',21)
2133 IF(ANIM_CE(10249)==1) CALL ANI_TXT('volumetric fraction 2',21)
2134 IF(ANIM_CE(10250)==1) CALL ANI_TXT('volumetric fraction 3',21)
2135 IF(ANIM_CE(10251)==1) CALL ANI_TXT('volumetric fraction 4',21)
2136 IF(ANIM_CE(10252)==1) CALL ANI_TXT('burn fraction',13)
2137
2138
2139
2140 IF(ANIM_CE(10253)==1) CALL ANI_TXT('nxt failure factor',18)
2141 IF(ANIM_CE(10254)==1) CALL ANI_TXT('sigma1/h',8)
2142 IF(ANIM_CE(10255)==1) CALL ANI_TXT('sigma2/h',8)
2143
2144
2145
2146 IF(ANIM_CE(10256)==1) CALL ANI_TXT('max damage element
',18)
2147 IF(ANIM_CE(10257)==1) CALL ANI_TXT('max damage upper
',16)
2148 IF(ANIM_CE(10258)==1) CALL ANI_TXT('max damage lower
',16)
2149 IF(ANIM_CE(10259)==1) CALL ANI_TXT('max damage membrane
',19)
2150 DO I=10260,10359
2151 IF(ANIM_CE(I)==1)THEN
2152 II = I - 10259
2153 WRITE(MES,'(a,i3,a)')
2154 . 'damage,(layer ',II,')'
2155 CALL ANI_TXT(MES,20)
2156 ENDIF
2157 ENDDO
2158 IF(ANIM_CE(10360)==1) CALL ANI_TXT('nxt failure factor upper',24)
2159 IF(ANIM_CE(10361)==1) CALL ANI_TXT('nxt failure factor lower',24)
2160 IF(ANIM_CE(10362)==1) CALL ANI_TXT('nxt failure factor membrane',27)
2161 DO I=10363,10462
2162 IF(ANIM_CE(I)==1)THEN
2163 II = I - 10362
2164 WRITE(MES,'(a,i3,a)')
2165 . 'nxt failure factor,(layer ',II,')'
2166 CALL ANI_TXT(MES,32)
2167 ENDIF
2168 ENDDO
2169 IF(ANIM_CE(10463)==1) CALL ANI_TXT('sigma1/h upper',14)
2170 IF(ANIM_CE(10464)==1) CALL ANI_TXT('sigma1/h lower',14)
2171 IF(ANIM_CE(10465)==1) CALL ANI_TXT('sigma1/h membrane',17)
2172 DO I=10466,10565
2173 IF(ANIM_CE(I)==1)THEN
2174 II = I - 10465
2175 WRITE(MES,'(a,i3,a)')
2176 . 'sigma1/h,(layer ',II,')'
2177 CALL ANI_TXT(MES,22)
2178 ENDIF
2179 ENDDO
2180 IF(ANIM_CE(10566)==1) CALL ANI_TXT('sigma2/h upper',14)
2181 IF(ANIM_CE(10567)==1) CALL ANI_TXT('sigma2/h lower',14)
2182 IF(ANIM_CE(10568)==1) CALL ANI_TXT('sigma2/h membrane',17)
2183 DO I=10569,10668
2184 IF(ANIM_CE(I)==1)THEN
2185 II = I - 10568
2186 WRITE(MES,'(a,i3,a)')
2187 . 'sigma2/h,(layer ',II,')'
2188 CALL ANI_TXT(MES,22)
2189 ENDIF
2190 ENDDO
2191 IF(ANIM_CE(10669)==1)CALL ANI_TXT('inter
ply -
max-damage
',22)
2192 IF(ANIM_CE(10670)==1)CALL ANI_TXT('time deletion element',21)
2193 IF(ANIM_CE(10671)==1)CALL ANI_TXT('sound speed',11)
2194 IF(ANIM_CE(10672)==1)CALL ANI_TXT('schlieren',9)
2195 IF(ANIM_CE(10673)==1)CALL ANI_TXT('phi membrane',12)
2196 IF(ANIM_CE(10674)==1)CALL ANI_TXT('phi upper',9)
2197 IF(ANIM_CE(10675)==1)CALL ANI_TXT('phi lower',9)
2198 IF(ANIM_CE(10676)==1)CALL ANI_TXT('domain',6)
2199
2200
2201
2202 IF(ANIM_CE(10677)==1)CALL ANI_TXT('equiv stress',12)
2203
2204
2205
2206
2207 DO I=10678,10777
2208 IF (ANIM_CE(I) == 1) THEN
2209 IUS = MOD ((I - 10677), 100)
2210 IF(IUS==0) IUS = 100
2211 WRITE(MES,'(a,i3,a)')
2212 . 'plastic strain upper layer',IUS, ' '
2213 CALL ANI_TXT(MES,30)
2214 END IF
2215 END DO
2216
2217 DO I=10778,10877
2218 IF (ANIM_CE(I) == 1) THEN
2219 IUS = MOD ((I - 10777), 100)
2220 IF(IUS==0) IUS = 100
2221 WRITE(MES,'(a,i3,a)')
2222 . 'plastic strain lower layer',IUS, ' '
2223 CALL ANI_TXT(MES,30)
2224 END IF
2225 END DO
2226
2227 DO I=1,100
2228 DO J=1,10
2229 IUS = 10*I+J
2230 IF (ANIM_CE(IUS + 10877) == 1) THEN
2231 ILAY = I
2232 IPT = J
2233 WRITE(MES,'(a,i4,i3,a)')
2234 . 'plast strn layer/ipt ',ILAY,IPT, ' '
2235 CALL ANI_TXT(MES,29)
2236 END IF
2237 ENDDO
2238 ENDDO
2239
2240
2241
2242 IF(ANIM_CE(11888)==1)CALL ANI_TXT('artificial viscosity',20) !previous PID uses ANIM_CE(10678:11887)
2243 IF(ANIM_CE(11889)==1)CALL ANI_TXT('detonation time',15)
2244
2245 !multumaterial law 20 ouptus
2246 IF(ANIM_CE(11890)==1)CALL ANI_TXT('density-1',9)
2247 IF(ANIM_CE(11891)==1)CALL ANI_TXT('density-2',9)
2248 IF(ANIM_CE(11892)==1)CALL ANI_TXT('density-3',9)
2249 IF(ANIM_CE(11893)==1)CALL ANI_TXT('density-4',9)
2250
2251 IF(ANIM_CE(11894)==1)CALL ANI_TXT('specific energy-1',17)
2252 IF(ANIM_CE(11895)==1)CALL ANI_TXT('specific energy-2',17)
2253 IF(ANIM_CE(11896)==1)CALL ANI_TXT('specific energy-3',17)
2254 IF(ANIM_CE(11897)==1)CALL ANI_TXT('specific energy-4',17)
2255
2256 IF(ANIM_CE(11898)==1)CALL ANI_TXT('temperature-1',13)
2257 IF(ANIM_CE(11899)==1)CALL ANI_TXT('temperature-2',13)
2258 IF(ANIM_CE(11900)==1)CALL ANI_TXT('temperature-3',13)
2259 IF(ANIM_CE(11901)==1)CALL ANI_TXT('temperature-4',13)
2260
2261 IF(ANIM_CE(11902)==1)CALL ANI_TXT('pressure-1',10)
2262 IF(ANIM_CE(11903)==1)CALL ANI_TXT('pressure-2',10)
2263 IF(ANIM_CE(11904)==1)CALL ANI_TXT('pressure-3',10)
2264 IF(ANIM_CE(11905)==1)CALL ANI_TXT('pressure-4',10)
2265
2266 IF(ANIM_CE(11906)==1)CALL ANI_TXT('plastic strain-1',16)
2267 IF(ANIM_CE(11907)==1)CALL ANI_TXT('plastic strain-2',16)
2268 IF(ANIM_CE(11908)==1)CALL ANI_TXT('plastic strain-3',16)
2269 IF(ANIM_CE(11909)==1)CALL ANI_TXT('plastic strain-4',16)
2270
2271 IF(ANIM_CE(11910)==1)CALL ANI_TXT('sound speed-1',13)
2272 IF(ANIM_CE(11911)==1)CALL ANI_TXT('sound speed-2',13)
2273 IF(ANIM_CE(11912)==1)CALL ANI_TXT('sound speed-3',13)
2274 IF(ANIM_CE(11913)==1)CALL ANI_TXT('sound speed-4',13)
2275
2276 IF(ANIM_CE(11914)==1)CALL ANI_TXT('volume-1',8)
2277 IF(ANIM_CE(11915)==1)CALL ANI_TXT('volume-2',8)
2278 IF(ANIM_CE(11916)==1)CALL ANI_TXT('volume-3',8)
2279 IF(ANIM_CE(11917)==1)CALL ANI_TXT('volume-4',8)
2280
2281 IF(ANIM_CE(11918)==1)CALL ANI_TXT('mass-1',6)
2282 IF(ANIM_CE(11919)==1)CALL ANI_TXT('mass-2',6)
2283 IF(ANIM_CE(11920)==1)CALL ANI_TXT('mass-3',6)
2284 IF(ANIM_CE(11921)==1)CALL ANI_TXT('mass-4',6)
2285
2286 IF(ANIM_CE(11922)==1)CALL ANI_TXT('artificial viscosity-1',22)
2287 IF(ANIM_CE(11923)==1)CALL ANI_TXT('artificial viscosity-2',22)
2288 IF(ANIM_CE(11924)==1)CALL ANI_TXT('artificial viscosity-3',22)
2289 IF(ANIM_CE(11925)==1)CALL ANI_TXT('artificial viscosity-4',22)
2290
2291
2292
2293
2294
2295 DO I=1,MX_PLY_ANIM
2296 IF(ANIM_CE(11925+I) == 1) THEN
2297 WRITE(MES,'(a,i10)')
2298 . 'ply_id ',PLY_ANIM( 3 * (I - 1) + 1)
2299 CALL ANI_TXT(MES,17)
2300 ENDIF
2301 ENDDO
2302
2303
2304
2305 DO I=1,MX_PLY_ANIM
2306 IF(ANIM_CE( (11925+MX_PLY_ANIM) +I) == 1) THEN
2307 WRITE(MES,'(a,i10,a)')
2308 . 'phi,(ply_id ',PLY_ANIM_PHI( 3 * (I - 1) + 1),')'
2309 CALL ANI_TXT(MES,23)
2310 ENDIF
2311 ENDDO
2312
2313
2314
2315 DO I=1,MX_PLY_ANIM
2316 IF(ANIM_CE( (11925+2*MX_PLY_ANIM) +I) == 1) THEN
2317 WRITE(MES,'(a,i10,a,i3)')
2318 . 'plas str
ply/ipt
',PLY_ANIM_EPSP( 3 * (I - 1) + 1),
2319 . ' ',PLY_ANIM_EPSP( 3 * (I - 1) + 3)
2320 CALL ANI_TXT(MES,30)
2321 ENDIF
2322 ENDDO
2323
2324
2325
2326 DO I=1,MX_PLY_ANIM
2327 IF(ANIM_CE( (11925+3*MX_PLY_ANIM) +I) == 1) THEN
2328 WRITE(MES,'(a,i10,a,i3)')
2329 . 'damage
ply/ipt
',PLY_ANIM_DAMA( 3 * (I - 1) + 1),
2330 . ' ',PLY_ANIM_DAMA( 3 * (I - 1) + 3)
2331 CALL ANI_TXT(MES,28)
2332 ENDIF
2333 ENDDO
2334
2335
2336
2337 IDX = 11925+4*MX_PLY_ANIM
2338 IF(ANIM_CE(IDX+1) == 1) CALL ANI_TXT('fld failure factor upper',24)
2339 IF(ANIM_CE(IDX+2) == 1) CALL ANI_TXT('fld failure factor lower',24)
2340 IF(ANIM_CE(IDX+3) == 1) CALL ANI_TXT('fld failure factor membrane',27)
2341
2342
2343
2344 IDX = 11925+4*MX_PLY_ANIM+3
2345 IF(ANIM_CE(IDX+1) == 1) CALL ANI_TXT('fld zone index upper',20)
2346 IF(ANIM_CE(IDX+2) == 1) CALL ANI_TXT('fld zone index lower',20)
2347 IF(ANIM_CE(IDX+3) == 1) CALL ANI_TXT('fld zone index membrane',23)
2348
2349
2350
2351
2352
2353 IDX = 11931+4*MX_PLY_ANIM
2354 DO I=IDX+1,IDX+100
2355 IF (ANIM_CE(I) == 1) THEN
2356 IUS = MOD ((I - IDX), 100)
2357 IF (IUS == 0) IUS = 100
2358 WRITE(MES,'(a,i3,a)')
2359 . 'max damage upper layer
',IUS, ' '
2360 CALL ANI_TXT(MES,26)
2361 ENDIF
2362 ENDDO
2363
2364 IDX = 12031+4*MX_PLY_ANIM
2365 DO I=IDX+1,IDX+100
2366 IF (ANIM_CE(I) == 1) THEN
2367 IUS = MOD ((I - IDX), 100)
2368 IF (IUS == 0) IUS = 100
2369 WRITE(MES,'(a,i3,a)')
2370 . 'max damage lower layer
',IUS, ' '
2371 CALL ANI_TXT(MES,26)
2372 ENDIF
2373 ENDDO
2374
2375 IDX = 12131+4*MX_PLY_ANIM
2376 DO I=IDX+1,IDX+100
2377 IF (ANIM_CE(I) == 1) THEN
2378 IUS = MOD ((I - IDX), 100)
2379 IF (IUS == 0) IUS = 100
2380 WRITE(MES,'(a,i3,a)')
2381 . 'max damage membrane layer
',IUS, ' '
2382 CALL ANI_TXT(MES,29)
2383 ENDIF
2384 ENDDO
2385
2386 IDX = 12231+4*MX_PLY_ANIM
2387 DO I=1,100
2388 DO J=1,10
2389 IUS = 10*I+J
2390 IF (ANIM_CE(IUS + IDX) == 1) THEN
2391 ILAY = I
2392 IPT = J
2393 WRITE(MES,'(a,i4,i3,a)')
2394 . 'max damage layer/ipt
',ILAY,IPT, ' '
2395 CALL ANI_TXT(MES,29)
2396 END IF
2397 ENDDO
2398 ENDDO
2399
2400 !/ANIM/ELEM/DT
2401 IDX = 4*MX_PLY_ANIM
2402 IF(ANIM_CE(IDX+13242)==1)CALL ANI_TXT('element time step',17)
2403
2404 !/ANIM/ELEM/AMS
2405 IDX = 4*MX_PLY_ANIM
2406 IF(ANIM_CE(IDX+13242+1)==1)CALL ANI_TXT('ams selection',13)
2407
2408 !/ANIM/ELEM/EINT
2409 IDX = 4*MX_PLY_ANIM
2410 IF(ANIM_CE(IDX+13242+2)==1)CALL ANI_TXT('internal energy',15)
2411 !/ANIM/ELEM/WPLA
2412 IDX = 4*MX_PLY_ANIM
2413 IF(ANIM_CE(IDX+13242+3)==1)CALL ANI_TXT('plastic work',12)
2414!!!
2415 IDX = 13245 + 4*MX_PLY_ANIM
2416 IF(ANIM_CE(IDX + 1)==1) CALL ANI_TXT('plastic work upper',18)
2417 IF(ANIM_CE(IDX + 2)==1) CALL ANI_TXT('plastic work lower',18)
2418 IDX = 13247 + 4*MX_PLY_ANIM
2419 DO I=1,100
2420 IF(ANIM_CE(IDX + I)==1)THEN
2421 IUS = I
2422 IF(IUS==0)IUS = 100
2423 WRITE(MES,'(a,i3,a)')
2424 . 'plast work layer ',IUS, ' '
2425 CALL ANI_TXT(MES,21)
2426 END IF
2427 END DO
2428
2429
2430
2431
2432
2433 IDX = 13347 + 4*MX_PLY_ANIM
2434 DO I=1,100
2435 IF (ANIM_CE(IDX + I) == 1) THEN
2436 IUS = I
2437 IF(IUS==0) IUS = 100
2438 WRITE(MES,'(a,i3,a)')
2439 . 'plastic work upper layer',IUS, ' '
2440 CALL ANI_TXT(MES,28)
2441 END IF
2442 END DO
2443
2444 IDX = 13447 + 4*MX_PLY_ANIM
2445 DO I=1,100
2446 IF (ANIM_CE(IDX + I) == 1) THEN
2447 IUS = I
2448 IF(IUS==0) IUS = 100
2449 WRITE(MES,'(a,i3,a)')
2450 . 'plastic work lower layer',IUS, ' '
2451 CALL ANI_TXT(MES,28)
2452 END IF
2453 END DO
2454
2455 IDX = 13547 + 4*MX_PLY_ANIM
2456 DO I=1,100
2457 DO J=1,10
2458 IUS = 10*(I-1)+J
2459 IF (ANIM_CE(IDX + IUS) == 1) THEN
2460 ILAY = I
2461 IPT = J
2462 WRITE(MES,'(a,i4,i3,a)')
2463 . 'plast work layer/ipt ',ILAY,IPT, ' '
2464 CALL ANI_TXT(MES,29)
2465 END IF
2466 ENDDO
2467 ENDDO
2468
2469 !-----------------------------------------------
2470 ! Element status ( OFF value in buffer :
2471 ! 0.0:deleted 1.0:activated 0.to1.0 under failure <0:Standby
2472 !-----------------------------------------------
2473 IDX = 13547 + 4*MX_PLY_ANIM +1000 +1
2474 IF(ANIM_CE(IDX) == 1) CALL ANI_TXT('element status',14)
2475
2476 IDX = 13547 + 4*MX_PLY_ANIM +1000 +2
2477 IF(ANIM_CE(IDX) == 1) CALL ANI_TXT('mach number',11)
2478
2479 IDX = 13547 + 4*MX_PLY_ANIM +1000 +3
2480 IF(ANIM_CE(IDX) == 1) CALL ANI_TXT('color function',14)
2481
2482 IDX = 13547 + 4*MX_PLY_ANIM +1000 +4
2483 IF(ANIM_CE(IDX)==1) CALL ANI_TXT('damage(mean value)',19)
2484 IF(ANIM_CE(IDX+1)==1) CALL ANI_TXT('damage(upper value)',20)
2485 IF(ANIM_CE(IDX+2)==1) CALL ANI_TXT('damage(lower value)',20)
2486 IF(ANIM_CE(IDX+3)==1) CALL ANI_TXT('damage(membrane value)',23)
2487 DO I=IDX+3+1,IDX+3+11
2488 IF(ANIM_CE(I)==1)THEN
2489 II = I - (IDX+3)
2490 WRITE(MES,'(a,i3,a)')
2491 . 'damage(thck. point ',II,' value)'
2492 CALL ANI_TXT(MES,30)
2493 ENDIF
2494 ENDDO
2495
2496 !---QUAD VOLUME
2497 IDX = IDX+3+11
2498 IDX = IDX+1 ! => IDX = 4*MX_PLY_ANIM + 14566
2499 IF(ANIM_CE(IDX) == 1) THEN
2500 CALL ANI_TXT('volume',6)
2501 ENDIF
2502
2503 !---NON LOCAL PLASTIC STRAIN
2504 IDX = 14567 + 4*MX_PLY_ANIM
2505 IF(ANIM_CE(IDX) == 1) CALL ANI_TXT('non-local plastic strain',24)
2506 IF(ANIM_CE(IDX+1) == 1) CALL ANI_TXT('non-local plastic strain(upper)',32)
2507 IF(ANIM_CE(IDX+2) == 1) CALL ANI_TXT('non-local plastic strain(lower)',32)
2508 DO I=IDX+2+1,IDX+2+11
2509 IF (ANIM_CE(I) == 1) THEN
2510 II = I - (IDX+2)
2511 WRITE(MES,'(a,i3,a)')
2512 . 'nloc plast at point ',II,' '
2513 CALL ANI_TXT(MES,30)
2514 ENDIF
2515 ENDDO
2516
2517 !---NON LOCAL PLASTIC STRAIN RATE
2518 IDX = 14581 + 4*MX_PLY_ANIM
2519 IF(ANIM_CE(IDX) == 1) CALL ANI_TXT('non-local plastic strain rate',29)
2520 IF(ANIM_CE(IDX+1) == 1) CALL ANI_TXT('non-local plastic strain rate(upper)',37)
2521 IF(ANIM_CE(IDX+2) == 1) CALL ANI_TXT('non-local plastic strain rate(lower)',37)
2522 DO I=IDX+2+1,IDX+2+11
2523 IF (ANIM_CE(I) == 1) THEN
2524 II = I - (IDX+2)
2525 WRITE(MES,'(a,i3,a)')'nloc rate at point ',II,' '
2526 CALL ANI_TXT(MES,30)
2527 ENDIF
2528 ENDDO
2529
2530
2531
2532
2533!/ANIM/ELEM/TSAIWU
2534 IDX = 14595 + 4*MX_PLY_ANIM
2535 IF(ANIM_CE(IDX )==1) CALL ANI_TXT('tsai-wu criterion' ,17)
2536 IF(ANIM_CE(IDX + 1)==1) CALL ANI_TXT('tsai-wu crit. upper',19)
2537 IF(ANIM_CE(IDX + 2)==1) CALL ANI_TXT('tsai-wu crit. lower',19)
2538 DO I=1,100
2539 IF(ANIM_CE(IDX + 2 + I)==1)THEN
2540 IUS = I
2541 IF(IUS==0) IUS = 100
2542 WRITE(MES,'(a,i3,a)')'tsai-wu crit. layer ',IUS, ' '
2543 CALL ANI_TXT(MES,24)
2544 END IF
2545 END DO
2546
2547
2548 IDX = 14697 + 4*MX_PLY_ANIM
2549 DO I=1,100
2550 IF (ANIM_CE(IDX + I) == 1) THEN
2551 IUS = I
2552 IF(IUS==0) IUS = 100
2553 WRITE(MES,'(a,i3,a)')'Tsai-Wu Crit. Upper Layer',ius, ' '
2555 END IF
2556 END DO
2557
2558 idx = 14797 + 4*mx_ply_anim
2559 DO i=1,100
2560 IF (anim_ce(idx + i) == 1) THEN
2561 ius = i
2562 IF(ius==0) ius = 100
2563 WRITE(mes,'(A,I3,A)')'Tsai-Wu Crit. Lower Layer',ius, ' '
2565 END IF
2566 END DO
2567
2568 idx = 14897 + 4*mx_ply_anim
2569 DO i=1,100
2570 DO j=1,10
2571 ius = 10*(i-1)+j
2572 IF (anim_ce(idx + ius) == 1) THEN
2573 ilay = i
2574 ipt = j
2575 WRITE(mes,'(A,I4,I3,A)')'Tsai-Wu Crit. Lay/IPT ',ilay' '
2577 END IF
2578 ENDDO
2579 ENDDO
2580
2581
2582 idx = 15898 + 4*mx_ply_anim
2583 IF(anim_ce(idx) == 1)
CALL ani_txt(
'Region identifier in p,v diagram',32)
2584
2585
2586 idx=idx+1;
IF(anim_ce(idx) == 1)
CALL ani_txt(
'Volumetric Strain'
2587 idx=idx+1;
IF(anim_ce(idx) == 1)
CALL ani_txt(
'Volumetric Strain - 1'
2588 idx=idx+1;
IF(anim_ce(idx) == 1)
CALL ani_txt(
'Volumetric Strain - 2',21)
2589 idx=idx+1;
IF(anim_ce(idx) == 1)
CALL ani_txt(
'Volumetric Strain - 3',21)
2590 idx=idx+1;
IF(anim_ce(idx) == 1)
CALL ani_txt(
'Volumetric Strain - 4',21)
2591 idx=idx+1;
IF(anim_ce(idx) == 1)
CALL ani_txt(
'Volumetric Strain - 5',21)
2592 idx=idx+1;
IF(anim_ce(idx) == 1)
CALL ani_txt(
'Volumetric Strain - 6',21)
2593 idx=idx+1;
IF(anim_ce(idx) == 1)
CALL ani_txt(
'Volumetric Strain - 7',21)
2594 idx=idx+1;
IF(anim_ce(idx) == 1)
CALL ani_txt(
'Volumetric Strain - 8',21)
2595 idx=idx+1;
IF(anim_ce(idx) == 1)
CALL ani_txt(
'Volumetric Strain - 9',21)
2596 idx=idx+1;
IF(anim_ce(idx) == 1)
CALL ani_txt(
'Volumetric Strain - 10',22)
2597
2598
2599
2600
2601 ENDIF
2602
2603 ENDIF
2604
2605
2606
2607 k = 0
2608 iad_gp2=iad_gps+100
2609 iad_gp3=iad_gp2+100
2610 iad_iso=iad_gp3+100
2611 iad_gp4=iad_iso+100
2612 DO i = 1,mx_ani
2613 ifunc = i
2614 IF (i==(iad_gps+3).OR.i==(iad_gps+9).OR.i==(iad_gps+15)
2615 . .OR.i==(iad_gp2+3).OR.i==(iad_gp2+9)
2616 . .OR.i==(iad_gp2+15) .OR.i==(iad_gp3+1).OR.i=
2617 . ifirst=0
2618 IF(anim_n(i)/=1) cycle
2619 DO n=1,numnod
2620 wa4(n) = zero
2621 ENDDO
2622 IF(i<3.OR.i==12)THEN
2623 DO n=1,numnod
2624 wa4(n)=anin(n+k)
2625 ENDDO
2626 k = k + numnod
2627 ELSEIF(i>=3.AND.i<=11 .OR. i==30) THEN
2628 IF(i == 6 .AND. (glob_therm%ITHERM_FE > 0 )) THEN
2629 DO n=1,numnod
2630 wa4(n)=temp(n)
2631 ENDDO
2632 ELSE
2633
2634 IF (i==3) THEN
2635 IF(n2d==0)
CALL nodalp(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixs,nixs,numels,itab,nv46,monvol,volmon,
2636 . 0, is_written_node, is_written_node_fvm, ispmd,
fvdata, swa4, 0)
2637 IF(n2d/=0)
CALL nodalp(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixq,nixq,numelq,itab,nv46,monvol,volmon,
2638 . 0, is_written_node, is_written_node_fvm, ispmd,
fvdata, swa4, 0)
2639 ENDIF
2640
2641 IF (i==4) THEN
2642 IF(n2d==0)
CALL nodald(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixs,nixs,numels,itab,nv46,monvol,volmon,
2643 . 0, is_written_node, is_written_node_fvm, ispmd,
fvdata, swa4, 0)
2644 IF(n2d/=0)
CALL nodald(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixq,nixq,numelq,itab,nv46,monvol,volmon,
2645 . 0, is_written_node, is_written_node_fvm, ispmd,
fvdata, swa4, 0)
2646 ENDIF
2647
2648 IF (i==6) THEN
2649 IF(n2d==0)
CALL nodalt(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixs,nixs,numels,itab,nv46,monvol,volmon,
2650 . 0, is_written_node, is_written_node_fvm, ispmd,
fvdata, swa4, 0)
2651 IF(n2d/=0)
CALL nodalt(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixq,nixq,numelq,itab,nv46,monvol,volmon,
2652 . 0, is_written_node, is_written_node_fvm, ispmd,
fvdata, swa4, 0)
2653 ENDIF
2654
2655 IF (i==30) THEN
2656 IF(n2d==0)
CALL nodalssp(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixs,nixs,numels,itab,nv46,monvol,volmon,
2657 . 0, is_written_node, is_written_node_fvm, ispmd,
fvdata, swa4, 0, multi_fvm)
2658 IF(n2d/=0)
CALL nodalssp(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixq,nixq,numelq,itab,nv46,monvol,volmon,
2659 . 0, is_written_node, is_written_node_fvm, ispmd,
fvdata
2660 ENDIF
2661
2662
2663
2664 CALL animbale(i, wa4,is_written_node, monvol, volmon ,2,
2665 . numnod, nimv, nvolu, nrvolu, licbag, libagjet,
2666 . libaghol, lrcbag, lrbagjet, lrbaghol, nspmd)
2667
2668 ENDIF
2669
2670
2671 ELSEIF (i==13) THEN
2672 CALL nodalp(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixs,nixs,numels,itab,nv46,monvol,volmon,
2673 . 0, is_written_node, is_written_node_fvm, ispmd,
fvdata, swa4, 0)
2674
2675
2676 ELSEIF(i==14)THEN
2677 IF(idtmins==0)THEN
2678 DO n=1,numnod
2679 wa4(n)=zero
2680 ENDDO
2681 ELSE
2682 DO n=1,numnod
2683 wa4(n)=
max(zero,diag_sms(n)/
max(em20,ms(n))-one)
2684 ENDDO
2685 END IF
2686
2687 ELSEIF(i==15)THEN
2688 DO n=1,numnod
2689 wa4(n)=pdama2(1,n)
2690 ENDDO
2691 ELSEIF(i==16)THEN
2692 DO n=1,numnod
2693 wa4(n)=pdama2(2,n)
2694 ENDDO
2695 ELSEIF(i==17)THEN
2696 CALL nodal_schlieren(wa4,x,ixs,ixq,itab,iparg,0,elbuf_tab,ale_connectivity)
2697 ELSEIF(i==18)THEN
2698 IF(iroddl/=0)THEN
2699 DO n=1,numnod
2700 wa4(n)=stifr(n)
2701 ENDDO
2702 ELSE
2703 DO n=1,numnod
2704 wa4(n)=zero
2705 ENDDO
2706 ENDIF
2707
2708
2709 ELSEIF (i > iadchksum .AND. i < iadchksum + 256 -1) THEN
2710 DO j=1,256
2711 IF (i == iadchksum + j) THEN
2712
2713 DO n=1,numnod
2714 wa4(n) = zero
2715 ENDDO
2716 ENDIF
2717 ENDDO
2718
2719 ELSEIF(i==19)THEN
2720 DO n=1,numnod
2721 wa4(n)=stifn(n)
2722 ENDDO
2723 ELSEIF(i>=20 .AND. i<=23)THEN
2724
2725 IF(n2d==0)
CALL nodalvfrac(i, wa4, iflow, rflow,iparg,elbuf_tab,ixs,nixs,itab,nv46)
2726 IF(n2d/=0)
CALL nodalvfrac(i, wa4, iflow, rflow,iparg,elbuf_tab,ixq,nixq,itab,nv46)
2727 ELSEIF(i>=24 .AND. i<=27)THEN
2728
2729
2730 ELSEIF(i==28.OR.i==29)THEN
2731
2732 IF(n2d==0)
CALL nodalzvol(i, wa4, iflow, rflow,iparg,elbuf_tab,ixs,nixs,itab,nv46)
2733 ELSEIF(i==31)THEN
2734
2735 IF(n2d == 0)THEN
2736 IF(anim_has_noda_pext == 1)THEN
2737 DO n=1,numnod
2738 IF(noda_surf(n) > zero)THEN
2739 wa4(n) = noda_pext(n) / noda_surf(n)
2740 ENDIF
2741 ENDDO
2742 ENDIF
2743 ENDIF
2744
2745 ELSEIF (i>iad_gps.AND.i<(iad_gps+3)) THEN
2746 DO n=1,numnod
2747 itagps(n) = 0
2748 wgps(n) = zero
2749 ENDDO
2750 j = i - iad_gps
2751
2752 CALL dfungps1(elbuf_tab ,wgps ,j ,iparg ,geo ,
2753 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
2754 . ixc ,ixtg ,ixt ,ixp ,ixr ,
2755 . itagps )
2756
2757
2758 IF(nspmd > 1)THEN
2759 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2762 ENDIF
2763
2764
2765 DO n=1,numnod
2766 IF (itagps(n)>0) wa4(n)=wgps(n)/itagps(n)
2767 ENDDO
2768 ELSEIF (i>(iad_gps+2).AND.i<(iad_gps+9)) THEN
2769 ifirst=ifirst+1
2770 IF (ifirst==1) THEN
2771 DO n=1,numnod
2772 itagps(n) = 0
2773 ENDDO
2774 DO j=1,3
2775 DO n=1,numnod
2776 vflu(j,n) = zero
2777 aflu(j,n) = zero
2778 ENDDO
2779 ENDDO
2780 CALL tensgps1(vflu ,aflu ,iparg ,geo ,
2781 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
2782 . ixc ,ixtg ,ixt ,ixp ,ixr ,
2783 . x ,itagps ,elbuf_tab)
2784 ENDIF
2785 j = i-(iad_gps+2)
2786
2787 IF(nspmd > 1)THEN
2788 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2790 IF (j<=3) THEN
2792 ELSE
2794 ENDIF
2795 ENDIF
2796
2797
2798 IF (j<=3) THEN
2799 DO n=1,numnod
2800 IF (itagps(n)>0) wa4(n)=vflu(j,n)/itagps(n)
2801 ENDDO
2802 ELSE
2803 DO n=1,numnod
2804 IF (itagps(n)>0) wa4(n)=aflu(j-3,n)/itagps(n)
2805 ENDDO
2806 ENDIF
2807
2808 ELSEIF (i>(iad_gps+8).AND.i<(iad_gps+15)) THEN
2809 ifirst=ifirst+1
2810 IF (ifirst==1) THEN
2811 iul = 1
2812 DO n=1,numnod
2813 itagps(n) = 0
2814 ENDDO
2815 DO j=1,3
2816 DO n=1,numnod
2817 vflu(j,n) = zero
2818 aflu(j,n) = zero
2819 ENDDO
2820 ENDDO
2821 CALL tencgps1(elbuf_tab ,iparg,iul ,vflu ,aflu ,
2822 . x ,ixc ,igeo ,ixtg ,itagps )
2823 ENDIF
2824 j = i-(iad_gps+8)
2825
2826 IF(nspmd > 1)THEN
2827 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2829 IF (j<=3) THEN
2831 ELSE
2833 ENDIF
2834 ENDIF
2835
2836
2837 IF (j<=3) THEN
2838 DO n=1,numnod
2839 IF (itagps(n)>0) wa4(n)=vflu(j,n)/itagps(n)
2840 ENDDO
2841 ELSE
2842 DO n=1,numnod
2843 IF (itagps(n)>0) wa4(n)=aflu(j-3,n)/itagps(n)
2844 ENDDO
2845 ENDIF
2846 ELSEIF (i>(iad_gps+14).AND.i<(iad_gps+21)) THEN
2847 ifirst=ifirst+1
2848 IF (ifirst==1) THEN
2849 iul = 2
2850 DO n=1,numnod
2851 itagps(n) = 0
2852 ENDDO
2853 DO j=1,3
2854 DO n=1,numnod
2855 vflu(j,n) = zero
2856 aflu(j,n) = zero
2857 ENDDO
2858 ENDDO
2859 CALL tencgps1(elbuf_tab ,iparg,iul ,vflu ,aflu ,
2860 . x ,ixc ,igeo ,ixtg ,itagps )
2861 ENDIF
2862 j = i-(iad_gps+14)
2863
2864 IF(nspmd > 1)THEN
2865 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2867 IF (j<=3) THEN
2869 ELSE
2871 ENDIF
2872 ENDIF
2873
2874
2875 IF (j<=3) THEN
2876 DO n=1,numnod
2877 IF (itagps(n)>0) wa4(n)=vflu(j,n)/itagps(n)
2878 ENDDO
2879 ELSE
2880 DO n=1,numnod
2881 IF (itagps(n)>0) wa4(n)=aflu(j-3,n)/itagps(n)
2882 ENDDO
2883 ENDIF
2884
2885 ELSEIF (i>iad_gp2.AND.i<(iad_gp2+3)) THEN
2886 DO n=1,numnod
2887 vgps(n) = zero
2888 wgps(n) = zero
2889 ENDDO
2890 j = i - iad_gp2
2891 CALL dfungps2(elbuf_tab ,wgps ,j ,iparg ,geo ,
2892 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
2893 . ixc ,ixtg ,ixt ,ixp ,ixr ,
2894 . x ,vgps )
2895
2896
2897 IF(nspmd > 1)THEN
2898 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2901 ENDIF
2902
2903
2904 DO n=1,numnod
2905 IF (vgps(n)>zero) wa4(n)=wgps(n)/vgps(n)
2906 ENDDO
2907 ELSEIF (i>(iad_gp2+2).AND.i<(iad_gp2+9)) THEN
2908 ifirst=ifirst+1
2909 IF (ifirst==1) THEN
2910 DO n=1,numnod
2911 vgps(n) = zero
2912 ENDDO
2913 DO j=1,3
2914 DO n=1,numnod
2915 vflu(j,n) = zero
2916 aflu(j,n) = zero
2917 ENDDO
2918 ENDDO
2919 CALL tensgps2(vflu ,aflu ,iparg ,geo ,
2920 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
2921 . ixc ,ixtg ,ixt ,ixp ,ixr ,
2922 . x ,vgps ,elbuf_tab )
2923 ENDIF
2924 j = i-(iad_gp2+2)
2925
2926
2927 IF(nspmd > 1)THEN
2928 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2930 IF (j<=3) THEN
2932 ELSE
2934 ENDIF
2935 ENDIF
2936
2937
2938 IF (j<=3) THEN
2939 DO n=1,numnod
2940 IF (vgps(n)>zero) wa4(n)=vflu(j,n)/vgps(n)
2941 ENDDO
2942 ELSE
2943 DO n=1,numnod
2944 IF (vgps(n)>zero) wa4(n)=aflu(j-3,n)/vgps(n)
2945 ENDDO
2946 ENDIF
2947
2948 ELSEIF (i>(iad_gp2+8).AND.i<(iad_gp2+15)) THEN
2949 ifirst=ifirst+1
2950 IF (ifirst==1) THEN
2951 iul = 1
2952 DO n=1,numnod
2953 vgps(n) = zero
2954 ENDDO
2955 DO j=1,3
2956 DO n=1,numnod
2957 vflu(j,n) = zero
2958 aflu(j,n) = zero
2959 ENDDO
2960 ENDDO
2961 CALL tencgps2(elbuf_tab ,iparg,iul ,vflu ,aflu ,
2962 . x ,ixc ,igeo ,ixtg ,geo ,
2963 . vgps )
2964 ENDIF
2965 j = i-(iad_gp2+8)
2966
2967 IF(nspmd > 1)THEN
2968 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2970 IF (j<=3) THEN
2972 ELSE
2974 ENDIF
2975 ENDIF
2976
2977 IF (j<=3) THEN
2978 DO n=1,numnod
2979 IF (vgps(n)>zero) wa4(n)=vflu(j,n)/vgps(n)
2980 ENDDO
2981 ELSE
2982 DO n=1,numnod
2983 IF (vgps(n)>zero) wa4(n)=aflu(j-3,n)/vgps(n)
2984 ENDDO
2985 ENDIF
2986 ELSEIF (i>(iad_gp2+14).AND.i<(iad_gp2+21)) THEN
2987 ifirst=ifirst+1
2988 IF (ifirst==1) THEN
2989 iul = 2
2990 DO n=1,numnod
2991 vgps(n) = zero
2992 ENDDO
2993 DO j=1,3
2994 DO n=1,numnod
2995 vflu(j,n) = zero
2996 aflu(j,n) = zero
2997 ENDDO
2998 ENDDO
2999 CALL tencgps2(elbuf_tab ,iparg,iul ,vflu ,aflu ,
3000 . x ,ixc ,igeo ,ixtg ,geo ,
3001 . vgps )
3002 ENDIF
3003 j = i-(iad_gp2+14)
3004
3005 IF(nspmd > 1)THEN
3006 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
3008 IF (j<=3) THEN
3010 ELSE
3012 ENDIF
3013 ENDIF
3014
3015
3016 IF (j<=3) THEN
3017 DO n=1,numnod
3018 IF (vgps(n)>zero) wa4(n)=vflu(j,n)/vgps(n)
3019 ENDDO
3020 ELSE
3021 DO n=1,numnod
3022 IF (vgps(n)>zero) wa4(n)=aflu(j-3,n)/vgps(n)
3023 ENDDO
3024 ENDIF
3025 ELSEIF (i>(iad_gp3).AND.i<(iad_gp3+7)) THEN
3026
3027
3028 ifirst=ifirst+1
3029 IF (ifirst==1) THEN
3030 DO n=1,numnod
3031 itagps(n) = 0
3032 ENDDO
3033 DO j=1,3
3034 DO n=1,numnod
3035 vflu(j,n) = zero
3036 aflu(j,n) = zero
3037 ENDDO
3038 ENDDO
3039 CALL tensgps3(elbuf_tab,vflu ,aflu ,iparg ,geo ,
3040 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
3041 . ixc ,ixtg ,ixt ,ixp ,ixr ,
3042 . x ,itagps ,pm)
3043 ENDIF
3044 j = i-iad_gp3
3045
3046 IF(nspmd > 1)THEN
3047 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
3049 IF (j<=3) THEN
3051 ELSE
3053 ENDIF
3054 ENDIF
3055
3056
3057 IF (j<=3) THEN
3058 DO n=1,numnod
3059 IF (itagps(n)>0) wa4(n)=vflu(j,n)/itagps(n)
3060 ENDDO
3061 ELSE
3062 DO n=1,numnod
3063 IF (itagps(n)>0) wa4(n)=aflu(j-3,n)/itagps(n)
3064 ENDDO
3065 ENDIF
3066 ELSEIF (i>(iad_iso).AND.i<(iad_iso+7)) THEN
3067
3068 DO n=1,64*numelig3d
3069 wa4(numnod + n)=tabstresl(i-iad_iso,n)
3070 ENDDO
3071 ELSEIF (i>(iad_gp4).AND.i<(iad_gp4+7)) THEN
3072
3073
3074 ifirst=ifirst+1
3075 IF (ifirst==1) THEN
3076 DO n=1,numnod
3077 itagps(n) = 0
3078 ENDDO
3079 DO j=1,3
3080 DO n=1,numnod
3081 vflu(j,n) = zero
3082 aflu(j,n) = zero
3083 ENDDO
3084 ENDDO
3086 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
3087 . ixc ,ixtg ,ixt ,ixp ,ixr ,
3088 . x ,itagps ,pm )
3089
3090
3091 ENDIF
3092
3093 j = i-iad_gp4
3094
3095 IF(nspmd > 1)THEN
3096 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
3098 IF (j<=3) THEN
3100 ELSE
3102 ENDIF
3103 ENDIF
3104
3105
3106 IF (j<=3) THEN
3107 DO n=1,numnod
3108 IF (itagps(n)>0) wa4(n)=vflu(j,n)/itagps(n)
3109 ENDDO
3110 ELSE
3111 DO n=1,numnod
3112 IF (itagps(n)>0) wa4(n)=aflu(j-3,n)/itagps(n)
3113 ENDDO
3114 ENDIF
3115
3116
3117 ENDIF
3118
3119
3120 IF (nspmd == 1) THEN
3121 IF (numelig3d /= 0) THEN
3122 DO j=1,numnod + 64*numelig3d
3124 ENDDO
3125 ELSE
3126 DO j=1,numnod
3128 ENDDO
3129 ENDIF
3130 ELSE
3131 IF (ispmd==0) THEN
3133 ELSE
3135 END IF
3136 END IF
3137 r4 = zero
3138 IF(ncuts>0) THEN
3139 IF (i<3.OR.i==12) THEN
3140 CALL cutfunc(anin(k+1),icbuf(mic2),cbuf(mac2),nodcut)
3141 ELSE
3142 DO n=1,nodcut
3144 ENDDO
3145 ENDIF
3146 ENDIF
3147 IF (ispmd==0) THEN
3148 DO n=1,nsect+nrwall+nnwl+nnsrg+nnsmd+nnsphg+2*numels16g
3150 ENDDO
3151 ENDIF
3152
3153 IF(ispmd == 0. and. anim_ply >0 ) THEN
3154 r4 = zero
3155 DO n=1,nfnod_pxfemg
3157 ENDDO
3158 ENDIF
3159
3160 IF(ispmd == 0 .AND. anim_crk > 0)THEN
3161 r4 = zero
3162 DO n=1,nfnod_crkxfemg
3164 ENDDO
3165 ENDIF
3166
3167
3168 IF (ispmd==0.AND.nfvnod>0) THEN
3169 r4=zero
3170 DO n=1,nfvnod+3
3172 ENDDO
3173 ENDIF
3174 ENDDO
3175
3176
3177
3178 ndma2= numnod*(
min(1,anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT)
3179 . +
min(1,anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS)
3180 . +
min(1,anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER))
3181
3182 IF (nspmd == 1 .AND. nfvtr>0) THEN
3183 ALLOCATE(fvmass(nfvtr),fvpres(nfvtr), fvqx(nfvtr),
3184 . fvqy(nfvtr), fvqz(nfvtr), fvrho(nfvtr),
3185 . fvener(nfvtr), fvcson(nfvtr), fvgama(nfvtr),
3186 . fvvisu(nfvtr))
3187 DO i=1,nfvtr
3188 fvmass(i)=zero
3189 fvpres(i)=zero
3190 fvqx(i)=zero
3191 fvqy(i)=zero
3192 fvqz(i)=zero
3193 fvrho(i)=zero
3194 fvener(i)=zero
3195 fvcson(i)=zero
3196 fvgama(i)=zero
3197 fvvisu(i)=zero
3198 ENDDO
3199
3202 IF (
fvdata(i)%NPOLH_ANIM>0)
THEN
3203
3206 ssp=sqrt((gama-one)*gama*
fvdata(i)%EPOLH(j)/
3210 DO n=
fvdata(i)%IFVTADR(kk),
3211 .
fvdata(i)%IFVTADR(kk+1)-1
3213 fac=one
3214 IF (
fvdata(i)%IFVTRI(4,nn)>0)
THEN
3216 fvvisu(fvel2fa(
eloff+nn))=idp-(idp/8)*8+1
3217 ELSE
3218 fvvisu(fvel2fa(
eloff+nn))=-1
3219 fac=half
3220 ENDIF
3221 nn=fvel2fa(
eloff+nn)
3222 fvmass(nn)=fvmass(nn)+fac*
fvdata(i)%MPOLH(j)
3223 fvpres(nn)=fvpres(nn)+fac*
fvdata(i)%PPOLH(j)
3224 IF (
fvdata(i)%MPOLH(j)>zero)
THEN
3225 fvqx(nn)=fvqx(nn)+fac*
fvdata(i)%QPOLH(1,j)/
3227 fvqy(nn)=fvqy(nn)+fac*
fvdata(i)%QPOLH(2,j)/
3229 fvqz(nn)=fvqz(nn)+fac*
fvdata(i)%QPOLH(3,j)/
3231 fvener(nn)=fvener(nn)+fac*
fvdata(i)%EPOLH(j)/
3233 ENDIF
3234 fvrho(nn)=fvrho(nn)+fac*
fvdata(i)%RPOLH(j)
3235 fvcson(nn)=fvcson(nn)+fac*ssp
3236 fvgama(nn)=fvgama(nn)+fac*gama
3237 ENDDO
3238 ENDDO
3239 ENDDO
3241 ENDIF
3242 ENDDO
3243 ELSEIF(nfvtr>0) THEN
3244 IF (ispmd==0) THEN
3245 ALLOCATE(fvmass(nfvtr),fvpres(nfvtr), fvqx(nfvtr),
3246 . fvqy(nfvtr), fvqz(nfvtr), fvrho(nfvtr),
3247 . fvener(nfvtr), fvcson(nfvtr), fvgama(nfvtr),
3248 . fvvisu(nfvtr))
3249 DO i=1,nfvtr
3250 fvmass(i)=zero
3251 fvpres(i)=zero
3252 fvqx(i)=zero
3253 fvqy(i)=zero
3254 fvqz(i)=zero
3255 fvrho(i)=zero
3256 fvener(i)=zero
3257 fvcson(i)=zero
3258 fvgama(i)=zero
3259 fvvisu(i)=zero
3260 ENDDO
3261 ENDIF
3262
3264 . fvrho, fvener, fvcson, fvgama, fvvisu,
3265 . fvel2fa)
3266 ENDIF
3267
3268 DO i = 1,mx_ani
3269 ifunc = i
3270 IF(anim_ce(i)==1)THEN
3271 IF(i<=2142 .OR. i==2155 .OR. i==2156 .OR. (i>=2239.AND.i<=10252) .OR.
3272 . (i>=10253.AND.i<=10675) .OR. (i >= 10676 .AND. i <= 1000000)) THEN
3273 CALL dfuncc(elbuf_tab ,waft ,ifunc ,iparg,geo ,
3274 . ixq ,ixc ,ixtg ,mas ,pm ,
3275 . el2fa ,nbf ,iad ,glob_therm%ITHERM ,
3276 . nbf_l ,eani ,anin(ndma2+1) ,nbpart ,iadg ,
3277 . ipm ,igeo ,thke ,err_thk_sh4 ,err_thk_sh3,
3278 .
invert ,x ,v ,w ,ale_connectivity,
3279 . nv46 ,nercvois ,nesdvois ,lercvois ,lesdvois ,
3280 . stack ,bufmat ,multi_fvm ,mat_param)
3281 IF(ncuts>0)
3282 .
CALL cutfunce(icbuf,nelcut,elbuf_tab,ifunc,iparg,pm,ixs)
3283 IF (ispmd==0) THEN
3284 r4 = zero
3285 DO j=1,nesbw2
3287 ENDDO
3288 ENDIF
3289
3290
3291 IF (anim_ply > 0)THEN
3292 CALL dfuncc_ply(elbuf_tab, waft_ply, ifunc, iparg, geo,
3293 . ixc , ixtg , mas, pm, el2fa_ply,
3294 . nbf_pxfem,iad , plynumc,eani,anin(ndma2+1),
3295 .
nplypart,iad_plyg,ipm ,igeo , thke,
3296 . err_thk_sh4, err_thk_sh3,mat_param,
3297 . nbf_pxfemg ,x , stack )
3298 ENDIF
3299 IF (anim_crk > 0)THEN
3301 . elbuf_tab ,len_crkx ,ifunc ,iparg,geo ,
3302 . ixc ,ixtg ,mas ,pm ,el2fa_crk ,
3303 . nbf_crkxfem ,iad ,nbf_crkxfem,eani ,anin(ndma2+1),
3304 . ncrkpart ,iad_crkg ,ipm ,igeo ,thke ,
3305 . err_thk_sh4 ,err_thk_sh3,xfem_tab ,iel_crk ,indx_crk,
3306 . nbf_crkxfemg,el2fa ,crkedge )
3307 ENDIF
3308
3309
3310 IF (ispmd==0.AND.nfvtr>0) THEN
3311 r4=zero
3312 DO j=1,nfvtr
3314 ENDDO
3315 ENDIF
3316 ELSEIF (i==2143.OR.i==2144) THEN
3317 CALL animcale(i, monvol, volmon, nbf, el2fa,
3318 . nbpart, iadg, nbf_l ,
3319 . ispmd, nspmd, nimv, nrvolu, nvolu,
3320 . licbag, lrcbag,
3321 . libaghol, lrbaghol,lrbagjet, libagjet,
3322 . numelqg, numelcg, numeltgg)
3323
3324 IF (ispmd==0) THEN
3325 r4 = zero
3326 DO j=1,nesbw2
3328 ENDDO
3329 ENDIF
3330
3331 IF(ispmd == 0 .AND. anim_ply > 0 ) THEN
3332 r4=zero
3333 DO j=1,nbf_pxfemg
3335 ENDDO
3336 ENDIF
3337
3338 IF(ispmd==0 .AND. anim_crk > 0)THEN
3339 r4=zero
3340 DO j=1,nbf_crkxfemg
3342 ENDDO
3343 ENDIF
3344
3345 IF (ispmd==0.AND.nfvtr>0) THEN
3346 r4=zero
3347 DO j=1,nfvtr
3349 ENDDO
3350 ENDIF
3351
3352 ELSEIF (i>=2145.AND.i<=2154) THEN
3353 IF (ispmd==0) THEN
3354 r4=zero
3355 DO j=1,nbf+nelcut+nesbw2+nbf_pxfemg+nbf_crkxfemg
3357 ENDDO
3358 ENDIF
3359 IF (ispmd==0.AND.nfvtr>0) THEN
3360 IF (i==2145) THEN
3361 DO j=1,nfvtr
3362 r4=fvmass(j)
3364 ENDDO
3365 ELSEIF (i==2146) THEN
3366 DO j=1,nfvtr
3367 r4=fvpres(j)
3369 ENDDO
3370 ELSEIF (i==2147) THEN
3371 DO j=1,nfvtr
3372 r4=fvqx(j)
3374 ENDDO
3375 ELSEIF (i==2148) THEN
3376 DO j=1,nfvtr
3377 r4=fvqy(j)
3379 ENDDO
3380 ELSEIF (i==2149) THEN
3381 DO j=1,nfvtr
3382 r4=fvqz(j)
3384 ENDDO
3385 ELSEIF (i==2150) THEN
3386 DO j=1,nfvtr
3387 r4=fvrho(j)
3389 ENDDO
3390 ELSEIF (i==2151) THEN
3391 DO j=1,nfvtr
3392 r4=fvener(j)
3394 ENDDO
3395 ELSEIF (i==2152) THEN
3396 DO j=1,nfvtr
3397 r4=fvcson(j)
3399 ENDDO
3400 ELSEIF (i==2153) THEN
3401 DO j=1,nfvtr
3402 r4=fvgama(j)
3404 ENDDO
3405 ELSEIF (i==2154) THEN
3406 DO j=1,nfvtr
3407 r4=fvvisu(j)
3409 ENDDO
3410 ENDIF
3411 ENDIF
3412 endif
3413 ENDIF
3414 ENDDO
3415 IF (ispmd==0.AND.nfvtr>0)
3416 . DEALLOCATE(fvmass, fvpres, fvqx, fvqy, fvqz, fvrho, fvener,
3417 . fvcson, fvgama)
3418
3419
3420
3421 IF (ispmd==0) THEN
3422 IF(anim_v(1)==1)
CALL ani_txt(
'Velocity',8)
3423 IF(anim_v(2)==1)
CALL ani_txt(
'Displacement',12)
3424 IF(anim_v(3)==1)
CALL ani_txt(
'Acceleration',12)
3425 IF(anim_v(4)==1.AND.animcont==1)
CALL ani_txt(
'Contact Forces',14)
3426 IF(anim_v(5)==1)
CALL ani_txt(
'Internal Forces',15)
3427 IF(anim_v(6)==1)
CALL ani_txt(
'External Forces',15)
3428 IF(anim_v(7)==1)
CALL ani_txt(
'Sect.RBY,Wall F.',16)
3429 IF(anim_v(8)==1)
CALL ani_txt(
'Sect.RBY Moments',16)
3430 IF(anim_v(9)==1)
CALL ani_txt(
'Rotational Velocity',19)
3431 IF(anim_v(10)==1)
CALL ani_txt(
'Fluid velocity',14)
3432 IF(anim_v(11)==1)
CALL ani_txt(
'Residual Forces',15)
3433 IF(anim_v(12)==1) THEN
3434 CALL ani_txt(
'Contact Pressure / Normal',25)
3435 CALL ani_txt(
'Contact Pressure / Tangent',26)
3436 END IF
3437 IF(anim_v(13)==1)
CALL ani_txt(
'Tied Contact Forces',19)
3438 IF(anim_v(14)==1)
CALL ani_txt(
'Rotational DOF',14)
3439 IF(anim_v(16)==1)
CALL ani_txt(
'Gaz Velocity',12)
3440 IF(anim_v(17)==1)
CALL ani_txt(
'Reaction Forces',15)
3441 IF(anim_v(18)==1)
CALL ani_txt(
'Reaction Moments',16)
3442 IF(anim_v(19)==1)
CALL ani_txt(
'Cluster Forces',14)
3443 IF(anim_v(20)==1)
CALL ani_txt(
'Cluster Moments',15)
3444 IF(anim_v(21)==1)
CALL ani_txt(
'inter22 - Centroid Velocity',27)
3445 IF(anim_v(22)==1)
CALL ani_txt(
'inter22 - Faces Velocity',24)
3446 IF(anim_v(23)==1)
3447 .
CALL ani_txt(
'inter22 - Centroid Momentum Density',35)
3448 IF(anim_v(24)==1)
CALL ani_txt(
'inter22 - Faces Pressure Forces',31)
3449 IF(anim_v(25)==1)
3450 .
CALL ani_txt(
'inter22 - Centroid Internal Force',33)
3451 IF(anim_v(26)==1)
3452 .
CALL ani_txt(
'Maximum Contact Forces Over Time',32)
3453 IF(anim_v(27)==1) THEN
3454 CALL ani_txt(
'Tied Contact Pressure / Normal',30)
3455 CALL ani_txt(
'Tied Contact Pressure / Tangent',31)
3456 END IF
3457 ENDIF
3458
3459
3460
3461 nnnsrg=nnsrg+nnsmd+nnsphg+2*numels16g
3462
3463 IF(.NOT. ALLOCATED(icbuf)) ALLOCATE(icbuf(1))
3464 IF(.NOT. ALLOCATED(cbuf)) ALLOCATE(cbuf(1))
3465
3466 IF(anim_v(1)==1) THEN
3467 CALL velvec(v,v_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3468 . nnnsrg,nodglob,weight,nfvnod,1,
3469 . nfnod_pxfem,nod_pxfem,
indx_ply,nfnod_crkxfemg,itab)
3470 ENDIF
3471 IF(anim_v(2)==1)
3472 .
CALL velvec(d,d_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3473 . nnnsrg,nodglob,weight,nfvnod,2,
3474 . nfnod_pxfem,nod_pxfem,
indx_ply,nfnod_crkxfemg,itab)
3475 IF(anim_v(3)==1)
3476 .
CALL velvec(a,a_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3477 . nnnsrg,nodglob,weight,nfvnod,3,
3478 . nfnod_pxfem,nod_pxfem,
indx_ply,nfnod_crkxfemg,itab)
3479 IF(anim_v(4)==1.AND.animcont==1)THEN
3480 IF(nintstamp==0)THEN
3481 CALL velvecc(cont,cont_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3482 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3483 . nfnod_crkxfemg)
3484 ELSE
3485 CALL velvecc21(cont,cont_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3486 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3487 . fcontg,nfnod_crkxfemg)
3488 END IF
3489 END IF
3490 IF(anim_v(5)==1)
3491 .
CALL velvec(fint,fint_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3492 . nnnsrg,nodglob,weight,nfvnod,5,
3493 . nfnod_pxfem,nod_pxfem,
indx_ply,nfnod_crkxfemg,itab)
3494 IF(anim_v(6)==1)
3495 .
CALL velvecc(fext,fext_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3496 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3497 . nfnod_crkxfemg)
3498
3499 IF(anim_v(7)==1)
CALL velvec2(icbuf(mic2),bid_temp,cbuf(mac2),
3500 . nodcut,fopt(1,1),npby,nnwl,nnnsrg,
3501 . nodglob,weight,fr_sec,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3502 . nfnod_crkxfemg)
3503 IF(anim_v(8)==1)
CALL velvec2(icbuf(mic2),bid_temp,cbuf(mac2),
3504 . nodcut,fopt(4,1),npby,nnwl,nnnsrg,
3505 . nodglob,weight,fr_sec,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3506 . nfnod_crkxfemg)
3507 IF(anim_v(9)==1 .AND. iroddl/=0) THEN
3508 CALL velvec(vr,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,
3509 . nnwl,nnnsrg,nodglob,weight,nfvnod,9,
3510 . nfnod_pxfem,nod_pxfem,
indx_ply,nfnod_crkxfemg,itab)
3511 ELSEIF(anim_v(9)==1) THEN
3512 IF (nspmd == 1) THEN
3513 DO i=1,numnod
3514 r4 = zero
3518 ENDDO
3519 IF (numelig3d /= 0)THEN
3520 DO i=1,64*numelig3d
3521 r4 = bid_temp(1,i)
3523 r4 = bid_temp(2,i)
3525 r4 = bid_temp(3,i)
3527 ENDDO
3528 ENDIF
3529 ELSEIF (ispmd == 0) THEN
3530 DO i=1,numnodg
3531 r4 = zero
3535 ENDDO
3536 ENDIF
3537 ENDIF
3538 IF (anim_v(10)==1) THEN
3539
3540
3541
3542
3543 CALL velvec3(vflu,bid_temp,vflu_ale,icbuf(mic2),cbuf(mac2),
3544 . nodcut,nnwl,nnnsrg,nodglob,weight,0,nfnod_pxfem,
3545 . nfnod_pxfemg,nfnod_crkxfemg)
3546 IF (nfvnod>0) THEN
3547 IF (nspmd == 1) THEN
3548 CALL alevec()
3549 ELSE
3551 ENDIF
3552 ENDIF
3553 ENDIF
3554 IF (anim_v(11)==1) THEN
3555 IF(idtmins==0.AND.idtmins_int==0)THEN
3556 fac=one
3557 IF (impl_s>0.AND.idyna==0)fac=zero
3558 DO j=1,3
3559 DO n=1,numnod
3560 vflu(j,n)=fext(j,n)+fint(j,n)-fac*ms(n)*a(j,n)
3561 ENDDO
3562 ENDDO
3563 CALL velvec(vflu,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3564 . nnnsrg,nodglob,weight,nfvnod,11,
3565 . nfnod_pxfem,nod_pxfem,
indx_ply,nfnod_crkxfemg,itab)
3566 ELSE
3567 CALL velvec(res_sms,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3568 . nnnsrg,nodglob,weight,nfvnod,11,
3569 . nfnod_pxfem,nod_pxfem,
indx_ply,nfnod_crkxfemg,itab)
3570 END IF
3571 ENDIF
3572 IF(anim_v(12)==1) THEN
3573 IF(nintstamp==0)THEN
3574 CALL velvecc(fncont,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3575 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3576 . nfnod_crkxfemg)
3577 CALL velvecc(ftcont,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3578 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3579 . nfnod_crkxfemg)
3580 ELSE
3581 CALL velvecc21(fncont,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3582 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3583 . fncontg,nfnod_crkxfemg)
3584 CALL velvecc21(ftcont,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3585 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3586 . ftcontg,nfnod_crkxfemg)
3587 END IF
3588 END IF
3589
3590 IF(anim_v(13)==1) THEN
3591 CALL velvecc(fncont2,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3592 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3593 . nfnod_crkxfemg)
3594 ENDIF
3595
3596 IF(anim_v(14)==1 .AND.(idrot == 1 .OR. isecut>0 .OR. iisrot>0 .OR. impose_dr>0 ) .AND. iroddl/=0) THEN
3597 CALL velvec(dr,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3598 . nnnsrg,nodglob,weight,nfvnod,14,
3599 . nfnod_pxfem,nod_pxfem,
indx_ply,nfnod_crkxfemg,itab)
3600 ENDIF
3601
3602 IF (anim_v(15) == 1) THEN
3603 CALL velvecc(dxancg,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3604 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,
3605 . nfnod_pxfemg,nfnod_crkxfemg)
3606 ENDIF
3607 IF(anim_v(16)==1 .AND. ialelag > 0 ) THEN
3608 CALL velvec(vgaz,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3609 . nnnsrg,nodglob,weight,nfvnod,16,
3610 . nfnod_pxfem,nod_pxfem,
indx_ply,nfnod_crkxfemg,itab)
3611 ELSEIF(anim_v(16)==1 .AND. ialelag == 0 ) THEN
3612 IF (ispmd == 0) THEN
3613 DO i=1,numnodg
3614 r4 = zero
3618 ENDDO
3619 ENDIF
3620 ENDIF
3621 IF(anim_v(17)==1) THEN
3622 DO n=1,numnod
3623 fanreact(1,n)=fanreac(1,n)
3624 fanreact(2,n)=fanreac(2,n)
3625 fanreact(3,n)=fanreac(3,n)
3626 ENDDO
3627 CALL velvec(fanreact,fanreact_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3628 . nnnsrg,nodglob,weight,nfvnod,17,
3629 . nfnod_pxfem,nod_pxfem,
indx_ply,nfnod_crkxfemg,itab)
3630 ENDIF
3631 IF(anim_v(18)==1) THEN
3632 DO n=1,numnod
3633 fanreacr(1,n)=fanreac(4,n)
3634 fanreacr(2,n)=fanreac(5,n)
3635 fanreacr(3,n)=fanreac(6,n)
3636 ENDDO
3637 CALL velvec(fanreacr,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3638 . nnnsrg,nodglob,weight,nfvnod,18,
3639 . nfnod_pxfem,nod_pxfem,
indx_ply,nfnod_crkxfemg,itab)
3640
3641 ENDIF
3642
3643 IF (anim_v(19) == 1) THEN
3644
3645 CALL velvecc(fcluster,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3646 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,
3647 . nfnod_pxfemg,nfnod_crkxfemg)
3648 ENDIF
3649
3650 IF (anim_v(20) == 1) THEN
3651
3652 CALL velvecc(mcluster,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3653 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,
3654 . nfnod_pxfemg,nfnod_crkxfemg)
3655 ENDIF
3656
3657 IF (anim_v(21) == 1) THEN
3658
3659 CALL velvecc22(elbuf_tab,iparg,1,ixs,ixq,itab)
3660 ENDIF
3661
3662 IF (anim_v(22) == 1) THEN
3663
3664 CALL velvecz22(elbuf_tab,iparg ,ipari ,igrnod , x,
3665 . ixs ,ixq ,itab ,1 )
3666 ENDIF
3667
3668 IF (anim_v(23) == 1) THEN
3669
3670 CALL velvecc22(elbuf_tab,iparg,2,ixs,ixq,itab)
3671 ENDIF
3672
3673 IF (anim_v(24) == 1) THEN
3674
3675 CALL velvecz22(elbuf_tab,iparg ,ipari ,igrnod , x,
3676 . ixs ,ixq ,itab ,2 )
3677 ENDIF
3678
3679 IF (anim_v(25) == 1) THEN
3680
3681 CALL velvecc22(elbuf_tab,iparg,3,ixs,ixq,itab)
3682 ENDIF
3683
3684 IF(anim_v(26)==1)THEN
3685
3686 IF(nintstamp==0)THEN
3687 CALL velvecc(fcont_max,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3688 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3689 . nfnod_crkxfemg)
3690 ELSE
3691 CALL velvecc_max(fcont_max,nodcut,nnwl,nnsrg,nfvnod,
3692 . nfnod_pxfemg,nfnod_crkxfemg)
3693 ENDIF
3694 END IF
3695
3696 IF(anim_v(27)==1) THEN
3697 CALL velvecc(fncontp2,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3698 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3699 . nfnod_crkxfemg)
3700 CALL velvecc(ftcontp2,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3701 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3702 . nfnod_crkxfemg)
3703 ENDIF
3704
3705
3706
3707
3708
3709 IF (ispmd==0.AND.nbf+nelcut+nesbw2/=0)THEN
3710 IF(anim_ct(1)==1)
CALL ani_txt(
'Stress (membrane)',17)
3711 IF(anim_ct(2)==1)
CALL ani_txt(
'Stress (moment/t^2)',19)
3712 IF(anim_ct(3)==1)
CALL ani_txt(
'Stress (upper)',14)
3713 IF(anim_ct(4)==1)
CALL ani_txt(
'Stress (lower)',14)
3714 IF(anim_ct(5)==1)
CALL ani_txt(
'Strain (membrane)',17)
3715 IF(anim_ct(6)==1)
CALL ani_txt(
'Strain (Curvature)',18)
3716 IF(anim_ct(7)==1)
CALL ani_txt(
'Strain (upper)',14)
3717 IF(anim_ct(8)==1)
CALL ani_txt(
'Strain (lower)',14)
3718 IF(anim_ct(91)==1)
CALL ani_txt(
'Strn rate (membrane)',20)
3719 IF(anim_ct(92)==1)
CALL ani_txt(
'Strn rate (Curvature)',21)
3720 IF(anim_ct(93)==1)
CALL ani_txt(
'Strn rate (upper)',17)
3721 IF(anim_ct(94)==1)
CALL ani_txt(
'Strn rate (lower)',17)
3722 DO i=1,100
3723 IF(anim_ct(100+i)==1)THEN
3724 WRITE(mes,'(A,I3,A)')'Stress (layer',i,')'
3726 ENDIF
3727 ENDDO
3728 DO i=1,100
3729 IF(anim_ct(200+i)==1)THEN
3730 WRITE(mes,'(A,I3,A)')'Strain (layer',i,')'
3732 ENDIF
3733 ENDDO
3734 DO i=1,100
3735 IF(anim_ct(300+i)==1)THEN
3736 WRITE(mes,'(A,I3,A)')'Strn rate (layer',i,')'
3738 ENDIF
3739 ENDDO
3740
3741
3742
3743
3744
3745
3746 DO i=401,500
3747 IF (anim_ct(i) == 1) THEN
3748 ius = mod((i - 400), 100)
3749 IF(ius==0) ius = 100
3750 WRITE(mes,'(A,I3,A)')'Stress (UPPER/LAYER',ius,')'
3752 END IF
3753 END DO
3754
3755
3756
3757 DO i=501,600
3758 IF (anim_ct(i) == 1) THEN
3759 ius = mod((i - 500), 100)
3760 IF(ius==0) ius = 100
3761 WRITE(mes,'(A,I3,A)')'Stress (LOWER/LAYER',ius,')'
3763 END IF
3764 END DO
3765
3766
3767
3768 DO i=1,100
3769 DO j=1,10
3770 ius = 10*i+j
3771 IF (anim_ct(ius + 600) == 1) THEN
3772 ilay = i
3773 ipt = j
3774 WRITE(mes,'(A,I3,I3,A)')
3775 . 'Stress (LAYER/IPT',ilay,ipt,')'
3777 END IF
3778 ENDDO
3779 ENDDO
3780
3781
3782
3783 DO i=1,mx_ply_anim
3784 IF (anim_ct(1610 + i) == 1) THEN
3785 WRITE(mes,'(A,I10,X,I3,A)')
3786 . 'Stress (PLY/IPT',ply_anim_stress( 3 * (i - 1) + 1),
3787 . ply_anim_stress( 3 * (i - 1) + 3),')'
3789 END IF
3790 ENDDO
3791
3792
3793
3794 DO i=1,mx_ply_anim
3795 IF (anim_ct( (1610+ mx_ply_anim) + i) == 1) THEN
3796 WRITE(mes,'(A,I10,X,I3,A)')
3797 . 'Strain (PLY/IPT',ply_anim_strain( 3 * (i - 1) + 1),
3798 . ply_anim_strain( 3 * (i - 1) + 3),')'
3800 END IF
3801 ENDDO
3802
3803
3804
3805 DO i=1,mx_ply_anim
3806 IF (anim_ct( (1610+ 2*mx_ply_anim) + i) == 1) THEN
3807 WRITE(mes,'(A,I10,X,I3,A)')
3808 . 'Epsdot (PLY/IPT',ply_anim_epsdot( 3 * (i - 1) + 1),
3809 . ply_anim_epsdot( 3 * (i - 1) + 3),')'
3811 END IF
3812 ENDDO
3813
3814
3815
3816
3817 idx = 1610 + 3*mx_ply_anim
3818 DO i=idx+1,idx+100
3819 IF (anim_ct(i) == 1) THEN
3820 ius = mod((i - idx), 100)
3821 IF (ius == 0) ius = 100
3822 WRITE(mes,'(A,I3,A)')'Strain (UPPER/LAYER',ius,')'
3824 ENDIF
3825 ENDDO
3826
3827 idx = 1710 + 3*mx_ply_anim
3828 DO i=idx+1,idx+100
3829 IF (anim_ct(i) == 1) THEN
3830 ius = mod((i - idx), 100)
3831 IF (ius == 0) ius = 100
3832 WRITE(mes,'(A,I3,A)')'Strain (LOWER/LAYER',ius,')'
3834 ENDIF
3835 ENDDO
3836
3837 idx = 1810 + 3*mx_ply_anim
3838 DO i=1,100
3839 DO j=1,10
3840 ius = 10*i+j
3841 IF (anim_ct(ius + idx) == 1) THEN
3842 ilay = i
3843 ipt = j
3844 WRITE(mes,'(A,I3,I3,A)')
3845 . 'Strain (LAYER/IPT',ilay,ipt,')'
3847 END IF
3848 ENDDO
3849 ENDDO
3850
3851
3852
3853
3854 idx = 2820 + 3*mx_ply_anim
3855 DO i=idx+1,idx+100
3856 IF (anim_ct(i) == 1) THEN
3857 ius = mod((i - idx), 100)
3858 IF (ius == 0) ius = 100
3859 WRITE(mes,'(A,I3,A)')'Epsdot (UPPER/LAYER',ius,')'
3861 ENDIF
3862 ENDDO
3863
3864 idx = 2920 + 3*mx_ply_anim
3865 DO i=idx+1,idx+100
3866 IF (anim_ct(i) == 1) THEN
3867 ius = mod((i - idx), 100)
3868 IF (ius == 0) ius = 100
3869 WRITE(mes,'(A,I3,A)')'Epsdot (LOWER/LAYER',ius,')'
3871 ENDIF
3872 ENDDO
3873
3874 idx = 3020 + 3*mx_ply_anim
3875 DO i=1,100
3876 DO j=1,10
3877 ius = 10*i+j
3878 IF (anim_ct(ius + idx) == 1) THEN
3879 ilay = i
3880 ipt = j
3881 WRITE(mes,'(A,I3,I3,A)')
3882 . 'Epsdot (LAYER/IPT',ilay,ipt,')'
3884 END IF
3885 ENDDO
3886 ENDDO
3887
3888
3889
3890
3891 idx = 3120 + 3*mx_ply_anim
3892
3893 IF (anim_ct(idx+1)==1)
CALL ani_txt(
'Mstress (membrane)',18)
3894 IF (anim_ct(idx+2)==1)
CALL ani_txt(
'Mstress (upper)',15)
3895 IF (anim_ct(idx+3)==1)
CALL ani_txt(
'Mstress (lower)',15)
3896
3897 idx = 3120 + 3*mx_ply_anim + 3
3898 DO i = idx+1,idx+100
3899 IF (anim_ct(i)==1) THEN
3900 WRITE(mes,'(A,I3,A)')'Mstress (layer',i,')'
3902 ENDIF
3903 ENDDO
3904
3905
3906
3907 idx = 3120 + 3*mx_ply_anim + 103
3908 DO i = idx+1,idx + mx_ply_anim
3909 IF (anim_ct(i) == 1) THEN
3910 WRITE(mes,'(A,I10,X,I3,A)')
3911 . 'Mstress (PLY/IPT',ply_anim_stress( 3 * (i - 1) + 1),
3912 . ply_anim_stress(3 * (i - 1) + 3),')'
3914 END IF
3915 ENDDO
3916
3917 ENDIF
3918
3919
3920
3921 DO i = 1,mx_ani
3922 ifunc = i
3923 IF (anim_ct(i) == 1) THEN
3925 . el2fa ,nbf ,waft ,tani ,iad ,
3926 . nbf_l ,nbpart,iadg ,x ,ixc ,
3927 . igeo ,ixtg ,ipm ,stack ,mat_param,
3928 . geo ,drape_sh4n, drape_sh3n, drapeg)
3929 IF (ispmd==0) THEN
3930 r4 = zero
3931 DO j=1,nesbw2
3935 ENDDO
3936 ENDIF
3937
3938 IF (anim_ply > 0) THEN
3940 . ifunc,
invert, el2fa_ply ,nbf_pxfem,
3941 . waft_ply,tani, iad, plynumc,
3942 . nbpart, iad_plyg, x, ixc,mat_param,
3943 . igeo, ixtg, nbf_pxfemg,ipm, stack )
3944 ENDIF
3945
3946 IF (anim_crk > 0) THEN
3948 . elbuf_tab,xfem_tab ,iparg ,ipm ,
3949 . ifunc ,
invert ,el2fa_crk,nbf_crkxfemg,
3950 . len_crkx ,tani ,iad ,nbf_crkxfem ,
3951 . nbpart ,iad_crkg ,x ,ixc ,
3952 . igeo ,ixtg ,iel_crk ,iadc_crk ,
3953 . crkedge ,indx_crk ,mat_param)
3954 ENDIF
3955
3956 IF (ispmd==0.AND.nfvtr>0) THEN
3957 r4 = zero
3958 DO j=1,nfvtr
3962 ENDDO
3963 ENDIF
3964 ENDIF
3965 ENDDO
3966
3967
3968
3969
3970 IF(anim_m==1)THEN
3971
3972 IF(nspmd == 1) THEN
3973 DO i=1,nbf
3974 r4 = mas(i)
3976 ENDDO
3977
3978
3979
3980
3981
3982
3983
3984
3985 ELSE
3986 DO i = 1, nbf_l
3987 mas4(i) = mas(i)
3988 ENDDO
3989 IF(ispmd==0) THEN
3990 buf = (numelqg+numelcg+numeltgg)
3991 ELSE
3992 buf=1
3993 END IF
3995 ENDIF
3996
3997 IF (ispmd==0) THEN
3998 r4 = 0.
3999 DO j=1,nesbw2+nelcut
4001 ENDDO
4002 ENDIF
4003
4004 IF(ispmd == 0 .AND. anim_ply > 0 ) THEN
4005 r4 = zero
4006 DO i=1,nbf_pxfemg
4008 ENDDO
4009 ENDIF
4010
4011 IF(ispmd == 0 .AND. anim_crk > 0)THEN
4012 r4 = zero
4013 DO i=1,nbf_crkxfemg
4015 ENDDO
4016 ENDIF
4017
4018 IF (ispmd==0.AND.nfvtr>0) THEN
4019 r4=zero
4020 DO j=1,nfvtr
4022 ENDDO
4023 ENDIF
4024
4025
4026
4027
4028 DO i=1,numnod
4029 IF (weight_md(i)==1) THEN
4030 wa4(i)=ms(i)
4031 ELSE
4032 wa4(i)=zero
4033 END IF
4034 ENDDO
4035
4036 DO n=1,nrbykin
4037 m=npby(1,n)
4038 IF (m>0) THEN
4039 wa4(m)=wa4(m)+(rby(15,n)-ms(m))* weight_md(m)
4040 ENDIF
4041 ENDDO
4042
4043 IF (nspmd == 1) THEN
4044 DO k=1,numnod
4045 r4 = wa4(k)
4047 ENDDO
4048 ELSE
4049 IF (ispmd==0) THEN
4050 buf = numnodg
4051 ELSE
4052 buf = 1
4053 ENDIF
4055 ENDIF
4056
4057 r4 = zero
4058 IF(nodcut>0)
4059 .
CALL cutmass(icbuf,cbuf,cbuf(mac2),nodcut,nelcut,
4060 . v,cbuf(mac3),icbuf(mic2))
4061 IF (ispmd==0) THEN
4062 r4 = 0.
4063
4064
4065 sz16 = numels16g
4066 sznnsph = nnsphg
4067 DO n=1,nsect+nrwall+nnwl+nnsrg+nnsmd+sznnsph+2*sz16
4069 ENDDO
4070 ENDIF
4071
4072 IF(ispmd==0 .AND. anim_ply > 0 ) THEN
4073 r4=zero
4074 DO i=1,nfnod_pxfemg
4076 ENDDO
4077 ENDIF
4078
4079 IF(ispmd==0 .AND. anim_crk > 0)THEN
4080 r4=zero
4081 DO i=1,nfnod_crkxfemg
4083 ENDDO
4084 ENDIF
4085
4086 IF (ispmd==0.AND.nfvnod>0) THEN
4087 r4=zero
4088 DO n=1,nfvnod+3
4090 ENDDO
4091 ENDIF
4092 ENDIF
4093
4094
4095
4096
4097 IF (nspmd == 1) THEN
4099 IF (numelig3d>0) THEN
4100 DO i=1,64*numelig3d
4102 ENDDO
4103 ENDIF
4104 ELSE
4105 IF (ispmd==0) THEN
4106 buf = numnodg
4107 ELSE
4108 buf = 1
4109 ENDIF
4111 ENDIF
4112
4113
4114
4115 sz16 = numels16g
4116 sznnsph = nnsphg
4117
4118 IF (ispmd==0) THEN
4119 DO i=1,nodcut+nsect+nrwall+nnwl+nnsrg+nnsmd+sznnsph+2*sz16
4121 ENDDO
4122 ENDIF
4123
4124
4125 IF(anim_ply > 0) THEN
4126 IF (nspmd == 1) THEN
4127 ii = 0
4128 ALLOCATE(itab_ply(nplyxfe))
4129 itab_ply =0
4132 nn =
plynod(iply)%PLYNUMNODS
4133 DO i=1,nn
4134 itab_ply(i) = idmax + ii + i
4135 ENDDO
4137 ii = ii + nn
4138 ENDDO
4139 DEALLOCATE(itab_ply)
4140 idmax = idmax + nfnod_pxfem
4141 ELSE
4142 IF (ispmd==0)THEN
4143 ALLOCATE(itab_ply(nfnod_pxfemg))
4144 ii = 0
4145 itab_ply =0
4146 DO j=1,nfnod_pxfemg
4147 itab_ply(j) = idmax + j
4148 ENDDO
4149
4150
4151
4152
4154
4155 DEALLOCATE(itab_ply)
4156 idmax = idmax + nfnod_pxfemg
4157 ENDIF
4158 ENDIF
4159 ENDIF
4160
4161 IF(anim_crk > 0)THEN
4162 IF(nspmd == 1)THEN
4163 ii = 0
4164 ALLOCATE(itab_crk(nfnod_crkxfemg))
4165 itab_crk =0
4166 DO icrk=1,ncrkpart
4167 DO i=1,
crknod(ilev)%CRKNUMNODS
4168 j =
crknod(ilev)%CRKNUMNODS*(icrk-1)
4169 k = nodglobxfe(i+j)
4170 itab_crk(k) =
crknod(icrk)%XFECRKNODID(i)+idmax
4172 ENDDO
4173 ENDDO
4174 DEALLOCATE(itab_crk)
4175 ELSE
4176 IF(ispmd==0)THEN
4177 buf = nfnod_crkxfemg
4178 ELSE
4179 buf = 1
4180 END IF
4181 DO icrk=1,ncrkpart
4183 END DO
4184 ENDIF
4185 ELSE
4186 ALLOCATE(itab_crk(0))
4187 ENDIF
4188
4189
4190 IF (nspmd == 1 .AND. nfvnod>0) THEN
4192 IF (
fvdata(i)%NPOLH_ANIM>0)
THEN
4193 DO j=1,
fvdata(i)%NNS_ANIM
4194 jj=fvoff(2,i)+j
4196 ENDDO
4197 ENDIF
4198 ENDDO
4202 ELSEIF(nfvnod>0) THEN
4204 ENDIF
4205
4207 . el2fa,nbf ,waft ,nelcut,
4208 . dd_iad,iad ,nbf_l,
4209 . nbpart,iadg,nodglob,idcmax)
4210 IF (ispmd==0) THEN
4211 DO j=1,nesbw2
4213 ENDDO
4214 ENDIF
4215
4216
4217 IF(anim_ply > 0 ) THEN
4218 nel_ply= 0
4221 . el2fa_ply,nbf_pxfem ,waft_ply ,nelcut,
4222 . dd_iad,iad ,plynumc,
4223 . nbpart,iad_plyg,nodglob,idcmax,nbf_pxfemg)
4224 ENDIF
4225
4226 IF (anim_crk > 0) THEN
4228 . iparg ,iel_crk ,waft_crk ,idcmax ,
4229 . el2fa_crk,iad_crkg ,nbf_crkxfem,nbf_crkxfemg,indx_crk)
4230 ENDIF
4231
4232 IF (ispmd==0.AND.nfvtr>0) THEN
4233 DO i=1,nfvtr
4235 ENDDO
4236 DEALLOCATE(fvel2fa, fvinum)
4237 ENDIF
4238
4239
4240
4241 IF (nfvpart>0) THEN
4242 IF (ispmd==0) ALLOCATE(fvpbuf(nfvpart))
4243 ii=nsubs
4244 . +
min(1,nsect)+
min(1,nrbody+ nrbe2t+nrbe3t)+
min(1,nrwall)
4245 . +
min(1,nsurg+nsmad) +
min(1,nplypartw)
4246 . +
min(1,ncrkpartw)-1
4248 ENDIF
4249
4250 IF (ispmd==0) THEN
4251
4252
4253
4254
4255
4256
4257
4258 DO i=1,npart
4259 IF(mater(i)==1) THEN
4260 IF (ipart(3,i)<nsubs) THEN
4262 ELSE
4264 . +
min(1,nsect)+
min(1,nrbody+ nrbe2t+nrbe3t)
4265 . +
min(1,nrwall)+
min(1,nsurg+nsmad)
4266 . +nfvsubs+
min(1,nplypartw)
4267 . +
min(1,ncrkpartw)-1,1)
4268 END IF
4269 END IF
4270 ENDDO
4271 DO i=1,ncuts
4273 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)+
min(1,nrwall)
4274 . +
min(1,nsurg+nsmad)+
min(1,nplypartw)
4275 . +
min(1,ncrkpartw)-1,1)
4276 ENDDO
4277 DO i=1,nsect
4279 END DO
4280 DO i=1,nrwall
4282 . +
min(1,nrbody+nrbe2t+nrbe3t)-1,1)
4283 END DO
4284 DO i=1,nsurg
4286 . nrbe3t)+
min(1,nrwall)-1,1)
4287 END DO
4288 DO i=1,nsmad
4290 . nrbe3t)+
min(1,nrwall)-1,1)
4291 END DO
4292
4293 IF(anim_ply > 0) THEN
4294 IF (ispmd==0)THEN
4295 ii = nsubs +
min(1,nsect) +
min(1,nrbody+nrbe2t+nrbe3t)
4296 . +
min(1,nrwall)+
min(1,nsurg+nsmad) - 1
4297
4300 ENDDO
4301 ENDIF
4302 ENDIF
4303
4304 IF(anim_crk > 0)THEN
4305 IF (ispmd==0)THEN
4306 ii = nsubs +
min(1,nsect) +
min(1,nrbody+nrbe2t+nrbe3t)
4307 . +
min(1,nrwall)+
min(1,nsurg+nsmad) - 1
4308 DO i= 1,ncrkpartw
4310 ENDDO
4311 ENDIF
4312 ENDIF
4313
4314
4315 IF (nspmd == 1.AND.nfvtr>0) THEN
4316 ii=nsubs
4317 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)+
min(1,nrwall)
4318 . +
min(1,nsurg+nsmad) +
min(nplypartw,1)
4319 . +
min(1,ncrkpartw)-1
4321 IF (
fvdata(i)%NPOLH_ANIM>0)
THEN
4322 ii=ii+1
4323 DO j=1,
fvdata(i)%NPOLH_ANIM
4325 ENDDO
4326 ENDIF
4327 ENDDO
4328 ELSEIF (nfvpart>0) THEN
4330 DEALLOCATE(fvpbuf)
4331 ENDIF
4332 DO i=1,npart
4333 IF(mater(i)==1)
CALL write_i_c(ipart(1,i),1)
4334 ENDDO
4335 DO i=1,ncuts+nrwall+nsect+nsurg+nsmad+nplypartw+ncrkpartw
4337 ENDDO
4338
4339 DO i=1,nfvpart
4341 ENDDO
4342
4343 DO i=1,npart
4344 IF(mater(i)==1)
CALL write_i_c(ipart(2,i),1)
4345 ENDDO
4346 DO i=1,ncuts+nrwall+nsect+nsurg+nsmad+nplypartw+ncrkpartw
4348 ENDDO
4349 DO i=1,nfvpart
4351 ENDDO
4352 ENDIF
4353
4354
4355
4356
4357
4358 IF(numels_t+numels16_t+isph3d*(numsph_t+maxpjet)+numelig3d==0)
4359 . GOTO 400
4360
4361
4362
4363 DO i=1,npart
4364 bufferp(i) = mater(i)
4365 mater(i) = 0
4366 ENDDO
4367
4368
4369 DO ng = 1, ngroup
4370 nel =iparg(2,ng)
4371 nft =iparg(3,ng)
4372 ity =iparg(5,ng)
4373 IF(ity==1)THEN
4374 DO i = 1, nel
4375 n = i + nft
4376 mater(iparts(n))=2
4377 ENDDO
4378
4379 ELSEIF (isph3d==1.AND.ity==51)THEN
4380 DO i = 1, nel
4381 n = i + nft
4382 mater(ipartsp(n))=2
4383 ENDDO
4384 ELSEIF (ity==101)THEN
4385 DO i = 1, nel
4386 n = i + nft
4387 mater(ipartig3d(n))=2
4388 ENDDO
4389 ENDIF
4390 ENDDO
4391
4393 DO i=1,npart
4394 IF(mater(i)>2) mater(i) = 2
4395 ENDDO
4396 IF(nspmd > 1)
CALL spmd_ibcast(mater,mater,npart,1,0,2)
4397 DO i=1,npart
4398 mater(i) = mater(i)+bufferp(i)
4399 ENDDO
4400
4401
4402 nbpart = 0
4403 DO i=1,npart
4404 nbpart = nbpart + mater(i)/2
4405 ENDDO
4406
4407
4408
4409
4410 IF (ispmd==0) THEN
4411 CALL write_i_c(numels_t+3*numels16g+isph3d*numsphg+27*numelig3d,1)
4415 ENDIF
4416
4417
4418
4419
4420 shftsph = numnodg+nodcut+nsect+nrwall+nnwl+nnsrg+nnsmd
4421 shftsph = shftsph + sphshift
4422 shft16 = numnodg+nodcut+nsect+nrwall+nnwl+nnsrg+nnsmd+nnsphg
4423 shft16 = shft16 + num16shift
4424
4425 insph=numnod+nodcut+nsect+nrwall+nnwl+nnsrg+nnsmd
4426
4427 CALL parsors(iad ,iparg ,ixs ,mater,iparts,
4428 2 el2fa , dd_iad,
4429 3 iadg ,insph ,kxsp ,ipartsp,
4430 4 ixs10 ,ixs20 ,ixs16 ,nnsph ,isph3d,
4431 5 nodglob,shft16 ,shftsph,nnsphg,ipartig3d,
4432 6 kxig3d,igeo,ig3dsolid)
4433
4434
4435
4436 nnn = numels+isph3d*(numsph+maxpjet)+3*numels16+27*numelig3d
4437 CALL anioffs(elbuf_tab,iparg,waft ,el2fa ,nnn ,
4438 . nbpart ,iadg ,isph3d )
4439
4440
4441
4442 IF (ispmd==0) THEN
4443 DO i = 1, nbpart
4444 bufferp(i) = 0
4445 DO k = 1, nspmd
4446 bufferp(i) = bufferp(i) + iadg(k,i)
4447 ENDDO
4448 ENDDO
4450 ENDIF
4451
4452
4453
4454
4455 IF (ispmd==0) THEN
4456 DO i=1,npart
4457 IF(mater(i)==2)THEN
4458 WRITE(str,'(I9,A1)')ipart(4,i),':'
4459 DO j=1,10
4460 ctext(j)=ichar(str(j:j))
4461 ENDDO
4462 ib = 10
4463 CALL fretitl2(titl,ipart(lipart1-ltitr+1,i),40)
4464 DO j=1,ltitl
4465 IF(titl(j:j)/=' ') ib = j+10
4466 ctext(j+10)=ichar(titl(j:j))
4467 END DO
4468 ctext(ib+1)=0
4470 ENDIF
4471 ENDDO
4472 ENDIF
4473
4474
4475
4476
4477 IF(anim_m==1.OR.anim_se(3)==1.OR.anim_se(25)==1)THEN
4478 CALL dmasanis(elbuf_tab,x ,d ,geo ,iparg ,
4479 . ixs ,mas ,pm ,el2fa ,numels ,
4480 . ipart ,ipartsp ,isph3d )
4481 ENDIF
4482
4483
4484
4485 IF (ispmd==0) THEN
4486 ctext(81)=0
4487 IF(anim_se(1)==1)
CALL ani_txt(
'Plastic Strain',14)
4488 IF(anim_se(2)==1)
CALL ani_txt(
'Density',7)
4489 IF(anim_se(3)==1)
CALL ani_txt(
'Specific Energy',15)
4490 IF(anim_se(4)==1)
CALL ani_txt(
'Temperature',11)
4491 IF(anim_se(6)==1)
CALL ani_txt(
'Pressure',8)
4492 IF(anim_se(7)==1)
CALL ani_txt(
'Von Mises',9)
4493 IF(anim_se(8)==1)
CALL ani_txt(
'Turbulent Energy',16)
4494 IF(anim_se(9)==1)
CALL ani_txt(
'Turbulent Viscosity',19)
4495 IF(anim_se(10)==1)
CALL ani_txt(
'Vorticity-X',11)
4496 IF(anim_se(11)==1)
CALL ani_txt(
'Damage 1',8)
4497 IF(anim_se(12)==1)
CALL ani_txt(
'Damage 2',8)
4498 IF(anim_se(13)==1)
CALL ani_txt(
'Damage 3',8)
4499 IF(anim_se(14)==1)
CALL ani_txt(
'Stress X ',9)
4500 IF(anim_se(15)==1)
CALL ani_txt(
'Stress Y ',9)
4501 IF(anim_se(16)==1)
CALL ani_txt(
'Stress Z ',9)
4502 IF(anim_se(17)==1)
CALL ani_txt(
'Stress XY',9)
4503 IF(anim_se(18)==1)
CALL ani_txt(
'Stress YZ',9)
4504 IF(anim_se(19)==1)
CALL ani_txt(
'Stress ZX',9)
4505 IF(anim_se(20)==1)
CALL ani_txt(
'User Var 1',10)
4506 IF(anim_se(21)==1)
CALL ani_txt(
'User Var 2',10)
4507 IF(anim_se(22)==1)
CALL ani_txt(
'User Var 3',10)
4508 IF(anim_se(23)==1)
CALL ani_txt(
'User Var 4',10)
4509 IF(anim_se(24)==1)
CALL ani_txt(
'User Var 5',10)
4510 IF(anim_se(25)==1)
CALL ani_txt(
'Hourglass Energy per unit mass',30)
4511 IF(anim_se(26)==1)
CALL ani_txt(
'Strain Rate',11)
4512 IF(anim_se(27)==1)
CALL ani_txt(
'User Var 6',10)
4513 IF(anim_se(28)==1)
CALL ani_txt(
'User Var 7',10)
4514 IF(anim_se(29)==1)
CALL ani_txt(
'User Var 8',10)
4515 IF(anim_se(30)==1)
CALL ani_txt(
'User Var 9',10)
4516 IF(anim_se(31)==1)
CALL ani_txt(
'User Var 10',11)
4517 IF(anim_se(32)==1)
CALL ani_txt(
'User Var 11',11)
4518 IF(anim_se(33)==1)
CALL ani_txt(
'User Var 12',11)
4519 IF(anim_se(34)==1)
CALL ani_txt(
'User Var 13',11)
4520 IF(anim_se(35)==1)
CALL ani_txt(
'User Var 14',11)
4521 IF(anim_se(36)==1)
CALL ani_txt(
'User Var 15',11)
4522 IF(anim_se(37)==1)
CALL ani_txt(
'User Var 16',11)
4523 IF(anim_se(38)==1)
CALL ani_txt(
'User Var 17',11)
4524 IF(anim_se(39)==1)
CALL ani_txt(
'User Var 18',11)
4525 IF(anim_se(40)==1)
CALL ani_txt(
'User Var 19',11)
4526 IF(anim_se(41)==1)
CALL ani_txt(
'User Var 20',11)
4527 IF(anim_se(42)==1)
CALL ani_txt(
'User Var 21',11)
4528 IF(anim_se(43)==1)
CALL ani_txt(
'User Var 22',11)
4529 IF(anim_se(44)==1)
CALL ani_txt(
'User Var 23',11)
4530 IF(anim_se(45)==1)
CALL ani_txt(
'User Var 24',11)
4531 IF(anim_se(46)==1)
CALL ani_txt(
'User Var 25',11)
4532 IF(anim_se(47)==1)
CALL ani_txt(
'User Var 26',11)
4533 IF(anim_se(48)==1)
CALL ani_txt(
'User Var 27',11)
4534 IF(anim_se(49)==1)
CALL ani_txt(
'User Var 28',11)
4535 IF(anim_se(50)==1)
CALL ani_txt(
'User Var 29',11)
4536 IF(anim_se(51)==1)
CALL ani_txt(
'User Var 30',11)
4537 IF(anim_se(52)==1)
CALL ani_txt(
'User Var 31',11)
4538 IF(anim_se(53)==1)
CALL ani_txt(
'User Var 32',11)
4539 IF(anim_se(54)==1)
CALL ani_txt(
'User Var 33',11)
4540 IF(anim_se(55)==1)
CALL ani_txt(
'User Var 34',11)
4541 IF(anim_se(56)==1)
CALL ani_txt(
'User Var 35',11)
4542 IF(anim_se(57)==1)
CALL ani_txt(
'User Var 36',11)
4543 IF(anim_se(58)==1)
CALL ani_txt(
'User Var 37',11)
4544 IF(anim_se(59)==1)
CALL ani_txt(
'User Var 38',11)
4545 IF(anim_se(60)==1)
CALL ani_txt(
'User Var 39',11)
4546 IF(anim_se(61)==1)
CALL ani_txt(
'User Var 40',11)
4547 IF(anim_se(62)==1)
CALL ani_txt(
'User Var 41',11)
4548 IF(anim_se(63)==1)
CALL ani_txt(
'User Var 42',11)
4549 IF(anim_se(64)==1)
CALL ani_txt(
'User Var 43',11)
4550 IF(anim_se(65)==1)
CALL ani_txt(
'User Var 44',11)
4551 IF(anim_se(66)==1)
CALL ani_txt(
'User Var 45',11)
4552 IF(anim_se(67)==1)
CALL ani_txt(
'User Var 46',11)
4553 IF(anim_se(68)==1)
CALL ani_txt(
'User Var 47',11)
4554 IF(anim_se(69)==1)
CALL ani_txt(
'User Var 48',11)
4555 IF(anim_se(70)==1)
CALL ani_txt(
'User Var 49',11)
4556 IF(anim_se(71)==1)
CALL ani_txt(
'User Var 50',11)
4557 IF(anim_se(72)==1)
CALL ani_txt(
'User Var 51',11)
4558 IF(anim_se(73)==1)
CALL ani_txt(
'User Var 52',11)
4559 IF(anim_se(74)==1)
CALL ani_txt(
'User Var 53',11)
4560 IF(anim_se(75)==1)
CALL ani_txt(
'User Var 54',11)
4561 IF(anim_se(76)==1)
CALL ani_txt(
'User Var 55',11)
4562 IF(anim_se(77)==1)
CALL ani_txt(
'User Var 56',11)
4563 IF(anim_se(78)==1)
CALL ani_txt(
'User Var 57',11)
4564 IF(anim_se(79)==1)
CALL ani_txt(
'User Var 58',11)
4565 IF(anim_se(80)==1)
CALL ani_txt(
'User Var 59',11)
4566 IF(anim_se(81)==1)
CALL ani_txt(
'User Var 60',11)
4567
4568 DO i=82,281
4569 IF(anim_se(i)==1)THEN
4570 ii = i - 81
4571 WRITE(mes,'(A,I3)')
4572 . 'WPLA layer',ii
4574 ENDIF
4575 ENDDO
4576
4577 IF(anim_se(282)==1)
CALL ani_txt(
'Failed layers',13)
4578
4579
4580
4581
4582 IF(anim_se(283)==1)
CALL ani_txt(
'Volumetric Fraction 1',21)
4583 IF(anim_se(284)==1)
CALL ani_txt(
'Volumetric Fraction 2',21)
4584 IF(anim_se(285)==1)
CALL ani_txt(
'Volumetric Fraction 3',21)
4585 IF(anim_se(286)==1)
CALL ani_txt(
'Volumetric Fraction 4',21)
4586
4587
4588 DO i=1,200
4589 IF(anim_se(286+3*(i-1)+1)==1)THEN
4590 WRITE(mes,'(A,I3,A)')'Psi (layer',i,')'
4592 ENDIF
4593 IF(anim_se(286+3*(i-1)+2)==1)THEN
4594 WRITE(mes,'(A,I3,A)')'Teta (layer',i,')'
4596 ENDIF
4597 IF(anim_se(286+3*(i-1)+3)==1)THEN
4598 WRITE(mes,'(A,I3,A)')'Phi (layer',i,')'
4600 ENDIF
4601 ENDDO
4602
4603 IF(anim_se(887)==1)
CALL ani_txt(
'Burn Fraction',13)
4604 IF(anim_se(888)==1)
CALL ani_txt(
'Damage variable1',16)
4605 IF(anim_se(889)==1)
CALL ani_txt(
'Damage variable2',16)
4606 IF(anim_se(890)==1)
CALL ani_txt(
'Damage variable3',16)
4607 DO i=1, 999
4608 IF(anim_se(890+i)==1)THEN
4609 WRITE(mes,'(A,I3,A)')'Damage var1 Intg Point (',i,')'
4611 ENDIF
4612 ENDDO
4613 DO i=1, 999
4614 IF(anim_se(1890+i)==1)THEN
4615 WRITE(mes,'(A,I3,A)')'Damage var2 Intg Point (',i,')'
4617 ENDIF
4618 ENDDO
4619 DO i=1, 999
4620 IF(anim_se(2890+i)==1)THEN
4621 WRITE(mes,'(A,I3,A)')'Damage var3 Intg Point (',i,')'
4623 ENDIF
4624 ENDDO
4625 IF(anim_se(3890)==1)
CALL ani_txt(
'MAX DAMAGE ELEMENT',18)
4626
4627 DO i=1, 999
4628 IF(anim_se(3890+i)==1)THEN
4629 WRITE(mes,'(A,I3,A)')'MAX DAMAGE Intg Point (',i,')'
4631 ENDIF
4632 ENDDO
4633 DO i=1, 4010
4634 IF(anim_se(5910+i)==1)THEN
4635 ii = i +5910-3890
4636 WRITE(mes,'(A,3I3)')
4637 . 'MAX DAMAGE Intg Pt ',abs(ii)/2010,
4638 . mod(abs(ii)/10,201),mod(abs(ii),10)
4640 ENDIF
4641 ENDDO
4642 IF(anim_se(4890)==1)
CALL ani_txt(
'TIME DELETION ELEMENT',21)
4643 IF(anim_se(4891)==1)
CALL ani_txt(
'Sound Speed',11)
4644 IF(anim_se(4892)==1)
CALL ani_txt(
'Schlieren',9)
4645 IF(anim_se(4893)==1)
CALL ani_txt(
'Domain',6)
4646 IF(anim_se(4894)==1)
CALL ani_txt(
'Filling percentage',18)
4647
4648
4649
4650 IF(anim_se(4895)==1)
CALL ani_txt(
'Equiv stress',12)
4651 IF(anim_se(4896)==1)
CALL ani_txt(
'Artificial Viscosity',20)
4652
4653
4654
4655
4656 IF(anim_se(4897)==1)
CALL ani_txt(
'Density-1',9)
4657 IF(anim_se(4898)==1)
CALL ani_txt'Density-2',9)
4658 IF(anim_se(4899)==1)
CALL ani_txt(
'Density-3',9)
4659 IF(anim_se(4900)==1)
CALL ani_txt(
'Density-4',9)
4660
4661 IF(anim_se(4901)==1)
CALL ani_txt(
'Specific Energy-1',17)
4662 IF(anim_se(4902)==1)
CALL ani_txt(
'Specific Energy-2',17)
4663 IF(anim_se(4903)==1)
CALL ani_txt(
'Specific Energy-3',17)
4664 IF(anim_se(4904)==1)
CALL ani_txt(
'Specific Energy-4',17)
4665
4666 IF(anim_se(4905)==1)
CALL ani_txt(
'Temperature-1',13)
4667 IF(anim_se(4906)==1)
CALL ani_txt(
'Temperature-2',13)
4668 IF(anim_se(4907)==1)
CALL ani_txt(
'Temperature-3',13)
4669 IF(anim_se(4908)==1)
CALL ani_txt(
'Temperature-4',13)
4670
4671 IF(anim_se(4909)==1)
CALL ani_txt(
'Pressure-1',10)
4672 IF(anim_se(4910)==1)
CALL ani_txt(
'Pressure-2',10)
4673 IF(anim_se(4911)==1)
CALL ani_txt(
'Pressure-3',10)
4674 IF(anim_se(4912)==1)
CALL ani_txt(
'Pressure-4',10)
4675
4676 IF(anim_se(4913)==1)
CALL ani_txt(
'Plastic Strain-1',16)
4677 IF(anim_se(4914)==1)
CALL ani_txt(
'Plastic Strain-2',16)
4678 IF(anim_se(4915)==1)
CALL ani_txt(
'Plastic Strain-3',16)
4679 IF(anim_se(4916)==1)
CALL ani_txt(
'Plastic Strain-4',16)
4680
4681 IF(anim_se(4917)==1)
CALL ani_txt(
'Sound Speed-1',13)
4682 IF(anim_se(4918)==1)
CALL ani_txt(
'Sound Speed-2',13)
4683 IF(anim_se(4919)==1)
CALL ani_txt(
'Sound Speed-3',13)
4684 IF(anim_se(4920)==1)
CALL ani_txt(
'Sound Speed-4',13)
4685
4686 IF(anim_se(4921)=
CALL ani_txt(
'Volume',6)
4687
4688 IF(anim_se(4922)==1)
CALL ani_txt(
'Volume-1',8)
4689 IF(anim_se(4923)==1)
CALL ani_txt(
'Volume-2',8)
4690 IF(anim_se(4924)==1)
CALL ani_txt(
'Volume-3',8)
4691 IF(anim_se(4925)==1)
CALL ani_txt(
'Volume-4',8)
4692
4693 IF(anim_se(4926)==1)
CALL ani_txt(
'Mass-1',6)
4694 IF(anim_se(4927)==1)
CALL ani_txt(
'Mass-2',6)
4695 IF(anim_se(4928)==1)
CALL ani_txt(
'Mass-3'
4696 IF(anim_se(4929)==1)
CALL ani_txt(
'Mass-4',6)
4697
4698 IF(anim_se(4930)==1)
CALL ani_txt(
'Detonation Time',15)
4699
4700 IF(anim_se(4931)==1)
CALL ani_txt(
'Artificial Viscosity-1',22)
4701 IF(anim_se(4932)==1)
CALL ani_txt(
'Artificial Viscosity-2',22)
4702 IF(anim_se(4933)==1)
CALL ani_txt'Artificial Viscosity-3',22)
4703 IF(anim_se(4934)==1)
CALL ani_txt(
'Artificial Viscosity-4',22)
4704
4705 IF(anim_se(4935)==
CALL ani_txt(
'Density of Liquid - (law37)',27)
4706 IF(anim_se(4936)==1)
CALL ani_txt'Density of Gas - (law37)',27)
4707
4708 IF(anim_se(4937)==1)
CALL ani_txt(
'Element Time Step',17)
4709
4710 IF(anim_se(4938)==1)
CALL ani_txt(
'Momentum Density X ',20)
4711 IF(anim_se(4939)==1)
CALL ani_txt(
'Momentum Density Y ',20)
4712 IF(anim_se(4940)==1)
CALL ani_txt(
'Momentum Density Z ',20)
4713 IF(anim_se(4941)==1)
CALL ani_txt(
'Momentum Density XY ',20)
4714 IF(anim_se(4942)==1)
CALL ani_txt(
'Momentum Density YZ ',20)
4715 IF(anim_se(4943)==1)
CALL ani_txt(
'Momentum Density XZ ',20)
4716 IF(anim_se(4944)==1)
CALL ani_txt(
'Momentum Density ABS',20)
4717
4718 IF(anim_se(4945)==1)
CALL ani_txt(
'Velocity X ',12)
4719 IF(anim_se(4946)==1)
CALL ani_txt(
'Velocity Y ',12)
4720 IF(anim_se(4947)==1)
CALL ani_txt(
'Velocity Z ',12)
4721 IF(anim_se(4948)==1)
CALL ani_txt(
'Velocity XY '
4722 IF(anim_se(4949)==1)
CALL ani_txt(
'Velocity YZ ',12)
4723 IF(anim_se(4950)==1)
CALL ani_txt(
'Velocity XZ ',12)
4724 IF(anim_se(4951)==1)
CALL ani_txt(
'Velocity ABS',12)
4725
4726 IF(anim_se(4952)==1)
CALL ani_txt(
'Internal Force X ',18)
4727 IF(anim_se(4953)==1)
CALL ani_txt(
'Internal Force Y '
4728 IF(anim_se(4954)==1)
CALL ani_txt(
'Internal Force Z ',18)
4729 IF(anim_se(4955)==1)
CALL ani_txt(
'Internal Force XY ',18)
4730 IF(anim_se(4956)==1)
CALL ani_txt(
'Internal Force YZ ',18)
4731 IF(anim_se(4957)==1)
CALL ani_txt(
'Internal Force XY ',18)
4732 IF(anim_se(4958)==1)
CALL ani_txt(
'Internal Force ABS',18)
4733
4734 IF(anim_se(4959)==1)
CALL ani_txt(
'AMS selection',13)
4735
4736 IF(anim_se(4960)==1)
CALL ani_txt(
'Vorticity-Y',11)
4737 IF(anim_se(4961)==1)
CALL ani_txt(
'Vorticity-Z',11)
4738 IF(anim_se(4962)==1)
CALL ani_txt(
'Vorticity',9)
4739 IF(anim_se(4963)==1)
CALL ani_txt(
'Internal Energy',15)
4740
4741 IF(anim_se(4964)==1)
CALL ani_txt(
'Plastic Work',12)
4742 IF(anim_se(4965)==1)
CALL ani_txt(
'Element status',14)
4743 IF(anim_se(4966)==1)
CALL ani_txt(
'Mach Number',11)
4744 IF(anim_se(4967)==1)
CALL ani_txt(
'Color Function',14)
4745 IF(anim_se(4968)==1)
CALL ani_txt(
'Damage',6)
4746 IF(anim_se(4969)==1)
CALL ani_txt(
'Non-local plastic strain',24)
4747 IF(anim_se(4970)==1)
CALL ani_txt(
'Non-local plastic strain rate',29)
4748 IF(anim_se(4971)==1)
CALL ani_txt(
'Tsai-Wu Criterion',17)
4749 DO i=1,200
4750 IF(anim_se(4971+i)==1)THEN
4751 WRITE(mes,'(A,I3)')
4752 . 'Tsai-Wu Crit. layer',i
4754 ENDIF
4755 ENDDO
4756 IF(anim_se(5172)==1)
CALL ani_txt(
'Region identifier in p,v diagram',32)
4757 IF(anim_se(5173)==1)
CALL ani_txt(
'Volumetric Strain',17)
4758 IF(anim_se(5174)==1)
CALL ani_txt(
'Volumetric Strain - 1',21)
4759 IF(anim_se(5175)==1)
CALL ani_txt(
'Volumetric Strain - 2',21)
4760 IF(anim_se(5176)==1)
CALL ani_txt(
'Volumetric Strain - 3',21)
4761 IF(anim_se(5177)==1)
CALL ani_txt(
'Volumetric Strain - 4',21)
4762 IF(anim_se(5178)==1)
CALL ani_txt(
'Volumetric Strain - 5',21)
4763 IF(anim_se(5179)==1)
CALL ani_txt(
'Volumetric Strain - 6',21)
4764 IF(anim_se(5180)==1)
CALL ani_txt(
'Volumetric Strain - 7',21)
4765 IF(anim_se(5181)==1)
CALL ani_txt(
'Volumetric Strain - 8',21)
4766 IF(anim_se(5182)==1)
CALL ani_txt(
'Volumetric Strain - 9',21)
4767 IF(anim_se(5183)==1)
CALL ani_txt(
'Volumetric Strain - 10',22)
4768
4769
4770 ENDIF
4771
4772
4773
4774
4775 ndma2= numnod*(
min(1,anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT)
4776 . +
min(1,anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS)
4777 . +
min(1,anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER))
4778 nnn = numels+isph3d*(numsph+maxpjet)+3*numels16+27*numelig3d
4779 DO i = 1,mx_ani
4780 ifunc = i
4781 IF(anim_se(i)==1) THEN
4783 1 elbuf_tab ,waft ,ifunc ,iparg ,geo ,
4784 2 ixs ,mas ,pm ,el2fa ,nnn ,
4785 3 ipm ,igeo ,nbpart ,eani ,anin(ndma2+1),
4786 4 iadg ,spbuf ,ipart ,ipartsp ,isph3d ,
4787 5 x ,v ,w ,ale_connectivity,
4788 6 nercvois ,nesdvois ,lercvois ,lesdvois ,bufmat ,
4789 7
fani_cell ,multi_fvm ,mat_param ,glob_therm%ITHERM)
4790 ENDIF
4791 ENDDO
4792
4793
4794
4795 IF (ispmd==0) THEN
4796 IF(anim_st(1)==1)
CALL ani_txt(
'Stress',6)
4797 IF(anim_st(2)==1)
CALL ani_txt(
'Strain',6)
4798 IF(anim_st(3)==1)
CALL ani_txt(
'Strn rate',9)
4799 IF(anim_st(4)==1)
CALL ani_txt(
'Damage',6)
4800 IF(anim_st(5)==1)
CALL ani_txt(
'Plastic strain tensor',21)
4801
4802 DO i=10,1009
4803 IF(anim_st(i)==1)THEN
4804 ii = i - 10
4805 WRITE(mes,'(A,I3)')
4806 . 'Strs Intg Point',ii
4808 ENDIF
4809 ENDDO
4810 DO i=1010,2009
4811 IF(anim_st(i)==1)THEN
4812 ii = i - 1010
4813 WRITE(mes,'(A,I3)')
4814 . 'Stra Intg Point',ii
4816 ENDIF
4817 ENDDO
4818 DO i=2010,22109
4819 IF(anim_st(i)==1)THEN
4820 ii = i - 2010
4821 WRITE(mes,'(A,3I3)')
4822 . 'Strs In Pt',abs(ii)/2010,
4823 . mod(abs(ii)/10,201),mod(abs(ii),10)
4825 ENDIF
4826 ENDDO
4827 DO i=22110,42209
4828 IF(anim_st(i)==1)THEN
4829 ii = i - 22110
4830 WRITE(mes,'(A,3I3)')
4831 . 'Stra In Pt',abs(ii)/2010,
4832 . mod(abs(ii)/10,201),mod(abs(ii),10)
4834 ENDIF
4835 ENDDO
4836
4837 DO i=42210,43209
4838 IF(anim_st(i)==1)THEN
4839 ii = i - 42210
4840 WRITE(mes,'(A,I3)')
4841 . 'Plastic Strn Intg Point',ii
4843 ENDIF
4844 ENDDO
4845
4846 DO i=43210,63309
4847 IF(anim_st(i)==1)THEN
4848 ii = i - 43210
4849 WRITE(mes,'(A,3I3)')
4850 . 'Plastic Strn In Pt',abs(ii)/2010,
4851 . mod(abs(ii)/10,201),mod(abs(ii),10)
4853 ENDIF
4854 ENDDO
4855 ENDIF
4856
4857
4858
4859
4860 DO i = 1,mx_ani
4861 ifunc = i
4862 IF(anim_st(i)==1)THEN
4863 CALL tensors(elbuf_tab,iparg ,ifunc ,ixs ,pm ,
4864 2 el2fa ,nnn ,waft ,tani ,
4865 3 nbpart ,x ,iadg ,ipart ,
4866 4 ipartsp ,isph3d ,ipm ,igeo)
4867 ENDIF
4868 ENDDO
4869
4870
4871
4872 IF(anim_m==1)THEN
4873 IF(nspmd == 1) THEN
4874 DO i=1,nnn
4875 r4 = mas(i)
4877 ENDDO
4878 ELSE
4879
4880 DO i = 1,nnn
4881 mas4(i) = mas(i)
4882 ENDDO
4883 IF(ispmd==0) THEN
4884 buf = numelsg+3*numels16g+numsphg+27*numelig3d
4885 ELSE
4886 buf=1
4887 END IF
4888 nnng = numels+3*numels16+numsph+27*numelig3d
4890 ENDIF
4891 ENDIF
4892
4893
4894
4895 CALL delnumbs(iparg ,ixs ,el2fa ,nnn ,waft ,
4896 . dd_iad,iad ,nbpart,iadg ,kxsp ,
4897 . isph3d )
4898
4899
4900
4901 IF (ispmd==0) THEN
4902 DO i=1,npart
4903 IF(mater(i)==2)THEN
4904 IF (ipart(3,i)<nsubs) THEN
4906 ELSE
4908 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
4909 . +
min(1,nrwall)+
min(1,nsurg+nsmad)-1,1)
4910 END IF
4911 END IF
4912 ENDDO
4913 DO i=1,npart
4914 IF(mater(i)==2)
CALL write_i_c(ipart(1,i),1)
4915 ENDDO
4916 DO i=1,npart
4917 IF(mater(i)==2)
CALL write_i_c(ipart(2,i),1)
4918 ENDDO
4919 ENDIF
4920
4921 400 CONTINUE
4922
4923
4924
4925
4926
4927
4928 nerby = 0
4929 IF (nrbody>0)
4930 .
CALL drbycnt(nerby,npby,fr_rby2)
4931 nerbe2 = 0
4932 IF (nrbe2t>0)
4933 .
CALL drbe2cnt(nerbe2,irbe2,lrbe2,weight)
4934 nerbe3 = 0
4935
4936 IF (nrbe3t>0)
4937 .
CALL drbe3cnt(nerbe3,irbe3,lrbe3,weight)
4938 nb1d_t = nb1dg
4939
4940 IF(nb1dg+nrbody+nrbe2t+nrbe3t+nanim1d==0) GOTO 600
4941
4942
4943
4944 DO i=1,npart
4945 bufferp(i) = mater(i)
4946 mater(i) = 0
4947 ENDDO
4948
4949 DO ng = 1, ngroup
4950 nel =iparg(2,ng)
4951 nft =iparg(3,ng)
4952 ity =iparg(5,ng)
4953 IF(ity==4)THEN
4954 DO i = 1, nel
4955 n = i + nft
4956 mater(ipartt(n))=3
4957 ENDDO
4958 ELSEIF(ity==5)THEN
4959 DO i = 1, nel
4960 n = i + nft
4961 mater(ipartp(n))=3
4962 ENDDO
4963 ELSEIF(ity==6)THEN
4964 DO i = 1, nel
4965 n = i + nft
4966 mater(ipartr(n))=3
4967 ENDDO
4968 ELSEIF(ity==100)THEN
4969 DO i=1,nel
4970 n = i+nft
4971 iprt=ipartx(n)
4972 IF (nfacptx(1,iprt)>0) THEN
4973 mater(iprt)=3
4974 ELSE
4975 mater(iprt)=0
4976 ENDIF
4977 ENDDO
4978 ENDIF
4979 ENDDO
4980
4982 DO i=1,npart
4983 IF(mater(i)>3) mater(i) = 3
4984 ENDDO
4985 IF(nspmd > 1)
CALL spmd_ibcast(mater,mater,npart,1,0,2)
4986 DO i=1,npart
4987 mater(i) = mater(i) + bufferp(i)
4988 ENDDO
4989
4990 nbpart = 0
4991 DO i=1,npart
4992 nbpart = nbpart + mater(i)/3
4993 ENDDO
4994
4995 DO i=1,nb1d + 1
4996 el2fa(i)=0
4997 ENDDO
4998
4999
5000
5001 IF(ispmd==0) THEN
5002 CALL write_i_c(nb1d_t+nanim1d+nerby+nerbe2+nerbe3,1)
5003 CALL write_i_c(nbpart+nrbody+nrbe2t+nrbe3t,1)
5006
5008 ENDIF
5009
5010
5011
5012
5014 . x ,d ,iad ,cdg ,iparg ,
5015 . ixt ,ixp ,ixr ,mater ,el2fa ,
5016 . dd_iad ,iadg ,ipartt ,ipartp,ipartr ,
5017 . nfacptx,ixedge,nodglob,nb1d ,nanim1d_l,
5018 . ipart ,igeo ,iadg_tpr,siadg)
5019 IF(nrbody>0) THEN
5020
5021 IF (nspmd > 1) THEN
5022 sbufspm=0
5023 sbufrecvm=0
5024 sbufspo=0
5025 sporby=0
5026
5027 DO i=1,nspmd
5028 sbufspm = sbufspm + iad_rby2(1,i)
5029 sbufrecvm = sbufrecvm + iad_rby2(2,i)+1
5030 ENDDO
5031 sbufspm = sbufspm + 2*nrbykin
5032 sbufrecvm = sbufrecvm + 2*nrbykin*nspmd
5033 DO i=1,nrbykin
5034
5035 IF ((ispmd+1)==abs(fr_rby2(3,i)))
5036 . sbufspo = sbufspo + fr_rby2(2,i)
5037 ENDDO
5038 sbufspo = sbufspo + nrbykin*2
5039 IF (ispmd==0) THEN
5040 sporby = nerby+nrbykin*2
5041 ELSE
5042 sporby=1
5043 ENDIF
5045 . sbufspm,sbufrecvm,sbufspo,sporby,
5046 . nodglob,weight,itab)
5047 ELSE
5049 ENDIF
5050 ENDIF
5051 IF(nrbe2t>0) THEN
5052 IF (nspmd>1) THEN
5054 * nerbe2t)
5055 ELSE
5057 ENDIF
5058 ENDIF
5059 IF(nrbe3t>0) THEN
5060 IF (nspmd>1) THEN
5062 * nerbe3t)
5063 ELSE
5065 ENDIF
5066 ENDIF
5067
5068
5069
5070 CALL aniofff(elbuf_tab, iparg ,waft,el2fa ,
5071 . nb1d ,iad ,nbpart,iadg,ioffx1,
5072 . nanim1d_l)
5073 IF (ispmd==0) THEN
5074 DO j=1,nerby+nerbe2+nerbe3
5076 ENDDO
5077 ENDIF
5078
5079
5080
5081 IF (ispmd==0) THEN
5082 DO i = 1, nbpart
5083 bufferp(i) = 0
5084 DO k = 1, nspmd
5085 bufferp(i) = bufferp(i) + iadg(k,i)
5086 ENDDO
5087 ENDDO
5089 ENDIF
5090
5091 DO i=1,nrbody
5092 nerbt(i)=0
5093 ENDDO
5094 DO i=1,nrbody
5095 proc=abs(fr_rby2(3,i))
5096 IF (proc==loc_proc) THEN
5097 nerbt(i)=fr_rby2(2,i)
5098 ENDIF
5099 ENDDO
5101 IF (ispmd==0) THEN
5102 nerby1=0
5103 nerbe2_1 = 0
5104 nerbe3_1 = 0
5105 DO irby=1,nrbody
5106 CALL donerby(irby,nerby1,npby,nerbt)
5108 END DO
5109 DO i=1,nrbe2t
5110 CALL donerbe2(i,nerbe2_1,irbe2,nerbe2t)
5111 CALL write_i_c(nb1d+nanim1d+nerby1+nerbe2_1,1)
5112 END DO
5113 DO i=1,nrbe3t
5114 CALL donerbe3(i,nerbe3_1,irbe3,nerbe3t)
5115 CALL write_i_c(nb1d+nanim1d+nerby1+nerbe2_1+nerbe3_1,1)
5116 END DO
5117
5118
5119
5120
5121
5122 DO i=1,npart
5123 IF(mater(i)==3)THEN
5124 WRITE(str,'(I9,A1)')ipart(4,i),':'
5125 DO j=1,10
5126 ctext(j)=ichar(str(j:j))
5127 ENDDO
5128 ib = 10
5129
5130 CALL fretitl2(titl,ipart(lipart1-ltitr+1,i),40)
5131 DO j=1,ltitl
5132 IF(titl(j:j)/=' ') ib = j+10
5133 ctext(j+10)=ichar(titl(j:j))
5134 END DO
5135 ctext(ib+1)=0
5137
5138 ENDIF
5139 ENDDO
5140
5141 IF (invstr<40) THEN
5142 DO irby=1,nrbody
5143 WRITE(str,'(I9,A2,A10)') irby,': ','Rigid Body'
5144 DO j=1,21
5145 ctext(j)=ichar(str(j:j))
5146 ENDDO
5147 ib = 21
5148 ctext(ib+1)=0
5149
5151 END DO
5152 DO i=1,nrbe2t
5153 WRITE(str,'(I9,A2,A4)') i,': ','Rbe2'
5154 DO j=1,15
5155 ctext(j)=ichar(str(j:j))
5156 ENDDO
5157 ib = 15
5158 ctext(ib+1)=0
5159 END DO
5160 DO i=1,nrbe3t
5161 WRITE(str,'(I9,A2,A4)') i,': ','Rbe3'
5162 DO j=1,15
5163 ctext(j)=ichar(str(j:j))
5164 ENDDO
5165 ib = 15
5166 ctext(ib+1)=0
5167
5169 END DO
5170 ELSE
5171 DO irby=1,nrbody
5172 WRITE(str,'(I9,A2)') nom_opt(i161+lnopt1*(irby-1)),': '
5173 DO j=1,11
5174 ctext(j)=ichar(str(j:j))
5175 ENDDO
5176
5177 CALL fretitl2(titl,nom_opt(i161+lnopt1*(irby-1)
5178 & +lnopt1-ltitr),40)
5179 ib = ltitl+10
5180 DO j=1,ltitl
5181 ctext(j+11)=ichar(titl(j:j))
5182 END DO
5183 ctext(ib+1)=0
5185 END DO
5186 DO i=1,nrbe2t
5187 WRITE(str,'(I9,A2)') nom_opt(i16l+lnopt1*(i-1)),': '
5188 DO j=1,11
5189 ctext(j)=ichar(str(j:j))
5190 ENDDO
5191
5192 CALL fretitl2(titl,nom_opt(i16l+lnopt1*(i-1)
5193 & +lnopt1-ltitr),40)
5194 ib = ltitl+10
5195 DO j=1,ltitl
5196 ctext(j+11)=ichar(titl(j:j))
5197 END DO
5198 ctext(ib+1)=0
5200 END DO
5201 DO i=1,nrbe3t
5202 WRITE(str,'(I9,A2)') nom_opt(i16m+lnopt1*(i-1)),': '
5203 DO j=1,11
5204 ctext(j)=ichar(str(j:j))
5205 ENDDO
5206
5207 CALL fretitl2(titl,nom_opt(i16m+lnopt1*(i-1)
5208 & +lnopt1-ltitr),40)
5209 ib = ltitl+10
5210 DO j=1,ltitl
5211 ctext(j+11)=ichar(titl(j:j))
5212 END DO
5213 ctext(ib+1)=0
5215 END DO
5216 END IF
5217 ENDIF
5218
5219
5220
5221 IF(anim_m==1.OR.anim_fe(3)==1)THEN
5222 CALL dmasanif(elbuf_tab, x ,d ,geo ,iparg,
5223 . ixt ,ixp ,ixr ,mas ,pm ,
5224 . el2fa ,nb1d )
5225 ENDIF
5226
5227
5228
5229 IF (ispmd==0) THEN
5230 IF(anim_fe(1)==1)
CALL ani_txt(
'Plastic Strain',14)
5231 IF(anim_fe(3)==1)
CALL ani_txt(
'Specific Energy',15)
5232 IF(anim_fe(7)==1)
CALL ani_txt(
'Von Mises',9)
5233 IF(anim_fe(11)==1)
CALL ani_txt(
'Damage 1',8)
5234 IF(anim_fe(12)==1)
CALL ani_txt(
'Damage 2',8)
5235 IF(anim_fe(13)==1)
CALL ani_txt(
'Damage 3',8)
5236 IF(anim_fe(14)==1)
CALL ani_txt(
'Stress X ',9)
5237 IF(anim_fe(15)==1)
CALL ani_txt(
'Stress Y ',9)
5238 IF(anim_fe(16)==1)
CALL ani_txt(
'Stress Z ',9)
5239 IF(anim_fe(17)==1)
CALL ani_txt(
'Stress XY',9)
5240 IF(anim_fe(18)==1)
CALL ani_txt(
'Stress YZ',9)
5241 IF(anim_fe(19)==1)
CALL ani_txt(
'Stress ZX',9)
5242 IF(anim_fe(20)==1)
CALL ani_txt(
'Element Time Step',17)
5243 IF(anim_fe(21)==1)
CALL ani_txt(
'AMS selection',13)
5244 IF(anim_fe(22)==1)
CALL ani_txt(
'Element status',14)
5245
5246 DO i=23,122
5247 IF (anim_fe(i) == 1) THEN
5248 ius = mod((i - 22), 100)
5249 IF (ius==0) ius = 100
5250 WRITE(mes,'(A,I3,A)') 'Plast Strn IPT ',ius, ' '
5252 END IF
5253 ENDDO
5254
5255 IF (anim_fe(123)==1)
CALL ani_txt(
'Strain X ',9)
5256 IF (anim_fe(124)==1)
CALL ani_txt(
'Strain rate',11)
5257 IF (anim_fe(125)==1)
CALL ani_txt(
'Damage ',7)
5258
5259 ENDIF
5260
5261
5262
5263 ndma2= numnod*(
min(1,anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT)
5264 . +
min(1,anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS)
5265 . +
min(1,anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER))
5266 DO i = 1,mx_ani
5267 ifunc = i
5268 IF(anim_fe(i)==1) THEN
5269
5270 CALL dfuncf(elbuf_tab ,waft ,ifunc ,iparg ,geo ,
5271 . ixt ,ixp ,ixr ,mas ,pm ,
5272 . el2fa ,nb1d ,iad ,nbpart ,eani ,
5273 . anin(ndma2+1),iadg ,xfunc1 ,nanim1d_l,igeo )
5274 IF (ispmd==0) THEN
5275 r4 = 0.
5276 DO j=1,nerby+nerbe2+nerbe3
5278 ENDDO
5279 ENDIF
5280 ENDIF
5281 ENDDO
5282
5283
5284
5285 IF (ispmd==0) THEN
5286 IF(anim_ft(1)==1)
CALL ani_txt(
'Force & Moment ',15)
5287 ENDIF
5288
5289
5290
5291 DO i = 1,mx_ani
5292 ifunc = i
5293 IF(anim_ft(i)==1)THEN
5294 CALL torseur(iadg_tpr ,iparg,ifunc ,ixt ,ixp ,
5295 . ixr ,el2fa,nb1d ,waft ,tors ,
5296 . nbpart)
5297 IF (ispmd==0) THEN
5298 r4 = 0.
5299 DO j=1,nanim1d
5309 ENDDO
5310 ENDIF
5311
5312 IF (ispmd==0) THEN
5313 r4 = 0.
5314 DO j=1,nerby+nerbe2+nerbe3
5324 ENDDO
5325 ENDIF
5326 ENDIF
5327 ENDDO
5328
5329
5330
5331 CALL cntskew(iparg,lrbuf,lrbufg)
5332 IF (ispmd==0) lrbuf=lrbufg
5333
5334
5335 CALL aniskewf(geo,skew,iparg,ixr,dd_iad,lrbuf)
5336 IF (ispmd==0) THEN
5337
5338 DO i=1,nanim1d
5340 ENDDO
5341 ENDIF
5342 IF (ispmd==0) THEN
5343 DO j=1,nerby+nerbe2+nerbe3
5345 ENDDO
5346 ENDIF
5347
5348
5349
5350 IF(anim_m==1)THEN
5351 IF(nspmd == 1) THEN
5352 DO i=1,nb1d
5353 r4 = mas(i)
5355 ENDDO
5356 DO i=1,nanim1d
5357 r4 = xmass1(i)
5359 ENDDO
5360 ELSE
5361 IF (ispmd==0) THEN
5362 buf = nb1dg+nanim1d
5363 ELSE
5364 buf = 1
5365 ENDIF
5366 DO i = 1, nb1d
5367 mas4(i) = mas(i)
5368 ENDDO
5369 DO i=1,nanim1d_l
5370 mas4(nb1d+i) = xmass1(i)
5371 ENDDO
5373 ENDIF
5374 IF (ispmd==0) THEN
5375 r4 = 0.
5376 DO j=1,nerby+nerbe2+nerbe3
5378 ENDDO
5379 ENDIF
5380 ENDIF
5381
5382
5383
5384 CALL delnumbf(iparg ,ixt ,ixp ,ixr ,el2fa ,
5385 . nb1d ,waft ,dd_iad ,iad ,nbpart,
5386 . iadg ,inumx1,nanim1d_l)
5387 IF (ispmd==0) THEN
5388 DO j=1,nerby+nerbe2+nerbe3
5390 ENDDO
5391 ENDIF
5392
5393
5394
5395 IF (ispmd==0) THEN
5396 DO i=1,npart
5397 IF(mater(i)==3)THEN
5398 IF (ipart(3,i)<nsubs) THEN
5400 ELSE
5402 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5403 . +
min(1,nrwall)+
min(1,nsurg+nsmad)-1,1)
5404 END IF
5405 END IF
5406 ENDDO
5407
5408 DO i=1,nrbody+nrbe2t+nrbe3t
5410 END DO
5411 DO i=1,npart
5412 IF(mater(i)==3)
CALL write_i_c(ipart(1,i),1)
5413 ENDDO
5414 DO i=1,nrbody+nrbe2t+nrbe3t
5416 ENDDO
5417 DO i=1,npart
5418 IF(mater(i)==3)
CALL write_i_c(ipart(2,i),1)
5419 ENDDO
5420 DO i=1,nrbody+nrbe2t+nrbe3t
5422 ENDDO
5423 ENDIF
5424
5425 600 CONTINUE
5426
5427
5428
5429
5430
5431 IF (ispmd==0) THEN
5432 j=0
5433 DO i=1,npart
5434 IF(mater(i)==1)THEN
5435 j=j+1
5436 mater(i)=j
5437 ELSE
5438 mater(i)=-mater(i)
5439 ENDIF
5440 ENDDO
5441 m01=j
5442 j=j+ncuts+nrwall+nsect+nsurg+nsmad+nplypartw+ncrkpartw
5443 m1=j
5444 DO i=1,npart
5445 IF(mater(i)==-2)THEN
5446 j=j+1
5447 mater(i)=j
5448 ENDIF
5449 ENDDO
5450 m2=j
5451 DO i=1,npart
5452 IF(mater(i)==-3)THEN
5453 j=j+1
5454 mater(i)=j
5455 ENDIF
5456 ENDDO
5457 m3=j+nrbody+nrbe2t+nrbe3t
5458 ENDIF
5459
5460
5461
5462
5463 IF (anim_ply > 0)THEN
5465 ELSE
5466 nplysubs= 0
5467 ENDIF
5468
5469 IF(anim_crk > 0)THEN
5470 ncrksubs =
min(1,ncrkpart)
5471 ELSE
5472 ncrksubs= 0
5473 ENDIF
5474
5475 IF (ispmd==0) THEN
5477 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5478 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nfvsubs+ nplysubs
5479 . +ncrksubs,1)
5480 ENDIF
5481
5482
5483
5485 IF (ispmd==0) THEN
5486 IF (nsubs==1) THEN
5487
5488 mxsubs=1
5489
5490
5491
5492 IF (nrbody+nrbe2t+nrbe3t>0) THEN
5493 WRITE(str,'(I8,A28)')mxsubs+1,':RBODIES & RBE2 & RBE3 MODEL'
5494 DO j=1,36
5495 ctext(j)=ichar(str(j:j))
5496 ENDDO
5497 ctext(37)=0
5499
5501 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5502 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nfvsubs
5503 . +nplysubs+ncrksubs-1,1)
5504
5506
5507
5508 n1=0
5509 n2=0
5510 n3=nrbody+nrbe2t+nrbe3t
5511
5513
5515
5517 DO j=nrbody+nrbe2t+nrbe3t,1,-1
5519 ENDDO
5520 END IF
5521
5522
5523
5524 IF (nsect>0) THEN
5525 WRITE(str,'(I8,A15)')mxsubs
5526 . +
min(1,nrbody+nrbe2t+nrbe3t)+1,
':SECTIONS MODEL'
5527 DO j=1,23
5528 ctext(j)=ichar(str(j:j))
5529 ENDDO
5530 ctext(24)=0
5532
5534 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5535 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nfvsubs
5536 . +nplysubs+ncrksubs-1,1)
5537
5539
5540
5541 n1=nsect
5542 n2=0
5543 n3=0
5544
5546 DO j=nsect,1,-1
5547 CALL write_i_c(m1-nsurg-nsmad-nrwall-nplypartw
5548 . -ncrkpartw-j,1)
5549 ENDDO
5550
5552
5554 END IF
5555
5556
5557
5558 IF (nrwall>0) THEN
5559 WRITE(str,'(I8,A13)')mxsubs
5560 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)+1,
5561 . ':RWALLS MODEL'
5562 DO j=1,21
5563 ctext(j)=ichar(str(j:j))
5564 ENDDO
5565 ctext(22)=0
5567
5569 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5570 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nfvsubs
5571 . +nplysubs+ncrksubs-1,1)
5572
5574
5575
5576 n1=nrwall
5577 n2=0
5578 n3=0
5579
5581 DO j=nrwall,1,-1
5583 . -ncrkpartw-j,1)
5584 ENDDO
5585
5587
5589 END IF
5590
5591
5592
5593 IF (nsurg+nsmad>0) THEN
5594 WRITE(str,'(I8,A15)')mxsubs
5595 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5596 . +
min(1,nrwall)+1,
':SURFACES MODEL'
5597 DO j=1,23
5598 ctext(j)=ichar(str(j:j))
5599 ENDDO
5600 ctext(24)=0
5602
5604 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5605 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nfvsubs
5606 . +nplysubs+ncrksubs-1,1)
5607
5609
5610
5611 n1=nsurg+nsmad
5612 n2=0
5613 n3=0
5614
5616 DO j=nsurg+nsmad,1,-1
5617 CALL write_i_c(m1-nplypartw-ncrkpartw-j,1)
5618 ENDDO
5619
5621
5623 END IF
5624
5625
5626
5627 IF (nplysubs>0) THEN
5628 ii= mxsubs
5629 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)+
min(1,nrwall)
5630 . +
min(1,nsurg+nsmad) + 1
5631 WRITE(str,'(I8,A8)')
5632 . ii,': PLIES '
5633
5634
5635 DO j=1,24
5636 ctext(j)=ichar(str(j:j))
5637 ENDDO
5638 ctext(25)=0
5640
5642 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5643 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nplysubs
5644 . +nfvsubs-1,1)
5645
5647
5648 n1=nplypartw
5649 n2=0
5650 n3=0
5652
5653 DO j=nplypartw,1,-1
5655 ENDDO
5656
5658
5660 ENDIF
5661
5662
5663
5664
5665 IF (ncrksubs>0) THEN
5666 ii= mxsubs
5667 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)+
min(1,nrwall)
5668 . +
min(1,nsurg+nsmad) + 1
5669 WRITE(str,'(I8,A9)')
5670 . ii,': CRACKS '
5671
5672 DO j=1,17
5673 ctext(j)=ichar(str(j:j))
5674 ENDDO
5675 ctext(18)=0
5677
5679 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5680 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nplysubs
5681 . +nfvsubs+ncrksubs-1,1)
5682
5684
5685 n1=ncrkpartw
5686 n2=0
5687 n3=0
5689
5690 DO j=ncrkpartw,1,-1
5692 ENDDO
5693
5695
5697 ENDIF
5698
5699
5700
5701
5702 IF (nfvsubs>0) THEN
5703 ii=nsubs
5704 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5705 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+ nplysubs
5706 . +ncrksubs-1
5707 offpart=nbpart2d + nplysubs + ncrksubs
5709 IF (
fvdata(i)%NPOLH_ANIM>0)
THEN
5710 ii=ii+1
5711 WRITE(str,'(I8,A11,I8)')
5712 . ii,
':FVMBAG ID ',
fvdata(i)%ID
5713 DO j=1,27
5714 ctext(j)=ichar(str(j:j))
5715 ENDDO
5716 ctext(28)=0
5718
5720 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5721 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nfvsubs
5722 . +nplysubs+ncrksubs-1,1)
5723
5725
5727 DO j=1,
fvdata(i)%NPOLH_ANIM
5729 ENDDO
5730 offpart=offpart+
fvdata(i)%NPOLH_ANIM
5731
5733
5735 ENDIF
5736 ENDDO
5737 ENDIF
5738
5739
5740
5741 WRITE(str,'(I8,A13)')1,':GLOBAL MODEL'
5742 DO j=1,21
5743 ctext(j)=ichar(str(j:j))
5744 ENDDO
5745 ctext(22)=0
5747
5749
5751 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nfvsubs
5752 . +nplysubs+ncrksubs,1)
5753
5754 IF (nrbody+nrbe2t+nrbe3t>0)
5756 IF (nsect>0)
5757 .
CALL write_i_c(nsubs+
min(1,nrbody+nrbe2t+nrbe3t)-1,1)
5758 IF (nrwall>0)
5760 . +
min(1,nrbody+nrbe2t+nrbe3t)-1,1)
5761 IF (nsurg+nsmad>0)
5763 . nrbe3t)+
min(1,nrwall)-1,1)
5764 IF (ispmd==0 .AND.nplysubs > 0) THEN
5765 ii=nsubs+
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5766 . +
min(1,nrwall)+
min(1,nsurg+nsmad) - 1
5768 ENDIF
5769
5770 IF (ispmd==0 .AND.ncrksubs > 0) THEN
5771 ii=nsubs+
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5772 . +
min(1,nrwall)+
min(1,nsurg+nsmad) - 1
5774 ENDIF
5775
5776 IF (ispmd==0.AND.nfvsubs>0) THEN
5777 ii=
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)+
min(1,nrwall)
5778 . +
min(1,nsurg+nsmad)+1
5780 ii=ii+1
5782 ENDDO
5783 ENDIF
5784
5785 n1=0
5786 n2=0
5787 n3=0
5788 DO k=1,npart
5789 IF(mater(k)>0.AND.mater(k)<=m01)THEN
5790 n1=n1+1
5791 ELSEIF(mater(k)>m1.AND.mater(k)<=m2)THEN
5792 n2=n2+1
5793 ELSEIF(mater(k)>m2)THEN
5794 n3=n3+1
5795 ENDIF
5796 ENDDO
5797
5798 n1=n1+ncuts
5799
5801 DO k=1,npart
5802 IF(mater(k)>0.AND.mater(k)<=m01)
5804 ENDDO
5805
5806 DO j=1,ncuts
5807 CALL write_i_c(m1-nrwall-nsect-nsurg-nsmad-nplypartw
5808 . -ncrkpartw-j,1)
5809 ENDDO
5810
5812 DO k=1,npart
5813 IF(mater(k)>m1.AND.mater(k)<=m2)
5815 ENDDO
5816
5818 DO k=1,npart
5819 IF(mater(k)>m2)
CALL write_i_c(mater(k)-m2-1,1)
5820 ENDDO
5821 ELSE
5822
5823
5824
5825 mxsubs=0
5826 DO i=1,nsubs-1
5827 IF (subset(i)%ID > mxsubs) mxsubs=subset(i)%ID
5828 WRITE(str,'(I9,A1)') subset(i)%ID,':'
5829 DO j=1,10
5830 ctext(j)=ichar(str(j:j))
5831 ENDDO
5832 ib = 10
5833 titl(1:ltitl) = subset(i)%TITLE(1:ltitl)
5834 DO j=1,ltitl
5835 IF(titl(j:j)/=' ') ib = j+10
5836 ctext(j+10)=ichar(titl(j:j))
5837 ENDDO
5838 ctext(ib+1)=0
5840
5841 IF (subset(i)%PARENT < nsubs) THEN
5843 ELSE
5845 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5846 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nfvsubs
5847 . +nplysubs+ncrksubs-1,1)
5848 END IF
5849
5851
5852 DO j=1,subset(i)%NCHILD
5854 ENDDO
5855
5856 n1=0
5857 n2=0
5858 n3=0
5859 DO j=1,subset(i)%NPART
5860 k = subset(i)%PART(j)
5861 IF(mater(k)>0.AND.mater(k)<=m01)THEN
5862 n1=n1+1
5863 ELSEIF(mater(k)>m1.AND.mater(k)<=m2)THEN
5864 n2=n2+1
5865 ELSEIF(mater(k)>m2)THEN
5866 n3=n3+1
5867 ENDIF
5868 ENDDO
5869
5871 DO j=1,subset(i)%NPART
5872 k = subset(i)%PART(j)
5873 IF(mater(k)>0.AND.mater(k)<=m01)
5875 ENDDO
5876
5878 DO j=1,subset(i)%NPART
5879 k = subset(i)%PART(j)
5880 IF(mater(k)>m1.AND.mater(k)<=m2)
5882 ENDDO
5883
5885 DO j=1,subset(i)%NPART
5886 k = subset(i)%PART(j)
5887 IF(mater(k)>m2)
CALL write_i_c(mater(k)-m2-1,1)
5888 ENDDO
5889 ENDDO
5890
5891
5892
5893 IF (nrbody+nrbe2t+nrbe3t>0) THEN
5894 WRITE(str,'(I8,A14)')mxsubs+1,':RBODIES MODEL'
5895 DO j=1,22
5896 ctext(j)=ichar(str(j:j))
5897 ENDDO
5898 ctext(23)=0
5900
5902 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5903 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nfvsubs
5904 . +nplysubs+ncrksubs-1,1)
5905
5907
5908
5909 n1=0
5910 n2=0
5911 n3=nrbody+nrbe2t+nrbe3t
5912
5914
5916
5918 DO j=nrbody+nrbe2t+nrbe3t,1,-1
5920 ENDDO
5921 END IF
5922
5923
5924
5925 IF (nsect>0) THEN
5926 WRITE(str,
'(I8,A15)')mxsubs+
min(1,nrbody+nrbe2t+nrbe3t)
5927 . +1,':SECTIONS MODEL'
5928 DO j=1,23
5929 ctext(j)=ichar(str(j:j))
5930 ENDDO
5931 ctext(24)=0
5933
5935 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5936 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nfvsubs
5937 . +nplysubs+ncrksubs-1,1)
5938
5940
5941
5942 n1=nsect
5943 n2=0
5944 n3=0
5945
5947 DO j=nsect,1,-1
5948 CALL write_i_c(m1-nsurg-nsmad-nrwall-nplypartw-
5949 . ncrkpartw-j,1)
5950 ENDDO
5951
5953
5955 END IF
5956
5957
5958
5959 IF (nrwall>0) THEN
5960 WRITE(str,'(I8,A13)')mxsubs
5961 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5962 . +1,':RWALLS MODEL'
5963 DO j=1,21
5964 ctext(j)=ichar(str(j:j))
5965 ENDDO
5966 ctext(22)=0
5968
5970 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5971 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nfvsubs
5972 . +nplysubs+ncrksubs-1,1)
5973
5975
5976
5977 n1=nrwall
5978 n2=0
5979 n3=0
5980
5982 DO j=nrwall,1,-1
5984 . -ncrkpartw-j,1)
5985 ENDDO
5986
5988
5990 END IF
5991
5992
5993
5994 IF (nsurg+nsmad>0) THEN
5995 WRITE(str,'(I8,A15)')mxsubs
5996 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
5997 . +
min(1,nrwall)+1,
':SURFACES MODEL'
5998 DO j=1,23
5999 ctext(j)=ichar(str(j:j))
6000 ENDDO
6001 ctext(24)=0
6003
6005 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
6006 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nplysubs
6007 . +nfvsubs+ncrksubs-1,1)
6008
6010
6011
6012 n1=nsurg+nsmad
6013 n2=0
6014 n3=0
6015
6017 DO j=nsurg+nsmad,1,-1
6018 CALL write_i_c(m1-j-nplypartw-ncrkpartw,1)
6019 ENDDO
6020
6022
6024 END IF
6025
6026
6027
6028 IF (nplysubs>0) THEN
6029 ii=mxsubs
6030 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)+
min(1,nrwall)
6031 . +
min(1,nsurg+nsmad)+1
6032
6033 WRITE(str,'(I8,A8)')
6034 . ii,': PLIES '
6035 DO j=1,24
6036 ctext(j)=ichar(str(j:j))
6037 ENDDO
6038 ctext(25)=0
6040
6042 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
6043 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nplysubs
6044 . +nfvsubs-1,1)
6045
6047
6048 n1=nplypartw
6049 n2=0
6050 n3=0
6052
6053 DO j=nplypartw,1,-1
6055 ENDDO
6056
6058
6060 ENDIF
6061
6062
6063
6064
6065 IF (ncrksubs>0) THEN
6066 ii=mxsubs
6067 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)+
min(1,nrwall)
6068 . +
min(1,nsurg+nsmad)+1
6069
6070 WRITE(str,'(I8,A9)')
6071 . ii,': CRACKS '
6072 DO j=1,17
6073 ctext(j)=ichar(str(j:j))
6074 ENDDO
6075 ctext(18)=0
6077
6079 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
6080 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nplysubs
6081 . +nfvsubs+ncrksubs-1,1)
6082
6084
6085 n1=ncrkpartw
6086 n2=0
6087 n3=0
6089
6090 DO j=ncrkpartw,1,-1
6092 ENDDO
6093
6095
6097 ENDIF
6098
6099
6100
6101
6102 IF (nfvsubs>0) THEN
6103 ii=nsubs
6104 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
6105 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+ nplysubs
6106 . +ncrksubs-1
6107 offpart=nbpart2d+ nplysubs+ncrksubs
6109 IF (
fvdata(i)%NPOLH_ANIM>0)
THEN
6110 ii=ii+1
6111 WRITE(str,'(I8,A11,I8)')
6112 . ii,
':FVMBAG ID ',
fvdata(i)%ID
6113 DO j=1,27
6114 ctext(j)=ichar(str(j:j))
6115 ENDDO
6116 ctext(28)=0
6118
6120 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
6121 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nplysubs
6122 . +nfvsubs+ncrksubs-1,1)
6123
6125
6127 DO j=1,
fvdata(i)%NPOLH_ANIM
6129 ENDDO
6130 offpart=offpart+
fvdata(i)%NPOLH_ANIM
6131
6133
6135 ENDIF
6136 ENDDO
6137 ENDIF
6138
6139
6140
6141 WRITE(str,'(I9,A1)') subset(nsubs)%ID,':'
6142 DO j=1,10
6143 ctext(j)=ichar(str(j:j))
6144 ENDDO
6145 ib = 10
6146 titl(1:ltitl) = subset(i)%TITLE(1:ltitl)
6147 DO j=1,ltitl
6148 IF(titl(j:j)/=' ') ib = j+10
6149 ctext(j+10)=ichar(titl(j:j))
6150 ENDDO
6151 ctext(ib+1)=0
6153
6154 CALL write_i_c(subset(nsubs)%PARENT-1,1)
6155
6157 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
6158 . +
min(1,nrwall)+
min(1,nsurg+nsmad)+nplysubs+nfvsubs
6159 . +ncrksubs,1)
6160
6161 DO j=1,subset(nsubs)%NCHILD
6162 CALL write_i_c(subset(nsubs)%CHILD(j)-1,1)
6163 ENDDO
6164 IF (nrbody+nrbe2t+nrbe3t>0)
6166 IF (nsect>0)
6167 .
CALL write_i_c(nsubs+
min(1,nrbody+nrbe2t+nrbe3t)-1,1)
6168 IF (nrwall>0)
6170 . nrbe3t)-1,1)
6171 IF (nsurg+nsmad>0)
6173 . nrbe3t)+
min(1,nrwall)-1,1)
6174 IF (ispmd==0.AND.nplysubs>0) THEN
6175 ii=nsubs+
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
6176 . +
min(1,nrwall)+
min(1,nsurg+nsmad) - 1
6178 ENDIF
6179
6180 IF (ispmd==0.AND.ncrksubs>0) THEN
6181 ii=nsubs+
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
6182 . +
min(1,nrwall)+
min(1,nsurg+nsmad) - 1
6184 ENDIF
6185
6186 IF (ispmd==0.AND.nfvsubs>0) THEN
6187 ii=nsubs+
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
6188 . +
min(1,nrwall)+
min(1,nsurg+nsmad)
6191 ii=ii+1
6192 ENDDO
6193 ENDIF
6194
6195 n1=0
6196 n2=0
6197 n3=0
6198 DO j=1,subset(i)%NPART
6199 k = subset(i)%PART(j)
6200 IF(mater(k)>0.AND.mater(k)<=m01)THEN
6201 n1=n1+1
6202 ELSEIF(mater(k)>m1.AND.mater(k)<=m2)THEN
6203 n2=n2+1
6204 ELSEIF(mater(k)>m2)THEN
6205 n3=n3+1
6206 ENDIF
6207 ENDDO
6208
6209 n1=n1+ncuts
6210
6212 DO j=1,subset(i)%NPART
6213 k = subset(i)%PART(j)
6214 IF(mater(k)>0.AND.mater(k)<=m01)
6216 ENDDO
6217
6218 DO j=1,ncuts
6219 CALL write_i_c(m1-nrwall-nsect-nsurg-nsmad-nplypartw-
6220 . ncrkpartw-j,1)
6221 ENDDO
6222
6224 DO j=1,subset(i)%NPART
6225 k = subset(i)%PART(j)
6226 IF(mater(k)>m1.AND.mater(k)<=m2)
6228 ENDDO
6229
6231 DO j=1,subset(i)%NPART
6232 k = subset(i)%PART(j)
6233 IF(mater(k)>m2)
CALL write_i_c(mater(k)-m2-1,1)
6234 ENDDO
6235 ENDIF
6236 ENDIF
6237
6238
6239
6240 IF (ispmd==0) THEN
6243 ENDIF
6244
6245
6246
6247 IF (ispmd==0) THEN
6249 DO i=1,nummat
6250 WRITE(str,'(I9,A1)') ipm(1,i),':'
6251 DO j=1,10
6252 ctext(j)=ichar(str(j:j))
6253 ENDDO
6254 ib = 10
6255 CALL fretitl2(titl,ipm(npropmi-ltitr+1,i),40)
6256 DO j=1,ltitl
6257 IF(titl(j:j)/=' ') ib = j+10
6258 ctext(j+10)=ichar(titl(j:j))
6259 ENDDO
6260 ctext(ib+1)=0
6262 ENDDO
6263 ENDIF
6264
6265
6266
6267 IF (ispmd==0) THEN
6269 DO i=1,nummat
6271 ENDDO
6272 ENDIF
6273
6274
6275
6276 IF (ispmd==0) THEN
6278 DO i=1,numgeo
6279 WRITE(str,'(I9,A1)') igeo(1,i),':'
6280 DO j=1,10
6281 ctext(j)=ichar(str(j:j))
6282 ENDDO
6283 ib = 10
6284 CALL fretitl2(titl,igeo(npropgi-ltitr+1,i),40)
6285 DO j=1,ltitl
6286 IF(titl(j:j)/=' ') ib = j+10
6287 ctext(j+10)=ichar(titl(j:j))
6288 ENDDO
6289 ctext(ib+1)=0
6291 ENDDO
6292 ENDIF
6293
6294
6295
6296 IF (ispmd==0) THEN
6298 DO i=1,numgeo
6300 ENDDO
6301 ENDIF
6302
6303
6304
6305
6306
6307 IF(isph3d==1.OR.numsph_t+maxpjet==0) GOTO 700
6308
6309
6310
6311 IF (ispmd==0) THEN
6312 DO i=1,npart
6313 mater(i)=-mater(i)
6314 ENDDO
6315 ENDIF
6316
6317
6318
6319 DO i=1,npart
6320 bufferp(i) = mater(i)
6321 mater(i) = 0
6322 ENDDO
6323
6324 DO ng = 1, ngroup
6325 nel =iparg(2,ng)
6326 nft =iparg(3,ng)
6327 ity =iparg(5,ng)
6328 IF(ity==51)THEN
6329 DO i = 1, nel
6330 n = i + nft
6331 mater(ipartsp(n))=4
6332 ENDDO
6333 ENDIF
6334 ENDDO
6336 DO i=1,npart
6337 IF(mater(i)>4) mater(i) = 4
6338 ENDDO
6339 IF(nspmd > 1)
CALL spmd_ibcast(mater,mater,npart,1,0,2)
6340 DO i=1,npart
6341 mater(i) = mater(i)+bufferp(i)
6342 ENDDO
6343
6344 nbpart = 0
6345 DO i=1,npart
6346 IF(mater(i)==4)nbpart = nbpart + 1
6347 ENDDO
6348
6349
6350
6351 IF (ispmd==0) THEN
6356 ENDIF
6357
6358
6359
6360 CALL parsor0(iad ,iparg ,mater ,el2fa ,
6361 2 dd_iad ,iadg ,
6362 3 kxsp ,ipartsp ,nodglob)
6363
6364
6365
6366 nnn = numsph+maxpjet
6367 CALL anioff0(elbuf_tab ,iparg ,waft ,el2fa ,
6368 . nnn ,nbpart ,iadg ,swaft,sph2sol)
6369
6370
6371
6372 IF (ispmd==0) THEN
6373 DO i = 1, nbpart
6374 bufferp(i) = 0
6375 DO k = 1, nspmd
6376 bufferp(i) = bufferp(i) + iadg(k,i)
6377 ENDDO
6378 ENDDO
6380 ENDIF
6381
6382
6383
6384 IF (ispmd==0) THEN
6385 DO i=1,npart
6386 IF(mater(i)==4)THEN
6387 WRITE(str,'(I9,A1)')ipart(4,i),':'
6388 DO j=1,10
6389 ctext(j)=ichar(str(j:j))
6390 ENDDO
6391 ib = 10
6392 CALL fretitl2(titl,ipart(lipart1-ltitr+1,i),40)
6393 DO j=1,ltitl
6394 IF(titl(j:j)/=' ') ib = j+10
6395 ctext(j+10)=ichar(titl(j:j))
6396 ENDDO
6397 ctext(ib+1)=0
6399 ENDIF
6400 ENDDO
6401 ENDIF
6402
6403
6404
6405 IF(anim_m==1.OR.anim_se(3)==1.OR.
6406 . anim_se(25)==1)THEN
6407 CALL dmasani0(x ,d ,elbuf_tab,geo ,iparg
6408
6409 ENDIF
6410
6411
6412
6413 IF (ispmd==0) THEN
6414 ctext(81)=0
6415
6417 CALL ani_txt(
'Number of neighbours',20)
6418
6419 IF(anim_se(1)==1)
CALL ani_txt(
'Plastic Strain',14)
6420 IF(anim_se(2)==1)
CALL ani_txt(
'Density',7)
6421 IF(anim_se(3)==1)
CALL ani_txt(
'Specific Energy',15)
6422 IF(anim_se(4)==1)
CALL ani_txt(
'Temperature',11)
6423 IF(anim_se(6)==1)
CALL ani_txt(
'Pressure',8)
6424 IF(anim_se(7)==1)
CALL ani_txt(
'Von Mises',9)
6425 IF(anim_se(8)==1)
CALL ani_txt(
'Turbulent Energy',16)
6426 IF(anim_se(9)==1)
CALL ani_txt(
'Turbulent Viscosity',19)
6427 IF(anim_se(10)==1)
CALL ani_txt(
'Vorticity',9)
6428 IF(anim_se(11)==1)
CALL ani_txt(
'Damage 1',8)
6429 IF(anim_se(12)==1)
CALL ani_txt(
'Damage 2',8)
6430 IF(anim_se(13)==1)
CALL ani_txt(
'Damage 3',8)
6431 IF(anim_se(14)==1)
CALL ani_txt(
'Stress X ',9)
6432 IF(anim_se(15)==1)
CALL ani_txt(
'Stress Y ',9)
6433 IF(anim_se(16)==1)
CALL ani_txt(
'Stress Z ',9)
6434 IF(anim_se(17)==1)
CALL ani_txt(
'Stress XY',9)
6435 IF(anim_se(18)==1)
CALL ani_txt(
'Stress YZ',9)
6436 IF(anim_se(19)==1)
CALL ani_txt(
'Stress ZX',9)
6437 IF(anim_se(20)==1)
CALL ani_txt(
'User Var 1',10)
6438 IF(anim_se(21)==1)
CALL ani_txt(
'User Var 2',10)
6439 IF(anim_se(22)==1)
CALL ani_txt(
'User Var 3',10)
6440 IF(anim_se(23)==1)
CALL ani_txt(
'User Var 4',10)
6441 IF(anim_se(24)==1)
CALL ani_txt(
'User Var 5',10)
6442 IF(anim_se(25)==1)
CALL ani_txt(
'Hourglass Energy per unit mass',30)
6443 IF(anim_se(26)==1)
CALL ani_txt(
'Strain Rate',11)
6444 IF(anim_se(27)==1)
CALL ani_txt(
'User Var 6',10)
6445 IF(anim_se(28)==1)
CALL ani_txt(
'User Var 7',10)
6446 IF(anim_se(29)==1)
CALL ani_txt(
'User Var 8',10)
6447 IF(anim_se(30)==1)
CALL ani_txt(
'User Var 9',10)
6448 IF(anim_se(31)==1)
CALL ani_txt(
'User Var 10',11)
6449 IF(anim_se(32)==1)
CALL ani_txt(
'User Var 11',11)
6450 IF(anim_se(33)==1)
CALL ani_txt(
'User Var 12',11)
6451 IF(anim_se(34)==1)
CALL ani_txt(
'User Var 13',11)
6452 IF(anim_se(35)==1)
CALL ani_txt(
'User Var 14',11)
6453 IF(anim_se(36)==1)
CALL ani_txt(
'User Var 15',11)
6454 IF(anim_se(37)==1)
CALL ani_txt(
'User Var 16',
6455 IF(anim_se(38)==1)
CALL ani_txt(
'User Var 17',11)
6456 IF(anim_se(39)==1)
CALL ani_txt(
'User Var 18',11)
6457 IF(anim_se(40)==1)
CALL ani_txt(
'User Var 19',11)
6458 IF(anim_se(41)==1)
CALL ani_txt(
'User Var 20',11)
6459 IF(anim_se(42)==1)
CALL ani_txt(
'User Var 21',11)
6460 IF(anim_se(43)==1)
CALL ani_txt(
'User Var 22',11)
6461 IF(anim_se(44)==1)
CALL ani_txt(
'User Var 23',11)
6462 IF(anim_se(45)==1)
CALL ani_txt(
'User Var 24',11)
6463 IF(anim_se(46)==1)
CALL ani_txt(
'User Var 25',11)
6464 IF(anim_se(47)==1)
CALL ani_txt(
'User Var 26'
6465 IF(anim_se
CALL ani_txt(
'User Var 27',11)
6466 IF(anim_se(49)==1)
CALL ani_txt(
'User Var 28',11)
6467 IF(anim_se(50)==1)
CALL ani_txt(
'User Var 29',11)
6468 IF(anim_se(51)==1)
CALL ani_txt(
'User Var 30',11)
6469 IF(anim_se(52)==1)
CALL ani_txt(
'User Var 31',11)
6470 IF(anim_se(53)==1)
CALL ani_txt(
'User Var 32',11)
6471 IF(anim_se(54)==1)
CALL ani_txt(
'User Var 33',11)
6472 IF(anim_se(55)==1)
CALL ani_txt(
'User Var 34',11)
6473 IF(anim_se(56)==1)
CALL ani_txt(
'User Var 35',11)
6474 IF(anim_se(57)==1)
CALL ani_txt(
'User Var 36',11)
6475 IF(anim_se(58)==1)
CALL ani_txt(
'User Var 37',11)
6476 IF(anim_se(59)==1)
CALL ani_txt(
'User Var 38',11)
6477 IF(anim_se(60)==1)
CALL ani_txt(
'User Var 39',11)
6478 IF(anim_se(61)==1)
CALL ani_txt(
'User Var 40',11)
6479 IF(anim_se(62)==1)
CALL ani_txt(
'User Var 41',11)
6480 IF(anim_se(63)==1)
CALL ani_txt(
'User Var 42',11)
6481 IF(anim_se(64
CALL ani_txt(
'User Var 43',
6482 IF(anim_se(65)==1)
CALL ani_txt(
'User Var 44',11)
6483 IF(anim_se(66)==1)
CALL ani_txt(
'User Var 45',11)
6484 IF(anim_se(67)==1)
CALL ani_txt(
'User Var 46',11)
6485 IF(anim_se(68)
CALL ani_txt(
'User Var 47',11)
6486 IF(anim_se(69)==1)
CALL ani_txt(
'User Var 48',11)
6487 IF(anim_se(70)==1)
CALL ani_txt(
'User Var 49',11)
6488 IF(anim_se(71)==1)
CALL ani_txt(
'User Var 50',11)
6489 IF(anim_se(72)==1)
CALL ani_txt(
'User Var 51',11)
6490 IF(anim_se(73)==1)
CALL ani_txt(
'User Var 52',11)
6491 IF(anim_se(74)==1)
CALL ani_txt(
'User Var 53',11)
6492 IF(anim_se(75)==1)
CALL ani_txt(
'User Var 54',11)
6493 IF(anim_se(76)==1)
CALL ani_txt(
'User Var 55',11)
6494 IF(anim_se(77)==1)
CALL ani_txt(
'User Var 56',11)
6495 IF(anim_se(78)==1)
CALL ani_txt(
'User Var 57',11)
6496 IF(anim_se(79)==1)
CALL ani_txt(
'User Var 58',11)
6497 IF(anim_se(80)==1)
CALL ani_txt(
'User Var 59',11)
6498 IF(anim_se(81)==1)
CALL ani_txt(
'User Var 60',11)
6499 DO i=82,281
6500 IF(anim_se(i)==1)THEN
6501 ii = i - 81
6502 WRITE(mes,'(A,I3)')
6503 . 'WPLA layer',ii
6505 ENDIF
6506 ENDDO
6507 DO i=1,200
6508 IF(anim_se(286+3*(iTHEN
6509 WRITE(mes,'(A,I3,A)')'Psi (layer',i,')'
6511 ENDIF
6512 IF(anim_se(286+3*(i-1)+2)==1)THEN
6513 WRITE(mes,'(A,I3,A)')'Teta (layer',i,')'
6515 ENDIF
6516 IF(anim_se(286+3*(i-1)+3)==1)THEN
6517 WRITE(mes,'(A,I3,A)')'Phi (layer'')'
6519 ENDIF
6520 ENDDO
6521 IF(anim_se(3890)==1)
CALL ani_txt(
'MAX DAMAGE ELEMENT',18)
6522 IF(anim_se(4893)==1)
CALL ani_txt(
'Domain',6)
6523 IF(anim_se(4937)==1)
CALL ani_txt(
'Element Time Step',17)
6524 IF(anim_se(4959)==1)
CALL ani_txt(
'AMS selection',13)
6525 IF(anim_se(4965)==1)
CALL ani_txt(
'Element status',14)
6526 IF(anim_se(4895)==1)
CALL ani_txt(
'Equiv stress',12)
6527 IF(anim_se(5172)==1)
CALL ani_txt(
'Region identifier in p,v diagram',32)
6528 IF(anim_se(5173)==1)
CALL ani_txt(
'Volumetric Strain',17)
6529 ENDIF
6530
6531
6532
6533 nnn = numsph+maxpjet
6534
6535
6536 DO
6537 ifunc = 0
6538 default_output = i
6539 CALL dfunc0(elbuf_tab ,waft ,ifunc ,iparg ,
6540 2 mas ,pm ,el2fa ,nnn ,
6541 3 nbpart ,iadg ,spbuf ,ipart ,
6542 4 ipartsp ,ale_connectivity,ipm ,
6543 5 x ,v ,w ,glob_therm%ITHERM,
6544 6 nercvois ,nesdvois ,lercvois ,lesdvois,
6545 7 bufmat ,multi_fvm ,kxsp ,default_output,
6546 8 mat_param)
6547 ENDDO
6548
6549
6550 DO i = 1,mx_ani
6551 ifunc = i
6552 default_output = 0
6553 IF(anim_se(i) == 1) THEN
6554 CALL dfunc0(elbuf_tab ,waft ,ifunc ,iparg ,
6555 2 mas ,pm ,el2fa ,nnn ,
6556 3 nbpart
6557 4 ipartsp ,ale_connectivity,ipm ,
6558 5 x ,v ,w ,glob_therm%ITHERM,
6559 6 nercvois ,nesdvois ,lercvois ,lesdvois,
6560 7 bufmat ,multi_fvm ,kxsp ,default_output,
6561 8 mat_param)
6562 ENDIF
6563 ENDDO
6564
6565
6566
6567 IF (ispmd==0) THEN
6568 IF(anim_st(1)==1)
CALL ani_txt(
'Stress',6)
6569 IF(anim_st(2)==1)
CALL ani_txt(
'Strain',6)
6570 IF(anim_st(3)==1)
CALL ani_txt(
'Strn rate',9)
6571 IF(anim_st(4)==1)
CALL ani_txt(
'Damage',6)
6572 IF(anim_st(5)==1)
CALL ani_txt(
'Plastic Strain Tensor',21)
6573
6574 DO i=10,1009
6575 IF(anim_st(i)==1)THEN
6576 ii = i - 10
6577 WRITE(mes,'(A,I3)')
6578 . 'Strs Intg Point',ii
6580 ENDIF
6581 ENDDO
6582 DO i=1010,2009
6583 IF(anim_st(i)==1)THEN
6584 ii = i - 1010
6585 WRITE(mes,'(A,I3)')
6586 . 'Stra Intg Point',ii
6588 ENDIF
6589 ENDDO
6590 DO i=2010,22109
6591 IF(anim_st(i)==1)THEN
6592 ii = i - 2010
6593 WRITE(mes,'(A,3I3)')
6594 . 'Strs In Pt',abs(ii)/2010,
6595 . mod(abs(ii)/10,201),mod(abs(ii),10)
6597 ENDIF
6598 ENDDO
6599 DO i=22110,42209
6600 IF(anim_st(i)==1)THEN
6601 ii = i - 22110
6602 WRITE(mes,'(A,3I3)')
6603 . 'Stra In Pt',abs(ii)/2010,
6604 . mod(abs(ii)/10,201),mod(abs(ii),10)
6606 ENDIF
6607 ENDDO
6608
6609 DO i=42210,43209
6610 IF(anim_st(i)==1)THEN
6611 ii = i - 42210
6612 WRITE(mes,'(A,I3)')
6613 . 'Plastic Strn Intg Point',ii
6615 ENDIF
6616 ENDDO
6617
6618 DO i=43210,63309
6619 IF(anim_st(i)==1)THEN
6620 ii = i - 43210
6621 WRITE(mes,'(A,3I3)')
6622 . 'Plastic Strn In Pt',abs(ii)/2010,
6623 . mod(abs(ii)/10,201),mod(abs(ii),10)
6625 ENDIF
6626 ENDDO
6627 ENDIF
6628
6629
6630
6631 DO i = 1,mx_ani
6632 ifunc = i
6633 IF(anim_st(i)==1)THEN
6634 CALL tensor0(elbuf_tab,iparg ,ifunc ,pm ,el2fa ,
6635 2 nnn ,waft ,tani ,iad ,
6636 3 nbpart ,x ,iadg ,ipart ,ipartsp
6637 4 ipm )
6638 ENDIF
6639 ENDDO
6640
6641
6642
6643 IF(anim_m==1)THEN
6644 IF(nspmd == 1) THEN
6645 DO i=1,nnn
6646 r4 = mas(i)
6648 ENDDO
6649 ELSE
6650 DO i = 1,nnn
6651 mas4(i) = mas(i)
6652 ENDDO
6653 IF(ispmd==0) THEN
6654 buf = numsphg
6655 ELSE
6656 buf=1
6657 END IF
6659 ENDIF
6660 ENDIF
6661
6662
6663
6664 CALL delnumb0(iparg ,el2fa ,nnn ,waft ,dd_iad,
6665 . iad ,nbpart,iadg ,kxsp )
6666
6667
6668
6669 IF (ispmd==0) THEN
6670 DO i=1,npart
6671 IF(mater(i)==4)THEN
6672 IF (ipart(3,i)<nsubs) THEN
6674 ELSE
6676 . +
min(1,nsect)+
min(1,nrbody+nrbe2t+nrbe3t)
6677 . +
min(1,nrwall)+
min(1,nsurg+nsmad)-1,1)
6678 END IF
6679 END IF
6680 ENDDO
6681 DO i=1,npart
6682 IF(mater(i)==4)
CALL write_i_c(ipart(1,i),1)
6683 ENDDO
6684 DO i=1,npart
6685 IF(mater(i)==4)
CALL write_i_c(ipart(2,i),1)
6686 ENDDO
6687 ENDIF
6688
6689
6690
6691 IF (ispmd==0) THEN
6692 j=m3
6693 DO i=1,npart
6694 IF(mater(iTHEN
6695 j=j+1
6696 mater(i)=j
6697 ENDIF
6698 ENDDO
6699 m4=j
6700 IF (nsubs==1) THEN
6701
6702 n0=0
6703 DO k=1,npart
6704 IF(mater(k)>m3THEN
6705 n0=n0+1
6706 ENDIF
6707 ENDDO
6708
6710 DO k=1,npart
6711 IF(mater(k)>m3)
6713 ENDDO
6714 ELSE
6715
6716
6717
6718 DO i=1,nsubs-1
6719
6720 n0=0
6721 DO j=1,subset(i)%NPART
6722 k = subset(i)%PART(j)
6723 IF(mater(k)>m3)THEN
6724 n0=n0+1
6725 ENDIF
6726 ENDDO
6727
6729 DO j=1,subset(i)%NPART
6730 k = subset(i)%PART(j)
6731 IF(mater(k)>m3)
6733 ENDDO
6734 ENDDO
6735
6736
6737
6738
6739 n0=0
6740 DO j=1,subset(i)%NPART
6741 k = subset(i)%PART(j)
6742 IF(mater(k)>m3)THEN
6743 n0=n0+1
6744 ENDIF
6745 ENDDO
6746
6748 DO j=1,subset(i)%NPART
6749 k = subset(i)%PART(j)
6750 IF(mater(k)>m3)
6752 ENDDO
6753 ENDIF
6754
6755 DO i=1,npart
6756 IF(mater(i)<0)mater(i)=-mater(i)
6757 ENDDO
6758 ENDIF
6759
6760 700 CONTINUE
6761
6762 IF (ispmd==0) THEN
6763
6766
6767 IF (output%checksum%checksum_countTHEN
6769 ENDIF
6770
6771 animtotalsize=animtotalsize+animsize
6772
6773 WRITE (iout,1000) filnam(1:filen)
6774 WRITE (istdo,1000) filnam(1:filen)
6775 1000 FORMAT (4x,' ANIMATION FILE:',1x,a,' WRITTEN')
6776 ENDIF
6777
6778 IF(anim_ply > 0) THEN
6779 DEALLOCATE(waft_ply)
6780 DEALLOCATE(el2fa_ply)
6781 DEALLOCATE(iad_plyg)
6782 ENDIF
6783 IF(anim_crk > 0) THEN
6784 DEALLOCATE(el2fa_crk)
6785 DEALLOCATE(iad_crkg)
6786 DEALLOCATE(iad_crk)
6787 DEALLOCATE(iad_lay)
6788 DEALLOCATE(waft_crk)
6789 ENDIF
6790
6791 DEALLOCATE(waft,mas,xnorm,xmass1,xmass2,xmass3,
6792 . xfunc1,xfunc2,xfunc3,xusr)
6793
6794 DEALLOCATE(wa4,mas4)
6795 DEALLOCATE(wa4_fvm)
6796
6797 DEALLOCATE(vflu,vvar1,aflu,vflu_ale,fanreact,fanreacr)
6798
6799 DEALLOCATE(wgps,vgps,itagps)
6800 DEALLOCATE(is_written_node)
6801 DEALLOCATE(iad)
6803 DEALLOCATE(mater)
6804 DEALLOCATE(el2fa)
6805 DEALLOCATE(iadg)
6806 DEALLOCATE(iadg_tpr)
6807 DEALLOCATE(nfshsz)
6808 DEALLOCATE(nfnodsz)
6809 DEALLOCATE(uix)
6810 DEALLOCATE(nfacptx)
6811 DEALLOCATE(ixedge)
6812 DEALLOCATE(ixfacet)
6813 DEALLOCATE(ixsolid)
6814 DEALLOCATE(inumx1)
6815 DEALLOCATE(inumx2)
6816 DEALLOCATE(inumx3)
6817 DEALLOCATE(ioffx1)
6818 DEALLOCATE(ioffx2)
6819 DEALLOCATE(ioffx3)
6820 DEALLOCATE(ig3dsolid)
6821
6822 RETURN
subroutine animig3d(elbuf_tab, iparg, x, d, v, a, wige, kxig3d, ixig3d, ig3dsolid, nanim3d_l, x_temp, d_temp, v_temp, a_temp, tabstresl, igeo, knot, itab, ipartig3d, ipart, cont, cont_temp, fint, fint_temp, fext, fext_temp, freac, freac_temp, knotlocpc, knotlocel)
subroutine animx(elbuf_tab, iparg, itab, x, kxx, ixx, ipartx, pm, geo, bufmat, bufgeo, uix, xusr, nfacptx, ixedge, ixfacet, ixsolid, inumx1, inumx2, inumx3, ioffx1, ioffx2, ioffx3, xmass1, xmass2, xmass3, xfunc1, xfunc2, xfunc3, nanim1d_l)
subroutine anioffc_crk(xfem_tab, iparg, ipart, ipartc, iparttg, ioff, el2fa, nbf, nbf_l, iad_crkg, iel_crk, indx_crk)
subroutine anioffc_ply(iply, nel_ply, elbuf_tab, iparg, ioff, el2fa, nbf, iadd, nbf_l, nbpart, iadg, nodglob, ipart, ipartc, iparttg, nbf_pxfemg, ipm, igeo, ixc, stack)
subroutine anioffs(elbuf_tab, iparg, ioff, el2fa, nbf, nbpart, isph3d)
void compute_binary_checksum(checksum *cs_output_files, char *file, int len, int izip)
subroutine cutcnt(icut, xcut, ixs, xyz0, d, len)
subroutine cutfunc(func, ivois, al, nodcut)
subroutine cutfunce(nc, numel, elbuf_tab, ifunc, iparg, pm, ixs)
subroutine cutmain(icut, xcut, ixs, xyz0, d, nodcut, nelcut, icbuf, cbuf, len, nbf)
subroutine cutmass(nc, x, al, nodcut, nelcut, vel, v, ivois)
subroutine delnumbc_crk(iparg, iel_crk, inum, idcmax, el2fa, iad_crkg, nbf_l, nbf, indx_crk)
subroutine delnumbc_ply(iply, nel_ply, iparg, ixc, ixtg, invert, el2fa, nbf, inum, nelcut, dd_iad, iadd, nbf_l, nbpart, iadg, nodglob, idcmax, nbf_pxfemg)
subroutine delnumbs(iparg, ixs, el2fa, nbf, inum, kxsp, isph3d)
subroutine dfuncc_crk(elbuf_tab, len, ifunc, iparg, geo, ixc, ixtg, mass, pm, el2fa, nbf, iadp, nbf_l, ehour, anim, nbpart, iadg, ipm, igeo, thke, err_thk_sh4, err_thk_sh3, xfem_tab, iel_crk, indx_crk, nbf_crkxfemg, el2fa0, crkedge)
subroutine dfuncc_ply(elbuf_tab, func, ifunc, iparg, geo, ixc, ixtg, mass, pm, el2fa, nbf, iadp, nbf_l, ehour, anim, nbpart, iadg, ipm, igeo, thke, err_thk_sh4, err_thk_sh3, mat_param, nbf_pxfemg, x, stack)
subroutine dfuncs(elbuf_tab, func, ifunc, iparg, ixs, pm, el2fa, nbf, isph3d)
subroutine dmasanis(elbuf_tab, iparg, ixs, mas, pm, el2fa, nbf, ipart, ipartsp, isph3d)
subroutine donerbe2(i, nerbe2_1, irbe2, nerbe2t)
subroutine donerbe3(i, nerbe3_1, irbe3, nerbe3t)
subroutine dparrbe2(lrbe2, irbe2)
subroutine dparrbe3(lrbe3, irbe3)
subroutine drbe2cnt(nerbe2, irbe2, lrbe2, weight)
subroutine drbe3cnt(nerbe3, irbe3, lrbe3, weight)
subroutine eloff(ixs, ixq, ixc, ixp, ixt, ixr, ixtg, iparg, iactiv, time, iflag, nn, elbuf_tab, x, temp, mcp, pm, igroups, mcp_off, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, itherm_fe)
subroutine cntskew(iparg, cnt, cntg)
subroutine dfungps2(elbuf_tab, func, ifunc, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, vgps)
subroutine dfungps1(elbuf_tab, func, ifunc, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, itagps)
subroutine tencgps2(elbuf_tab, iparg, itens, tens1, tens2, x, ixc, igeo, ixtg, geo, vgps)
subroutine tencgps1(elbuf_tab, iparg, itens, tens1, tens2, x, ixc, igeo, ixtg, itagps)
subroutine velvecc(v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
subroutine velvecc_max(vmax, nodcut, nnwl, nnsrg, nfvnod, nfnod_pxfemg, nfnod_crkxfemg)
subroutine velvecc22(elbuf_tab, iparg, iflg, ixs, ixq, itab)
subroutine velvec3(v, v_temp, vale, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
subroutine velvecc21(v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, vg21, nfnod_crkxfemg)
subroutine velvec2(ivois, v_temp, al, nodcut, fopt, npby, nnwl, nnsrg, nodglob, weight, fr_sec, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
subroutine xyznor16(ixs, ixs10, ixs20, ixs16, x)
subroutine xyz16(ixs, ixs10, ixs20, ixs16, x)
subroutine invert(matrix, inverse, n, errorflag)
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
type(fani_cell_) fani_cell
type(xfem_nodes_), dimension(:), allocatable crknod
type(xfem_shell_), dimension(:), allocatable crkshell
type(fvbag_data), dimension(:), allocatable fvdata
integer airbags_total_fvm_in_h3d
character(len=outfile_char_len) outfile_name
type(plynods), dimension(:), allocatable plynod
type(ply_data), dimension(:), allocatable ply
integer, dimension(:), allocatable indx_ply
integer, dimension(:), allocatable idpid_ply
type(plyshells), dimension(:), allocatable plyshell
subroutine nodal_schlieren(wa4, x, ixs, ixq, itab, iparg, ibid, elbuf_tab, ale_connectivity)
subroutine nodald(ifunc, wa4, wa4_fvm, iflow, rflow, iparg, elbuf_tab, ix, nix, numel, itab, nv46, monvol, volmon, airbags_total_fvm_in_h3d, is_written_node, is_written_node_fvm, ispmd, fvdata_p, swa4, airbags_node_id_shift)
subroutine nodalp(ifunc, wa4, wa4_fvm, iflow, rflow, iparg, elbuf_tab, ix, nix, numel, itab, nv46, monvol, volmon, airbags_total_fvm_in_h3d, is_written_node, is_written_node_fvm, ispmd, fvdata_p, swa4, airbags_node_id_shift)
subroutine nodalssp(ifunc, wa4, wa4_fvm, iflow, rflow, iparg, elbuf_tab, ix, nix, numel, itab, nv46, monvol, volmon, airbags_total_fvm_in_h3d, is_written_node, is_written_node_fvm, ispmd, fvdata_p, swa4, airbags_node_id_shift, multi_fvm)
subroutine nodalt(ifunc, wa4, wa4_fvm, iflow, rflow, iparg, elbuf_tab, ix, nix, numel, itab, nv46, monvol, volmon, airbags_total_fvm_in_h3d, is_written_node, is_written_node_fvm, ispmd, fvdata_p, swa4, airbags_node_id_shift)
subroutine nodalvfrac(ifunc, wa4, iflow, rflow, iparg, elbuf_tab, ix, nix, itab, nv46)
subroutine nodalzvol(ifunc, wa4, iflow, rflow, iparg, elbuf_tab, ix, nix, itab, nv46)
subroutine norcut(vn, lastn)
subroutine parcut(ixc, nelcut)
subroutine parsor_crk(iparg, ixc, ixtg, el2fa, idcrk, iad_crk, iad_crkg, nbf_l, nbf, iel_crk, nodglobxfe, indx_crk, itab)
subroutine parsor_ply(nel_ply, x, d, xnorm, cdg, iparg, ixc, ixtg, invert, el2fa, mater, ipartc, nodglob, idply, iadply, iadplyg, plynumc, nbf_pxfemg)
subroutine smass3(rho, ms, partsav, x, v, ipart, mss, volu, msnf, mssf, in, vr, ins, wma, rhocp, mcp, mcps, mssa, rhof, frac, fill, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
subroutine spmd_crk_idmax(idmax, itab)
subroutine spmd_dparrbe2(lrbe2, irbe2, nodglob, weight, nerbe2y, nerbe2t)
subroutine spmd_dparrbe3(lrbe3, irbe3, nodglob, weight, nerbe3y, nerbe3t)
subroutine spmd_dparrby(npby, lpby, fr_rby2, iad_rby2, sbufspm, sbufrecvm, sbufspo, sporby, nodglob, weight, itab)
subroutine spmd_exch_n(xnorm, iad_elem, fr_elem, lenr)
subroutine spmd_exch_nodarea2(nodarea, iad_elem, fr_elem, lenr, weight, jj)
subroutine spmd_exch_nodarea(nodarea, iad_elem, fr_elem, lenr, weight)
subroutine spmd_exch_nodareai(nodareai, iad_elem, fr_elem, lenr, weight)
subroutine spmd_fvb_adim(nfvtr, fvoff, nfvnod, nfvpart, nfvsubs, idmax, itab, nodcut, nnwl, nnsrg, nnsmd, nnsphg)
subroutine spmd_fvb_aelf(fvmass, fvpres, fvqx, fvqy, fvqz, fvrho, fvener, fvcson, fvgama, fvvisu, fvel2fa)
subroutine spmd_fvb_amon(monvol, volmon)
subroutine spmd_fvb_anod()
subroutine spmd_fvb_anum(fvoff, idmax, nfvnod)
subroutine spmd_fvb_aoff(fvel2fa)
subroutine spmd_fvb_apar(nelcut, nbf, nesct, nerwl, nesrg, nesmd1, fvpbuf)
subroutine spmd_fvb_asub1(ii, fvpbuf)
subroutine spmd_fvb_asub2()
subroutine spmd_fvb_atit(ctext, str, titl, ltitl, maxpart)
subroutine spmd_fvb_atr(nbid1, nbid2, nbid3, fvel2fa, fvinum, fvoff)
subroutine spmd_fvb_avec()
subroutine spmd_gatherf(v, weight, nodglob, num)
subroutine spmd_gatheritab(v, weight, nodglob, num)
subroutine spmd_gatheritab_crk(icrk, num, idmaxnod, nodglobxfe)
subroutine spmd_glob_imax9(v, len)
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
subroutine spmd_r4get_partn(size, nbf_l, nbpart, iadg, wal, buf)
subroutine spmd_glob_isum9(v, len)
subroutine spmd_max_xfe_i(int)
subroutine ani_txt50(text, len)
subroutine ani_txt(text, len)
subroutine anioff0(elbuf_tab, iparg, ioff, el2fa, nbf, sioff, sph2sol)
subroutine anioffc(elbuf_tab, iparg, ioff, el2fa, nbf)
subroutine aniofff(elbuf_tab, iparg, ioff, el2fa, nbf, ioffx1)
subroutine aniskew(elbuf_tab, skew, iparg, x, ixt, ixp, ixr, geo, bufl)
subroutine aniskewf(geo, skew, iparg, ixr, lrbuf)
subroutine delnumb0(iparg, el2fa, nbf, inum, kxsp)
subroutine delnumbc(iparg, ixq, ixc, ixtg, el2fa, nbf, inum, nelcut, nbpart, idcmax)
subroutine delnumbf(iparg, ixt, ixp, ixr, el2fa, nbf, inum, inumx1)
subroutine dfunc0(elbuf_tab, func, ifunc, iparg, pm, el2fa, nbf, spbuf, ipart, ipartsp)
subroutine dfuncc(elbuf_tab, bufel, func, ifunc, iparg, ixq, ixc, ixtg, pm, el2fa, nbf)
subroutine dfuncf(elbuf_tab, func, ifunc, iparg, geo, ixt, ixp, ixr, mass, pm, el2fa, nbf, iadp, nbpart, xfunc1)
subroutine dmasani0(elbuf_tab, iparg, mas, pm, el2fa, ipart, ipartsp)
subroutine dmasanic(elbuf_tab, x, d, geo, iparg, ixq, ixc, ixtg, mas, pm, el2fa, nbf)
subroutine dmasanif(x, d, elbuf_tab, geo, iparg, ixt, ixp, ixr, mas, pm, el2fa, nbf)
subroutine donerby(irby, nerby, npby, nerbt)
subroutine donerwl(irwl, nerwl, nprw)
subroutine donesec(isect, nesct, nstrf, ixs)
subroutine donesrg(isrg, nesrg)
subroutine dparrby(lpby, npby)
subroutine dparrws(nesbw, nstrf, ixc, ixtg, x, nodcut, rwbuf, nprw, ixs)
subroutine dparsrg(nsurg, nnwl, nodcut)
subroutine drbycnt(nerby, npby)
subroutine dseccnt(nesct, nerwl, nesbw, nstrf, rwbuf, nprw, nnwl, ixs)
subroutine dsecnor(x, rwbuf, nprw)
subroutine dsphcnt(nesph, nnsph, nesphg, nnsphg)
subroutine dsphnor(kxsp, x, spbuf, nnsph)
subroutine dsrgcnt(igrsurf, nsurg, nesrg, nnsrg, nesbw)
subroutine dsrgnor(igrsurf, bufsf)
subroutine dxyzsect(nstrf, rwbuf, nprw, x, xmin, ymin, zmin, xmax, ymax, zmax, itab)
subroutine dxyzsph(nesph, kxsp, x, spbuf, snnsphg, nnsph)
subroutine dxyzsrg(nesrg, igrsurf, bufsf)
subroutine parsor0(iadd, iparg, mater, el2fa, kxsp, ipartsp)
subroutine parsorc(x, d, xnorm, iadd, cdg, bufel, iparg, ixq, ixc, ixtg, invert, el2fa, mater, ipartq, ipartc, iparttg, elbuf_tab)
subroutine parsorf(iadd, iparg, ixt, ixp, ixr, mater, el2fa, ipartt, ipartp, ipartr, nfacptx, ixedge)
subroutine parsors(iadd, iparg, ixs, mater, iparts, el2fa, insph, kxsp, ipartsp, ixs10, ixs20, ixs16, nnsph, isph3d, shft16, shftsph, nnsphg)
subroutine scanor(x, d, cdg, scale)
subroutine tensor0(elbuf_tab, iparg, itens, pm, el2fa, nbf, tens, ipart, ipartsp)
subroutine tensorc(elbuf_tab, iparg, itens, invert, nelcut, el2fa, nbf, tens, iadp, nbf_l, nbpart, x, ixc, igeo, ixtg)
subroutine velvec(v, nnwl, nnsrg)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
subroutine tensgpstrain(elbuf_tab, func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, pm)
subroutine tensgps1(func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, elbuf_tab)
subroutine tensgps3(elbuf_tab, func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, pm)
subroutine tensgps2(func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, vgps, elbuf_tab)
subroutine tensorc_crk(elbuf_tab, xfem_tab, iparg, ipm, itens, invert, el2fa, nbf, len, epsdot, iadp, nbf_l, nbpart, iadg, x, ixc, igeo, ixtg, iel_crk, iadc_crk, crkedge, indx_crk, mat_param)
subroutine tensorc_ply(iply, nel_ply, elbuf_tab, iparg, itens, invert, el2fa, nbf, tens, epsdot, iadp, nbf_l, nbpart, iadg, x, ixc, mat_param, igeo, ixtg, nbf_pxfemg, ipm, stack)
subroutine tensors(elbuf_tab, iparg, itens, ixs, pm, el2fa, nbf, tens, x, ipart, ipartsp, isph3d, ipm)
subroutine torseur(iadg, iparg, itens, ixt, ixp, ixr, el2fa, nbf, tens, tors, nbpart)
subroutine velvecz22(elbuf_tab, iparg, ipari, igrnod, x, ixs, ixq, itab, iflg)
void write_s_c(int *w, int *len)
void write_i_c(int *w, int *len)
void write_r_c(float *w, int *len)
void file_size(int *filesize)
void write_c_c(int *w, int *len)
void open_c(int *ifil, int *len, int *mod)
subroutine xfecut(iparg, ixc, ixtg, ilev, elcutc, iel_crk, iadc_crk, nodedge, crkedge, xedge4n, xedge3n)
subroutine xyzcut(x, nodcut)
subroutine xyznod_crk(icrk, nfnod_crkxfemg, nodglobxfe)
subroutine xyznod_crk0(ilev)
subroutine xyznod_ply(iply, idply, nod_pxfem, x, zi_ply, nodglob, empsizpl)
subroutine xyznor_crk(icrk, xnorm, nfnod_crkxfemg)
subroutine xyznor_ply(iply, xnorm, nodglob, weight, empsizpl)
1.15.0