diff --git a/src/MNH/ppm.f90 b/src/MNH/ppm.f90
index 04cdcc4fb27565cba1c92890d421d6698017fe7d..2cc5ae3a6403dbab88d4164cd8f360bc21fe0c58 100644
--- a/src/MNH/ppm.f90
+++ b/src/MNH/ppm.f90
@@ -319,62 +319,14 @@ END MODULE MODI_PPM
!
!-------------------------------------------------------------------------------
!
-#ifdef MNH_OPENACC
! ########################################################################
-!!$ FUNCTION PPM_01_X(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP) &
-!!$ RESULT(PR)
+#ifdef MNH_OPENACC
SUBROUTINE PPM_01_X(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP, PR)
-! ########################################################################
-
- USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
- USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
-
- IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
-!
-INTEGER, INTENT(IN) :: KGRID ! C grid localisation
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-! output source term
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
-
-INTEGER :: IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG
-
-!$acc data present( PSRC, PCR, PRHO, PR )
-
- CALL MNH_GET_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
-
- CALL PPM_01_X_D(IIU,IJU,IKU,HLBCX, KGRID, &
- & PSRC, PCR, PRHO, PTSTEP, PR, &
- & ZT3D(:,:,:,IZQL),ZT3D(:,:,:,IZQR),ZT3D(:,:,:,IZDQ),ZT3D(:,:,:,IZQ6), &
- & ZT3D(:,:,:,IZDMQ),ZT3D(:,:,:,IZQL0),ZT3D(:,:,:,IZQR0), ZT3D(:,:,:,IZQ60), &
- & ZT3D(:,:,:,IZFPOS),ZT3D(:,:,:,IZFNEG) )
-
- CALL MNH_REL_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
-
-!$acc end data
-!
-CONTAINS
-!
-! ########################################################################
- SUBROUTINE PPM_01_X_D(IIU,IJU,IKU,HLBCX, KGRID, &
- & PSRC, PCR, PRHO, PTSTEP, PR, &
- & ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
-
-! ########################################################################
#else
-! ########################################################################
FUNCTION PPM_01_X(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP) &
RESULT(PR)
-! ########################################################################
#endif
+! ########################################################################
!!
!!**** PPM_01_X - PPM_01 fully monotonic PPM advection scheme in X direction
!! Colella notation
@@ -392,6 +344,9 @@ CONTAINS
USE MODD_CONF
USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifdef MNH_OPENACC
use mode_msg
@@ -411,9 +366,6 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-#ifdef MNH_OPENACC
-INTEGER , INTENT(IN) :: IIU,IJU,IKU
-#endif
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
@@ -436,8 +388,8 @@ INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
!
integer :: ji, jj, jk
-#ifndef MNH_OPENACC
integer :: iiu, iju, iku
+#ifndef MNH_OPENACC
! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL,ZQR
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZDQ,ZQ6
@@ -448,32 +400,23 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL0,ZQR0,ZQ60
!
! advection fluxes
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
-!
-!BEG JUAN PPM_LL
-INTEGER :: IJS,IJN
-!END JUAN PPM_LL
#else
INTEGER :: I,J,K
+! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZQL,ZQR
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZDQ,ZQ6
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZDMQ
!
-!!$!
-!!$! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
-REAL , DIMENSION(:,:,:) :: &
- ZQL,ZQR, ZDQ,ZQ6, ZDMQ &
-!!$!
-!!$! extra variables for the initial guess of parabolae parameters
- , ZQL0,ZQR0,ZQ60 &
-!!$!
-!!$! advection fluxes
- , ZFPOS, ZFNEG
+! extra variables for the initial guess of parabolae parameters
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZQL0,ZQR0,ZQ60
!
-INTEGER :: IJS,IJN
+! advection fluxes
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZFPOS, ZFNEG
#endif
+INTEGER :: IJS,IJN
LOGICAL :: GWEST , GEAST
!-------------------------------------------------------------------------------
-!$acc data present( PSRC, PCR, PRHO, PR , &
-!$acc & ZQL, ZQR, ZDQ, ZQ6, ZDMQ, ZQL0, ZQR0, ZQ60, ZFPOS, ZFNEG )
-
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PCR, "PPM_01_X beg:PCR")
@@ -481,6 +424,30 @@ IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PSRC,"PPM_01_X beg:PSRC")
END IF
+
+iiu = size( PSRC, 1 )
+iju = size( PSRC, 2 )
+iku = size( PSRC, 3 )
+
+#ifdef MNH_OPENACC
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ZQL, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQR, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZDQ, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQ6, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZDMQ, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQL0, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQR0, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQ60, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFPOS, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFNEG, IIU, IJU, IKU )
+#endif
+
+!$acc data present( PSRC, PCR, PRHO, PR , &
+!$acc & ZQL, ZQR, ZDQ, ZQ6, ZDMQ, ZQL0, ZQR0, ZQ60, ZFPOS, ZFNEG )
+
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -497,10 +464,6 @@ GEAST = LEAST_ll()
!* initialise & update halo & halo2 for PSRC
!
#ifndef MNH_OPENACC
-iiu = size( PSRC, 1 )
-iju = size( PSRC, 2 )
-iku = size( PSRC, 3 )
-
CALL GET_HALO(PSRC, HNAME='PSRC')
!
PR (:,:,:) = PSRC(:,:,:)
@@ -535,15 +498,8 @@ CALL GET_HALO_D(PSRC,HDIR="01_X", HNAME='UPDATE_HALO_ll::GET_HALO::PSRC')
end do
end do
!
-#if 0
-ZFPOS(:,1:IJS,:)=PSRC(:,1:IJS,:)
-ZFNEG(:,1:IJS,:)=PSRC(:,1:IJS,:)
-ZFPOS(:,IJN:,:)=PSRC(:,IJN:,:)
-ZFNEG(:,IJN:,:)=PSRC(:,IJN:,:)
-#else
ZFPOS(:,:,:) = PSRC(:,:,:)
ZFNEG(:,:,:) = PSRC(:,:,:)
-#endif
!$acc end kernels
#endif
!
@@ -693,7 +649,6 @@ CASE('OPEN')
!
! calculate dmq
CALL DIF2X( PSRC, ZDMQ )
-!$acc kernels
!
! overwrite the values on the boundary to get second order difference
! for qL and qR at the boundary
@@ -701,19 +656,24 @@ CASE('OPEN')
! WEST BOUND
!
IF (GWEST) THEN
+!$acc kernels
ZDMQ(IIB-1,IJS:IJN,:) = -ZDMQ(IIB,IJS:IJN,:)
+!$acc end kernels
ENDIF
!
! EAST BOUND
!
IF (GEAST) THEN
+!$acc kernels
ZDMQ(IIE+1,IJS:IJN,:) = -ZDMQ(IIE,IJS:IJN,:)
+!$acc end kernels
ENDIF
!
! monotonize the difference followinq eq. 5 in Lin94
!
! ZDMQ(i) = Fct[ ZDMQ(i),PSRC(i),PSRC(i-1),PSRC(i+1) ]
!
+!$acc kernels
!$acc loop independent collapse(3)
do jk = 1, iku
do jj = ijs, ijn
@@ -774,29 +734,32 @@ CASE('OPEN')
#else
!$acc end kernels
CALL GET_HALO_D(ZQL0,HDIR="01_X", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
-!$acc kernels
#endif
!
! WEST BOUND
!
IF (GWEST) THEN
+!$acc kernels
ZQL0(IIB-1,IJS:IJN,:) = ZQL0(IIB,IJS:IJN,:)
+!$acc end kernels
ENDIF
!
+!$acc kernels present( ZQL0, ZQR0 )
ZQR0(IIB-1:IIE,IJS:IJN,:) = ZQL0(IIB:IIE+1,IJS:IJN,:)
+!$acc end kernels
!
#ifndef MNH_OPENACC
CALL GET_HALO(ZQR0, HNAME='ZQR0')
#else
-!$acc end kernels
CALL GET_HALO_D(ZQR0, HDIR="01_X", HNAME='UPDATE_HALO_ll::GET_HALO::ZQR0')
-!$acc kernels
#endif
!
! EAST BOUND
!
IF (GEAST) THEN
+!$acc kernels present( ZQR0 )
ZQR0(IIE+1,IJS:IJN,:) = ZQR0(IIE,IJS:IJN,:)
+!$acc end kernels
ENDIF
#ifndef MNH_OPENACC
!
@@ -831,6 +794,7 @@ CASE('OPEN')
!
ZDQ(:,IJS:IJN,:) = ZQR(:,IJS:IJN,:) - ZQL(:,IJS:IJN,:)
#else
+!$acc kernels present( ZQL0, ZQR0 )
!$acc loop independent collapse(3)
DO K=1,IKU
DO J = IJS,IJN
@@ -868,6 +832,7 @@ DO K=1,IKU
!
ZDQ(I,J,K) = ZQR(I,J,K) - ZQL(I,J,K)
ENDDO ; ENDDO ; ENDDO
+!$acc end kernels
#endif
!
! and finally calculate fluxes for the advection
@@ -878,6 +843,7 @@ ENDDO ; ENDDO ; ENDDO
!!$ ZFPOS(IIB+1:IIE+1,:,:) = ZQR(IIB:IIE,:,:) - 0.5*PCR(IIB+1:IIE+1,:,:) * &
!!$ (ZDQ(IIB:IIE,:,:) - (1.0 - 2.0*PCR(IIB+1:IIE+1,:,:)/3.0) &
!!$ * ZQ6(IIB:IIE,:,:))
+!$acc kernels
!$acc loop independent collapse(3)
do jk = 1, iku
do jj = ijs, ijn
@@ -895,7 +861,6 @@ ENDDO ; ENDDO ; ENDDO
#else
!$acc end kernels
CALL GET_HALO_D(ZFPOS, HDIR="01_X", HNAME='UPDATE_HALO_ll::GET_HALO::ZFPOS')
-!$acc kernels
#endif
!
!
@@ -904,16 +869,19 @@ ENDDO ; ENDDO ; ENDDO
! advection flux at open boundary when u(IIB) > 0
!
IF (GWEST) THEN
+!$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,:)
! PPOSX(IIB-1,:,:) is not important for the calc of advection so
! we set it to 0
!!$ ZFPOS(IIB-1,:,:) = 0.0
+!$acc end kernels
ENDIF
!
!!$ ZFNEG(IIB-1:IIE,:,:) = ZQL(IIB-1:IIE,:,:) - 0.5*PCR(IIB-1:IIE,:,:) * &
!!$ (ZDQ(IIB-1:IIE,:,:) + (1.0 + 2.0*PCR(IIB-1:IIE,:,:)/3.0) &
!!$ * ZQ6(IIB-1:IIE,:,:))
+!$acc kernels
!$acc loop independent collapse(3)
do jk = 1, iku
do jj = ijs, ijn
@@ -929,15 +897,16 @@ ENDDO ; ENDDO ; ENDDO
#else
!$acc end kernels
CALL GET_HALO_D(ZFNEG, HDIR="01_X", HNAME='UPDATE_HALO_ll::GET_HALO::ZFNEG')
-!$acc kernels
#endif
!
! EAST BOUND
!
! advection flux at open boundary when u(IIE+1) < 0
IF (GEAST) THEN
+!$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 kernels
ENDIF
!
! advect the actual field in X direction by U*dt
@@ -948,7 +917,6 @@ ENDDO ; ENDDO ; ENDDO
CALL GET_HALO(PR, HNAME='PR')
#else
!mxm(ZQL,PRHO)
-!$acc end kernels
CALL MXM_DEVICE(PRHO,ZQL)
!$acc kernels
where ( PCR(:,:,:) > 0. )
@@ -973,11 +941,12 @@ END IF
!$acc end data
-#ifndef MNH_OPENACC
-CONTAINS
-#else
-END SUBROUTINE PPM_01_X_D
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
#endif
+
+CONTAINS
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
@@ -1000,14 +969,14 @@ END SUBROUTINE PPM_01_X_D
!-------------------------------------------------------------------------------
!
!
-USE MODE_ll
+! USE MODE_ll
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PQ
-REAL, DIMENSION(SIZE(PQ,1),SIZE(PQ,2),SIZE(PQ,3)), INTENT(OUT) :: DQ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQ
+REAL, DIMENSION(SIZE(PQ,1),SIZE(PQ,2),SIZE(PQ,3)) :: DQ
!
!* 0.2 Declarations of local variables :
!
@@ -1040,7 +1009,7 @@ DQ = 0.5*DQ
!$acc end data
END SUBROUTINE DIF2X
-!
+
#ifdef MNH_OPENACC
END SUBROUTINE PPM_01_X
#else
@@ -1051,62 +1020,14 @@ END FUNCTION PPM_01_X
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-#ifdef MNH_OPENACC
! ########################################################################
-!!$ FUNCTION PPM_01_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP) &
-!!$ RESULT(PR)
+#ifdef MNH_OPENACC
SUBROUTINE PPM_01_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP, PR)
-! ########################################################################
-
- USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
- USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
-
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
-!
-INTEGER, INTENT(IN) :: KGRID ! C grid localisation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR & ! Courant number
- , PRHO ! density
-!
-! output source term
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
-
-INTEGER :: IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG
-
-!$acc data present( PSRC, PCR, PRHO, PR )
-
- CALL MNH_GET_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
-
- CALL PPM_01_Y_D(IIU,IJU,IKU,HLBCY, KGRID, &
- & PSRC, PCR, PRHO, PTSTEP, PR, &
- & ZT3D(:,:,:,IZQL),ZT3D(:,:,:,IZQR),ZT3D(:,:,:,IZDQ),ZT3D(:,:,:,IZQ6), &
- & ZT3D(:,:,:,IZDMQ),ZT3D(:,:,:,IZQL0),ZT3D(:,:,:,IZQR0), ZT3D(:,:,:,IZQ60), &
- & ZT3D(:,:,:,IZFPOS),ZT3D(:,:,:,IZFNEG) )
-
- CALL MNH_REL_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
-
-!$acc end data
-
-CONTAINS
-!
-! ########################################################################
- SUBROUTINE PPM_01_Y_D(IIU,IJU,IKU,HLBCY, KGRID, &
- & PSRC, PCR, PRHO, PTSTEP, PR, &
- & ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
-
-! ########################################################################
#else
-! ########################################################################
FUNCTION PPM_01_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP) &
RESULT(PR)
-! ########################################################################
#endif
+! ########################################################################
!!
!!**** PPM_01_Y - PPM_01 fully monotonic PPM advection scheme in Y direction
!! Colella notation
@@ -1124,6 +1045,9 @@ CONTAINS
USE MODD_CONF
USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifdef MNH_OPENACC
use mode_msg
@@ -1143,9 +1067,6 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-#ifdef MNH_OPENACC
-integer, intent(in) :: iiu, iju, iku
-#endif
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
@@ -1168,11 +1089,11 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
!
+integer :: iiu, iju, iku
INTEGER :: IIW,IIA
!
LOGICAL :: GSOUTH , GNORTH
#ifndef MNH_OPENACC
-integer :: iiu, iju, iku
!
! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL,ZQR
@@ -1187,27 +1108,24 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
!
#else
! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
-REAL, DIMENSION(:,:,:) :: &
- ZQL,ZQR , ZDQ,ZQ6 , ZDMQ &
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZQL, ZQR
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZDQ, ZQ6
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZDMQ
+!
! extra variables for the initial guess of parabolae parameters
- , ZQL0,ZQR0,ZQ60 &
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZQL0,ZQR0,ZQ60
+!
! advection fluxes
- , ZFPOS, ZFNEG
-
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZFPOS, ZFNEG
!
-!JUAN ACC
INTEGER :: I,J,K
!
INTEGER :: IKB,IKE
INTEGER :: IJN,IJS
-!JUAN ACC
#endif
integer :: ji, jj, jk
!-------------------------------------------------------------------------------
-!$acc data present( PSRC, PCR, PRHO, PR, &
-!$acc & ZQL, ZQR, ZDQ, ZQ6, ZDMQ, ZQL0, ZQR0, ZQ60, ZFPOS, ZFNEG )
-
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PCR, "PPM_01_Y beg:PCR")
@@ -1215,6 +1133,30 @@ IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PSRC,"PPM_01_Y beg:PSRC")
END IF
+
+iiu = size( PSRC, 1 )
+iju = size( PSRC, 2 )
+iku = size( PSRC, 3 )
+
+#ifdef MNH_OPENACC
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ZQL, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQR, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZDQ, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQ6, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZDMQ, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQL0, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQR0, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQ60, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFPOS, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFNEG, IIU, IJU, IKU )
+#endif
+
+!$acc data present( PSRC, PCR, PRHO, PR, &
+!$acc & ZQL, ZQR, ZDQ, ZQ6, ZDMQ, ZQL0, ZQR0, ZQ60, ZFPOS, ZFNEG )
+
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -1227,10 +1169,6 @@ GSOUTH=LSOUTH_ll()
GNORTH=LNORTH_ll()
!
#ifndef MNH_OPENACC
-iiu = size( PSRC, 1 )
-iju = size( PSRC, 2 )
-iku = size( PSRC, 3 )
-
CALL GET_HALO(PSRC, HNAME='PSRC')
#else
IJS=1
@@ -1268,20 +1206,8 @@ CALL GET_HALO_D(PSRC, HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::PSRC')
end do
end do
end do
-#ifndef MNH_OPENACC
-ZFPOS=PSRC
-ZFNEG=PSRC
-#else
-#if 0
-ZFPOS(1:IIW,:,IKB:IKE)=PSRC(1:IIW,:,IKB:IKE)
-ZFNEG(1:IIW,:,IKB:IKE)=PSRC(1:IIW,:,IKB:IKE)
-ZFPOS(IIA:,:,IKB:IKE)=PSRC(IIA:,:,IKB:IKE)
-ZFNEG(IIA:,:,IKB:IKE)=PSRC(IIA:,:,IKB:IKE)
-#else
ZFPOS(:,:,:) = PSRC(:,:,:)
ZFNEG(:,:,:) = PSRC(:,:,:)
-#endif
-#endif
!$acc end kernels
!
SELECT CASE ( HLBCY(1) ) ! Y direction LBC type: (1) for left side
@@ -1454,6 +1380,8 @@ CALL MPPDB_CHECK(ZQL0,"PPM_01_Y: ZQL0")
END DO
END DO
END DO
+!$acc end kernels
+!$acc kernels
#endif
!
! and finally calculate fluxes for the advection
@@ -1524,23 +1452,27 @@ CASE('OPEN')
!
! calculate dmq
CALL DIF2Y( PSRC, ZDMQ )
-!$acc kernels
! overwrite the values on the boundary to get second order difference
! for qL and qR at the boundary
!
! SOUTH BOUND
!
IF (GSOUTH) THEN
+!$acc kernels
ZDMQ(IIW:IIA,IJB-1,:) = -ZDMQ(IIW:IIA,IJB,:)
+!$acc end kernels
ENDIF
!
! NORTH BOUND
!
IF (GNORTH) THEN
+!$acc kernels
ZDMQ(IIW:IIA,IJE+1,:) = -ZDMQ(IIW:IIA,IJE,:)
+!$acc end kernels
ENDIF
!
! monotonize the difference followinq eq. 5 in Lin94
+!$acc kernels
!$acc loop independent collapse(3)
do jk = 1, iku
do jj = ijb, ije
@@ -1590,15 +1522,17 @@ end do
#else
!$acc end kernels
CALL GET_HALO_D(ZQL0,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
-!$acc kernels
#endif
!
! SOUTH BOUND
!
IF (GSOUTH) THEN
+!$acc kernels
ZQL0(IIW:IIA,IJB-1,:) = ZQL0(IIW:IIA,IJB,:)
+!$acc end kernels
ENDIF
!
+!$acc kernels
!$acc loop independent collapse(3)
do jk = 1, iku
do jj = ijb - 1, ije
@@ -1607,11 +1541,14 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
end do
end do
end do
+!$acc end kernels
!
! NORTH BOUND
!
IF (GNORTH) THEN
+!$acc kernels
ZQR0(IIW:IIA,IJE+1,:) = ZQR0(IIW:IIA,IJE,:)
+!$acc end kernels
ENDIF
#ifndef MNH_OPENACC
!
@@ -1647,6 +1584,7 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
ZDQ(IIW:IIA,:,:) = ZQR(IIW:IIA,:,:) - ZQL(IIW:IIA,:,:)
!
#else
+!$acc kernels
!$acc loop independent collapse(3)
DO K=IKB,IKE
DO J=IJS,IJN
@@ -1686,6 +1624,7 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
END DO
END DO
END DO
+!$acc end kernels
#endif
!
! and finally calculate fluxes for the advection
@@ -1693,6 +1632,7 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
!!$ ZFPOS(:,IJB+1:IJE+1,:) = ZQR(:,IJB:IJE,:) - 0.5*PCR(:,IJB+1:IJE+1,:) * &
!!$ (ZDQ(:,IJB:IJE,:) - (1.0 - 2.0*PCR(:,IJB+1:IJE+1,:)/3.0) &
!!$ * ZQ6(:,IJB:IJE,:))
+!$acc kernels
!$acc loop independent collapse(3)
do jk = 1, iku
do jj = ijb, ije + 1
@@ -1708,7 +1648,6 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
#else
!$acc end kernels
CALL GET_HALO_D(ZFPOS,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZFPOS')
-!$acc kernels
#endif
!
!
@@ -1717,8 +1656,10 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
! SOUTH BOUND
!
IF (GSOUTH) THEN
+!$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 kernels
ENDIF
!
! PPOSX(:,IJB-1,:) is not important for the calc of advection so
@@ -1728,6 +1669,7 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
!!$ ZFNEG(:,IJB-1:IJE,:) = ZQL(:,IJB-1:IJE,:) - 0.5*PCR(:,IJB-1:IJE,:) * &
!!$ ( ZDQ(:,IJB-1:IJE,:) + (1.0 + 2.0*PCR(:,IJB-1:IJE,:)/3.0) * &
!!$ ZQ6(:,IJB-1:IJE,:) )
+!$acc kernels
!$acc loop independent collapse(3)
do jk = 1, iku
do jj = 1, iju
@@ -1743,7 +1685,6 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
#else
!$acc end kernels
CALL GET_HALO_D(ZFNEG,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZFNEG')
-!$acc kernels
#endif
!
! advection flux at open boundary when u(IJE+1) < 0
@@ -1751,8 +1692,10 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
! NORTH BOUND
!
IF (GNORTH) THEN
+!$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 kernels
ENDIF
#ifndef MNH_OPENACC
!
@@ -1762,7 +1705,6 @@ CALL GET_HALO_D(ZQL0,HDIR="01_Y", HNAME='UPDATE_HALO_ll::GET_HALO::ZQL0')
ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
!
#else
-!$acc end kernels
CALL MYM_DEVICE(PRHO,ZQL)
!$acc kernels
!$acc loop independent collapse(3)
@@ -1799,11 +1741,12 @@ END IF
!$acc end data
-#ifndef MNH_OPENACC
-CONTAINS
-#else
-END SUBROUTINE PPM_01_Y_D
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
#endif
+
+CONTAINS
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
@@ -1872,8 +1815,6 @@ END SUBROUTINE DIF2Y
! #endif
!
#ifdef MNH_OPENACC
-! END SUBROUTINE PPM_01_Y_D
-
END SUBROUTINE PPM_01_Y
#else
END FUNCTION PPM_01_Y
@@ -1883,57 +1824,13 @@ END FUNCTION PPM_01_Y
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-#ifdef MNH_OPENACC
! ########################################################################
-!!$ FUNCTION PPM_01_Z(KGRID, PSRC, PCR, PRHO, PTSTEP) RESULT(PR)
+#ifdef MNH_OPENACC
SUBROUTINE PPM_01_Z(KGRID, PSRC, PCR, PRHO, PTSTEP, PR)
-! ########################################################################
-
- USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
- USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
-
- IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KGRID ! C grid localisation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR & ! Courant number
- , PRHO ! density
-!
-! output source term
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
-
-INTEGER :: IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG
-
-!$acc data present( PSRC, PCR, PRHO, PR )
-
- CALL MNH_GET_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
-
- CALL PPM_01_Z_D(IIU,IJU,IKU, KGRID, &
- & PSRC, PCR, PRHO, PTSTEP, PR, &
- & ZT3D(:,:,:,IZQL),ZT3D(:,:,:,IZQR),ZT3D(:,:,:,IZDQ),ZT3D(:,:,:,IZQ6), &
- & ZT3D(:,:,:,IZDMQ),ZT3D(:,:,:,IZQL0),ZT3D(:,:,:,IZQR0), ZT3D(:,:,:,IZQ60), &
- & ZT3D(:,:,:,IZFPOS),ZT3D(:,:,:,IZFNEG) )
-
- CALL MNH_REL_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
-
-!$acc end data
-
-CONTAINS
-!
-! ########################################################################
- SUBROUTINE PPM_01_Z_D(IIU,IJU,IKU,KGRID, &
- & PSRC, PCR, PRHO, PTSTEP, PR, &
- & ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
-! ########################################################################
#else
-! ########################################################################
FUNCTION PPM_01_Z(KGRID, PSRC, PCR, PRHO, PTSTEP) RESULT(PR)
-! ########################################################################
#endif
+! ########################################################################
!!
!!**** PPM_01_Z - PPM_01 fully monotonic PPM advection scheme in Z direction
!! Colella notation
@@ -1945,30 +1842,29 @@ CONTAINS
!!
!-------------------------------------------------------------------------------
!
+USE MODD_CONF
+USE MODD_PARAMETERS, ONLY: JPVEXT
+
USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
+USE MODE_MPPDB
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
+USE MODI_GET_HALO
#ifndef MNH_OPENACC
USE MODI_SHUMAN
#else
USE MODI_SHUMAN_DEVICE
#endif
-USE MODI_GET_HALO
-#ifdef MNH_BITREP
-USE MODI_BITREP
-#endif
-!
-USE MODD_CONF
-USE MODD_PARAMETERS
-!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-USE MODE_MPPDB
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-#ifdef MNH_OPENACC
-integer, intent(in) :: iiu, iju, iku
-#endif
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
#ifndef MNH_OPENACC
@@ -1990,11 +1886,11 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
!
!* 0.2 Declarations of local variables :
!
-#ifndef MNH_OPENACC
INTEGER :: IIU, IJU, IKU
INTEGER:: IKB ! Begining useful area in x,y,z directions
INTEGER:: IKE ! End useful area in x,y,z directions
!
+#ifndef MNH_OPENACC
! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL,ZQR
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZDQ,ZQ6
@@ -2007,17 +1903,15 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL0,ZQR0,ZQ60
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
#else
! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
-REAL, DIMENSION(:,:,:) :: &
- ZQL, ZQR, ZDQ, ZQ6, ZDMQ &
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZQL, ZQR
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZDQ, ZQ6
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZDMQ
!
! extra variables for the initial guess of parabolae parameters
- , ZQL0,ZQR0,ZQ60 &
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZQL0,ZQR0,ZQ60
!
! advection fluxes
- , ZFPOS, ZFNEG
-!
-INTEGER:: IKB ! Begining useful area in x,y,z directions
-INTEGER:: IKE ! End useful area in x,y,z directions
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZFPOS, ZFNEG
!
INTEGER :: I,J,K
#endif
@@ -2025,8 +1919,6 @@ integer :: ji, jj, jk
!
!-------------------------------------------------------------------------------
-!$acc data present( PSRC, PCR, PRHO, PR, &
-!$acc & ZQL, ZQR, ZDQ, ZQ6, ZDMQ, ZQL0, ZQR0, ZQ60, ZFPOS, ZFNEG )
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PCR, "PPM_01_Z beg:PCR")
@@ -2034,17 +1926,36 @@ IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PSRC,"PPM_01_Z beg:PSRC")
END IF
+
+iiu = size( PSRC, 1 )
+iju = size( PSRC, 2 )
+iku = size( PSRC, 3 )
+
+#ifdef MNH_OPENACC
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ZQL, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQR, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZDQ, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQ6, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZDMQ, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQL0, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQR0, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZQ60, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFPOS, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFNEG, IIU, IJU, IKU )
+#endif
+
+!$acc data present( PSRC, PCR, PRHO, PR, &
+!$acc & ZQL, ZQR, ZDQ, ZQ6, ZDMQ, ZQL0, ZQR0, ZQ60, ZFPOS, ZFNEG )
+
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
IKB = 1 + JPVEXT
IKE = SIZE(PSRC,3) - JPVEXT
-#ifndef MNH_OPENACC
-iiu = size( PSRC, 1 )
-iju = size( PSRC, 2 )
-iku = size( PSRC, 3 )
-#endif
!$acc kernels
!$acc loop independent collapse(3)
@@ -2103,16 +2014,22 @@ do jk = ikb, ike
end do
end do
end do
+!$acc end kernels
+!$acc kernels
ZDMQ(:,:,IKB-1) = &
SIGN( (MIN( ABS(ZDMQ(:,:,IKB-1)), 2.0*(PSRC(:,:,IKB-1) - &
MIN(PSRC(:,:,IKE-1),PSRC(:,:,IKB-1),PSRC(:,:,IKB))), &
2.0*(MAX(PSRC(:,:,IKE-1),PSRC(:,:,IKB-1),PSRC(:,:,IKB)) - &
PSRC(:,:,IKB-1)) )), ZDMQ(:,:,IKB-1) )
+!$acc end kernels
+!$acc kernels
ZDMQ(:,:,IKE+1) = &
SIGN( (MIN( ABS(ZDMQ(:,:,IKE+1)), 2.0*(PSRC(:,:,IKE+1) - &
MIN(PSRC(:,:,IKE),PSRC(:,:,IKE+1),PSRC(:,:,IKB+1))), &
2.0*(MAX(PSRC(:,:,IKE),PSRC(:,:,IKE+1),PSRC(:,:,IKB+1)) - &
PSRC(:,:,IKE+1)) )), ZDMQ(:,:,IKE+1) )
+!$acc end kernels
+!$acc kernels
!
! calculate qL and qR with the modified dmq
!
@@ -2126,6 +2043,8 @@ do jk = ikb, ike + 1
end do
ZQL0(:,:,IKB-1) = ZQL0(:,:,IKE)
!
+!$acc end kernels
+!$acc kernels
!$acc loop independent collapse(3)
do jk = ikb - 1, ike
do jj = 1, iju
@@ -2225,9 +2144,11 @@ ZDQ = ZQR - ZQL
END DO
END DO
#endif
+!$acc end kernels
!
! and finally calculate fluxes for the advection
!
+!$acc kernels
!$acc loop independent collapse(3)
do jk = ikb + 1, ike + 1
do jj = 1, iju
@@ -2237,7 +2158,9 @@ do jk = ikb + 1, ike + 1
end do
end do
end do
+!$acc end kernels
!
+!$acc kernels
! advection flux at open boundary when u(IKB) > 0
ZFPOS(:,:,IKB) = (PSRC(:,:,IKB-1) - ZQR(:,:,IKB-1))*PCR(:,:,IKB) + &
ZQR(:,:,IKB-1)
@@ -2246,6 +2169,8 @@ ZFPOS(:,:,IKB) = (PSRC(:,:,IKB-1) - ZQR(:,:,IKB-1))*PCR(:,:,IKB) + &
! we set it to 0
ZFPOS(:,:,IKB-1) = 0.0
!
+!$acc end kernels
+!$acc kernels
!$acc loop independent collapse(3)
do jk = ikb - 1, ike
do jj = 1, iju
@@ -2256,6 +2181,8 @@ do jk = ikb - 1, ike
end do
end do
!
+!$acc end kernels
+!$acc kernels
! advection flux at open boundary when u(IKE+1) < 0
ZFNEG(:,:,IKE+1) = (ZQR(:,:,IKE)-PSRC(:,:,IKE+1))*PCR(:,:,IKE+1) + &
ZQR(:,:,IKE)
@@ -2301,11 +2228,12 @@ END IF
!$acc end data
-#ifndef MNH_OPENACC
-CONTAINS
-#else
-END SUBROUTINE PPM_01_Z_D
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
#endif
+
+CONTAINS
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
@@ -2372,11 +2300,8 @@ DQ = 0.5 * DQ
!$acc end data
END SUBROUTINE DIF2Z
-! #endif
-!
+
#ifdef MNH_OPENACC
-! END SUBROUTINE PPM_01_Z_D
-!
END SUBROUTINE PPM_01_Z
#else
END FUNCTION PPM_01_Z
@@ -2386,59 +2311,14 @@ END FUNCTION PPM_01_Z
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-#ifdef MNH_OPENACC
-! ########################################################################
-!!$ FUNCTION PPM_S0_X(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP) &
-!!$ RESULT(PR)
-SUBROUTINE PPM_S0_X(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP , PR)
-
- USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
- USE MODE_MNH_ZWORK, ONLY : ZPSRC_HALO2_WEST
-
- IMPLICIT NONE
- !
- !* 0.1 Declarations of dummy arguments :
- !
- CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
- !
- INTEGER, INTENT(IN) :: KGRID ! C grid localisation
- !
- REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
- REAL, INTENT(IN) :: PTSTEP ! Time step
- !
- ! output source term
- REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
-
- INTEGER :: IZFPOS,IZFNEG,IZPHAT,IZRHO_MXM,IZCR_MXM,IZCR_DXF
-
-!$acc data present( PSRC, PCR, PRHO, PR )
-
- CALL MNH_GET_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MXM,IZCR_MXM,IZCR_DXF)
-
- CALL PPM_S0_X_D(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP , PR, &
- & ZT3D(:,:,:,IZFPOS),ZT3D(:,:,:,IZFNEG),ZT3D(:,:,:,IZPHAT),ZT3D(:,:,:,IZRHO_MXM), &
- & ZT3D(:,:,:,IZCR_MXM),ZT3D(:,:,:,IZCR_DXF),ZPSRC_HALO2_WEST )
-
- CALL MNH_REL_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MXM,IZCR_MXM,IZCR_DXF)
-
-!$acc end data
-
-CONTAINS
-!
-! ########################################################################
- SUBROUTINE PPM_S0_X_D(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP , PR &
- & ,ZFPOS,ZPHAT,ZFNEG &
- & ,ZRHO_MXM,ZCR_MXM,ZCR_DXF,ZPSRC_HALO2_WEST )
-
! ########################################################################
+#ifdef MNH_OPENACC
+ SUBROUTINE PPM_S0_X( HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP, PR )
#else
-! ########################################################################
FUNCTION PPM_S0_X(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP) &
RESULT(PR)
-! ########################################################################
#endif
+! ########################################################################
!!
!!**** PPM_S0_X - PPM advection scheme in X direction in Skamarock 2006
!! notation - NO CONSTRAINTS
@@ -2455,6 +2335,9 @@ USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
USE MODD_CONF
USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
#ifdef MNH_OPENACC
use mode_msg
@@ -2467,14 +2350,6 @@ USE MODI_SHUMAN
USE MODI_SHUMAN_DEVICE
#endif
!
-#ifdef MNH_OPENACC
-USE MODD_PARAMETERS, ONLY : JPHEXT
-!
-USE MODE_MNH_ZWORK, ONLY : IIB,IIE, IIU,IJU,IKU , IJS,IJN, GWEST,GEAST
-!
-USE MODD_IO, ONLY : GSMONOPROC
-#endif
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -2498,13 +2373,14 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
!
!* 0.2 Declarations of local variables :
!
-#ifndef MNH_OPENACC
INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
INTEGER :: IJS,IJN
+integer :: iiu, iju, iku
!
LOGICAL :: GWEST, GEAST
+#ifndef MNH_OPENACC
! advection fluxes
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
!
@@ -2514,24 +2390,21 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
REAL, DIMENSION(SIZE(PCR,2),SIZE(PCR,3)) :: ZPSRC_HALO2_WEST
#else
! advection fluxes
-REAL, DIMENSION(:,:,:) :: ZFPOS, ZFNEG
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZFPOS, ZFNEG
!
! variable at cell edges
-REAL, DIMENSION(:,:,:) :: ZPHAT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZPHAT
!
-REAL, DIMENSION(:,:,:) :: ZRHO_MXM, ZCR_MXM , ZCR_DXF
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZCR_DXF, ZCR_MXM, ZRHO_MXM
INTEGER :: I,J,K
!
-REAL, DIMENSION(:,:) :: ZPSRC_HALO2_WEST
+REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZPSRC_HALO2_WEST
#endif
TYPE(HALO2LIST_ll), POINTER :: TZ_PSRC_HALO2_ll ! halo2 for PSRC
!-------------------------------------------------------------------------------
-!$acc data present( PSRC, PCR, PRHO, PR , &
-!$acc & ZFPOS, ZFNEG, ZPHAT, ZRHO_MXM, ZCR_MXM, ZCR_DXF, ZPSRC_HALO2_WEST )
-
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PCR, "PPM_S0_X beg:PCR")
@@ -2539,11 +2412,31 @@ IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PSRC,"PPM_S0_X beg:PSRC")
END IF
+
+iiu = size( PSRC, 1 )
+iju = size( PSRC, 2 )
+iku = size( PSRC, 3 )
+
+#ifdef MNH_OPENACC
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ZFPOS, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFNEG, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZPHAT, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZCR_DXF, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZCR_MXM, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRHO_MXM, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZPSRC_HALO2_WEST, IJU, IKU )
+#endif
+
+!$acc data present( PSRC, PCR, PRHO, PR , &
+!$acc & ZFPOS, ZFNEG, ZPHAT, ZRHO_MXM, ZCR_MXM, ZCR_DXF, ZPSRC_HALO2_WEST )
+
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
-#ifndef MNH_OPENACC
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IJS=IJB
IJN=IJE
@@ -2552,7 +2445,6 @@ IJN=IJE
!
GWEST = LWEST_ll()
GEAST = LEAST_ll()
-#endif
!
!BEG JUAN PPM_LL
!
@@ -2651,7 +2543,6 @@ CALL GET_HALO(ZFNEG, HNAME='ZFNEG') ! JUAN
CALL GET_HALO(PR, HNAME='PR') ! JUAN
!
CASE ('OPEN')
-!$acc kernels
!
!!$ ZPHAT(IIB,:,:) = 0.5*(PSRC(IIB-1,:,:) + PSRC(IIB,:,:))
!!$ ZPHAT(IIB-1,:,:) = ZPHAT(IIB,:,:) ! not used
@@ -2660,12 +2551,13 @@ CASE ('OPEN')
! WEST BOUND
!
IF (.NOT. GWEST) THEN
+!$acc kernels
ZPHAT(IIB ,IJS:IJN,:) = ( 7.0 * &
( PSRC(IIB ,IJS:IJN,:) + PSRC(IIB-1,IJS:IJN,:) ) - &
( PSRC(IIB+1,IJS:IJN,:) + ZPSRC_HALO2_WEST(IJS:IJN,:) ) ) / 12.0
! <=> WEST BOUND ( PSRC(IIB+1,IJS:IJN,:) + PSRC(IIB-2,IJS:IJN,:) ) ) / 12.0
-ENDIF
!$acc end kernels
+ENDIF
!
! update ZPHAT HALO before next/further utilisation
!
@@ -2712,15 +2604,17 @@ ENDIF
! acc update device(ZFPOS)
#endif
!
-!$acc kernels
! positive flux on the WEST boundary
IF (GWEST) THEN
+!$acc kernels
ZFPOS(IIB,IJS:IJN,:) = (PSRC(IIB-1,IJS:IJN,:) - ZPHAT(IIB,IJS:IJN,:))*PCR(IIB,IJS:IJN,:) + &
ZPHAT(IIB,IJS:IJN,:)
! this is not used
ZFPOS(IIB-1,IJS:IJN,:) = 0.0
+!$acc end kernels
ENDIF
!
+!$acc kernels
! negative fluxes
!!$ ZFNEG(IIB:IIE,:,:) = ZPHAT(IIB:IIE,:,:) + &
!!$ PCR(IIB:IIE,:,:)*(ZPHAT(IIB:IIE,:,:) - PSRC(IIB:IIE,:,:)) + &
@@ -2740,8 +2634,8 @@ ENDIF
! acc update device(ZFNEG)
#endif
!
-!$acc kernels
IF (GEAST) THEN
+!$acc kernels
!
! in OPEN case PCR(IIB-1) is not used, so we also set ZFNEG(IIB-1) = 0
!
@@ -2752,6 +2646,7 @@ ENDIF
!
ZFNEG(IIE+1,IJS:IJN,:) = (ZPHAT(IIE+1,IJS:IJN,:) - PSRC(IIE+1,IJS:IJN,:))*PCR(IIE+1,IJS:IJN,:) + &
ZPHAT(IIE+1,IJS:IJN,:)
+!$acc end kernels
ENDIF
!
! calculate the advection
@@ -2761,7 +2656,6 @@ ENDIF
DXF( PCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
#else
-!$acc end kernels
CALL MXM_DEVICE(PRHO,ZRHO_MXM)
!$acc kernels
ZCR_MXM = PCR * ZRHO_MXM * ( ZFPOS*(0.5+SIGN(0.5,PCR)) + ZFNEG*(0.5-SIGN(0.5,PCR)) )
@@ -2769,27 +2663,31 @@ ENDIF
CALL DXF_DEVICE(ZCR_MXM,ZCR_DXF)
!$acc kernels
PR = PSRC * PRHO - ZCR_DXF
+!$acc end kernels
#endif
!
! in OPEN case fix boundary conditions
!
IF (GWEST) THEN
+!$acc kernels
WHERE ( PCR(IIB,IJS:IJN,:) <= 0. ) ! OUTFLOW condition
PR(IIB-1,IJS:IJN,:) = 2.*PR(IIB,IJS:IJN,:) - PR(IIB+1,IJS:IJN,:)
ELSEWHERE
PR(IIB-1,IJS:IJN,:) = PR(IIB,IJS:IJN,:)
END WHERE
+!$acc end kernels
ENDIF
!
IF (GEAST) THEN
+!$acc kernels
WHERE ( PCR(IIE,IJS:IJN,:) >= 0. ) ! OUTFLOW condition
PR(IIE+1,IJS:IJN,:) = 2.*PR(IIE,IJS:IJN,:) - PR(IIE-1,IJS:IJN,:)
ELSEWHERE
PR(IIE+1,IJS:IJN,:) = PR(IIE,IJS:IJN,:)
END WHERE
+!$acc end kernels
ENDIF
!
-!$acc end kernels
!
!
END SELECT
@@ -2813,8 +2711,11 @@ END IF
!$acc end data
#ifdef MNH_OPENACC
-END SUBROUTINE PPM_S0_X_D
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
+#ifdef MNH_OPENACC
END SUBROUTINE PPM_S0_X
#else
END FUNCTION PPM_S0_X
@@ -2823,59 +2724,14 @@ END FUNCTION PPM_S0_X
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-#ifdef MNH_OPENACC
! ########################################################################
-!!$ FUNCTION PPM_S0_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP) &
-!!$ RESULT(PR)
+#ifdef MNH_OPENACC
SUBROUTINE PPM_S0_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP, PR)
-
- USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
- USE MODE_MNH_ZWORK, ONLY : ZPSRC_HALO2_SOUTH
-
- IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
-!
-INTEGER, INTENT(IN) :: KGRID ! C grid localisation
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-! output source term
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
-
- INTEGER :: IZFPOS,IZPHAT,IZFNEG,IZRHO_MYM,IZCR_MYM,IZCR_DYF
-
-!$acc data present( PSRC, PCR, PRHO, PR )
-
- CALL MNH_GET_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MYM,IZCR_MYM,IZCR_DYF)
-
- CALL PPM_S0_Y_D(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP , PR, &
- & ZT3D(:,:,:,IZFPOS),ZT3D(:,:,:,IZFNEG),ZT3D(:,:,:,IZPHAT),ZT3D(:,:,:,IZRHO_MYM), &
- & ZT3D(:,:,:,IZCR_MYM),ZT3D(:,:,:,IZCR_DYF),ZPSRC_HALO2_SOUTH )
-
- CALL MNH_REL_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MYM,IZCR_MYM,IZCR_DYF)
-
-!$acc end data
-
-CONTAINS
-!
-! ########################################################################
- SUBROUTINE PPM_S0_Y_D(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP , PR &
- & ,ZFPOS,ZPHAT,ZFNEG &
- & ,ZRHO_MYM,ZCR_MYM,ZCR_DYF,ZPSRC_HALO2_SOUTH )
-
-! ########################################################################
#else
-! ########################################################################
FUNCTION PPM_S0_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP) &
RESULT(PR)
-! ########################################################################
#endif
+! ########################################################################
!!
!!**** PPM_S0_Y - PPM advection scheme in Y direction in Skamarock 2006
!! notation - NO CONSTRAINTS
@@ -2890,6 +2746,9 @@ CONTAINS
USE MODD_CONF
USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
#ifdef MNH_OPENACC
use mode_msg
@@ -2902,15 +2761,6 @@ USE MODI_SHUMAN
USE MODI_SHUMAN_DEVICE
#endif
!
-#ifdef MNH_OPENACC
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-USE MODD_PARAMETERS, ONLY : JPHEXT
-!
-USE MODE_MNH_ZWORK, ONLY : IJB,IJE, IIU,IJU,IKU , IIW,IIA, GSOUTH , GNORTH
-!
-USE MODD_IO, ONLY : GSMONOPROC
-#endif
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -2934,14 +2784,14 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
!
!* 0.2 Declarations of local variables :
!
-#ifndef MNH_OPENACC
INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-INTEGER :: IJS,IJN
INTEGER :: IIW,IIA
+INTEGER :: IIU, IJU, IKU
!
LOGICAL :: GNORTH, GSOUTH
!
+#ifndef MNH_OPENACC
! advection fluxes
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
!
@@ -2953,28 +2803,24 @@ TYPE(HALO2LIST_ll), POINTER :: TZ_PHAT_HALO2_ll ! halo2 for ZPHAT
!
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,3)) :: ZPSRC_HALO2_SOUTH
#else
-!
! advection fluxes
-REAL, DIMENSION(:,:,:) :: ZFPOS, ZFNEG
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZFPOS, ZFNEG
!
! variable at cell edges
-REAL, DIMENSION(:,:,:) :: ZPHAT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZPHAT
!
TYPE(HALO2LIST_ll), POINTER :: TZ_PSRC_HALO2_ll ! halo2 for PSRC
TYPE(HALO2LIST_ll), POINTER :: TZ_PHAT_HALO2_ll ! halo2 for ZPHAT
!
-REAL, DIMENSION(:,:,:) :: ZRHO_MYM , ZCR_MYM , ZCR_DYF
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZCR_DYF, ZCR_MYM, ZRHO_MYM
!
INTEGER :: I,J,K
!
-REAL, DIMENSION(:,:) :: ZPSRC_HALO2_SOUTH
+REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZPSRC_HALO2_SOUTH
#endif
!
!-------------------------------------------------------------------------------
-!$acc data present( PSRC, PCR, PRHO, PR , &
-!$acc & ZFPOS, ZFNEG, ZPHAT, ZRHO_MYM, ZCR_MYM, ZCR_DYF, ZPSRC_HALO2_SOUTH )
-
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PCR, "PPM_S0_Y beg:PCR")
@@ -2982,11 +2828,31 @@ IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PSRC,"PPM_S0_Y beg:PSRC")
END IF
+
+iiu = size( PSRC, 1 )
+iju = size( PSRC, 2 )
+iku = size( PSRC, 3 )
+
+#ifdef MNH_OPENACC
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ZFPOS, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFNEG, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZPHAT, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZCR_DYF, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZCR_MYM, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRHO_MYM, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZPSRC_HALO2_SOUTH, IIU, IKU )
+#endif
+
+!$acc data present( PSRC, PCR, PRHO, PR , &
+!$acc & ZFPOS, ZFNEG, ZPHAT, ZRHO_MYM, ZCR_MYM, ZCR_DYF, ZPSRC_HALO2_SOUTH )
+
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
-#ifndef MNH_OPENACC
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IIW=IIB
IIA=IIE
@@ -2995,7 +2861,6 @@ IIA=IIE
!
GNORTH = LNORTH_ll()
GSOUTH = LSOUTH_ll()
-#endif
!
!-------------------------------------------------------------------------------
!
@@ -3096,7 +2961,6 @@ CALL GET_HALO(ZFNEG, HNAME='ZFNEG') ! JUAN
#endif
!
CASE ('OPEN')
-!$acc kernels
!
!!$ ZPHAT(:,IJB,:) = 0.5*(PSRC(:,IJB-1,:) + PSRC(:,IJB,:))
!!$ ZPHAT(:,IJB-1,:) = ZPHAT(:,IJB,:) ! not used
@@ -3106,15 +2970,16 @@ CASE ('OPEN')
! SOUTH BOUND
!
IF ( .NOT. GSOUTH) THEN
+!$acc kernels
ZPHAT(IIW:IIA,IJB ,:) = (7.0 * &
(PSRC(IIW:IIA,IJB ,:) + PSRC(IIW:IIA,IJB-1,:)) - &
(PSRC(IIW:IIA,IJB+1,:) + ZPSRC_HALO2_SOUTH(IIW:IIA,:) )) / 12.0
! (PSRC(IIW:IIA,IJB+1,:) + TZ_PSRC_HALO2_ll%HALO2%SOUTH(IIW:IIA,:) )) / 12.0
! <=> SOUTH BOUND (PSRC(IIW:IIA,IJB+1,:) + PSRC(IIW:IIA,IJB-2,:) )) / 12.0
+!$acc end kernels
ENDIF
!
!TEMPO_JUAN
-!$acc end kernels
!
#ifndef MNH_OPENACC
!PW: a remettre? CALL GET_HALO(ZPHAT, HNAME='ZPHAT')
@@ -3124,16 +2989,19 @@ CASE ('OPEN')
! acc update device(ZPHAT)
#endif
!
-!$acc kernels
IF (GSOUTH) THEN
+!$acc kernels
ZPHAT(IIW:IIA,IJB ,:) = 0.5*(PSRC(IIW:IIA,IJB-1,:) + PSRC(IIW:IIA,IJB,:))
ZPHAT(IIW:IIA,IJB-1,:) = ZPHAT(IIW:IIA,IJB,:)
+!$acc end kernels
ENDIF
!
! NORTH BOUND
!
IF (GNORTH) THEN
+!$acc kernels
ZPHAT(IIW:IIA,IJE+1,:) = 0.5*(PSRC(IIW:IIA,IJE,:) + PSRC(IIW:IIA,IJE+1,:))
+!$acc end kernels
ENDIF
!
!
@@ -3147,7 +3015,8 @@ CASE ('OPEN')
!!$ PCR(:,IJB+1:IJE+1,:)*(ZPHAT(:,IJB+1:IJE+1,:) - PSRC(:,IJB:IJE,:)) - &
!!$ PCR(:,IJB+1:IJE+1,:)*(1.0 - PCR(:,IJB+1:IJE+1,:)) * &
!!$ (ZPHAT(:,IJB:IJE,:) - 2.0*PSRC(:,IJB:IJE,:) + ZPHAT(:,IJB+1:IJE+1,:))
- ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZPHAT(IIW:IIA,IJB:IJE+1,:) - &
+!$acc kernels
+ ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZPHAT(IIW:IIA,IJB:IJE+1,:) - &
PCR(IIW:IIA,IJB:IJE+1,:)*( ZPHAT(IIW:IIA,IJB:IJE+1,:) - PSRC(IIW:IIA,IJB-1:IJE ,:) ) - &
PCR(IIW:IIA,IJB:IJE+1,:)*( 1.0 - PCR(IIW:IIA,IJB :IJE+1,:) ) * &
(ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) + ZPHAT(IIW:IIA,IJB:IJE+1,:))
@@ -3161,14 +3030,15 @@ CASE ('OPEN')
! acc update device(ZFPOS)
#endif
!
-!$acc kernels
! positive flux on the SOUTH boundary
IF (GSOUTH) THEN
+!$acc kernels
ZFPOS(IIW:IIA,IJB,:) = (PSRC(IIW:IIA,IJB-1,:) - ZPHAT(IIW:IIA,IJB,:))*PCR(IIW:IIA,IJB,:) + &
ZPHAT(IIW:IIA,IJB,:)
!
! this is not used
ZFPOS(IIW:IIA,IJB-1,:) = 0.0
+!$acc end kernels
ENDIF
!
! negative fluxes
@@ -3176,7 +3046,8 @@ CASE ('OPEN')
!!$ PCR(:,IJB:IJE,:)*(ZPHAT(:,IJB:IJE,:) - PSRC(:,IJB:IJE,:)) + &
!!$ PCR(:,IJB:IJE,:)*(1.0 + PCR(:,IJB:IJE,:)) * &
!!$ (ZPHAT(:,IJB:IJE,:) - 2.0*PSRC(:,IJB:IJE,:) +ZPHAT(:,IJB+1:IJE+1,:))
- ZFNEG(IIW:IIA,IJB-1:IJE,:) = ZPHAT(IIW:IIA,IJB-1:IJE,:) + &
+!$acc kernels
+ ZFNEG(IIW:IIA,IJB-1:IJE,:) = ZPHAT(IIW:IIA,IJB-1:IJE,:) + &
PCR(IIW:IIA,IJB-1:IJE,:)*(ZPHAT(IIW:IIA,IJB-1:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) + &
PCR(IIW:IIA,IJB-1:IJE,:)*(1.0 + PCR(IIW:IIA,IJB-1:IJE,:)) * &
(ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) +ZPHAT(IIW:IIA,IJB:IJE+1,:))
@@ -3190,14 +3061,15 @@ CASE ('OPEN')
! acc update device(ZFNEG)
#endif
!
-!$acc kernels
IF (GNORTH) THEN
+!$acc kernels
! this is not used
ZFNEG(IIW:IIA,IJB-1,:) = 0.0
!
! negative flux on the NORTH boundary
ZFNEG(IIW:IIA,IJE+1,:) = (ZPHAT(IIW:IIA,IJE+1,:) - PSRC(IIW:IIA,IJE+1,:))*PCR(IIW:IIA,IJE+1,:) + &
ZPHAT(IIW:IIA,IJE+1,:)
+!$acc end kernels
ENDIF
!
! calculate the advection
@@ -3207,7 +3079,6 @@ CASE ('OPEN')
DYF( PCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
#else
-!$acc end kernels
CALL MYM_DEVICE(PRHO,ZRHO_MYM)
!$acc kernels
ZCR_MYM = PCR * ZRHO_MYM * ( ZFPOS(:,:,:)*(0.5+SIGN(0.5,PCR)) + ZFNEG*(0.5-SIGN(0.5,PCR)) )
@@ -3215,28 +3086,31 @@ CASE ('OPEN')
CALL DYF_DEVICE(ZCR_MYM,ZCR_DYF)
!$acc kernels
PR = PSRC * PRHO - ZCR_DYF
+!$acc end kernels
#endif
!
! in OPEN case fix boundary conditions
!
IF (GSOUTH) THEN
+!$acc kernels
WHERE ( PCR(IIW:IIA,IJB,:) <= 0. ) ! OUTFLOW condition
PR(IIW:IIA,IJB-1,:) = 1.0 * 2.*PR(IIW:IIA,IJB,:) - PR(IIW:IIA,IJB+1,:)
ELSEWHERE
PR(IIW:IIA,IJB-1,:) = PR(IIW:IIA,IJB,:)
END WHERE
+!$acc end kernels
ENDIF
!
IF (GNORTH) THEN
+!$acc kernels
WHERE ( PCR(IIW:IIA,IJE,:) >= 0. ) ! OUTFLOW condition
PR(IIW:IIA,IJE+1,:) = 1.0 * 2.*PR(IIW:IIA,IJE,:) - PR(IIW:IIA,IJE-1,:)
ELSEWHERE
PR(IIW:IIA,IJE+1,:) = PR(IIW:IIA,IJE,:)
END WHERE
+!$acc end kernels
ENDIF
!
-!$acc end kernels
-!
!
END SELECT
!
@@ -3260,8 +3134,11 @@ END IF !not L2D
!$acc end data
#ifdef MNH_OPENACC
-END SUBROUTINE PPM_S0_Y_D
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
+#ifdef MNH_OPENACC
END SUBROUTINE PPM_S0_Y
#else
END FUNCTION PPM_S0_Y
@@ -3271,58 +3148,14 @@ END FUNCTION PPM_S0_Y
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-#ifdef MNH_OPENACC
-! ########################################################################
-!!$ FUNCTION PPM_S0_Z(KGRID, PSRC, PCR, PRHO, PTSTEP) &
-!!$ RESULT(PR)
-SUBROUTINE PPM_S0_Z(KGRID, PSRC, PCR, PRHO, PTSTEP, PR)
-
- USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
-
- IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KGRID ! C grid localisation
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-! output source term
-REAL, DIMENSION(:,:,:),INTENT(OUT):: PR
-
-
- INTEGER :: IZFPOS,IZPHAT,IZFNEG,IZRHO_MZM,IZCR_MZM,IZCR_DZF
-
-!$acc data present ( PSRC, PCR, PRHO, PR )
-
- CALL MNH_GET_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MZM,IZCR_MZM,IZCR_DZF)
-
- CALL PPM_S0_Z_D(KGRID, PSRC, PCR, PRHO, PTSTEP , PR, &
- & ZT3D(:,:,:,IZFPOS), ZT3D(:,:,:,IZFNEG), ZT3D(:,:,:,IZPHAT), &
- & ZT3D(:,:,:,IZRHO_MZM),ZT3D(:,:,:,IZCR_MZM),ZT3D(:,:,:,IZCR_DZF) )
-
- CALL MNH_REL_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MZM,IZCR_MZM,IZCR_DZF)
-
-!$acc end data
-
-CONTAINS
-!
-! ########################################################################
-SUBROUTINE PPM_S0_Z_D(KGRID, PSRC, PCR, PRHO, PTSTEP , PR &
- & ,ZFPOS,ZFNEG,ZPHAT &
- & ,ZRHO_MZM,ZCR_MZM,ZCR_DZF )
-
! ########################################################################
+#ifdef MNH_OPENACC
+ SUBROUTINE PPM_S0_Z(KGRID, PSRC, PCR, PRHO, PTSTEP, PR)
#else
-! ########################################################################
FUNCTION PPM_S0_Z(KGRID, PSRC, PCR, PRHO, PTSTEP) &
RESULT(PR)
-! ########################################################################
#endif
+! ########################################################################
!!
!!**** PPM_S0_Z - PPM advection scheme in Z direction in Skamarock 2006
!! notation - NO CONSTRAINTS
@@ -3334,22 +3167,22 @@ SUBROUTINE PPM_S0_Z_D(KGRID, PSRC, PCR, PRHO, PTSTEP , PR &
!!
!-------------------------------------------------------------------------------
!
+USE MODD_CONF
+USE MODD_PARAMETERS
+
USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
+USE MODE_MPPDB
+
+USE MODI_GET_HALO
#ifndef MNH_OPENACC
USE MODI_SHUMAN
#else
USE MODI_SHUMAN_DEVICE
#endif
-USE MODI_GET_HALO
-!
-USE MODD_CONF
-USE MODD_PARAMETERS
-USE MODE_MPPDB
-!
-#ifdef MNH_OPENACC
-USE MODE_MNH_ZWORK, ONLY : IKB,IKE, IKU
-#endif
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -3371,10 +3204,11 @@ REAL, DIMENSION(:,:,:),INTENT(OUT):: PR
!
!* 0.2 Declarations of local variables :
!
-#ifndef MNH_OPENACC
INTEGER:: IKB ! Begining useful area in x,y,z directions
INTEGER:: IKE ! End useful area in x,y,z directions
+INTEGER :: IIU, IJU, IKU
!
+#ifndef MNH_OPENACC
! advection fluxes
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
!
@@ -3382,18 +3216,15 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
#else
! advection fluxes
-REAL, DIMENSION(:,:,:),INTENT(OUT):: ZFPOS, ZFNEG &
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZFPOS, ZFNEG
!
! interpolated variable at cell edges
- & , ZPHAT &
- & , ZRHO_MZM ,ZCR_MZM,ZCR_DZF
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZPHAT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZCR_DZF, ZCR_MZM, ZRHO_MZM
#endif
!
!-------------------------------------------------------------------------------
-!$acc data present ( PSRC, PCR, PRHO, PR , &
-!$acc & ZFPOS, ZFNEG, ZPHAT, ZRHO_MZM, ZCR_MZM, ZCR_DZF )
-
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PCR, "PPM_S0_Z beg:PCR")
@@ -3401,14 +3232,32 @@ IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PSRC,"PPM_S0_Z beg:PSRC")
END IF
+
+iiu = size( PSRC, 1 )
+iju = size( PSRC, 2 )
+iku = size( PSRC, 3 )
+
+#ifdef MNH_OPENACC
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ZFPOS, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFNEG, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZPHAT, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZCR_DZF, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZCR_MZM, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRHO_MZM, IIU, IJU, IKU )
+#endif
+
+!$acc data present ( PSRC, PCR, PRHO, PR , &
+!$acc & ZFPOS, ZFNEG, ZPHAT, ZRHO_MZM, ZCR_MZM, ZCR_DZF )
+
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
-#ifndef MNH_OPENACC
IKB = 1 + JPVEXT
IKE = SIZE(PSRC,3) - JPVEXT
-#endif
!
!-------------------------------------------------------------------------------
!
@@ -3420,9 +3269,7 @@ IKE = SIZE(PSRC,3) - JPVEXT
CALL GET_HALO_D(PSRC, HNAME='UPDATE_HALO_ll::GET_HALO::PSRC')
#endif
!
-#ifdef MNH_OPENACC
!$acc kernels
-#endif
!
ZPHAT(:,:,IKB+1:IKE) = (7.0 * &
(PSRC(:,:,IKB+1:IKE) + PSRC(:,:,IKB:IKE-1)) - &
@@ -3512,8 +3359,11 @@ END IF
!$acc end data
#ifdef MNH_OPENACC
-END SUBROUTINE PPM_S0_Z_D
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
+#ifdef MNH_OPENACC
END SUBROUTINE PPM_S0_Z
#else
END FUNCTION PPM_S0_Z
@@ -3522,71 +3372,14 @@ END FUNCTION PPM_S0_Z
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-#ifdef MNH_OPENACC
-! ########################################################################
-! FUNCTION PPM_S1_X(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, &
-! PTSTEP) RESULT(PR)
- SUBROUTINE PPM_S1_X(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, &
- PTSTEP, PR)
-! ########################################################################
-USE MODE_ll
-use mode_msg
-USE MODE_IO
-USE MODI_SHUMAN_DEVICE
-!
-USE MODD_CONF
-USE MODD_LUNIT
-USE MODD_PARAMETERS
-!
-USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
-!
-INTEGER, INTENT(IN) :: KGRID ! C grid localisation
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-
-INTEGER :: IZPHAT,IZRUT,IZFUP,IZFCOR,IZRPOS,IZRNEG
-
-!$acc data present( PSRC, PCR, PRHO, PRHOT, PR )
-
- call Print_msg( NVERB_ERROR, 'GEN', 'PPM_S1_X', 'OpenACC: not yet implemented' )
-
- CALL MNH_GET_ZT3D(IZPHAT,IZRUT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
-
- CALL PPM_S1_X_D(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, PTSTEP, PR, &
- ZT3D(:,:,:,IZPHAT),ZT3D(:,:,:,IZRUT),ZT3D(:,:,:,IZFUP), &
- ZT3D(:,:,:,IZFCOR),ZT3D(:,:,:,IZRPOS),ZT3D(:,:,:,IZRNEG) )
-
- CALL MNH_REL_ZT3D(IZPHAT,IZRUT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
-
-!$acc end data
-
- CONTAINS
-!
-! ########################################################################
-! FUNCTION PPM_S1_X_D(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, &
-! PTSTEP) RESULT(PR)
- SUBROUTINE PPM_S1_X_D(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, &
- PTSTEP, PR, ZPHAT,ZRUT,ZFUP,ZFCOR,ZRPOS,ZRNEG)
! ########################################################################
+#ifdef MNH_OPENACC
+ SUBROUTINE PPM_S1_X(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, PTSTEP, PR)
#else
-! ########################################################################
FUNCTION PPM_S1_X(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, &
PTSTEP) RESULT(PR)
-! ########################################################################
#endif
+! ########################################################################
!!
!!**** PPM_S1_X - PPM advection scheme in X direction in Skamarock 2006
!! notation - with flux limiting for monotonicity
@@ -3602,6 +3395,9 @@ USE MODD_CONF
USE MODD_PARAMETERS
USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifndef MNH_OPENACC
@@ -3640,6 +3436,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
!
INTEGER:: IIB,IJB,IKB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE,IKE ! End useful area in x,y,z directions
+INTEGER :: IIU, IJU, IKU
!
#ifndef MNH_OPENACC
! variable at cell edges
@@ -3652,13 +3449,13 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFUP, ZFCOR
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZRPOS, ZRNEG
#else
! variable at cell edges
-REAL, DIMENSION(:,:,:) :: ZPHAT, ZRUT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZPHAT, ZRUT
!
! advection fluxes, upwind and correction
-REAL, DIMENSION(:,:,:) :: ZFUP, ZFCOR
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZFUP, ZFCOR
!
! ratios for limiting the correction flux
-REAL, DIMENSION(:,:,:) :: ZRPOS, ZRNEG
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRPOS, ZRNEG
#endif
!
! variables for limiting the correction flux
@@ -3670,9 +3467,9 @@ INTEGER :: II, IJ, IK
INTEGER :: IRESP ! for prints
!
!-------------------------------------------------------------------------------
-
-!$acc data present( PSRC, PCR, PRHO, PRHOT, PR, &
-!$acc & ZPHAT, ZRUT, ZFUP, ZFCOR, ZRPOS, ZRNEG )
+#ifdef MNH_OPENACC
+call Print_msg( NVERB_ERROR, 'GEN', 'PPM_S1_X', 'OpenACC: not yet implemented' )
+#endif
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
@@ -3682,6 +3479,26 @@ IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PSRC, "PPM_S1_X beg:PSRC")
END IF
+
+iiu = size( PSRC, 1 )
+iju = size( PSRC, 2 )
+iku = size( PSRC, 3 )
+
+#ifdef MNH_OPENACC
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ZPHAT, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRUT, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFUP, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFCOR, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRPOS, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRNEG, IIU, IJU, IKU )
+#endif
+
+!$acc data present( PSRC, PCR, PRHO, PRHOT, PR, &
+!$acc & ZPHAT, ZRUT, ZFUP, ZFCOR, ZRPOS, ZRNEG )
+
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -3875,7 +3692,11 @@ END IF
!$acc end data
#ifdef MNH_OPENACC
- END SUBROUTINE PPM_S1_X_D
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
+
+#ifdef MNH_OPENACC
END SUBROUTINE PPM_S1_X
#else
END FUNCTION PPM_S1_X
@@ -3884,71 +3705,15 @@ END FUNCTION PPM_S1_X
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-#ifdef MNH_OPENACC
! ########################################################################
-! FUNCTION PPM_S1_Y(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, &
-! PTSTEP) RESULT(PR)
- SUBROUTINE PPM_S1_Y(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, &
+#ifdef MNH_OPENACC
+ SUBROUTINE PPM_S1_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PRHOT, &
PTSTEP, PR)
-! ########################################################################
-USE MODE_ll
-USE MODE_IO
-use mode_msg
-USE MODI_SHUMAN_DEVICE
-!
-USE MODD_CONF
-USE MODD_LUNIT
-USE MODD_PARAMETERS
-!
-USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
-!
-INTEGER, INTENT(IN) :: KGRID ! C grid localisation
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-
-INTEGER :: IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG
-
-!$acc data present( PSRC, PCR, PRHO, PRHOT, PR )
-
- call Print_msg( NVERB_ERROR, 'GEN', 'PPM_S1_Y', 'OpenACC: not yet implemented' )
-
- CALL MNH_GET_ZT3D(IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
-
- CALL PPM_S1_Y_D(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, PTSTEP, PR, &
- ZT3D(:,:,:,IZPHAT),ZT3D(:,:,:,IZRVT),ZT3D(:,:,:,IZFUP), &
- ZT3D(:,:,:,IZFCOR),ZT3D(:,:,:,IZRPOS),ZT3D(:,:,:,IZRNEG) )
-
- CALL MNH_REL_ZT3D(IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
-
-!$acc end data
-
- CONTAINS
-!
-! ########################################################################
-! FUNCTION PPM_S1_Y_D(HLBCY, KGRID, PSRC, PCR, PRHO, PRHOT, &
-! PTSTEP) RESULT(PR)
- SUBROUTINE PPM_S1_Y_D(HLBCY, KGRID, PSRC, PCR, PRHO, PRHOT, &
- PTSTEP, PR, ZPHAT,ZRVT,ZFUP,ZFCOR,ZRPOS,ZRNEG)
-! ########################################################################
#else
-! ########################################################################
FUNCTION PPM_S1_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PRHOT, &
PTSTEP) RESULT(PR)
-! ########################################################################
#endif
+! ########################################################################
!!
!!**** PPM_S1_Y - PPM advection scheme in Y direction in Skamarock 2006
!! notation - with flux limiting for monotonicity
@@ -3960,7 +3725,13 @@ INTEGER :: IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG
!!
!-------------------------------------------------------------------------------
!
+USE MODD_CONF
+USE MODD_PARAMETERS
+
USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifndef MNH_OPENACC
@@ -3970,12 +3741,6 @@ USE MODI_SHUMAN
USE MODI_SHUMAN_DEVICE
#endif
!
-USE MODD_CONF
-USE MODD_PARAMETERS
-!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-#ifdef MNH_OPENACC
-USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
-#endif
!
IMPLICIT NONE
!
@@ -4006,6 +3771,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
!
INTEGER:: IIB,IJB,IKB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE,IKE ! End useful area in x,y,z directions
+INTEGER :: IIU, IJU, IKU
!
#ifndef MNH_OPENACC
! variable at cell edges
@@ -4018,13 +3784,13 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFUP, ZFCOR
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZRPOS, ZRNEG
#else
! variable at cell edges
-REAL, DIMENSION(:,:,:) :: ZPHAT, ZRVT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZPHAT, ZRVT
!
! advection fluxes, upwind and correction
-REAL, DIMENSION(:,:,:) :: ZFUP, ZFCOR
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZFUP, ZFCOR
!
! ratios for limiting the correction flux
-REAL, DIMENSION(:,:,:) :: ZRPOS, ZRNEG
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRPOS, ZRNEG
#endif
!
! variables for limiting the correction flux
@@ -4037,9 +3803,9 @@ INTEGER :: II, IJ, IK
INTEGER :: IRESP ! Return code of FM-routines
!
!-------------------------------------------------------------------------------
-
-!$acc data present( PSRC, PCR, PRHO, PRHOT, PR , &
-!$acc & ZPHAT, ZRVT, ZFUP, ZFCOR, ZRPOS, ZRNEG )
+#ifdef MNH_OPENACC
+call Print_msg( NVERB_ERROR, 'GEN', 'PPM_S1_Y', 'OpenACC: not yet implemented' )
+#endif
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
@@ -4050,7 +3816,25 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PSRC, "PPM_S1_Y beg:PSRC")
END IF
-!
+iiu = size( PSRC, 1 )
+iju = size( PSRC, 2 )
+iku = size( PSRC, 3 )
+
+#ifdef MNH_OPENACC
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ZPHAT, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRVT, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFUP, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFCOR, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRPOS, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRNEG, IIU, IJU, IKU )
+#endif
+
+!$acc data present( PSRC, PCR, PRHO, PRHOT, PR , &
+!$acc & ZPHAT, ZRVT, ZFUP, ZFCOR, ZRPOS, ZRNEG )
+
IF ( L2D ) THEN
PR = PSRC*PRHO
!RETURN
@@ -4247,7 +4031,11 @@ END IF !not L2D
!$acc end data
#ifdef MNH_OPENACC
- END SUBROUTINE PPM_S1_Y_D
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
+
+#ifdef MNH_OPENACC
END SUBROUTINE PPM_S1_Y
#else
END FUNCTION PPM_S1_Y
@@ -4256,68 +4044,14 @@ END FUNCTION PPM_S1_Y
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-#ifdef MNH_OPENACC
-!
-! ########################################################################
-! FUNCTION PPM_S1_Z(KGRID, PSRC, PCR, PRHO, PRHOT, &
-! PTSTEP) RESULT(PR)
- SUBROUTINE PPM_S1_Z(KGRID, PSRC, PCR, PRHO, PRHOT, &
- PTSTEP, PR)
-! ########################################################################
-USE MODE_ll
-USE MODE_IO
-use mode_msg
-
-USE MODI_SHUMAN_DEVICE
-!
-USE MODD_CONF
-USE MODD_LUNIT
-USE MODD_PARAMETERS
-!
-USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KGRID ! C grid localisation
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-
-INTEGER :: IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG
-
-!$acc data present( PSRC, PCR, PRHO, PRHOT, PR )
-
- call Print_msg( NVERB_ERROR, 'GEN', 'PPM_S1_Z', 'OpenACC: not yet implemented' )
-
- CALL MNH_GET_ZT3D(IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
-
- CALL PPM_S1_Z_D(KGRID, PSRC, PCR, PRHO, PRHOT, PTSTEP, PR, &
- ZT3D(:,:,:,IZPHAT),ZT3D(:,:,:,IZRVT),ZT3D(:,:,:,IZFUP), &
- ZT3D(:,:,:,IZFCOR),ZT3D(:,:,:,IZRPOS),ZT3D(:,:,:,IZRNEG) )
-
- CALL MNH_REL_ZT3D(IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
-
-!$acc end data
-
- CONTAINS
-! ########################################################################
- SUBROUTINE PPM_S1_Z_D(KGRID, PSRC, PCR, PRHO, PRHOT, PTSTEP, &
- PR, ZPHAT,ZRVT,ZFUP,ZFCOR,ZRPOS,ZRNEG)
! ########################################################################
+#ifdef MNH_OPENACC
+ SUBROUTINE PPM_S1_Z(KGRID, PSRC, PCR, PRHO, PRHOT, PTSTEP, PR)
#else
-! ########################################################################
FUNCTION PPM_S1_Z(KGRID, PSRC, PCR, PRHO, PRHOT, PTSTEP) &
RESULT(PR)
-! ########################################################################
#endif
+! ########################################################################
!!
!!**** PPM_S1_Z - PPM advection scheme in Z direction in Skamarock 2006
!! notation - with flux limiting for monotonicity
@@ -4329,7 +4063,13 @@ INTEGER :: IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG
!!
!-------------------------------------------------------------------------------
!
+USE MODD_CONF
+USE MODD_PARAMETERS
+
USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifndef MNH_OPENACC
@@ -4338,14 +4078,7 @@ USE MODI_SHUMAN
USE MODI_SHUMAN
USE MODI_SHUMAN_DEVICE
#endif
-!
-USE MODD_CONF
-USE MODD_PARAMETERS
-!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-#ifdef MNH_OPENACC
-USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
-#endif
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -4373,6 +4106,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
!
INTEGER:: IIB,IJB,IKB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE,IKE ! End useful area in x,y,z directions
+INTEGER :: IIU, IJU, IKU
!
#ifndef MNH_OPENACC
! variable at cell edges
@@ -4385,13 +4119,13 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFUP, ZFCOR
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZRPOS, ZRNEG
#else
! variable at cell edges
-REAL, DIMENSION(:,:,:) :: ZPHAT, ZRVT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZPHAT, ZRVT
!
! advection fluxes, upwind and correction
-REAL, DIMENSION(:,:,:) :: ZFUP, ZFCOR
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZFUP, ZFCOR
!
! ratios for limiting the correction flux
-REAL, DIMENSION(:,:,:) :: ZRPOS, ZRNEG
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRPOS, ZRNEG
#endif
!
! variables for limiting the correction flux
@@ -4402,9 +4136,9 @@ REAL, PARAMETER :: ZEPS = 1.0E-16
INTEGER :: II, IJ, IK
!
!-------------------------------------------------------------------------------
-
-!$acc data present( PSRC, PCR, PRHO, PRHOT, PR, &
-!$acc & ZPHAT, ZRVT, ZFUP, ZFCOR, ZRPOS, ZRNEG )
+#ifdef MNH_OPENACC
+call Print_msg( NVERB_ERROR, 'GEN', 'PPM_S1_Z', 'OpenACC: not yet implemented' )
+#endif
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
@@ -4415,6 +4149,25 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PSRC, "PPM_S1_Z beg:PSRC")
END IF
+iiu = size( PSRC, 1 )
+iju = size( PSRC, 2 )
+iku = size( PSRC, 3 )
+
+#ifdef MNH_OPENACC
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ZPHAT, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRVT, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFUP, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZFCOR, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRPOS, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRNEG, IIU, IJU, IKU )
+#endif
+
+!$acc data present( PSRC, PCR, PRHO, PRHOT, PR, &
+!$acc & ZPHAT, ZRVT, ZFUP, ZFCOR, ZRPOS, ZRNEG )
+
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -4672,7 +4425,11 @@ END IF
!$acc end data
#ifdef MNH_OPENACC
- END SUBROUTINE PPM_S1_Z_D
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
+
+#ifdef MNH_OPENACC
END SUBROUTINE PPM_S1_Z
#else
END FUNCTION PPM_S1_Z