From a306b1684d5b80020b99e9c151a3a17362db8d2d Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Mon, 11 Jun 2018 10:08:48 +0200
Subject: [PATCH] Juan 11/06/2018: rewrite some loops for OpenACC in PPM_01_Z
---
src/MNH/ppm.f90 | 99 +++++++++++++++++++++++++++++++++++++++----------
1 file changed, 79 insertions(+), 20 deletions(-)
diff --git a/src/MNH/ppm.f90 b/src/MNH/ppm.f90
index 7e5b0d26d..591a141a8 100644
--- a/src/MNH/ppm.f90
+++ b/src/MNH/ppm.f90
@@ -1838,6 +1838,7 @@ ZQR0(:,:,IKE+1) = ZQR0(:,:,IKB)
!
ZDQ = ZQR0 - ZQL0
ZQ60 = 6.0*(PSRC - 0.5*(ZQL0 + ZQR0))
+#ifndef _OPENACC
!
! initialize final parabolae parameters
!
@@ -1847,7 +1848,6 @@ ZQ6 = ZQ60
!
! eliminate over and undershoots and create qL and qR as in Lin96
!
-#ifndef _OPENACC
WHERE ( ZDMQ == 0.0 )
ZQL = PSRC
ZQR = PSRC
@@ -1857,34 +1857,93 @@ ELSEWHERE ( ZQ60*ZDQ < -(ZDQ)**2 )
ZQR = ZQL0 - ZQ6
ZQL = ZQL0
ELSEWHERE ( ZQ60*ZDQ > (ZDQ)**2 )
- ZQ6 = 3.0*(ZQR0 - PSRC)
- ZQL = ZQR0 - ZQ6
- ZQR = ZQR0
-END WHERE
#else
-!PW: BUG: done like that because if using PGI (tested up to 16.10)
-! will cause crashes at run (address not mapped)
-! and problems at compilation
-WHERE ( ZDMQ == 0.0 )
- ZQL = PSRC
- ZQR = PSRC
- ZQ6 = 0.0
-END WHERE
-WHERE ( ( ZDMQ /= 0.0 ) .AND. ( ZQ60*ZDQ < -(ZDQ)**2 ) )
- ZQ6 = 3.0*(ZQL0 - PSRC)
- ZQR = ZQL0 - ZQ6
- ZQL = ZQL0
-END WHERE
-WHERE ( ( ZDMQ /= 0.0 ) .AND. ( ZQ60*ZDQ > (ZDQ)**2 ) )
ZQ6 = 3.0*(ZQR0 - PSRC)
ZQL = ZQR0 - ZQ6
ZQR = ZQR0
END WHERE
-#endif
!
! recalculate coefficients of the parabolae
!
ZDQ = ZQR - ZQL
+#else
+!!!
+!!! initialize final parabolae parameters
+!!!
+!!ZQL = ZQL0
+!!ZQR = ZQR0
+!!ZQ6 = ZQ60
+!!!
+!!! eliminate over and undershoots and create qL and qR as in Lin96
+!!!
+!!!PW: BUG: done like that because if using PGI (tested up to 16.10)
+!!! will cause crashes at run (address not mapped)
+!!! and problems at compilation
+!!$WHERE ( ZDMQ == 0.0 )
+!!$ ZQL = PSRC
+!!$ ZQR = PSRC
+!!$ ZQ6 = 0.0
+!!$END WHERE
+!!$WHERE ( ( ZDMQ /= 0.0 ) .AND. ( ZQ60*ZDQ < -ZDQ**2 ) )
+!!$WHERE ( ( ZDMQ /= 0.0 ) .AND. ( ZQ60*ZDQ < -BR_P2(ZDQ) ) )
+!!$ ZQ6 = 3.0*(ZQL0 - PSRC)
+!!$ ZQR = ZQL0 - ZQ6
+!!$ ZQL = ZQL0
+!!$END WHERE
+!!$WHERE ( ( ZDMQ /= 0.0 ) .AND. ( ZQ60*ZDQ > ZDQ**2 ) )
+!!$WHERE ( ( ZDMQ /= 0.0 ) .AND. ( ZQ60*ZDQ > BR_P2(ZDQ) ) )
+!!$ ZQ6 = 3.0*(ZQR0 - PSRC)
+!!$ ZQL = ZQR0 - ZQ6
+!!$ ZQR = ZQR0
+!!$END WHERE
+!!!
+!!! recalculate coefficients of the parabolae
+!!!
+!!ZDQ = ZQR - ZQL
+ !$acc loop gang vector
+ DO K=1,IKU
+ !$acc loop gang vector
+ DO J=1,IJU
+ !$acc loop gang vector
+ DO I=1,IIU
+ !
+ ! determine initial coefficients of the parabolae
+ !
+ ZDQ(I,J,K) = ZQR0(I,J,K) - ZQL0(I,J,K)
+ ZQ60(I,J,K) = 6.0*(PSRC(I,J,K) - 0.5*(ZQL0(I,J,K) + ZQR0(I,J,K)))
+ !
+ ! initialize final parabolae parameters
+ !
+ ZQL(I,J,K) = ZQL0(I,J,K)
+ ZQR(I,J,K) = ZQR0(I,J,K)
+ ZQ6(I,J,K) = ZQ60(I,J,K)
+ !
+ ! eliminate over and undershoots and create qL and qR as in Lin96
+ !
+ IF ( ZDMQ(I,J,K) == 0.0 ) THEN
+ ZQL(I,J,K) = PSRC(I,J,K)
+ ZQR(I,J,K) = PSRC(I,J,K)
+ ZQ6(I,J,K) = 0.0
+ END IF
+ IF ( ( ZDMQ(I,J,K) /= 0.0 ) .AND. ( ZQ60(I,J,K)*ZDQ(I,J,K) < -ZDQ(I,J,K)**2 ) ) THEN
+ ZQ6(I,J,K) = 3.0*(ZQL0(I,J,K) - PSRC(I,J,K))
+ ZQR(I,J,K) = ZQL0(I,J,K) - ZQ6(I,J,K)
+ ZQL(I,J,K) = ZQL0(I,J,K)
+ END IF
+ IF ( ( ZDMQ(I,J,K) /= 0.0 ) .AND. ( ZQ60(I,J,K)*ZDQ(I,J,K) > ZDQ(I,J,K)**2 ) ) THEN
+ ZQ6(I,J,K) = 3.0*(ZQR0(I,J,K) - PSRC(I,J,K))
+ ZQL(I,J,K) = ZQR0(I,J,K) - ZQ6(I,J,K)
+ ZQR(I,J,K) = ZQR0(I,J,K)
+ END IF
+ !
+ ! recalculate coefficients of the parabolae
+ !
+ ZDQ(I,J,K) = ZQR(I,J,K) - ZQL(I,J,K)
+ !
+ END DO
+ END DO
+ END DO
+#endif
!
! and finally calculate fluxes for the advection
!
--
GitLab