elmpb.f

Go to the documentation of this file.

!                       ****************
                        SUBROUTINE elmpb
!                       ****************
!
     &(nbpb,numpb,x,y,ikle,ncolor,isdry,new)
!
!***********************************************************************
! PROGICIEL : STBTEL  V5.2                    A. CABAL / P. LANG SOGREAH
!***********************************************************************
!
!     FONCTION  :  ELIMINATION DES ELEMENTS APPARTENANT A PLUSIEURS
!                  SEGMENTS FRONTIERES
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! |      NOM       |MODE|                   ROLE
! |________________|____|______________________________________________
! |   NBPB         |--> | NB DE POINTS A SUPPRIMER
! |   NUMPB        |--> | NUMERO DES POINTS A SUPPRIMER
! |   X,Y          |<-->| COORDONNEES DU MAILLAGE .
! |   IKLE         |<-->| NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT
! |   NCOLOR       |<-->| TABLEAU DES COULEURS DES POINTS DU MAILLAGE
! | ELPSEC         | -->| INDICATEUR ELIMIN. DES ELEMENTS PARTIELLEMENT SECS
! | ISDRY(NELMAX)  |<-- | TAB INDICATEUR ELEMENTS SECS
! |                |    | = 1 POINT TOUJOURS SEC,
! |                |    | = 0 SOUS SEUSEC M D'EAU AU MOINS POUR 1 PAS DE TEMPS
! | IHAUT          | -->| NUM D'ORDRE DE LA VARIABLE HAUT D'EAU DANS FICH TEL2D
! | NVAR           | -->| NB DE VAR STOCKEES DANS LE FICHIER TEL2D
! | H              | -->| TABLEAU DES HAUTEURS D'EAU
! |________________|____|______________________________________________
! | COMMON:        |    |
! |  GEO:          |
! |    MESH        | -->| TYPE DES ELEMENTS DU MAILLAGE
! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
! |    NPOIN       |<-->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
! |    NELEM       |<-->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
! |________________|____|______________________________________________
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!----------------------------------------------------------------------
! APPELE PAR : STBTEL
!***********************************************************************
!
      USE declarations_special
      USE declarations_stbtel
      IMPLICIT NONE
!
      INTEGER, INTENT(INOUT) :: IKLE(nelmax,4), ISDRY(npmax), NEW(npmax)
      INTEGER, INTENT(INOUT) :: NCOLOR(npmax)
      INTEGER,INTENT(IN) :: NBPB, NUMPB(100)
      DOUBLE PRECISION, INTENT(INOUT) :: X(npmax) , Y(npmax)
!
      INTEGER I, IEL, J, NELI

!
!
!     -------------------------------------------------------------
!     ELIMINATION DES ELEMENTS COMPORTANT DES POINTS A PROBLEME
!     -------------------------------------------------------------
!
      DO i=1,nbpb
        DO iel = 1, nelem
          IF (ikle(iel,1).EQ.numpb(i).OR.ikle(iel,2).EQ.numpb(i)
     &        .OR.ikle(iel,3).EQ.numpb(i)) THEN
            ikle(iel, 1) = 0
            ikle(iel, 2) = 0
            ikle(iel, 3) = 0
          ENDIF
        ENDDO
      ENDDO
!
!     ELIMINATION DES ELEMENTS
!     ------------------------
!
      neli = 0
      iel = 1
!     POUR CHAQUE ELEMENT FAIRE
 20   CONTINUE
        IF ((ikle(iel, 1).EQ.0).AND.(ikle(iel, 2).EQ.0).AND.
     &     (ikle(iel, 3).EQ.0)) THEN
          neli = neli + 1
          DO i = iel, nelem - neli
            ikle(i,1) = ikle(i+1, 1)
            ikle(i,2) = ikle(i+1, 2)
            ikle(i,3) = ikle(i+1, 3)
          ENDDO
        ELSE
          iel = iel + 1
        ENDIF
      IF (iel .LE. nelem-neli) GOTO 20
!     FIN POUR CHAQUE ELEMENT
!
      WRITE(lu,2009) neli
!
      nelem = nelem - neli
!
!      ELIMINATION DES POINTS NE FAISANT PLUS PARTIE DU MAILLAGE
!      REUTILISATION DE ISDRY POUR MARQUER LES POINTS NON UTILISEES
!      ---------------------------------------------
      DO i = 1, npoin
        isdry(i) = 0
        new(i) = 0
      ENDDO
!
      DO iel = 1, nelem
      ENDDO
!
      neli = 0
      i = 1
!     POUR CHAQUE POINT FAIRE
      DO i = 1, npoin
        IF (isdry(i) .EQ.0) THEN
          neli = neli + 1
          new(i) = 0
        ELSE
          new(i) = i - neli
        ENDIF
      ENDDO
!     FIN POUR CHAQUE POINT
!
      neli = 0
      i = 1
!     POUR CHAQUE POINT FAIRE
 30   CONTINUE
        IF (isdry(i) .EQ.0) THEN
!         POINT I  A ELIMINER
          neli = neli + 1
!         DECALAGE DANS LE TABLEAU DES POINTS
          DO j = i, npoin - neli
            x(j) = x(j+1)
            y(j) = y(j+1)
            ncolor(j) = ncolor(j+1)
            IF (isdry(j+1).GT.0) THEN
              isdry(j) = isdry(j+1) - 1
            ELSE
              isdry(j) = 0
            ENDIF
          ENDDO
        ELSE
          i = i + 1
        ENDIF
      IF (i .LE. npoin - neli) GOTO 30
!     FIN POUR CHAQUE POINT
      WRITE(lu,2011) neli
      npoin = npoin - neli
!
!     ON REPERCUTE LA RENUMEROTATION DANS IKLE
!     ----------------------------------------
      DO iel = 1, nelem
        j = ikle(iel,1)
        ikle(iel,1) = new(j)
        j = ikle(iel,2)
        ikle(iel,2) = new(j)
        j = ikle(iel,3)
        ikle(iel,3) = new(j)
      ENDDO
      RETURN
!***********************************************************************
 2009 FORMAT(1x,'ELEMENTS CANCELLED IN THE MESH:',i8)
 2011 FORMAT(1x,'POINTS CANCELLED IN THE MESH:  ',i8)
      END