dd_ani.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr15_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	dd_ani (x, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, iparg, kxsp, ixsp)

Function/Subroutine Documentation

dd_ani()

subroutine dd_ani	(		x,
		integer, dimension(*)	ixs,
		integer, dimension(*)	ixq,
		integer, dimension(*)	ixc,
		integer, dimension(*)	ixt,
		integer, dimension(*)	ixp,
		integer, dimension(*)	ixr,
		integer, dimension(*)	ixtg,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(nisp,*)	kxsp,
		integer, dimension(kvoisph,*)	ixsp )

Definition at line 35 of file dd_ani.F.

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