From dd822867c652c38c6656479a41de32a1e03a7f42 Mon Sep 17 00:00:00 2001
From: Juan Escobar <escj@aero.obs-mip.fr>
Date: Fri, 14 Sep 2012 17:26:14 +0200
Subject: [PATCH] Juan 14/09/2012: acc ppm_s0_z & some optimization by commun
dimension declaration
---
MNH/ppm.f90 | 58 ++++++++++++++++++++++++++++++++++++-----------------
1 file changed, 40 insertions(+), 18 deletions(-)
diff --git a/MNH/ppm.f90 b/MNH/ppm.f90
index f293b5b1d..3e4ebc41e 100644
--- a/MNH/ppm.f90
+++ b/MNH/ppm.f90
@@ -1288,7 +1288,7 @@ IKU=size(psrc,3)
#define JUAN_ACC_01_Z
#ifdef JUAN_ACC_01_Z
-!$acc data region local (ZDMQ,ZQL0,ZQR0,ZDQ,ZQ60,ZQL,ZQR,ZQ6,ZFPOS,ZFNEG) copyin (psrc,pcr,prho) copyout(pr)
+!$acc data region local (ZDMQ,ZQL0,ZQR0,ZDQ,ZQ60,ZQL,ZQR,ZQ6,ZFPOS,ZFNEG) copyin (psrc,pcr,prho) copyout(pr)
!$acc region
#endif
!
@@ -1309,6 +1309,8 @@ ZDMQ(:,:,IKB:IKE) = &
MIN(PSRC(:,:,IKB-1:IKE-1),PSRC(:,:,IKB:IKE),PSRC(:,:,IKB+1:IKE+1))), &
2.0*(MAX(PSRC(:,:,IKB-1:IKE-1),PSRC(:,:,IKB:IKE),PSRC(:,:,IKB+1:IKE+1)) - &
PSRC(:,:,IKB:IKE)) )), ZDMQ(:,:,IKB:IKE) )
+!!$ZDMQ(:,:,IKB-1) = ZDMQ(:,:,IKB)
+!!$ZDMQ(:,:,IKE+1) = ZDMQ(:,:,IKE)
ZDMQ(:,:,IKB-1) = &
SIGN( (MIN( ABS(ZDMQ(:,:,IKB-1)), 2.0*(PSRC(:,:,IKB-1) - &
MIN(PSRC(:,:,IKE-1),PSRC(:,:,IKB-1),PSRC(:,:,IKB))), &
@@ -1796,7 +1798,7 @@ USE MODI_GET_HALO
!
USE MODD_LUNIT
USE MODD_CONF
-!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
USE MODD_PARAMETERS, ONLY : JPHEXT
USE MODE_MPPDB
!
@@ -1815,18 +1817,20 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
+REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR &
!
!* 0.2 Declarations of local variables :
!
-INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
-INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-!
! advection fluxes
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
+ , ZFPOS, ZFNEG &
!
! variable at cell edges
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
+ , ZPHAT &
+!
+ , ZRHO_MYM , ZCR_MYM , ZCR_DYF
+!
+INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER:: IIE,IJE ! End useful area in x,y,z directions
!
!BEG JUAN PPM_LL
TYPE(HALO2LIST_ll), POINTER :: TZ_PSRC_HALO2_ll ! halo2 for PSRC
@@ -1834,7 +1838,6 @@ INTEGER :: ILUOUT,IRESP ! for prints
INTEGER :: IIW,IIA
!END JUAN PPM_LL
!JUAN ACC
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZRHO_MYM , ZCR_MYM , ZCR_DYF
INTEGER :: I,J,K ,IIU,IJU,IKU
LOGICAL :: GSOUTH , GNORTH
!
@@ -2098,18 +2101,20 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
+REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR &
!
!* 0.2 Declarations of local variables :
!
-INTEGER:: IKB ! Begining useful area in x,y,z directions
-INTEGER:: IKE ! End useful area in x,y,z directions
-!
! advection fluxes
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
+ , ZFPOS, ZFNEG &
!
! interpolated variable at cell edges
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
+ , ZPHAT &
+ , ZRHO_MZM ,ZCR_MZM,ZCR_DZF
+!
+INTEGER:: IKB ! Begining useful area in x,y,z directions
+INTEGER:: IKE ! End useful area in x,y,z directions
+INTEGER:: IKU
!
!-------------------------------------------------------------------------------
!
@@ -2119,12 +2124,20 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
IKB = 1 + JPVEXT
IKE = SIZE(PSRC,3) - JPVEXT
!
+IKU=size(psrc,3)
+!
!-------------------------------------------------------------------------------
!
! calculate 4th order fluxes at cell edges in the inner domain
!
CALL GET_HALO(PSRC)
!
+#define JUAN_ACC_S0_Z
+#ifdef JUAN_ACC_S0_Z
+!$acc data region local(ZPHAT,ZFPOS,ZFNEG,ZRHO_MZM,ZCR_MZM,ZCR_DZF) copyin (psrc,pcr,prho) copyout(pr)
+!$acc region
+#endif
+!
ZPHAT(:,:,IKB+1:IKE) = (7.0 * &
(PSRC(:,:,IKB+1:IKE) + PSRC(:,:,IKB:IKE-1)) - &
(PSRC(:,:,IKB+2:IKE+1) + PSRC(:,:,IKB-1:IKE-2))) / 12.0
@@ -2171,14 +2184,23 @@ ZFNEG(:,:,IKE+1) = (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE+1))*PCR(:,:,IKE+1) + &
!
! calculate the advection
!
-PR = PSRC * PRHO - &
- DZF( PCR*MZM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
- ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
+ mzm(ZRHO_MZM,PRHO)
+ ZCR_MZM = PCR* ZRHO_MZM*( ZFPOS*(0.5+SIGN(0.5,PCR)) + ZFNEG*(0.5-SIGN(0.5,PCR)) )
+ dzf(ZCR_DZF,ZCR_MZM)
+ PR = PSRC * PRHO - ZCR_DZF
+!!$PR = PSRC * PRHO - &
+!!$ DZF( PCR*MZM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
+!!$ ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
!
! in OPEN case fix boundary conditions
!
PR(:,:,IKB-1) = PR(:,:,IKB)
PR(:,:,IKE+1) = PR(:,:,IKE)
+!
+#ifdef JUAN_ACC_S0_Z
+!$acc end region
+!$acc end data region
+#endif
!
CALL GET_HALO(PR) ! JUAN
CALL MPPDB_CHECK3DM("PPM::PPM_S0_Z ::PR",PRECISION,PR)
--
GitLab