elmsec.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE elmsec
!                       *****************
!
     &( elpsec, seusec, tpsfin,  x, y, ikle, ncolor, isdry,
     &  ihaut, nvar, h, work, new, std, ngeo, texte )
!
!***********************************************************************
! PROGICIEL : STBTEL V5.2                     A. CABAL / P. LANG SOGREAH
!***********************************************************************
!
!     FONCTION  :  ELIMINATION DES ELEMENTS SECS DU MAILLAGE
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! |      NOM       |MODE|                   ROLE
! |________________|____|______________________________________________
! |   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
! | SEUSEC         | -->| VALEUR POUR LA DEFINITION SECHERESSE
! | 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
! | WORK           | -->| TABLEAU (REAL) DE TRAVAIL
! |________________|____|______________________________________________
! | 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)
! |  FICH:         |    |
! |    NRES        |--> | NUMERO DU CANAL DU FICHIER DE SERAFIN
! |    NGEO       |--> | NUMERO DU CANAL DU FICHIER MAILLEUR
! |    NLIM      |--> | NUMERO DU CANAL DU FICHIER DYNAM DE TELEMAC
! |    NFO1      |--> | NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
! |________________|____|______________________________________________
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!----------------------------------------------------------------------
! APPELE PAR : STBTEL
!***********************************************************************
!
      USE declarations_special
      USE declarations_stbtel, ONLY: nelem,npoin,nelmax,npmax,fformat
      USE interface_stbtel, ex_elmsec => elmsec
      USE interface_hermes
      IMPLICIT NONE
!
      LOGICAL, INTENT(IN) :: ELPSEC
      DOUBLE PRECISION, INTENT(IN) :: SEUSEC
      DOUBLE PRECISION, INTENT(INOUT) :: X(npmax),Y(npmax)
      DOUBLE PRECISION, INTENT(INOUT) :: H(npmax),TPSFIN(1)
      INTEGER, INTENT(INOUT) :: IKLE(nelmax,4), ISDRY(npmax), NEW(npmax)
      INTEGER, INTENT(INOUT) :: NCOLOR(npmax)
      INTEGER, INTENT(IN) :: IHAUT, NVAR
      REAL, INTENT(INOUT) :: WORK(*)
      INTEGER, INTENT(IN) :: NGEO
      CHARACTER(LEN=3), INTENT(IN) :: STD
      CHARACTER(LEN=32), INTENT(IN) :: TEXTE(nvar)
!
!
!     VARIABLES LOCALES
!
      INTEGER I, IEL, NPDT, NPSEC, NSEC
      INTEGER J, NELI, IERR
      INTEGER NP1, NP2, NP3, ISECH
!------------------------------------------------------------
      IF (nvar.EQ.0) THEN
        WRITE(lu,2012)
        RETURN
      ENDIF
      IF (ihaut.EQ.0) THEN
        WRITE(lu,2013)
        RETURN
      ENDIF
!     INITIALISATION DU TABLEAU ISDRY : PAS DEFAUT TOUS SECS
      DO i = 1, npoin
        isdry(i) = 1
      ENDDO
!     LECTURE DES RESULTATS TELEMAC ET REMPLISSAGE DU TABLEAU ISDRY
!     -------------------------------------------------------------

!     -----------------------
!     ON RESSORT SI LE FICHIER NE CONTENAIT AUCUN PAS DE TEMPS
      CALL get_data_ntimestep(fformat, ngeo, npdt, ierr)
      CALL check_call(ierr, 'ELMSEC:GET_DATA_NTIMESTEP')

      IF (npdt.EQ.0) THEN
        WRITE(lu,2001)
        CALL plante(1)
        stop
      ENDIF

      CALL get_data_time(fformat, ngeo, npdt-1, tpsfin(1), ierr)
      CALL check_call(ierr, 'ELMSEC:GET_DATA_TIME')

      CALL get_data_value(fformat, ngeo, npdt-1, texte(ihaut),
     &                    h, npoin,ierr)
      CALL check_call(ierr, 'ELMSEC:GET_DATA_VALUE')

      npsec = 0
      DO i = 1, npoin
        IF (h(i).GT.seusec) THEN
          isdry(i) = 0
        ELSE
          npsec = npsec + 1
        ENDIF
      ENDDO
      WRITE(lu,2000) tpsfin(1), npsec, seusec
!
!     TEST DES ELEMENTS SECS OU PARTIELLEMENTS SECS
!     ---------------------------------------------
      npsec = 0
      nsec = 0
!
!     PARCOURS DES ELEMENTS
      DO iel = 1, nelem
        np1 = ikle(iel, 1)
        np2 = ikle(iel, 2)
        np3 = ikle(iel, 3)
        isech = isdry(np1) * isdry(np2) * isdry(np3)
