lecfon.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\lecfon.f
00002 !
00030                         SUBROUTINE LECFON
00031 !                       *****************
00032 !
00033      &( XRELV , YRELV , ZRELV , NBAT , NFOND , NBFOND ,  NP ,
00034      &  NPT , FONTRI , CORTRI , MAILLE, NGEO )
00035 !
00036 !***********************************************************************
00037 ! PROGICIEL : STBTEL V5.2         25/03/92    J-C GALLAND  (LNH)
00038 !                                 09/11/94    P. LANG / LHF (TRIGRID)
00039 !                                  07/96    P. CHAILLET / LHF (FASTTABS)
00040 !***********************************************************************
00041 !
00042 ! FONCTION : LECTURE DES FICHIERS DE BATHYMETRIE
00043 !
00044 !----------------------------------------------------------------------
00045 !                             ARGUMENTS
00046 ! .________________.____.______________________________________________
00047 ! |      NOM       |MODE|                   ROLE
00048 ! |________________|____|______________________________________________
00049 ! |    XRELV,YRELV | -->|  COORDONNEES DES POINTS DE BATHY
00050 ! |    ZRELV       | -->|  COTES DES POINTS DE BATHY
00051 ! |    NBAT        | -->|  NOMBRE DE POINTS DE BATHY
00052 ! |    NFOND       | -->|  CANAUX DES FICHIERS DES FONDS
00053 ! |    NBFOND      | -->|  NOMBRE DE FICHIERS FONDS DONNES PAR
00054 ! |                |    |  L'UTILISATEUR (5 MAXI)
00055 ! |    FOND        | -->|  NOM DES FICHIERS DES FONDS
00056 ! |    NP          | -->|  NOMBRES DE POINTS LUS PAR LECFON DANS LES
00057 ! |                |    |  FICHIERS DES FONDS
00058 ! |    NPT         | -->|  NOMBRE TOTAL DE POINTS DE BATHYMETRIE
00059 ! |    FONTRI      | -->|  INDICATEUR DE LECTURE DES FONDS DANS TRIGRID
00060 ! |    CORTRI      | -->|  VALEUR DE LA CORRECTION DES FONDS DE TRIGRID
00061 ! |    MAILLE      | -->| NOM DU MAILLEUR UTILISE
00062 ! |________________|____|______________________________________________
00063 ! | COMMON :       |    |
00064 ! |                |    |
00065 ! |  FICH:         |    |
00066 ! |    NRES        | -->|  NUMERO DU CANAL DU FICHIER GEOMETRIE
00067 ! |    NGEO        | -->|  NUMERO DU CANAL DU FICHIER UNIVERSEL
00068 ! |    NLIM        | -->|  NUMERO DU CANAL DU FICHIER DYNAM
00069 ! |    NFO1        | -->|  NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
00070 ! |________________|____|______________________________________________
00071 !
00072 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00073 !----------------------------------------------------------------------
00074 !
00075 ! APPELE PAR : INTERP
00076 ! APPEL DE : -
00077 !
00078 !**********************************************************************
00079 !
00080       IMPLICIT NONE
00081       INTEGER LNG,LU
00082       COMMON/INFO/LNG,LU
00083 !
00084       INTEGER I , NPT , NBAT
00085       INTEGER NFOND(*) , NP(5) , NBFOND
00086       INTEGER NGEO , IDUMMY , ITRI
00087 !
00088       DOUBLE PRECISION XRELV(*) , YRELV(*) , ZRELV(*)
00089       DOUBLE PRECISION CORTRI
00090 !
00091 !     REELS DECLARES SIMPLES PRECISION POUR LECTURE FICHIER SINUSX
00092 !
00093       REAL   XSP , YSP , ZSP
00094 !
00095       CHARACTER*1  C
00096 !
00097 ! Ajout PCt - 11/07/96
00098       CHARACTER*9  MAILLE
00099       CHARACTER*80 LIGNE
00100 !
00101       LOGICAL FONTRI
00102 !
00103       INTRINSIC DBLE
00104 !
00105 !=======================================================================
00106 !  INITIALISATION
00107 !=======================================================================
00108 !
00109       DO I=1,NBAT
00110         XRELV(I)=0.D0
00111         YRELV(I)=0.D0
00112         ZRELV(I)=0.D0
00113       ENDDO
00114 !
00115 !=======================================================================
00116 ! LECTURE DES FICHIERS FOND
00117 !=======================================================================
00118 !
00119       NP(1) = 0
00120       NP(2) = 0
00121       NP(3) = 0
00122       NP(4) = 0
00123       NP(5) = 0
00124       NPT   = 0
00125 !
00126 ! DANS LE CAS DU MAILLEUR TRIGRID, SI FONTRI=VRAI ON LIT LA BATHY
00127 ! DIRECTEMENT DANS LE FICHIER UNIVERSEL, SINON ON EFFECTUE LE TRAITEMENT
00128 ! NORMAL.
00129 !
00130 ! Modification PCt le 11/07/96
00131 ! ajout du cas FASTTABS
00132 !
00133       IF (FONTRI) THEN
00134         IF (MAILLE.EQ.'TRIGRID') THEN
00135           IF (LNG.EQ.1) WRITE (LU,1040)
00136           IF (LNG.EQ.2) WRITE (LU,4040)
00137           REWIND (NGEO)
00138           READ (NGEO,'(//)')
00139 1         CONTINUE
00140             READ (NGEO,*,END=9000,ERR=9000) IDUMMY,XSP,YSP,ITRI,ZSP
00141             NPT = NPT + 1
00142             XRELV(NPT) = DBLE(XSP)
00143             YRELV(NPT) = DBLE(YSP)
00144             ZRELV(NPT) = DBLE(-ZSP) + CORTRI
00145             GOTO 1
00146 9000      CONTINUE
00147           NP(1) = NPT
00148           IF (LNG.EQ.1) WRITE (LU,1050) NPT
00149           IF (LNG.EQ.2) WRITE (LU,4050) NPT
00150         ELSEIF (MAILLE.EQ.'FASTTABS') THEN
00151 !
00152 ! Ajout PCt - FASTTABS - le 11/07/1996
00153 !
00154           IF (LNG.EQ.1) WRITE (LU,1060)
00155           IF (LNG.EQ.2) WRITE (LU,4070)
00156           REWIND (NGEO)
00157 2         CONTINUE
00158             READ (NGEO,'(A)',END=9010,ERR=8000) LIGNE
00159             IF (LIGNE(1:3).EQ.'GNN') THEN
00160               READ(LIGNE(4:80),*,ERR=8000,END=8000) IDUMMY,XSP,YSP,ZSP
00161               NPT = NPT + 1
00162               XRELV(NPT) = DBLE(XSP)
00163               YRELV(NPT) = DBLE(YSP)
00164               ZRELV(NPT) = DBLE(ZSP)
00165             ENDIF
00166             GOTO 2
00167 9010      CONTINUE
00168         ENDIF
00169 ! temporaire
00170       ELSE
00171 !
00172         DO I = 1,NBFOND
00173 !
00174           REWIND NFOND(I)
00175 30        READ(NFOND(I),1000,END=40) C
00176           IF (C(1:1).NE.'C'.AND.C(1:1).NE.'B') THEN
00177             BACKSPACE ( UNIT = NFOND(I) )
00178             NP(I)=NP(I)+1
00179             NPT  =NPT +1
00180             IF (NPT.GT.NBAT.AND.LNG.EQ.1) THEN
00181               WRITE(LU,1020) NBAT
00182               CALL PLANTE(1)
00183               STOP
00184             ENDIF
00185             IF (NPT.GT.NBAT.AND.LNG.EQ.2) THEN
00186               WRITE(LU,4020) NBAT
00187               CALL PLANTE(1)
00188               STOP
00189             ENDIF
00190 !
00191 ! LECTURE FICHIER SINUSX SIMPLE PRECISION PUIS -> DOUBLE PRECISION
00192 !
00193              READ (NFOND(I),*) XSP,YSP,ZSP
00194              XRELV(NPT) = DBLE(XSP)
00195              YRELV(NPT) = DBLE(YSP)
00196              ZRELV(NPT) = DBLE(ZSP)
00197 !
00198           ENDIF
00199           GOTO 30
00200 40        CONTINUE
00201           IF (NP(I).EQ.0.AND.LNG.EQ.1) THEN
00202             WRITE(LU,1030) I
00203             CALL PLANTE(1)
00204             STOP
00205           ENDIF
00206           IF (NP(I).EQ.0.AND.LNG.EQ.2) THEN
00207             WRITE(LU,4030) I
00208             CALL PLANTE(1)
00209             STOP
00210           ENDIF
00211 !
00212         ENDDO! I
00213       ENDIF
00214 !
00215 ! Ajout PCt - FASTTABS - le 11/07/1996
00216 !
00217       RETURN
00218  8000 CONTINUE
00219       IF (LNG.EQ.1) WRITE (LU,4000)
00220       IF (LNG.EQ.2) WRITE (LU,4001)
00221  4000 FORMAT (//,1X,'***************************************'
00222      &        ,/,1X,'SOUS-PROGRAMME LECFON : ERREUR DANS LA'
00223      &        ,/,1X,'LECTURE DU FICHIER DE MAILLAGE FASTTABS.'
00224      &        ,/,1X,'***************************************')
00225  4001 FORMAT (//,1X,'****************************'
00226      &        ,/,1X,'SUBROUTINE LECFON :'
00227      &        ,/,1X,'ERROR READING FASTTABS FILE.'
00228      &        ,/,1X,'****************************')
00229       CALL PLANTE(1)
00230       STOP
00231 !
00232 !-----------------------------------------------------------------------
00233 !
00234 1000  FORMAT(A1)
00235 1020  FORMAT(/,'****************************************************',/,
00236      &         'LE NOMBRE DE POINTS DE BATHYMETRIE EST   ',           /,
00237      &         'SUPERIEUR A :',                                   1I6,/,
00238      &         'MODIFIER LE PARAMETRE SUIVANT DU FICHIER CAS : '     ,/,
00239      &         'NOMBRE MAXIMUM DE POINTS DE BATHYMETRIE'             ,/,
00240      &         '****************************************************')
00241 4020  FORMAT(/,'****************************************************',/,
00242      &         'THE NUMBER OF BATHYMETRY POINTS IS     ',/,
00243      &         'GREATER THAN :',                                  1I6,/,
00244      &         'CHANGE THE FOLLOWING PARAMETER ',/,
00245      &         'IN THE STEERING FILE : ',/,
00246      &         'NUMBER OF BATHYMETRY POINTS '             ,/,
00247      &         '****************************************************')
00248 1030  FORMAT(/,'********************************',/,
00249      &         'LE FICHIER FOND ',I1,' EST VIDE |',/,
00250      &         '********************************',/)
00251 4030  FORMAT(/,'******************************************',/,
00252      &         'THE BOTTOM TOPOGRAPHY FILE ',I1,' IS EMPTY|',/,
00253      &         '******************************************',/)
00254 1040  FORMAT(/,'**********************************************',/,
00255      &         'SOUS-PROGRAMME LECFON',/,
00256      &         'LA BATHYMETRIE EST LUE DANS LE FICHIER TRIGRID',/
00257      &         '**********************************************',/)
00258 4040  FORMAT(/,'****************************************',/,
00259      &         'SUBROUTINE LECFON',/,
00260      &         'READING BATHYMETRY IN TRIGRID MESH FILE',/
00261      &         '****************************************',/)
00262 1050  FORMAT(/,'**********************************************',/,
00263      &         'SOUS-PROGRAMME LECFON',/,
00264      &         'NOMBRE DE POINTS LUS DANS LE FICHIER TRIGRID : ',
00265      &         I5,/
00266      &         '**********************************************',/)
00267 4050  FORMAT(/,'****************************************',/,
00268      &         'SUBROUTINE LECFON',/,
00269      &         'NUMBER OF BATHYMETRIC POINTS IN TRIGRID FILE : ',
00270      &         I5,/
00271      &         '****************************************',/)
00272 1060  FORMAT(/,'**********************************************',/,
00273      &         'SOUS-PROGRAMME LECFON',/,
00274      &         'LA BATHYMETRIE EST LUE DANS LE FICHIER FASTTABS',/
00275      &         '**********************************************',/)
00276 4070  FORMAT(/,'****************************************',/,
00277      &         'SUBROUTINE LECFON',/,
00278      &         'NUMBER OF BATHYMETRIC POINTS IN FASTTABS FILE : ',
00279      &         I5,/
00280      &         '****************************************',/)
00281 !
00282       END SUBROUTINE

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0