Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • mesonh/mesonh-code
  • quentin.rodier/mesonh-code-fork
  • benoit.vie/mesonh-code
  • joris.pianezze/mesonh-code
  • 8qq4g5s7/mesonh-code
  • jean.baptiste.filippi/meso-nh-fire-code
  • fdl68d9p/mesonh-code-sophia
7 results
Show changes
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 3756 additions and 384 deletions
src/MNH/advec_weno_k_1_aux.f90
View file @ 8b176c90
......@@ -15,6 +15,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_UX
!
SUBROUTINE UP_UX_DEVICE(PSRC, PRUCT, PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRUCT,PR)
END SUBROUTINE UP_UX_DEVICE
!
FUNCTION UP_MX(PSRC, PRUCT) RESULT(PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
......@@ -22,6 +30,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_MX
!
SUBROUTINE UP_MX_DEVICE(PSRC, PRUCT, PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRUCT,PR)
END SUBROUTINE UP_MX_DEVICE
!
FUNCTION UP_VY(PSRC, PRVCT) RESULT(PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
......@@ -29,6 +45,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_VY
!
SUBROUTINE UP_VY_DEVICE(PSRC, PRVCT, PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRVCT,PR)
END SUBROUTINE UP_VY_DEVICE
!
FUNCTION UP_MY(PSRC, PRVCT) RESULT(PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
......@@ -36,6 +60,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_MY
!
SUBROUTINE UP_MY_DEVICE(PSRC, PRVCT, PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRVCT,PR)
END SUBROUTINE UP_MY_DEVICE
!
FUNCTION UP_WZ(PSRC, PRWCT) RESULT(PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
......@@ -43,6 +75,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_WZ
!
SUBROUTINE UP_WZ_DEVICE(PSRC, PRWCT, PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRWCT,PR)
END SUBROUTINE UP_WZ_DEVICE
!
FUNCTION UP_MZ(PSRC, PRWCT) RESULT(PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
......@@ -50,6 +90,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_MZ
!
SUBROUTINE UP_MZ_DEVICE(PSRC, PRWCT, PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRWCT,PR)
END SUBROUTINE UP_MZ_DEVICE
!
END INTERFACE
!
END MODULE MODI_ADVEC_WENO_K_1_AUX
......@@ -104,6 +152,57 @@ END FUNCTION UP_UX
!
!-------------------------------------------------------------------------------
!
! ########################################################################
SUBROUTINE UP_UX_DEVICE(PSRC, PRUCT, PR)
! ########################################################################
!!
!!**** UP_UX - upstream fluxes of U in X direction
!! input variable PSRC is on U grid, and output PR is on mass grid
!!
!! MODIFICATIONS
!! -------------
!!
!-------------------------------------------------------------------------------
!
USE MODE_ll
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
!
! output source term
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRUCT,PR)
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER :: IIE,IJE ! End useful area in x,y,z directions
!
!-------------------------------------------------------------------------------
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
! upstream flux on mass points
!
!$acc kernels
PR(IIB:IIE,:,:) = PSRC(IIB:IIE,:,:) * (0.5+SIGN(0.5,PRUCT(IIB:IIE,:,:))) +&
PSRC(IIB+1:IIE+1,:,:) * (0.5-SIGN(0.5,PRUCT(IIB:IIE,:,:)))
!
PR(IIB-1,:,:) = PR(IIE,:,:)
PR(IIE+1,:,:) = PR(IIB,:,:)
!
PR = PR * PRUCT
!$acc end kernels
!
END SUBROUTINE UP_UX_DEVICE
!
!-------------------------------------------------------------------------------
!
! ########################################################################
FUNCTION UP_MX(PSRC, PRUCT) RESULT(PR)
! ########################################################################
......@@ -152,6 +251,57 @@ END FUNCTION UP_MX
!
!-------------------------------------------------------------------------------
!
! ########################################################################
SUBROUTINE UP_MX_DEVICE(PSRC, PRUCT, PR)
! ########################################################################
!!
!!**** UP_MX - upstream fluxes of variable in X direction
!! input variable PSRC is on MASS grid, and output PR is on U grid
!!
!! MODIFICATIONS
!! -------------
!!
!-------------------------------------------------------------------------------
!
USE MODE_ll
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS GRID at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on U GRID
!
! output source term
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRUCT,PR)
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER :: IIE,IJE ! End useful area in x,y,z directions
!
!-------------------------------------------------------------------------------
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
! upstream flux on mass points
!
!$acc kernels
PR(IIB:IIE,:,:) = PSRC(IIB-1:IIE-1,:,:) * (0.5 + SIGN(0.5,PRUCT(IIB:IIE,:,:))) &
+ PSRC(IIB:IIE,:,:) * (0.5 - SIGN(0.5,PRUCT(IIB:IIE,:,:)))
!
PR(IIB-1,:,:) = PR(IIE,:,:)
PR(IIE+1,:,:) = PR(IIB,:,:)
!
PR = PR * PRUCT
!$acc end kernels
!
END SUBROUTINE UP_MX_DEVICE
!
!-------------------------------------------------------------------------------
!
! ########################################################################
FUNCTION UP_VY(PSRC, PRVCT) RESULT(PR)
! ########################################################################
......@@ -200,6 +350,57 @@ END FUNCTION UP_VY
!
!-------------------------------------------------------------------------------
!
! ########################################################################
SUBROUTINE UP_VY_DEVICE(PSRC, PRVCT, PR)
! ########################################################################
!!
!!**** UP_VY - upstream fluxes of V in Y direction
!! input variable PSRC is on V grid, and output PR is on MASS grid
!!
!! MODIFICATIONS
!! -------------
!!
!-------------------------------------------------------------------------------
!
USE MODE_ll
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on V grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
!
! output source term
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRVCT,PR)
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER :: IIE,IJE ! End useful area in x,y,z directions
!
!-------------------------------------------------------------------------------
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
! upstream flux on mass points
!
!$acc kernels
PR(:,IJB:IJE,:) = PSRC(:,IJB:IJE,:) * (0.5+SIGN(0.5,PRVCT(:,IJB:IJE,:))) +&
PSRC(:,IJB+1:IJE+1,:) * (0.5-SIGN(0.5,PRVCT(:,IJB:IJE,:)))
!
PR(:,IJB-1,:) = PR(:,IJE,:)
PR(:,IJE+1,:) = PR(:,IJB,:)
!
PR = PR * PRVCT
!$acc end kernels
!
END SUBROUTINE UP_VY_DEVICE
!
!-------------------------------------------------------------------------------
!
! ########################################################################
FUNCTION UP_MY(PSRC, PRVCT) RESULT(PR)
! ########################################################################
......@@ -248,6 +449,57 @@ END FUNCTION UP_MY
!
!-------------------------------------------------------------------------------
!
! ########################################################################
SUBROUTINE UP_MY_DEVICE(PSRC, PRVCT, PR)
! ########################################################################
!!
!!**** UP_MY - upstream fluxes of variable in Y direction
!! input variable PSRC is on MASS grid, and output PR is on V grid
!!
!! MODIFICATIONS
!! -------------
!!
!-------------------------------------------------------------------------------
!
USE MODE_ll
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on V GRID
!
! output source term
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRVCT,PR)
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER :: IIE,IJE ! End useful area in x,y,z directions
!
!-------------------------------------------------------------------------------
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
! upstream flux on mass points
!
!$acc kernels
PR(:,IJB:IJE,:) = PSRC(:,IJB-1:IJE-1,:) * (0.5+SIGN(0.5,PRVCT(:,IJB:IJE,:))) +&
PSRC(:,IJB:IJE,:) * (0.5-SIGN(0.5,PRVCT(:,IJB:IJE,:)))
!
PR(:,IJB-1,:) = PR(:,IJE,:)
PR(:,IJE+1,:) = PR(:,IJB,:)
!
PR = PR * PRVCT
!$acc end kernels
!
END SUBROUTINE UP_MY_DEVICE
!
!-------------------------------------------------------------------------------
!
! ########################################################################
FUNCTION UP_WZ(PSRC, PRWCT) RESULT(PR)
! ########################################################################
......@@ -298,6 +550,59 @@ END FUNCTION UP_WZ
!
!-------------------------------------------------------------------------------
!
! ########################################################################
SUBROUTINE UP_WZ_DEVICE(PSRC, PRWCT, PR)
! ########################################################################
!!
!!**** UP_WZ - upstream fluxes of W in Z direction
!! input variable PSRC is on W grid, and output PR is on MASS grid
!!
!! MODIFICATIONS
!! -------------
!!
!-------------------------------------------------------------------------------
!
USE MODE_ll
USE MODD_PARAMETERS,ONLY: JPVEXT
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
!
! output source term
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRWCT,PR)
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IKB ! Begining useful area in x,y,z directions
INTEGER :: IKE ! End useful area in x,y,z directions
!
!-------------------------------------------------------------------------------
!
!$acc kernels
IKB = 1 + JPVEXT
IKE = SIZE(PSRC,3) - JPVEXT
!
! upstream flux on mass points
!
PR(:,:,IKB:IKE) = PSRC(:,:,IKB:IKE) * (0.5+SIGN(0.5,PRWCT(:,:,IKB:IKE))) +&
PSRC(:,:,IKB+1:IKE+1) * (0.5-SIGN(0.5,PRWCT(:,:,IKB:IKE)))
!
PR(:,:,IKB-1) = PR(:,:,IKB)
PR(:,:,IKE+1) = PR(:,:,IKE)
!
PR = PR * PRWCT
!$acc end kernels
!
END SUBROUTINE UP_WZ_DEVICE
!
!-------------------------------------------------------------------------------
!
! ########################################################################
FUNCTION UP_MZ(PSRC, PRWCT) RESULT(PR)
! ########################################################################
......@@ -345,3 +650,56 @@ PR(:,:,IKE+1) = PR(:,:,IKE)
PR = PR * PRWCT
!
END FUNCTION UP_MZ
!
!-------------------------------------------------------------------------------
!
! ########################################################################
SUBROUTINE UP_MZ_DEVICE(PSRC, PRWCT, PR)
! ########################################################################
!!
!!**** UP_MZ - upstream fluxes of variable in Z direction
!! input variable PSRC is on MASS grid, and output PR is on W grid
!!
!! MODIFICATIONS
!! -------------
!!
!-------------------------------------------------------------------------------
!
USE MODE_ll
USE MODD_PARAMETERS,ONLY: JPVEXT
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
!
! output source term
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
!$acc declare present(PSRC,PRWCT,PR)
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IKB ! Begining useful area in x,y,z directions
INTEGER :: IKE ! End useful area in x,y,z directions
!
!-------------------------------------------------------------------------------
!
!$acc kernels
IKB = 1 + JPVEXT
IKE = SIZE(PSRC,3) - JPVEXT
!
! upstream flux on mass points
!
PR(:,:,IKB:IKE) = PSRC(:,:,IKB-1:IKE-1) * (0.5+SIGN(0.5,PRWCT(:,:,IKB:IKE))) +&
PSRC(:,:,IKB:IKE) * (0.5-SIGN(0.5,PRWCT(:,:,IKB:IKE)))
!
PR(:,:,IKB-1) = PR(:,:,IKB)
PR(:,:,IKE+1) = PR(:,:,IKE)
!
PR = PR * PRWCT
!$acc end kernels
!
END SUBROUTINE UP_MZ_DEVICE
src/MNH/advec_weno_k_2_aux.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/advec_weno_k_3_aux.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/advection_metsv.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/advection_uvw.f90
View file @ 8b176c90
......@@ -31,9 +31,12 @@ REAL, INTENT(IN) :: PTSTEP
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
!$acc declare pcopyin(PUT,PVT,PWT,PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS, PRWS
!$acc declare create(PRUS,PRVS,PRWS)
! Sources terms
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
!
......@@ -101,12 +104,21 @@ USE MODD_PARAMETERS, ONLY : JPVEXT
USE MODD_CONF, ONLY : NHALO
USE MODD_BUDGET
!
#ifndef _OPENACC
USE MODI_SHUMAN
#else
USE MODI_SHUMAN_DEVICE
#endif
USE MODI_CONTRAV
USE MODI_ADVECUVW_RK
USE MODI_ADV_BOUNDARIES
USE MODI_BUDGET
!
#ifdef _OPENACC
USE MODE_DEVICE
USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D, MNH_GET_ZT4D , MNH_REL_ZT4D
#endif
!
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
......@@ -128,9 +140,12 @@ REAL, INTENT(IN) :: PTSTEP
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
!$acc declare pcopyin(PUT,PVT,PWT,PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS, PRWS
!$acc declare create(PRUS,PRVS,PRWS)
! Sources terms
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
!
......@@ -144,6 +159,7 @@ INTEGER :: IKE ! indice K End in z direction
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWT
!$acc declare create(ZRUT,ZRVT,ZRWT)
! cartesian
! components of
! momentum
......@@ -151,22 +167,27 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCT
!$acc declare create(ZRUCT,ZRVCT,ZRWCT)
! contravariant
! components
! of momentum
!
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZU, ZV, ZW
!$acc declare create(ZU,ZV,ZW)
! Guesses at the end of the sub time step
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUS_OTHER
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVS_OTHER
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWS_OTHER
!$acc declare create(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER)
! Contribution of the RK time step
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUS_ADV
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVS_ADV
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWS_ADV
!$acc declare create(ZRUS_ADV,ZRVS_ADV,ZRWS_ADV)
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMXM_RHODJ
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMYM_RHODJ
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMZM_RHODJ
!$acc declare create(ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ)
!
! Momentum tendencies due to advection
INTEGER :: ISPLIT ! Number of splitting loops
......@@ -179,11 +200,55 @@ TYPE(LIST_ll), POINTER :: TZFIELD_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
!
#ifdef _OPENACC
INTEGER :: ISPL, IZU, IZV, IZW, IZUT, IZVT, IZWT, IZ1, IZ2
INTEGER :: IZRUSB, IZRUSE, IZRVSB, IZRVSE, IZRWSB, IZRWSE
#endif
!
!
!-------------------------------------------------------------------------------
!
!* 0. INITIALIZATION
! --------------
#ifdef _OPENACC
CALL INIT_ON_HOST_AND_DEVICE(ZRUT,-1e99,'ADVECTION_UVW::ZRUT')
CALL INIT_ON_HOST_AND_DEVICE(ZRVT,-2e99,'ADVECTION_UVW::ZRVT')
CALL INIT_ON_HOST_AND_DEVICE(ZRWT,-3e99,'ADVECTION_UVW::ZRWT')
CALL INIT_ON_HOST_AND_DEVICE(ZRUCT,-1e98,'ADVECTION_UVW::ZRUCT')
CALL INIT_ON_HOST_AND_DEVICE(ZRVCT,-2e98,'ADVECTION_UVW::ZRVCT')
CALL INIT_ON_HOST_AND_DEVICE(ZRWCT,-3e98,'ADVECTION_UVW::ZRWCT')
CALL INIT_ON_HOST_AND_DEVICE(ZU,-1e99,'ADVECTION_UVW::ZU')
CALL INIT_ON_HOST_AND_DEVICE(ZV,-1e99,'ADVECTION_UVW::ZV')
CALL INIT_ON_HOST_AND_DEVICE(ZW,-1e99,'ADVECTION_UVW::ZW')
CALL INIT_ON_HOST_AND_DEVICE(ZRUS_OTHER,-1e99,'ADVECTION_UVW::ZRUS_OTHER')
CALL INIT_ON_HOST_AND_DEVICE(ZRVS_OTHER,-1e99,'ADVECTION_UVW::ZRVS_OTHER')
CALL INIT_ON_HOST_AND_DEVICE(ZRWS_OTHER,-1e99,'ADVECTION_UVW::ZRWS_OTHER')
CALL INIT_ON_HOST_AND_DEVICE(ZRUS_ADV,-1e99,'ADVECTION_UVW::ZRUS_ADV')
CALL INIT_ON_HOST_AND_DEVICE(ZRVS_ADV,-1e99,'ADVECTION_UVW::ZRVS_ADV')
CALL INIT_ON_HOST_AND_DEVICE(ZRWS_ADV,-1e99,'ADVECTION_UVW::ZRWS_ADV')
CALL INIT_ON_HOST_AND_DEVICE(ZMXM_RHODJ,-1e97,'ADVECTION_UVW::ZMXM_RHODJ')
CALL INIT_ON_HOST_AND_DEVICE(ZMYM_RHODJ,-2e97,'ADVECTION_UVW::ZMYM_RHODJ')
CALL INIT_ON_HOST_AND_DEVICE(ZMZM_RHODJ,-3e97,'ADVECTION_UVW::ZMZM_RHODJ')
!
SELECT CASE (HTEMP_SCHEME)
CASE('RK11')
ISPL = 1
CASE('RK21')
ISPL = 2
CASE('RK33')
ISPL = 3
CASE('RK53')
ISPL = 5
CASE DEFAULT
PRINT *,'ERROR: UNKNOWN HTEMP_SCHEME'
CALL ABORT()
END SELECT
!
CALL MNH_GET_ZT3D(IZU, IZV, IZW, IZUT, IZVT, IZWT, IZ1, IZ2)
CALL MNH_GET_ZT4D(ISPL, IZRUSB, IZRUSE)
CALL MNH_GET_ZT4D(ISPL, IZRVSB, IZRVSE)
CALL MNH_GET_ZT4D(ISPL, IZRWSB, IZRWSE)
#endif
!
IKE = SIZE(PWT,3) - JPVEXT
!
......@@ -192,18 +257,27 @@ IJU = SIZE(PWT,2)
IKU = SIZE(PWT,3)
!
!
#ifndef _OPENACC
ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
#else
CALL MXM_DEVICE(PRHODJ,ZMXM_RHODJ)
CALL MYM_DEVICE(PRHODJ,ZMYM_RHODJ)
CALL MZM_DEVICE(PRHODJ,ZMZM_RHODJ)
#endif
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTES THE CONTRAVARIANT COMPONENTS
! -------------------------------------
!
!$acc kernels present(ZRUT,ZRVT,ZRWT) present(PUT,PVT,PWT) present(ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ)
ZRUT = PUT(:,:,:) * ZMXM_RHODJ
ZRVT = PVT(:,:,:) * ZMYM_RHODJ
ZRWT = PWT(:,:,:) * ZMZM_RHODJ
!$acc end kernels
!$acc update self(ZRUT,ZRVT)
!
NULLIFY(TZFIELD_ll)
!!$IF(NHALO == 1) THEN
......@@ -212,8 +286,15 @@ NULLIFY(TZFIELD_ll)
CALL UPDATE_HALO_ll(TZFIELD_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELD_ll)
!!$END IF
!$acc update device(ZRUT,ZRVT)
!
#ifndef _OPENACC
CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,4)
#else
CALL CONTRAV_DEVICE (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,4,&
ZT3D(:,:,:,IZ1),ZT3D(:,:,:,IZ2),ODATA_ON_DEVICE=.TRUE.)
!Not necessary: already done in contrav_device !$acc update self(ZRUCT,ZRVCT,ZRWCT)
#endif
!
NULLIFY(TZFIELDS_ll)
!!$IF(NHALO == 1) THEN
......@@ -223,6 +304,7 @@ NULLIFY(TZFIELDS_ll)
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
!!$END IF
!$acc update device(ZRUCT,ZRVCT,ZRWCT) !Needed in advecuvw_weno_k called by advecuvw_rk
!
!-------------------------------------------------------------------------------
!
......@@ -230,17 +312,31 @@ NULLIFY(TZFIELDS_ll)
!* 2. COMPUTES THE TENDENCIES SINCE THE BEGINNING OF THE TIME STEP
! ------------------------------------------------------------
!
!$acc update device(PRUS,PRVS,PRWS)
!$acc kernels present(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER) &
!$acc & present(ZRUT,ZRVT,ZRWT) present(PRUS,PRVS,PRWS) &
!$acc & copyin(PRUS_PRES,PRVS_PRES,PRWS_PRES)
ZRUS_OTHER = PRUS - ZRUT / PTSTEP + PRUS_PRES
ZRVS_OTHER = PRVS - ZRVT / PTSTEP + PRVS_PRES
ZRWS_OTHER = PRWS - ZRWT / PTSTEP + PRWS_PRES
!$acc end kernels
!
! Top and bottom Boundaries
!
#ifndef _OPENACC
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRUS_OTHER)
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRVS_OTHER)
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRWS_OTHER)
#else
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRUS_OTHER)
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRVS_OTHER)
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRWS_OTHER)
#endif
!$acc kernels
ZRWS_OTHER(:,:,IKE+1) = 0.
!$acc end kernels
!$acc update self(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER)
NULLIFY(TZFIELDS0_ll)
!!$IF(NHALO == 1) THEN
CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRUS_OTHER)
......@@ -249,6 +345,7 @@ NULLIFY(TZFIELDS0_ll)
CALL UPDATE_HALO_ll(TZFIELDS0_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS0_ll)
!!$END IF
!$acc update device(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER)
!
!
!
......@@ -259,9 +356,12 @@ ZTSTEP = PTSTEP / REAL(ISPLIT)
!
!-------------------------------------------------------------------------------
!
!$acc kernels present(ZU,ZV,ZW) present(PUT,PVT,PWT)
ZU = PUT
ZV = PVT
ZW = PWT
!$acc end kernels
!$acc update self(ZU,ZV,ZW)
!
!
!* 3. TIME SPLITTING
......@@ -277,10 +377,21 @@ DO JSPL=1,ISPLIT
ZMXM_RHODJ, ZMYM_RHODJ, ZMZM_RHODJ, &
ZRUCT, ZRVCT, ZRWCT, &
ZRUS_ADV, ZRVS_ADV, ZRWS_ADV, &
ZRUS_OTHER, ZRVS_OTHER, ZRWS_OTHER )
ZRUS_OTHER, ZRVS_OTHER, ZRWS_OTHER &
#ifndef _OPENACC
)
#else
,ZT3D(:,:,:,IZU), ZT3D(:,:,:,IZV), ZT3D(:,:,:,IZW), &
ZT3D(:,:,:,IZUT), ZT3D(:,:,:,IZVT), ZT3D(:,:,:,IZWT), &
ZT3D(:,:,:,IZRUSB:IZRUSE), ZT3D(:,:,:,IZRVSB:IZRVSE), ZT3D(:,:,:,IZRWSB:IZRWSE) )
#endif
!
! Tendencies on wind
!$acc update device(ZRUS_ADV,ZRVS_ADV,ZRWS_ADV)
!$acc kernels present(ZU,ZV,ZW) present(ZRUS_ADV,ZRVS_ADV,ZRWS_ADV) &
!$acc & present(ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ) &
!$acc & present(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER) &
!$acc & present(PRUS,PRVS,PRWS)
PRUS(:,:,:) = PRUS(:,:,:) + ZRUS_ADV(:,:,:) / ISPLIT
PRVS(:,:,:) = PRVS(:,:,:) + ZRVS_ADV(:,:,:) / ISPLIT
PRWS(:,:,:) = PRWS(:,:,:) + ZRWS_ADV(:,:,:) / ISPLIT
......@@ -288,19 +399,34 @@ DO JSPL=1,ISPLIT
!
! Guesses for next time splitting loop
!
IF (JSPL<ISPLIT) THEN
ZU(:,:,:) = ZU(:,:,:) + ZTSTEP / ZMXM_RHODJ * &
(ZRUS_OTHER(:,:,:) + ZRUS_ADV(:,:,:))
ZV(:,:,:) = ZV(:,:,:) + ZTSTEP / ZMYM_RHODJ * &
(ZRVS_OTHER(:,:,:) + ZRVS_ADV(:,:,:))
ZW(:,:,:) = ZW(:,:,:) + ZTSTEP / ZMZM_RHODJ * &
(ZRWS_OTHER(:,:,:) + ZRWS_ADV(:,:,:))
END IF
!$acc end kernels
!$acc update self(PRUS,PRVS,PRWS)
!
! Top and bottom Boundaries
!
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZU, PUT, 'U' )
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZV, PVT, 'V' )
IF (JSPL<ISPLIT) THEN
#ifndef _OPENACC
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZU, PUT, 'U' )
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZV, PVT, 'V' )
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZW, PWT, 'W' )
#else
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZU, PUT, 'U' )
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZV, PVT, 'V' )
CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZW, PWT, 'W' )
#endif
!$acc kernels present(ZW)
ZW (:,:,IKE+1 ) = 0.
!$acc end kernels
!$acc update self(ZU,ZV,ZW)
END IF
!
! End of the time splitting loop
END DO
......@@ -314,4 +440,11 @@ IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADV_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADV_BU_RW')
!-------------------------------------------------------------------------------
!
#ifdef _OPENACC
CALL MNH_REL_ZT4D(ISPL, IZRWSB)
CALL MNH_REL_ZT4D(ISPL, IZRVSB)
CALL MNH_REL_ZT4D(ISPL, IZRUSB)
CALL MNH_REL_ZT3D(ISPL, IZV, IZW, IZUT, IZVT, IZWT, IZ1, IZ2)
#endif
!
END SUBROUTINE ADVECTION_UVW
src/MNH/advection_uvw_cen.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/advecuvw_4th.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/advecuvw_rk.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/advecuvw_weno_k.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/aircraft_balloon_evol.f90
View file @ 8b176c90
......@@ -128,6 +128,9 @@ END MODULE MODI_AIRCRAFT_BALLOON_EVOL
!! Dec,15, 2008 (V. Masson) correct do while aircraft move
!! March, 2013 (O.Caumont) add radar reflectivities
!! April, 2014 (C.Lac) allow RARE calculation only if CCLOUD=ICE3
!! May, 2014 (O.Caumont) modify RARE for hydrometeors containing ice
!! add bright band calculation for RARE
!! Feb, 2015 (C.Lac) Correction to prevent aircraft crash
!!
!!
!! --------------------------------------------------------------------------
......@@ -146,7 +149,7 @@ USE MODD_CONF
USE MODD_DIAG_IN_RUN
USE MODD_TURB_FLUX_AIRCRAFT_BALLOON
USE MODD_RAIN_ICE_DESCR
USE MODE_FSCATTER,ONLY : QEPSW,QEPSI,BHMIE,MOMG
USE MODE_FSCATTER,ONLY : QEPSW,QEPSI,BHMIE,MOMG,MG
USE MODE_FGAU, ONLY : GAULAG
USE MODD_REF_n, ONLY : XRHODREF
USE MODI_GAMMA, ONLY : GAMMA
......@@ -298,13 +301,15 @@ REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZR
REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
REAL :: ZA,ZB,ZCC,ZCX,ZALPHA,ZNU,ZLB,ZLBEX,ZRHOHYD ! generic microphysical parameters
INTEGER :: JJ ! loop counter for quadrature
COMPLEX :: QMW,QMI,QM,QB ! dielectric parameter
COMPLEX :: QMW,QMI,QM,QB,QEPSIW,QEPSWI ! dielectric parameter
REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! temporary scattering parameters
REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays
INTEGER :: JPTS_GAULAG=7 ! number of points for Gauss-Laguerre quadrature
REAL :: ZLBDA ! slope distribution parameter
REAL :: ZFRAC_ICE ! ice water fraction
REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point
REAL :: ZFW ! liquid fraction
REAL :: ZFPW ! weight for mixed-phase reflectivity
REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
!----------------------------------------------------------------------------
......@@ -1003,6 +1008,7 @@ IF ( TPFLYER%FLY) THEN
ZRTMIN(6)=XRTMIN(6)
ZRTMIN(7)=XRTMIN(2) ! cloud water over land
! compute cloud radar reflectivity from vertical profiles of temperature and mixing ratios
! print *,"cest parti !!!"
DO JK=1,IKU
QMW=SQRT(QEPSW(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
QMI=SQRT(QEPSI(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
......@@ -1018,10 +1024,8 @@ IF ( TPFLYER%FLY) THEN
ZNU=XNUC2
ZLBEX=1.0/(ZCX-ZB)
ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
ZRHOHYD=XRHOLW
QM=QMW
CASE(3) ! rain water
ZA=XAR
ZA=XAR
ZB=XBR
ZCC=XCCR
ZCX=-1.
......@@ -1029,8 +1033,6 @@ IF ( TPFLYER%FLY) THEN
ZNU=XNUR
ZLB=XLBR
ZLBEX=XLBEXR
ZRHOHYD=XRHOLW
QM=QMW
CASE(4) ! pristine ice
ZA=XAI
ZB=XBI
......@@ -1040,8 +1042,7 @@ IF ( TPFLYER%FLY) THEN
ZNU=XNUI
ZLBEX=XLBEXI
ZLB=XLBI*ZCC**(-ZLBEX) ! because ZCC not included in XLBI
ZRHOHYD=.92*XRHOLW
QM=QMI
ZFW=0
CASE(5) ! snow
ZA=XAS
ZB=XBS
......@@ -1051,14 +1052,16 @@ IF ( TPFLYER%FLY) THEN
ZNU=XNUS
ZLB=XLBS
ZLBEX=XLBEXS
ZRHOHYD=.92*XRHOLW
QM=QMI
ZFW=0
CASE(6) ! graupel
IF(ZTEMPZ(JK) > XTT) THEN ! mixture of ice and water
ZFRAC_ICE = .85
ELSE ! only ice
ZFRAC_ICE=1.
END IF
!If temperature between -10 and 10°C and Mr and Mg over min threshold: melting graupel
! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel (Fw=0)
IF( ZTEMPZ(JK) > XTT-10 .AND. ZTEMPZ(JK) < XTT+10 &
.AND. ZRZ(JK,3) > XRTMIN(3) ) THEN
ZFW=ZRZ(JK,3)/(ZRZ(JK,3)+ZRZ(JK,JLOOP))
ELSE
ZFW=0
ENDIF
ZA=XAG
ZB=XBG
ZCC=XCCG
......@@ -1067,9 +1070,6 @@ IF ( TPFLYER%FLY) THEN
ZNU=XNUG
ZLB=XLBG
ZLBEX=XLBEXG
ZRHOHYD=((1.-ZFRAC_ICE)+ZFRAC_ICE*0.92)*XRHOLW
QB=2.*QMW**2*(2.*QMI**2*LOG(QMI/QMW)/(QMI**2-QMW**2)-1.)/(QMI**2-QMW**2)
QM=SQRT(((1.-ZFRAC_ICE)*QMW**2+ZFRAC_ICE*QB*QMI**2)/(1.-ZFRAC_ICE+ZFRAC_ICE*QB)) ! Bohren & Battan (1982)
CASE(7) ! cloud water over land
ZA=XAC
ZB=XBC
......@@ -1079,14 +1079,35 @@ IF ( TPFLYER%FLY) THEN
ZNU=XNUC
ZLBEX=1.0/(ZCX-ZB)
ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
ZRHOHYD=XRHOLW
QM=QMW
END SELECT
ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX
ZREFLOC=0.
ZAETMP=0.
DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature
ZDELTA_EQUIV=( 6.*ZA/XPI/ZRHOHYD * (ZX(JJ)**(1./ZALPHA)/ZLBDA)**ZB )**(1./3.)
ZDELTA_EQUIV=ZX(JJ)**(1./ZALPHA)/ZLBDA
SELECT CASE(JLOOP)
CASE(2,3,7)
QM=QMW
CASE(4,5,6)
! pristine ice, snow, dry graupel
ZRHOHYD=MIN(6.*ZA*ZDELTA_EQUIV**(ZB-3.)/XPI,.92*XRHOLW)
QM=sqrt(MG(QMI**2,CMPLX(1,0),ZRHOHYD/.92/XRHOLW))
! water inclusions in ice in air
QEPSWI=MG(QMW**2,QM**2,ZFW)
! ice in air inclusions in water
QEPSIW=MG(QM**2,QMW**2,1.-ZFW)
!MG weighted rule (Matrosov 2008)
IF(ZFW .LT. 0.37) THEN
ZFPW=0
ELSE IF(ZFW .GT. 0.63) THEN
ZFPW=1
ELSE
ZFPW=(ZFW-0.37)/(0.63-0.37)
ENDIF
QM=sqrt(QEPSWI*(1.-ZFPW)+QEPSIW*ZFPW)
END SELECT
CALL BHMIE(XPI/XLAM_CRAD*ZDELTA_EQUIV,QM,ZQEXT,ZQSCA,ZQBACK)
ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
......@@ -1124,8 +1145,8 @@ IF ( TPFLYER%FLY) THEN
END DO
! zenith
ZAETOT=1.
DO JK=COUNT(TPFLYER%Z_CUR >= ZZMZ(:))+1,IKU
IF(JK.EQ.COUNT(TPFLYER%Z_CUR >= ZZMZ(:))+1) THEN
DO JK = MAX(COUNT(TPFLYER%Z_CUR >= ZZMZ(:)),1)+1,IKU
IF ( JK .EQ. (MAX(COUNT(TPFLYER%Z_CUR >= ZZMZ(:)),1)+1) ) THEN
IF(TPFLYER%Z_CUR>=ZZMZ(JK)-.5*(ZZMZ(JK)-ZZMZ(JK-1))) THEN
! only attenuation from ZAELOC(JK)
ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK)*(ZZMZ(JK)-TPFLYER%Z_CUR)))
......
src/MNH/boundaries.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/calcsound.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/contrav.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/drag_veg.f90
View file @ 8b176c90
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
......
src/MNH/emoist.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/etheta.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/fast_terms.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/flat_invz.f90
View file @ 8b176c90
......@@ -1006,10 +1006,12 @@ CONTAINS
SUBROUTINE FAST_SUBSTITUTION_3D(PBAND_YR,PBETX,PPBF,PGAM,PPCF,PAF &
,PBAND_Y,KIY,KJY,KKU)
INTEGER :: KIY,KJY,KKU
REAL, DIMENSION (KIY*KJY,KKU) :: PBAND_YR,PBAND_Y,PPBF,PGAM,PAF
REAL, DIMENSION (KIY*KJY) :: PBETX
REAL, DIMENSION (KKU) :: PPCF
INTEGER,INTENT(IN) :: KIY,KJY,KKU
REAL, DIMENSION (KIY*KJY,KKU),INTENT(OUT) :: PBAND_YR,PGAM
REAL, DIMENSION (KIY*KJY,KKU),INTENT(IN) :: PBAND_Y,PPBF,PAF
REAL, DIMENSION (KIY*KJY),INTENT(OUT) :: PBETX
REAL, DIMENSION (KKU),INTENT(IN) :: PPCF
!
INTEGER :: JK
!
!
......
src/MNH/get_halo.f90
View file @ 8b176c90
This diff is collapsed.
src/MNH/gradient_m.f90
View file @ 8b176c90
This diff is collapsed.

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