Newer
Older

WAUTELET Philippe
committed
CALL IO_FILE_CLOSE(INFILES(1)%TFILE)

WAUTELET Philippe
committed
END IF

WAUTELET Philippe
committed
END IF
!

WAUTELET Philippe
committed
!Read problem dimensions and some grid variables (needed to determine domain size and also by IO_FILE_OPEN to create netCDF files)
CALL IO_Field_read(INFILES(1)%TFILE,'JPHEXT',JPHEXT)

WAUTELET Philippe
committed
JPHEXT_ll = JPHEXT
JPVEXT_ll = JPVEXT

WAUTELET Philippe
committed
!
ALLOCATE(NIMAX_ll,NJMAX_ll,NKMAX)

WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,'IMAX',NIMAX_ll)
CALL IO_Field_read(INFILES(1)%TFILE,'JMAX',NJMAX_ll)
CALL IO_Field_read(INFILES(1)%TFILE,'KMAX',NKMAX,IRESP2)

WAUTELET Philippe
committed
IF (IRESP2/=0) NKMAX = 0

WAUTELET Philippe
committed
!

WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,'PROGRAM',CPROGRAM_ORIG)

WAUTELET Philippe
committed
!
ALLOCATE(CSTORAGE_TYPE)

WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,'STORAGE_TYPE',CSTORAGE_TYPE)

WAUTELET Philippe
committed
!

WAUTELET Philippe
committed
ALLOCATE(XXHAT(NIMAX_ll+2*JPHEXT))

WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,'XHAT',XXHAT)

WAUTELET Philippe
committed
ALLOCATE(XYHAT(NJMAX_ll+2*JPHEXT))

WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,'YHAT',XYHAT)
CALL IO_Field_read(INFILES(1)%TFILE,'CARTESIAN',LCARTESIAN)

WAUTELET Philippe
committed
!

WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,'LAT0',XLAT0)
CALL IO_Field_read(INFILES(1)%TFILE,'LON0',XLON0)
CALL IO_Field_read(INFILES(1)%TFILE,'BETA',XBETA)

WAUTELET Philippe
committed
!

WAUTELET Philippe
committed
IF (.NOT.LCARTESIAN) THEN

WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,'RPK', XRPK)
CALL IO_Field_read(INFILES(1)%TFILE,'LATORI',XLATORI)
CALL IO_Field_read(INFILES(1)%TFILE,'LONORI',XLONORI)

WAUTELET Philippe
committed
ENDIF
!
IF (TRIM(CPROGRAM_ORIG)/='PGD' .AND. TRIM(CPROGRAM_ORIG)/='NESPGD' .AND. TRIM(CPROGRAM_ORIG)/='ZOOMPG' &
.AND. .NOT.(TRIM(CPROGRAM_ORIG)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
ALLOCATE(XZHAT(NKMAX+2*JPVEXT))

WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,'ZHAT',XZHAT)

WAUTELET Philippe
committed
ALLOCATE(LSLEVE)

WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,'SLEVE',LSLEVE)

WAUTELET Philippe
committed
ALLOCATE(TDTMOD)

WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,'DTMOD',TDTMOD,IRESP2)

WAUTELET Philippe
committed
IF(IRESP2/=0) DEALLOCATE(TDTMOD)
ALLOCATE(TDTCUR)

WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,'DTCUR',TDTCUR,IRESP2)

WAUTELET Philippe
committed
IF(IRESP2/=0) DEALLOCATE(TDTCUR)

WAUTELET Philippe
committed
END IF

WAUTELET Philippe
committed
! 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
KNFILES_OUT = KNFILES_OUT + 1

WAUTELET Philippe
committed
idx = KNFILES_OUT

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,HOUTFILE,'MNH','WRITE', &

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

WAUTELET Philippe
committed
CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)

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

WAUTELET Philippe
committed
END IF

WAUTELET Philippe
committed
IF (options(OPTREDUCE)%set) THEN
outfiles(idx)%tfile%LNCREDUCE_FLOAT_PRECISION = .TRUE.

WAUTELET Philippe
committed
END IF
status = NF90_SET_FILL(outfiles(idx)%TFILE%NNCID,NF90_NOFILL,omode)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END IF ! .NOT.osplit

WAUTELET Philippe
committed
!
! LFI
!
KNFILES_OUT = KNFILES_OUT + 1
idx = KNFILES_OUT

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,houtfile,'MNH','WRITE', &

WAUTELET Philippe
committed
HFORMAT='LFI',KLFIVERB=0,OOLD=.TRUE.)

WAUTELET Philippe
committed
LIOCDF4 = .FALSE. !Necessary to open correctly the LFI file

WAUTELET Philippe
committed
CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)

WAUTELET Philippe
committed
LIOCDF4 = .TRUE.
END IF
!
! Create a dummy netCDF file necessary to manage correctly the netCDF dims
IF (runmode == MODECDF2LFI) THEN
KNFILES_OUT = KNFILES_OUT + 1
idx = KNFILES_OUT

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,'dummy_file','MNH','WRITE', &
HFORMAT='NETCDF4',OOLD=.TRUE.)

