From 332cb7029ce866eee6f449093192c907eb315a5d Mon Sep 17 00:00:00 2001
From: Juan Escobar <escj@aero.obs-mip.fr>
Date: Fri, 22 Mar 2013 15:02:57 +0100
Subject: [PATCH] Juan 22/03/2013: add MODD_PPM_01 to save
allocation/deallocation in use acc MIRROR
---
MNH/ppm.f90 | 99 ++++++++++++++++++++++++++++++++++++++++-------------
1 file changed, 76 insertions(+), 23 deletions(-)
diff --git a/MNH/ppm.f90 b/MNH/ppm.f90
index b60c58072..60b687959 100644
--- a/MNH/ppm.f90
+++ b/MNH/ppm.f90
@@ -178,6 +178,32 @@ END MODULE MODI_PPM
!
!
!-------------------------------------------------------------------------------
+MODULE MODD_PPM_01
+INTEGER, SAVE :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER, SAVE :: IIE,IJE ! End useful area in x,y,z directions
+!
+! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
+REAL, SAVE, ALLOCATABLE , DIMENSION(:,:,:) :: &
+ ZQL,ZQR, ZDQ,ZQ6, ZDMQ &
+!
+! extra variables for the initial guess of parabolae parameters
+ , ZQL0,ZQR0,ZQ60 &
+!
+! advection fluxes
+ , ZFPOS, ZFNEG
+#define ACC_MIRROR
+#ifdef ACC_MIRROR
+!$acc declare mirror (ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
+#endif
+!
+!BEG JUAN PPM_LL
+INTEGER,SAVE :: IJS,IJN
+!END JUAN PPM_LL
+!JUAN ACC
+INTEGER, SAVE :: IIU,IJU,IKU
+LOGICAL, SAVE :: GWEST , GEAST
+LOGICAL, SAVE :: GFIRST_CALL_PPM_01_X = .TRUE.
+END MODULE MODD_PPM_01
!-------------------------------------------------------------------------------
! ########################################################################
!!$ FUNCTION PPM_01_X(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP) &
@@ -207,6 +233,7 @@ USE MODD_LUNIT
!END JUAN PPM_LL
USE MODE_MPPDB
USE MODD_PARAMETERS, ONLY : JPHEXT
+USE MODD_PPM_01
!
IMPLICIT NONE
!
@@ -227,26 +254,31 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: 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
-!
-! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: &
- ZQL,ZQR, ZDQ,ZQ6, ZDMQ &
-!
-! extra variables for the initial guess of parabolae parameters
- , ZQL0,ZQR0,ZQ60 &
+INTEGER :: ILUOUT,IRESP ! for prints
+INTEGER :: I,J,K
!
-! advection fluxes
- , ZFPOS, ZFNEG
+!!$INTEGER, SAVE :: IIB,IJB ! Begining useful area in x,y,z directions
+!!$INTEGER, SAVE :: IIE,IJE ! End useful area in x,y,z directions
+!!$!
+!!$! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
+!!$REAL, SAVE, ALLOCATABLE , DIMENSION(:,:,:) :: &
+!!$ ZQL,ZQR, ZDQ,ZQ6, ZDMQ &
+!!$!
+!!$! extra variables for the initial guess of parabolae parameters
+!!$ , ZQL0,ZQR0,ZQ60 &
+!!$!
+!!$! advection fluxes
+!!$ , ZFPOS, ZFNEG
+!!$!$acc declare mirror (ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
+!!$!
+!!$!BEG JUAN PPM_LL
+!!$INTEGER,SAVE :: IJS,IJN
+!!$!END JUAN PPM_LL
+!!$!JUAN ACC
+!!$INTEGER, SAVE :: IIU,IJU,IKU
+!!$LOGICAL, SAVE :: GWEST , GEAST
+!!$LOGICAL, SAVE :: GFIRST_CALL_PPM_01_X = .TRUE.
!
-!BEG JUAN PPM_LL
-INTEGER :: ILUOUT,IRESP ! for prints
-INTEGER :: IJS,IJN
-!END JUAN PPM_LL
-!JUAN ACC
-INTEGER :: I,J,K ,IIU,IJU,IKU
-LOGICAL :: GWEST , GEAST
! inline shuman with macro
#define dif2x(DQ,PQ) DQ(IIB:IIE,:,:)=0.5*(PQ(IIB+1:IIE+1,:,:)-PQ(IIB-1:IIE-1,:,:));\
DQ(IIB-1,:,:)=0.5*(PQ(IIB,:,:)-PQ(IIE-1,:,:));\
@@ -259,6 +291,10 @@ DQ(IIE+1,:,:)=0.5*(PQ(IIB+1,:,:)-PQ(IIE,:,:)) ! DIF2X(DQ,PQ)
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
+
+IF (GFIRST_CALL_PPM_01_X) THEN
+GFIRST_CALL_PPM_01_X = .FALSE.
+
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IJS=IJB
IJN=IJE
@@ -270,6 +306,18 @@ IKU=size(psrc,3)
GWEST = LWEST_ll()
GEAST = LEAST_ll()
+ALLOCATE (ZQL(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)))
+ALLOCATE (ZQR(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)))
+ALLOCATE (ZDQ(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)))
+ALLOCATE (ZQ6(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)))
+ALLOCATE (ZDMQ(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)))
+ALLOCATE (ZQL0(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)))
+ALLOCATE (ZQR0(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)))
+ALLOCATE (ZQ60(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)))
+ALLOCATE (ZFPOS(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)))
+ALLOCATE (ZFNEG(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)))
+
+END IF
!
!BEG JUAN PPM_LL
!
@@ -289,10 +337,12 @@ CALL GET_HALO_D(PSRC,HDIR="01_X")
!
#define JUAN_ACC_01_X
#ifdef JUAN_ACC_01_X
+#ifndef ACC_MIRROR
!$acc data region local (ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
+#endif
!$acc region
#endif
- DO K=1,IKU ; DO J = 1,IJU ; DO I=1,IIU
+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)
@@ -612,7 +662,9 @@ CALL GET_HALO_D(ZFNEG,HDIR="01_X")
#ifdef JUAN_ACC_01_X
!$acc end region
+#ifndef ACC_MIRROR
!$acc end data region
+#endif
#endif
CALL GET_HALO_D(PR,HDIR="01_X")
@@ -677,6 +729,7 @@ CALL GET_HALO_D(ZFNEG,HDIR="01_X")
!!$END FUNCTION DIF2X
!
!!$END FUNCTION PPM_01_X
+
END SUBROUTINE PPM_01_X
!
!
@@ -1583,8 +1636,8 @@ ZPSRC_HALO2_WEST(:,:) = TZ_PSRC_HALO2_ll%HALO2%WEST(:,:)
!
#define JUAN_ACC_S0_X
#ifdef JUAN_ACC_S0_X
-!$acc data region local (ZPHAT,ZFPOS,ZFNEG,ZRHO_MXM,ZCR_MXM,ZCR_DXF) copyin (psrc,pcr,prho,ZPSRC_HALO2_WEST) copyout(pr)
-!$acc region
+!$acc data pcreate (ZPHAT,ZFPOS,ZFNEG,ZRHO_MXM,ZCR_MXM,ZCR_DXF) pcopyin (psrc,pcr,prho,ZPSRC_HALO2_WEST) pcopyout(pr)
+!$acc kernels
#endif
!
ZPHAT=PSRC
@@ -1763,8 +1816,8 @@ ENDIF
ENDIF
!
#ifdef JUAN_ACC_S0_X
-!$acc end region
-!$acc end data region
+!$acc end kernels
+!$acc end data
#endif
!
CALL GET_HALO(PR,HDIR="S0_X")
--
GitLab