#define __PIO_FILE__ "pionfget_mod.F90" !> !! @file !! $Revision: 925 $ !! $LastChangedDate: 2014-01-25 04:55:17 +0800 (Sat, 25 Jan 2014) $ !! @brief Read Routines for non-decomposed NetCDF data. !< 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 #ifndef NO_MPIMOD use mpi ! _EXTERNAL #endif #ifdef USE_PNETCDF_MOD use pnetcdf #endif implicit none private #ifdef _PNETCDF #ifndef USE_PNETCDF_MOD #include /* _EXTERNAL */ #endif #endif #ifdef NO_MPIMOD include 'mpif.h' ! _EXTERNAL #endif !> !! @defgroup PIO_get_var PIO_get_var !! @brief Reads non-decomposed data from a NetCDF 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 Reads non-decomposed fields from a NetCDF file !! @details !! @param File @ref file_desc_t !! @param varid : The netcdf variable identifier !! @param index : a multidimensional index that specifies which value to get !! @param ival : The value for the netcdf metadata !! @retval ierr @ref error_return !< integer function get_var1_{TYPE} (File,varid, index, ival) result(ierr) use pio_msg_mod, only : pio_msg_getvar1 use pio_types, only : pio_max_var_dims 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, sofindex, itype integer(kind=pio_offset) :: kount(PIO_MAX_VAR_DIMS) #ifdef TIMING call t_startf("pio_get_var1_{TYPE}") #endif ierr=0 iotype = File%iotype ios => File%iosystem sofindex = size(index) #if ({ITYPE} == TYPETEXT) ilen = len(ival) ival(1:ilen) = ' ' #else ilen=1 #endif if(Debug) print *,__PIO_FILE__,__LINE__,index, ilen 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(sofindex,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(index,sofindex,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) itype = {ITYPE} 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 #if ({ITYPE} == TYPETEXT) kount = 1 kount(1) = ilen ierr = nfmpi_get_vara_{TYPE} (File%fh, varid, int(index,kind=PIO_OFFSET), kount(1:sofindex), ival) #else ierr = nfmpi_get_var1_{TYPE} (File%fh, varid, int(index,kind=PIO_OFFSET), ival) #endif 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) ierr = nf90_get_var(File%fh, varid, ival, start=index) case(pio_iotype_netcdf, pio_iotype_netcdf4c) ! 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 @ref file_desc_t !! @param vardesc @ref var_desc_t !! @param index : a multidimensional index that specifies which value to get !! @param ival : The value for the netcdf metadata !! @retval ierr @ref 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 @ref file_desc_t !! @param varid : The netcdf variable identifier !! @param start : A vector of size_t integers specifying the index in !! the variable where the first of the data values will be read. The !! indices are relative to 0, so for example, the first data value of !! a variable would have index (0, 0, ... , 0). The length of start !! must be the same as the number of dimensions of the specified !! variable. The elements of start correspond, in order, to the !! variable's dimensions. Hence, if the variable is a record variable, !! the first index would correspond to the starting record number for !! reading the data values. !! @param count : A vector of size_t integers specifying the edge !! lengths along each dimension of the block of data values to be !! read. To read a single value, for example, specify count as (1, 1, !! ... , 1). The length of count is the number of dimensions of the !! specified variable. The elements of count correspond, in order, to !! the variable's dimensions. Hence, if the variable is a record !! variable, the first element of count corresponds to a count of the !! number of records to read. !! Note: setting any element of the count array to zero causes the function to exit without error, and without doing anything. !! @param ival : The value for the netcdf metadata !! @retval ierr @ref 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, itype, slen 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) itype = {ITYPE} call MPI_BCAST(itype,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) slen = size(start) call MPI_BCAST(slen,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(start,slen,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(count,slen,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) ierr = nf90_get_var(File%fh, varid, ival, start=start, count=count) case(pio_iotype_netcdf, pio_iotype_netcdf4c) ! 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 @ref file_desc_t !! @param vardesc @ref var_desc_t !! @param start : A vector of size_t integers specifying the index in !! the variable where the first of the data values will be read. The !! indices are relative to 0, so for example, the first data value of !! a variable would have index (0, 0, ... , 0). The length of start !! must be the same as the number of dimensions of the specified !! variable. The elements of start correspond, in order, to the !! variable's dimensions. Hence, if the variable is a record variable, !! the first index would correspond to the starting record number for !! reading the data values. !! @param count : A vector of size_t integers specifying the edge !! lengths along each dimension of the block of data values to be !! read. To read a single value, for example, specify count as (1, 1, !! ... , 1). The length of count is the number of dimensions of the !! specified variable. The elements of count correspond, in order, to !! the variable's dimensions. Hence, if the variable is a record !! variable, the first element of count corresponds to a count of the !! number of records to read. !! Note: setting any element of the count array to zero causes the function to exit without error, and without doing anything. !! @param ival : The value for the netcdf metadata !! @retval ierr @ref 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 @ref file_desc_t !! @param varid : The netcdf variable identifier !! @param ival : The value for the netcdf metadata !! @retval ierr @ref 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, itype #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) itype = {ITYPE} 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) ierr = nf90_get_var(File%fh, varid, ival) case(pio_iotype_netcdf, pio_iotype_netcdf4c) ! 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 @ref file_desc_t !! @param vardesc @ref var_desc_t !! @param ival : The value for the netcdf metadata !! @retval ierr @ref 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