91 module mpp_domains_mod
 
   93 #if defined(use_libMPI) 
   97   use mpp_parameter_mod,      
only : mpp_debug, mpp_verbose, mpp_domain_time
 
   98   use mpp_parameter_mod,      
only : global_data_domain, cyclic_global_domain, global,cyclic
 
   99   use mpp_parameter_mod,      
only : agrid, bgrid_sw, bgrid_ne, cgrid_ne, cgrid_sw, dgrid_ne, dgrid_sw
 
  100   use mpp_parameter_mod,      
only : fold_west_edge, fold_east_edge, fold_south_edge, fold_north_edge
 
  101   use mpp_parameter_mod,      
only : wupdate, eupdate, supdate, nupdate, xupdate, yupdate
 
  102   use mpp_parameter_mod,      
only : non_bitwise_exact_sum, bitwise_exact_sum, mpp_domain_time
 
  103   use mpp_parameter_mod,      
only : center, corner, scalar_pair, scalar_bit, bitwise_efp_sum
 
  104   use mpp_parameter_mod,      
only : north, north_east, east, south_east
 
  105   use mpp_parameter_mod,      
only : south, south_west, west, north_west
 
  106   use mpp_parameter_mod,      
only : max_domain_fields, null_pe, domain_id_base
 
  107   use mpp_parameter_mod,      
only : zero, ninety, minus_ninety, one_hundred_eighty, max_tiles
 
  108   use mpp_parameter_mod,      
only : event_send, event_recv, root_global
 
  109   use mpp_parameter_mod,      
only : nonblock_update_tag, edgeonly, edgeupdate
 
  110   use mpp_parameter_mod,      
only : nonsymedge, nonsymedgeupdate
 
  111   use mpp_data_mod,           
only : mpp_domains_stack, ptr_domains_stack
 
  112   use mpp_data_mod,           
only : mpp_domains_stack_nonblock, ptr_domains_stack_nonblock
 
  115   use mpp_mod,                
only : 
mpp_clock_id, mpp_clock_begin, mpp_clock_end
 
  120   use mpp_mod,                
only : 
mpp_type, mpp_byte
 
  122   use mpp_mod,                
only : comm_tag_1, comm_tag_2, comm_tag_3, comm_tag_4
 
  131   public :: global_data_domain, cyclic_global_domain, bgrid_ne, bgrid_sw, cgrid_ne, cgrid_sw, agrid
 
  132   public :: dgrid_ne, dgrid_sw, fold_west_edge, fold_east_edge, fold_south_edge, fold_north_edge
 
  133   public :: wupdate, eupdate, supdate, nupdate, xupdate, yupdate
 
  134   public :: non_bitwise_exact_sum, bitwise_exact_sum, mpp_domain_time, bitwise_efp_sum
 
  135   public :: center, corner, scalar_pair
 
  136   public :: north, north_east, east, south_east
 
  137   public :: south, south_west, west, north_west
 
  138   public :: zero, ninety, minus_ninety, one_hundred_eighty
 
  139   public :: edgeupdate, nonsymedgeupdate
 
  142   public :: null_domain1d, null_domain2d
 
  193   public :: mpp_get_ug_domain_npes, mpp_get_ug_compute_domain, mpp_get_ug_domain_tile_id
 
  194   public :: mpp_get_ug_domain_pelist, mpp_get_ug_domain_grid_index
 
  195   public :: mpp_get_ug_domain_ntiles, mpp_get_ug_global_domain
 
  197   public :: mpp_define_null_ug_domain, null_domainug, mpp_get_ug_domains_index
 
  198   public :: mpp_get_ug_sg_domain, mpp_get_ug_domain_tile_pe_inf
 
  203   public :: mpp_get_nest_coarse_domain, mpp_get_nest_fine_domain
 
  204   public :: mpp_is_nest_coarse, mpp_is_nest_fine
 
  205   public :: mpp_get_nest_pelist, mpp_get_nest_npes
 
  206   public :: mpp_get_nest_fine_pelist, mpp_get_nest_fine_npes
 
  210   public :: mpp_domain_ug_is_tile_root_pe
 
  211   public :: mpp_deallocate_domainug
 
  212   public :: mpp_get_io_domain_ug_layout
 
  215   integer, 
parameter :: NAME_LENGTH = 64
 
  216   integer, 
parameter :: MAXLIST = 100
 
  217   integer, 
parameter :: MAXOVERLAP = 200
 
  218   integer, 
parameter :: FIELD_S = 0
 
  219   integer, 
parameter :: FIELD_X = 1
 
  220   integer, 
parameter :: FIELD_Y = 2
 
  230      integer :: begin, end, size, max_size
 
  231      integer :: begin_index, end_index
 
  238      type(unstruct_axis_spec) :: compute
 
  250      integer, 
pointer :: i(:)=>null()
 
  251      integer, 
pointer :: j(:)=>null()
 
  258      integer :: nsend, nrecv
 
  259      type(unstruct_overlap_type), 
pointer :: recv(:)=>null()
 
  260      type(unstruct_overlap_type), 
pointer :: send(:)=>null()
 
  269      type(
domainug), 
pointer :: io_domain=>null() 
 
  272      integer, 
pointer :: grid_index(:) => null() 
 
  273      type(
domain2d), 
pointer :: sg_domain => null()
 
  278      integer :: tile_root_pe
 
  280      integer :: npes_io_group
 
  281      integer(i4_kind) :: io_layout
 
  299      type(domain_axis_spec) :: compute
 
  300      type(domain_axis_spec) :: global
 
  310      integer,        
pointer :: tile_id(:) => null() 
 
  313      integer                 :: tile_root_pe
 
  324      integer ,        
pointer :: msgsize(:)      => null() 
 
  325      integer,         
pointer :: tileme(:)       => null() 
 
  326      integer,         
pointer :: tilenbr(:)      => null() 
 
  327      integer,         
pointer :: is(:)           => null() 
 
  328      integer,         
pointer :: ie(:)           => null() 
 
  329      integer,         
pointer :: js(:)           => null() 
 
  330      integer,         
pointer :: je(:)           => null() 
 
  331      integer,         
pointer :: dir(:)          => null() 
 
  332      integer,         
pointer :: rotation(:)     => null() 
 
  333      integer,         
pointer :: index(:)        => null() 
 
  334      logical,         
pointer :: from_contact(:) => null() 
 
  342      integer                     :: whalo, ehalo, shalo, nhalo
 
  343      integer                     :: xbegin, xend, ybegin, yend
 
  344      integer                     :: nsend, nrecv
 
  345      integer                     :: sendsize, recvsize
 
  354      integer :: xbegin, xend, ybegin, yend
 
  368      character(len=NAME_LENGTH)  :: name=
'unnamed' 
  369      integer(i8_kind)            :: id
 
  374      integer                     :: whalo, ehalo
 
  375      integer                     :: shalo, nhalo
 
  378      integer                     :: tile_comm_id
 
  379      integer                     :: max_ntile_pe
 
  381      logical                     :: rotated_ninety
 
  382      logical                     :: initialized=.false. 
 
  383      integer                     :: tile_root_pe
 
  384      integer                     :: io_layout(2)
 
  386      integer,            
pointer :: pearray(:,:)  => null() 
 
  387      integer,            
pointer :: tile_id(:)    => null() 
 
  388      integer,            
pointer :: tile_id_all(:)=> null() 
 
  419      integer, 
pointer :: tile(:) =>null()                       
 
  420      integer, 
pointer :: align1(:)=>null(), align2(:)=>null()   
 
  421      real,    
pointer :: refine1(:)=>null(), refine2(:)=>null() 
 
  422      integer, 
pointer :: is1(:)=>null(), ie1(:)=>null()         
 
  423      integer, 
pointer :: js1(:)=>null(), je1(:)=>null()         
 
  424      integer, 
pointer :: is2(:)=>null(), ie2(:)=>null()         
 
  425      integer, 
pointer :: js2(:)=>null(), je2(:)=>null()         
 
  431      integer :: is_me, ie_me, js_me, je_me
 
  432      integer :: is_you, ie_you, js_you, je_you
 
  439      integer                     :: xbegin, xend, ybegin, yend
 
  440      integer                     :: xbegin_c, xend_c, ybegin_c, yend_c
 
  441      integer                     :: xbegin_f, xend_f, ybegin_f, yend_f
 
  442      integer                     :: xsize_c, ysize_c
 
  443      type(index_type)            :: west, east, south, north, center
 
  444      integer                     :: nsend, nrecv
 
  445      integer                     :: extra_halo
 
  446      type(overlap_type), 
pointer :: send(:) => null()
 
  447      type(overlap_type), 
pointer :: recv(:) => null()
 
  448      type(nestSpec),     
pointer :: next => null()
 
  455      character(len=NAME_LENGTH)     :: name
 
  457      integer,               
pointer :: nest_level(:) => null() 
 
  460      integer,               
pointer :: tile_fine(:), tile_coarse(:)
 
  461      integer,               
pointer :: istart_fine(:), iend_fine(:), jstart_fine(:), jend_fine(:)
 
  462      integer,               
pointer :: istart_coarse(:), iend_coarse(:), jstart_coarse(:), jend_coarse(:)
 
  470      logical                    :: is_fine, is_coarse
 
  472      integer                    :: my_num_nest
 
  473      integer,           
pointer :: my_nest_id(:)
 
  474      integer,           
pointer :: tile_fine(:), tile_coarse(:)
 
  475      integer,           
pointer :: istart_fine(:), iend_fine(:), jstart_fine(:), jend_fine(:)
 
  476      integer,           
