freanim.F File Reference

#include "implicit_f.inc"
#include "units_c.inc"
#include "com01_c.inc"
#include "warn_c.inc"
#include "scr06_c.inc"
#include "scr14_c.inc"
#include "scrcut_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	freanim (ikad, key0, kanim, sensors)

Function/Subroutine Documentation

freanim()

subroutine freanim	(	integer, dimension(0:*)	ikad,
		character, dimension(*)	key0,
		integer	kanim,
		type (sensors_), intent(inout)	sensors )

Definition at line 42 of file freanim.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE names_and_titles_mod, ONLY: ncharline100,ncharkey,line120
      USE message_mod
      USE stack_mod
      USE anim_mod
      USE sensor_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
#include      "com01_c.inc"
#include      "warn_c.inc"
#include      "scr06_c.inc"
#include      "scr14_c.inc"
#include      "scrcut_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IKAD(0:*),KANIM
      CHARACTER KEY0(*)*5
      TYPE (SENSORS_), INTENT(INOUT) :: SENSORS
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER NVAR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, NBC, K, IKEY, N1, N2, N3, ITYP,J,NTITLE, IXITKEY
      CHARACTER  TITLE*72,  TITLE2*80
      CHARACTER(LEN=LINE120)::LINE
      CHARACTER(LEN=NCHARLINE100)::CARTE
      CHARACTER(LEN=NCHARKEY)::KEY2
      CHARACTER(LEN=NCHARKEY)::KEY3
      CHARACTER(LEN=NCHARKEY)::KEY4
      CHARACTER(LEN=NCHARKEY)::KEY5
      CHARACTER(LEN=NCHARKEY)::KEY6
      CHARACTER(LEN=NCHARKEY)::KEY7
      CHARACTER(LEN=NCHARKEY)::KEY8
 
      my_real x0,y0,z0,vnx,vny,vnz,v0
C-----------------------------------------------
      ikey = kanim
      animcont = 0
C-----------------------------------------------
C     Set all indexes and some other variables for ANIM to zero
C-----------------------------------------------
      CALL anim_set2zero_struct(sensors)
C-----------------------------------------------
C     Loop over /ANIM cards
C-----------------------------------------------
      ixitkey=0
      IF(ikad(ikey)/=ikad(ikey+1))THEN
       k=0
 1160  READ(iusc1,rec=ikad(ikey)+k,fmt='(A)')line
       CALL fredec_8key_i(line,key2,key3,key4,key5,key6,key7,key8,nbc)
 
       k=k+1
 
       IF(nbc/=0)THEN
C----------------------------
C        THE FOLLOWING OPTIONS USE AN ADDITIONAL CARD
C----------------------------
         IF(key2(1:5)=='DT   ')THEN
           CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
           READ(iusc2,*,err=310,END=320)TANIM0,DTANIM0,tanim_stop0
           GOTO 320
 310       READ(iusc2,*,err=320,END=320)tanim0
 320       CONTINUE
!
           IF (dtanim0 <= zero) THEN
             CALL ancmsg(msgid=293,anmode=aninfo,c1='ANIM',c2='ANIM')
             CALL arret(0)
           ENDIF
           
           IF (tanim_stop0 < zero) THEN
             CALL ancmsg(msgid=304,anmode=aninfo,c1='ANIM',c2='ANIM')
             CALL arret(0)
           ELSEIF (tanim_stop0 == zero)THEN
             tanim_stop0 = ep20
           ELSE
             tanim_stop0 = max(tanim_stop0, max(zero,tanim0))
           ENDIF           
!
         ELSEIF(key2(1:5)=='SENSO')THEN
           CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
           READ(iusc2,*,err=9990) sensors%ANIM_ID,sensors%ANIM_DT
!
         ELSEIF(key2(1:5)=='LSENS')THEN
          DO i=1,nbc
             READ(iusc1,rec=ikad(ikey)+k+i-1,fmt='(A)',err=9990)carte
             CALL wriusc2(ikad(ikey)+k+i-1,1,key0(ikey))
             READ(iusc2,*,err=9990,END=9990) (SENSORS%ANIM_TMP(J+SENSORS%NANIM),J=1,NVAR(CARTE))
             DO j=1,nvar(carte)
               sensors%NANIM = sensors%NANIM + 1
             ENDDO
          ENDDO
