|
82 | 82 | end procedure |
83 | 83 |
|
84 | 84 | module procedure laplacian |
85 | | - |
86 | | - integer i, j, k |
| 85 | + integer i, j, k; |
87 | 86 | real, allocatable :: halo_west(:,:), halo_east(:,:) |
88 | 87 |
|
89 | 88 | call_assert(allocated(rhs%s_)) |
90 | 89 | call_assert(allocated(halo_x)) |
91 | 90 |
|
92 | 91 | allocate(laplacian_rhs%s_(my_nx, ny, nz)) |
93 | | - |
94 | 92 | halo_west = merge(halo_x(west,:,:), rhs%s_(1,:,:), me/=1) |
95 | 93 | i = my_internal_west |
96 | 94 | 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 |
108 | 121 |
|
109 | 122 | halo_east = merge(halo_x(east,:,:), rhs%s_(my_nx,:,:), me/=num_subdomains) |
110 | 123 | i = my_internal_east |
111 | 124 | 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. |
124 | 125 |
|
| 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 |
125 | 145 | end procedure |
126 | 146 |
|
127 | 147 | module procedure multiply |
|
0 commit comments