FMS  2024.03
Flexible Modeling System
mpp_domains_misc.inc
1 ! -*-f90-*-
2 !***********************************************************************
3 !* GNU Lesser General Public License
4 !*
5 !* This file is part of the GFDL Flexible Modeling System (FMS).
6 !*
7 !* FMS is free software: you can redistribute it and/or modify it under
8 !* the terms of the GNU Lesser General Public License as published by
9 !* the Free Software Foundation, either version 3 of the License, or (at
10 !* your option) any later version.
11 !*
12 !* FMS is distributed in the hope that it will be useful, but WITHOUT
13 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 !* for more details.
16 !*
17 !* You should have received a copy of the GNU Lesser General Public
18 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
19 !***********************************************************************
20 
21 !> @file
22 !> @brief Initialization and finalization routines for @ref mpp_domains_mod as well
23 !! as other utility routines.
24 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
25 !> @ingroup mpp_domains_mod
26 !> @{
27 !!
28 ! !
29 ! MPP_DOMAINS: initialization and termination !
30 ! !
31 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
32 
33  !> @brief Initialize domain decomp package.
34  !!
35  !> Called to initialize the <TT>mpp_domains_mod</TT> package.
36  !! <TT>flags</TT> can be set to <TT>MPP_VERBOSE</TT> to have
37  !! <TT>mpp_domains_mod</TT> keep you informed of what it's up
38  !! to. <TT>MPP_DEBUG</TT> returns even more information for debugging.
39  !!
40  !! <TT>mpp_domains_init</TT> will call <TT>mpp_init</TT>, to make sure
41  !! <TT>@ref mpp_mod</TT> is initialized. (Repeated
42  !! calls to <TT>@ref mpp_init</TT> do no harm, so don't worry if you already
43  !! called it).
44  subroutine mpp_domains_init(flags)
45  integer, intent(in), optional :: flags
46  integer :: n
47  integer :: io_status, iunit
48 
49  if( module_is_initialized )return
50  call mpp_init(flags) !this is a no-op if already initialized
51  module_is_initialized = .true.
52  pe = mpp_root_pe()
53  iunit = stdlog()
54  if( mpp_pe() .EQ.mpp_root_pe() ) write( iunit,'(/a)' )'MPP_DOMAINS module '//trim(version)
55 
56  if( PRESENT(flags) )then
57  debug = flags.EQ.mpp_debug
58  verbose = flags.EQ.mpp_verbose .OR. debug
59  domain_clocks_on = flags.EQ.mpp_domain_time
60  end if
61 
62  !--- namelist
63  read (input_nml_file, mpp_domains_nml, iostat=io_status)
64  if (io_status > 0) then
65  call mpp_error(fatal,'=>mpp_domains_init: Error reading mpp_domains_nml')
66  endif
67 
68 
69  select case(lowercase(trim(debug_update_domain)))
70  case("none")
71  debug_update_level = no_check
72  case("fatal")
73  debug_update_level = fatal
74  case("warning")
75  debug_update_level = warning
76  case("note")
77  debug_update_level = note
78  case default
79  call mpp_error(fatal, "mpp_domains_init: debug_update_level should be 'none', 'fatal', 'warning', or 'note'")
80  end select
81 
82  allocate(nonblock_data(max_nonblock_update))
83 
84  do n = 1, max_nonblock_update
85  call init_nonblock_type(nonblock_data(n))
86  enddo
87 
88  call mpp_domains_set_stack_size(32768) !default, pretty arbitrary
89 
90 !NULL_DOMAIN is a domaintype that can be used to initialize to undef
91  call mpp_define_null_domain(null_domain1d);
92  call mpp_define_null_domain(null_domain2d);
93  call mpp_define_null_ug_domain(null_domainug)
94 
95  if( domain_clocks_on )then
96  pack_clock = mpp_clock_id( 'Halo pack' )
97  send_clock = mpp_clock_id( 'Halo send' )
98  recv_clock = mpp_clock_id( 'Halo recv' )
99  unpk_clock = mpp_clock_id( 'Halo unpk' )
100  wait_clock = mpp_clock_id( 'Halo wait' )
101  send_pack_clock_nonblock = mpp_clock_id( 'Halo pack and send nonblock' )
102  recv_clock_nonblock = mpp_clock_id( 'Halo recv nonblock' )
103  unpk_clock_nonblock = mpp_clock_id( 'Halo unpk nonblock' )
104  wait_clock_nonblock = mpp_clock_id( 'Halo wait nonblock' )
105  nest_pack_clock = mpp_clock_id( 'nest pack' )
106  nest_send_clock = mpp_clock_id( 'nest send' )
107  nest_recv_clock = mpp_clock_id( 'nest recv' )
108  nest_unpk_clock = mpp_clock_id( 'nest unpk' )
109  nest_wait_clock = mpp_clock_id( 'nest wait' )
110  group_pack_clock = mpp_clock_id( 'group pack' )
111  group_send_clock = mpp_clock_id( 'group send' )
112  group_recv_clock = mpp_clock_id( 'group recv' )
113  group_unpk_clock = mpp_clock_id( 'group unpk' )
114  group_wait_clock = mpp_clock_id( 'group wait' )
115  nonblock_group_pack_clock = mpp_clock_id( 'nonblock group pack' )
116  nonblock_group_send_clock = mpp_clock_id( 'nonblock group send' )
117  nonblock_group_recv_clock = mpp_clock_id( 'nonblock group recv' )
118  nonblock_group_unpk_clock = mpp_clock_id( 'nonblock group unpk' )
119  nonblock_group_wait_clock = mpp_clock_id( 'nonblock group wait' )
120  end if
121  return
122  end subroutine mpp_domains_init
123 
124 !#####################################################################
125 subroutine init_nonblock_type( nonblock_obj )
126  type(nonblock_type), intent(inout) :: nonblock_obj
127 
128 
129  nonblock_obj%recv_pos = 0
130  nonblock_obj%send_pos = 0
131  nonblock_obj%recv_msgsize = 0
132  nonblock_obj%send_msgsize = 0
133  nonblock_obj%update_flags = 0
134  nonblock_obj%update_position = 0
135  nonblock_obj%update_gridtype = 0
136  nonblock_obj%update_whalo = 0
137  nonblock_obj%update_ehalo = 0
138  nonblock_obj%update_shalo = 0
139  nonblock_obj%update_nhalo = 0
140  nonblock_obj%request_send_count = 0
141  nonblock_obj%request_recv_count = 0
142  nonblock_obj%size_recv(:) = 0
143  nonblock_obj%type_recv(:) = 0
144 #ifdef use_libMPI
145  nonblock_obj%request_send(:) = mpi_request_null
146  nonblock_obj%request_recv(:) = mpi_request_null
147 #else
148  nonblock_obj%request_send(:) = 0
149  nonblock_obj%request_recv(:) = 0
150 #endif
151  nonblock_obj%buffer_pos_send(:) = 0
152  nonblock_obj%buffer_pos_recv(:) = 0
153  nonblock_obj%nfields = 0
154  nonblock_obj%field_addrs(:) = 0
155  nonblock_obj%field_addrs2(:) = 0
156 
157  return
158 
159 end subroutine init_nonblock_type
160 
161 !#####################################################################
162 
163  !> @brief Exit <TT>mpp_domains_mod</TT>.
164  !! Serves no particular purpose, but is provided should you require to
165  !! re-initialize <TT>mpp_domains_mod</TT>, for some odd reason.
166  subroutine mpp_domains_exit()
167  integer :: iunit
168  if( .NOT.module_is_initialized )return
169  call mpp_max(mpp_domains_stack_hwm)
170  iunit = stdout()
171  if( mpp_pe().EQ.mpp_root_pe() )write( iunit,* )'MPP_DOMAINS_STACK high water mark=', mpp_domains_stack_hwm
172  module_is_initialized = .false.
173  return
174  end subroutine mpp_domains_exit
175 
176 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
177 ! !
178 ! MPP_CHECK_FIELD: Check parallel !
179 ! !
180 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
181 
182  !> This routine is used to do parallel checking for 3d data between n and m pe. The comparison is
183  !! is done on pelist2. When size of pelist2 is 1, we can check the halo; otherwise,
184  !! halo can not be checked.
185  subroutine mpp_check_field_3d(field_in, pelist1, pelist2, domain, mesg, &
186  w_halo, s_halo, e_halo, n_halo, force_abort, position )
187 
188  real, dimension(:,:,:), intent(in) :: field_in !< field to be checked
189  integer, dimension(:), intent(in) :: pelist1, pelist2 !< pe list for the two groups
190  type(domain2d), intent(in) :: domain !< domain for each pe
191  character(len=*), intent(in) :: mesg !< message to be printed out
192  !! if differences found
193  integer, intent(in), optional :: w_halo, s_halo, e_halo, n_halo
194  !< halo size for west, south, east and north
195  logical, intent(in), optional :: force_abort !< when true, call mpp_error if any difference
196  !! found. default value is false.
197  integer, intent(in), optional :: position !< when domain is symmetry, only value = CENTER is
198  !! implemented.
199 
200  integer :: k
201  character(len=256) :: temp_mesg
202 
203 
204  do k = 1, size(field_in,3)
205  write(temp_mesg, '(a, i3)') trim(mesg)//" at level " , k
206  call mpp_check_field_2d(field_in(:,:,k), pelist1, pelist2, domain, temp_mesg, &
207  w_halo, s_halo, e_halo, n_halo, force_abort, position )
208  enddo
209 
210  end subroutine mpp_check_field_3d
211 
212 
213 !#####################################################################################
214 
215  !> This routine is used to do parallel checking for 2d data between n and m pe. The comparison is
216  !! is done on pelist2. When size of pelist2 is 1, we can check the halo; otherwise,
217  !! halo can not be checked.
218  subroutine mpp_check_field_2d(field_in, pelist1, pelist2, domain, mesg, &
219  w_halo, s_halo, e_halo, n_halo,force_abort, position )
220 
221  real, dimension(:,:), intent(in) :: field_in !< field to be checked
222  integer, dimension(:), intent(in) :: pelist1, pelist2 !< pe list for the two groups
223  type(domain2d), intent(in) :: domain !< domain for each pe
224  character(len=*), intent(in) :: mesg !< message to be printed out
225  !! if differences found
226  integer, intent(in), optional :: w_halo, s_halo, e_halo, n_halo !< halo size for west, south, east and north
227  logical, intent(in), optional :: force_abort !< when true, call mpp_error if any difference
228  !! found. default value is false.
229  integer, intent(in), optional :: position !< when domain is symmetry, only value = CENTER is
230  !! implemented.
231 
232  if(present(position)) then
233  if(position .NE. center .AND. domain%symmetry) call mpp_error(fatal, &
234  'mpp_check_field: when domain is symmetry, only value CENTER is implemented, contact author')
235  endif
236 
237  if(size(pelist2(:)) == 1) then
238  call mpp_check_field_2d_type1(field_in, pelist1, pelist2, domain, mesg, &
239  w_halo, s_halo, e_halo, n_halo, force_abort )
240  else if(size(pelist1(:)) == 1) then
241  call mpp_check_field_2d_type1(field_in, pelist2, pelist1, domain, mesg, &
242  w_halo, s_halo, e_halo, n_halo, force_abort )
243  else if(size(pelist1(:)) .gt. 1 .and. size(pelist2(:)) .gt. 1) then
244  call mpp_check_field_2d_type2(field_in, pelist1, pelist2, domain, mesg, force_abort )
245  else
246  call mpp_error(fatal, 'mpp_check_field: size of both pelists should be greater than 0')
247  endif
248 
249  end subroutine mpp_check_field_2d
250 
251 
252 !####################################################################################
253 
254  !> This routine is used to check field between running on 1 pe (pelist2) and
255  !! n pe(pelist1). The need_to_be_checked data is sent to the pelist2 and All the
256  !! comparison is done on pelist2.
257  subroutine mpp_check_field_2d_type1(field_in, pelist1, pelist2, domain, mesg, &
258  w_halo, s_halo, e_halo, n_halo,force_abort )
259 
260  real, dimension(:,:), intent(in) :: field_in !< field to be checked
261  integer, dimension(:), intent(in) :: pelist1, pelist2 !< pe list for the two groups
262  type(domain2d), intent(in) :: domain !< domain for each pe
263  character(len=*), intent(in) :: mesg !< message to be printed out
264  !! if differences found
265  integer, intent(in), optional :: w_halo, s_halo, e_halo, n_halo !< halo size for west, south, east and north
266  logical, intent(in), optional :: force_abort !< when, call mpp_error if any difference
267  !! found. default value is false.
268 ! some local data
269 
270  integer :: pe,npes, p
271  integer :: hwest, hsouth, heast, hnorth, isg, ieg, jsg, jeg, xhalo, yhalo
272  integer :: i,j,im,jm,l,is,ie,js,je,isc,iec,jsc,jec,isd,ied,jsd,jed
273  real,dimension(:,:), allocatable :: field1,field2
274  real,dimension(:), allocatable :: send_buffer
275  integer, dimension(4) :: ibounds
276  logical :: check_success, error_exit
277 
278  check_success = .true.
279  error_exit = .false.
280  if(present(force_abort)) error_exit = force_abort
281  hwest = 0; if(present(w_halo)) hwest = w_halo
282  heast = 0; if(present(e_halo)) heast = e_halo
283  hsouth = 0; if(present(s_halo)) hsouth = s_halo
284  hnorth = 0; if(present(n_halo)) hnorth = n_halo
285 
286  pe = mpp_pe()
287  npes = mpp_npes()
288 
289  call mpp_get_compute_domain(domain, isc, iec, jsc, jec)
290  call mpp_get_data_domain(domain, isd, ied, jsd, jed)
291  call mpp_get_global_domain(domain, isg, ieg, jsg, jeg)
292  xhalo = isc - isd
293  yhalo = jsc - jsd
294  !--- need to checked halo size should not be bigger than x_halo or y_halo
295  if(hwest .gt. xhalo .or. heast .gt. xhalo .or. hsouth .gt. yhalo .or. hnorth .gt. yhalo) &
296  call mpp_error(fatal,'mpp_check_field: '//trim(mesg)//': The halo size is not correct')
297 
298  is = isc - hwest; ie = iec + heast; js = jsc - hsouth; je = jec + hnorth
299  allocate(field2(is:ie,js:je))
300 
301  ! check if the field_in is on compute domain or data domain
302  if((size(field_in,1) .eq. iec-isc+1) .and. (size(field_in,2) .eq. jec-jsc+1)) then
303  !if field_in on compute domain, you can not check halo points
304  if( hwest .ne. 0 .or. heast .ne. 0 .or. hsouth .ne. 0 .or. hnorth .ne. 0 ) &
305  call mpp_error(fatal,'mpp_check_field: '//trim(mesg)//': field is on compute domain, can not check halo')
306  field2(:,:) = field_in(:,:)
307  else if((size(field_in,1) .eq. ied-isd+1) .and. (size(field_in,2) .eq. jed-jsd+1)) then
308  field2(is:ie,js:je) = field_in(is-isd+1:ie-isd+1,js-jsd+1:je-jsd+1)
309  else if((size(field_in,1) .eq. ieg-isg+1) .and. (size(field_in,2) .eq. jeg-jsg+1)) then
310  if( hwest .ne. 0 .or. heast .ne. 0 .or. hsouth .ne. 0 .or. hnorth .ne. 0 ) &
311  call mpp_error(fatal,'mpp_check_field: '//trim(mesg)//': field is on compute domain, can not check halo')
312  field2(is:ie,js:je) = field_in(1:ie-is+1,1:je-js+1)
313  else if((size(field_in,1) .eq. ieg-isg+1+2*xhalo) .and. (size(field_in,2) .eq. jeg-jsg+1+2*yhalo)) then
314  field2(is:ie,js:je) = field_in(is-isd+1:ie-isd+1,js-jsd+1:je-jsd+1)
315  else
316  print*, 'on pe ', pe, 'domain: ', isc, iec, jsc, jec, isd, ied, jsd, jed, 'size of field: ', size(field_in,1), &
317  & size(field_in,2)
318  call mpp_error(fatal,'mpp_check_field: '//trim(mesg)//':field is not on compute, data or global domain')
319  endif
320 
321  call mpp_sync_self()
322 
323  if(any(pelist1 == pe)) then ! send data to root pe
324 
325  im = ie-is+1; jm=je-js+1
326  allocate(send_buffer(im*jm))
327 
328  ibounds(1) = is; ibounds(2) = ie; ibounds(3) = js; ibounds(4) = je
329  l = 0
330  do i = is,ie
331  do j = js,je
332  l = l+1
333  send_buffer(l) = field2(i,j)
334  enddo
335  enddo
336 ! send the check bounds and data to the root pe
337  ! Force use of "scalar", integer pointer mpp interface
338  call mpp_send(ibounds(1), plen=4, to_pe=pelist2(1), tag=comm_tag_1)
339  call mpp_send(send_buffer(1),plen=im*jm, to_pe=pelist2(1), tag=comm_tag_2)
340  deallocate(send_buffer)
341 
342  else if(pelist2(1) == pe) then ! receive data and compare
343  do p = pelist1(1), pelist1(size(pelist1(:)))
344  ! Force use of "scalar", integer pointer mpp interface
345  call mpp_recv(ibounds(1), glen=4,from_pe=p, tag=comm_tag_1)
346  is = ibounds(1); ie = ibounds(2); js=ibounds(3); je=ibounds(4)
347  im = ie-is+1; jm=je-js+1
348  if(allocated(field1)) deallocate(field1)
349  if(allocated(send_buffer)) deallocate(send_buffer)
350  allocate(field1(is:ie,js:je),send_buffer(im*jm))
351  ! Force use of "scalar", integer pointer mpp interface
352  call mpp_recv(send_buffer(1),glen=im*jm,from_pe=p, tag=comm_tag_2)
353  l = 0
354 
355 ! compare here, the comparison criteria can be changed according to need
356  do i = is,ie
357  do j = js,je
358  l = l+1
359  field1(i,j) = send_buffer(l)
360  if(field1(i,j) .ne. field2(i,j)) then
361  ! write to standard output
362  print*,trim(mesg)//": ", i, j, field1(i,j), field2(i,j), field1(i,j) - field2(i,j)
363 ! write(stdout(),'(a,2i,2f)') trim(mesg), i, j, pass_field(i,j), field_check(i,j)
364  check_success = .false.
365  if(error_exit) call mpp_error(fatal,"mpp_check_field: can not reproduce at this point")
366  endif
367  enddo
368  enddo
369  enddo
370 
371  if(check_success) then
372  print*, trim(mesg)//": ", 'comparison between 1 pe and ', npes-1, ' pes is ok'
373  endif
374  ! release memery
375  deallocate(field1, send_buffer)
376  endif
377 
378  deallocate(field2)
379 
380  call mpp_sync()
381 
382  end subroutine mpp_check_field_2d_type1
383 
384 !####################################################################
385 
386  !> This routine is used to check field between running on m pe (root pe) and
387  !! n pe. This routine can not check halo.
388  subroutine mpp_check_field_2d_type2(field_in, pelist1, pelist2, domain, mesg,force_abort)
389 
390  real, dimension(:,:), intent(in) :: field_in
391  type(domain2d), intent(in) :: domain
392  integer, dimension(:), intent(in) :: pelist1
393  integer, dimension(:), intent(in) :: pelist2
394  character(len=*), intent(in) :: mesg
395  logical, intent(in), optional :: force_abort !< when, call mpp_error if any difference
396  !! found. default value is false.
397 ! some local variables
398  logical :: check_success, error_exit
399  real, dimension(:,:), allocatable :: field1, field2
400  integer :: i, j, pe, npes, isd,ied,jsd,jed, is, ie, js, je
401  type(domain2d) :: domain1, domain2
402 
403  check_success = .true.
404  error_exit = .false.
405  if(present(force_abort)) error_exit = force_abort
406  pe = mpp_pe()
407  npes = mpp_npes()
408  call mpp_sync_self()
409  if(any(pelist1 == pe)) domain1 = domain
410  if(any(pelist2 == pe)) domain2 = domain
411 
412 ! Comparison is made on pelist2.
413  if(any(pelist2 == pe)) then
414  call mpp_get_data_domain(domain2, isd, ied, jsd, jed)
415  call mpp_get_compute_domain(domain2, is, ie, js, je)
416  allocate(field1(isd:ied, jsd:jed),field2(isd:ied, jsd:jed))
417  if((size(field_in,1) .ne. ied-isd+1) .or. (size(field_in,2) .ne. jed-jsd+1)) &
418  call mpp_error(fatal,'mpp_check_field: input field is not on the data domain')
419  field2(isd:ied, jsd:jed) = field_in(:,:)
420  endif
421 
422 ! allocate field1 on pelist1
423 ! if field1 is left unallocated, the code will try to access unallocated memory
424 ! when field1 is set to 0 in mpp_redistribute
425  if(any(pelist1 == pe)) then
426  allocate(field1(1,1))
427  endif
428 
429 ! broadcast domain
430  call mpp_broadcast_domain(domain1)
431  call mpp_broadcast_domain(domain2)
432 
433  call mpp_redistribute(domain1,field_in,domain2,field1)
434 
435  if(any(pelist2 == pe)) then
436  do i =is,ie
437  do j =js,je
438  if(field1(i,j) .ne. field2(i,j)) then
439  print*, trim(mesg)//": ", i, j, field1(i,j), field2(i,j), field1(i,j) - field2(i,j)
440 ! write(stdout(),'(a,2i,2f)') trim(mesg), i, j, field_check(i,j), field_out(i,j)
441  check_success = .false.
442  if(error_exit) call mpp_error(fatal,"mpp_check_field: can not reproduce at this point")
443  endif
444  enddo
445  enddo
446  if(check_success) &
447  print*, trim(mesg)//": ", 'comparison between ', size(pelist1(:)), ' pes and ', &
448  size(pelist2(:)), ' pe on', pe, ' pes is ok'
449  endif
450 
451  if(any(pelist2 == pe)) deallocate(field1, field2)
452 
453  if(any(pelist1 == pe)) deallocate(field1)
454 
455  call mpp_sync()
456 
457  return
458 
459  end subroutine mpp_check_field_2d_type2
460 
461 
462 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
463 ! !
464 ! MPP_BROADCAST_DOMAIN !
465 ! !
466 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
467 
468  !> broadcast domain (useful only outside the context of its own pelist)
469  subroutine mpp_broadcast_domain_1( domain )
470  type(domain2d), intent(inout) :: domain
471  integer, allocatable :: pes(:)
472  logical :: native !> true if I'm on the pelist of this domain
473  integer :: listsize, listpos
474  integer :: n
475  integer, dimension(12) :: msg, info !> pe and compute domain of each item in list
476  integer :: errunit
477 
478  errunit = stderr()
479  if( .NOT.module_is_initialized ) &
480  call mpp_error( fatal, 'MPP_BROADCAST_DOMAIN_1: You must first call mpp_domains_init.' )
481 
482 !get the current pelist
483  allocate( pes(0:mpp_npes()-1) )
484  call mpp_get_current_pelist(pes)
485 
486 !am I part of this domain?
487  native = ASSOCIATED(domain%list)
488 
489 !set local list size
490  if( native )then
491  listsize = size(domain%list(:))
492  else
493  listsize = 0
494  end if
495  call mpp_max(listsize)
496 
497  if( .NOT.native )then
498 !initialize domain%list and set null values in message
499  allocate( domain%list(0:listsize-1) )
500  domain%pe = null_pe
501  domain%pos = -1
502  allocate(domain%x(1), domain%y(1), domain%tile_id(1))
503  do n = 0, listsize-1
504  allocate(domain%list(n)%x(1), domain%list(n)%y(1), domain%list(n)%tile_id(1) )
505  end do
506  domain%x%compute%begin = 1
507  domain%x%compute%end = -1
508  domain%y%compute%begin = 1
509  domain%y%compute%end = -1
510  domain%x%domain_data %begin = -1
511  domain%x%domain_data %end = -1
512  domain%y%domain_data %begin = -1
513  domain%y%domain_data %end = -1
514  domain%x%global %begin = -1
515  domain%x%global %end = -1
516  domain%y%global %begin = -1
517  domain%y%global %end = -1
518  domain%tile_id = -1
519  domain%whalo = -1
520  domain%ehalo = -1
521  domain%shalo = -1
522  domain%nhalo = -1
523  domain%symmetry = .false.
524  end if
525 !initialize values in info
526  info(1) = domain%pe
527  call mpp_get_compute_domain( domain, info(2), info(3), info(4), info(5) )
528  info(6) = domain%tile_id(1)
529  info(7) = domain%whalo
530  info(8) = domain%ehalo
531  info(9) = domain%shalo
532  info(10)= domain%nhalo
533  if(domain%symmetry) then
534  info(11) = 1
535  else
536  info(11) = 0
537  endif
538  info(12) = domain%ntiles
539 !broadcast your info across current pelist and unpack if needed
540  listpos = 0
541  do n = 0,mpp_npes()-1
542  msg = info
543  if( mpp_pe().EQ.pes(n) .AND. debug )write( errunit,* )'PE ', mpp_pe(), 'broadcasting msg ', msg
544  call mpp_broadcast( msg, 12, pes(n) )
545 !no need to unpack message if native
546 !no need to unpack message from non-native PE
547  if( .NOT.native .AND. msg(1).NE.null_pe )then
548  domain%list(listpos)%pe = msg(1)
549  domain%list(listpos)%x%compute%begin = msg(2)
550  domain%list(listpos)%x%compute%end = msg(3)
551  domain%list(listpos)%y%compute%begin = msg(4)
552  domain%list(listpos)%y%compute%end = msg(5)
553  domain%list(listpos)%tile_id(1) = msg(6)
554  if(domain%x(1)%global%begin < 0) then
555  domain%x(1)%domain_data %begin = msg(2)
556  domain%x(1)%domain_data %end = msg(3)
557  domain%y(1)%domain_data %begin = msg(4)
558  domain%y(1)%domain_data %end = msg(5)
559  domain%x(1)%global%begin = msg(2)
560  domain%x(1)%global%end = msg(3)
561  domain%y(1)%global%begin = msg(4)
562  domain%y(1)%global%end = msg(5)
563  domain%whalo = msg(7)
564  domain%ehalo = msg(8)
565  domain%shalo = msg(9)
566  domain%nhalo = msg(10)
567  if(msg(11) == 1) then
568  domain%symmetry = .true.
569  else
570  domain%symmetry = .false.
571  endif
572  domain%ntiles = msg(12)
573  else
574  domain%x(1)%domain_data %begin = msg(2) - msg(7)
575  domain%x(1)%domain_data %end = msg(3) + msg(8)
576  domain%y(1)%domain_data %begin = msg(4) - msg(9)
577  domain%y(1)%domain_data %end = msg(5) + msg(10)
578  domain%x(1)%global%begin = min(domain%x(1)%global%begin, msg(2))
579  domain%x(1)%global%end = max(domain%x(1)%global%end, msg(3))
580  domain%y(1)%global%begin = min(domain%y(1)%global%begin, msg(4))
581  domain%y(1)%global%end = max(domain%y(1)%global%end, msg(5))
582  endif
583  listpos = listpos + 1
584  if( debug )write( errunit,* )'PE ', mpp_pe(), 'received domain from PE ', msg(1), 'is,ie,js,je=', msg(2:5)
585  end if
586  end do
587 
588  end subroutine mpp_broadcast_domain_1
589 
590 
591 !##############################################################################
592  !> Broadcast domain (useful only outside the context of its own pelist)
593  subroutine mpp_broadcast_domain_2( domain_in, domain_out )
594  type(domain2d), intent(in) :: domain_in
595  type(domain2d), intent(inout) :: domain_out
596  integer, allocatable :: pes(:)
597  integer :: listpos
598  integer :: n
599  integer, dimension(12) :: msg, info !< pe and compute domain of each item in list
600  integer :: errunit, npes_in, npes_out, pstart, pend
601 
602  errunit = stderr()
603  if( .NOT.module_is_initialized ) &
604  call mpp_error( fatal, 'MPP_BROADCAST_DOMAIN_2: You must first call mpp_domains_init.' )
605 
606 !get the current pelist
607  allocate( pes(0:mpp_npes()-1) )
608  call mpp_get_current_pelist(pes)
609 
610 ! domain_in must be initialized
611  if( .not. ASSOCIATED(domain_in%list) ) then
612  call mpp_error( fatal, 'MPP_BROADCAST_DOMAIN_2: domain_in is not initialized')
613  endif
614  if( ASSOCIATED(domain_out%list) ) then
615  call mpp_error( fatal, 'MPP_BROADCAST_DOMAIN_2: domain_out is already initialized')
616  endif
617 
618  npes_in = size(domain_in%list(:))
619  if( npes_in == mpp_npes() ) then
620  call mpp_error( fatal, 'MPP_BROADCAST_DOMAIN_2: size(domain_in%list(:)) == mpp_npes()')
621  endif
622  npes_out = mpp_npes() - npes_in
623 
624 !initialize domain_out%list and set null values in message
625  allocate( domain_out%list(0:npes_out-1) )
626  domain_out%pe = null_pe
627  domain_out%pos = -1
628  allocate(domain_out%x(1), domain_out%y(1), domain_out%tile_id(1))
629  do n = 0, npes_out-1
630  allocate(domain_out%list(n)%x(1), domain_out%list(n)%y(1), domain_out%list(n)%tile_id(1) )
631  end do
632  domain_out%x%compute%begin = 1
633  domain_out%x%compute%end = -1
634  domain_out%y%compute%begin = 1
635  domain_out%y%compute%end = -1
636  domain_out%x%domain_data %begin = -1
637  domain_out%x%domain_data %end = -1
638  domain_out%y%domain_data %begin = -1
639  domain_out%y%domain_data %end = -1
640  domain_out%x%global %begin = -1
641  domain_out%x%global %end = -1
642  domain_out%y%global %begin = -1
643  domain_out%y%global %end = -1
644  domain_out%tile_id = -1
645  domain_out%whalo = -1
646  domain_out%ehalo = -1
647  domain_out%shalo = -1
648  domain_out%nhalo = -1
649  domain_out%symmetry = .false.
650 !initialize values in info
651  info(1) = domain_in%pe
652  call mpp_get_compute_domain( domain_in, info(2), info(3), info(4), info(5) )
653  info(6) = domain_in%tile_id(1)
654  info(7) = domain_in%whalo
655  info(8) = domain_in%ehalo
656  info(9) = domain_in%shalo
657  info(10)= domain_in%nhalo
658  if(domain_in%symmetry) then
659  info(11) = 1
660  else
661  info(11) = 0
662  endif
663  info(12) = domain_in%ntiles
664 
665 !broadcast your info across current pelist and unpack if needed
666  if( domain_in%list(0)%pe == mpp_root_pe() ) then
667  pstart = npes_in
668  pend = mpp_npes()-1
669  else
670  pstart = 0
671  pend = npes_out-1
672  endif
673  do n = 0,mpp_npes()-1
674  msg = info
675  if( mpp_pe().EQ.pes(n) .AND. debug )write( errunit,* )'PE ', mpp_pe(), 'broadcasting msg ', msg
676  call mpp_broadcast( msg, 12, pes(n) )
677  !--- pack if from other domain
678  if( n .GE. pstart .AND. n .LE. pend )then
679  listpos = n - pstart
680  domain_out%list(listpos)%pe = msg(1)
681  domain_out%list(listpos)%x%compute%begin = msg(2)
682  domain_out%list(listpos)%x%compute%end = msg(3)
683  domain_out%list(listpos)%y%compute%begin = msg(4)
684  domain_out%list(listpos)%y%compute%end = msg(5)
685  domain_out%list(listpos)%tile_id(1) = msg(6)
686  if(domain_out%x(1)%global%begin < 0) then
687  domain_out%x(1)%domain_data %begin = msg(2)
688  domain_out%x(1)%domain_data %end = msg(3)
689  domain_out%y(1)%domain_data %begin = msg(4)
690  domain_out%y(1)%domain_data %end = msg(5)
691  domain_out%x(1)%global%begin = msg(2)
692  domain_out%x(1)%global%end = msg(3)
693  domain_out%y(1)%global%begin = msg(4)
694  domain_out%y(1)%global%end = msg(5)
695  domain_out%whalo = msg(7)
696  domain_out%ehalo = msg(8)
697  domain_out%shalo = msg(9)
698  domain_out%nhalo = msg(10)
699  if(msg(11) == 1) then
700  domain_out%symmetry = .true.
701  else
702  domain_out%symmetry = .false.
703  endif
704  domain_out%ntiles = msg(12)
705  else
706  domain_out%x(1)%domain_data %begin = msg(2) - msg(7)
707  domain_out%x(1)%domain_data %end = msg(3) + msg(8)
708  domain_out%y(1)%domain_data %begin = msg(4) - msg(9)
709  domain_out%y(1)%domain_data %end = msg(5) + msg(10)
710  domain_out%x(1)%global%begin = min(domain_out%x(1)%global%begin, msg(2))
711  domain_out%x(1)%global%end = max(domain_out%x(1)%global%end, msg(3))
712  domain_out%y(1)%global%begin = min(domain_out%y(1)%global%begin, msg(4))
713  domain_out%y(1)%global%end = max(domain_out%y(1)%global%end, msg(5))
714  endif
715  if( debug )write( errunit,* )'PE ', mpp_pe(), 'received domain from PE ', msg(1), 'is,ie,js,je=', msg(2:5)
716  end if
717  end do
718 
719  end subroutine mpp_broadcast_domain_2
720 
721  !> Broadcast fine nested domain (useful only outside the context of its own pelist)
722  subroutine mpp_broadcast_domain_nest_fine( domain, tile_nest )
723  type(domain2d), intent(inout) :: domain
724  integer, intent(in) :: tile_nest(:)
725  integer, allocatable :: pes(:)
726  logical :: native !< true if I'm on the pelist of this domain
727  integer :: listsize, listpos, nestsize(size(tile_nest(:)))
728  integer :: n, tile, ind, num_nest
729  integer, dimension(15) :: msg, info !< pe and compute domain of each item in list
730  integer :: errunit
731 
732  errunit = stderr()
733  if( .NOT.module_is_initialized ) &
734  call mpp_error( fatal, 'MPP_BROADCAST_DOMAIN_NEST_FINE: You must first call mpp_domains_init.' )
735 
736 !get the current pelist
737  allocate( pes(0:mpp_npes()-1) )
738  call mpp_get_current_pelist(pes)
739 
740 !am I part of this domain?
741  native = ASSOCIATED(domain%list)
742  num_nest = size(tile_nest(:))
743 !set local list size
744  nestsize = 0
745  if( native )then
746  tile = domain%tile_id(1)
747  ind = 0
748  do n = 1, num_nest
749  if(tile_nest(n) == tile) then
750  ind = n
751  exit
752  endif
753  enddo
754  if(ind == 0) call mpp_error( fatal, &
755  & 'MPP_BROADCAST_DOMAIN_NEST_FINE:native is true, but tile_id is found in tile_nest')
756  nestsize(ind) = size(domain%list(:))
757  end if
758  call mpp_max(nestsize, num_nest)
759  listsize = sum(nestsize)
760 
761  if( .NOT.native )then
762 !initialize domain%list and set null values in message
763  allocate( domain%list(0:listsize-1) )
764  domain%pe = null_pe
765  domain%pos = -1
766  allocate(domain%x(1), domain%y(1), domain%tile_id(1))
767  do n = 0, listsize-1
768  allocate(domain%list(n)%x(1), domain%list(n)%y(1), domain%list(n)%tile_id(1) )
769  end do
770  domain%x%compute%begin = 0
771  domain%x%compute%end = -1
772  domain%y%compute%begin = 0
773  domain%y%compute%end = -1
774  domain%x%domain_data %begin = 0
775  domain%x%domain_data %end = -1
776  domain%y%domain_data %begin = 0
777  domain%y%domain_data %end = -1
778  domain%x%global %begin = 0
779  domain%x%global %end = -1
780  domain%y%global %begin = 0
781  domain%y%global %end = -1
782  domain%tile_id = -1
783  domain%whalo = -1
784  domain%ehalo = -1
785  domain%shalo = -1
786  domain%nhalo = -1
787  domain%symmetry = .false.
788  end if
789 !initialize values in info
790  info(1) = domain%pe
791  call mpp_get_compute_domain( domain, info(2), info(3), info(4), info(5) )
792  info(6) = domain%tile_id(1)
793  info(7) = domain%whalo
794  info(8) = domain%ehalo
795  info(9) = domain%shalo
796  info(10)= domain%nhalo
797  if(domain%symmetry) then
798  info(11) = 1
799  else
800  info(11) = 0
801  endif
802  call mpp_get_global_domain( domain, info(12), info(13), info(14), info(15) )
803 !broadcast your info across current pelist and unpack if needed
804  listpos = 0
805  do n = 0,mpp_npes()-1
806  msg = info
807  if( mpp_pe().EQ.pes(n) .AND. debug )write( errunit,* )'PE ', mpp_pe(), 'broadcasting msg ', msg
808  call mpp_broadcast( msg, 15, pes(n) )
809 !no need to unpack message if native
810 !no need to unpack message from non-native PE
811  if( .NOT.native .AND. msg(1).NE.null_pe )then
812  domain%list(listpos)%pe = msg(1)
813  if(domain%x(1)%compute%begin == 0) then
814  domain%whalo = msg(7)
815  domain%ehalo = msg(8)
816  domain%shalo = msg(9)
817  domain%nhalo = msg(10)
818  if(msg(11) == 1) then
819  domain%symmetry = .true.
820  else
821  domain%symmetry = .false.
822  endif
823  endif
824  domain%list(listpos)%x%compute%begin = msg(2)
825  domain%list(listpos)%x%compute%end = msg(3)
826  domain%list(listpos)%y%compute%begin = msg(4)
827  domain%list(listpos)%y%compute%end = msg(5)
828  domain%list(listpos)%tile_id(1) = msg(6)
829  domain%list(listpos)%x%global %begin = msg(12)
830  domain%list(listpos)%x%global %end = msg(13)
831  domain%list(listpos)%y%global %begin = msg(14)
832  domain%list(listpos)%y%global %end = msg(15)
833  listpos = listpos + 1
834  if( debug )write( errunit,* )'PE ', mpp_pe(), 'received domain from PE ', msg(1), 'is,ie,js,je=', msg(2:5)
835  end if
836  end do
837 
838  end subroutine mpp_broadcast_domain_nest_fine
839 
840  !> Broadcast nested domain (useful only outside the context of its own pelist)
841  subroutine mpp_broadcast_domain_nest_coarse( domain, tile_coarse )
842  type(domain2d), intent(inout) :: domain
843  integer, intent(in) :: tile_coarse
844  integer, allocatable :: pes(:)
845  logical :: native !< true if I'm on the pelist of this domain
846  integer :: listsize, listpos
847  integer, allocatable :: tile_pesize(:)
848  integer :: n, maxtile
849  integer, dimension(17) :: msg, info !< pe and compute domain of each item in list
850  integer :: errunit
851 
852  errunit = stderr()
853  if( .NOT.module_is_initialized ) &
854  call mpp_error( fatal, 'MPP_BROADCAST_DOMAIN_NEST_COARSE: You must first call mpp_domains_init.' )
855 
856 !get the current pelist
857  allocate( pes(0:mpp_npes()-1) )
858  call mpp_get_current_pelist(pes)
859 
860  maxtile = tile_coarse
861  call mpp_max(maxtile)
862  allocate(tile_pesize(maxtile))
863  tile_pesize = 0
864 !am I part of this domain?
865  native = ASSOCIATED(domain%list)
866 !set local list size
867  if( native )then
868 ! tile = domain%tile_id(1)
869 ! if(tile .NE. tile_coarse) then
870 ! print*, "tile,tile_coarse=", tile, tile_coarse, mpp_pe()
871 ! call mpp_error( FATAL, 'MPP_BROADCAST_DOMAIN_NEST_COARSE: tile .NE. tile_coarse')
872 ! endif
873  tile_pesize(tile_coarse) = size(domain%list(:))
874  end if
875  call mpp_max(tile_pesize, maxtile)
876  listsize = tile_pesize(tile_coarse)
877 
878  if( .NOT.native )then
879 !initialize domain%list and set null values in message
880  allocate( domain%list(0:listsize-1) )
881  domain%pe = null_pe
882  domain%pos = -1
883  allocate(domain%x(1), domain%y(1), domain%tile_id(1))
884  do n = 0, listsize-1
885  allocate(domain%list(n)%x(1), domain%list(n)%y(1), domain%list(n)%tile_id(1) )
886  end do
887  domain%x%compute%begin = 0
888  domain%x%compute%end = -1
889  domain%y%compute%begin = 0
890  domain%y%compute%end = -1
891  domain%x%domain_data %begin = 0
892  domain%x%domain_data %end = -1
893  domain%y%domain_data %begin = 0
894  domain%y%domain_data %end = -1
895  domain%x%global %begin = 0
896  domain%x%global %end = -1
897  domain%y%global %begin = 0
898  domain%y%global %end = -1
899  domain%tile_id = -1
900  domain%whalo = -1
901  domain%ehalo = -1
902  domain%shalo = -1
903  domain%nhalo = -1
904  domain%symmetry = .false.
905  domain%ntiles = 0
906  end if
907 !initialize values in info
908  info(1) = domain%pe
909  call mpp_get_compute_domain( domain, info(2), info(3), info(4), info(5) )
910  info(6) = domain%tile_id(1)
911  info(7) = domain%whalo
912  info(8) = domain%ehalo
913  info(9) = domain%shalo
914  info(10)= domain%nhalo
915  if(domain%symmetry) then
916  info(11) = 1
917  else
918  info(11) = 0
919  endif
920  call mpp_get_global_domain( domain, info(12), info(13), info(14), info(15) )
921  info(16) = tile_coarse
922  info(17) = domain%ntiles
923 !broadcast your info across current pelist and unpack if needed
924  listpos = 0
925  do n = 0,mpp_npes()-1
926  msg = info
927  call mpp_broadcast( msg, 17, pes(n) )
928 !no need to unpack message if native
929 !no need to unpack message from non-native PE
930  if( .NOT.native .AND. msg(1).NE.null_pe .AND. tile_coarse==msg(16) )then
931  domain%list(listpos)%pe = msg(1)
932  if(domain%x(1)%compute%begin == 0) then
933  domain%x(1)%domain_data %begin = msg(2) - msg(7)
934  domain%x(1)%domain_data %end = msg(3) + msg(8)
935  domain%y(1)%domain_data %begin = msg(4) - msg(9)
936  domain%y(1)%domain_data %end = msg(5) + msg(10)
937  domain%x(1)%global%begin = msg(12)
938  domain%x(1)%global%end = msg(13)
939  domain%y(1)%global%begin = msg(14)
940  domain%y(1)%global%end = msg(15)
941  domain%whalo = msg(7)
942  domain%ehalo = msg(8)
943  domain%shalo = msg(9)
944  domain%nhalo = msg(10)
945  domain%ntiles = msg(17)
946  if(msg(11) == 1) then
947  domain%symmetry = .true.
948  else
949  domain%symmetry = .false.
950  endif
951  endif
952  domain%list(listpos)%x%compute%begin = msg(2)
953  domain%list(listpos)%x%compute%end = msg(3)
954  domain%list(listpos)%y%compute%begin = msg(4)
955  domain%list(listpos)%y%compute%end = msg(5)
956  domain%list(listpos)%tile_id(1) = msg(6)
957  domain%list(listpos)%x%global %begin = msg(12)
958  domain%list(listpos)%x%global %end = msg(13)
959  domain%list(listpos)%y%global %begin = msg(14)
960  domain%list(listpos)%y%global %end = msg(15)
961  listpos = listpos + 1
962  if( debug )write( errunit,* )'PE ', mpp_pe(), 'received domain from PE ', msg(1), 'is,ie,js,je=', msg(2:5)
963  end if
964  end do
965 
966  end subroutine mpp_broadcast_domain_nest_coarse
967 !> @}
968 
969 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
970 ! !
971 ! MPP_UPDATE_DOMAINS: fill halos for 2D decomposition !
972 ! !
973 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
974 
975 #undef VECTOR_FIELD_
976 #define VECTOR_FIELD_
977 #undef MPP_TYPE_
978 #define MPP_TYPE_ real(r8_kind)
979 #undef MPP_UPDATE_DOMAINS_2D_
980 #define MPP_UPDATE_DOMAINS_2D_ mpp_update_domain2D_r8_2D
981 #undef MPP_UPDATE_DOMAINS_3D_
982 #define MPP_UPDATE_DOMAINS_3D_ mpp_update_domain2D_r8_3D
983 #undef MPP_UPDATE_DOMAINS_4D_
984 #define MPP_UPDATE_DOMAINS_4D_ mpp_update_domain2D_r8_4D
985 #undef MPP_UPDATE_DOMAINS_5D_
986 #define MPP_UPDATE_DOMAINS_5D_ mpp_update_domain2D_r8_5D
987 #ifdef VECTOR_FIELD_
988 #undef MPP_UPDATE_DOMAINS_2D_V_
989 #define MPP_UPDATE_DOMAINS_2D_V_ mpp_update_domain2D_r8_2Dv
990 #undef MPP_UPDATE_DOMAINS_3D_V_
991 #define MPP_UPDATE_DOMAINS_3D_V_ mpp_update_domain2D_r8_3Dv
992 #undef MPP_UPDATE_DOMAINS_4D_V_
993 #define MPP_UPDATE_DOMAINS_4D_V_ mpp_update_domain2D_r8_4Dv
994 #undef MPP_UPDATE_DOMAINS_5D_V_
995 #define MPP_UPDATE_DOMAINS_5D_V_ mpp_update_domain2D_r8_5Dv
996 #endif
997 #undef MPP_REDISTRIBUTE_2D_
998 #define MPP_REDISTRIBUTE_2D_ mpp_redistribute_r8_2D
999 #undef MPP_REDISTRIBUTE_3D_
1000 #define MPP_REDISTRIBUTE_3D_ mpp_redistribute_r8_3D
1001 #undef MPP_REDISTRIBUTE_4D_
1002 #define MPP_REDISTRIBUTE_4D_ mpp_redistribute_r8_4D
1003 #undef MPP_REDISTRIBUTE_5D_
1004 #define MPP_REDISTRIBUTE_5D_ mpp_redistribute_r8_5D
1005 #include <mpp_update_domains2D.fh>
1006 #undef VECTOR_FIELD_
1007 
1008 #ifdef OVERLOAD_C8
1009 #undef MPP_TYPE_
1010 #define MPP_TYPE_ complex(c8_kind)
1011 #undef MPP_UPDATE_DOMAINS_2D_
1012 #define MPP_UPDATE_DOMAINS_2D_ mpp_update_domain2D_c8_2D
1013 #undef MPP_UPDATE_DOMAINS_3D_
1014 #define MPP_UPDATE_DOMAINS_3D_ mpp_update_domain2D_c8_3D
1015 #undef MPP_UPDATE_DOMAINS_4D_
1016 #define MPP_UPDATE_DOMAINS_4D_ mpp_update_domain2D_c8_4D
1017 #undef MPP_UPDATE_DOMAINS_5D_
1018 #define MPP_UPDATE_DOMAINS_5D_ mpp_update_domain2D_c8_5D
1019 #undef MPP_REDISTRIBUTE_2D_
1020 #define MPP_REDISTRIBUTE_2D_ mpp_redistribute_c8_2D
1021 #undef MPP_REDISTRIBUTE_3D_
1022 #define MPP_REDISTRIBUTE_3D_ mpp_redistribute_c8_3D
1023 #undef MPP_REDISTRIBUTE_4D_
1024 #define MPP_REDISTRIBUTE_4D_ mpp_redistribute_c8_4D
1025 #undef MPP_REDISTRIBUTE_5D_
1026 #define MPP_REDISTRIBUTE_5D_ mpp_redistribute_c8_5D
1027 #include <mpp_update_domains2D.fh>
1028 #endif
1029 
1030 #undef MPP_TYPE_
1031 #define MPP_TYPE_ integer(i8_kind)
1032 #undef MPP_UPDATE_DOMAINS_2D_
1033 #define MPP_UPDATE_DOMAINS_2D_ mpp_update_domain2D_i8_2D
1034 #undef MPP_UPDATE_DOMAINS_3D_
1035 #define MPP_UPDATE_DOMAINS_3D_ mpp_update_domain2D_i8_3D
1036 #undef MPP_UPDATE_DOMAINS_4D_
1037 #define MPP_UPDATE_DOMAINS_4D_ mpp_update_domain2D_i8_4D
1038 #undef MPP_UPDATE_DOMAINS_5D_
1039 #define MPP_UPDATE_DOMAINS_5D_ mpp_update_domain2D_i8_5D
1040 #undef MPP_REDISTRIBUTE_2D_
1041 #define MPP_REDISTRIBUTE_2D_ mpp_redistribute_i8_2D
1042 #undef MPP_REDISTRIBUTE_3D_
1043 #define MPP_REDISTRIBUTE_3D_ mpp_redistribute_i8_3D
1044 #undef MPP_REDISTRIBUTE_4D_
1045 #define MPP_REDISTRIBUTE_4D_ mpp_redistribute_i8_4D
1046 #undef MPP_REDISTRIBUTE_5D_
1047 #define MPP_REDISTRIBUTE_5D_ mpp_redistribute_i8_5D
1048 #include <mpp_update_domains2D.fh>
1049 
1050 #undef VECTOR_FIELD_
1051 #define VECTOR_FIELD_
1052 #undef MPP_TYPE_
1053 #define MPP_TYPE_ real(r4_kind)
1054 #undef MPP_UPDATE_DOMAINS_2D_
1055 #define MPP_UPDATE_DOMAINS_2D_ mpp_update_domain2D_r4_2D
1056 #undef MPP_UPDATE_DOMAINS_3D_
1057 #define MPP_UPDATE_DOMAINS_3D_ mpp_update_domain2D_r4_3D
1058 #undef MPP_UPDATE_DOMAINS_4D_
1059 #define MPP_UPDATE_DOMAINS_4D_ mpp_update_domain2D_r4_4D
1060 #undef MPP_UPDATE_DOMAINS_5D_
1061 #define MPP_UPDATE_DOMAINS_5D_ mpp_update_domain2D_r4_5D
1062 #ifdef VECTOR_FIELD_
1063 #undef MPP_UPDATE_DOMAINS_2D_V_
1064 #define MPP_UPDATE_DOMAINS_2D_V_ mpp_update_domain2D_r4_2Dv
1065 #undef MPP_UPDATE_DOMAINS_3D_V_
1066 #define MPP_UPDATE_DOMAINS_3D_V_ mpp_update_domain2D_r4_3Dv
1067 #undef MPP_UPDATE_DOMAINS_4D_V_
1068 #define MPP_UPDATE_DOMAINS_4D_V_ mpp_update_domain2D_r4_4Dv
1069 #undef MPP_UPDATE_DOMAINS_5D_V_
1070 #define MPP_UPDATE_DOMAINS_5D_V_ mpp_update_domain2D_r4_5Dv
1071 #undef MPP_REDISTRIBUTE_2D_
1072 #define MPP_REDISTRIBUTE_2D_ mpp_redistribute_r4_2D
1073 #undef MPP_REDISTRIBUTE_3D_
1074 #define MPP_REDISTRIBUTE_3D_ mpp_redistribute_r4_3D
1075 #undef MPP_REDISTRIBUTE_4D_
1076 #define MPP_REDISTRIBUTE_4D_ mpp_redistribute_r4_4D
1077 #undef MPP_REDISTRIBUTE_5D_
1078 #define MPP_REDISTRIBUTE_5D_ mpp_redistribute_r4_5D
1079 #include <mpp_update_domains2D.fh>
1080 #undef VECTOR_FIELD_
1081 #endif
1082 
1083 #ifdef OVERLOAD_C4
1084 #undef MPP_TYPE_
1085 #define MPP_TYPE_ complex(c4_kind)
1086 #undef MPP_UPDATE_DOMAINS_2D_
1087 #define MPP_UPDATE_DOMAINS_2D_ mpp_update_domain2D_c4_2D
1088 #undef MPP_UPDATE_DOMAINS_3D_
1089 #define MPP_UPDATE_DOMAINS_3D_ mpp_update_domain2D_c4_3D
1090 #undef MPP_UPDATE_DOMAINS_4D_
1091 #define MPP_UPDATE_DOMAINS_4D_ mpp_update_domain2D_c4_4D
1092 #undef MPP_UPDATE_DOMAINS_5D_
1093 #define MPP_UPDATE_DOMAINS_5D_ mpp_update_domain2D_c4_5D
1094 #undef MPP_REDISTRIBUTE_2D_
1095 #define MPP_REDISTRIBUTE_2D_ mpp_redistribute_c4_2D
1096 #undef MPP_REDISTRIBUTE_3D_
1097 #define MPP_REDISTRIBUTE_3D_ mpp_redistribute_c4_3D
1098 #undef MPP_REDISTRIBUTE_4D_
1099 #define MPP_REDISTRIBUTE_4D_ mpp_redistribute_c4_4D
1100 #undef MPP_REDISTRIBUTE_5D_
1101 #define MPP_REDISTRIBUTE_5D_ mpp_redistribute_c4_5D
1102 #include <mpp_update_domains2D.fh>
1103 #endif
1104 
1105 #undef MPP_TYPE_
1106 #define MPP_TYPE_ integer(i4_kind)
1107 #undef MPP_UPDATE_DOMAINS_2D_
1108 #define MPP_UPDATE_DOMAINS_2D_ mpp_update_domain2D_i4_2D
1109 #undef MPP_UPDATE_DOMAINS_3D_
1110 #define MPP_UPDATE_DOMAINS_3D_ mpp_update_domain2D_i4_3D
1111 #undef MPP_UPDATE_DOMAINS_4D_
1112 #define MPP_UPDATE_DOMAINS_4D_ mpp_update_domain2D_i4_4D
1113 #undef MPP_UPDATE_DOMAINS_5D_
1114 #define MPP_UPDATE_DOMAINS_5D_ mpp_update_domain2D_i4_5D
1115 #undef MPP_REDISTRIBUTE_2D_
1116 #define MPP_REDISTRIBUTE_2D_ mpp_redistribute_i4_2D
1117 #undef MPP_REDISTRIBUTE_3D_
1118 #define MPP_REDISTRIBUTE_3D_ mpp_redistribute_i4_3D
1119 #undef MPP_REDISTRIBUTE_4D_
1120 #define MPP_REDISTRIBUTE_4D_ mpp_redistribute_i4_4D
1121 #undef MPP_REDISTRIBUTE_5D_
1122 #define MPP_REDISTRIBUTE_5D_ mpp_redistribute_i4_5D
1123 #include <mpp_update_domains2D.fh>
1124 
1125 
1126 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1127 ! !
1128 ! MPP_START_UPDATE_DOMAINS and MPP_COMPLETE_UPDATE_DOMAINS: !
1129 ! fill halos for 2D decomposition --- non-blocking !
1130 ! !
1131 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1132 
1133 #undef VECTOR_FIELD_
1134 #define VECTOR_FIELD_
1135 #undef MPP_TYPE_
1136 #define MPP_TYPE_ real(r8_kind)
1137 #undef MPP_START_UPDATE_DOMAINS_2D_
1138 #define MPP_START_UPDATE_DOMAINS_2D_ mpp_start_update_domain2D_r8_2D
1139 #undef MPP_START_UPDATE_DOMAINS_3D_
1140 #define MPP_START_UPDATE_DOMAINS_3D_ mpp_start_update_domain2D_r8_3D
1141 #undef MPP_START_UPDATE_DOMAINS_4D_
1142 #define MPP_START_UPDATE_DOMAINS_4D_ mpp_start_update_domain2D_r8_4D
1143 #undef MPP_START_UPDATE_DOMAINS_5D_
1144 #define MPP_START_UPDATE_DOMAINS_5D_ mpp_start_update_domain2D_r8_5D
1145 #undef MPP_COMPLETE_UPDATE_DOMAINS_2D_
1146 #define MPP_COMPLETE_UPDATE_DOMAINS_2D_ mpp_complete_update_domain2D_r8_2D
1147 #undef MPP_COMPLETE_UPDATE_DOMAINS_3D_
1148 #define MPP_COMPLETE_UPDATE_DOMAINS_3D_ mpp_complete_update_domain2D_r8_3D
1149 #undef MPP_COMPLETE_UPDATE_DOMAINS_4D_
1150 #define MPP_COMPLETE_UPDATE_DOMAINS_4D_ mpp_complete_update_domain2D_r8_4D
1151 #undef MPP_COMPLETE_UPDATE_DOMAINS_5D_
1152 #define MPP_COMPLETE_UPDATE_DOMAINS_5D_ mpp_complete_update_domain2D_r8_5D
1153 #ifdef VECTOR_FIELD_
1154 #undef MPP_START_UPDATE_DOMAINS_2D_V_
1155 #define MPP_START_UPDATE_DOMAINS_2D_V_ mpp_start_update_domain2D_r8_2Dv
1156 #undef MPP_START_UPDATE_DOMAINS_3D_V_
1157 #define MPP_START_UPDATE_DOMAINS_3D_V_ mpp_start_update_domain2D_r8_3Dv
1158 #undef MPP_START_UPDATE_DOMAINS_4D_V_
1159 #define MPP_START_UPDATE_DOMAINS_4D_V_ mpp_start_update_domain2D_r8_4Dv
1160 #undef MPP_START_UPDATE_DOMAINS_5D_V_
1161 #define MPP_START_UPDATE_DOMAINS_5D_V_ mpp_start_update_domain2D_r8_5Dv
1162 #undef MPP_COMPLETE_UPDATE_DOMAINS_2D_V_
1163 #define MPP_COMPLETE_UPDATE_DOMAINS_2D_V_ mpp_complete_update_domain2D_r8_2Dv
1164 #undef MPP_COMPLETE_UPDATE_DOMAINS_3D_V_
1165 #define MPP_COMPLETE_UPDATE_DOMAINS_3D_V_ mpp_complete_update_domain2D_r8_3Dv
1166 #undef MPP_COMPLETE_UPDATE_DOMAINS_4D_V_
1167 #define MPP_COMPLETE_UPDATE_DOMAINS_4D_V_ mpp_complete_update_domain2D_r8_4Dv
1168 #undef MPP_COMPLETE_UPDATE_DOMAINS_5D_V_
1169 #define MPP_COMPLETE_UPDATE_DOMAINS_5D_V_ mpp_complete_update_domain2D_r8_5Dv
1170 #endif
1171 #include <mpp_update_domains2D_nonblock.fh>
1172 
1173 #ifdef OVERLOAD_C8
1174 #undef VECTOR_FIELD_
1175 #undef MPP_TYPE_
1176 #define MPP_TYPE_ complex(c8_kind)
1177 #undef MPP_START_UPDATE_DOMAINS_2D_
1178 #define MPP_START_UPDATE_DOMAINS_2D_ mpp_start_update_domain2D_c8_2D
1179 #undef MPP_START_UPDATE_DOMAINS_3D_
1180 #define MPP_START_UPDATE_DOMAINS_3D_ mpp_start_update_domain2D_c8_3D
1181 #undef MPP_START_UPDATE_DOMAINS_4D_
1182 #define MPP_START_UPDATE_DOMAINS_4D_ mpp_start_update_domain2D_c8_4D
1183 #undef MPP_START_UPDATE_DOMAINS_5D_
1184 #define MPP_START_UPDATE_DOMAINS_5D_ mpp_start_update_domain2D_c8_5D
1185 #undef MPP_COMPLETE_UPDATE_DOMAINS_2D_
1186 #define MPP_COMPLETE_UPDATE_DOMAINS_2D_ mpp_complete_update_domain2D_c8_2D
1187 #undef MPP_COMPLETE_UPDATE_DOMAINS_3D_
1188 #define MPP_COMPLETE_UPDATE_DOMAINS_3D_ mpp_complete_update_domain2D_c8_3D
1189 #undef MPP_COMPLETE_UPDATE_DOMAINS_4D_
1190 #define MPP_COMPLETE_UPDATE_DOMAINS_4D_ mpp_complete_update_domain2D_c8_4D
1191 #undef MPP_COMPLETE_UPDATE_DOMAINS_5D_
1192 #define MPP_COMPLETE_UPDATE_DOMAINS_5D_ mpp_complete_update_domain2D_c8_5D
1193 #include <mpp_update_domains2D_nonblock.fh>
1194 #endif
1195 
1196 #undef VECTOR_FIELD_
1197 #undef MPP_TYPE_
1198 #define MPP_TYPE_ integer(i8_kind)
1199 #undef MPP_START_UPDATE_DOMAINS_2D_
1200 #define MPP_START_UPDATE_DOMAINS_2D_ mpp_start_update_domain2D_i8_2D
1201 #undef MPP_START_UPDATE_DOMAINS_3D_
1202 #define MPP_START_UPDATE_DOMAINS_3D_ mpp_start_update_domain2D_i8_3D
1203 #undef MPP_START_UPDATE_DOMAINS_4D_
1204 #define MPP_START_UPDATE_DOMAINS_4D_ mpp_start_update_domain2D_i8_4D
1205 #undef MPP_START_UPDATE_DOMAINS_5D_
1206 #define MPP_START_UPDATE_DOMAINS_5D_ mpp_start_update_domain2D_i8_5D
1207 #undef MPP_COMPLETE_UPDATE_DOMAINS_2D_
1208 #define MPP_COMPLETE_UPDATE_DOMAINS_2D_ mpp_complete_update_domain2D_i8_2D
1209 #undef MPP_COMPLETE_UPDATE_DOMAINS_3D_
1210 #define MPP_COMPLETE_UPDATE_DOMAINS_3D_ mpp_complete_update_domain2D_i8_3D
1211 #undef MPP_COMPLETE_UPDATE_DOMAINS_4D_
1212 #define MPP_COMPLETE_UPDATE_DOMAINS_4D_ mpp_complete_update_domain2D_i8_4D
1213 #undef MPP_COMPLETE_UPDATE_DOMAINS_5D_
1214 #define MPP_COMPLETE_UPDATE_DOMAINS_5D_ mpp_complete_update_domain2D_i8_5D
1215 #include <mpp_update_domains2D_nonblock.fh>
1216 
1217 #undef VECTOR_FIELD_
1218 #define VECTOR_FIELD_
1219 #undef MPP_TYPE_
1220 #define MPP_TYPE_ real(r4_kind)
1221 #undef MPP_START_UPDATE_DOMAINS_2D_
1222 #define MPP_START_UPDATE_DOMAINS_2D_ mpp_start_update_domain2D_r4_2D
1223 #undef MPP_START_UPDATE_DOMAINS_3D_
1224 #define MPP_START_UPDATE_DOMAINS_3D_ mpp_start_update_domain2D_r4_3D
1225 #undef MPP_START_UPDATE_DOMAINS_4D_
1226 #define MPP_START_UPDATE_DOMAINS_4D_ mpp_start_update_domain2D_r4_4D
1227 #undef MPP_START_UPDATE_DOMAINS_5D_
1228 #define MPP_START_UPDATE_DOMAINS_5D_ mpp_start_update_domain2D_r4_5D
1229 #undef MPP_COMPLETE_UPDATE_DOMAINS_2D_
1230 #define MPP_COMPLETE_UPDATE_DOMAINS_2D_ mpp_complete_update_domain2D_r4_2D
1231 #undef MPP_COMPLETE_UPDATE_DOMAINS_3D_
1232 #define MPP_COMPLETE_UPDATE_DOMAINS_3D_ mpp_complete_update_domain2D_r4_3D
1233 #undef MPP_COMPLETE_UPDATE_DOMAINS_4D_
1234 #define MPP_COMPLETE_UPDATE_DOMAINS_4D_ mpp_complete_update_domain2D_r4_4D
1235 #undef MPP_COMPLETE_UPDATE_DOMAINS_5D_
1236 #define MPP_COMPLETE_UPDATE_DOMAINS_5D_ mpp_complete_update_domain2D_r4_5D
1237 #ifdef VECTOR_FIELD_
1238 #undef MPP_START_UPDATE_DOMAINS_2D_V_
1239 #define MPP_START_UPDATE_DOMAINS_2D_V_ mpp_start_update_domain2D_r4_2Dv
1240 #undef MPP_START_UPDATE_DOMAINS_3D_V_
1241 #define MPP_START_UPDATE_DOMAINS_3D_V_ mpp_start_update_domain2D_r4_3Dv
1242 #undef MPP_START_UPDATE_DOMAINS_4D_V_
1243 #define MPP_START_UPDATE_DOMAINS_4D_V_ mpp_start_update_domain2D_r4_4Dv
1244 #undef MPP_START_UPDATE_DOMAINS_5D_V_
1245 #define MPP_START_UPDATE_DOMAINS_5D_V_ mpp_start_update_domain2D_r4_5Dv
1246 #undef MPP_COMPLETE_UPDATE_DOMAINS_2D_V_
1247 #define MPP_COMPLETE_UPDATE_DOMAINS_2D_V_ mpp_complete_update_domain2D_r4_2Dv
1248 #undef MPP_COMPLETE_UPDATE_DOMAINS_3D_V_
1249 #define MPP_COMPLETE_UPDATE_DOMAINS_3D_V_ mpp_complete_update_domain2D_r4_3Dv
1250 #undef MPP_COMPLETE_UPDATE_DOMAINS_4D_V_
1251 #define MPP_COMPLETE_UPDATE_DOMAINS_4D_V_ mpp_complete_update_domain2D_r4_4Dv
1252 #undef MPP_COMPLETE_UPDATE_DOMAINS_5D_V_
1253 #define MPP_COMPLETE_UPDATE_DOMAINS_5D_V_ mpp_complete_update_domain2D_r4_5Dv
1254 #endif
1255 #include <mpp_update_domains2D_nonblock.fh>
1256 
1257 #ifdef OVERLOAD_C4
1258 #undef VECTOR_FIELD_
1259 #undef MPP_TYPE_
1260 #define MPP_TYPE_ complex(c4_kind)
1261 #undef MPP_START_UPDATE_DOMAINS_2D_
1262 #define MPP_START_UPDATE_DOMAINS_2D_ mpp_start_update_domain2D_c4_2D
1263 #undef MPP_START_UPDATE_DOMAINS_3D_
1264 #define MPP_START_UPDATE_DOMAINS_3D_ mpp_start_update_domain2D_c4_3D
1265 #undef MPP_START_UPDATE_DOMAINS_4D_
1266 #define MPP_START_UPDATE_DOMAINS_4D_ mpp_start_update_domain2D_c4_4D
1267 #undef MPP_START_UPDATE_DOMAINS_5D_
1268 #define MPP_START_UPDATE_DOMAINS_5D_ mpp_start_update_domain2D_c4_5D
1269 #undef MPP_COMPLETE_UPDATE_DOMAINS_2D_
1270 #define MPP_COMPLETE_UPDATE_DOMAINS_2D_ mpp_complete_update_domain2D_c4_2D
1271 #undef MPP_COMPLETE_UPDATE_DOMAINS_3D_
1272 #define MPP_COMPLETE_UPDATE_DOMAINS_3D_ mpp_complete_update_domain2D_c4_3D
1273 #undef MPP_COMPLETE_UPDATE_DOMAINS_4D_
1274 #define MPP_COMPLETE_UPDATE_DOMAINS_4D_ mpp_complete_update_domain2D_c4_4D
1275 #undef MPP_COMPLETE_UPDATE_DOMAINS_5D_
1276 #define MPP_COMPLETE_UPDATE_DOMAINS_5D_ mpp_complete_update_domain2D_c4_5D
1277 #include <mpp_update_domains2D_nonblock.fh>
1278 #endif
1279 
1280 #undef VECTOR_FIELD_
1281 #undef MPP_TYPE_
1282 #define MPP_TYPE_ integer(i4_kind)
1283 #undef MPP_START_UPDATE_DOMAINS_2D_
1284 #define MPP_START_UPDATE_DOMAINS_2D_ mpp_start_update_domain2D_i4_2D
1285 #undef MPP_START_UPDATE_DOMAINS_3D_
1286 #define MPP_START_UPDATE_DOMAINS_3D_ mpp_start_update_domain2D_i4_3D
1287 #undef MPP_START_UPDATE_DOMAINS_4D_
1288 #define MPP_START_UPDATE_DOMAINS_4D_ mpp_start_update_domain2D_i4_4D
1289 #undef MPP_START_UPDATE_DOMAINS_5D_
1290 #define MPP_START_UPDATE_DOMAINS_5D_ mpp_start_update_domain2D_i4_5D
1291 #undef MPP_COMPLETE_UPDATE_DOMAINS_2D_
1292 #define MPP_COMPLETE_UPDATE_DOMAINS_2D_ mpp_complete_update_domain2D_i4_2D
1293 #undef MPP_COMPLETE_UPDATE_DOMAINS_3D_
1294 #define MPP_COMPLETE_UPDATE_DOMAINS_3D_ mpp_complete_update_domain2D_i4_3D
1295 #undef MPP_COMPLETE_UPDATE_DOMAINS_4D_
1296 #define MPP_COMPLETE_UPDATE_DOMAINS_4D_ mpp_complete_update_domain2D_i4_4D
1297 #undef MPP_COMPLETE_UPDATE_DOMAINS_5D_
1298 #define MPP_COMPLETE_UPDATE_DOMAINS_5D_ mpp_complete_update_domain2D_i4_5D
1299 #include <mpp_update_domains2D_nonblock.fh>
1300 
1301 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1302 ! !
1303 ! mpp_start_do_update and mpp_complete_do_update !
1304 ! private routine. To be called in mpp_start_update_domains !
1305 ! and mpp_complete_update_domains !
1306 ! !
1307 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1308 #undef MPP_TYPE_
1309 #define MPP_TYPE_ real(r8_kind)
1310 #undef MPI_TYPE_
1311 #define MPI_TYPE_ MPI_REAL8
1312 #undef MPP_START_DO_UPDATE_3D_
1313 #define MPP_START_DO_UPDATE_3D_ mpp_start_do_update_r8_3D
1314 #undef MPP_COMPLETE_DO_UPDATE_3D_
1315 #define MPP_COMPLETE_DO_UPDATE_3D_ mpp_complete_do_update_r8_3D
1316 #undef MPP_START_DO_UPDATE_3D_V_
1317 #define MPP_START_DO_UPDATE_3D_V_ mpp_start_do_update_r8_3Dv
1318 #undef MPP_COMPLETE_DO_UPDATE_3D_V_
1319 #define MPP_COMPLETE_DO_UPDATE_3D_V_ mpp_complete_do_update_r8_3Dv
1320 #include <mpp_do_update_nonblock.fh>
1321 #include <mpp_do_updateV_nonblock.fh>
1322 
1323 #ifdef OVERLOAD_C8
1324 #undef MPP_TYPE_
1325 #define MPP_TYPE_ complex(c8_kind)
1326 #undef MPI_TYPE_
1327 #define MPI_TYPE_ MPI_DOUBLE_COMPLEX
1328 #undef MPP_START_DO_UPDATE_3D_
1329 #define MPP_START_DO_UPDATE_3D_ mpp_start_do_update_c8_3D
1330 #undef MPP_COMPLETE_DO_UPDATE_3D_
1331 #define MPP_COMPLETE_DO_UPDATE_3D_ mpp_complete_do_update_c8_3D
1332 #include <mpp_do_update_nonblock.fh>
1333 #endif
1334 
1335 #undef MPP_TYPE_
1336 #define MPP_TYPE_ integer(i8_kind)
1337 #undef MPI_TYPE_
1338 #define MPI_TYPE_ MPI_INTEGER8
1339 #undef MPP_START_DO_UPDATE_3D_
1340 #define MPP_START_DO_UPDATE_3D_ mpp_start_do_update_i8_3D
1341 #undef MPP_COMPLETE_DO_UPDATE_3D_
1342 #define MPP_COMPLETE_DO_UPDATE_3D_ mpp_complete_do_update_i8_3D
1343 #include <mpp_do_update_nonblock.fh>
1344 
1345 #undef MPP_TYPE_
1346 #define MPP_TYPE_ real(r4_kind)
1347 #undef MPI_TYPE_
1348 #define MPI_TYPE_ MPI_REAL4
1349 #undef MPP_START_DO_UPDATE_3D_
1350 #define MPP_START_DO_UPDATE_3D_ mpp_start_do_update_r4_3D
1351 #undef MPP_COMPLETE_DO_UPDATE_3D_
1352 #define MPP_COMPLETE_DO_UPDATE_3D_ mpp_complete_do_update_r4_3D
1353 #undef MPP_START_DO_UPDATE_3D_V_
1354 #define MPP_START_DO_UPDATE_3D_V_ mpp_start_do_update_r4_3Dv
1355 #undef MPP_COMPLETE_DO_UPDATE_3D_V_
1356 #define MPP_COMPLETE_DO_UPDATE_3D_V_ mpp_complete_do_update_r4_3Dv
1357 #include <mpp_do_update_nonblock.fh>
1358 #include <mpp_do_updateV_nonblock.fh>
1359 
1360 #ifdef OVERLOAD_C4
1361 #undef MPP_TYPE_
1362 #define MPP_TYPE_ complex(c4_kind)
1363 #undef MPI_TYPE_
1364 #define MPI_TYPE_ MPI_COMPLEX
1365 #undef MPP_START_DO_UPDATE_3D_
1366 #define MPP_START_DO_UPDATE_3D_ mpp_start_do_update_c4_3D
1367 #undef MPP_COMPLETE_DO_UPDATE_3D_
1368 #define MPP_COMPLETE_DO_UPDATE_3D_ mpp_complete_do_update_c4_3D
1369 #include <mpp_do_update_nonblock.fh>
1370 #endif
1371 
1372 #undef MPP_TYPE_
1373 #define MPP_TYPE_ integer(i4_kind)
1374 #undef MPI_TYPE_
1375 #define MPI_TYPE_ MPI_INTEGER4
1376 #undef MPP_START_DO_UPDATE_3D_
1377 #define MPP_START_DO_UPDATE_3D_ mpp_start_do_update_i4_3D
1378 #undef MPP_COMPLETE_DO_UPDATE_3D_
1379 #define MPP_COMPLETE_DO_UPDATE_3D_ mpp_complete_do_update_i4_3D
1380 #include <mpp_do_update_nonblock.fh>
1381 
1382 !*******************************************************
1383 #undef VECTOR_FIELD_
1384 #define VECTOR_FIELD_
1385 #undef MPP_TYPE_
1386 #define MPP_TYPE_ real(r8_kind)
1387 #undef MPP_DO_UPDATE_3D_
1388 #define MPP_DO_UPDATE_3D_ mpp_do_update_r8_3d
1389 #ifdef VECTOR_FIELD_
1390 #undef MPP_DO_UPDATE_3D_V_
1391 #define MPP_DO_UPDATE_3D_V_ mpp_do_update_r8_3dv
1392 #endif
1393 #include <mpp_do_update.fh>
1394 #include <mpp_do_updateV.fh>
1395 
1396 #ifdef OVERLOAD_C8
1397 #undef VECTOR_FIELD_
1398 #undef MPP_TYPE_
1399 #define MPP_TYPE_ complex(c8_kind)
1400 #undef MPP_DO_UPDATE_3D_
1401 #define MPP_DO_UPDATE_3D_ mpp_do_update_c8_3d
1402 #include <mpp_do_update.fh>
1403 #define VECTOR_FIELD_
1404 #endif
1405 
1406 #undef MPP_TYPE_
1407 #define MPP_TYPE_ integer(i8_kind)
1408 #undef MPP_DO_UPDATE_3D_
1409 #define MPP_DO_UPDATE_3D_ mpp_do_update_i8_3d
1410 #include <mpp_do_update.fh>
1411 
1412 #undef VECTOR_FIELD_
1413 #define VECTOR_FIELD_
1414 #undef MPP_TYPE_
1415 #define MPP_TYPE_ real(r4_kind)
1416 #undef MPP_DO_UPDATE_3D_
1417 #define MPP_DO_UPDATE_3D_ mpp_do_update_r4_3d
1418 #ifdef VECTOR_FIELD_
1419 #undef MPP_DO_UPDATE_3D_V_
1420 #define MPP_DO_UPDATE_3D_V_ mpp_do_update_r4_3dv
1421 #endif
1422 #include <mpp_do_update.fh>
1423 #include <mpp_do_updateV.fh>
1424 
1425 #ifdef OVERLOAD_C4
1426 #undef VECTOR_FIELD_
1427 #undef MPP_TYPE_
1428 #define MPP_TYPE_ complex(c4_kind)
1429 #undef MPP_DO_UPDATE_3D_
1430 #define MPP_DO_UPDATE_3D_ mpp_do_update_c4_3d
1431 #include <mpp_do_update.fh>
1432 #define VECTOR_FIELD_
1433 #endif
1434 
1435 #undef MPP_TYPE_
1436 #define MPP_TYPE_ integer(i4_kind)
1437 #undef MPP_DO_UPDATE_3D_
1438 #define MPP_DO_UPDATE_3D_ mpp_do_update_i4_3d
1439 #include <mpp_do_update.fh>
1440 
1441 
1442 #undef MPP_TYPE_
1443 #define MPP_TYPE_ real(r8_kind)
1444 #undef MPP_DO_CHECK_3D_
1445 #define MPP_DO_CHECK_3D_ mpp_do_check_r8_3d
1446 #ifdef VECTOR_FIELD_
1447 #undef MPP_DO_CHECK_3D_V_
1448 #define MPP_DO_CHECK_3D_V_ mpp_do_check_r8_3dv
1449 #endif
1450 #include <mpp_do_check.fh>
1451 #include <mpp_do_checkV.fh>
1452 
1453 #ifdef OVERLOAD_C8
1454 #undef VECTOR_FIELD_
1455 #undef MPP_TYPE_
1456 #define MPP_TYPE_ complex(c8_kind)
1457 #undef MPP_DO_CHECK_3D_
1458 #define MPP_DO_CHECK_3D_ mpp_do_check_c8_3d
1459 #include <mpp_do_check.fh>
1460 #define VECTOR_FIELD_
1461 #endif
1462 
1463 #undef MPP_TYPE_
1464 #define MPP_TYPE_ integer(i8_kind)
1465 #undef MPP_DO_CHECK_3D_
1466 #define MPP_DO_CHECK_3D_ mpp_do_check_i8_3d
1467 #include <mpp_do_check.fh>
1468 
1469 #undef VECTOR_FIELD_
1470 #define VECTOR_FIELD_
1471 #undef MPP_TYPE_
1472 #define MPP_TYPE_ real(r4_kind)
1473 #undef MPP_DO_CHECK_3D_
1474 #define MPP_DO_CHECK_3D_ mpp_do_check_r4_3d
1475 #ifdef VECTOR_FIELD_
1476 #undef MPP_DO_CHECK_3D_V_
1477 #define MPP_DO_CHECK_3D_V_ mpp_do_check_r4_3dv
1478 #endif
1479 #include <mpp_do_check.fh>
1480 #include <mpp_do_checkV.fh>
1481 
1482 #ifdef OVERLOAD_C4
1483 #undef VECTOR_FIELD_
1484 #undef MPP_TYPE_
1485 #define MPP_TYPE_ complex(c4_kind)
1486 #undef MPP_DO_CHECK_3D_
1487 #define MPP_DO_CHECK_3D_ mpp_do_check_c4_3d
1488 #include <mpp_do_check.fh>
1489 #endif
1490 
1491 #undef MPP_TYPE_
1492 #define MPP_TYPE_ integer(i4_kind)
1493 #undef MPP_DO_CHECK_3D_
1494 #define MPP_DO_CHECK_3D_ mpp_do_check_i4_3d
1495 #include <mpp_do_check.fh>
1496 
1497 #undef VECTOR_FIELD_
1498 #define VECTOR_FIELD_
1499 #undef MPP_TYPE_
1500 #define MPP_TYPE_ real(r8_kind)
1501 #undef MPP_UPDATE_NEST_FINE_2D_
1502 #define MPP_UPDATE_NEST_FINE_2D_ mpp_update_nest_fine_r8_2D
1503 #undef MPP_UPDATE_NEST_FINE_3D_
1504 #define MPP_UPDATE_NEST_FINE_3D_ mpp_update_nest_fine_r8_3D
1505 #undef MPP_UPDATE_NEST_FINE_4D_
1506 #define MPP_UPDATE_NEST_FINE_4D_ mpp_update_nest_fine_r8_4D
1507 #undef MPP_UPDATE_NEST_FINE_2D_V_
1508 #define MPP_UPDATE_NEST_FINE_2D_V_ mpp_update_nest_fine_r8_2Dv
1509 #undef MPP_UPDATE_NEST_FINE_3D_V_
1510 #define MPP_UPDATE_NEST_FINE_3D_V_ mpp_update_nest_fine_r8_3Dv
1511 #undef MPP_UPDATE_NEST_FINE_4D_V_
1512 #define MPP_UPDATE_NEST_FINE_4D_V_ mpp_update_nest_fine_r8_4Dv
1513 #undef MPP_UPDATE_NEST_COARSE_2D_
1514 #define MPP_UPDATE_NEST_COARSE_2D_ mpp_update_nest_coarse_r8_2D
1515 #undef MPP_UPDATE_NEST_COARSE_3D_
1516 #define MPP_UPDATE_NEST_COARSE_3D_ mpp_update_nest_coarse_r8_3D
1517 #undef MPP_UPDATE_NEST_COARSE_4D_
1518 #define MPP_UPDATE_NEST_COARSE_4D_ mpp_update_nest_coarse_r8_4D
1519 #undef MPP_UPDATE_NEST_COARSE_2D_V_
1520 #define MPP_UPDATE_NEST_COARSE_2D_V_ mpp_update_nest_coarse_r8_2Dv
1521 #undef MPP_UPDATE_NEST_COARSE_3D_V_
1522 #define MPP_UPDATE_NEST_COARSE_3D_V_ mpp_update_nest_coarse_r8_3Dv
1523 #undef MPP_UPDATE_NEST_COARSE_4D_V_
1524 #define MPP_UPDATE_NEST_COARSE_4D_V_ mpp_update_nest_coarse_r8_4Dv
1525 #include <mpp_update_nest_domains.fh>
1526 
1527 #ifdef OVERLOAD_C8
1528 #undef VECTOR_FIELD_
1529 #undef MPP_TYPE_
1530 #define MPP_TYPE_ complex(c8_kind)
1531 #undef MPP_UPDATE_NEST_FINE_2D_
1532 #define MPP_UPDATE_NEST_FINE_2D_ mpp_update_nest_fine_c8_2D
1533 #undef MPP_UPDATE_NEST_FINE_3D_
1534 #define MPP_UPDATE_NEST_FINE_3D_ mpp_update_nest_fine_c8_3D
1535 #undef MPP_UPDATE_NEST_FINE_4D_
1536 #define MPP_UPDATE_NEST_FINE_4D_ mpp_update_nest_fine_c8_4D
1537 #undef MPP_UPDATE_NEST_COARSE_2D_
1538 #define MPP_UPDATE_NEST_COARSE_2D_ mpp_update_nest_coarse_c8_2D
1539 #undef MPP_UPDATE_NEST_COARSE_3D_
1540 #define MPP_UPDATE_NEST_COARSE_3D_ mpp_update_nest_coarse_c8_3D
1541 #undef MPP_UPDATE_NEST_COARSE_4D_
1542 #define MPP_UPDATE_NEST_COARSE_4D_ mpp_update_nest_coarse_c8_4D
1543 #include <mpp_update_nest_domains.fh>
1544 #endif
1545 
1546 #undef VECTOR_FIELD_
1547 #undef MPP_TYPE_
1548 #define MPP_TYPE_ integer(i8_kind)
1549 #undef MPP_UPDATE_NEST_FINE_2D_
1550 #define MPP_UPDATE_NEST_FINE_2D_ mpp_update_nest_fine_i8_2D
1551 #undef MPP_UPDATE_NEST_FINE_3D_
1552 #define MPP_UPDATE_NEST_FINE_3D_ mpp_update_nest_fine_i8_3D
1553 #undef MPP_UPDATE_NEST_FINE_4D_
1554 #define MPP_UPDATE_NEST_FINE_4D_ mpp_update_nest_fine_i8_4D
1555 #undef MPP_UPDATE_NEST_COARSE_2D_
1556 #define MPP_UPDATE_NEST_COARSE_2D_ mpp_update_nest_coarse_i8_2D
1557 #undef MPP_UPDATE_NEST_COARSE_3D_
1558 #define MPP_UPDATE_NEST_COARSE_3D_ mpp_update_nest_coarse_i8_3D
1559 #undef MPP_UPDATE_NEST_COARSE_4D_
1560 #define MPP_UPDATE_NEST_COARSE_4D_ mpp_update_nest_coarse_i8_4D
1561 #include <mpp_update_nest_domains.fh>
1562 
1563 #undef VECTOR_FIELD_
1564 #define VECTOR_FIELD_
1565 #undef MPP_TYPE_
1566 #define MPP_TYPE_ real(r4_kind)
1567 #undef MPP_UPDATE_NEST_FINE_2D_
1568 #define MPP_UPDATE_NEST_FINE_2D_ mpp_update_nest_fine_r4_2D
1569 #undef MPP_UPDATE_NEST_FINE_3D_
1570 #define MPP_UPDATE_NEST_FINE_3D_ mpp_update_nest_fine_r4_3D
1571 #undef MPP_UPDATE_NEST_FINE_4D_
1572 #define MPP_UPDATE_NEST_FINE_4D_ mpp_update_nest_fine_r4_4D
1573 #undef MPP_UPDATE_NEST_FINE_2D_V_
1574 #define MPP_UPDATE_NEST_FINE_2D_V_ mpp_update_nest_fine_r4_2Dv
1575 #undef MPP_UPDATE_NEST_FINE_3D_V_
1576 #define MPP_UPDATE_NEST_FINE_3D_V_ mpp_update_nest_fine_r4_3Dv
1577 #undef MPP_UPDATE_NEST_FINE_4D_V_
1578 #define MPP_UPDATE_NEST_FINE_4D_V_ mpp_update_nest_fine_r4_4Dv
1579 #undef MPP_UPDATE_NEST_COARSE_2D_
1580 #define MPP_UPDATE_NEST_COARSE_2D_ mpp_update_nest_coarse_r4_2D
1581 #undef MPP_UPDATE_NEST_COARSE_3D_
1582 #define MPP_UPDATE_NEST_COARSE_3D_ mpp_update_nest_coarse_r4_3D
1583 #undef MPP_UPDATE_NEST_COARSE_4D_
1584 #define MPP_UPDATE_NEST_COARSE_4D_ mpp_update_nest_coarse_r4_4D
1585 #undef MPP_UPDATE_NEST_COARSE_2D_V_
1586 #define MPP_UPDATE_NEST_COARSE_2D_V_ mpp_update_nest_coarse_r4_2Dv
1587 #undef MPP_UPDATE_NEST_COARSE_3D_V_
1588 #define MPP_UPDATE_NEST_COARSE_3D_V_ mpp_update_nest_coarse_r4_3Dv
1589 #undef MPP_UPDATE_NEST_COARSE_4D_V_
1590 #define MPP_UPDATE_NEST_COARSE_4D_V_ mpp_update_nest_coarse_r4_4Dv
1591 #include <mpp_update_nest_domains.fh>
1592 
1593 #ifdef OVERLOAD_C4
1594 #undef VECTOR_FIELD_
1595 #undef MPP_TYPE_
1596 #define MPP_TYPE_ complex(c4_kind)
1597 #undef MPP_UPDATE_NEST_FINE_2D_
1598 #define MPP_UPDATE_NEST_FINE_2D_ mpp_update_nest_fine_c4_2D
1599 #undef MPP_UPDATE_NEST_FINE_3D_
1600 #define MPP_UPDATE_NEST_FINE_3D_ mpp_update_nest_fine_c4_3D
1601 #undef MPP_UPDATE_NEST_FINE_4D_
1602 #define MPP_UPDATE_NEST_FINE_4D_ mpp_update_nest_fine_c4_4D
1603 #undef MPP_UPDATE_NEST_COARSE_2D_
1604 #define MPP_UPDATE_NEST_COARSE_2D_ mpp_update_nest_coarse_c4_2D
1605 #undef MPP_UPDATE_NEST_COARSE_3D_
1606 #define MPP_UPDATE_NEST_COARSE_3D_ mpp_update_nest_coarse_c4_3D
1607 #undef MPP_UPDATE_NEST_COARSE_4D_
1608 #define MPP_UPDATE_NEST_COARSE_4D_ mpp_update_nest_coarse_c4_4D
1609 #include <mpp_update_nest_domains.fh>
1610 #endif
1611 
1612 #undef VECTOR_FIELD_
1613 #undef MPP_TYPE_
1614 #define MPP_TYPE_ integer(i4_kind)
1615 #undef MPP_UPDATE_NEST_FINE_2D_
1616 #define MPP_UPDATE_NEST_FINE_2D_ mpp_update_nest_fine_i4_2D
1617 #undef MPP_UPDATE_NEST_FINE_3D_
1618 #define MPP_UPDATE_NEST_FINE_3D_ mpp_update_nest_fine_i4_3D
1619 #undef MPP_UPDATE_NEST_FINE_4D_
1620 #define MPP_UPDATE_NEST_FINE_4D_ mpp_update_nest_fine_i4_4D
1621 #undef MPP_UPDATE_NEST_COARSE_2D_
1622 #define MPP_UPDATE_NEST_COARSE_2D_ mpp_update_nest_coarse_i4_2D
1623 #undef MPP_UPDATE_NEST_COARSE_3D_
1624 #define MPP_UPDATE_NEST_COARSE_3D_ mpp_update_nest_coarse_i4_3D
1625 #undef MPP_UPDATE_NEST_COARSE_4D_
1626 #define MPP_UPDATE_NEST_COARSE_4D_ mpp_update_nest_coarse_i4_4D
1627 #include <mpp_update_nest_domains.fh>
1628 
1629 #undef VECTOR_FIELD_
1630 #define VECTOR_FIELD_
1631 #undef MPP_TYPE_
1632 #define MPP_TYPE_ real(r8_kind)
1633 #undef MPP_DO_UPDATE_NEST_FINE_3D_
1634 #define MPP_DO_UPDATE_NEST_FINE_3D_ mpp_do_update_nest_fine_r8_3D
1635 #undef MPP_DO_UPDATE_NEST_FINE_3D_V_
1636 #define MPP_DO_UPDATE_NEST_FINE_3D_V_ mpp_do_update_nest_fine_r8_3Dv
1637 #undef MPP_DO_UPDATE_NEST_COARSE_3D_
1638 #define MPP_DO_UPDATE_NEST_COARSE_3D_ mpp_do_update_nest_coarse_r8_3D
1639 #undef MPP_DO_UPDATE_NEST_COARSE_3D_V_
1640 #define MPP_DO_UPDATE_NEST_COARSE_3D_V_ mpp_do_update_nest_coarse_r8_3Dv
1641 #include <mpp_do_update_nest.fh>
1642 
1643 #ifdef OVERLOAD_C8
1644 #undef VECTOR_FIELD_
1645 #undef MPP_TYPE_
1646 #define MPP_TYPE_ complex(c8_kind)
1647 #undef MPP_DO_UPDATE_NEST_FINE_3D_
1648 #define MPP_DO_UPDATE_NEST_FINE_3D_ mpp_do_update_nest_fine_c8_3D
1649 #undef MPP_DO_UPDATE_NEST_COARSE_3D_
1650 #define MPP_DO_UPDATE_NEST_COARSE_3D_ mpp_do_update_nest_coarse_c8_3D
1651 #include <mpp_do_update_nest.fh>
1652 #endif
1653 
1654 #undef VECTOR_FIELD_
1655 #undef MPP_TYPE_
1656 #define MPP_TYPE_ integer(i8_kind)
1657 #undef MPP_DO_UPDATE_NEST_FINE_3D_
1658 #define MPP_DO_UPDATE_NEST_FINE_3D_ mpp_do_update_nest_fine_i8_3D
1659 #undef MPP_DO_UPDATE_NEST_COARSE_3D_
1660 #define MPP_DO_UPDATE_NEST_COARSE_3D_ mpp_do_update_nest_coarse_i8_3D
1661 #include <mpp_do_update_nest.fh>
1662 
1663 #undef VECTOR_FIELD_
1664 #define VECTOR_FIELD_
1665 #undef MPP_TYPE_
1666 #define MPP_TYPE_ real(r4_kind)
1667 #undef MPP_DO_UPDATE_NEST_FINE_3D_
1668 #define MPP_DO_UPDATE_NEST_FINE_3D_ mpp_do_update_nest_fine_r4_3D
1669 #undef MPP_DO_UPDATE_NEST_FINE_3D_V_
1670 #define MPP_DO_UPDATE_NEST_FINE_3D_V_ mpp_do_update_nest_fine_r4_3Dv
1671 #undef MPP_DO_UPDATE_NEST_COARSE_3D_
1672 #define MPP_DO_UPDATE_NEST_COARSE_3D_ mpp_do_update_nest_coarse_r4_3D
1673 #undef MPP_DO_UPDATE_NEST_COARSE_3D_V_
1674 #define MPP_DO_UPDATE_NEST_COARSE_3D_V_ mpp_do_update_nest_coarse_r4_3Dv
1675 #include <mpp_do_update_nest.fh>
1676 
1677 #ifdef OVERLOAD_C4
1678 #undef VECTOR_FIELD_
1679 #undef MPP_TYPE_
1680 #define MPP_TYPE_ complex(c4_kind)
1681 #undef MPP_DO_UPDATE_NEST_FINE_3D_
1682 #define MPP_DO_UPDATE_NEST_FINE_3D_ mpp_do_update_nest_fine_c4_3D
1683 #undef MPP_DO_UPDATE_NEST_COARSE_3D_
1684 #define MPP_DO_UPDATE_NEST_COARSE_3D_ mpp_do_update_nest_coarse_c4_3D
1685 #include <mpp_do_update_nest.fh>
1686 #endif
1687 
1688 #undef VECTOR_FIELD_
1689 #undef MPP_TYPE_
1690 #define MPP_TYPE_ integer(i4_kind)
1691 #undef MPP_DO_UPDATE_NEST_FINE_3D_
1692 #define MPP_DO_UPDATE_NEST_FINE_3D_ mpp_do_update_nest_fine_i4_3D
1693 #undef MPP_DO_UPDATE_NEST_COARSE_3D_
1694 #define MPP_DO_UPDATE_NEST_COARSE_3D_ mpp_do_update_nest_coarse_i4_3D
1695 #include <mpp_do_update_nest.fh>
1696 
1697 !bnc
1698 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1699 ! !
1700 ! MPP_UPDATE_DOMAINS_AD: adjoint fill halos for 2D decomposition !
1701 ! !
1702 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1703 #undef VECTOR_FIELD_
1704 #define VECTOR_FIELD_
1705 #undef MPP_TYPE_
1706 #define MPP_TYPE_ real(r8_kind)
1707 #undef MPP_UPDATE_DOMAINS_AD_2D_
1708 #define MPP_UPDATE_DOMAINS_AD_2D_ mpp_update_domains_ad_2D_r8_2D
1709 #undef MPP_UPDATE_DOMAINS_AD_3D_
1710 #define MPP_UPDATE_DOMAINS_AD_3D_ mpp_update_domains_ad_2D_r8_3D
1711 #undef MPP_UPDATE_DOMAINS_AD_4D_
1712 #define MPP_UPDATE_DOMAINS_AD_4D_ mpp_update_domains_ad_2D_r8_4D
1713 #undef MPP_UPDATE_DOMAINS_AD_5D_
1714 #define MPP_UPDATE_DOMAINS_AD_5D_ mpp_update_domains_ad_2D_r8_5D
1715 #ifdef VECTOR_FIELD_
1716 #undef MPP_UPDATE_DOMAINS_AD_2D_V_
1717 #define MPP_UPDATE_DOMAINS_AD_2D_V_ mpp_update_domains_ad_2D_r8_2Dv
1718 #undef MPP_UPDATE_DOMAINS_AD_3D_V_
1719 #define MPP_UPDATE_DOMAINS_AD_3D_V_ mpp_update_domains_ad_2D_r8_3Dv
1720 #undef MPP_UPDATE_DOMAINS_AD_4D_V_
1721 #define MPP_UPDATE_DOMAINS_AD_4D_V_ mpp_update_domains_ad_2D_r8_4Dv
1722 #undef MPP_UPDATE_DOMAINS_AD_5D_V_
1723 #define MPP_UPDATE_DOMAINS_AD_5D_V_ mpp_update_domains_ad_2D_r8_5Dv
1724 #endif
1725 #include <mpp_update_domains2D_ad.fh>
1726 
1727 #undef VECTOR_FIELD_
1728 #define VECTOR_FIELD_
1729 #undef MPP_TYPE_
1730 #define MPP_TYPE_ real(r4_kind)
1731 #undef MPP_UPDATE_DOMAINS_AD_2D_
1732 #define MPP_UPDATE_DOMAINS_AD_2D_ mpp_update_domains_ad_2D_r4_2D
1733 #undef MPP_UPDATE_DOMAINS_AD_3D_
1734 #define MPP_UPDATE_DOMAINS_AD_3D_ mpp_update_domains_ad_2D_r4_3D
1735 #undef MPP_UPDATE_DOMAINS_AD_4D_
1736 #define MPP_UPDATE_DOMAINS_AD_4D_ mpp_update_domains_ad_2D_r4_4D
1737 #undef MPP_UPDATE_DOMAINS_AD_5D_
1738 #define MPP_UPDATE_DOMAINS_AD_5D_ mpp_update_domains_ad_2D_r4_5D
1739 #ifdef VECTOR_FIELD_
1740 #undef MPP_UPDATE_DOMAINS_AD_2D_V_
1741 #define MPP_UPDATE_DOMAINS_AD_2D_V_ mpp_update_domains_ad_2D_r4_2Dv
1742 #undef MPP_UPDATE_DOMAINS_AD_3D_V_
1743 #define MPP_UPDATE_DOMAINS_AD_3D_V_ mpp_update_domains_ad_2D_r4_3Dv
1744 #undef MPP_UPDATE_DOMAINS_AD_4D_V_
1745 #define MPP_UPDATE_DOMAINS_AD_4D_V_ mpp_update_domains_ad_2D_r4_4Dv
1746 #undef MPP_UPDATE_DOMAINS_AD_5D_V_
1747 #define MPP_UPDATE_DOMAINS_AD_5D_V_ mpp_update_domains_ad_2D_r4_5Dv
1748 #endif
1749 #include <mpp_update_domains2D_ad.fh>
1750 
1751 !*******************************************************
1752 #undef VECTOR_FIELD_
1753 #define VECTOR_FIELD_
1754 #undef MPP_TYPE_
1755 #define MPP_TYPE_ real(r8_kind)
1756 #undef MPP_DO_UPDATE_AD_3D_
1757 #define MPP_DO_UPDATE_AD_3D_ mpp_do_update_ad_r8_3d
1758 #ifdef VECTOR_FIELD_
1759 #undef MPP_DO_UPDATE_AD_3D_V_
1760 #define MPP_DO_UPDATE_AD_3D_V_ mpp_do_update_ad_r8_3dv
1761 #endif
1762 #include <mpp_do_update_ad.fh>
1763 #include <mpp_do_updateV_ad.fh>
1764 
1765 #ifdef OVERLOAD_C8
1766 #undef VECTOR_FIELD_
1767 #undef MPP_TYPE_
1768 #define MPP_TYPE_ complex(c8_kind)
1769 #undef MPP_DO_UPDATE_AD_3D_
1770 #define MPP_DO_UPDATE_AD_3D_ mpp_do_update_ad_c8_3d
1771 #include <mpp_do_update_ad.fh>
1772 #define VECTOR_FIELD_
1773 #endif
1774 
1775 #undef MPP_TYPE_
1776 #define MPP_TYPE_ integer(i8_kind)
1777 #undef MPP_DO_UPDATE_AD_3D_
1778 #define MPP_DO_UPDATE_AD_3D_ mpp_do_update_ad_i8_3d
1779 #include <mpp_do_update_ad.fh>
1780 
1781 #undef VECTOR_FIELD_
1782 #define VECTOR_FIELD_
1783 #undef MPP_TYPE_
1784 #define MPP_TYPE_ real(r4_kind)
1785 #undef MPP_DO_UPDATE_AD_3D_
1786 #define MPP_DO_UPDATE_AD_3D_ mpp_do_update_ad_r4_3d
1787 #ifdef VECTOR_FIELD_
1788 #undef MPP_DO_UPDATE_AD_3D_V_
1789 #define MPP_DO_UPDATE_AD_3D_V_ mpp_do_update_ad_r4_3dv
1790 #endif
1791 #include <mpp_do_update_ad.fh>
1792 #include <mpp_do_updateV_ad.fh>
1793 
1794 #ifdef OVERLOAD_C4
1795 #undef VECTOR_FIELD_
1796 #undef MPP_TYPE_
1797 #define MPP_TYPE_ complex(c4_kind)
1798 #undef MPP_DO_UPDATE_AD_3D_
1799 #define MPP_DO_UPDATE_AD_3D_ mpp_do_update_ad_c4_3d
1800 #include <mpp_do_update_ad.fh>
1801 #define VECTOR_FIELD_
1802 #endif
1803 
1804 #undef MPP_TYPE_
1805 #define MPP_TYPE_ integer(i4_kind)
1806 #undef MPP_DO_UPDATE_AD_3D_
1807 #define MPP_DO_UPDATE_AD_3D_ mpp_do_update_ad_i4_3d
1808 #include <mpp_do_update_ad.fh>
1809 
1810 !********************************************************
1811 #undef MPP_TYPE_
1812 #define MPP_TYPE_ real(r8_kind)
1813 #undef MPP_DO_REDISTRIBUTE_3D_
1814 #define MPP_DO_REDISTRIBUTE_3D_ mpp_do_redistribute_r8_3D
1815 #include <mpp_do_redistribute.fh>
1816 #undef VECTOR_FIELD_
1817 
1818 #ifdef OVERLOAD_C8
1819 #undef MPP_TYPE_
1820 #define MPP_TYPE_ complex(c8_kind)
1821 #undef MPP_DO_REDISTRIBUTE_3D_
1822 #define MPP_DO_REDISTRIBUTE_3D_ mpp_do_redistribute_c8_3D
1823 #include <mpp_do_redistribute.fh>
1824 #endif
1825 
1826 #undef MPP_TYPE_
1827 #define MPP_TYPE_ integer(i8_kind)
1828 #undef MPP_DO_REDISTRIBUTE_3D_
1829 #define MPP_DO_REDISTRIBUTE_3D_ mpp_do_redistribute_i8_3D
1830 #include <mpp_do_redistribute.fh>
1831 
1832 #undef MPP_TYPE_
1833 #define MPP_TYPE_ logical(l8_kind)
1834 #undef MPP_DO_REDISTRIBUTE_3D_
1835 #define MPP_DO_REDISTRIBUTE_3D_ mpp_do_redistribute_l8_3D
1836 #include <mpp_do_redistribute.fh>
1837 
1838 #undef MPP_TYPE_
1839 #define MPP_TYPE_ real(r4_kind)
1840 #undef MPP_DO_REDISTRIBUTE_3D_
1841 #define MPP_DO_REDISTRIBUTE_3D_ mpp_do_redistribute_r4_3D
1842 #include <mpp_do_redistribute.fh>
1843 #undef VECTOR_FIELD_
1844 
1845 #ifdef OVERLOAD_C4
1846 #undef MPP_TYPE_
1847 #define MPP_TYPE_ complex(c4_kind)
1848 #undef MPP_DO_REDISTRIBUTE_3D_
1849 #define MPP_DO_REDISTRIBUTE_3D_ mpp_do_redistribute_c4_3D
1850 #include <mpp_do_redistribute.fh>
1851 #endif
1852 
1853 #undef MPP_TYPE_
1854 #define MPP_TYPE_ integer(i4_kind)
1855 #undef MPP_DO_REDISTRIBUTE_3D_
1856 #define MPP_DO_REDISTRIBUTE_3D_ mpp_do_redistribute_i4_3D
1857 #include <mpp_do_redistribute.fh>
1858 
1859 #undef MPP_TYPE_
1860 #define MPP_TYPE_ logical(l4_kind)
1861 #undef MPP_DO_REDISTRIBUTE_3D_
1862 #define MPP_DO_REDISTRIBUTE_3D_ mpp_do_redistribute_l4_3D
1863 #include <mpp_do_redistribute.fh>
1864 
1865 #undef MPP_TYPE_
1866 #define MPP_TYPE_ real(r8_kind)
1867 #undef MPP_GET_BOUNDARY_2D_
1868 #define MPP_GET_BOUNDARY_2D_ mpp_get_boundary_r8_2d
1869 #undef MPP_GET_BOUNDARY_3D_
1870 #define MPP_GET_BOUNDARY_3D_ mpp_get_boundary_r8_3d
1871 !#undef MPP_GET_BOUNDARY_4D_
1872 !#define MPP_GET_BOUNDARY_4D_ mpp_get_boundary_r8_4d
1873 !#undef MPP_GET_BOUNDARY_5D_
1874 !#define MPP_GET_BOUNDARY_5D_ mpp_get_boundary_r8_5d
1875 #undef MPP_GET_BOUNDARY_2D_V_
1876 #define MPP_GET_BOUNDARY_2D_V_ mpp_get_boundary_r8_2dv
1877 #undef MPP_GET_BOUNDARY_3D_V_
1878 #define MPP_GET_BOUNDARY_3D_V_ mpp_get_boundary_r8_3dv
1879 !#undef MPP_GET_BOUNDARY_4D_V_
1880 !#define MPP_GET_BOUNDARY_4D_V_ mpp_get_boundary_r8_4dv
1881 !#undef MPP_GET_BOUNDARY_5D_V_
1882 !#define MPP_GET_BOUNDARY_5D_V_ mpp_get_boundary_r8_5dv
1883 #include <mpp_get_boundary.fh>
1884 
1885 #undef MPP_TYPE_
1886 #define MPP_TYPE_ real(r8_kind)
1887 #undef MPP_GET_BOUNDARY_AD_2D_
1888 #define MPP_GET_BOUNDARY_AD_2D_ mpp_get_boundary_ad_r8_2d
1889 #undef MPP_GET_BOUNDARY_AD_3D_
1890 #define MPP_GET_BOUNDARY_AD_3D_ mpp_get_boundary_ad_r8_3d
1891 #undef MPP_GET_BOUNDARY_AD_2D_V_
1892 #define MPP_GET_BOUNDARY_AD_2D_V_ mpp_get_boundary_ad_r8_2dv
1893 #undef MPP_GET_BOUNDARY_AD_3D_V_
1894 #define MPP_GET_BOUNDARY_AD_3D_V_ mpp_get_boundary_ad_r8_3dv
1895 #include <mpp_get_boundary_ad.fh>
1896 
1897 #undef MPP_TYPE_
1898 #define MPP_TYPE_ real(r4_kind)
1899 #undef MPP_GET_BOUNDARY_2D_
1900 #define MPP_GET_BOUNDARY_2D_ mpp_get_boundary_r4_2d
1901 #undef MPP_GET_BOUNDARY_3D_
1902 #define MPP_GET_BOUNDARY_3D_ mpp_get_boundary_r4_3d
1903 !#undef MPP_GET_BOUNDARY_4D_
1904 !#define MPP_GET_BOUNDARY_4D_ mpp_get_boundary_r4_4d
1905 !#undef MPP_GET_BOUNDARY_5D_
1906 !#define MPP_GET_BOUNDARY_5D_ mpp_get_boundary_r4_5d
1907 #undef MPP_GET_BOUNDARY_2D_V_
1908 #define MPP_GET_BOUNDARY_2D_V_ mpp_get_boundary_r4_2dv
1909 #undef MPP_GET_BOUNDARY_3D_V_
1910 #define MPP_GET_BOUNDARY_3D_V_ mpp_get_boundary_r4_3dv
1911 !#undef MPP_GET_BOUNDARY_4D_V_
1912 !#define MPP_GET_BOUNDARY_4D_V_ mpp_get_boundary_r4_4dv
1913 !#undef MPP_GET_BOUNDARY_5D_V_
1914 !#define MPP_GET_BOUNDARY_5D_V_ mpp_get_boundary_r4_5dv
1915 #include <mpp_get_boundary.fh>
1916 
1917 #undef MPP_TYPE_
1918 #define MPP_TYPE_ real(r4_kind)
1919 #undef MPP_GET_BOUNDARY_AD_2D_
1920 #define MPP_GET_BOUNDARY_AD_2D_ mpp_get_boundary_ad_r4_2d
1921 #undef MPP_GET_BOUNDARY_AD_3D_
1922 #define MPP_GET_BOUNDARY_AD_3D_ mpp_get_boundary_ad_r4_3d
1923 #undef MPP_GET_BOUNDARY_AD_2D_V_
1924 #define MPP_GET_BOUNDARY_AD_2D_V_ mpp_get_boundary_ad_r4_2dv
1925 #undef MPP_GET_BOUNDARY_AD_3D_V_
1926 #define MPP_GET_BOUNDARY_AD_3D_V_ mpp_get_boundary_ad_r4_3dv
1927 #include <mpp_get_boundary_ad.fh>
1928 
1929 #undef MPP_TYPE_
1930 #define MPP_TYPE_ real(r8_kind)
1931 #undef MPP_DO_GET_BOUNDARY_3D_
1932 #define MPP_DO_GET_BOUNDARY_3D_ mpp_do_get_boundary_r8_3d
1933 #undef MPP_DO_GET_BOUNDARY_3DV_
1934 #define MPP_DO_GET_BOUNDARY_3D_V_ mpp_do_get_boundary_r8_3dv
1935 #include <mpp_do_get_boundary.fh>
1936 
1937 #undef MPP_TYPE_
1938 #define MPP_TYPE_ real(r8_kind)
1939 #undef MPP_DO_GET_BOUNDARY_AD_3D_
1940 #define MPP_DO_GET_BOUNDARY_AD_3D_ mpp_do_get_boundary_ad_r8_3d
1941 #undef MPP_DO_GET_BOUNDARY_AD_3DV_
1942 #define MPP_DO_GET_BOUNDARY_AD_3D_V_ mpp_do_get_boundary_ad_r8_3dv
1943 #include <mpp_do_get_boundary_ad.fh>
1944 
1945 #undef MPP_TYPE_
1946 #define MPP_TYPE_ real(r4_kind)
1947 #undef MPP_DO_GET_BOUNDARY_3D_
1948 #define MPP_DO_GET_BOUNDARY_3D_ mpp_do_get_boundary_r4_3d
1949 #undef MPP_DO_GET_BOUNDARY_3D_V_
1950 #define MPP_DO_GET_BOUNDARY_3D_V_ mpp_do_get_boundary_r4_3dv
1951 #include <mpp_do_get_boundary.fh>
1952 
1953 #undef MPP_TYPE_
1954 #define MPP_TYPE_ real(r4_kind)
1955 #undef MPP_DO_GET_BOUNDARY_AD_3D_
1956 #define MPP_DO_GET_BOUNDARY_AD_3D_ mpp_do_get_boundary_ad_r4_3d
1957 #undef MPP_DO_GET_BOUNDARY_AD_3D_V_
1958 #define MPP_DO_GET_BOUNDARY_AD_3D_V_ mpp_do_get_boundary_ad_r4_3dv
1959 #include <mpp_do_get_boundary_ad.fh>
1960 
1961 #undef MPP_TYPE_
1962 #define MPP_TYPE_ real(r8_kind)
1963 #undef MPI_TYPE_
1964 #define MPI_TYPE_ MPI_REAL8
1965 #undef MPP_CREATE_GROUP_UPDATE_2D_
1966 #define MPP_CREATE_GROUP_UPDATE_2D_ mpp_create_group_update_r8_2d
1967 #undef MPP_CREATE_GROUP_UPDATE_3D_
1968 #define MPP_CREATE_GROUP_UPDATE_3D_ mpp_create_group_update_r8_3d
1969 #undef MPP_CREATE_GROUP_UPDATE_4D_
1970 #define MPP_CREATE_GROUP_UPDATE_4D_ mpp_create_group_update_r8_4d
1971 #undef MPP_CREATE_GROUP_UPDATE_2D_V_
1972 #define MPP_CREATE_GROUP_UPDATE_2D_V_ mpp_create_group_update_r8_2dv
1973 #undef MPP_CREATE_GROUP_UPDATE_3D_V_
1974 #define MPP_CREATE_GROUP_UPDATE_3D_V_ mpp_create_group_update_r8_3dv
1975 #undef MPP_CREATE_GROUP_UPDATE_4D_V_
1976 #define MPP_CREATE_GROUP_UPDATE_4D_V_ mpp_create_group_update_r8_4dv
1977 #undef MPP_DO_GROUP_UPDATE_
1978 #define MPP_DO_GROUP_UPDATE_ mpp_do_group_update_r8
1979 #undef MPP_START_GROUP_UPDATE_
1980 #define MPP_START_GROUP_UPDATE_ mpp_start_group_update_r8
1981 #undef MPP_COMPLETE_GROUP_UPDATE_
1982 #define MPP_COMPLETE_GROUP_UPDATE_ mpp_complete_group_update_r8
1983 #undef MPP_RESET_GROUP_UPDATE_FIELD_2D_
1984 #define MPP_RESET_GROUP_UPDATE_FIELD_2D_ mpp_reset_group_update_field_r8_2d
1985 #undef MPP_RESET_GROUP_UPDATE_FIELD_3D_
1986 #define MPP_RESET_GROUP_UPDATE_FIELD_3D_ mpp_reset_group_update_field_r8_3d
1987 #undef MPP_RESET_GROUP_UPDATE_FIELD_4D_
1988 #define MPP_RESET_GROUP_UPDATE_FIELD_4D_ mpp_reset_group_update_field_r8_4d
1989 #undef MPP_RESET_GROUP_UPDATE_FIELD_2D_V_
1990 #define MPP_RESET_GROUP_UPDATE_FIELD_2D_V_ mpp_reset_group_update_field_r8_2dv
1991 #undef MPP_RESET_GROUP_UPDATE_FIELD_3D_V_
1992 #define MPP_RESET_GROUP_UPDATE_FIELD_3D_V_ mpp_reset_group_update_field_r8_3dv
1993 #undef MPP_RESET_GROUP_UPDATE_FIELD_4D_V_
1994 #define MPP_RESET_GROUP_UPDATE_FIELD_4D_V_ mpp_reset_group_update_field_r8_4dv
1995 #include <mpp_group_update.fh>
1996 
1997 #undef MPP_TYPE_
1998 #define MPP_TYPE_ real(r4_kind)
1999 #undef MPI_TYPE_
2000 #define MPI_TYPE_ MPI_REAL4
2001 #undef MPP_CREATE_GROUP_UPDATE_2D_
2002 #define MPP_CREATE_GROUP_UPDATE_2D_ mpp_create_group_update_r4_2d
2003 #undef MPP_CREATE_GROUP_UPDATE_3D_
2004 #define MPP_CREATE_GROUP_UPDATE_3D_ mpp_create_group_update_r4_3d
2005 #undef MPP_CREATE_GROUP_UPDATE_4D_
2006 #define MPP_CREATE_GROUP_UPDATE_4D_ mpp_create_group_update_r4_4d
2007 #undef MPP_CREATE_GROUP_UPDATE_2D_V_
2008 #define MPP_CREATE_GROUP_UPDATE_2D_V_ mpp_create_group_update_r4_2dv
2009 #undef MPP_CREATE_GROUP_UPDATE_3D_V_
2010 #define MPP_CREATE_GROUP_UPDATE_3D_V_ mpp_create_group_update_r4_3dv
2011 #undef MPP_CREATE_GROUP_UPDATE_4D_V_
2012 #define MPP_CREATE_GROUP_UPDATE_4D_V_ mpp_create_group_update_r4_4dv
2013 #undef MPP_DO_GROUP_UPDATE_
2014 #define MPP_DO_GROUP_UPDATE_ mpp_do_group_update_r4
2015 #undef MPP_START_GROUP_UPDATE_
2016 #define MPP_START_GROUP_UPDATE_ mpp_start_group_update_r4
2017 #undef MPP_COMPLETE_GROUP_UPDATE_
2018 #define MPP_COMPLETE_GROUP_UPDATE_ mpp_complete_group_update_r4
2019 #undef MPP_RESET_GROUP_UPDATE_FIELD_2D_
2020 #define MPP_RESET_GROUP_UPDATE_FIELD_2D_ mpp_reset_group_update_field_r4_2d
2021 #undef MPP_RESET_GROUP_UPDATE_FIELD_3D_
2022 #define MPP_RESET_GROUP_UPDATE_FIELD_3D_ mpp_reset_group_update_field_r4_3d
2023 #undef MPP_RESET_GROUP_UPDATE_FIELD_4D_
2024 #define MPP_RESET_GROUP_UPDATE_FIELD_4D_ mpp_reset_group_update_field_r4_4d
2025 #undef MPP_RESET_GROUP_UPDATE_FIELD_2D_V_
2026 #define MPP_RESET_GROUP_UPDATE_FIELD_2D_V_ mpp_reset_group_update_field_r4_2dv
2027 #undef MPP_RESET_GROUP_UPDATE_FIELD_3D_V_
2028 #define MPP_RESET_GROUP_UPDATE_FIELD_3D_V_ mpp_reset_group_update_field_r4_3dv
2029 #undef MPP_RESET_GROUP_UPDATE_FIELD_4D_V_
2030 #define MPP_RESET_GROUP_UPDATE_FIELD_4D_V_ mpp_reset_group_update_field_r4_4dv
2031 #include <mpp_group_update.fh>
mpp_check_field_2d_type1
subroutine mpp_check_field_2d_type1(field_in, pelist1, pelist2, domain, mesg, w_halo, s_halo, e_halo, n_halo, force_abort)
This routine is used to check field between running on 1 pe (pelist2) and n pe(pelist1)....
Definition: mpp_domains_misc.inc:259
mpp_broadcast_domain_1
subroutine logical mpp_broadcast_domain_1(domain)
broadcast domain (useful only outside the context of its own pelist)
Definition: mpp_domains_misc.inc:470
mpp_domains_init
subroutine mpp_domains_init(flags)
Initialize domain decomp package.
Definition: mpp_domains_misc.inc:45
mpp_check_field_2d
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...
Definition: mpp_domains_misc.inc:220
mpp_domains_exit
subroutine mpp_domains_exit()
Exit mpp_domains_mod. Serves no particular purpose, but is provided should you require to re-initiali...
Definition: mpp_domains_misc.inc:167
mpp_check_field_3d
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...
Definition: mpp_domains_misc.inc:187
mpp_broadcast_domain_nest_coarse
subroutine mpp_broadcast_domain_nest_coarse(domain, tile_coarse)
Broadcast nested domain (useful only outside the context of its own pelist)
Definition: mpp_domains_misc.inc:842
mpp_check_field_2d_type2
subroutine mpp_check_field_2d_type2(field_in, pelist1, pelist2, domain, mesg, force_abort)
This routine is used to check field between running on m pe (root pe) and n pe. This routine can not ...
Definition: mpp_domains_misc.inc:389
mpp_domains_set_stack_size
subroutine mpp_domains_set_stack_size(n)
Set user stack size.
Definition: mpp_domains_util.inc:36
init_nonblock_type
subroutine init_nonblock_type(nonblock_obj)
Initialize domain decomp package.
Definition: mpp_domains_misc.inc:126
mpp_sync_self
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...
Definition: mpp_util_mpi.inc:172
stdout
integer function stdout()
This function returns the current standard fortran unit numbers for output.
Definition: mpp_util.inc:43
mpp_init
subroutine mpp_init(flags, localcomm, test_level, alt_input_nml_path)
Initialize the mpp_mod module. Must be called before any usage.
Definition: mpp_comm_mpi.inc:34
stderr
integer function stderr()
This function returns the current standard fortran unit numbers for error messages.
Definition: mpp_util.inc:51
stdlog
integer function stdlog()
This function returns the current standard fortran unit numbers for log messages. Log messages,...
Definition: mpp_util.inc:59
mpp_npes
integer function mpp_npes()
Returns processor count for current pelist.
Definition: mpp_util.inc:421
mpp_pe
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:407
mpp_sync
subroutine mpp_sync(pelist, do_self)
Synchronize PEs in list.
Definition: mpp_util_mpi.inc:149
mpp_clock_id
integer function mpp_clock_id(name, flags, grain)
Return an ID for a new or existing clock.
Definition: mpp_util.inc:705