dd_ani.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/.
!||====================================================================
!||    dd_ani          ../starter/source/output/anim/dd_ani.F
!||--- called by ------------------------------------------------------
!||    domdec1         ../starter/source/spmd/domain_decomposition/domdec1.F
!||--- calls      -----------------------------------------------------
!||    parsor          ../starter/source/output/anim/parsor.F
!||    scanor          ../starter/source/output/anim/scanor.F
!||    slagcnt         ../starter/source/output/anim/slagcnt.F
!||    xyznod          ../starter/source/output/anim/xyznod.F
!||    xyznor          ../starter/source/output/anim/xyznor.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      SUBROUTINE dd_ani(X     ,IXS   ,IXQ  ,IXC  ,
     .                  IXT   ,IXP   ,IXR  ,IXTG ,
     .                  IPARG ,KXSP  ,IXSP )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE inoutfile_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      "com01_c.inc"
#include      "com04_c.inc"
#include      "scr15_c.inc"
#include      "param_c.inc"
#include      "units_c.inc"
#include      "sphcom.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real
     .   x(*)
      INTEGER IXS(*),IXQ(*),IXC(*),KXSP(NISP,*),IXSP(KVOISPH,*),
     .        IXTG(*),IXT(*),IXP(*),IXR(*),IPARG(NPARG,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     &  , DIMENSION(:,:), ALLOCATABLE :: d,xnorm
      INTEGER, DIMENSION(:), ALLOCATABLE :: INVERT,IAD
      CHARACTER*80 STR
      CHARACTER CHANIM*3,FILNAM*12
      INTEGER I, NBF, NBPART, MAGIC, J, FILEN,NNSLAG,
     .        ianim, nbcsph, n1, n2,
     .        ctext(81),ib,proc
      my_real
     .        cdg(3), s3000, scale,bufel(1)
      REAL R4
C
C      
      s3000 = three1000
C
Calcul connectivite sph pour A000 domdec
C
      nbcsph = 0
      DO i = 1, numsph
C maillage hexagonal compact => 12 voisins les + proches
          DO j = 1,min(12,kxsp(4,i))
            n1 = kxsp(3,i)
            n2 = ixsp(j,i)
            IF(n1<n2) THEN
              nbcsph = nbcsph + 1
            END IF
          END DO
      END DO
C---------- -------------------------------------
C   INIT SPECIAL STARTER
C-----------------------------------------------
      ALLOCATE(xnorm(3,numnod))
      ALLOCATE(d(3,numnod))
      ALLOCATE(
     &  invert(numelc+numeltg+numelq+6*numels+numelt+numelp+numelr+
     &         nbcsph))
      ALLOCATE(iad(nspmd+1))
      DO i=1,3
        DO j=1,numnod
          d(i,j) = zero
        END DO
      END DO
C-----------------------------------------------
C   OPEN FILE
C-----------------------------------------------
      ianim=0
      WRITE(chanim,'(I3.3)')ianim
      filnam=outfile_name(1:outfile_name_len)//rootnam(1:rootlen)//'A'//chanim
      filen = rootlen + 4 + outfile_name_len
C
      DO 1 i=1,filen
 1    ctext(i)=ichar(filnam(i:i))
      CALL cur_fil_c(0)
C     CALL OPEN_C(CTEXT,FILEN)
      CALL open_c(ctext,filen,0)
C-----------------------------------------------
C   PART COUNT
C-----------------------------------------------
     
      nbpart = 0
      nbpart = nspmd
C
      CALL slagcnt(iparg,nnslag)
C
      nbf = 6*nnslag + numelq + numelc + numeltg + numelp
     .               + numelt + numelr + nfacx + nbcsph   
C-----------------------------------------------
C   WRITE CONTROL
C-----------------------------------------------
C
C     MAGIC = 0x5429
      magic = 21545
      CALL write_i_c(magic,1)
      CALL write_i_c(numnod,1)
      CALL write_i_c(nbf,1)
      CALL write_i_c(nbpart,1)
      CALL write_i_c(0,1)
      CALL write_i_c(0,1)
      CALL write_i_c(0,1)
C-----------------------------------------------
      r4 = zero
      CALL write_r_c(r4,1)
C-----------------------------------------------
C   NODE X Y Z
C-----------------------------------------------
      CALL xyznod(x)
      CALL scanor(x,d,cdg,scale)
C-----------------------------------------------
C   PART SORT
C-----------------------------------------------
      CALL parsor(x    ,d    ,xnorm ,iad  ,cdg   ,
     .            bufel,iparg,ixs   ,ixq  ,ixc   ,
     .            ixtg ,ixt  ,ixp   ,ixr  ,invert,
     .            kxsp ,ixsp  )
C-----------------------------------------------
C   PART ADD
C-----------------------------------------------
       CALL write_i_c(iad,nbpart)
C-----------------------------------------------
C   PART HEAD
C-----------------------------------------------
       DO proc = 1, nspmd
         WRITE(str,'(A17,I4)') 'Domaine number : ',proc
         DO j = 1, 21
           ctext(j)=ichar(str(j:j))
         END DO
         ctext(22) = 0
         CALL write_c_c(ctext,81)
       END DO
C-----------------------------------------------
C   NORMAL
C-----------------------------------------------
      CALL xyznor(xnorm)
C-----------------------------------------------
C   FUNC TEXT
C-----------------------------------------------
      ctext(81)=0
C-----------------------------------------------
      CALL close_c
C-----------------------------------------------
C   FIN SPECIAL STARTER
C-----------------------------------------------
       DEALLOCATE(xnorm)
       DEALLOCATE(d)
       DEALLOCATE(invert)
       DEALLOCATE(iad)
C-----------------------------------------------
      WRITE (iout,1000)  filnam(1:filen)
      WRITE (istdo,1000) filnam(1:filen)
 1000 FORMAT (1x,'.. ANIMATION FILE:',1x,a,' WRITTEN')
C
      RETURN
      END