Newer
Older

WAUTELET Philippe
committed
!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence

WAUTELET Philippe
committed
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######################
MODULE MODI_LES_BUDGET
! ######################
!
INTERFACE
!
SUBROUTINE LES_BUDGET(PVARS,KBUDN,HBUVAR,oadd)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
INTEGER, INTENT(IN) :: KBUDN ! variable number
CHARACTER(LEN=*), INTENT(IN) :: HBUVAR ! Identifier of the budget of the variable that is considered
logical, intent(in) :: oadd ! Flag to determine if source is to be added (true) or if is absolute (false)
END SUBROUTINE LES_BUDGET
END INTERFACE
END MODULE MODI_LES_BUDGET
!
! ####################################
SUBROUTINE LES_BUDGET(PVARS,KBUDN,HBUVAR,oadd)
! ####################################
!
!!**** *LES_BUDGET* - stores
!!
!! PURPOSE
!! -------
!
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! V. Masson *Meteo France*
!!
!! MODIFICATIONS
!! -------------
!! Original September 19, 2002
!! 25/11/2016 Q.Rodier correction bug variance u'^2 v'^2 w'^2

WAUTELET Philippe
committed
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 17/08/2020: treat LES budgets correctly
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!

WAUTELET Philippe
committed
use modd_budget, only: NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_TKE, &
NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1
USE MODD_LES
USE MODD_LES_BUDGET
USE MODD_NSV
!
USE MODI_SHUMAN
USE MODI_LES_VER_INT
USE MODI_LES_MEAN_ll
!
USE MODE_ll
!
USE MODI_SECOND_MNH
!
IMPLICIT NONE
!
!* 0.2 declaration of local variables
! ------------------------------
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
INTEGER, INTENT(IN) :: KBUDN ! variable number
CHARACTER(LEN=*), INTENT(IN) :: HBUVAR ! Identifier of the budget of the variable that is considered
logical, intent(in) :: oadd ! Flag to determine if source is to be added (true) or if is absolute (false)
!
!* 0.2 declaration of local variables
! ------------------------------
!
INTEGER :: ILES_BU ! number of process in LES budgets
!
INTEGER :: IIU, IJU, IKU ! array dimensions
INTEGER :: JSV ! scalar loop counter
REAL :: ZTIME1, ZTIME2
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEND
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK_LES ! work array
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZANOM ! field anomaly after process occured
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL_ANOM ! THL anomaly after process occured
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
REAL, DIMENSION(NLES_K) :: ZLES_PROF
INTEGER :: IINFO_ll ! return code of parallel routine
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
INTEGER :: JK
!-------------------------------------------------------------------------------
!
CALL SECOND_MNH(ZTIME1)
!
CALL GET_DIM_EXT_ll('B',IIU,IJU)
IKU=SIZE(PVARS,3)
!
!
ALLOCATE(ZWORK_LES (IIU,IJU,NLES_K))
ALLOCATE(ZANOM (IIU,IJU,NLES_K))
!
!* LES budget term depending of the current physical process
! ---------------------------------------------------------
!
CALL LES_BU_PROCESS(HBUVAR,ILES_BU)
!
!* test on variable type
! ---------------------
!
!
SELECT CASE (KBUDN)
!
!* u
!

