Sources Esope | Cast3M

rtconn
C RTCONN    SOURCE    CB215821  17/11/30    21:17:13     9639           
      SUBROUTINE RTCONN(XYZPT,IDIMC,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
     >                     COORD,SPH,IADET,NBADET,NADMAX,ZERO,iarr)
C     **********************************************************************
C     OBJET : RECHERCHE DES TRIANGLES CONNEXES "NON-DELAUNAY"
C     EN ENTREE   :
C        XYZPT : COORDONNEES DU POINT AJOUTE
C        IDIMC  : DIMENSION DE L'ESPACE
C        ITRNOE,NBNMAX,ITRTRI,NBCMAX,COORD : LA TRIANGULATION
C        SPH   : LES SPHERES CIRCONSCRITES AUX TRIANGLES
C        IADET,NBADET : L'ENSEMBLE DES ELEMENTS "NON-DELAUNAY"
C                (IE A DETRUIRE) ; EN ENTREE IL DOIT CONTENIR 1 ELEMENT.
C        NBADET: NOMBRE D'ELEMENTS A DETRUIRE
C        NBADETMNAX : TAILLE DU TABLEAU IADET
C     EN SORTIE   :
C        IADET    : TABLEAU DES TRIANGLES "NON-DELAUNAY"
C        NBADET   : NOMBRE DE TRIANGLES "  "    "   "
C     **********************************************************************
      IMPLICIT INTEGER(I-N)
      REAL*8       XYZPT(*)
      INTEGER    IDIMC
      INTEGER    ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
      INTEGER    IADET(*),NBADET,NADMAX,iarr
      REAL*8       COORD(*),SPH(*),ZERO
C
C
C     --- POUR LE DEBUG ---
C
C      COMMON /DEBUG/ ITRACE, ITEST, IERROR, IMESS
C      INTEGER       ITRACE, ITEST, IERROR
C      CHARACTER*256 IMESS
C     ---------------------------------------------------------------------
C     --- POUR LES STATS ---
C
C      COMMON /STATS/ ICARD(100)
C      INTEGER       ICARD
C     ---------------------------------------------------------------------
C     --- VARIABLES INTERNES ---
      INTEGER   J,K,NT,IPTDS, NBTRA, IVOIS, IT, ITRA, NBC
      INTEGER  SPPOIN
      EXTERNAL SPPOIN
C
      iarr = 0
      NBC = IDIMC+1
      IF( NBADET.NE.1 )THEN
        iarr = -1
        GOTO 999
      ENDIF
C
      NBTRA = 0
      ITRA  = 2
C
      IT = IADET(1)
      DO 3 J=1,NBC
        IVOIS = ITRTRI((IT-1)*NBCMAX+J)
        IF( IVOIS .LE. 0 )GOTO 3
        IADET(ITRA + NBTRA) = IVOIS
        NBTRA = NBTRA + 1
    3 CONTINUE
C
C     ON BOUCLE TANTQUE ITRAVAIL N'EST PAS VIDE
C     ----------------------------------------
    5 IF( NBTRA .EQ. 0 )GOTO 999
      IT     = IADET(ITRA)
      NBTRA  = NBTRA-1
      ITRA = ITRA + 1
      NT =ITRNOE((IT-1)*NBNMAX+1+IDIMC)
      IF( NT.EQ. 0 )GOTO 5
      IPTDS = SPPOIN(IDIMC,COORD((NT-1)*IDIMC+1),XYZPT,
     >       SPH((IT-1)*(IDIMC+1)+1),ZERO)
        IF( IPTDS.EQ.1 )THEN
C         ---------------------------
C         LE TRIANGLE EST A DETRUIRE
C         ---------------------------
          NBADET = NBADET+1
          IF(NBADET.GT.NADMAX)THEN
            iarr = -2
            GO TO 999
          ENDIF
          IADET(NBADET)= IT
C         ------------------------------------------
C         ON MET LES VOISINS A TRAITER DANS ITRAVAIL
C         ------------------------------------------
          DO 20 J=1,NBC
            IVOIS = ITRTRI((IT-1)*NBCMAX+J)
            IF( IVOIS .LE. 0 )GOTO 20
            DO 10 K=1,NBADET
              IF( IVOIS.EQ.IADET(K) )GOTO 20
   10       CONTINUE
C           --- LE VOISIN EST DEJA A TRAITER : BUG6 ---
C           EN 3D POSSIBLE - EN 2D => ON PERD UN SOMMET
C           -------------------------------------------
            DO 15 K=1,NBTRA
              IF( IVOIS.EQ.IADET(ITRA+K-1) )GOTO 20
   15       CONTINUE
C
            IF((NBTRA+ITRA).GT.NADMAX)THEN
              iarr = -2
              GO TO 999
            ENDIF
            IADET(ITRA + NBTRA) = IVOIS
            NBTRA = NBTRA + 1
   20     CONTINUE
        ENDIF
        GOTO 5
  999 END