Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / FM2DIA / read_diachro.f90
1 !     ######spl
2       MODULE MODI_READ_DIACHRO
3 !     ########################
4 !
5 INTERFACE
6 !
7 SUBROUTINE READ_DIACHRO(HFILEDIA,HLUOUTDIA,HGROUP)
8 CHARACTER(LEN=*) :: HFILEDIA,HLUOUTDIA
9 CHARACTER(LEN=*) :: HGROUP
10 END SUBROUTINE READ_DIACHRO
11 !
12 END INTERFACE
13 END MODULE MODI_READ_DIACHRO
14 !     ##################################################
15       SUBROUTINE READ_DIACHRO(HFILEDIA,HLUOUTDIA,HGROUP)
16 !     ##################################################
17 !
18 !!****  *READ_DIACHRO* - Lecture d'un enregistrement dans un fichier
19 !!                       diachronique
20
21 !!    PURPOSE
22 !!    -------
23 !!      Permet la lecture d'un enregistrement de nom HGROUP
24 !!      (En realite, il s'agit de plusieurs enregistrements 
25 !!       identifies par un nom=HGROUP+1suffixe)
26 !      
27 !
28 !!**  METHOD
29 !!    ------
30 !!      En fonction du nom passe dans HGROUP , on lit un 1er enregistrement
31 !!      qui fournit le type d'informations a traiter. Puis ce type donne
32 !!      acces a un 2eme enregistrement contenant les dimensions de
33 !!      toutes les matrices qui seront lues dans les articles suivants
34 !!      et qui sont donc allouees dynamiquement a ce moment.
35 !!     
36 !!
37 !!    EXTERNAL
38 !!    --------
39 !!      None
40 !!
41 !!    IMPLICIT ARGUMENTS
42 !!    ------------------
43 !!      Module
44 !!
45 !!    REFERENCE
46 !!    ---------
47 !!
48 !!
49 !!    AUTHOR
50 !!    ------
51 !!      J. Duron    * Laboratoire d'Aerologie *
52 !!
53 !!
54 !!    MODIFICATIONS
55 !!    -------------
56 !!      Original       05/02/96
57 !!      Updated   PM 
58 !-------------------------------------------------------------------------------
59 !
60 !*       0.    DECLARATIONS
61 !              ------------
62 !
63 USE MODD_TYPE_AND_LH
64 USE MODD_RESOLVCAR
65 USE MODD_DIM1
66 USE MODD_ALLOC_FORDIACHRO
67 USE MODI_ALLOC_FORDIACHRO
68 USE MODI_FMREAD
69
70 IMPLICIT NONE
71 !
72 !*       0.1   Dummy arguments
73 !              ---------------
74
75 CHARACTER(LEN=*)              :: HFILEDIA,HLUOUTDIA
76 CHARACTER(LEN=*)              :: HGROUP
77
78 !
79 !*       0.1   Local variables
80 !              ---------------
81
82 !
83 CHARACTER(LEN=16) :: YRECFM, YTEM
84 CHARACTER(LEN=LEN(HFILEDIA)+4) :: YFILEDIA
85 ! Aout 99 longueur YCOMMENT passee de 20 a 100
86 CHARACTER(LEN=100) :: YCOMMENT
87 CHARACTER(LEN=3)  :: YJ
88 INTEGER   ::   ILENG, ILENCH, ILENTITRE, ILENUNITE, ILENCOMMENT, IRESP
89 INTEGER   ::   ILUOUTDIA,INPRARDIA,IFTYPEDIA,IVERBDIA,ININARDIA
90 INTEGER   ::   II, IJ, IK, IT, IN, IP, INUM, J, JJ
91 INTEGER   ::   INTRAJT, IKTRAJX, IKTRAJY, IKTRAJZ
92 INTEGER   ::   ITTRAJX, ITTRAJY, ITTRAJZ
93 INTEGER   ::   INTRAJX, INTRAJY, INTRAJZ
94 INTEGER   ::   IIMASK, IJMASK, IKMASK, ITMASK, INMASK, IPMASK
95 INTEGER   ::   ICOMPX, ICOMPY, ICOMPZ
96 INTEGER   ::   ILENGP, IUSCORE, III
97 INTEGER,DIMENSION(:),ALLOCATABLE :: ITABCHAR
98 CHARACTER(LEN=20) :: CFORMAT
99 !------------------------------------------------------------------------------
100 !
101 ILENCH = LEN(YCOMMENT)
102 if (nverbia > 0)then
103 print *,' BEGIN READ_DIACHRO ******************'
104 endif
105
106 CALL FMLOOK(HLUOUTDIA,HLUOUTDIA,ILUOUTDIA,IRESP)
107 !WRITE(ILUOUTDIA,*)' READ_DIACHRO IRESP ',IRESP
108 IF(IRESP== -54)THEN
109   CALL FMATTR(HLUOUTDIA,HLUOUTDIA,ILUOUTDIA,IRESP)
110   OPEN(UNIT=ILUOUTDIA,FILE=HLUOUTDIA)
111   IFTYPEDIA = 0; IVERBDIA = 5
112 ENDIF
113 YFILEDIA=ADJUSTL(ADJUSTR(HFILEDIA)//'.lfi')
114 CALL FMLOOK(YFILEDIA,HLUOUTDIA,INUM,IRESP)
115 !WRITE(ILUOUTDIA,*)' READ_DIACHRO IRESP ',IRESP
116 IF(IRESP ==  -54)THEN
117 ! Modif demandee par Nicole Asencio. 28/9/98
118   IFTYPEDIA=2
119   CALL FMOPEN(HFILEDIA,'OLD',HLUOUTDIA,INPRARDIA,IFTYPEDIA,IVERBDIA, &
120   ININARDIA,IRESP)
121 END IF
122
123 !
124 ! 1er enregistrement TYPE
125 !
126 YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TYPE')
127 ILENG = LEN(CTYPE)
128 ALLOCATE(ITABCHAR(ILENG))
129 CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
130 ITABCHAR,NGRID,ILENCH,YCOMMENT,IRESP)
131 IF(IRESP == -47)THEN
132   DEALLOCATE(ITABCHAR)
133   print *,' ERREUR D''ORTHOGRAPHE OU DE SYNTAXE DANS VOTRE DIRECTIVE '
134   print *,' VERIFIEZ ET RENTREZ LA A NOUVEAU '
135   LPBREAD=.TRUE.
136   RETURN
137 ENDIF
138 DO J = 1,ILENG
139   CTYPE(J:J) = CHAR(ITABCHAR(J))
140 ENDDO
141 !WRITE(ILUOUTDIA,*)' 1er ENREGISTREMENT LU OK',CTYPE
142 DEALLOCATE(ITABCHAR)
143 !
144 if (nverbia > 0)then
145 print *,' TYPE ',CTYPE
146 endif
147
148 ! 2eme  enregistrement DIMENSIONS des MATRICES et LONGUEUR des TABLEAUX de CARACTERES et FLAGS de COMPRESSION sur les DIFFERENTS AXES
149 !
150 YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.DIM')
151 SELECT CASE(CTYPE)
152
153   CASE('CART','MASK','SPXY')
154
155     ILENG = 34
156     ALLOCATE(ITABCHAR(ILENG))
157
158     CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
159     NGRID,ILENCH,YCOMMENT,IRESP)
160     ILENTITRE=ITABCHAR(1); ILENUNITE=ITABCHAR(2)
161     ILENCOMMENT=ITABCHAR(3); II=ITABCHAR(4)
162     IJ=ITABCHAR(5); IK=ITABCHAR(6)
163     IT=ITABCHAR(7); IN=ITABCHAR(8)
164     IP=ITABCHAR(9); NIL=ITABCHAR(10)
165     NJL=ITABCHAR(11); NKL=ITABCHAR(12)
166     NIH=ITABCHAR(13); NJH=ITABCHAR(14)
167     NKH=ITABCHAR(15); ICOMPX=ITABCHAR(16)
168     ICOMPY=ITABCHAR(17); ICOMPZ=ITABCHAR(18)
169     INTRAJT=ITABCHAR(19); IKTRAJX=ITABCHAR(20)
170     IKTRAJY=ITABCHAR(21); IKTRAJZ=ITABCHAR(22)
171     ITTRAJX=ITABCHAR(23); ITTRAJY=ITABCHAR(24)
172     ITTRAJZ=ITABCHAR(25); INTRAJX=ITABCHAR(26)
173     INTRAJY=ITABCHAR(27); INTRAJZ=ITABCHAR(28)
174     IIMASK=ITABCHAR(29); IJMASK=ITABCHAR(30)
175     IKMASK=ITABCHAR(31); ITMASK=ITABCHAR(32)
176     INMASK=ITABCHAR(33); IPMASK=ITABCHAR(34)
177     LICP=.FALSE.; LJCP=.FALSE.; LKCP=.FALSE.
178     IF(ICOMPX==1)THEN
179       LICP=.TRUE.
180     ENDIF
181     IF(ICOMPY==1)THEN
182       LJCP=.TRUE.
183     ENDIF
184     IF(ICOMPZ==1)THEN
185       LKCP=.TRUE.
186     ENDIF
187 if (nverbia > 0)then
188 print *,' DIM ',ILENG
189 !print *, ITABCHAR
190 endif
191 !   WRITE(ILUOUTDIA,*)' ILENTITRE,ILENUNITE,ILENCOMMENT  LUES',ILENTITRE,ILENUNITE,ILENCOMMENT
192     DEALLOCATE(ITABCHAR)
193
194   CASE DEFAULT
195
196     ILENG = 25
197     ALLOCATE(ITABCHAR(ILENG))
198
199     CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ITABCHAR, &
200     NGRID,ILENCH,YCOMMENT,IRESP)
201
202     ILENTITRE=ITABCHAR(1); ILENUNITE=ITABCHAR(2)
203     ILENCOMMENT=ITABCHAR(3); II=ITABCHAR(4)
204     IJ=ITABCHAR(5); IK=ITABCHAR(6)
205     IT=ITABCHAR(7); IN=ITABCHAR(8)
206     IP=ITABCHAR(9)
207     INTRAJT=ITABCHAR(10); IKTRAJX=ITABCHAR(11)
208     IKTRAJY=ITABCHAR(12); IKTRAJZ=ITABCHAR(13)
209     ITTRAJX=ITABCHAR(14); ITTRAJY=ITABCHAR(15)
210     ITTRAJZ=ITABCHAR(16); INTRAJX=ITABCHAR(17)
211     INTRAJY=ITABCHAR(18); INTRAJZ=ITABCHAR(19)
212     IIMASK=ITABCHAR(20); IJMASK=ITABCHAR(21)
213     IKMASK=ITABCHAR(22); ITMASK=ITABCHAR(23)
214     INMASK=ITABCHAR(24); IPMASK=ITABCHAR(25)
215
216 !   CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,ILENTITRE,ILENUNITE, &
217 !   ILENCOMMENT,II,IJ,IK,IT,IN,IP,NGRID,ILENCH,YCOMMENT,IRESP)
218 if (nverbia > 0)then
219 print'(A5,I3)',' DIM ',ILENG
220 write(CFORMAT,FMT='(A1,I2,A7)') "(",ILENG,"(I4,X))"
221 print CFORMAT, ITABCHAR
222 endif
223     DEALLOCATE(ITABCHAR)
224 END SELECT
225 !WRITE(ILUOUTDIA,*)' 2eme ENREGISTREMENT LU OK'
226 !
227 ! Allocation des tableaux pour la lecture
228 !
229 if (nverbia > 0)then
230   print *,' READ_DIACHRO AVANT ALLOC'
231   print'(A19,6I4)',' II,IJ,IK,IT,IN,IP ',II,IJ,IK,IT,IN,IP
232   print'(A41,5I4)',' INTRAJT,IKTRAJX,IKTRAJY,IKTRAJZ,ITTRAJX ',INTRAJT,IKTRAJX,IKTRAJY,IKTRAJZ,ITTRAJX
233   print'(A49,6I4)',' ITTRAJX,ITTRAJY,ITTRAJZ,INTRAJX,INTRAJY,INTRAJZ ',ITTRAJX,ITTRAJY,ITTRAJZ,INTRAJX,INTRAJY,INTRAJZ
234   print'(A42,6I4)',' IIMASK,IJMASK,IKMASK,ITMASK,INMASK,IPMASK ',IIMASK,IJMASK,IKMASK,ITMASK,INMASK,IPMASK
235 endif 
236 CALL ALLOC_FORDIACHRO(II,IJ,IK,IT,IN,IP,2,INTRAJT,IKTRAJX,IKTRAJY,  &
237  IKTRAJZ,ITTRAJX,ITTRAJY,ITTRAJZ,INTRAJX,INTRAJY,INTRAJZ,IIMASK,    &
238  IJMASK,IKMASK,ITMASK,INMASK,IPMASK)
239 if (nverbia > 0)then
240   print *,' READ_DIACHRO APRES ALLOC'
241   print'(A19,6I4)',' II,IJ,IK,IT,IN,IP ',II,IJ,IK,IT,IN,IP
242   print'(A41,5I4)',' INTRAJT,IKTRAJX,IKTRAJY,IKTRAJZ,ITTRAJX ',INTRAJT,IKTRAJX,IKTRAJY,IKTRAJZ,ITTRAJX
243   print'(A49,6I4)',' ITTRAJX,ITTRAJY,ITTRAJZ,INTRAJX,INTRAJY,INTRAJZ ',ITTRAJX,ITTRAJY,ITTRAJZ,INTRAJX,INTRAJY,INTRAJZ
244   print'(A42,6I4)',' IIMASK,IJMASK,IKMASK,ITMASK,INMASK,IPMASK ',IIMASK,IJMASK,IKMASK,ITMASK,INMASK,IPMASK
245 endif 
246 !
247 ! 3eme enregistrement TITRE
248 !
249 YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TITRE')
250 if (nverbia > 0)then
251   print'(A14,I3,X,I3)',' ILENTITRE IP ',ILENTITRE,IP
252 endif
253 ILENG = ILENTITRE*IP
254 ALLOCATE(ITABCHAR(ILENG))
255 CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
256 ITABCHAR,NGRID,ILENCH,YCOMMENT,IRESP)
257 if (nverbia > 0)then
258   print'(A14,I3,X,I3)' ,' ILENTITRE IP ',ILENTITRE,IP
259 endif
260 DO JJ = 1,IP
261 DO J = 1,ILENTITRE
262   CTITRE(JJ)(J:J)=CHAR(ITABCHAR(ILENTITRE*(JJ-1)+J))
263 ENDDO
264 !WRITE(ILUOUTDIA,*)CTITRE(JJ)
265 if (nverbia > 0)then
266 print *,' TITRE '
267 print *,CTITRE(JJ)
268 endif
269 ENDDO
270 !WRITE(ILUOUTDIA,*)' 3eme ENREGISTREMENT LU OK'
271 DEALLOCATE(ITABCHAR)
272 !
273 ! 4eme enregistrement UNITE
274 !
275 YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.UNITE')
276 ILENG = ILENUNITE*IP
277 ALLOCATE(ITABCHAR(ILENG))
278 CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
279 ITABCHAR,NGRID,ILENCH,YCOMMENT,IRESP)
280 DO JJ = 1,IP
281 !! Fev 2002
282   CUNITE(JJ)=' '
283   if (nverbia > 0)then
284   print *,' **read_diachro CUNITE AP MISE A BLANC ILENUNITE JJ ',ILENUNITE,JJ, CUNITE(JJ)
285   endif
286 !! Fev 2002
287 DO J = 1,ILENUNITE
288   CUNITE(JJ)(J:J)=CHAR(ITABCHAR(ILENUNITE*(JJ-1)+J))
289 ENDDO
290 !WRITE(ILUOUTDIA,*)CUNITE(JJ)
291 if (nverbia > 0)then
292 print *,' UNITE'
293 print *,CUNITE(JJ)
294 endif
295 ENDDO
296 !WRITE(ILUOUTDIA,*)' 4eme ENREGISTREMENT LU  OK'
297 DEALLOCATE(ITABCHAR)
298 !
299 ! 5eme enregistrement COMMENT
300 !
301 YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.COMMENT')
302 ILENG = ILENCOMMENT*IP
303 ALLOCATE(ITABCHAR(ILENG))
304 CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
305 ITABCHAR,NGRID,ILENCH,YCOMMENT,IRESP)
306 DO JJ = 1,IP
307 DO J = 1,ILENCOMMENT
308   CCOMMENT(JJ)(J:J)=CHAR(ITABCHAR(ILENCOMMENT*(JJ-1)+J))
309 ENDDO
310 !WRITE(ILUOUTDIA,*)CCOMMENT(JJ)
311 if (nverbia > 0)then
312 print *,' COMMENT'
313 print *,CCOMMENT(JJ)
314 endif
315 ENDDO
316 !WRITE(ILUOUTDIA,*)' 5eme ENREGISTREMENT LU OK'
317 DEALLOCATE(ITABCHAR)
318 !
319 ! 6eme enregistrement VAR
320 !
321 ! Dans la mesure ou cette matrice risque d'etre tres volumineuse, on a ecrit 
322 ! et donc on lit un enregistrement par processus
323 DO J = 1,IP
324 YJ = '   '
325 IF(J < 10)WRITE(YJ,'(I1)')J 
326 IF(J >= 10 .AND. J < 100)WRITE(YJ,'(I2)')J
327 YJ = ADJUSTL(YJ)
328 IF(J >= 100 .AND. J < 1000)WRITE(YJ,'(I3)')J
329 YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.PROC'//YJ)
330 ILENG = II*IJ*IK*IT*IN
331 !print *,' PVAR '
332 CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
333 XVAR(:,:,:,:,:,J),NGRIDIA(J),ILENCH,YCOMMENT,IRESP)
334 !print *,' YJ ILENG YRECFM NGRIDIA',YJ,ILENG,YRECFM,NGRIDIA(J)
335 !WRITE(ILUOUTDIA,*)' 6eme ENREGISTREMENT LU OK'
336 if (nverbia > 0)then
337   print *,' J de VAR(J) ',J
338 endif
339 ENDDO
340 ! PROVI MOdif dim  d'un spectre pour voir si pb
341 !NIMAX=0 ; NJMAX=0 ; NIL=0; NJL=0; NIH=0; NJH=0
342 !
343 ! 7eme enregistrement TRAJT
344 !
345 YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJT')
346 ILENG = IT*INTRAJT
347 CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
348 XTRAJT,NGRID,ILENCH,YCOMMENT,IRESP)
349 if (nverbia == -5)then
350 print *,' XTRAJT ',XTRAJT
351 endif
352 if (nverbia > 0)then
353 print *,' XTRAJT '
354 !print *,XTRAJT
355 endif
356 !
357 ! Dans certains cas
358 !
359 !
360 ! 8eme enregistrement TRAJX
361 !
362 IF(IKTRAJX /= 0 .AND. ITTRAJX /= 0 .AND. INTRAJX /= 0 )THEN
363   YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJX')
364   ILENG = IKTRAJX*ITTRAJX*INTRAJX
365   CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
366   XTRAJX,NGRID,ILENCH,YCOMMENT,IRESP)
367 if (nverbia > 0)then
368 print *,' XTRAJX'
369 !print *,XTRAJX
370 endif
371 ENDIF
372 !
373 !                        ou
374 !
375 if (nverbia > 0)then
376   print'(A42,6I4)',' IIMASK,IJMASK,IKMASK,ITMASK,INMASK,IPMASK ',&
377   IIMASK,IJMASK,IKMASK,ITMASK,INMASK,IPMASK
378 endif
379 IF(IIMASK /= 0 .AND. IJMASK /= 0 .AND. IKMASK /= 0 .AND. &
380    ITMASK /= 0 .AND. INMASK /= 0 .AND. IPMASK /= 0)THEN
381   YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.MASK')
382   ILENG = IIMASK*IJMASK*IKMASK*ITMASK*INMASK*IPMASK
383   CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
384   XMASK,NGRID,ILENCH,YCOMMENT,IRESP)
385 if (nverbia > 0)then
386   IF(IRESP /= 0)THEN
387     print'(A19,A20,I1)',' YRECFM IRESP MASK ',YRECFM,IRESP
388   ENDIF
389 endif
390 ! Modif demandee par Nicole pour les budgets en Juin 99 mais compatible avec
391 ! les anciennes ecritures
392 ! (Ecriture du masque 1 seule fois pour tous les groupes et par sequence temp.
393 ! avec le nom : 'MASK_nnnn.MASK' (nnnn=suffixe numerique id. a celui du
394 ! nom des bilans pour avoir la bonne correspondance temporelle))
395 ! Donc si en lecture on ne trouve pas l'enr. de nom YRECFM ci-dessus, 
396 ! on recherche celui de nom 'MASK_nnnn.MASK'
397 !
398   IF(IRESP == -47)THEN
399     YTEM=YRECFM
400     ILENGP=LEN_TRIM(HGROUP)
401     IUSCORE=INDEX(HGROUP,'___')
402     IF(IUSCORE == 0)THEN
403       IUSCORE=INDEX(HGROUP,'__')
404       IF(IUSCORE == 0)THEN
405         IUSCORE=INDEX(HGROUP,'_')
406         IUSCORE=IUSCORE+1
407       ELSE
408         IUSCORE=IUSCORE+2
409       ENDIF
410     ELSE
411       IUSCORE=IUSCORE+3
412     ENDIF
413     YRECFM(1:LEN(YRECFM))=' '
414     YRECFM='MASK_'
415     YRECFM=ADJUSTL(ADJUSTR(YRECFM)//HGROUP(IUSCORE:ILENGP))
416     YRECFM=ADJUSTL(ADJUSTR(YRECFM)//'.MASK')
417     print *,' Absence ',YTEM(1:LEN_TRIM(YTEM)),' Recherche ',YRECFM(1:LEN_TRIM(YRECFM))
418     CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
419     XMASK,NGRID,ILENCH,YCOMMENT,IRESP)
420     IF(IRESP /= 0)THEN
421       print *,'PB ou ABSENCE ENR. de nom',YRECFM,' ou ',YTEM
422       print *,'Impossibilite de tracer des MASQUES'
423     ENDIF
424   ENDIF
425   
426 if (nverbia > 0)then
427 do iii=1,INMASK
428 print *,' XMASK',size(XMASK,1),size(XMASK,2),' N',III
429 !print 10,XMASK(:,:,:,:,iii,:)
430 10 FORMAT(40I2)
431 enddo
432 endif
433
434 ENDIF
435 !
436 ! 9eme enregistrement TRAJY
437 !
438 IF(IKTRAJY /= 0 .AND. ITTRAJY /= 0 .AND. INTRAJY /= 0 )THEN
439   YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJY')
440   ILENG = IKTRAJY*ITTRAJY*INTRAJY
441   CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
442   XTRAJY,NGRID,ILENCH,YCOMMENT,IRESP)
443 if (nverbia > 0)then
444 print *,' XTRAJY'
445 !print *,XTRAJY
446 endif
447 ENDIF
448 !
449 ! 10eme enregistrement TRAJZ
450 !
451 IF(IKTRAJZ /= 0 .AND. ITTRAJZ /= 0 .AND. INTRAJZ /= 0 )THEN
452   YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.TRAJZ')
453   ILENG = IKTRAJZ*ITTRAJZ*INTRAJZ
454   CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
455   XTRAJZ,NGRID,ILENCH,YCOMMENT,IRESP)
456 if (nverbia > 0)then
457 print *,' XTRAJZ'
458 !print *,XTRAJZ
459 endif
460 ENDIF
461 !
462 ! 11eme enregistrement  XDATIME
463 !
464 YRECFM = ADJUSTL(ADJUSTR(HGROUP)//'.DATIM')
465 ILENG=16*IT
466 CALL FMREAD(HFILEDIA,YRECFM,HLUOUTDIA,ILENG,  &
467 XDATIME,NGRID,ILENCH,YCOMMENT,IRESP)
468 if (nverbia > 0)then
469 print *,' XDATIME '
470 !print *,XDATIME
471 endif
472 if (nverbia == -5)then
473 print *,' XDATIME ',XDATIME
474 !print *,XDATIME
475 endif
476
477 if (nverbia > 0)then
478 print *,' END READ_DIACHRO **************'
479 endif
480 !
481 !-----------------------------------------------------------------------------
482 !
483 !*       2.       EXITS
484 !                 -----
485
486 RETURN
487 END SUBROUTINE READ_DIACHRO