The TELEMAC-MASCARET system  trunk
lecdon_stbtel.f
Go to the documentation of this file.
1 ! ************************
2  SUBROUTINE lecdon_stbtel
3 ! ************************
4 !
5 !***********************************************************************
6 ! PROGICIEL : STBTEL V5.2 24/10/90 J-M HERVOUET (LNH) 30 71 80 18
7 ! 09/11/94 P LANG / LHF
8 ! 08/96 P CHAILLET/ LHF
9 ! 01/99 A CABAL/ P LANG SOGREAH
10 !***********************************************************************
11 !
12 ! FONCTION : LECTURE DU FICHIER CAS PAR APPEL DU LOGICIEL DAMOCLES.
13 !
14 !----------------------------------------------------------------------
15 ! ARGUMENTS
16 ! .________________.____.______________________________________________
17 ! | NOM |MODE| ROLE
18 ! |________________|____|______________________________________________
19 ! | NCLE | -->| NUMERO D'UNITE LOGIQUE DES MOTS-CLES DE REF.
20 ! | NCAS | -->| NUMERO D'UNITE LOGIQUE DU FICHIER CAS.
21 ! | STD |<-- | STANDARD DE BINAIRE
22 ! | DECTRI |<-- | DECOUPAGE DES TRIANGLES SURCONTRAINTS
23 ! | FOND |<-- | TABLEAU DES NOMS DES FICHIERS DE BATHYMETRIE
24 ! | EPSI |<-- | DISTANCE MINIMALE ENTRE 2 NOEUDS DU MAILLAGE
25 ! | | | L'INTERPOLATION DES FONDS
26 ! | COLOR |<-- | ECRITURE DE LA COULEUR DES NOEUDS
27 ! | NBAT |<-- | NOMBRE DE POINTS DE BATHYMETRIE
28 ! | ELIDEP |<-- | ELIMINATION DES DEPENDANCES ARRIERES
29 ! | NBFOND |<-- | NOMBRE DE FICHIERS BATHY
30 ! | MAILLE |<-- | MAILLEUR UTILISE :
31 ! | | | SUPERTAB VERSION 6 : SUPERTAB6 (DEFAUT)
32 ! | | | SUPERTAB VERSION 4 : SUPERTAB4
33 ! | | | SIMAIL
34 ! | DM |<-- | DISTANCE MNIMALE A LA FRONTIERE POUR
35 ! | | | L'INTERPOLATION DES FONDS
36 ! | FONTRI |<-- | INDICATEUR DE LECTURE DES FONDS DANS TRIGRID
37 ! | CORTRI |<-- | CORRECTION DES FONDS DE TRIGRID
38 ! | OPTASS | |
39 ! | ADDFAS |<-- | CONDITION LIMITE DANS FICHIER ADDITIONNEL
40 ! | ELISEC |<-- | INDIC ELIMINATION DES ELEMENTS SECS
41 ! | ELPSEC |<-- | INDIC ELIM ELEMENTS PARTIELLEMENT SECS
42 ! | SEUSEC |<-- | VALEUR POUR LA DEFINITION SECHERESSE
43 ! | STOTOT |<-- | INDIC RECUP TOTALITE DES PAS DE TEMPS
44 ! |________________|____|______________________________________________
45 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
46 !----------------------------------------------------------------------
47 !
48 ! APPELE PAR : STBTEL
49 ! APPEL DE : DAMOCL
50 !
51 !**********************************************************************
52 !
57  IMPLICIT NONE
58 !
59 ! AJOUTE POUR EDAMOX:
60 !
61  INTEGER TROUVE(4,maxkeyword)
62  INTEGER ADRES(4,maxkeyword) , DIMENS(4,maxkeyword)
63  INTEGER MOTINT(maxkeyword)
64  INTEGER NLNG
65  CHARACTER(LEN=PATH_LEN) MOTCAR(maxkeyword)
66  CHARACTER(LEN=72) MOTCLE(4,maxkeyword,2)
67  DOUBLE PRECISION MOTREA(maxkeyword)
68  LOGICAL DOC
69  LOGICAL MOTLOG(maxkeyword)
70 !
71 ! FIN DES VARIABLES AJOUTEES POUR EDAMOX:
72 !
73  INTEGER I
74 !
75 !-----------------------------------------------------------------------
76 !
77  doc = .false.
78  nlng=2
79 !
80  CALL damocles( adres , dimens, maxkeyword , doc , lng , lu ,
81  & motint, motrea, motlog , motcar ,
82  & motcle, trouve, ncle , ncas , .false. )
83 !
84 ! AFFECTATION DES PARAMETRES SOUS LEUR NOM EN FORTRAN
85 !
86 !-----------------------------------------------------------------------
87 ! MOTS CLE DE TYPE ENTIER
88 !-----------------------------------------------------------------------
89 !
90  nbat = motint(adres(1,1))
91  lgvec = motint(adres(1,2))
92  nsom = min(motint(adres(1,3)),9)
93  nsom2 = min(motint(adres(1,4)),9)
94 !
95 !-----------------------------------------------------------------------
96 ! MOTS CLE DE TYPE REEL
97 !-----------------------------------------------------------------------
98 !
99  epsi = motrea(adres(2,1))
100  dm = motrea(adres(2,2))
101  cortri = motrea(adres(2,3))
102 !
103  IF (nsom.GE.3) THEN
104  DO i=1,nsom
105  som(i,1) = motrea(adres(2,4)+i-1)
106  som(i,2) = motrea(adres(2,5)+i-1)
107  ENDDO
108  som(nsom+1,1) = som(1,1)
109  som(nsom+1,2) = som(1,2)
110  ENDIF
111 !
112  IF (nsom2.GE.3) THEN
113  DO i=1,nsom2
114  som2(i,1) = motrea(adres(2,6)+i-1)
115  som2(i,2) = motrea(adres(2,7)+i-1)
116  ENDDO
117  som2(nsom2+1,1) = som2(1,1)
118  som2(nsom2+1,2) = som2(1,2)
119  ENDIF
120 !
121  seusec = motrea(adres(2,8))
122  dx = motrea(adres(2,9))
123  dy = motrea(adres(2,10))
124 !
125 !-----------------------------------------------------------------------
126 ! MOTS CLE DE TYPE LOGIQUE
127 !-----------------------------------------------------------------------
128 !
129  dectri = motlog(adres(3,1))
130  color = motlog(adres(3,2))
131  elidep = motlog(adres(3,3))
132  div4 = motlog(adres(3,4))
133  fontri = motlog(adres(3,5))
134  optass = motlog(adres(3,6))
135 !
136  addfas = motlog(adres(3,7))
137  projex = motlog(adres(3,8))
138 !
139  IF (nsom2.GE.3) div4 = .true.
140 !
141  elisec = motlog(adres(3,9))
142  elpsec = motlog(adres(3,10))
143  stotot = motlog(adres(3,11))
144  debug = motlog(adres(3,12))
145  conver = motlog(adres(3,13))
146  srf_bnd = motlog(adres(3,14))
147  translate = motlog(adres(3,15))
148 !
149 !-----------------------------------------------------------------------
150 ! MOTS CLE DE TYPE CARACTERE
151 !-----------------------------------------------------------------------
152 !
153  nbfond=0
154 
155  IF (motcar(adres(4,8)).NE.' ') THEN
156  nbfond = nbfond + 1
157  fond(nbfond) = motcar(adres(4,8))
158  nomfon = motcar(adres(4,8))
159  ENDIF
160  IF (motcar(adres(4,9)).NE.' ') THEN
161  nbfond = nbfond + 1
162  fond(nbfond) = motcar(adres(4,9))
163  nomfo2 = motcar(adres(4,9))
164  ENDIF
165  IF (motcar(adres(4,10)).NE.' ') THEN
166  nbfond = nbfond + 1
167  fond(nbfond) = motcar(adres(4,10))
168  nomimp = motcar(adres(4,10))
169  ENDIF
170  IF (motcar(adres(4,17)).NE.' ') THEN
171  nbfond = nbfond + 1
172  fond(nbfond) = motcar(adres(4,17))
173  nomfrc = motcar(adres(4,17))
174  ENDIF
175  IF (motcar(adres(4,18)).NE.' ') THEN
176  nbfond = nbfond + 1
177  fond(nbfond) = motcar(adres(4,18))
178  nomsou = motcar(adres(4,18))
179  ENDIF
180 !
181  nomgeo = motcar( adres(4, 5) )
182  nomfor = motcar( adres(4, 3) )
183  nomcas = motcar( adres(4, 4) )
184  nomlim = motcar( adres(4, 7) )
185  nomres = motcar( adres(4, 6) )
186  fformat = 'SERAFIN '
187  out_format = motcar( adres(4, 31) )(1:8)
188  nomfo1 = motcar( adres(4,15) )
189  infile = motcar( adres(4,24) )
190  outfile = motcar( adres(4,25) )
191  boundfile = motcar( adres(4,26) )
192  logfile = motcar( adres(4,27) )
193  outbndfile = motcar( adres(4,28) )
194  outlogfile = motcar( adres(4,29) )
195  nombnd2 = motcar( adres(4,30) )
196 !
197  std = motcar( adres(4,11))(1:3)
198  maille = motcar( adres(4,14))(1:9)
199  infmt = motcar( adres(4,22))(1:9)
200  outfmt = motcar( adres(4,23))(1:9)
201 !
202  fusion = .false.
203  IF (motcar(adres(4,15)).NE.' '.AND.maille.EQ.'SELAFIN')
204  & fusion = .true.
205 !
206 !-----------------------------------------------------------------------
207 ! VERIFICATION DES VALEURS LUES
208 !-----------------------------------------------------------------------
209 !
210  IF (fontri) nbfond = 1
211  IF (nbfond.GT.5) THEN
212  WRITE(lu,4000)
213  CALL plante(1)
214  stop
215  ENDIF
216 !
217  IF (std.NE.'IBM'.AND.std.NE.'I3E'.AND.std.NE.'STD') THEN
218  WRITE(lu,4100) std
219  CALL plante(1)
220  stop
221  ENDIF
222 !
223  IF (maille.NE.'SUPERTAB4'.AND.maille.NE.'SUPERTAB6'.AND.
224  & maille.NE.'SIMAIL' .AND.maille.NE.'SELAFIN' .AND.
225  & maille.NE.'TRIGRID' .AND.maille.NE.'MASTER2' .AND.
226  & maille.NE.'FASTTABS' .AND.maille.NE.'ADCIRC' ) THEN
227  WRITE(lu,4200) maille
228  CALL plante(1)
229  stop
230  ENDIF
231 !
232  IF (maille.EQ.'SUPERTAB4') THEN
233 ! INDICATEUR DE DEBUT DE LA LISTE DES POINTS DU MAILLAGE
234  nsec11 = 15
235  nsec12 = 0
236 ! INDICATEUR DE DEBUT DE LA LISTE DES IKLE
237  nsec2 = 71
238 ! INDICATEUR DE POSITION DU TITRE
239  nsec3 = 151
240  ELSEIF (maille.EQ.'SUPERTAB6') THEN
241 ! INDICATEUR DE DEBUT DE LA LISTE DES POINTS DU MAILLAGE
242 ! LECTURE EN SIMPLE PRECISION
243  nsec11 = 15
244 ! LECTURE EN DOUBLE PRECISION
245  nsec12 = 781
246 ! INDICATEUR DE DEBUT DE LA LISTE DES IKLE
247  nsec2 = 780
248 ! INDICATEUR DE POSITION DU TITRE
249  nsec3 = 151
250  ELSEIF (maille.EQ.'MASTER2') THEN
251 ! INDICATEUR DE DEBUT DE LA LISTE DES POINTS DU MAILLAGE
252  nsec11 = 0
253  nsec12 = 2411
254 ! INDICATEUR DE DEBUT DE LA LISTE DES IKLE
255  nsec2 = 2412
256 ! INDICATEUR DE POSITION DU TITRE
257  nsec3 = 151
258  ENDIF
259 !
260 !-----------------------------------------------------------------------
261 !
262  IF (elisec) THEN
263  IF (maille.NE.'SELAFIN') THEN
264  WRITE(lu,4300)
265  CALL plante(1)
266  stop
267  ENDIF
268  IF (nbfond.GT.0) THEN
269  WRITE(lu,4301)
270  CALL plante(1)
271  stop
272  ENDIF
273  IF (div4) THEN
274  WRITE(lu,4302)
275  CALL plante(1)
276  stop
277  ENDIF
278  div4 = .false.
279  fontri = .false.
280  optass = .false.
281  addfas = .false.
282  projex = .false.
283  ENDIF
284 !
285 !-----------------------------------------------------------------------
286 !
287 4000 FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||||',/,
288  & 1x,'LECDON . THE NUMBER OF BOTTOM TOPOGRAPHY FILES',/,
289  & 1x,' IS LIMITED TO 5 |',/,
290  & 1x,' (KEYWORD : BOTTOM TOPOGRAPHY FILE)',/,
291  & 1x,'||||||||||||||||||||||||||||||||||||||||||||||',//)
292 !
293 4100 FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||',/,
294  & 1x,'LECDON . UNKNOWN BINARY FILE STANDARD : ',a3,/,
295  & 1x,' (KEYWORD : BINARY FILE STANDARD)',/,
296  & 1x,'||||||||||||||||||||||||||||||||||||||||||||',//)
297 !
298 4200 FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||||',/,
299  & 1x,'LECDON . UNKNOWN TYPE OF MESH GENERATOR : ',a9,/,
300  & 1x,' (KEYWORD : MESH GENERATOR)',/,
301  & 1x,'||||||||||||||||||||||||||||||||||||||||||||||',//)
302  4300 FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||',/,
303  & 1x,'LECDON . THE DRY ELEMENTS ELIMINATION IS ONLY',/,
304  & 1x,'AVAILABLE WHEN USING SELAFIN FILE.',/,
305  & 1x,'||||||||||||||||||||||||||||||||||||||||||||',//)
306  4301 FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||',/,
307  & 1x,'LECDON . BATHYMETRY INTERPOLATION IMPOSSIBLE',/,
308  & 1x,'WHEN USING DRY ELEMENTS ELIMINATION.',/,
309  & 1x,'||||||||||||||||||||||||||||||||||||||||||||',//)
310  4302 FORMAT(//,1x,'||||||||||||||||||||||||||||||||||||||||||||',/,
311  & 1x,'LECDON . TRIANGLE CUTTING IMPOSSIBLE',/,
312  & 1x,'WHEN USING DRY ELEMENTS ELIMINATION.',/,
313  & 1x,'||||||||||||||||||||||||||||||||||||||||||||',//)
314 !
315 !-----------------------------------------------------------------------
316 !
317  RETURN
318  END
character(len=maxlenfile) nomcas
character(len=maxlenfile) outfile
character(len=8) fformat
character(len=9) maille
character(len=maxlenfile) boundfile
double precision seusec
integer, parameter maxkeyword
character(len=maxlenfile) outlogfile
character(len=maxlenfile) infile
double precision, dimension(10, 2) som2
character(len=maxlenfile) outbndfile
character(len=9) infmt
subroutine lecdon_stbtel
Definition: lecdon_stbtel.f:4
character(len=maxlenfile) nomgeo
character(len=maxlenfile) nomfor
character(len=8) out_format
double precision cortri
character(len=maxlenfile) nomfrc
character(len=maxlenfile) nomfon
double precision epsi
double precision, dimension(10, 2) som
subroutine damocles(ADRESS, DIMENS, NMAX, DOC, LLNG, LLU, MOTINT, MOTREA, MOTLOG, MOTCAR, MOTCLE, TROUVE, NFICMO, NFICDA, GESTD)
Definition: damocles.f:9
character(len=maxlenfile) nomsou
character(len=9) outfmt
character(len=maxlenfile) nomres
character(len=maxlenfile) nomimp
character(len=3) std
character(len=path_len), dimension(5) fond
character(len=maxlenfile) nomfo1
character(len=maxlenfile) nombnd2
character(len=maxlenfile) nomlim
character(len=maxlenfile) nomfo2
character(len=maxlenfile) logfile