Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / extract_and_open_files.f90
1 !     ######spl
2       MODULE MODI_EXTRACT_AND_OPEN_FILES
3 !     ##################################
4 !
5 INTERFACE
6 !
7 SUBROUTINE EXTRACT_AND_OPEN_FILES(HCARIN,HCAROUT)
8 CHARACTER(LEN=*)    :: HCARIN
9 CHARACTER(LEN=*)    :: HCAROUT
10 END SUBROUTINE EXTRACT_AND_OPEN_FILES
11 !
12 END INTERFACE
13 !
14 END MODULE MODI_EXTRACT_AND_OPEN_FILES
15 !     ######spl
16       SUBROUTINE EXTRACT_AND_OPEN_FILES(HCARIN,HCAROUT)
17 !     #################################################
18 !
19 !!****  *EXTRACT_AND_OPEN_FILES* - 
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 ! NBGUIL
57 USE MODD_ALLOC_FORDIACHRO
58 USE MODD_RESOLVCAR
59 USE MODD_PARAMETERS,ONLY:JPHEXT
60 !USE MODD_DIM1
61 !USE MODN_PARA
62 !USE MODN_NCAR
63 USE MODI_CREATLINK
64 USE MODI_FMREAD
65 !
66 IMPLICIT NONE
67 !
68 !*       0.1   Dummy arguments
69 !              ---------------
70 !
71 CHARACTER(LEN=*)    :: HCARIN
72 CHARACTER(LEN=*)    :: HCAROUT
73 !
74 !*       0.1   Local variables
75 !              ---------------
76
77 !
78 CHARACTER(LEN=LEN_TRIM(HCARIN)) :: YCARIN
79 CHARACTER(LEN=28) :: YNAMFILE,YDUMMYFILE
80 CHARACTER(LEN=32) :: YDESFM   
81 CHARACTER(LEN=1)  :: YC1
82 CHARACTER(LEN=2)  :: YC2
83 INTEGER   ::   ILENC
84 INTEGER   ::   INCR, INDFI, INDQUI, IDIF, INDFIS, INDON
85 INTEGER   ::   ILUDES, IRESP, INUMFILECUR
86 INTEGER   ::   J, JJ, JM, JMM, JA, JME
87 INTEGER,DIMENSION(13),SAVE             :: IASF
88
89 INTEGER   ::   ISTA, IER, INB, IWK
90 INTEGER   ::   ILU, INUM, IRESP2
91 LOGICAL   ::   GPLUS
92 !INTEGER           :: IIINF, IJINF, IISUP, IJSUP
93 !REAL              :: ZIDEBCOU, ZJDEBCOU
94 CHARACTER(LEN=20) :: YCOMMENT
95 INTEGER           ::  ILENCH,ILENG,IGRID
96 !------------------------------------------------------------------------------
97 !
98 YCARIN = HCARIN
99 if(nverbia >0)then
100   print *,' ENTREE EXTRACT LEN et YCARIN ',LEN(YCARIN),YCARIN
101 ! print *,' ENTREE EXTRACT HCAROUT ',HCAROUT
102 endif
103 ILENC = LEN(YCARIN)
104 ! En cas de superpositions ou presence _MINUS_ , on ne traite pas immediatement
105 INDON=INDEX(YCARIN,'_ON_')
106 IF(INDON == 0)THEN
107   INDON=INDEX(YCARIN,'_MINUS_')
108 ENDIF
109 IF(INDON == 0)THEN
110   INDON=INDEX(YCARIN,'_PLUS_')
111 ENDIF
112 IF(INDON /= 0)THEN
113   HCAROUT(1:LEN(HCAROUT))=' '
114   HCAROUT=YCARIN
115   HCAROUT=ADJUSTL(HCAROUT)
116 !print *,' PRESENCE _ON_ HCAROUT ',HCAROUT
117 !print *,' YCARIN ',YCARIN(1:LEN_TRIM(YCARIN))
118   RETURN
119 ENDIF
120 !
121 HCAROUT(1:LEN(HCAROUT))=' '
122 !print *,' HCARIN ',LEN(HCARIN)
123 !print *,' YCARIN ILENC ',ILENC,YCARIN
124 !
125 ! Extraction des noms de fichiers
126 !
127 ! Absence nom de fichier mais presence chaine _FILEx_ ou _FILExx_
128 !
129 if(nverbia >0)then
130  print *,' ** EXTRACT NBGUILlemets= ',NBGUIL
131 endif
132 IF(NBGUIL == 0)THEN
133   INDQUI=0
134   INDQUI=INDEX(YCARIN,'_QUIT')
135   IF(INDQUI == 0)THEN
136     INDQUI=INDEX(YCARIN,'QUIT')
137   ENDIF
138   IF(INDQUI /= 0)THEN
139 ! Fermeture des fichiers et arret du programme    
140 ! Inutile pour les fichiers FM ouverts en lecture
141     !DO J=1,NBFILES
142       !CALL FMCLOS(CFILEDIAS(J),'KEEP',CLUOUTDIAS(J),NRESPDIAS(J))
143       ! plante car le .des est deja ferme
144     !ENDDO
145     YDUMMYFILE=''
146     CALL CREATLINK(' ',YDUMMYFILE,'CLEAN',NVERBIA)
147     CALL FMLOOK('FICVAL','FICVAL',ILU,IRESP2)
148     IF(IRESP2 == 0)THEN
149       CLOSE(ILU)
150     ENDIF
151     CALL SFLUSH
152     CALL GQOPS(ISTA)
153     ! INB donne le nombre de stations ouvertes
154     ! Eventuellement on ferme la WISS N9
155     CALL GQOPWK(1,IER,INB,IWK)
156 if(nverbia >0)then
157  print *,' ** EXTRACT nb de stations ouvertes INB= ',INB
158 endif
159     IF(INB >1)THEN
160       DO JJ=1,INB
161         CALL GQOPWK(JJ,IER,INB,IWK)
162         IF(IWK == 9)THEN
163           CALL GCLWK(9)
164           EXIT
165         ENDIF
166       ENDDO
167     ENDIF
168     ! INB donne le nombre de stations actives
169     CALL GQACWK(1,IER,INB,IWK)
170 if(nverbia >0)then
171  print *,' ** EXTRACT nb de stations actives INB= ',INB
172 endif
173     IF(ISTA >1 .AND. INB > 1)THEN
174       CALL GDAWK(2)
175       CALL GCLWK(2)
176     ENDIF
177 ! CALL FRAME
178     CALL NGPICT(1,1)
179     CALL CLSGKS
180 if(nverbia >0)then
181  print *,' ** EXTRACT AV RETURN'
182 endif
183     RETURN
184   ENDIF     ! fin de 'QUIT'
185   !
186   INDFI=0
187   INDFI=INDEX(YCARIN,'_FILE')
188   INUMFILECUR=NUMFILECUR
189   IF(INDFI /= 0)THEN
190     INDFIS=0
191 ! On reutilise un fichier deja ouvert; on renvoit l'instruction sans la chaine
192 ! _FILEx_ ou _FILExx_; on positionne le numero du fichier courant
193 ! Cas numero suivant _FILE a 1 chiffre
194     IF(YCARIN(INDFI+6:INDFI+6) == '_')THEN
195       READ(YCARIN(INDFI+5:INDFI+5),'(I1)')NUMFILECUR
196 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
197 !     HCAROUT(1:INDFI-1)=YCARIN(1:INDFI-1)
198 !     HCAROUT(INDFI:ILENC-7)=YCARIN(INDFI+7:ILENC)
199       HCAROUT(1:ILENC)=YCARIN(1:ILENC)
200       INDFIS=MIN(INDFI+6+1,ILENC)
201 ! Cas numero suivant _FILE a 2 chiffres
202     ELSE IF(YCARIN(INDFI+7:INDFI+7) == '_')THEN
203       READ(YCARIN(INDFI+5:INDFI+6),'(I2)')NUMFILECUR
204 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
205 !     HCAROUT(1:INDFI-1)=YCARIN(1:INDFI-1)
206 !     HCAROUT(INDFI:ILENC-8)=YCARIN(INDFI+8:ILENC)
207       HCAROUT(1:ILENC)=YCARIN(1:ILENC)
208       INDFIS=MIN(INDFI+7+1,ILENC)
209     ENDIF
210     
211     JME=0
212     DO JA=1,NBFILES
213       IF(NUMFILES(JA) == NUMFILECUR)THEN
214         JME=JA
215       ENDIF
216     ENDDO
217     IF(JME==0) THEN
218       PRINT*,'*PB avec la directive:'
219       PRINT*,'  _file',NUMFILECUR,'_ n est pas associe a un nom de fichier'
220       LPBREAD=.TRUE.
221       RETURN
222     ENDIF
223
224 !   IIINF=NIINF; IJINF=NJINF; IISUP=NISUP; IJSUP=NJSUP
225 !   ZIDEBCOU=XIDEBCOU; ZJDEBCOU=XJDEBCOU
226 !   CALL INI_CST
227 !   CALL READ_DIMGRIDREF(JME,CFILEDIAS(JME),CLUOUTDIAS(JME))
228 !   CALL INIDEF
229 !   NIMNMX=-1
230 !   LMINMAX=.TRUE.
231 !   CALL COMPCOORD_FORDIACHRO(0)
232 !   NIINF=IIINF; NJINF=IJINF; NISUP=IISUP; NJSUP=IJSUP
233 !   XIDEBCOU=ZIDEBCOU; XJDEBCOU=ZJDEBCOU
234     IF (INUMFILECUR /= NUMFILECUR) THEN
235       ! lecture de l en-tete si le fichier traite n est pas l ancien fichier
236       ! courant      
237       IF(NVERBIA>0) THEN
238         print *,' ** EXTRACT avant lecture de l entete de ',TRIM(CFILEDIAS(JME))
239       ENDIF
240       CALL READ_FILEHEAD(JME,CFILEDIAS(JME),CLUOUTDIAS(JME))
241     ENDIF
242
243     INDFI=INDEX(YCARIN(INDFIS:ILENC),'_FILE')
244     IF(INDFI == 0)THEN
245
246       LFIC1=.TRUE.
247
248     ELSE
249
250       DO J=1,90  ! cf nb max de fic dans modd_files_diachro
251         INDFI=INDEX(YCARIN(INDFIS:ILENC),'_FILE')
252
253         IF(INDFI == 0)THEN
254           EXIT
255
256         ELSE
257
258           LFIC1=.FALSE.
259           INDFI=INDFIS+INDFI-1
260           IF(J == 1)THEN
261             NBSIMULT=1
262             NUMFILESIMULT(:)=0
263             NINDFILESIMULT(:)=0
264             NUMFILESIMULT(NBSIMULT)=NUMFILECUR
265           ENDIF
266           NBSIMULT=NBSIMULT+1
267           IF(YCARIN(INDFI+6:INDFI+6) == '_')THEN
268             READ(YCARIN(INDFI+5:INDFI+5),'(I1)')NUMFILESIMULT(NBSIMULT)
269             INDFIS=MIN(INDFI+6+1,ILENC)
270           ELSE IF(YCARIN(INDFI+7:INDFI+7) == '_')THEN
271             READ(YCARIN(INDFI+5:INDFI+6),'(I2)')NUMFILESIMULT(NBSIMULT)
272             INDFIS=MIN(INDFI+7+1,ILENC)
273           ENDIF
274
275         ENDIF
276
277       ENDDO
278
279     ENDIF
280
281     IF(.NOT.LFIC1)THEN
282       DO J=1,NBSIMULT
283         DO JA=1,NBFILES
284           IF(NUMFILESIMULT(J) == NUMFILES(JA))THEN
285             NINDFILESIMULT(J)=JA
286             EXIT
287           ENDIF
288         ENDDO
289         IF(NINDFILESIMULT(J)==0) THEN
290           PRINT*,'*PB avec la directive:'
291           PRINT*,'  _file',NUMFILECUR,'_ n est pas associe a un nom de fichier'
292           LPBREAD=.TRUE.
293           RETURN
294         ENDIF
295       ENDDO
296     ENDIF
297
298   ELSE
299 ! Cas absence nom de fichier; on renvoit l'instruction telle quelle
300     HCAROUT=ADJUSTL(YCARIN)
301   ENDIF
302   RETURN
303 ENDIF
304 !
305 ! Presence d'au moins un nom de fichier
306 !
307 DO J=1,NBGUIL,2 !***********************************************************
308 !
309   IF(YCARIN(NMGUIL(J)-1:NMGUIL(J)-1) /= '_')THEN
310     print *,'*PB. UN GUILLEMET DOIT ETRE PRECEDE D UN _', &
311     ' (Cas instruction _FILEx_)'
312     print *,'ou ERREUR DANS LE NOM SYMBOLIQUE UTILISE. ', &
313     ' VERIFIEZ LA SYNTAXE OU L''ORTHOGRAPHE DE VOS INSTRUCTIONS'
314     LPBREAD=.TRUE.
315     RETURN
316   ENDIF
317 ! Cas nom d'un processus
318   IF(YCARIN(NMGUIL(J)-3:NMGUIL(J)-3) == '_' .AND. &
319      YCARIN(NMGUIL(J)-2:NMGUIL(J)-2) == 'P')THEN
320      CYCLE
321   ELSE
322 ! Cas nom d'un fichier
323     INCR=1
324     DO JJ=1,10
325       INCR=INCR+1
326       IF(YCARIN(NMGUIL(J)-INCR:NMGUIL(J)-INCR) == '_')EXIT
327     ENDDO
328 !
329 ! JM = indice debut chaine  _FILEx_  ou  _FILExx_
330 !
331     JM=NMGUIL(J)-INCR;!print *,' JM ',JM
332     IF(YCARIN(JM+1:JM+4) /= 'FILE')THEN
333       print *,' CHAINE DE CARACTERES _FILEx_ ATTENDUE DEVANT LES GUILLEMETS', &
334       '  ABSENTE. VERIFIEZ LA SYNTAXE DE VOS INSTRUCTIONS'
335       STOP
336     ELSE
337
338       YNAMFILE(1:LEN(YNAMFILE))=' '
339       YNAMFILE=ADJUSTL(YCARIN(NMGUIL(J)+1:NMGUIL(J+1)-1))
340       IF(NVERBIA>0) THEN
341         print *,' ** EXTRACT YNAMFILE ',YNAMFILE
342       ENDIF
343
344       IF(NBFILES == 0)THEN
345 !
346 ! INIT GKS et ouverture du premier fichier
347 !
348         IASF(:)=1
349         CALL GQOPS(ISTA)
350         IF(ISTA == 0)THEN
351           CALL OPNGKS
352           CALL TABCOL_FORDIACHRO
353         ENDIF
354         CALL GSTXFP(-13,2)
355         CALL GSASF(IASF)
356
357         NBFILES=NBFILES+1
358         CFILEDIAS(NBFILES)=ADJUSTL(YNAMFILE)
359         IF (ABS(JM-NMGUIL(J))-1-1 == 4)THEN
360           NUMFILES(NBFILES)=NBFILES
361         ELSE IF (ABS(JM-NMGUIL(J))-1-1 == 5)THEN
362           READ(YCARIN(NMGUIL(J)-2:NMGUIL(J)-2),'(I1)')NUMFILES(NBFILES)
363         ELSE IF (ABS(JM-NMGUIL(J))-1-1 == 6)THEN
364           READ(YCARIN(NMGUIL(J)-3:NMGUIL(J)-2),'(I2)')NUMFILES(NBFILES)
365         ENDIF
366         NUMFILECUR=NUMFILES(NBFILES)
367
368 ! ouverture du listing
369         CALL FMATTR(CLUOUTDIAS(NBFILES),CLUOUTDIAS(NBFILES), &
370                     NLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
371         OPEN(UNIT=NLUOUTDIAS(NBFILES),FILE=CLUOUTDIAS(NBFILES),FORM='FORMATTED')
372         WRITE(UNIT=NLUOUTDIAS(NBFILES),FMT=1)NBFILES,' ',CFILEDIAS(NBFILES)
373         1 FORMAT(' OPEN DIACHRONIC FILE ',I2.2,A,A28)
374
375 ! Ouverture du fichier .lfi et fermeture du fichier .des correspondant
376       IF(NVERBIA>0) THEN
377         print *,' ** EXTRACT avant link et open premier fichier ',   &
378                 CFILEDIAS(NBFILES)
379       ENDIF
380         CALL CREATLINK('DIRLFI',CFILEDIAS(NBFILES),'CREAT',NVERBIA)
381         CALL FMOPEN(CFILEDIAS(NBFILES),'OLD',CLUOUTDIAS(NBFILES), &
382                     NNPRARDIAS(NBFILES),NFTYPEDIAS(NBFILES),NVERBDIAS(NBFILES),&
383                     NNINARDIAS(NBFILES),NRESPDIAS(NBFILES))
384         IF (NRESPDIAS(NBFILES) .NE. 0) THEN
385           PRINT*,'*PB a l ouverture de ',CFILEDIAS(NBFILES)
386           LPBREAD=.TRUE.
387           RETURN
388         ENDIF
389         YDESFM(1:LEN(YDESFM))=' '
390         YDESFM=ADJUSTL(ADJUSTR(CFILEDIAS(NBFILES))//'.des')
391         CALL FMLOOK(YDESFM,YDESFM,ILUDES,IRESP)
392         CLOSE(ILUDES)
393         CALL FMFREE(YDESFM,CLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
394
395 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
396         IF(JM>=1)THEN
397           HCAROUT(1:NMGUIL(J)-1)=YCARIN(1:NMGUIL(J)-1)
398         ENDIF
399 ! READ JPHEXT
400         CALL FMREAD(CFILEDIAS(NBFILES),'JPHEXT',CLUOUTDIAS(NBFILES),ILENG,JPHEXT,IGRID,ILENCH,YCOMMENT,NRESPDIAS(NBFILES))
401       ELSE    ! NBFILES/=0
402 !
403 ! Fichiers autres que le premier
404 !
405         INUMFILECUR=NUMFILECUR
406         NUMFILECUR=0
407         DO JJ=1,NBFILES
408           IF(YNAMFILE == CFILEDIAS(JJ))THEN
409             PRINT*,'*PB avec la directive:'
410             IF (NUMFILES(JJ)<10)THEN
411               WRITE(YC1,'(I1)')NUMFILES(JJ)
412               PRINT*,'  ce nom de fichier ',TRIM(YNAMFILE), &
413                      ' est deja ouvert avec _FILE'//YC1,'_'
414             ELSE
415               WRITE(YC2,'(I2)')NUMFILES(JJ)
416               PRINT*,'  ce nom de fichier ',TRIM(YNAMFILE), &
417                      ' est deja ouvert avec _FILE'//YC2,'_'
418             ENDIF
419             LPBREAD=.TRUE.
420             NUMFILECUR=INUMFILECUR
421             RETURN
422           END IF
423         ENDDO
424
425 !       IF(INUMFILECUR /= NUMFILECUR)THEN
426         IF(NUMFILECUR == 0)THEN
427           IF (ABS(JM-NMGUIL(J))-1-1 == 4)THEN       ! _file_
428             ! pas d incrementation de NBFILES
429             NUMFILES(NBFILES)=NBFILES
430           ELSE IF (ABS(JM-NMGUIL(J))-1-1 == 5)THEN  ! _filex_
431             NBFILES=NBFILES+1
432             READ(YCARIN(NMGUIL(J)-2:NMGUIL(J)-2),'(I1)')NUMFILES(NBFILES)
433           ELSE IF (ABS(JM-NMGUIL(J))-1-1 == 6)THEN  ! _filexx_
434             NBFILES=NBFILES+1
435             READ(YCARIN(NMGUIL(J)-3:NMGUIL(J)-2),'(I2)')NUMFILES(NBFILES)
436           ENDIF
437           ! on ne passe pas dans la boucle pour _file_ car NBFILES=1
438           !(sauf si _file_ et _filex_ melanges ...)
439           DO JJ=1,NBFILES-1
440             IF(NUMFILES(NBFILES)==NUMFILES(JJ))THEN
441               PRINT*,'*PB avec la directive:'
442               IF (NUMFILES(NBFILES)<10)THEN
443                 WRITE(YC1,'(I1)')NUMFILES(JJ)
444                 PRINT*,' _FILE'//YC1,'_ deja associe au ', &
445                      'nom de fichier ',TRIM(CFILEDIAS(JJ))
446               ELSE
447                 WRITE(YC2,'(I2)')NUMFILES(JJ)
448                 PRINT*,' _FILE'//YC2,'_ deja associe au ', &
449                      'nom de fichier ',TRIM(CFILEDIAS(JJ))
450               ENDIF
451               NBFILES=NBFILES-1
452               LPBREAD=.TRUE.
453               NUMFILECUR=INUMFILECUR
454               RETURN
455             ENDIF
456           ENDDO
457           !
458           NUMFILECUR=NUMFILES(NBFILES)
459           CFILEDIAS(NBFILES)=ADJUSTL(YNAMFILE)
460
461 ! Ouverture du fichier lfi et fermeture du fichier des correspondant
462           CALL FMLOOK(CLUOUTDIAS(NBFILES),CLUOUTDIAS(NBFILES), &
463                       NLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
464           IF (NRESPDIAS(NBFILES) .NE. 0) THEN
465             PRINT*,'*PB pour l ecriture dans ',CLUOUTDIAS(NBFILES)
466             LPBREAD=.TRUE.
467             RETURN
468           ENDIF
469           WRITE(UNIT=NLUOUTDIAS(NBFILES),FMT=1)NBFILES,' ',CFILEDIAS(NBFILES)
470
471       IF(NVERBIA>0) THEN
472         print *,' ** EXTRACT avant link et open fichier suivant'
473       ENDIF
474           CALL CREATLINK('DIRLFI',CFILEDIAS(NBFILES),'CREAT',NVERBIA)
475           CALL FMOPEN(CFILEDIAS(NBFILES),'OLD',CLUOUTDIAS(NBFILES), &
476                       NNPRARDIAS(NBFILES),NFTYPEDIAS(NBFILES),      &
477                       NVERBDIAS(NBFILES),NNINARDIAS(NBFILES),NRESPDIAS(NBFILES))
478           IF (NRESPDIAS(NBFILES) .NE. 0) THEN
479             PRINT*,'*PB a l ouverture de ',CFILEDIAS(NBFILES)
480             LPBREAD=.TRUE.
481             RETURN
482           ENDIF
483           YDESFM(1:LEN(YDESFM))=' '
484           YDESFM=ADJUSTL(ADJUSTR(CFILEDIAS(NBFILES))//'.des')
485           CALL FMLOOK(YDESFM,YDESFM,ILUDES,IRESP)
486           CLOSE(ILUDES)
487           CALL FMFREE(YDESFM,CLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
488         ENDIF
489         IF(NVERBIA>0) THEN
490           print *,' ** EXTRACT fichier suivant numero: ',NUMFILECUR
491         ENDIF
492
493         IF(MAX(1,J-1) == 1)THEN
494 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
495           IDIF=NMGUIL(J)-1-1
496           IF(IDIF >0)THEN
497             JMM=LEN_TRIM(HCAROUT)+1
498 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
499             HCAROUT(JMM:JMM+IDIF)=YCARIN(1:NMGUIL(J)-1)
500           ENDIF
501         ELSE
502 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
503           IDIF=NMGUIL(J)-1-(NMGUIL(MAX(1,J-1))+1)
504           IF(IDIF >0)THEN
505             JMM=LEN_TRIM(HCAROUT)+1
506 ! Modif le 3/1/96. Pour conserver la chaine _FILEx_
507             HCAROUT(JMM:JMM+IDIF)=YCARIN(NMGUIL(MAX(1,J-1))+1:NMGUIL(J)-1)
508           ENDIF
509         ENDIF
510
511       ENDIF
512
513       DO JA=1,NBFILES
514         IF(NUMFILES(JA) == NUMFILECUR)THEN
515           JME=JA
516         ENDIF
517       ENDDO
518       IF(NVERBIA>0) THEN
519         print *,' ** EXTRACT avant lecture de l entete de ',TRIM(CFILEDIAS(JME))
520       ENDIF
521     CALL READ_FILEHEAD(JME,CFILEDIAS(JME),CLUOUTDIAS(JME))
522     LFIC1=.TRUE.
523
524     ENDIF
525       
526   ENDIF
527 ENDDO     !***********************************************************
528
529
530 IDIF=ILENC-(NMGUIL(NBGUIL)+1)
531 !print *,' IDIF ILENC ',IDIF,ILENC,NMGUIL(NBGUIL)
532 IF(IDIF >0)THEN
533   JMM=LEN_TRIM(HCAROUT)+1
534   HCAROUT(JMM:JMM+IDIF)=YCARIN(NMGUIL(NBGUIL)+1:ILENC)
535 ENDIF
536 !
537 IF(nverbia >0)then
538   print *,' END of EXTRACT_AND_OPEN_FILES HCAROUT ',TRIM(HCAROUT)
539 ENDIF
540 !-----------------------------------------------------------------------------
541 !
542 !*       2.       EXITS
543 !                 -----
544
545 RETURN
546 END SUBROUTINE EXTRACT_AND_OPEN_FILES