lecfon.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE lecfon
!                       *****************
!
     &( xrelv , yrelv , zrelv , nbat , nfond , nbfond ,  np ,
     &  npt , fontri , cortri , maille, ngeo )
!
!***********************************************************************
! PROGICIEL : STBTEL V5.2         25/03/92    J-C GALLAND  (LNH)
!                                 09/11/94    P. LANG / LHF (TRIGRID)
!                                  07/96    P. CHAILLET / LHF (FASTTABS)
!***********************************************************************
!
! FONCTION : LECTURE DES FICHIERS DE BATHYMETRIE
!
!----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! |      NOM       |MODE|                   ROLE
! |________________|____|______________________________________________
! |    XRELV,YRELV | -->|  COORDONNEES DES POINTS DE BATHY
! |    ZRELV       | -->|  COTES DES POINTS DE BATHY
! |    NBAT        | -->|  NOMBRE DE POINTS DE BATHY
! |    NFOND       | -->|  CANAUX DES FICHIERS DES FONDS
! |    NBFOND      | -->|  NOMBRE DE FICHIERS FONDS DONNES PAR
! |                |    |  L'UTILISATEUR (5 MAXI)
! |    FOND        | -->|  NOM DES FICHIERS DES FONDS
! |    NP          | -->|  NOMBRES DE POINTS LUS PAR LECFON DANS LES
! |                |    |  FICHIERS DES FONDS
! |    NPT         | -->|  NOMBRE TOTAL DE POINTS DE BATHYMETRIE
! |    FONTRI      | -->|  INDICATEUR DE LECTURE DES FONDS DANS TRIGRID
! |    CORTRI      | -->|  VALEUR DE LA CORRECTION DES FONDS DE TRIGRID
! |    MAILLE      | -->| NOM DU MAILLEUR UTILISE
! |________________|____|______________________________________________
! | COMMON :       |    |
! |                |    |
! |  FICH:         |    |
! |    NRES        | -->|  NUMERO DU CANAL DU FICHIER GEOMETRIE
! |    NGEO        | -->|  NUMERO DU CANAL DU FICHIER UNIVERSEL
! |    NLIM        | -->|  NUMERO DU CANAL DU FICHIER DYNAM
! |    NFO1        | -->|  NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
! |________________|____|______________________________________________
!
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!----------------------------------------------------------------------
!
! APPELE PAR : INTERP
! APPEL DE : -
!
!**********************************************************************
!
      USE declarations_special
      IMPLICIT NONE
!
      DOUBLE PRECISION, INTENT(INOUT) :: XRELV(*) , YRELV(*) , ZRELV(*)
      INTEGER, INTENT(IN) :: NFOND(*) , NBAT , NBFOND
      INTEGER, INTENT(INOUT) :: NP(5), NPT
      LOGICAL, INTENT(IN) :: FONTRI
      DOUBLE PRECISION, INTENT(IN) :: CORTRI
      CHARACTER(LEN=9), INTENT(IN) ::  MAILLE
      INTEGER, INTENT(IN) :: NGEO
!
      INTEGER I
      INTEGER IDUMMY , ITRI
!
!     REELS DECLARES SIMPLES PRECISION POUR LECTURE FICHIER SINUSX
!
      REAL   XSP , YSP , ZSP
!
      CHARACTER(LEN=1)  C
!
! Ajout PCt - 11/07/96
      CHARACTER(LEN=80) LIGNE
!
!
      INTRINSIC dble
!
!=======================================================================
!  INITIALISATION
!=======================================================================
!
      DO i=1,nbat
        xrelv(i)=0.d0
        yrelv(i)=0.d0
        zrelv(i)=0.d0
      ENDDO
!
!=======================================================================
! LECTURE DES FICHIERS FOND
!=======================================================================
!
      np(1) = 0
      np(2) = 0
      np(3) = 0
      np(4) = 0
      np(5) = 0
      npt   = 0
!
! DANS LE CAS DU MAILLEUR TRIGRID, SI FONTRI=VRAI ON LIT LA BATHY
! DIRECTEMENT DANS LE FICHIER UNIVERSEL, SINON ON EFFECTUE LE TRAITEMENT
! NORMAL.
!
! Modification PCt le 11/07/96
! ajout du cas FASTTABS
!
      IF (fontri) THEN
        IF (maille.EQ.'TRIGRID') THEN
          WRITE (lu,4040)
          rewind(ngeo)
          READ (ngeo,'(//)')
