stbtel.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE stbtel
!                       *****************
!
     &( npoin1 , typele , nfond , precis , nsfond , titre)
!
!***********************************************************************
! PROGICIEL : STBTEL  7.2           09/08/89    J.C. GALLAND
!                                    19/02/93    J.M. JANIN
!                                    09/11/94    P. LANG / LHF (TRIGRID)
!                                  07/96    P. CHAILLET / LHF (FASTTABS)
!                                  09/98    A. CABAL / P. LANG SOGREAH
!***********************************************************************
!
!     FONCTION  : STBTEL MAIN PROGRAM
!
!history  J-M HERVOUET (JUBILADO)
!+        24/10/2016
!+        V7P2
!+   Optimisation in the case of splitting of all elements. Look for
!+   the second call to VERIFI (no skipped with a test) and the only
!+   call to INTERP (test changed). The work of VERIFI and INTERP is
!+   done in DIVISE in the case DIV4.AND.NSOM2.EQ.0.
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! |      NOM       |MODE|                   ROLE
! |________________|____|______________________________________________
! | X,Y            |<-- | COORDONNEES DES POINTS DU MAILLAGE
! | ZF             |<-- | COTES DU FOND
! | XR,YR          |<-- | COORDONNEES DES POINTS DE BATHY
! | ZR             |<-- | COTES DES POINTS DE BATHY
! | NBAT           | -->| NOMBRE DE POINTS DE BATHY
! | IKLE           |<-- | NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT
! | IFABOR         |<-- | NUMERO DE L'ELEMENT VOISIN DE CHAQUE FACE
! | NBOR           |<-- | NUMEROTATION DES ELEMENTS DE BORD
! | TRAV1,2        |<-->| TABLEAUX DE TRAVAIL
! | NCOLOR         |<-- | TABLEAU DES COULEURS DES NOEUDS
! | NCOLFR         |<-- | TABLEAU DES COULEURS DES NOEUDS FRONTIERES
! | NOP5           | -->| TABLEAU DE TRAVAIL POUR LA LECTURE DU FICHIER
! |                |    | GEOMETRIE DE SIMAIL
! | NPOIN1         | -->| NOMBRE REEL DE POINTS DU MAILLAGE
! |                |    | (NPOIN REPRESENTE L'INDICE MAX DES NOEUDS CAR
! |                |    | SUPERTAB LAISSE DES TROUS DANS LA NUMEROTATION
! | TYPELE         | -->| TYPE DES ELEMENTS
! | STD            | -->| STANDARD DE BINAIRE
! | DECTRI         | -->| DECOUPAGE OU NON DES TRIANGLES SURCONTRAINTS
! | FOND           | -->| TABLEAU DES NOMS DES FICHIERS BATHY
! | NFOND          | -->| TABLEAU DES CANAUX DES FICHIERS BATHY
! | EPSI           | -->| DISTANCE MINIMALE ENTRE 2 POINTS POUR DEFINIR
! |                |    | LES POINTS DE MAILLAGE CONFONDUS
! | COLOR          |<-- | COULEUR DES NOEUDS
! | ELIDEP         | -->| LOGIQUE POUR L'ELIMINATION DES MOTS-CLES
! | NBFOND         | -->| NOMBRE DE FICHIERS DE BATHY
! | MAILLE         | -->| NOM DU MAILLEUR UTILISE
! | DM             | -->| DISTANCE MINIMALE A LA FRONTIERE
! |                |    | POUR LA PROJECTION DES FONDS
! | PRECIS         | -->| FORMAT DE LECTURE DES COORDONNEES DES NOEUDS
! | FONTRI         | -->| INDICATEUR DE LECTURE DES FONDS DANS NGEO
! | CORTRI         | -->| CORRECTION DES FONDS POUR TRIGRID
! | TFAST1,2       | -->| TABLEAUX DE TRAVAIL (FASTTABS)
! | ADDFAS         | -->| INDICATEUR UTILISATION DES C.L. (FASTTABS)
! | VAR            | -->| TABLEAU DOUBLE PREC. SERVANT A LIRE LES RESULTATS
! | ELISEC         | -->| INDICATEUR ELIMINATION DES ELEMENTS SECS
! | ELPSEC         | -->| INDICATEUR ELIM DES ELEMENTS PARTIELLEMENT SECS
! | SEUSEC         | -->| VALEUR POUR LA DEFINITION SECHERESSE
! | ISDRY          | -->| TABLEAU D'INDICATEURS HAUTEUR NULLE
! | IHAUT          | -->| INDICE DE LA HAUTEUR_D_EAU DANS LA LISTE DES VARIABLES
! |________________|____|______________________________________________
! | 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
! |  SECT:         |    |
! |    NSEC11      |--> | INDICATEUR DU SECTEUR CONTENANT LES NOEUDS
! |                |--> | (LECTURE EN SIMPLE PRECISION)
! |    NSEC12      |--> | INDICATEUR DU SECTEUR CONTENANT LES NOEUDS
! |                |--> | (LECTURE EN DOUBLE PRECISION)
! |    NSEC2       |--> | INDICATEUR DU SECTEUR CONTENANT LES ELEMENTS
! |    NSEC3       |--> | INDICATEUR DU SECTEUR CONTENANT LE TITRE
! |________________|____|______________________________________________
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!-----------------------------------------------------------------------
! APPELE PAR : HOMERE
! APPEL DE : LECSIM, LECSTB, IMPRIM , VERIFI, VOISIN, RANBO, SURCON,
!            SHUFLE, CORDEP, DEPARR, PROJEC, PRESEL, FMTSEL, ECRSEL,
!            DYNAMI
!***********************************************************************
!
      USE bief_def
      USE bief, ONLY : voisin
      USE declarations_telemac
      USE declarations_stbtel
      USE declarations_special
      USE interface_stbtel, ex_stbtel => stbtel
!
      IMPLICIT NONE
!
      INTEGER, INTENT(INOUT) :: NPOIN1
      CHARACTER(LEN=11), INTENT(INOUT) :: TYPELE
      INTEGER, INTENT(IN) :: NFOND(5)
      CHARACTER(LEN=6), INTENT(INOUT) :: PRECIS
      INTEGER, INTENT(INOUT) :: NSFOND
      CHARACTER(LEN=80), INTENT(INOUT) :: TITRE
!
      INTEGER NPTFR , NITER, OLD_NPTFR
      INTEGER NDEPAR , IELM
!
!     TABLEAU BIDON UTILISE PAR VOISIN SEULEMENT EN PARALLELISME
      INTEGER NACHB(1)
!
      INTEGER NVAR , NVARCL
      INTEGER NPINIT , NEINIT
      INTEGER NUMPB(100), NBPB, I
      INTEGER :: IPARAM(10) = (/ 0,0,0,0,0,0,0,0,0,0 /)
!
      REAL, DIMENSION(:), ALLOCATABLE :: W
      DOUBLE PRECISION,DIMENSION(:)  ,ALLOCATABLE :: WORK,X,Y,ZF
      DOUBLE PRECISION,DIMENSION(:)  ,ALLOCATABLE :: XR,YR,ZR
      DOUBLE PRECISION,DIMENSION(:)  ,ALLOCATABLE :: XINIT,YINIT
      DOUBLE PRECISION,DIMENSION(:)  ,ALLOCATABLE :: VAINIT,VAR
      DOUBLE PRECISION,DIMENSION(:)  ,ALLOCATABLE :: CHBORD
      DOUBLE PRECISION,ALLOCATABLE :: HBOR(:),UBOR(:,:),VBOR(:,:)
      DOUBLE PRECISION,DIMENSION(:,:),ALLOCATABLE :: SHP
      INTEGER, DIMENSION(:)  , ALLOCATABLE :: TRAV1,TRAV2,TRAV3
      INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLE,IFABOR,IKINIT
      INTEGER, DIMENSION(:)  , ALLOCATABLE :: NBOR,KP1BOR,LIUBOR
      INTEGER, ALLOCATABLE :: OLD_NBOR(:)
      INTEGER, DIMENSION(:)  , ALLOCATABLE :: LIVBOR,LITBOR,LIHBOR
      INTEGER, DIMENSION(:)  , ALLOCATABLE :: ELT,NCOLOR,NCOLFR,NOP5
      INTEGER, DIMENSION(:),ALLOCATABLE :: TFAST1,TFAST2,ISDRY,IPOBO
!
!
      CHARACTER(LEN=32) TEXTE(26) , VARCLA(1)
!
      LOGICAL SORLEO(26)
      LOGICAL SUIT , ECRI , DEBU , LISTIN
!
      INTEGER DATE(3) , TIME(3)
      INTEGER X_ORIG,Y_ORIG
      DOUBLE PRECISION TPSFIN(1)
      INTEGER NVARIN , NVAROU , NVAR2 ,ERR
      INTEGER NSOR , MXPTVS , MXELVS
      TYPE(bief_obj) :: DUMMY
!
!
!     ALLOCATION DYNAMIQUE DES TABLEAUX REELS
!
      ALLOCATE(w(npoin)       ,stat=err)
      CALL check_allocate(err,'W')
      ALLOCATE(work(npmax)    ,stat=err)
      CALL check_allocate(err,'WORK')
      ALLOCATE(x(npmax)       ,stat=err)
      CALL check_allocate(err,'X')
      ALLOCATE(y(npmax)       ,stat=err)
      CALL check_allocate(err,'Y')
      ALLOCATE(zf(npmax)      ,stat=err)
      CALL check_allocate(err,'ZF')
      ALLOCATE(xr(nbat)       ,stat=err)
      CALL check_allocate(err,'XR')
      ALLOCATE(yr(nbat)       ,stat=err)
      CALL check_allocate(err,'YR')
      ALLOCATE(zr(nbat)       ,stat=err)
      CALL check_allocate(err,'ZR')
      ALLOCATE(xinit(npoin)   ,stat=err)
      CALL check_allocate(err,'XINIT')
      ALLOCATE(yinit(npoin)   ,stat=err)
      CALL check_allocate(err,'YINIT')
      ALLOCATE(vainit(npoin)  ,stat=err)
      CALL check_allocate(err,'VAINIT')
      ALLOCATE(var(npmax)     ,stat=err)
      CALL check_allocate(err,'VAR')
      ALLOCATE(shp(npmax,3)   ,stat=err)
      CALL check_allocate(err,'SHP')
      ALLOCATE(nop5(inop5)    ,stat=err)
      CALL check_allocate(err,'NOP5')
!
!     ALLOCATION DYNAMIQUE DES TABLEAUX ENTIERS
!
      ALLOCATE(trav1(4*nelmax)  ,stat=err)
      CALL check_allocate(err,'TRAV1')
      ALLOCATE(trav2(4*nelmax)  ,stat=err)
      CALL check_allocate(err,'TRAV2')
      ALLOCATE(trav3(npmax)     ,stat=err)
      CALL check_allocate(err,'TRAV3')
      ALLOCATE(ncolor(npmax)    ,stat=err)
      CALL check_allocate(err,'NCOLOR')
      ALLOCATE(ikle(nelmax,4)   ,stat=err)
      CALL check_allocate(err,'IKLE')
      ALLOCATE(ikinit(nelem,3)  ,stat=err)
      CALL check_allocate(err,'IKINIT')
      ALLOCATE(ifabor(nelmax,4) ,stat=err)
      CALL check_allocate(err,'IFABOR')
      ALLOCATE(elt(npmax)       ,stat=err)
      CALL check_allocate(err,'ELT')
      ALLOCATE(tfast1(npmax)    ,stat=err)
      CALL check_allocate(err,'TFAST1')
      ALLOCATE(tfast2(npmax)    ,stat=err)
      CALL check_allocate(err,'TFAST2')
      ALLOCATE(isdry(npmax)     ,stat=err)
      CALL check_allocate(err,'ISDRY')
!     NPTFR REMPLACE PAR NPMAX (VALEUR PAR EXCES)
      ALLOCATE(nbor(npmax)      ,stat=err)
      CALL check_allocate(err,'NBOR')
      ALLOCATE(old_nbor(npmax)      ,stat=err)
      CALL check_allocate(err,'OLD_NBOR')
      ALLOCATE(kp1bor(npmax)    ,stat=err)
      CALL check_allocate(err,'KP1BOR')
      ALLOCATE(liubor(npmax)    ,stat=err)
      CALL check_allocate(err,'LIUBOR')
      ALLOCATE(livbor(npmax)    ,stat=err)
      CALL check_allocate(err,'LIVBOR')
      ALLOCATE(litbor(npmax)    ,stat=err)
      CALL check_allocate(err,'LITBOR')
      ALLOCATE(lihbor(npmax)    ,stat=err)
      CALL check_allocate(err,'LIHBOR')
      ALLOCATE(ncolfr(npmax)    ,stat=err)
      CALL check_allocate(err,'NCOLFR')

      ALLOCATE(chbord(npmax)    ,stat=err)
      CALL check_allocate(err,'CHBORD')
      ALLOCATE(hbor(npmax)    ,stat=err)
      CALL check_allocate(err,'HBOR')
      ALLOCATE(ubor(npmax,2)    ,stat=err)
      CALL check_allocate(err,'UBOR')
      ALLOCATE(vbor(npmax,2)    ,stat=err)
      CALL check_allocate(err,'VBOR')

!
!=======================================================================
! LECTURE DES COORDONNEES ET DE LA COULEUR DES POINTS , DES IKLE ET DU
! TITRE DU MAILLAGE
!=======================================================================
!
      nvarin = 0
      nptfr = 1
      npinit = npoin
      neinit = nelem
!
      typ_elem = triangle_elt_type
      ALLOCATE(ipobo(npoin)     ,stat=err)
      CALL check_allocate(err,'IPOBO')
      IF (maille.EQ.'SELAFIN') THEN
        CALL lecsel (xinit,yinit,ikinit,npinit,neinit,x,y,ikle,trav1,
     &               w,titre,texte,nvarin,nvar2,std,fusion,
     &               ngeo,nfo1,ipobo,iparam,date,time,x_orig,y_orig)
        IF(nombnd2(1:1) .NE. ' ') THEN
          CALL lecsellim (ngeo,lihbor,liubor,livbor,hbor,ubor,vbor,
     &                    chbord,nbor,npmax,nptfr,ncolor)
        ENDIF
      ELSEIF (maille.EQ.'ADCIRC') THEN
        CALL lecadc (x,y,zf,ikle,ngeo)
        nsfond=1
      ELSEIF (maille.EQ.'SIMAIL') THEN
        CALL lecsim (x,y,ikle,ncolor,titre,nop5,ngeo)
      ELSEIF (maille.EQ.'TRIGRID') THEN
        CALL lectri (x,y,ikle,ncolor,ngeo,nfo1)
        titre = 'MAILLAGE TRIGRID'
      ELSEIF (maille.EQ.'FASTTABS') THEN
        CALL lecfas (x,y,ikle, ncolor, tfast1, tfast2, addfas,
     &               ngeo , nfo1)
        titre = 'MAILLAGE FASTTABS'
      ELSE
        typ_elem = quadrangle_elt_type
        CALL lecstb (x,y,ikle,ncolor,titre,npoin1,
     &               ngeo,nsec2,nsec3,nsec11,nsec12)
      ENDIF
!
!=======================================================================
! EXTRACTION D'UN MAILLAGE
!=======================================================================
!
      IF(mesh.EQ.3.AND.nsom.GE.3) THEN
        CALL extrac(x,y,som,ikle,trav1,nelem,nelmax,npoin,nsom,projex)
      ENDIF
!
!=======================================================================
! IMPRESSION DES DONNEES GEOMETRIQUES
!=======================================================================
!
      CALL imprim(npoin1,npoin,typele,nelem,titre,maille,precis)
!
!=======================================================================
! DIVISION PAR 4 DE TOUTE OU PARTIE DES MAILLES
!=======================================================================
!
      IF(mesh.EQ.3.AND.div4) THEN
        CALL divise(x,y,ikle,ncolor,npoin,nelem,nelmax,nsom2,som2,
     &              trav1,trav2,shp,elt,npmax)
        old_nptfr = nptfr
        old_nbor = nbor
      ELSE
        IF(div4) WRITE(lu,3901)
      ENDIF
!
!=======================================================================
! OPTION ELIMINATION DES ELEMENTS SECS OU PARTIELLEMENT SECS
!=======================================================================
!
      IF(elisec) THEN
        IF(mesh.EQ.3) THEN
          WRITE(lu,3007)
          CALL elmsec ( elpsec, seusec, tpsfin, x, y, ikle,
     &    ncolor, isdry, ihaut, nvarin, var, w , trav2, std ,ngeo,texte)
!
! APRES ELIMINATION, ON RECHERCHE LES POINTS FRONTIERES POSANT PROBLEME
!
          CALL verifi(x,y,ikle,ncolor,trav1,epsi,
     &                mesh,ndp,npoin,nelem,nelmax)
          ielm = 11
          CALL voisin(ifabor,nelem,nelmax,ielm,ikle,nelmax,npoin,
     &                       nachb,nbor,nptfr,trav1,trav2)
          CALL verifs (ifabor,ikle,trav1,nptfr,numpb,nbpb)
          IF (nbpb.GT.0) THEN
            DO i=1,nbpb
              WRITE(lu,3001) numpb(i)
            ENDDO
            CALL elmpb (nbpb, numpb, x,y,ikle,ncolor,isdry,trav2)
          ELSE
            WRITE(lu,3009)
          ENDIF
        ELSE
          WRITE(lu,4002)
        ENDIF
      ENDIF
!
!=======================================================================
! MISE AU FORMAT TELEMAC DU MAILLAGE
!=======================================================================
!
      IF(.NOT.div4) THEN
        CALL verifi(x,y,ikle,ncolor,trav1,epsi,
     &              mesh,ndp,npoin,nelem,nelmax)
      ENDIF
!
!=======================================================================
! CONSTRUCTION DU TABLEAU IFABOR
!=======================================================================
!
      ielm = 21
      IF (mesh.EQ.3) ielm = 11
!
      CALL voisin(ifabor,nelem,nelmax,ielm,ikle,nelmax,npoin,
     &                   nachb,nbor,nptfr,trav1,trav2)
!
!=======================================================================
! CONSTRUCTION DE LA TABLE DES POINTS DE BORD
!    (RANGES DANS L'ORDRE TRIGONOMETRIQUE POUR LE CONTOUR
!     ET L'ORDRE INVERSE POUR LES ILES)
!=======================================================================
!
      CALL ranbo(nbor,kp1bor,ifabor,ikle,ncolor,trav1,nptfr,x,y,
     &           ncolfr,ndp,npoin,nelem,nelmax,mesh)
!
!=======================================================================
! Setting boudnary info after a refinement
!=======================================================================
!
      IF(mesh.EQ.3.AND.div4) THEN
        ! Fill_lim only works if the whole mesh is refined
        IF(nsom.LT.3) THEN
          CALL fill_lim
     &   (old_nptfr,npmax,0,lihbor,liubor,livbor,dummy,
     &    hbor,ubor,vbor,chbord,dummy,dummy,dummy, nbor, old_nbor)
        ENDIF
      ENDIF
!
!=======================================================================
! ELIMINATION DES TRIANGLES SURCONTRAINTS
!=======================================================================
!
      IF(mesh.EQ.3.AND.dectri) THEN
!
        CALL surcon (x,y,ikle,trav1,nbor,nptfr,ncolor,ifabor,color)
!
      ELSE
        IF (dectri) WRITE(lu,3900)
      ENDIF
!
!=======================================================================
! RENUMEROTATION DES NOEUDS POUR OPTIMISATION D'ASSEMBLAGE
!=======================================================================
!
      IF(optass) THEN
        IF(div4.OR.nsom2.GT.0) THEN
          WRITE(lu,*) 'RENUMBERING IS NOT POSSIBLE IF '//
     &                'YOU ARE DOING A REFINEMENT.'
          WRITE(lu,*) 'YOU WILL NEED TO DO IT IN ANOTHER RUN'
          CALL plante(1)
          stop
        ENDIF
        CALL renum
     &  (x,y,work,ikle,nbor,trav1,trav2,trav3,ncolor,color,nptfr)
      ENDIF
!
!=======================================================================
! RENUMEROTATION DES ELEMENTS POUR EVITER LES DEPENDENCES ARRIERES
!=======================================================================
!
      IF (elidep) THEN
!
        WRITE(lu,3011)
        CALL shufle (ikle,x)
!
        niter = 0
!
10      CONTINUE
!
        CALL cordep (ikle,lgvec)
!
!=======================================================================
! VERIFICATION DES DEPENDANCES ARRIERES
!=======================================================================
!
        CALL deparr (ikle,ndepar,lgvec)
        IF(ndepar.NE.0) THEN
          niter = niter + 1
          IF (niter.GT.50) THEN
            WRITE(lu,4000)
            CALL plante(1)
            stop
          ENDIF
          GOTO 10
        ENDIF
!
        WRITE(lu,4100) niter
!
      ENDIF
!
!=======================================================================
! PROJECTION DES FONDS SUR LE MAILLAGE
!=======================================================================
!
      IF(nbfond.NE.0) THEN
        CALL projec (x,y,zf,xr,yr,zr,nbat,nbor,nptfr,nfond,nbfond,
     &               fond,dm,fontri,cortri,maille,ngeo,kp1bor)
      ENDIF
!
!=======================================================================
! CONSTRUCTION DU FICHIER DE GEOMETRIE AU FORMAT SELAFIN :
!=======================================================================
!
      WRITE(lu,3003)
      nvarcl= 0
      debu  = .false.
      suit  = .false.
      ecri  = .true.
      listin= .true.
!
      nsor = 26
!     SI LA DATE MANQUE
      IF(iparam(10).EQ.0) THEN
        date(1) = 0
        date(2) = 0
        date(3) = 0
        time(1) = 0
        time(2) = 0
        time(3) = 0
      ENDIF
!
      CALL presel(ikle,trav1,nelem,nelmax,ndp,texte,nbfond,sorleo,
     &            color,nsfond,nvarin,nvarou,maille)
!
!  ATTENTION DANS L'APPEL A FM3SEL, LE VRAI IKLE EST TRAV1
!  ET IKLE EST EMPLOYE COMME TABLEAU DE TRAVAIL.
!
      CALL fm3sel(x,y,npoin,nbor,nres,std,nvar,texte,texte,
     &            varcla,nvarcl,titre,sorleo,nsor,w,trav1,ikle,
     &            trav2,nelem,nptfr,ndp,mxptvs,mxelvs,date,time,
     &            debu,suit,ecri,listin,iparam,ipobo,x_orig,y_orig)
!
!  INTERPOLATION DES VARIABLES DU FICHIER D'ENTREE
!
      IF(maille.EQ.'SELAFIN'.AND..NOT.div4) THEN
        CALL interp(xinit,yinit,ikinit,npinit,neinit,x,y,npoin,
     &              npmax,shp,elt)
      ENDIF
!
      IF(elisec) THEN
!       ECRITURE DES VARIABLES DE SORTIE AU FORMAT RESULTAT TELEMAC-2D
        CALL ecrsel (vainit,ikinit,npinit,neinit,shp,elt,npoin,npoin1,
     &             npmax,w,x,zf,nsfond,ncolor,color,var,nvarin,nvarou,
     &             0, 'STD', .false., nres, ngeo, 0, maille, texte)
      ELSE
!       ECRITURE DES VARIABLES DE SORTIE AU FORMAT SELAFIN
        CALL ecrsel(vainit,ikinit,npinit,neinit,shp,elt,npoin,npoin1,
     &             npmax,w,x,zf,nsfond,ncolor,color,var,nvarin,nvarou,
     &             nvar2,std,fusion,nres,ngeo,nfo1,maille,texte)
      ENDIF
!
!=======================================================================
! CONSTRUCTION DU FICHIER DYNAM DE TELEMAC
!=======================================================================
!
      WRITE(lu,3005)
      IF(div4 .AND. nombnd2(1:1).NE.' ') THEN
        CALL writesellim
     &(nres,lihbor,liubor,livbor,hbor,ubor(:,1),vbor(:,1),
     & chbord,nbor,npmax,nptfr)
      ELSE
        CALL dynami (nptfr,nbor,lihbor,liubor,livbor,litbor,
     &              ncolfr,maille,nres)
      ENDIF
!
 3900 FORMAT(//,'********************************************',/,
     &          'OVERSTRESSED ELEMENTS ARE CANCELLED ONLY IN',/,
     &          'THE CASE OF TRIANGLES                     ',/,
     &          '********************************************',/)
 3901 FORMAT(//,'********************************************',/,
     &          'ELEMENTS CAN BE CUT IN FOUR ONLY IN',/,
     &          'THE CASE OF TRIANGLES                     ',/,
     &          '********************************************',/)
 4000 FORMAT(//,'***********************************************',/,
     &          'FAILURE IN CANCELLING BACKWARD DEPENDENCIES    ',/,
     &          '         (NUMBER OF ATTEMPTS : 50)             ',/,
     &          'THERE MUST BE TOO FEW NODES IN THE MESH        ',/,
     &          '***********************************************')
 4100 FORMAT(1x,'BACKWARD DEPENDENCIES ARE CANCELLED AFTER ',i2,
     &          ' ATTEMPTS')
!
 4002 FORMAT(//,'***********************************************',/,
     &          'MESH DRY ELEMENT SUPPRESION NOT AVAILABLE FOR ',
     &          'NON TRIANGULAR MESH.',/,
     &          '***********************************************')
!
 3001 FORMAT(1x,'THE POINT NUMBER ',i6,' HAS TO BE REMOVED')
 3003 FORMAT(//,1x,'GENERATING GEOMETRY FILE',/,
     &         1x,'------------------------')
 3005 FORMAT(//,1x,'TREATMENT OF BOUNDARY CONDITIONS',/,
     &         1x,'--------------------------------')
 3007 FORMAT(//,1x,'MESH DRY ELEMENT SUPPRESSION',
     &        /,1x,'----------------------------',/)
 3009 FORMAT(/,1x,'NO CONNECTED ISLAND')
 3011 FORMAT(//,1x,'ELIMINATION OK BACKWARDS DEPENDENCIES',
     &        /,1x,'------------------------------------',/)
!
      DEALLOCATE(w)
      DEALLOCATE(work)
      DEALLOCATE(x)
      DEALLOCATE(y)
      DEALLOCATE(zf)
      DEALLOCATE(xr)
      DEALLOCATE(yr)
      DEALLOCATE(zr)
      DEALLOCATE(xinit)
      DEALLOCATE(yinit)
      DEALLOCATE(vainit)
      DEALLOCATE(var)
      DEALLOCATE(shp)
      DEALLOCATE(nop5)
      DEALLOCATE(trav1)
      DEALLOCATE(trav2)
      DEALLOCATE(trav3)
      DEALLOCATE(ncolor)
      DEALLOCATE(ikle)
      DEALLOCATE(ikinit)
      DEALLOCATE(ifabor)
      DEALLOCATE(elt)
      DEALLOCATE(tfast1)
      DEALLOCATE(tfast2)
      DEALLOCATE(isdry)
      DEALLOCATE(nbor)
      DEALLOCATE(old_nbor)
      DEALLOCATE(kp1bor)
      DEALLOCATE(liubor)
      DEALLOCATE(livbor)
      DEALLOCATE(litbor)
      DEALLOCATE(lihbor)
      DEALLOCATE(ncolfr)

      DEALLOCATE(chbord)
      DEALLOCATE(hbor)
      DEALLOCATE(ubor)
      DEALLOCATE(vbor)
      DEALLOCATE(ipobo)
!
!-----------------------------------------------------------------------
!
      RETURN
      END