The TELEMAC-MASCARET system  trunk
mycarlu.f
Go to the documentation of this file.
1 ! ***********************************
2  CHARACTER(LEN=PATH_LEN) FUNCTION mycarlu
3 ! ***********************************
4 !
5  &( lcar , icol , ligne , extrem , lgvar )
6 !
7 !***********************************************************************
8 ! DAMOCLES V7P0 21/08/2010
9 !***********************************************************************
10 !
11 !brief DECODES A CHARACTER STRING, FROM COLUMN ICOL+1 OF THE
12 !+ CURRENT LINE (MAXIMUM OF LGA CHARACTERS).
13 !+ IF THE STRING IS NOT COMPLETE, GOES TO THE NEXT LINE
14 !+ IF NEED BE.
15 !+ MOVES THE POINTER ICOL TO THE LAST DECODED CHARACTER
16 !+ OR TO ICOL=0 IF THE NEXT LINE WAS READ WITH NO REASON.
17 !
18 !note PORTABILITY : IBM,CRAY,HP,SUN
19 !
20 !warning FOLLOWS THE FORTRAN CONVENTION : '' IS READ AS
21 !+ ' WHEN WITHIN A CHARACTER STRING
22 !+
23 !warning STRINGS WITHOUT ' OR " CANNOT CONTAIN SEPARATOR
24 !+ CHARACTERS
25 !
26 !history O. QUIQUEMPOIX (LNH)
27 !+ 14/12/1993
28 !+
29 !+
30 !
31 !history J.M. HERVOUET (LNH); A. YESSAYAN
32 !+ 16/08/1994
33 !+ V5P1
34 !+
35 !
36 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
37 !+ 13/07/2010
38 !+ V6P0
39 !+ Translation of French comments within the FORTRAN sources into
40 !+ English comments
41 !
42 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
43 !+ 21/08/2010
44 !+ V6P0
45 !+ Creation of DOXYGEN tags for automated documentation and
46 !+ cross-referencing of the FORTRAN sources
47 !
48 !history J.M. HERVOUET (EDF R&D, LNHE)
49 !+ 31/12/2013
50 !+ V7P0
51 !+ Prints of LIGNED limited to maximum size LGVAR.
52 !
53 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
54 !| EXTREM |-->| SEPARATEUR DE CHAINE = ' OU "
55 !| ICOL |<->| POSITION COURANTE DU POINTEUR DANS LA LIGNE
56 !| LCAR |<--| LONGUEUR DE LA CHAINE DE CARACTERES
57 !| LGVAR |-->| LONGUEUR MAXIMUM DE LA CHAINE A LIRE
58 !| LIGNE |<->| LIGNE EN COURS DE DECODAGE
59 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
60 !
61  USE declarations_special
62  USE declarations_damocles
63  IMPLICIT NONE
64 !
65  INTEGER LCAR,ICOL,LGVAR
66  CHARACTER(LEN=*) LIGNE
67  CHARACTER(LEN=1) EXTREM
68 !
69  INTEGER NEXT,PRECAR,LONGLU
70  EXTERNAL next,precar,longlu
71 !
72 !
73 !-----------------------------------------------------------------------
74 !
75  INTEGER I,IDEB,IFIN,NCAR,ICOL2,NLIGN2,LGLU
76  INTEGER QCAS
77  LOGICAL COTE,LISUIV,LUFIC,LUCOTE
78  CHARACTER(LEN=1) QUOTE,TABUL
79  CHARACTER(LEN=72) LIGNE2
80  CHARACTER(LEN=PATH_LEN) LIGNED
81 !
82 !-----------------------------------------------------------------------
83 !
84 !
85  INTRINSIC char
86 !
87 !-----------------------------------------------------------------------
88 !
89 !
90 !***********************************************************************
91 ! RCS AND SCCS MARKING
92 !
93 !***********************************************************************
94 !
95  cote = .false.
96  lisuiv = .false.
97  lufic = .false.
98  lucote = .false.
99  lcar = 1
100  mycarlu = ' '
101  quote = ''''
102  tabul = char(9)
103  nlign2 = nlign
104  icol2 = icol
105  ligne2 = ligne(1:min(72,len(ligne)))
106  ligned = ' '
107  lglu = 0
108  qcas = 0
109 !
110  icol = next( icol+1 , ligne )
111 !
112 ! //// FINDS THE ENDS OF THE STRING ////
113 !
114 ! NOTE: THE STRING CAN BE BETWEEN QUOTES OR WITHOUT QUOTES
115 ! IT CANNOT CONTAIN WHITE CHARACTERS IF THERE ARE
116 ! NO QUOTES
117 !
118  IF ( ligne(icol:icol).NE.extrem ) THEN
119  ideb = icol
120 ! PRECAR : SAME ROLE AS PREVAL, EXCEPT IT DOES NOT
121 ! SKIP COMMENTED LINES
122  icol = precar( icol+1 , ligne , ' ' , ';' , tabul) - 1
123  ifin = icol
124  ligned = ligne(ideb:ifin)
125  lglu = ifin-ideb+1
126 !
127 ! STEERING FILE : GOES TO THE NEXT, WHEN GETS TO THE END OF A LINE
128 !
129 290 IF (ifin.GE.longli) THEN
130  lisuiv = .true.
131  lufic = .true.
132  READ(nfic,end=900,err=998,fmt='(A)') ligne2
133  icol2 = 0
134  IF (ligne2(1:1).EQ.'&'.OR.
135  & ligne2(1:1).EQ.'='.OR.ligne2(1:1).EQ.':'.OR.
136  & ligne2(1:1).EQ.';'.OR.ligne2(1:1).EQ.'/' ) THEN
137  lisuiv = .false.
138  GO TO 96
139  ENDIF
140 !
141 ! CHECKS IF IT'S A KNOWN KEYWORD FOR THE STEERING FILE
142 !
143 !
144 ! GETS TO THIS POINT IF/WHEN HAS TO READ THE NEXT LINE
145 !
146  icol2 =precar(1 , ligne2 , ' ' , tabul ,' ') - 1
147 !
148  lglu = lglu + icol2
149 !
150  IF(lglu.GT.lgvar) THEN
151  erreur = .true.
152  IF (longlu(ligned).GT.0) THEN
153  ligned = ligned(1:longlu(ligned))//ligne2(1:icol2)
154  ELSE
155  ligned = ligne2(1:icol2)
156  ENDIF
157  IF(lglu.GT.0) WRITE(lu,'(1X,A)')
158  & ligned(1:min(lglu,path_len))
159  WRITE(lu,*) ' '
160  WRITE(lu,'(1X,A5,I4,1X,A23)') 'LINE: ',nlign,
161  & 'ERROR : STRING TOO LONG'
162  icol = icol -1
163  GO TO 1000
164  ELSE
165 ! NEEDS TO READ ANOTHER LINE - SIMULATES A SHIFT OF LINE
166  lisuiv = .false.
167  ligne = ligne2
168  IF (longlu(ligned).GT.0) THEN
169  ligned = ligned(1:longlu(ligned))//ligne2(1:longli)
170  ELSE
171  ligned = ligne2(1:longli)
172  ENDIF
173  nlign = nlign2
174  icol = icol2
175  ifin = longli+1
176  GO TO 290
177  ENDIF
178  96 IF(lisuiv) THEN
179  IF(longlu(ligned).GT.0) THEN
180  ligned = ligned(1:longlu(ligned))//ligne2(1:icol2)
181  ELSE
182  ligned = ligne2(1:longli)
183  ENDIF
184  ifin = lglu+icol2
185  ideb = 1
186  ENDIF
187  ENDIF
188 !
189  GO TO 901
190  900 CONTINUE
191  retour = .true.
192  901 CONTINUE
193  DO i = 1 , lglu
194  IF (ligned(i:i).EQ.quote.OR.ligned(i:i).EQ.'&'.OR.
195  & ligned(i:i).EQ.'='.OR.ligned(i:i).EQ.':'.OR.
196  & ligned(i:i).EQ.'/') THEN
197  IF (nlign2.NE.nlign.AND.(.NOT.(lufic)))
198  & WRITE(lu,'(1X,A)') ligne2(1:longli)
199  IF (lglu.GT.0) WRITE(lu,'(1X,A)') ligned(1:lglu)
200  WRITE(lu,'(1X,A5,I4,A)') 'LINE: ',nlign,
201  & ' ERROR: UNEXPECTED CHARACTER IN A STRING WITHOUT QUOTES'
202  erreur = .true.
203  GO TO 1000
204  ENDIF
205  ENDDO ! I
206 !
207  ELSE
208 !
209 ! CASE WHERE THERE ARE QUOTES
210 !
211  ideb = icol + 1
212 !
213 ! THE 1ST QUOTE IS IN LAST POSITION (QCAS=4 OR QCAS=5)
214  IF (icol.EQ.longli) qcas=45
215 !
216  100 icol = precar( icol+1 , ligne , extrem , extrem , extrem )
217  IF (icol.EQ.longli) icol = longli+1
218 !
219 ! CASE WHERE DOUBLE QUOTES CAN BE FOUND IN THE 1ST LINE EXCEPT IN COLUMN 72
220 !
221  IF(icol.LT.longli) THEN
222  IF(ligne(icol+1:icol+1).EQ.extrem.AND.extrem.EQ.quote) THEN
223  icol = icol + 1
224 ! THE QUOTE IN 72 IS THE 2ND QUOTE OF A DOUBLE QUOTE (QCAS=3)
225  IF (icol.EQ.longli) qcas=3
226  cote = .true.
227  GO TO 100
228  ENDIF
229  ENDIF
230 !
231  lglu = max(0,icol-ideb)
232  IF (lglu.GT.0) ligned = ligne(ideb:icol-1)
233 !
234 ! HAS NOT FOUND THE END, OR A QUOTE WAS FOUND IN COLUMN 72
235 !
236  IF (icol.GT.longli) THEN
237 390 lisuiv = .true.
238  lufic = .true.
239  READ(nfic,end=905,err=998,fmt='(A)') ligne2
240 !
241 ! CASE WHERE THE PRECEDING LINE ENDS WITH A QUOTE
242 !
243  IF (ligne(longli:longli).EQ.quote) THEN
244 ! THE QUOTE IN COLUMN 72 STARTS A STRING, OR IS THE 2ND OF A DOUBLE QUOTE
245  IF (qcas.EQ.45.OR.qcas.EQ.3) THEN
246  qcas=0
247  ELSEIF (ligne2(1:1).EQ.quote) THEN
248  cote = .true.
249  lucote = .true.
250  qcas=0
251  ELSE
252  lglu=lglu-1
253  IF (lglu.GT.0) ligned = ligned(1:lglu)
254  lisuiv = .false.
255  qcas=0
256  GO TO 920
257  ENDIF
258  ENDIF
259 !
260  icol2 = 0
261  IF(ligne2(1:1).EQ.quote.AND.lucote) THEN
262  lucote = .false.
263  icol2=1
264  ENDIF
265  110 icol2 =precar(icol2+1,ligne2,extrem,extrem,extrem)
266  IF(icol2.LT.longli) THEN
267  IF(ligne2(icol2+1:icol2+1).EQ.
268  & extrem.AND.extrem.EQ.quote) THEN
269 ! ICOL2 = PRECAR(ICOL2+1,LIGNE2,EXTREM,EXTREM,EXTREM)
270  icol2=icol2+1
271  cote=.true.
272  IF (icol2.EQ.longli) qcas=3
273  GO TO 110
274  ENDIF
275  ENDIF
276  IF(icol2.EQ.longli) icol2=icol2+1
277  IF(lglu.GT.0) THEN
278  ligned = ligned(1:lglu)//ligne2(1:icol2-1)
279  ELSE
280  ligned = ligne2(1:icol2-1)
281  ENDIF
282  lglu = lglu + icol2-1
283 !
284  IF(lglu.GT.lgvar) GO TO 910
285 !
286 ! GOES TO NEXT LINE IF NOT COMPLETE, OR IF HAS FOUND A QUOTE IN 72
287 !
288  IF(icol2.GE.longli) THEN
289  lisuiv = .false.
290  ligne = ligne2
291  nlign = nlign2
292  icol = icol2
293  ifin = icol2
294  GO TO 390
295  ENDIF
296 ! HERE IT'S OK
297  GO TO 920
298 !
299  905 CONTINUE
300  retour = .true.
301 !
302  910 CONTINUE
303  WRITE(lu,'(1X,A)') ligned(1:max(1,min(lglu,lgvar)))
304  WRITE(lu,*)
305  WRITE(lu,'(1X,A5,I4,A)') 'LINE: ',nlign,
306  & ' ERROR: QUOTE MISSING AT THE END OF THE STRING'
307  WRITE(lu,*)'OR STRING TOO LONG ... '
308  erreur = .true.
309  icol = longli
310  GO TO 1000
311 !
312  ENDIF
313  ifin = icol - 1
314  ENDIF
315 !
316  920 CONTINUE
317  IF(lglu.NE.0) THEN
318  lcar = min(lglu,lgvar)
319  mycarlu = ligned(1:lglu)
320  ENDIF
321 !
322 ! CHANGES DOUBLE QUOTES WITH SIMPLE QUOTES
323 !
324  IF(cote) THEN
325  ncar = lcar
326  i = 1
327  200 CONTINUE
328  IF(i.GT.ncar) THEN
329  lcar = ncar
330  GO TO 1000
331  ENDIF
332  IF(mycarlu(i:i).EQ.quote.AND.mycarlu(i+1:i+1).EQ.quote) THEN
333  mycarlu(i+1:lcar) = mycarlu(i+2:lcar)//' '
334  ncar = ncar - 1
335  ENDIF
336  i = i + 1
337  GO TO 200
338  ENDIF
339 !
340 1000 CONTINUE
341 !
342  IF (lufic) THEN
343  nlign = nlign + 1
344  ligne = ligne2
345  IF (lisuiv) THEN
346  icol = icol2
347  ELSE
348  icol = 0
349  ENDIF
350  ENDIF
351 !
352 !-----------------------------------------------------------------------
353 !
354  RETURN
355 !
356 998 CONTINUE
357  WRITE(lu,1999) nfic,nlign+1
358 1999 FORMAT(1x,'LOGICAL UNIT ',1i2,' ERROR LINE ',1i6)
359  retour = .true.
360  RETURN
361 !
362 !-----------------------------------------------------------------------
363 !
364  END
declarations_special
Definition: declarations_special.F:3
declarations_special::lu
integer lu
Definition: declarations_special.F:45
declarations_damocles::retour
logical retour
Definition: declarations_damocles.f:28
declarations_damocles::nlign
integer nlign
Definition: declarations_damocles.f:30
declarations_damocles::nfic
integer nfic
Definition: declarations_damocles.f:33
mycarlu
character(len=path_len) function mycarlu(LCAR, ICOL, LIGNE, EXTREM, LGVAR)
Definition: mycarlu.f:7
declarations_special::path_len
integer, parameter path_len
Definition: declarations_special.F:41
declarations_damocles::longli
integer longli
Definition: declarations_damocles.f:31
declarations_damocles::erreur
logical erreur
Y. AUDOUIN (EDF LAB, LNHE) 09/05/2014 V7P0 First version.
Definition: declarations_damocles.f:27
declarations_damocles
Definition: declarations_damocles.f:3
Generated on Tue Jan 5 2021 14:38:02 for The TELEMAC-MASCARET system by doxygen 1.8.13