WAUTELET Philippe
committed
CASE( NBUDGET_U )
if ( oadd ) then
CALL LES_BUDGET_ANOMALY(XCURRENT_RUS + PVARS,'X',ZANOM)
else
CALL LES_BUDGET_ANOMALY(PVARS,'X',ZANOM)
end if
ZWORK_LES = 0.5*( ZANOM ** 2 - XU_ANOM ** 2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_KE(:,ILES_BU) = X_LES_BU_RES_KE(:,ILES_BU) + ZLES_PROF(:)
!
!* update fields
if ( oadd ) then
XCURRENT_RUS = XCURRENT_RUS + PVARS
else
XCURRENT_RUS = PVARS
end if
XU_ANOM = ZANOM
!
!* v
!

WAUTELET Philippe
committed
CASE( NBUDGET_V )
if ( oadd ) then
CALL LES_BUDGET_ANOMALY(XCURRENT_RVS + PVARS,'Y',ZANOM)
else
CALL LES_BUDGET_ANOMALY(PVARS,'Y',ZANOM)
end if
ZWORK_LES = 0.5*( ZANOM ** 2 - XV_ANOM ** 2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_KE(:,ILES_BU) = X_LES_BU_RES_KE(:,ILES_BU) + ZLES_PROF(:)
!
!* update fields
if ( oadd ) then
XCURRENT_RVS = XCURRENT_RVS + PVARS
else
XCURRENT_RVS = PVARS
end if
XV_ANOM = ZANOM
!
!* w
!

WAUTELET Philippe
committed
CASE( NBUDGET_W )
if ( oadd ) then
CALL LES_BUDGET_ANOMALY(XCURRENT_RWS + PVARS,'Z',ZANOM)
else
CALL LES_BUDGET_ANOMALY(PVARS,'Z',ZANOM)
end if
ZWORK_LES = 0.5*( ZANOM ** 2 - XW_ANOM ** 2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_KE(:,ILES_BU) = X_LES_BU_RES_KE(:,ILES_BU) + ZLES_PROF(:)
!
!* action in WTHL budget
ZWORK_LES = ( ZANOM * XTHL_ANOM - XW_ANOM * XTHL_ANOM ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_WTHL(:,ILES_BU) = X_LES_BU_RES_WTHL(:,ILES_BU) + ZLES_PROF(:)
ZWORK_LES = ( ZANOM * XRT_ANOM - XW_ANOM * XRT_ANOM ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_WRT(:,ILES_BU) = X_LES_BU_RES_WRT(:,ILES_BU) + ZLES_PROF(:)
ZWORK_LES = ( ZANOM * XSV_ANOM(:,:,:,JSV) - XW_ANOM * XSV_ANOM(:,:,:,JSV)) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_WSV(:,ILES_BU,JSV) = X_LES_BU_RES_WSV(:,ILES_BU,JSV) + ZLES_PROF(:)
if ( oadd ) then
XCURRENT_RWS = XCURRENT_RWS + PVARS
else
XCURRENT_RWS = PVARS
end if
XW_ANOM = ZANOM
!
!* Th
!

WAUTELET Philippe
committed
CASE( NBUDGET_TH )
if ( oadd ) then
XCURRENT_RTHLS = XCURRENT_RTHLS + PVARS
else
XCURRENT_RTHLS = XCURRENT_RTHLS + PVARS - XCURRENT_RTHS
end if
CALL LES_BUDGET_ANOMALY(XCURRENT_RTHLS,'-',ZANOM)
!
!* action in WTHL budget
ZWORK_LES = ( ZANOM * XW_ANOM - XW_ANOM * XTHL_ANOM ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_WTHL(:,ILES_BU) = X_LES_BU_RES_WTHL(:,ILES_BU) + ZLES_PROF(:)
!* action in THL2 budget
ZWORK_LES = ( ZANOM ** 2 - XTHL_ANOM**2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_THL2(:,ILES_BU) = X_LES_BU_RES_THL2(:,ILES_BU) + ZLES_PROF(:)
ZWORK_LES = ( ZANOM * XRT_ANOM - XRT_ANOM * XTHL_ANOM ) / &
XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_THLRT(:,ILES_BU) = X_LES_BU_RES_THLRT(:,ILES_BU) + ZLES_PROF(:)
if ( oadd ) then
XCURRENT_RTHS = XCURRENT_RTHS + PVARS
else
XCURRENT_RTHS = PVARS
end if

WAUTELET Philippe
committed
CASE( NBUDGET_TKE )
if ( oadd ) then
ZTEND(:,:,:) = PVARS(:,:,:) / XCURRENT_RHODJ
XCURRENT_RTKES = XCURRENT_RTKES+PVARS
else
ZTEND(:,:,:) = (PVARS(:,:,:)-XCURRENT_RTKES(:,:,:)) / XCURRENT_RHODJ
XCURRENT_RTKES = PVARS
end if
CALL LES_VER_INT( ZTEND, ZWORK_LES )
DEALLOCATE(ZTEND)
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_SBG_Tke(:,ILES_BU) = X_LES_BU_SBG_Tke(:,ILES_BU) + ZLES_PROF(:)
!
!* Rv, Rr, Ri, Rs, Rg, Rh
!

WAUTELET Philippe
committed
CASE( NBUDGET_RV, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH )
!* transformation into conservative variables: RT
if ( oadd ) then
XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:)
else
XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1))
end if
CALL LES_BUDGET_ANOMALY(XCURRENT_RRTS,'-',ZANOM)
!
!* action in WRT budget
ZWORK_LES = ( ZANOM * XW_ANOM - XW_ANOM * XRT_ANOM ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_WRT(:,ILES_BU) = X_LES_BU_RES_WRT(:,ILES_BU) + ZLES_PROF(:)
!* action in RT2 budget
ZWORK_LES = ( ZANOM **2 - XRT_ANOM **2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_RT2(:,ILES_BU) = X_LES_BU_RES_RT2(:,ILES_BU) + ZLES_PROF(:)
!* action in THLRT budget
ZWORK_LES = ( ZANOM * XTHL_ANOM - XTHL_ANOM * XRT_ANOM ) / &
XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_THLRT(:,ILES_BU) = X_LES_BU_RES_THLRT(:,ILES_BU) + ZLES_PROF(:)
if ( oadd ) then
XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) = XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) + PVARS
else
XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) = PVARS
end if

WAUTELET Philippe
committed
CASE( NBUDGET_RC )
!* transformation into conservative variables: theta_l; RT
if ( oadd ) then
XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:)
else
XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1))
end if
if ( oadd ) then
XCURRENT_RTHLS = XCURRENT_RTHLS - XCURRENT_L_O_EXN_CP &
* (PVARS(:,:,:) )
else
XCURRENT_RTHLS = XCURRENT_RTHLS - XCURRENT_L_O_EXN_CP &
* (PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)))
end if
ALLOCATE(ZTHL_ANOM(IIU,IJU,NLES_K))
CALL LES_BUDGET_ANOMALY(XCURRENT_RTHLS,'-',ZTHL_ANOM)
CALL LES_BUDGET_ANOMALY(XCURRENT_RRTS,'-',ZANOM)
!
!* action in WTHL budget
ZWORK_LES = ( ZTHL_ANOM * XW_ANOM - XTHL_ANOM * XW_ANOM ) / &
XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_WTHL(:,ILES_BU) = X_LES_BU_RES_WTHL(:,ILES_BU) + ZLES_PROF(:)
!* action in THL2 budget
ZWORK_LES = ( ZTHL_ANOM **2 - XTHL_ANOM **2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_THL2(:,ILES_BU) = X_LES_BU_RES_THL2(:,ILES_BU) + ZLES_PROF(:)
!* action in THLRT budget
ZWORK_LES = ( ZANOM * ZTHL_ANOM - XRT_ANOM * XTHL_ANOM ) / &
XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_THLRT(:,ILES_BU) = X_LES_BU_RES_THLRT(:,ILES_BU) + ZLES_PROF(:)
!* action in WRT budget
ZWORK_LES = ( ZANOM * XW_ANOM - XRT_ANOM * XW_ANOM ) / &
XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_WRT(:,ILES_BU) = X_LES_BU_RES_WRT(:,ILES_BU) + ZLES_PROF(:)
!* action in RT2 budget
ZWORK_LES = ( ZANOM **2 - XRT_ANOM **2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_RT2(:,ILES_BU) = X_LES_BU_RES_RT2(:,ILES_BU) + ZLES_PROF(:)
if ( oadd ) then
XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) = XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) + PVARS
else
XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) = PVARS
end if

