Newer
Older
WAUTELET Philippe
committed
!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
WAUTELET Philippe
committed
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
WAUTELET Philippe
committed
! Modifications:
! P. Wautelet 07/02/2019: force TYPE to a known value for IO_FILE_ADD2LIST
WAUTELET Philippe
committed
! P. Wautelet 10/04/2019: use IO_Err_handle_nc4 to handle netCDF errors
! P. Wautelet 25/06/2019: add support for 3D integer arrays
WAUTELET Philippe
committed
!-----------------------------------------------------------------
WAUTELET Philippe
committed
USE MODD_IO, ONLY: TFILE_ELT
USE MODD_NETCDF, ONLY: DIMCDF, CDFINT
USE MODD_PARAMETERS, ONLY: JPVEXT, NLFIMAXCOMMENTLENGTH, NMNHNAMELGTMAX
use modd_precision, only: LFIINT
WAUTELET Philippe
committed
WAUTELET Philippe
committed
USE MODE_FIELD
WAUTELET Philippe
committed
USE MODE_IO_FIELD_READ
USE MODE_IO_FIELD_WRITE
WAUTELET Philippe
committed
use mode_io_tools_nc4, only: IO_Err_handle_nc4
WAUTELET Philippe
committed
WAUTELET Philippe
committed
USE mode_options
WAUTELET Philippe
committed
USE NETCDF
INTEGER,PARAMETER :: MAXRAW=10
WAUTELET Philippe
committed
WAUTELET Philippe
committed
INTEGER,PARAMETER :: FM_FIELD_SIZE = 32
CHARACTER(LEN=NMNHNAMELGTMAX) :: name ! nom du champ
WAUTELET Philippe
committed
LOGICAL :: found ! T if found in the input file
LOGICAL :: calc ! T if computed from other variables
LOGICAL :: tbw ! to be written or not
LOGICAL :: tbr ! to be read or not
WAUTELET Philippe
committed
LOGICAL :: LSPLIT = .FALSE. ! TRUE if variable is split by vertical level
WAUTELET Philippe
committed
INTEGER :: NSIZE = 0 ! Size of the variable (in number of elements)
INTEGER :: NSRC = 0 ! Number of variables used to compute the variable (needed only if calc=.true.)
WAUTELET Philippe
committed
INTEGER :: NDIMS_FILE ! Number of dims (as present in input file)
INTEGER,DIMENSION(:),ALLOCATABLE :: NDIMSIZES_FILE ! Dimensions sizes (as present in input file)
CHARACTER(LEN=NF90_MAX_NAME),DIMENSION(:),ALLOCATABLE :: CDIMNAMES_FILE ! Dimensions names (as present in input file)
CHARACTER(LEN=40) :: CUNITS_FILE = '' ! Units (as present in input file)
INTEGER :: NGRID_FILE ! Grid number (as present in input file)
INTEGER :: NTYPE_FILE ! netCDF datatype (NF90_CHAR, NF90_INT...) (as present in input file)
WAUTELET Philippe
committed
INTEGER,DIMENSION(MAXRAW) :: src ! List of variables used to compute the variable (needed only if calc=.true.)
INTEGER :: tgt ! Target: id of the variable that use it (calc variable)
TYPE(TFIELDDATA) :: TFIELD ! Metadata about the field
TYPE(DIMCDF),DIMENSION(:),ALLOCATABLE :: TDIMS ! Dimensions of the field
WAUTELET Philippe
committed
LOGICAL(KIND=LFIINT), PARAMETER :: ltrue = .TRUE.
LOGICAL(KIND=LFIINT), PARAMETER :: lfalse = .FALSE.
WAUTELET Philippe
committed
CHARACTER(LEN=6) :: CPROGRAM_ORIG
SUBROUTINE parse_infiles(infiles, outfiles, KNFILES_OUT, nbvar_infile, nbvar_tbr, nbvar_calc, nbvar_tbw, &
tpreclist, options, runmode)
WAUTELET Philippe
committed
USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
WAUTELET Philippe
committed
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, NGRIDUNKNOWN
WAUTELET Philippe
committed
WAUTELET Philippe
committed
use mode_io_tools_nc4, only: IO_Dimids_guess_nc4
WAUTELET Philippe
committed
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: outfiles
INTEGER, INTENT(IN) :: KNFILES_OUT
INTEGER, INTENT(IN) :: nbvar_infile, nbvar_tbr, nbvar_calc, nbvar_tbw
TYPE(workfield), DIMENSION(:),POINTER,INTENT(OUT) :: tpreclist
TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER, INTENT(IN) :: runmode
TYPE TLFIDATE
CHARACTER(LEN=FM_FIELD_SIZE) :: CNAME = '' !Name of the date variable
INTEGER :: NIDX_DATE = -1 !Index of the date part
INTEGER :: NIDX_TIME = -1 !Index of the time part
END TYPE TLFIDATE
CHARACTER(LEN=FM_FIELD_SIZE) :: yrecfm, YDATENAME
CHARACTER(LEN=FM_FIELD_SIZE) :: var_calc
CHARACTER(LEN=FM_FIELD_SIZE),dimension(MAXRAW) :: var_raw
WAUTELET Philippe
committed
CHARACTER(LEN=1) :: YNDIMS
CHARACTER(LEN=32) :: YTYPE
INTEGER :: ji,jj
INTEGER :: ndb, nde, ndey, idx, idx_out, idx_var, maxvar
INTEGER :: leng
INTEGER :: IID, IRESP, IDATES, ICURDATE
INTEGER :: IDXDATE, IDXTIME
WAUTELET Philippe
committed
INTEGER(KIND=LFIINT) :: iresp2,ilu,ileng,ipos
INTEGER(KIND=CDFINT) :: kcdf_id, kcdf_id2, var_id
INTEGER(KIND=CDFINT) :: status
LOGICAL :: ladvan
LOGICAL :: GOK
TYPE(TLFIDATE),DIMENSION(MAXDATES) :: TLFIDATES
CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles','called')
IF (options(OPTSPLIT)%set) THEN
idx_out = 0
ELSE
idx_out = 1
END IF
WAUTELET Philippe
committed
IF (runmode==MODECDF2LFI) THEN
!This file is a dummy one to manage netCDF dims
idx_out = KNFILES_OUT
IF (INFILES(1)%TFILE%CFORMAT == 'LFI') THEN
ilu = INFILES(1)%TFILE%NLFIFLU
ELSE IF (INFILES(1)%TFILE%CFORMAT == 'NETCDF4') THEN
kcdf_id = INFILES(1)%TFILE%NNCID
WAUTELET Philippe
committed
PRINT *,'MESONH 3D, 2D articles DIMENSIONS used :'
PRINT *,'DIMX =',NIMAX_ll+2*JPHEXT
PRINT *,'DIMY =',NJMAX_ll+2*JPHEXT
PRINT *,'DIMZ =',NKMAX +2*JPVEXT
! Phase 1 : build articles list to convert.
!
! Pour l'instant tous les articles du fichier LFI sont
! convertis. On peut modifier cette phase pour prendre en
! compte un sous-ensemble d'article (liste definie par
WAUTELET Philippe
committed
IF (options(OPTVAR)%set) THEN
ALLOCATE(tpreclist(nbvar_tbr+nbvar_calc))
DO ji=1,nbvar_tbr+nbvar_calc
tpreclist(ji)%found = .FALSE.
tpreclist(ji)%calc = .FALSE. !By default variables are not computed from others
tpreclist(ji)%tbw = .TRUE. !By default variables are written
tpreclist(ji)%tbr = .TRUE. !By default variables are read
tpreclist(ji)%src(:) = -1
tpreclist(ji)%tgt = -1
END DO
! A variable list is provided with -v var1,...
ndb = 1
idx_var = 1
DO ji=1,nbvar_tbw
WAUTELET Philippe
committed
!crash compiler GCC 4.2.0: nde = INDEX(TRIM(options(OPTVAR)%cvalue(ndb:)),',')
nde = INDEX(TRIM(options(OPTVAR)%cvalue(ndb:len(trim(options(OPTVAR)%cvalue)))),',')
IF (nde == 0) nde = LEN( TRIM(options(OPTVAR)%cvalue(ndb:len(trim(options(OPTVAR)%cvalue)))) ) + 1
WAUTELET Philippe
committed
yrecfm = options(OPTVAR)%cvalue(ndb:ndb+nde-2)
!Detect operations on variables (only + is supported now)
ndey = INDEX(TRIM(yrecfm),'=')
idx = 1
IF (ndey /= 0) THEN
var_calc = yrecfm(1:ndey-1)
DO WHILE (ndey /= 0)
IF (idx>MAXRAW) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','MAXRAW exceeded (too many raw variables for 1 computed one)')
END IF
yrecfm = yrecfm(ndey+1:)
ndey = INDEX(TRIM(yrecfm),'+')
IF (ndey /= 0) THEN
var_raw(idx) = yrecfm(1:ndey-1)
ELSE
var_raw(idx) = TRIM(yrecfm)
END IF
idx = idx + 1
END DO
tpreclist(idx_var)%name = trim(var_calc)
tpreclist(idx_var)%calc = .TRUE.
tpreclist(idx_var)%tbw = .TRUE.
tpreclist(idx_var)%tbr = .FALSE.
tpreclist(idx_var)%NSRC = idx-1
idx_var=idx_var+1
DO jj = 1, idx-1
tpreclist(idx_var-jj)%src(jj) = idx_var
tpreclist(idx_var)%name = trim(var_raw(jj))
tpreclist(idx_var)%calc = .FALSE.
tpreclist(idx_var)%tbw = .FALSE.
tpreclist(idx_var)%tbr = .TRUE.
tpreclist(idx_var)%tgt = idx_var-jj
idx_var=idx_var+1
END DO
ELSE
tpreclist(idx_var)%name = trim(yrecfm)
tpreclist(idx_var)%calc = .FALSE.
tpreclist(idx_var)%tbw = .TRUE.
idx_var=idx_var+1
END IF
ndb = nde+ndb
END DO
DO ji=1,nbvar_tbr+nbvar_calc
IF (tpreclist(ji)%calc) CYCLE
yrecfm = TRIM(tpreclist(ji)%name)
IF (INFILES(1)%TFILE%CFORMAT == 'LFI') THEN
WAUTELET Philippe
committed
CALL LFINFO(iresp2,ilu,trim(yrecfm),ileng,ipos)
IF (iresp2 == 0 .AND. ileng /= 0) THEN
tpreclist(ji)%found = .true.
tpreclist(ji)%NSIZE = ileng - 2 - NLFIMAXCOMMENTLENGTH
END IF
IF (iresp2==0 .AND. ileng == 0 .AND. ipos==0 .AND. INFILES(1)%TFILE%NSUBFILES_IOZ>0) THEN
WAUTELET Philippe
committed
!Variable not found with no error (iresp2==0 .AND. ileng == 0 .AND. ipos==0)
!If we are merging, maybe it is one of the split variable
WAUTELET Philippe
committed
!In that case, the 1st part of the variable is in the 1st split file with a 0001 suffix
CALL LFINFO(iresp2,INFILES(1)%TFILE%TFILES_IOZ(1)%TFILE%NLFIFLU,trim(yrecfm)//'0001',ileng,ipos)
WAUTELET Philippe
committed
IF (iresp2 == 0 .AND. ileng /= 0) THEN
tpreclist(ji)%found = .true.
tpreclist(ji)%LSPLIT = .true.
IF (tpreclist(ji)%tgt > 0) THEN !If this variable is used for a calculated one
tpreclist(tpreclist(ji)%tgt)%LSPLIT = .true.
END IF
END IF
tpreclist(ji)%NSIZE = (ileng - 2 - NLFIMAXCOMMENTLENGTH) * (NKMAX+2*JPVEXT)
ileng = tpreclist(ji)%NSIZE + 2 + NLFIMAXCOMMENTLENGTH
WAUTELET Philippe
committed
END IF
ELSE IF (INFILES(1)%TFILE%CFORMAT == 'NETCDF4') THEN
status = NF90_INQ_VARID(kcdf_id,trim(yrecfm),var_id)
IF (status /= NF90_NOERR .AND. INFILES(1)%TFILE%NSUBFILES_IOZ>0) THEN
WAUTELET Philippe
committed
!Variable probably not found (other error possible...)
!If we are merging, maybe it is one of the split variable
WAUTELET Philippe
committed
!In that case, the 1st part of the variable is in the 1st split file with a 0001 suffix
kcdf_id2 = INFILES(1)%TFILE%TFILES_IOZ(1)%TFILE%NNCID
status = NF90_INQ_VARID(kcdf_id2,trim(yrecfm)//'0001',var_id)
WAUTELET Philippe
committed
IF (status == NF90_NOERR) THEN
tpreclist(ji)%LSPLIT = .true.
IF (tpreclist(ji)%tgt > 0) THEN !If this variable is used for a calculated one
tpreclist(tpreclist(ji)%tgt)%LSPLIT = .true.
END IF
WAUTELET Philippe
committed
if ( status /= NF90_NOERR ) &
call IO_Err_handle_nc4( status, 'parse_infiles', 'NF90_INQ_VARID', trim(yrecfm)//'0001' )
WAUTELET Philippe
committed
END IF
ELSE IF (status /= NF90_NOERR) THEN
WAUTELET Philippe
committed
call IO_Err_handle_nc4( status, 'parse_infiles', 'NF90_INQ_VARID', trim(yrecfm) )
WAUTELET Philippe
committed
ELSE
kcdf_id2 = kcdf_id
ENDIF
!
IF (status == NF90_NOERR) THEN
tpreclist(ji)%found = .true.
WAUTELET Philippe
committed
CALL IO_Metadata_get_nc4(kcdf_id2,var_id,tpreclist(ji))
END IF
END IF
IF (.NOT.tpreclist(ji)%found) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','variable '//TRIM(yrecfm)//' not found => ignored')
tpreclist(ji)%tbw = .FAlSE.
tpreclist(ji)%tbr = .FAlSE.
maxvar = nbvar_tbr+nbvar_calc
DO ji=1,nbvar_tbr+nbvar_calc
print *,ji,'name=',trim(tpreclist(ji)%name),' calc=',tpreclist(ji)%calc,' tbw=',tpreclist(ji)%tbw,&
' tbr=',tpreclist(ji)%tbr,' found=',tpreclist(ji)%found
END DO
ELSE
! Entire file is converted
ALLOCATE(tpreclist(nbvar_infile))
DO ji=1,nbvar_infile
tpreclist(ji)%calc = .FALSE. !By default variables are not computed from others
tpreclist(ji)%tbw = .TRUE. !By default variables are written
tpreclist(ji)%src(:) = -1
END DO
IF (INFILES(1)%TFILE%CFORMAT == 'LFI') THEN
WAUTELET Philippe
committed
CALL LFIPOS(iresp2,ilu)
ladvan = .TRUE.
DO ji=1,nbvar_infile
WAUTELET Philippe
committed
CALL LFICAS(iresp2,ilu,yrecfm,ileng,ipos,ladvan)
WAUTELET Philippe
committed
tpreclist(ji)%name = trim(yrecfm)
WAUTELET Philippe
committed
tpreclist(ji)%NSIZE = ileng - 2 - NLFIMAXCOMMENTLENGTH
!Detect if date variable
IDXDATE = INDEX(trim(yrecfm),"%TDATE",.TRUE.)
IDXTIME = INDEX(trim(yrecfm),"%TIME", .TRUE.)
IF (IDXDATE/=0 .AND. IDXTIME/=0) &
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','field in LFI file with %TDATE and %TIME in name '//TRIM(YRECFM))
IDX = MAX(IDXDATE,IDXTIME)
IF (IDX>0) THEN
YDATENAME = YRECFM(1:IDX-1)
!Look if datename is already known
ICURDATE = 0
DO JJ=1,IDATES
IF (TRIM(YDATENAME)==TRIM(TLFIDATES(JJ)%CNAME)) THEN
ICURDATE = JJ
EXIT
END DO
!
IF (ICURDATE == 0) THEN
!New date name detected
IDATES = IDATES + 1
IF (IDATES>MAXDATES) CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','too many dates, increase MAXDATES')
ICURDATE = IDATES
END IF
TLFIDATES(ICURDATE)%CNAME = TRIM(YDATENAME)
IF (IDXTIME>0) THEN
IF (TLFIDATES(ICURDATE)%NIDX_TIME /= -1) &
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','NIDX_TIME already set for '//TRIM(YDATENAME))
TLFIDATES(ICURDATE)%NIDX_TIME = JI
!Set variable name to truncated name (necessary to correctly identify the variable when read)
tpreclist(ji)%name = TRIM(YDATENAME)
END IF
IF (IDXDATE>0) THEN
IF (TLFIDATES(ICURDATE)%NIDX_DATE /= -1) &
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','NIDX_DATE already set for '//TRIM(YDATENAME))
TLFIDATES(ICURDATE)%NIDX_DATE = JI
!Do not treat this variable (the date part will be read with the time part)
tpreclist(ji)%name = 'removed_date'
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
END IF
END IF
DO JI=1,IDATES
IF (TLFIDATES(JI)%NIDX_DATE == -1 .OR. TLFIDATES(JI)%NIDX_TIME == -1) &
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','incomplete DATE/TIME fields for '//TRIM(TLFIDATES(JI)%CNAME))
END DO
!
ELSE IF (INFILES(1)%TFILE%CFORMAT == 'NETCDF4') THEN
var_id = ji
status = NF90_INQUIRE_VARIABLE(kcdf_id,var_id, name = tpreclist(ji)%name)
WAUTELET Philippe
committed
if ( status /= NF90_NOERR ) &
call IO_Err_handle_nc4( status, 'parse_infiles', 'NF90_INQUIRE_VARIABLE', tpreclist(ji)%name )
WAUTELET Philippe
committed
CALL IO_Metadata_get_nc4(kcdf_id,var_id,tpreclist(ji))
END DO
END IF
maxvar = nbvar_infile
WAUTELET Philippe
committed
! Check if variable is in TFIELDLIST and populate corresponding metadata
DO ji=1,maxvar
IF (runmode/=MODECDF2LFI .AND. options(OPTSPLIT)%set .AND. tpreclist(ji)%tbw) idx_out = idx_out + 1
IF (.NOT.tpreclist(ji)%found .OR. tpreclist(ji)%calc ) CYCLE
WAUTELET Philippe
committed
!
!Do not treat dimension variables (they are automatically added when creating netCDF file)
IF ( tpreclist(ji)%name == 'ni' &
.OR. tpreclist(ji)%name == 'nj' &
.OR. tpreclist(ji)%name == 'ni_u' &
.OR. tpreclist(ji)%name == 'nj_u' &
.OR. tpreclist(ji)%name == 'ni_v' &
.OR. tpreclist(ji)%name == 'nj_v' &
.OR. tpreclist(ji)%name == 'latitude' &
.OR. tpreclist(ji)%name == 'longitude' &
.OR. tpreclist(ji)%name == 'latitude_u' &
.OR. tpreclist(ji)%name == 'longitude_u' &
.OR. tpreclist(ji)%name == 'latitude_v' &
.OR. tpreclist(ji)%name == 'longitude_v' &
.OR. tpreclist(ji)%name == 'latitude_f' &
.OR. tpreclist(ji)%name == 'longitude_f' &
.OR. tpreclist(ji)%name == 'level' &
WAUTELET Philippe
committed
.OR. tpreclist(ji)%name == 'level_w' &
.OR. tpreclist(ji)%name == 'time' ) THEN
WAUTELET Philippe
committed
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
ELSE
WAUTELET Philippe
committed
CALL FIND_FIELD_ID_FROM_MNHNAME(tpreclist(ji)%name,IID,IRESP,ONOWARNING=.TRUE.)
WAUTELET Philippe
committed
IF (IRESP==0) THEN
tpreclist(ji)%TFIELD = TFIELDLIST(IID)
WAUTELET Philippe
committed
! Determine TDIMS
WAUTELET Philippe
committed
IF (runmode==MODELFI2CDF) THEN
ALLOCATE(tpreclist(ji)%TDIMS(tpreclist(ji)%TFIELD%NDIMS))
WAUTELET Philippe
committed
CALL IO_Dimids_guess_nc4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
WAUTELET Philippe
committed
tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
ELSE !If we read netCDF4, we already have all necessary data
WAUTELET Philippe
committed
!Special case for EMIS (only the first band is read/written) -> NDIMS reduced to 2
if(tpreclist(ji)%TFIELD%CMNHNAME=="EMIS") tpreclist(ji)%TFIELD%NDIMS = 2
WAUTELET Philippe
committed
CALL IO_Dims_fill_nc4(outfiles(idx_out)%TFILE,tpreclist(ji),IRESP)
WAUTELET Philippe
committed
ENDIF
WAUTELET Philippe
committed
IF (IRESP/=0) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','can not guess dimensions for '//tpreclist(ji)%TFIELD%CMNHNAME// &
' => ignored')
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
CYCLE
END IF
WAUTELET Philippe
committed
ELSE !Field not found in list, try to determine characteristics
tpreclist(ji)%TFIELD%CMNHNAME = TRIM(tpreclist(ji)%name)
tpreclist(ji)%TFIELD%CSTDNAME = ''
tpreclist(ji)%TFIELD%CLONGNAME = TRIM(tpreclist(ji)%name)
tpreclist(ji)%TFIELD%CUNITS = ''
tpreclist(ji)%TFIELD%CDIR = 'XY' !Assumption...
tpreclist(ji)%TFIELD%CLBTYPE = 'NONE'
tpreclist(ji)%TFIELD%CCOMMENT = ''
!
IF (runmode==MODELFI2CDF) THEN
tpreclist(ji)%TFIELD%NGRID = 1 !Assumption
tpreclist(ji)%TFIELD%NTYPE = TYPEREAL !Assumption
WRITE(YTYPE,'( A )') 'REAL (forced)'
IF (tpreclist(ji)%NSIZE>1) THEN
ALLOCATE(tpreclist(ji)%TDIMS(3))
! Determine TDIMS
CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles',tpreclist(ji)%TFIELD%CMNHNAME//': try 3D')
tpreclist(ji)%TFIELD%NDIMS = 3 !Try with 3D
WAUTELET Philippe
committed
CALL IO_Dimids_guess_nc4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
WAUTELET Philippe
committed
tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
!
IF (IRESP/=0 .OR. tpreclist(ji)%TDIMS(3)%LEN==1) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles',tpreclist(ji)%TFIELD%CMNHNAME//': try 2D')
!Try again with 2D
tpreclist(ji)%TFIELD%NDIMS = 2
WAUTELET Philippe
committed
CALL IO_Dimids_guess_nc4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
WAUTELET Philippe
committed
tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
END IF
!
IF (IRESP/=0 .OR. tpreclist(ji)%TDIMS(2)%LEN==1) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles',tpreclist(ji)%TFIELD%CMNHNAME//': try 1D')
!Try again with 1D
tpreclist(ji)%TFIELD%NDIMS = 1
tpreclist(ji)%TFIELD%CDIR = '--' !Assumption...
WAUTELET Philippe
committed
CALL IO_Dimids_guess_nc4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
WAUTELET Philippe
committed
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
END IF
!
IF (IRESP/=0) THEN !Could not find valid characteristics
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
CYCLE
END IF
ELSE !NSIZE==0
tpreclist(ji)%TFIELD%CDIR = '--'
tpreclist(ji)%TFIELD%NDIMS = 0
tpreclist(ji)%TFIELD%NGRID = 0
END IF
tpreclist(ji)%TFIELD%LTIMEDEP = .FALSE. !Assumption
ELSE ! Input file is netCDF
tpreclist(ji)%TFIELD%NGRID = tpreclist(ji)%NGRID_FILE
SELECT CASE(tpreclist(ji)%NTYPE_FILE)
CASE (NF90_INT1) !NF90_INT1=NF90_BYTE
tpreclist(ji)%TFIELD%NTYPE = TYPELOG
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%NDIMS_FILE
WRITE(YTYPE,'( A )') 'LOGICAL'
CASE (NF90_CHAR)
tpreclist(ji)%TFIELD%NTYPE = TYPECHAR
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%NDIMS_FILE-1
WRITE(YTYPE,'( A )') 'CHARACTER'
CASE (NF90_INT,NF90_INT64)
tpreclist(ji)%TFIELD%NTYPE = TYPEINT
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%NDIMS_FILE
WRITE(YTYPE,'( A )') 'INTEGER'
CASE (NF90_FLOAT,NF90_DOUBLE)
tpreclist(ji)%TFIELD%NTYPE = TYPEREAL
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%NDIMS_FILE
WRITE(YTYPE,'( A )') 'REAL'
CASE DEFAULT
tpreclist(ji)%TFIELD%NTYPE = TYPEUNDEF
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%NDIMS_FILE
WRITE(YTYPE,'( A )') 'UNKNOWN'
END SELECT
tpreclist(ji)%TFIELD%CUNITS = tpreclist(ji)%CUNITS_FILE
IF (tpreclist(ji)%TFIELD%NDIMS<2) THEN
tpreclist(ji)%TFIELD%CDIR = '--' !Assumption
ELSE
tpreclist(ji)%TFIELD%CDIR = 'XY' !Assumption
END IF
WAUTELET Philippe
committed
CALL IO_Dims_fill_nc4(outfiles(idx_out)%TFILE,tpreclist(ji),IRESP)
WAUTELET Philippe
committed
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
IF (tpreclist(ji)%NDIMS_FILE>0) THEN
IF (tpreclist(ji)%CDIMNAMES_FILE(tpreclist(ji)%NDIMS_FILE)=='time') THEN
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%TFIELD%NDIMS - 1
END IF
END IF
!
IF (IRESP/=0) THEN
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
END IF
END IF
!
IF (runmode==MODELFI2CDF) THEN
tpreclist(ji)%TFIELD%NGRID = NGRIDUNKNOWN !Assumption
IF(tpreclist(ji)%TFIELD%NDIMS == 0 .OR. tpreclist(ji)%TFIELD%NTYPE == TYPECHAR) THEN
tpreclist(ji)%TFIELD%NGRID = 0
END IF
END IF
!
IF (.NOT.tpreclist(ji)%found) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','can not guess dimensions for '// &
TRIM(tpreclist(ji)%TFIELD%CMNHNAME)//' => ignored')
ELSE
IF (tpreclist(ji)%TFIELD%LTIMEDEP) THEN
WRITE(YNDIMS,'( I1 )') tpreclist(ji)%TFIELD%NDIMS-1
CALL PRINT_MSG(NVERB_WARNING,'IO','unknown field',tpreclist(ji)%TFIELD%CMNHNAME//' seems to be '// &
YNDIMS//'D of type '//TRIM(YTYPE)//' (time dependent)')
ELSE
WRITE(YNDIMS,'( I1 )') tpreclist(ji)%TFIELD%NDIMS
CALL PRINT_MSG(NVERB_WARNING,'IO','unknown field',tpreclist(ji)%TFIELD%CMNHNAME//' seems to be '// &
YNDIMS//'D of type '//TRIM(YTYPE))
END IF
END IF
WAUTELET Philippe
committed
END IF
END IF
END DO
IF (nbvar_calc>0) THEN
!Calculated variables
WAUTELET Philippe
committed
!Done after previous loop to reuse metadata from component variables
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
!Derive metadata from its components
!If same value for all components => take it
!If not => nothing or default value
!Check sizes: must be the same for all
DO ji=1,maxvar
IF (.NOT.tpreclist(ji)%calc ) CYCLE
!
tpreclist(ji)%TFIELD%CMNHNAME = tpreclist(ji)%name
tpreclist(ji)%TFIELD%CSTDNAME = ''
tpreclist(ji)%TFIELD%CLONGNAME = tpreclist(ji)%name
!
GOK = .TRUE.
DO jj=1,tpreclist(ji)%NSRC
idx_var = tpreclist(ji)%src(jj)
IF(.NOT.tpreclist(idx_var)%found) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','some components for calculated variable ' &
//TRIM(tpreclist(ji)%name)//' are not known => ignored')
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
GOK = .FALSE.
EXIT
END IF
END DO
!
IF (GOK) THEN
idx_var = tpreclist(ji)%src(1)
tpreclist(ji)%TFIELD%CUNITS = tpreclist(idx_var)%TFIELD%CUNITS
tpreclist(ji)%TFIELD%CDIR = tpreclist(idx_var)%TFIELD%CDIR
tpreclist(ji)%TFIELD%CLBTYPE = tpreclist(idx_var)%TFIELD%CLBTYPE
tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%name)//'='//TRIM(tpreclist(idx_var)%name)
IF (tpreclist(ji)%NSRC>1) tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%TFIELD%CCOMMENT)//'+'
tpreclist(ji)%TFIELD%NGRID = tpreclist(idx_var)%TFIELD%NGRID
tpreclist(ji)%TFIELD%NTYPE = tpreclist(idx_var)%TFIELD%NTYPE
tpreclist(ji)%TFIELD%NDIMS = tpreclist(idx_var)%TFIELD%NDIMS
#if 0
!PW: TODO?
tpreclist(ji)%TFIELD%NFILLVALUE
tpreclist(ji)%TFIELD%XFILLVALUE
tpreclist(ji)%TFIELD%NVALIDMIN
tpreclist(ji)%TFIELD%NVALIDMAX
tpreclist(ji)%TFIELD%XVALIDMIN
tpreclist(ji)%TFIELD%XVALIDMAX
#endif
DO jj=2,tpreclist(ji)%NSRC
idx_var = tpreclist(ji)%src(jj)
!
IF (tpreclist(ji)%TFIELD%CUNITS /= tpreclist(idx_var)%TFIELD%CUNITS) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','CUNITS is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name)//' => CUNITS not set')
tpreclist(ji)%TFIELD%CUNITS = ''
END IF
!
IF (tpreclist(ji)%TFIELD%CDIR /= tpreclist(idx_var)%TFIELD%CDIR) THEN
CALL PRINT_MSG(NVERB_ERROR,'IO','parse_infiles','CDIR is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name)//' => CDIR=--')
tpreclist(ji)%TFIELD%CDIR = '--'
END IF
!
IF (tpreclist(ji)%TFIELD%CLBTYPE /= tpreclist(idx_var)%TFIELD%CLBTYPE) THEN
CALL PRINT_MSG(NVERB_ERROR,'IO','parse_infiles','CLBTYPE is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name)//' => CLBTYPE=NONE')
tpreclist(ji)%TFIELD%CLBTYPE = 'NONE'
END IF
!
tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%TFIELD%CCOMMENT)//TRIM(tpreclist(idx_var)%name)
IF (jj<tpreclist(ji)%NSRC) tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%TFIELD%CCOMMENT)//'+'
!
IF (tpreclist(ji)%TFIELD%NGRID /= tpreclist(idx_var)%TFIELD%NGRID) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','NGRID is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name)//' => NGRID=1')
tpreclist(ji)%TFIELD%NGRID = 1
END IF
!
IF (tpreclist(ji)%TFIELD%NTYPE /= tpreclist(idx_var)%TFIELD%NTYPE) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','NTYPE is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name))
tpreclist(ji)%TFIELD%NTYPE = TYPEUNDEF
END IF
!
IF (tpreclist(ji)%TFIELD%NDIMS /= tpreclist(idx_var)%TFIELD%NDIMS) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','NDIMS is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name))
END IF
END DO
!
ALLOCATE(tpreclist(ji)%TDIMS(tpreclist(ji)%TFIELD%NDIMS))
tpreclist(ji)%TDIMS = tpreclist(idx_var)%TDIMS
!
END IF
END DO !ji=1,maxvar
END IF !nbvar_calc>0
SUBROUTINE def_ncdf(infiles,outfiles,KNFILES_OUT)
USE MODD_CONF, ONLY: NMNHVERSION
WAUTELET Philippe
committed
use mode_io_write_nc4, only: IO_Header_write_nc4
WAUTELET Philippe
committed
TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: outfiles
INTEGER, INTENT(IN) :: KNFILES_OUT
CHARACTER(LEN=*),PARAMETER :: YUNKNOWNHIST = 'Previous history is unknown'
CHARACTER(LEN=16) :: YMNHVERSION
CHARACTER(LEN=:),ALLOCATABLE :: YHISTORY
INTEGER :: ilen, ji
INTEGER(KIND=CDFINT) :: status
INTEGER(KIND=CDFINT) :: kcdf_id
CALL PRINT_MSG(NVERB_DEBUG,'IO','def_ncdf','called')
!Copy history attribute for netCDF files
IF( outfiles(1)%TFILE%CFORMAT=='NETCDF4' ) THEN
IF( infiles(1)%TFILE%CFORMAT=='NETCDF4' ) THEN
status = NF90_INQUIRE_ATTRIBUTE(infiles(1)%TFILE%NNCID, NF90_GLOBAL, 'history', LEN=ilen)
IF (status == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ilen) :: YHISTORY)
status = NF90_GET_ATT(infiles(1)%TFILE%NNCID, NF90_GLOBAL, 'history', YHISTORY)
ELSE
YHISTORY = YUNKNOWNHIST
END IF
ELSE
YHISTORY = YUNKNOWNHIST
END IF
DO ji = 1,KNFILES_OUT
kcdf_id = outfiles(ji)%TFILE%NNCID
status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'history',YHISTORY)
WAUTELET Philippe
committed
if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'def_ncdf', 'NF90_PUT_ATT', 'history' )
END DO
END IF
!Write header for netCDF files
DO ji = 1,KNFILES_OUT
kcdf_id = outfiles(ji)%TFILE%NNCID
WAUTELET Philippe
committed
! global attributes
WAUTELET Philippe
committed
CALL IO_Header_write_nc4(outfiles(ji)%TFILE)
WAUTELET Philippe
committed
!
WRITE(YMNHVERSION,"( I0,'.',I0,'.',I0 )" ) NMNHVERSION(1),NMNHVERSION(2),NMNHVERSION(3)
status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'lfi2cdf_version',TRIM(YMNHVERSION))
WAUTELET Philippe
committed
if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'def_ncdf', 'NF90_PUT_ATT', 'lfi2cdf_version' )
SUBROUTINE fill_files(infiles,outfiles,tpreclist,knaf,options)
USE MODD_TYPE_DATE
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: outfiles
WAUTELET Philippe
committed
TYPE(workfield), DIMENSION(:),INTENT(INOUT) :: tpreclist
INTEGER, INTENT(IN) :: knaf
TYPE(option),DIMENSION(:), INTENT(IN) :: options
WAUTELET Philippe
committed
INTEGER :: idx, ji, jj
INTEGER :: IDIMS
INTEGER :: INSRC
INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IDIMLEN
WAUTELET Philippe
committed
logical,dimension(knaf) :: gtimedep_in, gtimedep_out
WAUTELET Philippe
committed
CHARACTER(LEN=:), ALLOCATABLE :: YTAB0D
INTEGER, DIMENSION(:), ALLOCATABLE :: ITAB1D, ITAB1D2
INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITAB2D, ITAB2D2
INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ITAB3D, ITAB3D2
LOGICAL, DIMENSION(:), ALLOCATABLE :: GTAB1D
REAL, DIMENSION(:), ALLOCATABLE :: XTAB1D, XTAB1D2
REAL, DIMENSION(:,:), ALLOCATABLE :: XTAB2D, XTAB2D2
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XTAB3D, XTAB3D2
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XTAB4D, XTAB4D2
WAUTELET Philippe
committed
TYPE(DATE_TIME) :: TZDATE
CALL PRINT_MSG(NVERB_DEBUG,'IO','fill_files','called')
WAUTELET Philippe
committed
! For versions of MesoNH <5.4.0, fields were not stored with a time dimension
! ->necessary to remove it when reading and to restore to the correct one when writing
if( infiles(1)%TFILE%NMNHVERSION(1)<5 .OR. &
(infiles(1)%TFILE%NMNHVERSION(1)==5 .AND. infiles(1)%TFILE%NMNHVERSION(2)<4) ) then
gtimedep_in(:) = .false.
else
gtimedep_in(:) = tpreclist(:)%TFIELD%LTIMEDEP
end if
gtimedep_out(:) = tpreclist(:)%TFIELD%LTIMEDEP
WAUTELET Philippe
committed
idx = 1
WAUTELET Philippe
committed
IF (.NOT.tpreclist(ji)%tbw) CYCLE
WAUTELET Philippe
committed
IDIMS = tpreclist(ji)%TFIELD%NDIMS
WAUTELET Philippe
committed
SELECT CASE(tpreclist(ji)%TFIELD%NTYPE)
CASE (TYPEINT)
IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%LEN
WAUTELET Philippe
committed
IF (.NOT.tpreclist(ji)%calc) THEN
INSRC = 1
ISRC = ji
ELSE
INSRC = tpreclist(ji)%NSRC
ISRC = tpreclist(ji)%src(1)
WAUTELET Philippe
committed
END IF
WAUTELET Philippe
committed
tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
WAUTELET Philippe
committed
SELECT CASE(IDIMS)
CASE (0)
ALLOCATE(ITAB1D(1))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB1D2(1))
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D(1))
WAUTELET Philippe
committed
CASE (1)
ALLOCATE(ITAB1D(IDIMLEN(1)))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB1D2(IDIMLEN(1)))
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D)
WAUTELET Philippe
committed
CASE (2)
ALLOCATE(ITAB2D(IDIMLEN(1),IDIMLEN(2)))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB2D2(IDIMLEN(1),IDIMLEN(2)))
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB2D)
CASE (3)
ALLOCATE(ITAB3D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB3D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB3D)
WAUTELET Philippe
committed
CASE DEFAULT
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
WAUTELET Philippe
committed
//TRIM(tpreclist(ISRC)%name)//' => ignored')
CYCLE
END SELECT
DO JJ=2,INSRC
ISRC = tpreclist(ji)%src(jj)
WAUTELET Philippe
committed
tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
WAUTELET Philippe
committed
SELECT CASE(IDIMS)
CASE (0)
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D2(1))
WAUTELET Philippe
committed
ITAB1D(1) = ITAB1D(1) + ITAB1D2(1)
CASE (1)
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D2)
WAUTELET Philippe
committed
ITAB1D(:) = ITAB1D(:) + ITAB1D2(:)
CASE (2)
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB2D2)
WAUTELET Philippe
committed
ITAB2D(:,:) = ITAB2D(:,:) + ITAB2D2(:,:)
CASE (3)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB3D2)
ITAB3D(:,:,:) = ITAB3D(:,:,:) + ITAB3D2(:,:,:)
WAUTELET Philippe
committed
END SELECT
END DO
WAUTELET Philippe
committed
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
WAUTELET Philippe
committed
SELECT CASE(IDIMS)
CASE (0)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB1D(1))
WAUTELET Philippe
committed
DEALLOCATE(ITAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB1D2)
CASE (1)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB1D)
WAUTELET Philippe
committed
DEALLOCATE(ITAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB1D2)
CASE (2)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB2D)
WAUTELET Philippe
committed
DEALLOCATE(ITAB2D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB2D2)
CASE (3)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB3D)
DEALLOCATE(ITAB3D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB3D2)
WAUTELET Philippe
committed
END SELECT
WAUTELET Philippe
committed
CASE (TYPELOG)
WAUTELET Philippe
committed
IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%LEN
WAUTELET Philippe
committed
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
WAUTELET Philippe
committed
SELECT CASE(IDIMS)
CASE (0)
ALLOCATE(GTAB1D(1))
WAUTELET Philippe
committed
CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,GTAB1D(1))
WAUTELET Philippe
committed
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,GTAB1D(1))
WAUTELET Philippe
committed
DEALLOCATE(GTAB1D)
CASE (1)
ALLOCATE(GTAB1D(IDIMLEN(1)))
WAUTELET Philippe
committed
CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,GTAB1D)
WAUTELET Philippe
committed
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,GTAB1D)
WAUTELET Philippe
committed
DEALLOCATE(GTAB1D)
CASE DEFAULT
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
WAUTELET Philippe
committed
//TRIM(tpreclist(ji)%name)//' => ignored')
WAUTELET Philippe
committed
CYCLE
END SELECT
WAUTELET Philippe
committed
WAUTELET Philippe
committed
IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%LEN
WAUTELET Philippe
committed
INSRC = 1
ISRC = ji
WAUTELET Philippe
committed
INSRC = tpreclist(ji)%NSRC
ISRC = tpreclist(ji)%src(1)
WAUTELET Philippe
committed
WAUTELET Philippe
committed
tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
WAUTELET Philippe
committed
SELECT CASE(IDIMS)
WAUTELET Philippe
committed
ALLOCATE(XTAB1D(1))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB1D2(1))
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D(1))
CASE (1)
ALLOCATE(XTAB1D(IDIMLEN(1)))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB1D2(IDIMLEN(1)))
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D)
CASE (2)
ALLOCATE(XTAB2D(IDIMLEN(1),IDIMLEN(2)))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB2D2(IDIMLEN(1),IDIMLEN(2)))
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB2D)
CASE (3)
ALLOCATE(XTAB3D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB3D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB3D)
CASE (4)
ALLOCATE(XTAB4D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3),IDIMLEN(4)))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB4D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3),IDIMLEN(4)))
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB4D)
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
WAUTELET Philippe
committed
//TRIM(tpreclist(ISRC)%name)//' => ignored')
CYCLE
WAUTELET Philippe
committed
DO JJ=2,INSRC
ISRC = tpreclist(ji)%src(jj)
WAUTELET Philippe
committed
tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
WAUTELET Philippe
committed
SELECT CASE(IDIMS)
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2(1))
XTAB1D(1) = XTAB1D(1) + XTAB1D2(1)
CASE (1)
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2)
XTAB1D(:) = XTAB1D(:) + XTAB1D2(:)
CASE (2)
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB2D2)
XTAB2D(:,:) = XTAB2D(:,:) + XTAB2D2(:,:)
CASE (3)
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB3D2)
XTAB3D(:,:,:) = XTAB3D(:,:,:) + XTAB3D2(:,:,:)
CASE (4)
WAUTELET Philippe
committed
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB4D2)
XTAB4D(:,:,:,:) = XTAB4D(:,:,:,:) + XTAB4D2(:,:,:,:)
END SELECT
END DO
WAUTELET Philippe
committed
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
WAUTELET Philippe
committed
SELECT CASE(IDIMS)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB1D(1))
DEALLOCATE(XTAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB1D2)
CASE (1)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB1D)
DEALLOCATE(XTAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB1D2)
CASE (2)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB2D)
DEALLOCATE(XTAB2D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB2D2)
CASE (3)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB3D)
DEALLOCATE(XTAB3D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB3D2)
CASE (4)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB4D)
DEALLOCATE(XTAB4D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB4D2)
END SELECT
WAUTELET Philippe
committed
CASE (TYPECHAR)
WAUTELET Philippe
committed
ISRC = ji
WAUTELET Philippe
committed
IF (IDIMS/=0) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
WAUTELET Philippe
committed
//TRIM(tpreclist(ISRC)%name)//' => ignored')
CYCLE
WAUTELET Philippe
committed
ALLOCATE(CHARACTER(LEN=tpreclist(ji)%NSIZE)::YTAB0D)
WAUTELET Philippe
committed
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
WAUTELET Philippe
committed
CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,YTAB0D)
WAUTELET Philippe
committed
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,YTAB0D)
WAUTELET Philippe
committed
DEALLOCATE(YTAB0D)
CASE (TYPEDATE)
WAUTELET Philippe
committed
ISRC = ji
WAUTELET Philippe
committed
IF (IDIMS/=0) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
WAUTELET Philippe
committed
//TRIM(tpreclist(ISRC)%name)//' => ignored')
CYCLE
END IF
WAUTELET Philippe
committed
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
WAUTELET Philippe
committed
CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD%CMNHNAME,TZDATE)
WAUTELET Philippe
committed
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
WAUTELET Philippe
committed
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,TZDATE)
WAUTELET Philippe
committed
WAUTELET Philippe
committed
CASE default
WAUTELET Philippe
committed
ISRC = ji
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','invalid datatype for ' &
WAUTELET Philippe
committed
//TRIM(tpreclist(ISRC)%name)//' => ignored')
WAUTELET Philippe
committed
END SELECT
WAUTELET Philippe
committed
if (options(OPTSPLIT)%set) idx = idx + 1
END SUBROUTINE fill_files
SUBROUTINE OPEN_FILES(infiles,outfiles,KNFILES_OUT,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, ONLY: LIOCDF4
WAUTELET Philippe
committed
USE MODD_PARAMETERS, ONLY: JPHEXT
USE MODD_PARAMETERS_ll, ONLY: JPHEXT_ll=>JPHEXT, JPVEXT_ll=>JPVEXT
WAUTELET Philippe
committed
USE MODD_TIME_n, ONLY: TDTCUR, TDTMOD
WAUTELET Philippe
committed
WAUTELET Philippe
committed
USE MODE_IO_FILE, ONLY: IO_FILE_OPEN, IO_FILE_CLOSE
WAUTELET Philippe
committed
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
TYPE(TFILE_ELT),DIMENSION(:),INTENT(OUT) :: infiles
TYPE(TFILE_ELT),DIMENSION(:),INTENT(OUT) :: outfiles
INTEGER, INTENT(OUT) :: KNFILES_OUT
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 :: idx, IRESP2
INTEGER(KIND=CDFINT) :: omode
INTEGER(KIND=CDFINT) :: status
WAUTELET Philippe
committed
INTEGER(KIND=LFIINT) :: ilu,iresp
CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_FILES','called')
KNFILES_OUT = 0
WAUTELET Philippe
committed
!
! Infiles
!
IF (runmode == MODECDF2CDF .OR. runmode == MODECDF2LFI) THEN
!
! NetCDF
!
WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(INFILES(1)%TFILE,HINFILE,'MNH','READ',HFORMAT='NETCDF4')
WAUTELET Philippe
committed
CALL IO_FILE_OPEN(INFILES(1)%TFILE)
nbvar_infile = INFILES(1)%TFILE%NNCNAR
WAUTELET Philippe
committed
ELSE
!
! LFI
!
WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(INFILES(1)%TFILE,HINFILE,'MNH','READ', &