WAUTELET Philippe
committed
CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)

WAUTELET Philippe
committed
END IF
PRINT *,'--> Converted to file: ', TRIM(houtfile)

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

WAUTELET Philippe
committed
USE MODE_IO_FILE, ONLY: IO_FILE_OPEN

WAUTELET Philippe
committed
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
TYPE(TFILE_ELT),DIMENSION(:), INTENT(INOUT) :: outfiles
INTEGER, INTENT(OUT) :: KNFILES_OUT

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

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

WAUTELET Philippe
committed
CHARACTER(LEN=:),ALLOCATABLE :: filename
CHARACTER(LEN=:),ALLOCATABLE :: YLIST
CHARACTER(LEN=NMNHNAMELGTMAX),DIMENSION(nbvar) :: YVARS
INTEGER :: ji
INTEGER :: idx1, idx2
INTEGER(KIND=IDCDF_KIND) :: status
INTEGER(KIND=IDCDF_KIND) :: omode
CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_SPLIT_NCFILES_OUT','called')
KNFILES_OUT = nbvar
YLIST = TRIM(options(OPTVAR)%cvalue)
DO ji = 1,nbvar-1
idx1 = INDEX(YLIST,',')
idx2 = INDEX(YLIST,'=')
IF (idx1/=0) THEN
IF (idx2/=0 .AND. idx2<idx1) THEN
YVARS(ji) = YLIST(1:idx2-1)
ELSE
YVARS(ji) = YLIST(1:idx1-1)
END IF
YLIST = YLIST(idx1+1:)
ELSE
CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_SPLIT_NCFILES_OUT','problem separating variable names')
END IF

WAUTELET Philippe
committed
END DO
idx2 = INDEX(YLIST,'=')
IF (idx2>0) THEN
YVARS(nbvar) = YLIST(1:idx2-1)
ELSE
YVARS(nbvar) = YLIST
END IF

WAUTELET Philippe
committed
DO ji = 1,nbvar
filename = trim(houtfile)//'.'//TRIM(YVARS(ji))

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(outfiles(ji)%TFILE,filename,'MNH','WRITE', &

WAUTELET Philippe
committed
HFORMAT='NETCDF4')

WAUTELET Philippe
committed
CALL IO_FILE_OPEN(outfiles(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)

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

WAUTELET Philippe
committed
END IF
IF (options(OPTREDUCE)%set) THEN
outfiles(ji)%tfile%LNCREDUCE_FLOAT_PRECISION = .TRUE.

WAUTELET Philippe
committed
END IF

WAUTELET Philippe
committed
status = NF90_SET_FILL(outfiles(ji)%TFILE%NNCID,NF90_NOFILL,omode)

WAUTELET Philippe
committed
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END DO
SUBROUTINE CLOSE_FILES(filelist,KNFILES)

WAUTELET Philippe
committed
USE MODE_IO_FILE, ONLY: IO_FILE_CLOSE

WAUTELET Philippe
committed
TYPE(TFILE_ELT),DIMENSION(:),INTENT(INOUT) :: filelist
INTEGER, INTENT(IN) :: KNFILES
INTEGER :: ji
CALL PRINT_MSG(NVERB_DEBUG,'IO','CLOSE_FILES','called')
DO ji=1,KNFILES

WAUTELET Philippe
committed
IF (filelist(ji)%TFILE%LOPENED) CALL IO_FILE_CLOSE(filelist(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)

WAUTELET Philippe
committed
END DO

WAUTELET Philippe
committed

WAUTELET Philippe
committed

WAUTELET Philippe
committed
SUBROUTINE IO_Metadata_get_nc4(KFILE_ID,KVAR_ID,TPREC)
USE MODD_DIM_n, ONLY: NKMAX
USE MODD_PARAMETERS, ONLY: JPVEXT
INTEGER, INTENT(IN) :: KFILE_ID
INTEGER, INTENT(IN) :: KVAR_ID
TYPE(workfield),INTENT(INOUT) :: TPREC
INTEGER :: ILENG
INTEGER :: JDIM
INTEGER(KIND=IDCDF_KIND) :: ISTATUS
INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IDIMS_ID

WAUTELET Philippe
committed
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Metadata_get_nc4','called')
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
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
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
ISTATUS = NF90_INQUIRE_VARIABLE(KFILE_ID,KVAR_ID,NDIMS = TPREC%NDIMS_FILE, &
XTYPE = TPREC%NTYPE_FILE, DIMIDS = IDIMS_ID)
IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__)
IF (.NOT.TPREC%LSPLIT) THEN
ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE))
ALLOCATE(TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE))
ELSE
ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE+1))
ALLOCATE(TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE+1))
END IF
IF (TPREC%NDIMS_FILE == 0) THEN
! Scalar variable
ILENG = 1
ELSE
! Fill dimensions info
ILENG = 1
DO JDIM=1,TPREC%NDIMS_FILE
ISTATUS = NF90_INQUIRE_DIMENSION(KFILE_ID,IDIMS_ID(JDIM), &
len = TPREC%NDIMSIZES_FILE(JDIM), &
name = TPREC%CDIMNAMES_FILE(JDIM) )
IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__)
ILENG = ILENG*TPREC%NDIMSIZES_FILE(JDIM)
END DO
IF (TPREC%NDIMS_FILE>0) THEN
IF (TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE)=='time') THEN
TPREC%TFIELD%LTIMEDEP = .TRUE.
ELSE
TPREC%TFIELD%LTIMEDEP = .FALSE.
END IF
ELSE
TPREC%TFIELD%LTIMEDEP = .FALSE.
END IF
IF (TPREC%LSPLIT) THEN
IF( (.NOT.TPREC%TFIELD%LTIMEDEP .AND. TPREC%NDIMS_FILE/=2) &
.OR. ( TPREC%TFIELD%LTIMEDEP .AND. TPREC%NDIMS_FILE/=3) ) &
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','split variables can only be 3D')
!Split variables are Z-split
ILENG = ILENG * (NKMAX+2*JPVEXT)
!Move time dimension to last (4th) position
IF (TPREC%TFIELD%LTIMEDEP) THEN
TPREC%NDIMSIZES_FILE(4) = TPREC%NDIMSIZES_FILE(3)
TPREC%CDIMNAMES_FILE(4) = TPREC%CDIMNAMES_FILE(3)
END IF
!Add vertical dimension
TPREC%NDIMSIZES_FILE(3) = NKMAX+2*JPVEXT
TPREC%CDIMNAMES_FILE(3) = 'level' !Could also be 'level_w'
END IF
END IF
TPREC%NSIZE = ILENG
ISTATUS = NF90_GET_ATT(KFILE_ID,KVAR_ID,'grid',TPREC%NGRID_FILE)

