44 integer,
intent(in),
optional :: flags
46 integer :: io_status, iunit
48 if( module_is_initialized )
return
50 module_is_initialized = .true.
53 if(
mpp_pe() .EQ.mpp_root_pe() )
write( iunit,
'(/a)' )
'MPP_DOMAINS module '//trim(version)
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
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')
68 select case(lowercase(trim(debug_update_domain)))
70 debug_update_level = no_check
72 debug_update_level = fatal
74 debug_update_level = warning
76 debug_update_level = note
78 call mpp_error(fatal,
"mpp_domains_init: debug_update_level should be 'none', 'fatal', 'warning', or 'note'")
81 allocate(nonblock_data(max_nonblock_update))
83 do n = 1, max_nonblock_update
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)
94 if( domain_clocks_on )
then
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' )
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' )
125 type(nonblock_type),
intent(inout) :: nonblock_obj
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
144 nonblock_obj%request_send(:) = mpi_request_null
145 nonblock_obj%request_recv(:) = mpi_request_null
147 nonblock_obj%request_send(:) = 0
148 nonblock_obj%request_recv(:) = 0
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
167 if( .NOT.module_is_initialized )
return
168 call mpp_max(mpp_domains_stack_hwm)
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.
185 w_halo, s_halo, e_halo, n_halo, force_abort, position )
187 real,
dimension(:,:,:),
intent(in) :: field_in
188 integer,
dimension(:),
intent(in) :: pelist1, pelist2
189 type(domain2d),
intent(in) :: domain
190 character(len=*),
intent(in) :: mesg
192 integer,
intent(in),
optional :: w_halo, s_halo, e_halo, n_halo
194 logical,
intent(in),
optional :: force_abort
196 integer,
intent(in),
optional :: position
200 character(len=256) :: temp_mesg
203 do k = 1,
size(field_in,3)
204 write(temp_mesg,
'(a, i3)') trim(mesg)//
" at level " , k
206 w_halo, s_halo, e_halo, n_halo, force_abort, position )
218 w_halo, s_halo, e_halo, n_halo,force_abort, position )
220 real,
dimension(:,:),
intent(in) :: field_in
221 integer,
dimension(:),
intent(in) :: pelist1, pelist2
222 type(domain2d),
intent(in) :: domain
223 character(len=*),
intent(in) :: mesg
225 integer,
intent(in),
optional :: w_halo, s_halo, e_halo, n_halo
226 logical,
intent(in),
optional :: force_abort
228 integer,
intent(in),
optional :: position
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')
236 if(
size(pelist2(:)) == 1)
then
238 w_halo, s_halo, e_halo, n_halo, force_abort )
239 else if(
size(pelist1(:)) == 1)
then
241 w_halo, s_halo, e_halo, n_halo, force_abort )
242 else if(
size(pelist1(:)) .gt. 1 .and.
size(pelist2(:)) .gt. 1)
then
245 call mpp_error(fatal,
'mpp_check_field: size of both pelists should be greater than 0')
257 w_halo, s_halo, e_halo, n_halo,force_abort )
259 real,
dimension(:,:),
intent(in) :: field_in
260 integer,
dimension(:),
intent(in) :: pelist1, pelist2
261 type(domain2d),
intent(in) :: domain
262 character(len=*),
intent(in) :: mesg
264 integer,
intent(in),
optional :: w_halo, s_halo, e_halo, n_halo
265 logical,
intent(in),
optional :: force_abort
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
277 check_success = .true.
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
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)
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')
297 is = isc - hwest; ie = iec + heast; js = jsc - hsouth; je = jec + hnorth
298 allocate(field2(is:ie,js:je))
301 if((
size(field_in,1) .eq. iec-isc+1) .and. (
size(field_in,2) .eq. jec-jsc+1))
then
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)
315 print*,
'on pe ', pe,
'domain: ', isc, iec, jsc, jec, isd, ied, jsd, jed,
'size of field: ',
size(field_in,1), &
317 call mpp_error(fatal,
'mpp_check_field: '//trim(mesg)//
':field is not on compute, data or global domain')
322 if(any(pelist1 == pe))
then
324 im = ie-is+1; jm=je-js+1
325 allocate(send_buffer(im*jm))
327 ibounds(1) = is; ibounds(2) = ie; ibounds(3) = js; ibounds(4) = je
332 send_buffer(l) = field2(i,j)
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)
341 else if(pelist2(1) == pe)
then
342 do p = pelist1(1), pelist1(
size(pelist1(:)))
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))
351 call mpp_recv(send_buffer(1),glen=im*jm,from_pe=p, tag=comm_tag_2)
358 field1(i,j) = send_buffer(l)
359 if(field1(i,j) .ne. field2(i,j))
then
361 print*,trim(mesg)//
": ", i, j, field1(i,j), field2(i,j), field1(i,j) - field2(i,j)
363 check_success = .false.
364 if(error_exit)
call mpp_error(fatal,
"mpp_check_field: can not reproduce at this point")
370 if(check_success)
then
371 print*, trim(mesg)//
": ",
'comparison between 1 pe and ', npes-1,
' pes is ok'
374 deallocate(field1, send_buffer)
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
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
402 check_success = .true.
404 if(
present(force_abort)) error_exit = force_abort
408 if(any(pelist1 == pe)) domain1 = domain
409 if(any(pelist2 == pe)) domain2 = domain
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(:,:)
424 if(any(pelist1 == pe))
then
425 allocate(field1(1,1))
429 call mpp_broadcast_domain(domain1)
430 call mpp_broadcast_domain(domain2)
432 call mpp_redistribute(domain1,field_in,domain2,field1)
434 if(any(pelist2 == pe))
then
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)
440 check_success = .false.
441 if(error_exit)
call mpp_error(fatal,
"mpp_check_field: can not reproduce at this point")
446 print*, trim(mesg)//
": ",
'comparison between ',
size(pelist1(:)),
' pes and ', &
447 size(pelist2(:)),
' pe on', pe,
' pes is ok'
450 if(any(pelist2 == pe))
deallocate(field1, field2)
452 if(any(pelist1 == pe))
deallocate(field1)
469 type(domain2d),
intent(inout) :: domain
470 integer,
allocatable :: pes(:)
472 integer :: listsize, listpos
474 integer,
dimension(12) :: msg, info
478 if( .NOT.module_is_initialized ) &
479 call mpp_error( fatal,
'MPP_BROADCAST_DOMAIN_1: You must first call mpp_domains_init.' )
483 call mpp_get_current_pelist(pes)
486 native =
ASSOCIATED(domain%list)
490 listsize =
size(domain%list(:))
494 call mpp_max(listsize)
496 if( .NOT.native )
then
498 allocate( domain%list(0:listsize-1) )
501 allocate(domain%x(1), domain%y(1), domain%tile_id(1))
503 allocate(domain%list(n)%x(1), domain%list(n)%y(1), domain%list(n)%tile_id(1) )
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
522 domain%symmetry = .false.
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
537 info(12) = domain%ntiles
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) )
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.
569 domain%symmetry = .false.
571 domain%ntiles = msg(12)
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))
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)
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(:)
598 integer,
dimension(12) :: msg, info
599 integer :: errunit, npes_in, npes_out, pstart, pend
602 if( .NOT.module_is_initialized ) &
603 call mpp_error( fatal,
'MPP_BROADCAST_DOMAIN_2: You must first call mpp_domains_init.' )
607 call mpp_get_current_pelist(pes)
610 if( .not.
ASSOCIATED(domain_in%list) )
then
611 call mpp_error( fatal,
'MPP_BROADCAST_DOMAIN_2: domain_in is not initialized')
613 if(
ASSOCIATED(domain_out%list) )
then
614 call mpp_error( fatal,
'MPP_BROADCAST_DOMAIN_2: domain_out is already initialized')
617 npes_in =
size(domain_in%list(:))
619 call mpp_error( fatal,
'MPP_BROADCAST_DOMAIN_2: size(domain_in%list(:)) == mpp_npes()')
624 allocate( domain_out%list(0:npes_out-1) )
625 domain_out%pe = null_pe
627 allocate(domain_out%x(1), domain_out%y(1), domain_out%tile_id(1))
629 allocate(domain_out%list(n)%x(1), domain_out%list(n)%y(1), domain_out%list(n)%tile_id(1) )
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.
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
662 info(12) = domain_in%ntiles
665 if( domain_in%list(0)%pe == mpp_root_pe() )
then
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) )
677 if( n .GE. pstart .AND. n .LE. pend )
then
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.
701 domain_out%symmetry = .false.
703 domain_out%ntiles = msg(12)
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))
714 if( debug )
write( errunit,* )
'PE ',
mpp_pe(),
'received domain from PE ', msg(1),
'is,ie,js,je=', msg(2:5)
718 end subroutine mpp_broadcast_domain_2
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(:)
726 integer :: listsize, listpos, nestsize(size(tile_nest(:)))
727 integer :: n, tile, ind, num_nest
728 integer,
dimension(15) :: msg, info
732 if( .NOT.module_is_initialized ) &
733 call mpp_error( fatal,
'MPP_BROADCAST_DOMAIN_NEST_FINE: You must first call mpp_domains_init.' )
737 call mpp_get_current_pelist(pes)
740 native =
ASSOCIATED(domain%list)
741 num_nest =
size(tile_nest(:))
745 tile = domain%tile_id(1)
748 if(tile_nest(n) == tile)
then
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(:))
757 call mpp_max(nestsize, num_nest)
758 listsize = sum(nestsize)
760 if( .NOT.native )
then
762 allocate( domain%list(0:listsize-1) )
765 allocate(domain%x(1), domain%y(1), domain%tile_id(1))
767 allocate(domain%list(n)%x(1), domain%list(n)%y(1), domain%list(n)%tile_id(1) )
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
786 domain%symmetry = .false.
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
801 call mpp_get_global_domain( domain, info(12), info(13), info(14), info(15) )
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) )
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.
820 domain%symmetry = .false.
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)
837 end subroutine mpp_broadcast_domain_nest_fine
841 type(domain2d),
intent(inout) :: domain
842 integer,
intent(in) :: tile_coarse
843 integer,
allocatable :: pes(:)
845 integer :: listsize, listpos
846 integer,
allocatable :: tile_pesize(:)
847 integer :: n, maxtile
848 integer,
dimension(17) :: msg, info
852 if( .NOT.module_is_initialized ) &
853 call mpp_error( fatal,
'MPP_BROADCAST_DOMAIN_NEST_COARSE: You must first call mpp_domains_init.' )
857 call mpp_get_current_pelist(pes)
859 maxtile = tile_coarse
860 call mpp_max(maxtile)
861 allocate(tile_pesize(maxtile))
864 native =
ASSOCIATED(domain%list)
872 tile_pesize(tile_coarse) =
size(domain%list(:))
874 call mpp_max(tile_pesize, maxtile)
875 listsize = tile_pesize(tile_coarse)
877 if( .NOT.native )
then
879 allocate( domain%list(0:listsize-1) )
882 allocate(domain%x(1), domain%y(1), domain%tile_id(1))
884 allocate(domain%list(n)%x(1), domain%list(n)%y(1), domain%list(n)%tile_id(1) )
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
903 domain%symmetry = .false.
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
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
926 call mpp_broadcast( msg, 17, pes(n) )
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.
948 domain%symmetry = .false.
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)
975 #define VECTOR_FIELD_
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
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
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_
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>
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>
1049 #undef VECTOR_FIELD_
1050 #define VECTOR_FIELD_
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_
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>
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>
1132 #undef VECTOR_FIELD_
1133 #define VECTOR_FIELD_
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
1170 #include <mpp_update_domains2D_nonblock.fh>
1173 #undef VECTOR_FIELD_
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>
1195 #undef VECTOR_FIELD_
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>
1216 #undef VECTOR_FIELD_
1217 #define VECTOR_FIELD_
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
1254 #include <mpp_update_domains2D_nonblock.fh>
1257 #undef VECTOR_FIELD_
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>
1279 #undef VECTOR_FIELD_
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>
1308 #define MPP_TYPE_ real(r8_kind)
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>
1324 #define MPP_TYPE_ complex(c8_kind)
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>
1335 #define MPP_TYPE_ integer(i8_kind)
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>
1345 #define MPP_TYPE_ real(r4_kind)
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>
1361 #define MPP_TYPE_ complex(c4_kind)
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>
1372 #define MPP_TYPE_ integer(i4_kind)
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>
1382 #undef VECTOR_FIELD_
1383 #define VECTOR_FIELD_
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
1392 #include <mpp_do_update.fh>
1393 #include <mpp_do_updateV.fh>
1396 #undef VECTOR_FIELD_
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_
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>
1411 #undef VECTOR_FIELD_
1412 #define VECTOR_FIELD_
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
1421 #include <mpp_do_update.fh>
1422 #include <mpp_do_updateV.fh>
1425 #undef VECTOR_FIELD_
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_
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>
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
1449 #include <mpp_do_check.fh>
1450 #include <mpp_do_checkV.fh>
1453 #undef VECTOR_FIELD_
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_
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>
1468 #undef VECTOR_FIELD_
1469 #define VECTOR_FIELD_
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
1478 #include <mpp_do_check.fh>
1479 #include <mpp_do_checkV.fh>
1482 #undef VECTOR_FIELD_
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>
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>
1496 #undef VECTOR_FIELD_
1497 #define VECTOR_FIELD_
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>
1527 #undef VECTOR_FIELD_
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>
1545 #undef VECTOR_FIELD_
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>
1562 #undef VECTOR_FIELD_
1563 #define VECTOR_FIELD_
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>
1593 #undef VECTOR_FIELD_
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>
1611 #undef VECTOR_FIELD_
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>
1628 #undef VECTOR_FIELD_
1629 #define VECTOR_FIELD_
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>
1643 #undef VECTOR_FIELD_
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>
1653 #undef VECTOR_FIELD_
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>
1662 #undef VECTOR_FIELD_
1663 #define VECTOR_FIELD_
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>
1677 #undef VECTOR_FIELD_
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>
1687 #undef VECTOR_FIELD_
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>
1702 #undef VECTOR_FIELD_
1703 #define VECTOR_FIELD_
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
1724 #include <mpp_update_domains2D_ad.fh>
1726 #undef VECTOR_FIELD_
1727 #define VECTOR_FIELD_
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
1748 #include <mpp_update_domains2D_ad.fh>
1751 #undef VECTOR_FIELD_
1752 #define VECTOR_FIELD_
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
1761 #include <mpp_do_update_ad.fh>
1762 #include <mpp_do_updateV_ad.fh>
1765 #undef VECTOR_FIELD_
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_
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>
1780 #undef VECTOR_FIELD_
1781 #define VECTOR_FIELD_
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
1790 #include <mpp_do_update_ad.fh>
1791 #include <mpp_do_updateV_ad.fh>
1794 #undef VECTOR_FIELD_
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_
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>
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_
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>
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>
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>
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_
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>
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>
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>
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
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
1882 #include <mpp_get_boundary.fh>
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>
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
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
1914 #include <mpp_get_boundary.fh>
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>
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>
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>
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>
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>
1961 #define MPP_TYPE_ real(r8_kind)
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>
1997 #define MPP_TYPE_ real(r4_kind)
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>
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)....
subroutine logical mpp_broadcast_domain_1(domain)
broadcast domain (useful only outside the context of its own pelist)
subroutine mpp_domains_init(flags)
Initialize domain decomp package.
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...
subroutine mpp_domains_exit()
Exit mpp_domains_mod. Serves no particular purpose, but is provided should you require to re-initiali...
subroutine mpp_check_field_3d(field_in, pelist1, pelist2, domain, mesg, w_halo, s_halo, e_halo, n_halo, force_abort, position)
This routine is used to do parallel checking for 3d data between n and m pe. The comparison is is don...
subroutine mpp_broadcast_domain_nest_coarse(domain, tile_coarse)
Broadcast nested domain (useful only outside the context of its own pelist)
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 ...
subroutine mpp_domains_set_stack_size(n)
Set user stack size.
subroutine init_nonblock_type(nonblock_obj)
Initialize domain decomp package.
subroutine mpp_sync_self(pelist, check, request, msg_size, msg_type)
This is to check if current PE's outstanding puts are complete but we can't use shmem_fence because w...
integer function stdout()
This function returns the current standard fortran unit numbers for output.
subroutine mpp_init(flags, localcomm, test_level, alt_input_nml_path)
Initialize the mpp_mod module. Must be called before any usage.
integer function stderr()
This function returns the current standard fortran unit numbers for error messages.
integer function stdlog()
This function returns the current standard fortran unit numbers for log messages. Log messages,...
integer function mpp_npes()
Returns processor count for current pelist.
integer function mpp_pe()
Returns processor ID.
subroutine mpp_sync(pelist, do_self)
Synchronize PEs in list.
integer function mpp_clock_id(name, flags, grain)
Return an ID for a new or existing clock.