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