Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / EXTRACTDIA / writellhv.f90
1 !     #################################
2       MODULE MODI_WRITELLHV
3 !     #################################
4 INTERFACE WRITELLHV     
5       SUBROUTINE WRITELLHV(kideb,kifin,kjdeb,kjfin,kkdeb,kkfin,     &
6                            KTDEB,KTFIN,KTRDEB,KTRFIN,KPDEB,KPFIN,   &
7                            HLABELCHAMP,HFILENAME,HFLAGFILE,HTYPEOUT,&
8                            KVERBIA,KRETCODE,HFILENAME_SUP,PLON,PLAT,PALT )
9 !
10 CHARACTER(LEN=*), INTENT(in) :: HLABELCHAMP,HFILENAME ! nom du champ et du fichier
11 CHARACTER(LEN=*), INTENT(in) :: HFLAGFILE             ! NEW=creation 
12                                                       ! OLD=ajout 
13                                                       ! CLOSE=fermeture
14                                                       ! NEW1H=creation entete speciale
15                                                       ! OLDNH= ajout sans entete
16 CHARACTER(LEN=*), INTENT(in) :: HTYPEOUT              ! type de fichier sortie
17                                                       ! LL?V= lon lat alt val
18                                                       ! ll?v= lat lon alt val
19                                                       !?=H,h alt du niveau k
20                                                       !  Z,z alt apres
21                                                       !  P,p interpol. verticale
22                                                       ! en Z=cst Presssion=cst
23 INTEGER , INTENT(in)         :: KVERBIA               ! prints de controle
24                                       ! desactive (0) / active (1) les prints
25                                       ! limites sur les 6 dimensions
26 INTEGER , INTENT(in)         :: KIDEB,KIFIN,KJDEB,KJFIN,KKDEB,KKFIN
27 INTEGER , INTENT(in)         :: KTDEB,KTFIN,KTRDEB,KTRFIN,KPDEB,KPFIN
28 INTEGER , INTENT(out)        :: KRETCODE   ! Code de retour de la routine       
29 CHARACTER(LEN=3) ,OPTIONAL   :: HFILENAME_SUP    ! chaine de caracteres
30                                                  !a rajouter a HFILENAME
31 REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL   :: PLON,PLAT ! tableaux des lat et
32                                                           ! lon si LLZV ou LLPV
33 REAL, DIMENSION(:,:,:), INTENT(IN),OPTIONAL  :: PALT ! tableau des altitudes
34 END SUBROUTINE       
35 END INTERFACE
36 END MODULE MODI_WRITELLHV       
37 !     ######
38       SUBROUTINE WRITELLHV(kideb,kifin,kjdeb,kjfin,kkdeb,kkfin,     &
39                            KTDEB,KTFIN,KTRDEB,KTRFIN,KPDEB,KPFIN,   &
40                            HLABELCHAMP,HFILENAME,HFLAGFILE,HTYPEOUT,&
41                            KVERBIA,KRETCODE,HFILENAME_SUP,PLON,PLAT,PALT )
42 !     ################
43 !
44 !!****  *WRITELLHV* - 
45 !! 
46 !!
47 !!    PURPOSE
48 !!    -------
49 !     Ecriture d'un fichier de type lon,lat,alt,val (LL) ou lat,lon,alt,val (ll)
50 !         lon,lat= type LLHV,llhv: position dans la grille modele
51 !                  type LLZV,llzv/LLPV,llpv: apres interpolation horizontale
52 !                                                                (PLAT,PLON)
53 !         alt= type LLHV,llhv: position verticale de la grille du modèle (XZZ)
54 !                        ou apres interpolation verticale a Z ou P=cst (PALT)
55 !              type LLZVllzv,/LLPV,llpv: apres interpolation verticale 
56 !                                         a Z ou P=cst (PALT)
57 ! NB: ces interpolations ont ete realisees avant l'appel de WRITELLHV
58
59 !
60 !!**  METHOD
61 !!    ------
62 !     utilisation des routines de diaprog : le tableau de stockage
63 !     XVAR est alloué avant l appel a WRITELLHV
64 !
65 !     HFLAGFILE='NEW' lors de la premiere utilisation du fichier
66 !     HFLAGFILE='OLD' lors des utilisations suivantes avec nouvelle entete
67 !     HFLAGFILE='NEW1H' lors de la premiere utilisation du fichier et gestion
68 !                d une entete speciale (cas mesonh2obs)
69 !     HFLAGFILE='OLDNH' lors des utilisations suivantes sans nouvelle entete
70 !                      (cas mesonh2obs)
71 !     HFLAGFILE='OLD1H' lors des utilisations suivantes du fichier et gestion
72 !                d une entete speciale (cas mesonh2obs)
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 WRITELLHV 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 !     KTDEB,KTFIN,KTRDEB,KTRFIN,KPDEB,KPFIN = limites en indices
87 !       des dimensions 4,5,6 de XVAR       
88 !!      
89 !!    EXTERNAL
90 !!    --------
91 !!
92 !!          FROM_COMPUTING_UNITS: retour aux unites initiales  avant ecriture
93 !!                               = passage inverse a celui realise par
94 !!                                 TO_COMPUTING_UNITS
95 !!    IMPLICIT ARGUMENTS
96 !!    ------------------
97 !!
98 !!    REFERENCE
99 !!    ---------
100 !!
101 !!    AUTHORS
102 !!    -------
103 !!     N. Asencio  * CNRM*
104 !!
105 !!    Copyright 2003,  Meteo-France and Laboratoire d'Aerologie
106 !!    All Rights Reserved
107 !!
108 !!    MODIFICATIONS
109 !!    -------------
110 !     04/11/2009 (G. Tanguy) : add case IJHV,IJZV, IJPV , JIHV, JIZV, JIPV
111 !     11/07/2014 (G. Tanguy) : correctoin bug IJHV au lieu de JIHV
112 !
113 !-------------------------------------------------------------------------------
114 !
115 !*       0.    DECLARATIONS
116 !              ------------
117 !
118 ! modules MESONH
119 USE MODD_CST
120 USE MODD_PARAMETERS, ONLY: JPHEXT,JPVEXT
121 USE MODE_GRIDPROJ
122 USE MODD_GRID, ONLY: XLONORI,XLATORI
123 USE MODD_GRID1, ONLY: XZZ,XXHAT,XYHAT
124 !      
125 ! modules DIACHRO
126 USE MODN_NCAR,  ONLY: XSPVAL       
127 !                    XVAR(i,j,k,,,),XMASK,XTRAJT,X,Y,Z,XDATIME(16,t),CUNITE(p)
128 USE MODD_ALLOC_FORDIACHRO
129 USE MODD_COORD, ONLY: XXX,XXY,XXZS, & !  XXX(:,1:7), XXY(:,1:7), XXZS(:,:,1:7)
130                       XXDXHAT,XXDYHAT ! XXDXHAT(:,1:7), XXDYHAT(:,1:7)
131 !                    nom de fichiers NLUOUT,CLFIFM, CDESFM
132 USE MODD_OUT
133 USE MODD_FILES_DIACHRO, ONLY: NBFILES, CLUOUTDIAS, NRESPDIAS
134 !                    pour appel a FMATTR et FMCLOS
135 !USE MODD_DIACHRO, ONLY:CFILEDIA,CLUOUTDIA, &
136 !                       NLUOUTDIA,NRESPDIA,NNPRARDIA,NFTYPEDIA,NVERBDIA,NNINARDIA
137 !
138 !
139 USE MODI_FROM_COMPUTING_UNITS
140 IMPLICIT NONE
141 !
142 !*       0.1   Arguments d'appel
143 !
144 CHARACTER(LEN=*), INTENT(IN):: HLABELCHAMP,HFILENAME ! nom du champ et du fichier
145 CHARACTER(LEN=*), INTENT(IN):: HFLAGFILE             ! NEW=creation 
146                                                      ! OLD=ajout 
147                                                      ! CLOSE=fermeture
148                                                      ! NEW1H=creation entete speciale
149                                                      ! OLDNH=ajout  sans entete
150 CHARACTER(LEN=*), INTENT(IN):: HTYPEOUT              ! type de fichier sortie
151                                                      ! LL?V= lon lat alt val
152                                                      ! ll?v= lat lon alt val
153                                                      !?=H,h alt du niveau k
154                                                      !  Z,z alt apres
155                                                      !  P,p interpol. verticale
156                                                      ! en Z=cst Presssion=cst
157 INTEGER, INTENT(IN)         :: KVERBIA               ! prints de controle
158                                       ! desactive (0) / active (1) les prints
159                                                 ! limites sur les 6 dimensions
160 INTEGER, INTENT(IN)         :: KIDEB,KIFIN,KJDEB,KJFIN,KKDEB,KKFIN
161 INTEGER, INTENT(IN)         :: KTDEB,KTFIN,KTRDEB,KTRFIN,KPDEB,KPFIN
162
163 INTEGER , INTENT(OUT)       :: KRETCODE   ! Code de retour de la routine 
164 CHARACTER(LEN=3) ,OPTIONAL   :: HFILENAME_SUP    ! chaine de caracteres
165                                                  !a rajouter a HFILENAME
166 REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL   :: PLON,PLAT ! tableaux des lat et
167                                                           ! lon si LLZV ou LLPV
168 REAL, DIMENSION(:,:,:), INTENT(IN),OPTIONAL  :: PALT ! tableau des altitudes
169 !
170 !*       0.2   Declarations des variables locales
171 !
172 INTEGER      ::   JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP ! indices de boucle
173 INTEGER,save ::   ILUOUTLL                        ! unite logique de sortie 
174 INTEGER      ::   IAN,IMOIS,IJOUR,IHEURE,IMINUTE,ISEC,INBVAL,IGRID
175 INTEGER      ::   IIU,IJU
176 ! taille= 28 cf routines FM 
177 CHARACTER (LEN=28)  :: YFILEOUT                        ! Fichier de sortie
178 REAL   , DIMENSION(:,:)  ,ALLOCATABLE        :: ZLAT,ZLON ! lat et lon
179 REAL   , DIMENSION(:,:)  ,ALLOCATABLE        :: ZX,ZY
180 !-------------------------------------------------------------------------------
181 !
182 !*       1.    INITIALISATION 
183 !              --------------
184 !      
185 if (KVERBIA >= 0) then
186   print *,'--------- '
187   print *,'Entree WRITELLHV: ',TRIM(HFILENAME),' ',TRIM(HLABELCHAMP),' ', &
188                                TRIM(HFLAGFILE),' ',TRIM(HTYPEOUT),' ',KVERBIA
189 endif
190 !
191 ! Code de retour de la routine : 0 = OK
192 !                                1 = erreur lors de l ouverture du fichier
193 !                                2 = erreur lors de la fermeture du fichier 
194 KRETCODE=0
195 !
196 !  Retour aux unites initiales si necessaire
197 IF (HFLAGFILE(1:3) /= 'CLO' ) THEN
198   IF (HLABELCHAMP/='END') CALL From_Computing_Units(HLABELCHAMP,CUNITE(1)) 
199 END IF
200 !
201 !
202 ! init du zoom
203 if (KVERBIA > 0 .AND.  HFLAGFILE(1:3) /= 'CLO' ) THEN
204   print*,'WRITELLHV: zoom '
205   print'(A,6(I4,X))','  ideb,ifin,jdeb,jfin,kdeb,kfin=',&
206            kideb,kifin,kjdeb,kjfin,kkdeb,kkfin
207   print'(A,2(I8,X),4(I4,X))','  tdeb,tfin,trdeb,trfin,pdeb,pfin=',&
208            KTDEB,KTFIN,KTRDEB,KTRFIN,KPDEB,KPFIN
209 endif
210 !
211 !*       1.1   nom du fichier de sortie (ajout d un suffixe LLHV/LLZV/LLPV)
212 !
213 SELECT CASE ( HTYPEOUT(1:4) )
214  CASE ('LLHV','llhv','LLZV','llzv','LLPV','llpv','jihv','IJHV',&
215          'IJZV','jizv','IJPV','jipv','llav','LLAV') 
216    YFILEOUT=ADJUSTL(ADJUSTR(HFILENAME(1:LEN(HFILENAME)-1))//HTYPEOUT(1:4))
217  CASE DEFAULT
218    PRINT*,' ****WRITELLHV: type ', TRIM(HTYPEOUT),' non prevu'
219    PRINT*,'types possibles: LLHV/llhv, LLZV/llzv, LLPV/llpv, IJHV/jihv'
220    PRINT*,'IJZV/jizv, IJPV/jipv,LLAV/llav'
221    KRETCODE=1
222    RETURN
223 END SELECT
224 IF ( PRESENT(HFILENAME_SUP)) THEN
225     IF(HFILENAME_SUP(1:3) /= '  ') THEN
226       YFILEOUT=ADJUSTL( ADJUSTR(YFILEOUT)//'_'//ADJUSTL(HFILENAME_SUP) )     
227     ENDIF
228 ENDIF
229 !
230 !*       1.2   ouverture du fichier de sortie et allocations
231 !
232 IF ( HFLAGFILE(1:3) == 'NEW' ) THEN
233   ! recupere l unite logique et ouverture du fichier
234   CALL FMATTR(YFILEOUT,CLUOUTDIAS(NBFILES),ILUOUTLL,NRESPDIAS(NBFILES))
235   IF (NRESPDIAS(NBFILES)==0 ) THEN
236     OPEN(UNIT=ILUOUTLL,FILE=YFILEOUT,STATUS='NEW',FORM='FORMATTED')
237   ELSE
238     PRINT*,' ****WRITELLHV: error when openning ', TRIM(YFILEOUT), &
239            'code= ',NRESPDIAS(NBFILES)
240     KRETCODE=1
241     RETURN
242   ENDIF
243 ENDIF
244 !
245 !*       1.3   test sur les arguments optionnels
246 !
247 IF ( HFLAGFILE(1:3) /= 'CLO' ) THEN
248 IIU=SIZE(XZZ,1) ; IJU=SIZE(XZZ,2)
249 !
250 IF (.NOT.PRESENT(PLAT) .AND. .NOT.PRESENT(PLON)) THEN
251 ! utilisation des lat. et lon. de la grille modele
252   ALLOCATE(ZX(IIU,IJU),ZY(IIU,IJU))
253   ALLOCATE(ZLAT(IIU,IJU),ZLON(IIU,IJU))
254   if (KVERBIA>0) print*,'WRITELLHV: LAT et LON de la grille modele '
255 ELSE ! ( present(PLAT) .or. present(PLON) )
256   IF ( (PRESENT(PLAT) .AND. .NOT.PRESENT(PLON)) .OR. &
257        (.NOT.PRESENT(PLAT) .AND. PRESENT(PLON)) .OR. &
258        .NOT.PRESENT(PALT)                            ) THEN
259     PRINT*,' ****WRITELLHV: latitudes ET longitudes doivent etre presentes '
260     PRINT*,'               ET altitudes '
261     KRETCODE=1
262     RETURN
263   ENDIF
264   ! Cas de passage par argument de PLAT et PLON différents de 
265   !ceux de la grille du modele
266   IF (PRESENT (PLON)) THEN
267     ALLOCATE(ZLON(SIZE(PLON,1),SIZE(PLON,2)))
268     ZLON=PLON
269   ENDIF
270   IF (PRESENT (PLAT)) THEN
271     ALLOCATE(ZLAT(SIZE(PLON,1),SIZE(PLON,2)))
272     ZLAT=PLAT
273   ENDIF
274 ENDIF
275 ENDIF
276 !
277 !------------------------------------------------------------------------------
278 !
279 !*       2.    ECRITURE DU CHAMP DANS LE FICHIER DE SORTIE
280 !              -------------------------------------------
281 !
282 IF ( HFLAGFILE(1:3) /= 'CLO' ) THEN
283   if (KVERBIA > 0) then
284     print'(A,I4)','WRITELLHV: unite sortie ILUOUTLL= ', ILUOUTLL
285   endif
286   ! ecriture de la ligne d entete de champ
287   !(temps courant)
288   IAN=XDATIME(13,1)
289   IMOIS=XDATIME(14,1)
290   IJOUR=XDATIME(15,1)
291   IHEURE=XDATIME(16,1)/3600
292   IMINUTE=(XDATIME(16,1)-(IHEURE*3600))/60
293   IF ( HFLAGFILE(4:5) /= 'NH') THEN
294     ! first line
295     write(ILUOUTLL,FMT='(I4,4(I2,X),A,A,A,A)') IAN,IMOIS,IJOUR,IHEURE,IMINUTE,TRIM(HLABELCHAMP),' ',TRIM(CUNITE(1)),&
296                     ' first_line_format=Year Month Day UTCHour Minute VARIABLE_NAME UNIT'
297     ! second line
298     IF ( HFLAGFILE(4:5)== '1H') THEN
299     ! entete unique donnant le nombre de valeurs totales ecrites lors de
300     ! plusieurs appels avec OLDNH
301       write(ILUOUTLL,*) 'second_line_format=values written in the same chronological order than the OBS file' 
302     ELSE
303     ! entete donnant exactement le nombre de valeurs ecrites lors de cet appel
304       write(ILUOUTLL,FMT='(6(I4,X),A)') kkdeb,kkfin,kjdeb,kjfin,kideb,kifin ,&
305                 'second_line_format=values written from (k=kbeg,kend (j=jbeg,jend (i=ibeg,iend)))'
306     ENDIF
307   ENDIF
308   !
309   if (KVERBIA > 0) then
310     print'(A,6(I4,X))',' kideb,kifin,kjdeb,kjfin,kkdeb,kkfin= ',kideb,kifin,kjdeb,kjfin,kkdeb,kkfin
311     print'(A,2(I6,X),4(I4,X))',' ktdeb,ktfin,ktrdeb,ktrfin,kpdeb,kpfin= ',&
312     ktdeb,ktfin,ktrdeb,ktrfin,kpdeb,kpfin
313     print'(A,6(I4,X))',' dimensions de XVAR ',SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
314                                   SIZE(XVAR,4),SIZE(XVAR,5),SIZE(XVAR,6)
315
316   endif
317   ! ecriture du champ + lat,lon ,altitude du niveau
318   INBVAL= (kkfin-kkdeb+1) * (kjfin-kjdeb+1) * (kifin-kideb+1)
319   DO JPLOOP= KPDEB,KPFIN
320     IGRID=NGRIDIA(JPLOOP)
321     IF (.NOT.PRESENT(PLAT) .AND. .NOT.PRESENT(PLON)) THEN
322       ZX(1:IIU,1) = XXX(1:IIU,IGRID)
323       ZX(:,2:IJU) = SPREAD(ZX(:,1),2,IJU-1)
324       ZY(1,1:IJU) = XXY(1:IJU,IGRID)
325       ZY(2:IIU,:) = SPREAD(ZY(1,:),1,IIU-1)
326       ! les 2 premiers arg. doivent etre XXHAT et XYHAT (pas XXX et XXY)
327       !! peu importe en masdev4_6 car plus utilises.. 
328       !CALL SM_LATLON(XXHAT,XYHAT,XLATORI,XLONORI, &
329       !! supprimes en masdev4_7
330       CALL SM_LATLON(XLATORI,XLONORI,             &
331                      ZX,ZY,ZLAT,ZLON              )
332     ENDIF
333     ! init de XZZ a la grille du champ (par defaut readvar
334     !l initialise a la grille 4 des vitesses verticales W)
335     CALL COMPCOORD_FORDIACHRO(IGRID)
336     if (KVERBIA > 0) then
337       print'(A,I2)','*after COMPCOORD_FORDIACHRO ',IGRID
338     endif
339     DO JTRLOOP= KTRDEB,KTRFIN
340       DO JTLOOP= KTDEB,KTFIN
341         IAN=XDATIME(13,JTLOOP)
342         IMOIS=XDATIME(14,JTLOOP)
343         IJOUR=XDATIME(15,JTLOOP)
344         IHEURE=XDATIME(16,JTLOOP)/3600
345         IMINUTE=(XDATIME(16,JTLOOP)-(IHEURE*3600))/60
346         ISEC=XDATIME(16,JTLOOP)-IHEURE*3600-IMINUTE*60
347         IF ( HFLAGFILE(4:5) /= 'NH') THEN
348           IF ( HFLAGFILE(4:5) == '1H') THEN       
349           ! plusieurs futurs appels avec OLDNH : le nombre de lignes ne peut 
350           ! etre connu a cet instant
351             write(ILUOUTLL,FMT='(F10.5,X,I6,A,3(I2,X),A,2(I2,X),A,A)') XSPVAL,&
352                                JTLOOP,'(',            &
353                               IHEURE,IMINUTE,ISEC,')',  &
354                               JTRLOOP,JPLOOP, & 
355                     ' undef_value for these timenumber,',&
356                     ' (UTCHour Min. Sec.), trajectorynumber, processnumber'
357           ELSE
358             write(ILUOUTLL,FMT='(I7,X,F10.5,X,I6,A,3(I2,X),A,2(I2,X),A,A)') INBVAL,&
359                               XSPVAL,JTLOOP,'(',            &
360                               IHEURE,IMINUTE,ISEC,')',  &
361                               JTRLOOP,JPLOOP, & 
362                     'number_of_next_lines, undef_value for these timenumber,',&
363                     ' (UTCHour Min. Sec.), trajectorynumber, processnumber'
364           ENDIF
365         ENDIF
366         DO JKLOOP= kkdeb,kkfin
367           SELECT CASE ( HTYPEOUT(1:4) )
368           CASE ('LLHV','llhv') 
369             IF (kkdeb == 1 .AND. kkfin == 1) THEN
370               ! champ 2D: altitude donnee par PALT(:,:,IGRID) ou XXZS(:,:,IGRID)
371               DO JJLOOP= kjdeb,kjfin
372               DO JILOOP= kideb,kifin
373                 IF (PRESENT (PALT) ) THEN
374                   if (KVERBIA > 0) then
375                     print'(A,I2,X,F10.5)', 'LLHV 2D igrid PALT(:,:)= ',IGRID, &
376                                                        PALT(JILOOP,JJLOOP,IGRID)
377                   endif
378                   IF (HTYPEOUT(1:4)=='LLHV') THEN
379                     WRITE(ILUOUTLL,FMT=1000)ZLON(JILOOP,JJLOOP), &
380                                             ZLAT(JILOOP,JJLOOP), &
381                                             PALT(JILOOP,JJLOOP,IGRID), & 
382                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
383                   ELSE IF (HTYPEOUT(1:4)=='llhv') THEN
384                     WRITE(ILUOUTLL,FMT=1000)ZLAT(JILOOP,JJLOOP), &
385                                             ZLON(JILOOP,JJLOOP), &
386                                             PALT(JILOOP,JJLOOP,IGRID), & 
387                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
388                   ENDIF
389                 ELSE
390                   IF (HTYPEOUT(1:4)=='LLHV') THEN
391                     WRITE(ILUOUTLL,FMT=1000)ZLON(JILOOP,JJLOOP), &
392                                             ZLAT(JILOOP,JJLOOP), &
393                                             XXZS(JILOOP,JJLOOP,IGRID), & 
394                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
395                   ELSE IF (HTYPEOUT(1:4)=='llhv') THEN
396                     WRITE(ILUOUTLL,FMT=1000)ZLAT(JILOOP,JJLOOP), &
397                                             ZLON(JILOOP,JJLOOP), &
398                                             XXZS(JILOOP,JJLOOP,IGRID), & 
399                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
400                   ENDIF
401                 ENDIF
402               END DO
403               END DO
404             ELSE
405               ! champ 3D
406               !altitude des niveaux donnee par XZZ ou PALT
407               DO JJLOOP= kjdeb,kjfin
408               DO JILOOP= kideb,kifin
409                 IF (PRESENT (PALT) ) THEN
410                   if (KVERBIA > 0 .AND. JILOOP==1 .AND. JJLOOP==1) then
411                     print '(A,I4,X,F10.5)', 'LLHV 3D K,PALT(1,1,K)= ',JKLOOP, &
412                                                       PALT(JILOOP,JJLOOP,JKLOOP)
413                   endif
414                   IF (HTYPEOUT(1:4)=='LLHV') THEN
415                     WRITE(ILUOUTLL,FMT=1000)ZLON(JILOOP,JJLOOP),       &
416                                             ZLAT(JILOOP,JJLOOP),       &
417                                             PALT(JILOOP,JJLOOP,JKLOOP), &
418                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
419                   ELSE IF (HTYPEOUT(1:4)=='llhv') THEN
420                     WRITE(ILUOUTLL,FMT=1000)ZLAT(JILOOP,JJLOOP),       &
421                                             ZLON(JILOOP,JJLOOP),       &
422                                             PALT(JILOOP,JJLOOP,JKLOOP), &
423                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
424                   ENDIF
425                 ELSE
426                   IF (HTYPEOUT(1:4)=='LLHV') THEN
427                     WRITE(ILUOUTLL,FMT=1000)ZLON(JILOOP,JJLOOP),       &
428                                             ZLAT(JILOOP,JJLOOP),       &
429                                             XZZ(JILOOP,JJLOOP,JKLOOP), &
430                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
431                   ELSE IF (HTYPEOUT(1:4)=='llhv') THEN
432                     WRITE(ILUOUTLL,FMT=1000)ZLAT(JILOOP,JJLOOP),       &
433                                             ZLON(JILOOP,JJLOOP),       &
434                                             XZZ(JILOOP,JJLOOP,JKLOOP), &
435                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
436                   ENDIF
437                 ENDIF
438               END DO
439               END DO
440             ENDIF
441           CASE ('IJHV','jihv') 
442             IF (kkdeb == 1 .AND. kkfin == 1) THEN
443               ! champ 2D: altitude donnee par PALT(:,:,IGRID) ou XXZS(:,:,IGRID)
444               DO JJLOOP= kjdeb,kjfin
445               DO JILOOP= kideb,kifin
446                 IF (PRESENT (PALT) ) THEN
447                   if (KVERBIA > 0) then
448                     print '(A,I2,X,F10.5)', 'IJHV 2D igrid PALT(:,:)= ',IGRID, &
449                                                        PALT(JILOOP,JJLOOP,IGRID)
450                   endif
451                   IF (HTYPEOUT(1:4)=='IJHV') THEN
452                     WRITE(ILUOUTLL,FMT=1001) JILOOP, &
453                                              JJLOOP, &
454                                             PALT(JILOOP,JJLOOP,IGRID), & 
455                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
456                   ELSE IF (HTYPEOUT(1:4)=='jihv') THEN
457                     WRITE(ILUOUTLL,FMT=1001)JJLOOP, &
458                                             JILOOP, &
459                                             PALT(JILOOP,JJLOOP,IGRID), & 
460                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
461                   ENDIF
462                 ELSE
463                   IF (HTYPEOUT(1:4)=='IJHV') THEN
464                     WRITE(ILUOUTLL,FMT=1001)JILOOP, &
465                                             JJLOOP, &
466                                             XXZS(JILOOP,JJLOOP,IGRID), & 
467                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
468                   ELSE IF (HTYPEOUT(1:4)=='jihv') THEN
469                     WRITE(ILUOUTLL,FMT=1001)JJLOOP, &
470                                             JILOOP, &
471                                             XXZS(JILOOP,JJLOOP,IGRID), & 
472                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
473                   ENDIF
474                 ENDIF
475               END DO
476               END DO
477             ELSE
478               ! champ 3D
479               !altitude des niveaux donnee par XZZ ou PALT
480               DO JJLOOP= kjdeb,kjfin
481               DO JILOOP= kideb,kifin
482                 IF (PRESENT (PALT) ) THEN
483                   if (KVERBIA > 0 .AND. JILOOP==1 .AND. JJLOOP==1) then
484                     print '(A,I4,X,F10.5)', 'IJHV 3D K,PALT(1,1,K)= ',JKLOOP, &
485                                                       PALT(JILOOP,JJLOOP,JKLOOP)
486                   endif
487                   IF (HTYPEOUT(1:4)=='IJHV') THEN
488                     WRITE(ILUOUTLL,FMT=1001)JILOOP,       &
489                                             JJLOOP,       &
490                                             PALT(JILOOP,JJLOOP,JKLOOP), &
491                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
492                   ELSE IF (HTYPEOUT(1:4)=='jihv') THEN
493                     WRITE(ILUOUTLL,FMT=1001)JILOOP,       &
494                                             JJLOOP,       &
495                                             PALT(JILOOP,JJLOOP,JKLOOP), &
496                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
497                   ENDIF
498                 ELSE
499                   IF (HTYPEOUT(1:4)=='IJHV') THEN
500                     WRITE(ILUOUTLL,FMT=1001)JILOOP,       &
501                                             JJLOOP,       &
502                                             XZZ(JILOOP,JJLOOP,JKLOOP), &
503                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
504                   ELSE IF (HTYPEOUT(1:4)=='jihv') THEN
505                     WRITE(ILUOUTLL,FMT=1001)JILOOP,       &
506                                             JJLOOP,       &
507                                             XZZ(JILOOP,JJLOOP,JKLOOP), &
508                                             XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
509                   ENDIF
510                 ENDIF
511               END DO
512               END DO
513             ENDIF
514   
515           CASE ('LLZV','llzv','LLPV','llpv','LLAV','llav')
516             IF (PRESENT (PALT) ) THEN
517             !altitude des niveaux donnee par PALT
518               if (KVERBIA > 0) then
519                 print'(A,A,I4,X,F10.5)', HTYPEOUT(1:4),' K,PALT(1,1,K)= ',JKLOOP,PALT(1,1,JKLOOP)
520               endif
521             ELSE
522               PRINT*,'** WRITELLHV: les altitudes doivent etre passees par argument'
523               PRINT*,'          pour HTYPEOUT= ',HTYPEOUT(1:4)
524               KRETCODE=1
525               RETURN
526             ENDIF
527             DO JJLOOP= kjdeb,kjfin
528             DO JILOOP= kideb,kifin
529               IF (HTYPEOUT(1:2)=='LL') THEN
530                 WRITE(ILUOUTLL,FMT=1000)ZLON(JILOOP,JJLOOP),       &
531                                         ZLAT(JILOOP,JJLOOP),       &
532                                         PALT(1,1,JKLOOP),          &
533                                         XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
534               ELSE IF (HTYPEOUT(1:2)=='ll') THEN
535                 WRITE(ILUOUTLL,FMT=1000)ZLAT(JILOOP,JJLOOP),       &
536                                         ZLON(JILOOP,JJLOOP),       &
537                                         PALT(1,1,JKLOOP),          &
538                                         XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
539               ENDIF
540             END DO
541             END DO
542           CASE ('IJZV','jizv','IJPV','jipv') 
543             IF (PRESENT (PALT) ) THEN
544             !altitude des niveaux donnee par PALT
545               if (KVERBIA > 0) then
546                 print'(A,A,I4,X,F10.5)', HTYPEOUT(1:4),' K,PALT(1,1,K)= ',JKLOOP,PALT(1,1,JKLOOP)
547               endif
548             ELSE
549               PRINT*,'** WRITELLHV: les altitudes doivent etre passees par argument'
550               PRINT*,'          pour HTYPEOUT= ',HTYPEOUT(1:4)
551               KRETCODE=1
552               RETURN
553             ENDIF
554             DO JJLOOP= kjdeb,kjfin
555             DO JILOOP= kideb,kifin
556               IF (HTYPEOUT(1:2)=='IJ') THEN
557                 WRITE(ILUOUTLL,FMT=1001)JILOOP,       &
558                                         JJLOOP,       &
559                                         PALT(1,1,JKLOOP),          &
560                                         XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
561               ELSE IF (HTYPEOUT(1:2)=='ji') THEN
562                 WRITE(ILUOUTLL,FMT=1001)JJLOOP,       &
563                                         JILOOP,       &
564                                         PALT(1,1,JKLOOP),          &
565                                         XVAR(JILOOP,JJLOOP,JKLOOP,JTLOOP,JTRLOOP,JPLOOP)
566               ENDIF
567             END DO
568             END DO
569   
570           END SELECT
571         END DO
572       END DO
573     END DO
574   END DO
575 !    
576 1000  FORMAT ( 2(F11.6,1x),F8.2,1x,E15.9)
577 1001  FORMAT ( 2(I4,1x),F8.2,1x,E15.9)
578
579   if (KVERBIA >= 0) then
580     print*,'WRITELLHV: ecriture de ',TRIM(HLABELCHAMP)
581     print*,'--------- '
582   endif
583 ENDIF
584 !-------------------------------------------------------------------------------
585 !
586 !*       3.    FERMETURE DU FICHIER DE SORTIE
587 !              ------------------------------
588 !
589 IF ( HFLAGFILE(1:3) == 'CLO' ) THEN
590   if (KVERBIA > 0) then
591     print*,'WRITELLHV: before closing file ',TRIM(YFILEOUT),' unit ',iluoutll
592   endif
593   !
594   ! fichier de sortie
595   CLOSE(UNIT=ILUOUTLL)
596   CALL FMFREE(YFILEOUT,CLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
597   IF( NRESPDIAS(NBFILES)==0 ) THEN
598     if (KVERBIA >= 0) then
599             print*,'End of WRITELLHV: File ',TRIM(YFILEOUT),' available with format ',HTYPEOUT 
600       print*,'--------- '
601     endif
602   ELSE
603     PRINT*,' ****WRITELLHV: error when closing ', TRIM(YFILEOUT), &
604            ' code= ',NRESPDIAS(NBFILES)
605     KRETCODE=2
606     RETURN
607   ENDIF
608   !
609 ENDIF
610 !
611 !-------------------------------------------------------------------------------
612 END SUBROUTINE WRITELLHV