lecdon_stbtel.f

Go to the documentation of this file.

!                       ************************
                        SUBROUTINE lecdon_stbtel
!                       ************************
!
!***********************************************************************
! PROGICIEL : STBTEL V5.2     24/10/90    J-M HERVOUET (LNH) 30 71 80 18
!                             09/11/94    P LANG / LHF
!                                08/96    P CHAILLET/ LHF
!                                01/99    A CABAL/ P LANG SOGREAH
!***********************************************************************
!
! FONCTION : LECTURE DU FICHIER CAS PAR APPEL DU LOGICIEL DAMOCLES.
!
!----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! |      NOM       |MODE|                   ROLE
! |________________|____|______________________________________________
! |    NCLE       | -->| NUMERO D'UNITE LOGIQUE DES MOTS-CLES DE REF.
! |    NCAS        | -->| NUMERO D'UNITE LOGIQUE DU FICHIER CAS.
! |    STD         |<-- | STANDARD  DE BINAIRE
! |    DECTRI      |<-- | DECOUPAGE DES TRIANGLES SURCONTRAINTS
! |    FOND        |<-- | TABLEAU DES NOMS DES FICHIERS DE BATHYMETRIE
! |    EPSI        |<-- | DISTANCE MINIMALE ENTRE 2 NOEUDS DU MAILLAGE
! |                |    | L'INTERPOLATION DES FONDS
! |    COLOR       |<-- | ECRITURE DE LA COULEUR DES NOEUDS
! |    NBAT        |<-- | NOMBRE DE POINTS DE BATHYMETRIE
! |    ELIDEP      |<-- | ELIMINATION DES DEPENDANCES ARRIERES
! |    NBFOND      |<-- | NOMBRE DE FICHIERS BATHY
! |    MAILLE      |<-- | MAILLEUR UTILISE :
! |                |    |   SUPERTAB VERSION 6 : SUPERTAB6 (DEFAUT)
! |                |    |   SUPERTAB VERSION 4 : SUPERTAB4
! |                |    |   SIMAIL
! |    DM          |<-- | DISTANCE MNIMALE A LA FRONTIERE POUR
! |                |    | L'INTERPOLATION DES FONDS
! |    FONTRI      |<-- | INDICATEUR DE LECTURE DES FONDS DANS TRIGRID
! |    CORTRI      |<-- | CORRECTION DES FONDS DE TRIGRID
! |    OPTASS      |    |
! |    ADDFAS      |<-- | CONDITION LIMITE DANS FICHIER ADDITIONNEL
! |    ELISEC      |<-- | INDIC ELIMINATION DES ELEMENTS SECS
! |    ELPSEC      |<-- | INDIC ELIM ELEMENTS PARTIELLEMENT SECS
! |    SEUSEC      |<-- | VALEUR POUR LA DEFINITION SECHERESSE
! |    STOTOT      |<-- | INDIC RECUP TOTALITE DES PAS DE TEMPS
! |________________|____|______________________________________________
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!----------------------------------------------------------------------
!
! APPELE PAR : STBTEL
! APPEL DE : DAMOCL
!
!**********************************************************************
!
      USE declarations_special
      USE declarations_telemac
      USE declarations_stbtel
      USE declarations_special
      IMPLICIT NONE
!
! AJOUTE POUR EDAMOX:
!
      INTEGER          TROUVE(4,maxkeyword)
      INTEGER          ADRES(4,maxkeyword) , DIMENS(4,maxkeyword)
      INTEGER          MOTINT(maxkeyword)
      INTEGER          NLNG
      CHARACTER(LEN=PATH_LEN)    MOTCAR(maxkeyword)
      CHARACTER(LEN=72)     MOTCLE(4,maxkeyword,2)
      DOUBLE PRECISION MOTREA(maxkeyword)
      LOGICAL          DOC
      LOGICAL          MOTLOG(maxkeyword)
!
! FIN DES VARIABLES AJOUTEES POUR EDAMOX:
!
      INTEGER I
!
!-----------------------------------------------------------------------
!
      doc = .false.
      nlng=2
!
      CALL damocles( adres , dimens, maxkeyword   , doc    , lng , lu ,
     &               motint, motrea, motlog , motcar ,
     &               motcle, trouve, ncle  , ncas   , .false. )
!
!    AFFECTATION DES PARAMETRES SOUS LEUR NOM EN FORTRAN
!
!-----------------------------------------------------------------------
! MOTS CLE DE TYPE ENTIER
!-----------------------------------------------------------------------
!
      nbat      = motint(adres(1,1))
      lgvec     = motint(adres(1,2))
      nsom      = min(motint(adres(1,3)),9)
      nsom2     = min(motint(adres(1,4)),9)
