Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / EXTRACTDIA / writecdl.f90
1 !     #################################
2       MODULE MODI_WRITECDL
3 !     #################################
4 INTERFACE WRITECDL
5       SUBROUTINE  WRITECDL(kideb,kifin,kjdeb,kjfin,kkdeb,kkfin,&
6                    kitdeb,kitfin,kitrdeb,kitrfin,kipdeb,kipfin,&
7                    HLABELCHAMP,HFILENAME,HFLAGFILE,HTYPEGRID,  &
8                    HFILENAME_SUP,KVERBIA,KRETCODE,             &
9                    PGRIDX,PGRIDY                               )
10 !
11 CHARACTER(LEN=*), intent(inout)  :: HLABELCHAMP         ! nom du champ
12                        ! inout pour modifier le nom VLEV en altitude
13 CHARACTER(LEN=*), intent(in)  ::  HFILENAME             ! nom du fichier
14 CHARACTER(LEN=*), intent(in)  :: HFLAGFILE              ! NEW=creation 
15                                                         ! OLD=ajout 
16                                                         ! CLOSE=fermeture
17 CHARACTER(LEN=3)              :: HFILENAME_SUP          ! chaine de caracteres
18                                                         ! a rajouter a
19                                                         ! HFILENAME
20 CHARACTER(LEN=*), intent(in) :: HTYPEGRID               !  format grille reguliere plan conforme
21                                                         ! ou lat lon CONF/LALO
22 INTEGER , intent(in)         :: KVERBIA                 ! prints de controle
23                                       ! desactive (0) / active (1) les prints
24                                       ! limites sur les 6 dimensions
25 INTEGER , intent(in)         :: kideb,kifin,kjdeb,kjfin,kkdeb,kkfin   
26 INTEGER , intent(in)         :: kitdeb,kitfin,kitrdeb,kitrfin,kipdeb,kipfin
27
28 INTEGER , intent(out)        :: KRETCODE   ! Code de retour de la routine 
29 REAL, DIMENSION(:), INTENT(IN) :: PGRIDX, PGRIDY
30 END SUBROUTINE
31 END INTERFACE
32 END MODULE MODI_WRITECDL
33 !
34 !     ################
35       SUBROUTINE  WRITECDL(kideb,kifin,kjdeb,kjfin,kkdeb,kkfin,&
36                    kitdeb,kitfin,kitrdeb,kitrfin,kipdeb,kipfin,&
37                    HLABELCHAMP,HFILENAME,HFLAGFILE,HTYPEGRID,  &
38                    HFILENAME_SUP,KVERBIA,KRETCODE,             &
39                    PGRIDX,PGRIDY                               )
40 !     ################
41 !
42 !!****  *writedcdl* - 
43 !! 
44 !!
45 !!    PURPOSE
46 !!    -------
47 !     Ecriture d'un fichier  de type CDL pour etre transformé en netcdf
48 !     via ncgen -b file.cdl
49
50 !
51 !!**  METHOD
52 !!    ------
53 !   Ecriture ascii de 2 fichiers en parallele:
54 ! un fichier pour l entete
55 ! un fichier pour les données
56 !   Chaque appel de la routine writecdl complete le fichier d entete
57 ! et le fichier de données.
58 !   Ces 2 fichiers seront concatenes avant d'appeler ncgen ( outil netcdf
59 ! qui cree un fichier netcdf a partir d un fichier ascii de format CDL).
60 !   Voir le script tonetcdf  ci-dessous:
61 !# concatenation de l entete et des données
62 !# 
63 !cat ${FILE}hcl ${FILE}dcl > ${FILE}cdl
64 !#
65 !# outil netcdf : ncgen 
66 !#
67 !ncgen -b ${FILE}cdl      
68 !
69 !     XVAR est alloué avant l appel a writecdl
70 !
71 !     HFLAGFILE='NEW' lors de la premiere utilisation du fichier
72 !     HFLAGFILE='OLD' lors des utilisations suivantes
73 !     HFLAGFILE='CLO' pour la fermeture du fichier de sortie
74 !      ( fin de mise a jour du menu )
75 !
76 !     KVERBIA= 0 impressions reduites au minimum (entree et sortie de la
77 !      routine)
78 !     KVERBIA >0 impressions pour signaler chaque etape de READVAR
79 !
80 !     KRETCODE = 0 execution de writecdl correcte
81 !     KRETCODE = 1 erreur lors de l ouverture du fichier
82 !     KRETCODE = 2 erreur lors de la fermeture du fichier
83 !
84 !     kideb,kifin,kjdeb,kjfin,kkdeb,kkfin = limites en indices i,j,k du
85 !                                                   domaine à traiter dans XVAR
86 !     kitdeb,kitfin,kitrdeb,kitrfin,kipdeb,kipfin = limites en indices
87 !                                                  des dimensions 4,5,6 de XVAR
88 !!      
89 !!
90 !!    EXTERNAL
91 !!    --------
92 !!
93 !!          FROM_COMPUTING_UNITS: retour aux unites initiales  avant ecriture
94 !!                               = passage inverse a celui realise par
95 !!                                 TO_COMPUTING_UNITS
96 !!
97 !!    IMPLICIT ARGUMENTS
98 !!    ------------------
99 !!
100 !!    REFERENCE
101 !!    ---------
102 !!     
103 !!
104 !!    AUTHORS
105 !!    -------
106 !!     N. Asencio * CNRM*
107 !!
108 !!    Copyright 2003,  Meteo-France and Laboratoire d'Aerologie
109 !!    All Rights Reserved
110 !!
111 !!    MODIFICATIONS
112 !!    -------------
113 !!    23/06/2009 G. TANGUY * CNRM*
114 !! ajout du champ _Fillvalue pour les valeurs indéfinies
115 !! modification de l'ecriture de "time" : type int et la référence est prise au
116 !! premier janvier deux ans auparavant
117 !! ecriture de la dimension de vertical_levels quand il n'y a qu'un seul niveau
118 !! demandé
119 !! ajout de la variable YNETCDFCHAMP pour remplacer HLABELCHAMP dans ce
120 !! programme ce qui évite de tronquer vertical_levels
121 !! ajout du champ global attributes pour préciser la simulation dans l'entête
122 !! 18/02/2010 : time doit etre ecrit en premier puisqu'il est UNLIMITED
123 !!              changement de l'ordre avec le mask
124 !! Nov 2010 : ajout des paramètres de cartes (LON0,LAT0,LONOR,LATOR,RPK,BETA)
125 !!            pour les projections conformes (utile sous NCL pour retracer la carte)
126 !!            Passage des coordonnées en metres au lieu de km (coord conformes
127 !!            et niveaux verticaux)
128 !-------------------------------------------------------------------------------
129 !
130 !*       0.    DECLARATIONS
131 !              ------------
132 !
133 ! pour getenv et system
134 #ifdef NAGf95
135 USE F90_UNIX
136 USE F90_UNIX_PROC       
137 #endif
138 !
139 USE MODN_NCAR,  ONLY: XSPVAL       
140 !
141 !                    grille : XXDXHAT(:,1:7) et XXX(:,1:7), XXZS(:,:,1:7)
142 USE MODD_COORD
143 !                     min max des indices selon x et y
144 USE MODD_TYPE_AND_LH
145 !                    XVAR(i,j,k,,,), XMASK,XTRAJ ,XDATIME(16,t)   
146 USE MODD_ALLOC_FORDIACHRO
147 USE MODD_FILES_DIACHRO, ONLY: NBFILES, CLUOUTDIAS, NRESPDIAS
148 !                       
149 USE MODI_TEMPORAL_DIST_FOR_EXT
150 USE MODI_FROM_COMPUTING_UNITS
151 USE MODD_CONF, ONLY: CEXP
152 USE MODD_TIME, ONLY: TDTEXP,TDTSEG
153 USE MODD_TIME1, ONLY: TDTCUR
154 USE MODD_GRID
155
156 !
157 IMPLICIT NONE
158 !
159 !*       0.1   Arguments d'appel
160 !              -----------------
161 !
162 CHARACTER(LEN=*), intent(inout)  :: HLABELCHAMP         ! nom du champ
163                        ! inout pour modifier le nom VLEV en altitude
164 CHARACTER(LEN=*), intent(in)  :: HFILENAME              ! nom du fichier
165 CHARACTER(LEN=*), intent(in)  :: HFLAGFILE              !NEW=creation 
166                                                         !OLD=ajout 
167                                                         !CLOSE=fermeture
168 CHARACTER(LEN=3)              :: HFILENAME_SUP          ! chaine de caracteres
169                                                         !a rajouter a HFILENAME
170 CHARACTER(LEN=*), intent(in) :: HTYPEGRID               ! format grille reguliere plan conforme
171                                                         !ou lat lon CONF/LALO
172 INTEGER , intent(in)         :: KVERBIA                 ! prints de controle
173                                       !desactive (0) / active (1) les prints
174                                       ! limites sur les 6 dimensions
175 INTEGER , intent(in)         :: kideb,kifin,kjdeb,kjfin,kkdeb,kkfin   
176 INTEGER , intent(in)         :: kitdeb,kitfin,kitrdeb,kitrfin,kipdeb,kipfin
177
178 INTEGER , intent(out)        :: KRETCODE   ! Code de retour de la routine 
179 REAL, DIMENSION(:), INTENT(IN) :: PGRIDX, PGRIDY
180 !
181 !*       0.2   Variables locales
182 !              -----------------
183 !
184 INTEGER           :: ILOOP,JLOOP,KLOOP,KLOOP4,KLOOP5,KLOOP6, iret
185 INTEGER,save      :: ILUOUT1HEAD,ILUOUT2DATA  ! unites logiques de sortie 
186 INTEGER           :: IAN,IMOIS,IJOUR,ISECONDE,ibasetime
187 INTEGER           :: IAN2,IMOIS2,IJOUR2,ISECONDE2,IANREF
188 INTEGER, dimension(:), ALLOCATABLE :: ioffset_time
189 INTEGER  :: zbasetime
190 !DOUBLE PRECISION  :: zbasetime
191
192 !
193 REAL              :: zmini ,zmaxi
194 !
195 ! taille=100  et 28 cf diaprog 
196 CHARACTER (LEN=100) :: YSAVETITRE, YSAVECOMMENT, YSAVEUNITE 
197 CHARACTER (LEN=28)  :: YFILEOUT,YFILEOUT1,YFILEOUT2   ! Fichiers de sortie
198 CHARACTER (LEN=100) :: ycommand, ytextdim
199 CHARACTER (LEN=13), save :: YLIBELLEDIM1,YLIBELLEDIM2
200 CHARACTER (LEN=5)   :: YNUM
201 CHARACTER (LEN=28)  :: YLABELCHAMPnew
202 INTEGER :: ikdeb,ikfin,iitdeb,iitfin,iitrdeb,iitrfin,JK
203 CHARACTER (LEN=15)  :: YNETCDFCHAMP
204 CHARACTER  (LEN=8) :: YDATE
205 CHARACTER  (LEN=10) :: YTIME
206 CHARACTER  (LEN=5) :: YZONE
207 INTEGER,DIMENSION(8) :: IVALUES
208 REAL,DIMENSION(:,:,:,:,:), ALLOCATABLE:: XVAR2
209 INTEGER :: II,IJ,IK,IT,IM
210 !
211 !-------------------------------------------------------------------------------
212 !
213 !*       1.    INITIALISATION
214 !              --------------
215
216   IAN=XDATIME(13,1)
217   IMOIS=XDATIME(14,1)
218   IJOUR=XDATIME(15,1)
219   ISECONDE=XDATIME(16,1)
220   IANREF=IAN-2
221 !
222 YNETCDFCHAMP=HLABELCHAMP
223 if (KVERBIA >= 0) then
224    print *,' --------- '
225    print *,'Entree WRITECDL ',TRIM(HFILENAME),' ',TRIM(YNETCDFCHAMP),' ', &
226                               TRIM(HFLAGFILE),' ',TRIM(HTYPEGRID),' ', &
227                               TRIM(HFILENAME_SUP),' ',KVERBIA
228 endif
229 !
230 ! Code de retour de la routine : 0 = OK
231 !                                1 = erreur lors de l ouverture du fichier
232 !                                2 = erreur lors de la fermeture du fichier
233 KRETCODE=0
234 !
235 !  Retour aux unites initiales si necessaire
236 CALL FROM_COMPUTING_UNITS(YNETCDFCHAMP,CUNITE(1)) 
237 !
238 !
239 ! code de retour d erreur des routines diaprog
240 LPBREAD=.FALSE.                                                        
241 !
242 if (KVERBIA > 0) then
243   print'(A41,6(I4,X))','WRITECDL: ideb,ifin,jdeb,jfin,kdeb,kfin= ',&
244           kideb,kifin,kjdeb,kjfin,kkdeb,kkfin
245   print'(A42,2(I10,X),4(I4,X))','          tdeb,tfin,trdeb,trfin,pdeb,pfin= ',&
246           kitdeb,kitfin,kitrdeb,kitrfin,kipdeb,kipfin 
247   print'(A26,6(I4,X))','  nil,nih,njl,njh,nkl,nkh=',nil,nih,njl,njh,nkl,nkh
248 endif
249 !
250 !*       1.1    nom des fichiers de sortie (ajout d un suffixe hkcl/dkcl
251 !                                                           ou hzcl/dzcl)
252 !
253 YFILEOUT=ADJUSTL(ADJUSTR(HFILENAME(1:LEN(HFILENAME)-1))//HFILENAME_SUP)
254 YFILEOUT1=ADJUSTL(ADJUSTR(HFILENAME(1:LEN(HFILENAME)-1))//'h'//&
255           ADJUSTL(HFILENAME_SUP))
256 YFILEOUT2=ADJUSTL(ADJUSTR(HFILENAME(1:LEN(HFILENAME)-1))//'d'//&
257           ADJUSTL(HFILENAME_SUP))
258 if (KVERBIA > 0) then
259     print*,'fichier d entete   YFILEOUT1= ',YFILEOUT1
260     print*,'fichier de donnees YFILEOUT2= ',YFILEOUT2
261 endif
262 !   
263 !-------------------------------------------------------------------------------
264 !
265 !*       2.1   OUVERTURE DES FICHIERS DE SORTIE
266 !              -------------------
267 !
268 IF ( HFLAGFILE(1:3) == 'NEW' ) THEN
269   !
270   ! recupere l unite logique et ouverture des fichiers
271   !
272   !*    2.1.1 Fichier entete : partie commune a toutes les variables
273   !           --------------
274   CALL FMATTR(YFILEOUT1,CLUOUTDIAS(NBFILES),ILUOUT1HEAD,NRESPDIAS(NBFILES))
275   IF (NRESPDIAS(NBFILES).NE.0)THEN
276     KRETCODE=1
277     print *,' ****WRITECDL: erreur lors de l ouverture du fichier ',&
278             TRIM(YFILEOUT1),' code= ',NRESPDIAS(NBFILES)
279     RETURN
280   ENDIF
281   OPEN(UNIT=ILUOUT1HEAD,FILE=YFILEOUT1,STATUS='NEW',FORM='FORMATTED')
282   ! creation du debut de l entete
283   !nom du fichier
284   write(ILUOUT1HEAD,*) 'netcdf ',YFILEOUT,' { '
285   !dimensions
286   write(ILUOUT1HEAD,*) 'dimensions: '
287   SELECT CASE (HTYPEGRID(1:4) ) 
288   CASE ('CONF')
289      YLIBELLEDIM1='W_E_direction'
290      YLIBELLEDIM2='S_N_direction'
291   CASE ('LALO')
292      YLIBELLEDIM1='longitude'
293      YLIBELLEDIM2='latitude'
294   CASE DEFAULT
295      print*, ' type de grille incorrect: LALO/CONF possibles et non ', HTYPEGRID
296   END SELECT
297   !
298   write(ILUOUT1HEAD,*) '   ',TRIM(YLIBELLEDIM1),'  = ', kifin-kideb +1, ';'
299   write(ILUOUT1HEAD,*) '   ',TRIM(YLIBELLEDIM2),'  = ', kjfin-kjdeb +1, ';'
300   write(ILUOUT1HEAD,*) '   vertical_levels   = ', kkfin-kkdeb +1, ';'
301 !  write(ILUOUT1HEAD,*) '       time   =  ',kitfin-kitdeb +1, ';'
302   write(ILUOUT1HEAD,*) '   time   =  UNLIMITED ; // (',kitfin-kitdeb +1,' currently) ;'
303    write(ILUOUT1HEAD,*) '   mask = ', kitrfin-kitrdeb +1, ';'
304   write(ILUOUT1HEAD,*) 'variables: '
305   
306 !  write (ILUOUT1HEAD,*) '        double time(time);'
307   write (ILUOUT1HEAD,*) '        int time(time);'
308   write(ILUOUT1HEAD,'(A,I4,A)') ' time:units = "seconds since ',IANREF,'-1-1 00:00:00" ;'
309   write(ILUOUT1HEAD,'(A,I4,A)') ' time:time_origin = "',IANREF,'-1-1 00:00:00" ;'
310
311   !reference temporelle
312 !  write (ILUOUT1HEAD,*) '        int base_time ;'
313 !  write (ILUOUT1HEAD,*)' base_time:units = "seconds since 1970-01-01'&
314 !                            ,'00:00:00 UTC" ;'
315 !  write (ILUOUT1HEAD,*) ' base_time:long_name = ',&
316 !                       '"base time for the file" ;'
317   !evolution temporelle / reference
318 !  write (ILUOUT1HEAD,*) '        int time_offset(time) ;'
319 !  write (ILUOUT1HEAD,*)' time_offset:units = "seconds" ;'
320 !  write (ILUOUT1HEAD,*) ' time_offset:long_name = "time offset from'&
321 !                       ,' base time" ;'
322   SELECT CASE (HTYPEGRID(1:4) ) 
323   CASE ('CONF')
324     !grille réguliere selon x dans le plan conforme
325     write (ILUOUT1HEAD,*) '        float W_E_direction(W_E_direction);'
326     write (ILUOUT1HEAD,*) '   W_E_direction:units = "km" ;'
327     write (ILUOUT1HEAD,*) '   W_E_direction:long_name = "model grid in the conformal projection" ;'
328     !grille réguliere selon y dans le plan conforme
329     write (ILUOUT1HEAD,*) '        float S_N_direction(S_N_direction);'
330     write (ILUOUT1HEAD,*) '   S_N_direction:units = "km" ;'
331     write (ILUOUT1HEAD,*) '   S_N_direction:long_name = "model grid in the conformal projection" ;'
332     write (ILUOUT1HEAD,*) '        float LON0 ;'
333     write (ILUOUT1HEAD,*) '   LON0:units = "degrees_east" ;'
334     write (ILUOUT1HEAD,*) '   LON0:long_name = "reference longitude for the conformal projection" ;'
335     write (ILUOUT1HEAD,*) '        float LAT0 ;'
336     write (ILUOUT1HEAD,*) '   LAT0:units = "degrees_north" ;'
337     write (ILUOUT1HEAD,*) '   LAT0:long_name = "reference latitude for the conformal projection" ;'
338     write (ILUOUT1HEAD,*) '        float LONOR ;'
339     write (ILUOUT1HEAD,*) '   LONOR:units = "degrees_east" ;'
340     write (ILUOUT1HEAD,*) '   LONOR:long_name = "longitude of point x=0,y=0 in the conformal projection" ;'
341     write (ILUOUT1HEAD,*) '        float LATOR ;'
342     write (ILUOUT1HEAD,*) '   LATOR:units = "degrees_north" ;'
343     write (ILUOUT1HEAD,*) '   LATOR:long_name = "latitude of point x=0,y=0 in  the conformal projection" ;'
344     write (ILUOUT1HEAD,*) '        float BETA ;'
345     write (ILUOUT1HEAD,*) '   BETA:units = "degrees" ;'
346     write (ILUOUT1HEAD,*) '   BETA:long_name = "Rotation angle for the conformal projection" ;'
347     write (ILUOUT1HEAD,*) '        float RPK ;'
348     write (ILUOUT1HEAD,*) '   RPK:units = " " ;'
349     write (ILUOUT1HEAD,*) '   RPK:long_name = "projection parameter for the conformal projection" ;'
350
351   CASE('LALO')
352     !grille réguliere selon x en longitude
353     write (ILUOUT1HEAD,*) '        float longitude(longitude);'
354     write (ILUOUT1HEAD,*) '   longitude:units = "degrees_east" ;'
355     write (ILUOUT1HEAD,*) '   longitude:long_name = "longitudes" ;'
356     !grille réguliere selon y en latitude
357     write (ILUOUT1HEAD,*) '        float latitude(latitude);'
358     write (ILUOUT1HEAD,*) '   latitude:units = "degrees_north" ;'
359     write (ILUOUT1HEAD,*) '   latitude:long_name = "latitudes" ;'
360   END SELECT
361   !
362   !*    2.1.2 Fichier contenant les donnees: variables contenant la grille
363   !           ------------------------------ 
364   CALL FMATTR(YFILEOUT2,CLUOUTDIAS(NBFILES),ILUOUT2DATA,NRESPDIAS(NBFILES))
365   IF (NRESPDIAS(NBFILES).NE.0)THEN
366     KRETCODE=1
367     print *,' ****WRITECDL: erreur lors de l ouverture du fichier ',&
368             TRIM(YFILEOUT2),' code= ',NRESPDIAS(NBFILES)
369     RETURN
370   ENDIF
371   OPEN(UNIT=ILUOUT2DATA,FILE=YFILEOUT2,STATUS='NEW',FORM='FORMATTED')
372   !
373   !calcul  et ecriture du nombre de secondes depuis le 01/01 2 ans auparavant
374    zbasetime=0.
375   if (KVERBIA > 0) then
376     print *,' calcul ibasetime: IAN,IMOIS,IJOUR,ISECONDE,zbasetime'
377     print *,IAN,IMOIS,IJOUR,ISECONDE,zbasetime
378   endif
379    CALL TEMPORAL_DIST_FOR_EXT(IAN,IMOIS,IJOUR,ISECONDE,IANREF,01,01,0,zbasetime)
380   if (KVERBIA > 0) then
381      print *, IAN,IMOIS,IJOUR,ISECONDE,zbasetime
382   endif
383   !
384   ibasetime=zbasetime
385   write(ILUOUT2DATA,*) 'data: '
386   write(ILUOUT2DATA,*) 'time = '!,zbasetime !, ' ;'
387
388  ! write(ILUOUT2DATA,*) 'base_time = ',ibasetime, ' ;'
389   !ecriture de l instant du fichier= 0 seconde / reference
390   !write(ILUOUT2DATA,*) 'time_offset = 0 ;'
391 !  ytextdim='time_offset = '
392 !  write(ILUOUT2DATA,*) ytextdim
393   ALLOCATE(ioffset_time(kitfin-kitdeb+1)) ; ioffset_time(:)=0
394   DO JK=kitdeb,kitfin
395     !ibasetime=XTRAJT(JK,1)-XTRAJT(kitdeb,1)  !
396     ! cas ou TEXP et TSEG sont faux
397     IAN=XDATIME(13,kitdeb)
398     IMOIS=XDATIME(14,kitdeb)
399     IJOUR=XDATIME(15,kitdeb)
400     ISECONDE=XDATIME(16,kitdeb)
401     IAN2=XDATIME(13,JK)
402     IMOIS2=XDATIME(14,JK)
403     IJOUR2=XDATIME(15,JK)
404     ISECONDE2=XDATIME(16,JK)
405     CALL TEMPORAL_DIST_FOR_EXT(IAN2,IMOIS2,IJOUR2,ISECONDE2,IAN,IMOIS,IJOUR,ISECONDE,zbasetime)
406     ioffset_time(jk-kitdeb+1)=ibasetime+zbasetime
407   ENDDO
408   write(ILUOUT2DATA,1010,advance='no') ioffset_time(1:kitfin-kitdeb+1)
409   DEALLOCATE(ioffset_time)
410   WRITE(ILUOUT2DATA,'(";")')
411   write(ILUOUT2DATA,*) ' '
412 !------------------------------------------------------------------
413   SELECT CASE (HTYPEGRID(1:4) ) 
414   CASE ('CONF')
415     ! grille régulière selon X en km
416     write(ILUOUT2DATA,*) ' W_E_direction ='
417     write(ILUOUT2DATA,1000,advance='no') PGRIDX(kideb:kifin)*0.001
418     WRITE(ILUOUT2DATA,'(";")')
419     write(ILUOUT2DATA,*) ' '
420     ! grille régulière selon Y en km
421     write(ILUOUT2DATA,*) ' S_N_direction ='
422     write(ILUOUT2DATA,1000,advance='no') PGRIDY(kjdeb:kjfin)*0.001
423     WRITE(ILUOUT2DATA,'(";")')
424     write(ILUOUT2DATA,*) ' '
425     !parametre de la grille
426     write(ILUOUT2DATA,*) ' LON0 ='
427     write(ILUOUT2DATA,1000,advance='no') XLON0
428     WRITE(ILUOUT2DATA,'(";")')
429     write(ILUOUT2DATA,*) ' '
430     write(ILUOUT2DATA,*) ' LAT0 ='
431     write(ILUOUT2DATA,1000,advance='no') XLAT0
432     WRITE(ILUOUT2DATA,'(";")')
433     write(ILUOUT2DATA,*) ' '
434     write(ILUOUT2DATA,*) ' LONOR ='
435     write(ILUOUT2DATA,1000,advance='no') XLONORI
436     WRITE(ILUOUT2DATA,'(";")')
437     write(ILUOUT2DATA,*) ' '
438     write(ILUOUT2DATA,*) ' LATOR ='
439     write(ILUOUT2DATA,1000,advance='no') XLATORI
440     WRITE(ILUOUT2DATA,'(";")')
441     write(ILUOUT2DATA,*) ' '
442     write(ILUOUT2DATA,*) ' BETA ='
443     write(ILUOUT2DATA,1000,advance='no') XBETA
444     WRITE(ILUOUT2DATA,'(";")')
445     write(ILUOUT2DATA,*) ' '
446     write(ILUOUT2DATA,*) ' RPK ='
447     write(ILUOUT2DATA,1000,advance='no') XRPK
448     WRITE(ILUOUT2DATA,'(";")')
449     write(ILUOUT2DATA,*) ' '
450
451
452   CASE('LALO')
453     write(ILUOUT2DATA,*) 'longitude ='
454     write(ILUOUT2DATA,1000,advance='no') PGRIDX(kideb:kifin)
455     WRITE(ILUOUT2DATA,'(";")')
456     write(ILUOUT2DATA,*) ' '
457     write(ILUOUT2DATA,*) 'latitude ='
458     write(ILUOUT2DATA,1000,advance='no') PGRIDY(kjdeb:kjfin)
459     WRITE(ILUOUT2DATA,'(";")')
460     write(ILUOUT2DATA,*) ' '
461   END SELECT
462 ENDIF
463 !
464 !-------------------------------------------------------------------------------
465 !
466 !*       3.    ECRITURE du champ dans YFILEOUT2 et de l entete dans YFILEOUT1
467 !              --------
468 !
469 IF ( HFLAGFILE(1:3) /= 'CLO' ) THEN
470   !
471   if (KVERBIA > 0) then
472     print*,'WRITECDL: format CDL ecriture en cours '
473   endif
474   ! 
475   ! Ecriture du champ + lat,lon ,altitude du niveau
476   ! 
477   !      3.1  liste des dimensions tel que "Last dim varies fastest"
478   ! 
479   ytextdim=''
480   !Process: ecriture d une variable netcdf par processus donc lignes commentees
481   !IF ( kipfin-kipdeb > 0) THEN
482   !   ytextdim='process '
483   !ENDIF
484   ! ATTENTION le TEMPS DOIT ETRE LA PREMIERE VARIABLE CAR UNLIMITED  
485   !Time
486   SELECT CASE (YNETCDFCHAMP)
487   CASE ('VLEV')
488     if (KVERBIA >= 2) then
489       print*,' No temporal dimension for ', YNETCDFCHAMP
490     endif
491     IF ( SIZE(XVAR,2) > 1 ) THEN
492       ! cas du champ 3D pour les altitudes
493       ! passage en km pour utilisation Zebra
494       YNETCDFCHAMP='VLEV'
495       CUNITE(1)='km'
496       XVAR=XVAR*0.001
497     ELSE
498       ! cas d une liste de niveaux verticaux choisis par l utilisateur
499       ! on garde l unité donnée par extractdia metres ou hPa
500       YNETCDFCHAMP='vertical_levels'
501      ENDIF
502   CASE ('LAT','LON')
503     if (KVERBIA >= 2) then
504       print*,' No temporal dimension for ', YNETCDFCHAMP
505     endif
506   CASE DEFAULT
507     ! Les variables doivent avoir la dimension time meme si
508     ! cette dimension est egale a 1
509     !IF ( kitfin-kitdeb > 0 ) THEN
510     IF (ytextdim /= '') ytextdim=ADJUSTL(ADJUSTR(ytextdim)//',')
511     ytextdim=ADJUSTL(ADJUSTR(ytextdim)//'time ')
512     !ENDIF
513   END SELECT
514
515   !Mask
516   SELECT CASE (YNETCDFCHAMP)
517   CASE ('VLEV','LAT','LON')
518   CASE DEFAULT
519     IF ( kitrfin-kitrdeb > 0) THEN
520       IF (ytextdim /= '') ytextdim=ADJUSTL(ADJUSTR(ytextdim)//',')
521       ytextdim=ADJUSTL(ADJUSTR(ytextdim)//'mask ')
522     ENDIF      
523   END SELECT
524
525   !Z
526   SELECT CASE (YNETCDFCHAMP)
527   CASE ('LAT','LON')
528     if (KVERBIA >= 2) then
529       print*,' No vertical dimension for ', YNETCDFCHAMP
530     endif
531   CASE ('vertical_levels')
532     IF (ytextdim /= '') ytextdim=ADJUSTL(ADJUSTR(ytextdim)//',')
533     ytextdim=ADJUSTL(ADJUSTR(ytextdim)//'vertical_levels ')
534   CASE DEFAULT
535     IF ( kkfin-kkdeb > 0) THEN
536       IF (ytextdim /= '') ytextdim=ADJUSTL(ADJUSTR(ytextdim)//',')
537       ytextdim=ADJUSTL(ADJUSTR(ytextdim)//'vertical_levels ')
538     ENDIF
539   END SELECT
540   !Y
541   IF ( kjfin-kjdeb > 0) THEN
542     IF (ytextdim /= '') ytextdim=ADJUSTL(ADJUSTR(ytextdim)//',')
543     ytextdim=ADJUSTL(ADJUSTR(ytextdim)//ADJUSTL(YLIBELLEDIM2))
544   ENDIF
545   !X
546   IF ( kifin-kideb > 0) THEN
547     IF (ytextdim /= '') ytextdim=ADJUSTL(ADJUSTR(ytextdim)//',')
548     ytextdim=ADJUSTL(ADJUSTR(ytextdim)//ADJUSTL(YLIBELLEDIM1))
549   ENDIF
550   !
551   if (KVERBIA >= 2) then
552     print *,' dimensions du tableau= ', TRIM(ytextdim)
553   end if
554   !
555  ! Ecriture d une variable netcdf par processus
556  ! nommée nom_var+pnum_process
557  DO  KLOOP6=kipdeb,kipfin
558   YLABELCHAMPnew=ADJUSTL(YNETCDFCHAMP)
559   IF ( SIZE(XVAR,6)  > 1  ) THEN
560     ! ajout du numéro de processus
561     WRITE (YNUM,'(I5)') KLOOP6
562     YLABELCHAMPnew=ADJUSTL(ADJUSTR(YNETCDFCHAMP)//'p'//ADJUSTL(YNUM))
563   ENDIF
564   write (ILUOUT1HEAD,*) '        float ',TRIM(YLABELCHAMPnew),'(',TRIM(ytextdim),') ;'
565   write (ILUOUT1HEAD,*) TRIM(YLABELCHAMPnew), ':long_name = "',TRIM(CTITRE(kloop6)),'" ;'
566   write (ILUOUT1HEAD,*) TRIM(YLABELCHAMPnew), ':units = "',TRIM(CUNITE(kloop6)),'" ;'
567   SELECT CASE (YNETCDFCHAMP)
568   CASE ('LAT','LON')
569     ikdeb=1 ; ikfin=1 ; iitdeb=1 ; iitfin=1 ; iitrdeb=1 ; iitrfin=1
570   CASE DEFAULT
571     ikdeb=kkdeb ; ikfin=kkfin ; iitdeb=kitdeb ; iitfin=kitfin ; iitrdeb=kitrdeb ; iitrfin=kitrfin
572   END SELECT
573   IF (ANY(XVAR(kideb:kifin,kjdeb:kjfin,ikdeb:ikfin,iitdeb:iitfin,iitrdeb:iitrfin,kloop6)/=XSPVAL)) THEN
574     zmini=MINVAL(XVAR(kideb:kifin,kjdeb:kjfin,ikdeb:ikfin, &
575                       iitdeb:iitfin,iitrdeb:iitrfin,kloop6), &
576                  MASK=XVAR(kideb:kifin,kjdeb:kjfin,ikdeb:ikfin, &
577                            iitdeb:iitfin,iitrdeb:iitrfin,kloop6)/=XSPVAL     )
578     zmaxi=MAXVAL(XVAR(kideb:kifin,kjdeb:kjfin,ikdeb:ikfin, &
579                       iitdeb:iitfin,iitrdeb:iitrfin,kloop6), &
580                  MASK=XVAR(kideb:kifin,kjdeb:kjfin,ikdeb:ikfin, &
581                            iitdeb:iitfin,iitrdeb:iitrfin,kloop6)/=XSPVAL     )
582   ELSE
583     zmini=XSPVAL ; zmaxi=XSPVAL
584   ENDIF
585   IF (ABS (zmini) > 1.E-05 .AND. ABS(zmaxi) > 1.E-05 ) THEN
586     write (ILUOUT1HEAD,FMT=101) TRIM(YLABELCHAMPnew),zmini,zmaxi
587   ELSE
588     write (ILUOUT1HEAD,FMT=103) TRIM(YLABELCHAMPnew),zmini,zmaxi
589   ENDIF
590   IF (YNETCDFCHAMP /= 'vertical_levels') THEN
591     write (ILUOUT1HEAD,FMT=102) TRIM(YLABELCHAMPnew),XSPVAL
592     write (ILUOUT1HEAD,FMT=104) TRIM(YLABELCHAMPnew),XSPVAL
593   ENDIF
594   ! 
595   !      3.2 ecriture des valeurs: Last dim varies fastest
596   ! 
597 ! on intervertit la place du temps et la place du mask avant l'ecriture
598
599 ALLOCATE(XVAR2(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),SIZE(XVAR,5),SIZE(XVAR,4)))
600
601 DO II=kideb,kifin
602   DO IJ=kjdeb,kjfin
603     DO IK=ikdeb,ikfin
604       DO IT=iitdeb,iitfin 
605         DO IM=iitrdeb,iitrfin
606           XVAR2(II,IJ,IK,IM,IT)=XVAR(II,IJ,IK,IT,IM,kloop6)
607         ENDDO
608       ENDDO
609     ENDDO
610   ENDDO
611 ENDDO
612
613
614
615   write(ILUOUT2DATA,*) TRIM(YLABELCHAMPnew),' = '
616   IF (ABS (zmini) > 1.E-04 .AND. ABS(zmaxi) > 1.E-04 ) THEN
617     WRITE(ILUOUT2DATA,FMT=1000,advance='no') XVAR2(kideb:kifin,kjdeb:kjfin,&
618                    ikdeb:ikfin,iitrdeb:iitrfin,iitdeb:iitfin)
619   ELSE
620     WRITE(ILUOUT2DATA,FMT=1001,advance='no') XVAR2(kideb:kifin,kjdeb:kjfin,&
621                    ikdeb:ikfin,iitrdeb:iitrfin,iitdeb:iitfin)        
622   ENDIF
623 DEALLOCATE(XVAR2)
624   WRITE(ILUOUT2DATA,'(";")')
625   write(ILUOUT2DATA,*) ' '
626  END DO
627
628   !
629 101   FORMAT (1H ,A,16H :actual_range = ,F0.5,3Hf ,,F0.5,3Hf ;) 
630 103   FORMAT (1H ,A,16H :actual_range = ,E11.5,3Hf ,,E11.5,3Hf ;) 
631 102   FORMAT (1H ,A,18H :missing_value = ,F0.5,3Hf ;)
632 104   FORMAT (1H ,A,15H :_FillValue = ,F0.5,3Hf ;)
633 !105   FORMAT (8H time = ,E17.11,3Hf ;)
634
635   ! le ":" est le descripteur de fin d'exploitation d'un format. 
636   ! sous f95 et pgf90. D. Gazen
637 1000  FORMAT (7(F0.5,:,", "))      
638 1001  FORMAT (7(E11.5,:,", "))      
639 1010  FORMAT (7(I10,:,", "))      
640 !
641 ENDIF
642 !
643 !-------------------------------------------------------------------------------
644 !
645 !*       4.    FERMETURE des fichiers de sortie
646 !              --------------------------------
647 !
648 IF ( HFLAGFILE(1:3) == 'CLO' ) THEN
649   ! fin de fichier de données
650   WRITE(ILUOUT2DATA,*) '}'  
651   if (KVERBIA > 0) then
652     print*,'WRITECDL: avant fermeture fichier de sortie ',YFILEOUT
653   endif
654   ! force les buffers a etre vides pour permettre a l appel
655   ! systeme de traiter les fichiers complets
656   !CALL FLUSH (ILUOUT1HEAD)
657   !CALL FLUSH (ILUOUT2DATA)
658   !
659   ! fermeture
660     write (ILUOUT1HEAD,*)  "// global attributes:"
661     write (ILUOUT1HEAD,*)  '  :title = "Meso-NH simulation" ;'
662     write (ILUOUT1HEAD,*)  '  :grid_resolution_in_meters = "',  XXDXHAT(1,1),' x ',XXDYHAT(1,1),'" ;'
663     write (ILUOUT1HEAD,*)  '  :description = "Data are from the file ', HFILENAME, '" ;'
664     write (ILUOUT1HEAD,'(A46,3(I4,X),F12.4,A25,3(I4,X),F12.4,A3)')&
665     '  :comments = " Meso-NH  experience starts at ',TDTEXP,' and segment starts at ', TDTSEG,' ";'
666     CALL DATE_AND_TIME(YDATE, YTIME, YZONE, IVALUES)
667     write (ILUOUT1HEAD,FMT=201) IVALUES(3),IVALUES(2),IVALUES(1),IVALUES(5),IVALUES(6),IVALUES(7)
668 201   FORMAT ('   :history = "created on  ',I2,'/',I2,'/',I4, ' at ',I2,':',I2,':',I2,'" ;') 
669
670
671   CLOSE(ILUOUT1HEAD)
672   CALL FMFREE(YFILEOUT1,CLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
673   IF (NRESPDIAS(NBFILES).NE.0)THEN
674     KRETCODE=2
675     print *,' ****WRITECDL: erreur lors de la fermeture du fichier ',&
676             TRIM(YFILEOUT1),' code= ',NRESPDIAS(NBFILES)
677   ENDIF
678   CLOSE(ILUOUT2DATA)
679   CALL FMFREE(YFILEOUT2,CLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
680   IF (NRESPDIAS(NBFILES).NE.0)THEN
681     KRETCODE=2
682     print *,' ****WRITECDL: erreur lors de la fermeture du fichier ',&
683             TRIM(YFILEOUT2),' code= ',NRESPDIAS(NBFILES)
684   ENDIF
685   !
686   if (KVERBIA > 0) then
687     print *,'WRITECDL: before calling tonetcdf'
688   end if
689   ycommand='tonetcdf '//ADJUSTL(ADJUSTR(HFILENAME))
690   call SYSTEM ( TRIM(ycommand) )
691   !
692   if (KVERBIA >= 0) then
693     print*,'Sortie WRITECDL: Fichier ',TRIM(YFILEOUT),' disponible au format cdl'
694     print*,' --------- '
695   endif
696   !
697 ENDIF
698 !
699 !
700 HLABELCHAMP=YNETCDFCHAMP
701
702 END SUBROUTINE WRITECDL