mode_util.f90

  END SUBROUTINE fill_ncdf

  SUBROUTINE build_lfi(infiles,outfiles,tpreclist,kbuflen)
    TYPE(filelist_struct),         INTENT(IN) :: infiles, outfiles
    TYPE(workfield), DIMENSION(:), INTENT(IN) :: tpreclist
    INTEGER,                       INTENT(IN) :: kbuflen
    
    INTEGER :: kcdf_id, status
    INTEGER :: ivar,ji,jj,ndims
    INTEGER,DIMENSION(3) :: idims
    INTEGER(KIND=8), DIMENSION(:), POINTER  :: iwork
    INTEGER(KIND=8), DIMENSION(:), POINTER  :: idata
    REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: xtab3d
    INTEGER,      DIMENSION(:,:,:), ALLOCATABLE :: itab3d
    CHARACTER,    DIMENSION(:), ALLOCATABLE :: ytab
    CHARACTER(LEN=FM_FIELD_SIZE)            :: yrecfm

    INTEGER :: iartlen, idlen, icomlen
    INTEGER(KIND=LFI_INT) :: iresp,ilu,iartlen8


    ilu = outfiles%files(1)%lun_id
    kcdf_id = infiles%files(1)%lun_id

    ! Un article LFI est compose de :
    !   - 1 entier identifiant le numero de grille
    !   - 1 entier contenant la taille du commentaire
    !   - le commentaire code en entier 64 bits
    !   - les donnees proprement dites

    PRINT *,'Taille buffer = ',2+kbuflen

    ALLOCATE(iwork(2+kbuflen))

    DO ivar=1,SIZE(tpreclist)
       icomlen = LEN(tpreclist(ivar)%comment)

       ! traitement Grille et Commentaire
       iwork(1) = tpreclist(ivar)%grid
       iwork(2) = icomlen
       DO jj=1,iwork(2)
          iwork(2+jj)=ICHAR(tpreclist(ivar)%comment(jj:jj))
       END DO

       IF (ASSOCIATED(tpreclist(ivar)%dim)) THEN
          idlen = tpreclist(ivar)%dim%len
          ndims = tpreclist(ivar)%dim%ndims
       ELSE 
          idlen = 1
          ndims = 0
       END IF
       
       idims(:) = 1
       if(ndims>0) idims(1) = ptdimx%len
       if(ndims>1) idims(2) = ptdimy%len
       if(ndims>2) idims(3) = ptdimz%len
       if(ndims>3) then
         PRINT *,'Too many dimensions'
         STOP
       endif

       iartlen = 2+icomlen+idlen
       idata=>iwork(3+icomlen:iartlen)


       SELECT CASE(tpreclist(ivar)%TYPE)
       CASE(INT,BOOL)
          ALLOCATE( itab3d(idims(1),idims(2),idims(3)) )
          status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id_in,itab3d)
          IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)

!          PRINT *,'INT,BOOL --> ',tpreclist(ivar)%name,',len = ',idlen
          idata(1:idlen) = RESHAPE( itab3d , (/ idims(1)*idims(2)*idims(3) /) )

          DEALLOCATE(itab3d)

       CASE(FLOAT)
          ALLOCATE( xtab3d(idims(1),idims(2),idims(3)) )
          status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id_in,xtab3d)
          IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)

!          PRINT *,'FLOAT -->    ',tpreclist(ivar)%name,',len = ',idlen
          idata(1:idlen) = RESHAPE( TRANSFER(xtab3d,(/ 0_8 /),idlen) , (/ idims(1)*idims(2)*idims(3) /) )

          DEALLOCATE(xtab3d)

       CASE(TEXT)
          ALLOCATE(ytab(idlen))
          status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id_in,ytab)
          IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)