!
         ELSEIF(key2(1:5)=='TITLE')THEN
          DO i=1,nbc
             READ(iusc1,rec=ikad(ikey)+k+i-1,fmt='(A)',err=9990)carte
             CALL wriusc2(ikad(ikey)+k+i-1,1,key0(ikey))
             READ(iusc2,*,err=9990,END=9990) NTITLE,title2
             nltitle=nltitle+1
             ntitletab(nltitle)=ntitle
             titletab(nltitle)=title2
          ENDDO
         ELSEIF(key2(1:3)=='CUT')THEN
          ncuts=ncuts+1
          READ(key3(1:4),'(I4)')ityp
          CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
          READ(iusc2,'(A)',err=9990,END=9990)title
          WRITE(iin,'(I8,A)')ityp,title
          k=k+1
          CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
          IF(ityp<3)THEN
            READ(iusc2,*,err=9990,END=9990)X0,Y0,Z0,VNX,VNY,VNZ,v0
            WRITE(iin,'(7E16.9)')x0,y0,z0,vnx,vny,vnz,v0
          ELSE
            READ(iusc2,*,err=9990,END=9990)N1,N2,n3
            WRITE(iin,'(3I8)')n1,n2,n3
          ENDIF
          k=k-1
         END IF
       ELSE ! IF(NBC/=0)THEN
C----------------------------
C        THE FOLLOWING OPTIONS DONT USE ANY ADDITIONAL CARD
C----------------------------
         CALL anim_dcod_key_0(key2,key3,key4,key5,key6,ierr,ixitkey)
         IF(ixitkey/=0) GOTO 9990
       ENDIF
       k=k+nbc
       IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 1160
      ENDIF
C-----------------------------------------------
C     This routine is resetting indexes in cas of /STRESS/ALL, /STRAIN/ALL, etc
C     The correct indexes wrt integration points or layers of all actual elements 
C     will be rebuilt after reading the restart file.
C-----------------------------------------------
      CALL anim_reset_index_all()
C-----------------------------------------------
      nv_ani = 0
      nt_ani = 0
      ne_ani = 0
      nn_ani = 0
      nct_ani = 0
      nce_ani = 0
      nst_ani = 0
      nse_ani = 0
      nft_ani = 0
      nfe_ani = 0
      DO i = 1,mx_ani
        nv_ani = nv_ani + anim_v(i)
        nt_ani = nt_ani + anim_t(i)
        ne_ani = ne_ani + anim_e(i)
        nn_ani = nn_ani + anim_n(i)
        nst_ani = nst_ani + anim_st(i)
        nse_ani = nse_ani + anim_se(i)
        nct_ani = nct_ani + anim_ct(i)
        nce_ani = nce_ani + anim_ce(i)
        nft_ani = nft_ani + anim_ft(i)
        nfe_ani = nfe_ani + anim_fe(i)
      ENDDO
      IF(anim_v(12)==1)nv_ani=nv_ani+1
      IF(anim_v(4)==1.AND.animcont == 0) nv_ani=nv_ani-1
      IF(anim_v(27)==1)nv_ani=nv_ani+1
C-----------------------------------------------
C     Anim Cut non portees en SPMD
      IF (ncuts>0.AND.nspmd>1) THEN
       CALL ancmsg(msgid=191,anmode=aninfo)
       ierr=ierr+1
      ENDIF
      IF(anim_vers<40) THEN
        CALL ancmsg(msgid=192,anmode=aninfo)
        ierr=ierr+1
      ENDIF
      IF (anim_vers>=50) THEN
        CALL ancmsg(msgid=193,anmode=aninfo)
        ierr=ierr+1
      ENDIF
      RETURN
C-----------------------------------------------
 9990 CONTINUE
      CALL ancmsg(msgid=73,anmode=aninfo,c1=key0(ikey),c2=line(1:35))
      CALL arret(0)