Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / FM2DIA / write_othersfields.f90
1 !     ######spl
2       MODULE MODI_WRITE_OTHERSFIELDS
3 !     ##############################
4 !
5 INTERFACE
6 !
7 SUBROUTINE WRITE_OTHERSFIELDS(K,HFILEDIA,HLUOUTDIA,KX,KY,KZ)
8 INTEGER :: K
9 CHARACTER(LEN=*) :: HFILEDIA,HLUOUTDIA
10 INTEGER, INTENT(IN), OPTIONAL :: KX,KY,KZ
11 END SUBROUTINE WRITE_OTHERSFIELDS
12 !
13 END INTERFACE
14 !
15 END MODULE MODI_WRITE_OTHERSFIELDS
16 !     #############################################################
17       SUBROUTINE WRITE_OTHERSFIELDS(K,HFILEDIA,HLUOUTDIA,KX,KY,KZ)
18 !     #############################################################
19 !
20 !!****  *WRITE_OTHERSFIELDS* - 
21 !! 
22 !!
23 !!    PURPOSE
24 !!    -------
25
26 !
27 !!**  METHOD
28 !!    ------
29 !!      
30 !!
31 !!    REFERENCE
32 !!    ---------
33 !!     
34 !!
35 !!    AUTHORS
36 !!    -------
37 !!    J. Duron      *Lab. Aerologie* 
38 !!
39 !!
40 !!    MODIFICATIONS
41 !!    -------------
42 !!      Original    30/01/96 
43 !-------------------------------------------------------------------------------
44 !
45 !*       0.    DECLARATIONS
46 !              ------------
47 !
48 USE  MODD_DIMGRID_FORDIACHRO        
49 USE  MODD_OUT_DIA
50 USE  MODD_DIACHRO  
51 USE  MODD_ALLOC_FORDIACHRO  
52 USE  MODI_ALLOC_FORDIACHRO
53 USE  MODD_PARAMETERS
54 USE  MODD_DIM1
55 USE  MODD_TYPE_AND_LH
56 USE  MODD_RESOLVCAR, ONLY : CGROUP
57 USE  MODD_GRID
58 USE  MODD_CONF
59 USE  MODD_GRID1
60 USE  MODD_TIME1
61 USE MODD_TYPE_DATE
62 USE  MODI_WRITE_DIACHRO
63 USE  MODI_READ_DIACHRO
64 USE  MODI_RESOLV_UNITS
65 USE  MODI_TEMPORAL_DIST
66 USE  MODD_TIME
67 USE  MODI_FMREAD
68 USE  MODI_FMWRIT
69 !
70 IMPLICIT NONE
71 !
72 !*       0.1   Dummy arguments
73 !
74 INTEGER           :: K   ! Input file number
75 CHARACTER(LEN=*)  :: HFILEDIA, HLUOUTDIA
76 INTEGER, INTENT(IN), OPTIONAL :: KX,KY,KZ
77 !
78 !*       0.2   Local variables declarations
79 !
80 INTEGER           :: JJ, J, JA, I
81 INTEGER           :: ixyz, J1, J2, J3, I1, I2, I3
82 INTEGER           :: IIU, IJU, IKU
83 INTEGER           :: IGRID, ILENCH, IRESP
84 INTEGER           :: IPCENT
85 INTEGER           :: IMULT, ILYCOMM
86 INTEGER           :: ILUOUTDIA
87 !
88 CHARACTER(LEN=100):: YCOMMENT, YCAROUT
89 CHARACTER(LEN=20):: YCOMM
90 CHARACTER(LEN=16) :: YRECFM
91 !
92 REAL,DIMENSION(:),ALLOCATABLE  :: ZTAB
93 REAL,DIMENSION(:,:,:),ALLOCATABLE  :: ZTAB3, ZTABM3, Z3D
94 INTEGER,DIMENSION(3):: ITAB3  ! sizes of array ZTAB3
95 !
96 TYPE (DATE_TIME), SAVE :: TZDTEXP  ! to store exp. time when TT files
97 LOGICAL :: GPACK  ! to store LPACK
98 !----------------------------------------------------------------------------
99 !
100 !*       1.    INITIALISATION
101 !              --------------
102 !
103 GPACK=LPACK
104 ! Duplication du profil au niveau des points de garde en 1D ou 2D
105 IF(NIMAX==1 .OR. NJMAX==1) LPACK=.FALSE.
106 !
107 ILENCH=LEN(YCOMMENT)
108 ILYCOMM=LEN(YCOMM)
109 YCOMM(1:ILYCOMM)='NOTHING'
110 !
111 IIU=NIMAX+2*JPHEXT
112 IJU=NJMAX+2*JPHEXT
113 IKU=NKMAX+2*JPVEXT
114 print*,'IIU,IJU,IKU= ',IIU,IJU,IKU
115 !JDJDJDJD 291196
116 WRITE(NLUOUTD,*)' ******** WRITE_OTHERSFIELDS ENTREE CSTORAGE_TYPE ',CSTORAGE_TYPE
117 IF(CSTORAGE_TYPE == 'PG' .OR. CSTORAGE_TYPE == 'SU')THEN
118   IKU=1
119 ENDIF
120 !JDJDJDJD 291196
121
122 CALL FMLOOK(HLUOUTDIA,HLUOUTDIA,ILUOUTDIA,IRESP)
123 !
124 ! resolution degradee
125 ixyz=0
126 IF (PRESENT(KX)) THEN
127 IF (KX>1.AND.NIMAX/=1) ixyz=1 
128 ENDIF
129 IF (PRESENT(KY)) THEN 
130 IF (KY>1.AND.NJMAX/=1) ixyz=ixyz+10
131 ENDIF
132 IF (PRESENT(KZ)) THEN 
133 IF (KZ>1)              ixyz=ixyz+100
134 ENDIF
135 !
136 ! NNB= NB d'articles a lire dans le fichier en cours de traitement en entree
137 ! Mais en fait on prend comme ref. les articles du premier fichier
138 ! (CF instruction IF(NNUMT(JJ,1....) en supposant que tous les fichiers
139 ! traites ont la meme organisation (ce qui doit etre le cas sachant que
140 ! ces fichiers sont differentes echeances d'un meme run)
141 !
142 DO JJ=1,NNB
143 !
144   IF(NNUMT(JJ,1) /= 0)THEN
145 !
146 !----------------------------------------------------------------------------
147 !
148 !*       2.    TREATMENT ACCORDING THE VARIABLE SHAPE
149 !              --------------------------------------
150 !
151 ! 130198 Introduction de IMULT pour prise en compte du 2D Vertical dont
152 ! seul le plan central est enregistre
153     IMULT=1
154 !
155 !*       2.0  
156 !
157     IF(NSIZT(JJ,K) == IIU*IJU)THEN
158 ! 051296 Modif pour tenir compte du 2D surfacique horizontal
159       IKU=1
160     ELSE IF(NSIZT(JJ,K)*(2*JPHEXT+NJMAX) == IIU*IJU)THEN
161 ! 130198 Modif pour tenir compte du 2D Vertical filaire et surfacique; cas
162 ! enregistrement du seul plan central
163       IKU=1
164       IMULT=2*JPHEXT+NJMAX
165       WRITE(NLUOUTD,*)'***************************************************************'
166       WRITE(NLUOUTD,*)' Variable 1D rencontree // X et enregistree dans le fichier',&
167       &' diachronique ',CRECFM2T(JJ,K),' size origine et size enr.  ',NSIZT(JJ,K),NSIZT(JJ,K)*IMULT
168       WRITE(NLUOUTD,*)' (Duplication du profil (<--> 2D filaire) au niveau des points de garde)'
169       WRITE(NLUOUTD,*)'***************************************************************'
170     ELSE IF(NSIZT(JJ,K)*(2*JPHEXT+NIMAX) == IIU*IJU)THEN
171       WRITE(NLUOUTD,*)'***************************************************************'
172       WRITE(NLUOUTD,*)' Variable 1D // Y non enregistree dans le fichier',&
173      &' diachronique ',CRECFM2T(JJ,K),' size et IIU,IJU,IKU ',NSIZT(JJ,K),IIU,IJU,IKU
174       WRITE(NLUOUTD,*)'***************************************************************'
175       CYCLE
176     ELSE IF(NSIZT(JJ,K)*(2*JPHEXT+NIMAX) == IIU*IJU/(2*JPHEXT+NJMAX))THEN
177       IF(NIMAX==1 .AND. NJMAX==1) THEN
178 ! 110906 Cas 0D Vertical ou seul le profil central est enregistre
179 !        Duplication du profil sur les points de garde
180 !        (rigoureusement, il faut dupliquer car type CART)
181         IKU=1
182         IMULT = (2*JPHEXT+NIMAX)*(2*JPHEXT+NJMAX)
183         WRITE(NLUOUTD,*)'***************************************************************'
184         WRITE(NLUOUTD,*)' Variable 0D enregistree dans le fichier',&
185       &' diachronique ',CRECFM2T(JJ,K),' size origine et size enr.  ',NSIZT(JJ,K),NSIZT(JJ,K)*IMULT
186         WRITE(NLUOUTD,*)' (Duplication du profil au niveau des points de garde...)'
187         WRITE(NLUOUTD,*)'***************************************************************'
188       ENDIF
189     ELSE
190       IKU=NKMAX+2*JPVEXT 
191       IF(NSIZT(JJ,K)*(2*JPHEXT+NJMAX) == IIU*IJU*IKU)THEN
192         IMULT=2*JPHEXT+NJMAX
193         WRITE(NLUOUTD,*)'***************************************************************'
194         WRITE(NLUOUTD,*)' Variable 2D Vertical // X et enregistree dans le fichier',&
195       &' diachronique ',CRECFM2T(JJ,K),' size origine et size enr.  ',NSIZT(JJ,K),NSIZT(JJ,K)*IMULT
196         WRITE(NLUOUTD,*)' (Duplication du plan au niveau des points de garde)'
197         WRITE(NLUOUTD,*)'***************************************************************'
198       ELSE IF(NSIZT(JJ,K)*(2*JPHEXT+NIMAX) == IIU*IJU*IKU)THEN
199         WRITE(NLUOUTD,*)'***************************************************************'
200         WRITE(NLUOUTD,*)' Variable 2D Vertical // Y non enregistree dans le fichier',&
201      &' diachronique ',CRECFM2T(JJ,K),' size et IIU,IJU,IKU ',NSIZT(JJ,K),IIU,IJU,IKU
202         WRITE(NLUOUTD,*)'***************************************************************'
203         CYCLE
204       !ELSE IF(NSIZT(JJ,K)*(2*JPHEXT+NIMAX)*(2*JPHEXT+NJMAX) == IIU*IJU*IKU)THEN
205       !remplace par la ligne suivante car le membre de gauche peut etre tres grand
206       ELSE IF(NSIZT(JJ,K)*(2*JPHEXT+NIMAX)==IIU*IJU*IKU/(2*JPHEXT+NJMAX) )THEN
207         WRITE(NLUOUTD,*)'***************************************************************'
208         IF(NIMAX==1 .AND. NJMAX==1) THEN
209 ! 180703 Cas 1D Vertical ou seul le profil central est enregistre
210 !        Duplication du profil sur les points de garde
211 !        (rigoureusement, il faut dupliquer car type CART)
212           IMULT = (2*JPHEXT+NIMAX)*(2*JPHEXT+NJMAX)
213         WRITE(NLUOUTD,*)' Variable 1D Vertical enregistree dans le fichier',&
214       &' diachronique ',CRECFM2T(JJ,K),' size origine et size enr.  ',NSIZT(JJ,K),NSIZT(JJ,K)*IMULT
215           WRITE(NLUOUTD,*)' (Duplication du profil au niveau des points de garde...)'
216         ELSE
217           WRITE(NLUOUTD,*)' Variable 1D Vertical enregistree dans le fichier',&
218       &' diachronique ',CRECFM2T(JJ,K),' size origine et size enr.  ',NSIZT(JJ,K),NSIZT(JJ,K)*IMULT
219         ENDIF
220         WRITE(NLUOUTD,*)'***************************************************************'
221       ELSE
222         IF(NSIZT(JJ,K) == IIU*IJU*IKU)THEN
223 ! Variable 3D normale IKU= NKMAX+2*JPVEXT IMULT=1 On ne fait rien
224         ELSE
225           IF(NJMAX==1 .AND. GPACK) THEN
226             IF(MOD(NSIZT(JJ,K) , IIU) == 0)THEN
227 ! Variable 3D avec la 3eme dim  <= a IKU habituel et sans signification spatiale
228               IKU=NSIZT(JJ,K)/IIU
229               WRITE(NLUOUTD,*)'*********** 3D mais 3e dimension =/= de IKU *******************'
230               WRITE(NLUOUTD,*)' Variable 3D enregistree dans le fichier diachronique ',&
231        &CRECFM2T(JJ,K),' size et IIU,3e DIMENSION,IKU ',NSIZT(JJ,K),IIU,IKU,NKMAX+2*JPVEXT
232               IF(CSTORAGE_TYPE == 'PG' .OR. CSTORAGE_TYPE == 'SU')THEN
233                 WRITE(NLUOUTD,*)' cas d un fichier physiographique: niveaux supplementaires de 1 a ',IKU
234               ELSE
235                 WRITE(NLUOUTD,*)' consideree comme une matrice partielle en K dont seuls les niveaux 1 a ',IKU,' sont enregistres'
236               END IF
237 !        Duplication du profil sur les points de garde
238 !        (rigoureusement, il faut dupliquer car type CART)
239               IMULT = 2*JPHEXT+NJMAX
240               WRITE(NLUOUTD,*)' (Duplication au niveau des points de garde)'
241             ENDIF
242           ELSE IF(MOD(NSIZT(JJ,K) , IIU*IJU) == 0)THEN
243 ! Variable 3D avec la 3eme dim  <= a IKU habituel et sans signification spatiale
244             IKU=NSIZT(JJ,K)/(IIU*IJU)
245             WRITE(NLUOUTD,*)'*********** 3D mais 3e dimension =/= de IKU *******************'
246             WRITE(NLUOUTD,*)' Variable 3D enregistree dans le fichier diachronique ',&
247      &CRECFM2T(JJ,K),' size et IIU,IJU,3e DIMENSION,IKU ',NSIZT(JJ,K),IIU,IJU,IKU,NKMAX+2*JPVEXT
248             IF(CSTORAGE_TYPE == 'PG' .OR. CSTORAGE_TYPE == 'SU')THEN
249               WRITE(NLUOUTD,*)' cas d un fichier physiographique: niveaux supplementaires de 1 a ',IKU
250             ELSE
251               WRITE(NLUOUTD,*)' consideree comme une matrice partielle en K dont seuls les niveaux 1 a ',IKU,' sont enregistres'
252             END IF
253           ENDIF
254         ENDIF
255       ENDIF
256     ENDIF
257     !
258 !
259 ! Allocation de la zone tampon de lecture
260     ALLOCATE(ZTAB(NSIZT(JJ,K)))
261     ! LPACK n intervient pas dans cette maniere de lire (ZTAB est 1D)
262 !
263 ! Lecture de l'article concerne (CRECFM2T(JJ,K))
264     CALL FMREAD(CNAMFILED(K),CRECFM2T(JJ,K),CLUOUTD,NSIZT(JJ,K), &
265       ZTAB,IGRID,ILENCH,YCOMMENT,IRESP)
266     YCOMMENT=ADJUSTL(ADJUSTR(YCOMMENT))
267     CGROUP(1:LEN(CGROUP))=' '
268     CGROUP=CRECFM2T(JJ,K)
269     CGROUP=ADJUSTL(CGROUP)
270 !
271 ! 051296 Modifs pour enregistrer le relief ZS egalement sous le nom ZSBIS
272     IF(CGROUP(1:LEN_TRIM(CGROUP)) == 'ZS')THEN
273       CRECFM2T(JJ,K)='ZSBIS'
274       CGROUP='ZSBIS'
275     ENDIF
276 ! 120106 idem pour le smooth relief
277     IF(CGROUP(1:LEN_TRIM(CGROUP)) == 'ZSMT')THEN
278       CRECFM2T(JJ,K)='ZSMTBIS'
279       CGROUP='ZSMTBIS'
280     ENDIF
281 !
282 ! Extraction des unites du champ commentaire
283   YCAROUT(1:LEN(YCAROUT))=' '
284   IF (LEN_TRIM(YCOMMENT)/=0) &
285     CALL RESOLV_UNITS(YCOMMENT(1:LEN_TRIM(YCOMMENT)),YCAROUT)
286 !
287 !
288 !*       2.1  ++++3D + 2D H + 2D V et 1D // X+++++
289 !
290 ! Traitement informations 3D et 2D Horiz. Sont considerees de type CART
291 ! dans le fichier diachronique
292 ! (En realite si on W en 2D, on recupere le 2D plan et filaire 
293 ! (3D + 2D avec les points de garde) et si on W
294 ! en 1D on recupere 1 profil vertical (3D avec les points de garde) et
295 ! peut-etre 1 scalaire avec des points de garde horiz. (2D)) A VERIFIER
296
297 ! 130198 Ajout 2D Vertical surfacique + filaire // X
298 !   IF(NSIZT(JJ,K) == IIU*IJU*IKU)THEN
299     IF(NSIZT(JJ,K)*IMULT == IIU*IJU*IKU)THEN
300       IF(IMULT /= 1)THEN
301         IF(IMULT == (2*JPHEXT+NIMAX)*(2*JPHEXT+NJMAX))THEN
302 ! 180703 Cas 1D Vertical ou seul le profil central est enregistre
303 !         si pas de duplication du profil sur les points de garde:
304 !         ITAB3(1)=1; ITAB3(2)=1; ITAB3(3)=IKU
305 !         ALLOCATE(ZTAB3(ITAB3(1),ITAB3(2),ITAB3(3)))
306 !         ZTAB3=RESHAPE(ZTAB,ITAB3)
307 !        il faut dupliquer car type CART:
308           ITAB3(1)=1 ; ITAB3(2)=1 ; ITAB3(3)=IKU
309           ALLOCATE(ZTABM3(ITAB3(1),ITAB3(2),ITAB3(3)))
310           ZTABM3=RESHAPE(ZTAB,ITAB3)
311           ITAB3(1)=2*JPHEXT+NIMAX ; ITAB3(2)=2*JPHEXT+NJMAX ; ITAB3(3)=IKU
312           IF (ALLOCATED(ZTAB3)) DEALLOCATE(ZTAB3)
313           ALLOCATE(ZTAB3(ITAB3(1),ITAB3(2),ITAB3(3)))
314           DO J=1,ITAB3(2)
315           DO I=1,ITAB3(1)
316             ZTAB3(I,J,:)=ZTABM3(1,1,:)
317           ENDDO
318           ENDDO
319           DEALLOCATE(ZTABM3)
320         ELSE
321 ! 130198 Cas 2D Vertical // X ou seul le plan central est enregistre
322 !        Duplication du plan sur les points de garde
323           ITAB3(1)=IIU; ITAB3(2)=1; ITAB3(3)=IKU
324           ALLOCATE(ZTABM3(ITAB3(1),ITAB3(2),ITAB3(3)))
325           ZTABM3=RESHAPE(ZTAB,ITAB3)
326           IF (ALLOCATED(ZTAB3)) DEALLOCATE(ZTAB3)
327           ITAB3(1)=IIU; ITAB3(2)=IJU; ITAB3(3)=IKU
328           ALLOCATE(ZTAB3(ITAB3(1),ITAB3(2),ITAB3(3)))
329           DO J=1,ITAB3(2)
330             ZTAB3(:,J,:)=ZTABM3(:,1,:)
331           ENDDO
332           DEALLOCATE(ZTABM3)
333         END IF
334       ELSE ! Variable 3D normale IKU= NKMAX+2*JPVEXT IMULT=1 
335         ITAB3(1)=IIU; ITAB3(2)=IJU; ITAB3(3)=IKU
336         IF (ALLOCATED(ZTAB3)) DEALLOCATE(ZTAB3)
337         ALLOCATE(ZTAB3(ITAB3(1),ITAB3(2),ITAB3(3)))
338         ZTAB3=RESHAPE(ZTAB,ITAB3)
339       ENDIF
340 !
341 ! Dans ce pg de conversion, on considere que chaque variable (prognostique,
342 ! diagnostique, generique represente a elle seule un groupe a 1 processus
343 ! (--> indice de processus = 1)
344 ! On affecte (arbitrairement) le meme nom au groupe et au processus
345       IF(K == 1)THEN      
346         CTYPE='CART'
347 ! resolution degradee
348         IF (PRESENT(KX)) THEN
349         IF (KX>1.AND.NIMAX/=1) ITAB3(1)=(IIU-1)/KX +1 
350         ENDIF
351         IF (PRESENT(KY)) THEN
352         IF (KY>1.AND.NJMAX/=1) ITAB3(2)=(IJU-1)/KY +1 
353         ENDIF
354         IF (PRESENT(KZ)) THEN
355         IF (KZ>1)              ITAB3(3)=(IKU-1)/KZ +1
356         ENDIF
357 ! Allocation des matrices utilisees dans le fichier diachronique (dernier
358 ! argument = 1 pour ecriture; = 2 pour lecture; si =3, desallocation)
359         CALL ALLOC_FORDIACHRO(ITAB3(1),ITAB3(2),ITAB3(3),NNBF,1,1,1)
360 ! Initialisation de variables et matrices
361         LICP=.FALSE. ; LJCP=.FALSE. ; LKCP=.FALSE.
362         NIL=1 ; NJL=1 ; NKL=1
363         NIH=ITAB3(1) ; NJH=ITAB3(2) ; NKH=ITAB3(3)
364         XVAR(:,:,:,:,:,:)=0.
365         XTRAJT(:,:)=0.
366         CTITRE(:)(1:LEN(CTITRE))=' '
367         CUNITE(:)(1:LEN(CUNITE))=' '
368         CCOMMENT(:)(1:LEN(CCOMMENT))=' '
369         XDATIME(:,:)=0.
370       ENDIF
371 !
372 ! Distinction 1er fichier et les suivants. Dans le premier cas on ecrit di-
373 ! -rectement dans le fic. diachronique et apres les avoir reorganisees les
374 ! informations lues. Dans les cas suivants, on relit d'abord les infos du
375 ! fic. diachron. pour les augmenter des nouvelles  fraichement lues avant
376 ! de les reecrire.
377 ! NOTA on a pris la precaution de prevoir des le depart une taille d'article
378 ! = a la dimension de la matrice traitee * par le nb de fichiers lus (NNBF)
379 !
380       IF (K == 1)THEN                   !************************************
381 ! resolution degradee
382         ! in:  ZTAB3, taille:IIU(ou 1),IJU(ou 1),IKU
383         ! out: XVAR,  taille:ITAB3
384         SELECT CASE(ixyz)
385         CASE (0)
386           XVAR(:,:,:,K,1,1)=ZTAB3
387         CASE (1)   !X
388           DO J3=1,SIZE(ZTAB3,3)
389           DO J2=1,SIZE(ZTAB3,2)
390             XVAR(:,J2,J3,K,1,1)=ZTAB3(1:IIU:KX,J2,J3)
391           END DO
392           END DO
393         CASE (10)  !Y
394           DO J3=1,SIZE(ZTAB3,3)
395           DO J1=1,SIZE(ZTAB3,1)
396             XVAR(J1,:,J3,K,1,1)=ZTAB3(J1,1:IJU:KY,J3)
397           END DO
398           END DO
399         CASE (11)  !X et Y
400           DO J3=1,SIZE(ZTAB3,3)
401             I2=0
402             DO J2=1,SIZE(ZTAB3,2),KY
403               I2=I2+1
404               XVAR(:,I2,J3,K,1,1)=ZTAB3(1:IIU:KX,J2,J3)
405             END DO
406             IF (I2>SIZE(XVAR,2)) THEN
407               print*,'cas xy: niveau ',J3,' debordement de tableau: ', &
408                      I2,SIZE(XVAR,2)
409               STOP
410             ENDIF
411           END DO
412         CASE (100) !Z
413           DO J2=1,SIZE(ZTAB3,2)
414           DO J1=1,SIZE(ZTAB3,1)
415             XVAR(J1,J2,:,K,1,1)=ZTAB3(J1,J2,1:IKU:KZ)
416           END DO
417           END DO
418         CASE (101) !X et Z
419           DO J2=1,SIZE(ZTAB3,2)
420             I1=0
421             DO J1=1,SIZE(ZTAB3,1),KX
422               I1=I1+1
423               XVAR(I1,J2,:,K,1,1)=ZTAB3(J1,J2,1:IKU:KZ)
424             END DO
425             IF (I1>SIZE(XVAR,1)) THEN
426               print*,'cas xz: colonne ',J2,' debordement de tableau: ', &
427                      I1,SIZE(XVAR,1)
428               STOP
429             ENDIF
430           END DO
431         CASE (110)  !Y et Z
432           DO J1=1,SIZE(ZTAB3,1)
433             I2=0
434             DO J2=1,SIZE(ZTAB3,2),KY
435               I2=I2+1
436               XVAR(J1,I2,:,K,1,1)=ZTAB3(J1,I2,1:IKU:KZ)
437               IF (I2>SIZE(XVAR,2)) THEN
438                 print*,'cas xy: ligne ',J1,' debordement de tableau: ', &
439                        I2,SIZE(XVAR,2)
440                 STOP
441               ENDIF
442             END DO
443           END DO
444         CASE (111)  !X, Y et Z
445           ALLOCATE(Z3D(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(ZTAB3,3)))
446           !first X et Y
447           DO J3=1,SIZE(ZTAB3,3)
448             I2=0
449             DO J2=1,SIZE(ZTAB3,2),KY
450               I2=I2+1
451               Z3D(:,I2,J3)=ZTAB3(1:IIU:KX,J2,J3)
452             END DO
453             IF (I2>SIZE(XVAR,2)) THEN
454               print*,'cas xyz: niveau ',J3,' debordement de tableau: ', &
455                      I2,SIZE(XVAR,2)
456               STOP
457             ENDIF
458           END DO
459           !then Z
460           DO J2=1,SIZE(XVAR,2)
461           DO J1=1,SIZE(XVAR,1)
462             XVAR(J1,J2,:,K,1,1)=Z3D(J1,J2,1:IKU:KZ)
463           END DO
464           END DO
465           DEALLOCATE(Z3D)
466         END SELECT
467 !
468 ! Le tps courant est transforme en temps relatif par / au debut de l'experience
469         CALL TEMPORAL_DIST(TDTCUR%TDATE%YEAR,TDTCUR%TDATE%MONTH, &
470           TDTCUR%TDATE%DAY,TDTCUR%TIME,TDTEXP%TDATE%YEAR,    &
471           TDTEXP%TDATE%MONTH,TDTEXP%TDATE%DAY,TDTEXP%TIME,           &
472           XTRAJT(K,1))
473         TZDTEXP=TDTEXP
474         CTITRE(1)=CGROUP
475         CUNITE(1)=ADJUSTL(YCAROUT)
476         CCOMMENT(1)=YCOMMENT
477         XDATIME(1,K)=TDTEXP%TDATE%YEAR; XDATIME(2,K)=TDTEXP%TDATE%MONTH
478         XDATIME(3,K)=TDTEXP%TDATE%DAY;  XDATIME(4,K)=TDTEXP%TIME
479         XDATIME(5,K)=TDTSEG%TDATE%YEAR; XDATIME(6,K)=TDTSEG%TDATE%MONTH
480         XDATIME(7,K)=TDTSEG%TDATE%DAY;  XDATIME(8,K)=TDTSEG%TIME
481         XDATIME(9,K)=TDTMOD%TDATE%YEAR; XDATIME(10,K)=TDTMOD%TDATE%MONTH
482         XDATIME(11,K)=TDTMOD%TDATE%DAY; XDATIME(12,K)=TDTMOD%TIME
483         XDATIME(13,K)=TDTCUR%TDATE%YEAR;XDATIME(14,K)=TDTCUR%TDATE%MONTH
484         XDATIME(15,K)=TDTCUR%TDATE%DAY; XDATIME(16,K)=TDTCUR%TIME
485 !
486 ! Ecriture dans le fichier diachronique
487         NGRIDIA(1)=IGRID
488         CALL WRITE_DIACHRO(HFILEDIA,HLUOUTDIA,CGROUP,CTYPE,NGRIDIA,XDATIME,XVAR, &
489           XTRAJT,CTITRE,CUNITE,CCOMMENT, &
490         LICP,LJCP,LKCP,NIL,NIH,NJL,NJH,NKL,NKH)
491 !
492 ! Desallocation des matrices
493         DEALLOCATE(ZTAB3)
494         CALL ALLOC_FORDIACHRO(IIU,IJU,IKU,NNBF,1,1,3)
495 !
496       ELSE                              !************************************
497 !
498 ! On relit les infos deja enregistrees du fichier diachronique en connaissant
499 ! le nom du groupe CGROUP=CRECFM2T(JJ,K)
500         CALL READ_DIACHRO(CFILEDIA,CLUOUTDIA,CGROUP)
501         SELECT CASE(ixyz)
502         CASE (0)
503           XVAR(:,:,:,K,1,1)=ZTAB3
504         CASE (1)   !X
505           DO J3=1,SIZE(ZTAB3,3)
506           DO J2=1,SIZE(ZTAB3,2)
507             XVAR(:,J2,J3,K,1,1)=ZTAB3(1:IIU:KX,J2,J3)
508           END DO
509           END DO
510         CASE (10)  !Y
511           DO J3=1,SIZE(ZTAB3,3)
512           DO J1=1,SIZE(ZTAB3,1)
513             XVAR(J1,:,J3,K,1,1)=ZTAB3(J1,1:IJU:KY,J3)
514           END DO
515           END DO
516         CASE (11)  !X et Y
517           DO J3=1,SIZE(ZTAB3,3)
518             I2=0
519             DO J2=1,SIZE(ZTAB3,2),KY
520               I2=I2+1
521               XVAR(:,I2,J3,K,1,1)=ZTAB3(1:IIU:KX,J2,J3)
522             END DO
523           END DO
524         CASE (100) !Z
525           DO J2=1,SIZE(ZTAB3,2)
526           DO J1=1,SIZE(ZTAB3,1)
527             XVAR(J1,J2,:,K,1,1)=ZTAB3(J1,J2,1:IKU:KZ)
528           END DO
529           END DO
530         CASE (101) !X et Z
531           DO J2=1,SIZE(ZTAB3,2)
532             I1=0
533             DO J1=1,SIZE(ZTAB3,1),KX
534               I1=I1+1
535               XVAR(I1,J2,:,K,1,1)=ZTAB3(J1,J2,1:IKU:KZ)
536             END DO
537           END DO
538         CASE (110)  !Y et Z
539           DO J1=1,SIZE(ZTAB3,1)
540             I2=0
541             DO J2=1,SIZE(ZTAB3,2),KY
542               I2=I2+1
543               XVAR(J1,I2,:,K,1,1)=ZTAB3(J1,I2,1:IKU:KZ)
544             END DO
545           END DO
546         CASE (111)  !X, Y et Z
547           ALLOCATE(Z3D(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(ZTAB3,3)))
548           !first X et Y
549           DO J3=1,SIZE(ZTAB3,3)
550             I2=0
551             DO J2=1,SIZE(ZTAB3,2),KY
552               I2=I2+1
553               Z3D(:,I2,J3)=ZTAB3(1:IIU:KX,J2,J3)
554             END DO
555           END DO
556           !then Z
557           DO J2=1,SIZE(XVAR,2)
558           DO J1=1,SIZE(XVAR,1)
559             XVAR(J1,J2,:,K,1,1)=Z3D(J1,J2,1:IKU:KZ)
560           END DO
561           END DO
562           DEALLOCATE(Z3D)
563         END SELECT
564         CALL TEMPORAL_DIST(TDTCUR%TDATE%YEAR,TDTCUR%TDATE%MONTH, &
565           TDTCUR%TDATE%DAY,TDTCUR%TIME,TDTEXP%TDATE%YEAR,    &
566           TDTEXP%TDATE%MONTH,TDTEXP%TDATE%DAY,TDTEXP%TIME,           &
567         XTRAJT(K,1))
568         IF (CSTORAGE_TYPE=='TT') THEN
569           CALL TEMPORAL_DIST(TDTCUR%TDATE%YEAR,TDTCUR%TDATE%MONTH, &
570             TDTCUR%TDATE%DAY,TDTCUR%TIME,TZDTEXP%TDATE%YEAR,    &
571             TZDTEXP%TDATE%MONTH,TZDTEXP%TDATE%DAY,TZDTEXP%TIME,        &
572           XTRAJT(K,1))
573           WRITE(NLUOUTD,*) &
574           ' WRITE_OTHERSFIELDS calcul de XTRAJT par rapport au 1er fichier ',XTRAJT(K,1)
575         END IF
576         XDATIME(1,K)=TDTEXP%TDATE%YEAR; XDATIME(2,K)=TDTEXP%TDATE%MONTH
577         XDATIME(3,K)=TDTEXP%TDATE%DAY;  XDATIME(4,K)=TDTEXP%TIME
578         XDATIME(5,K)=TDTSEG%TDATE%YEAR; XDATIME(6,K)=TDTSEG%TDATE%MONTH
579         XDATIME(7,K)=TDTSEG%TDATE%DAY;  XDATIME(8,K)=TDTSEG%TIME
580         XDATIME(9,K)=TDTMOD%TDATE%YEAR; XDATIME(10,K)=TDTMOD%TDATE%MONTH
581         XDATIME(11,K)=TDTMOD%TDATE%DAY; XDATIME(12,K)=TDTMOD%TIME
582         XDATIME(13,K)=TDTCUR%TDATE%YEAR;XDATIME(14,K)=TDTCUR%TDATE%MONTH
583         XDATIME(15,K)=TDTCUR%TDATE%DAY; XDATIME(16,K)=TDTCUR%TIME
584 !
585         WRITE(ILUOUTDIA,*)' OTHERSFIELDS IGRID XVAR,XTRAJT,CTITRE,CUNITE,CCOMMENT'
586         WRITE(ILUOUTDIA,*)IGRID,SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),SIZE(XVAR,4), &
587         SIZE(XVAR,5),SIZE(XVAR,6),'  ',SIZE(XTRAJT,1),SIZE(XTRAJT,2),XTRAJT
588         WRITE(ILUOUTDIA,*)(CTITRE(J)(1:LEN(CTITRE)),J=1,SIZE(CTITRE))
589         WRITE(ILUOUTDIA,*)(CUNITE(J)(1:LEN(CUNITE)),J=1,SIZE(CUNITE))
590         WRITE(ILUOUTDIA,*)(CCOMMENT(J)(1:LEN(CCOMMENT)),J=1,SIZE(CCOMMENT))
591
592 ! Ecriture dans le fichier diachronique
593         NGRIDIA(1)=IGRID
594         CALL WRITE_DIACHRO(HFILEDIA,HLUOUTDIA,CGROUP,CTYPE,NGRIDIA,XDATIME,XVAR, &
595         XTRAJT,CTITRE,CUNITE,CCOMMENT, &
596         LICP,LJCP,LKCP,NIL,NIH,NJL,NJH,NKL,NKH)
597
598 ! Desallocation des matrices
599         DEALLOCATE(ZTAB3)
600         CALL ALLOC_FORDIACHRO(IIU,IJU,IKU,NNBF,1,1,3)
601
602       ENDIF                             !************************************
603 !
604 !
605 !*       2.2  ++++2D+++++
606 !
607 ! Traitement des infos 2D (Traite avec le 3D)
608 !   ELSE IF(NSIZT(JJ,K) == IIU*IJU)THEN
609 !
610 !
611 !*       2.3  ++++1D // Z+++++
612 !
613 ! Traitement des infos 1D
614     ELSE IF(NSIZT(JJ,K) == IKU)THEN
615       WRITE(NLUOUTD,*)'***************************************************************'
616       WRITE(NLUOUTD,*)' Variable 1D rencontree et enregistree dans le fichier',&
617       &' diachronique ',CGROUP,' size et IKU ',NSIZT(JJ,K),IKU
618       WRITE(NLUOUTD,*)'***************************************************************'
619       ITAB3(1)=1; ITAB3(2)=1; ITAB3(3)=IKU
620       IF(ALLOCATED(ZTAB3))THEN
621         DEALLOCATE(ZTAB3)
622       ENDIF
623       ALLOCATE(ZTAB3(ITAB3(1),ITAB3(2),ITAB3(3)))
624       ZTAB3=RESHAPE(ZTAB,ITAB3)
625 !
626       IF(K == 1)THEN      
627         CTYPE='CART'
628 ! resolution degradee
629         IF (PRESENT(KZ)) THEN
630         IF (KZ>1)              ITAB3(3)=(IKU-1)/KZ +1
631         ENDIF
632 ! Allocation des matrices utilisees dans le fichier diachronique (dernier
633 ! argument = 1 pour ecriture; = 2 pour lecture; si =3, desallocation)
634         CALL ALLOC_FORDIACHRO(ITAB3(1),ITAB3(2),ITAB3(3),NNBF,1,1,1)
635 ! Initialisation de variables et matrices
636         LICP=.FALSE. ; LJCP=.FALSE. ; LKCP=.FALSE.
637         NIL=JPHEXT ; NJL=JPHEXT ; NKL=1
638         NIH=JPHEXT ; NJH=JPHEXT ; NKH=ITAB3(3)
639         XVAR(:,:,:,:,:,:)=0.
640         XTRAJT(:,:)=0.
641         CTITRE(:)(1:LEN(CTITRE))=' '
642         CUNITE(:)(1:LEN(CUNITE))=' '
643         CCOMMENT(:)(1:LEN(CCOMMENT))=' '
644         XDATIME(:,:)=0
645       ENDIF
646 !
647 ! Distinction 1er fichier et les suivants. Dans le premier cas on ecrit di-
648 ! -rectement dans le fic. diachronique et apres les avoir reorganisees les
649 ! informations lues. Dans les cas suivants, on relit d'abord les infos du
650 ! fic. diachron. pour les augmenter des nouvelles  fraichement lues avant
651 ! de les reecrire.
652 ! NOTA on a pris la precaution de prevoir des le depart une taille d'article
653 ! = a la dimension de la matrice traitee * par le nb de fichiers lus (NNBF)
654 !
655       IF (K == 1)THEN                   !************************************
656         IF (PRESENT(KZ)) THEN
657         DO J2=1,SIZE(ZTAB3,2)
658         DO J1=1,SIZE(ZTAB3,1)
659           XVAR(J1,J2,:,K,1,1)=ZTAB3(J1,J2,1:IKU:KZ)
660         END DO
661         END DO
662         ELSE
663         XVAR(:,:,:,K,1,1)=ZTAB3
664         ENDIF
665 !
666 ! Le tps courant est transforme en temps relatif par / au debut de l'experience
667         CALL TEMPORAL_DIST(TDTCUR%TDATE%YEAR,TDTCUR%TDATE%MONTH, &
668           TDTCUR%TDATE%DAY,TDTCUR%TIME,TDTEXP%TDATE%YEAR,    &
669           TDTEXP%TDATE%MONTH,TDTEXP%TDATE%DAY,TDTEXP%TIME,           &
670           XTRAJT(K,1))
671         CTITRE(1)=CGROUP
672         CUNITE(1)=ADJUSTL(YCAROUT)
673         CCOMMENT(1)=YCOMMENT
674         XDATIME(1,K)=TDTEXP%TDATE%YEAR; XDATIME(2,K)=TDTEXP%TDATE%MONTH
675         XDATIME(3,K)=TDTEXP%TDATE%DAY;  XDATIME(4,K)=TDTEXP%TIME
676         XDATIME(5,K)=TDTSEG%TDATE%YEAR; XDATIME(6,K)=TDTSEG%TDATE%MONTH
677         XDATIME(7,K)=TDTSEG%TDATE%DAY;  XDATIME(8,K)=TDTSEG%TIME
678         XDATIME(9,K)=TDTMOD%TDATE%YEAR; XDATIME(10,K)=TDTMOD%TDATE%MONTH
679         XDATIME(11,K)=TDTMOD%TDATE%DAY; XDATIME(12,K)=TDTMOD%TIME
680         XDATIME(13,K)=TDTCUR%TDATE%YEAR;XDATIME(14,K)=TDTCUR%TDATE%MONTH
681         XDATIME(15,K)=TDTCUR%TDATE%DAY; XDATIME(16,K)=TDTCUR%TIME
682
683 ! Ecriture dans le fichier diachronique
684         NGRIDIA(1)=IGRID
685         CALL WRITE_DIACHRO(HFILEDIA,HLUOUTDIA,CGROUP,CTYPE,NGRIDIA,XDATIME,XVAR, &
686         XTRAJT,CTITRE,CUNITE,CCOMMENT, &
687         LICP,LJCP,LKCP,NIL,NIH,NJL,NJH,NKL,NKH)
688
689 ! Desallocation des matrices
690         DEALLOCATE(ZTAB3)
691         CALL ALLOC_FORDIACHRO(1,1,IKU,NNBF,1,1,3)
692 !     
693       ELSE                              !************************************
694 !
695 ! On relit les infos deja enregistrees du fichier diachronique en connaissant
696 ! le nom du groupe CGROUP=CRECFM2T(JJ,K)
697         CALL READ_DIACHRO(CFILEDIA,CLUOUTDIA,CGROUP)
698         IF (PRESENT(KZ)) THEN
699         DO J2=1,SIZE(ZTAB3,2)
700         DO J1=1,SIZE(ZTAB3,1)
701           XVAR(J1,J2,:,K,1,1)=ZTAB3(J1,J2,1:IKU:KZ)
702         END DO
703         END DO
704         ELSE
705         XVAR(:,:,:,K,1,1)=ZTAB3
706         ENDIF
707         CALL TEMPORAL_DIST(TDTCUR%TDATE%YEAR,TDTCUR%TDATE%MONTH, &
708           TDTCUR%TDATE%DAY,TDTCUR%TIME,TDTEXP%TDATE%YEAR,    &
709           TDTEXP%TDATE%MONTH,TDTEXP%TDATE%DAY,TDTEXP%TIME,           &
710           XTRAJT(K,1))
711         XDATIME(1,K)=TDTEXP%TDATE%YEAR; XDATIME(2,K)=TDTEXP%TDATE%MONTH
712         XDATIME(3,K)=TDTEXP%TDATE%DAY;  XDATIME(4,K)=TDTEXP%TIME
713         XDATIME(5,K)=TDTSEG%TDATE%YEAR; XDATIME(6,K)=TDTSEG%TDATE%MONTH
714         XDATIME(7,K)=TDTSEG%TDATE%DAY;  XDATIME(8,K)=TDTSEG%TIME
715         XDATIME(9,K)=TDTMOD%TDATE%YEAR; XDATIME(10,K)=TDTMOD%TDATE%MONTH
716         XDATIME(11,K)=TDTMOD%TDATE%DAY; XDATIME(12,K)=TDTMOD%TIME
717         XDATIME(13,K)=TDTCUR%TDATE%YEAR;XDATIME(14,K)=TDTCUR%TDATE%MONTH
718         XDATIME(15,K)=TDTCUR%TDATE%DAY; XDATIME(16,K)=TDTCUR%TIME
719   
720         WRITE(ILUOUTDIA,*)' OTHERSFIELDS IGRID XVAR,XTRAJT,CTITRE,CUNITE,CCOMMENT'
721         WRITE(ILUOUTDIA,*)IGRID,SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),SIZE(XVAR,4), &
722         SIZE(XVAR,5),SIZE(XVAR,6),'  ',SIZE(XTRAJT,1),SIZE(XTRAJT,2)
723         WRITE(ILUOUTDIA,*)(CTITRE(J)(1:LEN(CTITRE)),J=1,SIZE(CTITRE))
724         WRITE(ILUOUTDIA,*)(CUNITE(J)(1:LEN(CUNITE)),J=1,SIZE(CUNITE))
725         WRITE(ILUOUTDIA,*)(CCOMMENT(J)(1:LEN(CCOMMENT)),J=1,SIZE(CCOMMENT))
726 !
727 ! Ecriture dans le fichier diachronique
728         NGRIDIA(1)=IGRID
729         CALL WRITE_DIACHRO(HFILEDIA,HLUOUTDIA,CGROUP,CTYPE,NGRIDIA,XDATIME,XVAR, &
730         XTRAJT,CTITRE,CUNITE,CCOMMENT, &
731         LICP,LJCP,LKCP,NIL,NIH,NJL,NJH,NKL,NKH)
732 !
733 ! Desallocation des matrices
734         DEALLOCATE(ZTAB3)
735         CALL ALLOC_FORDIACHRO(1,1,IKU,NNBF,1,1,3)
736 !
737       ENDIF                             !************************************
738 !
739 !
740 !*       2.4  ++++0D+++++
741 !
742 ! Traitement des scalaires 'individuels'
743     ELSE IF(NSIZT(JJ,K) == 1)THEN
744 !     WRITE(NLUOUTD,*)'***************************************************************'
745 !     WRITE(NLUOUTD,*)' Scalaire rencontre et non enregistre dans le fichier',&
746 !     WRITE(NLUOUTD,*)' Scalaire rencontre et enregistre dans le fichier',&
747 !     &' diachronique ',CGROUP,' size ',NSIZT(JJ,K)
748 !     WRITE(NLUOUTD,*)' Prevenir J.DURON . Mail: durj@aero.obs-mip.fr '
749 !     Prise en compte de certains temps 
750 !     WRITE(NLUOUTD,*)'***************************************************************'
751       IPCENT=0
752       IPCENT=INDEX(CRECFM2T(JJ,K),'%TIM')
753       IF(IPCENT /= 0)THEN                      !===================
754         CALL FMWRIT(HFILEDIA,CGROUP,HLUOUTDIA,NSIZT(JJ,K),ZTAB,IGRID,&
755         ILYCOMM,YCOMM,IRESP)
756 !       ILENCH,YCOMMENT,IRESP)
757         CALL ELIM(CRECFM2T(JJ,K))
758         print *,' Impression pour controle ',CGROUP,ZTAB,' size ', &
759         NSIZT(JJ,K)
760       ELSE                                 !===================
761 !
762         ITAB3(1)=1; ITAB3(2)=1; ITAB3(3)=1
763         IF(ALLOCATED(ZTAB3))THEN
764           DEALLOCATE(ZTAB3)
765         ENDIF
766         ALLOCATE(ZTAB3(ITAB3(1),ITAB3(2),ITAB3(3)))
767         ZTAB3=RESHAPE(ZTAB,ITAB3)
768 !
769         IF(K == 1)THEN      
770           CTYPE='CART'
771 !
772 ! Allocation des matrices utilisees dans le fichier diachronique (dernier
773 ! argument = 1 pour ecriture; = 2 pour lecture; si =3, desallocation)
774 !
775           CALL ALLOC_FORDIACHRO(ITAB3(1),ITAB3(2),ITAB3(3),NNBF,1,1,1)
776
777 ! Initialisation de variables et matrices
778           LICP=.FALSE. ; LJCP=.FALSE. ; LKCP=.FALSE.
779           NIL=1 ; NJL=1 ; NKL=1
780           NIH=1 ; NJH=1 ; NKH=1
781           XVAR(:,:,:,:,:,:)=0.
782           XTRAJT(:,:)=0.
783           CTITRE(:)(1:LEN(CTITRE))=' '
784           CUNITE(:)(1:LEN(CUNITE))=' '
785           CCOMMENT(:)(1:LEN(CCOMMENT))=' '
786           XDATIME(:,:)=0
787         ENDIF
788 !
789 ! Distinction 1er fichier et les suivants. Dans le premier cas on ecrit di-
790 ! -rectement dans le fic. diachronique et apres les avoir reorganisees les
791 ! informations lues. Dans les cas suivants, on relit d'abord les infos du
792 ! fic. diachron. pour les augmenter des nouvelles  fraichement lues avant
793 ! de les reecrire.
794 ! NOTA on a pris la precaution de prevoir des le depart une taille d'article
795 ! = a la dimension de la matrice traitee * par le nb de fichiers lus (NNBF)
796 !
797         IF (K == 1)THEN                   !************************************
798           XVAR(:,:,:,K,1,1)=ZTAB3
799 !
800 ! Le tps courant est transforme en temps relatif par / au debut de l'experience
801           CALL TEMPORAL_DIST(TDTCUR%TDATE%YEAR,TDTCUR%TDATE%MONTH, &
802             TDTCUR%TDATE%DAY,TDTCUR%TIME,TDTEXP%TDATE%YEAR,    &
803             TDTEXP%TDATE%MONTH,TDTEXP%TDATE%DAY,TDTEXP%TIME,           &
804             XTRAJT(K,1))
805           CTITRE(1)=CGROUP
806           CUNITE(1)=ADJUSTL(YCAROUT)
807           CCOMMENT(1)=YCOMMENT
808           XDATIME(1,K)=TDTEXP%TDATE%YEAR; XDATIME(2,K)=TDTEXP%TDATE%MONTH
809           XDATIME(3,K)=TDTEXP%TDATE%DAY;  XDATIME(4,K)=TDTEXP%TIME
810           XDATIME(5,K)=TDTSEG%TDATE%YEAR; XDATIME(6,K)=TDTSEG%TDATE%MONTH
811           XDATIME(7,K)=TDTSEG%TDATE%DAY;  XDATIME(8,K)=TDTSEG%TIME
812           XDATIME(9,K)=TDTMOD%TDATE%YEAR; XDATIME(10,K)=TDTMOD%TDATE%MONTH
813           XDATIME(11,K)=TDTMOD%TDATE%DAY; XDATIME(12,K)=TDTMOD%TIME
814           XDATIME(13,K)=TDTCUR%TDATE%YEAR;XDATIME(14,K)=TDTCUR%TDATE%MONTH
815           XDATIME(15,K)=TDTCUR%TDATE%DAY; XDATIME(16,K)=TDTCUR%TIME
816 !
817 ! Ecriture dans le fichier diachronique
818           NGRIDIA(1)=IGRID
819           CALL WRITE_DIACHRO(HFILEDIA,HLUOUTDIA,CGROUP,CTYPE,NGRIDIA,XDATIME,XVAR, &
820             XTRAJT,CTITRE,CUNITE,CCOMMENT, &
821             LICP,LJCP,LKCP,NIL,NIH,NJL,NJH,NKL,NKH)
822 !
823 ! Desallocation des matrices
824           DEALLOCATE(ZTAB3)
825           CALL ALLOC_FORDIACHRO(1,1,1,NNBF,1,1,3)
826 !
827         ELSE                              !************************************
828 !
829 ! On relit les infos deja enregistrees du fichier diachronique en connaissant
830 ! le nom du groupe CGROUP=CRECFM2T(JJ,K)
831           CALL READ_DIACHRO(CFILEDIA,CLUOUTDIA,CGROUP)
832           XVAR(:,:,:,K,1,1)=ZTAB3
833           CALL TEMPORAL_DIST(TDTCUR%TDATE%YEAR,TDTCUR%TDATE%MONTH, &
834             TDTCUR%TDATE%DAY,TDTCUR%TIME,TDTEXP%TDATE%YEAR,    &
835             TDTEXP%TDATE%MONTH,TDTEXP%TDATE%DAY,TDTEXP%TIME,           &
836             XTRAJT(K,1))
837           XDATIME(1,K)=TDTEXP%TDATE%YEAR; XDATIME(2,K)=TDTEXP%TDATE%MONTH
838           XDATIME(3,K)=TDTEXP%TDATE%DAY;  XDATIME(4,K)=TDTEXP%TIME
839           XDATIME(5,K)=TDTSEG%TDATE%YEAR; XDATIME(6,K)=TDTSEG%TDATE%MONTH
840           XDATIME(7,K)=TDTSEG%TDATE%DAY;  XDATIME(8,K)=TDTSEG%TIME
841           XDATIME(9,K)=TDTMOD%TDATE%YEAR; XDATIME(10,K)=TDTMOD%TDATE%MONTH
842           XDATIME(11,K)=TDTMOD%TDATE%DAY; XDATIME(12,K)=TDTMOD%TIME
843           XDATIME(13,K)=TDTCUR%TDATE%YEAR;XDATIME(14,K)=TDTCUR%TDATE%MONTH
844           XDATIME(15,K)=TDTCUR%TDATE%DAY; XDATIME(16,K)=TDTCUR%TIME
845
846           WRITE(ILUOUTDIA,*)' OTHERSFIELDS IGRID XVAR,XTRAJT,CTITRE,CUNITE,CCOMMENT'
847           WRITE(ILUOUTDIA,*)IGRID,SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),SIZE(XVAR,4), &
848           SIZE(XVAR,5),SIZE(XVAR,6),'  ',SIZE(XTRAJT,1),SIZE(XTRAJT,2)
849           WRITE(ILUOUTDIA,*)(CTITRE(J)(1:LEN(CTITRE)),J=1,SIZE(CTITRE))
850           WRITE(ILUOUTDIA,*)(CUNITE(J)(1:LEN(CUNITE)),J=1,SIZE(CUNITE))
851           WRITE(ILUOUTDIA,*)(CCOMMENT(J)(1:LEN(CCOMMENT)),J=1,SIZE(CCOMMENT))
852 !
853 ! Ecriture dans le fichier diachronique
854           NGRIDIA(1)=IGRID
855           CALL WRITE_DIACHRO(HFILEDIA,HLUOUTDIA,CGROUP,CTYPE,NGRIDIA,XDATIME,XVAR, &
856           XTRAJT,CTITRE,CUNITE,CCOMMENT, &
857           LICP,LJCP,LKCP,NIL,NIH,NJL,NJH,NKL,NKH)
858 !
859 ! Desallocation des matrices
860           DEALLOCATE(ZTAB3)
861           CALL ALLOC_FORDIACHRO(1,1,1,NNBF,1,1,3)
862
863         ENDIF                             !************************************
864       ENDIF                             !===============
865 !
866 !
867 !*       2.5  ++++  +++++
868 !
869 ! Impression des infos non recensees
870 !
871     ELSE
872 !     Some dates are taken into account
873       IPCENT=0
874       IPCENT=INDEX(CRECFM2T(JJ,K),'%TDA')
875       IF(IPCENT /= 0)THEN                      !===================
876         CALL FMWRIT(HFILEDIA,CGROUP,HLUOUTDIA,NSIZT(JJ,K),ZTAB,IGRID,&
877         ILYCOMM,YCOMM,IRESP)
878 !       ILENCH,YCOMMENT,IRESP)
879         CALL ELIM(CRECFM2T(JJ,K))
880         print *,' Impression pour controle ',CGROUP,ZTAB,' size ',NSIZT(JJ,K)
881       ELSE
882         WRITE(NLUOUTD,*)'***************************************************************'
883         WRITE(NLUOUTD,*)' Variable non prise en compte dans le fichier diachronique ',&
884         CGROUP,' size ',NSIZT(JJ,K),' IIU IJU IKU ',IIU,IJU,IKU
885         IF (LEN_TRIM(YCOMMENT) /=0) THEN
886           WRITE(NLUOUTD,*)' YCOMMENT=',YCOMMENT(1:LEN_TRIM(YCOMMENT))
887         ELSE
888           WRITE(NLUOUTD,*)' YCOMMENT '
889         ENDIF
890         WRITE(NLUOUTD,*)'***************************************************************'
891       ENDIF
892     ENDIF
893 !
894 !
895 !*       2.6  ++++END+++++
896 !
897 !
898     DEALLOCATE(ZTAB)
899     IF(K == NNBF)THEN
900       WRITE(ILUOUTDIA,*)CRECFM2T(JJ,K),' TREATED with size ', NSIZT(JJ,K)*K*IMULT
901     ENDIF
902 !
903 !
904 !----------------------------------------------------------------------------
905 !
906 !*       3.    TREATMENT OF ELIMINATED VARIABLE
907 !              --------------------------------
908 !
909   ELSE
910     IPCENT=0
911     IPCENT=INDEX(CRECFM2T(JJ,K),'%TIM')
912     IF(IPCENT /= 0 .AND. K >1)THEN   
913       IF(INDEX(CRECFM2T(JJ,K),'TDTEXP%TDA') /= 0 .OR.      &
914          INDEX(CRECFM2T(JJ,K),'TDTEXP%TIM') /= 0 .OR.      &
915          INDEX(CRECFM2T(JJ,K),'TDTSEG%TDA') /= 0 .OR.      &
916          INDEX(CRECFM2T(JJ,K),'TDTSEG%TIM') /= 0 .OR.      &
917          INDEX(CRECFM2T(JJ,K),'TDTMOD%TDA') /= 0 .OR.      &
918          INDEX(CRECFM2T(JJ,K),'TDTMOD%TIM') /= 0 .OR.      &
919          INDEX(CRECFM2T(JJ,K),'TDTCUR%TDA') /= 0 .OR.      &
920          INDEX(CRECFM2T(JJ,K),'TDTCUR%TIM') /= 0)THEN
921       ELSE
922         ALLOCATE(ZTAB(NSIZT(JJ,K)))
923         CALL FMREAD(CNAMFILED(K),CRECFM2T(JJ,K),CLUOUTD,NSIZT(JJ,K), &
924         ZTAB,IGRID,ILENCH,YCOMMENT,IRESP)
925         print *,' CRECFM2T(JJ,K)  K= ',CRECFM2T(JJ,K),K,'  non enr. volontairement .'
926         DEALLOCATE(ZTAB)
927       ENDIF
928     ENDIF
929   ENDIF
930 !
931 ENDDO
932 !
933 LPACK=GPACK
934 !----------------------------------------------------------------------------
935 RETURN
936 !
937 END SUBROUTINE WRITE_OTHERSFIELDS