pointer :: istart_coarse(:), iend_coarse(:), jstart_coarse(:), jend_coarse(:)
 
  477      integer                    :: x_refine, y_refine
 
  478      logical                    :: is_fine_pe, is_coarse_pe
 
  479      integer,           
pointer :: pelist(:) => null()
 
  480      integer,           
pointer :: pelist_fine(:) => null()
 
  481      integer,           
pointer :: pelist_coarse(:) => null()
 
  482      type(nestSpec), 
pointer :: C2F_T => null()
 
  483      type(nestSpec), 
pointer :: C2F_C => null()
 
  484      type(nestSpec), 
pointer :: C2F_E => null()
 
  485      type(nestSpec), 
pointer :: C2F_N => null()
 
  486      type(nestSpec), 
pointer :: F2C_T => null()
 
  487      type(nestSpec), 
pointer :: F2C_C => null()
 
  488      type(nestSpec), 
pointer :: F2C_E => null()
 
  489      type(nestSpec), 
pointer :: F2C_N => null()
 
  490      type(domain2d), 
pointer :: domain_fine   => null()
 
  491      type(domain2d), 
pointer :: domain_coarse => null()
 
  499      logical            :: initialized=.false.
 
  500      integer(i8_kind) :: id=-9999
 
  501      integer(i8_kind) :: l_addr  =-9999
 
  502      integer(i8_kind) :: l_addrx =-9999
 
  503      integer(i8_kind) :: l_addry =-9999
 
  504      type(domain2D), 
pointer :: domain     =>null()
 
  505      type(domain2D), 
pointer :: domain_in  =>null()
 
  506      type(domain2D), 
pointer :: domain_out =>null()
 
  507      type(overlapSpec), 
pointer :: send(:,:,:,:) => null()
 
  508      type(overlapSpec), 
pointer :: recv(:,:,:,:) => null()
 
  509      integer, 
dimension(:,:),       
allocatable :: sendis
 
  510      integer, 
dimension(:,:),       
allocatable :: sendie
 
  511      integer, 
dimension(:,:),       
allocatable :: sendjs
 
  512      integer, 
dimension(:,:),       
allocatable :: sendje
 
  513      integer, 
dimension(:,:),       
allocatable :: recvis
 
  514      integer, 
dimension(:,:),       
allocatable :: recvie
 
  515      integer, 
dimension(:,:),       
allocatable :: recvjs
 
  516      integer, 
dimension(:,:),       
allocatable :: recvje
 
  517      logical, 
dimension(:),         
allocatable :: S_do_buf
 
  518      logical, 
dimension(:),         
allocatable :: R_do_buf
 
  519      integer, 
dimension(:),         
allocatable :: cto_pe
 
  520      integer, 
dimension(:),         
allocatable :: cfrom_pe
 
  521      integer, 
dimension(:),         
allocatable :: S_msize
 
  522      integer, 
dimension(:),         
allocatable :: R_msize
 
  523      integer :: Slist_size=0, rlist_size=0
 
  524      integer :: isize=0, jsize=0, ke=0
 
  525      integer :: isize_in=0, jsize_in=0
 
  526      integer :: isize_out=0, jsize_out=0
 
  527      integer :: isize_max=0, jsize_max=0
 
  528      integer :: gf_ioff=0, gf_joff=0
 
  530      integer, 
dimension(:)  , 
allocatable :: isizeR
 
  531      integer, 
dimension(:)  , 
allocatable :: jsizeR
 
  532      integer, 
dimension(:,:), 
allocatable :: sendisR
 
  533      integer, 
dimension(:,:), 
allocatable :: sendjsR
 
  534      integer(i8_kind), 
dimension(:), 
allocatable :: rem_addr
 
  535      integer(i8_kind), 
dimension(:), 
allocatable :: rem_addrx
 
  536      integer(i8_kind), 
dimension(:), 
allocatable :: rem_addry
 
  537      integer(i8_kind), 
dimension(:,:), 
allocatable :: rem_addrl
 
  538      integer(i8_kind), 
dimension(:,:), 
allocatable :: rem_addrlx
 
  539      integer(i8_kind), 
dimension(:,:), 
allocatable :: rem_addrly
 
  543   integer, 
parameter :: max_request = 100
 
  550      integer                         :: recv_msgsize
 
  551      integer                         :: send_msgsize
 
  552      integer                         :: update_flags
 
  553      integer                         :: update_position
 
  554      integer                         :: update_gridtype
 
  555      integer                         :: update_whalo
 
  556      integer                         :: update_ehalo
 
  557      integer                         :: update_shalo
 
  558      integer                         :: update_nhalo
 
  559      integer                         :: request_send_count
 
  560      integer                         :: request_recv_count
 
  561      integer, 
dimension(MAX_REQUEST) :: request_send
 
  562      integer, 
dimension(MAX_REQUEST) :: request_recv
 
  563      integer, 
dimension(MAX_REQUEST) :: size_recv
 
  564      integer, 
dimension(MAX_REQUEST) :: type_recv
 
  565      integer, 
dimension(MAX_REQUEST) :: buffer_pos_send
 
  566      integer, 
dimension(MAX_REQUEST) :: buffer_pos_recv
 
  567      integer(i8_kind)              :: field_addrs(MAX_DOMAIN_FIELDS)
 
  568      integer(i8_kind)              :: field_addrs2(MAX_DOMAIN_FIELDS)
 
  576      logical            :: initialized = .false.
 
  577      logical            :: k_loop_inside = .true.
 
  578      logical            :: nonsym_edge = .false.
 
  579      integer            :: nscalar = 0
 
  580      integer            :: nvector = 0
 
  581      integer            :: flags_s=0, flags_v=0
 
  582      integer            :: whalo_s=0, ehalo_s=0, shalo_s=0, nhalo_s=0
 
  583      integer            :: isize_s=0, jsize_s=0, ksize_s=1
 
  584      integer            :: whalo_v=0, ehalo_v=0, shalo_v=0, nhalo_v=0
 
  585      integer            :: isize_x=0, jsize_x=0, ksize_v=1
 
  586      integer            :: isize_y=0, jsize_y=0
 
  587      integer            :: position=0, gridtype=0
 
  588      logical            :: recv_s(8), recv_x(8), recv_y(8)
 
  589      integer            :: is_s=0, ie_s=0, js_s=0, je_s=0
 
  590      integer            :: is_x=0, ie_x=0, js_x=0, je_x=0
 
  591      integer            :: is_y=0, ie_y=0, js_y=0, je_y=0
 
  592      integer            :: nrecv=0, nsend=0
 
  593      integer            :: npack=0, nunpack=0
 
  594      integer            :: reset_index_s = 0
 
  595      integer            :: reset_index_v = 0
 
  596      integer            :: tot_msgsize = 0
 
  597      integer            :: from_pe(MAXOVERLAP)
 
  598      integer            :: to_pe(MAXOVERLAP)
 
  599      integer            :: recv_size(MAXOVERLAP)
 
  600      integer            :: send_size(MAXOVERLAP)
 
  601      integer            :: buffer_pos_recv(MAXOVERLAP)
 
  602      integer            :: buffer_pos_send(MAXOVERLAP)
 
  603      integer            :: pack_type(MAXOVERLAP)
 
  604      integer            :: pack_buffer_pos(MAXOVERLAP)
 
  605      integer            :: pack_rotation(MAXOVERLAP)
 
  606      integer            :: pack_size(MAXOVERLAP)
 
  607      integer            :: pack_is(MAXOVERLAP)
 
  608      integer            :: pack_ie(MAXOVERLAP)
 
  609      integer            :: pack_js(MAXOVERLAP)
 
  610      integer            :: pack_je(MAXOVERLAP)
 
  611      integer            :: unpack_type(MAXOVERLAP)
 
  612      integer            :: unpack_buffer_pos(MAXOVERLAP)
 
  613      integer            :: unpack_rotation(MAXOVERLAP)
 
  614      integer            :: unpack_size(MAXOVERLAP)
 
  615      integer            :: unpack_is(MAXOVERLAP)
 
  616      integer            :: unpack_ie(MAXOVERLAP)
 
  617      integer            :: unpack_js(MAXOVERLAP)
 
  618      integer            :: unpack_je(MAXOVERLAP)
 
  619      integer(i8_kind) :: addrs_s(MAX_DOMAIN_FIELDS)
 
  620      integer(i8_kind) :: addrs_x(MAX_DOMAIN_FIELDS)
 
  621      integer(i8_kind) :: addrs_y(MAX_DOMAIN_FIELDS)
 
  622      integer            :: buffer_start_pos = -1
 
  623      integer            :: request_send(MAX_REQUEST)
 
  624      integer            :: request_recv(MAX_REQUEST)
 
  625      integer            :: type_recv(MAX_REQUEST)
 
  654   logical              :: module_is_initialized = .false.
 
  655   logical              :: debug                 = .false.
 
  656   logical              :: verbose=.false.
 
  657   logical              :: mosaic_defined = .false.
 
  658   integer              :: mpp_domains_stack_size=0
 
  659   integer              :: mpp_domains_stack_hwm=0
 
  660   type(
domain1d),
save  :: null_domain1d
 
  661   type(
domain2d),
save  :: null_domain2d
 
  662   type(
domainug),
save  :: null_domainug
 
  663   integer              :: current_id_update = 0
 
  664   integer                         :: num_update = 0
 
  665   integer                         :: num_nonblock_group_update = 0
 
  666   integer                         :: nonblock_buffer_pos = 0
 
  667   integer                         :: nonblock_group_buffer_pos = 0
 
  668   logical                         :: start_update = .true.
 
  669   logical                         :: complete_update = .false.
 
  671   integer, 