WAUTELET Philippe
committed
CASE( NBUDGET_SV1: )
if ( oadd ) then
CALL LES_BUDGET_ANOMALY(XCURRENT_RSVS(:,:,:,KBUDN-(NBUDGET_SV1-1)) + PVARS,'-',ZANOM)
else
CALL LES_BUDGET_ANOMALY(PVARS,'-',ZANOM)
end if

WAUTELET Philippe
committed
ZWORK_LES = ( ZANOM * XW_ANOM - XSV_ANOM(:,:,:,KBUDN-(NBUDGET_SV1-1)) * XW_ANOM ) / &
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)

WAUTELET Philippe
committed
X_LES_BU_RES_WSV(:,ILES_BU,KBUDN-(NBUDGET_SV1-1)) = X_LES_BU_RES_WSV(:,ILES_BU,KBUDN-(NBUDGET_SV1-1)) + ZLES_PROF(:)

WAUTELET Philippe
committed
ZWORK_LES = ( ZANOM **2 - XSV_ANOM(:,:,:,KBUDN-(NBUDGET_SV1-1)) **2 ) / &
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)

WAUTELET Philippe
committed
X_LES_BU_RES_SV2(:,ILES_BU,KBUDN-(NBUDGET_SV1-1)) = X_LES_BU_RES_SV2(:,ILES_BU,KBUDN-(NBUDGET_SV1-1)) + ZLES_PROF(:)
if ( oadd ) then
XCURRENT_RSVS(:,:,:,KBUDN-(NBUDGET_SV1-1)) = XCURRENT_RSVS(:,:,:,KBUDN-(NBUDGET_SV1-1)) + PVARS
else
XCURRENT_RSVS(:,:,:,KBUDN-(NBUDGET_SV1-1)) = PVARS
end if

