Télécharger la plaquette Cast3M


fr en

Télécharger rtadet.eso

Retour à la liste

Numérotation des lignes : 

rtadet

  1. C RTADET    SOURCE    CB215821  17/11/30    21:17:12     9639           
  2.       SUBROUTINE RTADET(XYZPT,IDIMC,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  3.      >                     NBE,COORD,SPH,
  4.      >                     IADET,NBADET,NADMAX,ZERO,iarr)
  5. C     **********************************************************************
  6. C     OBJET : RECHERCHE DES TRIANGLES A DETRUIRE (IE "NON-DELAUNAY")
  7. C             A L'AJOUT D'UN POINT
  8. C     EN ENTREE   :
  9. C        XYZPT : COORDONNEES DU POINT AJOUTE
  10. C        IDIMC  : DIMENSION DE L'ESPACE
  11. C        ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,COORD : LA TRIANGULATION
  12. C        SPH   : LES SPHERES CIRCONSCRITES AUX TRIANGLES
  13. C        NBADETMNAX : TAILLE DU TABLEAU IADET
  14. C        ZERO  : PRECISION DU TEST "POINT DANS SPHERE"
  15. C     EN SORTIE   :
  16. C        IADET    : TABLEAU DES TRIANGLES "NON-DELAUNAY"
  17. C        NBADET   : NOMBRE DE TRIANGLES "  "    "   "
  18. C     **********************************************************************
  19.       IMPLICIT INTEGER(I-N)
  20.       REAL*8       XYZPT(*)
  21.       INTEGER    IDIMC
  22.       INTEGER    ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
  23.       INTEGER    NBE,IADET(*),NBADET,NADMAX,iarr
  24.       REAL*8       COORD(*),SPH(*),ZERO
  25. C
  26. C
  27. C     --- POUR LE DEBUG ---
  28. C
  29. C      COMMON /DEBUG/ ITRACE, ITEST, ierrOR, IMESS
  30. C      INTEGER       ITRACE, ITEST, ierrOR
  31. C      CHARACTER*256 IMESS
  32. C     ---------------------------------------------------------------------
  33. C     --- POUR LES STATS ---
  34. C
  35. C      COMMON /STATS/ ICARD(100)
  36. C      INTEGER       ICARD
  37. C     ---------------------------------------------------------------------
  38. C     --- VARIABLES INTERNES ---
  39.       INTEGER   I,NT,IPTDS,IPTDSC,IPTDS2,ITRACE
  40.       REAL*8      SPHC(4)
  41.       INTEGER  SPPOIN
  42.       EXTERNAL SPPOIN
  43. C
  44.       ITRACE = 0
  45.       DO i = 1, 4
  46.         SPHC(i) = 0.D0
  47.       ENDDO
  48.       iarr = 0
  49.       NBADET = 0
  50.       DO 30 I=1,NBE
  51. C     ----- ON PREND LE DERNIER NOEUD ---
  52.         NT =ITRNOE((I-1)*NBNMAX+1+IDIMC)
  53.         IF ( NT.EQ. 0 ) GO TO 30
  54.         IPTDS = SPPOIN(IDIMC,COORD((NT-1)*IDIMC+1),XYZPT,
  55.      >       SPH((I-1)*(IDIMC+1)+1),ZERO)
  56. C
  57.         IF( IPTDS.EQ.1 )THEN
  58.           IADET(1) = I
  59.           NBADET = 1
  60.           CALL RTCONN(XYZPT,IDIMC,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  61.      >                   COORD,SPH,IADET,NBADET,NADMAX,ZERO,iarr)
  62.           RETURN
  63.         ENDIF
  64. C
  65.    30 CONTINUE
  66.  
  67.       RETURN
  68.       END
  69.  
  70.  
  71.  
  72.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales