Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / mesonh / write_lfifm1_fordiachro_cv.f90
1 !     ######spl
2       MODULE MODI_WRITE_LFIFM1_FORDIACHRO_CV
3 !     ########################################
4 !
5 INTERFACE
6 !
7 SUBROUTINE WRITE_LFIFM1_FORDIACHRO_CV(HFMFILE)
8 CHARACTER(LEN=28), INTENT(IN) :: HFMFILE      ! Name of FM-file to write
9 END SUBROUTINE WRITE_LFIFM1_FORDIACHRO_CV
10 !
11 END INTERFACE
12 !
13 END MODULE MODI_WRITE_LFIFM1_FORDIACHRO_CV
14 !     ##############################################
15       SUBROUTINE WRITE_LFIFM1_FORDIACHRO_CV(HFMFILE)
16 !     ##############################################
17 !
18 !!****  *WRITE_LFIFM1_FORDIACHRO_CV* - routine  pour l'ecriture dans un
19 !!           fichier diachronique des dimensions, parametres de grille
20 !!           et etat de ref. lus dans les fichiers d'entree
21 !!
22 !!    PURPOSE
23 !!    -------
24 !        Voir la routine write_lfifmn_fordiachron de mesonh.
25 !        Ici (_CV pour conv) ecriture en plus de MY_NAME, DAD_NAME,
26 !      DXRATIO, DYRATIO, XOR, YOR, XEND, YEND, 
27 !      ainsi que traitement special pour ZS dans le cas 2D (recopie sur pts de
28 !      garde).
29 !
30 !!**  METHOD
31 !!    ------
32 !!      The data written in the LFIFM file are :
33 !!        - dimensions
34 !!        - grid variables
35 !!        - configuration variables
36 !!        - 1D anelastic reference state
37 !!
38 !!
39 !!    EXTERNAL
40 !!    --------
41 !!      FMWRIT : FM-routine to write a record
42 !!
43 !!
44 !!    IMPLICIT ARGUMENTS
45 !!    ------------------
46 !!      Module MODD_DIM1   : contains dimensions
47 !!      Module MODD_TIME1   : contains time variables and uses MODD_TIME
48 !!      Module MODD_GRID    : contains spatial grid variables for all models
49 !!      Module MODD_GRID1 : contains spatial grid variables
50 !!      Module MODD_REF     : contains reference state variables
51 !!      Module MODD_LUNIT1: contains logical unit variables.
52 !!      Module MODD_CONF    : contains configuration variables for all models
53 !!      Module MODD_CONF1  : contains configuration variables
54 !!      Module MODD_PARAM1    : contains parameterization options
55 !!
56 !!
57 !!    REFERENCE
58 !!    ---------
59 !!
60 !!
61 !!    AUTHOR
62 !!    ------
63 !!      V. Ducrocq   *Meteo France* 
64 !!
65 !!    MODIFICATIONS
66 !!    -------------
67 !!      Original    06/05/94 
68 !!       V. Ducrocq    27/06/94                  
69 !!       J.Stein       20/10/94 (name of the FMFILE)
70 !!       I. Mallet        09/04 for conv2dia: write MASDEV (for masdev4_6)
71 !-------------------------------------------------------------------------------
72 !
73 !*       0.    DECLARATIONS
74 !              ------------
75 !
76 USE MODD_CONF, ONLY: CPROGRAM,CSTORAGE_TYPE,LCARTESIAN,LTHINSHELL, &
77                      NMASDEV,NBUGFIX,L1D,L2D,LPACK 
78 USE MODD_DIM1, ONLY: NIMAX,NJMAX,NKMAX
79 USE MODD_GRID, ONLY: XRPK,XLON0,XLAT0,XBETA,XLONORI,XLATORI
80 USE MODD_GRID1, ONLY: XXHAT,XYHAT,XZHAT,XZS,XZSMT,LSLEVE,XLEN1,XLEN2
81 USE MODD_LUNIT1, ONLY: CLUOUT
82 USE MODD_PARAM1, ONLY: CSURF
83 USE MODD_TIME, ONLY: TDTEXP,TDTSEG
84 USE MODD_TIME1, ONLY: TDTCUR,TDTMOD
85 USE MODD_NESTING, ONLY: NDXRATIO_ALL,NDYRATIO_ALL, &
86                         NXOR_ALL,NYOR_ALL,NXEND_ALL,NYEND_ALL
87 USE MODD_PARAMETERS, ONLY: JPHEXT
88 !
89 USE MODD_DIACHRO, ONLY: CMY_NAME_DIA,CDAD_NAME_DIA
90 USE MODD_DIMGRID_FORDIACHRO
91 USE MODD_OUT_DIA
92 !
93 USE MODI_FMREAD 
94 USE MODI_FMWRIT 
95 !
96 USE MODE_GRIDPROJ
97 !
98 IMPLICIT NONE
99 !
100 !*       0.1   Declarations of arguments
101 !
102 CHARACTER(LEN=28), INTENT(IN) :: HFMFILE      ! Name of FM-file to write
103 !
104 !*       0.2   Declarations of local variables
105 !
106 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears 
107                                     !  at the open of the file                                                                      !  LFI  routines 
108 INTEGER           :: IGRID,ILENG    ! IGRID : grid indicator
109                                     ! ILENG : length of the data field  
110 INTEGER           :: ILENCH         ! ILENCH : length of comment string 
111 INTEGER           :: JT,JLOOP       ! loop index
112 INTEGER           :: J              ! loop index
113 !
114 CHARACTER(LEN=16) :: YRECFM         ! Name of the article to be written
115 CHARACTER(LEN=20) :: YCOMMENT       ! Comment string
116 CHARACTER(LEN=100) :: YCOMM       ! Comment string
117 !
118 REAL                              :: ZLATOR, ZLONOR ! geographical coordinates of 1st mass point
119 REAL                              :: ZXHATM, ZYHATM ! conformal    coordinates of 1st mass point
120 REAL, DIMENSION(:), ALLOCATABLE   :: ZXHAT_ll    !  Position x in the conformal
121                                                  ! plane (array on the complete domain)
122 REAL, DIMENSION(:), ALLOCATABLE   :: ZYHAT_ll    !   Position y in the conformal
123                                                  ! plane (array on the complete domain)
124 !
125 INTEGER, DIMENSION(3)  :: ITDATE      ! date array
126 INTEGER,DIMENSION(2)   :: ISTORAGE_TYPE
127 INTEGER, DIMENSION(28) :: INAME  ! name array for HFMFILE
128                                  ! and HDADFILE writing
129 REAL,DIMENSION(:),ALLOCATABLE,SAVE   :: ZXZS
130 REAL  :: ZTDATE      ! seconds
131 !
132 LOGICAL :: GPACK
133 !-------------------------------------------------------------------------------
134 !
135 !*       1.     WRITES IN THE LFI FILE
136 !               -----------------------
137 !
138 GPACK=LPACK
139 IF(L1D .OR. L2D) THEN
140   print*,'** Warning PACK forced to FALSE because of duplication **'
141   ! cf IMULT dans write_othersfields.f90
142   LPACK=.FALSE.
143 ENDIF
144 !*       1.0    Version :
145 !
146 YRECFM='MASDEV'
147 CALL ELIM(YRECFM)
148 YCOMMENT=' '
149 ILENG=1
150 IGRID=0
151 ILENCH=LEN(YCOMMENT)
152 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,NMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
153 !
154 YRECFM='BUGFIX'
155 CALL ELIM(YRECFM)
156 YCOMMENT=' '
157 ILENG=1
158 IGRID=0
159 ILENCH=LEN(YCOMMENT)
160 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,NBUGFIX,IGRID,ILENCH,YCOMMENT,IRESP)
161 !
162 YRECFM='L1D'
163 CALL ELIM(YRECFM)
164 YCOMMENT=' '
165 ILENG=1
166 IGRID=0
167 ILENCH=LEN(YCOMMENT)
168 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,L1D,IGRID,ILENCH,YCOMMENT,IRESP)
169 !
170 YRECFM='L2D'
171 CALL ELIM(YRECFM)
172 YCOMMENT=' '
173 ILENG=1
174 IGRID=0
175 ILENCH=LEN(YCOMMENT)
176 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,L2D,IGRID,ILENCH,YCOMMENT,IRESP)
177 !
178 YRECFM='PACK'
179 CALL ELIM(YRECFM)
180 YCOMMENT=' '
181 ILENG=1
182 IGRID=0
183 ILENCH=LEN(YCOMMENT)
184 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,LPACK,IGRID,ILENCH,YCOMMENT,IRESP)
185 !
186 YRECFM='SURF'
187 CALL ELIM(YRECFM)
188 YCOMMENT=' '
189 ILENG=4
190 IGRID=0
191 ILENCH=LEN(YCOMMENT)
192 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,CSURF,IGRID,ILENCH,YCOMMENT,IRESP)
193 !
194 !*       1.1    Dimensions :
195 !
196 YRECFM='MY_NAME'
197 CALL ELIM(YRECFM)
198 YCOMMENT=' '
199 ILENG=28
200 IGRID=0
201 ILENCH=LEN(YCOMMENT)
202 DO JLOOP=1,28
203  INAME(JLOOP)=IACHAR(CMY_NAME_DIA(JLOOP:JLOOP))
204 !INAME(JLOOP)=IACHAR(HFMFILE(JLOOP:JLOOP))
205 END DO
206 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,INAME,IGRID,ILENCH,YCOMMENT,IRESP)
207 !
208 YRECFM='DAD_NAME'
209 CALL ELIM(YRECFM)
210 YCOMMENT=' '
211 ILENG=28
212 IGRID=0
213 ILENCH=LEN(YCOMMENT)
214 DO JLOOP=1,28
215  INAME(JLOOP)=IACHAR(CDAD_NAME_DIA(JLOOP:JLOOP))
216 END DO
217 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,INAME,IGRID,ILENCH,YCOMMENT,IRESP)
218 !
219 IF (LEN_TRIM(CDAD_NAME_DIA)>0) THEN
220   CALL FMWRIT(HFMFILE,'DXRATIO',CLUOUT,1,NDXRATIO_ALL(1),0,ILENCH,YCOMMENT,IRESP)
221   CALL ELIM('DXRATIO')
222   CALL FMWRIT(HFMFILE,'DYRATIO',CLUOUT,1,NDYRATIO_ALL(1),0,ILENCH,YCOMMENT,IRESP)
223   CALL ELIM('DYRATIO')
224   CALL FMWRIT(HFMFILE,'XOR' ,CLUOUT,1,NXOR_ALL(1) ,0,ILENCH,YCOMMENT,IRESP)
225   CALL ELIM('XOR')
226   CALL FMWRIT(HFMFILE,'YOR' ,CLUOUT,1,NYOR_ALL(1) ,0,ILENCH,YCOMMENT,IRESP)
227   CALL ELIM('YOR')
228   CALL FMWRIT(HFMFILE,'XEND',CLUOUT,1,NXEND_ALL(1),0,ILENCH,YCOMMENT,IRESP)
229   CALL ELIM('XEND')
230   CALL FMWRIT(HFMFILE,'YEND',CLUOUT,1,NYEND_ALL(1),0,ILENCH,YCOMMENT,IRESP)
231   CALL ELIM('YEND')
232 END IF
233
234 YRECFM='STORAGE_TYPE'
235 CALL ELIM(YRECFM)
236 YCOMMENT=' '
237 ILENG=2
238 IGRID=0
239 ILENCH=LEN(YCOMMENT)
240 ISTORAGE_TYPE(1)=IACHAR(CSTORAGE_TYPE(1:1))
241 ISTORAGE_TYPE(2)=IACHAR(CSTORAGE_TYPE(2:2))
242 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,ISTORAGE_TYPE,IGRID,ILENCH,YCOMMENT,IRESP)
243 !
244 YRECFM='IMAX'
245 CALL ELIM(YRECFM)
246 YCOMMENT=' '
247 ILENG=1
248 IGRID=0
249 ILENCH=LEN(YCOMMENT)
250 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,NIMAX,IGRID,ILENCH,YCOMMENT,IRESP)
251 !
252 YRECFM='JMAX'
253 CALL ELIM(YRECFM)
254 YCOMMENT=' '
255 ILENG=1
256 IGRID=0
257 ILENCH=LEN(YCOMMENT)
258 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,NJMAX,IGRID,ILENCH,YCOMMENT,IRESP)
259 !
260 YRECFM='KMAX'
261 CALL ELIM(YRECFM)
262 YCOMMENT=' '
263 ILENG=1
264 IGRID=0
265 ILENCH=LEN(YCOMMENT)
266 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,NKMAX,IGRID,ILENCH,YCOMMENT,IRESP)
267 !
268 YRECFM='JPHEXT'
269 CALL ELIM(YRECFM)
270 YCOMMENT=' '
271 ILENG=1
272 IGRID=0
273 ILENCH=LEN(YCOMMENT)
274 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,JPHEXT,IGRID,ILENCH,YCOMMENT,IRESP)
275 !*       1.2    Grid variables :
276 !
277 IF (.NOT.LCARTESIAN) THEN
278
279   YRECFM='RPK'
280   CALL ELIM(YRECFM)
281   YCOMMENT=' '
282   ILENG=1
283   IGRID=0
284   ILENCH=LEN(YCOMMENT)
285   CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XRPK,IGRID,ILENCH,YCOMMENT,IRESP)
286
287   YRECFM='LONORI'
288   CALL ELIM(YRECFM)
289   YCOMMENT='DEGREES'
290   ILENG=1
291   IGRID=0
292   ILENCH=LEN(YCOMMENT)
293   CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XLONORI,IGRID,ILENCH,YCOMMENT,IRESP)
294 !
295   YRECFM='LATORI'
296   CALL ELIM(YRECFM)
297   YCOMMENT='DEGREES'
298   ILENG=1
299   IGRID=0
300   ILENCH=LEN(YCOMMENT)
301   CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XLATORI,IGRID,ILENCH,YCOMMENT,IRESP)
302 !
303 !* diagnostic of 1st mass point
304 !
305   !ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(NJMAX_ll+2 * JPHEXT))
306   !CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,IRESP) !//
307   !CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,IRESP) !//
308   !ZXHATM = 0.5 * (ZXHAT_ll(1)+ZXHAT_ll(2))
309   !ZYHATM = 0.5 * (ZYHAT_ll(1)+ZYHAT_ll(2))
310   ZXHATM = 0.5 * (XXHAT(1)+XXHAT(2))
311   ZYHATM = 0.5 * (XYHAT(1)+XYHAT(2))
312   CALL SM_LATLON(XLATORI,XLONORI,ZXHATM,ZYHATM,ZLATOR,ZLONOR)
313   !DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
314 !
315   YRECFM='LONOR'
316   CALL ELIM(YRECFM)
317   YCOMMENT='DEGREES'
318   ILENG=1
319   IGRID=0
320   ILENCH=LEN(YCOMMENT)
321   CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,ZLONOR,IGRID,ILENCH,YCOMMENT,IRESP)
322 !
323   YRECFM='LATOR'
324   CALL ELIM(YRECFM)
325   YCOMMENT='DEGREES'
326   ILENG=1
327   IGRID=0
328   ILENCH=LEN(YCOMMENT)
329   CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,ZLATOR,IGRID,ILENCH,YCOMMENT,IRESP)
330 END IF 
331 !
332 YRECFM='THINSHELL'
333 CALL ELIM(YRECFM)
334 YCOMMENT=' '
335 ILENG=1
336 IGRID=0
337 ILENCH=LEN(YCOMMENT)
338 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,LTHINSHELL,IGRID,ILENCH,YCOMMENT,IRESP)
339 !
340 YRECFM='LAT0'
341 CALL ELIM(YRECFM)
342 YCOMMENT='DEGREES'
343 ILENG=1
344 IGRID=0
345 ILENCH=LEN(YCOMMENT)
346 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XLAT0,IGRID,ILENCH,YCOMMENT,IRESP)
347 !
348 YRECFM='LON0'
349 CALL ELIM(YRECFM)
350 YCOMMENT='DEGREES'
351 ILENG=1
352 IGRID=0
353 ILENCH=LEN(YCOMMENT)
354 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XLON0,IGRID,ILENCH,YCOMMENT,IRESP)
355 !
356 YRECFM='BETA'
357 CALL ELIM(YRECFM)
358 YCOMMENT='DEGREES'
359 ILENG=1
360 IGRID=0
361 ILENCH=LEN(YCOMMENT)
362 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XBETA,IGRID,ILENCH,YCOMMENT,IRESP)
363
364 YRECFM='XHAT'
365 CALL ELIM(YRECFM)
366 YCOMMENT='METERS'
367 ILENG=SIZE(XXHAT)
368 IGRID=2
369 ILENCH=LEN(YCOMMENT)
370 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
371 !
372 YRECFM='YHAT'
373 CALL ELIM(YRECFM)
374 YCOMMENT='METERS'
375 ILENG=SIZE(XYHAT)
376 IGRID=3
377 ILENCH=LEN(YCOMMENT)
378 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
379 !
380 YRECFM='ZHAT'
381 CALL ELIM(YRECFM)
382 YCOMMENT='METERS'
383 ILENG=SIZE(XZHAT)
384 IGRID=4
385 ILENCH=LEN(YCOMMENT)
386 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XZHAT,IGRID,ILENCH,YCOMMENT,IRESP)
387 !
388 YRECFM='ZS'
389 ! 051296 Non elimine . Pour l'enregister avec le nom ZSBIS
390 !CALL ELIM(YRECFM)
391 YCOMMENT='METERS'
392 !print *,' NIMAX JPHEXT SIZE(XZS) ',NIMAX,JPHEXT,SIZE(XZS)
393 JT=0
394 DO J=1,NNB
395   IF(CRECFM2T(J,1) == 'ZS')THEN
396     JT=J
397     EXIT
398   ENDIF
399 ENDDO
400 !IF(JT /= 0 .AND.NSIZT(JT,1) == NIMAX+2*JPHEXT)THEN
401 ! expression evaluee l autre apres l autre
402 IF(JT /= 0 )THEN
403 IF(NSIZT(JT,1) == NIMAX+2*JPHEXT)THEN
404   ALLOCATE(ZXZS(NIMAX+2*JPHEXT))
405   ILENG=NIMAX+2*JPHEXT
406 ! Test sur la longueur du champ commentaire
407 ! Ajout le 4 Mai 2001 pour la prise en compte des commentaires >= 20 et <= 100
408 ! Cf instruction suivante apres .OR. -> Je charge dans un commentaire len=100
409   IF(NLENC(JT,1) == LEN(YCOMM) .OR. &
410     (NLENC(JT,1) > LEN(YCOMMENT).AND. NLENC(JT,1) <= LEN(YCOMM)))THEN
411     !IM!ILENCH=LEN(YCOMM) (output arg.)
412     CALL FMREAD(CNAMFILED(1),YRECFM,CLUOUT,ILENG,ZXZS,IGRID,ILENCH,YCOMM,IRESP)
413   ELSE IF(NLENC(JT,1) == LEN(YCOMMENT))THEN
414     !IM!ILENCH=LEN(YCOMMENT) (output arg.)
415     CALL FMREAD(CNAMFILED(1),YRECFM,CLUOUT,ILENG,ZXZS,IGRID,ILENCH,YCOMMENT,IRESP)
416   ELSE
417     print *,' Longueur du champ commentaire differente de 20 ou 100 . Imprevue ! ',NLENC(JT,1)
418   ENDIF
419 print *,' Size ZXZS ',SIZE(ZXZS)
420 print *,' Size XZS 1 2 ',SIZE(XZS,1),SIZE(XZS,2)
421   DO J=1,NJMAX+2*JPHEXT
422     XZS(1:SIZE(XZS,1),J)=ZXZS(:)
423   ENDDO
424 !print *,' XZS(60,:) ',XZS(60,:),XZS(150,:)
425   ILENG=SIZE(XZS)
426 ! print *,' XZS',XZS(:,1)
427 ! print *,' XZS',XZS(:,2)
428 ! print *,' XZS',XZS(:,3)
429 ELSE
430   ILENG=SIZE(XZS)
431 ENDIF
432 ENDIF
433 IF (JT==0 )THEN
434   ILENG=SIZE(XZS)
435 ENDIF
436 IGRID=4
437 ILENCH=LEN(YCOMMENT)
438 IF(ALLOCATED(ZXZS))THEN
439   DEALLOCATE(ZXZS)
440 ENDIF
441 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XZS,IGRID,ILENCH,YCOMMENT,IRESP)
442 !
443 YRECFM='ZSMT'
444 ! 120106 Non elimine . Pour l'enregister avec le nom ZSMTBIS
445 !CALL ELIM(YRECFM)
446 YCOMMENT='METERS'
447 ILENG=SIZE(XZSMT)
448 IGRID=4
449 ILENCH=LEN(YCOMMENT)
450 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XZSMT,IGRID,ILENCH,YCOMMENT,IRESP)
451 !
452 YRECFM='SLEVE'
453 CALL ELIM(YRECFM)
454 YCOMMENT=' '
455 ILENG=1
456 IGRID=4
457 ILENCH=LEN(YCOMMENT)
458 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,LSLEVE,IGRID,ILENCH,YCOMMENT,IRESP)
459 !
460 IF (LSLEVE) THEN
461   YRECFM='LEN1'
462   CALL ELIM(YRECFM)
463   YCOMMENT='METERS'
464   ILENG=1
465   IGRID=4
466   ILENCH=LEN(YCOMMENT)
467   CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XLEN1,IGRID,ILENCH,YCOMMENT,IRESP)
468   YRECFM='LEN2'
469   CALL ELIM(YRECFM)
470   YCOMMENT='METERS'
471   ILENG=1
472   IGRID=4
473   ILENCH=LEN(YCOMMENT)
474   CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XLEN2,IGRID,ILENCH,YCOMMENT,IRESP)
475 END IF
476 !
477 YRECFM='DTCUR%TDATE'   ! array of rank 3 for date is written in file
478 CALL ELIM(YRECFM)
479 YCOMMENT='YYYYMMDD'
480 ITDATE(1)=TDTCUR%TDATE%YEAR
481 ITDATE(2)=TDTCUR%TDATE%MONTH
482 ITDATE(3)=TDTCUR%TDATE%DAY
483 ILENG=3
484 IGRID=0
485 ILENCH=LEN(YCOMMENT)
486 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
487 YRECFM='DTCUR%TIME'
488 CALL ELIM(YRECFM)
489 YCOMMENT='SECONDS'
490 ILENG=1
491 IGRID=0
492 ILENCH=LEN(YCOMMENT)
493 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,TDTCUR%TIME,IGRID,ILENCH,           &
494              YCOMMENT,IRESP)
495 !
496 YRECFM='DTEXP%TDATE'   ! array of rank 3 for date is written in file
497 CALL ELIM(YRECFM)
498 YCOMMENT='YYYYMMDD'
499 IF (CSTORAGE_TYPE=='SU') THEN
500   ITDATE(1)=TDTCUR%TDATE%YEAR
501   ITDATE(2)=TDTCUR%TDATE%MONTH
502   ITDATE(3)=TDTCUR%TDATE%DAY
503   ZTDATE   =TDTCUR%TIME
504 ELSE
505   ITDATE(1)=TDTEXP%TDATE%YEAR
506   ITDATE(2)=TDTEXP%TDATE%MONTH
507   ITDATE(3)=TDTEXP%TDATE%DAY
508   ZTDATE   =TDTEXP%TIME
509 ENDIF
510 ILENG=3
511 IGRID=0
512 ILENCH=LEN(YCOMMENT)
513 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
514 YRECFM='DTEXP%TIME'
515 CALL ELIM(YRECFM)
516 YCOMMENT='SECONDS'
517 ILENG=1
518 IGRID=0
519 ILENCH=LEN(YCOMMENT)
520 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,ZTDATE,IGRID,ILENCH,           &
521              YCOMMENT,IRESP)
522 !
523 YRECFM='DTMOD%TDATE'    ! array of rank 3 for date is written in file
524 CALL ELIM(YRECFM)
525 YCOMMENT='YYYYMMDD'
526 IF (CSTORAGE_TYPE=='SU') THEN
527   ITDATE(1)=TDTCUR%TDATE%YEAR
528   ITDATE(2)=TDTCUR%TDATE%MONTH
529   ITDATE(3)=TDTCUR%TDATE%DAY
530   ZTDATE   =TDTCUR%TIME
531 ELSE
532   ITDATE(1)=TDTMOD%TDATE%YEAR
533   ITDATE(2)=TDTMOD%TDATE%MONTH
534   ITDATE(3)=TDTMOD%TDATE%DAY
535   ZTDATE   =TDTMOD%TIME
536 ENDIF
537 ILENG=3
538 IGRID=0
539 ILENCH=LEN(YCOMMENT)
540 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
541 YRECFM='DTMOD%TIME'
542 CALL ELIM(YRECFM)
543 YCOMMENT='SECONDS'
544 ILENG=1
545 IGRID=0
546 ILENCH=LEN(YCOMMENT)
547 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,ZTDATE,IGRID,ILENCH,           &
548              YCOMMENT,IRESP)
549 !
550 YRECFM='DTSEG%TDATE'    ! array of rank 3 for date is written in file
551 CALL ELIM(YRECFM)
552 YCOMMENT='YYYYMMDD'
553 IF (CSTORAGE_TYPE=='SU') THEN
554   ITDATE(1)=TDTCUR%TDATE%YEAR
555   ITDATE(2)=TDTCUR%TDATE%MONTH
556   ITDATE(3)=TDTCUR%TDATE%DAY
557   ZTDATE   =TDTCUR%TIME
558 ELSE
559   ITDATE(1)=TDTSEG%TDATE%YEAR
560   ITDATE(2)=TDTSEG%TDATE%MONTH
561   ITDATE(3)=TDTSEG%TDATE%DAY
562   ZTDATE   =TDTSEG%TIME
563 ENDIF
564 ILENG=3
565 IGRID=0
566 ILENCH=LEN(YCOMMENT)
567 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
568 YRECFM='DTSEG%TIME'
569 CALL ELIM(YRECFM)
570 YCOMMENT='SECONDS'
571 ILENG=1
572 IGRID=0
573 ILENCH=LEN(YCOMMENT)
574 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,ZTDATE,IGRID,ILENCH,           &
575              YCOMMENT,IRESP)
576 !
577 !*       1.3    Configuration  variables :
578 !
579 YRECFM='CARTESIAN'
580 CALL ELIM(YRECFM)
581 YCOMMENT='  '
582 ILENG=1
583 IGRID=0
584 ILENCH=LEN(YCOMMENT)
585 CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,LCARTESIAN,IGRID,ILENCH,YCOMMENT,IRESP)
586 !
587 !*       1.6    Reference state variables :
588 !
589 !YRECFM='RHOREFZ'
590 !CALL ELIM(YRECFM)
591 !IF (CPROGRAM(4:6)/='DIA') THEN 
592   !YCOMMENT='  '
593   !ILENG=SIZE(XRHODREFZ)
594   !IGRID=4
595   !ILENCH=LEN(YCOMMENT)
596   !CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XRHODREFZ,IGRID,ILENCH,YCOMMENT,IRESP)
597 !END IF
598 !
599 !YRECFM='THVREFZ'
600 !CALL ELIM(YRECFM)
601 !IF (CPROGRAM(4:6)/='DIA') THEN 
602   !YCOMMENT='  '
603   !ILENG=SIZE(XTHVREFZ)
604   !IGRID=4
605   !ILENCH=LEN(YCOMMENT)
606   !CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XTHVREFZ,IGRID,ILENCH,YCOMMENT,IRESP)
607 !END IF
608 !
609 !YRECFM='EXNTOP'
610 !CALL ELIM(YRECFM)
611 !IF (CPROGRAM(4:6)/='DIA') THEN 
612   !YCOMMENT='  '
613   !ILENG=1
614   !IGRID=4
615   !ILENCH=LEN(YCOMMENT)
616   !CALL FMWRIT(HFMFILE,YRECFM,CLUOUT,ILENG,XEXNTOP,IGRID,ILENCH,YCOMMENT,IRESP)
617 !END IF
618 !
619 !print *,' SORTIE  WRITE_LFIFM1_FORDIACHRO_CV'
620 !-------------------------------------------------------------------------------
621 LPACK=GPACK
622 !
623 END SUBROUTINE WRITE_LFIFM1_FORDIACHRO_CV