parameter              :: max_nonblock_update = 100
 
  673   integer                         :: group_update_buffer_pos = 0
 
  674   logical                         :: complete_group_update_on = .false.
 
  677   integer, 
parameter :: max_addrs=512
 
  679   integer,           
dimension(-1:MAX_ADDRS),
save :: 
addrs_idx=-9999
 
  684   integer, 
parameter :: max_addrs2=128
 
  690   integer, 
parameter :: max_dom_ids=128
 
  691   integer(i8_kind),
dimension(MAX_DOM_IDS),
save :: 
ids_sorted=-9999
 
  692   integer,           
dimension(-1:MAX_DOM_IDS),
save :: 
ids_idx=-9999
 
  697   integer, 
parameter :: max_fields=1024
 
  709   integer(i8_kind), 
parameter :: gt_base = 256_i8_kind 
 
  712   integer(i8_kind), 
parameter :: ke_base = 281474976710656_i8_kind 
 
  714   integer(i8_kind) :: domain_cnt=0
 
  717   logical :: domain_clocks_on=.false.
 
  718   integer :: send_clock=0, recv_clock=0, unpk_clock=0
 
  719   integer :: wait_clock=0, pack_clock=0
 
  720   integer :: send_pack_clock_nonblock=0, recv_clock_nonblock=0, unpk_clock_nonblock=0
 
  721   integer :: wait_clock_nonblock=0
 
  722   integer :: nest_send_clock=0, nest_recv_clock=0, nest_unpk_clock=0
 
  723   integer :: nest_wait_clock=0, nest_pack_clock=0
 
  724   integer :: group_recv_clock=0, group_send_clock=0, group_pack_clock=0, group_unpk_clock=0, group_wait_clock=0
 
  725   integer :: nonblock_group_recv_clock=0, nonblock_group_send_clock=0, nonblock_group_pack_clock=0
 
  726   integer :: nonblock_group_unpk_clock=0, nonblock_group_wait_clock=0
 
  747   logical           :: use_alltoallw = .false.
 
  753   integer, 