WAUTELET Philippe
committed
XSV_ANOM(:,:,:,KBUDN-(NBUDGET_SV1-1)) = ZANOM
END SELECT
!
!
!* deallocations
!
DEALLOCATE(ZWORK_LES)
DEALLOCATE(ZANOM )
!
CALL SECOND_MNH(ZTIME2)
!
XTIME_LES_BU_PROCESS = XTIME_LES_BU_PROCESS + ZTIME2 - ZTIME1
XTIME_LES_BU = XTIME_LES_BU + ZTIME2 - ZTIME1
!
!---------------------------------------------------
CONTAINS
!---------------------------------------------------
SUBROUTINE LES_BU_PROCESS(HBU,KLES_BU)
CHARACTER (LEN=*), INTENT(IN) :: HBU ! Identifier of the Budget of the
! variable that is considered
INTEGER, INTENT(OUT) :: KLES_BU ! LES budget identifier
!
IF (HBU=='ADV') THEN
ELSE IF (HBU=='REL') THEN
ELSE IF (HBU=='VTURB') THEN
ELSE IF (HBU=='HTURB') THEN
ELSE IF (HBU=='GRAV') THEN
ELSE IF (HBU=='PRES') THEN
ELSE IF (HBU=='PREF') THEN
ELSE IF (HBU=='CURV') THEN
ELSE IF (HBU=='COR') THEN
ELSE IF (HBU=='DP') THEN
ELSE IF (HBU=='TP') THEN
ELSE IF (HBU=='TR') THEN

WAUTELET Philippe
committed
ELSE IF ( HBU == 'DISS' .OR. HBU == 'DISSH' ) THEN
!Both DISS and DISSH source terms are included in the same index
!but they are stored in different budgets (DISS goes to NBUDGET_TKE, DISSH to NBUDGET_TH)
ELSE IF (HBU=='DIF') THEN
ELSE IF (HBU=='RAD') THEN
ELSE IF (HBU=='NEST') THEN
KLES_BU = NLES_NEST
ELSE
KLES_BU = NLES_MISC
END IF
!
END SUBROUTINE LES_BU_PROCESS
!
!--------------------------------------------------------------------------------
!
SUBROUTINE LES_BUDGET_ANOMALY(PVARS,HGRID,PANOM)
!
USE MODI_LES_ANOMALY_FIELD
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS
CHARACTER(LEN=1), INTENT(IN) :: HGRID
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PANOM
!
REAL, DIMENSION(SIZE(PVARS,1),SIZE(PVARS,2),SIZE(PVARS,3)) :: ZS
REAL, DIMENSION(SIZE(PVARS,1),SIZE(PVARS,2),SIZE(PVARS,3)) :: ZRHODJ
INTEGER :: IINFO_ll
SELECT CASE (HGRID)
CASE ('X')
ZRHODJ(:,:,:) = MXM(XCURRENT_RHODJ)
ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP
CASE ('Y')
ZRHODJ(:,:,:) = MYM(XCURRENT_RHODJ)
ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP

WAUTELET Philippe
committed
ZRHODJ(:,:,:) = MZM(XCURRENT_RHODJ)
ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP
CASE DEFAULT
ZRHODJ(:,:,:) = XCURRENT_RHODJ
ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP
END SELECT
NULLIFY(TZFIELDS_ll)

WAUTELET Philippe
committed
CALL ADD3DFIELD_ll( TZFIELDS_ll, ZS, 'LES_BUDGET_ANOMALY::ZS' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
!
SELECT CASE (HGRID)
CASE ('X')
ZS(:,:,:) = MXF(ZS)
CASE ('Y')
ZS(:,:,:) = MYF(ZS)
CASE ('Z')

WAUTELET Philippe
committed
ZS(:,:,:) = MZF(ZS)
END SELECT
CALL LES_ANOMALY_FIELD(ZS,PANOM)
END SUBROUTINE LES_BUDGET_ANOMALY
!--------------------------------------------------------------------------------
!
END SUBROUTINE LES_BUDGET