From 980a66cf9bf8975c89938c5645cef06494af0649 Mon Sep 17 00:00:00 2001
From: Wautelet Philippe <waup@aeropc45.aero.obs-mip.fr>
Date: Tue, 12 Oct 2021 15:06:05 +0200
Subject: [PATCH] Philippe 12/10/2021: OpenACC: Sources_neg_correct: replace
where by do concurrent (workaround for nvhpc bug)
---
src/MNH/sources_neg_correct.f90 | 73 +++++++++++++++++----------------
1 file changed, 38 insertions(+), 35 deletions(-)
diff --git a/src/MNH/sources_neg_correct.f90 b/src/MNH/sources_neg_correct.f90
index 4339cbaf3..de994c8ab 100644
--- a/src/MNH/sources_neg_correct.f90
+++ b/src/MNH/sources_neg_correct.f90
@@ -243,17 +243,18 @@ CLOUD: select case ( hcloud )
else
jrmax = Size( prrs, 4 )
end if
- do jr = 4, jrmax
!$acc kernels
-!PW: kernels directive inside do loop on jr because compiler bug... (NVHPC 21.7)
- where ( prrs(:, :, :, jr) < 0.)
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, jr) = 0.
- end where
-!$acc end kernels
+ do jr = 4, jrmax
+ do concurrent( ji = 1 : jiu, jj = 1 : jju, jk = 1 : jku )
+ if ( prrs(ji, jj, jk, jr) < 0. ) then
+ prrs(ji, jj, jk, 1) = prrs(ji, jj, jk, 1) + prrs(ji, jj, jk, jr)
+ prths(ji, jj, jk) = prths(ji, jj, jk) - prrs(ji, jj, jk, jr) * zls(ji, jj, jk) / &
+ ( zcph(ji, jj, jk) * zexn(ji, jj, jk) )
+ prrs(ji, jj, jk, jr) = 0.
+ end if
+ end do
end do
+!$acc end kernels
!
! cloud
if ( hbudname == 'NETUR' ) then
@@ -261,40 +262,42 @@ CLOUD: select case ( hcloud )
else
jrmax = 3
end if
- do jr = 2, jrmax
!$acc kernels
-!PW: kernels directive inside do loop on jr because compiler bug... (NVHPC 21.7)
- where ( prrs(:, :, :, jr) < 0.)
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, jr) = 0.
- end where
-!$acc end kernels
+ do jr = 2, jrmax
+ do concurrent( ji = 1 : jiu, jj = 1 : jju, jk = 1 : jku )
+ if ( prrs(ji, jj, jk, jr) < 0. ) then
+ prrs(ji, jj, jk, 1) = prrs(ji, jj, jk, 1) + prrs(ji, jj, jk, jr)
+ prths(ji, jj, jk) = prths(ji, jj, jk) - prrs(ji, jj, jk, jr) * zlv(ji, jj, jk) / &
+ ( zcph(ji, jj, jk) * zexn(ji, jj, jk) )
+ prrs(ji, jj, jk, jr) = 0.
+ end if
+ end do
end do
!
! if rc or ri are positive, we can correct negative rv
! cloud
-!$acc kernels
- where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 2) = 0.
- end where
-!$acc end kernels
+ do concurrent( ji = 1 : jiu, jj = 1 : jju, jk = 1 : jku )
+ if ( prrs(ji, jj, jk, 1) < 0. .and. prrs(ji, jj, jk, 2) > 0. ) then
+ prrs(ji, jj, jk, 1) = prrs(ji, jj, jk, 1) + prrs(ji, jj, jk, 2)
+ prths(ji, jj, jk) = prths(ji, jj, jk) - prrs(ji, jj, jk, 2) * zlv(ji, jj, jk) / &
+ ( zcph(ji, jj, jk) * zexn(ji, jj, jk) )
+ prrs(ji, jj, jk, 2) = 0.
+ end if
+ end do
! ice
if ( krr > 3 ) then
-!$acc kernels
- where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
- zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
- prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
- end where
-!$acc end kernels
+!$acc loop independent collapse(3)
+ do concurrent( ji = 1 : jiu, jj = 1 : jju, jk = 1 : jku )
+ if ( prrs(ji, jj, jk, 1) < 0. .and. prrs(ji, jj, jk, 4) > 0. ) then
+ zcor(ji, jj, jk) = Min( -prrs(ji, jj, jk, 1), prrs(ji, jj, jk, 4) )
+ prrs(ji, jj, jk, 1) = prrs(ji, jj, jk, 1) + zcor(ji, jj, jk)
+ prths(ji, jj, jk) = prths(ji, jj, jk) - zcor(ji, jj, jk) * zls(ji, jj, jk) / &
+ ( zcph(ji, jj, jk) * zexn(ji, jj, jk) )
+ prrs(ji, jj, jk, 4) = prrs(ji, jj, jk, 4) - zcor(ji, jj, jk)
+ end if
+ end do
end if
+!$acc end kernels
!
!
case( 'C2R2', 'KHKO' )
--
GitLab