parameter :: no_check = -1
 
  754   integer            :: debug_update_level = no_check
 
  903      module procedure mpp_define_null_domain1d
 
  904      module procedure mpp_define_null_domain2d
 
  919      module procedure mpp_deallocate_domain1d
 
  920      module procedure mpp_deallocate_domain2d
 
 1012      module procedure mpp_update_domain2d_r8_2d
 
 1013      module procedure mpp_update_domain2d_r8_3d
 
 1014      module procedure mpp_update_domain2d_r8_4d
 
 1015      module procedure mpp_update_domain2d_r8_5d
 
 1016      module procedure mpp_update_domain2d_r8_2dv
 
 1017      module procedure mpp_update_domain2d_r8_3dv
 
 1018      module procedure mpp_update_domain2d_r8_4dv
 
 1019      module procedure mpp_update_domain2d_r8_5dv
 
 1021      module procedure mpp_update_domain2d_c8_2d
 
 1022      module procedure mpp_update_domain2d_c8_3d
 
 1023      module procedure mpp_update_domain2d_c8_4d
 
 1024      module procedure mpp_update_domain2d_c8_5d
 
 1026      module procedure mpp_update_domain2d_i8_2d
 
 1027      module procedure mpp_update_domain2d_i8_3d
 
 1028      module procedure mpp_update_domain2d_i8_4d
 
 1029      module procedure mpp_update_domain2d_i8_5d
 
 1030      module procedure mpp_update_domain2d_r4_2d
 
 1031      module procedure mpp_update_domain2d_r4_3d
 
 1032      module procedure mpp_update_domain2d_r4_4d
 
 1033      module procedure mpp_update_domain2d_r4_5d
 
 1034      module procedure mpp_update_domain2d_r4_2dv
 
 1035      module procedure mpp_update_domain2d_r4_3dv
 
 1036      module procedure mpp_update_domain2d_r4_4dv
 
 1037      module procedure mpp_update_domain2d_r4_5dv
 
 1039      module procedure mpp_update_domain2d_c4_2d
 
 1040      module procedure mpp_update_domain2d_c4_3d
 
 1041      module procedure mpp_update_domain2d_c4_4d
 
 1042      module procedure mpp_update_domain2d_c4_5d
 
 1044      module procedure mpp_update_domain2d_i4_2d
 
 1045      module procedure mpp_update_domain2d_i4_3d
 
 1046      module procedure mpp_update_domain2d_i4_4d
 
 1047      module procedure mpp_update_domain2d_i4_5d
 
 1193      module procedure mpp_start_update_domain2d_r8_2d
 
 1194      module procedure mpp_start_update_domain2d_r8_3d
 
 1195      module procedure mpp_start_update_domain2d_r8_4d
 
 1196      module procedure mpp_start_update_domain2d_r8_5d
 
 1197      module procedure mpp_start_update_domain2d_r8_2dv
 
 1198      module procedure mpp_start_update_domain2d_r8_3dv
 
 1199      module procedure mpp_start_update_domain2d_r8_4dv
 
 1200      module procedure mpp_start_update_domain2d_r8_5dv
 
 1202      module procedure mpp_start_update_domain2d_c8_2d
 
 1203      module procedure mpp_start_update_domain2d_c8_3d
 
 1204      module procedure mpp_start_update_domain2d_c8_4d
 
 1205      module procedure mpp_start_update_domain2d_c8_5d
 
 1207      module procedure mpp_start_update_domain2d_i8_2d
 
 1208      module procedure mpp_start_update_domain2d_i8_3d
 
 1209      module procedure mpp_start_update_domain2d_i8_4d
 
 1210      module procedure mpp_start_update_domain2d_i8_5d
 
 1211      module procedure mpp_start_update_domain2d_r4_2d
 
 1212      module procedure mpp_start_update_domain2d_r4_3d
 
 1213      module procedure mpp_start_update_domain2d_r4_4d
 
 1214      module procedure mpp_start_update_domain2d_r4_5d
 
 1215      module procedure mpp_start_update_domain2d_r4_2dv
 
 1216      module procedure mpp_start_update_domain2d_r4_3dv
 
 1217      module procedure mpp_start_update_domain2d_r4_4dv
 
 1218      module procedure mpp_start_update_domain2d_r4_5dv
 
 1220      module procedure mpp_start_update_domain2d_c4_2d
 
 1221      module procedure mpp_start_update_domain2d_c4_3d
 
 1222      module procedure mpp_start_update_domain2d_c4_4d
 
 1223      module procedure mpp_start_update_domain2d_c4_5d
 
 1225      module procedure mpp_start_update_domain2d_i4_2d
 
 1226      module procedure mpp_start_update_domain2d_i4_3d
 
 1227      module procedure mpp_start_update_domain2d_i4_4d
 
 1228      module procedure mpp_start_update_domain2d_i4_5d
 
 1236      module procedure mpp_complete_update_domain2d_r8_2d
 
 1237      module procedure mpp_complete_update_domain2d_r8_3d
 
 1238      module procedure mpp_complete_update_domain2d_r8_4d
 
 1239      module procedure mpp_complete_update_domain2d_r8_5d
 
 1240      module procedure mpp_complete_update_domain2d_r8_2dv
 
 1241      module procedure mpp_complete_update_domain2d_r8_3dv
 
 1242      module procedure mpp_complete_update_domain2d_r8_4dv
 
 1243      module procedure mpp_complete_update_domain2d_r8_5dv
 
 1245      module procedure mpp_complete_update_domain2d_c8_2d
 
 1246      module procedure mpp_complete_update_domain2d_c8_3d
 
 1247      module procedure mpp_complete_update_domain2d_c8_4d
 
 1248      module procedure mpp_complete_update_domain2d_c8_5d
 
 1250      module procedure mpp_complete_update_domain2d_i8_2d
 
 1251      module procedure mpp_complete_update_domain2d_i8_3d
 
 1252      module procedure mpp_complete_update_domain2d_i8_4d
 
 1253      module procedure mpp_complete_update_domain2d_i8_5d
 
 1254      module procedure mpp_complete_update_domain2d_r4_2d
 
 1255      module procedure mpp_complete_update_domain2d_r4_3d
 
 1256      module procedure mpp_complete_update_domain2d_r4_4d
 
 1257      module procedure mpp_complete_update_domain2d_r4_5d
 
 1258      module procedure mpp_complete_update_domain2d_r4_2dv
 
 1259      module procedure mpp_complete_update_domain2d_r4_3dv
 
 1260      module procedure mpp_complete_update_domain2d_r4_4dv
 
 1261      module procedure mpp_complete_update_domain2d_r4_5dv
 
 1263      module procedure mpp_complete_update_domain2d_c4_2d
 
 1264      module procedure mpp_complete_update_domain2d_c4_3d
 
 1265      module procedure mpp_complete_update_domain2d_c4_4d
 
 1266      module procedure mpp_complete_update_domain2d_c4_5d
 
 1268      module procedure mpp_complete_update_domain2d_i4_2d
 
 1269      module procedure mpp_complete_update_domain2d_i4_3d
 
 1270      module procedure mpp_complete_update_domain2d_i4_4d
 
 1271      module procedure mpp_complete_update_domain2d_i4_5d
 
 1277      module procedure mpp_start_do_update_r8_3d
 
 1278      module procedure mpp_start_do_update_r8_3dv
 
 1280      module procedure mpp_start_do_update_c8_3d
 
 1282      module procedure mpp_start_do_update_i8_3d
 
 1283      module procedure mpp_start_do_update_r4_3d
 
 1284      module procedure mpp_start_do_update_r4_3dv
 
 1286      module procedure mpp_start_do_update_c4_3d
 
 1288      module procedure mpp_start_do_update_i4_3d
 
 1294      module procedure mpp_complete_do_update_r8_3d
 
 1295      module procedure mpp_complete_do_update_r8_3dv
 
 1297      module procedure mpp_complete_do_update_c8_3d
 
 1299      module procedure mpp_complete_do_update_i8_3d
 
 1300      module procedure mpp_complete_do_update_r4_3d
 
 1301      module procedure mpp_complete_do_update_r4_3dv
 
 1303      module procedure mpp_complete_do_update_c4_3d
 
 1305      module procedure mpp_complete_do_update_i4_3d
 
 1314      module procedure mpp_create_group_update_r4_2d
 
 1315      module procedure mpp_create_group_update_r4_3d
 
 1316      module procedure mpp_create_group_update_r4_4d
 
 1317      module procedure mpp_create_group_update_r4_2dv
 
 1318      module procedure mpp_create_group_update_r4_3dv
 
 1319      module procedure mpp_create_group_update_r4_4dv
 
 1320      module procedure mpp_create_group_update_r8_2d
 
 1321      module procedure mpp_create_group_update_r8_3d
 
 1322      module procedure mpp_create_group_update_r8_4d
 
 1323      module procedure mpp_create_group_update_r8_2dv
 
 1324      module procedure mpp_create_group_update_r8_3dv
 
 1325      module procedure mpp_create_group_update_r8_4dv
 
 1330      module procedure mpp_do_group_update_r4
 
 1331      module procedure mpp_do_group_update_r8
 
 1342      module procedure mpp_start_group_update_r4
 
 1343      module procedure mpp_start_group_update_r8
 
 1354      module procedure mpp_complete_group_update_r4
 
 1355      module procedure mpp_complete_group_update_r8
 
 1360      module procedure mpp_reset_group_update_field_r4_2d
 
 1361      module procedure mpp_reset_group_update_field_r4_3d
 
 1362      module procedure mpp_reset_group_update_field_r4_4d
 
 1363      module procedure mpp_reset_group_update_field_r4_2dv
 
 1364      module procedure mpp_reset_group_update_field_r4_3dv
 
 1365      module procedure mpp_reset_group_update_field_r4_4dv
 
 1366      module procedure mpp_reset_group_update_field_r8_2d
 
 1367      module procedure mpp_reset_group_update_field_r8_3d
 
 1368      module procedure mpp_reset_group_update_field_r8_4d
 
 1369      module procedure mpp_reset_group_update_field_r8_2dv
 
 1370      module procedure mpp_reset_group_update_field_r8_3dv
 
 1371      module procedure mpp_reset_group_update_field_r8_4dv
 
 1383      module procedure mpp_update_nest_fine_r8_2d
 
 1384      module procedure mpp_update_nest_fine_r8_3d
 
 1385      module procedure mpp_update_nest_fine_r8_4d
 
 1386      module procedure mpp_update_nest_fine_r8_2dv
 
 1387      module procedure mpp_update_nest_fine_r8_3dv
 
 1388      module procedure mpp_update_nest_fine_r8_4dv
 
 1390      module procedure mpp_update_nest_fine_c8_2d
 
 1391      module procedure mpp_update_nest_fine_c8_3d
 
 1392      module procedure mpp_update_nest_fine_c8_4d
 
 1394      module procedure mpp_update_nest_fine_i8_2d
 
 1395      module procedure mpp_update_nest_fine_i8_3d
 
 1396      module procedure mpp_update_nest_fine_i8_4d
 
 1397      module procedure mpp_update_nest_fine_r4_2d
 
 1398      module procedure mpp_update_nest_fine_r4_3d
 
 1399      module procedure mpp_update_nest_fine_r4_4d
 
 1400      module procedure mpp_update_nest_fine_r4_2dv
 
 1401      module procedure mpp_update_nest_fine_r4_3dv
 
 1402      module procedure mpp_update_nest_fine_r4_4dv
 
 1404      module procedure mpp_update_nest_fine_c4_2d
 
 1405      module procedure mpp_update_nest_fine_c4_3d
 
 1406      module procedure mpp_update_nest_fine_c4_4d
 
 1408      module procedure mpp_update_nest_fine_i4_2d
 
 1409      module procedure mpp_update_nest_fine_i4_3d
 
 1410      module procedure mpp_update_nest_fine_i4_4d
 
 1415      module procedure mpp_do_update_nest_fine_r8_3d
 
 1416      module procedure mpp_do_update_nest_fine_r8_3dv
 
 1418      module procedure mpp_do_update_nest_fine_c8_3d
 
 1420      module procedure mpp_do_update_nest_fine_i8_3d
 
 1421      module procedure mpp_do_update_nest_fine_r4_3d
 
 1422      module procedure mpp_do_update_nest_fine_r4_3dv
 
 1424      module procedure mpp_do_update_nest_fine_c4_3d
 
 1426      module procedure mpp_do_update_nest_fine_i4_3d
 
 1437      module procedure mpp_update_nest_coarse_r8_2d
 
 1438      module procedure mpp_update_nest_coarse_r8_3d
 
 1439      module procedure mpp_update_nest_coarse_r8_4d
 
 1440      module procedure mpp_update_nest_coarse_r8_2dv
 
 1441      module procedure mpp_update_nest_coarse_r8_3dv
 
 1442      module procedure mpp_update_nest_coarse_r8_4dv
 
 1444      module procedure mpp_update_nest_coarse_c8_2d
 
 1445      module procedure mpp_update_nest_coarse_c8_3d
 
 1446      module procedure mpp_update_nest_coarse_c8_4d
 
 1448      module procedure mpp_update_nest_coarse_i8_2d
 
 1449      module procedure mpp_update_nest_coarse_i8_3d
 
 1450      module procedure mpp_update_nest_coarse_i8_4d
 
 1451      module procedure mpp_update_nest_coarse_r4_2d
 
 1452      module procedure mpp_update_nest_coarse_r4_3d
 
 1453      module procedure mpp_update_nest_coarse_r4_4d
 
 1454      module procedure mpp_update_nest_coarse_r4_2dv
 
 1455      module procedure mpp_update_nest_coarse_r4_3dv
 
 1456      module procedure mpp_update_nest_coarse_r4_4dv
 
 1458      module procedure mpp_update_nest_coarse_c4_2d
 
 1459      module procedure mpp_update_nest_coarse_c4_3d
 
 1460      module procedure mpp_update_nest_coarse_c4_4d
 
 1462      module procedure mpp_update_nest_coarse_i4_2d
 
 1463      module procedure mpp_update_nest_coarse_i4_3d
 
 1464      module procedure mpp_update_nest_coarse_i4_4d
 
 1471      module procedure mpp_do_update_nest_coarse_r8_3d
 
 1472      module procedure mpp_do_update_nest_coarse_r8_3dv
 
 1474      module procedure mpp_do_update_nest_coarse_c8_3d
 
 1476      module procedure mpp_do_update_nest_coarse_i8_3d
 
 1477      module procedure mpp_do_update_nest_coarse_r4_3d
 
 1478      module procedure mpp_do_update_nest_coarse_r4_3dv
 
 1480      module procedure mpp_do_update_nest_coarse_c4_3d
 
 1482      module procedure mpp_do_update_nest_coarse_i4_3d
 
 1506     module procedure mpp_broadcast_domain_2
 
 1508     module procedure mpp_broadcast_domain_nest_fine
 
 1518      module procedure mpp_update_domains_ad_2d_r8_2d
 
 1519      module procedure mpp_update_domains_ad_2d_r8_3d
 
 1520      module procedure mpp_update_domains_ad_2d_r8_4d
 
 1521      module procedure mpp_update_domains_ad_2d_r8_5d
 
 1522      module procedure mpp_update_domains_ad_2d_r8_2dv
 
 1523      module procedure mpp_update_domains_ad_2d_r8_3dv
 
 1524      module procedure mpp_update_domains_ad_2d_r8_4dv
 
 1525      module procedure mpp_update_domains_ad_2d_r8_5dv
 
 1526      module procedure mpp_update_domains_ad_2d_r4_2d
 
 1527      module procedure mpp_update_domains_ad_2d_r4_3d
 
 1528      module procedure mpp_update_domains_ad_2d_r4_4d
 
 1529      module procedure mpp_update_domains_ad_2d_r4_5d
 
 1530      module procedure mpp_update_domains_ad_2d_r4_2dv
 
 1531      module procedure mpp_update_domains_ad_2d_r4_3dv
 
 1532      module procedure mpp_update_domains_ad_2d_r4_4dv
 
 1533      module procedure mpp_update_domains_ad_2d_r4_5dv
 
 1539      module procedure mpp_do_update_r8_3d
 
 1540      module procedure mpp_do_update_r8_3dv
 
 1542      module procedure mpp_do_update_c8_3d
 
 1544      module procedure mpp_do_update_i8_3d
 
 1545      module procedure mpp_do_update_r4_3d
 
 1546      module procedure mpp_do_update_r4_3dv
 
 1548      module procedure mpp_do_update_c4_3d
 
 1550      module procedure mpp_do_update_i4_3d
 
 1555      module procedure mpp_do_check_r8_3d
 
 1556      module procedure mpp_do_check_r8_3dv
 
 1558      module procedure mpp_do_check_c8_3d
 
 1560      module procedure mpp_do_check_i8_3d
 
 1561      module procedure mpp_do_check_r4_3d
 
 1562      module procedure mpp_do_check_r4_3dv
 
 1564      module procedure mpp_do_check_c4_3d
 
 1566      module procedure mpp_do_check_i4_3d
 
 1575      module procedure mpp_pass_sg_to_ug_r8_2d
 
 1576      module procedure mpp_pass_sg_to_ug_r8_3d
 
 1577      module procedure mpp_pass_sg_to_ug_r4_2d
 
 1578      module procedure mpp_pass_sg_to_ug_r4_3d
 
 1579      module procedure mpp_pass_sg_to_ug_i4_2d
 
 1580      module procedure mpp_pass_sg_to_ug_i4_3d
 
 1581      module procedure mpp_pass_sg_to_ug_l4_2d
 
 1582      module procedure mpp_pass_sg_to_ug_l4_3d
 
 1591      module procedure mpp_pass_ug_to_sg_r8_2d
 
 1592      module procedure mpp_pass_ug_to_sg_r8_3d
 
 1593      module procedure mpp_pass_ug_to_sg_r4_2d
 
 1594      module procedure mpp_pass_ug_to_sg_r4_3d
 
 1595      module procedure mpp_pass_ug_to_sg_i4_2d
 
 1596      module procedure mpp_pass_ug_to_sg_i4_3d
 
 1597      module procedure mpp_pass_ug_to_sg_l4_2d
 
 1598      module procedure mpp_pass_ug_to_sg_l4_3d
 
 1608      module procedure mpp_do_update_ad_r8_3d
 
 1609      module procedure mpp_do_update_ad_r8_3dv
 
 1610      module procedure mpp_do_update_ad_r4_3d
 
 1611      module procedure mpp_do_update_ad_r4_3dv
 
 1624      module procedure mpp_get_boundary_r8_2d
 
 1625      module procedure mpp_get_boundary_r8_3d
 
 1628      module procedure mpp_get_boundary_r8_2dv
 
 1629      module procedure mpp_get_boundary_r8_3dv
 
 1632      module procedure mpp_get_boundary_r4_2d
 
 1633      module procedure mpp_get_boundary_r4_3d
 
 1636      module procedure mpp_get_boundary_r4_2dv
 
 1637      module procedure mpp_get_boundary_r4_3dv
 
 1644      module procedure mpp_get_boundary_ad_r8_2d
 
 1645      module procedure mpp_get_boundary_ad_r8_3d
 
 1646      module procedure mpp_get_boundary_ad_r8_2dv
 
 1647      module procedure mpp_get_boundary_ad_r8_3dv
 
 1648      module procedure mpp_get_boundary_ad_r4_2d
 
 1649      module procedure mpp_get_boundary_ad_r4_3d
 
 1650      module procedure mpp_get_boundary_ad_r4_2dv
 
 1651      module procedure mpp_get_boundary_ad_r4_3dv
 
 1656      module procedure mpp_do_get_boundary_r8_3d
 
 1657      module procedure mpp_do_get_boundary_r8_3dv
 
 1658      module procedure mpp_do_get_boundary_r4_3d
 
 1659      module procedure mpp_do_get_boundary_r4_3dv
 
 1664      module procedure mpp_do_get_boundary_ad_r8_3d
 
 1665      module procedure mpp_do_get_boundary_ad_r8_3dv
 
 1666      module procedure mpp_do_get_boundary_ad_r4_3d
 
 1667      module procedure mpp_do_get_boundary_ad_r4_3dv
 
 1678      module procedure mpp_redistribute_r8_2d
 
 1679      module procedure mpp_redistribute_r8_3d
 
 1680      module procedure mpp_redistribute_r8_4d
 
 1681      module procedure mpp_redistribute_r8_5d
 
 1683      module procedure mpp_redistribute_c8_2d
 
 1684      module procedure mpp_redistribute_c8_3d
 
 1685      module procedure mpp_redistribute_c8_4d
 
 1686      module procedure mpp_redistribute_c8_5d
 
 1688      module procedure mpp_redistribute_i8_2d
 
 1689      module procedure mpp_redistribute_i8_3d
 
 1690      module procedure mpp_redistribute_i8_4d
 
 1691      module procedure mpp_redistribute_i8_5d
 
 1696      module procedure mpp_redistribute_r4_2d
 
 1697      module procedure mpp_redistribute_r4_3d
 
 1698      module procedure mpp_redistribute_r4_4d
 
 1699      module procedure mpp_redistribute_r4_5d
 
 1701      module procedure mpp_redistribute_c4_2d
 
 1702      module procedure mpp_redistribute_c4_3d
 
 1703      module procedure mpp_redistribute_c4_4d
 
 1704      module procedure mpp_redistribute_c4_5d
 
 1706      module procedure mpp_redistribute_i4_2d
 
 1707      module procedure mpp_redistribute_i4_3d
 
 1708      module procedure mpp_redistribute_i4_4d
 
 1709      module procedure mpp_redistribute_i4_5d
 
 1718      module procedure mpp_do_redistribute_r8_3d
 
 1720      module procedure mpp_do_redistribute_c8_3d
 
 1722      module procedure mpp_do_redistribute_i8_3d
 
 1723      module procedure mpp_do_redistribute_l8_3d
 
 1724      module procedure mpp_do_redistribute_r4_3d
 
 1726      module procedure mpp_do_redistribute_c4_3d
 
 1728      module procedure mpp_do_redistribute_i4_3d
 
 1729      module procedure mpp_do_redistribute_l4_3d
 
 1784      module procedure mpp_global_field2d_r8_2d
 
 1785      module procedure mpp_global_field2d_r8_3d
 
 1786      module procedure mpp_global_field2d_r8_4d
 
 1787      module procedure mpp_global_field2d_r8_5d
 
 1789      module procedure mpp_global_field2d_c8_2d
 
 1790      module procedure mpp_global_field2d_c8_3d
 
 1791      module procedure mpp_global_field2d_c8_4d
 
 1792      module procedure mpp_global_field2d_c8_5d
 
 1794      module procedure mpp_global_field2d_i8_2d
 
 1795      module procedure mpp_global_field2d_i8_3d
 
 1796      module procedure mpp_global_field2d_i8_4d
 
 1797      module procedure mpp_global_field2d_i8_5d
 
 1798      module procedure mpp_global_field2d_l8_2d
 
 1799      module procedure mpp_global_field2d_l8_3d
 
 1800      module procedure mpp_global_field2d_l8_4d
 
 1801      module procedure mpp_global_field2d_l8_5d
 
 1802      module procedure mpp_global_field2d_r4_2d
 
 1803      module procedure mpp_global_field2d_r4_3d
 
 1804      module procedure mpp_global_field2d_r4_4d
 
 1805      module procedure mpp_global_field2d_r4_5d
 
 1807      module procedure mpp_global_field2d_c4_2d
 
 1808      module procedure mpp_global_field2d_c4_3d
 
 1809      module procedure mpp_global_field2d_c4_4d
 
 1810      module procedure mpp_global_field2d_c4_5d
 
 1812      module procedure mpp_global_field2d_i4_2d
 
 1813      module procedure mpp_global_field2d_i4_3d
 
 1814      module procedure mpp_global_field2d_i4_4d
 
 1815      module procedure mpp_global_field2d_i4_5d
 
 1816      module procedure mpp_global_field2d_l4_2d
 
 1817      module procedure mpp_global_field2d_l4_3d
 
 1818      module procedure mpp_global_field2d_l4_4d
 
 1819      module procedure mpp_global_field2d_l4_5d
 
 1824      module procedure mpp_global_field2d_r8_2d_ad
 
 1825      module procedure mpp_global_field2d_r8_3d_ad
 
 1826      module procedure mpp_global_field2d_r8_4d_ad
 
 1827      module procedure mpp_global_field2d_r8_5d_ad
 
 1829      module procedure mpp_global_field2d_c8_2d_ad
 
 1830      module procedure mpp_global_field2d_c8_3d_ad
 
 1831      module procedure mpp_global_field2d_c8_4d_ad
 
 1832      module procedure mpp_global_field2d_c8_5d_ad
 
 1834      module procedure mpp_global_field2d_i8_2d_ad
 
 1835      module procedure mpp_global_field2d_i8_3d_ad
 
 1836      module procedure mpp_global_field2d_i8_4d_ad
 
 1837      module procedure mpp_global_field2d_i8_5d_ad
 
 1838      module procedure mpp_global_field2d_l8_2d_ad
 
 1839      module procedure mpp_global_field2d_l8_3d_ad
 
 1840      module procedure mpp_global_field2d_l8_4d_ad
 
 1841      module procedure mpp_global_field2d_l8_5d_ad
 
 1842      module procedure mpp_global_field2d_r4_2d_ad
 
 1843      module procedure mpp_global_field2d_r4_3d_ad
 
 1844      module procedure mpp_global_field2d_r4_4d_ad
 
 1845      module procedure mpp_global_field2d_r4_5d_ad
 
 1847      module procedure mpp_global_field2d_c4_2d_ad
 
 1848      module procedure mpp_global_field2d_c4_3d_ad
 
 1849      module procedure mpp_global_field2d_c4_4d_ad
 
 1850      module procedure mpp_global_field2d_c4_5d_ad
 
 1852      module procedure mpp_global_field2d_i4_2d_ad
 
 1853      module procedure mpp_global_field2d_i4_3d_ad
 
 1854      module procedure mpp_global_field2d_i4_4d_ad
 
 1855      module procedure mpp_global_field2d_i4_5d_ad
 
 1856      module procedure mpp_global_field2d_l4_2d_ad
 
 1857      module procedure mpp_global_field2d_l4_3d_ad
 
 1858      module procedure mpp_global_field2d_l4_4d_ad
 
 1859      module procedure mpp_global_field2d_l4_5d_ad
 
 1865      module procedure mpp_do_global_field2d_r8_3d
 
 1867      module procedure mpp_do_global_field2d_c8_3d
 
 1869      module procedure mpp_do_global_field2d_i8_3d
 
 1870      module procedure mpp_do_global_field2d_l8_3d
 
 1871      module procedure mpp_do_global_field2d_r4_3d
 
 1873      module procedure mpp_do_global_field2d_c4_3d
 
 1875      module procedure mpp_do_global_field2d_i4_3d
 
 1876      module procedure mpp_do_global_field2d_l4_3d
 
 1880      module procedure mpp_do_global_field2d_a2a_r8_3d
 
 1882      module procedure mpp_do_global_field2d_a2a_c8_3d
 
 1884      module procedure mpp_do_global_field2d_a2a_i8_3d
 
 1885      module procedure mpp_do_global_field2d_a2a_l8_3d
 
 1886      module procedure mpp_do_global_field2d_a2a_r4_3d
 
 1888      module procedure mpp_do_global_field2d_a2a_c4_3d
 
 1890      module procedure mpp_do_global_field2d_a2a_i4_3d
 
 1891      module procedure mpp_do_global_field2d_a2a_l4_3d
 
 1897      module procedure mpp_global_field2d_ug_r8_2d
 
 1898      module procedure mpp_global_field2d_ug_r8_3d
 
 1899      module procedure mpp_global_field2d_ug_r8_4d
 
 1900      module procedure mpp_global_field2d_ug_r8_5d
 
 1901      module procedure mpp_global_field2d_ug_i8_2d
 
 1902      module procedure mpp_global_field2d_ug_i8_3d
 
 1903      module procedure mpp_global_field2d_ug_i8_4d
 
 1904      module procedure mpp_global_field2d_ug_i8_5d
 
 1905      module procedure mpp_global_field2d_ug_r4_2d
 
 1906      module procedure mpp_global_field2d_ug_r4_3d
 
 1907      module procedure mpp_global_field2d_ug_r4_4d
 
 1908      module procedure mpp_global_field2d_ug_r4_5d
 
 1909      module procedure mpp_global_field2d_ug_i4_2d
 
 1910      module procedure mpp_global_field2d_ug_i4_3d
 
 1911      module procedure mpp_global_field2d_ug_i4_4d
 
 1912      module procedure mpp_global_field2d_ug_i4_5d
 
 1917      module procedure mpp_do_global_field2d_r8_3d_ad
 
 1919      module procedure mpp_do_global_field2d_c8_3d_ad
 
 1921      module procedure mpp_do_global_field2d_i8_3d_ad
 
 1922      module procedure mpp_do_global_field2d_l8_3d_ad
 
 1923      module procedure mpp_do_global_field2d_r4_3d_ad
 
 1925      module procedure mpp_do_global_field2d_c4_3d_ad
 
 1927      module procedure mpp_do_global_field2d_i4_3d_ad
 
 1928      module procedure mpp_do_global_field2d_l4_3d_ad
 
 1949      module procedure mpp_global_max_r8_2d
 
 1950      module procedure mpp_global_max_r8_3d
 
 1951      module procedure mpp_global_max_r8_4d
 
 1952      module procedure mpp_global_max_r8_5d
 
 1953      module procedure mpp_global_max_r4_2d
 
 1954      module procedure mpp_global_max_r4_3d
 
 1955      module procedure mpp_global_max_r4_4d
 
 1956      module procedure mpp_global_max_r4_5d
 
 1957      module procedure mpp_global_max_i8_2d
 
 1958      module procedure mpp_global_max_i8_3d
 
 1959      module procedure mpp_global_max_i8_4d
 
 1960      module procedure mpp_global_max_i8_5d
 
 1961      module procedure mpp_global_max_i4_2d
 
 1962      module procedure mpp_global_max_i4_3d
 
 1963      module procedure mpp_global_max_i4_4d
 
 1964      module procedure mpp_global_max_i4_5d
 
 1985      module procedure mpp_global_min_r8_2d
 
 1986      module procedure mpp_global_min_r8_3d
 
 1987      module procedure mpp_global_min_r8_4d
 
 1988      module procedure mpp_global_min_r8_5d
 
 1989      module procedure mpp_global_min_r4_2d
 
 1990      module procedure mpp_global_min_r4_3d
 
 1991      module procedure mpp_global_min_r4_4d
 
 1992      module procedure mpp_global_min_r4_5d
 
 1993      module procedure mpp_global_min_i8_2d
 
 1994      module procedure mpp_global_min_i8_3d
 
 1995      module procedure mpp_global_min_i8_4d
 
 1996      module procedure mpp_global_min_i8_5d
 
 1997      module procedure mpp_global_min_i4_2d
 
 1998      module procedure mpp_global_min_i4_3d
 
 1999      module procedure mpp_global_min_i4_4d
 
 2000      module procedure mpp_global_min_i4_5d
 
 2023      module procedure mpp_global_sum_r8_2d
 
 2024      module procedure mpp_global_sum_r8_3d
 
 2025      module procedure mpp_global_sum_r8_4d
 
 2026      module procedure mpp_global_sum_r8_5d
 
 2028      module procedure mpp_global_sum_c8_2d
 
 2029      module procedure mpp_global_sum_c8_3d
 
 2030      module procedure mpp_global_sum_c8_4d
 
 2031      module procedure mpp_global_sum_c8_5d
 
 2033      module procedure mpp_global_sum_r4_2d
 
 2034      module procedure mpp_global_sum_r4_3d
 
 2035      module procedure mpp_global_sum_r4_4d
 
 2036      module procedure mpp_global_sum_r4_5d
 
 2038      module procedure mpp_global_sum_c4_2d
 
 2039      module procedure mpp_global_sum_c4_3d
 
 2040      module procedure mpp_global_sum_c4_4d
 
 2041      module procedure mpp_global_sum_c4_5d
 
 2043      module procedure mpp_global_sum_i8_2d
 
 2044      module procedure mpp_global_sum_i8_3d
 
 2045      module procedure mpp_global_sum_i8_4d
 
 2046      module procedure mpp_global_sum_i8_5d
 
 2047      module procedure mpp_global_sum_i4_2d
 
 2048      module procedure mpp_global_sum_i4_3d
 
 2049      module procedure mpp_global_sum_i4_4d
 
 2050      module procedure mpp_global_sum_i4_5d
 
 2056      module procedure mpp_global_sum_tl_r8_2d
 
 2057      module procedure mpp_global_sum_tl_r8_3d
 
 2058      module procedure mpp_global_sum_tl_r8_4d
 
 2059      module procedure mpp_global_sum_tl_r8_5d
 
 2061      module procedure mpp_global_sum_tl_c8_2d
 
 2062      module procedure mpp_global_sum_tl_c8_3d
 
 2063      module procedure mpp_global_sum_tl_c8_4d
 
 2064      module procedure mpp_global_sum_tl_c8_5d
 
 2066      module procedure mpp_global_sum_tl_r4_2d
 
 2067      module procedure mpp_global_sum_tl_r4_3d
 
 2068      module procedure mpp_global_sum_tl_r4_4d
 
 2069      module procedure mpp_global_sum_tl_r4_5d
 
 2071      module procedure mpp_global_sum_tl_c4_2d
 
 2072      module procedure mpp_global_sum_tl_c4_3d
 
 2073      module procedure mpp_global_sum_tl_c4_4d
 
 2074      module procedure mpp_global_sum_tl_c4_5d
 
 2076      module procedure mpp_global_sum_tl_i8_2d
 
 2077      module procedure mpp_global_sum_tl_i8_3d
 
 2078      module procedure mpp_global_sum_tl_i8_4d
 
 2079      module procedure mpp_global_sum_tl_i8_5d
 
 2080      module procedure mpp_global_sum_tl_i4_2d
 
 2081      module procedure mpp_global_sum_tl_i4_3d
 
 2082      module procedure mpp_global_sum_tl_i4_4d
 
 2083      module procedure mpp_global_sum_tl_i4_5d
 
 2090      module procedure mpp_global_sum_ad_r8_2d
 
 2091      module procedure mpp_global_sum_ad_r8_3d
 
 2092      module procedure mpp_global_sum_ad_r8_4d
 
 2093      module procedure mpp_global_sum_ad_r8_5d
 
 2095      module procedure mpp_global_sum_ad_c8_2d
 
 2096      module procedure mpp_global_sum_ad_c8_3d
 
 2097      module procedure mpp_global_sum_ad_c8_4d
 
 2098      module procedure mpp_global_sum_ad_c8_5d
 
 2100      module procedure mpp_global_sum_ad_r4_2d
 
 2101      module procedure mpp_global_sum_ad_r4_3d
 
 2102      module procedure mpp_global_sum_ad_r4_4d
 
 2103      module procedure mpp_global_sum_ad_r4_5d
 
 2105      module procedure mpp_global_sum_ad_c4_2d
 
 2106      module procedure mpp_global_sum_ad_c4_3d
 
 2107      module procedure mpp_global_sum_ad_c4_4d
 
 2108      module procedure mpp_global_sum_ad_c4_5d
 
 2110      module procedure mpp_global_sum_ad_i8_2d
 
 2111      module procedure mpp_global_sum_ad_i8_3d
 
 2112      module procedure mpp_global_sum_ad_i8_4d
 
 2113      module procedure mpp_global_sum_ad_i8_5d
 
 2114      module procedure mpp_global_sum_ad_i4_2d
 
 2115      module procedure mpp_global_sum_ad_i4_3d
 
 2116      module procedure mpp_global_sum_ad_i4_4d
 
 2117      module procedure mpp_global_sum_ad_i4_5d
 
 2169   interface operator(.EQ.)
 
 2176   interface operator(.NE.)
 
 2335      module procedure check_data_size_1d
 
 2336      module procedure check_data_size_2d
 
 2350 #include<file_version.h> 
 2356 #include <mpp_define_nest_domains.inc> 
 2357 #include <mpp_domains_util.inc> 
 2358 #include <mpp_domains_comm.inc> 
 2359 #include <mpp_domains_define.inc> 
 2360 #include <mpp_domains_misc.inc> 
 2361 #include <mpp_domains_reduce.inc> 
 2362 #include <mpp_unstruct_domain.inc> 
 2364 end module mpp_domains_mod
 
