FV3 Bundle
mpp_write_compressed.h File Reference

Go to the source code of this file.

Functions

************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), 1) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), size(data, 2) *size(data, 3)) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) ::cdata MPP_TYPE_, allocatable, dimension(:,:) ::sbuff, rbuff MPP_TYPE_ ::fill MPP_TYPE_ ::sbuff1D(size(data)) MPP_TYPE_ ::rbuff1D(size(data, 2) *sum(nelems_io(:))) pointer(sptr, sbuff1D);pointer(rptr, rbuff1D) integer, allocatable ::pelist(:) integer, allocatable ::nz_gather(:) integer ::i, j, nz, nelems, mynelems, idx, npes type(domain2d), pointer ::io_domain=> NULL () call mpp_clock_begin(mpp_write_clock) if(.NOT.module_is_initialized) call mpp_error(FATAL
 
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), 1) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), size(data, 2) *size(data, 3)) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) ::cdata MPP_TYPE_, allocatable, dimension(:,:) ::sbuff, rbuff MPP_TYPE_ ::fill MPP_TYPE_ ::sbuff1D(size(data)) MPP_TYPE_ ::rbuff1D(size(data, 2) *sum(nelems_io(:))) pointer(sptr, sbuff1D);pointer(rptr, rbuff1D) integer, allocatable ::pelist(:) integer, allocatable ::nz_gather(:) integer ::i, j, nz, nelems, mynelems, idx, npes type(domain2d), pointer ::io_domain=> pelist concise unpack do mynelems do nz sbuff (i, j)
 
only root needs to know the vector of recv size nz do nelems cdata (i, j)
 

Variables

************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If not
 
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), 1) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), size(data, 2) *size(data, 3)) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) ::cdata MPP_TYPE_, allocatable, dimension(:,:) ::sbuff, rbuff MPP_TYPE_ ::fill MPP_TYPE_ ::sbuff1D(size(data)) MPP_TYPE_ ::rbuff1D(size(data, 2) *sum(nelems_io(:))) pointer(sptr, sbuff1D);pointer(rptr, rbuff1D) integer, allocatable ::pelist(:) integer, allocatable ::nz_gather(:) integer ::i, j, nz, nelems, mynelems, idx, npes type(domain2d), pointer ::io_domain=> MPP_WRITE_COMPRESSED_2D_
 
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), 1) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), size(data, 2) *size(data, 3)) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) ::cdata MPP_TYPE_, allocatable, dimension(:,:) ::sbuff, rbuff MPP_TYPE_ ::fill MPP_TYPE_ ::sbuff1D(size(data)) MPP_TYPE_ ::rbuff1D(size(data, 2) *sum(nelems_io(:))) pointer(sptr, sbuff1D);pointer(rptr, rbuff1D) integer, allocatable ::pelist(:) integer, allocatable ::nz_gather(:) integer ::i, j, nz, nelems, mynelems, idx, npes type(domain2d), pointer ::io_domain=> pelist mynelems
 
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), 1) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), size(data, 2) *size(data, 3)) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) ::cdata MPP_TYPE_, allocatable, dimension(:,:) ::sbuff, rbuff MPP_TYPE_ ::fill MPP_TYPE_ ::sbuff1D(size(data)) MPP_TYPE_ ::rbuff1D(size(data, 2) *sum(nelems_io(:))) pointer(sptr, sbuff1D);pointer(rptr, rbuff1D) integer, allocatable ::pelist(:) integer, allocatable ::nz_gather(:) integer ::i, j, nz, nelems, mynelems, idx, npes type(domain2d), pointer ::io_domain=> pelist concise unpack do j =1
 
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), 1) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), size(data, 2) *size(data, 3)) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) ::cdata MPP_TYPE_, allocatable, dimension(:,:) ::sbuff, rbuff MPP_TYPE_ ::fill MPP_TYPE_ ::sbuff1D(size(data)) MPP_TYPE_ ::rbuff1D(size(data, 2) *sum(nelems_io(:))) pointer(sptr, sbuff1D);pointer(rptr, rbuff1D) integer, allocatable ::pelist(:) integer, allocatable ::nz_gather(:) integer ::i, j, nz, nelems, mynelems, idx, npes type(domain2d), pointer ::io_domain=> pelist concise unpack do mynelems do i =1
 
