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