FV3 Bundle
mpp_do_update_ad.h File Reference

Go to the source code of this file.

Functions

*f90 *************************************************************************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_UPDATE_AD_3D_(f_addrs, domain, update, d_type, ke, flags)!updates data domain of 3D field whose computational domains have been computed integer(LONG_KIND), intent(in) ::f_addrs(:,:) type(domain2D), intent(in) ::domain type(overlapSpec), intent(in) ::update MPP_TYPE_, intent(in) ::d_type ! creates unique interface integer, intent(in) ::ke integer, optional, intent(in) ::flags MPP_TYPE_ ::field(update%xbegin:update%xend, update%ybegin:update%yend, ke) pointer(ptr_field, field) integer ::update_flags type(overlap_type), pointer ::overPtr=> NULL () character(len
 
nlist if (msg1(m) .NE. msg2(m)) then print *
 

Variables

*f90 *************************************************************************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
 
 ie
 
 je
 
update nsend overPtr
 
nlist My pe = ", mpp_pe(), "
 
nlist My domain name =", trim(domain%name), "
 

Function Documentation

◆ if()

nlist if ( msg1(m) .NE. msg2(m)  )

◆ NULL()

* f90* *********************************************************************** * 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_UPDATE_AD_3D_( f_addrs, domain, update, d_type, ke, flags)!updates data domain of 3D field whose computational domains have been computed integer(LONG_KIND), intent(in) :: f_addrs(:,:) type(domain2D), intent(in) :: domain type(overlapSpec), intent(in) :: update MPP_TYPE_, intent(in) :: d_type ! creates unique interface integer, intent(in) :: ke integer, optional, intent(in) :: flags MPP_TYPE_ :: field(update%xbegin:update%xend, update%ybegin:update%yend,ke) pointer(ptr_field, field) integer :: update_flags type(overlap_type), pointer :: overPtr => NULL ( )

Variable Documentation

◆ ie

ie
Initial value:
update nsend overPtr
l_size ! loop over number of fields ke do je do ie to js

Definition at line 94 of file mpp_do_update_ad.h.

◆ je

je
Initial value:
msgsize = msgsize + (ie-is+1)*(je-js+1)
end do
from_pe = update%recv(m)%pe
l = from_pe-mpp_root_pe()
call mpp_recv( msg1(l), glen=1, from_pe=from_pe, block=.FALSE., tag=COMM_TAG_1 )
msg2(l) = msgsize
enddo
do m = 1
update nsend overPtr
integer, parameter recv
************************************************************************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
from from_pe
integer, parameter m
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 je msgsize
nlist if(msg1(m) .NE. msg2(m)) then print *
nlist My pe
l_size ! loop over number of fields ke do je do ie to js

Definition at line 95 of file mpp_do_update_ad.h.

◆ name

nlist My domain name =", trim(domain%name), "

Definition at line 122 of file mpp_do_update_ad.h.

◆ not

* f90* *********************************************************************** * 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 7 of file mpp_do_update_ad.h.

◆ overPtr

update nsend overPtr
Initial value:
=> update%send(m)
msgsize = 0
do n = 1, overPtr%count
dir = overPtr%dir(n)
if(send(dir)) then
update nsend overPtr
integer, parameter send
integer, parameter m
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 je msgsize

Definition at line 106 of file mpp_do_update_ad.h.

◆ pe

nlist My domain from pe = ", mpp_pe(), "

Definition at line 122 of file mpp_do_update_ad.h.