Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / EXTRACTDIA / readvar.f90
1 !     ######
2       SUBROUTINE  READVAR(HLABELCHAMP,HFILENAME,HFLAGFILE,&
3        KVERBIA,KRETCODE)
4 !     ################
5 !
6 !!****  *READVAR* - 
7 !! 
8 !!
9 !!    PURPOSE
10 !!    -------
11 !     Extraction d un champ du fichier diachronique et initialisation
12 !     des differents parametres utiles (grille, relief...)
13
14 !
15 !!**  METHOD
16 !!    ------
17 !     utilisation des routines de diaprog : le tableau de stockage
18 !     XVAR est alloué par les routines de lecture.
19 !
20 !     au maximum 44 fichiers simultanement ouverts 
21 !       44 =limite FMOPEN= (JPNXFM-10)/2 avec JPNXFM=99
22 !
23 !     HFLAGFILE='OPE' lors de la premiere utilisation du fichier
24 !     HFLAGFILE='NOP' lors des utilisations suivantes
25 !     HFLAGFILE='CLO' fermeture du fichier traite ( decremente
26 !      le nombre de fichiers ouverts comptabilises par FMOPEN)
27 !
28 !     KVERBIA= 0 impressions reduites au minimum (entree et sortie de la
29 !      routine)
30 !     KVERBIA >0 impressions pour signaler chaque etape de READVAR
31 !
32 !     KRETCODE = 0 execution de READVAR correcte
33 !     KRETCODE = 1 erreur lors de l ouverture du fichier
34 !     KRETCODE = 2 champ inconnu dans le fichier
35 !     KRETCODE = 3 Nombre de fichiers ouverts simultanement > limite
36 !
37 !!
38 !!    EXTERNAL
39 !!    --------
40 !!          CREATLINK : à l'ouverture du fichier, HFLAGFILE='OPE',
41 !!                      création d'un lien dans le directory local
42 !!                      si le fichier existe sous $DIRLFI
43 !!          TO_COMPUTING_UNITS: passage unites vers unites plus pertinentes 
44 !!                              pour effectuer des calculs       
45 !!
46 !!
47 !!
48 !!    IMPLICIT ARGUMENTS
49 !!    ------------------
50 !!
51 !!    REFERENCE
52 !!    ---------
53 !!
54 !!    AUTHORS
55 !!    -------
56 !!    I. Mallet et N. Asencio * CNRM*
57 !!
58 !!    Copyright 2003,  Meteo-France and Laboratoire d'Aerologie
59 !!    All Rights Reserved
60 !!
61 !!    MODIFICATIONS
62 !!    -------------
63 !!      Original    17/03/2003
64 !!      N. Asencio  01/2005    call To_Computing_units
65 !!      G. TANGUY  03/2010     problème pour les champs sur point de flux 
66 !                              on remplace les 999 sur les mailles à côtés des bords du domaine 
67 !                              par la valeur la plus proche dans le domaine zoomé
68 !
69 !-------------------------------------------------------------------------------
70 !
71 !*       0.    DECLARATIONS
72 !              ------------
73 !
74 ! modules MesoNH
75 USE MODD_PARAMETERS, ONLY: XUNDEF,JPHEXT
76 USE MODD_DIM1, ONLY: NIMAX,NJMAX,NKMAX
77 USE MODD_GRID1, ONLY: XZZ
78 ! modules DIACHRO
79 !                    grille : XXDXHAT(:,1:7) et XXX(:,1:7), XXZS(:,:,1:7)
80 USE MODD_COORD
81 USE MODD_TYPE_AND_LH, ONLY: NIL,NIH,NJL,NJH,NKL,NKH,CTYPE,LICP,LJCP,LKCP
82 !                    XVAR(i,j,k,,,), XMASK,XTRAJ ,XDATIME(16,t) ,CUNITE(p)
83 USE MODD_ALLOC_FORDIACHRO
84 !                    nom de fichiers NLUOUT,CLFIFM, CDESFM
85 USE MODD_OUT
86 USE MODD_FILES_DIACHRO, ONLY: NBFILES,CFILEDIAS,CLUOUTDIAS,NRESPDIAS, &
87                               NLUOUTDIAS, NNPRARDIAS, NFTYPEDIAS,     &
88                               NNINARDIAS, NVERBDIAS
89 !
90 USE MODD_DIACHRO, ONLY:CFILEDIA       
91 !
92 USE MODI_FMREAD
93 USE MODI_READ_DIACHRO
94 USE MODI_VERIF_GROUP
95 USE MODI_ALLOC_FORDIACHRO
96 !
97 ! modules TOOL
98 USE MODI_CREATLINK
99 ! modules EXTRACTDIA
100 USE MODI_TO_COMPUTING_UNITS
101 USE MODD_READLH
102 !
103 IMPLICIT NONE
104 !
105 !*       0.1   Dummy arguments
106 !              ---------------
107 !
108 CHARACTER(LEN=*), INTENT(IN) :: HLABELCHAMP, HFILENAME ! nom du champ et du fichier
109 CHARACTER(LEN=3), INTENT(INOUT) :: HFLAGFILE           ! ouverture/ deja ouvert
110 INTEGER, INTENT(IN)          :: KVERBIA                ! prints de controle
111 !
112 INTEGER, INTENT(OUT)         :: KRETCODE   ! Code de retour de la routine 
113 !
114 !*       0.2   Local variables
115 !              ---------------
116 !
117 CHARACTER(LEN=13) :: YGP ! limite a 13 (ou 9 si plusieurs procs) 
118                          !car read_diachro lit YRECFM(1:16)=YGP//'.PROCnn'
119 CHARACTER(LEN=32) :: YDESFM
120 INTEGER           :: JLOOP,JLOOPFIN,JI                              
121 INTEGER           :: IRESP,ILUDES
122 INTEGER           :: ILENG, ILENCH, IGRID, ILENDIM, IGROUP
123 INTEGER           :: idim3
124 INTEGER,DIMENSION(:),ALLOCATABLE :: ITABCHAR
125 CHARACTER(LEN=16) :: YRECFM
126 CHARACTER(LEN=20) :: YCOMMENT
127 CHARACTER(LEN=16),DIMENSION(:),ALLOCATABLE    :: YGROUP 
128 ! pour traiter les champs budget deja zoomes
129 REAL , allocatable, dimension(:,:,:,:,:,:):: ZVARSAVE !
130 !-------------------------------------------------------------------------------
131 !
132 !*       1.    INITIALISATION
133 !              --------------
134 !      
135 print *,'---------'
136 print *,'Beginning of READVAR ',TRIM(HFILENAME),' ',HFLAGFILE,' ',TRIM(HLABELCHAMP)
137 !
138 ! Code de retour de la routine : 0 = OK
139 !                                1 = erreur lors de l ouverture du fichier
140 !                                2 = champ inconnu
141 !                                3 = erreur sur le nombre de fichier
142 IF ( HFLAGFILE /= 'OPE' .AND. HFLAGFILE /= 'NOP' .AND. HFLAGFILE /= 'CLO' ) THEN
143   KRETCODE=1
144   print * ,'erreur d initialisation de HFLAGFILE =', HFLAGFILE
145   print * ,'HFLAGFILE peut prendre les valeurs: OPE,NOP,CLO'
146   print *,'---------'
147   RETURN
148 ENDIF
149
150 KRETCODE=0
151 ! code de retour d erreur des routines diaprog
152 LPBREAD=.FALSE.
153 !
154 IF(ALLOCATED(XVAR))THEN
155 ! desallocation des tableaux alloues dans READ_DIACHRO (via ALLOC_FOR_DIACHRO)
156   CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
157   if (KVERBIA >0)then
158     print *,'*after ALLOC_FORDIACHRO(1,1,1,1,1,1,3)'
159   endif
160 ENDIF
161 !-------------------------------------------------------------------------------
162 !
163 !*       2.    CLOSE THE FILE
164 !              --------------
165 !      
166 IF ( HFLAGFILE(1:3) == 'CLO' ) THEN
167    CALL FMCLOS(HFILENAME,'KEEP',CLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
168    !! FMFREE ne relache pas l unite logique pour .lfi car .des deja relache
169    DO JLOOP=1,NBFILES
170      ! reperage de l indice de CFILEDIAS pour le fichier HFILENAME
171      IF (CFILEDIAS(JLOOP) == HFILENAME ) THEN
172       ! decalage du tableau CFILEDIAS pour supprimer cet element
173         DO JLOOPFIN= JLOOP,NBFILES-1
174           CFILEDIAS(JLOOPFIN)=CFILEDIAS(JLOOPFIN+1)
175           CLUOUTDIAS(JLOOPFIN)=CLUOUTDIAS(JLOOPFIN+1)
176           NLUOUTDIAS(JLOOPFIN)=NLUOUTDIAS(JLOOPFIN+1)                
177           NNPRARDIAS(JLOOPFIN)=NNPRARDIAS(JLOOPFIN+1)
178           NFTYPEDIAS(JLOOPFIN)=NFTYPEDIAS(JLOOPFIN+1)
179           NVERBDIAS(JLOOPFIN)=NVERBDIAS(JLOOPFIN+1)
180         ENDDO
181         ! suppression du lien
182         CALL CREATLINK('DIRLFI',CFILEDIAS(JLOOP),'CLEAN',KVERBIA)
183         EXIT
184      ENDIF
185    ENDDO
186    NBFILES=NBFILES-1
187    print *,'End of READVAR: close of file ',TRIM(HFILENAME)
188    print *,'---------'
189    RETURN
190 ENDIF
191 !
192 !-------------------------------------------------------------------------------
193 !
194 !*       3.    OPEN THE FILE (first call)
195 !              --------------------------
196 !      
197 IF ( HFLAGFILE(1:3) == 'OPE' ) THEN
198 !
199   if (KVERBIA >0)then
200     print'(A23,I2,A17)','*before OPENning file, ',NBFILES,' currently opened'
201   endif
202 !     utilisation de tableaux et de NBFILES pour calquer la methode
203 !     diaprog et permettre le traitement de plusieurs fichiers simultanement
204   NBFILES=NBFILES+1
205   !IF (NBFILES > 44 ) THEN
206     ! 44 =limite FMOPEN= (JPNXFM-10)/2 avec JPNXFM=99
207   !!limite >44 car fmfree de file.des
208     !KRETCODE=3
209     !print *,' ****READVAR: pour FMOPEN erreur nb de fichiers ouverts >44 ',&
210     !          ' nbfiles= ',NBFILES
211     !RETURN
212   !ENDIF
213   IF (NBFILES > size(CFILEDIAS) ) THEN
214     KRETCODE=3
215     print'(A58,I3,A10,I3)',' ****READVAR: pour diachro erreur nb de fichiers ouverts > ',&
216                   size(CFILEDIAS), ' nbfiles= ',NBFILES
217     print *,'---------'
218     RETURN
219   ENDIF
220   CFILEDIAS(NBFILES)=HFILENAME
221   CLUOUTDIAS(NBFILES)=CLUOUTDIAS(1)
222   NNPRARDIAS(NBFILES)=0
223   NFTYPEDIAS(NBFILES)= NFTYPEDIAS(1)
224   NVERBDIAS(NBFILES)=KVERBIA
225   ! listing OUT_DIA
226   CALL FMLOOK(CLUOUTDIAS(NBFILES),CLUOUTDIAS(NBFILES),&
227               NLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
228   IF (NRESPDIAS(NBFILES)/=0) THEN
229     ! ouverture du listing
230     CALL FMATTR(CLUOUTDIAS(NBFILES),CLUOUTDIAS(NBFILES),&
231                 NLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
232     OPEN(UNIT=NLUOUTDIAS(NBFILES),FILE=CLUOUTDIAS(NBFILES),&
233        FORM='FORMATTED')
234   END IF                  
235   ! fichier diachronique
236   CALL CREATLINK('DIRLFI',CFILEDIAS(NBFILES),'CREAT',KVERBIA)
237   CALL FMOPEN(CFILEDIAS(NBFILES),'OLD',CLUOUTDIAS(NBFILES),&
238               NNPRARDIAS(NBFILES),NFTYPEDIAS(NBFILES),NVERBDIAS(NBFILES),&
239               NNINARDIAS(NBFILES),NRESPDIAS(NBFILES))
240 !      apres cet appel , variables initialisees:
241 !      NINARDIAS(NBFILES)= nb d articles dans le fichier
242 !      NRESPDIAS(NBFILES)= code de retour
243 !      une unite logique pour HFILENAME.des et HFILENAME.lfi
244 !    
245   if (KVERBIA >0)then
246     print'(A,A,A,5(I5,X))','*after OPENning files ',&
247                     TRIM(CFILEDIAS(NBFILES)),&
248                     TRIM(CLUOUTDIAS(NBFILES)),NNPRARDIAS(NBFILES), &
249                     NFTYPEDIAS(NBFILES),NVERBDIAS(NBFILES),&
250                     NNINARDIAS(NBFILES),NRESPDIAS(NBFILES)
251   endif
252   !
253   IF (NRESPDIAS(NBFILES).NE.0)THEN
254     KRETCODE=1
255     print'(A52,A20,A6,I3)',' ****READVAR: erreur lors de l ouverture du fichier ',&
256             CFILEDIAS (NBFILES), 'code= ',NRESPDIAS(NBFILES)
257     print *,'---------'
258     RETURN
259   ENDIF
260   !  
261   ! partie DES du fichier: fermeture et unite logique relachee
262   !YDESFM(1:LEN(YDESFM))=' '
263   !YDESFM=ADJUSTL(ADJUSTR(CFILEDIAS(NBFILES))//'.des')
264   !CALL FMLOOK(YDESFM,YDESFM,ILUDES,IRESP)
265   !CLOSE(ILUDES)
266   !CALL FMFREE(YDESFM,CLUOUTDIAS(NBFILES),NRESPDIAS(NBFILES))
267 !! ne pas relacher unite logique car compute_r00_pc doit fermer (avec FMCLOS)
268 !!le fic.  d entree qui a ete amende des var. Lag.
269 !
270 ! READ JPHEXT
271     CALL FMREAD(CFILEDIAS(NBFILES),'JPHEXT',CLUOUTDIAS(NBFILES),1,JPHEXT,IGRID,ILENCH,YCOMMENT,NRESPDIAS(NBFILES))
272
273 !*       3.1   Reading head of file
274 !              --------------------
275 !      
276   CALL READ_FILEHEAD(1,HFILENAME,CLUOUTDIAS(NBFILES))
277   if (KVERBIA >0)then
278     print'(A41,3(I4,X))','*after READ_FILEHEAD, NIMAX,NJMAX,NKMAX= ',&
279     NIMAX,NJMAX,NKMAX
280   endif
281   !
282   ! lecture de MENU_BUDGET.DIM, MENU_BUDGET
283   ! appel a INI_CST
284   ! appel a READ_DIMGRIDREF: appel a SET_DIM pour lecture de IMAX, J,K-MAX 
285   !                                         et calcul de I,J,K-INF,SUP 
286   !                         lecture de CARTESIAN,THINSHELL,STORAGE_TYPE     
287   !                         appel a SET_GRID
288   ! appel a COMPCOORD_FORDIACHRO(0): pour les 7 grilles, 
289   !          calcul de X,Y,Z-HAT(m) dans XXX,XXY,XXZ(:,1:7)        ! (MODD_COORD)
290   !                 de topography altitude values(m):XXZS(:,:,1:7) ! (MODD_COORD)
291   !                 de meshsize values XXDXHAT,XXDYHAT(:,1:7)      ! (MODD_COORD)
292         
293   !    apres cette lecture, les variables suivantes sont disponibles:
294   !    NIMAX,NJMAX,NKMAX , apres SETDIM, LCARTESIAN, LTHINSHELL,CSTORAGE_TYPE,
295   !    NGRID
296   !    XXHAT(IIU)   pour la grille de U
297   !    XYHAT(IJU)   pour la grille de V
298   !    XZHAT(IIU)
299   !    XMAP(IIU,IJU)
300   !    XLAT(IIU,IJU)   pour la grille de masse
301   !    XLON(IIU,IJU)   pour la grille de masse
302   !    XDXHAT(IIU),XDYHAT(IJU)
303   !    XZS(IIU,IJU)
304   !    XZZ(IIU,IJU,IKU)  pour la grille W
305   !    TDTMOD,TDTCUR,TDTEXP,TDTSEG,
306   !    NSTOP,NOUT_TIMES,NOUT_NUMB, XTSTEP,XSEGLEN,
307   ! 
308   CALL COMPCOORD_FORDIACHRO(4)  ! NGRID set to 4 then XZZ is the true height
309                                 !of w-point as in the model
310   if (KVERBIA >0)then
311     print *,'*after COMPCOORD_FORDIACHRO(4)'
312   endif
313   !
314   ! indiquera  au prochain appel de READVAR que le fichier courant 
315   !est deja ouvert  (lecture du champ sans init des modules)
316   HFLAGFILE(1:3)='NOP'
317 ENDIF
318 !-------------------------------------------------------------------------------
319 !
320 !*       4.    LIST OF GROUPS
321 !              --------------
322 !
323 IF(HLABELCHAMP(1:5)=='GROUP')THEN
324   print *,'*following groups are present in the file ',TRIM(HFILENAME)
325   ILENDIM=1
326   YRECFM='MENU_BUDGET.DIM'
327   CALL FMREAD(HFILENAME,YRECFM,CLUOUTDIAS(NBFILES),ILENDIM,ILENG,&
328   IGRID,ILENCH,YCOMMENT,NRESPDIAS(NBFILES))
329   IF(NRESPDIAS(NBFILES) == -47)THEN
330     print *,' No record MENU_BUDGET '
331     RETURN
332   ENDIF
333   ALLOCATE(ITABCHAR(ILENG))
334   YRECFM='MENU_BUDGET'
335   CALL FMREAD(HFILENAME,YRECFM,CLUOUTDIAS(NBFILES),ILENG,ITABCHAR, &
336   IGRID,ILENCH,YCOMMENT,NRESPDIAS(NBFILES))
337   IGROUP=ILENG/16
338   ALLOCATE(YGROUP(IGROUP))
339   DO JLOOP=1,IGROUP
340     DO JI= 1,16
341       YGROUP(JLOOP)(JI:JI)=CHAR(ITABCHAR(16*(JLOOP-1)+JI))
342     ENDDO
343   ENDDO
344   print *,'****************************** GROUPS *****************************'
345   print 100,(YGROUP(JLOOP),JLOOP=1,IGROUP)
346 100 FORMAT(1X,5A15)
347   DEALLOCATE(ITABCHAR,YGROUP)
348 !
349 ELSE
350 !-------------------------------------------------------------------------------
351 !
352 !*       5.    TEST IF GROUP EXISTS 
353 !              --------------------
354 !
355 YGP=HLABELCHAMP
356 CALL VERIF_GROUP(HFILENAME,CLUOUTDIAS(NBFILES),YGP)
357 IF(LPBREAD)THEN
358   print *,' ****READVAR: Groupe ',TRIM(YGP),' inconnu dans le fichier ', &
359           TRIM(HFILENAME)
360   KRETCODE=2
361   LPBREAD=.FALSE.
362   print *,'---------'
363   RETURN
364 ENDIF
365 CFILEDIA=HFILENAME
366 !
367 !-------------------------------------------------------------------------------
368 !
369 !*       6.   READ GROUP
370 !             ----------
371 !
372 if (KVERBIA >0)then
373   print *,'*before READ_DIACHRO'
374 endif
375 !
376 CALL READ_DIACHRO(HFILENAME,CLUOUTDIAS(NBFILES),YGP)
377 if (KVERBIA >0)then
378   print *,'*after READ_DIACHRO'
379 endif
380 !
381 ! lecture d'un enregistrement de nom CGROUP (en fait plusieurs enregistrements 
382 !lus dans les variables suivantes:
383 !CGROUP//'.TYPE' => CTYPE('CART','MASK','SPXY','SSOL','RSPL','DRST','RAPL')
384                                                      ! MODD_TYPE_AND_LH
385 !CGROUP//'.DIM'  si CTYPE='CART','MASK','SPXY'
386 !             NIL,NJL,NKL,NIH,NJH,NKH,LICP,LJCP,LKCP ! MODD_TYPE_AND_LH
387 ! = zoom inside the complete x-y-zgrid
388 !                appel de ALLOC_FORDIACHRO pour allouer les var. suivantes
389 !CGROUP//'.TITRE'  =>CTITRE(p)                       ! MODD_ALLOC_FORDIACHRO
390 !CGROUP//'.UNITE'  =>CUNITE(p)                       ! MODD_ALLOC_FORDIACHRO
391 !CGROUP//'.COMMENT' =>COMMENT(p)                     ! MODD_ALLOC_FORDIACHRO
392 !CGROUP//'.PROCp' =>XVAR(i,j,k,t,n,p),NGRIDIA(p)     ! MODD_ALLOC_FORDIACHRO
393 !CGROUP//'.TRAJT' =>XTRAJT(t,n)                      ! MODD_ALLOC_FORDIACHRO
394
395 !CGROUP//'.TRAJX' =>XTRAJX(k,t,n)  optional          ! MODD_ALLOC_FORDIACHRO
396 !CGROUP//'.TRAJY' =>XTRAJY(k,t,n)    "               ! MODD_ALLOC_FORDIACHRO
397 !CGROUP//'.TRAJZ' =>XTRAJZ(k,t,n)    "               ! MODD_ALLOC_FORDIACHRO
398 !CGROUP//'.MASK'  =>XMASK(i,j,1,t,n,1)  " (si CTYPE='MASK')! MODD_ALLOC_FORDIACHRO
399 !CGROUP//'.DATIM' =>XDATIME(16,t)                    ! MODD_ALLOC_FORDIACHRO
400 ! EXP.YEAR=XDATIME(1,t); EXP.MONTH=XDATIME(2,t) 
401 ! EXP.DAY=XDATIME(3,t) ; EXP.TIME=XDATIME(4,t)
402 ! SEG.YEAR=XDATIME(5,t); SEG.MONTH=XDATIME(6,t)
403 ! SEG.DAY=XDATIME(7,t);  SEG.TIME=XDATIME(8,t)
404 ! MOD.YEAR=XDATIME(9,t); MOD.MONTH=XDATIME(10,t) 
405 ! MOD.DAY=XDATIME(11,t) ; MOD.TIME=XDATIME(12,t)
406 ! CUR.YEAR=XDATIME(13,t); CUR.MONTH=XDATIME(14,t)
407 ! CUR.DAY=XDATIME(15,t);  CUR.TIME=XDATIME(16,t)
408 !
409
410 ! Passage a des unites plus pertinentes pour calculs si necessaire
411 CALL TO_COMPUTING_UNITS(YGP,CUNITE(1))
412 !
413 ! Traitement d un champ eventuellement zoome
414 !
415 IF (CTYPE == 'CART' .AND. .NOT. LICP .AND. .NOT. LJCP ) THEN
416   IF( SIZE(XVAR,1) /= SIZE(XZZ,1) .OR. SIZE(XVAR,2) /= SIZE(XZZ,2) )THEN
417         ! replace le zoom dans le domaine total avant tout autre traitement
418         !pour avoir les memes indices pour XLON,XLAT et ZHAT et XVAR
419         if (KVERBIA > 0 ) then
420           print *,' Replace un champ zoome dans le domaine total:'
421           print'(A19,3(I4,X))','NIMAX,NJMAX,NKMAX= ',NIMAX,NJMAX,NKMAX
422           print'(A25,6(I4,X))','nil,nih,njl,njh,nkl,nkh= ',nil,nih,njl,njh,nkl,nkh
423         endif
424         ! sauve XVAR
425         ALLOCATE(ZVARSAVE(size(XVAR,1),size(XVAR,2),size(XVAR,3),   &
426                           size(XVAR,4),size(XVAR,5),size(XVAR,6))   )
427         ZVARSAVE=XVAR
428         if (KVERBIA > 0 ) then
429           print *,'dimensions 4 5 6 :'
430           print'(3(I5,x))',size(ZVARSAVE,4),size(ZVARSAVE,5),size(ZVARSAVE,6)
431         endif
432         DEALLOCATE(XVAR)
433         idim3=SIZE(XZZ,3)
434         IF (SIZE(ZVARSAVE,3) /= SIZE(XZZ,3)) THEN
435           IF (SIZE(ZVARSAVE,3)/=1 )THEN
436             !champ 3D zoome selon k
437             idim3=SIZE(XZZ,3)
438           ELSE
439             !champ 2D
440             idim3=SIZE(ZVARSAVE,3)
441           ENDIF
442         ENDIF
443         ! nouveau XVAR= domaine total
444         ALLOCATE(XVAR(SIZE(XZZ,1),SIZE(XZZ,2),idim3,&
445                       SIZE(ZVARSAVE,4),SIZE(ZVARSAVE,5),SIZE(ZVARSAVE,6)))
446         ! init seulement du zoom lu stocke dans ZVARSAVE
447         XVAR=XUNDEF
448         XVAR(nil:nih,njl:njh,nkl:nkh,:,:,:)=ZVARSAVE(:,:,:,:,:,:)
449         DEALLOCATE (ZVARSAVE)
450
451         !! GAELLE mars 2010
452         IF (nil /= 1) THEN
453            XVAR(nil-1,:,:,:,:,:)=XVAR(nil,:,:,:,:,:)
454         ENDIF
455         IF (nih /= SIZE(XZZ,1) ) THEN 
456             XVAR(nih+1,:,:,:,:,:)= XVAR(nih,:,:,:,:,:)
457         ENDIF
458         IF (njl /= 1) THEN
459            XVAR(:,njl-1,:,:,:,:)=XVAR(:,njl,:,:,:,:)
460         ENDIF
461         IF(njh /= SIZE(XZZ,2) ) THEN
462            XVAR(:,njh+1,:,:,:,:)=XVAR(:,njh,:,:,:,:)
463         ENDIF
464         IF (nkl /= 1) THEN
465            XVAR(:,:,nkl-1,:,:,:)=XVAR(:,:,nkl,:,:,:)
466         ENDIF
467         IF(nkh /= idim3) THEN
468            XVAR(:,:,nkh+1,:,:,:)=XVAR(:,:,nkh,:,:,:)
469         ENDIF
470         !! GAELLE mars 2010
471
472 !     ENDIF
473   ENDIF
474 ENDIF
475 !
476 ! Traitement d un champ partiellement ecrit
477 !
478 IF (CTYPE == 'CART' .AND. .NOT. LKCP) THEN
479   IF( SIZE(XVAR,3) /= SIZE(XZZ,3) )THEN
480         if (KVERBIA > 0 ) then
481           print *,' Replace un champ partiellement ecrit dans le domaine total:'
482           print'(A7,I3)','NKMAX= ',NKMAX
483           print'(A9,2(I3,X))','nkl,nkh= ',nkl,nkh
484         endif
485     ALLOCATE(ZVARSAVE(size(XVAR,1),size(XVAR,2),size(XVAR,3),   &
486                       size(XVAR,4),size(XVAR,5),size(XVAR,6))   )
487     ZVARSAVE=XVAR
488     IF (SIZE(ZVARSAVE,3)/=1 )THEN
489       !champ 3D zoome selon k
490       idim3=SIZE(XZZ,3)
491     ELSE
492       !champ 2D
493       idim3=SIZE(ZVARSAVE,3)
494     ENDIF
495     print*,idim3
496     DEALLOCATE(XVAR)
497     ALLOCATE(XVAR(SIZE(ZVARSAVE,1),SIZE(ZVARSAVE,2),idim3,&
498                   SIZE(ZVARSAVE,4),SIZE(ZVARSAVE,5),SIZE(ZVARSAVE,6)))
499     XVAR=XUNDEF
500     XVAR(:,:,nkl:nkh,:,:,:)=ZVARSAVE(:,:,:,:,:,:)
501     !! GAELLE mars 2010
502     IF (nkl /= 1) THEN
503     XVAR(:,:,nkl-1,:,:,:)=XVAR(:,:,nkl,:,:,:)
504     ENDIF
505     print*,nkh,idim3
506     IF(nkh /= idim3) THEN
507     XVAR(:,:,nkh+1,:,:,:)=XVAR(:,:,nkh,:,:,:)
508     ENDIF
509     !! GAELLE mars 2010
510
511     DEALLOCATE (ZVARSAVE)
512   ENDIF
513 ENDIF
514 !
515 NREADIL=1 ; NREADIH=SIZE(XVAR,1)
516 NREADJL=1 ; NREADJH=SIZE(XVAR,2)
517 NREADKL=1 ; NREADKH=SIZE(XVAR,3)
518 IF (CTYPE=='CART' .OR. CTYPE=='MASK' .OR. CTYPE=='SPXY') THEN 
519   IF (.NOT. LICP) THEN
520     NREADIL=NIL ; NREADIH=NIH
521   END IF
522   IF (.NOT. LJCP) THEN
523     NREADJL=NJL ; NREADJH=NJH
524   END IF
525   IF (.NOT. LKCP) THEN
526     NREADKL=NKL ; NREADKH=NKH
527   END IF
528 ENDIF
529 if (KVERBIA >= 0) then
530   print*,'End of READVAR: the group ',&
531           TRIM(YGP),' of file ',TRIM(HFILENAME),&
532           ' is available in the XVAR array with sizes'
533   print'(A4,I4,5(A5,I4))','  1:',SIZE(XVAR,1),',1:',SIZE(XVAR,2),',1:',SIZE(XVAR,3),&
534            ',1:',SIZE(XVAR,4),',1:',SIZE(XVAR,5),',1:',SIZE(XVAR,6)
535   IF (CTYPE=='CART' .OR. CTYPE=='MASK' .OR. CTYPE=='SPXY') THEN 
536     print'(A90,6(I4,A))',&
537          '(initialized in the zoom (NREADIL:NREADIH,NREADJL:NREADJH,NREADKL:NREADKH)= ',&
538          NREADIL,':',NREADIH,',',NREADJL,':',NREADJH,',',NREADKL,':',NREADKH,')'
539   END IF
540 endif
541 !
542 ENDIF  ! HLABELCHAMP(1:5)/='GROUP'
543 print *,'---------'
544 !
545 END SUBROUTINE READVAR