Newer
Older

WAUTELET Philippe
committed
if (ndims/=idims) then
print *,'aieeeeeee'
stop
end if
DO JJ=1,IDIMS
STATUS = NF90_INQUIRE_DIMENSION(infiles%TFILES(1)%TFILE%NNCID, IVDIMS(JJ), LEN=IDIMLEN(JJ))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END DO
ELSE
!Split variables are always 3D variables
IDIMLEN(1) = IDIMX
IDIMLEN(2) = IDIMY
IDIMLEN(3) = IDIMZ
END IF

WAUTELET Philippe
committed
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
SELECT CASE(ndims)
CASE (0)
CALL IO_READ_FIELD (infiles%tfiles(1)%TFILE, tpreclist(ji)%TFIELD,xtab(1))
CALL IO_WRITE_FIELD(outfiles%tfiles(idx)%TFILE,tpreclist(ji)%TFIELD,xtab(1))
CASE (1)
CALL IO_READ_FIELD (infiles%tfiles(1)%TFILE, tpreclist(ji)%TFIELD,xtab(1:IDIMLEN(1)))
CALL IO_WRITE_FIELD(outfiles%tfiles(idx)%TFILE,tpreclist(ji)%TFIELD,xtab(1:IDIMLEN(1)))
CASE (2)
ALLOCATE(XTAB2D(IDIMLEN(1),IDIMLEN(2)))
CALL IO_READ_FIELD (infiles%tfiles(1)%TFILE, tpreclist(ji)%TFIELD,XTAB2D)
CALL IO_WRITE_FIELD(outfiles%tfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB2D)
DEALLOCATE(XTAB2D)
CASE (3)
ALLOCATE(XTAB3D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
CALL IO_READ_FIELD (infiles%tfiles(1)%TFILE, tpreclist(ji)%TFIELD,XTAB3D)
CALL IO_WRITE_FIELD(outfiles%tfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB3D)
DEALLOCATE(XTAB3D)
CASE (4)
ALLOCATE(XTAB4D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3),IDIMLEN(4)))
CALL IO_READ_FIELD (infiles%tfiles(1)%TFILE, tpreclist(ji)%TFIELD,XTAB4D)
CALL IO_WRITE_FIELD(outfiles%tfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB4D)
DEALLOCATE(XTAB4D)
CASE DEFAULT

WAUTELET Philippe
committed
print *,'Error: arrays with ',ndims,' dimensions are not supported'

WAUTELET Philippe
committed
END SELECT
#if 0
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
ALLOCATE( xtab3d(idims(1),idims(2),idims(3)) )
IF (.NOT.tpreclist(ji)%calc) THEN
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(ji)%id_in,xtab3d)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
ELSE
ALLOCATE( xtab3d2(idims(1),idims(2),idims(3)) )
src=tpreclist(ji)%src(1)
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(src)%id_in,xtab3d)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
jj = 2
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
src=tpreclist(ji)%src(jj)
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(src)%id_in,xtab3d2)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
xtab3d(:,:,:) = xtab3d(:,:,:) + xtab3d2(:,:,:)
jj=jj+1
END DO
DEALLOCATE(xtab3d2)
END IF
!TODO: not clean, should be done only if merging z-levels
IF (ndims == 2) THEN
start = (/1,1,level/)
ELSE
start = (/1,1,1/)
ENDIF
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,xtab3d,start=start)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
DEALLOCATE(xtab3d)

WAUTELET Philippe
committed
#endif

WAUTELET Philippe
committed
CASE (TYPECHAR)

WAUTELET Philippe
committed
IF (ndims/=0) CALL PRINT_MSG(NVERB_FATAL,'IO','fill_ncdf','only ndims=0 is supported for TYPECHAR')
IF (infiles%files(1)%format == LFI_FORMAT) THEN
CALL LFINFO(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),ileng,ipos)
CALL LFILEC(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),iwork,ileng)

WAUTELET Philippe
committed
extent = ileng - 2 - iwork(2) !iwork(2) = comment length
! ALLOCATE(ytab(extent))
allocate(character(len=extent)::ytab)
DO jj=1,extent
ich = iwork(2+iwork(2)+jj)

WAUTELET Philippe
committed
! ytab(jj) = CHAR(ich)
ytab(jj:jj) = CHAR(ich)

WAUTELET Philippe
committed
CALL IO_WRITE_FIELD(outfiles%tfiles(idx)%TFILE,tpreclist(ji)%TFIELD,trim(ytab))
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN

