#define __PIO_FILE__ "pionfatt_mod.F90" module pionfatt_mod use pio_kinds, only : r4, r8, i4 use pio_types, only : iotype_netcdf, iotype_pnetcdf, pio_noerr use pio_types, only : pio_iotype_netcdf4p, pio_iotype_netcdf4c use pio_types, only : file_desc_t, var_desc_t, iosystem_desc_t use pio_kinds, only : pio_offset use pio_support, only : piodie, checkmpireturn, debug, debugasync use pio_utils, only : check_netcdf, bad_iotype #ifdef _NETCDF use netcdf ! _EXTERNAL #endif implicit none #ifdef _PNETCDF # include /* _EXTERNAL */ #endif include 'mpif.h' ! _EXTERNAL !> !! @private !< public :: put_att interface put_att module procedure put_att_{TYPE}, put_att_desc_{TYPE} ! TYPE real,int,double module procedure put_att_1d_{TYPE}, put_att_desc_1d_{TYPE} end interface !> !! @private !< public :: get_att interface get_att module procedure get_att_{TYPE}, get_att_desc_{TYPE} ! TYPE real,int,double module procedure get_att_1d_{TYPE}, get_att_desc_1d_{TYPE} end interface !> !! @public !! @defgroup PIO_put_att PIO_put_att !! @brief Writes an netcdf attribute to a file !< !> !! @public !! @defgroup PIO_get_att PIO_get_att !! @brief Reads an netcdf attribute from a file !< private :: modName character(len=*), parameter :: modName='pionfatt_mod' contains !> !! @public !! @ingroup PIO_put_att !! @brief Writes an netcdf attribute to a file !! @details !! @param File @copydoc file_desc_t !! @param varid : The netcdf variable identifier !! @param name : name of the attribute to add !! @param value : The value for the netcdf attribute !! @retval ierr @copydoc error_return !< integer function put_att_{TYPE} (File, varid, name, value) result(ierr) use pio_msg_mod, only : pio_msg_putatt type (File_desc_t), intent(inout) , target :: File integer, intent(in) :: varid character(len=*), intent(in) :: name {VTYPE}, intent(in) :: value type(iosystem_desc_t), pointer :: ios #if ({ITYPE} != TYPETEXT) #ifdef DEBUG {VTYPE} :: chkval #endif #endif !------------------ ! Local variables !------------------ character(len=*), parameter :: subName=modName//'::put_att_{TYPE}' integer :: iotype, mpierr, msg integer :: clen=1 iotype = File%iotype ierr=PIO_noerr #if ({ITYPE} == TYPETEXT) clen = len(value) #else clen = 1 #endif ios => file%iosystem if(ios%async_interface .and. .not. ios%ioproc ) then msg=PIO_MSG_PUTATT 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(len(name),1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(name,len(name),MPI_CHARACTER,ios%CompMaster, ios%my_comm , mpierr) #if ({ITYPE} == TYPETEXT) call MPI_BCAST(clen,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) #endif end if if(ios%async_interface) then call MPI_BCAST(value, clen, {MPITYPE}, ios%compmaster, ios%my_comm, mpierr) end if if(Ios%IOproc) then select case(iotype) #ifdef _PNETCDF case(iotype_pnetcdf) #if ({ITYPE} == TYPETEXT) clen = len(value) ierr= nfmpi_put_att_text (File%fh,varid,name,int(clen,kind=PIO_OFFSET),value) #else #ifdef DEBUG print *, __PIO_FILE__,__LINE__,value call MPI_ALLREDUCE(value, chkval, 1, {MPITYPE}, MPI_MAX ,Ios%io_comm, mpierr) call CheckMPIReturn(subName, mpierr) if(chkval /= value) then print *,__PIO_FILE__,__LINE__,chkval,value, mpierr call piodie(__PIO_FILE__,__LINE__,'attributes do not match') end if #endif #undef DEBUG ierr= nfmpi_put_att_{TYPE} (File%fh,varid,name, nf_{TYPE} , int(clen,kind=PIO_OFFSET),value) #endif #endif #ifdef _NETCDF case(iotype_netcdf,PIO_iotype_netcdf4c) if (Ios%io_rank==0) then ierr=nf90_put_att(File%fh,varid,name,value) endif case(PIO_iotype_netcdf4p) ierr=nf90_put_att(File%fh,varid,name,value) #endif case default call bad_iotype(iotype,__PIO_FILE__,__LINE__) end select endif call check_netcdf(File, ierr,__PIO_FILE__,__LINE__) end function put_att_{TYPE} !pl The next line is needed by genf90.pl, do not remove it. ! TYPE real,double,int !> !! @public !! @ingroup PIO_put_att !! @brief Writes an netcdf attribute to a file !! @details !! @param File @copydoc file_desc_t !! @param varid : The netcdf variable identifier !! @param name : name of the attribute to add !! @param value : The value for the netcdf attribute !! @retval ierr @copydoc error_return !< integer function put_att_1d_{TYPE} (File, varid, name, value) result(ierr) use pio_msg_mod, only : pio_msg_putatt_1D type (File_desc_t), intent(inout) , target :: File integer, intent(in) :: varid character(len=*), intent(in) :: name {VTYPE}, intent(in) :: value(:) type(iosystem_desc_t), pointer :: ios #ifdef DEBUG {VTYPE} :: chkval #endif !------------------ ! Local variables !------------------ character(len=*), parameter :: subName=modName//'::put_att_1d_{TYPE}' integer :: iotype, mpierr, msg integer :: clen iotype = File%iotype ierr=PIO_noerr clen = size(value) ios => file%iosystem if(ios%async_interface .and. .not. ios%ioproc ) then msg=PIO_MSG_PUTATT_1D 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(len(name),1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(name,len(name),MPI_CHARACTER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(clen,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) end if call mpi_barrier(ios%union_comm, mpierr) if(ios%async_interface) then call MPI_BCAST(value, clen, {MPITYPE}, ios%compmaster, ios%my_comm, mpierr) end if if(Debug.or.DebugAsync) print *,__PIO_FILE__,__LINE__,clen,value if(Ios%IOproc) then select case(iotype) #ifdef _PNETCDF case(iotype_pnetcdf) #ifdef DEBUG print *, __PIO_FILE__,__LINE__,value call MPI_ALLREDUCE(value, chkval, 1, {MPITYPE}, MPI_MAX ,Ios%io_comm, mpierr) call CheckMPIReturn(subName, mpierr) if(chkval /= value) then print *,__PIO_FILE__,__LINE__,chkval,value, mpierr call piodie(__PIO_FILE__,__LINE__,'attributes do not match') end if #endif #undef DEBUG ierr= nfmpi_put_att_{TYPE} (File%fh,varid,name, nf_{TYPE} , int(clen,kind=PIO_OFFSET),value) #endif #ifdef _NETCDF case(iotype_netcdf, PIO_iotype_netcdf4c) if (Ios%io_rank==0) then ierr=nf90_put_att(File%fh,varid,name,value) endif case(pio_iotype_netcdf4p) ierr=nf90_put_att(File%fh,varid,name,value) #endif case default call bad_iotype(iotype,__PIO_FILE__,__LINE__) end select endif call check_netcdf(File, ierr,__PIO_FILE__,__LINE__) end function put_att_1d_{TYPE} !> !! @public !! @ingroup PIO_put_att !! @brief Writes an netcdf attribute to a file !! @details !! @param File @copydoc file_desc_t !! @param varDesc @copydoc var_desc_t !! @param name : name of the attribute to add !! @param value : The value for the netcdf attribute !! @retval ierr @copydoc error_return !< integer function put_att_desc_{TYPE} (File,varDesc,name,value) result(ierr) type (File_desc_t), intent(inout) , target :: File type (VAR_desc_t), intent(in) :: varDesc character(len=*), intent(in) :: name {VTYPE}, intent(in) :: value ierr = put_att_{TYPE} (File,varDesc%varid,name,value) end function put_att_desc_{TYPE} ! TYPE real,int,double !> !! @public !! @ingroup PIO_put_att !! @brief Writes an netcdf attribute to a file !! @details !! @param File @copydoc file_desc_t !! @param varDesc @copydoc var_desc_t !! @param name : name of the attribute to add !! @param value : The value for the netcdf attribute !! @retval ierr @copydoc error_return !< integer function put_att_desc_1d_{TYPE} (File,varDesc,name,value) result(ierr) type (File_desc_t), intent(inout) , target :: File type (VAR_desc_t), intent(in) :: varDesc character(len=*), intent(in) :: name {VTYPE}, intent(in) :: value(:) character(len=*), parameter :: subName=modName//'::put_att_desc_1d_{TYPE}' ierr = put_att_1d_{TYPE} (File,varDesc%varid,name,value) end function put_att_desc_1d_{TYPE} !> !! @public !! @ingroup PIO_get_att !! @brief Reads an netcdf attribute from a file !! @details !! @param File @copydoc file_desc_t !! @param varDesc @copydoc var_desc_t !! @param name : name of the attribute to get !! @param value : The value for the netcdf attribute !! @retval ierr @copydoc error_return !< integer function get_att_desc_{TYPE} (File,varDesc,name,value) result(ierr) type (File_desc_t), intent(inout) , target :: File type (VAR_desc_t), intent(in) :: varDesc character(len=*), intent(in) :: name {VTYPE}, intent(out) :: value character(len=*), parameter :: subName=modName//'::get_att_desc_{TYPE}' ierr = get_att_{TYPE} (File,varDesc%varid,name,value) end function get_att_desc_{TYPE} ! TYPE real,int,double !> !! @public !! @ingroup PIO_get_att !! @brief Reads an netcdf attribute from a file !! @details !! @param File @copydoc file_desc_t !! @param varDesc @copydoc var_desc_t !! @param name : name of the attribute to get !! @param value : The value for the netcdf attribute !! @retval ierr @copydoc error_return !< integer function get_att_desc_1d_{TYPE} (File,varDesc,name,value) result(ierr) type (File_desc_t), intent(inout) , target :: File type (VAR_desc_t), intent(in) :: varDesc character(len=*), intent(in) :: name {VTYPE}, intent(out) :: value(:) character(len=*), parameter :: subName=modName//'::get_att_desc_1d_{TYPE}' ierr = get_att_1d_{TYPE} (File,varDesc%varid,name,value) end function get_att_desc_1d_{TYPE} !> !! @public !! @ingroup PIO_get_att !! @brief Reads an netcdf attribute from a file !! @details !! @param File @copydoc file_desc_t !! @param varid : The netcdf variable identifier !! @param name : name of the attribute to get !! @param value : The value for the netcdf attribute !! @retval ierr @copydoc error_return !< integer function get_att_{TYPE} (File,varid,name,value) result(ierr) use pio_msg_mod, only : pio_msg_getatt type (File_desc_t), intent(in) , target :: File integer(i4), intent(in) :: varid character(len=*), intent(in) :: name {VTYPE}, intent(out) :: value type(iosystem_desc_t), pointer :: ios !------------------ ! Local variables !------------------ character(len=*), parameter :: subName=modName//'::get_att_{TYPE}' integer :: iotype, mpierr, msg integer :: clen=1 iotype = File%iotype ierr=PIO_noerr #if ({ITYPE} == TYPETEXT) clen = len(value) value = ' ' #endif ios => file%iosystem if(ios%async_interface .and. .not. ios%ioproc ) then msg=PIO_MSG_GETATT 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(len(name),1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(name,len(name),MPI_CHARACTER,ios%CompMaster, ios%my_comm , mpierr) #if ({ITYPE} == TYPETEXT) call MPI_BCAST(clen,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) #endif end if if(Ios%IOproc) then select case(iotype) #ifdef _PNETCDF case(iotype_pnetcdf) ierr= nfmpi_get_att_{TYPE} (File%fh,varid,name,value) #endif #ifdef _NETCDF case(iotype_netcdf) if (Ios%io_rank==0) then ierr=nf90_get_att(File%fh,varid,name,value) endif if(Ios%num_tasks==Ios%num_iotasks) then call MPI_BCAST(value,clen ,{MPITYPE} ,0,Ios%IO_comm, mpierr) call CheckMPIReturn(subName, mpierr) end if case(PIO_iotype_netcdf4p,PIO_iotype_netcdf4c) ierr=nf90_get_att(File%fh,varid,name,value) #endif case default call bad_iotype(iotype,__PIO_FILE__,__LINE__) end select endif call check_netcdf(File, ierr,__PIO_FILE__,__LINE__) if(ios%async_interface .or. ios%num_tasks>ios%num_iotasks) then call MPI_BCAST(value, clen, {MPITYPE},Ios%iomaster,Ios%my_comm, mpierr) call CheckMPIReturn(subName, mpierr) end if end function get_att_{TYPE} ! TYPE real,int,double !> !! @public !! @ingroup PIO_get_att !! @brief Reads an netcdf attribute from a file !! @details !! @param File @copydoc file_desc_t !! @param varid : The netcdf variable identifier !! @param name : name of the attribute to get !! @param value : The value for the netcdf attribute !! @retval ierr @copydoc error_return !< integer function get_att_1d_{TYPE} (File,varid,name,value) result(ierr) use pio_msg_mod, only : pio_msg_getatt_1d type (File_desc_t), intent(in) , target :: File integer(i4), intent(in) :: varid character(len=*), intent(in) :: name {VTYPE}, intent(out) :: value(:) type(iosystem_desc_t), pointer :: ios !------------------ ! Local variables !------------------ character(len=*), parameter :: subName=modName//'::get_att_1d_{TYPE}' integer :: iotype, mpierr, msg integer :: clen iotype = File%iotype ierr=PIO_noerr clen = size(value) ios => file%iosystem if(ios%async_interface .and. .not. ios%ioproc ) then msg=PIO_MSG_GETATT_1D 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(len(name),1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(name,len(name),MPI_CHARACTER,ios%CompMaster, ios%my_comm , mpierr) call MPI_BCAST(clen,1,MPI_INTEGER,ios%CompMaster, ios%my_comm , mpierr) end if if(Ios%IOproc) then select case(iotype) #ifdef _PNETCDF case(iotype_pnetcdf) ierr= nfmpi_get_att_{TYPE} (File%fh,varid,name,value) #endif #ifdef _NETCDF case(iotype_netcdf) if (Ios%io_rank==0) then ierr=nf90_get_att(File%fh,varid,name,value) endif if(Ios%num_tasks==Ios%num_iotasks) then call MPI_BCAST(value,clen ,{MPITYPE} ,0,Ios%IO_comm, mpierr) call CheckMPIReturn(subName, mpierr) end if case(PIO_iotype_netcdf4p,PIO_iotype_netcdf4c) ierr=nf90_get_att(File%fh,varid,name,value) #endif case default call bad_iotype(iotype,__PIO_FILE__,__LINE__) end select endif call check_netcdf(File, ierr,__PIO_FILE__,__LINE__) if(ios%async_interface .or. ios%num_tasks>ios%num_iotasks) then call MPI_BCAST(value, clen, {MPITYPE},Ios%iomaster,Ios%my_comm, mpierr) call CheckMPIReturn(subName, mpierr) end if end function get_att_1d_{TYPE} end module pionfatt_mod