9a1b0dd803c0302e9224e7600f85da1d8925d5a8
[MNH-git_open_source-lfs.git] / tools / lfi2cdf / src / mode_util.f90
1 MODULE mode_util
2   USE MODE_FIELDTYPE
3   USE mode_dimlist
4   USE MODD_PARAM
5   USE netcdf
6
7   IMPLICIT NONE 
8
9   INTEGER,PARAMETER :: MAXRAW=10
10   INTEGER,PARAMETER :: MAXLEN=512
11
12   TYPE cdf_files
13     INTEGER :: nbfiles
14     LOGICAL :: opened
15     INTEGER,DIMENSION(:),ALLOCATABLE :: cdf_id !ID of the netCDF file
16     INTEGER,DIMENSION(:),ALLOCATABLE :: var_id !position of the variable in the workfield structure
17   END TYPE cdf_files
18
19
20   TYPE workfield
21      CHARACTER(LEN=FM_FIELD_SIZE)            :: name   ! nom du champ
22      INTEGER                                 :: TYPE   ! type (entier ou reel)    
23      CHARACTER(LEN=:), POINTER               :: comment
24      TYPE(dimCDF),                   POINTER :: dim
25      INTEGER                                 :: id
26      INTEGER                                 :: grid
27      LOGICAL                                 :: found  ! T if found in the input file
28      LOGICAL                                 :: calc   ! T if computed from other variables
29      LOGICAL                                 :: tbw    ! to be written or not
30      LOGICAL                                 :: tbr    ! to be read or not
31      INTEGER,DIMENSION(MAXRAW)               :: src    ! List of variables used to compute the variable (needed only if calc=.true.)
32      INTEGER                                 :: tgt    ! Target: id of the variable that use it (calc variable)
33   END TYPE workfield
34
35 #ifndef LOWMEM
36   TYPE lfidata
37      INTEGER(KIND=8), DIMENSION(:), POINTER :: iwtab
38   END TYPE lfidata
39   TYPE(lfidata), DIMENSION(:), ALLOCATABLE :: lfiart
40 #endif
41
42   LOGICAL(KIND=LFI_INT), PARAMETER :: ltrue  = .TRUE.
43   LOGICAL(KIND=LFI_INT), PARAMETER :: lfalse = .FALSE.
44
45 CONTAINS 
46   FUNCTION str_replace(hstr, hold, hnew)
47     CHARACTER(LEN=*) :: hstr, hold, hnew
48     CHARACTER(LEN=LEN_TRIM(hstr)+MAX(0,LEN(hnew)-LEN(hold))) :: str_replace
49     
50     INTEGER :: pos
51     
52     pos = INDEX(hstr,hold)
53     IF (pos /= 0) THEN
54        str_replace = hstr(1:pos-1)//hnew//hstr(pos+LEN(hold):)
55     ELSE 
56        str_replace = hstr 
57     END IF
58
59   END FUNCTION str_replace
60
61   SUBROUTINE FMREADLFIN1(klu,hrecfm,kval,kresp)
62   INTEGER(KIND=LFI_INT), INTENT(IN) :: klu ! logical fortran unit au lfi file
63   CHARACTER(LEN=*),INTENT(IN)       :: hrecfm ! article name to be read
64   INTEGER, INTENT(OUT)        :: kval ! integer value for hrecfm article
65   INTEGER(KIND=LFI_INT), INTENT(OUT):: kresp! return code null if OK
66   !
67   INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE::iwork
68   INTEGER :: icomlen
69   INTEGER(KIND=LFI_INT) :: iresp,ilenga,iposex
70   !
71   CALL LFINFO(iresp,klu,hrecfm,ilenga,iposex)
72   IF (iresp /=0 .OR. ilenga == 0) THEN
73     kresp = -1
74     kval = 0
75   ELSE
76     ALLOCATE(IWORK(ilenga))
77     CALL LFILEC(iresp,klu,hrecfm,iwork,ilenga)
78     icomlen = iwork(2)
79     kval = iwork(3+icomlen)
80     kresp = iresp
81     DEALLOCATE(IWORK)
82   END IF
83   END SUBROUTINE FMREADLFIN1
84
85   SUBROUTINE parse_lfi(klu, hvarlist, nbvar_lfi, nbvar_tbr, nbvar_calc, nbvar_tbw, tpreclist, kbuflen, icurrent_level)
86     INTEGER, INTENT(IN)                    :: klu
87     INTEGER, INTENT(IN)                    :: nbvar_lfi, nbvar_tbr, nbvar_calc, nbvar_tbw
88     CHARACTER(LEN=*), intent(IN)           :: hvarlist
89     TYPE(workfield), DIMENSION(:), POINTER :: tpreclist    
90     INTEGER, INTENT(OUT)                   :: kbuflen
91     INTEGER, INTENT(IN), OPTIONAL          :: icurrent_level
92
93     INTEGER                                  :: ji,jj
94     INTEGER                                  :: ndb, nde, ndey, idx, idx_var, maxvar
95     LOGICAL                                  :: ladvan
96     INTEGER                                  :: ich, current_level
97     INTEGER                                  :: fsize,sizemax
98     CHARACTER(LEN=FM_FIELD_SIZE)             :: yrecfm
99     CHARACTER(LEN=4)                         :: suffix
100 #ifdef LOWMEM
101     INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork
102 #endif
103     INTEGER(KIND=LFI_INT)                    :: iresp,ilu,ileng,ipos
104     !JUAN CYCCL3
105     INTEGER                        :: JPHEXT
106
107     ilu = klu
108
109     CALL FMREADLFIN1(klu,'JPHEXT',JPHEXT,iresp)
110     IF (iresp /= 0) JPHEXT=1
111     ! First check if IMAX,JMAX,KMAX exist in LFI file
112     ! to handle 3D, 2D variables -> update IDIMX,IDIMY,IDIMZ
113     CALL FMREADLFIN1(klu,'IMAX',IDIMX,iresp)
114     IF (iresp == 0) IDIMX = IDIMX+2*JPHEXT  ! IMAX + 2*JPHEXT
115     !
116     CALL FMREADLFIN1(klu,'JMAX',IDIMY,iresp)
117     IF (iresp == 0) IDIMY = IDIMY+2*JPHEXT  ! JMAX + 2*JPHEXT
118     !
119     CALL FMREADLFIN1(ilu,'KMAX',IDIMZ,iresp)
120     IF (iresp == 0) IDIMZ = IDIMZ+2  ! KMAX + 2*JPVEXT
121     GUSEDIM = (IDIMX*IDIMY > 0)
122     IF (GUSEDIM) THEN
123       PRINT *,'MESONH 3D, 2D articles DIMENSIONS used :'
124       PRINT *,'DIMX =',IDIMX
125       PRINT *,'DIMY =',IDIMY
126       PRINT *,'DIMZ =',IDIMZ ! IDIMZ may be equal to 0 (PGD files)
127     ELSE
128       PRINT *,'BEWARE : ALL MesoNH arrays are handled as 1D arrays !'
129     END IF
130
131     sizemax = 0
132
133     IF (present(icurrent_level)) THEN
134       write(suffix,'(I4.4)') icurrent_level
135       current_level = icurrent_level
136     ElSE
137       suffix=''
138       current_level = -1
139     END IF
140
141     ! Phase 1 : build articles list to convert.
142     !
143     !    Pour l'instant tous les articles du fichier LFI sont
144     !    convertis. On peut modifier cette phase pour prendre en
145     !    compte un sous-ensemble d'article (liste definie par
146     !    l'utilisateur par exemple)  
147     !
148     IF (LEN_TRIM(hvarlist) > 0) THEN
149 #ifndef LOWMEM
150       IF(.NOT.ALLOCATED(lfiart)) ALLOCATE(lfiart(nbvar_tbr+nbvar_calc))
151 #endif
152       ALLOCATE(tpreclist(nbvar_tbr+nbvar_calc))
153       DO ji=1,nbvar_tbr+nbvar_calc
154         tpreclist(ji)%found  = .FALSE.
155         tpreclist(ji)%calc   = .FALSE. !By default variables are not computed from others
156         tpreclist(ji)%tbw    = .TRUE.  !By default variables are written
157         tpreclist(ji)%tbr    = .TRUE.  !By default variables are written
158         tpreclist(ji)%src(:) = -1
159         tpreclist(ji)%tgt    = -1
160       END DO
161
162        ! A variable list is provided with -v var1,...
163        ndb  = 1
164        idx_var = 1
165        DO ji=1,nbvar_tbw
166           nde = INDEX(TRIM(hvarlist(ndb:)),',')
167           yrecfm = hvarlist(ndb:ndb+nde-2)
168
169           !Detect operations on variables (only + is supported now)
170           ndey = INDEX(TRIM(yrecfm),'=')
171           idx = 1
172           IF (ndey /= 0) THEN
173             var_calc = yrecfm(1:ndey-1)
174             DO WHILE (ndey /= 0)
175               IF (idx>MAXRAW) THEN
176                 print *,'Error: MAXRAW exceeded (too many raw variables for 1 computed one)'
177                 STOP
178               END IF
179               yrecfm = yrecfm(ndey+1:)
180               ndey = INDEX(TRIM(yrecfm),'+')
181               IF (ndey /= 0) THEN
182                 var_raw(idx) = yrecfm(1:ndey-1)
183               ELSE
184                 var_raw(idx) = TRIM(yrecfm)
185               END IF
186               idx = idx + 1
187             END DO
188
189             tpreclist(idx_var)%name = trim(var_calc)
190             tpreclist(idx_var)%calc = .TRUE.
191             tpreclist(idx_var)%tbw  = .TRUE.
192             tpreclist(idx_var)%tbr  = .FALSE.
193             idx_var=idx_var+1
194             DO jj = 1, idx-1
195               tpreclist(idx_var-jj)%src(jj) = idx_var
196               tpreclist(idx_var)%name = trim(var_raw(jj))
197               tpreclist(idx_var)%calc = .FALSE.
198               tpreclist(idx_var)%tbw  = .FALSE.
199               tpreclist(idx_var)%tbr  = .TRUE.
200               tpreclist(idx_var)%tgt  = idx_var-jj
201               idx_var=idx_var+1
202             END DO
203
204           ELSE
205             tpreclist(idx_var)%name = trim(yrecfm)
206             tpreclist(idx_var)%calc = .FALSE.
207             tpreclist(idx_var)%tbw  = .TRUE.
208             idx_var=idx_var+1
209
210           END IF
211
212           ndb = nde+ndb
213        END DO
214
215 !TODO: merge loop?
216        DO ji=1,nbvar_tbr+nbvar_calc
217           IF (tpreclist(ji)%calc) CYCLE
218           yrecfm = TRIM(tpreclist(ji)%name)
219           CALL LFINFO(iresp,ilu,trim(yrecfm)//trim(suffix),ileng,ipos)
220           
221           IF (iresp /= 0 .OR. ileng == 0) THEN
222              PRINT *,'Article ',TRIM(yrecfm), ' not found!'
223              tpreclist(ji)%found = .FAlSE.
224              tpreclist(ji)%tbw   = .FAlSE.
225              tpreclist(ji)%tbr   = .FAlSE.
226           ELSE
227              tpreclist(ji)%found = .TRUE.
228              ! PRINT *,'Article ',ji,' : ',TRIM(yrecfm),', longueur = ',ileng
229              IF (ileng > sizemax) sizemax = ileng        
230 #ifndef LOWMEM
231              ALLOCATE(lfiart(ji)%iwtab(ileng))
232 #endif
233           end IF
234        END DO
235
236        maxvar = nbvar_tbr+nbvar_calc
237
238 DO ji=1,nbvar_tbr+nbvar_calc
239   print *,ji,'name=',trim(tpreclist(ji)%name),' calc=',tpreclist(ji)%calc,' tbw=',tpreclist(ji)%tbw,&
240           ' tbr=',tpreclist(ji)%tbr,' found=',tpreclist(ji)%found
241 END DO
242
243     ELSE
244        ! Entire file is converted
245 #ifndef LOWMEM
246        IF(.NOT.ALLOCATED(lfiart)) ALLOCATE(lfiart(nbvar_lfi))
247 #endif
248        ALLOCATE(tpreclist(nbvar_lfi))
249        DO ji=1,nbvar_lfi
250          tpreclist(ji)%calc   = .FALSE. !By default variables are not computed from others
251          tpreclist(ji)%tbw    = .TRUE.  !By default variables are written
252          tpreclist(ji)%src(:) = -1
253        END DO
254
255        CALL LFIPOS(iresp,ilu)
256        ladvan = .TRUE.
257        
258        DO ji=1,nbvar_lfi
259           CALL LFICAS(iresp,ilu,yrecfm,ileng,ipos,ladvan)
260           ! PRINT *,'Article ',ji,' : ',TRIM(yrecfm),', longueur = ',ileng
261           tpreclist(ji)%name = trim(yrecfm)
262           tpreclist(ji)%found  = .TRUE.
263           IF (ileng > sizemax) sizemax = ileng        
264 #ifndef LOWMEM       
265           ALLOCATE(lfiart(ji)%iwtab(ileng))
266 #endif
267        END DO
268        maxvar = nbvar_lfi
269     END IF
270
271     kbuflen = sizemax
272
273 #ifdef LOWMEM
274     WRITE(*,'("Taille maximale du buffer :",f10.3," Mio")') sizemax*8./1048576.
275     ALLOCATE(iwork(sizemax))
276 #endif
277     
278     ! Phase 2 : Extract comments and dimensions for valid articles.
279     !           Infos are put in tpreclist.
280     CALL init_dimCDF()
281     DO ji=1,maxvar
282        IF (tpreclist(ji)%calc .OR. .NOT.tpreclist(ji)%found) CYCLE
283
284        yrecfm = trim(tpreclist(ji)%name)//trim(suffix)
285        CALL LFINFO(iresp,ilu,yrecfm,ileng,ipos)
286 #ifdef LOWMEM
287        CALL LFILEC(iresp,ilu,yrecfm,iwork,ileng)
288        tpreclist(ji)%TYPE = get_ftype(yrecfm,current_level)
289        tpreclist(ji)%grid = iwork(1)
290
291        ALLOCATE(character(len=iwork(2)) :: tpreclist(ji)%comment)
292        DO jj=1,iwork(2)
293           ich = iwork(2+jj)
294           tpreclist(ji)%comment(jj:jj) = CHAR(ich)
295        END DO
296        fsize = ileng-(2+iwork(2))
297 #else
298        CALL LFILEC(iresp,ilu,yrecfm,lfiart(ji)%iwtab,ileng)
299        tpreclist(ji)%TYPE = get_ftype(yrecfm,current_level)
300        tpreclist(ji)%grid = lfiart(ji)%iwtab(1)
301
302        ALLOCATE(character(len=lfiart(ji)%iwtab(2)) :: tpreclist(ji)%comment)
303        DO jj=1,lfiart(ji)%iwtab(2)
304           ich = lfiart(ji)%iwtab(2+jj)
305           tpreclist(ji)%comment(jj:jj) = CHAR(ich)
306        END DO
307        fsize = ileng-(2+lfiart(ji)%iwtab(2))
308 #endif
309        tpreclist(ji)%dim=>get_dimCDF(fsize)
310     END DO
311
312     !Complete info for calculated variables
313     IF (nbvar_calc>0) THEN
314     DO ji=1,maxvar
315        IF (.NOT.tpreclist(ji)%calc) CYCLE
316        tpreclist(ji)%TYPE = tpreclist(tpreclist(ji)%src(1))%TYPE
317        tpreclist(ji)%grid = tpreclist(tpreclist(ji)%src(1))%grid
318        tpreclist(ji)%dim  => tpreclist(tpreclist(ji)%src(1))%dim
319
320 !TODO: cleaner length!
321        ALLOCATE(character(len=256) :: tpreclist(ji)%comment)
322        tpreclist(ji)%comment='Constructed from'
323        jj = 1
324        DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
325          tpreclist(ji)%comment = trim(tpreclist(ji)%comment)//' '//trim(tpreclist(tpreclist(ji)%src(jj))%name)
326          IF (jj<MAXRAW .AND. tpreclist(ji)%src(jj+1)>0) THEN
327            tpreclist(ji)%comment = trim(tpreclist(ji)%comment)//' +'
328          END IF
329          jj=jj+1
330        END DO
331     END DO
332     END IF
333
334   
335     PRINT *,'Nombre de dimensions = ', size_dimCDF()
336 #ifdef LOWMEM
337     DEALLOCATE(iwork)
338 #endif
339   END SUBROUTINE parse_lfi
340   
341   SUBROUTINE read_data_lfi(klu, hvarlist, nbvar, tpreclist, kbuflen, current_level)
342     INTEGER, INTENT(IN)                    :: klu
343     INTEGER, INTENT(INOUT)                 :: nbvar
344     CHARACTER(LEN=*), intent(IN)           :: hvarlist
345     TYPE(workfield), DIMENSION(:), POINTER :: tpreclist
346     INTEGER, INTENT(IN)                    :: kbuflen
347     INTEGER, INTENT(IN), OPTIONAL          :: current_level
348
349     INTEGER                                  :: ji,jj
350     INTEGER                                  :: ndb, nde
351     LOGICAL                                  :: ladvan
352     INTEGER                                  :: ich
353     INTEGER                                  :: fsize,sizemax
354     CHARACTER(LEN=FM_FIELD_SIZE)             :: yrecfm
355     CHARACTER(LEN=4)                         :: suffix
356 #ifdef LOWMEM
357     INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork
358 #endif
359     INTEGER(KIND=LFI_INT)                    :: iresp,ilu,ileng,ipos
360     CHARACTER(LEN=FM_FIELD_SIZE)             :: var_calc
361     CHARACTER(LEN=FM_FIELD_SIZE),dimension(MAXRAW) :: var_raw
362
363     ilu = klu
364
365     IF (present(current_level)) THEN
366       write(suffix,'(I4.4)') current_level
367     ElSE
368       suffix=''
369     END IF
370
371 #ifdef LOWMEM
372     ALLOCATE(iwork(kbuflen))
373 #endif
374
375     DO ji=1,nbvar
376        IF (.NOT.tpreclist(ji)%tbr) CYCLE
377        yrecfm = trim(tpreclist(ji)%name)//trim(suffix)
378        CALL LFINFO(iresp,ilu,yrecfm,ileng,ipos)
379 #ifdef LOWMEM
380        CALL LFILEC(iresp,ilu,yrecfm,iwork,ileng)
381        tpreclist(ji)%grid = iwork(1)
382 #else
383        CALL LFILEC(iresp,ilu,yrecfm,lfiart(ji)%iwtab,ileng)
384        tpreclist(ji)%grid = lfiart(ji)%iwtab(1)
385 #endif
386     END DO
387
388 #ifdef LOWMEM
389     DEALLOCATE(iwork)
390 #endif
391   END SUBROUTINE read_data_lfi
392
393   SUBROUTINE HANDLE_ERR(status,line)
394     INTEGER :: status,line
395
396     IF (status /= NF90_NOERR) THEN
397        PRINT *, 'line ',line,': ',NF90_STRERROR(status)
398        STOP
399     END IF
400   END SUBROUTINE HANDLE_ERR
401
402   SUBROUTINE def_ncdf(tpreclist,nbvar,oreduceprecision,cdffiles,omerge,ocompress,compress_level)
403     TYPE(workfield),DIMENSION(:),INTENT(INOUT) :: tpreclist
404     INTEGER,                     INTENT(IN) :: nbvar
405     LOGICAL,                     INTENT(IN) :: oreduceprecision
406     TYPE(cdf_files),             INTENT(IN) :: cdffiles
407     LOGICAL,                     INTENT(IN) :: omerge
408     LOGICAL,                     INTENT(IN) :: ocompress
409     INTEGER,                     INTENT(IN) :: compress_level
410
411     INTEGER :: status
412     INTEGER :: idx, ji, nbfiles
413     INTEGER:: kcdf_id
414     TYPE(dimCDF), POINTER :: tzdim
415     INTEGER               :: invdims
416     INTEGER               :: type_float
417     INTEGER, DIMENSION(10) :: ivdims
418     CHARACTER(LEN=20)     :: ycdfvar
419
420
421     nbfiles = cdffiles%nbfiles
422
423     IF (oreduceprecision) THEN
424       type_float = NF90_REAL
425     ELSE
426       type_float = NF90_DOUBLE
427     END IF
428
429     DO ji = 1,nbfiles
430       kcdf_id = cdffiles%cdf_id(ji)
431
432       ! global attributes
433       status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'Title',VERSION_ID)
434       IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
435
436       ! define DIMENSIONS
437       tzdim=>first_DimCDF()
438       DO WHILE(ASSOCIATED(tzdim))
439         IF (tzdim%create) THEN
440           status = NF90_DEF_DIM(kcdf_id,tzdim%name,tzdim%len,tzdim%id)
441           IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
442         END IF
443         tzdim=>tzdim%next
444       END DO
445     END DO
446
447     PRINT *,'------------- NetCDF DEFINITION ---------------'
448
449     ! define VARIABLES and ATTRIBUTES
450     idx = 1
451     DO ji=1,nbvar
452        IF (.NOT.tpreclist(ji)%tbw) CYCLE
453
454        IF (ASSOCIATED(tpreclist(ji)%dim)) THEN
455          IF (tpreclist(ji)%dim%create) THEN
456            invdims   = 1
457            ivdims(1) = tpreclist(ji)%dim%id
458          ELSE
459            invdims = tpreclist(ji)%dim%ndims
460            IF(omerge) invdims=invdims+1 !when merging variables from LFI splitted files
461            SELECT CASE(invdims)
462            CASE(2)
463               ivdims(1)=ptdimx%id
464               ivdims(2)=ptdimy%id
465            CASE(3)
466               ivdims(1)=ptdimx%id
467               ivdims(2)=ptdimy%id
468               ivdims(3)=ptdimz%id
469            CASE(12)
470               ivdims(1)=ptdimx%id
471               ivdims(2)=ptdimz%id
472               invdims = 2 ! on retablit la bonne valeur du nbre de dimension
473            CASE default
474              PRINT *,'Fatal error in NetCDF dimension definition'
475              STOP
476            END SELECT
477          END IF
478        ELSE
479          ! scalar variables
480           invdims   = 0
481           ivdims(1) = 0 ! ignore dans ce cas
482        END IF
483        
484        ! Variables definition
485
486        !! NetCDF n'aime pas les '%' dans le nom des variables
487        !! "%" remplaces par '__' 
488        ycdfvar = str_replace(tpreclist(ji)%name,'%','__')
489        !! ni les '.' remplaces par '--'
490        ycdfvar = str_replace(ycdfvar,'.','--')
491
492        if (nbfiles > 1) kcdf_id = cdffiles%cdf_id(idx)
493
494        SELECT CASE(tpreclist(ji)%TYPE)
495        CASE (TEXT)
496 !          PRINT *,'TEXT : ',tpreclist(ji)%name
497           status = NF90_DEF_VAR(kcdf_id,ycdfvar,NF90_CHAR,&
498                    ivdims(:invdims),tpreclist(ji)%id)
499           IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
500
501        CASE (INT,BOOL)
502 !          PRINT *,'INT,BOOL : ',tpreclist(ji)%name
503           status = NF90_DEF_VAR(kcdf_id,ycdfvar,NF90_INT,&
504                    ivdims(:invdims),tpreclist(ji)%id)
505           IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
506
507        CASE(FLOAT)
508 !          PRINT *,'FLOAT : ',tpreclist(ji)%name
509           status = NF90_DEF_VAR(kcdf_id,ycdfvar,type_float,&
510                    ivdims(:invdims),tpreclist(ji)%id)
511           IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
512
513           
514        CASE default
515           PRINT *,'ATTENTION : ',TRIM(tpreclist(ji)%name),' est de&
516                & TYPE inconnu --> force a REAL'
517           status = NF90_DEF_VAR(kcdf_id,ycdfvar,type_float,&
518                    ivdims(:invdims),tpreclist(ji)%id)
519           IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
520           
521
522        END SELECT
523
524        ! Compress data (costly operation for the CPU)
525        IF (ocompress .AND. invdims>0) THEN
526          status = NF90_DEF_VAR_DEFLATE(kcdf_id,tpreclist(ji)%id,1,1,compress_level)
527          IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
528        END IF
529
530        ! GRID attribute definition
531        status = NF90_PUT_ATT(kcdf_id,tpreclist(ji)%id,'GRID',tpreclist(ji)%grid)
532        IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
533
534        ! COMMENT attribute definition
535        status = NF90_PUT_ATT(kcdf_id,tpreclist(ji)%id,'COMMENT',trim(tpreclist(ji)%comment))
536        IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
537
538        idx = idx + 1
539     END DO
540     
541     DO ji = 1,nbfiles
542       kcdf_id = cdffiles%cdf_id(ji)
543       status = NF90_ENDDEF(kcdf_id)
544       IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
545     END DO
546     
547   END SUBROUTINE def_ncdf
548
549   SUBROUTINE fill_ncdf(klu,tpreclist,knaf,kbuflen,cdffiles,current_level)
550     INTEGER,                      INTENT(IN):: klu
551     TYPE(workfield), DIMENSION(:),INTENT(IN):: tpreclist
552     INTEGER,                      INTENT(IN):: knaf
553     INTEGER,                      INTENT(IN):: kbuflen
554     TYPE(cdf_files),              INTENT(IN):: cdffiles
555     INTEGER, INTENT(IN), OPTIONAL           :: current_level
556
557 #ifdef LOWMEM
558     INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork
559 #endif
560     INTEGER                                  :: idx, ji,jj
561     INTEGER                                  :: kcdf_id
562     INTEGER                                  :: status
563     INTEGER                                  :: extent, ndims
564     INTEGER                                  :: ich
565     INTEGER                                  :: src
566     INTEGER                                  :: level
567     INTEGER(KIND=LFI_INT)                    :: iresp,ilu,ileng,ipos
568     CHARACTER(LEN=4)                         :: suffix
569     INTEGER,DIMENSION(:),ALLOCATABLE         :: itab
570     REAL(KIND=8),DIMENSION(:),ALLOCATABLE    :: xtab
571     CHARACTER, DIMENSION(:), ALLOCATABLE     :: ytab
572
573
574     kcdf_id = cdffiles%cdf_id(1)
575     !
576     ilu = klu
577     !
578
579     IF (present(current_level)) THEN
580       write(suffix,'(I4.4)') current_level
581       level = current_level
582     ElSE
583       suffix=''
584       level = 1
585     END IF
586
587 #if LOWMEM
588     ALLOCATE(iwork(kbuflen))
589 #endif
590     ALLOCATE(itab(kbuflen))
591     ALLOCATE(xtab(kbuflen))
592
593     idx = 1
594     DO ji=1,knaf
595        IF (.NOT.tpreclist(ji)%tbw) CYCLE
596
597        IF (cdffiles%nbfiles > 1) kcdf_id = cdffiles%cdf_id(idx)
598
599 #if LOWMEM
600        CALL LFINFO(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),ileng,ipos)
601        CALL LFILEC(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),iwork,ileng)
602 #endif
603        IF (ASSOCIATED(tpreclist(ji)%dim)) THEN
604           extent = tpreclist(ji)%dim%len
605           ndims = tpreclist(ji)%dim%ndims
606        ELSE
607           extent = 1
608           ndims = 0
609        END IF
610
611        SELECT CASE(tpreclist(ji)%TYPE)
612        CASE (INT,BOOL)
613 #if LOWMEM
614 ***
615 print *,'lowmem: not tested!!!!!' (to be compared with no low mem version)
616          itab(1:extent) = iwork(3+iwork(2):)
617 #else
618          IF (.NOT.tpreclist(ji)%calc) THEN
619            itab(1:extent) = lfiart(ji)%iwtab(3+lfiart(ji)%iwtab(2):)
620          ELSE
621            src=tpreclist(ji)%src(1)
622            xtab(1:extent) = lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):)
623            jj = 2
624            DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
625              src=tpreclist(ji)%src(jj)
626              xtab(1:extent) = xtab(1:extent) + lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):)
627              jj=jj+1
628            END DO
629          END IF
630          itab(1:extent) = lfiart(ji)%iwtab(3+lfiart(ji)%iwtab(2):)
631 #endif
632 !TODO: works in all cases??? (X, Y, Z dimensions assumed to be ptdimx,y or z)
633          SELECT CASE(ndims)
634          CASE (0)
635            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,itab(1))
636          CASE (1)
637            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,itab(1:extent),count=(/extent/))
638          CASE (2)
639            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,reshape(itab,(/ptdimx%len,ptdimy%len/)), &
640                                  start = (/1,1,level/) )
641          CASE (3)
642            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,reshape(itab,(/ptdimx%len,ptdimy%len,ptdimz%len/)))
643          CASE DEFAULT
644            print *,'Error: arrays with ',tpreclist(ji)%dim%ndims,' dimensions are not supported'
645          END SELECT
646          
647        CASE (FLOAT)
648 #if LOWMEM
649 ***
650 print *,'lowmem: not tested!!!!!' (to be compared with no low mem version)
651          xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /))
652 #else
653          IF (.NOT.tpreclist(ji)%calc) THEN
654            xtab(1:extent) = TRANSFER(lfiart(ji)%iwtab(3+lfiart(ji)%iwtab(2):),(/ 0.0_8 /))
655          ELSE
656            src=tpreclist(ji)%src(1)
657            xtab(1:extent) = TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /))
658            jj = 2
659            DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
660              src=tpreclist(ji)%src(jj)
661              xtab(1:extent) = xtab(1:extent) + TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /))
662              jj=jj+1
663            END DO
664          END IF
665 #endif
666 !TODO: works in all cases??? (X, Y, Z dimensions assumed to be ptdimx,y or z)
667          SELECT CASE(ndims)
668          CASE (0)
669            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,xtab(1))
670          CASE (1)
671            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,xtab(1:extent),count=(/extent/))
672          CASE (2)
673            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,reshape(xtab,(/ptdimx%len,ptdimy%len/)), &
674                                  start = (/1,1,level/) )
675          CASE (3)
676            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,reshape(xtab,(/ptdimx%len,ptdimy%len,ptdimz%len/)))
677          CASE DEFAULT
678            print *,'Error: arrays with ',tpreclist(ji)%dim%ndims,' dimensions are not supported'
679          END SELECT
680
681        CASE (TEXT)
682          ALLOCATE(ytab(extent))
683          DO jj=1,extent
684 #if LOWMEM
685 ***
686 print *,'lowmem: not tested!!!!!' (to be compared with no low mem version)
687            ich = iwork(2+iwork(2)+jj)
688 #else
689            ich = lfiart(ji)%iwtab(2+lfiart(ji)%iwtab(2)+jj)
690 #endif
691            ytab(jj) = CHAR(ich)
692          END DO
693          status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,ytab,count=(/extent/))
694          IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
695          DEALLOCATE(ytab)
696
697        CASE default
698 #if LOWMEM
699 ***
700 print *,'lowmem: not tested!!!!!' (to be compared with no low mem version)
701          xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /))
702 #else         
703          IF (.NOT.tpreclist(ji)%calc) THEN
704            xtab(1:extent) = TRANSFER(lfiart(ji)%iwtab(3+lfiart(ji)%iwtab(2):),(/ 0.0_8 /))
705          ELSE
706            src=tpreclist(ji)%src(1)
707            xtab(1:extent) = TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /))
708            jj = 2
709            DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
710              src=tpreclist(ji)%src(jj)
711              xtab(1:extent) = xtab(1:extent) + TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /))
712              jj=jj+1
713            END DO
714          END IF
715 #endif
716 !TODO: works in all cases??? (X, Y, Z dimensions assumed to be ptdimx,y or z)
717          SELECT CASE(ndims)
718          CASE (0)
719            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,xtab(1))
720          CASE (1)
721            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,xtab(1:extent),count=(/extent/))
722          CASE (2)
723            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,reshape(xtab,(/ptdimx%len,ptdimy%len/)), &
724                                  start = (/1,1,level/) )
725          CASE (3)
726            status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id,reshape(xtab,(/ptdimx%len,ptdimy%len,ptdimz%len/)))
727          CASE DEFAULT
728            print *,'Error: arrays with ',tpreclist(ji)%dim%ndims,' dimensions are not supported'
729          END SELECT
730          IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
731
732        END SELECT
733
734        idx = idx + 1
735     END DO
736     DEALLOCATE(itab,xtab)
737 #if LOWMEM
738     DEALLOCATE(iwork)
739 #endif 
740   END SUBROUTINE fill_ncdf
741
742   SUBROUTINE parse_cdf(kcdf_id,tpreclist,kbuflen)
743     INTEGER, INTENT(IN)                    :: kcdf_id
744     TYPE(workfield), DIMENSION(:), POINTER :: tpreclist
745     INTEGER, INTENT(OUT)                   :: kbuflen
746
747
748     INTEGER :: status
749     INTEGER :: nvars, var_id
750     INTEGER :: jdim
751     INTEGER :: sizemax
752     INTEGER :: itype
753     INTEGER, DIMENSION(10) :: idim_id
754     INTEGER :: icomlen,idimlen,idims,idimtmp
755     
756     status = NF90_INQUIRE(kcdf_id, nvariables = nvars)
757     IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
758     ALLOCATE(tpreclist(nvars))
759
760     sizemax = 0
761
762     CALL init_dimCDF()
763     
764     ! Parcours de toutes les variables et extraction des infos
765     !      - nom de dimension
766     !      - dimension, etendue
767     !      - attributs
768     DO var_id = 1, nvars
769        ! Pour la forme
770        tpreclist(var_id)%id = var_id  
771        
772        ! Nom, type et dimensions de la variable
773        status = NF90_INQUIRE_VARIABLE(kcdf_id, var_id, name = tpreclist(var_id)%name, xtype = itype, ndims = idims, &
774                                       dimids = idim_id)
775        IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
776        
777        SELECT CASE(itype)
778        CASE(NF90_CHAR)
779           tpreclist(var_id)%TYPE = TEXT
780        CASE(NF90_INT)
781           tpreclist(var_id)%TYPE = INT
782        CASE(NF90_FLOAT,NF90_DOUBLE)
783           tpreclist(var_id)%TYPE = FLOAT
784        CASE default 
785           PRINT *, 'Attention : variable ',TRIM(tpreclist(var_id)&
786                & %name), ' a un TYPE non reconnu par le convertisseur.'
787           PRINT *, '--> TYPE force a REAL(KIND 8) dans LFI !'
788        END SELECT
789       
790        IF (idims == 0) THEN
791           ! variable scalaire
792           NULLIFY(tpreclist(var_id)%dim)
793           idimlen = 1
794        ELSE
795           ! infos sur dimensions
796           idimlen = 1
797           DO jdim=1,idims
798             status = NF90_INQUIRE_DIMENSION(kcdf_id,idim_id(jdim),len = idimtmp)
799             IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
800             idimlen = idimlen*idimtmp
801           END DO
802           
803           tpreclist(var_id)%dim=>get_dimCDF(idimlen)
804           ! seul le champ 'len' de dimCDF sera utilise par la suite
805        END IF
806        
807        ! GRID et COMMENT attributes
808        status = NF90_GET_ATT(kcdf_id,var_id,'GRID',tpreclist(var_id)%grid)
809        IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
810
811        status = NF90_INQUIRE_ATTRIBUTE(kcdf_id,var_id,'COMMENT',len = icomlen)
812        IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
813        
814        ALLOCATE(character(len=icomlen) :: tpreclist(var_id)%comment)
815        status = NF90_GET_ATT(kcdf_id,var_id,'COMMENT',tpreclist(var_id)%comment)
816        IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
817
818        
819        IF (sizemax < icomlen+idimlen) sizemax = icomlen+idimlen 
820
821     END DO
822     
823     kbuflen = sizemax
824
825   END SUBROUTINE parse_cdf
826
827   SUBROUTINE build_lfi(kcdf_id,klu,tpreclist,kbuflen)
828     INTEGER,                       INTENT(IN) :: kcdf_id 
829     INTEGER,                       INTENT(IN) :: klu
830     TYPE(workfield), DIMENSION(:), INTENT(IN) :: tpreclist
831     INTEGER,                       INTENT(IN) :: kbuflen
832     
833     INTEGER :: status
834     INTEGER :: ivar,jj
835     INTEGER(KIND=8), DIMENSION(:), POINTER  :: iwork
836     INTEGER(KIND=8), DIMENSION(:), POINTER  :: idata
837     REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: xtab
838     INTEGER,      DIMENSION(:), ALLOCATABLE :: itab
839     CHARACTER,    DIMENSION(:), ALLOCATABLE :: ytab
840     CHARACTER(LEN=FM_FIELD_SIZE)            :: yrecfm
841
842     INTEGER :: iartlen, idlen, icomlen
843     INTEGER(KIND=LFI_INT) :: iresp,ilu,iartlen8
844
845     ! Un article LFI est compose de :
846     !   - 1 entier identifiant le numero de grille
847     !   - 1 entier contenant la taille du commentaire
848     !   - le commentaire code en entier 64 bits
849     !   - les donnees proprement dites
850
851     PRINT *,'Taille buffer = ',2+kbuflen
852
853     ALLOCATE(iwork(2+kbuflen))
854     ALLOCATE(itab(2+kbuflen))
855     ALLOCATE(xtab(2+kbuflen))
856
857     DO ivar=1,SIZE(tpreclist)
858        icomlen = LEN(tpreclist(ivar)%comment)
859
860        ! traitement Grille et Commentaire
861        iwork(1) = tpreclist(ivar)%grid
862        iwork(2) = icomlen
863        DO jj=1,iwork(2)
864           iwork(2+jj)=ICHAR(tpreclist(ivar)%comment(jj:jj))
865        END DO
866
867        IF (ASSOCIATED(tpreclist(ivar)%dim)) THEN
868           idlen = tpreclist(ivar)%dim%len
869        ELSE 
870           idlen = 1
871        END IF
872        
873        iartlen = 2+icomlen+idlen
874        idata=>iwork(3+icomlen:iartlen)
875
876
877        SELECT CASE(tpreclist(ivar)%TYPE)
878        CASE(INT,BOOL)
879           status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id,itab)
880           IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
881
882 !          PRINT *,'INT,BOOL --> ',tpreclist(ivar)%name,',len = ',idlen
883           idata(1:idlen) = itab(1:idlen)
884
885        CASE(FLOAT)
886           status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id,xtab)
887           IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
888           
889 !          PRINT *,'FLOAT    --> ',tpreclist(ivar)%name,',len = ',idlen
890           ! La ligne suivante ne pose aucun pb sur Cray alors que sur
891           ! fuji, elle genere une erreur d'execution
892 !          idata(1:idlen) = TRANSFER(xtab(1:idlen),(/ 0_8 /))
893           
894           ! la correction pour Fuji (valable sur CRAY) est :
895           idata(1:idlen) = TRANSFER(xtab,(/ 0_8 /),idlen)
896
897 !          IF (idlen < 10) PRINT *,'xtab = ',xtab(1:idlen)
898
899        CASE(TEXT)
900           ALLOCATE(ytab(idlen))
901           status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id,ytab)
902           IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
903
904 !          PRINT *,'TEXT -->     ',tpreclist(ivar)%name,',len = ',idlen
905
906           DO jj=1,idlen
907              idata(jj) = ICHAR(ytab(jj))
908           END DO
909           
910           DEALLOCATE(ytab)
911
912        CASE default
913           status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id,xtab)
914           IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
915
916           PRINT *,'Default (ERROR) -->',tpreclist(ivar)%name,',len = ',idlen
917           idata(1:idlen) = TRANSFER(xtab,(/ 0_8 /),idlen)
918
919        END SELECT
920        
921        ! Attention restoration des '%' dans le nom des champs LFI
922        yrecfm = str_replace(tpreclist(ivar)%name,'__','%')
923        ! et des '.'
924        yrecfm = str_replace(yrecfm,'--','.')
925        ilu = klu
926        iartlen8 = iartlen
927        CALL LFIECR(iresp,ilu,yrecfm,iwork,iartlen8)
928
929     END DO
930     DEALLOCATE(iwork,itab,xtab)
931
932   END SUBROUTINE build_lfi
933
934   SUBROUTINE OPEN_FILES(hinfile,houtfile,olfi2cdf,olfilist,ohdf5,cdffiles,klu,knaf,osplit)
935     LOGICAL,          INTENT(IN)  :: olfi2cdf, olfilist, ohdf5, osplit
936     CHARACTER(LEN=*), INTENT(IN)  :: hinfile
937     CHARACTER(LEN=*), INTENT(IN)  :: houtfile
938     TYPE(cdf_files) , INTENT(OUT) :: cdffiles
939     INTEGER         , INTENT(OUT) :: klu,knaf
940
941     INTEGER                     :: extindex
942     INTEGER(KIND=LFI_INT)       :: ilu,iresp,iverb,inap,inaf
943     INTEGER                     :: status
944     CHARACTER(LEN=4)            :: ypextsrc, ypextdest
945     LOGICAL                     :: fexist
946     INTEGER                     :: omode
947
948     iverb = 0
949     ilu   = 11
950
951     CALL init_sysfield()
952
953     IF (olfi2cdf) THEN 
954        ! Cas LFI -> NetCDF
955        CALL LFIOUV(iresp,ilu,ltrue,hinfile,'OLD',lfalse&
956             & ,lfalse,iverb,inap,inaf)
957
958        IF (olfilist) THEN
959           CALL LFILAF(iresp,ilu,lfalse)
960           CALL LFIFER(iresp,ilu,'KEEP')
961           return
962        END IF
963
964        IF (.NOT.osplit) THEN
965          cdffiles%nbfiles = 1
966          allocate(cdffiles%cdf_id(1))
967
968          IF (ohdf5) THEN
969             status = NF90_CREATE(houtfile, IOR(NF90_CLOBBER,NF90_NETCDF4), cdffiles%cdf_id(1))
970          ELSE
971             status = NF90_CREATE(houtfile, IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), cdffiles%cdf_id(1))
972          END IF
973        
974          IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
975          cdffiles%opened  = .TRUE.
976
977          status = NF90_SET_FILL(cdffiles%cdf_id(1),NF90_NOFILL,omode)
978          IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
979 !!$       SELECT CASE(omode)
980 !!$       CASE (NF90_FILL)
981 !!$          PRINT *,'Ancien mode : NF90_FILL'
982 !!$       CASE (NF90_NOFILL)
983 !!$          PRINT *,'Ancien mode : NF90_NOFILL'
984 !!$       CASE default
985 !!$          PRINT *, 'Ancien mode : inconnu'
986 !!$       END SELECT
987          END IF ! .NOT.osplit
988        
989     ELSE
990        ! Cas NetCDF -> LFI
991        cdffiles%nbfiles = 1
992        allocate(cdffiles%cdf_id(1))
993        status = NF90_OPEN(hinfile,NF90_NOWRITE,cdffiles%cdf_id(1))
994        IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
995        cdffiles%opened  = .TRUE.
996        
997        inap = 100
998        CALL LFIOUV(iresp,ilu,ltrue,houtfile,'NEW'&
999             & ,lfalse,lfalse,iverb,inap,inaf)
1000     END IF
1001
1002     klu  = ilu
1003     knaf = inaf
1004
1005     PRINT *,'--> Fichier converti : ', houtfile
1006
1007   END SUBROUTINE OPEN_FILES
1008
1009   SUBROUTINE OPEN_SPLIT_NCFILES(houtfile,nbvar,tpreclist,cdffiles,ohdf5)
1010     CHARACTER(LEN=*),              INTENT(IN)    :: houtfile
1011     INTEGER,                       INTENT(IN)    :: nbvar
1012     TYPE(workfield), DIMENSION(:), INTENT(IN)    :: tpreclist
1013     TYPE(cdf_files),               INTENT(INOUT) :: cdffiles
1014     LOGICAL,                       INTENT(IN)    :: ohdf5
1015
1016     INTEGER :: ji, idx
1017     INTEGER :: status
1018     INTEGER :: omode
1019     CHARACTER(LEN=MAXLEN) :: filename
1020
1021
1022     cdffiles%nbfiles = 0
1023     DO ji = 1,nbvar
1024       IF (tpreclist(ji)%tbw) cdffiles%nbfiles = cdffiles%nbfiles + 1
1025     END DO
1026     allocate(cdffiles%cdf_id(cdffiles%nbfiles))
1027     allocate(cdffiles%var_id(cdffiles%nbfiles))
1028
1029     idx = 1
1030     DO ji = 1,nbvar
1031       IF (.NOT.tpreclist(ji)%tbw) CYCLE
1032
1033       cdffiles%var_id(idx) = ji
1034
1035       IF (ohdf5) THEN
1036         filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc4'
1037         status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_NETCDF4), cdffiles%cdf_id(idx))
1038       ELSE
1039         filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc'
1040         status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), cdffiles%cdf_id(idx))
1041       END IF
1042
1043       IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
1044
1045       status = NF90_SET_FILL(cdffiles%cdf_id(idx),NF90_NOFILL,omode)
1046       IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
1047
1048       idx = idx + 1
1049     END DO
1050
1051     cdffiles%opened  = .TRUE.
1052
1053   END SUBROUTINE OPEN_SPLIT_NCFILES
1054   
1055   SUBROUTINE CLOSE_FILES(klu,cdffiles,osplit)
1056     INTEGER, INTENT(IN) :: klu
1057     TYPE(cdf_files),INTENT(INOUT) :: cdffiles
1058     LOGICAl, INTENT(IN) :: osplit
1059     
1060     INTEGER(KIND=LFI_INT) :: iresp,ilu
1061     INTEGER               :: ji,status
1062
1063     ilu = klu
1064     ! close LFI file
1065     CALL LFIFER(iresp,ilu,'KEEP')
1066
1067     ! close NetCDF files
1068     DO ji=1,cdffiles%nbfiles
1069       status = NF90_CLOSE(cdffiles%cdf_id(ji))
1070       IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
1071     END DO
1072     cdffiles%opened=.false.
1073     
1074   END SUBROUTINE CLOSE_files
1075
1076 END MODULE mode_util