WAUTELET Philippe
committed
INCID = infiles%TFILES(1)%TFILE%NNCID
STATUS = NF90_INQ_VARID(INCID,tpreclist(ji)%TFIELD%CMNHNAME,IVARID)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, NDIMS=IDIMS, DIMIDS=IVDIMS)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
! if (ndims/=idims) then
if (idims/=1) then
print *,'aieeeeeee'
stop
end if
DO JJ=1,IDIMS
STATUS = NF90_INQUIRE_DIMENSION(infiles%TFILES(1)%TFILE%NNCID, IVDIMS(JJ), LEN=IDIMLEN(JJ))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END DO
allocate(character(len=IDIMLEN(1))::ytab)
CALL IO_READ_FIELD (infiles%tfiles(1)%TFILE, tpreclist(ji)%TFIELD,ytab)
CALL IO_WRITE_FIELD(outfiles%tfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ytab)
DEALLOCATE(ytab)
CASE (TYPEDATE)
IF (ndims/=0) CALL PRINT_MSG(NVERB_FATAL,'IO','fill_ncdf','only ndims=0 is supported for TYPEDATE')
!PW: TODO: tpreclist(ji)%TFIELD%CMNHNAME => tpreclist(ji)%TFIELD
CALL IO_READ_FIELD (infiles%tfiles(1)%TFILE, tpreclist(ji)%TFIELD%CMNHNAME,TZDATE)
CALL IO_WRITE_FIELD(outfiles%tfiles(idx)%TFILE,tpreclist(ji)%TFIELD,TZDATE)
CALL PRINT_MSG(NVERB_FATAL,'IO','fill_ncdf','invalid datatype')

WAUTELET Philippe
committed
if (options(OPTSPLIT)%set) idx = idx + 1
DEALLOCATE(iwork)
END SUBROUTINE fill_ncdf

WAUTELET Philippe
committed
SUBROUTINE build_lfi(infiles,outfiles,tpreclist,knaf,kbuflen)
TYPE(filelist_struct), INTENT(IN) :: infiles, outfiles
TYPE(workfield), DIMENSION(:), INTENT(IN) :: tpreclist

WAUTELET Philippe
committed
INTEGER, INTENT(IN) :: knaf
INTEGER, INTENT(IN) :: kbuflen
INTEGER :: kcdf_id, status
INTEGER :: ivar,ji,jj,ndims

WAUTELET Philippe
committed
INTEGER,DIMENSION(3) :: idims
INTEGER(KIND=8), DIMENSION(:), POINTER :: iwork
INTEGER(KIND=8), DIMENSION(:), POINTER :: idata

WAUTELET Philippe
committed
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))

WAUTELET Philippe
committed
DO ivar=1,knaf
IF (.NOT.tpreclist(ivar)%tbw) CYCLE

WAUTELET Philippe
committed
icomlen = LEN(tpreclist(ivar)%TFIELD%CCOMMENT)

WAUTELET Philippe
committed
IF (icomlen > MAXLFICOMMENTLENGTH) THEN
PRINT *,'ERROR: comment length is too big. Please increase MAXLFICOMMENTLENGTH'
STOP
END IF
! traitement Grille et Commentaire

WAUTELET Philippe
committed
iwork(1) = tpreclist(ivar)%TFIELD%NGRID
iwork(2) = icomlen
DO jj=1,iwork(2)

WAUTELET Philippe
committed
iwork(2+jj)=ICHAR(tpreclist(ivar)%TFIELD%CCOMMENT(jj:jj))

WAUTELET Philippe
committed
stop

WAUTELET Philippe
committed
iartlen=2+icomlen+1

WAUTELET Philippe
committed
#if 0
IF (ASSOCIATED(tpreclist(ivar)%dim)) THEN
idlen = tpreclist(ivar)%dim%len

WAUTELET Philippe
committed
ndims = tpreclist(ivar)%dim%ndims

WAUTELET Philippe
committed
ndims = 0

WAUTELET Philippe
committed
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)

WAUTELET Philippe
committed
SELECT CASE(tpreclist(ivar)%TFIELD%NTYPE)
CASE(TYPEINT,TYPELOG)

WAUTELET Philippe
committed
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 *,'TYPEINT,TYPELOG --> ',tpreclist(ivar)%name,',len = ',idlen

WAUTELET Philippe
committed
idata(1:idlen) = RESHAPE( itab3d , (/ idims(1)*idims(2)*idims(3) /) )
DEALLOCATE(itab3d)
CASE(TYPEREAL)

