The TELEMAC-MASCARET system  trunk
lecfon.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE lecfon
3 ! *****************
4 !
5  &( xrelv , yrelv , zrelv , nbat , nfond , nbfond , np ,
6  & npt , fontri , cortri , maille, ngeo )
7 !
8 !***********************************************************************
9 ! PROGICIEL : STBTEL V5.2 25/03/92 J-C GALLAND (LNH)
10 ! 09/11/94 P. LANG / LHF (TRIGRID)
11 ! 07/96 P. CHAILLET / LHF (FASTTABS)
12 !***********************************************************************
13 !
14 ! FONCTION : LECTURE DES FICHIERS DE BATHYMETRIE
15 !
16 !----------------------------------------------------------------------
17 ! ARGUMENTS
18 ! .________________.____.______________________________________________
19 ! | NOM |MODE| ROLE
20 ! |________________|____|______________________________________________
21 ! | XRELV,YRELV | -->| COORDONNEES DES POINTS DE BATHY
22 ! | ZRELV | -->| COTES DES POINTS DE BATHY
23 ! | NBAT | -->| NOMBRE DE POINTS DE BATHY
24 ! | NFOND | -->| CANAUX DES FICHIERS DES FONDS
25 ! | NBFOND | -->| NOMBRE DE FICHIERS FONDS DONNES PAR
26 ! | | | L'UTILISATEUR (5 MAXI)
27 ! | FOND | -->| NOM DES FICHIERS DES FONDS
28 ! | NP | -->| NOMBRES DE POINTS LUS PAR LECFON DANS LES
29 ! | | | FICHIERS DES FONDS
30 ! | NPT | -->| NOMBRE TOTAL DE POINTS DE BATHYMETRIE
31 ! | FONTRI | -->| INDICATEUR DE LECTURE DES FONDS DANS TRIGRID
32 ! | CORTRI | -->| VALEUR DE LA CORRECTION DES FONDS DE TRIGRID
33 ! | MAILLE | -->| NOM DU MAILLEUR UTILISE
34 ! |________________|____|______________________________________________
35 ! | COMMON : | |
36 ! | | |
37 ! | FICH: | |
38 ! | NRES | -->| NUMERO DU CANAL DU FICHIER GEOMETRIE
39 ! | NGEO | -->| NUMERO DU CANAL DU FICHIER UNIVERSEL
40 ! | NLIM | -->| NUMERO DU CANAL DU FICHIER DYNAM
41 ! | NFO1 | -->| NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
42 ! |________________|____|______________________________________________
43 !
44 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
45 !----------------------------------------------------------------------
46 !
47 ! APPELE PAR : INTERP
48 ! APPEL DE : -
49 !
50 !**********************************************************************
51 !
53  IMPLICIT NONE
54 !
55  DOUBLE PRECISION, INTENT(INOUT) :: XRELV(*) , YRELV(*) , ZRELV(*)
56  INTEGER, INTENT(IN) :: NFOND(*) , NBAT , NBFOND
57  INTEGER, INTENT(INOUT) :: NP(5), NPT
58  LOGICAL, INTENT(IN) :: FONTRI
59  DOUBLE PRECISION, INTENT(IN) :: CORTRI
60  CHARACTER(LEN=9), INTENT(IN) :: MAILLE
61  INTEGER, INTENT(IN) :: NGEO
62 !
63  INTEGER I
64  INTEGER IDUMMY , ITRI
65 !
66 ! REELS DECLARES SIMPLES PRECISION POUR LECTURE FICHIER SINUSX
67 !
68  REAL XSP , YSP , ZSP
69 !
70  CHARACTER(LEN=1) C
71 !
72 ! Ajout PCt - 11/07/96
73  CHARACTER(LEN=80) LIGNE
74 !
75 !
76  INTRINSIC dble
77 !
78 !=======================================================================
79 ! INITIALISATION
80 !=======================================================================
81 !
82  DO i=1,nbat
83  xrelv(i)=0.d0
84  yrelv(i)=0.d0
85  zrelv(i)=0.d0
86  ENDDO
87 !
88 !=======================================================================
89 ! LECTURE DES FICHIERS FOND
90 !=======================================================================
91 !
92  np(1) = 0
93  np(2) = 0
94  np(3) = 0
95  np(4) = 0
96  np(5) = 0
97  npt = 0
98 !
99 ! DANS LE CAS DU MAILLEUR TRIGRID, SI FONTRI=VRAI ON LIT LA BATHY
100 ! DIRECTEMENT DANS LE FICHIER UNIVERSEL, SINON ON EFFECTUE LE TRAITEMENT
101 ! NORMAL.
102 !
103 ! Modification PCt le 11/07/96
104 ! ajout du cas FASTTABS
105 !
106  IF (fontri) THEN
107  IF (maille.EQ.'TRIGRID') THEN
108  WRITE (lu,4040)
109  rewind(ngeo)
110  READ (ngeo,'(//)')
111 1 CONTINUE
112  READ (ngeo,*,end=9000,err=9000) idummy,xsp,ysp,itri,zsp
113  npt = npt + 1
114  xrelv(npt) = dble(xsp)
115  yrelv(npt) = dble(ysp)
116  zrelv(npt) = dble(-zsp) + cortri
117  GOTO 1
118 9000 CONTINUE
119  np(1) = npt
120  WRITE (lu,4050) npt
121  ELSEIF (maille.EQ.'FASTTABS') THEN
122 !
123 ! Ajout PCt - FASTTABS - le 11/07/1996
124 !
125  WRITE (lu,4070)
126  rewind(ngeo)
127 2 CONTINUE
128  READ (ngeo,'(A)',end=9010,err=8000) ligne
129  IF (ligne(1:3).EQ.'GNN') THEN
130  READ(ligne(4:80),*,err=8000,end=8000) idummy,xsp,ysp,zsp
131  npt = npt + 1
132  xrelv(npt) = dble(xsp)
133  yrelv(npt) = dble(ysp)
134  zrelv(npt) = dble(zsp)
135  ENDIF
136  GOTO 2
137 9010 CONTINUE
138  ENDIF
139 ! temporaire
140  ELSE
141 !
142  DO i = 1,nbfond
143 !
144  rewind nfond(i)
145 30 READ(nfond(i),1000,end=40) c
146  IF (c(1:1).NE.'C'.AND.c(1:1).NE.'B') THEN
147  backspace( unit = nfond(i) )
148  np(i)=np(i)+1
149  npt =npt +1
150  IF (npt.GT.nbat) THEN
151  WRITE(lu,4020) nbat
152  CALL plante(1)
153  stop
154  ENDIF
155 !
156 ! LECTURE FICHIER SINUSX SIMPLE PRECISION PUIS -> DOUBLE PRECISION
157 !
158  READ (nfond(i),*) xsp,ysp,zsp
159  xrelv(npt) = dble(xsp)
160  yrelv(npt) = dble(ysp)
161  zrelv(npt) = dble(zsp)
162 !
163  ENDIF
164  GOTO 30
165 40 CONTINUE
166  IF (np(i).EQ.0) THEN
167  WRITE(lu,4030) i
168  CALL plante(1)
169  stop
170  ENDIF
171 !
172  ENDdo! I
173  ENDIF
174 !
175 ! Ajout PCt - FASTTABS - le 11/07/1996
176 !
177  RETURN
178  8000 CONTINUE
179  WRITE (lu,4001)
180  4001 FORMAT (//,1x,'****************************'
181  & ,/,1x,'SUBROUTINE LECFON :'
182  & ,/,1x,'ERROR READING FASTTABS FILE.'
183  & ,/,1x,'****************************')
184  CALL plante(1)
185  stop
186 !
187 !-----------------------------------------------------------------------
188 !
189 1000 FORMAT(a1)
190 4020 FORMAT(/,'****************************************************',/,
191  & 'THE NUMBER OF BATHYMETRY POINTS IS ',/,
192  & 'GREATER THAN :', 1i6,/,
193  & 'CHANGE THE FOLLOWING PARAMETER ',/,
194  & 'IN THE STEERING FILE : ',/,
195  & 'NUMBER OF BATHYMETRY POINTS ' ,/,
196  & '****************************************************')
197 4030 FORMAT(/,'******************************************',/,
198  & 'THE BOTTOM TOPOGRAPHY FILE ',i1,' IS EMPTY|',/,
199  & '******************************************',/)
200 4040 FORMAT(/,'****************************************',/,
201  & 'SUBROUTINE LECFON',/,
202  & 'READING BATHYMETRY IN TRIGRID MESH FILE',/
203  & '****************************************',/)
204 4050 FORMAT(/,'****************************************',/,
205  & 'SUBROUTINE LECFON',/,
206  & 'NUMBER OF BATHYMETRIC POINTS IN TRIGRID FILE : ',
207  & i5,/
208  & '****************************************',/)
209 4070 FORMAT(/,'****************************************',/,
210  & 'SUBROUTINE LECFON',/,
211  & 'NUMBER OF BATHYMETRIC POINTS IN FASTTABS FILE : ',
212  & i5,/
213  & '****************************************',/)
214 !
215  END SUBROUTINE
subroutine lecfon(XRELV, YRELV, ZRELV, NBAT, NFOND, NBFOND, NP, NPT, FONTRI, CORTRI, MAILLE, NGEO)
Definition: lecfon.f:8