!       SI ISECH (PRODUIT) = 1 ELEMENT IEL TOUJOURS SEC
        IF (isech.EQ.1) THEN
!         POSITIONNE A 0 TOUS LES NUMEROS DES POINTS DE L'ELEMENT
          nsec = nsec + 1
          ikle(iel, 1) = 0
          ikle(iel, 2) = 0
          ikle(iel, 3) = 0
        ELSE
          IF (elpsec) THEN
!         TEST SI ELEMENT PARTIELLEMENT SEC
            isech =  isdry(np1) + isdry(np2) + isdry(np3)
            IF (isech.GE.1) THEN
!             ELEMENT PARTIELLEMENT SEC A ELIMINER
!             POSITIONNE A 0 TOUS LES NUMEROS DES POINTS DE L'ELEMENT
              ikle(iel, 1) = 0
              ikle(iel, 2) = 0
              ikle(iel, 3) = 0
              npsec = npsec + 1
            ENDIF
!           FIN SI ELIMINATION PART. SECS
          ENDIF
        ENDIF
      ENDDO !IEL
!     FIN PARCOURS DE TOUS LES ELEMENTS
      IF (nsec.EQ.0) THEN
        WRITE(lu,2002)
      ELSE IF (nsec.EQ.1) THEN
        WRITE(lu,2003)
      ELSE
        WRITE(lu,2004) nsec
      ENDIF
!
      IF (elpsec) THEN
        IF (npsec.EQ.0) THEN
          WRITE(lu,2005)
        ELSE IF (npsec.EQ.1) THEN
          WRITE(lu,2006)
        ELSE
          WRITE(lu,2007) npsec
        ENDIF
      ENDIF
!
!     S'IL N'Y A PAS D'ELEMENTS SECS OU P.SECS ON S'EN VA
      IF ((nsec.EQ.0) .AND. (npsec.EQ.0)) RETURN
!
!     ELIMINATION DES ELEMENTS SECS ET PARTIELLLEMENT SECS
!     ---------------------------------------------
      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
!
      IF (neli .LE. 0) THEN
        WRITE(lu,2008)
      ELSE
        WRITE(lu,2009) neli
      ENDIF
!
      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
        isdry(ikle(iel,1)) = ikle(iel,1)
        isdry(ikle(iel,2)) = ikle(iel,2)
        isdry(ikle(iel,3)) = ikle(iel,3)
      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
!       WRITE(LU,*) 'POINT A ELIMINER',I,':',X(I),Y(I),NCOLOR(I)
        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
      IF (neli .LE. 0) THEN
        WRITE(lu,2010)
      ELSE
        WRITE(lu,2011) neli
      ENDIF
      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
!***********************************************************************
 2000 FORMAT(1x,'TIME ',g15.3,' : ',i8,
     &' POINT(S) WITH WATER DEPTH BELOW',g15.3)
!
 2001 FORMAT(/,1x,'SORRY, THE UNIVERSAL FILE DOES NOT CONTAIN',
     & /,1x,'ANY COMPUTATION RESULTS.',
     & /,1x,'FINDING OUT DRY ELEMENTS IS IMPOSSIBLE !')
!
 2002 FORMAT(1x,'NO COMPLETELY DRY ELEMENT IN THE MESH.')
!
 2003 FORMAT(1x,'ONLY ONE COMPLETELY DRY ELEMENT FOUND',
     & /,1x,'IN THE MESH.')
!
 2004 FORMAT(1x,'COMPLETELY DRY ELEMENTS IN THE MESH: ',i8)
!
 2005 FORMAT(1x,'NO PARTIALLY DRY ELEMENT IN THE MESH.')
!
 2006 FORMAT(1x,'ONLY ONE PARTIALLY DRY ELEMENT IN THE MESH.')
!
 2007 FORMAT(1x,'PARTIALLY DRY ELEMENTS IN THE MESH:',i8)
!
 2008 FORMAT(1x,'NO ELEMENT HAS BEEN CANCELLED IN THE MESH.')
!
 2009 FORMAT(1x,'ELEMENTS CANCELLED IN THE MESH:',i8)
!
 2010 FORMAT(1x,'NO POINT HAS BEEN CANCELLED IN THE MESH.')
!
 2011 FORMAT(1x,'POINTS CANCELLED IN THE MESH:  ',i8)
!
 2012 FORMAT(/,1x,'NO VARIABLE STORED ON THE FILE. ',
     & /,1x,'DRY ELEMENT SUPPRESSION IS IMPOSSIBLE.')
!
 2013 FORMAT(/,1x,'THE WATER DEPTH VARIABLE IS NOT STORED ON THE FILE',
     & /,1x,'DRY ELEMENT SUPPRESSION IS IMPOSSIBLE.')
      END