!
!-----------------------------------------------------------------------
! MOTS CLE DE TYPE REEL
!-----------------------------------------------------------------------
!
      epsi      = motrea(adres(2,1))
      dm        = motrea(adres(2,2))
      cortri    = motrea(adres(2,3))
!
      IF (nsom.GE.3) THEN
        DO i=1,nsom
          som(i,1) = motrea(adres(2,4)+i-1)
          som(i,2) = motrea(adres(2,5)+i-1)
        ENDDO
        som(nsom+1,1) = som(1,1)
        som(nsom+1,2) = som(1,2)
      ENDIF
!
      IF (nsom2.GE.3) THEN
        DO i=1,nsom2
          som2(i,1) = motrea(adres(2,6)+i-1)
          som2(i,2) = motrea(adres(2,7)+i-1)
        ENDDO
        som2(nsom2+1,1) = som2(1,1)
        som2(nsom2+1,2) = som2(1,2)
      ENDIF
!
      seusec =  motrea(adres(2,8))
      dx =  motrea(adres(2,9))
      dy =  motrea(adres(2,10))
!
!-----------------------------------------------------------------------
! MOTS CLE DE TYPE LOGIQUE
!-----------------------------------------------------------------------
!
      dectri    = motlog(adres(3,1))
      color     = motlog(adres(3,2))
      elidep    = motlog(adres(3,3))
      div4      = motlog(adres(3,4))
      fontri    = motlog(adres(3,5))
      optass    = motlog(adres(3,6))
!
      addfas    = motlog(adres(3,7))
      projex    = motlog(adres(3,8))
!
      IF (nsom2.GE.3) div4 = .true.
!
      elisec = motlog(adres(3,9))
      elpsec = motlog(adres(3,10))
      stotot = motlog(adres(3,11))
      debug  = motlog(adres(3,12))
      conver = motlog(adres(3,13))
      srf_bnd = motlog(adres(3,14))
      translate = motlog(adres(3,15))
!
!-----------------------------------------------------------------------
! MOTS CLE DE TYPE CARACTERE
!-----------------------------------------------------------------------
!
      nbfond=0

      IF (motcar(adres(4,8)).NE.' ') THEN
        nbfond = nbfond + 1
        fond(nbfond) = motcar(adres(4,8))
        nomfon = motcar(adres(4,8))
      ENDIF
      IF (motcar(adres(4,9)).NE.' ') THEN
        nbfond = nbfond + 1
        fond(nbfond) = motcar(adres(4,9))
        nomfo2 = motcar(adres(4,9))
      ENDIF
      IF (motcar(adres(4,10)).NE.' ') THEN
        nbfond = nbfond + 1
        fond(nbfond) = motcar(adres(4,10))
        nomimp = motcar(adres(4,10))
      ENDIF
      IF (motcar(adres(4,17)).NE.' ') THEN
        nbfond = nbfond + 1
        fond(nbfond) = motcar(adres(4,17))
        nomfrc = motcar(adres(4,17))
      ENDIF
      IF (motcar(adres(4,18)).NE.' ') THEN
        nbfond = nbfond + 1
        fond(nbfond) = motcar(adres(4,18))
        nomsou = motcar(adres(4,18))
      ENDIF
!
      nomgeo = motcar( adres(4, 5) )
      nomfor = motcar( adres(4, 3) )
      nomcas = motcar( adres(4, 4) )
      nomlim = motcar( adres(4, 7) )
      nomres = motcar( adres(4, 6) )
      fformat = 'SERAFIN '
      out_format = motcar( adres(4, 31) )(1:8)
      nomfo1 = motcar( adres(4,15) )
      infile = motcar( adres(4,24) )
      outfile = motcar( adres(4,25) )
      boundfile = motcar( adres(4,26) )
      logfile = motcar( adres(4,27) )
      outbndfile = motcar( adres(4,28) )
      outlogfile = motcar( adres(4,29) )
      nombnd2 = motcar( adres(4,30) )
!
      std       = motcar( adres(4,11))(1:3)
      maille    = motcar( adres(4,14))(1:9)
      infmt     = motcar( adres(4,22))(1:9)
      outfmt    = motcar( adres(4,23))(1:9)
!
      fusion = .false.
      IF (motcar(adres(4,15)).NE.' '.AND.maille.EQ.'SELAFIN')
     &   fusion = .true.
!
!-----------------------------------------------------------------------
! VERIFICATION DES VALEURS LUES
!-----------------------------------------------------------------------
!
      IF (fontri) nbfond = 1
      IF (nbfond.GT.5) THEN
        WRITE(lu,4000)
        CALL plante(1)
        stop
      ENDIF