WAUTELET Philippe
committed
!On MesoNH versions < 5.4.0, the grid number was stored in 'GRID' instead of 'grid'
IF (ISTATUS /= NF90_NOERR) ISTATUS = NF90_GET_ATT(KFILE_ID,KVAR_ID,'GRID',TPREC%NGRID_FILE)
IF (ISTATUS /= NF90_NOERR) TPREC%NGRID_FILE = 0
ISTATUS = NF90_GET_ATT(KFILE_ID,KVAR_ID,'units',TPREC%CUNITS_FILE)
IF (ISTATUS /= NF90_NOERR) TPREC%CUNITS_FILE = ''

WAUTELET Philippe
committed
END SUBROUTINE IO_Metadata_get_nc4

WAUTELET Philippe
committed
SUBROUTINE IO_Dims_fill_nc4(TPFILE,TPREC,KRESP)
USE MODD_IO, ONLY: TFILEDATA
use mode_io_tools_nc4, only: IO_Dimcdf_get_nc4, IO_Dim_find_byname_nc4

WAUTELET Philippe
committed
TYPE(TFILEDATA),INTENT(IN) :: TPFILE
TYPE(workfield),INTENT(INOUT) :: TPREC
INTEGER, INTENT(OUT) :: KRESP
INTEGER :: JJ
TYPE(DIMCDF),POINTER :: TZDIMPTR

WAUTELET Philippe
committed
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dims_fill_nc4','called')

WAUTELET Philippe
committed
KRESP = 0

WAUTELET Philippe
committed
IF (TPREC%NDIMS_FILE<TPREC%TFIELD%NDIMS) THEN

WAUTELET Philippe
committed
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dims_fill_nc4','less dimensions than expected for '//TRIM(TPREC%TFIELD%CMNHNAME)// &

WAUTELET Philippe
committed
' => ignored')
TPREC%tbw = .FALSE.
TPREC%tbr = .FALSE.
TPREC%found = .FALSE.
RETURN
END IF

WAUTELET Philippe
committed
ALLOCATE(TPREC%TDIMS(TPREC%TFIELD%NDIMS))
DO JJ=1,TPREC%TFIELD%NDIMS
!DO JJ=1,TPREC%NDIMS_FILE !NDIMS_FILE can be bigger than NDIMS due to time dimension (it can be ignored here)

WAUTELET Philippe
committed
CALL IO_Dim_find_byname_nc4(TPFILE,TPREC%CDIMNAMES_FILE(JJ),TPREC%TDIMS(JJ),KRESP)

WAUTELET Philippe
committed
!If dimension not found => create it
IF (KRESP/=0) THEN

WAUTELET Philippe
committed
TZDIMPTR => IO_Dimcdf_get_nc4(TPFILE,TPREC%NDIMSIZES_FILE(JJ))

WAUTELET Philippe
committed
TPREC%TDIMS(JJ) = TZDIMPTR
KRESP = 0
END IF
IF (TRIM(TPREC%TDIMS(JJ)%name)/='time' .AND. &
TPREC%TDIMS(JJ)%len /= TPREC%NDIMSIZES_FILE(JJ)) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','problem with dimensions for '//TPREC%TFIELD%CMNHNAME)
KRESP = -3
EXIT
END IF
END DO

WAUTELET Philippe
committed
END SUBROUTINE IO_Dims_fill_nc4

WAUTELET Philippe
committed