Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / convlo2up.f90
1 !     ######spl
2       MODULE MODI_CONVLO2UP
3 !     #####################
4 !
5 INTERFACE
6 !
7 SUBROUTINE CONVLO2UP(HCARIN,HCAROUT)
8 CHARACTER(LEN=*) :: HCARIN
9 CHARACTER(LEN=*) :: HCAROUT
10 END SUBROUTINE CONVLO2UP
11 !
12 END INTERFACE
13 !
14 END MODULE MODI_CONVLO2UP
15 !     ######spl
16       SUBROUTINE CONVLO2UP(HCARIN,HCAROUT)
17 !     ####################################
18 !
19 !!****  *CONVLO2UP* - 
20 !!
21 !!    PURPOSE
22 !!    -------
23 !      
24 !
25 !!**  METHOD
26 !!    ------
27 !!     
28 !!     N.A.
29 !!
30 !!    EXTERNAL
31 !!    --------
32 !!      None
33 !!
34 !!    IMPLICIT ARGUMENTS
35 !!    ------------------
36 !!      Module
37 !!
38 !!    REFERENCE
39 !!    ---------
40 !!
41 !!
42 !!    AUTHOR
43 !!    ------
44 !!      J. Duron    * Laboratoire d'Aerologie *
45 !!
46 !!
47 !!    MODIFICATIONS
48 !!    -------------
49 !!      Original       06/06/94
50 !!      Updated   PM   02/12/94
51 !-------------------------------------------------------------------------------
52 !
53 !*       0.    DECLARATIONS
54 !              ------------
55 !
56 USE MODD_FILES_DIACHRO
57 USE MODD_ALLOC_FORDIACHRO
58
59 IMPLICIT NONE
60 !
61 !*       0.1   Dummy arguments
62 !              ---------------
63
64 CHARACTER(LEN=*) :: HCARIN
65 CHARACTER(LEN=*) :: HCAROUT
66 !
67 !*       0.1   Local variables
68 !              ---------------
69
70 !
71 CHARACTER(LEN=LEN_TRIM(HCARIN)) :: YCARIN
72 CHARACTER(LEN=1),DIMENSION(26),SAVE  :: YLO=(/'a','b','c','d','e','f','g', &
73  'h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z'/)
74 CHARACTER(LEN=1),DIMENSION(26),SAVE  :: YUP=(/'A','B','C','D','E','F','G', & 
75  'H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/)
76 INTEGER   ::   ILENC
77 INTEGER   ::   INDCAR
78 INTEGER   ::   INDTIT, INDPVMIN, INDPVMAX, INDFTMIN, INDFTMAX 
79 INTEGER   ::   INDPVKTMIN, INDPVKTMAX
80 INTEGER   ::   INDISOMIN, INDISOMAX, INDDIAINT, INDISOREF
81 INTEGER   ::   INDFT1MIN, INDFT1MAX, INDISOLEV
82                
83 INTEGER   ::   J, JA, IBEG, IEND, JJ
84 !------------------------------------------------------------------------------
85 !
86 NBGUIL=0
87 HCAROUT(1:LEN(HCAROUT))=' '
88 YCARIN = HCARIN
89 ILENC = LEN(YCARIN)
90 !print *,' HCARIN ',LEN(HCARIN)
91 !print *,HCARIN
92 DO J=1,ILENC
93   DO JA=1,26
94     IF(YCARIN(J:J) == YLO(JA))YCARIN(J:J)=YUP(JA)
95   ENDDO
96 ENDDO
97 !print *,' YCARIN ',YCARIN
98 INDCAR=INDEX(YCARIN,'CSYMCAR')
99 IF(INDCAR /= 0)THEN
100   IF(YCARIN(INDCAR:INDCAR+6)=='CSYMCAR')THEN
101     HCARIN(INDCAR:INDCAR+6)=YCARIN(INDCAR:INDCAR+6)
102     HCAROUT=HCARIN
103     HCAROUT=ADJUSTL(HCAROUT)
104     RETURN
105   ENDIF
106 ENDIF
107 INDCAR=INDEX(YCARIN,'CNOMCAR')
108 IF(INDCAR /= 0)THEN
109   IF(YCARIN(INDCAR:INDCAR+6)=='CNOMCAR')THEN
110     HCARIN(INDCAR:INDCAR+6)=YCARIN(INDCAR:INDCAR+6)
111     HCAROUT=HCARIN
112     HCAROUT=ADJUSTL(HCAROUT)
113     RETURN
114   ENDIF
115 ENDIF
116
117 INDTIT=INDEX(YCARIN,'CTIT')
118
119 IF(INDTIT /= 0)THEN
120
121 IF(YCARIN(INDTIT:INDTIT+5)=='CTITT1' .OR. YCARIN(INDTIT:INDTIT+5)=='CTITT2'.OR.&
122    YCARIN(INDTIT:INDTIT+5)=='CTITT3' .OR. YCARIN(INDTIT:INDTIT+5)=='CTITB1'.OR.&
123    YCARIN(INDTIT:INDTIT+5)=='CTITB2' .OR. YCARIN(INDTIT:INDTIT+5)=='CTITB3'.OR.&
124    YCARIN(INDTIT:INDTIT+5)=='CTITYT' .OR. YCARIN(INDTIT:INDTIT+5)=='CTITYM'.OR.&
125    YCARIN(INDTIT:INDTIT+5)=='CTITYB' .OR. YCARIN(INDTIT:INDTIT+5)=='CTITXL'.OR.&
126    YCARIN(INDTIT:INDTIT+5)=='CTITXM' .OR. YCARIN(INDTIT:INDTIT+5)=='CTITXR')THEN
127 !print *,' HCARIN ',HCARIN
128    HCARIN(INDTIT:INDTIT+5)=YCARIN(INDTIT:INDTIT+5)
129 !  HCAROUT=ADJUSTL(HCARIN)
130    HCAROUT=HCARIN
131    HCAROUT=ADJUSTL(HCAROUT)
132 !print *,' HCARIN ',HCARIN
133 !print *,' HCAROUT ',HCAROUT
134    RETURN
135 ENDIF
136 IF(YCARIN(INDTIT:INDTIT+7)=='CTITVAR1' .OR. YCARIN(INDTIT:INDTIT+7)=='CTITVAR2'.OR.&
137    YCARIN(INDTIT:INDTIT+7)=='CTITVAR3' .OR. YCARIN(INDTIT:INDTIT+7)=='CTITVAR4'.OR.&
138    YCARIN(INDTIT:INDTIT+7)=='CTITVAR5' .OR. YCARIN(INDTIT:INDTIT+7)=='CTITVAR6'.OR.&
139    YCARIN(INDTIT:INDTIT+7)=='CTITVAR7' .OR. YCARIN(INDTIT:INDTIT+7)=='CTITVAR8')THEN
140 !print *,' HCARIN ',HCARIN
141    HCARIN(INDTIT:INDTIT+7)=YCARIN(INDTIT:INDTIT+7)
142 !  HCAROUT=ADJUSTL(HCARIN)
143    HCAROUT=HCARIN
144    HCAROUT=ADJUSTL(HCAROUT)
145 !print *,' HCARIN ',HCARIN
146 !print *,' HCAROUT ',HCAROUT
147    RETURN
148 ENDIF
149
150 ENDIF
151 !
152 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
153 INDTIT=INDEX(YCARIN,'CFT1TIT')
154 !
155 IF(INDTIT /= 0)THEN
156 !
157 IF(YCARIN(INDTIT:INDTIT+7)=='CFT1TIT1' .OR. YCARIN(INDTIT:INDTIT+7)=='CFT1TIT2'.OR.&
158    YCARIN(INDTIT:INDTIT+7)=='CFT1TIT3' .OR. YCARIN(INDTIT:INDTIT+7)=='CFT1TIT4'.OR.&
159    YCARIN(INDTIT:INDTIT+7)=='CFT1TIT5' .OR. YCARIN(INDTIT:INDTIT+7)=='CFT1TIT6'.OR.&
160    YCARIN(INDTIT:INDTIT+7)=='CFT1TIT7' .OR. YCARIN(INDTIT:INDTIT+7)=='CFT1TIT8'.OR.&
161    YCARIN(INDTIT:INDTIT+7)=='CFT1TIT9')THEN
162
163    HCARIN(INDTIT:INDTIT+7)=YCARIN(INDTIT:INDTIT+7)
164    HCAROUT=HCARIN
165    HCAROUT=ADJUSTL(HCAROUT)
166 !print *,' HCARIN ',HCARIN
167 !print *,' HCAROUT ',HCAROUT
168    RETURN
169 ENDIF
170 IF(YCARIN(INDTIT:INDTIT+8)=='CFT1TIT10'.OR.&
171    YCARIN(INDTIT:INDTIT+8)=='CFT1TIT11' .OR. YCARIN(INDTIT:INDTIT+8)=='CFT1TIT12' .OR. &
172    YCARIN(INDTIT:INDTIT+8)=='CFT1TIT13' .OR. YCARIN(INDTIT:INDTIT+8)=='CFT1TIT14' .OR. &
173    YCARIN(INDTIT:INDTIT+8)=='CFT1TIT15' )THEN
174
175    HCARIN(INDTIT:INDTIT+8)=YCARIN(INDTIT:INDTIT+8)
176    HCAROUT=HCARIN
177    HCAROUT=ADJUSTL(HCAROUT)
178 !print *,' HCARIN ',HCARIN
179 !print *,' HCAROUT ',HCAROUT
180    RETURN
181 ENDIF
182 !
183 ENDIF
184 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
185 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
186 INDTIT=INDEX(YCARIN,'CVARNPV')
187 !
188 IF(INDTIT /= 0)THEN
189 !
190 IF(YCARIN(INDTIT:INDTIT+7)=='CVARNPV1' .OR. YCARIN(INDTIT:INDTIT+7)=='CVARNPV2'.OR.&
191    YCARIN(INDTIT:INDTIT+7)=='CVARNPV3' .OR. YCARIN(INDTIT:INDTIT+7)=='CVARNPV4'.OR.&
192    YCARIN(INDTIT:INDTIT+7)=='CVARNPV5' .OR. YCARIN(INDTIT:INDTIT+7)=='CVARNPV6'.OR.&
193    YCARIN(INDTIT:INDTIT+7)=='CVARNPV7' .OR. YCARIN(INDTIT:INDTIT+7)=='CVARNPV8'.OR.&
194    YCARIN(INDTIT:INDTIT+7)=='CVARNPV9')THEN
195
196    HCARIN(INDTIT:INDTIT+7)=YCARIN(INDTIT:INDTIT+7)
197    HCAROUT=HCARIN
198    HCAROUT=ADJUSTL(HCAROUT)
199 !print *,' HCARIN ',HCARIN
200 !print *,' HCAROUT ',HCAROUT
201    RETURN
202 ENDIF
203 IF(YCARIN(INDTIT:INDTIT+8)=='CVARNPV10'.OR.&
204    YCARIN(INDTIT:INDTIT+8)=='CVARNPV11' .OR. YCARIN(INDTIT:INDTIT+8)=='CVARNPV12' .OR. &
205    YCARIN(INDTIT:INDTIT+8)=='CVARNPV13' .OR. YCARIN(INDTIT:INDTIT+8)=='CVARNPV14' .OR. &
206    YCARIN(INDTIT:INDTIT+8)=='CVARNPV15' )THEN
207
208    HCARIN(INDTIT:INDTIT+8)=YCARIN(INDTIT:INDTIT+8)
209    HCAROUT=HCARIN
210    HCAROUT=ADJUSTL(HCAROUT)
211 !print *,' HCARIN ',HCARIN
212 !print *,' HCAROUT ',HCAROUT
213    RETURN
214 ENDIF
215 !
216 ENDIF
217 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
218 INDTIT=INDEX(YCARIN,'CVARNPH')
219 !
220 IF(INDTIT /= 0)THEN
221 !
222 IF(YCARIN(INDTIT:INDTIT+7)=='CVARNPH1' .OR. YCARIN(INDTIT:INDTIT+7)=='CVARNPH2'.OR.&
223    YCARIN(INDTIT:INDTIT+7)=='CVARNPH3' .OR. YCARIN(INDTIT:INDTIT+7)=='CVARNPH4'.OR.&
224    YCARIN(INDTIT:INDTIT+7)=='CVARNPH5' .OR. YCARIN(INDTIT:INDTIT+7)=='CVARNPH6'.OR.&
225    YCARIN(INDTIT:INDTIT+7)=='CVARNPH7' .OR. YCARIN(INDTIT:INDTIT+7)=='CVARNPH8')THEN
226
227    HCARIN(INDTIT:INDTIT+7)=YCARIN(INDTIT:INDTIT+7)
228    HCAROUT=HCARIN
229    HCAROUT=ADJUSTL(HCAROUT)
230    RETURN
231 ENDIF
232 ENDIF
233 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
234 !
235 INDPVMIN=INDEX(YCARIN,'XPVMIN_')
236 IF(INDPVMIN /= 0)THEN
237 ! HCARIN(INDPVMIN:INDPVMIN+6)=YCARIN(INDPVMIN:INDPVMIN+6)
238   DO J=INDPVMIN+6,ILENC
239     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
240       YCARIN(INDPVMIN+6:J)=HCARIN(INDPVMIN+6:J)
241       EXIT
242     ENDIF
243   ENDDO
244 ENDIF
245 INDFTMIN=INDEX(YCARIN,'XFTMIN_')
246 IF(INDFTMIN /= 0)THEN
247 ! HCARIN(INDFTMIN:INDFTMIN+6)=YCARIN(INDFTMIN:INDFTMIN+6)
248   DO J=INDFTMIN+6,ILENC
249     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
250       YCARIN(INDFTMIN+6:J)=HCARIN(INDFTMIN+6:J)
251       EXIT
252     ENDIF
253   ENDDO
254 ENDIF
255 INDFT1MIN=INDEX(YCARIN,'XFT1MIN_')
256 IF(INDFT1MIN /= 0)THEN
257 ! HCARIN(INDFT1MIN:INDFT1MIN+7)=YCARIN(INDFT1MIN:INDFT1MIN+7)
258   DO J=INDFT1MIN+7,ILENC
259     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
260       YCARIN(INDFT1MIN+7:J)=HCARIN(INDFT1MIN+7:J)
261       EXIT
262     ENDIF
263   ENDDO
264 ENDIF
265 INDPVKTMIN=INDEX(YCARIN,'XPVKTMIN_')
266 IF(INDPVKTMIN /= 0)THEN
267 ! HCARIN(INDPVKTMIN:INDPVKTMIN+8)=YCARIN(INDPVKTMIN:INDPVKTMIN+8)
268   DO J=INDPVKTMIN+8,ILENC
269     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
270       YCARIN(INDPVKTMIN+8:J)=HCARIN(INDPVKTMIN+8:J)
271       EXIT
272     ENDIF
273   ENDDO
274 ENDIF
275 INDPVMAX=INDEX(YCARIN,'XPVMAX_')
276 IF(INDPVMAX /= 0)THEN
277 ! HCARIN(INDPVMAX:INDPVMAX+6)=YCARIN(INDPVMAX:INDPVMAX+6)
278   DO J=INDPVMAX+6,ILENC
279     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
280       YCARIN(INDPVMAX+6:J)=HCARIN(INDPVMAX+6:J)
281       EXIT
282     ENDIF
283   ENDDO
284 ENDIF
285 INDFTMAX=INDEX(YCARIN,'XFTMAX_')
286 IF(INDFTMAX /= 0)THEN
287 ! HCARIN(INDFTMAX:INDFTMAX+6)=YCARIN(INDFTMAX:INDFTMAX+6)
288   DO J=INDFTMAX+6,ILENC
289     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
290       YCARIN(INDFTMAX+6:J)=HCARIN(INDFTMAX+6:J)
291       EXIT
292     ENDIF
293   ENDDO
294 ENDIF
295 INDFT1MAX=INDEX(YCARIN,'XFT1MAX_')
296 IF(INDFT1MAX /= 0)THEN
297 ! HCARIN(INDFT1MAX:INDFT1MAX+7)=YCARIN(INDFT1MAX:INDFT1MAX+7)
298   DO J=INDFT1MAX+7,ILENC
299     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
300       YCARIN(INDFT1MAX+7:J)=HCARIN(INDFT1MAX+7:J)
301       EXIT
302     ENDIF
303   ENDDO
304 ENDIF
305 INDPVKTMAX=INDEX(YCARIN,'XPVKTMAX_')
306 IF(INDPVKTMAX /= 0)THEN
307 ! HCARIN(INDPVKTMAX:INDPVKTMAX+8)=YCARIN(INDPVKTMAX:INDPVKTMAX+8)
308   DO J=INDPVKTMAX+8,ILENC
309     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
310       YCARIN(INDPVKTMAX+8:J)=HCARIN(INDPVKTMAX+8:J)
311       EXIT
312     ENDIF
313   ENDDO
314 ENDIF
315 INDISOMIN=INDEX(YCARIN,'XISOMIN_')
316 IF(INDISOMIN /= 0)THEN
317 ! HCARIN(INDISOMIN:INDISOMIN+7)=YCARIN(INDISOMIN:INDISOMIN+7)
318   DO J=INDISOMIN+7,ILENC
319     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
320       YCARIN(INDISOMIN+7:J)=HCARIN(INDISOMIN+7:J)
321       EXIT
322     ENDIF
323   ENDDO
324 ENDIF
325 INDISOMAX=INDEX(YCARIN,'XISOMAX_')
326 IF(INDISOMAX /= 0)THEN
327 ! HCARIN(INDISOMAX:INDISOMAX+7)=YCARIN(INDISOMAX:INDISOMAX+7)
328   DO J=INDISOMAX+7,ILENC
329     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
330       YCARIN(INDISOMAX+7:J)=HCARIN(INDISOMAX+7:J)
331       EXIT
332     ENDIF
333   ENDDO
334 ENDIF
335 INDDIAINT=INDEX(YCARIN,'XDIAINT_')
336 IF(INDDIAINT /= 0)THEN
337 ! HCARIN(INDDIAINT:INDDIAINT+7)=YCARIN(INDDIAINT:INDDIAINT+7)
338   DO J=INDDIAINT+7,ILENC
339     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
340       YCARIN(INDDIAINT+7:J)=HCARIN(INDDIAINT+7:J)
341       EXIT
342     ENDIF
343   ENDDO
344 ENDIF
345 INDISOREF=INDEX(YCARIN,'XISOREF_')
346 IF(INDISOREF /= 0)THEN
347   DO J=INDISOREF+7,ILENC
348     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
349       YCARIN(INDISOREF+7:J)=HCARIN(INDISOREF+7:J)
350       EXIT
351     ENDIF
352   ENDDO
353 ENDIF
354 INDISOLEV=INDEX(YCARIN,'XISOLEV_')
355 IF(INDISOLEV /= 0)THEN
356   DO J=INDISOLEV+7,ILENC
357     IF(HCARIN(J:J) == ' ' .OR. HCARIN(J:J) == '=')THEN
358       YCARIN(INDISOLEV+7:J)=HCARIN(INDISOLEV+7:J)
359       EXIT
360     ENDIF
361   ENDDO
362 ENDIF
363 IF(INDPVMIN + INDPVMAX + INDFTMIN + INDFTMAX + INDPVKTMIN + &
364    INDPVKTMAX  + INDISOMIN + INDISOMAX + INDDIAINT + INDISOREF + &
365    INDFT1MIN + INDFT1MAX + INDISOLEV /= 0)THEN
366 !  HCAROUT=ADJUSTL(YCARIN)
367    HCAROUT=YCARIN
368    HCAROUT=ADJUSTL(HCAROUT)
369   RETURN
370 ENDIF
371
372 YCARIN = HCARIN
373
374 !print *,' YCARIN ILENC ',ILENC,YCARIN
375
376 NBGUIL=0
377
378 DO J = 1,ILENC
379   IF(YCARIN(J:J) == '"')THEN
380     NBGUIL=NBGUIL+1
381     NMGUIL(NBGUIL)=J
382   ENDIF
383   IF(YCARIN(J:J) == "'")THEN
384     NBGUIL=NBGUIL+1
385     NMGUIL(NBGUIL)=J
386   ENDIF
387 ENDDO
388 IF(MOD(NBGUIL,2) /= 0)THEN
389   print *,' NB DE GUILLEMETS ET(/OU) DE QUOTES IMPAIR. VERIFIEZ LA SYNTAXE DE VOS', &
390   ' INSTRUCTIONS D ENTREE'
391   LPBREAD=.TRUE.
392   RETURN
393 ! STOP
394 ENDIF
395 NMGUIL(NBGUIL+1)=ILENC+1
396 !
397 DO J=1,NBGUIL+1,2
398   IF(J == 1)THEN
399     IBEG=1
400     IEND=NMGUIL(J)-1
401   ELSE IF(J == NBGUIL+1)THEN
402     IBEG=MIN(NMGUIL(J-1)+1,ILENC)
403     IEND=ILENC
404   ELSE
405     IBEG=NMGUIL(J-1)+1
406     IEND=NMGUIL(J)-1
407   END IF
408 ! print *,' ibeg iend ilenc ycarin ',ibeg,iend,ilenc
409 ! print *,ycarin(ibeg:iend)
410 DO JJ=IBEG,IEND
411   DO JA=1,26
412     IF(YCARIN(JJ:JJ) == YLO(JA))YCARIN(JJ:JJ)=YUP(JA)
413   ENDDO
414 ENDDO
415 ENDDO
416 !HCAROUT=ADJUSTL(YCARIN)
417 HCAROUT=YCARIN
418 HCAROUT=ADJUSTL(HCAROUT)
419 !
420 !-----------------------------------------------------------------------------
421 !
422 !*       2.       EXITS
423 !                 -----
424
425 !print *,' ** sortie convlo2up'
426 RETURN
427 END SUBROUTINE CONVLO2UP