FV3 Bundle
Functions | Variables
mpp_do_redistribute.h File Reference

Go to the source code of this file.

Functions

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
 

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_DO_REDISTRIBUTE_3D_(f_in, f_out, d_comm, d_type) integer(LONG_KIND), intent(in) ::f_in(:), f_out(:) type(DomainCommunicator2D), intent(in) ::d_comm MPP_TYPE_, intent(in) ::d_type MPP_TYPE_ ::field_in(d_comm%domain_in%x(1)%data%begin:d_comm%domain_in%x(1)%data%end, &d_comm%domain_in%y(1)%data%begin:d_comm%domain_in%y(1)%data%end, d_comm%ke) pointer(ptr_field_in, field_in) MPP_TYPE_ ::field_out(d_comm%domain_out%x(1)%data%begin:d_comm%domain_out%x(1)%data%end, &d_comm%domain_out%y(1)%data%begin:d_comm%domain_out%y(1)%data%end, d_comm%ke) pointer(ptr_field_out, field_out) type(domain2D), pointer ::domain_in, domain_out integer ::i, j, k, l, n, l_size integer ::is, ie, js, je integer ::ke integer ::list, pos, msgsize integer ::to_pe, from_pe MPP_TYPE_ ::buffer(size(mpp_domains_stack(:))) pointer(ptr, buffer) integer ::buffer_pos, wordlen, errunit!fix ke errunit=stderr() l_size=size(f_out(:)) ! equal to size(f_in(:)) ke=d_comm%ke domain_in=> d_comm domain_in
 
 domain_out
 
 ie
 
 je
 
l_size ! loop over number of fields ptr_field_in
 
l_size ! loop over number of fields ke do j = js
 
l_size ! loop over number of fields ke do je do i = is
 
l_size ! loop over number of fields ke do je do ie pos
 
l_size ! loop over number of fields ke do je do ie pe
 
l_size ! loop over number of fields ke do je do ie to PE
 
l_size ! loop over number of fields ke do je do ie to to_pe
 
l_size ! loop over number of fields ke do je do ie to is
 
l_size ! loop over number of fields ke do je do ie to js
 
l_size ! loop over number of fields ke do je do ie to je msgsize
 
from from_pe
 
from je l_size ! loop over number of in out fields ptr_field_out
 

Function Documentation

◆ if()

l_size ! loop over number of fields ke do je do ie to je n if ( .NOT. d_comm%  R_do_buflist)
Here is the caller graph for this function:

Variable Documentation

◆ domain_in

*********************************************************************** * 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_DO_REDISTRIBUTE_3D_( f_in, f_out, d_comm, d_type ) integer(LONG_KIND), intent(in) :: f_in(:), f_out(:) type(DomainCommunicator2D), intent(in) :: d_comm MPP_TYPE_, intent(in) :: d_type MPP_TYPE_ :: field_in(d_comm%domain_in%x(1)%data%begin:d_comm%domain_in%x(1)%data%end, & d_comm%domain_in%y(1)%data%begin:d_comm%domain_in%y(1)%data%end,d_comm%ke) pointer( ptr_field_in, field_in) MPP_TYPE_ :: field_out(d_comm%domain_out%x(1)%data%begin:d_comm%domain_out%x(1)%data%end, & d_comm%domain_out%y(1)%data%begin:d_comm%domain_out%y(1)%data%end,d_comm%ke) pointer( ptr_field_out, field_out) type(domain2D), pointer :: domain_in, domain_out integer :: i, j, k, l, n, l_size integer :: is, ie, js, je integer :: ke integer :: list, pos, msgsize integer :: to_pe, from_pe MPP_TYPE_ :: buffer(size(mpp_domains_stack(:))) pointer( ptr, buffer ) integer :: buffer_pos, wordlen, errunit!fix ke errunit = stderr() l_size = size(f_out(:)) ! equal to size(f_in(:)) ke = d_comm%ke domain_in => d_comm domain_in

Definition at line 4 of file mpp_do_redistribute.h.

◆ domain_out

domain_out
Initial value:
=>d_comm%domain_out
buffer_pos = 0
ptr = LOC(mpp_domains_stack)
wordlen = size(TRANSFER(buffer(1),mpp_domains_stack))
!pre-post recv
n = d_comm%Rlist_size
do list = 0,n-1
if( .NOT. d_comm%R_do_buf(list) )cycle
from_pe = d_comm%cfrom_pe(list)
msgsize = d_comm%R_msize(list)*l_size
call mpp_recv( buffer(buffer_pos+1), glen=msgsize, from_pe=from_pe, block=.FALSE., tag=COMM_TAG_1 )
buffer_pos = buffer_pos + msgsize
enddo
!send
n = d_comm%Slist_size
do list = 0,n-1
if( .NOT. d_comm%S_do_buf(list) )cycle
to_pe = d_comm%cto_pe(list)
is=d_comm%sendis(1,list)
crtm_lowfrequency_mwssem::n
integer n
Definition: CRTM_LowFrequency_MWSSEM.f90:172
mpp_parameter_mod::recv
integer, parameter recv
Definition: mpp_parameter.F90:99
from_pe
from from_pe
Definition: mpp_do_redistribute.h:93
mpp_parameter_mod::send
integer, parameter send
Definition: mpp_parameter.F90:99
to_pe
l_size ! loop over number of fields ke do je do ie to to_pe
Definition: mpp_do_redistribute.h:72
domain_out
domain_out
Definition: mpp_do_redistribute.h:43
is
l_size ! loop over number of fields ke do je do ie to is
Definition: mpp_do_redistribute.h:72
msgsize
l_size ! loop over number of fields ke do je do ie to je msgsize
Definition: mpp_do_redistribute.h:79
size
************************************************************************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)
mpp_domains_mod::d_comm
type(domaincommunicator2d), dimension(:), allocatable, target, save d_comm
Definition: mpp_domains.F90:656

