Esope source files

   1 : C RTADET    SOURCE    FANDEUR   13/01/29    21:16:23     7683           
   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 : C      INTEGER  SPPOIN, SPPOI2    modif TC
  42 :       INTEGER  SPPOIN, SPPOI2,SPCIRC
  43 : C      EXTERNAL SPPOIN, SPPOI2   modif TC
  44 :       EXTERNAL SPPOIN, SPPOI2,SPCIRC
  45 : C
  46 :       ITRACE = 0
  47 :       DO i = 1, 4
  48 :         SPHC(i) = 0.D0
  49 :       ENDDO
  50 :       iarr = 0
  51 :       NBADET = 0
  52 :       DO 30 I=1,NBE
  53 : C     ----- ON PREND LE DERNIER NOEUD ---
  54 :         NT =ITRNOE((I-1)*NBNMAX+1+IDIMC)
  55 :         IF ( NT.EQ. 0 ) GO TO 30
  56 :         IPTDS = SPPOIN(IDIMC,COORD((NT-1)*IDIMC+1),XYZPT,
  57 :      >       SPH((I-1)*(IDIMC+1)+1),ZERO)
  58 : C
  59 : C       ---- POUR LE DEBUG ----
  60 : C
  61 :       IF( ITRACE .GT. 0 )THEN
  62 :         IPTDS2 = SPPOI2(IDIMC,COORD((NT-1)*IDIMC+1),XYZPT,
  63 :      >       SPH((I-1)*(IDIMC+1)+1),ZERO)
  64 :         IF( IPTDS2.NE.IPTDS )THEN
  65 : C          ICARD(1) = ICARD(1) + 1
  66 : C            PRINT *,'DIFFERENCE DE CALCUL'
  67 : C            PRINT *,'SPPOI2 = ',IPTDS2,' SPPOIN = ',IPTDS
  68 : C            PRINT *, (SPHC(J),J=1,3)
  69 :             IPTDS = SPPOIN(IDIMC,COORD((NT-1)*IDIMC+1),XYZPT,
  70 :      >       SPH((I-1)*(IDIMC+1)+1),ZERO)
  71 :             IPTDS2 = SPPOI2(IDIMC,COORD((NT-1)*IDIMC+1),XYZPT,
  72 :      >       SPH((I-1)*(IDIMC+1)+1),ZERO)
  73 :         ENDIF
  74 : C   modif TC spcirc est une fonction
  74 : C        CALL SPCIRC(ITRNOE((I-1)*NBNMAX+1),COORD,SPHC,ZERO)
  75 :         IBID= SPCIRC(ITRNOE((I-1)*NBNMAX+1),COORD,SPHC,ZERO)
  76 :         IPTDSC = SPPOIN(IDIMC,COORD((NT-1)*IDIMC+1),XYZPT,
  77 :      >         SPHC(1),ZERO)
  78 :         IF(( SPHC(1).NE. SPH((I-1)*(IDIMC+1)+1)).OR.
  79 :      >     ( SPHC(2).NE. SPH((I-1)*(IDIMC+1)+2)).OR.
  80 :      >     ( SPHC(3).NE. SPH((I-1)*(IDIMC+1)+3)))THEN
  81 : C          PRINT *,'ERREUR SUR LA SPHERE'
  82 : C          PRINT *, (SPH((I-1)*(IDIMC+1)+J),J=1,3)
  83 : C          PRINT *, (SPHC(J),J=1,3)
  84 :         ENDIF
  85 :         ENDIF
  86 : C       ------------------------
  87 :         IF( IPTDS.EQ.1 )THEN
  88 :           IADET(1) = I
  89 :           NBADET = 1
  89 :           CALL RTCONN(XYZPT,IDIMC,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  90 :      >                   COORD,SPH,IADET,NBADET,NADMAX,ZERO,iarr)
  91 :           RETURN
  92 :         ENDIF
  93 : C
  94 :    30 CONTINUE
  95 : 
  96 :       RETURN
  97 :       END
  98 :