From 07b08fb7ce082ea25faba13aebb07e0edead3666 Mon Sep 17 00:00:00 2001 From: Caitlyn Mcallister Date: Tue, 22 Aug 2023 22:22:40 -0400 Subject: [PATCH] change all variables named 'data' in test_mpp_* --- test_fms/mpp/fill_halo.F90 | 472 +++++++++++----------- test_fms/mpp/test_domains_utility_mod.F90 | 28 +- test_fms/mpp/test_mpp_domains.F90 | 293 +++++++------- test_fms/mpp/test_mpp_gatscat.F90 | 62 +-- test_fms/mpp/test_mpp_sendrecv.F90 | 112 ++--- 5 files changed, 492 insertions(+), 475 deletions(-) diff --git a/test_fms/mpp/fill_halo.F90 b/test_fms/mpp/fill_halo.F90 index bb8996ce38..63013ddbf8 100644 --- a/test_fms/mpp/fill_halo.F90 +++ b/test_fms/mpp/fill_halo.F90 @@ -90,285 +90,285 @@ module fill_halo contains !> fill the halo region of a 64-bit real array with zeros - subroutine fill_halo_zero_r8(data, whalo, ehalo, shalo, nhalo, xshift, yshift, isc, iec, jsc, jec, isd, ied, & + subroutine fill_halo_zero_r8(halo_data, whalo, ehalo, shalo, nhalo, xshift, yshift, isc, iec, jsc, jec, isd, ied, & & jsd, jed) - real(kind=r8_kind), dimension(isd:,jsd:,:), intent(inout) :: data + real(kind=r8_kind), dimension(isd:,jsd:,:), intent(inout) :: halo_data integer, intent(in) :: isc, iec, jsc, jec, isd, ied, jsd, jed integer, intent(in) :: whalo, ehalo, shalo, nhalo, xshift, yshift if(whalo >=0) then - data(iec+ehalo+1+xshift:ied+xshift,jsd:jed+yshift,:) = 0 - data(isd:isc-whalo-1,jsd:jed+yshift,:) = 0 + halo_data(iec+ehalo+1+xshift:ied+xshift,jsd:jed+yshift,:) = 0 + halo_data(isd:isc-whalo-1,jsd:jed+yshift,:) = 0 else - data(iec+1+xshift:iec-ehalo+xshift,jsc+shalo:jec-nhalo+yshift,:) = 0 - data(isc+whalo:isc-1,jsc+shalo:jec-nhalo+yshift,:) = 0 + halo_data(iec+1+xshift:iec-ehalo+xshift,jsc+shalo:jec-nhalo+yshift,:) = 0 + halo_data(isc+whalo:isc-1,jsc+shalo:jec-nhalo+yshift,:) = 0 end if if(shalo>=0) then - data(isd:ied+xshift, jec+nhalo+1+yshift:jed+yshift,:) = 0 - data(isd:ied+xshift, jsd:jsc-shalo-1,:) = 0 + halo_data(isd:ied+xshift, jec+nhalo+1+yshift:jed+yshift,:) = 0 + halo_data(isd:ied+xshift, jsd:jsc-shalo-1,:) = 0 else - data(isc+whalo:iec-ehalo+xshift,jec+1+yshift:jec-nhalo+yshift,:) = 0 - data(isc+whalo:iec-ehalo+xshift,jsc+shalo:jsc-1,:) = 0 + halo_data(isc+whalo:iec-ehalo+xshift,jec+1+yshift:jec-nhalo+yshift,:) = 0 + halo_data(isc+whalo:iec-ehalo+xshift,jsc+shalo:jsc-1,:) = 0 end if end subroutine fill_halo_zero_r8 !> fill the halo region of a 32-bit real array with zeros - subroutine fill_halo_zero_r4(data, whalo, ehalo, shalo, nhalo, xshift, yshift, isc, iec, jsc, jec, isd, ied, & + subroutine fill_halo_zero_r4(halo_data, whalo, ehalo, shalo, nhalo, xshift, yshift, isc, iec, jsc, jec, isd, ied, & & jsd, jed) - real(kind=r4_kind), dimension(isd:,jsd:,:), intent(inout) :: data + real(kind=r4_kind), dimension(isd:,jsd:,:), intent(inout) :: halo_data integer, intent(in) :: isc, iec, jsc, jec, isd, ied, jsd, jed integer, intent(in) :: whalo, ehalo, shalo, nhalo, xshift, yshift if(whalo >=0) then - data(iec+ehalo+1+xshift:ied+xshift,jsd:jed+yshift,:) = 0 - data(isd:isc-whalo-1,jsd:jed+yshift,:) = 0 + halo_data(iec+ehalo+1+xshift:ied+xshift,jsd:jed+yshift,:) = 0 + halo_data(isd:isc-whalo-1,jsd:jed+yshift,:) = 0 else - data(iec+1+xshift:iec-ehalo+xshift,jsc+shalo:jec-nhalo+yshift,:) = 0 - data(isc+whalo:isc-1,jsc+shalo:jec-nhalo+yshift,:) = 0 + halo_data(iec+1+xshift:iec-ehalo+xshift,jsc+shalo:jec-nhalo+yshift,:) = 0 + halo_data(isc+whalo:isc-1,jsc+shalo:jec-nhalo+yshift,:) = 0 end if if(shalo>=0) then - data(isd:ied+xshift, jec+nhalo+1+yshift:jed+yshift,:) = 0 - data(isd:ied+xshift, jsd:jsc-shalo-1,:) = 0 + halo_data(isd:ied+xshift, jec+nhalo+1+yshift:jed+yshift,:) = 0 + halo_data(isd:ied+xshift, jsd:jsc-shalo-1,:) = 0 else - data(isc+whalo:iec-ehalo+xshift,jec+1+yshift:jec-nhalo+yshift,:) = 0 - data(isc+whalo:iec-ehalo+xshift,jsc+shalo:jsc-1,:) = 0 + halo_data(isc+whalo:iec-ehalo+xshift,jec+1+yshift:jec-nhalo+yshift,:) = 0 + halo_data(isc+whalo:iec-ehalo+xshift,jsc+shalo:jsc-1,:) = 0 end if end subroutine fill_halo_zero_r4 !> fill the halo region of a 64-bit integer array with zeros - subroutine fill_halo_zero_i8(data, whalo, ehalo, shalo, nhalo, xshift, yshift, isc, iec, jsc, jec, isd, ied, & + subroutine fill_halo_zero_i8(halo_data, whalo, ehalo, shalo, nhalo, xshift, yshift, isc, iec, jsc, jec, isd, ied, & & jsd, jed) - integer(kind=i8_kind), dimension(isd:,jsd:,:), intent(inout) :: data + integer(kind=i8_kind), dimension(isd:,jsd:,:), intent(inout) :: halo_data integer, intent(in) :: isc, iec, jsc, jec, isd, ied, jsd, jed integer, intent(in) :: whalo, ehalo, shalo, nhalo, xshift, yshift if(whalo >=0) then - data(iec+ehalo+1+xshift:ied+xshift,jsd:jed+yshift,:) = 0 - data(isd:isc-whalo-1,jsd:jed+yshift,:) = 0 + halo_data(iec+ehalo+1+xshift:ied+xshift,jsd:jed+yshift,:) = 0 + halo_data(isd:isc-whalo-1,jsd:jed+yshift,:) = 0 else - data(iec+1+xshift:iec-ehalo+xshift,jsc+shalo:jec-nhalo+yshift,:) = 0 - data(isc+whalo:isc-1,jsc+shalo:jec-nhalo+yshift,:) = 0 + halo_data(iec+1+xshift:iec-ehalo+xshift,jsc+shalo:jec-nhalo+yshift,:) = 0 + halo_data(isc+whalo:isc-1,jsc+shalo:jec-nhalo+yshift,:) = 0 end if if(shalo>=0) then - data(isd:ied+xshift, jec+nhalo+1+yshift:jed+yshift,:) = 0 - data(isd:ied+xshift, jsd:jsc-shalo-1,:) = 0 + halo_data(isd:ied+xshift, jec+nhalo+1+yshift:jed+yshift,:) = 0 + halo_data(isd:ied+xshift, jsd:jsc-shalo-1,:) = 0 else - data(isc+whalo:iec-ehalo+xshift,jec+1+yshift:jec-nhalo+yshift,:) = 0 - data(isc+whalo:iec-ehalo+xshift,jsc+shalo:jsc-1,:) = 0 + halo_data(isc+whalo:iec-ehalo+xshift,jec+1+yshift:jec-nhalo+yshift,:) = 0 + halo_data(isc+whalo:iec-ehalo+xshift,jsc+shalo:jsc-1,:) = 0 end if end subroutine fill_halo_zero_i8 !> fill the halo region of a 32-bit integer array with zeros - subroutine fill_halo_zero_i4(data, whalo, ehalo, shalo, nhalo, xshift, yshift, isc, iec, jsc, jec, isd, ied, & + subroutine fill_halo_zero_i4(halo_data, whalo, ehalo, shalo, nhalo, xshift, yshift, isc, iec, jsc, jec, isd, ied, & & jsd, jed) - integer(kind=i4_kind), dimension(isd:,jsd:,:), intent(inout) :: data + integer(kind=i4_kind), dimension(isd:,jsd:,:), intent(inout) :: halo_data integer, intent(in) :: isc, iec, jsc, jec, isd, ied, jsd, jed integer, intent(in) :: whalo, ehalo, shalo, nhalo, xshift, yshift if(whalo >=0) then - data(iec+ehalo+1+xshift:ied+xshift,jsd:jed+yshift,:) = 0 - data(isd:isc-whalo-1,jsd:jed+yshift,:) = 0 + halo_data(iec+ehalo+1+xshift:ied+xshift,jsd:jed+yshift,:) = 0 + halo_data(isd:isc-whalo-1,jsd:jed+yshift,:) = 0 else - data(iec+1+xshift:iec-ehalo+xshift,jsc+shalo:jec-nhalo+yshift,:) = 0 - data(isc+whalo:isc-1,jsc+shalo:jec-nhalo+yshift,:) = 0 + halo_data(iec+1+xshift:iec-ehalo+xshift,jsc+shalo:jec-nhalo+yshift,:) = 0 + halo_data(isc+whalo:isc-1,jsc+shalo:jec-nhalo+yshift,:) = 0 end if if(shalo>=0) then - data(isd:ied+xshift, jec+nhalo+1+yshift:jed+yshift,:) = 0 - data(isd:ied+xshift, jsd:jsc-shalo-1,:) = 0 + halo_data(isd:ied+xshift, jec+nhalo+1+yshift:jed+yshift,:) = 0 + halo_data(isd:ied+xshift, jsd:jsc-shalo-1,:) = 0 else - data(isc+whalo:iec-ehalo+xshift,jec+1+yshift:jec-nhalo+yshift,:) = 0 - data(isc+whalo:iec-ehalo+xshift,jsc+shalo:jsc-1,:) = 0 + halo_data(isc+whalo:iec-ehalo+xshift,jec+1+yshift:jec-nhalo+yshift,:) = 0 + halo_data(isc+whalo:iec-ehalo+xshift,jsc+shalo:jsc-1,:) = 0 end if end subroutine fill_halo_zero_i4 !> fill the halo region of 64-bit array on a regular grid - subroutine fill_regular_refinement_halo_r8( data, data_all, ni, nj, tm, te, tse, ts, & + subroutine fill_regular_refinement_halo_r8( halo_data, data_all, ni, nj, tm, te, tse, ts, & tsw, tw, tnw, tn, tne, ioff, joff ) - real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data real(kind=r8_kind), dimension(:,:,:,:), intent(in) :: data_all integer, dimension(:), intent(in) :: ni, nj integer, intent(in) :: tm, te, tse, ts, tsw, tw, tnw, tn, tne integer, intent(in) :: ioff, joff - if(te>0) data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1:nj(tm)+joff, :) = & + if(te>0) halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1:nj(tm)+joff, :) = & data_all(1+ioff:ehalo+ioff, 1:nj(te)+joff, :,te) ! east - if(ts>0) data (1:ni(tm)+ioff, 1-shalo:0, :) = & + if(ts>0) halo_data (1:ni(tm)+ioff, 1-shalo:0, :) = & data_all(1:ni(ts)+ioff, nj(ts)-shalo+1:nj(ts), :,ts) ! south - if(tw>0) data (1-whalo:0, 1:nj(tm)+joff, :) = & + if(tw>0) halo_data (1-whalo:0, 1:nj(tm)+joff, :) = & data_all(ni(tw)-whalo+1:ni(tw), 1:nj(tw)+joff, :,tw) ! west - if(tn>0) data (1:ni(tm)+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tn>0) halo_data (1:ni(tm)+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(1:ni(tn)+ioff, 1+joff:nhalo+joff, :,tn) ! north - if(tse>0)data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1-shalo:0, :) = & + if(tse>0)halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1-shalo:0, :) = & data_all(1+ioff:ehalo+ioff, nj(tse)-shalo+1:nj(tse), :,tse) ! southeast - if(tsw>0)data (1-whalo:0, 1-shalo:0, :) = & + if(tsw>0)halo_data (1-whalo:0, 1-shalo:0, :) = & data_all(ni(tsw)-whalo+1:ni(tsw), nj(tsw)-shalo+1:nj(tsw), :,tsw) ! southwest - if(tne>0)data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tne>0)halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(1+ioff:ehalo+ioff, 1+joff:nhalo+joff, :,tnw) ! northeast - if(tnw>0)data (1-whalo:0, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tnw>0)halo_data (1-whalo:0, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(ni(tnw)-whalo+1:ni(tnw), 1+joff:nhalo+joff, :,tne) ! northwest end subroutine fill_regular_refinement_halo_r8 !> fill the halo region of 32-bit array on a regular grid - subroutine fill_regular_refinement_halo_r4( data, data_all, ni, nj, tm, te, tse, ts, tsw, tw, tnw, tn, tne, & + subroutine fill_regular_refinement_halo_r4( halo_data, data_all, ni, nj, tm, te, tse, ts, tsw, tw, tnw, tn, tne, & & ioff, joff ) - real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data real(kind=r4_kind), dimension(:,:,:,:), intent(in) :: data_all integer, dimension(:), intent(in) :: ni, nj integer, intent(in) :: tm, te, tse, ts, tsw, tw, tnw, tn, tne integer, intent(in) :: ioff, joff - if(te>0) data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1:nj(tm)+joff, :) = & + if(te>0) halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1:nj(tm)+joff, :) = & data_all(1+ioff:ehalo+ioff, 1:nj(te)+joff, :,te) ! east - if(ts>0) data (1:ni(tm)+ioff, 1-shalo:0, :) = & + if(ts>0) halo_data (1:ni(tm)+ioff, 1-shalo:0, :) = & data_all(1:ni(ts)+ioff, nj(ts)-shalo+1:nj(ts), :,ts) ! south - if(tw>0) data (1-whalo:0, 1:nj(tm)+joff, :) = & + if(tw>0) halo_data (1-whalo:0, 1:nj(tm)+joff, :) = & data_all(ni(tw)-whalo+1:ni(tw), 1:nj(tw)+joff, :,tw) ! west - if(tn>0) data (1:ni(tm)+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tn>0) halo_data (1:ni(tm)+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(1:ni(tn)+ioff, 1+joff:nhalo+joff, :,tn) ! north - if(tse>0)data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1-shalo:0, :) = & + if(tse>0)halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1-shalo:0, :) = & data_all(1+ioff:ehalo+ioff, nj(tse)-shalo+1:nj(tse), :,tse) ! southeast - if(tsw>0)data (1-whalo:0, 1-shalo:0, :) = & + if(tsw>0)halo_data (1-whalo:0, 1-shalo:0, :) = & data_all(ni(tsw)-whalo+1:ni(tsw), nj(tsw)-shalo+1:nj(tsw), :,tsw) ! southwest - if(tne>0)data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tne>0)halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(1+ioff:ehalo+ioff, 1+joff:nhalo+joff, :,tnw) ! northeast - if(tnw>0)data (1-whalo:0, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tnw>0)halo_data (1-whalo:0, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(ni(tnw)-whalo+1:ni(tnw), 1+joff:nhalo+joff, :,tne) ! northwest end subroutine fill_regular_refinement_halo_r4 !> fill the halo region of 64-bit integer array on a regular grid - subroutine fill_regular_refinement_halo_i8( data, data_all, ni, nj, tm, te, tse, ts, tsw, & + subroutine fill_regular_refinement_halo_i8( halo_data, data_all, ni, nj, tm, te, tse, ts, tsw, & tw, tnw, tn, tne, ioff, joff ) - integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer(kind=i8_kind), dimension(:,:,:,:), intent(in) :: data_all integer, dimension(:), intent(in) :: ni, nj integer, intent(in) :: tm, te, tse, ts, tsw, tw, tnw, tn, tne integer, intent(in) :: ioff, joff - if(te>0) data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1:nj(tm)+joff, :) = & + if(te>0) halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1:nj(tm)+joff, :) = & data_all(1+ioff:ehalo+ioff, 1:nj(te)+joff, :,te) ! east - if(ts>0) data (1:ni(tm)+ioff, 1-shalo:0, :) = & + if(ts>0) halo_data (1:ni(tm)+ioff, 1-shalo:0, :) = & data_all(1:ni(ts)+ioff, nj(ts)-shalo+1:nj(ts), :,ts) ! south - if(tw>0) data (1-whalo:0, 1:nj(tm)+joff, :) = & + if(tw>0) halo_data (1-whalo:0, 1:nj(tm)+joff, :) = & data_all(ni(tw)-whalo+1:ni(tw), 1:nj(tw)+joff, :,tw) ! west - if(tn>0) data (1:ni(tm)+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tn>0) halo_data (1:ni(tm)+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(1:ni(tn)+ioff, 1+joff:nhalo+joff, :,tn) ! north - if(tse>0)data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1-shalo:0, :) = & + if(tse>0)halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1-shalo:0, :) = & data_all(1+ioff:ehalo+ioff, nj(tse)-shalo+1:nj(tse), :,tse) ! southeast - if(tsw>0)data (1-whalo:0, 1-shalo:0, :) = & + if(tsw>0)halo_data (1-whalo:0, 1-shalo:0, :) = & data_all(ni(tsw)-whalo+1:ni(tsw), nj(tsw)-shalo+1:nj(tsw), :,tsw) ! southwest - if(tne>0)data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tne>0)halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(1+ioff:ehalo+ioff, 1+joff:nhalo+joff, :,tnw) ! northeast - if(tnw>0)data (1-whalo:0, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tnw>0)halo_data (1-whalo:0, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(ni(tnw)-whalo+1:ni(tnw), 1+joff:nhalo+joff, :,tne) ! northwest end subroutine fill_regular_refinement_halo_i8 !> fill the halo region of 32-bit integer array on a regular grid - subroutine fill_regular_refinement_halo_i4( data, data_all, ni, nj, tm, te, tse, ts, tsw, tw, tnw, tn, tne, & + subroutine fill_regular_refinement_halo_i4( halo_data, data_all, ni, nj, tm, te, tse, ts, tsw, tw, tnw, tn, tne, & & ioff, joff ) - integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer(kind=i4_kind), dimension(:,:,:,:), intent(in) :: data_all integer, dimension(:), intent(in) :: ni, nj integer, intent(in) :: tm, te, tse, ts, tsw, tw, tnw, tn, tne integer, intent(in) :: ioff, joff - if(te>0) data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1:nj(tm)+joff, :) = & + if(te>0) halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1:nj(tm)+joff, :) = & data_all(1+ioff:ehalo+ioff, 1:nj(te)+joff, :,te) ! east - if(ts>0) data (1:ni(tm)+ioff, 1-shalo:0, :) = & + if(ts>0) halo_data (1:ni(tm)+ioff, 1-shalo:0, :) = & data_all(1:ni(ts)+ioff, nj(ts)-shalo+1:nj(ts), :,ts) ! south - if(tw>0) data (1-whalo:0, 1:nj(tm)+joff, :) = & + if(tw>0) halo_data (1-whalo:0, 1:nj(tm)+joff, :) = & data_all(ni(tw)-whalo+1:ni(tw), 1:nj(tw)+joff, :,tw) ! west - if(tn>0) data (1:ni(tm)+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tn>0) halo_data (1:ni(tm)+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(1:ni(tn)+ioff, 1+joff:nhalo+joff, :,tn) ! north - if(tse>0)data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1-shalo:0, :) = & + if(tse>0)halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1-shalo:0, :) = & data_all(1+ioff:ehalo+ioff, nj(tse)-shalo+1:nj(tse), :,tse) ! southeast - if(tsw>0)data (1-whalo:0, 1-shalo:0, :) = & + if(tsw>0)halo_data (1-whalo:0, 1-shalo:0, :) = & data_all(ni(tsw)-whalo+1:ni(tsw), nj(tsw)-shalo+1:nj(tsw), :,tsw) ! southwest - if(tne>0)data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tne>0)halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(1+ioff:ehalo+ioff, 1+joff:nhalo+joff, :,tnw) ! northeast - if(tnw>0)data (1-whalo:0, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tnw>0)halo_data (1-whalo:0, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(ni(tnw)-whalo+1:ni(tnw), 1+joff:nhalo+joff, :,tne) ! northwest end subroutine fill_regular_refinement_halo_i4 ! Fill the halo points of a 64-bit real array on the regular mosaic grid - subroutine fill_regular_mosaic_halo_r8(data, data_all, te, tse, ts, tsw, tw, tnw, tn, tne) - real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_regular_mosaic_halo_r8(halo_data, data_all, te, tse, ts, tsw, tw, tnw, tn, tne) + real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data real(kind=r8_kind), dimension(:,:,:,:), intent(in) :: data_all integer, intent(in) :: te, tse, ts, tsw, tw, tnw, tn, tne - data(nx+1:nx+ehalo, 1:ny, :) = data_all(1:ehalo, 1:ny, :, te) ! east - data(1:nx, 1-shalo:0, :) = data_all(1:nx, ny-shalo+1:ny, :, ts) ! south - data(1-whalo:0, 1:ny, :) = data_all(nx-whalo+1:nx, 1:ny, :, tw) ! west - data(1:nx, ny+1:ny+nhalo, :) = data_all(1:nx, 1:nhalo, :, tn) ! north - data(nx+1:nx+ehalo, 1-shalo:0, :) = data_all(1:ehalo, ny-shalo+1:ny, :,tse) ! southeast - data(1-whalo:0, 1-shalo:0, :) = data_all(nx-whalo+1:nx, ny-shalo+1:ny, :,tsw) ! southwest - data(nx+1:nx+ehalo, ny+1:ny+nhalo, :) = data_all(1:ehalo, 1:nhalo, :,tnw) ! northeast - data(1-whalo:0, ny+1:ny+nhalo, :) = data_all(nx-whalo+1:nx, 1:nhalo, :,tne) ! northwest + halo_data(nx+1:nx+ehalo, 1:ny, :) = data_all(1:ehalo, 1:ny, :, te) ! east + halo_data(1:nx, 1-shalo:0, :) = data_all(1:nx, ny-shalo+1:ny, :, ts) ! south + halo_data(1-whalo:0, 1:ny, :) = data_all(nx-whalo+1:nx, 1:ny, :, tw) ! west + halo_data(1:nx, ny+1:ny+nhalo, :) = data_all(1:nx, 1:nhalo, :, tn) ! north + halo_data(nx+1:nx+ehalo, 1-shalo:0, :) = data_all(1:ehalo, ny-shalo+1:ny, :,tse) ! southeast + halo_data(1-whalo:0, 1-shalo:0, :) = data_all(nx-whalo+1:nx, ny-shalo+1:ny, :,tsw) ! southwest + halo_data(nx+1:nx+ehalo, ny+1:ny+nhalo, :) = data_all(1:ehalo, 1:nhalo, :,tnw) ! northeast + halo_data(1-whalo:0, ny+1:ny+nhalo, :) = data_all(nx-whalo+1:nx, 1:nhalo, :,tne) ! northwest end subroutine fill_regular_mosaic_halo_r8 !> Fill the halo points of a 32-bit real array on the regular mosaic grid - subroutine fill_regular_mosaic_halo_r4(data, data_all, te, tse, ts, tsw, tw, tnw, tn, tne) - real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_regular_mosaic_halo_r4(halo_data, data_all, te, tse, ts, tsw, tw, tnw, tn, tne) + real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data real(kind=r4_kind), dimension(:,:,:,:), intent(in) :: data_all integer, intent(in) :: te, tse, ts, tsw, tw, tnw, tn, tne - data(nx+1:nx+ehalo, 1:ny, :) = data_all(1:ehalo, 1:ny, :, te) ! east - data(1:nx, 1-shalo:0, :) = data_all(1:nx, ny-shalo+1:ny, :, ts) ! south - data(1-whalo:0, 1:ny, :) = data_all(nx-whalo+1:nx, 1:ny, :, tw) ! west - data(1:nx, ny+1:ny+nhalo, :) = data_all(1:nx, 1:nhalo, :, tn) ! north - data(nx+1:nx+ehalo, 1-shalo:0, :) = data_all(1:ehalo, ny-shalo+1:ny, :,tse) ! southeast - data(1-whalo:0, 1-shalo:0, :) = data_all(nx-whalo+1:nx, ny-shalo+1:ny, :,tsw) ! southwest - data(nx+1:nx+ehalo, ny+1:ny+nhalo, :) = data_all(1:ehalo, 1:nhalo, :,tnw) ! northeast - data(1-whalo:0, ny+1:ny+nhalo, :) = data_all(nx-whalo+1:nx, 1:nhalo, :,tne) ! northwest + halo_data(nx+1:nx+ehalo, 1:ny, :) = data_all(1:ehalo, 1:ny, :, te) ! east + halo_data(1:nx, 1-shalo:0, :) = data_all(1:nx, ny-shalo+1:ny, :, ts) ! south + halo_data(1-whalo:0, 1:ny, :) = data_all(nx-whalo+1:nx, 1:ny, :, tw) ! west + halo_data(1:nx, ny+1:ny+nhalo, :) = data_all(1:nx, 1:nhalo, :, tn) ! north + halo_data(nx+1:nx+ehalo, 1-shalo:0, :) = data_all(1:ehalo, ny-shalo+1:ny, :,tse) ! southeast + halo_data(1-whalo:0, 1-shalo:0, :) = data_all(nx-whalo+1:nx, ny-shalo+1:ny, :,tsw) ! southwest + halo_data(nx+1:nx+ehalo, ny+1:ny+nhalo, :) = data_all(1:ehalo, 1:nhalo, :,tnw) ! northeast + halo_data(1-whalo:0, ny+1:ny+nhalo, :) = data_all(nx-whalo+1:nx, 1:nhalo, :,tne) ! northwest end subroutine fill_regular_mosaic_halo_r4 ! Fill the halo points of a 64-bit integer array on the regular mosaic grid - subroutine fill_regular_mosaic_halo_i8(data, data_all, te, tse, ts, tsw, tw, tnw, tn, tne) - integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_regular_mosaic_halo_i8(halo_data, data_all, te, tse, ts, tsw, tw, tnw, tn, tne) + integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer(kind=i8_kind), dimension(:,:,:,:), intent(in) :: data_all integer, intent(in) :: te, tse, ts, tsw, tw, tnw, tn, tne - data(nx+1:nx+ehalo, 1:ny, :) = data_all(1:ehalo, 1:ny, :, te) ! east - data(1:nx, 1-shalo:0, :) = data_all(1:nx, ny-shalo+1:ny, :, ts) ! south - data(1-whalo:0, 1:ny, :) = data_all(nx-whalo+1:nx, 1:ny, :, tw) ! west - data(1:nx, ny+1:ny+nhalo, :) = data_all(1:nx, 1:nhalo, :, tn) ! north - data(nx+1:nx+ehalo, 1-shalo:0, :) = data_all(1:ehalo, ny-shalo+1:ny, :,tse) ! southeast - data(1-whalo:0, 1-shalo:0, :) = data_all(nx-whalo+1:nx, ny-shalo+1:ny, :,tsw) ! southwest - data(nx+1:nx+ehalo, ny+1:ny+nhalo, :) = data_all(1:ehalo, 1:nhalo, :,tnw) ! northeast - data(1-whalo:0, ny+1:ny+nhalo, :) = data_all(nx-whalo+1:nx, 1:nhalo, :,tne) ! northwest + halo_data(nx+1:nx+ehalo, 1:ny, :) = data_all(1:ehalo, 1:ny, :, te) ! east + halo_data(1:nx, 1-shalo:0, :) = data_all(1:nx, ny-shalo+1:ny, :, ts) ! south + halo_data(1-whalo:0, 1:ny, :) = data_all(nx-whalo+1:nx, 1:ny, :, tw) ! west + halo_data(1:nx, ny+1:ny+nhalo, :) = data_all(1:nx, 1:nhalo, :, tn) ! north + halo_data(nx+1:nx+ehalo, 1-shalo:0, :) = data_all(1:ehalo, ny-shalo+1:ny, :,tse) ! southeast + halo_data(1-whalo:0, 1-shalo:0, :) = data_all(nx-whalo+1:nx, ny-shalo+1:ny, :,tsw) ! southwest + halo_data(nx+1:nx+ehalo, ny+1:ny+nhalo, :) = data_all(1:ehalo, 1:nhalo, :,tnw) ! northeast + halo_data(1-whalo:0, ny+1:ny+nhalo, :) = data_all(nx-whalo+1:nx, 1:nhalo, :,tne) ! northwest end subroutine fill_regular_mosaic_halo_i8 !> Fill the halo points of a 64-bit integer array on the regular mosaic grid - subroutine fill_regular_mosaic_halo_i4(data, data_all, te, tse, ts, tsw, tw, tnw, tn, tne) - integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_regular_mosaic_halo_i4(halo_data, data_all, te, tse, ts, tsw, tw, tnw, tn, tne) + integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer(kind=i4_kind), dimension(:,:,:,:), intent(in) :: data_all integer, intent(in) :: te, tse, ts, tsw, tw, tnw, tn, tne - data(nx+1:nx+ehalo, 1:ny, :) = data_all(1:ehalo, 1:ny, :, te) ! east - data(1:nx, 1-shalo:0, :) = data_all(1:nx, ny-shalo+1:ny, :, ts) ! south - data(1-whalo:0, 1:ny, :) = data_all(nx-whalo+1:nx, 1:ny, :, tw) ! west - data(1:nx, ny+1:ny+nhalo, :) = data_all(1:nx, 1:nhalo, :, tn) ! north - data(nx+1:nx+ehalo, 1-shalo:0, :) = data_all(1:ehalo, ny-shalo+1:ny, :,tse) ! southeast - data(1-whalo:0, 1-shalo:0, :) = data_all(nx-whalo+1:nx, ny-shalo+1:ny, :,tsw) ! southwest - data(nx+1:nx+ehalo, ny+1:ny+nhalo, :) = data_all(1:ehalo, 1:nhalo, :,tnw) ! northeast - data(1-whalo:0, ny+1:ny+nhalo, :) = data_all(nx-whalo+1:nx, 1:nhalo, :,tne) ! northwest + halo_data(nx+1:nx+ehalo, 1:ny, :) = data_all(1:ehalo, 1:ny, :, te) ! east + halo_data(1:nx, 1-shalo:0, :) = data_all(1:nx, ny-shalo+1:ny, :, ts) ! south + halo_data(1-whalo:0, 1:ny, :) = data_all(nx-whalo+1:nx, 1:ny, :, tw) ! west + halo_data(1:nx, ny+1:ny+nhalo, :) = data_all(1:nx, 1:nhalo, :, tn) ! north + halo_data(nx+1:nx+ehalo, 1-shalo:0, :) = data_all(1:ehalo, ny-shalo+1:ny, :,tse) ! southeast + halo_data(1-whalo:0, 1-shalo:0, :) = data_all(nx-whalo+1:nx, ny-shalo+1:ny, :,tsw) ! southwest + halo_data(nx+1:nx+ehalo, ny+1:ny+nhalo, :) = data_all(1:ehalo, 1:nhalo, :,tnw) ! northeast + halo_data(1-whalo:0, ny+1:ny+nhalo, :) = data_all(nx-whalo+1:nx, 1:nhalo, :,tne) ! northwest end subroutine fill_regular_mosaic_halo_i4 !> Fill the halo region of a 64-bit array real on a domain with a folded north edge - subroutine fill_folded_north_halo_r8(data, ioff, joff, ishift, jshift, sign) - real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_north_halo_r8(halo_data, ioff, joff, ishift, jshift, sign) + real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -378,18 +378,19 @@ subroutine fill_folded_north_halo_r8(data, ioff, joff, ishift, jshift, sign) m1 = ishift - ioff m2 = 2*ishift - ioff - data(1-whalo:0,1:nyp,:) = data(nx-whalo+1:nx,1:ny+jshift,:) ! west - data(nx+1:nx+ehalo+ishift,1:nyp,:) = data(1:ehalo+ishift,1:ny+jshift,:) ! east + halo_data(1-whalo:0,1:nyp,:) = halo_data(nx-whalo+1:nx,1:ny+jshift,:) ! west + halo_data(nx+1:nx+ehalo+ishift,1:nyp,:) = halo_data(1:ehalo+ishift,1:ny+jshift,:) ! east if(m1 .GE. 1-whalo) & - data(1-whalo:m1,nyp+1:nyp+nhalo,:) = sign*data(whalo+m2:1+ishift:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) - data(m1+1:nx+m2,nyp+1:nyp+nhalo,:) = sign*data(nx+ishift:1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) - data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = sign*data(nx:nx-ehalo+m1+1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(1-whalo:m1,nyp+1:nyp+nhalo,:) = sign*halo_data(whalo+m2:1+ishift:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(m1+1:nx+m2,nyp+1:nyp+nhalo,:) = sign*halo_data(nx+ishift:1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = & + sign*halo_data(nx:nx-ehalo+m1+1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) end subroutine fill_folded_north_halo_r8 !> Fill the halo region of a 32-bit real array on a domain with a folded north edge - subroutine fill_folded_north_halo_r4(data, ioff, joff, ishift, jshift, sign) - real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_north_halo_r4(halo_data, ioff, joff, ishift, jshift, sign) + real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -399,19 +400,20 @@ subroutine fill_folded_north_halo_r4(data, ioff, joff, ishift, jshift, sign) m1 = ishift - ioff m2 = 2*ishift - ioff - data(1-whalo:0,1:nyp,:) = data(nx-whalo+1:nx,1:ny+jshift,:) ! west - data(nx+1:nx+ehalo+ishift,1:nyp,:) = data(1:ehalo+ishift,1:ny+jshift,:) ! east + halo_data(1-whalo:0,1:nyp,:) = halo_data(nx-whalo+1:nx,1:ny+jshift,:) ! west + halo_data(nx+1:nx+ehalo+ishift,1:nyp,:) = halo_data(1:ehalo+ishift,1:ny+jshift,:) ! east if(m1 .GE. 1-whalo) & - data(1-whalo:m1,nyp+1:nyp+nhalo,:) = sign*data(whalo+m2:1+ishift:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) - data(m1+1:nx+m2,nyp+1:nyp+nhalo,:) = sign*data(nx+ishift:1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) - data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = sign*data(nx:nx-ehalo+m1+1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(1-whalo:m1,nyp+1:nyp+nhalo,:) = sign*halo_data(whalo+m2:1+ishift:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(m1+1:nx+m2,nyp+1:nyp+nhalo,:) = sign*halo_data(nx+ishift:1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = & + sign*halo_data(nx:nx-ehalo+m1+1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) end subroutine fill_folded_north_halo_r4 !> Fill the halo region of a 64-bit integer array on a domain with a folded north edge - subroutine fill_folded_north_halo_i8(data, ioff, joff, ishift, jshift, sign) - integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_north_halo_i8(halo_data, ioff, joff, ishift, jshift, sign) + integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -421,18 +423,19 @@ subroutine fill_folded_north_halo_i8(data, ioff, joff, ishift, jshift, sign) m1 = ishift - ioff m2 = 2*ishift - ioff - data(1-whalo:0,1:nyp,:) = data(nx-whalo+1:nx,1:ny+jshift,:) ! west - data(nx+1:nx+ehalo+ishift,1:nyp,:) = data(1:ehalo+ishift,1:ny+jshift,:) ! east + halo_data(1-whalo:0,1:nyp,:) = halo_data(nx-whalo+1:nx,1:ny+jshift,:) ! west + halo_data(nx+1:nx+ehalo+ishift,1:nyp,:) = halo_data(1:ehalo+ishift,1:ny+jshift,:) ! east if(m1 .GE. 1-whalo) & - data(1-whalo:m1,nyp+1:nyp+nhalo,:) = sign*data(whalo+m2:1+ishift:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) - data(m1+1:nx+m2,nyp+1:nyp+nhalo,:) = sign*data(nx+ishift:1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) - data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = sign*data(nx:nx-ehalo+m1+1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(1-whalo:m1,nyp+1:nyp+nhalo,:) = sign*halo_data(whalo+m2:1+ishift:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(m1+1:nx+m2,nyp+1:nyp+nhalo,:) = sign*halo_data(nx+ishift:1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = & + sign*halo_data(nx:nx-ehalo+m1+1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) end subroutine fill_folded_north_halo_i8 !> Fill the halo region of a 32-bit integer array on a domain with a folded north edge - subroutine fill_folded_north_halo_i4(data, ioff, joff, ishift, jshift, sign) - integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_north_halo_i4(halo_data, ioff, joff, ishift, jshift, sign) + integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -442,19 +445,20 @@ subroutine fill_folded_north_halo_i4(data, ioff, joff, ishift, jshift, sign) m1 = ishift - ioff m2 = 2*ishift - ioff - data(1-whalo:0,1:nyp,:) = data(nx-whalo+1:nx,1:ny+jshift,:) ! west - data(nx+1:nx+ehalo+ishift,1:nyp,:) = data(1:ehalo+ishift,1:ny+jshift,:) ! east + halo_data(1-whalo:0,1:nyp,:) = halo_data(nx-whalo+1:nx,1:ny+jshift,:) ! west + halo_data(nx+1:nx+ehalo+ishift,1:nyp,:) = halo_data(1:ehalo+ishift,1:ny+jshift,:) ! east if(m1 .GE. 1-whalo) & - data(1-whalo:m1,nyp+1:nyp+nhalo,:) = sign*data(whalo+m2:1+ishift:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) - data(m1+1:nx+m2,nyp+1:nyp+nhalo,:) = sign*data(nx+ishift:1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) - data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = sign*data(nx:nx-ehalo+m1+1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(1-whalo:m1,nyp+1:nyp+nhalo,:) = sign*halo_data(whalo+m2:1+ishift:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(m1+1:nx+m2,nyp+1:nyp+nhalo,:) = sign*halo_data(nx+ishift:1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = & + sign*halo_data(nx:nx-ehalo+m1+1:-1,nyp-joff:nyp-nhalo-joff+1:-1,:) end subroutine fill_folded_north_halo_i4 !> Fill the halo region of a 64-bit real array on a domain with a folded south edge - subroutine fill_folded_south_halo_r8(data, ioff, joff, ishift, jshift, sign) - real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_south_halo_r8(halo_data, ioff, joff, ishift, jshift, sign) + real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -464,19 +468,19 @@ subroutine fill_folded_south_halo_r8(data, ioff, joff, ishift, jshift, sign) m1 = ishift - ioff m2 = 2*ishift - ioff - data(1-whalo:0,1:nyp,:) = data(nx-whalo+1:nx,1:nyp,:) ! west - data(nx+1:nx+ehalo+ishift,1:nyp,:) = data(1:ehalo+ishift, 1:nyp,:) ! east + halo_data(1-whalo:0,1:nyp,:) = halo_data(nx-whalo+1:nx,1:nyp,:) ! west + halo_data(nx+1:nx+ehalo+ishift,1:nyp,:) = halo_data(1:ehalo+ishift, 1:nyp,:) ! east if(m1 .GE. 1-whalo) & - data(1-whalo:m1,1-shalo:0,:) = sign*data(whalo+m2:1+ishift:-1, shalo+jshift:1+jshift:-1,:) + halo_data(1-whalo:m1,1-shalo:0,:) = sign*halo_data(whalo+m2:1+ishift:-1, shalo+jshift:1+jshift:-1,:) - data(m1+1:nx+m2,1-shalo:0,:) = sign*data(nxp:1:-1,shalo+jshift:1+jshift:-1,:) - data(nx+m2+1:nxp+ehalo,1-shalo:0,:) = sign*data(nx:nx-ehalo+m1+1:-1,shalo+jshift:1+jshift:-1,:) + halo_data(m1+1:nx+m2,1-shalo:0,:) = sign*halo_data(nxp:1:-1,shalo+jshift:1+jshift:-1,:) + halo_data(nx+m2+1:nxp+ehalo,1-shalo:0,:) = sign*halo_data(nx:nx-ehalo+m1+1:-1,shalo+jshift:1+jshift:-1,:) end subroutine fill_folded_south_halo_r8 !> Fill the halo region of a 32-bit real array on a domain with a folded south edge - subroutine fill_folded_south_halo_r4(data, ioff, joff, ishift, jshift, sign) - real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_south_halo_r4(halo_data, ioff, joff, ishift, jshift, sign) + real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -486,19 +490,19 @@ subroutine fill_folded_south_halo_r4(data, ioff, joff, ishift, jshift, sign) m1 = ishift - ioff m2 = 2*ishift - ioff - data(1-whalo:0,1:nyp,:) = data(nx-whalo+1:nx,1:nyp,:) ! west - data(nx+1:nx+ehalo+ishift,1:nyp,:) = data(1:ehalo+ishift, 1:nyp,:) ! east + halo_data(1-whalo:0,1:nyp,:) = halo_data(nx-whalo+1:nx,1:nyp,:) ! west + halo_data(nx+1:nx+ehalo+ishift,1:nyp,:) = halo_data(1:ehalo+ishift, 1:nyp,:) ! east if(m1 .GE. 1-whalo) & - data(1-whalo:m1,1-shalo:0,:) = sign*data(whalo+m2:1+ishift:-1, shalo+jshift:1+jshift:-1,:) + halo_data(1-whalo:m1,1-shalo:0,:) = sign*halo_data(whalo+m2:1+ishift:-1, shalo+jshift:1+jshift:-1,:) - data(m1+1:nx+m2,1-shalo:0,:) = sign*data(nxp:1:-1,shalo+jshift:1+jshift:-1,:) - data(nx+m2+1:nxp+ehalo,1-shalo:0,:) = sign*data(nx:nx-ehalo+m1+1:-1,shalo+jshift:1+jshift:-1,:) + halo_data(m1+1:nx+m2,1-shalo:0,:) = sign*halo_data(nxp:1:-1,shalo+jshift:1+jshift:-1,:) + halo_data(nx+m2+1:nxp+ehalo,1-shalo:0,:) = sign*halo_data(nx:nx-ehalo+m1+1:-1,shalo+jshift:1+jshift:-1,:) end subroutine fill_folded_south_halo_r4 !> Fill the halo region of a 64-bit intger array on a domain with a folded south edge - subroutine fill_folded_south_halo_i8(data, ioff, joff, ishift, jshift, sign) - integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_south_halo_i8(halo_data, ioff, joff, ishift, jshift, sign) + integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -508,19 +512,19 @@ subroutine fill_folded_south_halo_i8(data, ioff, joff, ishift, jshift, sign) m1 = ishift - ioff m2 = 2*ishift - ioff - data(1-whalo:0,1:nyp,:) = data(nx-whalo+1:nx,1:nyp,:) ! west - data(nx+1:nx+ehalo+ishift,1:nyp,:) = data(1:ehalo+ishift, 1:nyp,:) ! east + halo_data(1-whalo:0,1:nyp,:) = halo_data(nx-whalo+1:nx,1:nyp,:) ! west + halo_data(nx+1:nx+ehalo+ishift,1:nyp,:) = halo_data(1:ehalo+ishift, 1:nyp,:) ! east if(m1 .GE. 1-whalo) & - data(1-whalo:m1,1-shalo:0,:) = sign*data(whalo+m2:1+ishift:-1, shalo+jshift:1+jshift:-1,:) + halo_data(1-whalo:m1,1-shalo:0,:) = sign*halo_data(whalo+m2:1+ishift:-1, shalo+jshift:1+jshift:-1,:) - data(m1+1:nx+m2,1-shalo:0,:) = sign*data(nxp:1:-1,shalo+jshift:1+jshift:-1,:) - data(nx+m2+1:nxp+ehalo,1-shalo:0,:) = sign*data(nx:nx-ehalo+m1+1:-1,shalo+jshift:1+jshift:-1,:) + halo_data(m1+1:nx+m2,1-shalo:0,:) = sign*halo_data(nxp:1:-1,shalo+jshift:1+jshift:-1,:) + halo_data(nx+m2+1:nxp+ehalo,1-shalo:0,:) = sign*halo_data(nx:nx-ehalo+m1+1:-1,shalo+jshift:1+jshift:-1,:) end subroutine fill_folded_south_halo_i8 !> Fill the halo region of a 32-bit integer array on a domain with a folded south edge - subroutine fill_folded_south_halo_i4(data, ioff, joff, ishift, jshift, sign) - integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_south_halo_i4(halo_data, ioff, joff, ishift, jshift, sign) + integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -530,19 +534,19 @@ subroutine fill_folded_south_halo_i4(data, ioff, joff, ishift, jshift, sign) m1 = ishift - ioff m2 = 2*ishift - ioff - data(1-whalo:0,1:nyp,:) = data(nx-whalo+1:nx,1:nyp,:) ! west - data(nx+1:nx+ehalo+ishift,1:nyp,:) = data(1:ehalo+ishift, 1:nyp,:) ! east + halo_data(1-whalo:0,1:nyp,:) = halo_data(nx-whalo+1:nx,1:nyp,:) ! west + halo_data(nx+1:nx+ehalo+ishift,1:nyp,:) = halo_data(1:ehalo+ishift, 1:nyp,:) ! east if(m1 .GE. 1-whalo) & - data(1-whalo:m1,1-shalo:0,:) = sign*data(whalo+m2:1+ishift:-1, shalo+jshift:1+jshift:-1,:) + halo_data(1-whalo:m1,1-shalo:0,:) = sign*halo_data(whalo+m2:1+ishift:-1, shalo+jshift:1+jshift:-1,:) - data(m1+1:nx+m2,1-shalo:0,:) = sign*data(nxp:1:-1,shalo+jshift:1+jshift:-1,:) - data(nx+m2+1:nxp+ehalo,1-shalo:0,:) = sign*data(nx:nx-ehalo+m1+1:-1,shalo+jshift:1+jshift:-1,:) + halo_data(m1+1:nx+m2,1-shalo:0,:) = sign*halo_data(nxp:1:-1,shalo+jshift:1+jshift:-1,:) + halo_data(nx+m2+1:nxp+ehalo,1-shalo:0,:) = sign*halo_data(nx:nx-ehalo+m1+1:-1,shalo+jshift:1+jshift:-1,:) end subroutine fill_folded_south_halo_i4 !> Fill the halo region of a 64-bit real array on a domain with a folded west edge - subroutine fill_folded_west_halo_r8(data, ioff, joff, ishift, jshift, sign) - real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_west_halo_r8(halo_data, ioff, joff, ishift, jshift, sign) + real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -552,18 +556,18 @@ subroutine fill_folded_west_halo_r8(data, ioff, joff, ishift, jshift, sign) m1 = jshift - joff m2 = 2*jshift - joff - data(1:nxp, 1-shalo:0,:) = data(1:nxp, ny-shalo+1:ny, :) ! south - data(1:nxp, ny+1:nyp+nhalo,:) = data(1:nxp, 1:nhalo+jshift,:) ! north + halo_data(1:nxp, 1-shalo:0,:) = halo_data(1:nxp, ny-shalo+1:ny, :) ! south + halo_data(1:nxp, ny+1:nyp+nhalo,:) = halo_data(1:nxp, 1:nhalo+jshift,:) ! north if(m1 .GE. 1-shalo) & - data(1-whalo:0, 1-shalo:m1,:) = sign*data(whalo+ishift:1+ishift:-1,shalo+m2:1+jshift:-1,:) - data(1-whalo:0, m1+1:ny+m2,:) = sign*data(whalo+ishift:1+ishift:-1, nyp:1:-1, :) - data(1-whalo:0, ny+m2+1:nyp+nhalo,:) = sign*data(whalo+ishift:1+ishift:-1, ny:ny-nhalo+m1+1:-1,:) + halo_data(1-whalo:0, 1-shalo:m1,:) = sign*halo_data(whalo+ishift:1+ishift:-1,shalo+m2:1+jshift:-1,:) + halo_data(1-whalo:0, m1+1:ny+m2,:) = sign*halo_data(whalo+ishift:1+ishift:-1, nyp:1:-1, :) + halo_data(1-whalo:0, ny+m2+1:nyp+nhalo,:) = sign*halo_data(whalo+ishift:1+ishift:-1, ny:ny-nhalo+m1+1:-1,:) end subroutine fill_folded_west_halo_r8 !> Fill the halo region of a 32-bit real array on a domain with a folded west edge - subroutine fill_folded_west_halo_r4(data, ioff, joff, ishift, jshift, sign) - real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_west_halo_r4(halo_data, ioff, joff, ishift, jshift, sign) + real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -573,18 +577,18 @@ subroutine fill_folded_west_halo_r4(data, ioff, joff, ishift, jshift, sign) m1 = jshift - joff m2 = 2*jshift - joff - data(1:nxp, 1-shalo:0,:) = data(1:nxp, ny-shalo+1:ny, :) ! south - data(1:nxp, ny+1:nyp+nhalo,:) = data(1:nxp, 1:nhalo+jshift,:) ! north + halo_data(1:nxp, 1-shalo:0,:) = halo_data(1:nxp, ny-shalo+1:ny, :) ! south + halo_data(1:nxp, ny+1:nyp+nhalo,:) = halo_data(1:nxp, 1:nhalo+jshift,:) ! north if(m1 .GE. 1-shalo) & - data(1-whalo:0, 1-shalo:m1,:) = sign*data(whalo+ishift:1+ishift:-1,shalo+m2:1+jshift:-1,:) - data(1-whalo:0, m1+1:ny+m2,:) = sign*data(whalo+ishift:1+ishift:-1, nyp:1:-1, :) - data(1-whalo:0, ny+m2+1:nyp+nhalo,:) = sign*data(whalo+ishift:1+ishift:-1, ny:ny-nhalo+m1+1:-1,:) + halo_data(1-whalo:0, 1-shalo:m1,:) = sign*halo_data(whalo+ishift:1+ishift:-1,shalo+m2:1+jshift:-1,:) + halo_data(1-whalo:0, m1+1:ny+m2,:) = sign*halo_data(whalo+ishift:1+ishift:-1, nyp:1:-1, :) + halo_data(1-whalo:0, ny+m2+1:nyp+nhalo,:) = sign*halo_data(whalo+ishift:1+ishift:-1, ny:ny-nhalo+m1+1:-1,:) end subroutine fill_folded_west_halo_r4 !> Fill the halo region of a 64-bit integer array on a domain with a folded west edge - subroutine fill_folded_west_halo_i8(data, ioff, joff, ishift, jshift, sign) - integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_west_halo_i8(halo_data, ioff, joff, ishift, jshift, sign) + integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -594,18 +598,18 @@ subroutine fill_folded_west_halo_i8(data, ioff, joff, ishift, jshift, sign) m1 = jshift - joff m2 = 2*jshift - joff - data(1:nxp, 1-shalo:0,:) = data(1:nxp, ny-shalo+1:ny, :) ! south - data(1:nxp, ny+1:nyp+nhalo,:) = data(1:nxp, 1:nhalo+jshift,:) ! north + halo_data(1:nxp, 1-shalo:0,:) = halo_data(1:nxp, ny-shalo+1:ny, :) ! south + halo_data(1:nxp, ny+1:nyp+nhalo,:) = halo_data(1:nxp, 1:nhalo+jshift,:) ! north if(m1 .GE. 1-shalo) & - data(1-whalo:0, 1-shalo:m1,:) = sign*data(whalo+ishift:1+ishift:-1,shalo+m2:1+jshift:-1,:) - data(1-whalo:0, m1+1:ny+m2,:) = sign*data(whalo+ishift:1+ishift:-1, nyp:1:-1, :) - data(1-whalo:0, ny+m2+1:nyp+nhalo,:) = sign*data(whalo+ishift:1+ishift:-1, ny:ny-nhalo+m1+1:-1,:) + halo_data(1-whalo:0, 1-shalo:m1,:) = sign*halo_data(whalo+ishift:1+ishift:-1,shalo+m2:1+jshift:-1,:) + halo_data(1-whalo:0, m1+1:ny+m2,:) = sign*halo_data(whalo+ishift:1+ishift:-1, nyp:1:-1, :) + halo_data(1-whalo:0, ny+m2+1:nyp+nhalo,:) = sign*halo_data(whalo+ishift:1+ishift:-1, ny:ny-nhalo+m1+1:-1,:) end subroutine fill_folded_west_halo_i8 !> Fill the halo region of a 32-bit integer array on a domain with a folded west edge - subroutine fill_folded_west_halo_i4(data, ioff, joff, ishift, jshift, sign) - integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_west_halo_i4(halo_data, ioff, joff, ishift, jshift, sign) + integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -615,18 +619,18 @@ subroutine fill_folded_west_halo_i4(data, ioff, joff, ishift, jshift, sign) m1 = jshift - joff m2 = 2*jshift - joff - data(1:nxp, 1-shalo:0,:) = data(1:nxp, ny-shalo+1:ny, :) ! south - data(1:nxp, ny+1:nyp+nhalo,:) = data(1:nxp, 1:nhalo+jshift,:) ! north + halo_data(1:nxp, 1-shalo:0,:) = halo_data(1:nxp, ny-shalo+1:ny, :) ! south + halo_data(1:nxp, ny+1:nyp+nhalo,:) = halo_data(1:nxp, 1:nhalo+jshift,:) ! north if(m1 .GE. 1-shalo) & - data(1-whalo:0, 1-shalo:m1,:) = sign*data(whalo+ishift:1+ishift:-1,shalo+m2:1+jshift:-1,:) - data(1-whalo:0, m1+1:ny+m2,:) = sign*data(whalo+ishift:1+ishift:-1, nyp:1:-1, :) - data(1-whalo:0, ny+m2+1:nyp+nhalo,:) = sign*data(whalo+ishift:1+ishift:-1, ny:ny-nhalo+m1+1:-1,:) + halo_data(1-whalo:0, 1-shalo:m1,:) = sign*halo_data(whalo+ishift:1+ishift:-1,shalo+m2:1+jshift:-1,:) + halo_data(1-whalo:0, m1+1:ny+m2,:) = sign*halo_data(whalo+ishift:1+ishift:-1, nyp:1:-1, :) + halo_data(1-whalo:0, ny+m2+1:nyp+nhalo,:) = sign*halo_data(whalo+ishift:1+ishift:-1, ny:ny-nhalo+m1+1:-1,:) end subroutine fill_folded_west_halo_i4 !> Fill the halo region of a 64-bit real array on a domain with a folded east edge - subroutine fill_folded_east_halo_r8(data, ioff, joff, ishift, jshift, sign) - real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_east_halo_r8(halo_data, ioff, joff, ishift, jshift, sign) + real(kind=r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -636,19 +640,20 @@ subroutine fill_folded_east_halo_r8(data, ioff, joff, ishift, jshift, sign) m1 = jshift - joff m2 = 2*jshift - joff - data(1:nxp, 1-shalo:0, :) = data(1:nxp, ny-shalo+1:ny, :) ! south - data(1:nxp, ny+1:nyp+nhalo, :) = data(1:nxp, 1:nhalo+jshift,:) ! north + halo_data(1:nxp, 1-shalo:0, :) = halo_data(1:nxp, ny-shalo+1:ny, :) ! south + halo_data(1:nxp, ny+1:nyp+nhalo, :) = halo_data(1:nxp, 1:nhalo+jshift,:) ! north if(m1 .GE. 1-shalo) & - data(nxp+1:nxp+ehalo, 1-shalo:m1, :) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, shalo+m2:1+jshift:-1,:) + halo_data(nxp+1:nxp+ehalo, 1-shalo:m1, :) = sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, shalo+m2:1+jshift:-1,:) - data(nxp+1:nxp+ehalo, m1+1:ny+m2, :) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, nyp:1:-1, :) - data(nxp+1:nxp+ehalo, ny+m2+1:nyp+nhalo,:) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, ny:ny-nhalo+m1+1:-1,:) + halo_data(nxp+1:nxp+ehalo, m1+1:ny+m2, :) = sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, nyp:1:-1, :) + halo_data(nxp+1:nxp+ehalo, ny+m2+1:nyp+nhalo,:) = & + sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, ny:ny-nhalo+m1+1:-1,:) end subroutine fill_folded_east_halo_r8 !> Fill the halo region of a 32-bit real array on a domain with a folded east edge - subroutine fill_folded_east_halo_r4(data, ioff, joff, ishift, jshift, sign) - real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_east_halo_r4(halo_data, ioff, joff, ishift, jshift, sign) + real(kind=r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -658,19 +663,20 @@ subroutine fill_folded_east_halo_r4(data, ioff, joff, ishift, jshift, sign) m1 = jshift - joff m2 = 2*jshift - joff - data(1:nxp, 1-shalo:0, :) = data(1:nxp, ny-shalo+1:ny, :) ! south - data(1:nxp, ny+1:nyp+nhalo, :) = data(1:nxp, 1:nhalo+jshift,:) ! north + halo_data(1:nxp, 1-shalo:0, :) = halo_data(1:nxp, ny-shalo+1:ny, :) ! south + halo_data(1:nxp, ny+1:nyp+nhalo, :) = halo_data(1:nxp, 1:nhalo+jshift,:) ! north if(m1 .GE. 1-shalo) & - data(nxp+1:nxp+ehalo, 1-shalo:m1, :) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, shalo+m2:1+jshift:-1,:) + halo_data(nxp+1:nxp+ehalo, 1-shalo:m1, :) = sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, shalo+m2:1+jshift:-1,:) - data(nxp+1:nxp+ehalo, m1+1:ny+m2, :) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, nyp:1:-1, :) - data(nxp+1:nxp+ehalo, ny+m2+1:nyp+nhalo,:) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, ny:ny-nhalo+m1+1:-1,:) + halo_data(nxp+1:nxp+ehalo, m1+1:ny+m2, :) = sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, nyp:1:-1, :) + halo_data(nxp+1:nxp+ehalo, ny+m2+1:nyp+nhalo,:) = & + sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, ny:ny-nhalo+m1+1:-1,:) end subroutine fill_folded_east_halo_r4 !> Fill the halo region of a 64-bit integer array on a domain with a folded east edge - subroutine fill_folded_east_halo_i8(data, ioff, joff, ishift, jshift, sign) - integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_east_halo_i8(halo_data, ioff, joff, ishift, jshift, sign) + integer(kind=i8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -680,19 +686,20 @@ subroutine fill_folded_east_halo_i8(data, ioff, joff, ishift, jshift, sign) m1 = jshift - joff m2 = 2*jshift - joff - data(1:nxp, 1-shalo:0, :) = data(1:nxp, ny-shalo+1:ny, :) ! south - data(1:nxp, ny+1:nyp+nhalo, :) = data(1:nxp, 1:nhalo+jshift,:) ! north + halo_data(1:nxp, 1-shalo:0, :) = halo_data(1:nxp, ny-shalo+1:ny, :) ! south + halo_data(1:nxp, ny+1:nyp+nhalo, :) = halo_data(1:nxp, 1:nhalo+jshift,:) ! north if(m1 .GE. 1-shalo) & - data(nxp+1:nxp+ehalo, 1-shalo:m1, :) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, shalo+m2:1+jshift:-1,:) + halo_data(nxp+1:nxp+ehalo, 1-shalo:m1, :) = sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, shalo+m2:1+jshift:-1,:) - data(nxp+1:nxp+ehalo, m1+1:ny+m2, :) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, nyp:1:-1, :) - data(nxp+1:nxp+ehalo, ny+m2+1:nyp+nhalo,:) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, ny:ny-nhalo+m1+1:-1,:) + halo_data(nxp+1:nxp+ehalo, m1+1:ny+m2, :) = sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, nyp:1:-1, :) + halo_data(nxp+1:nxp+ehalo, ny+m2+1:nyp+nhalo,:) = & + sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, ny:ny-nhalo+m1+1:-1,:) end subroutine fill_folded_east_halo_i8 !> Fill the halo region of a 32-bit integer array on a domain with a folded east edge - subroutine fill_folded_east_halo_i4(data, ioff, joff, ishift, jshift, sign) - integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_east_halo_i4(halo_data, ioff, joff, ishift, jshift, sign) + integer(kind=i4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in) :: ioff, joff, ishift, jshift, sign ! local integer :: nxp, nyp, m1, m2 @@ -702,13 +709,14 @@ subroutine fill_folded_east_halo_i4(data, ioff, joff, ishift, jshift, sign) m1 = jshift - joff m2 = 2*jshift - joff - data(1:nxp, 1-shalo:0, :) = data(1:nxp, ny-shalo+1:ny, :) ! south - data(1:nxp, ny+1:nyp+nhalo, :) = data(1:nxp, 1:nhalo+jshift,:) ! north + halo_data(1:nxp, 1-shalo:0, :) = halo_data(1:nxp, ny-shalo+1:ny, :) ! south + halo_data(1:nxp, ny+1:nyp+nhalo, :) = halo_data(1:nxp, 1:nhalo+jshift,:) ! north if(m1 .GE. 1-shalo) & - data(nxp+1:nxp+ehalo, 1-shalo:m1, :) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, shalo+m2:1+jshift:-1,:) + halo_data(nxp+1:nxp+ehalo, 1-shalo:m1, :) = sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, shalo+m2:1+jshift:-1,:) - data(nxp+1:nxp+ehalo, m1+1:ny+m2, :) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, nyp:1:-1, :) - data(nxp+1:nxp+ehalo, ny+m2+1:nyp+nhalo,:) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, ny:ny-nhalo+m1+1:-1,:) + halo_data(nxp+1:nxp+ehalo, m1+1:ny+m2, :) = sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, nyp:1:-1, :) + halo_data(nxp+1:nxp+ehalo, ny+m2+1:nyp+nhalo,:) = & + sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, ny:ny-nhalo+m1+1:-1,:) end subroutine fill_folded_east_halo_i4 diff --git a/test_fms/mpp/test_domains_utility_mod.F90 b/test_fms/mpp/test_domains_utility_mod.F90 index f88054b9f5..65926016ed 100644 --- a/test_fms/mpp/test_domains_utility_mod.F90 +++ b/test_fms/mpp/test_domains_utility_mod.F90 @@ -38,11 +38,11 @@ module test_domains_utility_mod contains -subroutine fill_coarse_data_r8(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, nz, isd, jsd, nx, ny, & +subroutine fill_coarse_data_r8(coarse_data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, nz, isd, jsd, nx, ny, & ishift, jshift, x_add, y_add, sign1, sign2, x_cyclic, y_cyclic, ieg, jeg) integer, intent(in) :: rotate, is_c, ie_c, js_c, je_c, nz, isd, jsd, iadd, jadd, nx, ny, ishift, jshift integer, intent(in) :: sign1, sign2 - real(kind=r8_kind), intent(inout) :: data(isd:, jsd:, :) + real(kind=r8_kind), intent(inout) :: coarse_data(isd:, jsd:, :) real(kind=r8_kind), intent(in) :: x_add, y_add logical, intent(in) :: x_cyclic, y_cyclic integer, intent(in) :: ieg, jeg @@ -54,7 +54,7 @@ subroutine fill_coarse_data_r8(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, do k = 1, nz do j = js_c, je_c+jshift do i = is_c, ie_c+ishift - data(i,j,k) = dble(i+iadd)*1.d+6 + dble(j+jadd)*1.d+3 + dble(k) + x_add + coarse_data(i,j,k) = dble(i+iadd)*1.d+6 + dble(j+jadd)*1.d+3 + dble(k) + x_add enddo enddo enddo @@ -63,7 +63,7 @@ subroutine fill_coarse_data_r8(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, do k = 1, nz do j = js_c, je_c+jshift do i = is_c, ie_c+ishift - data(i,j,k) = sign1*( dble(nx-j+1+iadd+jshift)*1.d+6 + dble(i+jadd)*1.d+3 + dble(k) + y_add) + coarse_data(i,j,k) = sign1*( dble(nx-j+1+iadd+jshift)*1.d+6 + dble(i+jadd)*1.d+3 + dble(k) + y_add) enddo enddo enddo @@ -72,7 +72,7 @@ subroutine fill_coarse_data_r8(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, do k = 1, nz do j = js_c, je_c+jshift do i = is_c, ie_c+ishift - data(i,j,k) = sign2*( dble(j+iadd)*1.d+6 + dble(ny-i+1+jadd+ishift)*1.d+3 + dble(k) + y_add) + coarse_data(i,j,k) = sign2*( dble(j+iadd)*1.d+6 + dble(ny-i+1+jadd+ishift)*1.d+3 + dble(k) + y_add) enddo enddo enddo @@ -86,7 +86,7 @@ subroutine fill_coarse_data_r8(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, i = ie_c+ishift do k = 1, nz do j = js_c, je_c+jshift - data(i,j,k) = dble(i)*1.d+6 + dble(j+jadd)*1.d+3 + dble(k) + x_add + coarse_data(i,j,k) = dble(i)*1.d+6 + dble(j+jadd)*1.d+3 + dble(k) + x_add enddo enddo endif @@ -98,7 +98,7 @@ subroutine fill_coarse_data_r8(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, j = je_c+jshift do k = 1, nz do j = js_c, je_c+jshift - data(i,j,k) = dble(i+iadd)*1.d+6 + j*1.d+3 + dble(k) + x_add + coarse_data(i,j,k) = dble(i+iadd)*1.d+6 + j*1.d+3 + dble(k) + x_add enddo enddo endif @@ -107,11 +107,11 @@ subroutine fill_coarse_data_r8(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, end subroutine fill_coarse_data_r8 -subroutine fill_coarse_data_r4(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, nz, isd, jsd, nx, ny, & +subroutine fill_coarse_data_r4(coarse_data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, nz, isd, jsd, nx, ny, & ishift, jshift, x_add, y_add, sign1, sign2, x_cyclic, y_cyclic, ieg, jeg) integer, intent(in) :: rotate, is_c, ie_c, js_c, je_c, nz, isd, jsd, iadd, jadd, nx, ny, ishift, jshift integer, intent(in) :: sign1, sign2 - real(kind=r4_kind), intent(inout) :: data(isd:, jsd:, :) + real(kind=r4_kind), intent(inout) :: coarse_data(isd:, jsd:, :) real(kind=r4_kind), intent(in) :: x_add, y_add logical, intent(in) :: x_cyclic, y_cyclic integer, intent(in) :: ieg, jeg @@ -123,7 +123,7 @@ subroutine fill_coarse_data_r4(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, do k = 1, nz do j = js_c, je_c+jshift do i = is_c, ie_c+ishift - data(i,j,k) = (i+iadd)*1.e+6 + (j+jadd)*1.e+3 + k + x_add + coarse_data(i,j,k) = (i+iadd)*1.e+6 + (j+jadd)*1.e+3 + k + x_add enddo enddo enddo @@ -132,7 +132,7 @@ subroutine fill_coarse_data_r4(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, do k = 1, nz do j = js_c, je_c+jshift do i = is_c, ie_c+ishift - data(i,j,k) = sign1*((nx-j+1+iadd+jshift)*1.e+6 + (i+jadd)*1.e+3 + k + y_add) + coarse_data(i,j,k) = sign1*((nx-j+1+iadd+jshift)*1.e+6 + (i+jadd)*1.e+3 + k + y_add) enddo enddo enddo @@ -141,7 +141,7 @@ subroutine fill_coarse_data_r4(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, do k = 1, nz do j = js_c, je_c+jshift do i = is_c, ie_c+ishift - data(i,j,k) = sign2*((j+iadd)*1.e+6 + (ny-i+1+jadd+ishift)*1.e+3 + k + y_add) + coarse_data(i,j,k) = sign2*((j+iadd)*1.e+6 + (ny-i+1+jadd+ishift)*1.e+3 + k + y_add) enddo enddo enddo @@ -155,7 +155,7 @@ subroutine fill_coarse_data_r4(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, i = ie_c+ishift do k = 1, nz do j = js_c, je_c+jshift - data(i,j,k) = i*1.e+6 + (j+jadd)*1.e+3 + k + x_add + coarse_data(i,j,k) = i*1.e+6 + (j+jadd)*1.e+3 + k + x_add enddo enddo endif @@ -167,7 +167,7 @@ subroutine fill_coarse_data_r4(data, rotate, iadd, jadd, is_c, ie_c, js_c, je_c, j = je_c+jshift do k = 1, nz do j = js_c, je_c+jshift - data(i,j,k) = (i+iadd)*1.e+6 + j*1.e+3 + k + x_add + coarse_data(i,j,k) = (i+iadd)*1.e+6 + j*1.e+3 + k + x_add enddo enddo endif diff --git a/test_fms/mpp/test_mpp_domains.F90 b/test_fms/mpp/test_mpp_domains.F90 index 3ca557788f..c589f053e3 100644 --- a/test_fms/mpp/test_mpp_domains.F90 +++ b/test_fms/mpp/test_mpp_domains.F90 @@ -3678,63 +3678,63 @@ subroutine test_unstruct_update( type ) end subroutine test_unstruct_update !################################################################################# - subroutine fill_halo_zero(data, whalo, ehalo, shalo, nhalo, xshift, yshift, isc, iec, jsc, jec, isd, ied, jsd, jed) + subroutine fill_halo_zero(halo_data, whalo, ehalo, shalo, nhalo, xshift, yshift, isc, iec, jsc, jec, isd, ied, jsd, jed) integer, intent(in) :: isc, iec, jsc, jec, isd, ied, jsd, jed integer, intent(in) :: whalo, ehalo, shalo, nhalo, xshift, yshift - real, dimension(isd:,jsd:,:), intent(inout) :: data + real, dimension(isd:,jsd:,:), intent(inout) :: halo_data if(whalo >=0) then - data(iec+ehalo+1+xshift:ied+xshift,jsd:jed+yshift,:) = 0 - data(isd:isc-whalo-1,jsd:jed+yshift,:) = 0 + halo_data(iec+ehalo+1+xshift:ied+xshift,jsd:jed+yshift,:) = 0 + halo_data(isd:isc-whalo-1,jsd:jed+yshift,:) = 0 else - data(iec+1+xshift:iec-ehalo+xshift,jsc+shalo:jec-nhalo+yshift,:) = 0 - data(isc+whalo:isc-1,jsc+shalo:jec-nhalo+yshift,:) = 0 + halo_data(iec+1+xshift:iec-ehalo+xshift,jsc+shalo:jec-nhalo+yshift,:) = 0 + halo_data(isc+whalo:isc-1,jsc+shalo:jec-nhalo+yshift,:) = 0 end if if(shalo>=0) then - data(isd:ied+xshift, jec+nhalo+1+yshift:jed+yshift,:) = 0 - data(isd:ied+xshift, jsd:jsc-shalo-1,:) = 0 + halo_data(isd:ied+xshift, jec+nhalo+1+yshift:jed+yshift,:) = 0 + halo_data(isd:ied+xshift, jsd:jsc-shalo-1,:) = 0 else - data(isc+whalo:iec-ehalo+xshift,jec+1+yshift:jec-nhalo+yshift,:) = 0 - data(isc+whalo:iec-ehalo+xshift,jsc+shalo:jsc-1,:) = 0 + halo_data(isc+whalo:iec-ehalo+xshift,jec+1+yshift:jec-nhalo+yshift,:) = 0 + halo_data(isc+whalo:iec-ehalo+xshift,jsc+shalo:jsc-1,:) = 0 end if end subroutine fill_halo_zero !############################################################################## ! this routine fill the halo points for the regular mosaic. - subroutine fill_regular_mosaic_halo(data, data_all, te, tse, ts, tsw, tw, tnw, tn, tne) - real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_regular_mosaic_halo(halo_data, data_all, te, tse, ts, tsw, tw, tnw, tn, tne) + real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data real, dimension(:,:,:,:), intent(in) :: data_all integer, intent(in) :: te, tse, ts, tsw, tw, tnw, tn, tne - data(nx+1:nx+ehalo, 1:ny, :) = data_all(1:ehalo, 1:ny, :, te) ! east - data(1:nx, 1-shalo:0, :) = data_all(1:nx, ny-shalo+1:ny, :, ts) ! south - data(1-whalo:0, 1:ny, :) = data_all(nx-whalo+1:nx, 1:ny, :, tw) ! west - data(1:nx, ny+1:ny+nhalo, :) = data_all(1:nx, 1:nhalo, :, tn) ! north - data(nx+1:nx+ehalo, 1-shalo:0, :) = data_all(1:ehalo, ny-shalo+1:ny, :,tse) ! southeast - data(1-whalo:0, 1-shalo:0, :) = data_all(nx-whalo+1:nx, ny-shalo+1:ny, :,tsw) ! southwest - data(nx+1:nx+ehalo, ny+1:ny+nhalo, :) = data_all(1:ehalo, 1:nhalo, :,tnw) ! northeast - data(1-whalo:0, ny+1:ny+nhalo, :) = data_all(nx-whalo+1:nx, 1:nhalo, :,tne) ! northwest + halo_data(nx+1:nx+ehalo, 1:ny, :) = data_all(1:ehalo, 1:ny, :, te) ! east + halo_data(1:nx, 1-shalo:0, :) = data_all(1:nx, ny-shalo+1:ny, :, ts) ! south + halo_data(1-whalo:0, 1:ny, :) = data_all(nx-whalo+1:nx, 1:ny, :, tw) ! west + halo_data(1:nx, ny+1:ny+nhalo, :) = data_all(1:nx, 1:nhalo, :, tn) ! north + halo_data(nx+1:nx+ehalo, 1-shalo:0, :) = data_all(1:ehalo, ny-shalo+1:ny, :,tse) ! southeast + halo_data(1-whalo:0, 1-shalo:0, :) = data_all(nx-whalo+1:nx, ny-shalo+1:ny, :,tsw) ! southwest + halo_data(nx+1:nx+ehalo, ny+1:ny+nhalo, :) = data_all(1:ehalo, 1:nhalo, :,tnw) ! northeast + halo_data(1-whalo:0, ny+1:ny+nhalo, :) = data_all(nx-whalo+1:nx, 1:nhalo, :,tne) ! northwest end subroutine fill_regular_mosaic_halo - subroutine fill_folded_north_halo(data, ioff, joff, ishift, jshift, sign) - class(*), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_north_halo(halo_data, ioff, joff, ishift, jshift, sign) + class(*), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in ) :: ioff, joff, ishift, jshift, sign - select type(data) + select type(halo_data) type is (real(r4_kind)) - call fill_folded_north_halo_r4(data, ioff, joff, ishift, jshift, sign) + call fill_folded_north_halo_r4(halo_data, ioff, joff, ishift, jshift, sign) type is (real(r8_kind)) - call fill_folded_north_halo_r8(data, ioff, joff, ishift, jshift, sign) + call fill_folded_north_halo_r8(halo_data, ioff, joff, ishift, jshift, sign) end select end subroutine !################################################################################ - subroutine fill_folded_north_halo_r4(data, ioff, joff, ishift, jshift, sign) - real(r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_north_halo_r4(halo_data, ioff, joff, ishift, jshift, sign) + real(r4_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in ) :: ioff, joff, ishift, jshift, sign integer :: nxp, nyp, m1, m2 @@ -3743,17 +3743,19 @@ subroutine fill_folded_north_halo_r4(data, ioff, joff, ishift, jshift, sign) m1 = ishift - ioff m2 = 2*ishift - ioff - data(1-whalo:0, 1:nyp,:) = data(nx-whalo+1:nx, 1:ny+jshift,:) ! west - data(nx+1:nx+ehalo+ishift, 1:nyp,:) = data(1:ehalo+ishift, 1:ny+jshift,:) ! east - if(m1 .GE. 1-whalo) data(1-whalo:m1, nyp+1:nyp+nhalo,:) = sign*data(whalo+m2:1+ishift:-1, & + halo_data(1-whalo:0, 1:nyp,:) = halo_data(nx-whalo+1:nx, 1:ny+jshift,:) ! west + halo_data(nx+1:nx+ehalo+ishift, 1:nyp,:) = halo_data(1:ehalo+ishift, 1:ny+jshift,:) ! east + if(m1 .GE. 1-whalo) halo_data(1-whalo:m1, nyp+1:nyp+nhalo,:) = sign*halo_data(whalo+m2:1+ishift:-1, & & nyp-joff:nyp-nhalo-joff+1:-1,:) - data(m1+1:nx+m2, nyp+1:nyp+nhalo,:) = sign*data(nx+ishift:1:-1, nyp-joff:nyp-nhalo-joff+1:-1,:) - data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = sign*data(nx:nx-ehalo+m1+1:-1, nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(m1+1:nx+m2, nyp+1:nyp+nhalo,:) = & + sign*halo_data(nx+ishift:1:-1, nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = & + sign*halo_data(nx:nx-ehalo+m1+1:-1, nyp-joff:nyp-nhalo-joff+1:-1,:) end subroutine fill_folded_north_halo_r4 ! r8 version needed for mixed mode - subroutine fill_folded_north_halo_r8(data, ioff, joff, ishift, jshift, sign) - real(r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_north_halo_r8(halo_data, ioff, joff, ishift, jshift, sign) + real(r8_kind), dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in ) :: ioff, joff, ishift, jshift, sign integer :: nxp, nyp, m1, m2 @@ -3762,18 +3764,20 @@ subroutine fill_folded_north_halo_r8(data, ioff, joff, ishift, jshift, sign) m1 = ishift - ioff m2 = 2*ishift - ioff - data(1-whalo:0, 1:nyp,:) = data(nx-whalo+1:nx, 1:ny+jshift,:) ! west - data(nx+1:nx+ehalo+ishift, 1:nyp,:) = data(1:ehalo+ishift, 1:ny+jshift,:) ! east + halo_data(1-whalo:0, 1:nyp,:) = halo_data(nx-whalo+1:nx, 1:ny+jshift,:) ! west + halo_data(nx+1:nx+ehalo+ishift, 1:nyp,:) = halo_data(1:ehalo+ishift, 1:ny+jshift,:) ! east if(m1 .GE. 1-whalo) & - data(1-whalo:m1, nyp+1:nyp+nhalo,:) = sign*data(whalo+m2:1+ishift:-1, nyp-joff:nyp-nhalo-joff+1:-1,:) - data(m1+1:nx+m2, nyp+1:nyp+nhalo,:) = sign*data(nx+ishift:1:-1, nyp-joff:nyp-nhalo-joff+1:-1,:) - data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = sign*data(nx:nx-ehalo+m1+1:-1, nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(1-whalo:m1, nyp+1:nyp+nhalo,:) = sign*halo_data(whalo+m2:1+ishift:-1, nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(m1+1:nx+m2, nyp+1:nyp+nhalo,:) = & + sign*halo_data(nx+ishift:1:-1, nyp-joff:nyp-nhalo-joff+1:-1,:) + halo_data(nx+m2+1:nxp+ehalo,nyp+1:nyp+nhalo,:) = & + sign*halo_data(nx:nx-ehalo+m1+1:-1, nyp-joff:nyp-nhalo-joff+1:-1,:) end subroutine fill_folded_north_halo_r8 !################################################################################ - subroutine fill_folded_south_halo(data, ioff, joff, ishift, jshift, sign) - real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_south_halo(halo_data, ioff, joff, ishift, jshift, sign) + real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in ) :: ioff, joff, ishift, jshift, sign integer :: nxp, nyp, m1, m2 @@ -3783,17 +3787,18 @@ subroutine fill_folded_south_halo(data, ioff, joff, ishift, jshift, sign) m2 = 2*ishift - ioff - data(1-whalo:0, 1:nyp,:) = data(nx-whalo+1:nx, 1:nyp,:) ! west - data(nx+1:nx+ehalo+ishift, 1:nyp,:) = data(1:ehalo+ishift, 1:nyp,:) ! east - if(m1 .GE. 1-whalo)data(1-whalo:m1, 1-shalo:0,:) = sign*data(whalo+m2:1+ishift:-1, shalo+jshift:1+jshift:-1,:) - data(m1+1:nx+m2, 1-shalo:0,:) = sign*data(nxp:1:-1, shalo+jshift:1+jshift:-1,:) - data(nx+m2+1:nxp+ehalo,1-shalo:0,:) = sign*data(nx:nx-ehalo+m1+1:-1, shalo+jshift:1+jshift:-1,:) + halo_data(1-whalo:0, 1:nyp,:) = halo_data(nx-whalo+1:nx, 1:nyp,:) ! west + halo_data(nx+1:nx+ehalo+ishift, 1:nyp,:) = halo_data(1:ehalo+ishift, 1:nyp,:) ! east + if(m1 .GE. 1-whalo)halo_data(1-whalo:m1, 1-shalo:0,:) = & + sign*halo_data(whalo+m2:1+ishift:-1, shalo+jshift:1+jshift:-1,:) + halo_data(m1+1:nx+m2, 1-shalo:0,:) = sign*halo_data(nxp:1:-1, shalo+jshift:1+jshift:-1,:) + halo_data(nx+m2+1:nxp+ehalo,1-shalo:0,:) = sign*halo_data(nx:nx-ehalo+m1+1:-1, shalo+jshift:1+jshift:-1,:) end subroutine fill_folded_south_halo !################################################################################ - subroutine fill_folded_west_halo(data, ioff, joff, ishift, jshift, sign) - real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_west_halo(halo_data, ioff, joff, ishift, jshift, sign) + real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in ) :: ioff, joff, ishift, jshift, sign integer :: nxp, nyp, m1, m2 @@ -3802,17 +3807,18 @@ subroutine fill_folded_west_halo(data, ioff, joff, ishift, jshift, sign) m1 = jshift - joff m2 = 2*jshift - joff - data(1:nxp, 1-shalo:0, :) = data(1:nxp, ny-shalo+1:ny, :) ! south - data(1:nxp, ny+1:nyp+nhalo, :) = data(1:nxp, 1:nhalo+jshift,:) ! north - if(m1 .GE. 1-shalo) data(1-whalo:0, 1-shalo:m1, :) = sign*data(whalo+ishift:1+ishift:-1, shalo+m2:1+jshift:-1,:) - data(1-whalo:0, m1+1:ny+m2, :) = sign*data(whalo+ishift:1+ishift:-1, nyp:1:-1, :) - data(1-whalo:0, ny+m2+1:nyp+nhalo,:) = sign*data(whalo+ishift:1+ishift:-1, ny:ny-nhalo+m1+1:-1,:) + halo_data(1:nxp, 1-shalo:0, :) = halo_data(1:nxp, ny-shalo+1:ny, :) ! south + halo_data(1:nxp, ny+1:nyp+nhalo, :) = halo_data(1:nxp, 1:nhalo+jshift,:) ! north + if(m1 .GE. 1-shalo) halo_data(1-whalo:0, 1-shalo:m1, :) = & + sign*halo_data(whalo+ishift:1+ishift:-1, shalo+m2:1+jshift:-1,:) + halo_data(1-whalo:0, m1+1:ny+m2, :) = sign*halo_data(whalo+ishift:1+ishift:-1, nyp:1:-1, :) + halo_data(1-whalo:0, ny+m2+1:nyp+nhalo,:) = sign*halo_data(whalo+ishift:1+ishift:-1, ny:ny-nhalo+m1+1:-1,:) end subroutine fill_folded_west_halo !################################################################################ - subroutine fill_folded_east_halo(data, ioff, joff, ishift, jshift, sign) - real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_folded_east_halo(halo_data, ioff, joff, ishift, jshift, sign) + real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data integer, intent(in ) :: ioff, joff, ishift, jshift, sign integer :: nxp, nyp, m1, m2 @@ -3821,12 +3827,13 @@ subroutine fill_folded_east_halo(data, ioff, joff, ishift, jshift, sign) m1 = jshift - joff m2 = 2*jshift - joff - data(1:nxp, 1-shalo:0, :) = data(1:nxp, ny-shalo+1:ny, :) ! south - data(1:nxp, ny+1:nyp+nhalo, :) = data(1:nxp, 1:nhalo+jshift,:) ! north - if(m1 .GE. 1-shalo) data(nxp+1:nxp+ehalo, 1-shalo:m1, :) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, & + halo_data(1:nxp, 1-shalo:0, :) = halo_data(1:nxp, ny-shalo+1:ny, :) ! south + halo_data(1:nxp, ny+1:nyp+nhalo, :) = halo_data(1:nxp, 1:nhalo+jshift,:) ! north + if(m1 .GE. 1-shalo) halo_data(nxp+1:nxp+ehalo, 1-shalo:m1, :) = sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, & & shalo+m2:1+jshift:-1,:) - data(nxp+1:nxp+ehalo, m1+1:ny+m2, :) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, nyp:1:-1, :) - data(nxp+1:nxp+ehalo, ny+m2+1:nyp+nhalo,:) = sign*data(nxp-ioff:nxp-ehalo-ioff+1:-1, ny:ny-nhalo+m1+1:-1,:) + halo_data(nxp+1:nxp+ehalo, m1+1:ny+m2, :) = sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, nyp:1:-1, :) + halo_data(nxp+1:nxp+ehalo, ny+m2+1:nyp+nhalo,:) = & + sign*halo_data(nxp-ioff:nxp-ehalo-ioff+1:-1, ny:ny-nhalo+m1+1:-1,:) end subroutine fill_folded_east_halo @@ -4081,8 +4088,8 @@ end subroutine fill_cubic_grid_bound !############################################################################## ! this routine fill the halo points for the cubic grid. ioff and joff is used to distinguish ! T, C, E, or N-cell - subroutine fill_cubic_grid_halo(data, data1_all, data2_all, tile, ioff, joff, sign1, sign2) - real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_cubic_grid_halo(halo_data, data1_all, data2_all, tile, ioff, joff, sign1, sign2) + real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data real, dimension(:,:,:,:), intent(in) :: data1_all, data2_all integer, intent(in) :: tile, ioff, joff, sign1, sign2 integer :: lw, le, ls, ln @@ -4092,26 +4099,26 @@ subroutine fill_cubic_grid_halo(data, data1_all, data2_all, tile, ioff, joff, si if(le > 6 ) le = le - 6 if(ls < 1 ) ls = ls + 6 if(ln > 6 ) ln = ln - 6 - data(1-whalo:0, 1:ny+joff, :) = data1_all(nx-whalo+1:nx, 1:ny+joff, :, lw) ! west + halo_data(1-whalo:0, 1:ny+joff, :) = data1_all(nx-whalo+1:nx, 1:ny+joff, :, lw) ! west do i = 1, ehalo - data(nx+i+ioff, 1:ny+joff, :) = sign1*data2_all(nx+joff:1:-1, i+ioff, :, le) ! east + halo_data(nx+i+ioff, 1:ny+joff, :) = sign1*data2_all(nx+joff:1:-1, i+ioff, :, le) ! east end do do i = 1, shalo - data(1:nx+ioff, 1-i, :) = sign2*data2_all(nx-i+1, ny+ioff:1:-1, :, ls) ! south + halo_data(1:nx+ioff, 1-i, :) = sign2*data2_all(nx-i+1, ny+ioff:1:-1, :, ls) ! south end do - data(1:nx+ioff, ny+1+joff:ny+nhalo+joff, :) = data1_all(1:nx+ioff, 1+joff:nhalo+joff, :, ln) ! north + halo_data(1:nx+ioff, ny+1+joff:ny+nhalo+joff, :) = data1_all(1:nx+ioff, 1+joff:nhalo+joff, :, ln) ! north else ! tile 1, 3, 5 lw = tile - 2; le = tile + 1; ls = tile - 1; ln = tile + 2 if(lw < 1 ) lw = lw + 6 if(ls < 1 ) ls = ls + 6 if(ln > 6 ) ln = ln - 6 do i = 1, whalo - data(1-i, 1:ny+joff, :) = sign1*data2_all(nx+joff:1:-1, ny-i+1, :, lw) ! west + halo_data(1-i, 1:ny+joff, :) = sign1*data2_all(nx+joff:1:-1, ny-i+1, :, lw) ! west end do - data(nx+1+ioff:nx+ehalo+ioff, 1:ny+joff, :) = data1_all(1+ioff:ehalo+ioff, 1:ny+joff, :, le) ! east - data(1:nx+ioff, 1-shalo:0, :) = data1_all(1:nx+ioff, ny-shalo+1:ny, :, ls) ! south + halo_data(nx+1+ioff:nx+ehalo+ioff, 1:ny+joff, :) = data1_all(1+ioff:ehalo+ioff, 1:ny+joff, :, le) ! east + halo_data(1:nx+ioff, 1-shalo:0, :) = data1_all(1:nx+ioff, ny-shalo+1:ny, :, ls) ! south do i = 1, nhalo - data(1:nx+ioff, ny+i+joff, :) = sign2*data2_all(i+joff, ny+ioff:1:-1, :, ln) ! north + halo_data(1:nx+ioff, ny+i+joff, :) = sign2*data2_all(i+joff, ny+ioff:1:-1, :, ln) ! north end do end if @@ -4456,8 +4463,8 @@ subroutine test_nonuniform_mosaic( type ) end subroutine test_nonuniform_mosaic - subroutine fill_five_tile_halo(data, data_all, tile, ioff, joff) - real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_five_tile_halo(halo_data, data_all, tile, ioff, joff) + real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data real, dimension(:,:,:,:), intent(in) :: data_all integer, intent(in) :: tile, ioff, joff integer :: nxm, nym @@ -4466,57 +4473,58 @@ subroutine fill_five_tile_halo(data, data_all, tile, ioff, joff) select case(tile) case(1) - data(nxm+1+ioff:nxm+ehalo+ioff, 1:ny,:) = data_all(1+ioff:ehalo+ioff, 1:ny,:,2) ! east - data(nxm+1+ioff:nxm+ehalo+ioff, ny+1:nym+joff,:) = data_all(1+ioff:ehalo+ioff, 1:ny+joff,:,4) ! east - data(1-whalo:0, 1:ny,:) = data_all(nx-whalo+1:nx, 1:ny,:,3) ! west - data(1-whalo:0, ny+1:nym+joff,:) = data_all(nx-whalo+1:nx, 1:ny+joff,:,5) ! west - data(1:nxm+ioff, 1-shalo:0,:) = data_all(1:nxm+ioff, nym-shalo+1:nym,:,1) ! south - data(1:nxm+ioff, nym+1+joff:nym+nhalo+joff,:) = data_all(1:nxm+ioff, 1+joff:nhalo+joff,:,1) ! north - data(nxm+1+ioff:nxm+ehalo+ioff, 1-shalo:0,:) = data_all(1+ioff:ehalo+ioff, ny-shalo+1:ny,:,4) ! southeast - data(1-whalo:0, 1-shalo:0,:) = data_all(nx-whalo+1:nx, ny-shalo+1:ny,:,5) ! southwest - data(nxm+1+ioff:nxm+ehalo+ioff,nym+1+joff:nym+nhalo+joff,:) = & + halo_data(nxm+1+ioff:nxm+ehalo+ioff, 1:ny,:) = data_all(1+ioff:ehalo+ioff, 1:ny,:,2) ! east + halo_data(nxm+1+ioff:nxm+ehalo+ioff, ny+1:nym+joff,:) = data_all(1+ioff:ehalo+ioff, 1:ny+joff,:,4) ! east + halo_data(1-whalo:0, 1:ny,:) = data_all(nx-whalo+1:nx, 1:ny,:,3) ! west + halo_data(1-whalo:0, ny+1:nym+joff,:) = data_all(nx-whalo+1:nx, 1:ny+joff,:,5) ! west + halo_data(1:nxm+ioff, 1-shalo:0,:) = data_all(1:nxm+ioff, nym-shalo+1:nym,:,1) ! south + halo_data(1:nxm+ioff, nym+1+joff:nym+nhalo+joff,:) = data_all(1:nxm+ioff, 1+joff:nhalo+joff,:,1) ! north + halo_data(nxm+1+ioff:nxm+ehalo+ioff, 1-shalo:0,:) = data_all(1+ioff:ehalo+ioff, ny-shalo+1:ny,:,4) ! southeast + halo_data(1-whalo:0, 1-shalo:0,:) = data_all(nx-whalo+1:nx, ny-shalo+1:ny,:,5) ! southwest + halo_data(nxm+1+ioff:nxm+ehalo+ioff,nym+1+joff:nym+nhalo+joff,:) = & & data_all(1+ioff:ehalo+ioff, 1+joff:nhalo+joff,:,2) ! northeast - data(1-whalo:0, nym+1+joff:nym+nhalo+joff,:) = data_all(nx-whalo+1:nx, 1+joff:nhalo+joff,:,3) ! northwest + halo_data(1-whalo:0, nym+1+joff:nym+nhalo+joff,:) = data_all(nx-whalo+1:nx, 1+joff:nhalo+joff,:,3) ! northwest case(2) - data(nx+1+ioff:nx+ehalo+ioff, 1:ny+joff,:) = data_all(1+ioff:ehalo+ioff, 1:ny+joff,:,3) ! east - data(1-whalo:0, 1:ny+joff,:) = data_all(nxm-whalo+1:nxm, 1:ny+joff,:,1) ! west - data(1:nx+ioff, 1-shalo:0,:) = data_all(1:nx+ioff, ny-shalo+1:ny,:,4) ! south - data(1:nx+ioff, ny+1+joff:ny+nhalo+joff,:) = data_all(1:nx+ioff, 1+joff:nhalo+joff,:,4) ! north - data(nx+1+ioff:nx+ehalo+ioff, 1-shalo:0,:) = data_all(1+ioff:ehalo+ioff, ny-shalo+1:ny,:,5) ! southeast - data(1-whalo:0, 1-shalo:0,:) = data_all(nxm-whalo+1:nxm, nym-shalo+1:nym,:,1) ! southwest - data(nx+1+ioff:nx+ehalo+ioff,ny+1+joff:ny+nhalo+joff,:) = & - & data_all(1+ioff:ehalo+ioff, 1+joff:nhalo+joff,:,5) ! northeast - data(1-whalo:0, ny+1+joff:ny+nhalo+joff,:) = data_all(nxm-whalo+1:nxm, ny+1+joff:ny+nhalo+joff,:,1) ! northwest + halo_data(nx+1+ioff:nx+ehalo+ioff, 1:ny+joff,:) = data_all(1+ioff:ehalo+ioff, 1:ny+joff,:,3) ! east + halo_data(1-whalo:0, 1:ny+joff,:) = data_all(nxm-whalo+1:nxm, 1:ny+joff,:,1) ! west + halo_data(1:nx+ioff, 1-shalo:0,:) = data_all(1:nx+ioff, ny-shalo+1:ny,:,4) ! south + halo_data(1:nx+ioff, ny+1+joff:ny+nhalo+joff,:) = data_all(1:nx+ioff, 1+joff:nhalo+joff,:,4) ! north + halo_data(nx+1+ioff:nx+ehalo+ioff, 1-shalo:0,:) = data_all(1+ioff:ehalo+ioff, ny-shalo+1:ny,:,5) ! southeast + halo_data(1-whalo:0, 1-shalo:0,:) = data_all(nxm-whalo+1:nxm, nym-shalo+1:nym,:,1) ! southwest + halo_data(nx+1+ioff:nx+ehalo+ioff,ny+1+joff:ny+nhalo+joff,:) = & + & data_all(1+ioff:ehalo+ioff, 1+joff:nhalo+joff,:,5) ! northeast + halo_data(1-whalo:0, ny+1+joff:ny+nhalo+joff,:) = & + data_all(nxm-whalo+1:nxm, ny+1+joff:ny+nhalo+joff,:,1) ! northwest case(3) - data(nx+1+ioff:nx+ehalo+ioff, 1:ny+joff,:) = data_all(1+ioff:ehalo+ioff, 1:ny+joff,:,1) ! east - data(1-whalo:0, 1:ny+joff,:) = data_all(nx-whalo+1:nx, 1:ny+joff,:,2) ! west - data(1:nx+ioff, 1-shalo:0,:) = data_all(1:nx+ioff, ny-shalo+1:ny,:,5) ! south - data(1:nx+ioff, ny+1+joff:ny+nhalo+joff,:) = data_all(1:nx+ioff, 1+joff:nhalo+joff,:,5) ! north - data(nx+1+ioff:nx+ehalo+ioff, 1-shalo:0,:) = data_all(1+ioff:ehalo+ioff, nym-shalo+1:nym,:,1) ! southeast - data(1-whalo:0, 1-shalo:0,:) = data_all(nx-whalo+1:nx, ny-shalo+1:ny,:,4) ! southwest - data(nx+1+ioff:nx+ehalo+ioff,ny+1+joff:ny+nhalo+joff,:) = & - & data_all(1+ioff:ehalo+ioff,ny+1+joff:ny+nhalo+joff,:,1) ! northeast - data(1-whalo:0, ny+1+joff:ny+nhalo+joff,:) = data_all(nx-whalo+1:nx, 1+joff:nhalo+joff,:,4) ! northwest + halo_data(nx+1+ioff:nx+ehalo+ioff, 1:ny+joff,:) = data_all(1+ioff:ehalo+ioff, 1:ny+joff,:,1) ! east + halo_data(1-whalo:0, 1:ny+joff,:) = data_all(nx-whalo+1:nx, 1:ny+joff,:,2) ! west + halo_data(1:nx+ioff, 1-shalo:0,:) = data_all(1:nx+ioff, ny-shalo+1:ny,:,5) ! south + halo_data(1:nx+ioff, ny+1+joff:ny+nhalo+joff,:) = data_all(1:nx+ioff, 1+joff:nhalo+joff,:,5) ! north + halo_data(nx+1+ioff:nx+ehalo+ioff, 1-shalo:0,:) = data_all(1+ioff:ehalo+ioff, nym-shalo+1:nym,:,1) ! southeast + halo_data(1-whalo:0, 1-shalo:0,:) = data_all(nx-whalo+1:nx, ny-shalo+1:ny,:,4) ! southwest + halo_data(nx+1+ioff:nx+ehalo+ioff,ny+1+joff:ny+nhalo+joff,:) = & + & data_all(1+ioff:ehalo+ioff,ny+1+joff:ny+nhalo+joff,:,1) ! northeast + halo_data(1-whalo:0, ny+1+joff:ny+nhalo+joff,:) = data_all(nx-whalo+1:nx, 1+joff:nhalo+joff,:,4) ! northwest case(4) - data(nx+1+ioff:nx+ehalo+ioff, 1:ny+joff,:) = data_all(1+ioff:ehalo+ioff, 1:ny+joff,:,5) ! east - data(1-whalo:0, 1:ny+joff,:) = data_all(nxm-whalo+1:nxm, ny+1:2*ny+joff,:,1) ! west - data(1:nx+ioff, 1-shalo:0,:) = data_all(1:nx+ioff, ny-shalo+1:ny,:,2) ! south - data(1:nx+ioff, ny+1+joff:ny+nhalo+joff,:) = data_all(1:nx+ioff, 1+joff:nhalo+joff,:,2) ! north - data(nx+1+ioff:nx+ehalo+ioff, 1-shalo:0,:) = data_all(1+ioff:ehalo+ioff, ny-shalo+1:ny,:,3) ! southeast - data(1-whalo:0, 1-shalo:0,:) = data_all(nxm-whalo+1:nxm, ny-shalo+1:ny,:,1) ! southwest - data(nx+1+ioff:nx+ehalo+ioff,ny+1+joff:ny+nhalo+joff,:) = & + halo_data(nx+1+ioff:nx+ehalo+ioff, 1:ny+joff,:) = data_all(1+ioff:ehalo+ioff, 1:ny+joff,:,5) ! east + halo_data(1-whalo:0, 1:ny+joff,:) = data_all(nxm-whalo+1:nxm, ny+1:2*ny+joff,:,1) ! west + halo_data(1:nx+ioff, 1-shalo:0,:) = data_all(1:nx+ioff, ny-shalo+1:ny,:,2) ! south + halo_data(1:nx+ioff, ny+1+joff:ny+nhalo+joff,:) = data_all(1:nx+ioff, 1+joff:nhalo+joff,:,2) ! north + halo_data(nx+1+ioff:nx+ehalo+ioff, 1-shalo:0,:) = data_all(1+ioff:ehalo+ioff, ny-shalo+1:ny,:,3) ! southeast + halo_data(1-whalo:0, 1-shalo:0,:) = data_all(nxm-whalo+1:nxm, ny-shalo+1:ny,:,1) ! southwest + halo_data(nx+1+ioff:nx+ehalo+ioff,ny+1+joff:ny+nhalo+joff,:) = & & data_all(1+ioff:ehalo+ioff,1+joff:nhalo+joff,:,3) ! northeast - data(1-whalo:0, ny+1+joff:ny+nhalo+joff,:) = data_all(nxm-whalo+1:nxm, 1+joff:nhalo+joff,:,1) ! northwest + halo_data(1-whalo:0, ny+1+joff:ny+nhalo+joff,:) = data_all(nxm-whalo+1:nxm, 1+joff:nhalo+joff,:,1) ! northwest case(5) - data(nx+1+ioff:nx+ehalo+ioff, 1: ny+joff,:) = data_all(1+ioff:ehalo+ioff, ny+1:2*ny+joff,:,1) ! east - data(1-whalo:0, 1:ny+joff,:) = data_all(nx-whalo+1:nx, 1:ny+joff,:,4) ! west - data(1:nx+ioff, 1-shalo:0,:) = data_all(1:nx+ioff, ny-shalo+1:ny,:,3) ! south - data(1:nx+ioff, ny+1+joff:ny+nhalo+joff,:) = data_all(1:nx+ioff, 1+joff:nhalo+joff,:,3) ! north - data(nx+1+ioff:nx+ehalo+ioff, 1-shalo:0,:) = data_all(1+ioff:ehalo+ioff, ny-shalo+1:ny,:,1) ! southeast - data(1-whalo:0, 1-shalo:0,:) = data_all(nx-whalo+1:nx, ny-shalo+1:ny,:,2) ! southwest - data(nx+1+ioff:nx+ehalo+ioff,ny+1+joff:ny+nhalo+joff,:) = & + halo_data(nx+1+ioff:nx+ehalo+ioff, 1: ny+joff,:) = data_all(1+ioff:ehalo+ioff, ny+1:2*ny+joff,:,1) ! east + halo_data(1-whalo:0, 1:ny+joff,:) = data_all(nx-whalo+1:nx, 1:ny+joff,:,4) ! west + halo_data(1:nx+ioff, 1-shalo:0,:) = data_all(1:nx+ioff, ny-shalo+1:ny,:,3) ! south + halo_data(1:nx+ioff, ny+1+joff:ny+nhalo+joff,:) = data_all(1:nx+ioff, 1+joff:nhalo+joff,:,3) ! north + halo_data(nx+1+ioff:nx+ehalo+ioff, 1-shalo:0,:) = data_all(1+ioff:ehalo+ioff, ny-shalo+1:ny,:,1) ! southeast + halo_data(1-whalo:0, 1-shalo:0,:) = data_all(nx-whalo+1:nx, ny-shalo+1:ny,:,2) ! southwest + halo_data(nx+1+ioff:nx+ehalo+ioff,ny+1+joff:ny+nhalo+joff,:) = & & data_all(1+ioff:ehalo+ioff,1+joff:nhalo+joff,:,1) ! northeast - data(1-whalo:0, ny+1+joff:ny+nhalo+joff,:) = data_all(nx-whalo+1:nx, 1+joff:nhalo+joff,:,2) ! northwest + halo_data(1-whalo:0, ny+1+joff:ny+nhalo+joff,:) = data_all(nx-whalo+1:nx, 1+joff:nhalo+joff,:,2) ! northwest end select end subroutine fill_five_tile_halo @@ -5294,29 +5302,30 @@ subroutine test_get_boundary(type) end subroutine test_get_boundary !####################################################################################### - subroutine fill_regular_refinement_halo( data, data_all, ni, nj, tm, te, tse, ts, tsw, tw, tnw, tn, tne, ioff, joff ) - real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_regular_refinement_halo( halo_data, data_all, ni, nj, tm, te, tse, ts, & + tsw, tw, tnw, tn, tne, ioff, joff ) + real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data real, dimension(:,:,:,:), intent(in) :: data_all integer, dimension(:), intent(in) :: ni, nj integer, intent(in) :: tm, te, tse, ts, tsw, tw, tnw, tn, tne integer, intent(in) :: ioff, joff - if(te>0) data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1:nj(tm)+joff, :) = & + if(te>0) halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1:nj(tm)+joff, :) = & data_all(1+ioff:ehalo+ioff, 1:nj(te)+joff, :,te) ! east - if(ts>0) data (1:ni(tm)+ioff, 1-shalo:0, :) = & + if(ts>0) halo_data (1:ni(tm)+ioff, 1-shalo:0, :) = & data_all(1:ni(ts)+ioff, nj(ts)-shalo+1:nj(ts), :,ts) ! south - if(tw>0) data (1-whalo:0, 1:nj(tm)+joff, :) = & + if(tw>0) halo_data (1-whalo:0, 1:nj(tm)+joff, :) = & data_all(ni(tw)-whalo+1:ni(tw), 1:nj(tw)+joff, :,tw) ! west - if(tn>0) data (1:ni(tm)+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tn>0) halo_data (1:ni(tm)+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(1:ni(tn)+ioff, 1+joff:nhalo+joff, :,tn) ! north - if(tse>0)data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1-shalo:0, :) = & + if(tse>0)halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, 1-shalo:0, :) = & data_all(1+ioff:ehalo+ioff, nj(tse)-shalo+1:nj(tse), :,tse) ! southeast - if(tsw>0)data (1-whalo:0, 1-shalo:0, :) = & + if(tsw>0)halo_data (1-whalo:0, 1-shalo:0, :) = & data_all(ni(tsw)-whalo+1:ni(tsw), nj(tsw)-shalo+1:nj(tsw), :,tsw) ! southwest - if(tne>0)data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tne>0)halo_data (ni(tm)+1+ioff:ni(tm)+ehalo+ioff, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(1+ioff:ehalo+ioff, 1+joff:nhalo+joff, :,tnw) ! northeast - if(tnw>0)data (1-whalo:0, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & + if(tnw>0)halo_data (1-whalo:0, nj(tm)+1+joff:nj(tm)+nhalo+joff, :) = & data_all(ni(tnw)-whalo+1:ni(tnw), 1+joff:nhalo+joff, :,tne) ! northwest end subroutine fill_regular_refinement_halo @@ -5324,8 +5333,8 @@ end subroutine fill_regular_refinement_halo !############################################################################## ! this routine fill the halo points for the refined cubic grid. ioff and joff is used to distinguish ! T, C, E, or N-cell - subroutine fill_cubicgrid_refined_halo(data, data1_all, data2_all, ni, nj, tile, ioff, joff, sign1, sign2) - real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: data + subroutine fill_cubicgrid_refined_halo(halo_data, data1_all, data2_all, ni, nj, tile, ioff, joff, sign1, sign2) + real, dimension(1-whalo:,1-shalo:,:), intent(inout) :: halo_data real, dimension(:,:,:,:), intent(in) :: data1_all, data2_all integer, dimension(:), intent(in) :: ni, nj integer, intent(in) :: tile, ioff, joff, sign1, sign2 @@ -5337,20 +5346,20 @@ subroutine fill_cubicgrid_refined_halo(data, data1_all, data2_all, ni, nj, tile, if(ls < 1 ) ls = ls + 6 if(ln > 6 ) ln = ln - 6 if( nj(tile) == nj(lw) ) then - data(1-whalo:0, 1:nj(tile)+joff, :) = data1_all(ni(lw)-whalo+1:ni(lw), 1:nj(lw)+joff, :, lw) ! west + halo_data(1-whalo:0, 1:nj(tile)+joff, :) = data1_all(ni(lw)-whalo+1:ni(lw), 1:nj(lw)+joff, :, lw) ! west end if if( nj(tile) == ni(le) ) then do i = 1, ehalo - data(ni(tile)+i+ioff, 1:nj(tile)+joff, :) = sign1*data2_all(ni(le)+joff:1:-1, i+ioff, :, le) ! east + halo_data(ni(tile)+i+ioff, 1:nj(tile)+joff, :) = sign1*data2_all(ni(le)+joff:1:-1, i+ioff, :, le) ! east end do end if if(ni(tile) == nj(ls) ) then do i = 1, shalo - data(1:ni(tile)+ioff, 1-i, :) = sign2*data2_all(ni(ls)-i+1, nj(ls)+ioff:1:-1, :, ls) ! south + halo_data(1:ni(tile)+ioff, 1-i, :) = sign2*data2_all(ni(ls)-i+1, nj(ls)+ioff:1:-1, :, ls) ! south end do end if if(ni(tile) == ni(ln) ) then - data(1:ni(tile)+ioff, nj(tile)+1+joff:nj(tile)+nhalo+joff, :) = & + halo_data(1:ni(tile)+ioff, nj(tile)+1+joff:nj(tile)+nhalo+joff, :) = & & data1_all(1:ni(ln)+ioff, 1+joff:nhalo+joff, :, ln) ! north end if else ! tile 1, 3, 5 @@ -5360,34 +5369,34 @@ subroutine fill_cubicgrid_refined_halo(data, data1_all, data2_all, ni, nj, tile, if(ln > 6 ) ln = ln - 6 if(nj(tile) == ni(lw) ) then do i = 1, whalo - data(1-i, 1:nj(tile)+joff, :) = sign1*data2_all(ni(lw)+joff:1:-1, nj(lw)-i+1, :, lw) ! west + halo_data(1-i, 1:nj(tile)+joff, :) = sign1*data2_all(ni(lw)+joff:1:-1, nj(lw)-i+1, :, lw) ! west end do end if if(nj(tile) == nj(le) ) then - data(ni(tile)+1+ioff:ni(tile)+ehalo+ioff, 1:nj(tile)+joff, :) = & + halo_data(ni(tile)+1+ioff:ni(tile)+ehalo+ioff, 1:nj(tile)+joff, :) = & & data1_all(1+ioff:ehalo+ioff, 1:nj(le)+joff, :, le) ! east end if if(ni(tile) == ni(ls) ) then - data(1:ni(tile)+ioff, 1-shalo:0, :) = data1_all(1:ni(ls)+ioff, nj(ls)-shalo+1:nj(ls), :, ls) ! south + halo_data(1:ni(tile)+ioff, 1-shalo:0, :) = data1_all(1:ni(ls)+ioff, nj(ls)-shalo+1:nj(ls), :, ls) ! south end if if(ni(tile) == nj(ln) ) then do i = 1, nhalo - data(1:ni(tile)+ioff, nj(tile)+i+joff, :) = sign2*data2_all(i+joff, nj(ln)+ioff:1:-1, :, ln) ! north + halo_data(1:ni(tile)+ioff, nj(tile)+i+joff, :) = sign2*data2_all(i+joff, nj(ln)+ioff:1:-1, :, ln) ! north end do end if end if end subroutine fill_cubicgrid_refined_halo - subroutine set_corner_zero( data, isd, ied, jsd, jed, isc, iec, jsc, jec ) + subroutine set_corner_zero( corner_data, isd, ied, jsd, jed, isc, iec, jsc, jec ) integer, intent(in) :: isd, ied, jsd, jed integer, intent(in) :: isc, iec, jsc, jec - real, dimension(isd:,jsd:,:), intent(inout) :: data + real, dimension(isd:,jsd:,:), intent(inout) :: corner_data - data (isd :isc-1, jsd :jsc-1,:) = 0 - data (isd :isc-1, jec+1:jed, :) = 0 - data (iec+1:ied , jsd :jsc-1,:) = 0 - data (iec+1:ied , jec+1:jed, :) = 0 + corner_data (isd :isc-1, jsd :jsc-1,:) = 0 + corner_data (isd :isc-1, jec+1:jed, :) = 0 + corner_data (iec+1:ied , jsd :jsc-1,:) = 0 + corner_data (iec+1:ied , jec+1:jed, :) = 0 end subroutine set_corner_zero diff --git a/test_fms/mpp/test_mpp_gatscat.F90 b/test_fms/mpp/test_mpp_gatscat.F90 index d5709b91c7..5e5646487b 100644 --- a/test_fms/mpp/test_mpp_gatscat.F90 +++ b/test_fms/mpp/test_mpp_gatscat.F90 @@ -121,7 +121,7 @@ subroutine test_scatter_2D_R4(npes,pe,root,out_unit) integer :: pelist(npes) integer :: i,j,k - real(kind=r4_kind), allocatable, dimension(:,:) :: data !!Data to be scattered + real(kind=r4_kind), allocatable, dimension(:,:) :: scatter_data !!Data to be scattered real(kind=r4_kind), allocatable, dimension(:,:) :: segment integer :: DS, SS !!Source data size and segment size integer :: iz, jz !!The zeroth element to be scattered is at pos data(is+iz, js+jz) @@ -130,7 +130,7 @@ subroutine test_scatter_2D_R4(npes,pe,root,out_unit) DS = 7 !! DS should be less than 10 for the tests below to make sense. SS = 6 - allocate(data(DS, DS)) + allocate(scatter_data(DS, DS)) allocate(segment(SS, SS)) !!The full PE list [0, ...,npes-1] @@ -139,7 +139,7 @@ subroutine test_scatter_2D_R4(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1 + scatter_data = -1 segment = -2.0 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula @@ -147,7 +147,7 @@ subroutine test_scatter_2D_R4(npes,pe,root,out_unit) if (pe == root) then do i = 1,DS do j = 1,DS - data(i,j) = i*10 + j + scatter_data(i,j) = i*10 + j enddo enddo !! And re-initalize segment on the root pe. @@ -170,9 +170,9 @@ subroutine test_scatter_2D_R4(npes,pe,root,out_unit) js = 2 je = 3 if(pe .eq. root) then - call mpp_scatter(is, ie, js, je, pelist(1:npes-1), segment, data, .true., iz, jz) + call mpp_scatter(is, ie, js, je, pelist(1:npes-1), segment, scatter_data, .true., iz, jz) else - call mpp_scatter(is, ie, js, je, pelist(1:npes -1), segment, data, .false., iz, jz) + call mpp_scatter(is, ie, js, je, pelist(1:npes -1), segment, scatter_data, .false., iz, jz) endif call mpp_sync() ! @@ -227,7 +227,7 @@ subroutine test_scatter_2D_R8(npes,pe,root,out_unit) integer :: pelist(npes) integer :: i,j,k - real(kind=r8_kind), allocatable, dimension(:,:) :: data !!Data to be scattered + real(kind=r8_kind), allocatable, dimension(:,:) :: scatter_data !!Data to be scattered real(kind=r8_kind), allocatable, dimension(:,:) :: segment integer :: DS, SS !!Source data size and segment size integer :: iz, jz !!The zeroth element to be scattered is at pos data(is+iz, js+jz) @@ -237,7 +237,7 @@ subroutine test_scatter_2D_R8(npes,pe,root,out_unit) DS = 7 !! DS should be less than 10 for the tests below to make sense. SS = 6 - allocate(data(DS, DS)) + allocate(scatter_data(DS, DS)) allocate(segment(SS, SS)) !!The full PE list [0, ...,npes-1] @@ -246,7 +246,7 @@ subroutine test_scatter_2D_R8(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1 + scatter_data = -1 segment = -2.0 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula @@ -254,7 +254,7 @@ subroutine test_scatter_2D_R8(npes,pe,root,out_unit) if (pe == root) then do i = 1,DS do j = 1,DS - data(i,j) = i*10 + j + scatter_data(i,j) = i*10 + j enddo enddo !! And re-initalize segment on the root pe. @@ -277,9 +277,9 @@ subroutine test_scatter_2D_R8(npes,pe,root,out_unit) js = 2 je = 3 if(pe .eq. root) then - call mpp_scatter(is, ie, js, je, pelist(1:npes-1), segment, data, .true., iz, jz) + call mpp_scatter(is, ie, js, je, pelist(1:npes-1), segment, scatter_data, .true., iz, jz) else - call mpp_scatter(is, ie, js, je, pelist(1:npes -1), segment, data, .false., iz, jz) + call mpp_scatter(is, ie, js, je, pelist(1:npes -1), segment, scatter_data, .false., iz, jz) endif call mpp_sync() @@ -334,7 +334,7 @@ subroutine test_scatter_3D_R4(npes,pe,root,out_unit) integer :: pelist(npes) integer :: i,j,k - real(kind=r4_kind), allocatable, dimension(:,:,:) :: data !!Data to be scattered + real(kind=r4_kind), allocatable, dimension(:,:,:) :: scatter_data !!Data to be scattered real(kind=r4_kind), allocatable, dimension(:,:,:) :: segment integer :: DS, SS !!Source data size and segment size integer :: iz, jz !!The zeroth element to be scattered is at pos data(is+iz, js+jz) @@ -346,7 +346,7 @@ subroutine test_scatter_3D_R4(npes,pe,root,out_unit) NZ = 11 !! Depth of the square tube to be scattered. DS = 6 !! DS should be less than 10 for the tests below to make sense. SS = 5 !! Can be different that DS, but see retrictions. - allocate(data(DS, DS, NZ)) + allocate(scatter_data(DS, DS, NZ)) allocate(segment(SS, SS, NZ)) !!The full PE list is [0, ...,npes-1] @@ -355,7 +355,7 @@ subroutine test_scatter_3D_R4(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1 + scatter_data = -1 segment = -2.0 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula @@ -364,7 +364,7 @@ subroutine test_scatter_3D_R4(npes,pe,root,out_unit) do i = 1,DS do j = 1,DS do k = 1,NZ - data(i,j, k) = k*100 + j*10 + i + scatter_data(i,j, k) = k*100 + j*10 + i enddo enddo enddo @@ -372,7 +372,7 @@ subroutine test_scatter_3D_R4(npes,pe,root,out_unit) do i = 1,SS do j = 1,SS do k = 1,NZ - segment(i,j, k) = data(i,j, k) + segment(i,j, k) = scatter_data(i,j, k) enddo enddo enddo @@ -390,9 +390,9 @@ subroutine test_scatter_3D_R4(npes,pe,root,out_unit) js = 2 je = 3 if(pe .eq. root) then - call mpp_scatter(is, ie, js, je, NZ, pelist(1:npes-1), segment, data, .true., iz, jz) + call mpp_scatter(is, ie, js, je, NZ, pelist(1:npes-1), segment, scatter_data, .true., iz, jz) else - call mpp_scatter(is, ie, js, je, NZ, pelist(1:npes -1), segment, data, .false., iz, jz) + call mpp_scatter(is, ie, js, je, NZ, pelist(1:npes -1), segment, scatter_data, .false., iz, jz) endif call mpp_sync() @@ -464,7 +464,7 @@ subroutine test_scatter_3D_R8(npes,pe,root,out_unit) integer :: pelist(npes) integer :: i,j,k - real(kind=r8_kind), allocatable, dimension(:,:,:) :: data !!Data to be scattered + real(kind=r8_kind), allocatable, dimension(:,:,:) :: scatter_data !!Data to be scattered real(kind=r8_kind), allocatable, dimension(:,:,:) :: segment integer :: DS, SS !!Source data size and segment size integer :: iz, jz !!The zeroth element to be scattered is at pos data(is+iz, js+jz) @@ -476,7 +476,7 @@ subroutine test_scatter_3D_R8(npes,pe,root,out_unit) NZ = 11 !! Depth of the square tube to be scattered. DS = 6 !! DS should be less than 10 for the tests below to make sense. SS = 5 !! Can be different that DS, but see retrictions. - allocate(data(DS, DS, NZ)) + allocate(scatter_data(DS, DS, NZ)) allocate(segment(SS, SS, NZ)) !!The full PE list is [0, ...,npes-1] @@ -485,7 +485,7 @@ subroutine test_scatter_3D_R8(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1 + scatter_data = -1 segment = -2.0 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula @@ -494,7 +494,7 @@ subroutine test_scatter_3D_R8(npes,pe,root,out_unit) do i = 1,DS do j = 1,DS do k = 1,NZ - data(i,j, k) = k*100 + j*10 + i + scatter_data(i,j, k) = k*100 + j*10 + i enddo enddo enddo @@ -502,7 +502,7 @@ subroutine test_scatter_3D_R8(npes,pe,root,out_unit) do i = 1,SS do j = 1,SS do k = 1,NZ - segment(i,j, k) = data(i,j, k) + segment(i,j, k) = scatter_data(i,j, k) enddo enddo enddo @@ -520,9 +520,9 @@ subroutine test_scatter_3D_R8(npes,pe,root,out_unit) js = 2 je = 3 if(pe .eq. root) then - call mpp_scatter(is, ie, js, je, NZ, pelist(1:npes-1), segment, data, .true., iz, jz) + call mpp_scatter(is, ie, js, je, NZ, pelist(1:npes-1), segment, scatter_data, .true., iz, jz) else - call mpp_scatter(is, ie, js, je, NZ, pelist(1:npes -1), segment, data, .false., iz, jz) + call mpp_scatter(is, ie, js, je, NZ, pelist(1:npes -1), segment, scatter_data, .false., iz, jz) endif call mpp_sync() @@ -787,7 +787,7 @@ subroutine test_gather2DV(npes,pe,root,out_unit) integer :: pelist(npes),rsize(npes) integer :: pelist2(npes),rsize2(npes) integer :: i,j,k,l,nz,ssize,nelems - real,allocatable,dimension(:,:) :: data, cdata, sbuff,rbuff + real,allocatable,dimension(:,:) :: gather_data, cdata, sbuff,rbuff real,allocatable :: ref(:,:) integer, parameter :: KSIZE=10 @@ -805,9 +805,9 @@ subroutine test_gather2DV(npes,pe,root,out_unit) write(out_unit,*) ssize = pe+1 - allocate(data(ssize,KSIZE)) + allocate(gather_data(ssize,KSIZE)) do k=1,KSIZE; do i=1,ssize - data(i,k) = 10000.0*k + pe + 0.0001*i + gather_data(i,k) = 10000.0*k + pe + 0.0001*i enddo; enddo do i=1,npes pelist(i) = i-1 @@ -834,7 +834,7 @@ subroutine test_gather2DV(npes,pe,root,out_unit) ! and a clear, concise unpack do j=1,ssize do i=1,nz - sbuff(i,j) = data(j,i) + sbuff(i,j) = gather_data(j,i) enddo; enddo ! Note that the gatherV implied here is asymmetric; only root needs to know the vector of recv size @@ -892,7 +892,7 @@ subroutine test_gather2DV(npes,pe,root,out_unit) endif call mpp_sync() write(out_unit,*) "Test gather2DV with reversed pelist successful" - deallocate(data,sbuff,rbuff,cdata,ref) + deallocate(gather_data,sbuff,rbuff,cdata,ref) end subroutine test_gather2DV end program test_mpp_gatscat diff --git a/test_fms/mpp/test_mpp_sendrecv.F90 b/test_fms/mpp/test_mpp_sendrecv.F90 index 5f82683e14..c90b7bbfcc 100644 --- a/test_fms/mpp/test_mpp_sendrecv.F90 +++ b/test_fms/mpp/test_mpp_sendrecv.F90 @@ -119,11 +119,11 @@ subroutine test_sendrecv_2D_R4(npes,pe,root,out_unit) integer :: pelist(npes) integer :: i,j, p - real(kind=r4_kind), allocatable, dimension(:,:) :: data !!Data to be sendrecved + real(kind=r4_kind), allocatable, dimension(:,:) :: sendrecv_data !!Data to be sendrecved integer :: DS DS = 9 - allocate(data(DS, DS)) + allocate(sendrecv_data (DS, DS)) !!The full PE list [0, ...,npes-1] do i=0,npes-1 @@ -131,14 +131,14 @@ subroutine test_sendrecv_2D_R4(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1.0 + sendrecv_data = -1.0 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula !! using the indecies. E.g.. data(3,4) is 34.000, etc. if (pe == root) then do i = 1,DS do j = 1,DS - data(i,j) = i*10.0 + j*1.0 + sendrecv_data(i,j) = i*10.0 + j*1.0 enddo enddo endif @@ -147,10 +147,10 @@ subroutine test_sendrecv_2D_R4(npes,pe,root,out_unit) !! And receive from all other pes if ( pe == root ) then do p = 1,npes-1 - call mpp_send( data, DS* DS, p ) + call mpp_send( sendrecv_data, DS* DS, p ) end do else - call mpp_recv( data, DS * DS, 0 ) + call mpp_recv( sendrecv_data, DS * DS, 0 ) end if call mpp_sync() ! Needed ? @@ -159,7 +159,7 @@ subroutine test_sendrecv_2D_R4(npes,pe,root,out_unit) if(ANY(pe == pelist(1:npes-1))) then do j = 1, DS do i = 1, DS - if (data(i,j) /= ( i*10.0 + j*1.0)) then + if (sendrecv_data(i,j) /= ( i*10.0 + j*1.0)) then call mpp_error(FATAL, "Test sendrecv 2D R4 failed - basic copy area.") endif enddo @@ -177,11 +177,11 @@ subroutine test_sendrecv_2D_R8(npes,pe,root,out_unit) integer :: pelist(npes) integer :: i,j, p - real(kind=r8_kind), allocatable, dimension(:,:) :: data !!Data to be sendrecved + real(kind=r8_kind), allocatable, dimension(:,:) :: sendrecv_data !!Data to be sendrecved integer :: DS DS = 9 - allocate(data(DS, DS)) + allocate(sendrecv_data(DS, DS)) !!The full PE list [0, ...,npes-1] do i=0,npes-1 @@ -189,14 +189,14 @@ subroutine test_sendrecv_2D_R8(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1.0 + sendrecv_data = -1.0 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula !! using the indecies. E.g.. data(3,4) is 34.000, etc. if (pe == root) then do i = 1,DS do j = 1,DS - data(i,j) = i*10.0 + j*1.0 + sendrecv_data(i,j) = i*10.0 + j*1.0 enddo enddo endif @@ -205,10 +205,10 @@ subroutine test_sendrecv_2D_R8(npes,pe,root,out_unit) !! And receive from all other pes if ( pe == root ) then do p = 1,npes-1 - call mpp_send( data, DS* DS, p ) + call mpp_send( sendrecv_data, DS* DS, p ) end do else - call mpp_recv( data, DS * DS, 0 ) + call mpp_recv( sendrecv_data, DS * DS, 0 ) end if call mpp_sync() ! Needed ? @@ -218,7 +218,7 @@ subroutine test_sendrecv_2D_R8(npes,pe,root,out_unit) if(ANY(pe == pelist(1:npes-1))) then do j = 1, DS do i = 1, DS - if (data(i,j) /= ( i*10.0 + j*1.0)) then + if (sendrecv_data(i,j) /= ( i*10.0 + j*1.0)) then call mpp_error(FATAL, "Test sendrecv 2D R8 failed - basic copy area.") endif enddo @@ -236,7 +236,7 @@ subroutine test_sendrecv_3D_R4(npes,pe,root,out_unit) integer :: pelist(npes) integer :: i,j,k, p - real(kind=r4_kind), allocatable, dimension(:,:,:) :: data !!Data to be sendrecved + real(kind=r4_kind), allocatable, dimension(:,:,:) :: sendrecv_data !!Data to be sendrecved integer :: DS integer :: iz, jz !!The zeroth element to be sendrecved is at pos data(is+iz, js+jz) integer :: is, ie, js, je !!The amount of data to be sendrecved is (ie - is)*(je - js) @@ -245,7 +245,7 @@ subroutine test_sendrecv_3D_R4(npes,pe,root,out_unit) NZ = 9 !! Depth of the square tube to be sendrecved. DS = 8 !! DS should be less than 10 for the tests below to make sense. - allocate(data(DS, DS, NZ)) + allocate(sendrecv_data(DS, DS, NZ)) !!The full PE list is [0, ...,npes-1] do i=0,npes-1 @@ -253,7 +253,7 @@ subroutine test_sendrecv_3D_R4(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1.0 + sendrecv_data = -1.0 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula !! using the indecies. E.g.. data(3,4,5) is 543.000, etc. @@ -261,7 +261,7 @@ subroutine test_sendrecv_3D_R4(npes,pe,root,out_unit) do i = 1,DS do j = 1,DS do k = 1,NZ - data(i,j, k) = k*100.0 + j*10.0 + i*1.0 + sendrecv_data(i,j, k) = k*100.0 + j*10.0 + i*1.0 enddo enddo enddo @@ -272,10 +272,10 @@ subroutine test_sendrecv_3D_R4(npes,pe,root,out_unit) !! And receive from all other pes if ( pe == root ) then do p = 1,npes-1 - call mpp_send( data, DS* DS* NZ, p ) + call mpp_send( sendrecv_data, DS* DS* NZ, p ) end do else - call mpp_recv( data, DS * DS * NZ, 0 ) + call mpp_recv( sendrecv_data, DS * DS * NZ, 0 ) end if call mpp_sync() ! Needed ? @@ -286,7 +286,7 @@ subroutine test_sendrecv_3D_R4(npes,pe,root,out_unit) do k = 1, NZ do j = 1, DS do i = 1, DS - if (data(i,j, k) /= ( k*100.0 + j*10.0 + i*1.0 )) then + if (sendrecv_data(i,j, k) /= ( k*100.0 + j*10.0 + i*1.0 )) then call mpp_error(FATAL, "Test sendrecv 3D R4 failed - basic copy area.") endif enddo @@ -307,7 +307,7 @@ subroutine test_sendrecv_3D_R8(npes,pe,root,out_unit) integer :: pelist(npes) integer :: i,j,k, p - real(kind=r8_kind), allocatable, dimension(:,:,:) :: data !!Data to be sendrecved + real(kind=r8_kind), allocatable, dimension(:,:,:) :: sendrecv_data !!Data to be sendrecved integer :: DS integer :: iz, jz !!The zeroth element to be sendrecved is at pos data(is+iz, js+jz) integer :: is, ie, js, je !!The amount of data to be sendrecved is (ie - is)*(je - js) @@ -316,7 +316,7 @@ subroutine test_sendrecv_3D_R8(npes,pe,root,out_unit) NZ = 9 !! Depth of the square tube to be sendrecved. DS = 8 !! DS should be less than 10 for the tests below to make sense. - allocate(data(DS, DS, NZ)) + allocate(sendrecv_data(DS, DS, NZ)) !!The full PE list is [0, ...,npes-1] do i=0,npes-1 @@ -324,7 +324,7 @@ subroutine test_sendrecv_3D_R8(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1.0 + sendrecv_data = -1.0 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula !! using the indecies. E.g.. data(3,4,5) is 543.000, etc. @@ -332,7 +332,7 @@ subroutine test_sendrecv_3D_R8(npes,pe,root,out_unit) do i = 1,DS do j = 1,DS do k = 1,NZ - data(i,j, k) = k*100.0 + j*10.0 + i*1.0 + sendrecv_data(i,j, k) = k*100.0 + j*10.0 + i*1.0 enddo enddo enddo @@ -343,10 +343,10 @@ subroutine test_sendrecv_3D_R8(npes,pe,root,out_unit) !! And receive from all other pes if ( pe == root ) then do p = 1,npes-1 - call mpp_send( data, DS* DS* NZ, p ) + call mpp_send( sendrecv_data, DS* DS* NZ, p ) end do else - call mpp_recv( data, DS * DS * NZ, 0 ) + call mpp_recv( sendrecv_data, DS * DS * NZ, 0 ) end if call mpp_sync() ! Needed ? @@ -357,7 +357,7 @@ subroutine test_sendrecv_3D_R8(npes,pe,root,out_unit) do k = 1, NZ do j = 1, DS do i = 1, DS - if (data(i,j, k) /= ( k*100.0 + j*10.0 + i*1.0 )) then + if (sendrecv_data(i,j, k) /= ( k*100.0 + j*10.0 + i*1.0 )) then call mpp_error(FATAL, "Test sendrecv 3D R8 failed - basic copy area.") endif enddo @@ -377,11 +377,11 @@ subroutine test_sendrecv_2D_I4(npes,pe,root,out_unit) integer :: pelist(npes) integer(kind=i4_kind) :: i,j - integer(kind=i4_kind), allocatable, dimension(:,:) :: data !!Data to be sendrecved + integer(kind=i4_kind), allocatable, dimension(:,:) :: sendrecv_data !!Data to be sendrecved integer :: DS, p DS = 9 - allocate(data(DS, DS)) + allocate(sendrecv_data(DS, DS)) !!The full PE list [0, ...,npes-1] do i=0,npes-1 @@ -389,14 +389,14 @@ subroutine test_sendrecv_2D_I4(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1 + sendrecv_data = -1 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula !! using the indecies. E.g.. data(3,4) is 34.000, etc. if (pe == root) then do i = 1,DS do j = 1,DS - data(i,j) = i*10 + j + sendrecv_data(i,j) = i*10 + j enddo enddo endif @@ -405,10 +405,10 @@ subroutine test_sendrecv_2D_I4(npes,pe,root,out_unit) !! And receive from all other pes if ( pe == root ) then do p = 1,npes-1 - call mpp_send( data, DS* DS, p ) + call mpp_send( sendrecv_data, DS* DS, p ) end do else - call mpp_recv( data, DS * DS, 0 ) + call mpp_recv( sendrecv_data, DS * DS, 0 ) end if call mpp_sync() ! Needed ? @@ -417,7 +417,7 @@ subroutine test_sendrecv_2D_I4(npes,pe,root,out_unit) if(ANY(pe == pelist(1:npes-1))) then do j = 1, DS do i = 1, DS - if (data(i,j) /= ( i * 10 + j )) then + if (sendrecv_data(i,j) /= ( i * 10 + j )) then call mpp_error(FATAL, "Test sendrecv 2D I4 failed - basic copy area.") endif enddo @@ -435,11 +435,11 @@ subroutine test_sendrecv_2D_I8(npes,pe,root,out_unit) integer :: pelist(npes) integer(kind=i8_kind) :: i,j - integer(kind=i8_kind), allocatable, dimension(:,:) :: data !!Data to be sendrecved + integer(kind=i8_kind), allocatable, dimension(:,:) :: sendrecv_data !!Data to be sendrecved integer :: DS, p DS = 9 - allocate(data(DS, DS)) + allocate(sendrecv_data(DS, DS)) !!The full PE list [0, ...,npes-1] do i=0,npes-1 @@ -447,14 +447,14 @@ subroutine test_sendrecv_2D_I8(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1 + sendrecv_data = -1 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula !! using the indecies. E.g.. data(3,4) is 34.000, etc. if (pe == root) then do i = 1,DS do j = 1,DS - data(i,j) = i*10 + j + sendrecv_data(i,j) = i*10 + j enddo enddo endif @@ -463,10 +463,10 @@ subroutine test_sendrecv_2D_I8(npes,pe,root,out_unit) !! And receive from all other pes if ( pe == root ) then do p = 1,npes-1 - call mpp_send( data, DS* DS, p ) + call mpp_send( sendrecv_data, DS* DS, p ) end do else - call mpp_recv( data, DS * DS, 0 ) + call mpp_recv( sendrecv_data, DS * DS, 0 ) end if call mpp_sync() ! Needed ? @@ -475,7 +475,7 @@ subroutine test_sendrecv_2D_I8(npes,pe,root,out_unit) if(ANY(pe == pelist(1:npes-1))) then do j = 1, DS do i = 1, DS - if (data(i,j) /= ( i * 10 + j )) then + if (sendrecv_data(i,j) /= ( i * 10 + j )) then call mpp_error(FATAL, "Test sendrecv 2D I8 failed - basic copy area.") endif enddo @@ -493,7 +493,7 @@ subroutine test_sendrecv_3D_I4(npes,pe,root,out_unit) integer :: pelist(npes) integer(kind=i4_kind) :: i,j,k - integer(kind=i4_kind), allocatable, dimension(:,:,:) :: data !!Data to be sendrecved + integer(kind=i4_kind), allocatable, dimension(:,:,:) :: sendrecv_data !!Data to be sendrecved integer :: DS integer :: iz, jz !!The zeroth element to be sendrecved is at pos data(is+iz, js+jz) integer :: is, ie, js, je !!The amount of data to be sendrecved is (ie - is)*(je - js) @@ -502,7 +502,7 @@ subroutine test_sendrecv_3D_I4(npes,pe,root,out_unit) NZ = 9 !! Depth of the square tube to be sendrecved. DS = 8 !! DS should be less than 10 for the tests below to make sense. - allocate(data(DS, DS, NZ)) + allocate(sendrecv_data(DS, DS, NZ)) !!The full PE list is [0, ...,npes-1] do i=0,npes-1 @@ -510,7 +510,7 @@ subroutine test_sendrecv_3D_I4(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1 + sendrecv_data = -1 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula !! using the indecies. E.g.. data(3,4,5) is 543.000, etc. @@ -518,7 +518,7 @@ subroutine test_sendrecv_3D_I4(npes,pe,root,out_unit) do i = 1,DS do j = 1,DS do k = 1,NZ - data(i,j, k) = k*100 + j*10 + i + sendrecv_data(i,j, k) = k*100 + j*10 + i enddo enddo enddo @@ -529,10 +529,10 @@ subroutine test_sendrecv_3D_I4(npes,pe,root,out_unit) !! And receive from all other pes if ( pe == root ) then do p = 1,npes-1 - call mpp_send( data, DS* DS* NZ, p ) + call mpp_send( sendrecv_data, DS* DS* NZ, p ) end do else - call mpp_recv( data, DS * DS * NZ, 0 ) + call mpp_recv( sendrecv_data, DS * DS * NZ, 0 ) end if call mpp_sync() ! Needed ? @@ -543,7 +543,7 @@ subroutine test_sendrecv_3D_I4(npes,pe,root,out_unit) do k = 1, NZ do j = 1, DS do i = 1, DS - if (data(i,j, k) /= ( k * 100 + j*10 + i )) then + if (sendrecv_data(i,j, k) /= ( k * 100 + j*10 + i )) then call mpp_error(FATAL, "Test sendrecv 3D I4 failed - basic copy area.") endif enddo @@ -563,7 +563,7 @@ subroutine test_sendrecv_3D_I8(npes,pe,root,out_unit) integer :: pelist(npes) integer(kind=i8_kind) :: i,j,k - integer(kind=i8_kind), allocatable, dimension(:,:,:) :: data !!Data to be sendrecved + integer(kind=i8_kind), allocatable, dimension(:,:,:) :: sendrecv_data !!Data to be sendrecved integer :: DS integer :: iz, jz !!The zeroth element to be sendrecved is at pos data(is+iz, js+jz) integer :: is, ie, js, je !!The amount of data to be sendrecved is (ie - is)*(je - js) @@ -572,7 +572,7 @@ subroutine test_sendrecv_3D_I8(npes,pe,root,out_unit) NZ = 9 !! Depth of the square tube to be sendrecved. DS = 8 !! DS should be less than 10 for the tests below to make sense. - allocate(data(DS, DS, NZ)) + allocate(sendrecv_data(DS, DS, NZ)) !!The full PE list is [0, ...,npes-1] do i=0,npes-1 @@ -580,7 +580,7 @@ subroutine test_sendrecv_3D_I8(npes,pe,root,out_unit) enddo !!Initialize all data on all PEs - data = -1 + sendrecv_data = -1 !! Re-initialize data on the root PE only. !! Data is such that we can calculate what it should be with a Formula !! using the indecies. E.g.. data(3,4,5) is 543.000, etc. @@ -588,7 +588,7 @@ subroutine test_sendrecv_3D_I8(npes,pe,root,out_unit) do i = 1,DS do j = 1,DS do k = 1,NZ - data(i,j, k) = k*100 + j*10 + i + sendrecv_data(i,j, k) = k*100 + j*10 + i enddo enddo enddo @@ -599,10 +599,10 @@ subroutine test_sendrecv_3D_I8(npes,pe,root,out_unit) !! And receive from all other pes if ( pe == root ) then do p = 1,npes-1 - call mpp_send( data, DS* DS* NZ, p ) + call mpp_send( sendrecv_data, DS* DS* NZ, p ) end do else - call mpp_recv( data, DS * DS * NZ, 0 ) + call mpp_recv( sendrecv_data, DS * DS * NZ, 0 ) end if call mpp_sync() ! Needed ? @@ -613,7 +613,7 @@ subroutine test_sendrecv_3D_I8(npes,pe,root,out_unit) do k = 1, NZ do j = 1, DS do i = 1, DS - if (data(i,j, k) /= ( k * 100 + j*10 + i )) then + if (sendrecv_data(i,j, k) /= ( k * 100 + j*10 + i )) then call mpp_error(FATAL, "Test sendrecv 3D I8 failed - basic copy area.") endif enddo