1         CONTINUE
            READ (ngeo,*,end=9000,err=9000) idummy,xsp,ysp,itri,zsp
            npt = npt + 1
            xrelv(npt) = dble(xsp)
            yrelv(npt) = dble(ysp)
            zrelv(npt) = dble(-zsp) + cortri
            GOTO 1
9000      CONTINUE
          np(1) = npt
          WRITE (lu,4050) npt
        ELSEIF (maille.EQ.'FASTTABS') THEN
!
! Ajout PCt - FASTTABS - le 11/07/1996
!
          WRITE (lu,4070)
          rewind(ngeo)
2         CONTINUE
            READ (ngeo,'(A)',end=9010,err=8000) ligne
            IF (ligne(1:3).EQ.'GNN') THEN
              READ(ligne(4:80),*,err=8000,end=8000) idummy,xsp,ysp,zsp
              npt = npt + 1
              xrelv(npt) = dble(xsp)
              yrelv(npt) = dble(ysp)
              zrelv(npt) = dble(zsp)
            ENDIF
            GOTO 2
9010      CONTINUE
        ENDIF
! temporaire
      ELSE
!
        DO i = 1,nbfond
!
          rewind nfond(i)
30        READ(nfond(i),1000,end=40) c
          IF (c(1:1).NE.'C'.AND.c(1:1).NE.'B') THEN
            backspace( unit = nfond(i) )
            np(i)=np(i)+1
            npt  =npt +1
            IF (npt.GT.nbat) THEN
              WRITE(lu,4020) nbat
              CALL plante(1)
              stop
            ENDIF
!
! LECTURE FICHIER SINUSX SIMPLE PRECISION PUIS -> DOUBLE PRECISION
!
            READ (nfond(i),*) xsp,ysp,zsp
            xrelv(npt) = dble(xsp)
            yrelv(npt) = dble(ysp)
            zrelv(npt) = dble(zsp)
!
          ENDIF
          GOTO 30
40        CONTINUE
          IF (np(i).EQ.0) THEN
            WRITE(lu,4030) i
            CALL plante(1)
            stop
          ENDIF
!
        ENDdo! I
      ENDIF
!
! Ajout PCt - FASTTABS - le 11/07/1996
!
      RETURN
 8000 CONTINUE
      WRITE (lu,4001)
 4001 FORMAT (//,1x,'****************************'
     &        ,/,1x,'SUBROUTINE LECFON :'
     &        ,/,1x,'ERROR READING FASTTABS FILE.'
     &        ,/,1x,'****************************')
      CALL plante(1)
      stop
!
!-----------------------------------------------------------------------
!
1000  FORMAT(a1)
4020  FORMAT(/,'****************************************************',/,
     &         'THE NUMBER OF BATHYMETRY POINTS IS     ',/,
     &         'GREATER THAN :',                                  1i6,/,
     &         'CHANGE THE FOLLOWING PARAMETER ',/,
     &         'IN THE STEERING FILE : ',/,
     &         'NUMBER OF BATHYMETRY POINTS '             ,/,
     &         '****************************************************')
4030  FORMAT(/,'******************************************',/,
     &         'THE BOTTOM TOPOGRAPHY FILE ',i1,' IS EMPTY|',/,
     &         '******************************************',/)
4040  FORMAT(/,'****************************************',/,
     &         'SUBROUTINE LECFON',/,
     &         'READING BATHYMETRY IN TRIGRID MESH FILE',/
     &         '****************************************',/)
4050  FORMAT(/,'****************************************',/,
     &         'SUBROUTINE LECFON',/,
     &         'NUMBER OF BATHYMETRIC POINTS IN TRIGRID FILE : ',
     &         i5,/
     &         '****************************************',/)
4070  FORMAT(/,'****************************************',/,
     &         'SUBROUTINE LECFON',/,
     &         'NUMBER OF BATHYMETRIC POINTS IN FASTTABS FILE : ',
     &         i5,/
     &         '****************************************',/)
!
      END SUBROUTINE