From 01b48e736e40d3f2cc3bf8224d31f5221c0a6242 Mon Sep 17 00:00:00 2001
From: ESCOBAR Juan <escj@nuwa.aerologie.net>
Date: Wed, 30 Oct 2013 11:11:11 +0100
Subject: [PATCH] Juan 301/10/2013: convert from PgiAcc/region to
OpenAcc/kernels directive & test some loop vector(24) sheduling
---
MNH/ppm.f90 | 194 +++++++++++++++++++++++++++-------------------------
1 file changed, 102 insertions(+), 92 deletions(-)
diff --git a/MNH/ppm.f90 b/MNH/ppm.f90
index 6c8e4bd35..81cab3b7e 100644
--- a/MNH/ppm.f90
+++ b/MNH/ppm.f90
@@ -219,10 +219,7 @@ USE MODD_PARAMETERS, ONLY : JPHEXT
USE MODE_MNH_ZWORK, ONLY : &
& IIB,IIE, IIU,IJU,IKU , IJS,IJN, &
& GWEST,GEAST, &
-& ZQL=>ZW3D1,ZQR=>ZW3D2,ZDQ=>ZW3D3,ZQ6=>ZW3D4,ZDMQ=>ZW3D5 , &
-& ZQL0=>ZW3D6,ZQR0=>ZW3D7,ZQ60=>ZW3D8 , &
-& ZFPOS=>ZW3D9,ZFNEG=>ZW3D10
-
+& ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG
!
IMPLICIT NONE
!
@@ -300,22 +297,33 @@ CALL GET_HALO_D(PSRC,HDIR="01_X")
!
#define JUAN_ACC_01_X
#ifdef JUAN_ACC_01_X
-!$acc region
+!$acc kernels
#endif
-DO K=1,IKU ; DO J = 1,IJU ; DO I=1,IIU
-PR(I,J,K)=PSRC(I,J,K)
-ZQL(I,J,K)=PSRC(I,J,K)
-ZQR(I,J,K)=PSRC(I,J,K)
-ZDQ(I,J,K)=PSRC(I,J,K)
-ZQ6(I,J,K)=PSRC(I,J,K)
-ZDMQ(I,J,K)=PSRC(I,J,K)
-ZQL0(I,J,K)=PSRC(I,J,K)
-ZQR0(I,J,K)=PSRC(I,J,K)
-ZQ60(I,J,K)=PSRC(I,J,K)
-ZFPOS(I,J,K)=PSRC(I,J,K)
-ZFNEG(I,J,K)=PSRC(I,J,K)
-ENDDO ; ENDDO ; ENDDO
-! acc end region
+!!$DO K=1,IKU ; DO J = 1,IJU ; DO I=1,IIU
+!!$PR(I,J,K)=PSRC(I,J,K)
+!!$ZQL(I,J,K)=PSRC(I,J,K)
+!!$ZQR(I,J,K)=PSRC(I,J,K)
+!!$ZDQ(I,J,K)=PSRC(I,J,K)
+!!$ZQ6(I,J,K)=PSRC(I,J,K)
+!!$ZDMQ(I,J,K)=PSRC(I,J,K)
+!!$ZQL0(I,J,K)=PSRC(I,J,K)
+!!$ZQR0(I,J,K)=PSRC(I,J,K)
+!!$ZQ60(I,J,K)=PSRC(I,J,K)
+!!$ZFPOS(I,J,K)=PSRC(I,J,K)
+!!$ZFNEG(I,J,K)=PSRC(I,J,K)
+!!$ENDDO ; ENDDO ; ENDDO
+PR=PSRC
+ZQL=PSRC
+ZQR=PSRC
+ZDQ=PSRC
+ZQ6=PSRC
+ZDMQ=PSRC
+ZQL0=PSRC
+ZQR0=PSRC
+ZQ60=PSRC
+ZFPOS=PSRC
+ZFNEG=PSRC
+! acc end kernels
!
!-------------------------------------------------------------------------------
!
@@ -438,9 +446,9 @@ ENDDO ; ENDDO ; ENDDO
! calculate dmq
!
!! ZDMQ = DIF2X(PSRC)
- ! acc region
+ ! acc kernels
dif2x(ZDMQ,PSRC)
- ! acc end region
+ ! acc end kernels
!
! overwrite the values on the boundary to get second order difference
! for qL and qR at the boundary
@@ -448,17 +456,17 @@ ENDDO ; ENDDO ; ENDDO
! WEST BOUND
!
IF (GWEST) THEN
- ! acc region
+ ! acc kernels
ZDMQ(IIB-1,IJS:IJN,:) = -ZDMQ(IIB,IJS:IJN,:)
- ! acc end region
+ ! acc end kernels
ENDIF
!
! EAST BOUND
!
IF (GEAST) THEN
- ! acc region
+ ! acc kernels
ZDMQ(IIE+1,IJS:IJN,:) = -ZDMQ(IIE,IJS:IJN,:)
- ! acc end region
+ ! acc end kernels
ENDIF
!
! monotonize the difference followinq eq. 5 in Lin94
@@ -482,10 +490,10 @@ ENDDO ; ENDDO ; ENDDO
!
#define TEMPO_JUAN
#ifdef TEMPO_JUAN
-!$acc end region
+!$acc end kernels
CALL GET_HALO_D(ZDMQ,HDIR="01_X")
CALL MPPDB_CHECK3DM("PPM::PPM_01_X OPEN ::ZDMQ",PRECISION,ZDMQ)
-!$acc region
+!$acc kernels
#endif
!
! calculate qL and qR
@@ -498,37 +506,39 @@ CALL MPPDB_CHECK3DM("PPM::PPM_01_X OPEN ::ZDMQ",PRECISION,ZDMQ)
!
#ifdef TEMPO_JUAN
-!$acc end region
+!$acc end kernels
CALL GET_HALO_D(ZQL0,HDIR="01_X")
-!$acc region
+!$acc kernels
#endif
!
! WEST BOUND
!
- ! acc region
+ ! acc kernels
IF (GWEST) THEN
- ! acc region
+ ! acc kernels
ZQL0(IIB-1,IJS:IJN,:) = ZQL0(IIB,IJS:IJN,:)
- ! acc end region
+ ! acc end kernels
ENDIF
!
ZQR0(IIB-1:IIE,IJS:IJN,:) = ZQL0(IIB:IIE+1,IJS:IJN,:)
!
#ifdef TEMPO_JUAN
-!$acc end region
+!$acc end kernels
CALL GET_HALO_D(ZQR0,HDIR="01_X")
-!$acc region
+!$acc kernels
#endif
!
! EAST BOUND
!
IF (GEAST) THEN
- ! acc region
+ ! acc kernels
ZQR0(IIE+1,IJS:IJN,:) = ZQR0(IIE,IJS:IJN,:)
- ! acc end region
+ ! acc end kernels
ENDIF
-
-DO K=1,IKU ; DO J = 1,IJU ; DO I=1,IIU
+DO K=1,IKU
+ DO J = 1,IJU
+ !$acc loop vector(24)
+ DO I=1,IIU
!
! determine initial coefficients of the parabolae
!
@@ -572,9 +582,9 @@ ENDDO ; ENDDO ; ENDDO
* ZQ6(IIB-1:IIE,IJS:IJN,:))
!
#ifdef TEMPO_JUAN
-!$acc end region
+!$acc end kernels
CALL GET_HALO_D(ZFPOS,HDIR="01_X")
-!$acc region
+!$acc kernels
#endif
!
!
@@ -583,10 +593,10 @@ CALL GET_HALO_D(ZFPOS,HDIR="01_X")
! advection flux at open boundary when u(IIB) > 0
!
IF (GWEST) THEN
- ! acc region
+ ! acc kernels
ZFPOS(IIB,IJS:IJN,:) = (PSRC(IIB-1,IJS:IJN,:) - ZQR(IIB-1,IJS:IJN,:))*PCR(IIB,IJS:IJN,:) + &
ZQR(IIB-1,IJS:IJN,:)
- ! acc end region
+ ! acc end kernels
! PPOSX(IIB-1,:,:) is not important for the calc of advection so
! we set it to 0
ENDIF
@@ -595,24 +605,24 @@ CALL GET_HALO_D(ZFPOS,HDIR="01_X")
( ZDQ(:,IJS:IJN,:) + (1.0 + 2.0*PCR(:,IJS:IJN,:)/3.0) * ZQ6(:,IJS:IJN,:) )
!
#ifdef TEMPO_JUAN
-!$acc end region
+!$acc end kernels
CALL GET_HALO_D(ZFNEG,HDIR="01_X")
-!$acc region
+!$acc kernels
#endif
!
! EAST BOUND
!
! advection flux at open boundary when u(IIE+1) < 0
IF (GEAST) THEN
- ! acc region
+ ! acc kernels
ZFNEG(IIE+1,IJS:IJN,:) = (ZQR(IIE,IJS:IJN,:)-PSRC(IIE+1,IJS:IJN,:))*PCR(IIE+1,IJS:IJN,:) + &
ZQR(IIE,IJS:IJN,:)
- ! acc end region
+ ! acc end kernels
ENDIF
!
! advect the actual field in X direction by U*dt
!
- ! acc region
+ ! acc kernels
mxm(ZQL,PRHO)
ZQR = PCR* ZQL*( ZFPOS*(0.5+SIGN(0.5,PCR)) + ZFNEG*(0.5-SIGN(0.5,PCR)) )
dxf(PR,ZQR)
@@ -621,7 +631,7 @@ CALL GET_HALO_D(ZFNEG,HDIR="01_X")
!!$ ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
#ifdef JUAN_ACC_01_X
-!$acc end region
+!$acc end kernels
#endif
CALL GET_HALO_D(PR,HDIR="01_X")
@@ -820,7 +830,7 @@ ZQR0=PSRC
ZQ60=PSRC
ZFPOS=PSRC
ZFNEG=PSRC
-! acc end region
+! acc end kernels
!
!!$SELECT CASE ( HLBCY(1) ) ! Y direction LBC type: (1) for left side
!!$!
@@ -929,9 +939,9 @@ ZFNEG=PSRC
!
! calculate dmq
!! ZDMQ = DIF2Y(PSRC)
- !#acc region
+ !#acc kernels
dif2y(ZDMQ,PSRC)
- !#acc end region
+ !#acc end kernels
! overwrite the values on the boundary to get second order difference
! for qL and qR at the boundary
@@ -940,30 +950,30 @@ ZFNEG=PSRC
!
!!$ IF (LSOUTH_ll()) THEN
IF (GSOUTH) THEN
- !#acc region
+ !#acc kernels
ZDMQ(IIW:IIA,IJB-1,:) = -ZDMQ(IIW:IIA,IJB,:)
- !#acc end region
+ !#acc end kernels
ENDIF
!
! NORTH BOUND
!
IF (GNORTH) THEN
- !#acc region
+ !#acc kernels
ZDMQ(IIW:IIA,IJE+1,:) = -ZDMQ(IIW:IIA,IJE,:)
- !#acc end region
+ !#acc end kernels
ENDIF
!
! monotonize the difference followinq eq. 5 in Lin94
- !#acc region
+ !#acc kernels
ZDMQ(IIW:IIA,IJB:IJE,:) = &
SIGN( (MIN( ABS(ZDMQ(IIW:IIA,IJB:IJE,:)),2.0*(PSRC(IIW:IIA,IJB:IJE,:) - &
MIN(PSRC(IIW:IIA,IJB-1:IJE-1,:),PSRC(IIW:IIA,IJB:IJE,:),PSRC(IIW:IIA,IJB+1:IJE+1,:))), &
2.0*(MAX(PSRC(IIW:IIA,IJB-1:IJE-1,:),PSRC(IIW:IIA,IJB:IJE,:),PSRC(IIW:IIA,IJB+1:IJE+1,:)) - &
PSRC(IIW:IIA,IJB:IJE,:)) )), ZDMQ(IIW:IIA,IJB:IJE,:) )
- !#acc end region
+ !#acc end kernels
-!!$ !#acc region
+!!$ !#acc kernels
!!$ DO K=1,IKU ; DO J=IJB,IJE
!!$ !#acc do independent
!!$ DO I=IIW,IIA ; ZDMQ(I,J,K) = SIGN( (MIN( ABS(ZDMQ(I,J,K)),2.0*(PSRC(I,J,K) - &
@@ -971,7 +981,7 @@ ZFNEG=PSRC
!!$ 2.0*(MAX(PSRC(I,J-1,K),PSRC(I,J,K),PSRC(I,J+1,K)) - &
!!$ PSRC(I,J,K)) )), ZDMQ(I,J,K) )
!!$ ENDDO ; ENDDO ; ENDDO
-!!$ !#acc end region
+!!$ !#acc end kernels
!
! update ZDMQ HALO before next/further utilisation
@@ -984,17 +994,17 @@ CALL GET_HALO_D(ZDMQ,HDIR="01_Y")
!
! calculate qL and qR with the modified dmq
!
- !#acc region
+ !#acc kernels
ZQL0(IIW:IIA,IJB:IJE+1,:) = 0.5*(PSRC(IIW:IIA,IJB:IJE+1,:) + PSRC(IIW:IIA,IJB-1:IJE,:)) - &
(ZDMQ(IIW:IIA,IJB:IJE+1,:) - ZDMQ(IIW:IIA,IJB-1:IJE,:))/6.0
- !#acc end region
+ !#acc end kernels
-!!$ !#acc region
+!!$ !#acc kernels
!!$ DO K=1,IKU ; DO J=IJB,IJE+1
!!$ !#acc do independent
!!$ DO I=IIW,IIA ; ZQL0(I,J,K) = 0.5*(PSRC(I,J,K) + PSRC(I,J-1,K)) - (ZDMQ(I,J,K) - ZDMQ(I,J-1,K))/6.0
!!$ ENDDO ; ENDDO ; ENDDO
-!!$ !#acc end region
+!!$ !#acc end kernels
!
#ifdef TEMPO_JUAN
!$acc end kernels
@@ -1006,33 +1016,33 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y")
!
!!$ IF (LSOUTH_ll()) THEN
IF (GSOUTH) THEN
- !#acc region
+ !#acc kernels
ZQL0(IIW:IIA,IJB-1,:) = ZQL0(IIW:IIA,IJB,:)
- !#acc end region
+ !#acc end kernels
ENDIF
!
- !#acc region
+ !#acc kernels
ZQR0(IIW:IIA,IJB-1:IJE,:) = ZQL0(IIW:IIA,IJB:IJE+1,:)
- !#acc end region
+ !#acc end kernels
-!!$ !#acc region
+!!$ !#acc kernels
!!$ DO K=1,IKU ; DO J=IJB-1,IJE
!!$ !#acc do independent
!!$ DO I=IIW,IIA ; ZQR0(I,J,K) = ZQL0(I,J+1,K)
!!$ ENDDO ; ENDDO ; ENDDO
-!!$ !#acc end region
+!!$ !#acc end kernels
!
! NORTH BOUND
!
IF (GNORTH) THEN
- !#acc region
+ !#acc kernels
ZQR0(IIW:IIA,IJE+1,:) = ZQR0(IIW:IIA,IJE,:)
- !#acc end region
+ !#acc end kernels
ENDIF
!
! determine initial coefficients of the parabolae
!
- !#acc region
+ !#acc kernels
ZDQ = ZQR0 - ZQL0
ZQ60 = 6.0*(PSRC - 0.5*(ZQL0 + ZQR0))
!
@@ -1041,11 +1051,11 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y")
ZQL = ZQL0
ZQR = ZQR0
ZQ6 = ZQ60
- !#acc end region
+ !#acc end kernels
!
! eliminate over and undershoots and create qL and qR as in Lin96
!
- ! acc region
+ ! acc kernels
WHERE ( ZDMQ == 0.0 )
ZQL = PSRC
ZQR = PSRC
@@ -1061,30 +1071,30 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y")
ZQL = ZQR0 - ZQ6
ZQR = ZQR0
END WHERE
- ! acc end region
+ ! acc end kernels
!
! recalculate coefficients of the parabolae
!
- !#acc region
+ !#acc kernels
ZDQ = ZQR - ZQL
- !#acc end region
+ !#acc end kernels
!
! and finally calculate fluxes for the advection
- !#acc region
+ !#acc kernels
ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZQR(IIW:IIA,IJB-1:IJE,:) - 0.5*PCR(IIW:IIA,IJB:IJE+1,:) * &
(ZDQ(IIW:IIA,IJB-1:IJE,:) - (1.0 - 2.0*PCR(IIW:IIA,IJB:IJE+1,:)/3.0) &
* ZQ6(IIW:IIA,IJB-1:IJE,:))
- !#acc end region
+ !#acc end kernels
-!!$ !#acc region
+!!$ !#acc kernels
!!$ DO K=1,IKU ; DO J=IJB,IJE+1
!!$ !#acc do independent
!!$ DO I=IIW,IIA ; ZFPOS(I,J,K) = ZQR(I,J-1,K) - 0.5*PCR(I,J,K) * &
!!$ (ZDQ(I,J-1,K) - (1.0 - 2.0*PCR(I,J,K)/3.0) &
!!$ * ZQ6(I,J-1,K))
!!$ ENDDO ; ENDDO ; ENDDO
-!!$ !#acc end region
+!!$ !#acc end kernels
!
#ifdef TEMPO_JUAN
!$acc end kernels
@@ -1099,26 +1109,26 @@ CALL GET_HALO_D(ZFPOS,HDIR="01_Y")
!
!!$ IF (LSOUTH_ll()) THEN
IF (GSOUTH) THEN
- !#acc region
+ !#acc kernels
ZFPOS(IIW:IIA,IJB,:) = (PSRC(IIW:IIA,IJB-1,:) - ZQR(IIW:IIA,IJB-1,:))*PCR(IIW:IIA,IJB,:) + &
ZQR(IIW:IIA,IJB-1,:)
- !#acc end region
+ !#acc end kernels
ENDIF
!
! PPOSX(:,IJB-1,:) is not important for the calc of advection so
! we set it to 0
- !#acc region
+ !#acc kernels
ZFNEG(IIW:IIA,:,:) = ZQL(IIW:IIA,:,:) - 0.5*PCR(IIW:IIA,:,:) * &
( ZDQ(IIW:IIA,:,:) + (1.0 + 2.0*PCR(IIW:IIA,:,:)/3.0) * ZQ6(IIW:IIA,:,:) )
- !#acc end region
+ !#acc end kernels
-!!$ !#acc region
+!!$ !#acc kernels
!!$ DO K=1,IKU ; DO J=1,IJU
!!$ !#acc do independent
!!$ DO I=IIW,IIA ; ZFNEG(I,J,K) = ZQL(I,J,K) - 0.5*PCR(I,J,K) * &
!!$ ( ZDQ(I,J,K) + (1.0 + 2.0*PCR(I,J,K)/3.0) * ZQ6(I,J,K) )
!!$ ENDDO ; ENDDO ; ENDDO
-!!$ !#acc end region
+!!$ !#acc end kernels
!
#ifdef TEMPO_JUAN
!$acc end kernels
@@ -1131,19 +1141,19 @@ CALL GET_HALO_D(ZFPOS,HDIR="01_Y")
! NORTH BOUND
!
IF (GNORTH) THEN
- !#acc region
+ !#acc kernels
ZFNEG(IIW:IIA,IJE+1,:) = (ZQR(IIW:IIA,IJE,:)-PSRC(IIW:IIA,IJE+1,:))*PCR(IIW:IIA,IJE+1,:) + &
ZQR(IIW:IIA,IJE,:)
- !#acc end region
+ !#acc end kernels
ENDIF
!!$!
!!$! advect the actual field in X direction by U*dt
!!$!
- !#acc region
+ !#acc kernels
mym(ZQL,PRHO)
ZQR = PCR* ZQL*( ZFPOS*(0.5+SIGN(0.5,PCR)) + ZFNEG*(0.5-SIGN(0.5,PCR)) )
dyf(PR,ZQR)
- !#acc end region
+ !#acc end kernels
!!$ PR = ZDMQ + ZQL0 + ZDQ + ZQ60 + ZQL + ZQR + ZQ6 + ZQR0 + ZFPOS + ZFNEG
@@ -1940,7 +1950,7 @@ ZPHAT=PSRC
ZFPOS=PSRC
ZFNEG=PSRC
PR=PSRC
-! acc end region
+! acc end kernels
! acc end data region
!
!-------------------------------------------------------------------------------
--
GitLab