Esope source files

   1 : C TTCONN    SOURCE    CHAT      06/03/29    21:36:57     5360           
   2 : C
   3 : C     *****************************************************************
   4 : C     MODULE  : D3 (RESPECT D'UNE ARETE)
   5 : C     FICHIER : D3_FRONTIER.F
   6 : C     OBJET   : FORCE LE RESPECT DES ARETES FRONTIERE DANS UN MAILLAGE 
   7 : C               TETRAEDRIQUE 3D
   8 : C     FONCT.  : 
   9 : C       RF3RAR : IMPOSE LE RESPECTER D'UNE ARETE A UN MAILLAGE 
  10 : C       RF3FAR : FORCE LE MAILLAGE A RESPECTER UNE ARETE 
  11 : C
  12 : C     AUTEUR  : O. STAB
  13 : C     DATE    :  
  14 : C     TEST    :  
  15 : C     MODIFICATIONS :
  16 : C      AUTEUR, DATE, OBJET :
  17 : C
  18 : C     *****************************************************************
  19 : C
  20 : C
  21 :       SUBROUTINE TTCONN(NBN,NN,ITT,NBT,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  22 :      >                   ICONN,NBCONN,NADMAX,NBNOCO,iarr)
  23 : C     **********************************************************************
  24 : C     OBJET : TETRAEDRES CONTENANT DES NOEUDS
  25 : C     EN ENTREE   :
  26 : C        NBN  : NOMBRE DE NOEUDS RECHERCHES 
  27 : C        NN   : TABLEAU DES NOEUDS RECHERCHES
  28 : C        ITT  : L'ELEMENT DE DEPART CONTENANT DES NOEUDS DE NN
  29 : C        NBT  : NOMBRE DE NOEUDS DE NN QUE CONTIENT ITT ( 0 < NBT <= NBN)
  30 : C        ITRNOE,NBNMAX,ITRTRI,NBCMAX : LA TRIANGULATION
  31 : C
  32 : C        ICONN,NBCONN : L'ENSEMBLE DES ELEMENTS CONNEXES
  33 : C        NBCONNMNAX   : TAILLE DU TABLEAU ICONN 
  34 : C     EN SORTIE   :
  35 : C        ICONN    : TABLEAU DES ELEMENTS
  36 : C        NBCONN   : NOMBRE D'ELEMENTS
  37 : C        NBNOCO   : NOMBRE DE NOEUDS TROUVES
  38 : C     **********************************************************************
  39 :       IMPLICIT INTEGER(I-N)
  40 :       INTEGER    ITT,NBT,NN(*),NBN
  41 :       INTEGER    ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
  42 :       INTEGER    ICONN(*),NBCONN,NADMAX,NBNOCO,iarr
  43 : C
  44 : C   
  45 : C     --- POUR LE DEBUG ---
  46 : C
  47 : C      COMMON /DEBUG/ ITRACE, ITEST, IERROR, IMESS
  48 : C      INTEGER       ITRACE, ITEST, IERROR
  49 : C      CHARACTER*256 IMESS
  50 : C     ---------------------------------------------------------------------
  51 : C     --- POUR LES STATS ---
  52 : C
  53 :       COMMON /STATS/ ICARD(100)
  54 :       INTEGER       ICARD
  55 : C     ---------------------------------------------------------------------
  56 : C     --- VARIABLES INTERNES ---
  57 :       INTEGER   J,K,IPTDS, NBTRA, IVOIS, IT, ITRA, NBC, JJ
  58 :       INTEGER   ITI
  59 : C
  60 :       iarr = 0
  61 :       NBC = NBCMAX
  62 :       IT = ITT
  63 :       IPTDS = NBT
  64 :       NBCONN = 0
  65 : C
  66 :     1 ITI = IT
  67 :       NBNOCO = IPTDS
  68 :       NBTRA = 0
  69 :       ITRA  = 2
  70 :       NBCONN = 1
  71 :       ICONN(NBCONN) = ITI
  72 : C      PRINT *,'NBNOCO =',NBNOCO
  73 : C      
  74 :       DO 3 J=1,NBC
  75 :         IVOIS = ITRTRI((IT-1)*NBCMAX+J)
  76 :         IF( IVOIS .LE. 0 )GOTO 3
  77 :         ICONN(ITRA + NBTRA) = IVOIS
  78 :         NBTRA = NBTRA + 1
  79 :     3 CONTINUE      
  80 : C
  81 : C     ON BOUCLE TANTQUE ITRAVAIL N'EST PAS VIDE
  82 : C     ----------------------------------------
  83 :     5 IF( NBTRA .EQ. 0 )GOTO 999
  84 :       IT     = ICONN(ITRA)
  85 :       NBTRA  = NBTRA-1 
  86 :       ITRA   = ITRA + 1 
  87 : C
  88 : C     --- LE TEST ---
  89 : C
  90 :       IPTDS = 0
  91 :       DO 100 J=1,NBNMAX
  92 :         DO 110 JJ=1,NBN
  93 :           IF( ITRNOE((IT-1)*NBNMAX+J).EQ.NN(JJ) )IPTDS = IPTDS+1
  94 :   110   CONTINUE
  95 :   100 CONTINUE 
  96 : C
  97 :         IF( IPTDS.GT.NBNOCO )GOTO 1
  98 : C         ----------------------------------------------
  99 : C         ON A TROUVE MIEUX : LA LISTE EST REINITIALISEE
 100 : C         ----------------------------------------------
 101 :         IF( IPTDS.EQ.NBNOCO )THEN
 102 : C         ---------------------------
 103 : C         LE TRIANGLE EST A AJOUTE
 104 : C         ---------------------------
 105 :           NBCONN = NBCONN+1
 106 :           IF(NBCONN.GT.NADMAX)THEN
 107 : c            WRITE(*,*) 'TABLEAU NADMAX TROP PETIT 1'
 108 : c            WRITE(*,*) 'NADMAX = ',NADMAX,'> NBCONN = ',NBCONN
 109 :             iarr = -2
 110 :             GO TO 999
 111 :           ENDIF
 112 :           ICONN(NBCONN)= IT
 113 : C         ------------------------------------------
 114 : C         ON MET LES VOISINS A TRAITER DANS ITRAVAIL
 115 : C         ------------------------------------------
 116 :           DO 20 J=1,NBC
 117 :             IVOIS = ITRTRI((IT-1)*NBCMAX+J)
 118 :             IF( IVOIS .LE. 0 )GOTO 20
 119 :             DO 10 K=1,NBCONN
 120 :               IF( IVOIS.EQ.ICONN(K) )GOTO 20
 121 :    10       CONTINUE
 122 : C           --- LE VOISIN EST DEJA A TRAITER  ---
 123 : C           -------------------------------------------
 124 :             DO 15 K=1,NBTRA
 125 :               IF( IVOIS.EQ.ICONN(ITRA+K-1) )GOTO 20
 126 :    15       CONTINUE
 127 : C
 128 :             IF((NBTRA+ITRA).GT.NADMAX)THEN
 129 : c              WRITE(*,*) 'TABLEAU NADMAX TROP PETIT 2'
 130 : c              WRITE(*,*) 'NBTRA + ITRA = ',NBTRA+ITRA,
 131 : c     >                   ' NADMAX = ',NADMAX         
 132 :               iarr = -2
 133 :               GO TO 999
 134 :             ENDIF
 135 :             ICONN(ITRA + NBTRA) = IVOIS
 136 :             NBTRA = NBTRA + 1
 137 :    20     CONTINUE
 138 :         ENDIF
 139 :         GOTO 5
 140 :   999 END
 141 :  
 142 :  
 143 :