Skip to content

Commit 2b1f3b2

Browse files
authored
Merge pull request #179 from BerkeleyLab/locality-specifiers
refac(laplacian): add locality specifiers
2 parents 136c163 + 073aae1 commit 2b1f3b2

1 file changed

Lines changed: 46 additions & 26 deletions

File tree

src/matcha/subdomain_s.F90

Lines changed: 46 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -82,46 +82,66 @@
8282
end procedure
8383

8484
module procedure laplacian
85-
86-
integer i, j, k
85+
integer i, j, k;
8786
real, allocatable :: halo_west(:,:), halo_east(:,:)
8887

8988
call_assert(allocated(rhs%s_))
9089
call_assert(allocated(halo_x))
9190

9291
allocate(laplacian_rhs%s_(my_nx, ny, nz))
93-
9492
halo_west = merge(halo_x(west,:,:), rhs%s_(1,:,:), me/=1)
9593
i = my_internal_west
9694
call_assert_describe(i+1<=my_nx, "laplacian: westernmost subdomain too small")
97-
do concurrent(j=2:ny-1, k=2:nz-1)
98-
laplacian_rhs%s_(i,j,k) = ( halo_west(j,k ) - 2*rhs%s_(i,j,k) + rhs%s_(i+1,j ,k ))/dx_**2 + &
99-
(rhs%s_(i,j-1,k ) - 2*rhs%s_(i,j,k) + rhs%s_(i ,j+1,k ))/dy_**2 + &
100-
(rhs%s_(i,j ,k-1) - 2*rhs%s_(i,j,k) + rhs%s_(i ,j ,k+1))/dz_**2
101-
end do
102-
103-
do concurrent(i=my_internal_west+1:my_internal_east-1, j=2:ny-1, k=2:nz-1)
104-
laplacian_rhs%s_(i,j,k) = (rhs%s_(i-1,j ,k ) - 2*rhs%s_(i,j,k) + rhs%s_(i+1,j ,k ))/dx_**2 + &
105-
(rhs%s_(i ,j-1,k ) - 2*rhs%s_(i,j,k) + rhs%s_(i ,j+1,k ))/dy_**2 + &
106-
(rhs%s_(i ,j ,k-1) - 2*rhs%s_(i,j,k) + rhs%s_(i ,j ,k+1))/dz_**2
107-
end do
95+
96+
associate( laplacian_phi => laplacian_rhs%s_, inbox => halo_west, phi=>rhs%s_)
97+
#if HAVE_2018_LOCALITY_SPECIFIERS
98+
do concurrent(j=2:ny-1, k=2:nz-1) &
99+
default(none) shared(laplacian_phi, inbox, phi, dx_, dy_, dz_, i)
100+
#else
101+
do concurrent(j=2:ny-1, k=2:nz-1)
102+
#endif
103+
laplacian_phi(i,j,k) = (inbox(j,k ) - 2*phi(i,j,k) + phi(i+1,j ,k ))/dx_**2 + &
104+
(phi(i,j-1,k ) - 2*phi(i,j,k) + phi(i ,j+1,k ))/dy_**2 + &
105+
(phi(i,j ,k-1) - 2*phi(i,j,k) + phi(i ,j ,k+1))/dz_**2
106+
end do
107+
end associate
108+
109+
associate(laplacian_phi => laplacian_rhs%s_, phi=>rhs%s_)
110+
#if HAVE_2018_LOCALITY_SPECIFIERS
111+
do concurrent(i=my_internal_west+1:my_internal_east-1, j=2:ny-1, k=2:nz-1) &
112+
default(none) shared(laplacian_phi, phi, dx_, dy_, dz_)
113+
#else
114+
do concurrent(i=my_internal_west+1:my_internal_east-1, j=2:ny-1, k=2:nz-1)
115+
#endif
116+
laplacian_phi(i,j,k) = (phi(i-1,j ,k ) - 2*phi(i,j,k) + phi(i+1,j ,k ))/dx_**2 + &
117+
(phi(i ,j-1,k ) - 2*phi(i,j,k) + phi(i ,j+1,k ))/dy_**2 + &
118+
(phi(i ,j ,k-1) - 2*phi(i,j,k) + phi(i ,j ,k+1))/dz_**2
119+
end do
120+
end associate
108121

109122
halo_east = merge(halo_x(east,:,:), rhs%s_(my_nx,:,:), me/=num_subdomains)
110123
i = my_internal_east
111124
call_assert_describe(i-1>0, "laplacian: easternmost subdomain too small")
112-
do concurrent(j=2:ny-1, k=2:nz-1)
113-
laplacian_rhs%s_(i,j,k) = (rhs%s_(i-1,j ,k ) - 2*rhs%s_(i,j,k) + halo_east(j ,k ))/dx_**2 + &
114-
(rhs%s_(i ,j-1,k ) - 2*rhs%s_(i,j,k) + rhs%s_(i ,j+1,k ))/dy_**2 + &
115-
(rhs%s_(i ,j ,k-1) - 2*rhs%s_(i,j,k) + rhs%s_(i ,j ,k+1))/dz_**2
116-
end do
117-
118-
laplacian_rhs%s_(:, 1,:) = 0.
119-
laplacian_rhs%s_(:,ny,:) = 0.
120-
laplacian_rhs%s_(:,:, 1) = 0.
121-
laplacian_rhs%s_(:,:,nz) = 0.
122-
if (me==1) laplacian_rhs%s_(1,:,:) = 0.
123-
if (me==num_subdomains) laplacian_rhs%s_(my_nx,:,:) = 0.
124125

126+
associate(laplacian_phi => laplacian_rhs%s_, inbox => halo_east, phi=>rhs%s_)
127+
#if HAVE_2018_LOCALITY_SPECIFIERS
128+
do concurrent(j=2:ny-1, k=2:nz-1) &
129+
default(none) shared(laplacian_phi, inbox, phi, dx_, dy_, dz_, i)
130+
#else
131+
do concurrent(j=2:ny-1, k=2:nz-1)
132+
#endif
133+
laplacian_phi(i,j,k) = (phi(i-1,j ,k ) - 2*phi(i,j,k) + inbox( j ,k ))/dx_**2 + &
134+
(phi(i ,j-1,k ) - 2*phi(i,j,k) + phi(i ,j+1,k ))/dy_**2 + &
135+
(phi(i ,j ,k-1) - 2*phi(i,j,k) + phi(i ,j ,k+1))/dz_**2
136+
end do
137+
end associate
138+
139+
laplacian_rhs%s_(:, 1,:) = 0. ! y-direction low boundary
140+
laplacian_rhs%s_(:,ny,:) = 0. ! y-direction high boundary
141+
laplacian_rhs%s_(:,:, 1) = 0. ! z-direction low boundary
142+
laplacian_rhs%s_(:,:,nz) = 0. ! z-direction high boundary
143+
if (me==1) laplacian_rhs%s_(1,:,:) = 0. ! x-direction low boundary
144+
if (me==num_subdomains) laplacian_rhs%s_(my_nx,:,:) = 0. ! x-direction high boundary
125145
end procedure
126146

127147
module procedure multiply

0 commit comments

Comments
 (0)