!
      IF (std.NE.'IBM'.AND.std.NE.'I3E'.AND.std.NE.'STD') THEN
        WRITE(lu,4100) std
        CALL plante(1)
        stop
      ENDIF
!
      IF (maille.NE.'SUPERTAB4'.AND.maille.NE.'SUPERTAB6'.AND.
     &    maille.NE.'SIMAIL'   .AND.maille.NE.'SELAFIN'  .AND.
     &    maille.NE.'TRIGRID'  .AND.maille.NE.'MASTER2'  .AND.
     &    maille.NE.'FASTTABS' .AND.maille.NE.'ADCIRC'   ) THEN
        WRITE(lu,4200) maille
        CALL plante(1)
        stop
      ENDIF
!
      IF (maille.EQ.'SUPERTAB4') THEN
! INDICATEUR DE DEBUT DE LA LISTE DES POINTS DU MAILLAGE
        nsec11 = 15
        nsec12 = 0
! INDICATEUR DE DEBUT DE LA LISTE DES IKLE
        nsec2  = 71
! INDICATEUR DE POSITION DU TITRE
        nsec3  = 151
      ELSEIF (maille.EQ.'SUPERTAB6') THEN
! INDICATEUR DE DEBUT DE LA LISTE DES POINTS DU MAILLAGE
! LECTURE EN SIMPLE PRECISION
        nsec11 = 15
! LECTURE EN DOUBLE PRECISION
        nsec12 = 781
! INDICATEUR DE DEBUT DE LA LISTE DES IKLE
        nsec2  = 780
! INDICATEUR DE POSITION DU TITRE
        nsec3  = 151
      ELSEIF (maille.EQ.'MASTER2') THEN
! INDICATEUR DE DEBUT DE LA LISTE DES POINTS DU MAILLAGE
        nsec11 = 0
        nsec12 = 2411
! INDICATEUR DE DEBUT DE LA LISTE DES IKLE
        nsec2  = 2412
! INDICATEUR DE POSITION DU TITRE
        nsec3  = 151
      ENDIF
!
!-----------------------------------------------------------------------
!
      IF (elisec) THEN
        IF (maille.NE.'SELAFIN') THEN
          WRITE(lu,4300)
          CALL plante(1)
          stop
        ENDIF
        IF (nbfond.GT.0) THEN
          WRITE(lu,4301)
          CALL plante(1)
          stop
        ENDIF
        IF (div4) THEN
          WRITE(lu,4302)
          CALL plante(1)
          stop
        ENDIF
        div4      = .false.
        fontri    = .false.
        optass    = .false.
        addfas    = .false.
        projex    = .false.
      ENDIF
!
!-----------------------------------------------------------------------
!
4000  FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||||',/,
     &          1x,'LECDON . THE NUMBER OF BOTTOM TOPOGRAPHY FILES',/,
     &          1x,'         IS LIMITED TO 5 |',/,
     &          1x,'         (KEYWORD : BOTTOM TOPOGRAPHY FILE)',/,
     &          1x,'||||||||||||||||||||||||||||||||||||||||||||||',//)
!
4100  FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||',/,
     &          1x,'LECDON . UNKNOWN BINARY FILE STANDARD : ',a3,/,
     &          1x,'         (KEYWORD : BINARY FILE STANDARD)',/,
     &          1x,'||||||||||||||||||||||||||||||||||||||||||||',//)
!
4200  FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||||',/,
     &          1x,'LECDON . UNKNOWN TYPE OF MESH GENERATOR : ',a9,/,
     &          1x,'         (KEYWORD : MESH GENERATOR)',/,
     &          1x,'||||||||||||||||||||||||||||||||||||||||||||||',//)
 4300 FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||',/,
     &          1x,'LECDON . THE DRY ELEMENTS ELIMINATION IS ONLY',/,
     &          1x,'AVAILABLE WHEN USING SELAFIN FILE.',/,
     &          1x,'||||||||||||||||||||||||||||||||||||||||||||',//)
 4301 FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||',/,
     &          1x,'LECDON . BATHYMETRY INTERPOLATION IMPOSSIBLE',/,
     &          1x,'WHEN USING DRY ELEMENTS ELIMINATION.',/,
     &          1x,'||||||||||||||||||||||||||||||||||||||||||||',//)
 4302 FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||',/,
     &          1x,'LECDON . TRIANGLE CUTTING IMPOSSIBLE',/,
     &          1x,'WHEN USING DRY ELEMENTS ELIMINATION.',/,
     &          1x,'||||||||||||||||||||||||||||||||||||||||||||',//)
!
!-----------------------------------------------------------------------
!
      RETURN
      END