Esope source files

   1 : C RTCONN    SOURCE    CHAT      06/03/29    21:32:32     5360           
   2 :       SUBROUTINE RTCONN(XYZPT,IDIMC,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
   3 :      >                     COORD,SPH,IADET,NBADET,NADMAX,ZERO,iarr)
   4 : C     **********************************************************************
   5 : C     OBJET : RECHERCHE DES TRIANGLES CONNEXES "NON-DELAUNAY" 
   6 : C     EN ENTREE   :
   7 : C        XYZPT : COORDONNEES DU POINT AJOUTE
   8 : C        IDIMC  : DIMENSION DE L'ESPACE
   9 : C        ITRNOE,NBNMAX,ITRTRI,NBCMAX,COORD : LA TRIANGULATION
  10 : C        SPH   : LES SPHERES CIRCONSCRITES AUX TRIANGLES
  11 : C        IADET,NBADET : L'ENSEMBLE DES ELEMENTS "NON-DELAUNAY" 
  12 : C                (IE A DETRUIRE) ; EN ENTREE IL DOIT CONTENIR 1 ELEMENT.
  13 : C        NBADET: NOMBRE D'ELEMENTS A DETRUIRE
  14 : C        NBADETMNAX : TAILLE DU TABLEAU IADET 
  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    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   J,K,NT,IPTDS, NBTRA, IVOIS, IT, ITRA, NBC
  40 :       INTEGER  SPPOIN
  41 :       EXTERNAL SPPOIN
  42 : C
  43 :       iarr = 0
  44 :       NBC = IDIMC+1
  45 :       IF( NBADET.NE.1 )THEN
  46 :         iarr = -1
  47 :         GOTO 999
  48 :       ENDIF
  49 : C
  50 :       NBTRA = 0
  51 :       ITRA  = 2
  52 : C      
  53 :       IT = IADET(1)
  54 :       DO 3 J=1,NBC
  55 :         IVOIS = ITRTRI((IT-1)*NBCMAX+J)
  56 :         IF( IVOIS .LE. 0 )GOTO 3
  57 :         IADET(ITRA + NBTRA) = IVOIS
  58 :         NBTRA = NBTRA + 1
  59 :     3 CONTINUE      
  60 : C
  61 : C     ON BOUCLE TANTQUE ITRAVAIL N'EST PAS VIDE
  62 : C     ----------------------------------------
  63 :     5 IF( NBTRA .EQ. 0 )GOTO 999
  64 :       IT     = IADET(ITRA)
  65 :       NBTRA  = NBTRA-1 
  66 :       ITRA = ITRA + 1 
  67 :       NT =ITRNOE((IT-1)*NBNMAX+1+IDIMC)
  68 :       IF( NT.EQ. 0 )GOTO 5
  69 :       IPTDS = SPPOIN(IDIMC,COORD((NT-1)*IDIMC+1),XYZPT,
  70 :      >       SPH((IT-1)*(IDIMC+1)+1),ZERO)
  71 :         IF( IPTDS.EQ.1 )THEN
  72 : C         ---------------------------
  73 : C         LE TRIANGLE EST A DETRUIRE
  74 : C         ---------------------------
  75 :           NBADET = NBADET+1
  76 :           IF(NBADET.GT.NADMAX)THEN
  77 :             iarr = -2
  78 :             GO TO 999
  79 :           ENDIF
  80 :           IADET(NBADET)= IT
  81 : C         ------------------------------------------
  82 : C         ON MET LES VOISINS A TRAITER DANS ITRAVAIL
  83 : C         ------------------------------------------
  84 :           DO 20 J=1,NBC
  85 :             IVOIS = ITRTRI((IT-1)*NBCMAX+J)
  86 :             IF( IVOIS .LE. 0 )GOTO 20
  87 :             DO 10 K=1,NBADET
  88 :               IF( IVOIS.EQ.IADET(K) )GOTO 20
  89 :    10       CONTINUE
  90 : C           --- LE VOISIN EST DEJA A TRAITER : BUG6 ---
  91 : C           EN 3D POSSIBLE - EN 2D => ON PERD UN SOMMET
  92 : C           -------------------------------------------
  93 :             DO 15 K=1,NBTRA
  94 :               IF( IVOIS.EQ.IADET(ITRA+K-1) )GOTO 20
  95 :    15       CONTINUE
  96 : C
  97 :             IF((NBTRA+ITRA).GT.NADMAX)THEN
  98 :               iarr = -2
  99 :               GO TO 999
 100 :             ENDIF
 101 :             IADET(ITRA + NBTRA) = IVOIS
 102 :             NBTRA = NBTRA + 1
 103 :    20     CONTINUE
 104 :         ENDIF
 105 :         GOTO 5
 106 :   999 END
 107 :  
 108 :  
 109 :