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

Philippe + Maxime MOGE 12/09/2016: imported + adapted gradient_u.f90 from Maxime's work

parent ce6f3ddd
No related branches found
No related tags found
No related merge requests found
......@@ -28,6 +28,22 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_U_M ! result mass point
END FUNCTION GX_U_M
!
!
#ifdef _OPENACC
SUBROUTINE GX_U_M_DEVICE(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX,PGX_U_M_DEVICE)
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGX_U_M_DEVICE ! result mass point
!$acc declare present(PA,PDXX,PDZZ,PDZX,PGX_U_M_DEVICE)
!
END SUBROUTINE GX_U_M_DEVICE
#endif
!
!
FUNCTION GY_U_UV(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_U_UV)
!
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
......@@ -42,6 +58,22 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_U_UV ! result UV point
END FUNCTION GY_U_UV
!
!
#ifdef _OPENACC
SUBROUTINE GY_U_UV_DEVICE(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY,PGY_U_UV_DEVICE)
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGY_U_UV_DEVICE ! result UV point
!$acc declare present(PA,PDYY,PDZZ,PDZY,PGY_U_UV_DEVICE)
!
END SUBROUTINE GY_U_UV_DEVICE
#endif
!
!
FUNCTION GZ_U_UW(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_U_UW)
!
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
......@@ -53,6 +85,21 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_U_UW ! result UW point
!
END FUNCTION GZ_U_UW
!
!
#ifdef _OPENACC
SUBROUTINE GZ_U_UW_DEVICE(KKA,KKU,KL,PA,PDZZ,PGZ_U_UW_DEVICE)
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGZ_U_UW_DEVICE ! result UW point
!$acc declare present(PA,PDZZ,PGZ_U_UW_DEVICE)
!
END SUBROUTINE GZ_U_UW_DEVICE
#endif
!
!
END INTERFACE
!
END MODULE MODI_GRADIENT_U
......@@ -158,6 +205,74 @@ END IF
END FUNCTION GX_U_M
!
!
#ifdef _OPENACC
! #######################################################
SUBROUTINE GX_U_M_DEVICE(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX,PGX_U_M_DEVICE)
! #######################################################
!
!* 0. DECLARATIONS
!
!
USE MODI_SHUMAN_DEVICE
USE MODD_CONF
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments and result
!
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGX_U_M_DEVICE ! result mass point
!$acc declare present(PA,PDXX,PDZZ,PDZX,PGX_U_M_DEVICE)
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE
!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE)
!
!
!* 0.2 declaration of local variables
!
! NONE
!
!----------------------------------------------------------------------------
!
!* 1. DEFINITION of GX_U_M_DEVICE
! --------------------
IF (.NOT. LFLAT) THEN
CALL DXF_DEVICE(PA,ZTMP1_DEVICE)
CALL DZM_DEVICE(KKA,KKU,KL,PA,ZTMP2_DEVICE)
!$acc kernels
ZTMP3_DEVICE = PDZX * ZTMP2_DEVICE
!$acc end kernels
CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP2_DEVICE)
!$acc kernels
ZTMP3_DEVICE = ZTMP2_DEVICE / PDZZ
!$acc end kernels
CALL MZF_DEVICE(KKA,KKU,KL,ZTMP3_DEVICE,ZTMP2_DEVICE)
CALL MXF_DEVICE(PDXX,ZTMP3_DEVICE)
!$acc kernels
PGX_U_M_DEVICE(:,:,:)= ( ZTMP1_DEVICE - ZTMP2_DEVICE ) / ZTMP3_DEVICE
!$acc end kernels
ELSE
CALL DXF_DEVICE(PA,ZTMP1_DEVICE)
CALL MXF_DEVICE(PDXX,ZTMP2_DEVICE)
!$acc kernels
PGX_U_M_DEVICE(:,:,:)= ZTMP1_DEVICE / ZTMP2_DEVICE
!$acc end kernels
END IF
!
!
!----------------------------------------------------------------------------
!
END SUBROUTINE GX_U_M_DEVICE
#endif
!
!
! #########################################################
FUNCTION GY_U_UV(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_U_UV)
! #########################################################
......@@ -256,6 +371,76 @@ END IF
END FUNCTION GY_U_UV
!
!
#ifdef _OPENACC
! #########################################################
SUBROUTINE GY_U_UV_DEVICE(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY,PGY_U_UV_DEVICE)
! #########################################################
!
!* 0. DECLARATIONS
!
!
USE MODI_SHUMAN_DEVICE
USE MODD_CONF
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments and result
!
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGY_U_UV_DEVICE ! result UV point
!$acc declare present(PA,PDYY,PDZZ,PDZY,PGY_U_UV_DEVICE)
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE
!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE)
!
!
!* 0.2 declaration of local variables
!
! NONE
!
!----------------------------------------------------------------------------
!
!* 1. DEFINITION of GY_U_UV_DEVICE
! ---------------------
!
IF (.NOT. LFLAT) THEN
CALL DZM_DEVICE(KKA,KKU,KL,PA,ZTMP1_DEVICE)
CALL MXM_DEVICE(PDZZ,ZTMP2_DEVICE)
!$acc kernels
ZTMP3_DEVICE = ZTMP1_DEVICE/ZTMP2_DEVICE
!$acc end kernels
CALL MYM_DEVICE(ZTMP3_DEVICE,ZTMP1_DEVICE)
CALL MXM_DEVICE(PDZY,ZTMP2_DEVICE)
!$acc kernels
ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
!$acc end kernels
CALL MZF_DEVICE(KKA,KKU,KL, ZTMP3_DEVICE,ZTMP2_DEVICE )
CALL DYM_DEVICE(PA,ZTMP1_DEVICE)
CALL MXM_DEVICE(PDYY,ZTMP3_DEVICE)
!$acc kernels
PGY_U_UV_DEVICE(:,:,:)= ( ZTMP1_DEVICE - ZTMP2_DEVICE ) / ZTMP3_DEVICE
!$acc end kernels
ELSE
CALL DYM_DEVICE(PA,ZTMP1_DEVICE)
CALL MXM_DEVICE(PDYY,ZTMP2_DEVICE)
!$acc kernels
PGY_U_UV_DEVICE(:,:,:)= ZTMP1_DEVICE / ZTMP2_DEVICE
!$acc end kernels
END IF
!
!----------------------------------------------------------------------------
!
END SUBROUTINE GY_U_UV_DEVICE
#endif
!
!
! #######################################################
FUNCTION GZ_U_UW(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_U_UW)
! #######################################################
......@@ -337,3 +522,51 @@ PGZ_U_UW(:,:,:)= DZM(KKA,KKU,KL,PA) / MXM(PDZZ)
!----------------------------------------------------------------------------
!
END FUNCTION GZ_U_UW
!
!
#ifdef _OPENACC
! #######################################################
SUBROUTINE GZ_U_UW_DEVICE(KKA,KKU,KL,PA,PDZZ,PGZ_U_UW_DEVICE)
! #######################################################
!
!* 0. DECLARATIONS
!
!
USE MODI_SHUMAN_DEVICE
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments and result
!
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGZ_U_UW_DEVICE ! result UW point
!$acc declare present(PA,PDZZ,PGZ_U_UW_DEVICE)
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
!
!
!* 0.2 declaration of local variables
!
! NONE
!
!----------------------------------------------------------------------------
!
!* 1. DEFINITION of GZ_U_UW_DEVICE
! ---------------------
!
CALL DZM_DEVICE(KKA,KKU,KL,PA,ZTMP1_DEVICE)
CALL MXM_DEVICE(PDZZ,ZTMP2_DEVICE)
!$acc kernels
PGZ_U_UW_DEVICE(:,:,:)= ZTMP1_DEVICE / ZTMP2_DEVICE
!$acc end kernels
!
!----------------------------------------------------------------------------
!
END SUBROUTINE GZ_U_UW_DEVICE
#endif
......@@ -44,6 +44,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion do
REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
!$acc declare present(PDXX, PDYY, PDZZ, PDZX, PDZY)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
! Director Cosinus along z directions at surface w-point
......@@ -63,8 +64,11 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
!
! Variables at t-1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
!$acc declare copyin(PUM,PVM,PWM,PTHLM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
!$acc copyin(PRM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
!$acc copyin(PSVM)
REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
! maximum slope direction
REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
......@@ -192,6 +196,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion do
REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
!$acc declare present(PDXX, PDYY, PDZZ, PDZX, PDZY)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
! Director Cosinus along z directions at surface w-point
......@@ -211,7 +216,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
!
! Variables at t-1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
!$acc copyin(PTHLM)
!$acc declare copyin(PUM,PVM,PWM,PTHLM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
!$acc copyin(PRM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
......@@ -251,6 +256,7 @@ CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: GX_U_M_PUM
REAL, DIMENSION(SIZE(PVM,1),SIZE(PVM,2),SIZE(PVM,3)) :: GY_V_M_PVM
REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: GZ_W_M_PWM
!$acc declare create(GX_U_M_PUM)
REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: GZ_W_M_ZWP
REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZMZF_DZZ ! MZF(PDZZ)
REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZDFDDWDZ ! formal derivative of the
......@@ -290,7 +296,12 @@ IKU = SIZE(PUM,3)
!
ZDIRSINZW(:,:) = SQRT( 1. - PDIRCOSZW(:,:)**2 )
!
#ifndef _OPENACC
GX_U_M_PUM = GX_U_M(1,IKU,1,PUM,PDXX,PDZZ,PDZX)
#else
CALL GX_U_M_DEVICE(1,IKU,1,PUM,PDXX,PDZZ,PDZX,GX_U_M_PUM)
!$acc update self(GX_U_M_PUM)
#endif
IF (.NOT. L2D) THEN
GY_V_M_PVM = GY_V_M(1,IKU,1,PVM,PDYY,PDZZ,PDZY)
END IF
......
......@@ -46,6 +46,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
!$acc declare present(PDXX, PDYY, PDZZ, PDZX, PDZY)
REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
! Director Cosinus along z directions at surface w-point
REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
......@@ -64,6 +65,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
!
! Variables at t-1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM
!$acc declare copyin(PUM,PVM)
REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
! maximum slope direction
REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
......@@ -175,6 +177,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
!$acc declare present(PDXX, PDYY, PDZZ, PDZX, PDZY)
REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
! Director Cosinus along z directions at surface w-point
REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
......@@ -193,6 +196,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
!
! Variables at t-1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM
!$acc declare copyin(PUM,PVM)
REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
! maximum slope direction
REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
......@@ -223,8 +227,14 @@ CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
!
REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: GY_U_UV_PUM
REAL, DIMENSION(SIZE(PVM,1),SIZE(PVM,2),SIZE(PVM,3)) :: GX_V_UV_PVM
!$acc declare create(GY_U_UV_PUM)
!
REAL :: ZTIME1, ZTIME2
!
#ifdef _OPENACC
REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZTMP1_DEVICE
!$acc declare create(ZTMP1_DEVICE)
#endif
! ---------------------------------------------------------------------------
!
!* 1. PRELIMINARY COMPUTATIONS
......@@ -239,10 +249,18 @@ ILENCH=LEN(YCOMMENT)
!
ZDIRSINZW(:,:) = SQRT( 1. - PDIRCOSZW(:,:)**2 )
!
#ifndef _OPENACC
GX_V_UV_PVM = GX_V_UV(1,IKU,1,PVM,PDXX,PDZZ,PDZX)
IF (.NOT. L2D) THEN
GY_U_UV_PUM = GY_U_UV(1,IKU,1,PUM,PDYY,PDZZ,PDZY)
END IF
#else
GX_V_UV_PVM = GX_V_UV(1,IKU,1,PVM,PDXX,PDZZ,PDZX)
IF (.NOT. L2D) THEN
CALL GY_U_UV_DEVICE(1,IKU,1,PUM,PDYY,PDZZ,PDZY,GY_U_UV_PUM)
!$acc update self(GY_U_UV_PUM)
END IF
#endif
!
!
!* 12. < U'V'>
......@@ -359,9 +377,17 @@ END IF
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MXF(MYF(ZFLX)), X_LES_SUBGRID_UV )
CALL LES_MEAN_SUBGRID( MXF(MYF(GY_U_UV(1,IKU,1,PUM,PDYY,PDZZ,PDZY)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
CALL LES_MEAN_SUBGRID( MXF(MYF(GX_V_UV(1,IKU,1,PVM,PDXX,PDZZ,PDZX)*ZFLX)), X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
#else
CALL LES_MEAN_SUBGRID( MXF(MYF(ZFLX)), X_LES_SUBGRID_UV )
CALL GY_U_UV_DEVICE(1,IKU,1,PUM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
!$acc update self(ZTMP1_DEVICE)
CALL LES_MEAN_SUBGRID( MXF(MYF(ZTMP1_DEVICE*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
CALL LES_MEAN_SUBGRID( MXF(MYF(GX_V_UV(1,IKU,1,PVM,PDXX,PDZZ,PDZX)*ZFLX)), X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
......
......@@ -52,7 +52,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
!
! Variables at t-1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PWM,PTHLM
!$acc declare copyin(PTHLM)
!$acc declare copyin(PUM,PWM,PTHLM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
!$acc declare copyin(PRM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
......@@ -177,7 +177,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
!
! Variables at t-1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PWM,PTHLM
!$acc declare copyin(PTHLM)
!$acc declare copyin(PUM,PWM,PTHLM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
!$acc declare copyin(PRM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
......@@ -273,8 +273,14 @@ IF (KSPLT==1) THEN
!
!Contribution to the dynamic production of TKE:
!
#ifndef _OPENACC
ZWORK(:,:,:) =-MZF(1,IKU,1, MXF( &
ZFLX *( GZ_U_UW(1,IKU,1,PUM,PDZZ) + GX_W_UW_PWM ) ) )
#else
CALL GZ_U_UW_DEVICE(1,IKU,1,PUM,PDZZ,ZTMP1_DEVICE)
!$acc update self(ZTMP1_DEVICE)
ZWORK(:,:,:) =-MZF(1,IKU,1, MXF( ZFLX *( ZTMP1_DEVICE + GX_W_UW_PWM ) ) )
#endif
!
!
! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
......@@ -300,10 +306,10 @@ END IF
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(ZFLX)), X_LES_SUBGRID_WU , .TRUE. )
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GZ_U_UW(1,IKU,1,PUM,PDZZ)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GX_W_UW_PWM*ZFLX)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)*MZF(1,IKU,1,ZFLX)),&
X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
IF (KRR>=1) THEN
......@@ -315,6 +321,11 @@ IF (LLES_CALL .AND. KSPLT==1) THEN
X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
END DO
#else
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(ZFLX)), X_LES_SUBGRID_WU , .TRUE. )
CALL GZ_U_UW_DEVICE(1,IKU,1,PUM,PDZZ,ZTMP1_DEVICE)
!$acc update self(ZTMP1_DEVICE)
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(ZTMP1_DEVICE*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GX_W_UW_PWM*ZFLX)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
CALL GX_M_U_DEVICE(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
!$acc update self(ZTMP1_DEVICE)
CALL LES_MEAN_SUBGRID( MXF(ZTMP1_DEVICE*MZF(1,IKU,1,ZFLX)) , X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
......
......@@ -68,9 +68,11 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
! Wind at t-Delta t
!$acc declare copyin(PTHLM)
!$acc declare copyin(PUM,PTHLM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
!$acc declare copyin(PRM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
!$acc declare copyin(PSVM)
REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
! maximum slope direction
REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
......@@ -358,9 +360,11 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM, PTHLM
! Wind at t-Delta t
!$acc declare copyin(PTHLM)
!$acc declare copyin(PUM,PTHLM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
!$acc declare copyin(PRM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
!$acc declare copyin(PSVM)
REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
! maximum slope direction
REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
......@@ -545,7 +549,13 @@ PWU(:,:,:) = ZFLXZ(:,:,:)
! Contribution to the dynamic production of TKE
! compute the dynamic production at the mass point
!
#ifndef _OPENACC
PDP(:,:,:) = - MZF(KKA,KKU,KKL, MXF ( ZFLXZ * GZ_U_UW(KKA,KKU,KKL,PUM,PDZZ) ) )
#else
CALL GZ_U_UW_DEVICE(KKA,KKU,KKL,PUM,PDZZ,ZTMP1_DEVICE)
!$acc update self(ZTMP1_DEVICE)
PDP(:,:,:) = - MZF(KKA,KKU,KKL, MXF ( ZFLXZ * ZTMP1_DEVICE ) )
#endif
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
PDP(:,:,IKB:IKB) = - MXF ( &
......@@ -558,8 +568,14 @@ PDP(:,:,IKB:IKB) = - MXF (
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MXF(ZFLXZ)), X_LES_SUBGRID_WU )
#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MXF(GZ_U_UW(KKA,KKU,KKL,PUM,PDZZ) &
& *ZFLXZ)), X_LES_RES_ddxa_U_SBG_UaU )
#else
CALL GZ_U_UW_DEVICE(KKA,KKU,KKL,PUM,PDZZ,ZTMP1_DEVICE)
!$acc update self(ZTMP1_DEVICE)
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MXF(ZTMP1_DEVICE*ZFLXZ)), X_LES_RES_ddxa_U_SBG_UaU )
#endif
CALL LES_MEAN_SUBGRID( XCMFS * ZKEFF, X_LES_SUBGRID_Km )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
......@@ -612,11 +628,6 @@ IF(HTURBDIM=='3DIM') THEN
#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MXF(GX_M_U(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)&
* MZF(KKA,KKU,KKL,ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW )
#else
CALL GX_M_U_DEVICE(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
!$acc update self(ZTMP1_DEVICE)
CALL LES_MEAN_SUBGRID( MXF(ZTMP1_DEVICE * MZF(KKA,KKU,KKL,ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW )
#endif
IF (KRR>=1) THEN
CALL LES_MEAN_SUBGRID(MXF(GX_U_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX)&
*MZF(KKA,KKU,KKL,ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW )
......@@ -625,6 +636,21 @@ IF(HTURBDIM=='3DIM') THEN
CALL LES_MEAN_SUBGRID( MXF(GX_U_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,&
PDZX)*MZF(KKA,KKU,KKL,ZFLXZ)),X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
END DO
#else
CALL GX_M_U_DEVICE(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
!$acc update self(ZTMP1_DEVICE)
CALL LES_MEAN_SUBGRID( MXF(ZTMP1_DEVICE * MZF(KKA,KKU,KKL,ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW )
IF (KRR>=1) THEN
CALL GX_U_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
!$acc update self(ZTMP1_DEVICE)
CALL LES_MEAN_SUBGRID(MXF(ZTMP1_DEVICE*MZF(KKA,KKU,KKL,ZFLXZ)), X_LES_RES_ddxa_Rt_SBG_UaW )
END IF
DO JSV=1,NSV
CALL GX_U_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
!$acc update self(ZTMP1_DEVICE)
CALL LES_MEAN_SUBGRID( MXF(ZTMP1_DEVICE*MZF(KKA,KKU,KKL,ZFLXZ)), X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
END DO
#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment