renum.f

Go to the documentation of this file.

!                       ****************
                        SUBROUTINE renum
!                       ****************
!
     &(x,y,w,ikle,nbor,trav1,trav2,tab,ncolor,color,nptfr)
!
!***********************************************************************
! PROGICIEL : STBTEL V5.2                   19/04/91  J-C GALLAND  (LNH)
!                                           19/02/93  J-M JANIN    (LNH)
!***********************************************************************
!
! FONCTION : DECOUPAGE DES TRIANGLES SURCONTRAINTS :
!            ILS SONT COUPES EN TROIS PAR AJOUT D'UN POINT A
!            LEUR BARYCENTRE
!
!
!-----------------------------------------------------------------------
!| X,Y         |<->| COORDONNEES DU MAILLAGE .
!| IKLE        |<->| LISTE DES POINTS DE CHAQUE ELEMENT
!| TRAV1,2     |<->| TABLEAUX DE TRAVAIL
!| TAB         |<->| TABLEAU DE TRAVAIL
!| NCOLOR      |<->| TABLEAU DES COULEURS DES POINTS
!| COLOR       |<->| STOCKAGE COULEURS DES NOEUDS SUR FICHIER GEO
!| NPOIN       |-->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
!| NELEM       |-->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
!| NELMAX      |-->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
!|             |   | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
!-----------------------------------------------------------------------
!
      USE declarations_special
      USE declarations_stbtel, ONLY: nelem,npoin,nelmax
      IMPLICIT NONE
!
      DOUBLE PRECISION, INTENT(INOUT) :: X(*) , Y(*) , W(*)
      INTEGER, INTENT(INOUT) :: TRAV1(*) , TRAV2(*)
      INTEGER, INTENT(INOUT) :: IKLE(nelmax,3) , NCOLOR(*) , NBOR(*)
      INTEGER, INTENT(INOUT) :: TAB(*)
      LOGICAL, INTENT(IN) :: COLOR
      INTEGER, INTENT(IN) :: NPTFR
!
      INTEGER IPOIN , IELEM , IPTFR , I1 , I2 , TABMAX
!
!
!
!=======================================================================
! CALCUL DU NOMBRE DE POINTS ET ELEMENTS VOISINS
!=======================================================================
!
      DO ipoin = 1,npoin
        trav1(ipoin) = 0
      ENDDO
!
      DO ielem = 1,nelem
        trav1(ikle(ielem,1)) = trav1(ikle(ielem,1)) + 2
        trav1(ikle(ielem,2)) = trav1(ikle(ielem,2)) + 2
        trav1(ikle(ielem,3)) = trav1(ikle(ielem,3)) + 2
      ENDDO
!
      DO iptfr = 1,nptfr
        trav1(nbor(iptfr)) = trav1(nbor(iptfr)) + 1
      ENDDO
!
!=======================================================================
! RENUMEROTATIONS DES POINTS SUIVANT ORDRE CROISSANT DE VOISINS
!=======================================================================
!
      tabmax = 0
!
      DO ipoin = 1,npoin
!
        i1 = trav1(ipoin)
!
        IF (i1.GT.tabmax) THEN
          DO i2 = tabmax+1,i1
            tab(i2) = ipoin - 1
          ENDDO
          tabmax = i1
        ELSEIF (i1.LT.tabmax) THEN
          DO i2 = tabmax,i1+1,-1
            tab(i2) = tab(i2) + 1
            trav2(tab(i2)) = trav2(tab(i2-1)+1)
          ENDDO
        ENDIF
!
        tab(i1) = tab(i1) + 1
        trav2(tab(i1)) = ipoin
!
      ENDDO
!
      DO i1 = 1,tabmax
        WRITE(lu,*)'TAB(',i1,')=',tab(i1)
      ENDDO
!
!=======================================================================
! MODIFICATIONS CORRESPONDANTES DANS LES DIFFERENTES VARIABLES
!=======================================================================
!
      DO ipoin = 1,npoin
        trav1(trav2(ipoin)) = ipoin
      ENDDO
!
      DO ielem = 1,nelem
        ikle(ielem,1) = trav1(ikle(ielem,1))
        ikle(ielem,2) = trav1(ikle(ielem,2))
        ikle(ielem,3) = trav1(ikle(ielem,3))
      ENDDO
!
      DO iptfr = 1,nptfr
        nbor(iptfr) = trav1(nbor(iptfr))
        nbor(nptfr+iptfr) = trav1(nbor(nptfr+iptfr))
      ENDDO
!
      DO ipoin = 1,npoin
        w(ipoin) = x(trav2(ipoin))
      ENDDO
      DO ipoin = 1,npoin
        x(ipoin) = w(ipoin)
      ENDDO
!
      DO ipoin = 1,npoin
        w(ipoin) = y(trav2(ipoin))
      ENDDO
      DO ipoin = 1,npoin
        y(ipoin) = w(ipoin)
      ENDDO
!
      IF (color) THEN
!
        DO ipoin = 1,npoin
          trav1(ipoin) = ncolor(trav2(ipoin))
        ENDDO
        DO ipoin = 1,npoin
          ncolor(ipoin) = trav1(ipoin)
        ENDDO
!
      ENDIF
!
!=======================================================================
!
      RETURN
      END