WAUTELET Philippe
committed
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 *,'TYPEREAL --> ',tpreclist(ivar)%name,',len = ',idlen

WAUTELET Philippe
committed
idata(1:idlen) = RESHAPE( TRANSFER(xtab3d,(/ 0_8 /),idlen) , (/ idims(1)*idims(2)*idims(3) /) )
DEALLOCATE(xtab3d)
CASE(TYPECHAR)
status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id_in,ytab)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
! PRINT *,'TYPECHAR --> ',tpreclist(ivar)%name,',len = ',idlen
DO jj=1,idlen
idata(jj) = ICHAR(ytab(jj))
END DO
DEALLOCATE(ytab)
CASE default

WAUTELET Philippe
committed
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

WAUTELET Philippe
committed
idata(1:idlen) = RESHAPE( TRANSFER(xtab3d,(/ 0_8 /),idlen) , (/ idims(1)*idims(2)*idims(3) /) )
DEALLOCATE(xtab3d)

WAUTELET Philippe
committed
#endif
! 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)

WAUTELET Philippe
committed
DEALLOCATE(iwork)
END SUBROUTINE build_lfi
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
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

WAUTELET Philippe
committed
SUBROUTINE OPEN_FILES(infiles,outfiles,hinfile,houtfile,nbvar_infile,options,runmode)

WAUTELET Philippe
committed
USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
USE MODD_GRID, ONLY: XBETA, XRPK, XLAT0, XLON0, XLATORI, XLONORI
USE MODD_GRID_n, ONLY: LSLEVE, XXHAT, XYHAT, XZHAT

WAUTELET Philippe
committed
USE MODD_IO_ll, ONLY: LIOCDF4

WAUTELET Philippe
committed
USE MODD_PARAMETERS, ONLY: JPHEXT
USE MODD_PARAMETERS_ll, ONLY: JPHEXT_ll=>JPHEXT, JPVEXT_ll=>JPVEXT

WAUTELET Philippe
committed

WAUTELET Philippe
committed
USE MODE_FM, ONLY: IO_FILE_OPEN_ll, IO_FILE_CLOSE_ll
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
TYPE(filelist_struct),INTENT(OUT) :: infiles, outfiles
CHARACTER(LEN=*), INTENT(IN) :: hinfile
CHARACTER(LEN=*), INTENT(IN) :: houtfile

WAUTELET Philippe
committed
TYPE(option),DIMENSION(:),INTENT(IN) :: options
INTEGER , INTENT(IN) :: runmode

WAUTELET Philippe
committed
INTEGER :: IRESP

WAUTELET Philippe
committed
INTEGER(KIND=LFI_INT) :: ilu,iresp2,iverb,inap,inaf
CHARACTER(LEN=4) :: ypextsrc, ypextdest
LOGICAL :: fexist
INTEGER :: omode
iverb = 0

WAUTELET Philippe
committed
!
! Infiles
!
IF (runmode == MODECDF2CDF .OR. runmode == MODECDF2LFI) THEN
!
! NetCDF
!
infiles%nbfiles = infiles%nbfiles + 1
idx = infiles%nbfiles
CALL IO_FILE_ADD2LIST(INFILES%TFILES(idx)%TFILE,HINFILE,'UNKNOWN','READ',HFORMAT='NETCDF4')
CALL IO_FILE_OPEN_ll(INFILES%TFILES(idx)%TFILE)
infiles%files(idx)%lun_id = INFILES%TFILES(idx)%TFILE%NNCID
infiles%files(idx)%format = NETCDF_FORMAT
infiles%files(idx)%status = READING
infiles%files(idx)%opened = .TRUE.

WAUTELET Philippe
committed
status = NF90_INQUIRE(infiles%files(idx)%lun_id, nvariables = nbvar_infile)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
ELSE
!
! LFI
!
infiles%nbfiles = infiles%nbfiles + 1
idx = infiles%nbfiles

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(INFILES%TFILES(idx)%TFILE,HINFILE,'UNKNOWN','READ', &

WAUTELET Philippe
committed
HFORMAT='LFI',KLFIVERB=0)
CALL IO_FILE_OPEN_ll(INFILES%TFILES(idx)%TFILE)
infiles%files(idx)%lun_id = INFILES%TFILES(idx)%TFILE%NLFIFLU
infiles%files(idx)%format = LFI_FORMAT
infiles%files(idx)%status = READING
ilu = infiles%files(idx)%lun_id

WAUTELET Philippe
committed
nbvar_infile = INFILES%TFILES(idx)%TFILE%NLFININAR

