Skip to content
Snippets Groups Projects
Commit 45610874 authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 18/07/2019: OpenACC: various developments

parent 50c219fa
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/MNH/advec_4th_order_aux.f90
+ 8
− 9
View file @ 45610874
......@@ -159,7 +159,6 @@ END IF
! ------------------------------
!
#ifdef _OPENACC
call Print_msg( NVERB_WARNING, 'GEN', 'ADVEC_4TH_ORDER_ALGO', 'OpenACC: not yet tested' )
CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_WEST,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_WEST')
CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_EAST,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_EAST')
CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_SOUTH,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_SOUTH')
......@@ -243,9 +242,6 @@ ZHALO2_EAST(:,:) = TPHALO2%EAST(:,:)
!
CASE ('OPEN','WALL','NEST')
!
#ifdef _OPENACC
call Print_msg( NVERB_WARNING, 'GEN', 'ADVEC_4TH_ORDER_ALGO', 'OpenACC: HLBCX(1) AND OPEN/WALL/NEST not yet tested' )
#endif
ZHALO2_WEST(:,:) = TPHALO2%WEST(:,:)
ZHALO2_EAST(:,:) = TPHALO2%EAST(:,:)
!$acc update device (ZHALO2_WEST,ZHALO2_EAST)
......@@ -374,9 +370,6 @@ ZHALO2_NORTH(:,:) = TPHALO2%NORTH(:,:)
!
CASE ('OPEN','WALL','NEST')
!
#ifdef _OPENACC
call Print_msg( NVERB_WARNING, 'GEN', 'ADVEC_4TH_ORDER_ALGO', 'OpenACC: HLBCX(2) AND OPEN/WALL/NEST not yet tested' )
#endif
ZHALO2_SOUTH(:,:) = TPHALO2%SOUTH(:,:)
ZHALO2_NORTH(:,:) = TPHALO2%NORTH(:,:)
!$acc update device (ZHALO2_SOUTH,ZHALO2_NORTH)
......@@ -518,7 +511,8 @@ IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
! side
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF4 ! result at mass
! localization
! localization
!$acc declare present(PA, PMZF4)
!
!* 0.2 Declarations of local variables
!
......@@ -546,6 +540,7 @@ IIJU = IIU*IJU
JIJKOR1 = 1 + IIJU
JIJKEND1 = 2*IIJU
!
!$acc kernels
!CDIR NODEP
!OCL NOVREC
DO JIJK=JIJKOR1 , JIJKEND1
......@@ -576,6 +571,7 @@ END DO
DO JIJ=1,IIJU
PMZF4(JIJ,1,IKU) = -999.
END DO
!$acc end kernels
!
!-------------------------------------------------------------------------------
!
......@@ -638,7 +634,8 @@ IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
! localization
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM4 ! result at flux
! localization
! localization
!$acc declare present(PA, PMZM4)
!
!* 0.2 Declarations of local variables
!
......@@ -665,6 +662,7 @@ IIJU = IIU*IJU
JIJKOR1 = 1 + IIJU
JIJKEND1 = JIJKOR1 + IIJU
!
!$acc kernels
!CDIR NODEP
!OCL NOVREC
DO JIJK=JIJKOR1 , JIJKEND1
......@@ -692,6 +690,7 @@ END DO
DO JIJ=1,IIJU
PMZM4(JIJ,1,1) = -999.
END DO
!$acc end kernels
!
!-------------------------------------------------------------------------------
!
......
src/MNH/advec_weno_k_2_aux.f90
+ 3
− 2
View file @ 45610874
......@@ -753,8 +753,9 @@ REAL, PARAMETER :: ZEPS = 1.0E-15
!
!-------------------------------------------------------------------------------
IF (MPPDB_INITIALIZED) THEN
!Check all OUT arrays
CALL MPPDB_CHECK(PR,"ADVEC_WENO_K_2_MX end:PR")
!Check all IN arrays
CALL MPPDB_CHECK(PSRC, "ADVEC_WENO_K_2_MX beg:PSRC")
CALL MPPDB_CHECK(PRUCT,"ADVEC_WENO_K_2_MX beg:PRUCT")
END IF
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
......
src/MNH/advection_uvw_cen.f90
+ 0
− 3
View file @ 45610874
......@@ -196,9 +196,6 @@ INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! index values for the physical subdomain
INTEGER :: IZ1, IZ2
#endif
!
#ifdef _OPENACC
call Print_msg( NVERB_WARNING, 'GEN', 'ADVECTION_UVW_CEN', 'OpenACC: not yet tested' )
#endif
!-------------------------------------------------------------------------------
!
IF (MPPDB_INITIALIZED) THEN
......
src/MNH/advecuvw_4th.f90
+ 59
− 85
View file @ 45610874
......@@ -180,13 +180,12 @@ USE MODD_PARAMETERS
USE MODE_ll
use mode_mppdb
#ifdef _OPENACC
use mode_msg
#endif
USE MODI_ADVEC_4TH_ORDER_AUX
#ifndef _OPENACC
USE MODI_SHUMAN
#else
USE MODI_SHUMAN_DEVICE
#endif
!
IMPLICIT NONE
......@@ -237,7 +236,7 @@ REAL, DIMENSION(IIU,IJU,IKU) :: ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4
INTEGER :: II
#endif
!
#ifdef _OPENACC
#if 0
#define dxm(PDXM,PA) PDXM(2:IIU,:,:) = PA(2:IIU,:,:) - PA(1:IIU-1,:,:) ; PDXM(1,:,:) = PDXM(IIU-2*JPHEXT+1,:,:) ! DXM(PDXM,PA)
#define mxf(PMXF,PA) PMXF(1:IIU-1,:,:) = 0.5*( PA(2:IIU,:,:)+PA(1:IIU-1,:,:) ) ; PMXF(IIU,:,:) = PMXF(2*JPHEXT,:,:) ! MXF(PMXF,PA)
#define mxm(PMXM,PA) PMXM(2:IIU,:,:) = 0.5*( PA(2:IIU,:,:)+PA(1:IIU-1,:,:) ) ; PMXM(1,:,:) = PMXM(IIU-2*JPHEXT+1,:,:) ! MXM(PMXM,PA)
......@@ -256,9 +255,6 @@ INTEGER :: II
PMZF4(:,:,1) = 0.5*( PA(:,:,2)+PA(:,:,1) ) ; PMZF4(:,:,IKU-1) = 0.5*( PA(:,:,IKU)+PA(:,:,IKU-1) ) ; PMZF4(:,:,IKU) = -999.
#endif
!
#ifdef _OPENACC
call Print_msg( NVERB_WARNING, 'GEN', 'ADVECUVW_4TH', 'OpenACC: not yet tested' )
#endif
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
......@@ -307,41 +303,33 @@ PRUS(:,:,:) = PRUS(:,:,:) &
PRUS(:,:,:) = PRUS(:,:,:) &
-DZF(1,IKU,1, MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) )
#else
! pcopy(prus) pcopyin(pruct,ZMEANX) create(ZTEMP1,ZTEMP2,ZTEMP3)
!!$PRUS(:,:,:) = PRUS(:,:,:) &
!!$ -DXM( MXF(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!$acc kernels present(ZMEANX) present(PRUS)
mxf(ZTEMP1,PRUCT)
call mxf_device(PRUCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANX
dxm(ZTEMP3,ZTEMP2)
!$acc end kernels
call dxm_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP3
!$acc end kernels
!$acc end kernels
!
!!$PRUS(:,:,:) = PRUS(:,:,:) &
!!$ -DYF( MXM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!$acc kernels present(ZMEANY) present(PRUS)
mxm(ZTEMP1,PRVCT)
call mxm_device(PRVCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANY
dyf(ZTEMP3,ZTEMP2)
!$acc end kernels
call dyf_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP3
!$acc end kernels
!$acc end kernels
!
!!$PRUS(:,:,:) = PRUS(:,:,:) &
!!$ -DZF( MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) )
!$acc kernels present(PUT,PRUS)
mzm4(ZTEMP1,PUT)
mxm(ZTEMP2,PRWCT)
ZTEMP1 = MZM4( PUT )
call mxm_device(PRWCT,ZTEMP2)
!$acc kernels
ZTEMP3 = ZTEMP1 * ZTEMP2
dzf(ZTEMP4,ZTEMP3)
!$acc end kernels
call dzf_device(1,IKU,1,ZTEMP3,ZTEMP4)
!$acc kernels
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP4
!$acc end kernels
!$acc end kernels
#endif
!
!
......@@ -364,42 +352,35 @@ PRVS(:,:,:) = PRVS(:,:,:) &
PRVS(:,:,:) = PRVS(:,:,:) &
-DZF(1,IKU,1, MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) )
#else
!!$PRVS(:,:,:) = PRVS(:,:,:) &
!!$ -DXF( MYM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!$acc kernels present(ZMEANX) present(PRVS)
mym(ZTEMP1,PRUCT)
call mym_device(PRUCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANX
dxf(ZTEMP3,ZTEMP2)
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
!$acc end kernels
!$acc end kernels
call dxf_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
!$acc end kernels
!
!!$PRVS(:,:,:) = PRVS(:,:,:) &
!!$ -DYM( MYF(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!$acc kernels present(ZMEANY) present(PRVS)
myf(ZTEMP1,PRVCT)
call myf_device(PRVCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANY
dym(ZTEMP3,ZTEMP2)
!$acc end kernels
call dym_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
!$acc end kernels
!$acc end kernels
!
!!$PRVS(:,:,:) = PRVS(:,:,:) &
!!$ -DZF( MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) )
!$acc kernels present(PVT,PRVS)
mym(ZTEMP1,PRWCT)
mzm4(ZTEMP2,PVT)
call mym_device(PRWCT,ZTEMP1)
ZTEMP2 = MZM4( PVT )
!$acc kernels
ZTEMP3 = ZTEMP1 * ZTEMP2
dzf(ZTEMP4,ZTEMP3)
!$acc end kernels
call dzf_device(1,IKU,1,ZTEMP3,ZTEMP4)
!$acc kernels
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP4
!$acc end kernels
#endif
CALL MPPDB_CHECK(PRUCT,"ADVECUVW_4TH 02: PRUCT")
!
!
IGRID = 4
......@@ -422,38 +403,31 @@ PRWS(:,:,:) = PRWS(:,:,:) &
PRWS(:,:,:) = PRWS(:,:,:) &
-DZM(1,IKU,1, MZF(1,IKU,1,PRWCT(:,:,:))*MZF4(PWT(:,:,:)) )
#else
!!$PRWS(:,:,:) = PRWS(:,:,:) &
!!$ -DXF( MZM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!$acc kernels present(ZMEANX) present(PRWS)
mzm(ZTEMP1,PRUCT)
call mzm_device(PRUCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANX
dxf(ZTEMP3,ZTEMP2)
!$acc end kernels
call dxf_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP3
!$acc end kernels
!
!!$PRWS(:,:,:) = PRWS(:,:,:) &
!!$ -DYF( MZM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!$acc kernels present(ZMEANY) present(PRWS)
mzm(ZTEMP1,PRVCT)
call mzm_device(PRVCT,ZTEMP1)
!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANY
dyf(ZTEMP3,ZTEMP2)
!$acc end kernels
call dyf_device(ZTEMP2,ZTEMP3)
!$acc kernels
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP3
!$acc end kernels
!
!!$PRWS(:,:,:) = PRWS(:,:,:) &
!!$ -DZM( MZF(PRWCT(:,:,:))*MZF4(PWT(:,:,:)) )
!$acc kernels present(PWT,PRWS)
mzf(ZTEMP1,PRWCT)
mzf4(ZTEMP2,PWT)
ZTEMP1 = ZTEMP1 * ZTEMP2
dzm(ZTEMP4,ZTEMP1)
call mzf_device(1,IKU,1,PRWCT,ZTEMP1)
ZTEMP2 = MZF4( PWT )
!$acc kernels
ZTEMP1 = ZTEMP1 * ZTEMP2
!$acc end kernels
call dzm_device(1,IKU,1,ZTEMP1,ZTEMP4)
!$acc kernels
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP4
!$acc end kernels
#endif
......
src/MNH/prandtl.f90
+ 0
− 3
View file @ 45610874
......@@ -472,9 +472,6 @@ call Print_msg( NVERB_WARNING, 'GEN', 'PRANDTL', 'OpenACC: 1DIM not yet tested'
ELSE IF (L2D) THEN ! 3D case in a 2D model
!
IF (KRR /= 0) THEN ! moist 3D case
#ifdef _OPENACC
call Print_msg( NVERB_WARNING, 'GEN', 'PRANDTL', 'OpenACC: L2D=.T. and KRR/=0 not yet tested' )
#endif
#ifndef _OPENACC
#ifndef MNH_BITREP
PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
......
src/MNH/turb_hor_dyn_corr.f90
+ 0
− 5
View file @ 45610874
......@@ -573,14 +573,9 @@ END IF
! Complete the U tendency
#ifndef _OPENACC
IF (.NOT. LFLAT) THEN
CALL MPPDB_CHECK3DM("before turb_corr:PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ",PRECISION,&
& PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ )
PRUS(:,:,:)=PRUS &
-DXM(PRHODJ * ZFLX / MXF(PDXX) ) &
+DZF(1,IKU,1, PDZX / MZM(1,IKU,1,PDXX) * MXM( MZM(1,IKU,1,PRHODJ*ZFLX) * PINV_PDZZ ) )
CALL MPPDB_CHECK3DM("after turb_corr:PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ",PRECISION,&
& PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ )
ELSE
PRUS(:,:,:)=PRUS -DXM(PRHODJ * ZFLX / MXF(PDXX) )
END IF
......
src/MNH/turb_hor_vw.f90
+ 3
− 1
View file @ 45610874
......@@ -194,7 +194,9 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) &
:: ZFLX,ZWORK
! work arrays
!
!$acc declare create(ZFLX)
!$acc declare device_resident(ZWORK)
!
!! REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZVPTV
INTEGER :: IKB,IKE,IKU
! Index values for the Beginning and End
......
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