#include "ESMFPIO.h" #define __PIO_FILE__ "pionfget_mod.F90" module pionfget_mod #ifdef TIMING use perf_mod, only : t_startf, t_stopf ! _EXTERNAL #endif use pio_msg_mod use pio_kinds, only: i4,r4,r8,pio_offset use pio_types, only : file_desc_t, iosystem_desc_t, var_desc_t, & pio_iotype_pbinary, pio_iotype_binary, pio_iotype_direct_pbinary, & pio_iotype_netcdf, pio_iotype_pnetcdf, pio_iotype_netcdf4p, & pio_iotype_netcdf4c, pio_noerr use pio_utils, only : check_netcdf use pio_support, only : Debug, DebugIO, piodie, CheckMPIReturn #ifdef _NETCDF use netcdf ! _EXTERNAL #endif implicit none private #ifdef _PNETCDF #include /* _EXTERNAL */ #endif include 'mpif.h' ! _EXTERNAL !> !! @defgroup PIO_get_var PIO_get_var !! @brief Reads netcdf metadata from a file !! @details The get_var interface is provided as a simplified interface to !! read variables from a netcdf format file. The variable is read on the !! root IO task and broadcast in its entirety to all tasks. !< public :: get_var interface get_var module procedure get_var_{DIMS}d_{TYPE}, get_var_vdesc_{DIMS}d_{TYPE} ! DIMS 1,2,3,4,5 module procedure get_vara_{DIMS}d_{TYPE}, get_vara_vdesc_{DIMS}d_{TYPE} module procedure get_var1_{TYPE}, get_var1_vdesc_{TYPE} end interface character(len=*), parameter :: modName='pionfget_mod' CONTAINS !> !! @public !! @ingroup PIO_get_var !! @brief Writes an netcdf attribute to a file !! @details !! @param File @copydoc file_desc_t !! @param varid : The netcdf variable identifier !! @param index : !! @param ival : The value for the netcdf metadata !! @retval ierr @copydoc error_return !< integer function get_var1_{TYPE} (File,varid, index, ival) result(ierr) use pio_msg_mod, only : pio_msg_getvar1 type (File_desc_t), intent(in) :: File integer, intent(in) :: varid, index(:) {VTYPE}, intent(out) :: ival type(iosystem_desc_t), pointer :: ios character(len=*), parameter :: subName=modName//'::get_var1_{TYPE}' integer :: iotype, mpierr, ilen, msg #ifdef TIMING call t_startf("pio_get_var1_{TYPE}") #endif ierr=0 iotype = File%iotype ios => File%iosystem if(Debug) print *,__PIO_FILE__,__LINE__,index #if ({ITYPE} == TYPETEXT) ilen = len(ival) ival(1:ilen) = ' ' #else ilen=1 #endif if(ios%async_interface .and. .not. ios%ioproc ) then msg=PIO_MSG_GETVAR1 if(ios%comp_rank==0) call mpi_send(msg, 1, mpi_integer, ios%ioroot, 1, ios%union_comm, ierr) call MPI_BCAST(file%fh,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(varid,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(size(index),1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(index,size(index),MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST({ITYPE},1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) if({ITYPE} == TYPETEXT) then call MPI_BCAST(ilen,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) end if endif if(File%iosystem%IOProc) then select case (iotype) #ifdef _PNETCDF case(pio_iotype_pnetcdf) ierr = nfmpi_begin_indep_data(File%fh) ! Only io proc 0 will do reading if(ierr==PIO_NOERR .and. File%iosystem%io_rank==0) then ierr = nfmpi_get_var1_{TYPE} (File%fh, varid, int(index,kind=PIO_OFFSET), ival) if(ierr/=PIO_NOERR) print *, __PIO_FILE__,__LINE__,index, ival end if if(ierr==PIO_NOERR) then ierr = nfmpi_end_indep_data(File%fh) end if #endif #ifdef _NETCDF case(pio_iotype_netcdf4p, pio_iotype_netcdf4c) ierr = nf90_get_var(File%fh, varid, ival, start=index) case(pio_iotype_netcdf) ! Only io proc 0 will do reading if (File%iosystem%io_rank == 0) then ierr = nf90_get_var(File%fh, varid, ival, start=index) if(ierr/=PIO_NOERR) print *,__PIO_FILE__,__LINE__,index, ival end if #endif end select end if call check_netcdf(File,ierr,__PIO_FILE__,__LINE__) #if ({ITYPE} == TYPETEXT) ilen = len(ival) #else ilen=1 #endif call MPI_Bcast(ival, ilen, {MPITYPE} , File%iosystem%IOMaster, File%iosystem%MY_comm, mpierr) call CheckMPIReturn(subName, mpierr) #ifdef TIMING call t_stopf("pio_get_var1_{TYPE}") #endif end function get_var1_{TYPE} !> !! @public !! @ingroup PIO_get_var !! @brief Writes an netcdf attribute to a file !! @details !! @param File @copydoc file_desc_t !! @param vardesc @copydoc var_desc_t !! @param index : !! @param ival : The value for the netcdf metadata !! @retval ierr @copydoc error_return !< integer function get_var1_vdesc_{TYPE} (File,vardesc, index, ival) result(ierr) type (File_desc_t), intent(in) :: File type(var_desc_t), intent(in) :: vardesc integer, intent(in) :: index(:) {VTYPE}, intent(out) :: ival character(len=*), parameter :: subName=modName//'::get_var1_vdesc_{TYPE}' ierr = get_var1_{TYPE} (File, vardesc%varid, index, ival) end function get_var1_vdesc_{TYPE} ! DIMS 1,2,3,4,5 !> !! @public !! @ingroup PIO_get_var !! @brief Writes an netcdf attribute to a file !! @details !! @param File @copydoc file_desc_t !! @param varid : The netcdf variable identifier !! @param start : !! @param count : !! @param ival : The value for the netcdf metadata !! @retval ierr @copydoc error_return !< integer function get_vara_{DIMS}d_{TYPE} (File,varid, start, count, ival) result(ierr) type (File_desc_t), intent(in) :: File integer, intent(in) :: varid, start(:), count(:) {VTYPE}, intent(out) :: ival{DIMSTR} character(len=*), parameter :: subName=modName//'::get_vara_{DIMS}d_{TYPE}' integer :: dims({DIMS}) integer :: iotype, mpierr, i, msg, ilen integer(kind=PIO_OFFSET) :: isize type(iosystem_desc_t), pointer :: ios #ifdef TIMING call t_startf("pio_get_vara_{DIMS}d_{TYPE}") #endif ierr=0 iotype = File%iotype isize=1 do i=1,size(count) isize=isize*count(i) end do ios=>File%iosystem if(ios%async_interface .and. .not. ios%ioproc ) then msg=PIO_MSG_GETVARA_{DIMS}d if(ios%comp_rank==0) call mpi_send(msg, 1, mpi_integer, ios%ioroot, 1, ios%union_comm, ierr) call MPI_BCAST(file%fh,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(varid,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST({ITYPE},1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(size(start),1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(start,size(start),MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(count,size(start),MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) #if ({DIMS} > 0) do i=1,{DIMS} dims(i)=size(ival,i) end do call MPI_BCAST(dims,{DIMS},MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) #endif #if({ITYPE} == TYPETEXT) call MPI_BCAST(ilen,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) #endif endif if(File%iosystem%IOProc) then select case (iotype) #ifdef _PNETCDF case(pio_iotype_pnetcdf) ierr = nfmpi_get_vara_all (File%fh, varid, int(start,kind=PIO_OFFSET), & int(count,kind=PIO_OFFSET), ival, isize, {MPITYPE}) #endif #ifdef _NETCDF case(pio_iotype_netcdf4p, pio_iotype_netcdf4c) ierr = nf90_get_var(File%fh, varid, ival, start=start, count=count) case(pio_iotype_netcdf) ! Only io proc 0 will do reading if (File%iosystem%io_rank == 0) then ierr = nf90_get_var(File%fh, varid, ival, start=start, count=count) end if if(.not. ios%async_interface .and. ios%num_tasks==ios%num_iotasks) then call MPI_BCAST(ival,int(isize), {MPITYPE} ,0,ios%IO_comm, mpierr) call CheckMPIReturn(subName,mpierr) end if #endif end select end if call check_netcdf(File,ierr,__PIO_FILE__,__LINE__) if(ios%async_interface .or. ios%num_tasks>ios%num_iotasks) then call MPI_Bcast(ival,int(isize), {MPITYPE} , ios%IOMaster, ios%My_comm, mpierr) call CheckMPIReturn(subName, mpierr) end if #ifdef TIMING call t_stopf("pio_get_vara_{DIMS}d_{TYPE}") #endif end function get_vara_{DIMS}d_{TYPE} ! DIMS 1,2,3,4,5 !> !! @public !! @ingroup PIO_get_var !! @brief Writes an netcdf attribute to a file !! @details !! @param File @copydoc file_desc_t !! @param vardesc @copydoc var_desc_t !! @param start : !! @param count : !! @param ival : The value for the netcdf metadata !! @retval ierr @copydoc error_return !< integer function get_vara_vdesc_{DIMS}d_{TYPE} (File,vardesc, start, count, ival) result(ierr) type (File_desc_t), intent(in) :: File type(var_desc_t), intent(in) :: vardesc integer, intent(in) :: start(:), count(:) {VTYPE}, intent(out) :: ival{DIMSTR} character(len=*), parameter :: subName=modName//'::get_vara_vdesc_{DIMS}d_{TYPE}' ierr = get_vara_{DIMS}d_{TYPE} (File, vardesc%varid, start, count, ival) end function get_vara_vdesc_{DIMS}d_{TYPE} !> !! @public !! @ingroup PIO_get_var !! @brief Writes an netcdf attribute to a file !! @details !! @param File @copydoc file_desc_t !! @param varid : The netcdf variable identifier !! @param ival : The value for the netcdf metadata !! @retval ierr @copydoc error_return !< integer function get_var_{DIMS}d_{TYPE} (File,varid, ival) result(ierr) use pio_msg_mod, only : pio_msg_getvar_{DIMS}d type (File_desc_t), intent(in) :: File integer, intent(in) :: varid {VTYPE}, intent(out) :: ival{DIMSTR} type(iosystem_desc_t), pointer :: ios character(len=*), parameter :: subName=modName//'::get_var_{DIMS}d_{TYPE}' integer :: iotype, mpierr, msg, ilen #if ({DIMS} > 0) integer :: dims({DIMS}) integer :: i #endif integer(kind=PIO_OFFSET) :: isize #ifdef TIMING call t_startf("pio_get_var_{DIMS}d_{TYPE}") #endif ierr=0 iotype = File%iotype isize=1 #if ({DIMS} > 0) isize= size(ival) #endif #if ({ITYPE} == TYPETEXT) ilen = len(ival) isize = isize*ilen ival{DIMSTR} = ' ' #endif ios=>File%iosystem if(ios%async_interface .and. .not. ios%ioproc ) then msg=PIO_MSG_GETVAR_{DIMS}d if(ios%comp_rank==0) call mpi_send(msg, 1, mpi_integer, ios%ioroot, 1, ios%union_comm, ierr) call MPI_BCAST(file%fh,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(varid,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST({ITYPE},1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) #if ({DIMS} > 0) do i=1,{DIMS} dims(i)=size(ival,i) end do call MPI_BCAST(dims,{DIMS},MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) #endif #if({ITYPE} == TYPETEXT) call MPI_BCAST(ilen,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) #endif endif if(File%iosystem%IOProc) then select case (iotype) #ifdef _PNETCDF case(pio_iotype_pnetcdf) ierr = nfmpi_get_var_all(File%fh, varid, ival, isize, {MPITYPE}) #endif #ifdef _NETCDF case(pio_iotype_netcdf4p, pio_iotype_netcdf4c) ierr = nf90_get_var(File%fh, varid, ival) case(pio_iotype_netcdf) ! Only io proc 0 will do reading if (File%iosystem%io_rank == 0) then ierr = nf90_get_var(File%fh, varid, ival) end if if(.not. ios%async_interface .and. ios%num_tasks==ios%num_iotasks) then call MPI_BCAST(ival,int(isize), {MPITYPE} ,0,ios%IO_comm, mpierr) call CheckMPIReturn('nf_mod',mpierr) end if #endif end select end if call check_netcdf(File,ierr,__PIO_FILE__,__LINE__) if(ios%async_interface .or. ios%num_tasks>ios%num_iotasks) then call MPI_Bcast(ival,int(isize), {MPITYPE} , ios%IOMaster, ios%My_comm, mpierr) call CheckMPIReturn(subName, mpierr) end if #ifdef TIMING call t_stopf("pio_get_var_{DIMS}d_{TYPE}") #endif end function get_var_{DIMS}d_{TYPE} !> !! @public !! @ingroup PIO_get_var !! @brief Writes an netcdf attribute to a file !! @details !! @param File @copydoc file_desc_t !! @param vardesc @copydoc var_desc_t !! @param ival : The value for the netcdf metadata !! @retval ierr @copydoc error_return !< integer function get_var_vdesc_{DIMS}d_{TYPE} (File,vardesc, ival) result(ierr) type (File_desc_t), intent(in) :: File type(var_desc_t), intent(in) :: vardesc {VTYPE}, intent(out) :: ival{DIMSTR} character(len=*), parameter :: subName=modName//'::get_var_vdesc_{DIMS}d_{TYPE}' ierr = get_var_{DIMS}d_{TYPE} (File, vardesc%varid, ival) end function get_var_vdesc_{DIMS}d_{TYPE} end module pionfget_mod