freanim.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    freanim                ../engine/source/output/anim/reader/freanim.F
!||--- called by ------------------------------------------------------
!||    freform                ../engine/source/input/freform.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../engine/source/output/message/message.F
!||    anim_dcod_key_0        ../engine/source/output/anim/reader/anim_dcod_key_0.F
!||    anim_reset_index_all   ../engine/source/output/anim/reader/anim_reset_index_all.F
!||    anim_set2zero_struct   ../engine/source/output/anim/reader/anim_set2zero_struct.F
!||    arret                  ../engine/source/system/arret.F
!||    fredec_8key_i          ../engine/source/input/fredec_8key_i.F
!||    wriusc2                ../engine/source/input/wriusc2.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../engine/share/message_module/message_mod.F
!||    names_and_titles_mod   ../common_source/modules/names_and_titles_mod.F
!||    output_mod             ../common_source/modules/output/output_mod.F90
!||    sensor_mod             ../common_source/modules/sensor_mod.F90
!||    stack_mod              ../engine/share/modules/stack_mod.F
!||====================================================================
      SUBROUTINE freanim(OUTPUT,IKAD,KEY0,KANIM,SENSORS)
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 output_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-----------------------------------------------
      type(output_), intent(inout) :: OUTPUT
      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
      output%nb_anim_frame = 0
      output%DTANIM_FCT_ID = 0
C-----------------------------------------------
C     Set all indexes and some other variables for ANIM to zero
C-----------------------------------------------
      CALL anim_set2zero_struct(output,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)OUTPUT%TANIM0,output%DTANIM0,output%TANIM_STOP0,output%nb_anim_frame,output%dtanim_fct_id
           GOTO 320
 310       READ(iusc2,*,err=320,END=320)OUTPUT%tanim0
 320       CONTINUE
!
c           DO I=1,NBC
c             READ(IUSC1,REC=IKAD(IKEY)+K+I-1,FMT='(A)',ERR=9990)CARTE
c             CALL WRIUSC2(IKAD(IKEY)+K+I-1,1,KEY0(IKEY))
c             READ(IUSC2,*,ERR=9990,END=9990) TIME_I,NB_FRAME_I,TILTLE_I
c             NFRAME=NFRAME+1
c             TIME_ANIM_TAB( NFRAME) = TIME_I
c             NB_FRAME_ANIM_TAB(NFRAME)=NB_FRAME_I
c             TITLE_ANIM_TAB(NFRAME)=TILTLE_I
c           ENDDO
 
 
           IF (output%DTANIM0 <= zero.AND.output%DTANIM_FCT_ID == 0.AND.output%nb_anim_frame==0) THEN
             CALL ancmsg(msgid=293,anmode=aninfo,c1='ANIM',c2='ANIM')
             CALL arret(0)
           ENDIF
           
           IF (output%TANIM_STOP0 < zero) THEN
             CALL ancmsg(msgid=304,anmode=aninfo,c1='ANIM',c2='ANIM')
             CALL arret(0)
           ELSEIF (output%TANIM_STOP0 == zero)THEN
             output%TANIM_STOP0 = ep20
           ELSE
             output%TANIM_STOP0 = max(output%TANIM_STOP0, max(zero,output%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(output,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 not worn in 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)
      END