Télécharger la plaquette Cast3M


fr en

Télécharger ttconn.eso

Retour à la liste

Numérotation des lignes : 

ttconn

  1. C TTCONN    SOURCE    CB215821  17/11/30    21:17:18     9639           
  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.  
  144.  
  145.  

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