WAUTELET Philippe
committed
IF (options(OPTLIST)%set) THEN

WAUTELET Philippe
committed
CALL LFILAF(iresp2,ilu,lfalse)

WAUTELET Philippe
committed
CALL IO_FILE_CLOSE_ll(INFILES%TFILES(idx)%TFILE)

WAUTELET Philippe
committed
END IF

WAUTELET Philippe
committed
END IF
!
!Read problem dimensions and some grid variables (needed by IO_FILE_OPEN_ll to create netCDF files but also to determine IDIMX/Y/Z)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'JPHEXT',JPHEXT)

WAUTELET Philippe
committed
JPHEXT_ll = JPHEXT

WAUTELET Philippe
committed
!CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'JPVEXT',JPVEXT,IRESP)
!IF(IRESP/=0) JPVEXT=1

WAUTELET Philippe
committed
JPVEXT_ll = JPVEXT

WAUTELET Philippe
committed
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
!
ALLOCATE(NIMAX_ll,NJMAX_ll,NKMAX)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'IMAX',NIMAX_ll)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'JMAX',NJMAX_ll)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'KMAX',NKMAX)
!
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'PROGRAM',CPROGRAM_ORIG)
!
ALLOCATE(CSTORAGE_TYPE)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'STORAGE_TYPE',CSTORAGE_TYPE)
!
IF ( TRIM(CPROGRAM_ORIG)/='PGD' &
.AND. .NOT.(TRIM(CPROGRAM_ORIG)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
ALLOCATE(XXHAT(NIMAX_ll+2*JPHEXT))
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'XHAT',XXHAT)
ALLOCATE(XYHAT(NJMAX_ll+2*JPHEXT))
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'YHAT',XYHAT)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'CARTESIAN',LCARTESIAN)
!
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'LAT0',XLAT0)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'LON0',XLON0)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'BETA',XBETA)
!
IF (.NOT.LCARTESIAN) THEN
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'RPK', XRPK)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'LATORI',XLATORI)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'LONORI',XLONORI)
ENDIF
!
IF (TRIM(CPROGRAM_ORIG)/='NESPGD') THEN
ALLOCATE(XZHAT(NKMAX+2*JPVEXT))
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'ZHAT',XZHAT)
ALLOCATE(LSLEVE)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'SLEVE',LSLEVE)
END IF
END IF
!
! Outfiles
!
IF (runmode == MODELFI2CDF .OR. runmode == MODECDF2CDF) THEN

WAUTELET Philippe
committed
!

WAUTELET Philippe
committed
! NetCDF

WAUTELET Philippe
committed
!

WAUTELET Philippe
committed
IF (.NOT.options(OPTSPLIT)%set) THEN

WAUTELET Philippe
committed

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(OUTFILES%TFILES(idx)%TFILE,HOUTFILE,'UNKNOWN','WRITE', &

WAUTELET Philippe
committed
HFORMAT='NETCDF4',OOLD=.TRUE.)

