! $Id: ESMF_Array_C.F90,v 1.3 2011/06/30 18:45:48 w6ws Exp $ ! ! Earth System Modeling Framework ! Copyright 2002-2011, University Corporation for Atmospheric Research, ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics ! Laboratory, University of Michigan, National Centers for Environmental ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, ! NASA Goddard Space Flight Center. ! Licensed under the University of Illinois-NCSA License. ! !============================================================================== ! ! F77 interface files for C++ layer calling into F90 implementation layer. ! This cannot use any F90 syntax, including modules, or allocatable ! arrays, or ... ! !============================================================================== #define ESMF_FILENAME "ESMF_Array_C.F90" ! !------------------------------------------------------------------------------ ! INCLUDES #include "ESMF.h" !============================================================================== !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. ! character(*), parameter, private :: version = & ! '$Id: ESMF_Array_C.F90,v 1.3 2011/06/30 18:45:48 w6ws Exp $' !============================================================================== #undef ESMF_METHOD #define ESMF_METHOD "f_esmf_arrayread" subroutine f_esmf_arrayread(array, file, variableName, & timeslice, iofmt, rc) use ESMF_UtilTypesMod use ESMF_BaseMod use ESMF_LogErrMod use ESMF_ArraySpecMod use ESMF_LocalArrayMod use ESMF_VMMod use ESMF_ArrayCreateMod use ESMF_ArrayGetMod use ESMF_ArrayIOMod implicit none !------------------------------------------------------------------------------ !arguments type(ESMF_Array), intent(inout) :: array character(*), intent(in) :: file character(*), intent(in), optional :: variableName integer, intent(in), optional :: timeslice type(ESMF_IOFmtFlag), intent(in), optional :: iofmt integer, intent(out), optional :: rc ! ! ! Local vars integer :: localrc ! local return code integer :: localtk integer :: rank character(len=80) :: varname type(ESMF_IOFmtFlag) :: iofmt_internal character(len=10) :: piofmt integer :: time type(ESMF_TypeKind_Flag) :: typekind ! Initialize return code; assume routine not implemented localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL #ifdef ESMF_PIO ! Handle IO format iofmt_internal = ESMF_IOFMT_NETCDF ! default format if (present(iofmt)) iofmt_internal = iofmt time = 0 if(present(timeslice)) time = timeslice if (iofmt_internal == ESMF_IOFMT_NETCDF) then ! NETCDF format selected #ifdef ESMF_PNETCDF piofmt = "pnc" ! PNETCDF first choice to write NETCDF format #elif ESMF_NETCDF piofmt = "snc" ! serial NETCDF second choice to write NETCDF format #else call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, & msg="ESMF must be compiled with NETCDF or PNETCDF support for this format choice", & ESMF_CONTEXT, rcToReturn=rc) return #endif else if (iofmt_internal == ESMF_IOFMT_BIN) then #ifdef ESMF_MPIIO ! binary format selected piofmt = "bin" if (present(variableName)) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, & msg="The input argument variableName cannot be sepcified in ESMF_IOFMT_BIN mode", & ESMF_CONTEXT, rcToReturn=rc) return endif #else call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, & msg="ESMF must be compiled with an MPI that implements MPI-IO to support this format choice", & ESMF_CONTEXT, rcToReturn=rc) return #endif else ! format option that is not supported call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, & msg="this format is not currently supported by the ESMF IO layer", & ESMF_CONTEXT, rcToReturn=rc) return endif ! ! Obtain typekind and rank call ESMF_ArrayGet( array, typekind=typekind, rank=rank, name=varname, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if(present(variableName)) varname = variableName ! Call a T/K/R specific interface in order to create the proper ! type of F90 pointer, allocate the space, set the values in the ! Array object, and return. (The routine this code is calling is ! generated by macro.) localtk = typekind%dkind !! calling routines generated from macros by the preprocessor select case (localtk) ! case (ESMF_TYPEKIND_I4%dkind) ! The PIO data type is PIO_int select case(rank) case (1) call ESMF_ArrayReadIntl1DI4(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (2) call ESMF_ArrayReadIntl2DI4(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (3) call ESMF_ArrayReadIntl3DI4(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (4) call ESMF_ArrayReadIntl4DI4(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (5) call ESMF_ArrayReadIntl5DI4(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case default call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, msg="Unsupported rank", & ESMF_CONTEXT, rcToReturn=rc) return end select case (ESMF_TYPEKIND_R4%dkind) select case(rank) ! The PIO data type is PIO_real case (1) call ESMF_ArrayReadIntl1DR4(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (2) call ESMF_ArrayReadIntl2DR4(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (3) call ESMF_ArrayReadIntl3DR4(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (4) call ESMF_ArrayReadIntl4DR4(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (5) call ESMF_ArrayReadIntl5DR4(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case default call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, msg="Unsupported rank", & ESMF_CONTEXT, rcToReturn=rc) return end select case (ESMF_TYPEKIND_R8%dkind) ! The PIO data type is PIO_double select case(rank) case (1) call ESMF_ArrayReadIntl1DR8(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (2) call ESMF_ArrayReadIntl2DR8(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (3) call ESMF_ArrayReadIntl3DR8(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (4) call ESMF_ArrayReadIntl4DR8(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (5) call ESMF_ArrayReadIntl5DR8(array, file, varname, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case default call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, msg="Unsupported rank", & ESMF_CONTEXT, rcToReturn=rc) return end select case default call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, msg="Unsupported typekind", & ESMF_CONTEXT, rcToReturn=rc) return end select ! Return successfully if (present(rc)) rc = ESMF_SUCCESS #else ! Return indicating PIO not present call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, & msg="ESMF must be compiled with PIO support to support I/O methods", & ESMF_CONTEXT, rcToReturn=rc) #endif end subroutine f_esmf_arrayread !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "f_esmf_arraywrite" subroutine f_esmf_arraywrite(array, file, & variableName, append, timeslice, iofmt, rc) use ESMF_UtilTypesMod use ESMF_BaseMod use ESMF_LogErrMod use ESMF_ArraySpecMod use ESMF_LocalArrayMod use ESMF_VMMod use ESMF_ArrayCreateMod use ESMF_ArrayGetMod use ESMF_ArrayIOMod implicit none !------------------------------------------------------------------------------ !arguments type(ESMF_Array), intent(inout) :: array character(*), intent(in) :: file character(*), intent(in), optional :: variableName logical, intent(in), optional :: append integer, intent(in), optional :: timeslice type(ESMF_IOFmtFlag), intent(in), optional :: iofmt integer, intent(out), optional :: rc !------------------------------------------------------------------------------ ! Local vars integer :: localrc ! local return code integer :: localtk integer :: rank, time logical :: appd_internal character(len=80) :: varname type(ESMF_IOFmtFlag) :: iofmt_internal character(len=10) :: piofmt type(ESMF_TypeKind_Flag) :: typekind ! Initialize return code; assume routine not implemented localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL #ifdef ESMF_PIO ! Handle IO format iofmt_internal = ESMF_IOFMT_NETCDF ! default format if (present(iofmt)) iofmt_internal = iofmt if (iofmt_internal .eq. ESMF_IOFMT_NETCDF) then ! NETCDF format selected #ifdef ESMF_PNETCDF piofmt = "pnc" ! PNETCDF first choice to write NETCDF format #elif ESMF_NETCDF piofmt = "snc" ! serial NETCDF second choice to write NETCDF format #else call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, & msg="ESMF must be compiled with NETCDF or PNETCDF support for this format choice", & ESMF_CONTEXT, rcToReturn=rc) return #endif else if (iofmt_internal == ESMF_IOFMT_NETCDF4P) then ! NETCDF format selected #ifdef ESMF_NETCDF piofmt = "nc4p" ! parallel read/write of NETCDF4 (HDF5) files #else call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, & msg= "ESMF must be compiled with NETCDF support for this format choice", & ESMF_CONTEXT, rcToReturn=rc) return #endif else if (iofmt_internal == ESMF_IOFMT_NETCDF4C) then ! NETCDF format selected #ifdef ESMF_NETCDF piofmt = "nc4c" ! parallel read/serial write of NetCDF4 (HDF5) ! files with data compression #else call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, & msg="ESMF must be compiled with NETCDF support for this format choice", & ESMF_CONTEXT, rcToReturn=rc) return #endif else if (iofmt_internal == ESMF_IOFMT_BIN) then #ifdef ESMF_MPIIO ! binary format selected piofmt = "bin" if (present(variableName)) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, & msg="The input argument variableName cannot be sepcified in ESMF_IOFMT_BIN mode", & ESMF_CONTEXT, rcToReturn=rc) return endif if (present(timeslice)) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, & msg="The input argument timeslice cannot be sepcified in ESMF_IOFMT_BIN mode", & ESMF_CONTEXT, rcToReturn=rc) return endif #else call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, & msg="ESMF must be compiled with an MPI that implements MPI-IO to support this format choice", & ESMF_CONTEXT, rcToReturn=rc) return #endif else ! format option that is not supported call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, & msg="this format is not currently supported by the ESMF IO layer", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Handle time dimension time = -1 ! default, no time dimension if (present(timeslice)) time = timeslice ! ! Obtain typekind and rank call ESMF_ArrayGet( array, typekind=typekind, rank=rank, name=varname, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if(present(variableName)) varname = variableName appd_internal = .false. if(present(append)) appd_internal = append ! Call a T/K/R specific interface in order to create the proper ! type of F90 pointer, allocate the space, set the values in the ! Array object, and return. (The routine this code is calling is ! generated by macro.) localtk = typekind%dkind !! calling routines generated from macros by the preprocessor select case (localtk) ! case (ESMF_TYPEKIND_I4%dkind) ! The PIO data type is PIO_int select case(rank) case (1) call ESMF_ArrayWriteIntl1DI4(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (2) call ESMF_ArrayWriteIntl2DI4(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (3) call ESMF_ArrayWriteIntl3DI4(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (4) call ESMF_ArrayWriteIntl4DI4(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (5) call ESMF_ArrayWriteIntl5DI4(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case default call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, msg="Unsupported rank", & ESMF_CONTEXT, rcToReturn=rc) return end select case (ESMF_TYPEKIND_R4%dkind) ! The PIO data type is PIO_real select case(rank) case (1) call ESMF_ArrayWriteIntl1DR4(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (2) call ESMF_ArrayWriteIntl2DR4(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (3) call ESMF_ArrayWriteIntl3DR4(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (4) call ESMF_ArrayWriteIntl4DR4(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (5) call ESMF_ArrayWriteIntl5DR4(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case default call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, msg="Unsupported rank", & ESMF_CONTEXT, rcToReturn=rc) return end select case (ESMF_TYPEKIND_R8%dkind) ! The PIO data type is PIO_double select case(rank) case (1) call ESMF_ArrayWriteIntl1DR8(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (2) call ESMF_ArrayWriteIntl2DR8(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (3) call ESMF_ArrayWriteIntl3DR8(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (4) call ESMF_ArrayWriteIntl4DR8(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case (5) call ESMF_ArrayWriteIntl5DR8(array, file, varname, appd_internal, time, piofmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return case default call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, msg="Unsupported rank", & ESMF_CONTEXT, rcToReturn=rc) return end select case default call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, msg="Unsupported typekind", & ESMF_CONTEXT, rcToReturn=rc) return end select ! Return successfully if (present(rc)) rc = ESMF_SUCCESS #else ! Return indicating PIO not present call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, & msg="ESMF must be compiled with PIO support to support I/O methods", & ESMF_CONTEXT, rcToReturn=rc) #endif end subroutine f_esmf_arraywrite