Newer
Older

WAUTELET Philippe
committed
CALL IO_READ_FIELD(INFILES(1)%TFILE,'BETA',XBETA)

WAUTELET Philippe
committed
!

WAUTELET Philippe
committed
IF (.NOT.LCARTESIAN) THEN
CALL IO_READ_FIELD(INFILES(1)%TFILE,'RPK', XRPK)
CALL IO_READ_FIELD(INFILES(1)%TFILE,'LATORI',XLATORI)
CALL IO_READ_FIELD(INFILES(1)%TFILE,'LONORI',XLONORI)
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))
CALL IO_READ_FIELD(INFILES(1)%TFILE,'ZHAT',XZHAT)
ALLOCATE(LSLEVE)
CALL IO_READ_FIELD(INFILES(1)%TFILE,'SLEVE',LSLEVE)
ALLOCATE(TDTMOD)

WAUTELET Philippe
committed
CALL IO_READ_FIELD(INFILES(1)%TFILE,'DTMOD',TDTMOD,IRESP2)
IF(IRESP2/=0) DEALLOCATE(TDTMOD)
ALLOCATE(TDTCUR)
CALL IO_READ_FIELD(INFILES(1)%TFILE,'DTCUR',TDTCUR,IRESP2)
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
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,HOUTFILE,'UNKNOWN','WRITE', &

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

WAUTELET Philippe
committed
CALL IO_FILE_OPEN_ll(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
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,houtfile,'UNKNOWN','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_ll(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
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,'dummy_file','UNKNOWN','WRITE', &
HFORMAT='NETCDF4',OOLD=.TRUE.)

WAUTELET Philippe
committed
CALL IO_FILE_OPEN_ll(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_FM, ONLY: IO_FILE_OPEN_ll
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))
CALL IO_FILE_ADD2LIST(outfiles(ji)%TFILE,filename,'UNKNOWN','WRITE', &

WAUTELET Philippe
committed
HFORMAT='NETCDF4')

WAUTELET Philippe
committed
CALL IO_FILE_OPEN_ll(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_FM, ONLY: IO_FILE_CLOSE_ll
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
IF (filelist(ji)%TFILE%LOPENED) CALL IO_FILE_CLOSE_ll(filelist(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)

WAUTELET Philippe
committed
END DO

WAUTELET Philippe
committed

WAUTELET Philippe
committed
SUBROUTINE IO_GET_METADATA_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
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_GET_METADATA_NC4','called')
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
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
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 = ''
END SUBROUTINE IO_GET_METADATA_NC4

WAUTELET Philippe
committed
SUBROUTINE IO_FILL_DIMS_NC4(TPFILE,TPREC,KRESP)
USE MODD_IO_ll, ONLY: TFILEDATA
USE MODE_NETCDF, ONLY: GETDIMCDF, IO_FIND_DIM_BYNAME_NC4
TYPE(TFILEDATA),INTENT(IN) :: TPFILE
TYPE(workfield),INTENT(INOUT) :: TPREC
INTEGER, INTENT(OUT) :: KRESP
INTEGER :: JJ
TYPE(DIMCDF),POINTER :: TZDIMPTR
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILL_DIMS_NC4','called')

WAUTELET Philippe
committed
KRESP = 0

WAUTELET Philippe
committed
IF (TPREC%NDIMS_FILE<TPREC%TFIELD%NDIMS) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILL_DIMS_NC4','less dimensions than expected for '//TRIM(TPREC%TFIELD%CMNHNAME)// &
' => ignored')
TPREC%tbw = .FALSE.
TPREC%tbr = .FALSE.
TPREC%found = .FALSE.
RETURN
END IF

WAUTELET Philippe
committed
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
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)
CALL IO_FIND_DIM_BYNAME_NC4(TPFILE,TPREC%CDIMNAMES_FILE(JJ),TPREC%TDIMS(JJ),KRESP)
!If dimension not found => create it
IF (KRESP/=0) THEN
TZDIMPTR => GETDIMCDF(TPFILE,TPREC%NDIMSIZES_FILE(JJ))
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
END SUBROUTINE IO_FILL_DIMS_NC4