!          PRINT *,'TEXT -->     ',tpreclist(ivar)%name,',len = ',idlen
          DO jj=1,idlen
             idata(jj) = ICHAR(ytab(jj))
          END DO
          
          DEALLOCATE(ytab)

       CASE default
          ALLOCATE( xtab3d(idims(1),idims(2),idims(3)) )
          status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id_in,xtab3d)
          IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)

          PRINT *,'Default (ERROR) -->',tpreclist(ivar)%name,',len = ',idlen
          idata(1:idlen) = RESHAPE( TRANSFER(xtab3d,(/ 0_8 /),idlen) , (/ idims(1)*idims(2)*idims(3) /) )

          DEALLOCATE(xtab3d)

       END SELECT
       
       ! Attention restoration des '%' dans le nom des champs LFI
       yrecfm = str_replace(tpreclist(ivar)%name,'__','%')
       ! et des '.'
       yrecfm = str_replace(yrecfm,'--','.')
       iartlen8 = iartlen
       CALL LFIECR(iresp,ilu,yrecfm,iwork,iartlen8)

    END DO
    DEALLOCATE(iwork)

  END SUBROUTINE build_lfi

  SUBROUTINE UPDATE_VARID_IN(infiles,hinfile,tpreclist,nbvar,current_level)
    !Update the id_in for netCDF files (could change from one file to the other)
    TYPE(filelist_struct),         INTENT(IN)    :: infiles
    CHARACTER(LEN=*),              INTENT(IN)    :: hinfile
    TYPE(workfield), DIMENSION(:), INTENT(INOUT) :: tpreclist
    INTEGER,                       INTENT(IN)    :: nbvar
    INTEGER,                       INTENT(IN)    :: current_level

    INTEGER :: ji, status
    CHARACTER(len=4) :: suffix


    if (infiles%files(1)%format /= NETCDF_FORMAT) return

    write(suffix,'(I4.4)') current_level

    DO ji=1,nbvar
      IF (.NOT.tpreclist(ji)%tbr) CYCLE
      status = NF90_INQ_VARID(infiles%files(1)%lun_id,trim(tpreclist(ji)%name)//trim(suffix),tpreclist(ji)%id_in)
      IF (status /= NF90_NOERR .AND. tpreclist(ji)%found) THEN
        tpreclist(ji)%found=.false.
        tpreclist(ji)%tbr=.false.
        tpreclist(ji)%tbw=.false.
        print *,'Error: variable ',trim(tpreclist(ji)%name),' not found anymore in split file'
      END IF
    END DO
  END SUBROUTINE UPDATE_VARID_IN

  SUBROUTINE OPEN_FILES(infiles,outfiles,hinfile,houtfile,nbvar_infile,options,runmode)
    TYPE(filelist_struct),INTENT(OUT) :: infiles, outfiles
    CHARACTER(LEN=*), INTENT(IN)  :: hinfile
    CHARACTER(LEN=*), INTENT(IN)  :: houtfile
    INTEGER         , INTENT(OUT) :: nbvar_infile
    TYPE(option),DIMENSION(:),INTENT(IN) :: options
    INTEGER         , INTENT(IN)  :: runmode

    INTEGER                     :: extindex
    INTEGER(KIND=LFI_INT)       :: ilu,iresp,iverb,inap,inaf
    INTEGER                     :: idx,status
    CHARACTER(LEN=4)            :: ypextsrc, ypextdest
    LOGICAL                     :: fexist
    INTEGER                     :: omode

    iverb = 0

    CALL init_sysfield()

    IF (runmode == MODELFI2CDF) THEN
       ! Cas LFI -> NetCDF
       infiles%nbfiles = infiles%nbfiles + 1
       idx = infiles%nbfiles
       infiles%files(idx)%lun_id = 11
       infiles%files(idx)%format = LFI_FORMAT
       infiles%files(idx)%status = READING
       ilu = infiles%files(idx)%lun_id
       CALL LFIOUV(iresp,ilu,ltrue,hinfile,'OLD',lfalse&
            & ,lfalse,iverb,inap,inaf)
       infiles%files(idx)%opened  = .TRUE.

       nbvar_infile = inaf

       IF (options(OPTLIST)%set) THEN
          CALL LFILAF(iresp,ilu,lfalse)
          CALL LFIFER(iresp,ilu,'KEEP')
          return
       END IF

       IF (.NOT.options(OPTSPLIT)%set) THEN
         outfiles%nbfiles = outfiles%nbfiles + 1

         idx = outfiles%nbfiles
         outfiles%files(idx)%format = NETCDF_FORMAT
         outfiles%files(idx)%status = WRITING
         IF (options(OPTCDF4)%set) THEN
            status = NF90_CREATE(TRIM(houtfile)//'.nc', IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id)
         ELSE
            status = NF90_CREATE(TRIM(houtfile)//'.nc', IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), outfiles%files(idx)%lun_id)
         END IF
       
         IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
         outfiles%files(idx)%opened  = .TRUE.

         status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode)
         IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
!!$       SELECT CASE(omode)
!!$       CASE (NF90_FILL)
!!$          PRINT *,'Ancien mode : NF90_FILL'
!!$       CASE (NF90_NOFILL)
!!$          PRINT *,'Ancien mode : NF90_NOFILL'
!!$       CASE default
!!$          PRINT *, 'Ancien mode : inconnu'
!!$       END SELECT
         END IF ! .NOT.osplit
       
    ELSE IF (runmode == MODECDF2CDF) THEN
       ! Cas netCDF -> netCDF

       infiles%nbfiles = infiles%nbfiles + 1
       idx = infiles%nbfiles
       status = NF90_OPEN(hinfile,NF90_NOWRITE,infiles%files(idx)%lun_id)
       IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
       infiles%files(idx)%opened  = .TRUE.
       infiles%files(idx)%format = NETCDF_FORMAT
       infiles%files(idx)%status = READING

       status = NF90_INQUIRE(infiles%files(idx)%lun_id, nvariables = nbvar_infile)
       IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)


       IF (.NOT.options(OPTSPLIT)%set) THEN
         outfiles%nbfiles = outfiles%nbfiles + 1
         idx = outfiles%nbfiles

         IF (options(OPTCDF4)%set) THEN
            status = NF90_CREATE(houtfile, IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id)
         ELSE
            status = NF90_CREATE(houtfile, IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), outfiles%files(idx)%lun_id)
         END IF

         IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
         outfiles%files(idx)%opened  = .TRUE.
         outfiles%files(idx)%format = NETCDF_FORMAT
         outfiles%files(idx)%status = WRITING

         status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode)
         IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
       END IF ! .NOT.osplit

    ELSE
       ! Cas NetCDF -> LFI
       infiles%nbfiles = infiles%nbfiles + 1
       idx = infiles%nbfiles
       status = NF90_OPEN(hinfile,NF90_NOWRITE,infiles%files(idx)%lun_id)
       IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
       infiles%files(idx)%opened  = .TRUE.
       infiles%files(idx)%format = NETCDF_FORMAT
       infiles%files(idx)%status = READING
       
       status = NF90_INQUIRE(infiles%files(idx)%lun_id, nvariables = nbvar_infile)
       IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)

       inap = 100
       outfiles%nbfiles = outfiles%nbfiles + 1
       idx = outfiles%nbfiles
       outfiles%files(idx)%lun_id = 11
       outfiles%files(idx)%format = LFI_FORMAT
       outfiles%files(idx)%status = WRITING
       ilu = outfiles%files(idx)%lun_id
       CALL LFIOUV(iresp,ilu,ltrue,TRIM(houtfile)//'.lfi','NEW' ,lfalse,lfalse,iverb,inap,inaf)
       outfiles%files(idx)%opened  = .TRUE.
    END IF

    PRINT *,'--> Fichier converti : ', TRIM(houtfile)

  END SUBROUTINE OPEN_FILES

  SUBROUTINE OPEN_SPLIT_LFIFILE_IN(infiles,hinfile,current_level)
    TYPE(filelist_struct), INTENT(INOUT) :: infiles
    CHARACTER(LEN=*), INTENT(IN) :: hinfile
    INTEGER,          INTENT(IN) :: current_level

    INTEGER(KIND=LFI_INT) :: ilu,iresp,iverb,inap,nbvar

    CHARACTER(LEN=3)      :: suffix
    CHARACTER(LEN=:),ALLOCATABLE :: filename


    iverb = 0 !Verbosity level for LFI

    ALLOCATE(character(len=len(hinfile)) :: filename)

    ilu = infiles%files(1)%lun_id !We assume only 1 infile

    write(suffix,'(I3.3)') current_level
    filename=hinfile(1:len(hinfile)-7)//suffix//'.lfi'
    CALL LFIOUV(iresp,ilu,ltrue,filename,'OLD',lfalse,lfalse,iverb,inap,nbvar)
    infiles%files(1)%opened = .TRUE.

    DEALLOCATE(filename)
  END SUBROUTINE OPEN_SPLIT_LFIFILE_IN

  SUBROUTINE OPEN_SPLIT_NCFILE_IN(infiles,hinfile,current_level)
    TYPE(filelist_struct), INTENT(INOUT) :: infiles
    CHARACTER(LEN=*), INTENT(IN) :: hinfile
    INTEGER,          INTENT(IN) :: current_level

    INTEGER :: status
    CHARACTER(LEN=3)      :: suffix
    CHARACTER(LEN=:),ALLOCATABLE :: filename


    ALLOCATE(character(len=len(hinfile)) :: filename)

    write(suffix,'(I3.3)') current_level
    filename=hinfile(1:len(hinfile)-6)//suffix//'.nc'
    status = NF90_OPEN(filename,NF90_NOWRITE,infiles%files(1)%lun_id)
    IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
    infiles%files(1)%opened  = .TRUE.

    DEALLOCATE(filename)
  END SUBROUTINE OPEN_SPLIT_NCFILE_IN

  SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,houtfile,nbvar,tpreclist,options)
    TYPE(filelist_struct),         INTENT(INOUT) :: outfiles
    CHARACTER(LEN=*),              INTENT(IN)    :: houtfile
    INTEGER,                       INTENT(IN)    :: nbvar
    TYPE(workfield), DIMENSION(:), INTENT(IN)    :: tpreclist
    TYPE(option),DIMENSION(:),     INTENT(IN)    :: options

    INTEGER :: ji, idx
    INTEGER :: status
    INTEGER :: omode
    CHARACTER(LEN=MAXLEN) :: filename


    DO ji = 1,nbvar
      IF (tpreclist(ji)%tbw) outfiles%nbfiles = outfiles%nbfiles + 1
    END DO

    idx = 1
    DO ji = 1,nbvar
      IF (.NOT.tpreclist(ji)%tbw) CYCLE
      outfiles%files(idx)%var_id = ji

      IF (options(OPTCDF4)%set) THEN
        filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc'
        status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id)
      ELSE
        filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc'
        status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), outfiles%files(idx)%lun_id)
      END IF

      IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)

      status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode)
      IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)

      outfiles%files(idx)%opened  = .TRUE.
      outfiles%files(idx)%format = NETCDF_FORMAT
      outfiles%files(idx)%status = WRITING

      idx = idx + 1
    END DO

  END SUBROUTINE OPEN_SPLIT_NCFILES_OUT
  
  SUBROUTINE CLOSE_FILES(filelist)
    TYPE(filelist_struct),INTENT(INOUT) :: filelist
    
    INTEGER(KIND=LFI_INT) :: ilu,iresp
    INTEGER               :: ji,status

    DO ji=1,filelist%nbfiles
      IF ( .NOT.filelist%files(ji)%opened ) CYCLE

      IF ( filelist%files(ji)%format == LFI_FORMAT ) THEN
        ilu = filelist%files(ji)%lun_id
        CALL LFIFER(iresp,ilu,'KEEP')
      ELSE IF ( filelist%files(ji)%format == NETCDF_FORMAT ) THEN
        status = NF90_CLOSE(filelist%files(ji)%lun_id)
        IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
      END IF
      filelist%files(ji)%opened=.false.
    END DO

  END SUBROUTINE CLOSE_FILES

END MODULE mode_util