Skip to content
Snippets Groups Projects
Commit 01b48e73 authored by ESCOBAR Juan's avatar ESCOBAR Juan
Browse files

Juan 301/10/2013: convert from PgiAcc/region to OpenAcc/kernels directive &... 

Juan 301/10/2013: convert from PgiAcc/region to OpenAcc/kernels directive & test some loop vector(24) sheduling
parent de4a20a1
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 102 additions and 92 deletions
MNH/ppm.f90
+ 102
− 92
View file @ 01b48e73
......@@ -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
!
!-------------------------------------------------------------------------------
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme