Newer
Older
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
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
#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
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
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_ll, ONLY: JPHEXT, JPVEXT

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(1:LEN_TRIM(HINFILE)-4),'UNKNOWN','READ', &
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
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
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)
!CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'JPVEXT',JPVEXT,IRESP)
!IF(IRESP/=0) JPVEXT=1
JPVEXT = 1
!
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', &
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.

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,TRIM(houtfile)//'.lfi','UNKNOWN','WRITE', &
HFORMAT='LFI',KLFIVERB=0)
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
filename=hinfile(1:len(hinfile)-7)//suffix//'.lfi'
CALL LFIOUV(iresp,ilu,ltrue,filename,'OLD',lfalse,lfalse,iverb,inap,nbvar)
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
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.

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
filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc'

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
SUBROUTINE CLOSE_FILES(filelist)
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
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.

WAUTELET Philippe
committed
END DO

WAUTELET Philippe
committed

WAUTELET Philippe
committed