Skip to content
Snippets Groups Projects
mode_util.f90 53.3 KiB
Newer Older
   !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)
   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)
   CALL IO_Field_read(INFILES(1)%TFILE,'PROGRAM',CPROGRAM_ORIG)
   CALL IO_Field_read(INFILES(1)%TFILE,'STORAGE_TYPE',CSTORAGE_TYPE)
   CALL IO_Field_read(INFILES(1)%TFILE,'YHAT',XYHAT)
   CALL IO_Field_read(INFILES(1)%TFILE,'CARTESIAN',LCARTESIAN)
   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)
     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)
   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_Field_read(INFILES(1)%TFILE,'SLEVE',LSLEVE)
     CALL IO_Field_read(INFILES(1)%TFILE,'DTMOD',TDTMOD,IRESP2)
     IF(IRESP2/=0) DEALLOCATE(TDTMOD)
     ALLOCATE(TDTCUR)
     CALL IO_Field_read(INFILES(1)%TFILE,'DTCUR',TDTCUR,IRESP2)
   ! Outfiles
   !
   IF (runmode == MODELFI2CDF .OR. runmode == MODECDF2CDF) THEN
         KNFILES_OUT = KNFILES_OUT + 1
         CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,HOUTFILE,'MNH','WRITE', &
         CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
           outfiles(idx)%tfile%LNCCOMPRESS       = .TRUE.
           outfiles(idx)%tfile%NNCCOMPRESS_LEVEL = options(OPTCOMPRESS)%ivalue
           outfiles(idx)%tfile%LNCREDUCE_FLOAT_PRECISION = .TRUE.
         status = NF90_SET_FILL(outfiles(idx)%TFILE%NNCID,NF90_NOFILL,omode)
         IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
       END IF ! .NOT.osplit
       KNFILES_OUT = KNFILES_OUT + 1
       idx = KNFILES_OUT
       CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,houtfile,'MNH','WRITE', &
       LIOCDF4 = .FALSE. !Necessary to open correctly the LFI file
       CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
   END IF
   !
   ! Create a dummy netCDF file necessary to manage correctly the netCDF dims
   IF (runmode == MODECDF2LFI) THEN
     KNFILES_OUT = KNFILES_OUT + 1
     CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,'dummy_file','MNH','WRITE', &
                           HFORMAT='NETCDF4',OOLD=.TRUE.)
     CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
   PRINT *,'--> Converted to file: ', TRIM(houtfile)

  END SUBROUTINE OPEN_FILES
  SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,KNFILES_OUT,houtfile,nbvar,options)
    USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST

    TYPE(TFILE_ELT),DIMENSION(:),  INTENT(INOUT) :: outfiles
    INTEGER,                       INTENT(OUT)   :: KNFILES_OUT
    CHARACTER(LEN=*),              INTENT(IN)    :: houtfile
    INTEGER,                       INTENT(IN)    :: nbvar
    TYPE(option),DIMENSION(:),     INTENT(IN)    :: options
    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')

    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
    idx2 = INDEX(YLIST,'=')
    IF (idx2>0) THEN
      YVARS(nbvar) = YLIST(1:idx2-1)
    ELSE
      YVARS(nbvar) = YLIST
    END IF
      filename = trim(houtfile)//'.'//TRIM(YVARS(ji))
      CALL IO_FILE_ADD2LIST(outfiles(ji)%TFILE,filename,'MNH','WRITE', &
      CALL IO_FILE_OPEN(outfiles(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
        outfiles(ji)%tfile%LNCCOMPRESS       = .TRUE.
        outfiles(ji)%tfile%NNCCOMPRESS_LEVEL = options(OPTCOMPRESS)%ivalue
        outfiles(ji)%tfile%LNCREDUCE_FLOAT_PRECISION = .TRUE.
      status = NF90_SET_FILL(outfiles(ji)%TFILE%NNCID,NF90_NOFILL,omode)
      IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
    END DO

  END SUBROUTINE OPEN_SPLIT_NCFILES_OUT
  SUBROUTINE CLOSE_FILES(filelist,KNFILES)
    TYPE(TFILE_ELT),DIMENSION(:),INTENT(INOUT) :: filelist
    INTEGER,                     INTENT(IN)    :: KNFILES
    CALL PRINT_MSG(NVERB_DEBUG,'IO','CLOSE_FILES','called')

      IF (filelist(ji)%TFILE%LOPENED) CALL IO_FILE_CLOSE(filelist(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
  END SUBROUTINE CLOSE_FILES
  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

    CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Metadata_get_nc4','called')
    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)
      !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 = ''
  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

    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_Dims_fill_nc4','called')
    IF (TPREC%NDIMS_FILE<TPREC%TFIELD%NDIMS) THEN
      CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dims_fill_nc4','less dimensions than expected for '//TRIM(TPREC%TFIELD%CMNHNAME)// &
                                        ' => ignored')
      TPREC%tbw   = .FALSE.
      TPREC%tbr   = .FALSE.
      TPREC%found = .FALSE.
      RETURN
    END IF

    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_Dim_find_byname_nc4(TPFILE,TPREC%CDIMNAMES_FILE(JJ),TPREC%TDIMS(JJ),KRESP)
      !If dimension not found => create it
      IF (KRESP/=0)  THEN
        TZDIMPTR => IO_Dimcdf_get_nc4(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 MODULE mode_util