enddo ! Note that the gatherV implied here is asymmetric
 
only root needs to know the vector of recv size sptr
 
enddo ! cludge for now
 

Function Documentation

◆ cdata()

only root needs to know the vector of recv size nz do nelems cdata ( i  ,
j   
)

◆ NULL()

*********************************************************************** * GNU Lesser General Public License* * This file is part of the GFDL Flexible Modeling System (FMS). !* !* FMS is free software without even the implied warranty of MERCHANTABILITY or* FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License* for more details* * You should have received a copy of the GNU Lesser General Public* License along with FMS If see<http:!*********************************************************************** subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:) integer, intent(in) :: nelems_io(:) ! number of compressed elements real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data MPP_TYPE_ :: data2D(size(data,1),1) pointer( ptr, data2D ) ptr = LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:,:,:) integer, intent(in) :: nelems_io(:) ! number of compressed elements real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data MPP_TYPE_ :: data2D(size(data,1),size(data,2)*size(data,3)) pointer( ptr, data2D ) ptr = LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:,:) integer, intent(in) :: nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) :: cdata MPP_TYPE_, allocatable, dimension(:,:) :: sbuff,rbuff MPP_TYPE_ :: fill MPP_TYPE_ :: sbuff1D(size(data)) MPP_TYPE_ :: rbuff1D(size(data,2)*sum(nelems_io(:))) pointer(sptr,sbuff1D); pointer(rptr,rbuff1D) integer, allocatable :: pelist(:) integer, allocatable :: nz_gather(:) integer :: i,j,nz,nelems,mynelems,idx,npes type(domain2d), pointer :: io_domain=> NULL ( )

◆ sbuff()

*********************************************************************** * GNU Lesser General Public License* * This file is part of the GFDL Flexible Modeling System (FMS). !* !* FMS is free software without even the implied warranty of MERCHANTABILITY or* FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License* for more details* * You should have received a copy of the GNU Lesser General Public* License along with FMS If see<http:!*********************************************************************** subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:) integer, intent(in) :: nelems_io(:) ! number of compressed elements real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data MPP_TYPE_ :: data2D(size(data,1),1) pointer( ptr, data2D ) ptr = LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:,:,:) integer, intent(in) :: nelems_io(:) ! number of compressed elements real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data MPP_TYPE_ :: data2D(size(data,1),size(data,2)*size(data,3)) pointer( ptr, data2D ) ptr = LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:,:) integer, intent(in) :: nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) :: cdata MPP_TYPE_, allocatable, dimension(:,:) :: sbuff,rbuff MPP_TYPE_ :: fill MPP_TYPE_ :: sbuff1D(size(data)) MPP_TYPE_ :: rbuff1D(size(data,2)*sum(nelems_io(:))) pointer(sptr,sbuff1D); pointer(rptr,rbuff1D) integer, allocatable :: pelist(:) integer, allocatable :: nz_gather(:) integer :: i,j,nz,nelems,mynelems,idx,npes type(domain2d), pointer :: io_domain=> pelist concise unpack do mynelems do nz sbuff ( i  ,
j   
)

Variable Documentation

◆ asymmetric

enddo ! Note that the gatherV implied here is asymmetric

Definition at line 112 of file mpp_write_compressed.h.

◆ i

only root needs to know the vector of recv size nz do i =1

Definition at line 108 of file mpp_write_compressed.h.

◆ j

