From 92a2e8ffa453f026ab7c123c44f99736ee56fd23 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 28 Jan 2020 16:55:55 +0100
Subject: [PATCH] Philippe 28/01/2020: budgets: use the new data structures and
subroutines for budgets for U
---
src/MNH/advection_uvw.f90 | 26 +++--
src/MNH/advection_uvw_cen.f90 | 31 ++---
src/MNH/drag_veg.f90 | 30 +++--
src/MNH/dyn_sources.f90 | 32 ++++--
src/MNH/endstep.f90 | 50 +++++---
src/MNH/endstep_budget.f90 | 30 ++++-
src/MNH/forcing.f90 | 21 +++-
src/MNH/ini_budget.f90 | 210 ++++++++++++++++++----------------
src/MNH/initial_guess.f90 | 51 +++++----
src/MNH/modeln.f90 | 27 +++--
src/MNH/nudging.f90 | 16 ++-
src/MNH/num_diff.f90 | 35 +++---
src/MNH/pressure.f90 | 15 ++-
src/MNH/pressurez.f90 | 15 ++-
src/MNH/relaxation.f90 | 42 ++++---
src/MNH/shallow_mf_pack.f90 | 10 +-
src/MNH/turb.f90 | 30 +++--
src/MNH/two_way.f90 | 26 +++--
src/MNH/viscosity.f90 | 27 +++--
src/MNH/write_budget.f90 | 6 +-
20 files changed, 448 insertions(+), 282 deletions(-)
diff --git a/src/MNH/advection_uvw.f90 b/src/MNH/advection_uvw.f90
index 54b6db96a..5e18671a4 100644
--- a/src/MNH/advection_uvw.f90
+++ b/src/MNH/advection_uvw.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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
!MNH_LIC for details. version 1.
@@ -92,22 +92,25 @@ END MODULE MODI_ADVECTION_UVW
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! C.LAC 10/2016 : Add OSPLIT_WENO
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
-USE MODD_PARAMETERS, ONLY : JPVEXT
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, NBUDGET_U, NBUDGET_V, NBUDGET_W, tbudgets
USE MODD_CONF, ONLY : NHALO
-USE MODD_BUDGET
-!
-USE MODI_SHUMAN
-USE MODI_CONTRAV
-USE MODI_ADVECUVW_RK
+USE MODD_PARAMETERS, ONLY : JPVEXT
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_ll
+
USE MODI_ADV_BOUNDARIES
+USE MODI_ADVECUVW_RK
USE MODI_BUDGET
+USE MODI_CONTRAV
+USE MODI_SHUMAN
!
!-------------------------------------------------------------------------------
!
@@ -197,7 +200,9 @@ IKU = SIZE(PWT,3)
ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
-!
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus )
+
!-------------------------------------------------------------------------------
!
!* 1. COMPUTES THE CONTRAVARIANT COMPONENTS
@@ -319,7 +324,8 @@ END DO
!* 4. BUDGETS
! -------
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'ADV_BU_RU')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ADV', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'ADV_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'ADV_BU_RW')
!-------------------------------------------------------------------------------
diff --git a/src/MNH/advection_uvw_cen.f90 b/src/MNH/advection_uvw_cen.f90
index ea8051c4e..f1b1d8eb8 100644
--- a/src/MNH/advection_uvw_cen.f90
+++ b/src/MNH/advection_uvw_cen.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 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
!MNH_LIC for details. version 1.
@@ -88,27 +88,28 @@ END MODULE MODI_ADVECTION_UVW_CEN
!! Original 01/2013 (from ADVECTION routine)
!! Modif
!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
USE MODD_CONF
-USE MODD_PARAMETERS
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, NBUDGET_U, NBUDGET_V, NBUDGET_W, tbudgets
USE MODD_GRID_n
-!
-USE MODI_SHUMAN
-USE MODI_CONTRAV
+USE MODD_PARAMETERS
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_ll
+
USE MODI_ADVECUVW_2ND
USE MODI_ADVECUVW_4TH
-!
-USE MODD_BUDGET
USE MODI_BUDGET
-!
+USE MODI_CONTRAV
+USE MODI_SHUMAN
+
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
@@ -179,6 +180,9 @@ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKU = SIZE(XZHAT)
IKB=1+JPVEXT
IKE=IKU-JPVEXT
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus )
+
ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
@@ -247,8 +251,9 @@ PRWS(:,:,:) = PRWS(:,:,:) + ( ZWS(:,:,:) - PWM(:,:,:) - 0.5* PDWM) * ZMZM_RHODJ/
PDUM = ZUS(:,:,:) - PUM(:,:,:)
PDVM = ZVS(:,:,:) - PVM(:,:,:)
PDWM = ZWS(:,:,:) - PWM(:,:,:)
-!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'ADV_BU_RU')
+
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ADV', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'ADV_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'ADV_BU_RW')
!
diff --git a/src/MNH/drag_veg.f90 b/src/MNH/drag_veg.f90
index e8ece294e..fbd159cf2 100644
--- a/src/MNH/drag_veg.f90
+++ b/src/MNH/drag_veg.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2009-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-2020 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
!MNH_LIC for details. version 1.
@@ -74,29 +74,32 @@ SUBROUTINE DRAG_VEG(PTSTEP,PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
!! S. Donier 06/2015 : bug surface aerosols
!! C.Lac 07/2016 : Add droplet deposition
!! C.Lac 10/2017 : Correction on deposition
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!!---------------------------------------------------------------
!
!
!* 0. DECLARATIONS
! ------------
!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_rc, lbudget_sv, lbudget_tke, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_RC, NBUDGET_SV1, NBUDGET_TKE, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_DYN
USE MODD_DYN_n
-USE MODD_VEG_n
-USE MODD_BUDGET
-USE MODD_PARAM_C2R2
+USE MODD_GROUND_PAR
USE MODD_NSV
-
-!
-USE MODI_SHUMAN
+USE MODD_PARAM_C2R2
USE MODD_PGDFIELDS
-USE MODD_GROUND_PAR
-USE MODI_MNHGET_SURF_PARAM_n
+USE MODD_VEG_n
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
USE MODI_BUDGET
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_SHUMAN
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -149,6 +152,8 @@ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZWDEPR,ZWDEPS
IIU = SIZE(PUT,1)
IJU = SIZE(PUT,2)
IKU = SIZE(PUT,3)
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'DRAG', prus )
!
!* 0.3 Initialisation de kelkes variables
!
@@ -270,8 +275,9 @@ IF (ODEPOTREE) THEN
!
!
END IF
-!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'DRAG_BU_RU')
+
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'DRAG', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'DRAG_BU_RV')
IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),NBUDGET_RC,'DEPOTR_BU_RRC')
IF (LBUDGET_SV) CALL BUDGET (PSVS(:,:,:,NSV_C2R2BEG+1),NBUDGET_SV1+(NSV_C2R2BEG-1)+1,'DEPOTR_BU_RSV')
diff --git a/src/MNH/dyn_sources.f90 b/src/MNH/dyn_sources.f90
index 56c6a2010..3970a0c03 100644
--- a/src/MNH/dyn_sources.f90
+++ b/src/MNH/dyn_sources.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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
!MNH_LIC for details. version 1.
@@ -147,22 +147,26 @@ END MODULE MODI_DYN_SOURCES
!! Correction 06/10 (C.Lac) Exclude L1D for Coriolis term
!! Modification 03/11 (C.Lac) Split the gravity term due to buoyancy
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_DYN
-!
-USE MODI_SHUMAN
-USE MODI_GRADIENT_M
-USE MODI_BUDGET
-!
+
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_MPPDB
-!
+
+USE MODI_BUDGET
+USE MODI_GRADIENT_M
+USE MODI_SHUMAN
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -220,7 +224,9 @@ IKU = SIZE(PUT,3)
!
! Only when earth rotation is considered but not in 1D and CARTESIAN cases
!
-IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'CURV', prus )
+
+IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN
IF ( LTHINSHELL ) THEN ! THINSHELL approximation
!
ZWORK1(:,:,:) = SPREAD( PCURVX(:,:),DIM=3,NCOPIES=IKU ) / XRADIUS
@@ -263,7 +269,8 @@ IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN
!
END IF
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'CURV_BU_RU')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'CURV', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'CURV_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'CURV_BU_RW')
!
@@ -272,6 +279,8 @@ IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'CURV_BU_RW')
!* 3. COMPUTES THE CORIOLIS TERMS
! ---------------------------
!
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'COR', prus )
+
IF (LCORIO) THEN
!
ZWORK3(:,:,:) = SPREAD( PCORIOZ(:,:),DIM=3,NCOPIES=IKU ) * PRHODJ(:,:,:)
@@ -294,7 +303,8 @@ IF (LCORIO) THEN
!
END IF
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'COR_BU_RU')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'COR', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'COR_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'COR_BU_RW')
!
diff --git a/src/MNH/endstep.f90 b/src/MNH/endstep.f90
index d29f434ea..e533c689b 100644
--- a/src/MNH/endstep.f90
+++ b/src/MNH/endstep.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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
!MNH_LIC for details. version 1.
@@ -192,28 +192,35 @@ END MODULE MODI_ENDSTEP
!! 04/2014 (C.Lac) Check on the positivity of PSVT
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 02/2019 (S. Bielli) Sea salt : significant sea wave height influences salt emission; 5 salt modes
-!!
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_DYN
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, lbu_enable, &
+ 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, &
+ nbuctr_actv, nbuprocctr, nbustep, tbudgets
+USE MODD_CH_AEROSOL, ONLY: LORILAM
USE MODD_CONF
USE MODD_CTURB
+USE MODD_DUST, ONLY: LDUST
+USE MODD_DYN
USE MODD_GRID_n
-USE MODD_BUDGET
-USE MODD_NSV, ONLY : XSVMIN, NSV_CHEMBEG, NSV_CHEMEND, &
- NSV_AERBEG, NSV_AEREND,&
- NSV_DSTBEG, NSV_DSTEND,&
- NSV_SNWBEG, NSV_SNWEND
-USE MODD_CH_AEROSOL, ONLY : LORILAM
-USE MODD_DUST, ONLY : LDUST
-USE MODD_PARAM_C2R2, ONLY : LACTIT
-USE MODD_PARAM_LIMA, ONLY : LACTIT_LIMA=>LACTIT
-USE MODD_LBC_n, ONLY : CLBCX, CLBCY
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
+USE MODD_LBC_n, ONLY: CLBCX, CLBCY
+USE MODD_NSV, ONLY: XSVMIN, NSV_CHEMBEG, NSV_CHEMEND, &
+ NSV_AERBEG, NSV_AEREND,&
+ NSV_DSTBEG, NSV_DSTEND,&
+ NSV_SNWBEG, NSV_SNWEND
+USE MODD_PARAM_C2R2, ONLY: LACTIT
+USE MODD_PARAM_LIMA, ONLY: LACTIT_LIMA=>LACTIT
+
+use mode_budget, only: Budget_store_end, Budget_store_init
+
USE MODI_BUDGET
USE MODI_SHUMAN
!
@@ -516,8 +523,10 @@ END IF
IF (LBU_ENABLE) THEN
NBUPROCCTR (1 : NBUDGET_SV1 - 1 + KSV ) = 3
NBUCTR_ACTV(1 : NBUDGET_SV1 - 1 + KSV ) = 3
-!
- IF (LBUDGET_U) CALL BUDGET( PUT(:,:,:) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_U, 'AVEF_BU_RU' )
+
+ !Division by nbustep to compute average on the selected time period
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'AVEF', put(:, :, :) * prhodj(:, :, :) / ( ptstep * nbustep ) )
+
IF (LBUDGET_V) CALL BUDGET( PVT(:,:,:) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_V, 'AVEF_BU_RV' )
IF (LBUDGET_W) CALL BUDGET( PWT(:,:,:) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_W, 'AVEF_BU_RW' )
IF (LBUDGET_TH) CALL BUDGET( PTHT(:,:,:) * PRHODJ(:,:,:) / PTSTEP, NBUDGET_TH, 'AVEF_BU_RTH' )
@@ -537,8 +546,11 @@ IF (LBU_ENABLE) THEN
!
NBUPROCCTR (1 : NBUDGET_SV1 - 1 + KSV ) = 2
NBUCTR_ACTV(1 : NBUDGET_SV1 - 1 + KSV ) = 2
-!
- IF (LBUDGET_U) CALL BUDGET( PUS * MXM(PRHODJ) / PTSTEP, NBUDGET_U, 'ENDF_BU_RU' )
+
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ENDF', pus(:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep )
+
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ASSE', pus(:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep )
+
IF (LBUDGET_V) CALL BUDGET( PVS * MYM(PRHODJ) / PTSTEP, NBUDGET_V, 'ENDF_BU_RV' )
IF (LBUDGET_W) CALL BUDGET( PWS * MZM(1,IKU,1,PRHODJ) / PTSTEP, NBUDGET_W, 'ENDF_BU_RW' )
IF (LBUDGET_TH) CALL BUDGET( PTHS * PRHODJ / PTSTEP, NBUDGET_TH, 'ENDF_BU_RTH' )
diff --git a/src/MNH/endstep_budget.f90 b/src/MNH/endstep_budget.f90
index 8018b390e..06bf6ad2a 100644
--- a/src/MNH/endstep_budget.f90
+++ b/src/MNH/endstep_budget.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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
!MNH_LIC for details. version 1.
@@ -93,22 +93,22 @@ END MODULE MODI_ENDSTEP_BUDGET
!! N. Asensio 22/06/99 // MASK case : delete KIU,KJU,KKU arguments
!! and change the write_budget call
!! C.Lac 11/09/15 adaptation to FIT temporal scheme
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_BUDGET
USE MODD_IO, ONLY: TFILEDATA
USE MODD_TIME
-USE MODD_BUDGET
!
+use mode_msg
use mode_write_budget, only: Write_budget
!
IMPLICIT NONE
!
-!
!* 0.1 Declarations of arguments :
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
@@ -116,9 +116,13 @@ INTEGER, INTENT(IN) :: KTCOUNT ! temporal loop counter
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
REAL, INTENT(IN) :: PTSTEP ! time step
INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
+
+integer :: jbu, jgrp
+
!-------------------------------------------------------------------------------
!
+call Print_msg( NVERB_DEBUG, 'BUD', 'Endstep_budget', 'called' )
+
SELECT CASE(CBUTYPE)
!
!
@@ -151,6 +155,14 @@ SELECT CASE(CBUTYPE)
IF (ALLOCATED(XBURHODJV)) XBURHODJV=0.
IF (ALLOCATED(XBURHODJW)) XBURHODJW=0.
IF (ALLOCATED(XBURHODJ)) XBURHODJ =0.
+
+ if ( tbudgets(NBUDGET_U)%lenabled ) tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = 0.
+
+ do jbu = 1, nbudgets
+ do jgrp = 1, tbudgets(jbu)%ngroups
+ tbudgets(jbu)%tgroups(jgrp)%xdata(:, :, : ) = 0.
+ end do
+ end do
!
!* 1.3 reset budget beginning flag to TRUE
!
@@ -187,6 +199,12 @@ SELECT CASE(CBUTYPE)
IF (ALLOCATED(XBURHODJV)) XBURHODJV=0.
IF (ALLOCATED(XBURHODJW)) XBURHODJW=0.
IF (ALLOCATED(XBURHODJ)) XBURHODJ =0.
+
+ do jbu = 1, nbudgets
+ do jgrp = 1, tbudgets(jbu)%ngroups
+ tbudgets(jbu)%tgroups(jgrp)%xdata(:, :, : ) = 0.
+ end do
+ end do
!
NBUTIME=0
!
diff --git a/src/MNH/forcing.f90 b/src/MNH/forcing.f90
index fbf7f239a..bc26487f9 100644
--- a/src/MNH/forcing.f90
+++ b/src/MNH/forcing.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 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
!MNH_LIC for details. version 1.
@@ -143,15 +143,20 @@ END MODULE MODI_FORCING
!! 06/2012 V. Masson Adds tendency of geostrophic wind itself to wind tendency
!! 01/2014 J. escobar correction for // initialisation geostrophic ZUF,ZVF,ZWF
!! 09/2017 Q.Rodier add LTEND_UV_FRC
-!! 28/03/2018 P. Wautelet Replace TEMPORAL_DIST by DATETIME_DISTANCE
-!! use overloaded comparison operator for date_time
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/03/2018: replace TEMPORAL_DIST by DATETIME_DISTANCE
+! use overloaded comparison operator for date_time
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ 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, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_DYN
@@ -160,6 +165,7 @@ USE MODD_LUNIT
USE MODD_PARAMETERS
USE MODD_TIME
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_DATETIME
USE MODE_MSG
!
@@ -246,6 +252,8 @@ IJU=SIZE(PUT,2)
IKU=SIZE(PUT,3)
!
ILUOUT0 = TLUOUT0%NLU
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'FRC', prus )
!
!* 1. PREPARATION OF FORCING
! ----------------------
@@ -827,7 +835,8 @@ END IF
! ------------
!
!
-IF (LBUDGET_U) CALL BUDGET (PRUS, NBUDGET_U, 'FRC_BU_RU')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'FRC', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS, NBUDGET_V, 'FRC_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS, NBUDGET_W, 'FRC_BU_RW')
IF (LBUDGET_TH) CALL BUDGET (PRTHS, NBUDGET_TH, 'FRC_BU_RTH')
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index 4a5b3f689..5f88ea132 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -103,6 +103,7 @@ contains
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 15/11/2019: remove unused CBURECORD variable
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -112,6 +113,7 @@ USE MODD_PARAMETERS
USE MODD_BUDGET
USE MODD_DYN
USE MODD_CONF
+use modd_field, only: TYPEREAL
USE MODD_PARAM_ICE
USE MODD_PARAM_C2R2
USE MODD_ELEC_DESCR, ONLY : LINDUCTIVE
@@ -122,6 +124,7 @@ USE MODD_PARAM_LIMA, ONLY : OWARM=>LWARM, OCOLD=>LCOLD, OSEDI=>LSEDI, &
OHAIL=>LHAIL, OSCAV=>LSCAV, OMEYERS=>LMEYERS,&
ODEPOC=>LDEPOC, OPTSPLIT=>LPTSPLIT, &
NMOD_CCN
+use modd_viscosity, only: lvisc
!
USE MODE_ll
USE MODE_MSG
@@ -206,18 +209,13 @@ INTEGER :: JSV ! loop indice for the SVs
INTEGER :: IBUPROCNBR_SV_MAX ! Max number of processes for the SVs
INTEGER :: ILAST_PROC_NBR ! Index of the last process number
INTEGER :: IINFO_ll ! return status of the interface routine
-INTEGER :: IRESP ! Return code of FM-routines
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!
-!!! the lines below must be update as soon as MODD_BUDGET is updated
-!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!-------------------------------------------------------------------------------
+integer :: isourcesmax ! Maximum number of source terms in a budget
+type(tbusourcedata) :: tzsource ! Used to prepare metadate of source terms
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget', 'called' )
+
+nbudgets = NBUDGET_SV1 - 1 + ksv
+allocate( tbudgets( nbudgets ) )
!
!* 1. COMPUTE BUDGET VARIABLES
! ------------------------
@@ -361,110 +359,119 @@ IPROACTV(:,JPBUPROMAX+1) = 0
GERROR=.FALSE.
YWORK2(:,:) = ' '
YEND_COMMENT(:) = ' '
-!
-! Budget of RU
-IF (LBU_RU) THEN
- YWORK2(NBUDGET_U, 1) = 'INIF_'
- YWORK2(NBUDGET_U, 2) = 'ENDF_'
+tzsource%ntype = TYPEREAL
+tzsource%ndims = 3
- YWORK2(NBUDGET_U, 3) = 'AVEF_'
+! Budget of RU
+tbudgets(NBUDGET_U )%cname = "BU_RU"
+tbudgets(NBUDGET_U )%ccomment = "Budget for U"
- IPROC=4
- YWORK2(NBUDGET_U, IPROC) = 'ASSE_'
- IPROACTV(NBUDGET_U, IPROC) = NASSEU
+tbudgets(NBUDGET_U)%lenabled = lbu_ru
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'NEST_'
- IF( NMODEL>1 ) IPROACTV(NBUDGET_U, IPROC) = NNESTU
+if (lbu_ru) then
+ allocate( tbudgets(NBUDGET_U)%trhodj )
+ tbudgets(NBUDGET_U)%trhodj%cmnhname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_U)%trhodj%clongname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_U)%trhodj%ccomment = 'RhodJ for momentum along X axis'
+ tbudgets(NBUDGET_U)%trhodj%ngrid = 2
+ tbudgets(NBUDGET_U)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_U)%trhodj%ndims = 3
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'FRC_'
- IF( LFORCING ) IPROACTV(NBUDGET_U, IPROC) = NFRCU
+ allocate( tbudgets(NBUDGET_U)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = 0.
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'NUD_'
- IF( ONUDGING ) IPROACTV(NBUDGET_U, IPROC) = NNUDU
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ isourcesmax = 18
+ tbudgets(NBUDGET_U)%nsourcesmax = isourcesmax
+ allocate( tbudgets(NBUDGET_U)%tsources(isourcesmax) )
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'CURV_'
- IF ( .NOT. LCARTESIAN ) THEN
- IPROACTV(NBUDGET_U, IPROC) = NCURVU
- ELSE
- IPROACTV(NBUDGET_U, IPROC) = 4
- END IF
+ allocate( tbudgets(NBUDGET_U)%xtmpstore(ibudim1, ibudim2, ibudim3) )
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'COR_'
- IF ( LCORIO ) THEN
- IPROACTV(NBUDGET_U, IPROC) = NCORU
- ELSE
- IPROACTV(NBUDGET_U, IPROC) = 4
- END IF
+ tbudgets(NBUDGET_U)%tsources(:)%ngroup = 0
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'DIF_'
- IF ( ONUMDIFU ) IPROACTV(NBUDGET_U, IPROC) = NDIFU
+ tzsource%ccomment = 'Budget of momentum along X axis'
+ tzsource%ngrid = 2
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'REL_'
- IF ( OHORELAX_UVWTH .OR. OVE_RELAX ) THEN
- IPROACTV(NBUDGET_U, IPROC) = NRELU
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(NBUDGET_U, IPROC) = 4
- ELSE
- IPROACTV(NBUDGET_U, IPROC) = 3
- END IF
- END IF
+ tzsource%cunits = 'm s-1'
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'DRAG_'
- IF( ODRAGTREE ) IPROACTV(NBUDGET_U, IPROC) = NDRAGU
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, .true., 1, odonotinit = .true., ooverwrite = .true. )
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'VTURB_'
- IF ( HTURB /= 'NONE' ) IPROACTV(NBUDGET_U, IPROC) = NVTURBU
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, .true., 1, odonotinit = .true., ooverwrite = .true. )
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'HTURB_'
- IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
- IPROACTV(NBUDGET_U, IPROC) = NHTURBU
- ELSE
- IF ( HTURB /= 'NONE' ) THEN
- IPROACTV(NBUDGET_U, IPROC) = 4
- ELSE
- IPROACTV(NBUDGET_U, IPROC) = 3
- END IF
- END IF
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, .true., 1, odonotinit = .true., ooverwrite = .false. )
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'MAFL_'
- IF ( HSCONV == 'EDKF' ) IPROACTV(NBUDGET_U, IPROC) = NMAFLU
+ tzsource%cunits = 'm s-2'
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'ADV_'
- IPROACTV(NBUDGET_U, IPROC) = NADVU
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, .true., nasseu )
- IPROC=IPROC+1
- YWORK2(NBUDGET_U, IPROC) = 'PRES_'
- IPROACTV(NBUDGET_U, IPROC) = NPRESU
-!
- YEND_COMMENT(NBUDGET_U) = 'BU_RU'
- NBUPROCNBR(NBUDGET_U) = 3 !Initial number of budgets, will be increazed later if necessary
-!
- CBUACTION(NBUDGET_U, 1) = 'IG'
- CBUACTION(NBUDGET_U, 2) = 'CC'
- CBUACTION(NBUDGET_U, 3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(NBUDGET_U, JJ) = ADJUSTL( ADJUSTR( YWORK2(NBUDGET_U, JJ) ) // &
- ADJUSTL( YEND_COMMENT(NBUDGET_U) ) )
- END DO
-!
-END IF
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, nmodel > 1, nnestu )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, lforcing, nfrcu )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, onudging, nnudu )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, .not. lcartesian, ncurvu )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, lcorio, ncoru )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, onumdifu, ndifu )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, ohorelax_uvwth .or. ove_relax, nrelu )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odragtree, ndragu )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, hturb /= 'NONE', nvturbu )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, hturb /= 'NONE' .and. HTURBDIM == '3DIM', nhturbu )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, hsconv == 'EDKF', nmaflu )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, lvisc, nviscu )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, .true., nadvu )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, .true., npresu )
+end if
!
! Budget of RV
IF (LBU_RV) THEN
@@ -2686,6 +2693,9 @@ END IF
IF (GERROR) THEN
call Print_msg( NVERB_FATAL, 'BUD', 'INI_BUDGET', '' )
ENDIF
+
+call Ini_budget_groups( tbudgets, ibudim1, ibudim2, ibudim3 )
+
!-------------------------------------------------------------------------------
!* 5. ALLOCATE MEMORY FOR BUDGET STORAGE ARRAYS
! -----------------------------------------
diff --git a/src/MNH/initial_guess.f90 b/src/MNH/initial_guess.f90
index fe169bfcd..43eb8c20c 100644
--- a/src/MNH/initial_guess.f90
+++ b/src/MNH/initial_guess.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
! #########################
MODULE MODI_INITIAL_GUESS
! #########################
@@ -144,22 +139,28 @@ END MODULE MODI_INITIAL_GUESS
!! 20/05/06 Remove KEPS
!! 10/09 (C.Lac) FIT for variables advected with PPM
!! 04/13 (C.Lac) FIT for all variables
-!! 07/19 (J.Escobar) add reproductiblity test => MPPDB_CHECK( PRRS/RT/RHO )
-!!
+! J. Escobar) 07/2019: add reproductiblity test => MPPDB_CHECK( PRRS/RT/RHO )
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CONF
-USE MODD_GRID_n
-USE MODD_BUDGET
USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ 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, &
+ lbu_beg, lbu_enable, nbuctr_actv, nbuprocctr, tbudgets
+USE MODD_CONF
+USE MODD_GRID_n
+
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_MPPDB
+
+USE MODI_BUDGET
+USE MODI_SHUMAN
!
IMPLICIT NONE
!
@@ -239,8 +240,10 @@ IF (LBU_ENABLE) THEN
IF (LBU_BEG) THEN
NBUPROCCTR(:)=1
NBUCTR_ACTV(:)=1
-!
- IF (LBUDGET_U) CALL BUDGET( PRUS, NBUDGET_U, 'INIF_BU_RU' )
+
+ !Remark: does not need a call to Budget_store_init because the budget array is overwritten for this source term
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'INIF', prus )
+
IF (LBUDGET_V) CALL BUDGET( PRVS, NBUDGET_V, 'INIF_BU_RV' )
IF (LBUDGET_W) CALL BUDGET( PRWS, NBUDGET_W, 'INIF_BU_RW' )
IF (LBUDGET_TH) CALL BUDGET( PRTHS, NBUDGET_TH, 'INIF_BU_RTH' )
@@ -259,7 +262,6 @@ IF (LBU_ENABLE) THEN
NBUPROCCTR(:)=2
NBUCTR_ACTV(:)=2
!
- IF (LBUDGET_U) CALL BUDGET( PRUS, NBUDGET_U, 'ENDF_BU_RU' )
IF (LBUDGET_V) CALL BUDGET( PRVS, NBUDGET_V, 'ENDF_BU_RV' )
IF (LBUDGET_W) CALL BUDGET( PRWS, NBUDGET_W, 'ENDF_BU_RW' )
IF (LBUDGET_TH) CALL BUDGET( PRTHS, NBUDGET_TH, 'ENDF_BU_RTH' )
@@ -274,8 +276,6 @@ IF (LBU_ENABLE) THEN
DO JSV=1,KSV
IF (LBUDGET_SV) CALL BUDGET( PRSVS(:,:,:,JSV), JSV + NBUDGET_SV1 - 1, 'ENDF_BU_RSV' )
END DO
-!
- LBU_BEG=.FALSE.
END IF
!
NBUPROCCTR(:)=4
@@ -283,7 +283,12 @@ IF (LBU_ENABLE) THEN
!
! stores the Asselin source term
!
- IF (LBUDGET_U) CALL BUDGET( PRUS, NBUDGET_U, 'ASSE_BU_RU' )
+ !The Asselin source term is computed from the end of the previous time step to now
+ !Therefore, it has to be stored only if not the 1st timestep of the budget
+ if ( .not. lbu_beg ) then
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ASSE', prus )
+ end if
+
IF (LBUDGET_V) CALL BUDGET( PRVS, NBUDGET_V, 'ASSE_BU_RV' )
IF (LBUDGET_W) CALL BUDGET( PRWS, NBUDGET_W, 'ASSE_BU_RW' )
IF (LBUDGET_TH) CALL BUDGET( PRTHS, NBUDGET_TH, 'ASSE_BU_RTH' )
@@ -299,7 +304,9 @@ IF (LBU_ENABLE) THEN
IF (LBUDGET_SV) CALL BUDGET( PRSVS(:,:,:,JSV), JSV + NBUDGET_SV1 - 1, 'ASSE_BU_RSV' )
END DO
END IF
-!
+
+LBU_BEG=.FALSE.
+
!-------------------------------------------------------------------------------
!
END SUBROUTINE INITIAL_GUESS
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index eab765970..0fa0909ad 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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
!MNH_LIC for details. version 1.
@@ -265,7 +265,8 @@ END MODULE MODI_MODEL_n
! J. Escobar 09/07/2019: norme Doctor -> Rename Module Type variable TZ -> T
! J. Escobar 09/07/2019: for bug in management of XLSZWSM variable, add/use specific 2D TLSFIELD2D_ll pointer
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-! J. Escobar 27/09/2019: add missing report timing of RESOLVED_ELEC
+! J. Escobar 27/09/2019: add missing report timing of RESOLVED_ELEC
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -277,19 +278,20 @@ USE MODD_AIRCRAFT_BALLOON
USE MODD_BAKOUT
USE MODD_BIKHARDT_n
USE MODD_BLANK
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
USE MODD_BUDGET
USE MODD_CH_AERO_n, ONLY: XSOLORG, XMI
USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX,LUSECHAQ,LUSECHIC, &
LCH_INIT_FIELD
USE MODD_CLOUD_MF_n
-USE MODD_VISCOSITY
-USE MODD_DRAG_n
USE MODD_CLOUDPAR_n
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CURVCOR_n
USE MODD_DEEP_CONVECTION_n
USE MODD_DIM_n
+USE MODD_DRAG_n
USE MODD_DUST, ONLY: LDUST
USE MODD_DYN
USE MODD_DYN_n
@@ -327,8 +329,6 @@ USE MODD_PARAM_LIMA, ONLY: MSEDC => LSEDC, MWARM => LWARM, MRAIN => LRAIN, &
MACTIT => LACTIT, LSCAV, LCOLD, &
MSEDI => LSEDI, MHHONI => LHHONI, LHAIL, &
XRTMIN_LIMA=>XRTMIN, MACTTKE=>LACTTKE
-USE MODD_BLOWSNOW_n
-USE MODD_BLOWSNOW
USE MODD_PARAM_MFSHALL_n
USE MODD_PARAM_n
USE MODD_PAST_FIELD_n
@@ -348,7 +348,9 @@ USE MODD_TIME_n
USE MODD_TIMEZ
USE MODD_TURB_CLOUD, ONLY: NMODEL_CLOUD,CTURBLEN_CLOUD,XCEI
USE MODD_TURB_n
+USE MODD_VISCOSITY
!
+use mode_budget, only: Budget_store_init
USE MODE_DATETIME
USE MODE_ELEC_ll
USE MODE_GRIDCART
@@ -392,7 +394,6 @@ USE MODI_INI_MEAN_FIELD
USE MODI_INITIAL_GUESS
USE MODI_LES_INI_TIMESTEP_n
USE MODI_LES_N
-USE MODI_VISCOSITY
USE MODI_LIMA_PRECIP_SCAVENGING
USE MODI_LS_COUPLING
USE MODI_MASK_COMPRESS
@@ -419,6 +420,7 @@ USE MODI_STATION_n
USE MODI_TURB_CLOUD_INDEX
USE MODI_TWO_WAY
USE MODI_UPDATE_NSV
+USE MODI_VISCOSITY
USE MODI_WRITE_AIRCRAFT_BALLOON
USE MODI_WRITE_DESFM_n
USE MODI_WRITE_DIAG_SURF_ATM_N
@@ -995,6 +997,10 @@ IF (NBUMOD==IMI .AND. CBUTYPE=='MASK' ) THEN
IF (ALLOCATED(XBURHODJ)) &
XBURHODJ (:,NBUTIME,:) = XBURHODJ (:,NBUTIME,:) &
+ MASK_COMPRESS(XRHODJ)
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
END IF
!
IF (NBUMOD==IMI .AND. CBUTYPE=='CART' ) THEN
@@ -1007,6 +1013,9 @@ IF (NBUMOD==IMI .AND. CBUTYPE=='CART' ) THEN
IF (ALLOCATED(XBURHODJ)) &
XBURHODJ (:,:,:) = XBURHODJ (:,:,:) &
+ CART_COMPRESS(XRHODJ)
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) + Cart_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
END IF
!
CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
@@ -1607,7 +1616,9 @@ ZRUS=XRUS
ZRVS=XRVS
ZRWS=XRWS
!
- CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', xrus )
+
+CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
XTSTEP, &
XDXHAT, XDYHAT, XZHAT, &
XUT, XVT, &
diff --git a/src/MNH/nudging.f90 b/src/MNH/nudging.f90
index 28d18b0e8..d65ad77ee 100644
--- a/src/MNH/nudging.f90
+++ b/src/MNH/nudging.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2006-2020 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
!MNH_LIC for details. version 1.
@@ -74,13 +74,18 @@ END MODULE MODI_NUDGING
!! MODIFICATIONS
!! -------------
!! Original 15/05/06
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
-!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, &
+ tbudgets
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
USE MODI_BUDGET
!
IMPLICIT NONE
@@ -109,6 +114,8 @@ REAL :: ZINVTAU ! inverse of nudging time scale
!
!
ZINVTAU=1./PTNUDGING
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'NUD', prus )
!
!* 1. NUGDGING TOWARDS LS FIELDS
! --------------------------
@@ -124,7 +131,8 @@ IF (OUSERV) &
!* 2. BUDGET CALLS
! ------------
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'NUD_BU_RU')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'NUD', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'NUD_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'NUD_BU_RW')
IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'NUD_BU_RTH')
diff --git a/src/MNH/num_diff.f90 b/src/MNH/num_diff.f90
index 800f23a1b..eb0f21630 100644
--- a/src/MNH/num_diff.f90
+++ b/src/MNH/num_diff.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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
!MNH_LIC for details. version 1.
@@ -212,24 +212,30 @@ END MODULE MODI_NUM_DIFF
!! J.Escobar : 05/12/2017 : Pb SegFault , correct IF(ONUMDIFTH/OZDIFFU) nesting
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! J. Escobar 09/07/2019: add TTZHALO2*LIST structure, to match all cases of diffusion/U/TH activation T/F
-!!
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
!
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_BUDGET
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ 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, &
+ tbudgets
+USE MODD_CONF
+USE MODD_PARAMETERS
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_ll
USE MODE_TYPE_ZDIFFU
-!
+
+USE MODI_BUDGET
+USE MODI_SHUMAN
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -297,7 +303,9 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IKU=SIZE(PUM,3)
!
GTKEALLOC = SIZE(PTKEM,1) /= 0
-!
+
+if ( lbudget_u .and. onumdifu ) call Budget_store_init( tbudgets(NBUDGET_U), 'DIF', prus )
+
!-------------------------------------------------------------------------------
!
!* 2. CALL THE NUM_DIFF_ALGO ROUTINE FOR EACH FIELD
@@ -440,7 +448,8 @@ END IF
!* 3. STORES FIELDS IN BUDGET ARRAYS
! ------------------------------
!
-IF ( LBUDGET_U .AND. ONUMDIFU ) CALL BUDGET( PRUS, NBUDGET_U, 'DIF_BU_RU' )
+if ( lbudget_u .and. onumdifu ) call Budget_store_end( tbudgets(NBUDGET_U), 'DIF', prus )
+
IF ( LBUDGET_V .AND. ONUMDIFU ) CALL BUDGET( PRVS, NBUDGET_V, 'DIF_BU_RV' )
IF ( LBUDGET_W .AND. ONUMDIFU ) CALL BUDGET( PRWS, NBUDGET_W, 'DIF_BU_RW' )
IF ( LBUDGET_TH .AND. ONUMDIFTH ) CALL BUDGET( PRTHS, NBUDGET_TH, 'DIF_BU_RTH' )
diff --git a/src/MNH/pressure.f90 b/src/MNH/pressure.f90
index c84dfaf95..def6e2370 100644
--- a/src/MNH/pressure.f90
+++ b/src/MNH/pressure.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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
!MNH_LIC for details. version 1.
@@ -200,6 +200,7 @@ END MODULE MODI_PRESSURE
!! 06/2011 (J.escobar ) Bypass Bug with ifort11/12 on HLBCX,HLBCY
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!
!-------------------------------------------------------------------------------
!
@@ -207,7 +208,7 @@ END MODULE MODI_PRESSURE
! ------------
!
USE MODD_PARAMETERS
-USE MODD_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, NBUDGET_U, NBUDGET_V, NBUDGET_W, tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_LUNIT_n, ONLY: TLUOUT
@@ -223,6 +224,8 @@ USE MODI_P_ABS
USE MODI_BUDGET
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+
+use mode_budget, only: Budget_store_end
USE MODE_ll
!
IMPLICIT NONE
@@ -362,8 +365,9 @@ ZPABS_S(:,:) = 0.
ZPABS_N(:,:) = 0.
ZPABS_E(:,:) = 0.
ZPABS_W(:,:) = 0.
-!
-!
+
+! if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', prus )
+
!-------------------------------------------------------------------------------
!
!* 3. COMPUTE THE LINEIC MASS
@@ -610,7 +614,8 @@ ENDIF
!* 7. STORAGE OF THE FIELDS IN BUDGET ARRAYS
! --------------------------------------
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'PRES_BU_RU')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'PRES', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'PRES_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'PRES_BU_RW')
!
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index 976f428bd..72e24f8ad 100644
--- a/src/MNH/pressurez.f90
+++ b/src/MNH/pressurez.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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
!MNH_LIC for details. version 1.
@@ -219,13 +219,14 @@ END MODULE MODI_PRESSUREZ
!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_ARGSLIST_ll, ONLY: LIST_ll
-USE MODD_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, NBUDGET_U, NBUDGET_V, NBUDGET_W, tbudgets
USE MODD_CST
USE MODD_CONF
USE MODD_DYN_n, ONLY: LRES, XRES
@@ -236,6 +237,7 @@ use modd_precision, only: MNHREAL_MPI
USE MODD_REF, ONLY: LBOUSS
USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD , NPROC
!
+use mode_budget, only: Budget_store_end
USE MODE_ll
USE MODE_MPPDB
USE MODE_MSG
@@ -401,8 +403,10 @@ ZPABS_S(:,:) = 0.
ZPABS_N(:,:) = 0.
ZPABS_E(:,:) = 0.
ZPABS_W(:,:) = 0.
-!
-!
+
+! Done in model_n before call to Rad_bound
+! if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', prus )
+
!-------------------------------------------------------------------------------
!
!* 3. COMPUTE THE LINEIC MASS
@@ -677,7 +681,8 @@ ENDIF
!* 7. STORAGE OF THE FIELDS IN BUDGET ARRAYS
! --------------------------------------
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'PRES_BU_RU')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'PRES', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'PRES_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'PRES_BU_RW')
!
diff --git a/src/MNH/relaxation.f90 b/src/MNH/relaxation.f90
index df1c4133a..e6c57710c 100644
--- a/src/MNH/relaxation.f90
+++ b/src/MNH/relaxation.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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
!MNH_LIC for details. version 1.
@@ -256,27 +256,31 @@ END MODULE MODI_RELAXATION
!! 06/2011 (M.Chong) Case of ELEC
!! 11/2011 (C.Lac) Adaptation to FIT temporal scheme
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_BUDGET
-USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND
-USE MODD_ELEC_DESCR, ONLY: LRELAX2FW_ION
-!
-USE MODE_ll
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-USE MODE_EXTRAPOL
-!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, &
+ lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ 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, &
+ tbudgets
+USE MODD_CONF, only: cconf
+USE MODD_ELEC_DESCR, ONLY: LRELAX2FW_ION
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND
+USE MODD_PARAMETERS, only: jphext, jpvext
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_EXTRAPOL, only: Extrapol
+USE MODE_ll, only: Get_intersection_ll
USE MODE_MPPDB
-!
-!
+
+USE MODI_BUDGET
+USE MODI_SHUMAN
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -441,6 +445,8 @@ CALL GET_GLOBALDIMS_ll(IIU_ll,IJU_ll)
IIU_ll=IIU_ll+2*JPHEXT
IJU_ll=IJU_ll+2*JPHEXT
!
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'REL', prus )
+
ZRHODJU(:,:,:) = MXM(PRHODJ)
ZRHODJV(:,:,:) = MYM(PRHODJ)
ZRHODJW(:,:,:) = MZM(1,IKU,1,PRHODJ)
@@ -707,7 +713,9 @@ END DO
! ------------------------------
!
CALL EXTRAPOL('W ', PRUS)
-IF ( LBUDGET_U ) CALL BUDGET( PRUS, NBUDGET_U, 'REL_BU_RU')
+
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'REL', prus )
+
IF ( LBUDGET_V ) CALL BUDGET( PRVS, NBUDGET_V, 'REL_BU_RV')
IF ( LBUDGET_W ) CALL BUDGET( PRWS, NBUDGET_W, 'REL_BU_RW')
IF ( LBUDGET_TH ) CALL BUDGET( PRTHS, NBUDGET_TH, 'REL_BU_RTH')
diff --git a/src/MNH/shallow_mf_pack.f90 b/src/MNH/shallow_mf_pack.f90
index e5a23264c..33946f46e 100644
--- a/src/MNH/shallow_mf_pack.f90
+++ b/src/MNH/shallow_mf_pack.f90
@@ -119,12 +119,15 @@ END MODULE MODI_SHALLOW_MF_PACK
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! S. Riette 11/2016: support for CFRAC_ICE_SHALLOW_MF
! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_th, lbudget_rv, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_TH, NBUDGET_RV, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_IO, ONLY: TFILEDATA
@@ -135,6 +138,7 @@ USE MODD_PARAM_ICE, ONLY: CFRAC_ICE_SHALLOW_MF
USE MODD_PARAM_MFSHALL_n
use modd_precision, only: MNHTIME
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODI_BUDGET
@@ -276,6 +280,8 @@ IRR=SIZE(PRM,4)
! number of scalar var
ISV=SIZE(PSVM,4)
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'MAFL', prus )
+
ZSVM(:,:,:) = 0.
!
!
@@ -371,10 +377,10 @@ DO JSV=1,ISV
END DO
!!! 7. call to MesoNH budgets
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'MAFL', prus )
IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'MAFL_BU_RTH')
IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),NBUDGET_RV,'MAFL_BU_RRV')
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'MAFL_BU_RU')
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'MAFL_BU_RV')
DO JSV=1,ISV
IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),NBUDGET_SV1-1+JSV,'MAFL_BU_RSV')
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index 4e637204f..7f9877b56 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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
!MNH_LIC for details. version 1.
@@ -338,15 +338,18 @@ END MODULE MODI_TURB
!! 10/2012 (J. Colin) Correct bug in DearDoff for dry simulations
!! 10/2012 J.Escobar Bypass PGI bug , redefine some allocatable array inplace of automatic
!! 04/2016 (C.Lac) correction of negativity for KHKO
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! 01/2018 (Q.Rodier) Introduction of RM17
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! Q. Rodier 01/2018: introduction of RM17
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!! --------------------------------------------------------------------------
-!
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! --------------------------------------------------------------------------
+!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
@@ -374,6 +377,7 @@ USE MODI_TM06
USE MODI_UPDATE_LM
USE MODI_GET_HALO
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_SBL
!
@@ -905,6 +909,8 @@ ENDIF
!* 5. TURBULENT SOURCES
! -----------------
!
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'VTURB', prus )
+
CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
OCLOSE_OUT,OTURB_FLX, &
HTURBDIM,HTOM,PIMPL,ZEXPL, &
@@ -921,9 +927,9 @@ CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
PSBL_DEPTH,ZLMO, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
PDYP,PTHP,PSIGS,PWTH,PWRC,PWSV )
-!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'VTURB_BU_RU')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'VTURB', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'VTURB_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'VTURB_BU_RW')
IF (LBUDGET_TH) THEN
@@ -953,6 +959,8 @@ IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),NBUDGET_RC,'VTURB_BU_RRC')
IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),NBUDGET_RI,'VTURB_BU_RRI')
!
!
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'HTURB', prus )
+
IF (HTURBDIM=='3DIM') THEN
CALL TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
HLBCX,HLBCY,OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
@@ -970,9 +978,9 @@ IF (HTURBDIM=='3DIM') THEN
ZTRH, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
END IF
-!
-!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'HTURB_BU_RU')
+
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'HTURB', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'HTURB_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'HTURB_BU_RW')
IF (LBUDGET_TH) THEN
diff --git a/src/MNH/two_way.f90 b/src/MNH/two_way.f90
index ba399f93a..38d2e2857 100644
--- a/src/MNH/two_way.f90
+++ b/src/MNH/two_way.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1999-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1999-2020 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
!MNH_LIC for details. version 1.
@@ -92,22 +92,28 @@ END MODULE MODI_TWO_WAY
!! hydrometeors, the Short and Long Wave
!! + MASKkids array
!! 20/05/06 Remove EPS
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+!
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
USE MODD_NESTING
-USE MODD_BUDGET
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_MODELN_HANDLER
USE MODI_BUDGET
-!
USE MODI_TWO_WAY_n
-USE MODE_MODELN_HANDLER
-!
+
IMPLICIT NONE
!
!
@@ -145,6 +151,9 @@ INTEGER :: JKID ! loop index to look for the KID models
INTEGER :: JSV,JRR ! Loop index for scalar and moist variables
!
!-------------------------------------------------------------------------------
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'NEST', prus )
+
!
!* 1. CALL THE RIGHT TWO_WAY$n
! ------------------------
@@ -165,7 +174,8 @@ CALL GOTO_MODEL(KMI)
!* 2. BUDGET COMPUTATION
! ------------------
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'NEST_BU_RU')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'NEST', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'NEST_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_W,'NEST_BU_RW')
IF (LBUDGET_TH) CALL BUDGET (PRTHS,NBUDGET_TH,'NEST_BU_RTH')
diff --git a/src/MNH/viscosity.f90 b/src/MNH/viscosity.f90
index fb7a01b5c..f1f1da39d 100644
--- a/src/MNH/viscosity.f90
+++ b/src/MNH/viscosity.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 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
!MNH_LIC for details. version 1.
@@ -91,21 +91,29 @@ SUBROUTINE VISCOSITY(HLBCX, HLBCY, KRR, KSV, PNU, PPRANDTL, &
!! 01/18 (C.Lac) Add budgets
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 08/11/2019: corrected wrong budget name VISC_BU_RU -> VISC_BU_RTH
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
- USE MODI_LAP_M
- USE MODI_SHUMAN
- USE MODD_PARAMETERS
+ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+ use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
- USE MODD_VISCOSITY
USE MODD_DRAG_n
- USE MODD_BUDGET
+ USE MODD_PARAMETERS
+ USE MODD_VISCOSITY
+
+ use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_ll
- USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+
USE MODI_BUDGET
+ USE MODI_SHUMAN
+ USE MODI_LAP_M
!
!-------------------------------------------------------------------------------
!
@@ -180,6 +188,8 @@ IIU=SIZE(PWT,1)
IJU=SIZE(PWT,2)
IKU=SIZE(PWT,3)
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'VISC', prus )
+
!* 1. Viscous forcing for potential temperature
! -----------------------------------------
!
@@ -334,7 +344,8 @@ ENDIF
ENDIF
END IF
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,NBUDGET_U,'VISC_BU_RU')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'VISC', prus )
+
IF (LBUDGET_V) CALL BUDGET (PRVS,NBUDGET_V,'VISC_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,NBUDGET_V,'VISC_BU_RW')
!
diff --git a/src/MNH/write_budget.f90 b/src/MNH/write_budget.f90
index a1234be7d..16c8fa6ca 100644
--- a/src/MNH/write_budget.f90
+++ b/src/MNH/write_budget.f90
@@ -29,6 +29,7 @@
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
! P. Wautelet 14/10/2019: complete restructuration and deduplication of code
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
!-----------------------------------------------------------------
!#######################
@@ -116,6 +117,7 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
lbu_rri, lbu_rrs, lbu_rrg, lbu_rrh, lbu_rsv, &
NBUDGET_RHO, 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, &
+ tbudgets, &
xburhodj, xburhodju, xburhodjv, xburhodjw, &
xburu, xburv, xburw, xburth, xburtke, &
xburrv, xburrc, xburrr, xburri, xburrs, xburrg, xburrh, xbursv
@@ -270,8 +272,8 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
!* XBURHODJU and RU budgets
!
IF (LBU_RU) THEN
- call Store_one_budget_rho( tpdiafile, tzdates, xburhodju, NBUDGET_U, gnocompress, zrhodjn )
- call Store_one_budget( tpdiafile, tzdates, xburu, zrhodjn, NBUDGET_U, gnocompress, ptstep )
+ call Store_one_budget_rho_new( tpdiafile, tzdates, tbudgets(NBUDGET_U), NBUDGET_U, gnocompress, zrhodjn )
+ call Store_one_budget_new ( tpdiafile, tzdates, tbudgets(NBUDGET_U), zrhodjn, NBUDGET_U, gnocompress, ptstep )
END IF
!
!* XBURHODJV and RV budgets
--
GitLab