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

Juan 20/11/2013: OK advecuvw , manque optimisation

parent 98adf2c6
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
MNH/advec_4th_order_aux.f90
+ 66
− 47
View file @ 2fd76d72
...@@ -120,7 +120,10 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type ...@@ -120,7 +120,10 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
! !
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PMEANX, PMEANY ! fluxes REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PMEANX, PMEANY ! fluxes
!$acc declare pcopy(PMEANX,PMEANY)
!acc declare present(PMEANX,PMEANY)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t
!$acc declare pcopyin(PFIELDT)
INTEGER, INTENT(IN) :: KGRID ! C grid localisation INTEGER, INTENT(IN) :: KGRID ! C grid localisation
! !
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
...@@ -134,20 +137,36 @@ INTEGER:: IIE,IJE ! End useful area in x,y directions ...@@ -134,20 +137,36 @@ INTEGER:: IIE,IJE ! End useful area in x,y directions
! !
INTEGER:: ILUOUT,IRESP ! for prints INTEGER:: ILUOUT,IRESP ! for prints
! !
! JUAN ACC
LOGICAL :: GWEST , GEAST
LOGICAL :: GSOUTH , GNORTH
REAL, DIMENSION(SIZE(PFIELDT,2),SIZE(PFIELDT,3)) :: ZHALO2_WEST,ZHALO2_EAST
REAL, DIMENSION(SIZE(PFIELDT,1),SIZE(PFIELDT,3)) :: ZHALO2_SOUTH,ZHALO2_NORTH
!$acc declare create (ZHALO2_WEST,ZHALO2_EAST,ZHALO2_SOUTH,ZHALO2_NORTH)
!
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS !* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------ ! ------------------------------
! !
!$acc data
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
! !
GWEST = LWEST_ll()
GEAST = LEAST_ll()
GSOUTH=LSOUTH_ll()
GNORTH=LNORTH_ll()
!
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
!* 0.4. INITIALIZE THE FIELDS !* 0.4. INITIALIZE THE FIELDS
! --------------------- ! ---------------------
! !
PMEANX(:,:,:) = 0.0 !!$!$acc kernels
PMEANY(:,:,:) = 0.0 !!$PMEANX(:,:,:) = 0.0
!!$PMEANY(:,:,:) = 0.0
!!$!$acc end kernels
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
...@@ -161,6 +180,11 @@ SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side ...@@ -161,6 +180,11 @@ SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
! !
CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2) CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
! !
ZHALO2_WEST(:,:) = TPHALO2%WEST(:,:)
ZHALO2_EAST(:,:) = TPHALO2%EAST(:,:)
!$acc update device (ZHALO2_WEST,ZHALO2_EAST)
!
!$acc kernels
IF(NHALO == 1) THEN IF(NHALO == 1) THEN
IW=IIB+1 IW=IIB+1
IE=IIE IE=IIE
...@@ -187,33 +211,26 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2) ...@@ -187,33 +211,26 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
! !
!* lateral boundary conditions !* lateral boundary conditions
PMEANX(IWF-1,:,:) = (7.0*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) - & PMEANX(IWF-1,:,:) = (7.0*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) - &
( PFIELDT(IW,:,:)+TPHALO2%WEST(:,:) ) )/12.0 ( PFIELDT(IW,:,:)+ZHALO2_WEST(:,:) ) )/12.0
! !
PMEANX(IEF+1,:,:) = (7.0*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) - & PMEANX(IEF+1,:,:) = (7.0*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) - &
( TPHALO2%EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0 ( ZHALO2_EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
! !
!* inner domain !* inner domain
PMEANX(IWF:IEF,:,:) = (7.0*( PFIELDT(IW:IE,:,:)+PFIELDT(IW-1:IE-1,:,:) ) - & PMEANX(IWF:IEF,:,:) = (7.0*( PFIELDT(IW:IE,:,:)+PFIELDT(IW-1:IE-1,:,:) ) - &
( PFIELDT(IW+1:IE+1,:,:)+PFIELDT(IW-2:IE-2,:,:) ) )/12.0 ( PFIELDT(IW+1:IE+1,:,:)+PFIELDT(IW-2:IE-2,:,:) ) )/12.0
!$acc end kernels
! !
!!$!
!!$
!!$ IF(NHALO == 1) THEN
!!$ PMEANX(IWF-1,:,:) = (7.0*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) - &
!!$ ( PFIELDT(IW,:,:)+TPHALO2%WEST(:,:) ) )/12.0
!!$!
!!$ PMEANX(IEF+1,:,:) = (7.0*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) - &
!!$ ( TPHALO2%EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
!!$ ENDIF
!!$!
!!$ PMEANX(IWF:IEF,:,:) = (7.0*( PFIELDT(IW:IE,:,:)+PFIELDT(IW-1:IE-1,:,:) ) - &
!!$ ( PFIELDT(IW+1:IE+1,:,:)+PFIELDT(IW-2:IE-2,:,:) ) )/12.0
!!$!
!* 1.2 NON CYCLIC CASE IN THE X DIRECTION !* 1.2 NON CYCLIC CASE IN THE X DIRECTION
! !
CASE ('OPEN','WALL','NEST') CASE ('OPEN','WALL','NEST')
! !
IF (LWEST_ll()) THEN ZHALO2_WEST(:,:) = TPHALO2%WEST(:,:)
ZHALO2_EAST(:,:) = TPHALO2%EAST(:,:)
!$acc update device (ZHALO2_WEST,ZHALO2_EAST)
!
!$acc kernels
IF (GWEST) THEN
IF(KGRID == 2) THEN IF(KGRID == 2) THEN
IW=IIB+2 ! special case of C grid IW=IIB+2 ! special case of C grid
ELSE ELSE
...@@ -226,7 +243,7 @@ CASE ('OPEN','WALL','NEST') ...@@ -226,7 +243,7 @@ CASE ('OPEN','WALL','NEST')
IW=IIB IW=IIB
ENDIF ENDIF
ENDIF ENDIF
IF (LEAST_ll() .OR. NHALO == 1) THEN IF (GEAST .OR. NHALO == 1) THEN
! T. Maric ! T. Maric
! IE=IIE-1 ! original ! IE=IIE-1 ! original
IE=IIE IE=IIE
...@@ -248,7 +265,7 @@ CASE ('OPEN','WALL','NEST') ...@@ -248,7 +265,7 @@ CASE ('OPEN','WALL','NEST')
! !
!* Use a second order scheme at the physical border !* Use a second order scheme at the physical border
! !
IF (LWEST_ll()) THEN IF (GWEST) THEN
PMEANX(IWF-1,:,:) = 0.5*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) PMEANX(IWF-1,:,:) = 0.5*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) )
! T. Maric ! T. Maric
! PMEANX(1,:,:) = PMEANX(IWF-1,:,:) ! PMEANX(1,:,:) = PMEANX(IWF-1,:,:)
...@@ -256,20 +273,21 @@ CASE ('OPEN','WALL','NEST') ...@@ -256,20 +273,21 @@ CASE ('OPEN','WALL','NEST')
!PMEANX(1,:,:) = 0.5*(3.0*PFIELDT(1,:,:) - PFIELDT(2,:,:)) !PMEANX(1,:,:) = 0.5*(3.0*PFIELDT(1,:,:) - PFIELDT(2,:,:))
ELSEIF (NHALO == 1) THEN ELSEIF (NHALO == 1) THEN
PMEANX(IWF-1,:,:) = (7.0*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) - & PMEANX(IWF-1,:,:) = (7.0*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) - &
( PFIELDT(IW,:,:)+TPHALO2%WEST(:,:) ) )/12.0 ( PFIELDT(IW,:,:)+ZHALO2_WEST(:,:) ) )/12.0
ENDIF ENDIF
! !
IF (LEAST_ll()) THEN IF (GEAST) THEN
PMEANX(IEF+1,:,:) = 0.5*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) PMEANX(IEF+1,:,:) = 0.5*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) )
ELSEIF (NHALO == 1) THEN ELSEIF (NHALO == 1) THEN
PMEANX(IEF+1,:,:) = (7.0*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) - & PMEANX(IEF+1,:,:) = (7.0*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) - &
( TPHALO2%EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0 ( ZHALO2_EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
ENDIF ENDIF
! !
!* Use a fourth order scheme elsewhere !* Use a fourth order scheme elsewhere
! !
PMEANX(IWF:IEF,:,:) = (7.0*( PFIELDT(IW:IE,:,:)+PFIELDT(IW-1:IE-1,:,:) ) - & PMEANX(IWF:IEF,:,:) = (7.0*( PFIELDT(IW:IE,:,:)+PFIELDT(IW-1:IE-1,:,:) ) - &
( PFIELDT(IW+1:IE+1,:,:)+PFIELDT(IW-2:IE-2,:,:) ) )/12.0 ( PFIELDT(IW+1:IE+1,:,:)+PFIELDT(IW-2:IE-2,:,:) ) )/12.0
!$acc end kernels
END SELECT END SELECT
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
...@@ -284,6 +302,12 @@ IF ( .NOT. L2D ) THEN ...@@ -284,6 +302,12 @@ IF ( .NOT. L2D ) THEN
! !
CASE ('CYCL') ! In that case one must have HLBCY(1) == HLBCY(2) CASE ('CYCL') ! In that case one must have HLBCY(1) == HLBCY(2)
! !
ZHALO2_SOUTH(:,:) = TPHALO2%SOUTH(:,:)
ZHALO2_NORTH(:,:) = TPHALO2%NORTH(:,:)
!$acc update device (ZHALO2_SOUTH,ZHALO2_NORTH)
!
!$acc kernels
!
! !
IF(NHALO == 1) THEN IF(NHALO == 1) THEN
IS=IJB+1 IS=IJB+1
...@@ -311,31 +335,26 @@ IF ( .NOT. L2D ) THEN ...@@ -311,31 +335,26 @@ IF ( .NOT. L2D ) THEN
! !
!* lateral boundary conditions !* lateral boundary conditions
PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:) ) - & PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:) ) - &
( PFIELDT(:,IS,:)+TPHALO2%SOUTH(:,:) ) )/12.0 ( PFIELDT(:,IS,:)+ZHALO2_SOUTH(:,:) ) )/12.0
! !
PMEANY(:,INF+1,:) = (7.0*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:) ) - & PMEANY(:,INF+1,:) = (7.0*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:) ) - &
( TPHALO2%NORTH(:,:)+PFIELDT(:,IN-1,:) ) )/12.0 ( ZHALO2_NORTH(:,:)+PFIELDT(:,IN-1,:) ) )/12.0
! !
!* inner domain !* inner domain
PMEANY(:,ISF:INF,:) = (7.0*( PFIELDT(:,IS:IN,:)+PFIELDT(:,IS-1:IN-1,:)) - & PMEANY(:,ISF:INF,:) = (7.0*( PFIELDT(:,IS:IN,:)+PFIELDT(:,IS-1:IN-1,:)) - &
( PFIELDT(:,IS+1:IN+1,:)+PFIELDT(:,IS-2:IN-2,:) ))/12.0 ( PFIELDT(:,IS+1:IN+1,:)+PFIELDT(:,IS-2:IN-2,:) ))/12.0
!!$! !$acc end kernels
!!$ IF(NHALO == 1) THEN !
!!$ PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS,:)+PFIELDT(:,IS-1,:) ) - &
!!$ ( PFIELDT(:,IS+1,:)+TPHALO2%SOUTH(:,:) ) )/12.0
!!$!
!!$ PMEANY(:,ISF+1,:) = (7.0*( PFIELDT(:,IS,:)+PFIELDT(:,IS-1,:) ) - &
!!$ ( TPHALO2%NORTH(:,:)+PFIELDT(:,IS-2,:) ) )/12.0
!!$ ENDIF
!!$!
!!$ PMEANY(:,ISF:INF,:) = (7.0*( PFIELDT(:,IS:IN,:)+PFIELDT(:,IS-1:IN-1,:)) - &
!!$ ( PFIELDT(:,IS+1:IN+1,:)+PFIELDT(:,IS-2:IN-2,:) ))/12.0
!!$!
!* 2.2 NON CYCLIC CASE IN THE Y DIRECTION !* 2.2 NON CYCLIC CASE IN THE Y DIRECTION
! !
CASE ('OPEN','WALL','NEST') CASE ('OPEN','WALL','NEST')
! !
IF (LSOUTH_ll()) THEN ZHALO2_SOUTH(:,:) = TPHALO2%SOUTH(:,:)
ZHALO2_NORTH(:,:) = TPHALO2%NORTH(:,:)
!$acc update device (ZHALO2_SOUTH,ZHALO2_NORTH)
!
!$acc kernels
IF (GSOUTH) THEN
IF(KGRID == 3) THEN IF(KGRID == 3) THEN
IS=IJB+2 ! special case of C grid IS=IJB+2 ! special case of C grid
ELSE ELSE
...@@ -348,7 +367,7 @@ IF ( .NOT. L2D ) THEN ...@@ -348,7 +367,7 @@ IF ( .NOT. L2D ) THEN
IS=IJB IS=IJB
ENDIF ENDIF
ENDIF ENDIF
IF (LNORTH_ll() .OR. NHALO == 1) THEN IF (GNORTH .OR. NHALO == 1) THEN
! T. Maric ! T. Maric
! IN=IJE-1 ! original ! IN=IJE-1 ! original
IN=IJE IN=IJE
...@@ -366,38 +385,38 @@ IF ( .NOT. L2D ) THEN ...@@ -366,38 +385,38 @@ IF ( .NOT. L2D ) THEN
! !
!* Use a second order scheme at the physical border !* Use a second order scheme at the physical border
! !
IF (LSOUTH_ll()) THEN IF (GSOUTH) THEN
PMEANY(:,ISF-1,:) = 0.5*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:) ) PMEANY(:,ISF-1,:) = 0.5*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:) )
! T. Maric ! T. Maric
! PMEANY(:,1,:) = PMEANY(:,ISF-1,:) ! PMEANY(:,1,:) = PMEANY(:,ISF-1,:)
! extrapolate ! extrapolate
!PMEANY(:,1,:) = 0.5*(3.0*PFIELDT(:,1,:) - PFIELDT(:,2,:)) !PMEANY(:,1,:) = 0.5*(3.0*PFIELDT(:,1,:) - PFIELDT(:,2,:))
ELSEIF (NHALO == 1) THEN ELSEIF (NHALO == 1) THEN
!!$ PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS,:)+PFIELDT(:,IS-1,:)) - &
!!$ ( PFIELDT(:,IS+1,:)+TPHALO2%SOUTH(:,:) ))/12.0
PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:)) - & PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:)) - &
( PFIELDT(:,IS,:)+TPHALO2%SOUTH(:,:) ))/12.0 ( PFIELDT(:,IS,:)+ZHALO2_SOUTH(:,:) ))/12.0
ENDIF ENDIF
! !
IF (LNORTH_ll()) THEN IF (GNORTH) THEN
PMEANY(:,INF+1,:) = 0.5*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:) ) PMEANY(:,INF+1,:) = 0.5*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:) )
ELSEIF (NHALO == 1) THEN ELSEIF (NHALO == 1) THEN
!!$ PMEANY(:,INF+1,:) = (7.0*( PFIELDT(:,IN,:)+PFIELDT(:,IN-1,:)) - &
!!$ ( TPHALO2%NORTH(:,:)+PFIELDT(:,IN-2,:) ))/12.0
PMEANY(:,INF+1,:) = (7.0*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:)) - & PMEANY(:,INF+1,:) = (7.0*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:)) - &
( TPHALO2%NORTH(:,:)+PFIELDT(:,IN-1,:) ))/12.0 ( ZHALO2_NORTH(:,:)+PFIELDT(:,IN-1,:) ))/12.0
ENDIF ENDIF
! !
!* Use a fourth order scheme elsewhere !* Use a fourth order scheme elsewhere
! !
PMEANY(:,ISF:INF,:) = (7.0*( PFIELDT(:,IS:IN,:)+PFIELDT(:,IS-1:IN-1,:)) - & PMEANY(:,ISF:INF,:) = (7.0*( PFIELDT(:,IS:IN,:)+PFIELDT(:,IS-1:IN-1,:)) - &
( PFIELDT(:,IS+1:IN+1,:)+PFIELDT(:,IS-2:IN-2,:) ))/12.0 ( PFIELDT(:,IS+1:IN+1,:)+PFIELDT(:,IS-2:IN-2,:) ))/12.0
!$acc end kernels
! !
END SELECT END SELECT
ELSE ELSE
!$acc kernels
PMEANY(:,:,:) = 0.0 PMEANY(:,:,:) = 0.0
!$acc end kernels
ENDIF ENDIF
! !
!$acc end data
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
END SUBROUTINE ADVEC_4TH_ORDER_ALGO END SUBROUTINE ADVEC_4TH_ORDER_ALGO
......
MNH/advection.f90
+ 1
− 0
View file @ 2fd76d72
...@@ -352,6 +352,7 @@ IF(NHALO == 1) THEN ...@@ -352,6 +352,7 @@ IF(NHALO == 1) THEN
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll) CALL CLEANLIST_ll(TZFIELDS_ll)
END IF END IF
!$acc update device(ZRUCT,ZRVCT,ZRWCT)
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
......
MNH/advecuvw_4th.f90
+ 128
− 19
View file @ 2fd76d72
...@@ -171,10 +171,13 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type ...@@ -171,10 +171,13 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
!$acc declare present(PRUCT,PRVCT,PRWCT)
! !
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Variables at t REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Variables at t
!$acc declare pcopyin(PUT,PVT,PWT)
! !
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
!$acc declare pcopy(PRUS, PRVS, PRWS)
! !
TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
! !
...@@ -187,13 +190,42 @@ TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST ...@@ -187,13 +190,42 @@ TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST
! !
INTEGER :: IGRID ! localisation on the model grid INTEGER :: IGRID ! localisation on the model grid
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMEANX, ZMEANY ! fluxes REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMEANX, ZMEANY ! fluxes
!acc declare create(ZMEANX, ZMEANY)
!
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4
!$acc declare create(ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4)
INTEGER :: IIU,IJU,IKU
INTEGER :: II
!
#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)
#define dyf(PDYF,PA) PDYF(:,1:IJU-1,:) = PA(:,2:IJU,:) - PA(:,1:IJU-1,:) ; PDYF(:,IJU,:) = PDYF(:,2*JPHEXT,:) ! DYF(PDYF,PA)
#define dzf(PDZF,PA) PDZF(:,:,1:IKU-1) = PA(:,:,2:IKU) - PA(:,:,1:IKU-1) ; PDZF(:,:,IKU) = -999. ! DZF(PDZF,PA)
#define mzm4(PMZM4,PA) PMZM4(:,:,3:IKU-1) = (7.0*( PA(:,:,3:IKU-1)+PA(:,:,2:IKU-2) ) - (PA(:,:,4:IKU)+PA(:,:,1:IKU-3) ) )/12.0 ; \
PMZM4(:,:,2) = 0.5*( PA(:,:,2)+PA(:,:,1) ) ; PMZM4(:,:,IKU) = 0.5*( PA(:,:,IKU)+PA(:,:,IKU-1) ) ; PMZM4(:,:,1) = -999.
#define mym(PMYM,PA) PMYM(:,2:IJU,:) = 0.5*( PA(:,2:IJU,:)+PA(:,1:IJU-1,:) ) ; PMYM(:,1,:) = PMYM(:,IJU-2*JPHEXT+1,:) ! MYM(PMYM,PA)
#define dxf(PDXF,PA) PDXF(1:IIU-1,:,:) = PA(2:IIU,:,:) - PA(1:IIU-1,:,:) ; PDXF(IIU,:,:) = PDXF(2*JPHEXT,:,:) ! DXF(PDXF,PA)
#define myf(PMYF,PA) PMYF(:,1:IJU-1,:) = 0.5*( PA(:,1:IJU-1,:)+PA(:,2:IJU,:) ) ; PMYF(:,IJU,:) = PMYF(:,2*JPHEXT,:) ! MYF(PMYF,PA)
#define dym(PDYM,PA) PDYM(:,2:IJU,:) = PA(:,2:IJU,:) - PA(:,1:IJU-1,:) ; PDYM(:,1,:) = PDYM(:,IJU-2*JPHEXT+1,:) ! DYM(PDYM,PA)
#define mzm(PMZM,PA) PMZM(:,:,2:IKU) = 0.5*( PA(:,:,2:IKU)+PA(:,:,1:IKU-1) ) ; PMZM(:,:,1) = -999. ! MZM(PMZM,PA)
#define mzf(PMZF,PA) PMZF(:,:,1:IKU-1) = 0.5*( PA(:,:,1:IKU-1)+PA(:,:,2:IKU) ) ; PMZF(:,:,IKU) = -999. ! MZF(PMZF,PA)
#define dzm(PDZM,PA) PDZM(:,:,2:IKU) = PA(:,:,2:IKU) - PA(:,:,1:IKU-1) ; PDZM(:,:,1) = -999. ! DZM(PDZM,PA)
#define mzf4(PMZF4,PA) PMZF4(:,:,2:IKU-2) = (7.0*( PA(:,:,3:IKU-1)+PA(:,:,2:IKU-2) ) - (PA(:,:,4:IKU)+PA(:,:,1:IKU-3) ) )/12.0 ; \
PMZF4(:,:,1) = 0.5*( PA(:,:,2)+PA(:,:,1) ) ; PMZF4(:,:,IKU-1) = 0.5*( PA(:,:,IKU)+PA(:,:,IKU-1) ) ; PMZF4(:,:,IKU) = -999.
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
!* 1. COMPUTES THE DOMAIN DIMENSIONS !* 1. COMPUTES THE DOMAIN DIMENSIONS
!
! ------------------------------ ! ------------------------------
!$acc data create(ZMEANX, ZMEANY)
! !
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
CALL GET_DIM_EXT_ll('B',IIU,IJU)
IKU=SIZE(PUT,3)
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
...@@ -209,16 +241,43 @@ ELSE ...@@ -209,16 +241,43 @@ ELSE
CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PUT, IGRID, ZMEANX, ZMEANY) CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PUT, IGRID, ZMEANX, ZMEANY)
ENDIF ENDIF
! !
PRUS(:,:,:) = PRUS(:,:,:) & ! pcopy(prus) pcopyin(pruct,ZMEANX) create(ZTEMP1,ZTEMP2,ZTEMP3)
-DXM( MXF(PRUCT(:,:,:))*ZMEANX(:,:,:) ) !!$PRUS(:,:,:) = PRUS(:,:,:) &
!!$ -DXM( MXF(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!$acc kernels pcopyin(ZMEANX)
mxf(ZTEMP1,PRUCT)
ZTEMP2 = ZTEMP1 * ZMEANX
dxm(ZTEMP3,ZTEMP2)
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP3
!$acc end kernels
IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVX_BU_RU') IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVX_BU_RU')
!
PRUS(:,:,:) = PRUS(:,:,:) & !
-DYF( MXM(PRVCT(:,:,:))*ZMEANY(:,:,:) ) !!$PRUS(:,:,:) = PRUS(:,:,:) &
!!$ -DYF( MXM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!$acc kernels pcopyin(ZMEANY)
mxm(ZTEMP1,PRVCT)
ZTEMP2 = ZTEMP1 * ZMEANY
dyf(ZTEMP3,ZTEMP2)
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP3
!$acc end kernels
IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVY_BU_RU') IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVY_BU_RU')
! !
PRUS(:,:,:) = PRUS(:,:,:) & !!$PRUS(:,:,:) = PRUS(:,:,:) &
-DZF( MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) ) !!$ -DZF( MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) )
!$acc kernels
mzm4(ZTEMP1,PUT)
mxm(ZTEMP2,PRWCT)
ZTEMP3 = ZTEMP1 * ZTEMP2
dzf(ZTEMP4,ZTEMP3)
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP4
!$acc end kernels
IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVZ_BU_RU') IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVZ_BU_RU')
! !
! !
...@@ -231,16 +290,41 @@ ELSE ...@@ -231,16 +290,41 @@ ELSE
CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PVT, IGRID, ZMEANX, ZMEANY) CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PVT, IGRID, ZMEANX, ZMEANY)
ENDIF ENDIF
! !
PRVS(:,:,:) = PRVS(:,:,:) & !!$PRVS(:,:,:) = PRVS(:,:,:) &
-DXF( MYM(PRUCT(:,:,:))*ZMEANX(:,:,:) ) !!$ -DXF( MYM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!$acc kernels pcopyin(ZMEANX)
mym(ZTEMP1,PRUCT)
ZTEMP2 = ZTEMP1 * ZMEANX
dxf(ZTEMP3,ZTEMP2)
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
!$acc end kernels
IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVX_BU_RV') IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVX_BU_RV')
! !
PRVS(:,:,:) = PRVS(:,:,:) & !!$PRVS(:,:,:) = PRVS(:,:,:) &
-DYM( MYF(PRVCT(:,:,:))*ZMEANY(:,:,:) ) !!$ -DYM( MYF(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!$acc kernels pcopyin(ZMEANY)
myf(ZTEMP1,PRVCT)
ZTEMP2 = ZTEMP1 * ZMEANY
dym(ZTEMP3,ZTEMP2)
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
!$acc end kernels
IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVY_BU_RV') IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVY_BU_RV')
! !
PRVS(:,:,:) = PRVS(:,:,:) & !!$PRVS(:,:,:) = PRVS(:,:,:) &
-DZF( MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) ) !!$ -DZF( MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) )
!$acc kernels
mym(ZTEMP1,PRWCT)
mzm4(ZTEMP2,PVT)
ZTEMP3 = ZTEMP1 * ZTEMP2
dzf(ZTEMP4,ZTEMP3)
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP4
!$acc end kernels
IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVZ_BU_RV') IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVZ_BU_RV')
! !
! !
...@@ -254,18 +338,43 @@ ELSE ...@@ -254,18 +338,43 @@ ELSE
CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PWT, IGRID, ZMEANX, ZMEANY) CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PWT, IGRID, ZMEANX, ZMEANY)
ENDIF ENDIF
! !
PRWS(:,:,:) = PRWS(:,:,:) & !!$PRWS(:,:,:) = PRWS(:,:,:) &
-DXF( MZM(PRUCT(:,:,:))*ZMEANX(:,:,:) ) !!$ -DXF( MZM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!$acc kernels pcopyin(ZMEANX)
mzm(ZTEMP1,PRUCT)
ZTEMP2 = ZTEMP1 * ZMEANX
dxf(ZTEMP3,ZTEMP2)
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP3
!$acc end kernels
IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVX_BU_RW') IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVX_BU_RW')
! !
PRWS(:,:,:) = PRWS(:,:,:) & !!$PRWS(:,:,:) = PRWS(:,:,:) &
-DYF( MZM(PRVCT(:,:,:))*ZMEANY(:,:,:) ) !!$ -DYF( MZM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
!$acc kernels pcopyin(ZMEANY)
mzm(ZTEMP1,PRVCT)
ZTEMP2 = ZTEMP1 * ZMEANY
dyf(ZTEMP3,ZTEMP2)
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP3
!$acc end kernels
IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVY_BU_RW') IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVY_BU_RW')
! !
PRWS(:,:,:) = PRWS(:,:,:) & !!$PRWS(:,:,:) = PRWS(:,:,:) &
-DZM( MZF(PRWCT(:,:,:))*MZF4(PWT(:,:,:)) ) !!$ -DZM( MZF(PRWCT(:,:,:))*MZF4(PWT(:,:,:)) )
!$acc kernels
mzf(ZTEMP1,PRWCT)
mzf4(ZTEMP2,PWT)
ZTEMP1 = ZTEMP1 * ZTEMP2
dzm(ZTEMP4,ZTEMP1)
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP4
!$acc end kernels
IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVZ_BU_RW') IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVZ_BU_RW')
! !
!$acc end data
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
END SUBROUTINE ADVECUVW_4TH END SUBROUTINE ADVECUVW_4TH
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment

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