*********************************************************************** * GNU Lesser General Public License* * This file is part of the GFDL Flexible Modeling System (FMS). !* !* FMS is free software without even the implied warranty of MERCHANTABILITY or* FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License* for more details* * You should have received a copy of the GNU Lesser General Public* License along with FMS If see<http:!*********************************************************************** subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:) integer, intent(in) :: nelems_io(:) ! number of compressed elements real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data MPP_TYPE_ :: data2D(size(data,1),1) pointer( ptr, data2D ) ptr = LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:,:,:) integer, intent(in) :: nelems_io(:) ! number of compressed elements real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data MPP_TYPE_ :: data2D(size(data,1),size(data,2)*size(data,3)) pointer( ptr, data2D ) ptr = LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:,:) integer, intent(in) :: nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) :: cdata MPP_TYPE_, allocatable, dimension(:,:) :: sbuff,rbuff MPP_TYPE_ :: fill MPP_TYPE_ :: sbuff1D(size(data)) MPP_TYPE_ :: rbuff1D(size(data,2)*sum(nelems_io(:))) pointer(sptr,sbuff1D); pointer(rptr,rbuff1D) integer, allocatable :: pelist(:) integer, allocatable :: nz_gather(:) integer :: i,j,nz,nelems,mynelems,idx,npes type(domain2d), pointer :: io_domain=> pelist concise unpack do j =1

Definition at line 107 of file mpp_write_compressed.h.

◆ MPP_WRITE_COMPRESSED_2D_

*********************************************************************** * GNU Lesser General Public License* * This file is part of the GFDL Flexible Modeling System (FMS). !* !* FMS is free software without even the implied warranty of MERCHANTABILITY or* FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License* for more details* * You should have received a copy of the GNU Lesser General Public* License along with FMS If see<http:!*********************************************************************** subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:) integer, intent(in) :: nelems_io(:) ! number of compressed elements real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data MPP_TYPE_ :: data2D(size(data,1),1) pointer( ptr, data2D ) ptr = LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:,:,:) integer, intent(in) :: nelems_io(:) ! number of compressed elements real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data MPP_TYPE_ :: data2D(size(data,1),size(data,2)*size(data,3)) pointer( ptr, data2D ) ptr = LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:,:) integer, intent(in) :: nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) :: cdata MPP_TYPE_, allocatable, dimension(:,:) :: sbuff,rbuff MPP_TYPE_ :: fill MPP_TYPE_ :: sbuff1D(size(data)) MPP_TYPE_ :: rbuff1D(size(data,2)*sum(nelems_io(:))) pointer(sptr,sbuff1D); pointer(rptr,rbuff1D) integer, allocatable :: pelist(:) integer, allocatable :: nz_gather(:) integer :: i,j,nz,nelems,mynelems,idx,npes type(domain2d), pointer :: io_domain=> MPP_WRITE_COMPRESSED_2D_

Definition at line 80 of file mpp_write_compressed.h.

◆ mynelems