WAUTELET Philippe
committed
CALL IO_FILE_OPEN_ll(OUTFILES%TFILES(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
outfiles%files(idx)%lun_id = OUTFILES%TFILES(idx)%TFILE%NNCID
outfiles%files(idx)%format = NETCDF_FORMAT
outfiles%files(idx)%status = WRITING
outfiles%files(idx)%opened = .TRUE.

WAUTELET Philippe
committed
IF (options(OPTCOMPRESS)%set) THEN
outfiles%tfiles(idx)%tfile%LNCCOMPRESS = .TRUE.
outfiles%tfiles(idx)%tfile%NNCCOMPRESS_LEVEL = options(OPTCOMPRESS)%ivalue
END IF

WAUTELET Philippe
committed
IF (options(OPTREDUCE)%set) THEN
outfiles%tfiles(idx)%tfile%LNCREDUCE_FLOAT_PRECISION = .TRUE.
END IF
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

WAUTELET Philippe
committed
!
! LFI
!
outfiles%nbfiles = outfiles%nbfiles + 1
idx = outfiles%nbfiles

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(OUTFILES%TFILES(idx)%TFILE,houtfile,'UNKNOWN','WRITE', &
HFORMAT='LFI',KLFIVERB=0,OOLD=.TRUE.)

WAUTELET Philippe
committed
LIOCDF4 = .FALSE. !Necessary to open correctly the LFI file
CALL IO_FILE_OPEN_ll(OUTFILES%TFILES(idx)%TFILE)
LIOCDF4 = .TRUE.
outfiles%files(idx)%lun_id = OUTFILES%TFILES(idx)%TFILE%NLFIFLU
outfiles%files(idx)%format = LFI_FORMAT
outfiles%files(idx)%status = WRITING

WAUTELET Philippe
committed
infiles%files(idx)%opened = .TRUE.
END IF

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

WAUTELET Philippe
committed
SUBROUTINE OPEN_SPLIT_LFIFILE_IN(infiles,hinfile,current_level)
TYPE(filelist_struct), INTENT(INOUT) :: infiles

WAUTELET Philippe
committed
CHARACTER(LEN=*), INTENT(IN) :: hinfile
INTEGER, INTENT(IN) :: current_level
INTEGER(KIND=LFI_INT) :: ilu,iresp,iverb,inap,nbvar

WAUTELET Philippe
committed
CHARACTER(LEN=3) :: suffix
CHARACTER(LEN=:),ALLOCATABLE :: filename

WAUTELET Philippe
committed
iverb = 0 !Verbosity level for LFI
ALLOCATE(character(len=len(hinfile)) :: filename)
ilu = infiles%files(1)%lun_id !We assume only 1 infile

WAUTELET Philippe
committed
write(suffix,'(I3.3)') current_level

WAUTELET Philippe
committed
filename=hinfile(1:len(hinfile)-4)//suffix

WAUTELET Philippe
committed
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

WAUTELET Philippe
committed
filename=hinfile(1:len(hinfile)-4)//suffix
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.

WAUTELET Philippe
committed
DEALLOCATE(filename)

WAUTELET Philippe
committed

WAUTELET Philippe
committed
SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,houtfile,nbvar,tpreclist,options)

WAUTELET Philippe
committed
USE MODE_FM, ONLY: IO_FILE_OPEN_ll
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
TYPE(filelist_struct), INTENT(INOUT) :: outfiles

WAUTELET Philippe
committed
CHARACTER(LEN=*), INTENT(IN) :: houtfile
INTEGER, INTENT(IN) :: nbvar
TYPE(workfield), DIMENSION(:), INTENT(IN) :: tpreclist

WAUTELET Philippe
committed
TYPE(option),DIMENSION(:), INTENT(IN) :: options

WAUTELET Philippe
committed
INTEGER :: ji, idx
INTEGER :: status
INTEGER :: omode
CHARACTER(LEN=MAXLEN) :: filename
DO ji = 1,nbvar
IF (tpreclist(ji)%tbw) outfiles%nbfiles = outfiles%nbfiles + 1

WAUTELET Philippe
committed
END DO
idx = 1
DO ji = 1,nbvar
IF (.NOT.tpreclist(ji)%tbw) CYCLE

WAUTELET Philippe
committed

WAUTELET Philippe
committed
filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(OUTFILES%TFILES(idx)%TFILE,filename,'UNKNOWN','WRITE', &
HFORMAT='NETCDF4')
CALL IO_FILE_OPEN_ll(OUTFILES%TFILES(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
outfiles%files(idx)%lun_id = OUTFILES%TFILES(idx)%TFILE%NNCID
outfiles%files(idx)%format = NETCDF_FORMAT
outfiles%files(idx)%status = WRITING
outfiles%files(idx)%opened = .TRUE.
IF (options(OPTCOMPRESS)%set) THEN
outfiles%tfiles(idx)%tfile%LNCCOMPRESS = .TRUE.
outfiles%tfiles(idx)%tfile%NNCCOMPRESS_LEVEL = options(OPTCOMPRESS)%ivalue
END IF
IF (options(OPTREDUCE)%set) THEN
outfiles%tfiles(idx)%tfile%LNCREDUCE_FLOAT_PRECISION = .TRUE.
END IF

WAUTELET Philippe
committed
status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode)

WAUTELET Philippe
committed
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
idx = idx + 1
END DO

WAUTELET Philippe
committed
USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
TYPE(filelist_struct),INTENT(INOUT) :: filelist
INTEGER(KIND=LFI_INT) :: ilu,iresp

WAUTELET Philippe
committed
INTEGER :: ji,status
DO ji=1,filelist%nbfiles
IF ( .NOT.filelist%files(ji)%opened ) CYCLE

WAUTELET Philippe
committed
CALL IO_FILE_CLOSE_ll(filelist%TFILES(ji)%TFILE)

WAUTELET Philippe
committed
END DO

WAUTELET Philippe
committed

WAUTELET Philippe
committed