subroutine mpp_get_overlap(domain, action, p, is, ie, js, je, dir, rot, position)
Set user stack size.
subroutine mpp_get_neighbor_pe_2d(domain, direction, pe)
Return PE North/South/East/West of this PE-domain. direction must be NORTH, SOUTH,...
subroutine mpp_get_global_domains1d(domain, begin, end, size)
Set user stack size.
integer function mpp_get_domain_npes(domain)
Set user stack size.
subroutine mpp_define_unstruct_domain(UG_domain, SG_domain, npts_tile, grid_nlev, ndivs, npes_io_group, grid_index, name)
integer, save a2_sort_len
length sorted memory list
subroutine mpp_define_nest_domains(nest_domain, domain, num_nest, nest_level, tile_fine, tile_coarse, istart_coarse, icount_coarse, jstart_coarse, jcount_coarse, npes_nest_tile, x_refine, y_refine, extra_halo, name)
Set up a domain to pass data between aligned coarse and fine grid of nested model.
logical function mpp_domainug_ne(a, b)
Overload the .ne. for UG.
subroutine mpp_modify_domain2d(domain_in, domain_out, isc, iec, jsc, jec, isg, ieg, jsg, jeg, whalo, ehalo, shalo, nhalo)
logical function mpp_domain2d_eq(a, b)
Set user stack size.
integer function mpp_get_tile_npes(domain)
Returns number of processors used on current tile.
integer, dimension(-1:max_dom_ids), save ids_idx
index of d_comm associated with sorted addesses
integer nthread_control_loop
Determine the loop order for packing and unpacking. When number of threads is greater than nthread_co...
integer, save i_sort_len
length sorted domain ids list
subroutine mpp_get_global_domain2d(domain, xbegin, xend, ybegin, yend, xsize, xmax_size, ysize, ymax_size, tile_count, position)
Set user stack size.
subroutine mpp_get_pelist1d(domain, pelist, pos)
Set user stack size.
subroutine mpp_set_global_domain1d(domain, begin, end, size)
Set user stack size.
subroutine mpp_get_layout2d(domain, layout)
Set user stack size.
subroutine mpp_get_tile_pelist(domain, pelist)
Get the processors list used on current tile.
logical efp_sum_overflow_check
If .true., always do overflow_check when doing EFP bitwise mpp_global_sum.
subroutine mpp_get_domain_components(domain, x, y, tile_count)
Retrieve 1D components of 2D decomposition.
subroutine mpp_get_domain_extents1d(domain, xextent, yextent)
Set user stack size.
logical function mpp_group_update_is_set(group)
Set user stack size.
subroutine logical mpp_broadcast_domain_1(domain)
broadcast domain (useful only outside the context of its own pelist)
integer function mpp_get_domain_tile_commid(domain)
Set user stack size.
character(len=32) debug_update_domain
namelist interface
subroutine mpp_domains_init(flags)
Initialize domain decomp package.
subroutine mpp_set_global_domain2d(domain, xbegin, xend, ybegin, yend, xsize, ysize, tile_count)
Set user stack size.
logical function mpp_domain1d_eq(a, b)
Set user stack size.
integer function, dimension(size(domain%tile_id(:))) mpp_get_tile_id(domain)
Returns the tile_id on current pe.
logical function mpp_domain_is_symmetry(domain)
Set user stack size.
subroutine mpp_create_super_grid_domain(domain)
Modifies the indices of the input domain to create the supergrid domain.
logical function mpp_mosaic_defined()
Accessor function for value of mosaic_defined.
integer function mpp_get_num_overlap(domain, action, p, position)
Set user stack size.
integer function mpp_get_current_ntile(domain)
Returns number of tile on current pe.
subroutine mpp_define_domains1d(global_indices, ndivs, domain, pelist, flags, halo, extent, maskmap, memory_size, begin_halo, end_halo)
Define data and computational domains on a 1D set of data (isg:ieg) and assign them to PEs.
subroutine mpp_set_domain_symmetry(domain, symmetry)
Set user stack size.
integer function mpp_get_ntile_count(domain)
Returns number of tiles in mosaic.
subroutine mpp_get_domain_extents2d(domain, xextent, yextent)
This will return xextent and yextent for each tile.
logical debug_message_passing
Will check the consistency on the boundary between processor/tile when updating domain for symmetric ...
subroutine mpp_get_global_domain1d(domain, begin, end, size, max_size)
Set user stack size.
integer function, dimension(2) mpp_get_io_domain_layout(domain)
Set user stack size.
subroutine mpp_shift_nest_domains(nest_domain, domain, delta_i_coarse, delta_j_coarse, extra_halo)
Based on mpp_define_nest_domains, but just resets positioning of nest Modifies the parent/coarse star...
subroutine mpp_get_neighbor_pe_1d(domain, direction, pe)
Return PE to the righ/left of this PE-domain.
subroutine mpp_define_mosaic_pelist(sizes, pe_start, pe_end, pelist, costpertile)
Defines a pelist for use with mosaic tiles.
subroutine mpp_get_tile_compute_domains(domain, xbegin, xend, ybegin, yend, position)
Set user stack size.
subroutine mpp_get_compute_domain2d(domain, xbegin, xend, ybegin, yend, xsize, xmax_size, ysize, ymax_size, x_is_global, y_is_global, tile_count, position)
Set user stack size.
subroutine mpp_get_compute_domain1d(domain, begin, end, size, max_size, is_global)
Set user stack size.
subroutine mpp_define_io_domain(domain, io_layout)
Define the layout for IO pe's for the given domain.
subroutine mpp_get_f2c_index_coarse(nest_domain, is_coarse, ie_coarse, js_coarse, je_coarse, nest_level, position)
subroutine mpp_compute_extent(isg, ieg, ndivs, ibegin, iend, extent)
Computes extents for a grid decomposition with the given indices and divisions.
integer, dimension(-1:max_fields), save d_comm_idx
index of d_comm associated with sorted addresses
logical function mpp_domain1d_ne(a, b)
Set user stack size.
subroutine mpp_modify_domain1d(domain_in, domain_out, cbegin, cend, gbegin, gend, hbegin, hend)
Modifies the exents of a domain.
subroutine mpp_get_layout1d(domain, layout)
Set user stack size.
subroutine mpp_broadcast_domain_ug(domain)
Broadcast domain (useful only outside the context of its own pelist)
subroutine mpp_get_update_pelist(domain, action, pelist, position)
Set user stack size.
subroutine mpp_set_data_domain2d(domain, xbegin, xend, ybegin, yend, xsize, ysize, x_is_global, y_is_global, tile_count)
Set user stack size.
subroutine mpp_get_compute_domains1d(domain, begin, end, size)
Set user stack size.
integer(i8_kind), parameter addr2_base
= 0x0000000000010000
integer function mpp_get_domain_tile_root_pe(domain)
Set user stack size.
subroutine mpp_check_field_2d(field_in, pelist1, pelist2, domain, mesg, w_halo, s_halo, e_halo, n_halo, force_abort, position)
This routine is used to do parallel checking for 2d data between n and m pe. The comparison is is don...
integer, dimension(-1:max_addrs2), save addrs2_idx
index of addr2 associated with d_comm
subroutine mpp_define_mosaic(global_indices, layout, domain, num_tile, num_contact, tile1, tile2, istart1, iend1, jstart1, jend1, istart2, iend2, jstart2, jend2, pe_start, pe_end, pelist, whalo, ehalo, shalo, nhalo, xextent, yextent, maskmap, name, memory_size, symmetry, xflags, yflags, tile_id)
Defines a domain for mosaic tile grids.
integer, save n_comm
number of communicators used
subroutine mpp_domains_exit()
Exit mpp_domains_mod. Serves no particular purpose, but is provided should you require to re-initiali...
subroutine mpp_get_pelist2d(domain, pelist, pos)
Set user stack size.
integer, save n_ids
number of domain ids used (=i_sort_len; domain ids are never removed)
integer, save a_sort_len
length sorted memory list
subroutine mpp_get_memory_domain2d(domain, xbegin, xend, ybegin, yend, xsize, xmax_size, ysize, ymax_size, x_is_global, y_is_global, position)
Set user stack size.
subroutine mpp_check_field_3d(field_in, pelist1, pelist2, domain, mesg, w_halo, s_halo, e_halo, n_halo, force_abort, position)
This routine is used to do parallel checking for 3d data between n and m pe. The comparison is is don...
subroutine mpp_define_layout2d(global_indices, ndivs, layout)
subroutine mpp_set_compute_domain1d(domain, begin, end, size, is_global)
Set user stack size.
integer function mpp_get_domain_pe(domain)
Set user stack size.
subroutine mpp_get_tile_list(domain, tiles)
Return the tile_id on current pelist. one-tile-per-pe is assumed.
subroutine mpp_get_f2c_index_fine(nest_domain, is_coarse, ie_coarse, js_coarse, je_coarse, is_fine, ie_fine, js_fine, je_fine, nest_level, position)
subroutine mpp_compute_block_extent(isg, ieg, ndivs, ibegin, iend)
Computes the extents of a grid block.
logical function mpp_group_update_initialized(group)
Set user stack size.
integer, save dc_sort_len
length sorted comm keys (=num active communicators)
subroutine mpp_set_compute_domain2d(domain, xbegin, xend, ybegin, yend, xsize, ysize, x_is_global, y_is_global, tile_count)
Set user stack size.
type(domain2d) function, pointer mpp_get_io_domain(domain)
Set user stack size.
subroutine mpp_get_compute_domains2d(domain, xbegin, xend, xsize, ybegin, yend, ysize, position)
Set user stack size.
subroutine mpp_copy_domain2d(domain_in, domain_out)
Copies input 2d domain to the output 2d domain.
integer(i8_kind), dimension(max_fields), save dckey_sorted
list of sorted local addresses
subroutine mpp_get_memory_domain1d(domain, begin, end, size, max_size, is_global)
Set user stack size.
type(domaincommunicator2d), dimension(:), allocatable, target, save d_comm
domain communicators
subroutine mpp_get_domain_shift(domain, ishift, jshift, position)
Returns the shift value in x and y-direction according to domain position..
logical function mpp_domain2d_ne(a, b)
Set user stack size.
logical function mpp_domain_is_initialized(domain)
Set user stack size.
subroutine mpp_broadcast_domain_nest_coarse(domain, tile_coarse)
Broadcast nested domain (useful only outside the context of its own pelist)
subroutine nullify_domain2d_list(domain)
Set user stack size.
integer, dimension(-1:max_addrs), save addrs_idx
index of address associated with d_comm
logical function mpp_domain_is_tile_root_pe(domain)
Returns if current pe is the root pe of the tile, if number of tiles on current pe is greater than 1,...
character(len=name_length) function mpp_get_domain_name(domain)
Set user stack size.
subroutine mpp_get_global_domains2d(domain, xbegin, xend, xsize, ybegin, yend, ysize, position)
Set user stack size.
subroutine mpp_get_c2f_index(nest_domain, is_fine, ie_fine, js_fine, je_fine, is_coarse, ie_coarse, js_coarse, je_coarse, dir, nest_level, position)
Get the index of the data passed from coarse grid to fine grid.
integer function mpp_get_domain_commid(domain)
Set user stack size.
integer, save n_addrs2
number of memory addresses used
subroutine mpp_get_data_domain2d(domain, xbegin, xend, ybegin, yend, xsize, xmax_size, ysize, ymax_size, x_is_global, y_is_global, tile_count, position)
Set user stack size.
subroutine mpp_get_domain_pelist(domain, pelist)
Set user stack size.
integer(i8_kind), dimension(max_addrs2), save addrs2_sorted
list of sorted local addresses
subroutine mpp_domains_set_stack_size(n)
Set user stack size.
subroutine mpp_clear_group_update(group)
Set user stack size.
subroutine mpp_get_update_size(domain, nsend, nrecv, position)
Set user stack size.
integer(i8_kind), dimension(max_addrs), save addrs_sorted
list of sorted local addresses
integer(i8_kind), dimension(max_dom_ids), save ids_sorted
list of sorted domain identifiers
integer function mpp_get_domain_root_pe(domain)
Set user stack size.
logical function mpp_domainug_eq(a, b)
Overload the .eq. for UG.
subroutine mpp_set_data_domain1d(domain, begin, end, size, is_global)
Set user stack size.
recursive subroutine mpp_copy_domain1d(domain_in, domain_out)
Copies input 1d domain to the output 1d domain.
integer, save n_addrs
number of memory addresses used
subroutine mpp_get_data_domain1d(domain, begin, end, size, max_size, is_global)
Set user stack size.
subroutine mpp_define_domains2d(global_indices, layout, domain, pelist, xflags, yflags, xhalo, yhalo, xextent, yextent, maskmap, name, symmetry, memory_size, whalo, ehalo, shalo, nhalo, is_mosaic, tile_count, tile_id, complete, x_cyclic_offset, y_cyclic_offset)
Define 2D data and computational domain on global rectilinear cartesian domain (isg:ieg,...
Private interface for internal usage, compares two sizes.
Broadcasts domain to every pe. Only useful outside the context of it's own pelist.
Parallel checking between two ensembles which run on different set pes at the same time  There are tw...
Private interface used for non blocking updates.
Completes a pending non-blocking group update Must follow a call to mpp_start_group_update.
Must be used after a call to mpp_start_update_domains in order to complete a nonblocking domain updat...
Constructor for the mpp_group_update_type which is then used with mpp_start_group_update.
Deallocate given 1D or 2D domain.
Set up a domain decomposition.
Retrieve layout associated with a domain decomposition. Given a global 2D domain and the number of di...
Defines a nullified 1D or 2D domain.
Private interface to updates data domain of 3D field whose computational domains have been computed.
Private helper interface used by mpp_global_field.
Private interface used for mpp_update_domains.
Passes a data field from a unstructured grid to an structured grid  Example usage:
Used by mpp_update_nest_coarse to perform domain updates.
Get the boundary data for symmetric domain when the data is at C, E, or N-cell center....
These routines retrieve the axis specifications associated with the compute domains....
Retrieve the entire array of compute domain extents associated with a decomposition.
These routines retrieve the axis specifications associated with the data domains. The domain is a der...
Get the index of the data passed from fine grid to coarse grid.  Example usage:
These routines retrieve the axis specifications associated with the global domains....
Retrieve layout associated with a domain decomposition The 1D version of this call returns the number...
These routines retrieve the axis specifications associated with the memory domains....
Retrieve PE number of a neighboring domain.
Retrieve list of PEs associated with a domain decomposition. The 1D version of this call returns an a...
Fill in a global array from domain-decomposed arrays.
Same functionality as mpp_global_field but for unstructured domains.
Global max of domain-decomposed arrays.  mpp_global_max is used to get the maximum value of a domain-...
Global min of domain-decomposed arrays.  mpp_global_min is used to get the minimum value of a domain-...
Global sum of domain-decomposed arrays.  mpp_global_sum is used to get the sum of a domain-decomposed...
Modifies the extents (compute, data and global) of a given domain.
Nullify domain list. This interface is needed in mpp_domains_test. 1-D case can be added in if needed...
Passes data from a structured grid to an unstructured grid  Example usage:
Passes a data field from a structured grid to an unstructured grid  Example usage:
Reorganization of distributed global arrays.  mpp_redistribute is used to reorganize a distributed ar...
These routines set the axis specifications associated with the compute domains. The domain is a deriv...
These routines set the axis specifications associated with the data domains. The domain is a derived ...
These routines set the axis specifications associated with the global domains. The domain is a derive...
Private interface used for non blocking updates.
Starts non-blocking group update Must be followed up with a call to mpp_complete_group_update mpp_gro...
Interface to start halo updates mpp_start_update_domains is used to start a halo update of a domain-d...
Performs halo updates for a given domain.
Similar to mpp_update_domains , updates adjoint domains.
Pass the data from fine grid to fill the buffer to be ready to be interpolated onto coarse grid....
Pass the data from coarse grid to fill the buffer to be ready to be interpolated onto fine grid....
Type used to represent the contact between tiles.
One dimensional domain used to manage shared data access between pes.
A private type used to specify index limits for a domain decomposition.
The domain2D type contains all the necessary information to define the global, compute and data domai...
Private type to specify multiple index limits and pe information for a 2D domain.
Used to specify index limits along an axis of a domain.
Used for sending domain data between pe's.
Domain information for managing data on unstructured grids.
index bounds for use in nestSpec
used for updates on a group
domain with nested fine and course tiles
Private type to hold data for each level of nesting.
Used to specify bounds and index information for nested tiles as a linked list.
Used for nonblocking data transfer.
Type for overlapping data.
Private type for overlap specifications.
Upper and lower x and y bounds for a tile.
Private type for axis specification data for an unstructured grid.
Private type for axis specification data for an unstructured domain.
This interface uses a conversion to an integer representation of real numbers to give order-invariant...
subroutine, public mpp_memuse_end(text, unit)
End the memory collection, and report on total memory used during the execution of the model run.
subroutine, public mpp_memuse_begin
Initialize the memory module, and record the initial memory use.
subroutine mpp_sync_self(pelist, check, request, msg_size, msg_type)
This is to check if current PE's outstanding puts are complete but we can't use shmem_fence because w...
integer function stdout()
This function returns the current standard fortran unit numbers for output.
subroutine mpp_set_current_pelist(pelist, no_sync)
Set context pelist.
subroutine mpp_init(flags, localcomm, test_level, alt_input_nml_path)
Initialize the mpp_mod module. Must be called before any usage.
integer function stderr()
This function returns the current standard fortran unit numbers for error messages.
subroutine mpp_type_free(dtype)
Deallocates memory for mpp_type objects @TODO This should probably not take a pointer,...
subroutine mpp_declare_pelist(pelist, name, commID)
Declare a pelist.
integer function stdlog()
This function returns the current standard fortran unit numbers for log messages. Log messages,...
integer function mpp_npes()
Returns processor count for current pelist.
integer function mpp_pe()
Returns processor ID.
subroutine mpp_sync(pelist, do_self)
Synchronize PEs in list.
integer function mpp_clock_id(name, flags, grain)
Return an ID for a new or existing clock.
Scatter a vector across all PEs.
Perform parallel broadcasts.
Reduction operations. Find the max of scalar a from the PEs in pelist result is also automatically br...
Reduction operations. Find the min of scalar a from the PEs in pelist result is also automatically br...
Receive data from another PE.
Send data to a receiving PE.
Calculates sum of a given numerical array across pe's for adjoint domains.
Basic message-passing call.
Create a mpp_type variable.
Data types for generalized data transfer (e.g. MPI_Type)