*********************************************************************** * GNU Lesser General Public License* * This file is part of the GFDL Flexible Modeling System (FMS). !* !* FMS is free software without even the implied warranty of MERCHANTABILITY or* FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License* for more details* * You should have received a copy of the GNU Lesser General Public* License along with FMS If see<http:!*********************************************************************** subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:) integer, intent(in) :: nelems_io(:) ! number of compressed elements real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data MPP_TYPE_ :: data2D(size(data,1),1) pointer( ptr, data2D ) ptr = LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:,:,:) integer, intent(in) :: nelems_io(:) ! number of compressed elements real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data MPP_TYPE_ :: data2D(size(data,1),size(data,2)*size(data,3)) pointer( ptr, data2D ) ptr = LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) :: unit type(fieldtype), intent(inout) :: field type(domain2D), intent(inout) :: domain MPP_TYPE_, intent(inout) :: data(:,:) integer, intent(in) :: nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional :: tstamp MPP_TYPE_, intent(in), optional :: default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) :: cdata MPP_TYPE_, allocatable, dimension(:,:) :: sbuff,rbuff MPP_TYPE_ :: fill MPP_TYPE_ :: sbuff1D(size(data)) MPP_TYPE_ :: rbuff1D(size(data,2)*sum(nelems_io(:))) pointer(sptr,sbuff1D); pointer(rptr,rbuff1D) integer, allocatable :: pelist(:) integer, allocatable :: nz_gather(:) integer :: i,j,nz,nelems,mynelems,idx,npes type(domain2d), pointer :: io_domain=> pelist mynelems
Initial value:
= size(data,1)
nz = size(data,2)
nelems = sum(nelems_io(:))
! Check that nz is consistent across all PEs in io_domain
allocate(nz_gather(npes))
call mpp_gather((/nz/), nz_gather, pelist)
if ( mpp_file(unit)%write_on_this_pe.and.maxloc(nz_gather,1).ne.minloc(nz_gather,1) ) then
call mpp_error( FATAL, 'MPP_WRITE_COMPRESSED_2D_: size(data,2) must be consistent across all PEs in io_domain' )
deallocate(nz_gather)
if(mpp_file(unit)%write_on_this_pe ) allocate(rbuff(nz,nelems))
allocate(sbuff(nz,mynelems))
! this matrix inversion makes for easy gather to the IO root
! and a clear
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> unit
int npes
Definition: threadloc.c:26
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT end
integer, parameter, public nelems
l_size ! loop over number of fields ke do je do ie to je n if(.NOT. d_comm%R_do_buf(list)) cycle from_pe
l_size ! loop over number of fields ke do je do ie to is
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> mpp_file(unit)%id
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call mpp_error(FATAL, 'MPP_TRANSMIT:you cannot transmit to ANY_PE using MPI.') else if(to_pe.NE.NULL_PE) then !no other valid cases except NULL_PE call mpp_error(FATAL
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), 1) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), size(data, 2) *size(data, 3)) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) ::cdata MPP_TYPE_, allocatable, dimension(:,:) ::sbuff, rbuff MPP_TYPE_ ::fill MPP_TYPE_ ::sbuff1D(size(data)) MPP_TYPE_ ::rbuff1D(size(data, 2) *sum(nelems_io(:))) pointer(sptr, sbuff1D);pointer(rptr, rbuff1D) integer, allocatable ::pelist(:) integer, allocatable ::nz_gather(:) integer ::i, j, nz, nelems, mynelems, idx, npes type(domain2d), pointer ::io_domain=> MPP_WRITE_COMPRESSED_2D_
type(field_def), target, save root
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> tlevel if(PRESENT(start_in) .AND. PRESENT(axsiz_in)) then if(size(start(! the data domain and compute domain must refer to the subdomain being passed ! In this ! since that attempts to gather all data on PE size(field%axes(:)) axsiz(i)
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT get_len end if return end subroutine MPP_TRANSMIT_ ! MPP_BROADCAST ! subroutine but that doesn t allow !broadcast to a subset of PEs This version and mpp_transmit will remain !backward compatible intent(inout) a
integer, dimension(:), allocatable pelist
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), 1) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), size(data, 2) *size(data, 3)) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) ::cdata MPP_TYPE_, allocatable, dimension(:,:) ::sbuff, rbuff MPP_TYPE_ ::fill MPP_TYPE_ ::sbuff1D(size(data)) MPP_TYPE_ ::rbuff1D(size(data, 2) *sum(nelems_io(:))) pointer(sptr, sbuff1D);pointer(rptr, rbuff1D) integer, allocatable ::pelist(:) integer, allocatable ::nz_gather(:) integer ::i, j, nz, nelems, mynelems, idx, npes type(domain2d), pointer ::io_domain=> pelist concise unpack do mynelems do nz sbuff(i, j)
integer, parameter nz
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), 1) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), size(data, 2) *size(data, 3)) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) ::cdata MPP_TYPE_, allocatable, dimension(:,:) ::sbuff, rbuff MPP_TYPE_ ::fill MPP_TYPE_ ::sbuff1D(size(data)) MPP_TYPE_ ::rbuff1D(size(data, 2) *sum(nelems_io(:))) pointer(sptr, sbuff1D);pointer(rptr, rbuff1D) integer, allocatable ::pelist(:) integer, allocatable ::nz_gather(:) integer ::i, j, nz, nelems, mynelems, idx, npes type(domain2d), pointer ::io_domain=> pelist mynelems