Definition at line 43 of file mpp_do_redistribute.h.

◆ from_pe

from from_pe

Definition at line 93 of file mpp_do_redistribute.h.

◆ i

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

Definition at line 71 of file mpp_do_redistribute.h.

◆ ie

from ie
Initial value:
=d_comm%sendie(1,list)
js=d_comm%sendjs(1,list)
mpp_domains_mod::d_comm
type(domaincommunicator2d), dimension(:), allocatable, target, save d_comm
Definition: mpp_domains.F90:656
js
l_size ! loop over number of fields ke do je do ie to js
Definition: mpp_do_redistribute.h:72

Definition at line 64 of file mpp_do_redistribute.h.

◆ is

from is

Definition at line 72 of file mpp_do_redistribute.h.

◆ j

from je l_size ! loop over number of in out fields ke do j = js

Definition at line 70 of file mpp_do_redistribute.h.

◆ je

from je
Initial value:
=d_comm%sendje(1,list)
pos = buffer_pos
do l=1
mpp_domains_mod::d_comm
type(domaincommunicator2d), dimension(:), allocatable, target, save d_comm
Definition: mpp_domains.F90:656
pos
l_size ! loop over number of fields ke do je do ie pos
Definition: mpp_do_redistribute.h:72

Definition at line 65 of file mpp_do_redistribute.h.

◆ js

from js

Definition at line 72 of file mpp_do_redistribute.h.

◆ msgsize

l_size ! loop over number of fields ke do je do ie to je msgsize
Initial value:
= pos - buffer_pos
call mpp_send( buffer(buffer_pos+1), plen=msgsize, to_pe=to_pe, tag=COMM_TAG_1 )
buffer_pos = pos
end do
call mpp_sync_self(check=EVENT_RECV)
!unpack buffer
buffer_pos = 0
n = d_comm%Rlist_size
do list = 0
crtm_lowfrequency_mwssem::n
integer n
Definition: CRTM_LowFrequency_MWSSEM.f90:172
end
************************************************************************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
Definition: mpp_transmit_mpi.h:153
to_pe
l_size ! loop over number of fields ke do je do ie to to_pe
Definition: mpp_do_redistribute.h:72
msgsize
l_size ! loop over number of fields ke do je do ie to je msgsize
Definition: mpp_do_redistribute.h:79
fv3jedi_increment_mod::check
subroutine check(self)
Definition: fv3jedi_increment_mod.f90:1932
mpp_domains_mod::d_comm
type(domaincommunicator2d), dimension(:), allocatable, target, save d_comm
Definition: mpp_domains.F90:656
pos
l_size ! loop over number of fields ke do je do ie pos
Definition: mpp_do_redistribute.h:72

Definition at line 79 of file mpp_do_redistribute.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_do_redistribute.h.

◆ pe

nlist My domain from pe
Initial value:
=", &
domain%list(m)%pe, ":send size = ", msg1(m), "
mpp_parameter_mod::send
integer, parameter send
Definition: mpp_parameter.F90:99
size
************************************************************************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)

Definition at line 72 of file mpp_do_redistribute.h.

◆ PE

from PE

Definition at line 72 of file mpp_do_redistribute.h.

◆ pos

from je pos
Initial value:
= pos+1
buffer(pos) = field_in(i,j,k)
end do
end do
end do
end do
if( debug )write( errunit,* )'PE'
i
l_size ! loop over number of fields ke do je do i
Definition: mpp_do_redistribute.h:71
end
************************************************************************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
Definition: mpp_transmit_mpi.h:153
j
l_size ! loop over number of fields ke do j
Definition: mpp_do_redistribute.h:70
mpp_mod::debug
logical debug
Definition: mpp.F90:1297
gsw_mod_sp_coefficients::k
real(r8), parameter k
Definition: gsw_mod_sp_coefficients.f90:40
pos
l_size ! loop over number of fields ke do je do ie pos
Definition: mpp_do_redistribute.h:72

Definition at line 72 of file mpp_do_redistribute.h.

◆ ptr_field_in

l_size ! loop over number of fields ptr_field_in
Initial value:
= f_in(l)
do k = 1
gsw_mod_sp_coefficients::k
real(r8), parameter k
Definition: gsw_mod_sp_coefficients.f90:40

Definition at line 68 of file mpp_do_redistribute.h.

◆ ptr_field_out

from je l_size ! loop over number of in out fields ptr_field_out
Initial value:
= f_out(l)
do k = 1
gsw_mod_sp_coefficients::k
real(r8), parameter k
Definition: gsw_mod_sp_coefficients.f90:40

Definition at line 97 of file mpp_do_redistribute.h.

◆ to_pe

l_size ! loop over number of fields ke do je do ie to to_pe

Definition at line 72 of file mpp_do_redistribute.h.