Definition at line 91 of file mpp_write_compressed.h.

◆ not

*********************************************************************** * GNU Lesser General Public License* * This file is part of the GFDL Flexible Modeling System (FMS). !* !* FMS is free software without even the implied warranty of MERCHANTABILITY or* FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License* for more details* * You should have received a copy of the GNU Lesser General Public* License along with FMS If not

Definition at line 4 of file mpp_write_compressed.h.

◆ now

enddo ! cludge for now

Definition at line 125 of file mpp_write_compressed.h.

◆ sptr

only root needs to know the vector of recv size sptr
Initial value:
= LOC(sbuff)
rptr = 0
if(mpp_file(unit)%write_on_this_pe ) rptr = LOC(rbuff)
call mpp_gather(sbuff1D,size(sbuff),rbuff1D,nz*nelems_io(:),pelist)
if(mpp_file(unit)%write_on_this_pe ) then
allocate(cdata(nelems,nz))
do j=1
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> unit
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), 1) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), size(data, 2) *size(data, 3)) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) ::cdata MPP_TYPE_, allocatable, dimension(:,:) ::sbuff, rbuff MPP_TYPE_ ::fill MPP_TYPE_ ::sbuff1D(size(data)) MPP_TYPE_ ::rbuff1D(size(data, 2) *sum(nelems_io(:))) pointer(sptr, sbuff1D);pointer(rptr, rbuff1D) integer, allocatable ::pelist(:) integer, allocatable ::nz_gather(:) integer ::i, j, nz, nelems, mynelems, idx, npes type(domain2d), pointer ::io_domain=> pelist concise unpack do j
integer, parameter, public nelems
only root needs to know the vector of recv size nz do nelems cdata(i, j)
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> mpp_file(unit)%id
logical, pointer fill
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> tlevel if(PRESENT(start_in) .AND. PRESENT(axsiz_in)) then if(size(start(! the data domain and compute domain must refer to the subdomain being passed ! In this ! since that attempts to gather all data on PE size(field%axes(:)) axsiz(i)
integer, dimension(:), allocatable pelist
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_COMPRESSED_1D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), 1) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_1D_ subroutine MPP_WRITE_COMPRESSED_3D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data MPP_TYPE_ ::data2D(size(data, 1), size(data, 2) *size(data, 3)) pointer(ptr, data2D) ptr=LOC(data) call mpp_write_compressed(unit, field, domain, data2D, nelems_io, tstamp, default_data) return end subroutine MPP_WRITE_COMPRESSED_3D_ subroutine MPP_WRITE_COMPRESSED_2D_(unit, field, domain, data, nelems_io, tstamp, default_data) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:,:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. real, intent(in), optional ::tstamp MPP_TYPE_, intent(in), optional ::default_data!cdata is used to store the io-domain compressed data MPP_TYPE_, allocatable, dimension(:,:) ::cdata MPP_TYPE_, allocatable, dimension(:,:) ::sbuff, rbuff MPP_TYPE_ ::fill MPP_TYPE_ ::sbuff1D(size(data)) MPP_TYPE_ ::rbuff1D(size(data, 2) *sum(nelems_io(:))) pointer(sptr, sbuff1D);pointer(rptr, rbuff1D) integer, allocatable ::pelist(:) integer, allocatable ::nz_gather(:) integer ::i, j, nz, nelems, mynelems, idx, npes type(domain2d), pointer ::io_domain=> pelist concise unpack do mynelems do nz sbuff(i, j)
integer, parameter nz

Definition at line 113 of file mpp_write_compressed.h.