From 2749a15e65a6ffd531d358bad7afd5d739a513f5 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Wed, 18 Mar 2020 09:58:37 +0100
Subject: [PATCH] Philippe 18/03/2020: remove unused source files
---
src/MNH/advecmet.f90 | 240 --------
src/MNH/advecmet_4th.f90 | 315 -----------
src/MNH/advecscalar.f90 | 168 ------
src/MNH/advecscalar_4th.f90 | 204 -------
src/MNH/advecuvw.f90 | 177 ------
src/MNH/c3r5_adjust.f90 | 166 ------
src/MNH/ch_aqueous_sedimc2r2.f90JPP | 310 ----------
src/MNH/ch_read_meteo.f90 | 83 ---
src/MNH/dflux_corr.f90 | 307 ----------
src/MNH/dry_mass.f90 | 162 ------
src/MNH/dummy_gr_index.f90 | 86 ---
src/MNH/elec_trid.f90 | 679 ----------------------
src/MNH/fct_met.f90 | 363 ------------
src/MNH/fct_scalar.f90 | 166 ------
src/MNH/ice4_sedimentation_split_old.f90 | 463 ---------------
src/MNH/ice_c1r3.f90 | 190 -------
src/MNH/ini_elec.f90 | 102 ----
src/MNH/init_for_convlfi.f90 | 277 ---------
src/MNH/les_masksn.f90 | 188 -------
src/MNH/lochead.f90 | 184 ------
src/MNH/mean_prof.f90 | 196 -------
src/MNH/modd_type_allvar.f90 | 73 ---
src/MNH/mpdata.f90 | 405 -------------
src/MNH/mpdata_scalar.f90 | 250 ---------
src/MNH/prep_ideal_case.f90 | 1 -
src/MNH/pressure.f90 | 687 -----------------------
src/MNH/resolved_cloud.f90 | 2 -
src/MNH/select_std_pgd.f90 | 306 ----------
src/MNH/trid.f90 | 645 ---------------------
src/MNH/ver_dyn.f90 | 1 -
src/MNH/wguess.f90 | 169 ------
src/MNH/zs_boundaryn.f90 | 204 -------
32 files changed, 7769 deletions(-)
delete mode 100644 src/MNH/advecmet.f90
delete mode 100644 src/MNH/advecmet_4th.f90
delete mode 100644 src/MNH/advecscalar.f90
delete mode 100644 src/MNH/advecscalar_4th.f90
delete mode 100644 src/MNH/advecuvw.f90
delete mode 100644 src/MNH/c3r5_adjust.f90
delete mode 100644 src/MNH/ch_aqueous_sedimc2r2.f90JPP
delete mode 100644 src/MNH/ch_read_meteo.f90
delete mode 100644 src/MNH/dflux_corr.f90
delete mode 100644 src/MNH/dry_mass.f90
delete mode 100644 src/MNH/dummy_gr_index.f90
delete mode 100644 src/MNH/elec_trid.f90
delete mode 100644 src/MNH/fct_met.f90
delete mode 100644 src/MNH/fct_scalar.f90
delete mode 100644 src/MNH/ice4_sedimentation_split_old.f90
delete mode 100644 src/MNH/ice_c1r3.f90
delete mode 100644 src/MNH/ini_elec.f90
delete mode 100644 src/MNH/init_for_convlfi.f90
delete mode 100644 src/MNH/les_masksn.f90
delete mode 100644 src/MNH/lochead.f90
delete mode 100644 src/MNH/mean_prof.f90
delete mode 100644 src/MNH/modd_type_allvar.f90
delete mode 100644 src/MNH/mpdata.f90
delete mode 100644 src/MNH/mpdata_scalar.f90
delete mode 100644 src/MNH/pressure.f90
delete mode 100644 src/MNH/select_std_pgd.f90
delete mode 100644 src/MNH/trid.f90
delete mode 100644 src/MNH/wguess.f90
delete mode 100644 src/MNH/zs_boundaryn.f90
diff --git a/src/MNH/advecmet.f90 b/src/MNH/advecmet.f90
deleted file mode 100644
index f16414b42..000000000
--- a/src/MNH/advecmet.f90
+++ /dev/null
@@ -1,240 +0,0 @@
-!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.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_ADVECMET
-! #######################
-INTERFACE
- SUBROUTINE ADVECMET ( KRR, PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-END SUBROUTINE ADVECMET
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECMET
-!
-!
-!
-! ######################################################################
- SUBROUTINE ADVECMET ( KRR, PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-! ######################################################################
-!
-!!**** *ADVECMET * - routine to compute the advection tendancies of the
-!! meterological scalar fields.
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the total advection
-!! tendancies of the meteorological scalar fields, written in flux form.
-!! The advection velocity is taken as the contravariant form of
-!! the momentum for extension to non-cartesian geometry and
-!! conformal projection cases.
-!!
-!!
-!!** METHOD
-!! ------
-!! The left and right lateral EXTernal zones, have been previously
-!! prepared in routine LBC_S, to avoid particular cases close to the
-!! Lateral Boundaries in this routine.
-!! The Shuman functions are used to write the mean and finite
-!! differences operators.
-!! The different sources terms are stored for the budget
-!! computations.
-!!
-!! EXTERNAL
-!! --------
-!! MXM,MYM,MZM : Shuman functions (mean operators)
-!! DXM,DYM,DZM : Shuman functions (finite differences operators)
-!! BUDGET : Stores the different budget components
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RTH : logical for budget of RTH (potential temperature)
-!! .TRUE. = budget of RTH
-!! .FALSE. = no budget of RTH
-!! LBU_RTKE : logical for budget of RTKE (turbulent kinetic energy)
-!! .TRUE. = budget of RTKE
-!! .FALSE. = no budget of RTKE
-!! LBU_RRV : logical for budget of RRV (water vapor)
-!! .TRUE. = budget of RRV
-!! .FALSE. = no budget of RRV
-!! LBU_RRC : logical for budget of RRC (cloud water)
-!! .TRUE. = budget of RRC
-!! .FALSE. = no budget of RRC
-!! LBU_RRR : logical for budget of RRR (rain water)
-!! .TRUE. = budget of RRR
-!! .FALSE. = no budget of RRR
-!! LBU_RRI : logical for budget of RRI (ice)
-!! .TRUE. = budget of RRI
-!! .FALSE. = no budget of RRI
-!! LBU_RRS : logical for budget of RRS (snow)
-!! .TRUE. = budget of RRS
-!! .FALSE. = no budget of RRS
-!! LBU_RRG : logical for budget of RRG (graupel)
-!! .TRUE. = budget of RRG
-!! .FALSE. = no budget of RRG
-!! LBU_RRH : logical for budget of RRH (hail)
-!! .TRUE. = budget of RRH
-!! .FALSE. = no budget of RRH
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book2 of documentation ( routine ADVECMET )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/07/94
-!! Corrections 06/09/94 (J.-P. Lafore)
-!! 16/03/95 (J. Stein) remove R from the historical var.
-!! 01/04/95 (Ph. Hereil J. Nicolau) add the budget computation
-!! 16/10/95 (J. Stein) change the budget calls
-!! 19/12/96 (J.-P. Pinty) update the budget calls
-!! 07/11/02 (V. Masson) update the budget calls
-!! 24/04/06 (C.Lac) Split meteorological scalar and passive
-!! tracer routines
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET
-USE MODD_GRID_n
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JRR ! Loop index for moist variables
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTES THE ADVECTIVE TENDENCIES
-! ---------------------------------
-!
- ! Thermodynamical variable
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DXF( PRUCT(:,:,:) * MXM (PTHT(:,:,:)) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVX_BU_RTH')
-!
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DYF( PRVCT(:,:,:) * MYM (PTHT(:,:,:)) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVY_BU_RTH')
-!
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DZF( PRWCT(:,:,:) * MZM (PTHT(:,:,:)) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVZ_BU_RTH')
-!
- ! Case with KRR moist variables
-DO JRR=1,KRR
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DXF( PRUCT(:,:,:) * MXM (PRT(:,:,:,JRR)) )
-END DO
-!
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVX_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVX_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVX_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVX_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVX_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVX_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVX_BU_RRH')
-!
-DO JRR=1,KRR
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DYF( PRVCT(:,:,:) * MYM (PRT(:,:,:,JRR)) )
-END DO
-!
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVY_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVY_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVY_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVY_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVY_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVY_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVY_BU_RRH')
-!
-DO JRR=1,KRR
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DZF( PRWCT(:,:,:) * MZM (PRT(:,:,:,JRR)) )
-END DO
-!
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVZ_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVZ_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVZ_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVZ_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVZ_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVZ_BU_RRH')
-!
- ! TKE variable
-IF (SIZE(PTKET,1) /= 0) THEN
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DXF( PRUCT(:,:,:) * MXM (PTKET(:,:,:)) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVX_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DYF( PRVCT(:,:,:) * MYM (PTKET(:,:,:)) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVY_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DZF( PRWCT(:,:,:) * MZM (PTKET(:,:,:)) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVZ_BU_RTKE')
-END IF
-!
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECMET
diff --git a/src/MNH/advecmet_4th.f90 b/src/MNH/advecmet_4th.f90
deleted file mode 100644
index a0bd62e15..000000000
--- a/src/MNH/advecmet_4th.f90
+++ /dev/null
@@ -1,315 +0,0 @@
-!MNH_LIC Copyright 2005-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.
-!-----------------------------------------------------------------
-! ###############################
- MODULE MODI_ADVECMET_4TH
-! ###############################
-!
-INTERFACE
-!
- SUBROUTINE ADVECMET_4TH (HLBCX,HLBCY, KRR, &
- PRUCT, PRVCT, PRWCT, &
- PTHT, PTKET, PRT, &
- PRTHS, PRTKES, PRRS, TPHALO2LIST )
-!
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! Vars at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES! Source terms
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
-!
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
-!
-END SUBROUTINE ADVECMET_4TH
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECMET_4TH
-!
-! ######################################################################
- SUBROUTINE ADVECMET_4TH (HLBCX,HLBCY, KRR, &
- PRUCT, PRVCT, PRWCT, &
- PTHT, PTKET, PRT, &
- PRTHS, PRTKES, PRRS, TPHALO2LIST )
-! ######################################################################
-!
-!!**** *ADVEC_4TH_ORDER * - routine to compute the 4th order centered
-!! advection tendency of scalar variables
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to call the ADVEC_4TH_ORDER_ALGO
-!! routine for the horizontal advection and the MZM4 and MZF4 functions for
-!! the vertical advection of each prognostic variable. The code is
-!! parallelized and works for various boundary conditions.
-!!
-!!** METHOD
-!! ------
-!! For each prognostic variable the ADVEC_4TH_ORDER routine calls
-!! the ADVEC_4TH_ORDER_ALGO routine which computes the numerical advection
-!! of any 3D field.
-!! The following variables are passed as argument to ADVEC_4TH_ORDER_ALGO :
-!!
-!! -- The variable at t
-!! -- The second layer of the halo of the field at t
-!! -- The horizontal advection fluxes
-!! -- The localisation on the model grid :
-!!
-!! IGRID = 1 for mass grid point
-!! IGRID = 2 for U grid point
-!! IGRID = 3 for V grid point
-!! IGRID = 4 for w grid point
-!!
-!! EXTERNAL
-!! --------
-!! BUDGET : Stores the different budget components
-!! (not used in current version)
-!! ADVEC_4TH_ORDER_ALGO : computes the horizontal advection fluxes
-!! MZF4 and MZM4 : computes the vertical advection fluxes
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODULE MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! Switches for budgets activations:
-!!
-!! LBU_RU : logical for budget of RU (wind component along x)
-!!
-!! LBU_RU : logical for budget of RU (wind component along x)
-!! .TRUE. = budget of RU
-!! .FALSE. = no budget of RU
-!! LBU_RV : logical for budget of RV (wind component along y)
-!! .TRUE. = budget of RV
-!! .FALSE. = no budget of RV
-!! LBU_RW : logical for budget of RW (wind component along z)
-!! .TRUE. = budget of RW
-!! .FALSE. = no budget of RW
-!! LBU_RTH : logical for budget of RTH (potential temperature)
-!! .TRUE. = budget of RTH
-!! .FALSE. = no budget of RTH
-!! LBU_RTKE : logical for budget of RTKE (turbulent kinetic energy)
-!! .TRUE. = budget of RTKE
-!! .FALSE. = no budget of RTKE
-!! LBU_RRV : logical for budget of RRV (water vapor)
-!! .TRUE. = budget of RRV
-!! .FALSE. = no budget of RRV
-!! LBU_RRC : logical for budget of RRC (cloud water)
-!! .TRUE. = budget of RRC
-!! .FALSE. = no budget of RRC
-!! LBU_RRR : logical for budget of RRR (rain water)
-!! .TRUE. = budget of RRR
-!! .FALSE. = no budget of RRR
-!! LBU_RRI : logical for budget of RRI (ice)
-!! .TRUE. = budget of RRI
-!! .FALSE. = no budget of RRI
-!! LBU_RRS : logical for budget of RRS (snow)
-!! .TRUE. = budget of RRS
-!! .FALSE. = no budget of RRS
-!! LBU_RRG : logical for budget of RRG (graupel)
-!! .TRUE. = budget of RRG
-!! .FALSE. = no budget of RRG
-!! LBU_RRH : logical for budget of RRH (hail)
-!! .TRUE. = budget of RRH
-!! .FALSE. = no budget of RRH
-!!
-!! MODULE MODD_ARGSLIST
-!! HALO2LIST_ll : type for a list of "HALO2_lls"
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation ( routine ADVEC_4TH_ORDER )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 25/10/05
-!!
-!! Correction :
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODE_ll
-!
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_GRID_n
-USE MODD_BUDGET
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
-! incorporate ADVEC_4TH_ORDER_ALG, MZF4 and MZM4
-USE MODI_ADVEC_4TH_ORDER_AUX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! Vars at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES! Source terms
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
-!
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
-!
-!* 0.2 Declarations of local variables :
-!
-!
-INTEGER :: JRR ! Loop index for moist variables
-INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
-INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-!
-LOGICAL :: GTKEALLOC ! true if TKE arrays are not zero-sized
-!
-TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST
-!
-INTEGER :: IGRID ! localisation on the model grid
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZMEANX, ZMEANY ! fluxes
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTES THE DOMAIN DIMENSIONS
-! ------------------------------
-!
-CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
-!
-GTKEALLOC = SIZE(PTKET,1) /= 0
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. CALL THE ADVEC_4TH_ORDER_ALGO ROUTINE FOR EACH FIELD
-! ----------------------------------------------------
-!
-IGRID = 1
-!
-!!$IF (NHALO == 1) THEN
- TZHALO2LIST => TPHALO2LIST
- CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PTHT, IGRID, ZMEANX, ZMEANY, &
- TZHALO2LIST%HALO2 )
-!!$ELSE
-!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PTHT, IGRID, ZMEANX, ZMEANY)
-!!$ENDIF
-!
-! Thermodynamical variable
-!
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DXF( PRUCT(:,:,:) * ZMEANX(:,:,:) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVX_BU_RTH')
-!
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DYF( PRVCT(:,:,:) * ZMEANY(:,:,:) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVY_BU_RTH')
-!
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DZF( PRWCT(:,:,:) * MZM4(PTHT(:,:,:)) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVZ_BU_RTH')
-!
-! Turbulence variables
-!
-IF ( GTKEALLOC ) THEN
-!!$ IF(NHALO == 1) THEN
- TZHALO2LIST => TZHALO2LIST%NEXT
- CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PTKET, IGRID, &
- ZMEANX, ZMEANY, TPHALO2=TZHALO2LIST%HALO2)
-!!$ ELSE
-!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PTKET, IGRID, ZMEANX, ZMEANY)
-!!$ ENDIF
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DXF( PRUCT(:,:,:) * ZMEANX(:,:,:) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVX_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DYF( PRVCT(:,:,:) * ZMEANY(:,:,:) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVY_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DZF( PRWCT(:,:,:) * MZM4(PTKET(:,:,:)) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVZ_BU_RTKE')
-ENDIF
-!
-!
-! Case with KRR moist variables
-!
-DO JRR=1, KRR
-!!$ IF(NHALO == 1) THEN
- TZHALO2LIST => TZHALO2LIST%NEXT
- CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PRT(:,:,:,JRR), IGRID, &
- ZMEANX, ZMEANY,TPHALO2=TZHALO2LIST%HALO2 )
-!!$ ELSE
-!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PRT(:,:,:,JRR), IGRID, ZMEANX, ZMEANY)
-!!$ ENDIF
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DXF( PRUCT(:,:,:) * ZMEANX(:,:,:) )
- IF (JRR==1 .AND. LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVX_BU_RRV')
- IF (JRR==2 .AND. LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVX_BU_RRC')
- IF (JRR==3 .AND. LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVX_BU_RRR')
- IF (JRR==4 .AND. LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVX_BU_RRI')
- IF (JRR==5 .AND. LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVX_BU_RRS')
- IF (JRR==6 .AND. LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVX_BU_RRG')
- IF (JRR==7 .AND. LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVX_BU_RRH')
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DYF( PRVCT(:,:,:) * ZMEANY(:,:,:) )
- IF (JRR==1 .AND. LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVY_BU_RRV')
- IF (JRR==2 .AND. LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVY_BU_RRC')
- IF (JRR==3 .AND. LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVY_BU_RRR')
- IF (JRR==4 .AND. LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVY_BU_RRI')
- IF (JRR==5 .AND. LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVY_BU_RRS')
- IF (JRR==6 .AND. LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVY_BU_RRG')
- IF (JRR==7 .AND. LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVY_BU_RRH')
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DZF( PRWCT(:,:,:) * MZM4(PRT(:,:,:,JRR)) )
- IF (JRR==1 .AND. LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
- IF (JRR==2 .AND. LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVZ_BU_RRC')
- IF (JRR==3 .AND. LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVZ_BU_RRR')
- IF (JRR==4 .AND. LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVZ_BU_RRI')
- IF (JRR==5 .AND. LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVZ_BU_RRS')
- IF (JRR==6 .AND. LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVZ_BU_RRG')
- IF (JRR==7 .AND. LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVZ_BU_RRH')
-ENDDO
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECMET_4TH
-
-
diff --git a/src/MNH/advecscalar.f90 b/src/MNH/advecscalar.f90
deleted file mode 100644
index 44e315a3d..000000000
--- a/src/MNH/advecscalar.f90
+++ /dev/null
@@ -1,168 +0,0 @@
-!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.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_ADVECSCALAR
-! #######################
-INTERFACE
- SUBROUTINE ADVECSCALAR ( KSV, PSVT, PRUCT, PRVCT, PRWCT, PRSVS )
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-END SUBROUTINE ADVECSCALAR
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECSCALAR
-!
-!
-!
-! ######################################################################
- SUBROUTINE ADVECSCALAR ( KSV, PSVT, PRUCT, PRVCT, PRWCT, PRSVS )
-! ######################################################################
-!
-!!**** *ADVECSCALAR * - routine to compute the advection tendancies of the
-!! tracer scalar fields.
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the total advection
-!! tendancies of all the scalar fields, written in flux form.
-!! The advection velocity is taken as the contravariant form of
-!! the momentum for extension to non-cartesian geometry and
-!! conformal projection cases.
-!!
-!!
-!!** METHOD
-!! ------
-!! The left and right lateral EXTernal zones, have been previously
-!! prepared in routine LBC_S, to avoid particular cases close to the
-!! Lateral Boundaries in this routine.
-!! The Shuman functions are used to write the mean and finite
-!! differences operators.
-!! The different sources terms are stored for the budget
-!! computations.
-!!
-!! EXTERNAL
-!! --------
-!! MXM,MYM,MZM : Shuman functions (mean operators)
-!! DXM,DYM,DZM : Shuman functions (finite differences operators)
-!! BUDGET : Stores the different budget components
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RSV : logical for budget of RSVx (scalar variables)
-!! .TRUE. = budget of RSV
-!! .FALSE. = no budget of RSV
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book2 of documentation ( routine ADVECSCALAR )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/07/94
-!! Corrections 06/09/94 (J.-P. Lafore)
-!! 16/03/95 (J. Stein) remove R from the historical var.
-!! 01/04/95 (Ph. Hereil J. Nicolau) add the budget computation
-!! 16/10/95 (J. Stein) change the budget calls
-!! 19/12/96 (J.-P. Pinty) update the budget calls
-!! 07/11/02 (V. Masson) update the budget calls
-!! 24/04/06 (C.Lac) Split scalar and passive
-!! tracer routines
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET
-USE MODD_GRID_n
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JSV ! Loop index for Scalar Variables
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTES THE ADVECTIVE TENDENCIES
-! ---------------------------------
-!
- ! Case with KSV Scalar Variables
-DO JSV=1,KSV
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DXF( PRUCT(:,:,:) * MXM (PSVT(:,:,:,JSV)) )
-END DO
-IF (LBUDGET_SV) THEN
- DO JSV=1,KSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVX_BU_RSV')
- END DO
-END IF
-!
-DO JSV=1,KSV
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DYF( PRVCT(:,:,:) * MYM (PSVT(:,:,:,JSV)) )
-END DO
-IF (LBUDGET_SV) THEN
- DO JSV=1,KSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVY_BU_RSV')
- END DO
-END IF
-!
-DO JSV=1,KSV
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DZF( PRWCT(:,:,:) * MZM (PSVT(:,:,:,JSV)) )
-END DO
-IF (LBUDGET_SV) THEN
- DO JSV=1,KSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVZ_BU_RSV')
- END DO
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECSCALAR
diff --git a/src/MNH/advecscalar_4th.f90 b/src/MNH/advecscalar_4th.f90
deleted file mode 100644
index 9fa8e7847..000000000
--- a/src/MNH/advecscalar_4th.f90
+++ /dev/null
@@ -1,204 +0,0 @@
-!MNH_LIC Copyright 2005-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.
-!-----------------------------------------------------------------
-! ###############################
- MODULE MODI_ADVECSCALAR_4TH
-! ###############################
-!
-INTERFACE
-!
- SUBROUTINE ADVECSCALAR_4TH (HLBCX,HLBCY, KSV, PRUCT, PRVCT, PRWCT, &
- PSVT, PRSVS, TPHALO2LIST )
-!
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT !
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS !
-!
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
-!
-END SUBROUTINE ADVECSCALAR_4TH
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECSCALAR_4TH
-!
-! ######################################################################
- SUBROUTINE ADVECSCALAR_4TH (HLBCX,HLBCY, KSV, PRUCT, PRVCT, PRWCT, &
- PSVT, PRSVS, TPHALO2LIST )
-! ######################################################################
-!
-!!**** *ADVEC_4TH_ORDER * - routine to compute the 4th order centered
-!! advection tendency of scalar variables
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to call the ADVEC_4TH_ORDER_ALGO
-!! routine for the horizontal advection and the MZM4 and MZF4 functions for
-!! the vertical advection of each prognostic variable. The code is
-!! parallelized and works for various boundary conditions.
-!!
-!!** METHOD
-!! ------
-!! For each prognostic variable the ADVEC_4TH_ORDER routine calls
-!! the ADVEC_4TH_ORDER_ALGO routine which computes the numerical advection
-!! of any 3D field.
-!! The following variables are passed as argument to ADVEC_4TH_ORDER_ALGO :
-!!
-!! -- The variable at t
-!! -- The second layer of the halo of the field at t
-!! -- The horizontal advection fluxes
-!! -- The localisation on the model grid :
-!!
-!! IGRID = 1 for mass grid point
-!! IGRID = 2 for U grid point
-!! IGRID = 3 for V grid point
-!! IGRID = 4 for w grid point
-!!
-!! EXTERNAL
-!! --------
-!! BUDGET : Stores the different budget components
-!! (not used in current version)
-!! ADVEC_4TH_ORDER_ALGO : computes the horizontal advection fluxes
-!! MZF4 and MZM4 : computes the vertical advection fluxes
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODULE MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! Switches for budgets activations:
-!!
-!! LBU_RSV : logical for budget of RSVx (scalar variable)
-!! .TRUE. = budget of RSVx
-!! .FALSE. = no budget of RSVx
-!!
-!! MODULE MODD_ARGSLIST
-!! HALO2LIST_ll : type for a list of "HALO2_lls"
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation ( routine ADVEC_4TH_ORDER )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 25/10/05
-!!
-!! Correction :
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODE_ll
-!
-USE MODD_PARAMETERS
-USE MODD_GRID_n
-USE MODD_CONF
-USE MODD_BUDGET
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
-! incorporate ADVEC_4TH_ORDER_ALG, MZF4 and MZM4
-USE MODI_ADVEC_4TH_ORDER_AUX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT !
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
-!
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
-!
-!* 0.2 Declarations of local variables :
-!
-!
-INTEGER :: JSV ! Loop index for Scalar Variables
-INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
-INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-!
-TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST
-!
-INTEGER :: IGRID ! localisation on the model grid
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZMEANX, ZMEANY ! fluxes
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTES THE DOMAIN DIMENSIONS
-! ------------------------------
-!
-CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. CALL THE ADVEC_4TH_ORDER_ALGO ROUTINE FOR EACH FIELD
-! ----------------------------------------------------
-!
-IGRID = 1
-!
-!
-! Case with KSV tracers
-!
-DO JSV=1,KSV
-!
-!!$ IF(NHALO == 1) THEN
- TZHALO2LIST => TPHALO2LIST
- CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PSVT(:,:,:,JSV), IGRID, &
- ZMEANX, ZMEANY,TZHALO2LIST%HALO2 )
-!!$ ELSE
-!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PSVT(:,:,:,JSV), IGRID, ZMEANX, ZMEANY)
-!!$ ENDIF
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DXF( PRUCT(:,:,:) * ZMEANX(:,:,:) )
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVX_BU_RSV')
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DYF( PRVCT(:,:,:) * ZMEANY(:,:,:) )
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVY_BU_RSV')
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DZF( PRWCT(:,:,:) * MZM4(PSVT(:,:,:,JSV)) )
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVZ_BU_RSV')
-ENDDO
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECSCALAR_4TH
-
-
diff --git a/src/MNH/advecuvw.f90 b/src/MNH/advecuvw.f90
deleted file mode 100644
index 087ca0ecf..000000000
--- a/src/MNH/advecuvw.f90
+++ /dev/null
@@ -1,177 +0,0 @@
-!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.
-!-----------------------------------------------------------------
-! ####################
- MODULE MODI_ADVECUVW
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE ADVECUVW ( PUT, PVT, PWT, &
- PRUCT, PRVCT, PRWCT, &
- PRUS, PRVS, PRWS )
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Wind at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Sources of Momentum
-!
-END SUBROUTINE ADVECUVW
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECUVW
-!
-!
-!
-! ###########################################################
- SUBROUTINE ADVECUVW ( PUT, PVT, PWT, &
- PRUCT, PRVCT, PRWCT, &
- PRUS, PRVS, PRWS )
-! ###########################################################
-!
-!!**** *ADVECUVW * - routine to compute the advection terms of momentum
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the three advection terms
-!! of each component of the momentum, written in flux form.
-!! The advection velocity is taken as the contravariant form of
-!! the momentum for extension to non-cartesian geometry and
-!! conformal projection cases. The different sources terms are stored for
-!! the budget computations.
-!!
-!!
-!!** METHOD
-!! ------
-!! The left and right lateral EXTernal zones, have been previously
-!! prepared in routine LBC_S, to avoid particular cases close to the
-!! Lateral Boundaries in this routine.
-!! The Shuman functions are used to write the mean and finite
-!! differences operators.
-!!
-!! EXTERNAL
-!! --------
-!! DXM,DYM,DZM : Shuman functions (finite differences operators)
-!! BUDGET : Stores the different budget components
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS: declaration of parameter variables
-!! JPVEXT: define the number of marginal points out of the
-!! physical domain along the vertical direction.
-!!
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RU : logical for budget of RU (wind component along x)
-!! .TRUE. = budget of RU
-!! .FALSE. = no budget of RU
-!! LBU_RV : logical for budget of RV (wind component along y)
-!! .TRUE. = budget of RV
-!! .FALSE. = no budget of RV
-!! LBU_RW : logical for budget of RW (wind component along z)
-!! .TRUE. = budget of RW
-!! .FALSE. = no budget of RW
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation ( routine ADVECUVW )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/07/94
-!! Corrections 06/09/94 (J.-P. Lafore)
-!! 02/11/94 (J.Stein) extrapolation under the ground
-!! 16/03/95 (J.Stein) remove R from the historical variables
-!! 01/04/95 (Ph. Hereil J. Nicolau) add the budget computation
-!! 16/10/95 (J. Stein) change the budget calls
-!! 19/12/96 (J.-P. Pinty) update the budget calls
-!! 07/11/02 (V. Masson) update the budget calls
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_BUDGET
-USE MODD_GRID_n
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Wind at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Sources of Momentum
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTES THE ADVECTIVE TENDANCIES
-! ---------------------------------
-!
-PRUS(:,:,:) = PRUS(:,:,:) &
- -DXM( MXF(PRUCT(:,:,:))*MXF(PUT(:,:,:)) )
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVX_BU_RU')
-!
-PRUS(:,:,:) = PRUS(:,:,:) &
- -DYF( MXM(PRVCT(:,:,:))*MYM(PUT(:,:,:)) )
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVY_BU_RU')
-!
-PRUS(:,:,:) = PRUS(:,:,:) &
- -DZF( MXM(PRWCT(:,:,:))*MZM(PUT(:,:,:)) )
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVZ_BU_RU')
-!
-!
-PRVS(:,:,:) = PRVS(:,:,:) &
- -DXF( MYM(PRUCT(:,:,:))*MXM(PVT(:,:,:)) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVX_BU_RV')
-!
-PRVS(:,:,:) = PRVS(:,:,:) &
- -DYM( MYF(PRVCT(:,:,:))*MYF(PVT(:,:,:)) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVY_BU_RV')
-!
-PRVS(:,:,:) = PRVS(:,:,:) &
- -DZF( MYM(PRWCT(:,:,:))*MZM(PVT(:,:,:)) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVZ_BU_RV')
-!
-!
-PRWS(:,:,:) = PRWS(:,:,:) &
- -DXF( MZM(PRUCT(:,:,:))*MXM(PWT(:,:,:)) )
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVX_BU_RW')
-!
-PRWS(:,:,:) = PRWS(:,:,:) &
- -DYF( MZM(PRVCT(:,:,:))*MYM(PWT(:,:,:)) )
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVY_BU_RW')
-!
-PRWS(:,:,:) = PRWS(:,:,:) &
- -DZM( MZF(PRWCT(:,:,:))*MZF(PWT(:,:,:)) )
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVZ_BU_RW')
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECUVW
diff --git a/src/MNH/c3r5_adjust.f90 b/src/MNH/c3r5_adjust.f90
deleted file mode 100644
index b286ac8c7..000000000
--- a/src/MNH/c3r5_adjust.f90
+++ /dev/null
@@ -1,166 +0,0 @@
-!MNH_LIC Copyright 1994-2019 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.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_C3R5_ADJUST
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE C3R5_ADJUST( KRR, KMI, HRAD, &
- HTURBDIM, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PSIGS, PPABST, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
- PCCT, PCIT, PCNUCS, PCCS, PINUCS, PCIS, &
- PTHS, PSRCS, PCLDFR )
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Condensation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRST ! Aggregate m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRRS ! Rain water m.r. at t+1
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Cloud ice m.r. at t+1
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRSS ! Aggregate m.r. at t+1
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRGS ! Graupel m.r. at t+1
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHS ! Hail m.r. at t+1
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Cloud ice conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCNUCS ! Nucl. aero. conc. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water conc. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINUCS ! Ice Nucl. conc. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Cloud ice conc. source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux: s'rc'/2Sigma_s2 at time t+1 times Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
-!
-END SUBROUTINE C3R5_ADJUST
-!
-END INTERFACE
-!
-END MODULE MODI_C3R5_ADJUST
-!
-! ##########################################################################
- SUBROUTINE C3R5_ADJUST( KRR, KMI, HRAD, &
- HTURBDIM, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PSIGS, PPABST, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
- PCCT, PCIT, PCNUCS, PCCS, PINUCS, PCIS, &
- PTHS, PSRCS, PCLDFR )
-! ##########################################################################
-!
-!!**** *C3R5_ADJUST* - compute the fast microphysical sources
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the fast microphysical sources
-!! through an explict scheme and a saturation ajustement procedure.
-!!
-!!
-!!** METHOD
-!! ------
-!! Reisin et al., 1996 for the explicit scheme when ice is present
-!! Langlois, Tellus, 1973 for the implict adjustment for the cloud water
-!! (refer also to book 1 of the documentation).
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST
-!! XP00 ! Reference pressure
-!! XMD,XMV ! Molar mass of dry air and molar mass of vapor
-!! XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
-!! XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
-!! XCL ! Cl (liquid)
-!! XTT ! Triple point temperature
-!! XLVTT ! Vaporization heat constant
-!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor
-!! ! pressure function
-!! Module MODD_CONF
-!! CCONF
-!! Module MODD_BUDGET:
-!! NBUMOD
-!! CBUTYPE
-!! NBUPROCCTR
-!! LBU_RTH
-!! LBU_RRV
-!! LBU_RRC
-!! Module MODD_LES : NCTR_LES,LTURB_LES,NMODNBR_LES
-!! XNA declaration (cloud fraction as global var)
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 1 and Book2 of documentation ( routine FAST_TERMS )
-!! Langlois, Tellus, 1973
-!! AUTHOR
-!! ------
-!! E. Richard * Laboratoire d'Aerologie*
-!!
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 20/12/94
-!! Modifications: March 1, 1995 (J.M. Carriere)
-!! Introduction of cloud water with order 1
-!! formulation
-!! Modifications: June 8, 1995 ( J.Stein )
-!! Cleaning
-!! Modifications: August 30, 1995 ( J.Stein )
-!! add Lambda3 for the subgrid condensation
-!!
-!! October 16, 1995 (J. Stein) change the budget calls
-!! March 16, 1996 (J. Stein) store the cloud fraction
-!! April 03, 1996 (J. Stein) displace the nebulosity
-!! computation in the all and nothing case
-!! April 15, 1996 (J. Stein) displace the lambda 3
-!! multiplication and change the nebulosity threshold
-!! September 16, 1996 (J. Stein) bug in the SG cond for
-!! the M computation
-!! October 10, 1996 (J. Stein) reformulate the Subgrid
-!! condensation scheme
-!! October 8, 1996 (Cuxart,Sanchez) Cloud frac. LES diag (XNA)
-!! December 6, 1996 (J.-P. Pinty) correction of Delta_2
-!! November 5, 1996 (J. Stein) remove Rnp<0 values
-!! November 13 1996 (V. Masson) add prints in test above
-!! March 11, 1997 (J.-M. Cohard) C2R2 option
-!! April 6, 2001 (J.-P. Pinty) C3R5 option
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!!
-!-------------------------------------------------------------------------------
-!
-!implicit none
-!
-use mode_msg
-!
-call Print_msg(NVERB_FATAL,'GEN','C3R5_ADJUST','not yet developed')
-!
-END SUBROUTINE C3R5_ADJUST
diff --git a/src/MNH/ch_aqueous_sedimc2r2.f90JPP b/src/MNH/ch_aqueous_sedimc2r2.f90JPP
deleted file mode 100644
index 2627365be..000000000
--- a/src/MNH/ch_aqueous_sedimc2r2.f90JPP
+++ /dev/null
@@ -1,310 +0,0 @@
-!MNH_LIC Copyright 2008-2019 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.
-!-----------------------------------------------------------------
-! ################################
- MODULE MODI_CH_AQUEOUS_SEDIMC2R2
-! ################################
-!
-INTERFACE
- SUBROUTINE CH_AQUEOUS_SEDIMC2R2 (PTIME, PTSTEP, PZZ, PRHODREF, PRHODJ, &
- PRRM, PRRS, PCRM, PCRS, PSVT, PRSVS )
-!
-REAL, INTENT(IN) :: PTIME ! Current time
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRM ! Rain water C at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Precip. aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Precip. aq. species source
-!
-END SUBROUTINE CH_AQUEOUS_SEDIMC2R2
-END INTERFACE
-END MODULE MODI_CH_AQUEOUS_SEDIMC2R2
-!
-! #######################################################################
- SUBROUTINE CH_AQUEOUS_SEDIMC2R2 (PTIME,PTSTEP, PZZ, PRHODREF, PRHODJ, &
- PRRM, PRRS, PCRM, PCRS, PSVT, PRSVS )
-! #######################################################################
-!
-!!**** * - compute the explicit microphysical sources
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the sedimentation of chemical
-!! species in the raindrops for the C2R2 and C3R5 cloud microphysical schemes.
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process). see rain_c2r2.f90
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!! Module MODD_CONF :
-!! CCONF configuration of the model for the first time step
-!!
-!! REFERENCE
-!! ---------
-!! Book1 of the documentation ( routine CH_AQUEOUS_SEDIMC2R2 )
-!!
-!! AUTHOR
-!! ------
-!! M. Leriche & J.P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/10/08
-!!
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_LUNIT_n
-
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_RAIN_C2R2_DESCR, ONLY : XCEXVT, XRTMIN, XCTMIN, &
- XLBR, XLBEXR, XDR
-USE MODD_RAIN_C2R2_PARAM, ONLY : XFSEDRR, XFSEDCR
-USE MODD_CH_MNHC_n, ONLY: XRTMIN_AQ
-!
-use mode_tools, only: Countjv
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-REAL, INTENT(IN) :: PTIME ! Current time
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRM ! Rain water C at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Precip. aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Precip. aq. species source
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JK,JI,JJ ! Vertical loop index for the rain sedimentation
-INTEGER :: JN ! Temporal loop index for the rain sedimentation
-INTEGER :: IIB ! Define the domain where is
-INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IKB !
-INTEGER :: IKE !
-!
-REAL :: ZTSPLITR ! Small time step for rain sedimentation
-!
-INTEGER :: ISEDIM ! Case number of sedimentation
-LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: GSEDIM ! where to compute the SED processes
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZZRRS ! rain water m.r.source for sedim
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZZCRS ! rain water C source for sedim
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRRS ! Rain water m.r. source phys.tendency (*dt)
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZCRS ! Rain water C source phys.tendency
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZWLBDR3, ZWLBDR ! Slope parameter of the raindrops distribution
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZW ! work array
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZWSEDR, ZWSEDC ! sedimentation fluxes
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRR_SEDIM ! Drain/Dt sur ZTSPLIT
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZCR_SEDIM ! Drain/Dt sur ZTSPLIT
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZSV_SEDIM_FACT ! Cumul des Dsv/DT
-REAL, DIMENSION(:), ALLOCATABLE :: ZZZRRS ! Rain water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZZZCRS ! Rain water C source
-REAL, DIMENSION(:), ALLOCATABLE :: ZLBDR ! slope parameter
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
- ZZW1, ZZW2, ZZW3 ! Work array
-REAL, SAVE :: ZRTMIN, ZCTMIN
-!
-REAL :: ZVTRMAX, ZDZMIN, ZT
-LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
-INTEGER, SAVE :: ISPLITR
-!
-INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-
-
-INTEGER :: ILUOUT ! logical unit
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- !in LFI subroutines at the open of the file
-
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
-!
-IIB=1+JPHEXT
-IIE=SIZE(PZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PZZ,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-!-------------------------------------------------------------------------------
-!
-!!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
-! ---------------------------------------
-!
-ZRRS(:,:,:) = PRRS(:,:,:) / PRHODJ(:,:,:)
-ZCRS(:,:,:) = PCRS(:,:,:) / PRHODJ(:,:,:)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE SEDIMENTATION (RS) SOURCE
-! -------------------------------------
-!
-!* 3.1 splitting factor for high Courant number C=v_fall*(del_Z/del_T)
-!
-firstcall : IF (GSFIRSTCALL) THEN
- GSFIRSTCALL = .FALSE.
- ZVTRMAX = 30. !cf. ini_rain_c2r2.f90
- ZDZMIN = MINVAL(PZZ(IIB:IIE,IJB:IJE,IKB+1:IKE+1)-PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
- ISPLITR = 1
- SPLIT : DO
- ZT = PTSTEP / REAL(ISPLITR)
- IF ( ZT * ZVTRMAX / ZDZMIN .LT. 1.) EXIT SPLIT
- ISPLITR = ISPLITR + 1
- END DO SPLIT
- ZRTMIN = XRTMIN(3) / PTSTEP
- ZCTMIN = XCTMIN(3) / PTSTEP
-END IF firstcall
-!
-!* 3.2 Compute the slope parameter
-!
- ZWLBDR3(:,:,:) = 1.E30
- ZWLBDR(:,:,:) = 1.E10
-! WHERE (ZRRS(:,:,:)>0.0.AND.ZCRS(:,:,:)>0.0 )
- WHERE ( ZRRS(:,:,:)>ZRTMIN .AND. ZCRS(:,:,:)>ZCTMIN )
- ZWLBDR3(:,:,:) = XLBR * ZCRS(:,:,:) / (PRHODREF(:,:,:) * ZRRS(:,:,:))
- ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
- END WHERE
-!
-!* 3.3 time splitting loop initialization
-!
-ZTSPLITR = PTSTEP / REAL(ISPLITR) ! Small time step
-!
-!* 3.4 compute the fluxes
-!
-! optimization by looking for locations where
-! the precipitating fields are larger than a minimal value only !!!
-!
-ZSV_SEDIM_FACT(:,:,:) = 1.0
-ZZRRS(:,:,:) = ZRRS(:,:,:) * PTSTEP
-ZZCRS(:,:,:) = ZCRS(:,:,:) * PTSTEP
-!
-DO JN = 1 , ISPLITR
- GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZRRS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN
- ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- IF( ISEDIM >= 1 ) THEN
- IF( JN==1 ) THEN
- ZW(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZW(:,:,JK) =ZTSPLITR/(PZZ(:,:,JK+1)-PZZ(:,:,JK))
- END DO
- END IF
- ALLOCATE(ZRHODREF(ISEDIM))
- ALLOCATE(ZZZRRS(ISEDIM))
- ALLOCATE(ZZZCRS(ISEDIM))
- ALLOCATE(ZLBDR(ISEDIM))
- DO JL=1,ISEDIM
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZZRRS(JL) = ZZRRS(I1(JL),I2(JL),I3(JL))
- ZZZCRS(JL) = ZZCRS(I1(JL),I2(JL),I3(JL))
- ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL))
- ENDDO
- ALLOCATE(ZZW1(ISEDIM)) ; ZZW1(:) = 0.0
- ALLOCATE(ZZW2(ISEDIM)) ; ZZW2(:) = 0.0
- ALLOCATE(ZZW3(ISEDIM)) ; ZZW3(:) = 0.0
-!
-!* for rain
-!
- WHERE( ZZZRRS(:)>XRTMIN(3) )
- ZZW3(:) = ZRHODREF(:)**(-XCEXVT) * (ZLBDR(:)**(-XDR))
- ZZW1(:) = XFSEDRR * ZZZRRS(:)* ZZW3(:) * ZRHODREF(:)
- ZZW2(:) = XFSEDCR * ZZZCRS(:)* ZZW3(:)
- END WHERE
- ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDC(:,:,:) = UNPACK( ZZW2(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK)) &
- /PRHODREF(:,:,JK)
- ZCR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSEDC(:,:,JK+1)-ZWSEDC(:,:,JK))
- END DO
- ZZRRS(:,:,:) = ZZRRS(:,:,:) + ZRR_SEDIM(:,:,:)
- ZZCRS(:,:,:) = ZZCRS(:,:,:) + ZCR_SEDIM(:,:,:)
-!
- WHERE( ZZZRRS(:)>XRTMIN(3) )
- ZZW1(:) = XFSEDRR * ZZW3(:) * ZRHODREF(:)
- END WHERE
- ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZRR_SEDIM(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))
- END DO
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZZRRS)
- DEALLOCATE(ZZZCRS)
- DEALLOCATE(ZLBDR)
- DEALLOCATE(ZZW1)
- DEALLOCATE(ZZW2)
- DEALLOCATE(ZZW3)
- ZSV_SEDIM_FACT(:,:,:) = ZSV_SEDIM_FACT(:,:,:) * (1.0 + ZRR_SEDIM(:,:,:))
-!! (1.0 + ZRR_SEDIM(:,:,:)/MAX(ZZRRS(:,:,:),XRTMIN_AQ))
- END IF
-END DO
-!
-! Apply the rain sedimentation rate to the WR_xxx aqueous species
-!
-!ILUOUT = TLUOUT%NLU
-!WRITE(ILUOUT,*) 'valuers ZSV_SEDIM_FACT TIME =', PTIME-59400.
-!DO JI=IIB,IIE
-! DO JJ = IJB,IJE
-! DO JK= IKB,IKE
-!IF(ZSV_SEDIM_FACT(jI,jJ,jK)>5.) WRITE(ILUOUT,*) JI,JJ,JK,ZSV_SEDIM_FACT(ji,jj,jk)
-! ENDDO
-! ENDDO
-!ENDDO
-DO JL= 1, SIZE(PRSVS,4)
- PRSVS(:,:,:,JL) = MAX( 0.0,ZSV_SEDIM_FACT(:,:,:)*PRSVS(:,:,:,JL) )
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE CH_AQUEOUS_SEDIMC2R2
-
diff --git a/src/MNH/ch_read_meteo.f90 b/src/MNH/ch_read_meteo.f90
deleted file mode 100644
index 8dc06a98d..000000000
--- a/src/MNH/ch_read_meteo.f90
+++ /dev/null
@@ -1,83 +0,0 @@
-!MNH_LIC Copyright 1994-2018 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.
-!-----------------------------------------------------------------
-!! #########################
- MODULE MODI_CH_READ_METEO
-!! #########################
-!
-INTERFACE
-SUBROUTINE CH_READ_METEO(TPM)
-USE MODD_CH_M9_n, ONLY: METEOTRANSTYPE
-IMPLICIT NONE
-TYPE(METEOTRANSTYPE), INTENT(INOUT) :: TPM
-END SUBROUTINE CH_READ_METEO
-END INTERFACE
-END MODULE MODI_CH_READ_METEO
-!!
-!! #############################
- SUBROUTINE CH_READ_METEO(TPM)
-!! #############################
-!!
-!!*** *CH_READ_METEO*
-!!
-!! PURPOSE
-!! -------
-!! Read a set of meteo variables
-!!
-!!** METHOD
-!! ------
-!! read NMETEOVARS values and the time for the next update XTNEXTMETEO
-!!
-!! AUTHOR
-!! ------
-!! K. Suhre
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 21/04/95
-!! 27/07/96 (K. Suhre) restructured
-!! 01/12/03 (D. Gazen) change Chemical scheme interface
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-USE MODD_CH_MODEL0D, ONLY: TMETEOFILE, XTNEXTMETEO, NVERB
-USE MODD_CH_M9_n, ONLY: NMETEOVARS, METEOTRANSTYPE
-!!
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! -----------------
-IMPLICIT NONE
-!
-!* 0.1 declaration of arguments
-!
-TYPE(METEOTRANSTYPE), INTENT(INOUT) :: TPM ! the meteo variables
-!
-!* 0.2 declaration of local variables
-! ----------------
-INTEGER :: JI ! loop control
-!
-!------------------------------------------------------------------------------
-!
-!* EXECUTABLE STATEMENTS
-! ---------------------
-!
-! read meteo variables and time of next update
-READ(TMETEOFILE%NLU,*) (TPM%XMETEOVAR(JI), JI = 1, NMETEOVARS)
-READ(TMETEOFILE%NLU,*) XTNEXTMETEO
-!
-! print what has been read
-IF (NVERB >= 7) THEN
- PRINT *, 'CH_READ_METEO: new set of meteo variables has been read:'
- DO JI = 1, NMETEOVARS
- PRINT *, TPM%CMETEOVAR(JI), ': ', TPM%XMETEOVAR(JI)
- ENDDO
-END IF
-IF (NVERB >= 5) THEN
- PRINT *, 'CH_READ_METEO: next update at XTNEXTMETEO = ', XTNEXTMETEO
-END IF
-!
-END SUBROUTINE CH_READ_METEO
diff --git a/src/MNH/dflux_corr.f90 b/src/MNH/dflux_corr.f90
deleted file mode 100644
index fec030ec7..000000000
--- a/src/MNH/dflux_corr.f90
+++ /dev/null
@@ -1,307 +0,0 @@
-!MNH_LIC Copyright 1998-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.
-!-----------------------------------------------------------------
-! ##########################
- MODULE MODI_DFLUX_CORR
-! ##########################
-!
-INTERFACE
-!
-! ######################################################################
- SUBROUTINE DFLUX_CORR ( HLBCX, HLBCY, PTSTEP, PMIN, &
- PRHODJ, PAM, PAT, PRUCT, PRVCT, PRWCT, &
- PFX, PFY, PFZ)
-! ######################################################################
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PMIN
- ! Absolute minimum variable
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
- ! (Rho) dry *jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAM
- ! Variable at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAT
- ! Variable at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! Contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX, PFY, PFZ
- ! Flux components
-!
-END SUBROUTINE DFLUX_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_DFLUX_CORR
-!
-!
-!
-! ######################################################################
- SUBROUTINE DFLUX_CORR ( HLBCX, HLBCY, PTSTEP, PMIN, &
- PRHODJ, PAM, PAT, PRUCT, PRVCT, PRWCT, &
- PFX, PFY, PFZ)
-! ######################################################################
-!
-!!**** *DFLUX_CORR* - calculates the advective tendencies fluxes by means of
-!! the Directional Flux-Corrected Transport and
-!! the Flux-Corrected Transport advection schemes
-!!
-!! PURPOSE
-!! -------
-!!
-!! The purpose of the routine is to calculate the advection of a scalar.
-!! A centred advection scheme is used (leapfrog). Two corrections of
-!! the fluxes are is applied (DFCT and FCT) to insure that the total
-!! resulting scheme is positive definite.
-!! The advection scheme is second-order on time and on space.
-!
-!!** METHOD
-!! ------
-!!
-!! First, the advective flux is calculated. Second the flux is corrected
-!! using the Directional-Flux-Corrected Transport method.
-!! Second, the advective flux is calculated. Eventually the flux is corrected
-!! using the Flux-Corrected Transport method. This method implies the
-!! calculation of one limiting factors: BETAOUT. The
-!! first factor insures that the calculated flux is less than its respective
-!! analytical value (nonoscillatory condition).
-!!
-!! EXTERNAL
-!! --------
-!! GET_DIM_EXT_ll : get extended sub-domain sizes
-!! ADD3DFIELD_ll : add a field to 3D-list
-!! UPDATE_HALO_ll : update internal halos
-!! UPDATE_BOUNDARIES_ll : update external boundaries
-!! LWEAST_ll,LEAST_ll,LNORTH_ll,LSOUTH_ll : position functions
-!! MXM,MYM,MZM : Shuman functions (mean operators)
-!! DXF,DYF,DZF : Shuman functions (finite difference operators)
-!! CLEANLIST_ll : deaalocate a list
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! JPHEXT, JPVEXT
-!! MODD CONF:CCONF
-!!
-!! REFERENCE
-!! ---------
-!! Book1 of documentation (FCT scheme)
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Lafore *Meteo-France*
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! original 27/03/98
-!! V. Masson 24/11/97 removes the DO loops
-!! P. Jabouille 24/09/98 parallelize the code
-!! J. Stein 05/04/99 : bug for the case PMIN /= 0 + lbc
-!! JP Pinty & 12/10/98 : Vectorization of the first loops
-!! J Escobar
-!! J. Stein & 20/03/01 : bug for the open case at the boundary
-!! P. Jabouille
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_CONF
-USE MODD_PARAMETERS
-USE MODI_SHUMAN
-!
-IMPLICIT NONE
-!
-!* 0.1 DECLARATIONS OF ARGUMENTS
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-!
-REAL, INTENT(IN) :: PTSTEP
- ! Double Time step
-REAL, INTENT(IN) :: PMIN
- ! Absolute minimum variable
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
- ! (Rho) dry *jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAM
- ! Variable at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAT
- ! Variable at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX, PFY, PFZ
- ! Flux component
-!
-!* 0.2 DECLARATIONS OF LOCAL VARIABLES
-!
-!
-INTEGER:: IIU,IJU,IKU ! Size array in the x, y,
- ! and z directions
-INTEGER:: JI,JJ,JK ! Loop index in the x, y,
- ! and z directions
-REAL :: ZEPSILON ! Variable to ensure that the
- ! limiting factor is zero
-!
-!
-REAL,DIMENSION(SIZE(PAT,1),SIZE(PAT,2),SIZE(PAT,3)):: ZFOUT
- ! The outgoing flux of the grid cell
- ! (located at mass point)
-REAL,DIMENSION(SIZE(PAT,1),SIZE(PAT,2),SIZE(PAT,3)):: ZBETAOUT
- ! The outgoing limiting factor
-INTEGER :: IINFO_ll ! return code of parallel routine
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-!
-!* 0.3 PROLOGUE
-!
-NULLIFY(TZFIELDS_ll)
-!
-CALL GET_DIM_EXT_ll ('B',IIU,IJU)
-IKU=SIZE(PRUCT,3)
-!
-ZEPSILON=1.0E-15
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 1. First limitation on a directional base
-! --------------------------------------
-!
-ZBETAOUT(:,:,:) = -PRHODJ(:,:,:)*(PAM(:,:,:)-PMIN)/PTSTEP ! First limiter
-!
-!* 1.1 X-direction
-!
-ZFOUT(2:IIU,:,:) = -ZBETAOUT(1:IIU-1,:,:) ! Second limiter
-ZFOUT(1,:,:) = 0.0
-!
-PFX(:,:,:) = PRUCT(:,:,:) * MXM (PAT(:,:,:))
-PFX(:,:,:) = (0.5+SIGN(0.5,PRUCT(:,:,:)))*MIN( PFX(:,:,:),ZFOUT(:,:,:) ) &
- +(0.5-SIGN(0.5,PRUCT(:,:,:)))*MAX( PFX(:,:,:),ZBETAOUT(:,:,:) )
-!
-!* 1.2 Y-direction
-!
-ZFOUT(:,2:IJU,:) = -ZBETAOUT(:,1:IJU-1,:) ! Second limiter
-ZFOUT(:,1,:) = 0.0
-!
-PFY(:,:,:) = PRVCT(:,:,:) * MYM (PAT(:,:,:))
-PFY(:,:,:) = (0.5+SIGN(0.5,PRVCT(:,:,:)))*MIN( PFY(:,:,:),ZFOUT(:,:,:) ) &
- +(0.5-SIGN(0.5,PRVCT(:,:,:)))*MAX( PFY(:,:,:),ZBETAOUT(:,:,:) )
-!
-!* 1.3 Z-direction
-!
-ZFOUT(:,:,2:IKU) = -ZBETAOUT(:,:,1:IKU-1) ! Second limiter
-ZFOUT(:,:,1) = 0.0
-!
-PFZ(:,:,:) = PRWCT(:,:,:) * MZM (PAT(:,:,:))
-PFZ(:,:,:) = (0.5+SIGN(0.5,PRWCT(:,:,:)))*MIN( PFZ(:,:,:),ZFOUT(:,:,:) ) &
- +(0.5-SIGN(0.5,PRWCT(:,:,:)))*MAX( PFZ(:,:,:),ZBETAOUT(:,:,:) )
-!
-!
-!------------------------------------------------------------------------------
-!* 3. Flux-OUT calculation
-! ---------------------
-!
-DO JK=2,IKU-1
- DO JJ=2,IJU-1
- DO JI=2,IIU-1
- ZFOUT(JI,JJ,JK) = MAX(0.,PFX(JI+1,JJ,JK)) &
- - MIN(0.,PFX(JI, JJ,JK)) &
- + MAX(0.,PFY(JI,JJ+1,JK)) &
- - MIN(0.,PFY(JI,JJ ,JK)) &
- + MAX(0.,PFZ(JI,JJ,JK+1)) &
- - MIN(0.,PFZ(JI,JJ,JK ))
- END DO
- END DO
-END DO
-!
-!
-!------------------------------------------------------------------------------
-!* 4. BETAOUT calculation
-! -------------------
-ZBETAOUT(:,:,:) =(PAM(:,:,:)-PMIN)/ &
- (PTSTEP*ZFOUT(:,:,:)/PRHODJ(:,:,:)+ZEPSILON)
-!
-ZBETAOUT(:,:,1) = 1. ! no limitation outside the physical domain
-ZBETAOUT(:,:,IKU) = 1. ! because no velocity is available
-!
-!
-! Update halo and apply possible cyclic boundary conditions
-!
-!!$IF(NHALO == 1 .OR. HLBCX(1)=='CYCL' .OR. HLBCY(1)=='CYCL') THEN
-IF(HLBCX(1)=='CYCL' .OR. HLBCY(1)=='CYCL') THEN
- CALL ADD3DFIELD_ll( TZFIELDS_ll, ZBETAOUT, 'DFLUX_CORR::ZBETAOUT' )
-!!$ IF(NHALO == 1) THEN
- CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-!!$ ELSE
-!!$ IF(HLBCX(1)=='CYCL') CALL UPDATE_BOUNDARIES_ll('XX',TZFIELDS_ll,IINFO_ll)
-!!$ IF(HLBCY(1)=='CYCL') CALL UPDATE_BOUNDARIES_ll('YY',TZFIELDS_ll,IINFO_ll)
-!!$ END IF
- CALL CLEANLIST_ll(TZFIELDS_ll)
-ENDIF
-!
-!
-IF (HLBCX(1)/='CYCL') THEN
- IF (LWEST_ll( )) ZBETAOUT(1,:,:) = 1. ! no limitation outside the physical domain
- IF (LEAST_ll( )) ZBETAOUT(IIU,:,:) = 1. ! because no velocity is available
-END IF
-!
-IF (HLBCY(1)/='CYCL') THEN
- IF (LSOUTH_ll( )) ZBETAOUT(:,1,:) = 1. ! no limitation outside the physical domain
- IF (LNORTH_ll( )) ZBETAOUT(:,IJU,:) = 1. ! because no velocity is available
-END IF
-!
-!
-!------------------------------------------------------------------------------
-!* 4. Second Flux limitation
-! ----------------------
-!
-!
- ! x-component
- !
-ZFOUT(2:IIU,:,:) = ZBETAOUT(1:IIU-1,:,:)
-PFX(:,:,:) = MIN(1., ZFOUT(:,:,:)) * MAX(0.,PFX(:,:,:)) &
- + MIN(1., ZBETAOUT(:,:,:)) * MIN(0.,PFX(:,:,:))
- ! y-component
- !
-ZFOUT(:,2:IJU,:) = ZBETAOUT(:,1:IJU-1,:)
-PFY(:,:,:) = MIN(1., ZFOUT(:,:,:)) * MAX(0.,PFY(:,:,:)) &
- + MIN(1., ZBETAOUT(:,:,:)) * MIN(0.,PFY(:,:,:))
- ! z-component
- !
-ZFOUT(:,:,2:IKU) = ZBETAOUT(:,:,1:IKU-1)
-PFZ(:,:,:) = MIN(1., ZFOUT(:,:,:)) * MAX(0.,PFZ(:,:,:)) &
- + MIN(1., ZBETAOUT(:,:,:)) * MIN(0.,PFZ(:,:,:))
-!
-!------------------------------------------------------------------------------
-!
-!* 5. Boundary conditions for the flux cyclic case
-! --------------------------------------------
-!
- ! x-direction
-IF (HLBCX(1)=='CYCL') THEN
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PFX, 'DFLUX_CORR::PFX' )
- CALL UPDATE_BOUNDARIES_ll('XX',TZFIELDS_ll, IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-ENDIF
- ! y-direction
-IF (HLBCY(1)=='CYCL') THEN
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PFY, 'DFLUX_CORR::PFY' )
- CALL UPDATE_BOUNDARIES_ll('YY',TZFIELDS_ll, IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-ENDIF
-!
-!
-!------------------------------------------------------------------------------
-END SUBROUTINE DFLUX_CORR
diff --git a/src/MNH/dry_mass.f90 b/src/MNH/dry_mass.f90
deleted file mode 100644
index 0930b058b..000000000
--- a/src/MNH/dry_mass.f90
+++ /dev/null
@@ -1,162 +0,0 @@
-!MNH_LIC Copyright 1994-2019 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.
-!-----------------------------------------------------------------
-! ######spl
- MODULE MODI_DRY_MASS
-! ####################
-INTERFACE
- SUBROUTINE DRY_MASS(PTHV,PR,PJ,PPABS,PDRYMASS)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHV ! virtual potential temperature
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ ! jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABS ! absolute pressure
-!
-REAL, INTENT(OUT) :: PDRYMASS ! dry mass
-!
-END SUBROUTINE DRY_MASS
-END INTERFACE
-END MODULE MODI_DRY_MASS
-! ######spl
- SUBROUTINE DRY_MASS(PTHV,PR,PJ,PPABS,PDRYMASS)
-! ##########################################
-!
-!!**** *DRY_MASS* - computation of the total dry air mass
-!!
-!! PURPOSE
-!! -------
-!! This routine computes the total dry mass in the whole domain from
-!! the virtual potential temperature, the mixing ratio, the local Exner
-!! function at the top of the model and the Jacobian.
-!!
-!!** METHOD
-!! ------
-!!
-!! 1 The local Exner function in computed by integration of the hydrostatic
-!! relation from top (PEXNTOP2D) to bottom (routine COMPUTE_EXNER_FROM_TOP).
-!!
-!!
-!! 2 The Exner function at mass level is computed as follows and linearly
-!! extrapolated for the uppest non-physical level
-!! (routine COMPUTE_EXNER_FROM_TOP).
-!!
-!! 3 rhod is deduced by the relation:
-!!
-!!
-!! P / (PI)
-!! rhod= ----------------
-!! Rd thetav (1+rw)
-!!
-!! 4 The total dry mass is deduced from rhod and the Jacobian (the integration
-!! is performed on the inner points):
-!!
-!! Md= SUM rhod J*
-!! i,j,k
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! routine COMPUTE_EXNER_FROM_TOP : to compute the hydrostatic Exner function
-!!
-!! module MODI_COMPUTE_EXNER_FROM_TOP
-!! SUM3D_ll : distributed function equivalent to SUM
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_CONF : contains configuration variables for all models.
-!! NVERB : verbosity level for output-listing
-!! Module MODD_LUNIT_n : contains logical unit names for all models
-!! TLUOUT : name of output-listing
-!! Module MODD_GRID1 : contains grid variables for model1
-!! XZZ : altitude of the w points
-!! Module MODD_CST : contains physical constants
-!! XG : gravity constant
-!! XCPD: specific heat for dry air at constant pressure
-!! XP00: reference pressure
-!! XRD : gas constant for dry air
-!! Module MODD_PARAMETERS
-!! JPVEXT;JPHEXT
-!! Module MODD_FIELD1 : contains the prognostic fields of model1
-!! XDRYMASST : total dry mass at t
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/12/94
-!! Sept. 21, 1995 (J.Stein and V.Masson) surface pressure
-!! Jan. 09, 1996 (V. Masson) hydrostatic pressure at mass
-!! point
-!! March 06, 1996 (V. Masson) call to COMPUTE_EXNER_FROM_TOP
-!! Jan 15, 1997 (Stein,Lafore) Durran anelastic equation
-!! Jun 10, 1997 (V. Masson) use absolute pressure
-!! Jul 10, 1997 (V. Masson) removes use to modules of model 1
-!! Nov 21, 1997 (V. Masson) use all water species
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CONF ! declaration modules
-USE MODD_LUNIT_n, ONLY : TLUOUT
-USE MODD_CST
-USE MODD_PARAMETERS
-!
-USE MODE_ll
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHV ! virtual potential temperature
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ ! jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABS ! absolute pressure
-!
-REAL, INTENT(OUT) :: PDRYMASS ! dry mass
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-INTEGER :: JRR
-REAL, DIMENSION(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)) :: ZRHOD, ZSUMR
-INTEGER :: IINFO_ll ! return code of parallel routine
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. COMPUTATION OF RHOD
-! -------------------
-!
-!
-ZSUMR(:,:,:) = 0.
-DO JRR=1,SIZE(PR,4)
- ZSUMR(:,:,:) = ZSUMR(:,:,:) + PR(:,:,:,JRR)
-END DO
-!
-ZRHOD(:,:,:)=PPABS(:,:,:)/(PPABS(:,:,:)/XP00)**(XRD/XCPD) &
- /(XRD*PTHV(:,:,:)*(1.+ZSUMR(:,:,:)))
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. COMPUTATION OF THE TOTAL DRY MASS
-! ---------------------------------
-!
-PDRYMASS=SUM3D_ll(PJ(:,:,:)*ZRHOD(:,:,:),IINFO_ll)
-!
-!-------------------------------------------------------------------------------
-!
-WRITE(TLUOUT%NLU,*) 'Routine DRYMASS completed'
-!
-END SUBROUTINE DRY_MASS
diff --git a/src/MNH/dummy_gr_index.f90 b/src/MNH/dummy_gr_index.f90
deleted file mode 100644
index 1bdac1193..000000000
--- a/src/MNH/dummy_gr_index.f90
+++ /dev/null
@@ -1,86 +0,0 @@
-!MNH_LIC Copyright 1997-2019 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.
-!-----------------------------------------------------------------
-! #####################
- MODULE MODI_DUMMY_GR_INDEX
-! #####################
-INTERFACE
- FUNCTION DUMMY_GR_INDEX(HFIELD,HDUMMY_GR_NAME) RESULT(KINDEX)
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! name of PGD field
-CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HDUMMY_GR_NAME ! names of PGD field
-INTEGER :: KINDEX ! index of this field
-!
-END FUNCTION DUMMY_GR_INDEX
-END INTERFACE
-END MODULE MODI_DUMMY_GR_INDEX
-!
-! #########################################
- FUNCTION DUMMY_GR_INDEX(HFIELD,HDUMMY_GR_NAME) RESULT(KINDEX)
-! #########################################
-!
-!!
-!! PURPOSE
-!! -------
-!!
-!! routine to retrive the index of a PGD field in LNOCLASS_PGD array
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 15/12/97
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!!
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-use mode_msg
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! name of PGD field
-CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HDUMMY_GR_NAME ! names of PGD field
-INTEGER :: KINDEX ! index of this field
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: JDUMMY ! loop control
-!-------------------------------------------------------------------------------
-!
-DO JDUMMY=1,1000
- IF (HFIELD==HDUMMY_GR_NAME(JDUMMY)) THEN
- KINDEX = JDUMMY
- RETURN
- END IF
- IF (LEN_TRIM(HFIELD)==0) THEN
- call Print_msg(NVERB_FATAL,'GEN','DUMMY_GR_INDEX','LEN_TRIM(HFIELD)=0')
- ENDIF
-END DO
-!-------------------------------------------------------------------------------
-!
-END FUNCTION DUMMY_GR_INDEX
diff --git a/src/MNH/elec_trid.f90 b/src/MNH/elec_trid.f90
deleted file mode 100644
index 2a8c5aad1..000000000
--- a/src/MNH/elec_trid.f90
+++ /dev/null
@@ -1,679 +0,0 @@
-!MNH_LIC Copyright 1994-2019 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.
-!-----------------------------------------------------------------
-! #####################
- MODULE MODI_ELEC_TRID
-! #####################
-!
-INTERFACE
-!
- SUBROUTINE ELEC_TRID(HLBCX,HLBCY, &
- PMAP,PDXHAT,PDYHAT,PDXHATM,PDYHATM,PRHOM, &
- PAF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY, &
- PRHODJ,PTHVREF,PZZ,PBFY,PEPOTFW_TOP )
-!
-IMPLICIT NONE
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! x-direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference * J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
- ! Temperature of the reference state
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! scale factor
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
-!
-REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
-REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
-!
-REAL, INTENT(OUT) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(OUT) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(OUT) :: PRHOM ! mean of XRHODJ on the plane
- ! x y localized at a mass
- ! level
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBFY ! elements (yslice) of the tri-diag.
- ! matrix in the pressure eq.
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEPOTFW_TOP ! top boundary condition of
- ! the tri-diag. system; it
- ! has the dimension of an
- ! electrical potential
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXY ! - along y
-
-!
-END SUBROUTINE ELEC_TRID
-!
-END INTERFACE
-!
-END MODULE MODI_ELEC_TRID
-!
-! ###################################################################
- SUBROUTINE ELEC_TRID(HLBCX,HLBCY, &
- PMAP,PDXHAT,PDYHAT,PDXHATM,PDYHATM,PRHOM, &
- PAF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY, &
- PRHODJ,PTHVREF,PZZ,PBFY,PEPOTFW_TOP )
-! ####################################################################
-!
-!!**** *ELEC_TRID * - Compute coefficients for the flat operator to get the
-!! electric potential from the Gauss equation
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical time independent
-! coefficients a(k), b(k), c(k) required for the calculation of the "flat"
-! (i.e. neglecting the orography) operator Laplacian. RHOJ is averaged on
-! the whole horizontal domain. The form of the eigenvalues of the flat
-! operator depends on the lateral boundary conditions. Furthermore, this
-! routine initializes TRIGS and IFAX arrays required for the FFT transform
-! used in the routine PRECOND.
-! ELEC_TRID (to invert the Gauss equation) differs from TRID (to solve the
-! pressure equation) by the bottom boundary condition, here Dirichlet
-! instead of Neumann, because the earth surface is conductive so it is a
-! surface with an electrical equipotential referenced to zero.
-!
-!!** METHOD
-!! ------
-!! The forms of the eigenvalues of the horizontal Laplacian are given by:
-!! Cyclic conditions:
-!! -----------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( imax ) <dyy> <dyy> ( jmax )
-!!
-!! Open conditions:
-!! -----------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( 2imax ) <dyy> <dyy> ( 2jmax )
-!!
-!! Cyclic condition along x and open condition along y:
-!! ------------------------------------------------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( imax ) <dyy> <dyy> ( 2jmax )
-!!
-!! Open condition along x and cyclic condition along y:
-!! ------------------------------------------------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( 2imax ) <dyy> <dyy> ( jmax )
-!!
-!! where m = 0,1,2....imax-1, n = 0,1,2....jmax-1
-!! Note that rhoj contains the Jacobian J = Deltax*Deltay*Deltaz = volume of
-!! an elementary mesh.
-
-!!
-!! EXTERNAL
-!! --------
-!! Function FFTFAX: initialization of TRIGSX,IFAXX,TRIGSY,IFAXY for
-!! the FFT transform
-!! GET_DIM_EXT_ll : get extended sub-domain sizes
-!! GET_INDICE_ll : get physical sub-domain bounds
-!! GET_DIM_PHYS_ll : get physical sub-domain sizes
-!! GET_GLOBALDIMS_ll : get physical global domain sizes
-!! GET_OR_ll : get origine coordonates of the physical sub-domain
-!! in global indices
-!! REDUCESUM_ll : sum into a scalar variable
-!! GET_SLICE_ll : get a slice of the global domain
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : define constants
-!! XPI : pi
-!! XCPD
-!! Module MODD_PARAMETERS: declaration of parameter variables
-!! JPHEXT, JPVEXT: define the number of marginal points out of the
-!! physical domain along horizontal and vertical directions respectively
-!! Module MODD_CONF: model configurations
-!! LCARTESIAN: logical for CARTESIAN geometry
-!! .TRUE. = Cartesian geometry used
-!! L2D: logical for 2D model version
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation (routine ELEC_TRID)
-!!
-!! AUTHOR
-!! ------
-!! P. HÃ…reil and J. Stein * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 25/07/94
-!! 14/04/95 (J. Stein) bug in the ZDZM computation
-!! ( stretched case)
-!! 8/07/96 (P. Jabouille) change the FFT initialization
-!! which now works for odd number.
-!! 14/01/97 Durran anelastic equation (Stein,Lafore)
-!! 15/06/98 (D.Lugato, R.Guivarch) Parallelisation
-!! 10/08/98 (N. Asencio) add parallel code
-!! use PDXHAT, PDYHAT and not PXHAT,PYHAT
-!! PBFY is initialized
-!! 20/08/00 (J. Stein, J. Escobar) optimisation of the solver
-!! PBFY transposition
-!! 14/03/02 (P. Jabouille) set values for meaningless spectral coefficients
-!! (to avoid problem in bouissinesq configuration)
-!! 01/07/12 (J-P. Pinty) add a non-homogeneous fair-weather
-!! top boundary condition (Neuman)
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_CST
-USE MODD_CONF
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAMETERS
-!
-USE MODE_ll
-USE MODE_MSG
-!
-!JUAN
-USE MODE_REPRO_SUM
-!JUAN
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! x-direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference * J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
- ! Temperature of the reference state
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! scale factor
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
-!
-REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
-REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
-!
-REAL, INTENT(OUT) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(OUT) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(OUT) :: PRHOM ! mean of XRHODJ on the plane
- ! x y localized at a mass
- ! level
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBFY ! elements (yslice) of the tri-diag.
-! matrix in the pressure eq. which is transposed. PBFY is a y-slices structure
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEPOTFW_TOP ! top boundary condition of
- ! the tri-diag. system; it
- ! has the dimension of an
- ! electrical potential
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXY ! - along y
-
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IRESP ! FM return code
-INTEGER :: ILUOUT ! Logical unit number for
- ! output-listing
-INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! indice values of the physical subdomain
-INTEGER :: IKU ! size of the arrays along z
-INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll ! indice values of the physical global domain
-INTEGER :: IIMAX,IJMAX ! Number of points of the physical subdomain
-INTEGER :: IIMAX_ll,IJMAX_ll ! Number of points of Global physical domain
-!
-INTEGER :: JI,JJ,JK ! loop indexes
-!
-INTEGER :: INN ! temporary result for the computation of array TRIGS
-!
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZEIGEN_ll ! eigenvalues b(m,n) in global representation
-REAL, DIMENSION (:), ALLOCATABLE :: ZEIGENX_ll ! used for the computation of ZEIGEN_ll
-!
-REAL, DIMENSION( SIZE(PDXHAT)) :: ZWORKX ! work array to compute PDXHATM
-REAL, DIMENSION( SIZE(PDYHAT)) :: ZWORKY ! work array to compute PDYHATM
-!
-REAL :: ZGWNX,ZGWNY ! greater wave numbers allowed by the model
- ! configuration in x and y directions respectively
-!
-REAL, DIMENSION (SIZE(PZZ,3)) :: ZDZM ! mean of deltaz on the plane x y
- ! localized at a w-level
-!
-REAL :: ZANGLE,ZDEL ! needed for the initialization of the arrays used by the FFT
-!
-REAL :: ZINVMEAN ! inverse of inner points number in an horizontal grid
-!
-INTEGER :: IINFO_ll ! return code of parallel routine
-REAL, DIMENSION (SIZE(PMAP,1)) :: ZXMAP ! extraction of PMAP array along x
-REAL, DIMENSION (SIZE(PMAP,2)) :: ZYMAP ! extraction of PMAP array along y
-INTEGER :: IORXY_ll,IORYY_ll ! origin's coordinates of the y-slices subdomain
-INTEGER :: IIUY_ll,IJUY_ll ! dimensions of the y-slices subdomain
-INTEGER :: IXMODE_ll,IYMODE_ll ! number of modes in the x and y direction for global point of view
-INTEGER :: IXMODEY_ll,IYMODEY_ll ! number of modes in the x and y direction for y_slice point of view
-!JUAN16
-!TYPE(DOUBLE_DOUBLE) , DIMENSION (SIZE(PZZ,3)) :: ZRHOM_ll , ZDZM_ll
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZRHOM_2D , ZDZM_2D
-!JUAN16
-!
-!
-!
-!
-!
-!------------------------------------------------------------------------------
-!
-!* 1. INITIALIZATION
-! --------------
-!
-!* 1.1 retrieve a logical unit number
-! ------------------------------
-!
-ILUOUT = TLUOUT%NLU
-!
-!* 1.2 compute loop bounds
-! -------------------
-!
-! extended sub-domain
-CALL GET_DIM_EXT_ll ('Y',IIUY_ll,IJUY_ll)
-IKU=SIZE(PRHODJ,3)
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1 +JPVEXT
-IKE=IKU -JPVEXT
-! physical sub-domain
-CALL GET_DIM_PHYS_ll ( 'B',IIMAX,IJMAX)
-!
-! global physical domain limits
-CALL GET_GLOBALDIMS_ll ( IIMAX_ll, IJMAX_ll)
-IIB_ll = 1 + JPHEXT
-IIE_ll = IIMAX_ll + JPHEXT
-IJB_ll = 1 + JPHEXT
-IJE_ll = IJMAX_ll + JPHEXT
-!
-! the use of local array ZEIGENX and ZEIGEN would require some technical modifications
-!
-ALLOCATE (ZEIGENX_ll(IIMAX_ll + 2*JPHEXT))
-ALLOCATE (ZEIGEN_ll(IIMAX_ll + 2*JPHEXT, IJMAX_ll + 2*JPHEXT))
-ZEIGEN_ll = 0.0
-! Get the origin coordinates of the extended sub-domain in global landmarks
-CALL GET_OR_ll('Y',IORXY_ll,IORYY_ll)
-!
-!* 1.3 allocate x-slice array
-
-!
-!* 1.4 variables for the eigenvalues computation
-!
-ZGWNX = XPI/REAL(IIMAX_ll)
-ZGWNY = XPI/REAL(IJMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 2. COMPUTE THE AVERAGE OF RHOJ*CPD*THETAVREF ALONG XY
-! --------------------------------------------------
-!
-ZINVMEAN = 1./REAL(IIMAX_ll*IJMAX_ll)
-!JUAN16
-ALLOCATE(ZRHOM_2D(IIB:IIE, IJB:IJE))
-!
-DO JK = 1,SIZE(PZZ,3)
- IF ( CEQNSYS == 'DUR' .OR. CEQNSYS == 'MAE' ) THEN
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZRHOM_2D(JI,JJ) = PRHODJ(JI,JJ,JK)*XCPD*PTHVREF(JI,JJ,JK)*ZINVMEAN
- END DO
- END DO
- ELSEIF ( CEQNSYS == 'LHE' ) THEN
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZRHOM_2D(JI,JJ) = PRHODJ(JI,JJ,JK)*ZINVMEAN
- END DO
- END DO
- END IF
- ! global sum
- PRHOM(JK) = SUM_DD_R2_ll(ZRHOM_2D)
-END DO
-
-!
-! global sum
-!CALL REDUCESUM_ll(ZRHOM_ll,IINFO_ll)
-!PRHOM = ZRHOM_ll
-!JUAN16
-!
-!------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE MEAN INCREMENT BETWEEN Z LEVELS
-! -------------------------------------------
-!
-!JUAN16
-!ZDZM_ll = 0.
-ALLOCATE(ZDZM_2D(IIB:IIE, IJB:IJE))
-!
-DO JK = IKB-1,IKE
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZDZM_2D(JI,JJ) = (PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))*ZINVMEAN
- END DO
- END DO
- ZDZM(JK) = SUM_DD_R2_ll(ZDZM_2D)
-END DO
-ZDZM(IKE+1) = ZDZM(IKE)
-!
-! global sum
-!CALL REDUCESUM_ll(ZDZM_ll,IINFO_ll)
-!ZDZM = ZDZM_ll
-!JUAN16
-!
-!
-! vertical average to arrive at a w-level
-DO JK = IKE+1,IKB,-1
- ZDZM(JK) = (ZDZM(JK) + ZDZM(JK-1))*0.5
-END DO
-!
-ZDZM(IKB-1) = -999.
-!
-!------------------------------------------------------------------------------
-!
-!* 4. COMPUTE THE MEAN INCREMENT BETWEEN X LEVELS
-! -------------------------------------------
-!
-PDXHATM =0.
-! . local sum
-IF (LCARTESIAN) THEN
- PDXHATM = SUM_1DFIELD_ll ( PDXHAT,'X',IIB_ll,IIE_ll,IINFO_ll)
-ELSE
- ! Extraction of x-slice PMAP at j=(IJB_ll+IJE_ll)/2
- CALL GET_SLICE_ll (PMAP,'X',(IJB_ll+IJE_ll)/2,ZXMAP(IIB:IIE) &
- ,IIB,IIE,IINFO_ll)
- ! initialize the work array = PDXHAT/ZXMAP
- ZWORKX(IIB:IIE) = PDXHAT(IIB:IIE)/ ZXMAP (IIB:IIE)
- PDXHATM = SUM_1DFIELD_ll ( ZWORKX,'X',IIB_ll,IIE_ll,IINFO_ll)
-END IF
-! . division to complete sum
-PDXHATM = PDXHATM / REAL(IIMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 5. COMPUTE THE MEAN INCREMENT BETWEEN Y LEVELS
-! -------------------------------------------
-!
-PDYHATM = 0.
-IF (LCARTESIAN) THEN
- PDYHATM = SUM_1DFIELD_ll ( PDYHAT,'Y',IJB_ll,IJE_ll,IINFO_ll)
-ELSE
- ! Extraction of y-slice PMAP at i=IIB_ll+IIE_ll/2
- CALL GET_SLICE_ll (PMAP,'Y',(IIB_ll+IIE_ll)/2,ZYMAP(IJB:IJE) &
- ,IJB,IJE,IINFO_ll)
- ! initialize the work array = PDYHAT / ZYMAP
- ZWORKY(IJB:IJE) = PDYHAT(IJB:IJE) / ZYMAP (IJB:IJE)
- PDYHATM = SUM_1DFIELD_ll ( ZWORKY,'Y',IJB_ll,IJE_ll,IINFO_ll)
-END IF
-! . division to complete sum
-PDYHATM= PDYHATM / REAL(IJMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 6. COMPUTE THE OUT-DIAGONAL ELEMENTS A AND C OF THE MATRIX
-! -------------------------------------------------------
-!
-DO JK = IKB,IKE
- PAF(JK) = 0.5 * ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2
- PCF(JK) = 0.5 * ( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1) **2
-END DO
-!
-! at the upper and lower levels PAF and PCF are computed using the Neumann
-! conditions applying on the vertical component of the gradient
-!
-!
-! Neumann boundary condition (top of atmosphere)
-!
-PAF(IKE+1) = -0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / ZDZM(IKE+1) **2
-!
-! Dirichlet boundary condition (earth surface)
-!
-PCF(IKB-1) = 0.0
-!
-PAF(IKB-1) = 999.
-PCF(IKE+1) = 999.
-!------------------------------------------------------------------------------
-!* 7. COMPUTE THE DIAGONAL ELEMENTS B OF THE MATRIX
-! ---------------------------------------------
-!
-!* 7.1 compute the horizontal eigenvalues
-!
-!
-!* 7.1.1 compute the eigenvalues along the x direction
-!
-SELECT CASE (HLBCX(1))
-! in the cyclic case, the eigenvalues are the same for two following JM values:
-! it corresponds to the real and complex parts of the FFT
- CASE('CYCL') ! cyclic case
- IXMODE_ll = IIMAX_ll+2
- IXMODEY_ll = IIUY_ll
-!
- DO JI = 1,IXMODE_ll
- ZEIGENX_ll(JI) = - ( 2. * SIN ( (JI-1)/2*ZGWNX ) / PDXHATM )**2
- END DO
- CASE DEFAULT ! other cases
- IXMODE_ll = IIMAX_ll
-!
-!
- IF (LEAST_ll(HSPLITTING='Y')) THEN
- IXMODEY_ll = IIUY_ll - 2
- ELSE
- IXMODEY_ll = IIUY_ll
- END IF
-!
-!
- DO JI = 1,IXMODE_ll
- ZEIGENX_ll(JI) = - ( 2. *SIN (0.5*REAL(JI-1)*ZGWNX ) / PDXHATM )**2
- END DO
-END SELECT
-!
-!* 7.1.2 compute the eventual eigenvalues along the y direction
-!
-IF (.NOT. L2D) THEN
-!
-! y lateral boundary conditions for three-dimensional cases
-!
- SELECT CASE (HLBCY(1))
-! in the cyclic case, the eigenvalues are the same for two following JN values:
-! it corresponds to the real and complex parts of the FFT result
-!
- CASE('CYCL') ! 3D cyclic case
- IYMODE_ll = IJMAX_ll+2
- IYMODEY_ll = IJUY_ll
-!
- DO JJ = 1,IYMODE_ll
- DO JI = 1,IXMODE_ll
- ZEIGEN_ll(JI,JJ) = ZEIGENX_ll(JI) - &
- ( 2.* SIN ( (JJ-1)/2*ZGWNY ) / PDYHATM )**2
- END DO
- END DO
-!
- CASE DEFAULT ! 3D non-cyclic cases
- IYMODE_ll = IJMAX_ll
- IYMODEY_ll = IJUY_ll - 2
-!
- DO JJ = 1,IYMODE_ll
- DO JI = 1,IXMODE_ll
- ZEIGEN_ll(JI,JJ) = ZEIGENX_ll(JI) - ( 2.* SIN (0.5*REAL(JJ-1)*ZGWNY ) / &
- PDYHATM )**2
- END DO
- END DO
-!
- END SELECT
-ELSE
-!
-! copy the x eigenvalue array in a 2D array for a 2D case
-!
- IYMODE_ll = 1
- IYMODEY_ll = 1
- ZEIGEN_ll(1:IXMODE_ll,1)=ZEIGENX_ll(1:IXMODE_ll)
-!
-END IF
-!
-DEALLOCATE(ZEIGENX_ll)
-!
-!* 7.2 compute the matrix diagonal elements
-!
-!
-PBFY = 1.
-IF (L2D) THEN
- DO JK= IKB,IKE
- DO JJ= 1, IYMODEY_ll
- DO JI= 1, IXMODEY_ll
- PBFY(JI,JJ,JK) = PRHOM(JK)* ZEIGEN_ll(JI+IORXY_ll-1,JJ+IORYY_ll-1) - 0.5 * &
- ( ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2 &
- +( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1)**2 )
- END DO
- END DO
- END DO
-! at the upper and lower levels PBFY is computed using the Neumann
-! condition
-!
- PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKB) = PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKB) - &
- PAF(IKB)
- PAF(IKB) = 0.0
- PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKB-1) = 1.0
- !
- PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKE+1) = 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / &
- ZDZM(IKE+1) **2
- !
- !
-ELSE
- DO JK= IKB,IKE
- DO JJ= 1, IYMODEY_ll
- DO JI= 1, IXMODEY_ll
- PBFY(JJ,JI,JK) = PRHOM(JK)* ZEIGEN_ll(JI+IORXY_ll-1,JJ+IORYY_ll-1) - 0.5 * &
- ( ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2 &
- +( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1)**2 )
- END DO
- END DO
- END DO
-! at the upper and lower levels PBFY is computed using the Neumann
-! condition
-!
- PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKB) = PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKB) - &
- PAF(IKB)
- PAF(IKB) = 0.0
- PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKB-1) = 1.0
- !
- PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKE+1) = 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / &
- ZDZM(IKE+1) **2
- !
-END IF
-!
-DEALLOCATE(ZEIGEN_ll)
-!
-! second coefficent is meaningless in cyclic case
-IF (HLBCX(1) == 'CYCL' .AND. L2D) PBFY(2,:,:)=1.
-IF (HLBCX(1) == 'CYCL' .AND. .NOT.(L2D) .AND. LWEST_ll(HSPLITTING='Y')) PBFY(:,2,:)=1.
-IF (HLBCY(1) == 'CYCL' .AND. .NOT.(L2D)) PBFY(2,:,:)=1.
-!
-!------------------------------------------------------------------------------
-!* 8. INITIALIZATION OF THE TRIGS AND IFAX ARRAYS FOR THE FFT
-! -------------------------------------------------------
-!
-! 8.1 x lateral boundary conditions
-!
-CALL SET99(PTRIGSX,KIFAXX,IIMAX_ll)
-!
-! test on the value of KIMAX: KIMAX must be factorizable as a product
-! of powers of 2,3 and 5. KIFAXX(10) is equal to IIMAX if the decomposition
-! is correct, then KIFAXX(1) contains the number of decomposition factors
-! of KIMAX.
-!
-IF (KIFAXX(10) /= IIMAX_ll) THEN
- WRITE(UNIT=ILUOUT,FMT="(' ERROR',/, &
- &' : THE FORM OF THE FFT USED FOR THE INVERSION OF THE FLAT ',/,&
- &' OPERATOR REQUIRES THAT KIMAX MUST BE FACTORIZABLE' ,/,&
- & ' AS A PRODUCT OF POWERS OF 2, 3 AND 5.')")
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ELEC_TRID','')
-END IF
-!
-IF (HLBCX(1) /= 'CYCL') THEN
-!
-! extra trigs for shifted (co) sine transform (FFT55)
-!
- INN=2*(IIMAX_ll)
- ZDEL=ASIN(1.0)/REAL(IIMAX_ll)
- DO JI=1,IIMAX_ll
- ZANGLE=REAL(JI)*ZDEL
- PTRIGSX(INN+JI)=SIN(ZANGLE)
- END DO
-!
-ENDIF
-!
-! 8.2 y lateral boundary conditions
-!
-IF (.NOT. L2D) THEN
- CALL SET99(PTRIGSY,KIFAXY,IJMAX_ll)
- !
- ! test on the value of KJMAX: KJMAX must be factorizable as a product
- ! of powers of 2,3 and 5. KIFAXY(10) is equal to IJMAX_ll if the decomposition
- ! is correct, then KIFAXX(1) contains the number of decomposition factors
- ! of IIMAX_ll.
- !
- IF (KIFAXY(10) /= IJMAX_ll) THEN
- WRITE(UNIT=ILUOUT,FMT="(' ERROR',/, &
- &' : THE FORM OF THE FFT USED FOR THE INVERSION OF THE FLAT ',/,&
- &' OPERATOR REQUIRES THAT KJMAX MUST BE FACTORIZABLE' ,/,&
- & ' AS A PRODUCT OF POWERS OF 2, 3 AND 5.')")
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ELEC_TRID','')
- END IF
- !
- ! 8.3 top boundary conditions
- !
- PEPOTFW_TOP(:,:) = PEPOTFW_TOP(:,:) / ZDZM(IKE+1)
-
- !
- ! other cases
- !
- IF (HLBCY(1) /= 'CYCL') THEN
- !
- ! extra trigs for shifted (co) sine transform
- !
- INN=2*(IJMAX_ll)
- ZDEL=ASIN(1.0)/REAL(IJMAX_ll)
- DO JJ=1,IJMAX_ll
- ZANGLE=REAL(JJ)*ZDEL
- PTRIGSY(INN+JJ)=SIN(ZANGLE)
- END DO
- !
- ENDIF
- !
-ENDIF
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE ELEC_TRID
diff --git a/src/MNH/fct_met.f90 b/src/MNH/fct_met.f90
deleted file mode 100644
index b484dc593..000000000
--- a/src/MNH/fct_met.f90
+++ /dev/null
@@ -1,363 +0,0 @@
-!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.
-!-----------------------------------------------------------------
-! ######################
- MODULE MODI_FCT_MET
-! ######################
-!
-INTERFACE
- SUBROUTINE FCT_MET (HLBCX, HLBCY, KRR, &
- PTSTEP, PRHODJ, PTHM, PRM, PTKEM, &
- PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariant component of
- ! momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-!
-END SUBROUTINE FCT_MET
-!
-END INTERFACE
-!
-END MODULE MODI_FCT_MET
-!
-!
-!
-! #####################################################################
- SUBROUTINE FCT_MET (HLBCX, HLBCY, KRR, &
- PTSTEP, PRHODJ, PTHM, PRM, PTKEM, &
- PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-! #####################################################################
-!
-!!**** *FCT_MET * - routine to call the Flux-Corrected Transport for
-!! meteorological scalars
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to call the FLUX-CORRected routine
-!! for meteorological scalars variables.
-!!
-!!** METHOD
-!! ------
-!! The Flux-Corrected Transport method correct the fluxes using a limiting
-!! factor. This method ensures that the advection scheme is definite
-!! positive. A minimum value of the scalar (MIN) equal to 0 is used for
-!! the positiveness of the scheme.
-!!
-!! EXTERNAL
-!! --------
-!! Functions MXM,MYM,MZM : computes the averages along three directins
-!! Functions DXF,DYF,DZF : computes the finite differences
-!! Subroutine FLUX_CORR : corrects the advective fluxes
-!! Subroutine BUDGET : stores the sources for budget purposes
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_BUDGET : LBU_R* ( individual budget switches)
-!! CBUTYPE, NBUMOD
-!! REFERENCE
-!! ---------
-!! Book1 and book2 ( routine ADVECTION )
-!!
-!! AUTHOR
-!! ------
-!! J. Vila & JP. Lafore *Meteo-France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 27/10/94
-!! Stein 27/06/96 add the budgets
-!! Pinty 20/12/96 update the budgets
-!! Lafore 27/03/98 call to DFLUX_CORR
-!! Lafore 01/04/98 FCT only on total water (rv+rc+ri) and
-!! precipitating hydrometeors,
-!! remove 4D flux local arrays
-!! Stein 20/04/99 remove KMI from the list of argument of DFLUX_CORR
-!! Masson 07/11/02 update the budgets
-!! Lac 24/04/06 split meteorological and passive tracer routines
-!! 05/06 Remove KEPS
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET
-USE MODI_SHUMAN
-USE MODI_DFLUX_CORR
-USE MODI_BUDGET
-USE MODD_GRID_n
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariant component of
- ! momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JRR
- ! Loop index
-!
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) &
- :: ZFX ,ZFY ,ZFZ ! Advective flux components for each
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
- ZRTFX,ZRTFY,ZRTFZ ! variables and for total water (rv+rc+ri)
-!
-REAL :: ZMINR,ZMINTKE
- ! Absolute minimum values of
- ! water substances, TKE
-!-------------------------------------------------------------------------------
-!
-!* 1. FLUX-CORRECTED TRANSPORT ADVECTION SCHEME for the HMET group
-!
-!
-!* 1.1 Temperature: ---> advected by a CEN scheme
- ! NB! It is not necessary to make the
- ! flux correction since temperature is
- ! always positive.
-!
-!
- PRTHS(:,:,:) = PRTHS(:,:,:) &
- - DXF(PRUCT(:,:,:)*MXM (PTHT(:,:,:)))
- IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVX_BU_RTH')
-!
- PRTHS(:,:,:) = PRTHS(:,:,:) &
- - DYF(PRVCT(:,:,:)*MYM (PTHT(:,:,:)))
- IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVY_BU_RTH')
-!
- PRTHS(:,:,:) = PRTHS(:,:,:) &
- - DZF(PRWCT(:,:,:)*MZM (PTHT(:,:,:)))
- IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVZ_BU_RTH')
-!
-!* 1.2 No condensation case: Vapor ---> advected by a FCT scheme
-!
- ZMINR=0. ! Absolute minimum water substances
-!
- IF (KRR == 1) THEN
- CALL DFLUX_CORR (HLBCX, HLBCY, PTSTEP, ZMINR, PRHODJ, &
- PRM(:,:,:,1), PRT(:,:,:,1), &
- PRUCT, PRVCT, PRWCT, &
- ZFX(:,:,:), ZFY(:,:,:), ZFZ(:,:,:) )
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DXF(ZFX(:,:,:))
- IF (LBUDGET_RV) &
- CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVX_BU_RRV')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DYF(ZFY(:,:,:))
- IF (LBUDGET_RV) &
- CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVY_BU_RRV')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(ZFZ(:,:,:))
- IF (LBUDGET_RV) &
- CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
- END IF
-!
-!* 1.3 No ice case: rv+rc ---> advected by the FCT scheme
-! rc ---> advected by the CEN scheme
-!
- IF (KRR == 2 .OR. KRR == 3 ) THEN
- CALL DFLUX_CORR (HLBCX,HLBCY,PTSTEP,ZMINR,PRHODJ, &
- PRM(:,:,:,1)+PRM(:,:,:,2),PRT(:,:,:,1)+PRT(:,:,:,2), &
- PRUCT, PRVCT, PRWCT, &
- ZRTFX(:,:,:),ZRTFY(:,:,:),ZRTFZ(:,:,:) )
-!
- ZFX(:,:,:) = PRUCT(:,:,:) * MXM (PRT(:,:,:,2)) !
- ZFY(:,:,:) = PRVCT(:,:,:) * MYM (PRT(:,:,:,2)) ! CENtred scheme for rc
- ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (PRT(:,:,:,2)) !
-!
- ZRTFX(:,:,:) = ZRTFX(:,:,:) - ZFX(:,:,:) !
- ZRTFY(:,:,:) = ZRTFY(:,:,:) - ZFY(:,:,:) ! rv fluxes deduction
- ZRTFZ(:,:,:) = ZRTFZ(:,:,:) - ZFZ(:,:,:) !
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DXF(ZRTFX(:,:,:))
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DXF( ZFX(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVX_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVX_BU_RRC')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DYF(ZRTFY(:,:,:))
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DYF( ZFY(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVY_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVY_BU_RRC')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(ZRTFZ(:,:,:))
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DZF( ZFZ(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVZ_BU_RRC')
-!
- END IF
-!
-!* 1.4 Ice case: rv+rc+ri ---> advected by the FCT scheme
-! rc ---> advected by the CEN scheme
-! ri ---> advected by the CEN scheme
-!
- IF ( KRR >= 4 ) THEN
- CALL DFLUX_CORR (HLBCX,HLBCY,PTSTEP,ZMINR,PRHODJ, &
- PRM(:,:,:,1)+PRM(:,:,:,2)+PRM(:,:,:,4), &
- PRT(:,:,:,1)+PRT(:,:,:,2)+PRT(:,:,:,4), &
- PRUCT, PRVCT, PRWCT, &
- ZRTFX(:,:,:),ZRTFY(:,:,:),ZRTFZ(:,:,:) )
-!
- ZFX(:,:,:) = PRUCT(:,:,:) * MXM (PRT(:,:,:,2)) !
- ZFY(:,:,:) = PRVCT(:,:,:) * MYM (PRT(:,:,:,2)) ! CENtred scheme for rc
- ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (PRT(:,:,:,2)) !
-!
- ZRTFX(:,:,:) = ZRTFX(:,:,:) - ZFX(:,:,:) !
- ZRTFY(:,:,:) = ZRTFY(:,:,:) - ZFY(:,:,:) ! rv+ri fluxes deduction
- ZRTFZ(:,:,:) = ZRTFZ(:,:,:) - ZFZ(:,:,:) !
-!
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DXF( ZFX(:,:,:))
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVX_BU_RRC')
-!
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DYF( ZFY(:,:,:))
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVY_BU_RRC')
-!
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DZF( ZFZ(:,:,:))
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVZ_BU_RRC')
-!
-!
- ZFX(:,:,:) = PRUCT(:,:,:) * MXM (PRT(:,:,:,4)) !
- ZFY(:,:,:) = PRVCT(:,:,:) * MYM (PRT(:,:,:,4)) ! CENtred scheme for ri
- ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (PRT(:,:,:,4)) !
-!
- ZRTFX(:,:,:) = ZRTFX(:,:,:) - ZFX(:,:,:) !
- ZRTFY(:,:,:) = ZRTFY(:,:,:) - ZFY(:,:,:) ! rv fluxes deduction
- ZRTFZ(:,:,:) = ZRTFZ(:,:,:) - ZFZ(:,:,:) !
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DXF(ZRTFX(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - DXF( ZFX(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVX_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVX_BU_RRI')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DYF(ZRTFY(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - DYF( ZFY(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVY_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVY_BU_RRI')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(ZRTFZ(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - DZF( ZFZ(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVZ_BU_RRI')
-!
- END IF
-!
-!* 1.5 Rain case: rr ---> advected by the FCT scheme
-!
- IF ( KRR >= 3 ) THEN
- CALL DFLUX_CORR (HLBCX, HLBCY, &
- PTSTEP, ZMINR, PRHODJ, PRM(:,:,:,3), PRT(:,:,:,3), &
- PRUCT, PRVCT, PRWCT, &
- ZFX(:,:,:), ZFY(:,:,:), ZFZ(:,:,:) )
-!
- PRRS(:,:,:,3) = PRRS(:,:,:,3) - DXF( ZFX(:,:,:))
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVX_BU_RRR')
-!
- PRRS(:,:,:,3) = PRRS(:,:,:,3) - DYF( ZFY(:,:,:))
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVY_BU_RRR')
-!
- PRRS(:,:,:,3) = PRRS(:,:,:,3) - DZF( ZFZ(:,:,:))
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVZ_BU_RRR')
-!
- END IF
-!
-!* 1.6 Other hydrometeors: rs,rg,rh ---> advected by the FCT scheme
-!
- DO JRR = 5, KRR
- CALL DFLUX_CORR (HLBCX, HLBCY, &
- PTSTEP, ZMINR, PRHODJ, PRM(:,:,:,JRR), PRT(:,:,:,JRR), &
- PRUCT, PRVCT, PRWCT, &
- ZFX(:,:,:), ZFY(:,:,:), ZFZ(:,:,:) )
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) - DXF(ZFX(:,:,:))
- IF (JRR==5.AND.LBUDGET_RS) &
- CALL BUDGET (PRRS(:,:,:,5),10,'ADVX_BU_RRS')
- IF (JRR==6.AND.LBUDGET_RG) &
- CALL BUDGET (PRRS(:,:,:,6),11,'ADVX_BU_RRG')
- IF (JRR==7.AND.LBUDGET_RH) &
- CALL BUDGET (PRRS(:,:,:,7),12,'ADVX_BU_RRH')
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) - DYF(ZFY(:,:,:))
- IF (JRR==5.AND.LBUDGET_RS) &
- CALL BUDGET (PRRS(:,:,:,5),10,'ADVY_BU_RRS')
- IF (JRR==6.AND.LBUDGET_RG) &
- CALL BUDGET (PRRS(:,:,:,6),11,'ADVY_BU_RRG')
- IF (JRR==7.AND.LBUDGET_RH) &
- CALL BUDGET (PRRS(:,:,:,7),12,'ADVY_BU_RRH')
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) - DZF(ZFZ(:,:,:))
- IF (JRR==5.AND.LBUDGET_RS) &
- CALL BUDGET (PRRS(:,:,:,5),10,'ADVZ_BU_RRS')
- IF (JRR==6.AND.LBUDGET_RG) &
- CALL BUDGET (PRRS(:,:,:,6),11,'ADVZ_BU_RRG')
- IF (JRR==7.AND.LBUDGET_RH) &
- CALL BUDGET (PRRS(:,:,:,7),12,'ADVZ_BU_RRH')
-!
- END DO
-!
-!* 1.6 TKE ---> advected by the FCT scheme
-!
- IF (SIZE(PTKET,1) /= 0) THEN
-!
- ZMINTKE=0. ! Absolute minimum TKE
-!
- CALL DFLUX_CORR (HLBCX, HLBCY, &
- PTSTEP, ZMINTKE, PRHODJ, PTKEM,PTKET, &
- PRUCT, PRVCT, PRWCT, &
- ZFX(:,:,:), ZFY(:,:,:), ZFZ(:,:,:) )
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) - DXF(ZFX(:,:,:))
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVX_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) - DYF(ZFY(:,:,:))
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVY_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) - DZF(ZFZ(:,:,:))
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVZ_BU_RTKE')
-!
- END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE FCT_MET
diff --git a/src/MNH/fct_scalar.f90 b/src/MNH/fct_scalar.f90
deleted file mode 100644
index b37661bd0..000000000
--- a/src/MNH/fct_scalar.f90
+++ /dev/null
@@ -1,166 +0,0 @@
-!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.
-!-----------------------------------------------------------------
-! ######################
- MODULE MODI_FCT_SCALAR
-! ######################
-!
-INTERFACE
- SUBROUTINE FCT_SCALAR (HLBCX, HLBCY, KSV, &
- PTSTEP, PRHODJ, PSVM, PSVT, &
- PRUCT, PRVCT, PRWCT, PRSVS )
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariant component of
- ! momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-!
-END SUBROUTINE FCT_SCALAR
-!
-END INTERFACE
-!
-END MODULE MODI_FCT_SCALAR
-!
-!
-!
-! #####################################################################
- SUBROUTINE FCT_SCALAR (HLBCX, HLBCY, KSV, &
- PTSTEP, PRHODJ, PSVM, PSVT, &
- PRUCT, PRVCT, PRWCT, PRSVS )
-! #####################################################################
-!
-!!**** *FCT_SCALAR * - routine to call the Flux-Corrected Transport Scalar
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to call the FLUX-CORRected routine
-!! for scalar variables (tracers).
-!!
-!!** METHOD
-!! ------
-!! The Flux-Corrected Transport method correct the fluxes using a limiting
-!! factor. This method ensures that the advection scheme is definite
-!! positive. A minimum value of the scalar (MIN) equal to 0 is used for
-!! the positiveness of the scheme.
-!!
-!! EXTERNAL
-!! --------
-!! Functions MXM,MYM,MZM : computes the averages along three directins
-!! Functions DXF,DYF,DZF : computes the finite differences
-!! Subroutine FLUX_CORR : corrects the advective fluxes
-!! Subroutine BUDGET : stores the sources for budget purposes
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_BUDGET : LBU_R* ( individual budget switches)
-!! CBUTYPE, NBUMOD
-!! REFERENCE
-!! ---------
-!! Book1 and book2 ( routine ADVECTION )
-!!
-!! AUTHOR
-!! ------
-!! J. Vila & JP. Lafore *Meteo-France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 27/10/94
-!! Stein 27/06/96 add the budgets
-!! Pinty 20/12/96 update the budgets
-!! Lafore 27/03/98 call to DFLUX_CORR
-!! Lafore 01/04/98 FCT only on total water (rv+rc+ri) and
-!! precipitating hydrometeors,
-!! remove 4D flux local arrays
-!! Stein 20/04/99 remove KMI from the list of argument of DFLUX_CORR
-!! Jabouille 22/06/01 use XSVMIN
-!! Masson 07/11/02 update the budgets
-!! Lac 24/04/06 Split scalar and passive tracer routines
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET
-USE MODD_NSV, ONLY : XSVMIN
-USE MODD_GRID_n
-USE MODI_SHUMAN
-USE MODI_DFLUX_CORR
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariant component of
- ! momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JSV
- ! Loop index
-!
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
- :: ZFX ,ZFY ,ZFZ ! Advective flux components for each
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. FLUX-CORRECTED TRANSPORT ADVECTION SCHEME for the HSV group
-!
-!
-!
-!
- DO JSV = 1, KSV
- CALL DFLUX_CORR (HLBCX,HLBCY,PTSTEP,XSVMIN(JSV),PRHODJ, &
- PSVM(:,:,:,JSV),PSVT(:,:,:,JSV),PRUCT,PRVCT,PRWCT, &
- ZFX(:,:,:),ZFY(:,:,:),ZFZ(:,:,:) )
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - DXF(ZFX(:,:,:))
- IF (LBUDGET_SV) &
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVX_BU_RSV')
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - DYF(ZFY(:,:,:))
- IF (LBUDGET_SV) &
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVY_BU_RSV')
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - DZF(ZFZ(:,:,:))
- IF (LBUDGET_SV) &
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVZ_BU_RSV')
- END DO
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE FCT_SCALAR
diff --git a/src/MNH/ice4_sedimentation_split_old.f90 b/src/MNH/ice4_sedimentation_split_old.f90
deleted file mode 100644
index 47095b89e..000000000
--- a/src/MNH/ice4_sedimentation_split_old.f90
+++ /dev/null
@@ -1,463 +0,0 @@
-!MNH_LIC Copyright 1994-2019 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.
-!-----------------------------------------------------------------
-MODULE MODI_ICE4_SEDIMENTATION_SPLIT_OLD
-INTERFACE
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, KSPLITR, &
- &PSEA, PTOWN, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PINPRH, PRHT, PRHS, PFPR)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step integration for rain sedimendation
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD
-END INTERFACE
-END MODULE MODI_ICE4_SEDIMENTATION_SPLIT_OLD
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, KSPLITR, &
- &PSEA, PTOWN, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PINPRH, PRHT, PRHS, PFPR)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the sedimentation
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the plitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM
-
-USE MODE_MSG
-use mode_tools, only: Countjv
-
-USE MODI_BUDGET
-USE MODI_GAMMA
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step integration for rain sedimendation
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GSEDIM ! Test where to compute the SED processes
-INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
-
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D, & ! droplet condensation
- & ZRAY, & ! Cloud Mean radius
- & ZLBC, & ! XLBC weighted by sea fraction
- & ZFSEDC, &
- & ZPRCS,ZPRRS,ZPRIS,ZPRSS,ZPRGS,ZPRHS, & ! Mixing ratios created during the time step
- & ZW, & ! work array
- & ZRCT, &
- & ZRRT, &
- & ZRIT, &
- & ZRST, &
- & ZRGT, &
- & ZRHT
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) :: ZWSED ! sedimentation fluxes
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZCONC_TMP ! Weighted concentration
-REAL :: ZINVTSTEP
-INTEGER :: ISEDIM ! ! Case number of sedimentation
-REAL :: ZTSPLITR ! Small time step for rain sedimentation
-INTEGER :: JJ, JK, JN, JL
-!-------------------------------------------------------------------------------
-!
-!-------------------------------------------------------------------------------
-!
-!
-! O. Initialization of for sedimentation
-!
-ZINVTSTEP=1./PTSTEP
-ZTSPLITR=PTSTEP/REAL(KSPLITR)
-IF (OSEDIC) PINPRC (:,:) = 0.
-PINPRR (:,:) = 0.
-PINPRI (:,:) = 0.
-PINPRS (:,:) = 0.
-PINPRG (:,:) = 0.
-IF ( KRR == 7 ) PINPRH (:,:) = 0.
-!
-!* 1. Parameters for cloud sedimentation
-!
-IF (OSEDIC) THEN
- ZRAY(:,:,:) = 0.
- ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
-
- DO JK=KKTB, KKTE
- ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
- ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
- ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
- ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
- ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
- PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
- END DO
- ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
- ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
-ENDIF
-!
-!* 2. compute the fluxes
-!
-! optimization by looking for locations where
-! the precipitating fields are larger than a minimal value only !!!
-! For optimization we consider each variable separately
-!
-! External tendecies
-IF (OSEDIC) ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP
-ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP
-ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)* ZINVTSTEP
-ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP
-ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)* ZINVTSTEP
-IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)* ZINVTSTEP
-!
-! mr values inside the time-splitting loop
-ZRCT(:,:,:) = PRCT(:,:,:)
-ZRRT(:,:,:) = PRRT(:,:,:)
-ZRIT(:,:,:) = PRIT(:,:,:)
-ZRST(:,:,:) = PRST(:,:,:)
-ZRGT(:,:,:) = PRGT(:,:,:)
-IF (KRR==7) ZRHT(:,:,:) = PRHT(:,:,:)
-!
-DO JK = KKTB , KKTE
- ZW(:,:,JK) =ZTSPLITR/(PRHODREF(:,:,JK)* PDZZ(:,:,JK))
-END DO
-!
-DO JN = 1 , KSPLITR
- !We add part of the external tendencies
- IF (OSEDIC) ZRCT(:,:,:) = ZRCT(:,:,:) + ZPRCS(:,:,:)*ZTSPLITR
- ZRRT(:,:,:) = ZRRT(:,:,:) + ZPRRS(:,:,:)*ZTSPLITR
- ZRIT(:,:,:) = ZRIT(:,:,:) + ZPRIS(:,:,:)*ZTSPLITR
- ZRST(:,:,:) = ZRST(:,:,:) + ZPRSS(:,:,:)*ZTSPLITR
- ZRGT(:,:,:) = ZRGT(:,:,:) + ZPRGS(:,:,:)*ZTSPLITR
- IF (KRR==7) ZRHT(:,:,:) = ZRHT(:,:,:) + ZPRHS(:,:,:)*ZTSPLITR
- !
- !
- !* 2.1 for cloud
- !
- IF (OSEDIC) THEN
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRCT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(2)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &2, &
- &ZRCT, PRCS, ZWSED, &
- &ZRAY, ZLBC, ZFSEDC, ZCONC3D)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,2)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRC(:,:) = PINPRC(:,:) + ZWSED(:,:,KKB) / XRHOLW / KSPLITR
- END IF
- !
- !* 2.2 for rain
- !
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRRT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(3)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &3, &
- &ZRRT, PRRS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,3)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
- !
- !* 2.3 for pristine ice
- !
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRIT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(4)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &4, &
- &ZRIT, PRIS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,4)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRI(:,:) = PINPRI(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
- !
- !* 2.4 for aggregates/snow
- !
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRST(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(5)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &5, &
- &ZRST, PRSS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,5)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRS(:,:) = PINPRS(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
- !
- !* 2.5 for graupeln
- !
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRGT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(6)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &6, &
- &ZRGT, PRGS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,6)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRG(:,:) = PINPRG(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
- !
- !* 2.6 for hail
- !
- IF ( KRR == 7 ) THEN
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRHT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(7)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &7, &
- &ZRHT, PRHS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,7)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRH(:,:) = PINPRH(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
- END IF
- !
-END DO
-!
-!
-CONTAINS
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
- SUBROUTINE INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &KSEDIM, LDSEDIM, I1, I2, I3, &
- &PRHODREF, PTSORHODZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, PTOTAL_TSTEP, &
- &KSPE, &
- &PRXT, PRXS, PWSED, &
- &PRAY, PLBC, PFSEDC, PCONC3D)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- USE MODD_RAIN_ICE_DESCR
- USE MODD_RAIN_ICE_PARAM
- !
- IMPLICIT NONE
- !
- !* 0.1 Declarations of dummy arguments :
- !
- INTEGER, INTENT(IN) :: KIT, KJT, KKT, KKL
- INTEGER, INTENT(IN) :: KSEDIM
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LDSEDIM
- INTEGER, DIMENSION(KSEDIM), INTENT(IN) :: I1, I2, I3
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTSORHODZ ! TimeStep Over (Rhodref time delta Z)
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST
- REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
- REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT
- REAL, INTENT(IN) :: PTSTEP ! small timestep
- REAL, INTENT(IN) :: PTOTAL_TSTEP ! total timestep
- INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXT ! mr of specy X
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
- REAL, DIMENSION(KIT,KJT,0:KKT+1), INTENT(OUT) :: PWSED ! sedimentation flux
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
- !
- !* 0.2 declaration of local variables
- !
- !
- character(len=10) :: yspe ! String for error message
- INTEGER :: JK, JL, JI, JJ
- REAL :: ZINVTOTAL_TSTEP
- REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
- REAL :: ZFSED, ZEXSED
- REAL, DIMENSION(KIT, KJT) :: ZMRCHANGE
- !
- !-------------------------------------------------------------------------------
- !
- !
- !* 1. Parameters for cloud sedimentation
- !
- !
- !* 2. compute the fluxes
- !
- !
- ZINVTOTAL_TSTEP = 1./PTOTAL_TSTEP
- PWSED(:,:,:) = 0.
- IF(KSPE==2) THEN
- !******* for cloud
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / &
- (PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK))
- ZZWLBDC = ZZWLBDC**XLBEXC
- ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC
- ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/XP00)**(XRD/XCPD)
- ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15)
- ZZCC = XCC*(1.+1.26*ZZWLBDA/ZRAY)
- PWSED(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT +1 ) * &
- ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK)
- ENDDO
- ELSEIF(KSPE==4) THEN
- ! ******* for pristine ice
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI, JJ, JK) .GT. MAX(XRTMIN(4), 1.0E-7)) THEN
- PWSED(JI, JJ, JK) = XFSEDI * PRXT(JI, JJ, JK) * &
- & PRHODREF(JI,JJ,JK)**(1.-XCEXVT) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI
- ENDIF
- ENDDO
- ELSE
- ! ******* for other species
- IF(KSPE==3) THEN
- ZFSED=XFSEDR
- ZEXSED=XEXSEDR
- ELSEIF(KSPE==5) THEN
- ZFSED=XFSEDS
- ZEXSED=XEXSEDS
- ELSEIF(KSPE==6) THEN
- ZFSED=XFSEDG
- ZEXSED=XEXSEDG
- ELSEIF(KSPE==7) THEN
- ZFSED=XFSEDH
- ZEXSED=XEXSEDH
- ELSE
- write( yspe, '( I10 )' ) kspe
- call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT_OLD', &
- 'no sedimentation parameter for KSPE='//trim(yspe) )
- ENDIF
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- PWSED(JI, JJ, JK) = ZFSED * PRXT(JI, JJ, JK)**ZEXSED * &
- PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT)
- ENDDO
- ENDIF
- ZMRCHANGE(:,:) = 0.
- DO JK = KKTB , KKTE
- ZMRCHANGE(:,:) = PTSORHODZ(:,:,JK)*(PWSED(:,:,JK+KKL)-PWSED(:,:,JK))
- PRXT(:,:,JK) = PRXT(:,:,JK) + ZMRCHANGE(:,:)
- PRXS(:,:,JK) = PRXS(:,:,JK) + ZMRCHANGE(:,:) * ZINVTOTAL_TSTEP
- ENDDO
- END SUBROUTINE INTERNAL_SEDIM_SPLI
- !
-END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD
diff --git a/src/MNH/ice_c1r3.f90 b/src/MNH/ice_c1r3.f90
deleted file mode 100644
index 9d169e9e1..000000000
--- a/src/MNH/ice_c1r3.f90
+++ /dev/null
@@ -1,190 +0,0 @@
-!MNH_LIC Copyright 1996-2019 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.
-!-----------------------------------------------------------------
-! ######################
- MODULE MODI_ICE_C1R3
-! ######################
-!
-INTERFACE
- SUBROUTINE ICE_C1R3 (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PCCT, PCRT, PCIT, PCNS, PCCS, PCRS, PINS, PCIS, &
- PINPRS, PINPRG )
-!
-!
-!
-LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
- ! cloud ice sedimentation
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
- ! integration for ice sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel/hail m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCNS ! Cloud C. nuclei C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINS ! Ice nuclei C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-!
-END SUBROUTINE ICE_C1R3
-END INTERFACE
-END MODULE MODI_ICE_C1R3
-! ######################################################################
- SUBROUTINE ICE_C1R3 (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PCCT, PCRT, PCIT, PCNS, PCCS, PCRS, PINS, PCIS, &
- PINPRS, PINPRG )
-! ######################################################################
-!
-!!**** * - compute the explicit microphysical sources of cloud water and
-!! rain water concentrations and mixing ratios
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the microphysical sources:
-!! nucleation, sedimentation, autoconversion, accretion, self-collection
-!! and vaporisation which are parameterized according to Cohard and Pinty
-!! QJRMS, 2000
-!!
-!!
-!!** METHOD
-!! ------
-!! The activation of CCN is checked for quasi-saturated air parcels
-!! to update the cloud droplet number concentration. Then assuming a
-!! generalized gamma distribution law for the cloud droplets and the
-!! raindrops, the zeroth and third order moments tendencies are evaluated
-!! for all the coalescence terms by integrating the Stochastic Collection
-!! Equation. As autoconversion is a process that cannot be resolved
-!! analytically, the Berry-Reinhardt parameterisation is employed with
-!! modifications to initiate the raindrop spectrum mode. The integration
-!! of the raindrop evaporation of the raindrops below clouds is
-!! straightformward.
-!!
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process).
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!! Module MODD_CONF :
-!! CCONF configuration of the model for the first time step
-!!
-!! Module MODD_CST
-!! XP00 ! Reference pressure
-!! XRD,XRV ! Gaz constant for dry air, vapor
-!! XMD,XMV ! Molecular weight for dry air, vapor
-!! XCPD ! Cpd (dry air)
-!! XCL ! Cl (liquid)
-!! XTT ! Triple point temperature
-!! XLVTT ! Vaporization heat constant
-!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor pressure
-!! function over liquid water
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RTH : logical for budget of RTH (potential temperature)
-!! .TRUE. = budget of RTH
-!! .FALSE. = no budget of RTH
-!! LBU_RRV : logical for budget of RRV (water vapor)
-!! .TRUE. = budget of RRV
-!! .FALSE. = no budget of RRV
-!! LBU_RRC : logical for budget of RRC (cloud water)
-!! .TRUE. = budget of RRC
-!! .FALSE. = no budget of RRC
-!! LBU_RRR : logical for budget of RRR (rain water)
-!! .TRUE. = budget of RRR
-!! .FALSE. = no budget of RRR
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 31/12/96
-!! Jean-Pierre PINTY 7/ 4/01 Code cleaning
-!! Jean-Pierre PINTY 7/ 5/01 Bug correction in BERFI
-!! Jean-Pierre PINTY 17/ 5/01 Reset PINS=0 in case of IMLT
-!! Jean-Pierre PINTY 17/ 5/01 Bug in RRCFRIG and RICFRRG
-!! Jean-Pierre PINTY 29/ 5/01 Bug in RCHONI and graupel shedding
-!! Jean-Pierre PINTY 29/ 6/01 Bug in RCHONI and RVHNCI
-!! Jean-Pierre PINTY 29/ 6/01 Add RHHONI process (freezing haze part.)
-!! Jean-Pierre PINTY 13/ 9/01 Recode the RCHONI and RVHNCI processes
-!! Jean-Pierre PINTY 23/ 9/01 Recode the HM processes according to
-!! Beheng(1986) and Ovtchin. et al. (2000)
-!! and add the S to I conversion rate
-!! Jean-Pierre PINTY 1/10/01 Bug in RVHNCI
-!! Jean-Pierre PINTY 8/10/01 Revise limits in sedim. and review S->I
-!! Jean-Pierre PINTY 18/10/01 Revise Snow to Ice conversion
-!! Jean-Pierre PINTY 18/12/01 Revise Graupel wet growth (limitation)
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!!
-!-------------------------------------------------------------------------------
-!
-use mode_msg
-!
-call Print_msg(NVERB_FATAL,'GEN','ICE_C1R3','not yet developed')
-!
-END SUBROUTINE ICE_C1R3
diff --git a/src/MNH/ini_elec.f90 b/src/MNH/ini_elec.f90
deleted file mode 100644
index 0154ac6da..000000000
--- a/src/MNH/ini_elec.f90
+++ /dev/null
@@ -1,102 +0,0 @@
-!MNH_LIC Copyright 2002-2019 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.
-!-----------------------------------------------------------------
-! #########################################################
- SUBROUTINE INI_ELEC(KMI,TPINIFILE,PTSTEP,PDZMIN,KSPLITR, &
- PDXX,PDYY,PDZZ,PDZX,PDZY )
-! #########################################################
-!
-!!**** *INI_ELEC* - routine to initialize the electrical parameters
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to initialize the variables
-! of the atmospheric electricity scheme
-!
-!!** METHOD
-!! ------
-!! The initialization of the scheme is performed as follows :
-!!
-!! EXTERNAL
-!! --------
-!! CLEANLIST_ll : deaalocate a list
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation (routine INI_ELEC)
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 29/11/02
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_CONF
-USE MODD_CST
-USE MODD_DYN
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n
-USE MODD_NSV, ONLY: NSV, NSV_ELEC, NSV_ELECBEG, NSV_ELECEND
-USE MODD_PARAMETERS
-USE MODD_REF
-USE MODD_TIME
-!
-USE MODE_ll
-use mode_msg
-!
-USE MODI_INI_CLOUD
-!
-USE MODN_CONF_n
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KMI ! Model Index
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE! Initial file
-REAL, INTENT(IN) :: PTSTEP ! Time STEP
-!
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! integration for rain
- ! sedimendation
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: ILUOUT ! Logical unit number of output-listing
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. PROLOGUE
-! --------
-!
-!
-call Print_msg(NVERB_FATAL,'GEN','INI_ELEC','not yet developed')
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE INI_ELEC
diff --git a/src/MNH/init_for_convlfi.f90 b/src/MNH/init_for_convlfi.f90
deleted file mode 100644
index 733aa93ca..000000000
--- a/src/MNH/init_for_convlfi.f90
+++ /dev/null
@@ -1,277 +0,0 @@
-!MNH_LIC Copyright 1994-2019 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.
-!-----------------------------------------------------------------
-!###########################
-MODULE MODI_INIT_FOR_CONVLFI
-!###########################
-!
-!
-INTERFACE
- SUBROUTINE INIT_FOR_CONVLFI(TPINIFILE)
-!
-USE MODD_IO,ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! file being read
-!
-END SUBROUTINE INIT_FOR_CONVLFI
-END INTERFACE
-END MODULE MODI_INIT_FOR_CONVLFI
-!
-! ############################################
- SUBROUTINE INIT_FOR_CONVLFI(TPINIFILE)
-! ############################################
-!
-!!**** *INIT_FOR_CONVLFI * - light monitor to initialize the variables
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to initialize some variables
-! necessary in the conversion program.
-!
-!!** METHOD
-!! ------
-!! This initialization takes some parts of the whole initialization modules
-!! of monitor INIT:
-!! geometry and dimensions from ini_sizen
-!! grids, metric coefficients, dates and times from set_grid
-!! reading of the pressure field
-!!
-!!
-!! EXTERNAL
-!! --------
-!! INI_CST : to initialize physical constants
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! I. Mallet * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 20/02/01
-!! J.-P. Pinty and D. Gazen 31/03/04 Add the 2D capability for V5D plots
-!! 10/10/2011 J.Escobar call INI_PARAZ_ll
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_CST
-USE MODD_DIM_n
-USE MODD_FIELD_n
-USE MODD_GRID
-USE MODD_GRID_n
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_TIME
-USE MODD_TIME_n
-USE MODD_VAR_ll, ONLY: NPROC
-!
-USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
-USE MODE_TIME
-USE MODE_GRIDPROJ
-USE MODE_GRIDCART
-!
-USE MODE_GATHER_ll
-USE MODE_IO, only: IO_Pack_set
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_ll
-!
-USE MODI_INI_CST
-!JUANZ
-USE MODE_SPLITTINGZ_ll
-!JUANZ
-!
-IMPLICIT NONE
-!
-!* 0.1 Arguments variables
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! file being read
-!
-!* 0.2 Local variables
-!
-INTEGER :: IRESP
-CHARACTER (LEN=40) :: YTITLE ! Title for date print
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZJ ! Jacobian
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll ! Position x in the conformal
- ! plane (array on the complete domain)
-REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT_ll ! Position y in the conformal
- ! plane (array on the complete domain)
-REAL :: ZXHATM,ZYHATM ! coordinates of mass point
-REAL :: ZLATORI, ZLONORI ! lat and lon of left-bottom point
-!
-INTEGER :: IIU,IJU ! Upper dimension in x,y direction (local)
-INTEGER :: IKU ! Upper dimension in z direction
-INTEGER :: IINFO_ll ! return code of // routines
-INTEGER :: IID
-TYPE(TFIELDDATA) :: TZFIELD
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. INITIALIZE EACH MODEL SIZES AND DEPENDENCY (ini_sizen)
-! ------------------------------------------
-!
-!* 1.1 Read the geometry kind in the LFIFM file (Cartesian or spherical)
-!
-CALL IO_Field_read(TPINIFILE,'CARTESIAN',LCARTESIAN)
-!
-!* 1.2 Read configuration and dimensions in initial file and initialize
-! subdomain dimensions and parallel variables
-!
-CALL IO_Field_read(TPINIFILE,'IMAX',NIMAX_ll)
-CALL IO_Field_read(TPINIFILE,'JMAX',NJMAX_ll)
-!
-CALL IO_Field_read(TPINIFILE,'L1D',L1D,IRESP)
-IF (IRESP/=0) THEN
- L1D=.FALSE.
- IF( (NIMAX_ll == 1).AND.(NJMAX_ll == 1) ) L1D=.TRUE.
-ENDIF
-!
-CALL IO_Field_read(TPINIFILE,'L2D',L2D,IRESP)
-IF (IRESP/=0) THEN
- L2D=.FALSE.
- IF( (NIMAX_ll /= 1).AND.(NJMAX_ll == 1) ) L2D=.TRUE.
-ENDIF
-!
-CALL IO_Field_read(TPINIFILE,'PACK',LPACK,IRESP)
-IF (IRESP/=0) LPACK=.TRUE.
-!
-CALL IO_Pack_set(L1D,L2D,LPACK)
-!
-CALL IO_Field_read(TPINIFILE,'KMAX',NKMAX)
-!
-CSPLIT ='BSPLITTING' ; NHALO = 1
-CALL SET_SPLITTING_ll(CSPLIT)
-CALL SET_JP_ll(1,JPHEXT,JPVEXT, NHALO)
-CALL SET_DAD0_ll()
-CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
-CALL IO_Pack_set(L1D,L2D,LPACK)
-CALL SET_LBX_ll('OPEN', 1)
-CALL SET_LBY_ll('OPEN', 1)
-CALL SET_XRATIO_ll(1, 1)
-CALL SET_YRATIO_ll(1, 1)
-CALL SET_XOR_ll(1, 1)
-CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1)
-CALL SET_YOR_ll(1, 1)
-CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1)
-CALL SET_DAD_ll(0, 1)
-!JUANZ CALL INI_PARA_ll(IINFO_ll)
-CALL INI_PARAZ_ll(IINFO_ll)
-!
-!* 1.4 Compute sizes of arrays of the extended sub-domain (ini_modeln)
-!
-IKU=NKMAX + 2*JPVEXT
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. INITIALIZE GRIDS AND METRIC COEFFICIENTS (set_grid)
-! ---------------------
-!
-! 2.1 reading
-!
-CALL IO_Field_read(TPINIFILE,'LAT0',XLAT0)
-CALL IO_Field_read(TPINIFILE,'LON0',XLON0)
-CALL IO_Field_read(TPINIFILE,'BETA',XBETA)
-CALL IO_Field_read(TPINIFILE,'XHAT',XXHAT)
-CALL IO_Field_read(TPINIFILE,'YHAT',XYHAT)
-!
-IF (.NOT.LCARTESIAN) THEN
- CALL IO_Field_read(TPINIFILE,'RPK',XRPK)
- CALL IO_Field_read(TPINIFILE,'LONORI',XLONORI)
- CALL IO_Field_read(TPINIFILE,'LATORI',XLATORI)
- !
- IF (TPINIFILE%NMNHVERSION(1)<4 .OR. (TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)<=5)) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('LONORI',IID,IRESP)
- TZFIELD = TFIELDLIST(IID)
- TZFIELD%CMNHNAME = 'LONOR'
- CALL IO_Field_read(TPINIFILE,TZFIELD,XLONORI)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('LATORI',IID,IRESP)
- TZFIELD = TFIELDLIST(IID)
- TZFIELD%CMNHNAME = 'LATOR'
- CALL IO_Field_read(TPINIFILE,TZFIELD,XLATORI)
- !
- ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(NJMAX_ll+2 * JPHEXT))
- CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,IRESP) !//
- CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,IRESP) !//
- ZXHATM = - 0.5 * (ZXHAT_ll(1)+ZXHAT_ll(2))
- ZYHATM = - 0.5 * (ZYHAT_ll(1)+ZYHAT_ll(2))
- CALL SM_LATLON(XLATORI,XLONORI,ZXHATM,ZYHATM,ZLATORI,ZLONORI)
- DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
- XLATORI = ZLATORI
- XLONORI = ZLONORI
- END IF
-END IF
-!
-ALLOCATE(XZS(IIU,IJU))
-CALL IO_Field_read(TPINIFILE,'ZS',XZS,IRESP)
-IF (IRESP/=0) XZS(:,:)=0.
-!
-ALLOCATE(XZSMT(IIU,IJU))
-CALL IO_Field_read(TPINIFILE,'ZSMT',XZSMT,IRESP)
-IF (IRESP/=0) XZSMT(:,:)=XZS(:,:)
-!
-ALLOCATE(XZHAT(IKU))
-CALL IO_Field_read(TPINIFILE,'ZHAT',XZHAT)
-CALL IO_Field_read(TPINIFILE,'ZTOP',XZTOP)
-!
-CALL IO_Field_read(TPINIFILE,'SLEVE',LSLEVE,IRESP)
-IF (IRESP/=0) LSLEVE = .FALSE.
-!
-IF (LSLEVE) THEN
- CALL IO_Field_read(TPINIFILE,'LEN1',XLEN1)
- CALL IO_Field_read(TPINIFILE,'LEN2',XLEN2)
-END IF
-!
-CALL IO_Field_read(TPINIFILE,'DTEXP',TDTEXP)
-CALL IO_Field_read(TPINIFILE,'DTMOD',TDTMOD)
-CALL IO_Field_read(TPINIFILE,'DTSEG',TDTSEG)
-CALL IO_Field_read(TPINIFILE,'DTCUR',TDTCUR)
-!
-YTITLE='CURRENT DATE AND TIME'
-CALL SM_PRINT_TIME(TDTCUR,TLUOUT,YTITLE)
-!
-!* 2.2 Spatial grid
-!
-ALLOCATE(XDXHAT(IIU))
-ALLOCATE(XDYHAT(IJU))
-ALLOCATE(XZZ(IIU,IJU,IKU))
-ALLOCATE(ZJ(IIU,IJU,IKU))
-!
-CALL INI_CST
-!
-IF (LCARTESIAN) THEN
- CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,ZJ)
-ELSE
- ALLOCATE(XLON(IIU,IJU))
- ALLOCATE(XLAT(IIU,IJU))
- ALLOCATE(XMAP(IIU,IJU))
- CALL SM_GRIDPROJ(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, &
- XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,ZJ)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. INITIALIZE THE PROGNOSTIC AND SURFACE FIELDS (read_field)
-! --------------------------------------------
-ALLOCATE(XPABST(IIU,IJU,IKU))
-CALL IO_Field_read(TPINIFILE,'PABST',XPABST)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE INIT_FOR_CONVLFI
diff --git a/src/MNH/les_masksn.f90 b/src/MNH/les_masksn.f90
deleted file mode 100644
index 4add46bb6..000000000
--- a/src/MNH/les_masksn.f90
+++ /dev/null
@@ -1,188 +0,0 @@
-!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
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 les 2006/08/30 18:38:57
-!-----------------------------------------------------------------
-! ################
-MODULE MODI_LES_MASKS_n
-! ################
-!
-!
-!
-INTERFACE LES_MASKS_n
-!
- SUBROUTINE LES_MASKS_n(KTCOUNT)
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
-!
-END SUBROUTINE LES_MASKS_n
-!
-END INTERFACE
-!
-END MODULE MODI_LES_MASKS_n
-
-! #######################
- SUBROUTINE LES_MASKS_n(KTCOUNT)
-! #######################
-!
-!
-!!**** *LES_MASKS_n* initializes the LES variables for
-!! the current time-step of model _n
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/02/00
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_LES
-USE MODD_LES_n
-USE MODD_FIELD_n
-USE MODD_CONF_n
-USE MODD_TIME_n
-USE MODD_DYN_n
-USE MODD_TIME
-!
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
-!
-!
-! 0.2 declaration of local variables
-!
-INTEGER :: IXOR_ll, IYOR_ll ! origine point coordinates
-! ! of current processor domain
-! ! on model domain on all
-! ! processors
-INTEGER :: IIB_ll, IJB_ll ! SO point coordinates of
-! ! current processor phys. domain
-! ! on model domain on all
-! ! processors
-INTEGER :: IIE_ll, IJE_ll ! NE point coordinates of
-! ! current processor phys. domain
-! ! on model domain on all
-! ! processors
-INTEGER :: IIINF_MASK, IISUP_MASK ! cart. mask local proc. limits
-INTEGER :: IJINF_MASK, IJSUP_MASK ! cart. mask local proc. limits
-!
-INTEGER :: JK ! vertical loop counter
-INTEGER :: IIB, IJB, IIE, IJE ! hor. indices
-INTEGER :: IIU, IJU ! hor. indices
-INTEGER :: IKU ! ver. index
-INTEGER :: IRR, IRRC, IRRR, IRRI, IRRS, IRRG ! moist variables indices
-INTEGER :: IMI ! Current model index
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. Does current time-step is a LES time-step?
-! -----------------------------------------
-!
-LLES_CALL= .FALSE.
-!
-IF (.NOT. LLES) RETURN
-!
-IF ( KTCOUNT>1 .AND. MOD (KTCOUNT-1,NLES_DTCOUNT)==0) LLES_CALL=.TRUE.
-!
-IF (.NOT. LLES_CALL) RETURN
-!
-NLES_TCOUNT = NLES_TCOUNT + 1
-!
-NLES_CURRENT_TCOUNT = NLES_TCOUNT
-!
-!
-XLES_DATIME( 1,NLES_TCOUNT) = TDTEXP%TDATE%YEAR
-XLES_DATIME( 2,NLES_TCOUNT) = TDTEXP%TDATE%MONTH
-XLES_DATIME( 3,NLES_TCOUNT) = TDTEXP%TDATE%DAY
-XLES_DATIME( 4,NLES_TCOUNT) = TDTEXP%TIME
-XLES_DATIME( 5,NLES_TCOUNT) = TDTSEG%TDATE%YEAR
-XLES_DATIME( 6,NLES_TCOUNT) = TDTSEG%TDATE%MONTH
-XLES_DATIME( 7,NLES_TCOUNT) = TDTSEG%TDATE%DAY
-XLES_DATIME( 8,NLES_TCOUNT) = TDTSEG%TIME
-XLES_DATIME( 9,NLES_TCOUNT) = TDTMOD%TDATE%YEAR
-XLES_DATIME(10,NLES_TCOUNT) = TDTMOD%TDATE%MONTH
-XLES_DATIME(11,NLES_TCOUNT) = TDTMOD%TDATE%DAY
-XLES_DATIME(12,NLES_TCOUNT) = TDTMOD%TIME
-XLES_DATIME(13,NLES_TCOUNT) = TDTCUR%TDATE%YEAR
-XLES_DATIME(14,NLES_TCOUNT) = TDTCUR%TDATE%MONTH
-XLES_DATIME(15,NLES_TCOUNT) = TDTCUR%TDATE%DAY
-XLES_DATIME(16,NLES_TCOUNT) = TDTCUR%TIME
-!
-XLES_TRAJT(NLES_TCOUNT,1) = (KTCOUNT-1) * XTSTEP
-!
-!-------------------------------------------------------------------------------
-!
-CALL GET_OR_ll ('B',IXOR_ll,IYOR_ll)
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!
-IIB_ll=IXOR_ll+IIB-1
-IJB_ll=IYOR_ll+IJB-1
-IIE_ll=IXOR_ll+IIE-1
-IJE_ll=IYOR_ll+IJE-1
-!
-IKU = SIZE(XTHT,3)
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Definition of masks
-! -------------------
-!
-!* 2.1 Cartesian (sub-)domain (on local processor)
-! ----------------------
-!
-ALLOCATE(LLES_CURRENT_CART_MASK(IIU,IJU,NLES_K))
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-!
-IIINF_MASK = MAX(IIB, NLESn_IINF(IMI)-(IIB_ll-1-JPHEXT))
-IJINF_MASK = MAX(IJB, NLESn_JINF(IMI)-(IJB_ll-1-JPHEXT))
-IISUP_MASK = MIN(IIE, NLESn_ISUP(IMI)-(IIB_ll-1-JPHEXT))
-IJSUP_MASK = MIN(IJE, NLESn_JSUP(IMI)-(IJB_ll-1-JPHEXT))
-!
-LLES_CURRENT_CART_MASK(:,:,:) = .FALSE.
-LLES_CURRENT_CART_MASK(IIINF_MASK:IISUP_MASK,IJINF_MASK:IJSUP_MASK,:) = .TRUE.
-!
-CLES_CURRENT_LBCX(:) = CLES_LBCX(:,IMI)
-CLES_CURRENT_LBCY(:) = CLES_LBCY(:,IMI)
-!
-!
-!* 2.2 Cloud masks
-! -----------
-!
-CALL LES_CLOUD_MASKS_n
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LES_MASKS_n
diff --git a/src/MNH/lochead.f90 b/src/MNH/lochead.f90
deleted file mode 100644
index 5bb77e10e..000000000
--- a/src/MNH/lochead.f90
+++ /dev/null
@@ -1,184 +0,0 @@
-!MNH_LIC Copyright 1995-2019 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.
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_LOCHEAD
-! ###################
-INTERFACE
- SUBROUTINE LOCHEAD(PLATMIN,PLATMAX,PLONMIN,PLONMAX, &
- PGLBLATMIN,PGLBLATMAX,PGLBLONMIN,PGLBLONMAX, &
- KGLBNBLAT,KGLBNBLON,PCUTVAL,KSHIFT,KMAX, &
- HSAVEDDATAFILE,ODATASAVE )
-!
-REAL, INTENT(IN) :: PLATMIN ! min latitude of the local field.
-REAL, INTENT(IN) :: PLATMAX ! max latitude of the local field.
-REAL, INTENT(IN) :: PLONMIN ! min longitude of the local field.
-REAL, INTENT(IN) :: PLONMAX ! min longitude of the local field.
-REAL, INTENT(IN) :: PGLBLATMIN ! min latitude of the global file
-REAL, INTENT(IN) :: PGLBLATMAX ! max latitude of the global file
-REAL, INTENT(IN) :: PGLBLONMIN ! min longitude of the global file
-REAL, INTENT(IN) :: PGLBLONMAX ! max longitude of the global file
-INTEGER, INTENT(IN) :: KGLBNBLAT ! number of latitude rows in global file
-INTEGER, INTENT(IN) :: KGLBNBLON ! number of longitude rows in global file
-REAL, INTENT(IN) :: PCUTVAL ! special value in data file
-INTEGER, INTENT(OUT):: KSHIFT ! shift applied to longitude array
-INTEGER, INTENT(OUT):: KMAX ! maximum index of new longitude
-! ! array in local area
-CHARACTER(LEN=28), INTENT(IN) :: HSAVEDDATAFILE! Name of the local field file
-LOGICAL, INTENT(IN) :: ODATASAVE ! flag to save data on the local
-! ! field file
-!
-END SUBROUTINE LOCHEAD
-END INTERFACE
-END MODULE MODI_LOCHEAD
-!
-!
-! ################################################################
- SUBROUTINE LOCHEAD(PLATMIN,PLATMAX,PLONMIN,PLONMAX, &
- PGLBLATMIN,PGLBLATMAX,PGLBLONMIN,PGLBLONMAX, &
- KGLBNBLAT,KGLBNBLON,PCUTVAL,KSHIFT,KMAX, &
- HSAVEDDATAFILE,ODATASAVE )
-! ################################################################
-!
-!!**** *LOCHEAD* writes the head of a the local 'latlon' file.
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 29/08/95
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-REAL, INTENT(IN) :: PLATMIN ! min latitude of the local area
-REAL, INTENT(IN) :: PLATMAX ! max latitude of the local area
-REAL, INTENT(INOUT) :: PLONMIN ! min longitude of the local area
-REAL, INTENT(INOUT) :: PLONMAX ! min longitude of the local area
-REAL, INTENT(IN) :: PGLBLATMIN ! min latitude of the global file
-REAL, INTENT(IN) :: PGLBLATMAX ! max latitude of the global file
-REAL, INTENT(IN) :: PGLBLONMIN ! min longitude of the global file
-REAL, INTENT(IN) :: PGLBLONMAX ! max longitude of the global file
-INTEGER, INTENT(IN) :: KGLBNBLAT ! number of latitude rows in global file
-INTEGER, INTENT(IN) :: KGLBNBLON ! number of longitude rows in global file
-REAL, INTENT(IN) :: PCUTVAL ! special value in data file
-INTEGER, INTENT(OUT):: KSHIFT ! shift applied to longitude array
-INTEGER, INTENT(OUT):: KMAX ! maximum index of new longitude
-! ! array in local area
-CHARACTER(LEN=28), INTENT(IN) :: HSAVEDDATAFILE! Name of the local field file
-LOGICAL, INTENT(IN) :: ODATASAVE ! flag to save data on the local
-! ! field file
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: ISAVE ! logical unit
-INTEGER :: IRESP ! return code
-REAL, DIMENSION(KGLBNBLAT) :: Z1 ! latitudes of global field
-REAL, DIMENSION(KGLBNBLON) :: Z2 ! longitudes of global field
-REAL :: ZDLAT ! latitude mesh in the data file
-REAL :: ZDLON ! longitude mesh in the data file
-REAL :: Z1MIN ! min latitude of the local file
-REAL :: Z1MAX ! max latitude of the local file
-REAL :: Z2MIN ! min longitude of the local file
-REAL :: Z2MAX ! max longitude of the local file
-INTEGER, DIMENSION(1) :: INB1 ! number of lines in local file
-INTEGER, DIMENSION(1) :: INB2 ! number of columns in local file
-INTEGER :: JLAT ! loop control
-INTEGER :: JLON ! loop control
-TYPE(TFILEDATA),POINTER :: TZFILE
-!-------------------------------------------------------------------------------
-!
-IF (ODATASAVE) THEN
- CALL IO_File_find_byname(HSAVEDDATAFILE,TZFILE,IRESP)
- ISAVE = TZFILE%NLU
-END IF
-!
-ZDLAT=(PGLBLATMAX-PGLBLATMIN)/KGLBNBLAT
-ZDLON=(PGLBLONMAX-PGLBLONMIN)/KGLBNBLON
-!
-Z1(:)=(/ (PGLBLATMAX-(JLAT-0.5)*ZDLAT, JLAT=1,KGLBNBLAT) /)
-Z2(:)=(/ (PGLBLONMIN+(JLON-0.5)*ZDLON, JLON=1,KGLBNBLON) /)
-!
-IF (MINVAL(Z1)>PLATMAX .OR. MAXVAL(Z1)<PLATMIN) THEN
- KSHIFT=0
- RETURN
-END IF
-Z1MIN=MINVAL(Z1,MASK=(Z1>PLATMIN))-0.5*ZDLAT
-Z1MAX=MAXVAL(Z1,MASK=(Z1<PLATMAX))+0.5*ZDLAT
-INB1(:)=MINLOC(Z1,MASK=(Z1>PLATMIN)) &
- -MAXLOC(Z1,MASK=(Z1<PLATMAX)) +1
-!
-!* Computations on longitudes, shift of longitudes below PLONMIN
-!
-IF ( (PLONMAX+NINT((PGLBLONMIN-180.-PLONMIN)/360.)*360.<PGLBLONMIN) &
- .AND.(PLONMIN+NINT((PGLBLONMIN+180.-PLONMIN)/360.)*360.>PGLBLONMAX) ) THEN
- KMAX=0
- KSHIFT=0
-ELSE
- IF (PLONMAX+NINT((PGLBLONMIN-180.-PLONMIN)/360.)*360.>PGLBLONMIN) THEN
- Z2(:)=Z2(:)+NINT((PGLBLONMIN-180.-PLONMIN)/360.)*360.
- ELSE
- Z2(:)=Z2(:)+NINT((PGLBLONMIN+180.-PLONMIN)/360.)*360.
- END IF
- KSHIFT=COUNT(Z2(:)<PLONMIN)
- WHERE(Z2<PLONMIN)
- Z2=Z2+360.
- ENDWHERE
- Z2=CSHIFT(Z2,SHIFT=KSHIFT)
- INB2(:)=MAXLOC(Z2,MASK=(Z2<PLONMAX))
- KMAX=INB2(1)
- Z2MIN=MINVAL(Z2,MASK=(Z2>PLONMIN))-0.5*ZDLON
- Z2MAX=MAXVAL(Z2,MASK=(Z2<PLONMAX))+0.5*ZDLON
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF ( (KMAX>0) .AND. (INB1(1)>0) .AND. (ODATASAVE) ) THEN
- WRITE(ISAVE,*) 'local file ',HSAVEDDATAFILE
- WRITE(ISAVE,'(A8,F13.8)') 'nodata: ',PCUTVAL
- WRITE(ISAVE,'(A7,F13.8)') 'north: ',Z1MAX
- WRITE(ISAVE,'(A7,F13.8)') 'south: ',Z1MIN
- WRITE(ISAVE,'(A7,F13.8)') 'east: ', Z2MAX
- WRITE(ISAVE,'(A7,F13.8)') 'west: ', Z2MIN
- WRITE(ISAVE,'(A6,I7)') 'rows: ', INB1(1)
- WRITE(ISAVE,'(A6,I7)') 'cols: ', INB2(1)
-END IF
-!
-!-------------------------------------------------------------------------------
-END SUBROUTINE LOCHEAD
diff --git a/src/MNH/mean_prof.f90 b/src/MNH/mean_prof.f90
deleted file mode 100644
index 773ee9a8c..000000000
--- a/src/MNH/mean_prof.f90
+++ /dev/null
@@ -1,196 +0,0 @@
-!MNH_LIC Copyright 1997-2019 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.
-!-----------------------------------------------------------------
-! #####################
- MODULE MODI_MEAN_PROF
-! #####################
-INTERFACE
- SUBROUTINE MEAN_PROF(PVAR_MX,PZMASS_MX,PZS_LS,PCLIMGR,&
- PF_FREE,PZ_FREE)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR_MX ! thermodynamical field
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZMASS_MX ! mass points altitude
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS_LS ! large scale orography
-REAL, INTENT(IN) :: PCLIMGR ! climatological gradient
-! ! near the ground
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_FREE ! mean profile of the
-! ! thermodynamical field
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PZ_FREE ! discretization in x,y,z
-! ! of the profile on the
-! ! flat grid where zs is the
-! ! minimum of both orographies
-END SUBROUTINE MEAN_PROF
-END INTERFACE
-END MODULE MODI_MEAN_PROF
-! ##############################################################
- SUBROUTINE MEAN_PROF(PVAR_MX,PZMASS_MX,PZS_LS,PCLIMGR,&
- PF_FREE,PZ_FREE)
-! ##############################################################
-!
-!!**** *MEAN_PROF* - Computation of the profile of the free atmospheres
-!! i.e. without the Boundary layer structures
-!!
-!! PURPOSE
-!! -------
-!! This routine computes the profile used for the shift of a variable
-!! and the altitude of the discretization points of this profile.
-!
-!! CAUTION:
-!! The shift profile is only defined on the inner vertical points of the grid.
-!!
-!!** METHOD
-!! ------
-!! The profile is discretized on the vertical GS grid defined by
-!! the MESO-NH level array XZHAT and by a constant orography,
-!! corresponding to the minimum of the Arpege and MESO-NH orographies.
-!! If necessary, the profile is extrapolated under the minimum
-!! altitude of the Arpege orography with a climatological vertical
-!! gradient PCLIMGR (uniform on the whole domain).
-!!
-!! EXTERNAL
-!! --------
-!!
-!! function ZSECT : to compute the mean of a 3D field at a constant
-!! altitude
-!! Module MODI_ZSECT: contains interface for function ZSECT
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_CONF : contains configuration variables for all models.
-!! NVERB : verbosity level for output-listing
-!! Module MODD_LUNIT : contains logical unit names for all models
-!! TLUOUT0 : name of output-listing
-!! Module MODD_GRID1 : contains grid variables for model1
-!! XZS : orography of MESO-NH
-!! XZHAT : GS levels
-!! Module MODD_PARAMETERS
-!! JPVEXT
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 26/08/97
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CONF
-USE MODD_GRID_n
-USE MODD_LUNIT, ONLY: TLUOUT0
-USE MODD_PARAMETERS
-!
-USE MODI_ZSECT
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR_MX ! thermodynamical field
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZMASS_MX ! mass points altitude
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS_LS ! large scale orography
-REAL, INTENT(IN) :: PCLIMGR ! climatological gradient
-! ! near the ground
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_FREE ! mean profile of the
-! ! thermodynamical field
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PZ_FREE ! discretization in x,y,z
-! ! of the profile on the
-! ! flat grid where zs is the
-! ! minimum of both orographies
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: ILEVEL,IKB,IKE,ILB,ILE,JK
-REAL :: ZMIN
-REAL, DIMENSION(SIZE(PF_FREE,3)) :: ZF_FREE
-REAL, DIMENSION(SIZE(PZ_FREE,3)) :: ZZ_FREE
-!-------------------------------------------------------------------------------
-!
-!
-IKB=JPVEXT+1
-IKE=SIZE(PZ_FREE,3)-JPVEXT
-!
-!* 1. Computation of the altitude of the GS grid for the shift profile
-! ----------------------------------------------------------------
-!
-ZMIN=MIN(MINVAL(PZS_LS),MINVAL(XZS))
-ZZ_FREE(1:IKE)=ZMIN+0.5*(XZHAT(1:IKE)+XZHAT(2:IKE+1))*(1.-ZMIN/XZHAT(IKE+1))
-ZZ_FREE(IKE+1)=2.*XZHAT(IKE+1)-ZZ_FREE(IKE)
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Computation of the shift profile
-! --------------------------------
-!
-!* 2.1 Defined values
-! --------------
-!
-ZF_FREE(:)=-999.
-DO JK=IKB,IKE
- ZF_FREE(JK)=ZSECT(ZZ_FREE(JK),PZMASS_MX(:,:,IKB:IKE+1),&
- PVAR_MX(:,:,IKB:IKE+1))
-END DO
-!
-!* 2.2 Low levels values (extrapolation with constant gradient)
-! --------------------------------------------------------
-!
-ILEVEL=0
-DO JK=1,IKE
- IF (ABS(ZF_FREE(JK)+999.)<1.E-10) THEN
- ILEVEL=JK+1
- ELSE
- EXIT
- ENDIF
-ENDDO
-!
-DO JK=1,ILEVEL-1
- ZF_FREE(JK)=ZF_FREE(ILEVEL)&
- +PCLIMGR*(ZZ_FREE(JK)-ZZ_FREE(ILEVEL))
-ENDDO
-!
-!* 2.3 Upper levels values (linear extrapolation)
-! ------------------------------------------
-!
-ILEVEL=IKE+1
-DO JK=IKE+1,1,-1
- IF (ABS(ZF_FREE(JK)+999.)<1.E-10) THEN
- ILEVEL=JK-1
- ELSE
- EXIT
- ENDIF
-ENDDO
-!
-DO JK=IKE+1,ILEVEL+1
- ZF_FREE(JK)=ZF_FREE(ILEVEL) &
- +(ZF_FREE(ILEVEL)-ZF_FREE(ILEVEL-1)) &
- /(ZZ_FREE(ILEVEL)-ZZ_FREE(ILEVEL-1)) &
- *(ZZ_FREE(JK)-ZZ_FREE(ILEVEL))
-ENDDO
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. 3D output profiles arrays
-! -------------------------
-!
-PZ_FREE(:,:,:)=SPREAD(SPREAD(ZZ_FREE(:),1,SIZE(PZ_FREE,1)),2,SIZE(PZ_FREE,2))
-PF_FREE(:,:,:)=SPREAD(SPREAD(ZF_FREE(:),1,SIZE(PF_FREE,1)),2,SIZE(PF_FREE,2))
-!
-!-------------------------------------------------------------------------------
-!
-WRITE(TLUOUT0%NLU,*) 'Routine MEAN_PROF completed'
-!
-END SUBROUTINE MEAN_PROF
diff --git a/src/MNH/modd_type_allvar.f90 b/src/MNH/modd_type_allvar.f90
deleted file mode 100644
index b9c3b187c..000000000
--- a/src/MNH/modd_type_allvar.f90
+++ /dev/null
@@ -1,73 +0,0 @@
-!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
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modd 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###################
- MODULE MODD_TYPE_ALLVAR
-! ###################
-!
-!!**** *MODD_TYPE_ALLVAR* - Declaration des types de variables 3D, 2D, 1D,
-!!
-!! PURPOSE
-!! -------
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! P Jabouille
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 11/08/97
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-IMPLICIT NONE
-!
-TYPE X_Y_Z_
- CHARACTER(LEN=16) :: NAME
- INTEGER :: IGRID
- CHARACTER(LEN=16) :: UNITS
-END TYPE X_Y_Z_
-!
-TYPE X_Y_
- CHARACTER(LEN=16) :: NAME
- INTEGER :: IGRID
- CHARACTER(LEN=16) :: UNITS
-END TYPE X_Y_
-!
-TYPE VX_VY_VZ_
- CHARACTER(LEN=16),DIMENSION(3) :: NAME
- INTEGER,DIMENSION(3) :: IGRID
- CHARACTER(LEN=16),DIMENSION(3) :: UNITS
-END TYPE VX_VY_VZ_
-!
-TYPE VX_VY_
- CHARACTER(LEN=16),DIMENSION(3) :: NAME
- INTEGER,DIMENSION(3) :: IGRID
- CHARACTER(LEN=16),DIMENSION(3) :: UNITS
-END TYPE VX_VY_
-!
-TYPE Z_
- CHARACTER(LEN=16) :: NAME
- INTEGER :: IGRID
- CHARACTER(LEN=16) :: UNITS
-END TYPE Z_
-!
-END MODULE MODD_TYPE_ALLVAR
diff --git a/src/MNH/mpdata.f90 b/src/MNH/mpdata.f90
deleted file mode 100644
index 8b676d70d..000000000
--- a/src/MNH/mpdata.f90
+++ /dev/null
@@ -1,405 +0,0 @@
-!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.
-!-----------------------------------------------------------------
-! ##################
- MODULE MODI_MPDATA
-! ##################
-INTERFACE
- SUBROUTINE MPDATA (KLITER, HLBCX, HLBCY, KRR, &
- PTSTEP, PRHODJ, PTHM, PRM, PTKEM, &
- PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-!
-INTEGER, INTENT(IN) :: KLITER ! Number of iterations MPDATA
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT ! Contravariants
- ! components of the momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-END SUBROUTINE MPDATA
-!
-END INTERFACE
-!
-END MODULE MODI_MPDATA
-!
-!
-! ########################################################################
- SUBROUTINE MPDATA (KLITER, HLBCX, HLBCY, KRR, &
- PTSTEP, PRHODJ, PTHM, PRM, PTKEM, &
- PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-! ########################################################################
-!
-!!**** *MPDATA* - routine to compute the advection tendancies of the scalar
-!! fields using an upstream scheme. The excesive numerical
-!! correction of the scheme is corrected by means of an
-!! antidiffusive velocity.
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the total advection
-!! tendencies of all the scalar fields using the MPDATA scheme.
-!!
-!!** METHOD
-!! ------
-!! MPDATA solves the advection of a quantity in the following way
-!! 1.- 1st iteration. Upstream scheme.
-!! The quantity is advected by the contravariant
-!! velocities using an upstream scheme.
-!! 2.- 2nd and next iterations. The excessive diffusion
-!! of the upstream scheme is corrected by defining
-!! the antidiffusive velocities (ANTI_DIFF routine)
-!! and using for each iteration the upstream scheme.
-!! EXTERNAL
-!! --------
-!! ADD3DFIELD_ll : add a field to 3D-list
-!! CLEANLIST_ll : deallocate a list
-!! UPDATE_HALO_ll : update internal halos
-!! DXF,DYF,DZF : Shuman operators
-!! FXM,FYM,FZM : Flux operators
-!! ANTI_DIFF : antidiffusion
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book1 of documentation ( MPDATA scheme )
-!!
-!! AUTHOR
-!! ------
-!! J. Vila-Guerau * Meteo France*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/10/95
-!! J.-P. Pinty & J.-M. Cohard *LA* Add the budget calls
-!! J. Stein include the cyclic case
-!! P. Jabouille parallelization
-!! V. Masson 06/11/02 updates the budget calls
-!! 05/2006 Remove EPS
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-!
-USE MODD_BUDGET
-USE MODD_PARAMETERS
-!
-USE MODI_SHUMAN
-USE MODI_FLUX
-USE MODI_ANTI_DIFF
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KLITER ! Number of iterations MPDATA
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariants components momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JLITER ! Loop index for MPDATA iterations
-INTEGER :: JRR ! Loop index for moist variables
-!
-INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
-INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-!
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZGUESS ! Guess
- ! variable (to be removed in the future !)
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAUCT
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAVCT
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAWCT
- ! Antidiffusive contravariant component of the
- ! momentum
-!
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADV ! used
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVU ! for
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVV ! budget
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVW ! purpose
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRVARS ! only
-!
-CHARACTER (LEN=3) , DIMENSION(7) :: YRX
-CHARACTER (LEN=20) :: YBURX
-LOGICAL , DIMENSION(7) :: LBUDGET_R
-!
-INTEGER :: IINFO_ll ! return code of parallel routine
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-!-------------------------------------------------------------------------------
-!
-!-------------------------------------------------------------------------------
-!JUAN : init of TZFIELDS_ll
-NULLIFY(TZFIELDS_ll)
-!
-!* 0.3 PROLOGUE
-!
-CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
-!
-YRX(1) = 'RRV'
-YRX(2) = 'RRC'
-YRX(3) = 'RRR'
-YRX(4) = 'RRI'
-YRX(5) = 'RRS'
-YRX(6) = 'RRG'
-YRX(7) = 'RRH'
-!
-LBUDGET_R(1) = LBUDGET_RV
-LBUDGET_R(2) = LBUDGET_RC
-LBUDGET_R(3) = LBUDGET_RR
-LBUDGET_R(4) = LBUDGET_RI
-LBUDGET_R(5) = LBUDGET_RS
-LBUDGET_R(6) = LBUDGET_RG
-LBUDGET_R(7) = LBUDGET_RH
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!
-!* 1. Thermodynamical variable
-! -----------------------
-!
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PRTHS, 'MPDATA::PRTHS' )
-!
-!* 1st iteration (upstream scheme)
-!
- ZRVARS(:,:,:) = PRTHS(:,:,:)
- ZFADVU(:,:,:) = -DXF(FXM( PTHM(:,:,:),PRUCT(:,:,:) ) )
- ZFADVV(:,:,:) = -DYF(FYM( PTHM(:,:,:),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(FZM( PTHM(:,:,:),PRWCT(:,:,:) ) )
-!
- PRTHS(:,:,:) = PRTHS(:,:,:) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + ZFADVW(:,:,:)
-!
-!
-!* Iterations greater than 1
-!
- ZRAUCT(:,:,:)=PRUCT(:,:,:)
- ZRAVCT(:,:,:)=PRVCT(:,:,:)
- ZRAWCT(:,:,:)=PRWCT(:,:,:)
-!
- DO JLITER=2,KLITER
-!
-! update halo (and possibly periodize) the guess of the future time
-!
- CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-!
- CALL ANTI_DIFF(HLBCX,HLBCY,PTSTEP,PRHODJ,PRTHS,ZRAUCT,ZRAVCT,ZRAWCT)
-!
- ZGUESS(:,:,:)=PTSTEP*PRTHS/PRHODJ(:,:,:)
-!
- ZFADV(:,:,:) = -DXF(FXM( ZGUESS(:,:,:),ZRAUCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVU(:,:,:) = ZFADVU(:,:,:) + ZFADV(:,:,:)
- PRTHS(:,:,:) = PRTHS(:,:,:) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DYF(FYM( ZGUESS(:,:,:),ZRAVCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
- PRTHS(:,:,:) = PRTHS(:,:,:) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVW(:,:,:) = ZFADVW(:,:,:) + ZFADV(:,:,:)
- PRTHS(:,:,:) = PRTHS(:,:,:) + ZFADV(:,:,:)
-!
- END DO
-!
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!
- IF (LBUDGET_TH) THEN
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVU(:,:,:)
- CALL BUDGET (ZRVARS,4,'ADVX_BU_RTH')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVV(:,:,:)
- CALL BUDGET (ZRVARS,4,'ADVY_BU_RTH')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVW(:,:,:)
- CALL BUDGET (ZRVARS,4,'ADVZ_BU_RTH')
- END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Case with KRR water variables
-! -----------------------------
-!
- DO JRR=1,KRR
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PRRS(:,:,:,JRR), 'MPDATA::PRRS(:,:,:,JRR)' )
- ZRVARS(:,:,:) = PRRS(:,:,:,JRR)
- ZFADVU(:,:,:) = -DXF(FXM( PRM(:,:,:,JRR),PRUCT(:,:,:) ) )
- ZFADVV(:,:,:) = -DYF(FYM( PRM(:,:,:,JRR),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(FZM( PRM(:,:,:,JRR),PRWCT(:,:,:) ) )
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + &
- ZFADVW(:,:,:)
-!
- ZRAUCT(:,:,:)=PRUCT(:,:,:)
- ZRAVCT(:,:,:)=PRVCT(:,:,:)
- ZRAWCT(:,:,:)=PRWCT(:,:,:)
-!
- DO JLITER=2,KLITER
- CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-!
- CALL ANTI_DIFF(HLBCX,HLBCY,PTSTEP,PRHODJ,PRRS(:,:,:,JRR),ZRAUCT,ZRAVCT,ZRAWCT)
-!
- ZGUESS(:,:,:)=PTSTEP*PRRS(:,:,:,JRR)/PRHODJ(:,:,:)
-!
-!
- ZFADV(:,:,:) = -DXF(FXM( ZGUESS(:,:,:),ZRAUCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVU(:,:,:) = ZFADVU(:,:,:) + ZFADV(:,:,:)
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DYF(FYM( ZGUESS(:,:,:),ZRAVCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVW(:,:,:) = ZFADVW(:,:,:) + ZFADV(:,:,:)
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) + ZFADV(:,:,:)
- END DO
-!
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!
- IF (LBUDGET_R(JRR)) THEN
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVU(:,:,:)
- YBURX = 'ADVX_BU_'//YRX(JRR)
- CALL BUDGET (ZRVARS(:,:,:),JRR+5 ,YBURX)
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVV(:,:,:)
- YBURX = 'ADVY_BU_'//YRX(JRR)
- CALL BUDGET (ZRVARS(:,:,:),JRR+5 ,YBURX)
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVW(:,:,:)
- YBURX = 'ADVZ_BU_'//YRX(JRR)
- CALL BUDGET (ZRVARS(:,:,:),JRR+5 ,YBURX)
- END IF
- END DO
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. TKE variable
-! -------------
- IF (SIZE(PTKET,1) /= 0) THEN
-!
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PRTKES, 'MPDATA::PRTKES' )
- ZRVARS(:,:,:) = PRTKES(:,:,:)
- ZFADVU(:,:,:) = -DXF(FXM( PTKEM(:,:,:),PRUCT(:,:,:) ) )
- ZFADVV(:,:,:) = -DYF(FYM( PTKEM(:,:,:),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(FZM( PTKEM(:,:,:),PRWCT(:,:,:) ) )
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + ZFADVW(:,:,:)
-!
- ZRAUCT(:,:,:)=PRUCT(:,:,:)
- ZRAVCT(:,:,:)=PRVCT(:,:,:)
- ZRAWCT(:,:,:)=PRWCT(:,:,:)
-!
- DO JLITER=2,KLITER
- CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-!
- CALL ANTI_DIFF(HLBCX,HLBCY,PTSTEP,PRHODJ,PRTKES,ZRAUCT,ZRAVCT,ZRAWCT)
-!
- ZGUESS(:,:,:)=PTSTEP*PRTKES/PRHODJ(:,:,:)
-!
-!
- ZFADV(:,:,:) = -DXF(FXM( ZGUESS(:,:,:),ZRAUCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVU(:,:,:) = ZFADVU(:,:,:) + ZFADV(:,:,:)
- PRTKES(:,:,:) = PRTKES(:,:,:) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DYF(FYM( ZGUESS(:,:,:),ZRAVCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
- PRTKES(:,:,:) = PRTKES(:,:,:) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVW(:,:,:) = ZFADVW(:,:,:) + ZFADV(:,:,:)
- PRTKES(:,:,:) = PRTKES(:,:,:) + ZFADV(:,:,:)
- END DO
-!
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!
- IF (LBUDGET_TKE) THEN
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVU(:,:,:)
- CALL BUDGET (ZRVARS,5,'ADVX_BU_RTKE')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVV(:,:,:)
- CALL BUDGET (ZRVARS,5,'ADVY_BU_RTKE')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVW(:,:,:)
- CALL BUDGET (ZRVARS,5,'ADVZ_BU_RTKE')
- END IF
- END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE MPDATA
diff --git a/src/MNH/mpdata_scalar.f90 b/src/MNH/mpdata_scalar.f90
deleted file mode 100644
index 48b6e1215..000000000
--- a/src/MNH/mpdata_scalar.f90
+++ /dev/null
@@ -1,250 +0,0 @@
-!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.
-!-----------------------------------------------------------------
-! #########################
- MODULE MODI_MPDATA_SCALAR
-! #########################
-INTERFACE
- SUBROUTINE MPDATA_SCALAR ( KLITER, HLBCX, HLBCY, KSV, &
- PTSTEP, PRHODJ, PSVM, PSVT, &
- PRUCT, PRVCT, PRWCT, PRSVS )
-!
-INTEGER, INTENT(IN) :: KLITER ! Number of iterations MPDATA
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT ! Contravariants
- ! components of the momentum
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-END SUBROUTINE MPDATA_SCALAR
-!
-END INTERFACE
-!
-END MODULE MODI_MPDATA_SCALAR
-!
-!
-! ########################################################################
- SUBROUTINE MPDATA_SCALAR ( KLITER, HLBCX, HLBCY, KSV, &
- PTSTEP, PRHODJ, PSVM, PSVT, &
- PRUCT, PRVCT, PRWCT, PRSVS )
-! ########################################################################
-!
-!!**** *MPDATA_SCALAR* - routine to compute the advection tendancies of the scalar
-!! fields using an upstream scheme. The excesive numerical
-!! correction of the scheme is corrected by means of an
-!! antidiffusive velocity.
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the total advection
-!! tendencies of all the scalar fields using the MPDATA scheme.
-!!
-!!** METHOD
-!! ------
-!! MPDATA solves the advection of a quantity in the following way
-!! 1.- 1st iteration. Upstream scheme.
-!! The quantity is advected by the contravariant
-!! velocities using an upstream scheme.
-!! 2.- 2nd and next iterations. The excessive diffusion
-!! of the upstream scheme is corrected by defining
-!! the antidiffusive velocities (ANTI_DIFF routine)
-!! and using for each iteration the upstream scheme.
-!! EXTERNAL
-!! --------
-!! ADD3DFIELD_ll : add a field to 3D-list
-!! CLEANLIST_ll : deallocate a list
-!! UPDATE_HALO_ll : update internal halos
-!! DXF,DYF,DZF : Shuman operators
-!! FXM,FYM,FZM : Flux operators
-!! ANTI_DIFF : antidiffusion
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book1 of documentation ( MPDATA scheme )
-!!
-!! AUTHOR
-!! ------
-!! J. Vila-Guerau * Meteo France*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/10/95
-!! J.-P. Pinty & J.-M. Cohard *LA* Add the budget calls
-!! J. Stein include the cyclic case
-!! P. Jabouille parallelization
-!! V. Masson 06/11/02 updates the budget calls
-!! C.Lac Split meteorological scalar and tracer
-!! variables routines
-!! P.Tulet Upstream condition for aerosols
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-!
-USE MODD_BUDGET
-USE MODD_PARAMETERS
-USE MODD_NSV, ONLY : NSV_DSTBEG, NSV_DSTEND, NSV_AERBEG, NSV_AEREND,&
- NSV_SLTBEG, NSV_SLTEND
-!
-USE MODI_SHUMAN
-USE MODI_FLUX
-USE MODI_ANTI_DIFF
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KLITER ! Number of iterations MPDATA
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariants components momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JLITER ! Loop index for MPDATA iterations
-INTEGER :: JSV ! Loop index for Scalar Variables
-!
-INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
-INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-!
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: ZGUESS ! Guess
- ! variable (to be removed in the future !)
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAUCT
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAVCT
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAWCT
- ! Antidiffusive contravariant component of the
- ! momentum
-!
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADV ! used
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVU ! for
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVV ! budget
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVW ! purpose
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRVARS ! only
-!
-INTEGER :: IINFO_ll ! return code of parallel routine
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-!-------------------------------------------------------------------------------
-!
-!-------------------------------------------------------------------------------
-NULLIFY(TZFIELDS_ll)
-!
-!* 0. PROLOGUE
-!
-CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 1.- case with KSV Scalar Variables
-! --------------------------------
- DO JSV=1,KSV
-!
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PRSVS(:,:,:,JSV), 'MPDATA_SCALAR::PRSVS(:,:,:,JSV)' )
- ZRVARS(:,:,:) = PRSVS(:,:,:,JSV)
- ZFADVU(:,:,:) = -DXF(FXM( PSVM(:,:,:,JSV),PRUCT(:,:,:) ) )
- ZFADVV(:,:,:) = -DYF(FYM( PSVM(:,:,:,JSV),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(FZM( PSVM(:,:,:,JSV),PRWCT(:,:,:) ) )
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + &
- ZFADVW(:,:,:)
-!
- ZRAUCT(:,:,:)=PRUCT(:,:,:)
- ZRAVCT(:,:,:)=PRVCT(:,:,:)
- ZRAWCT(:,:,:)=PRWCT(:,:,:)
-!
-
-! ANTI_DIFF of MPDATA not suported by aerosols variables
- IF ((.NOT.((JSV .GE. NSV_AERBEG).AND.(JSV .LE. NSV_AEREND))).AND.&
- (.NOT.((JSV .GE. NSV_DSTBEG).AND.(JSV .LE. NSV_DSTEND))).AND.&
- (.NOT.((JSV .GE. NSV_SLTBEG).AND.(JSV .LE. NSV_SLTEND)))) THEN
-
- DO JLITER=2,KLITER
- CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-!
- CALL ANTI_DIFF(HLBCX,HLBCY,PTSTEP,PRHODJ,PRSVS(:,:,:,JSV),ZRAUCT,ZRAVCT,ZRAWCT)
-!
- ZGUESS(:,:,:)=PTSTEP*PRSVS(:,:,:,JSV)/PRHODJ(:,:,:)
-!
-!
- ZFADV(:,:,:) = -DXF(FXM( ZGUESS(:,:,:),ZRAUCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVU(:,:,:) = ZFADVU(:,:,:) + ZFADV(:,:,:)
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DYF(FYM( ZGUESS(:,:,:),ZRAVCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVW(:,:,:) = ZFADVW(:,:,:) + ZFADV(:,:,:)
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + ZFADV(:,:,:)
- END DO
- END IF
-!
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!
- IF (LBUDGET_SV) THEN
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVU(:,:,:)
- CALL BUDGET (ZRVARS,JSV+12,'ADVX_BU_RSV')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVV(:,:,:)
- CALL BUDGET (ZRVARS,JSV+12,'ADVY_BU_RSV')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVW(:,:,:)
- CALL BUDGET (ZRVARS,JSV+12,'ADVZ_BU_RSV')
- END IF
-!
- END DO
-
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE MPDATA_SCALAR
diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90
index 14b2b23d9..02cdc55d3 100644
--- a/src/MNH/prep_ideal_case.f90
+++ b/src/MNH/prep_ideal_case.f90
@@ -388,7 +388,6 @@ USE MODI_UPDATE_METRICS
USE MODI_SET_REF
USE MODI_SET_PERTURB
USE MODI_TOTAL_DMASS
-USE MODI_WGUESS
USE MODI_CH_INIT_SCHEME_n
USE MODI_CH_INIT_FIELD_n
USE MODI_INI_NSV
diff --git a/src/MNH/pressure.f90 b/src/MNH/pressure.f90
deleted file mode 100644
index f06d79f0a..000000000
--- a/src/MNH/pressure.f90
+++ /dev/null
@@ -1,687 +0,0 @@
-!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.
-!-----------------------------------------------------------------
-!###################
-MODULE MODI_PRESSURE
-!###################
-!
-INTERFACE
-!
- SUBROUTINE PRESSURE( &
- HLBCX,HLBCY,HPRESOPT,KITR,OITRADJ,KTCOUNT,PRELAX,KMI, &
- PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY,PDXHATM,PDYHATM,PRHOM, &
- PAF,PBF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY,PPABSM, &
- KRR,KRRL,KRRI,PDRYMASST,PREFMASS,PMASS_O_PHI0, &
- PTHT,PRT,PRHODREF,PTHVREF,PRVREF,PEXNREF,PLINMASS, &
- PRUS,PRVS,PRWS,PPABST,PRESIDUAL)
-!
-IMPLICIT NONE
-!
-CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX ! x-direction LBC type
-CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-CHARACTER (LEN=5), INTENT(IN) :: HPRESOPT ! choice of the pressure solver
-!
-INTEGER, INTENT(INOUT) :: KITR ! number of iterations for the
- ! pressure solver
-LOGICAL, INTENT(IN) :: OITRADJ ! switch to adjust or not KITR
-INTEGER, INTENT(IN) :: KTCOUNT ! counter value of the
- ! model temporal loop
-INTEGER, INTENT(IN) :: KMI ! Model index
-REAL, INTENT(IN) :: PRELAX ! relaxation coefficient for
- ! the Richardson's method
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference state
- ! * J
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY ! metric coefficients
-!
-REAL, INTENT(IN) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(IN) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(IN) :: PRHOM ! mean of XRHODJ on the plane x y
- ! localized at a mass level
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBF ! elements of the tri-diag.
- ! matrix in the pressure eq.
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(IN) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(IN) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(IN) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(IN) :: KIFAXY ! - along y
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! pressure (t-dt)
-!
-INTEGER, INTENT(IN) :: KRR ! Total number of water var.
-INTEGER, INTENT(IN) :: KRRL ! Number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! Number of ice water var.
-!
-REAL, INTENT(IN) :: PDRYMASST ! Mass of dry air and of
-REAL, INTENT(IN) :: PREFMASS ! the ref. atmosphere
-REAL, INTENT(IN) :: PMASS_O_PHI0 ! Mass / Phi0
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Temperature and water
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! variables at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry Density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVREF ! mixing ratio of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Exner function
- ! of the reference state
-REAL, INTENT(IN) :: PLINMASS ! lineic mass through
- ! open boundaries
-!
-REAL, INTENT(INOUT) :: PRUS(:,:,:) ! source term along x
-REAL, INTENT(INOUT) :: PRVS(:,:,:) ! source term along y
-REAL, INTENT(INOUT) :: PRWS(:,:,:) ! source term along z
-!
-REAL, INTENT(INOUT) :: PPABST(:,:,:) ! pressure(t)
-!JUAN
-REAL, OPTIONAL :: PRESIDUAL
-!JUAN
-!
-END SUBROUTINE PRESSURE
-!
-END INTERFACE
-!
-END MODULE MODI_PRESSURE
-! ######################################################################
- SUBROUTINE PRESSURE( &
- HLBCX,HLBCY,HPRESOPT,KITR,OITRADJ,KTCOUNT,PRELAX,KMI, &
- PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY,PDXHATM,PDYHATM,PRHOM, &
- PAF,PBF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY,PPABSM, &
- KRR,KRRL,KRRI,PDRYMASST,PREFMASS,PMASS_O_PHI0, &
- PTHT,PRT,PRHODREF,PTHVREF,PRVREF,PEXNREF,PLINMASS, &
- PRUS,PRVS,PRWS,PPABST,PRESIDUAL)
-! ######################################################################
-!
-!!**** *PRESSURE * - solve the pressure equation and add the pressure term
-!! to the sources
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to solve the pressure equation:
-! with either the conjugate gradient method or the Richardson's method.
-! The pressure gradient is added to the sources in order
-! to nullify the divergence of the momentum* Thetavref*(1+Rvref)
-! at the time t+dt.
-!
-!!** METHOD
-!! ------
-!! The divergence of the sources ( RHS of the pressure equation ) is
-!! computed. The pressure equation is then solved by either CG method,
-!! either Richardson's method, or an exact method. Finally, the pressure
-!! gradient is added to the sources RUS, RVS, RWS.
-!! Finally, the absolute pressure is diagnozed from the total mass
-!! included in the simulation domain.
-!!
-!! EXTERNAL
-!! --------
-!! Subroutine MASS_LEAK : assures global non-divergence condition in the
-!! case of open boundaries
-!! Subroutine FLAT_INV : solve the pressure equation for the case
-!! without orography
-!! Subroutine RICHARDSON: solve the pressure equation with the
-!! Richardson's method
-!! Subroutine CONJGRAD : solve the pressure equation with the Conjugate
-!! Gradient algorithm
-!! Function GX_M_U : compute the gradient along x
-!! Function GY_M_V : compute the gradient along y
-!! Function GZ_M_W : compute the gradient along z
-!! Subroutine GDIV : compute J times the divergence of 1/J times a vector
-!! Function MXM: compute an average in the x direction for a variable
-!! at a mass localization
-!! Function MYM: compute an average in the y direction for a variable
-!! at a mass localization
-!! Function MZM: compute an average in the z direction for a variable
-!! at a mass localization
-!! Subroutine P_ABS : compute the constant for PABS and therefore, the
-!! absolute pressure function
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CONF: model configuration
-!! LFLAT: logical switch for zero orography
-!! L2D : logical switch for two-dimensional configuration
-!! LCARTESIAN : logical switch for cartesian geometry
-!! Module MODD_PARAMETERS: declaration of parameter variables
-!! JPHEXT, JPVEXT: define the number of marginal points out of the
-!! physical domain along horizontal and vertical directions respectively
-!! Module MODD_CST: physical constants
-!! XCPD
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation (subroutine PRESSURE) + Book1 ( )
-!!
-!! AUTHOR
-!! ------
-!! P. Hereil and J. Stein * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 05/07/94
-!! Modification 03/01/95 (Lafore) To add the absolute pressure diagnosis
-!! Modification 31/01/95 (Stein) Copy of the pressure function in the
-!! 2D case in the two outermost planes
-!! Modification 16/02/95 (Mallet) Add the call to MASS_LEAK
-!! Modification 16/03/95 (Stein) change the argument list of the
-!! gradient and remove R from the historical var.
-!! Modification 30/06/95 (Stein) Add a test not to compute the absolute
-!! pressure in the Boussinesq case
-!! 16/10/95 (J. Stein) change the budget calls
-!! 29/01/96 (J. Stein) call iterative resolution for
-!! non-cartessian geometry
-!! 19/12/96 (J.-P. Pinty) update the budget calls
-!! 14/01/97 (Stein,Lafore) New anelastic equations
-!! 17/12/97 ( Stein )include the case of non-vanishing
-!! orography at the lbc
-!! 26/03/98 (Stein,Jabouille) fix the value of the corner point
-!! 15/06/98 (D.Lugato, R.Guivarch) Parallelisation
-!! 25/08/99 (J.-P. Pinty) add CRESI option to CPRESOPT
-!! 06/11/02 (V. Masson) update the budget calls
-!! 24/08/2005 (J. escobar) BUG : remove IIE+1, IJE+1 out of bound
-!! references in parallel run
-!! 08/2010 (V.Masson, C.Lac) Add UPDATE_HALO
-!! 11/2010 (V.Masson, C.Lac) PPABST, must not be cyclic => add temp array
-!! to save it before UPDATE_HALO
-!! 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
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_BUDGET
-USE MODD_CONF
-USE MODD_CST
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODI_MASS_LEAK
-USE MODI_GDIV
-USE MODI_FLAT_INV
-USE MODI_RICHARDSON
-USE MODI_CONJGRAD
-USE MODI_CONRESOL
-USE MODI_GRADIENT_M
-USE MODI_SHUMAN
-USE MODI_P_ABS
-USE MODI_BUDGET
-!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODE_ll
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
- CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX ! x-direction LBC type
- CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-CHARACTER (LEN=5), INTENT(IN) :: HPRESOPT ! choice of the pressure solver
-!
-INTEGER, INTENT(INOUT) :: KITR ! number of iterations for the
- ! pressure solver
-LOGICAL, INTENT(IN) :: OITRADJ ! switch to adjust or not KITR
-INTEGER, INTENT(IN) :: KTCOUNT ! counter value of the
- ! model temporal loop
-INTEGER, INTENT(IN) :: KMI ! Model index
-REAL, INTENT(IN) :: PRELAX ! relaxation coefficient for
- ! the Richardson's method
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference state
- ! * J
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY ! metric coefficients
-!
-REAL, INTENT(IN) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(IN) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(IN) :: PRHOM ! mean of XRHODJ on the plane x y
- ! localized at a mass level
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBF ! elements of the tri-diag.
- ! matrix in the pressure eq.
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(IN) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(IN) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(IN) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(IN) :: KIFAXY ! - along y
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! pressure (t-dt)
-!
-INTEGER, INTENT(IN) :: KRR ! Total number of water var.
-INTEGER, INTENT(IN) :: KRRL ! Number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! Number of ice water var.
-!
-REAL, INTENT(IN) :: PDRYMASST ! Mass of dry air and of
-REAL, INTENT(IN) :: PREFMASS ! the ref. atmosphere
-REAL, INTENT(IN) :: PMASS_O_PHI0 ! Mass / Phi0
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Temperature and water
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! variables at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry Density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVREF ! mixing ratio of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Exner function
- ! of the reference state
-REAL, INTENT(IN) :: PLINMASS ! lineic mass through
- ! open boundaries
-!
-REAL, INTENT(INOUT) :: PRUS(:,:,:) ! source term along x
-REAL, INTENT(INOUT) :: PRVS(:,:,:) ! source term along y
-REAL, INTENT(INOUT) :: PRWS(:,:,:) ! source term along z
-!
-REAL, INTENT(INOUT) :: PPABST(:,:,:) ! pressure(t)
-!JUAN
-REAL, OPTIONAL :: PRESIDUAL
-!JUAN
-!
-!
-!* 0.2 declarations of local variables
-!
-! Metric coefficients:
-!
-REAL, DIMENSION(SIZE(PPABSM,1),SIZE(PPABSM,2),SIZE(PPABSM,3)) :: ZDV_SOURCE
-! ! divergence of the sources
-!
-INTEGER :: IIB ! indice I for the first inner mass point along x
-INTEGER :: IIE ! indice I for the last inner mass point along x
-INTEGER :: IJB ! indice J for the first inner mass point along y
-INTEGER :: IJE ! indice J for the last inner mass point along y
-INTEGER :: IKB ! indice K for the first inner mass point along z
-INTEGER :: IKE ! indice K for the last inner mass point along z
-INTEGER :: ILUOUT ! Logical unit of output listing
-!
-REAL, DIMENSION(SIZE(PPABSM,1),SIZE(PPABSM,2),SIZE(PPABSM,3)) :: ZTHETAV, &
- ! virtual potential temperature
- ZPHIT
- ! MAE + DUR => Exner function perturbation
- ! LHE => Exner function perturbation * CPD * THVREF
-!
-REAL :: ZRV_OV_RD ! XRV / XRD
-REAL :: ZMAXVAL, ZMAXRES ! for print
-INTEGER, DIMENSION(3) :: IMAXLOC ! purpose
-INTEGER :: JWATER ! loop index on water species
-INTEGER :: IIU,IJU,IKU ! array sizes in I,J,K
-INTEGER :: JK ! loop index on the vertical levels
-INTEGER :: JI,JJ
-!
-REAL, DIMENSION(SIZE(PDXX,1),SIZE(PDXX,3)) :: ZPABS_S ! local pressure on southern side
-REAL, DIMENSION(SIZE(PDXX,1),SIZE(PDXX,3)) :: ZPABS_N ! local pressure on northern side
-REAL, DIMENSION(SIZE(PDYY,2),SIZE(PDXX,3)) :: ZPABS_E ! local pressure on eastern side
-REAL, DIMENSION(SIZE(PDYY,2),SIZE(PDXX,3)) :: ZPABS_W ! local pressure on western side
-INTEGER :: IINFO_ll
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-TYPE(LIST_ll), POINTER :: TZFIELDS_2_ll ! list of fields to exchange
-!
-!
-!------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-NULLIFY(TZFIELDS_ll)
-NULLIFY(TZFIELDS_2_ll)
-!
-!* 1. PRELIMINARIES
-! -------------
-!
-ILUOUT = TLUOUT%NLU
-!
-CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-!
-IKB= 1+JPVEXT
-IKU= SIZE(PPABSM,3)
-IKE= IKU - JPVEXT
-!
-ZPABS_S(:,:) = 0.
-ZPABS_N(:,:) = 0.
-ZPABS_E(:,:) = 0.
-ZPABS_W(:,:) = 0.
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE LINEIC MASS
-! -----------------------
-!
-IF ( ANY(HLBCX(:)=='OPEN') .OR. ANY(HLBCY(:)=='OPEN') ) THEN
- CALL MASS_LEAK(PDXX,PDYY,HLBCX,HLBCY,PLINMASS,PRHODJ,PRUS,PRVS)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. COMPUTE THE FORCING TERM FOR THE PRESSURE EQUATION
-! --------------------------------------------------
-!
-!
-CALL ADD3DFIELD_ll( TZFIELDS_ll, PRUS, 'PRESSURE::PRUS' )
-CALL ADD3DFIELD_ll( TZFIELDS_ll, PRVS, 'PRESSURE::PRVS' )
-CALL ADD3DFIELD_ll( TZFIELDS_ll, PRWS, 'PRESSURE::PRWS' )
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-!
-CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRUS,PRVS,PRWS,ZDV_SOURCE)
-!
-! The non-homogenous Neuman problem is transformed in an homogenous Neuman
-! problem in the non-periodic cases
-IF (HLBCX(1) /= 'CYCL') THEN
- IF (LWEST_ll()) ZDV_SOURCE(IIB-1,:,:) = 0.
- IF (LEAST_ll()) ZDV_SOURCE(IIE+1,:,:) = 0.
-ENDIF
-!
-IF (.NOT. L2D .AND. HLBCY(1) /= 'CYCL') THEN
- IF (LSOUTH_ll()) ZDV_SOURCE(:,IJB-1,:) = 0.
- IF (LNORTH_ll()) ZDV_SOURCE(:,IJE+1,:) = 0.
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. SOLVE THE PRESSURE EQUATION
-! ---------------------------
-!
-!
-!* 5.1 Compute the virtual theta and the pressure perturbation
-! -------------------------------------------------------
-!
-IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
- IF(KRR > 0) THEN
- !
- ! compute the ratio : 1 + total water mass / dry air mass
- ZRV_OV_RD = XRV / XRD
- ZTHETAV(:,:,:) = 1. + PRT(:,:,:,1)
- DO JWATER = 2 , 1+KRRL+KRRI
- ZTHETAV(:,:,:) = ZTHETAV(:,:,:) + PRT(:,:,:,JWATER)
- END DO
- ! compute the virtual potential temperature when water is present in any
- ! form
- ZTHETAV(:,:,:) = PTHT(:,:,:) * (1. + PRT(:,:,:,1) * ZRV_OV_RD) / ZTHETAV(:,:,:)
- ELSE
- ! compute the virtual potential temperature when water is absent
- ZTHETAV(:,:,:) = PTHT(:,:,:)
- END IF
- !
- ZPHIT(:,:,:)=(PPABSM(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)
- !
-ELSEIF(CEQNSYS=='LHE') THEN
- ZPHIT(:,:,:)= ((PPABSM(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)) &
- * XCPD * PTHVREF(:,:,:)
- !
-END IF
-!
-IF(CEQNSYS=='LHE'.AND. LFLAT .AND. LCARTESIAN) THEN
- ! flat cartesian LHE case -> exact solution
- !
- CALL FLAT_INV(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
- PTRIGSX,PTRIGSY,KIFAXX,KIFAXY,ZDV_SOURCE,ZPHIT)
-ELSE
- SELECT CASE(HPRESOPT)
- CASE('RICHA') ! Richardson's method
-!
- CALL RICHARDSON(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRHODJ,ZTHETAV, &
- PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF,PTRIGSX,PTRIGSY, &
- KIFAXX,KIFAXY,KITR,KTCOUNT,PRELAX,ZDV_SOURCE,ZPHIT)
-!
- CASE('CGRAD') ! Conjugate Gradient method
- CALL CONJGRAD(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRHODJ,ZTHETAV, &
- PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF,PTRIGSX,PTRIGSY, &
- KIFAXX,KIFAXY,KITR,ZDV_SOURCE,ZPHIT)
-!
- CASE('CRESI') ! Conjugate Residual method
- CALL CONRESOL(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRHODJ,ZTHETAV, &
- PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF,PTRIGSX,PTRIGSY, &
- KIFAXX,KIFAXY,KITR,ZDV_SOURCE,ZPHIT)
- END SELECT
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. ADD THE PRESSURE GRADIENT TO THE SOURCES
-! ----------------------------------------
-!
-IF ( HLBCX(1) /= 'CYCL' ) THEN
- IF(LWEST_ll()) ZPHIT(IIB-1,:,IKB-1) = ZPHIT(IIB,:,IKB-1)
- IF(LEAST_ll()) ZPHIT(IIE+1,:,IKB-1) = ZPHIT(IIE,:,IKB-1)
-ENDIF
-IF ( HLBCY(1) /= 'CYCL' ) THEN
- IF (LSOUTH_ll()) ZPHIT(:,IJB-1,IKB-1) = ZPHIT(:,IJB,IKB-1)
- IF (LNORTH_ll()) ZPHIT(:,IJE+1,IKB-1) = ZPHIT(:,IJE,IKB-1)
-ENDIF
-!
-IF ( L2D ) THEN
- IF (LSOUTH_ll()) ZPHIT(:,IJB-1,:) = ZPHIT(:,IJB,:)
- IF (LNORTH_ll()) ZPHIT(:,IJE+1,:) = ZPHIT(:,IJB,:)
-END IF
-!
-ZDV_SOURCE = GX_M_U(1,IKU,1,ZPHIT,PDXX,PDZZ,PDZX)
-!
-IF ( HLBCX(1) /= 'CYCL' ) THEN
- IF(LWEST_ll()) THEN
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
- DO JK=2,IKU-1
- ZDV_SOURCE(2,:,JK)= &
- (ZPHIT(2,:,JK) - ZPHIT(1,:,JK) - 0.5 * ( &
- PDZX(2,:,JK) * (ZPHIT(2,:,JK)-ZPHIT(2,:,JK-1)) / PDZZ(2,:,JK) &
- +PDZX(2,:,JK+1) * (ZPHIT(2,:,JK+1)-ZPHIT(2,:,JK)) / PDZZ(2,:,JK+1) &
- ) &
- ) / PDXX(2,:,JK)
- END DO
- ENDIF
- !
- IF(LEAST_ll()) THEN
- DO JK=2,IKU-1
- ZDV_SOURCE(IIU,:,JK)= &
- (ZPHIT(IIU,:,JK) - ZPHIT(IIU-1,:,JK) - 0.5 * ( &
- PDZX(IIU,:,JK) * (ZPHIT(IIU-1,:,JK)-ZPHIT(IIU-1,:,JK-1)) &
- / PDZZ(IIU-1,:,JK) &
- +PDZX(IIU,:,JK+1) * (ZPHIT(IIU-1,:,JK+1)-ZPHIT(IIU-1,:,JK)) &
- / PDZZ(IIU-1,:,JK+1) &
- ) &
- ) / PDXX(IIU,:,JK)
- END DO
- END IF
-END IF
-!
-IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
- PRUS = PRUS - MXM(PRHODJ * XCPD * ZTHETAV) * ZDV_SOURCE
- PRWS = PRWS - MZM(PRHODJ * XCPD * ZTHETAV) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
-ELSEIF(CEQNSYS=='LHE') THEN
- PRUS = PRUS - MXM(PRHODJ) * ZDV_SOURCE
- PRWS = PRWS - MZM(PRHODJ) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
-END IF
-!
-IF(.NOT. L2D) THEN
-!
- ZDV_SOURCE = GY_M_V(1,IKU,1,ZPHIT,PDYY,PDZZ,PDZY)
-!
- IF ( HLBCY(1) /= 'CYCL' ) THEN
- IF (LSOUTH_ll()) THEN
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
- DO JK=2,IKU-1
- ZDV_SOURCE(:,2,JK)= &
- (ZPHIT(:,2,JK) - ZPHIT(:,1,JK) - 0.5 * ( &
- PDZY(:,2,JK) * (ZPHIT(:,2,JK)-ZPHIT(:,2,JK-1)) / PDZZ(:,2,JK) &
- +PDZY(:,2,JK+1) * (ZPHIT(:,2,JK+1)-ZPHIT(:,2,JK)) / PDZZ(:,2,JK+1) &
- ) &
- ) / PDYY(:,2,JK)
- END DO
- END IF
- !
- IF (LNORTH_ll()) THEN
- DO JK=2,IKU-1
- ZDV_SOURCE(:,IJU,JK)= &
- (ZPHIT(:,IJU,JK) - ZPHIT(:,IJU-1,JK) - 0.5 * ( &
- PDZY(:,IJU,JK) * (ZPHIT(:,IJU-1,JK)-ZPHIT(:,IJU-1,JK-1)) &
- / PDZZ(:,IJU-1,JK) &
- +PDZY(:,IJU,JK+1) * (ZPHIT(:,IJU-1,JK+1)-ZPHIT(:,IJU-1,JK)) &
- / PDZZ(:,IJU-1,JK+1) &
- ) &
- ) / PDYY(:,IJU,JK)
- END DO
- END IF
- END IF
-!
- IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
- PRVS = PRVS - MYM(PRHODJ * XCPD * ZTHETAV) * ZDV_SOURCE
- ELSEIF(CEQNSYS=='LHE') THEN
- PRVS = PRVS - MYM(PRHODJ) * ZDV_SOURCE
- END IF
-END IF
-!
-!! same boundary conditions as in gdiv ... !! (provisory coding)
-!! (necessary when NVERB=1)
-DO JJ = IJB,IJE ! copy the horizontal components under
- DO JI = IIB,IIE
- PRUS(JI,JJ,IKB-1)=PRUS(JI,JJ,IKB)
- PRUS(JI,JJ,IKE+1)=PRUS(JI,JJ,IKE)
- END DO
-END DO
-!
-DO JJ = IJB,IJE
- DO JI = IIB,IIE ! the ground and above the top
- PRVS(JI,JJ,IKB-1)=PRVS(JI,JJ,IKB)
- PRVS(JI,JJ,IKE+1)=PRVS(JI,JJ,IKE)
- END DO
-END DO
-!!
-!
-! compute the residual divergence
-CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRUS,PRVS,PRWS,ZDV_SOURCE)
-!
-IF ( CEQNSYS=='DUR' ) THEN
- IF ( SIZE(PRVREF,1) == 0 ) THEN
- ZDV_SOURCE=ZDV_SOURCE/PRHODJ/XTH00*PRHODREF*PTHVREF
- ELSE
- ZDV_SOURCE=ZDV_SOURCE/PRHODJ/XTH00*PRHODREF*PTHVREF*(1.+PRVREF)
- END IF
-ELSEIF( CEQNSYS=='MAE' .OR. CEQNSYS=='LHE' ) THEN
- ZDV_SOURCE=ZDV_SOURCE/PRHODJ*PRHODREF
-END IF
-!
-ZMAXVAL=MAX_ll(ABS(ZDV_SOURCE),IINFO_ll)
-IF (PRESENT(PRESIDUAL)) PRESIDUAL = ZMAXVAL
-IMAXLOC=MAXLOC( ABS(ZDV_SOURCE(IIB:IIE,IJB:IJE,IKB:IKE))) !provisory coding one one processor only
-!
-WRITE(ILUOUT,*) 'residual divergence / 2 DT', ZMAXVAL, &
- ' located at ', IMAXLOC
-! number of iterations adjusted
-IF (LFLAT .AND. LCARTESIAN) THEN
- ZMAXRES = 1.E-12
-ELSE
- ZMAXRES = 1.E-9
-END IF
-!
-IF (OITRADJ) THEN
- IF (ZMAXVAL>10.*ZMAXRES) THEN
- KITR=KITR+2
- WRITE(ILUOUT,*) 'NITR adjusted to ', KITR
- ELSE IF (ZMAXVAL<ZMAXRES) THEN
- KITR=MAX(KITR-1,1)
- WRITE(ILUOUT,*) 'NITR adjusted to ', KITR
- ENDIF
-ENDIF
-!
-!* 7. STORAGE OF THE FIELDS IN BUDGET ARRAYS
-! --------------------------------------
-!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'PRES_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'PRES_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'PRES_BU_RW')
-!
-!-------------------------------------------------------------------------------
-!
-!* 8. ABSOLUTE PRESSURE COMPUTATION
-! -----------------------------
-!
-!IF ( ABS(PRHODREF(IIB,IJB,IKB)-PRHODREF(IIB,IJB,IKE)) > 1.E-16 &
-IF ( ABS(PRHODREF(IIB,IJB,IKB)-PRHODREF(IIB,IJB,IKE)) > 1.E-12 &
- .AND. KTCOUNT >0 ) THEN
- CALL P_ABS ( KRR, KRRL, KRRI, PDRYMASST, PREFMASS, PMASS_O_PHI0, &
- PTHT, PRT, PRHODJ, PRHODREF, ZTHETAV, PTHVREF, &
- PRVREF, PEXNREF, ZPHIT )
-!
- IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
- PPABST(:,:,:)=XP00*(ZPHIT+PEXNREF)**(XCPD/XRD)
- ELSEIF(CEQNSYS=='LHE') THEN
- PPABST(:,:,:)=XP00*(ZPHIT/(XCPD*PTHVREF)+PEXNREF)**(XCPD/XRD)
- ENDIF
-!
- IF( HLBCX(1) == 'CYCL' ) THEN
- IF (LWEST_ll()) THEN
- ZPABS_W(:,:)= PPABST(IIB,:,:)
- END IF
-!
- IF (LEAST_ll()) THEN
- ZPABS_E(:,:)= PPABST(IIE+1,:,:)
- END IF
-!
- END IF
-!
- IF( HLBCY(1) == 'CYCL' ) THEN
- IF (LSOUTH_ll()) THEN
- ZPABS_S(:,:)= PPABST(:,IJB,:)
- END IF
-!
- IF (LNORTH_ll()) THEN
- ZPABS_N(:,:)= PPABST(:,IJE+1,:)
- END IF
-!
- END IF
-!
- CALL ADD3DFIELD_ll( TZFIELDS_2_ll, PPABST, 'PRESSURE::PPABST' )
- CALL UPDATE_HALO_ll(TZFIELDS_2_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_2_ll)
-!
- IF( HLBCX(1) == 'CYCL' ) THEN
- IF (LWEST_ll()) THEN
- PPABST(IIB,:,:) = ZPABS_W(:,:)
- END IF
-!
- IF (LEAST_ll()) THEN
- PPABST(IIE+1,:,:) = ZPABS_E(:,:)
- END IF
-!
- END IF
-!
- IF( HLBCY(1) == 'CYCL' ) THEN
- IF (LSOUTH_ll()) THEN
- PPABST(:,IJB,:) = ZPABS_S(:,:)
- END IF
-!
- IF (LNORTH_ll()) THEN
- PPABST(:,IJE+1,:) = ZPABS_N(:,:)
- END IF
-!
- END IF
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE PRESSURE
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 68ae9f8b9..86d118fae 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -296,11 +296,9 @@ USE MODE_ll
!
USE MODI_BUDGET
USE MODI_C2R2_ADJUST
-USE MODI_C3R5_ADJUST
USE MODI_FAST_TERMS
USE MODI_GET_HALO
USE MODI_ICE_ADJUST
-USE MODI_ICE_C1R3
USE MODI_KHKO_NOTADJUST
USE MODI_LIMA
USE MODI_LIMA_ADJUST
diff --git a/src/MNH/select_std_pgd.f90 b/src/MNH/select_std_pgd.f90
deleted file mode 100644
index 355f99426..000000000
--- a/src/MNH/select_std_pgd.f90
+++ /dev/null
@@ -1,306 +0,0 @@
-!MNH_LIC Copyright 1997-2018 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.
-!-----------------------------------------------------------------
-! ##########################
- MODULE MODI_SELECT_STD_PGD
-! ##########################
-INTERFACE
- SUBROUTINE SELECT_STD_PGD(HFIELD_NAME,PFIELD)
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFIELD_NAME ! pgd field name
-REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD ! pgd field
-!
-END SUBROUTINE SELECT_STD_PGD
-END INTERFACE
-END MODULE MODI_SELECT_STD_PGD
-!
-! ######################################
- SUBROUTINE SELECT_STD_PGD(HFIELD_NAME,PFIELD)
-! ######################################
-!
-!!****
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 15/12/97
-!! F.Solmon 06/00 patch approach : Rq
-!! value of surface variable are atributed to NPT_USER class
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-USE MODD_LUNIT
-USE MODD_PGDFIELDS
-!
-!
-USE MODD_GROUND_PAR
-!
-!
-USE MODI_PGD_INDEX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFIELD_NAME ! pgd field name
-REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD ! pgd field
-!
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-!
-CHARACTER(LEN=20) :: YFIELD
-!
-!-------------------------------------------------------------------------------
-!
-YFIELD=' '
-YFIELD=HFIELD_NAME//YFIELD
-!
-SELECT CASE (YFIELD)
-!
-!* 1. Vegetation parameters
-! ---------------------
-!
-!
- CASE('VEG ')
- LNOCLASS_PGD0(PGD_INDEX('VEG'))=.TRUE.
- XPGDVEG(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('LAI ')
- LNOCLASS_PGD0(PGD_INDEX('LAI'))=.TRUE.
- XPGDLAI(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('RSMIN ')
- LNOCLASS_PGD0(PGD_INDEX('RSMIN'))=.TRUE.
- XPGDRSMIN(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('GAMMA ')
- LNOCLASS_PGD0(PGD_INDEX('GAMMA'))=.TRUE.
- XPGDGAMMA(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('RGL ')
- LNOCLASS_PGD0(PGD_INDEX('RGL'))=.TRUE.
- XPGDRGL(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('CV ')
- LNOCLASS_PGD0(PGD_INDEX('CV'))=.TRUE.
- XPGDCV(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('DG2 ')
- LNOCLASS_PGD0(PGD_INDEX('DG2'))=.TRUE.
- XPGDDG(:,:,2,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('DG3 ')
- LNOCLASS_PGD0(PGD_INDEX('DG3'))=.TRUE.
- XPGDDG(:,:,3,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('Z0VEG ')
- LNOCLASS_PGD0(PGD_INDEX('Z0VEG'))=.TRUE.
- XPGDZ0VEG(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('Z0HVEG ')
- LNOCLASS_PGD0(PGD_INDEX('Z0HVEG'))=.TRUE.
- XPGDZ0HVEG(:,:,NPT_USER) = PFIELD (:,:)
-
- CASE('ALBNIR_ECO ')
- LNOCLASS_PGD0(PGD_INDEX('ALBNIR_ECO'))=.TRUE.
- XPGDALBNIR_ECO(:,:,NPT_USER) = PFIELD (:,:)
-!
- CASE('ALBVIS_ECO ')
- LNOCLASS_PGD0(PGD_INDEX('ALBVIS_ECO'))=.TRUE.
- XPGDALBVIS_ECO(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('EMIS_ECO ')
- LNOCLASS_PGD0(PGD_INDEX('EMIS_ECO'))=.TRUE.
- XPGDEMIS_ECO(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('GMES ')
- LNOCLASS_PGD0(PGD_INDEX('GMES'))=.TRUE.
- XPGDGMES(:,:,NPT_USER) =PFIELD (:,:)
-
-!
- CASE('BSLAI ')
- LNOCLASS_PGD0(PGD_INDEX('BSLAI'))=.TRUE.
- XPGDBSLAI(:,:,NPT_USER) =PFIELD (:,:)
-
-!
- CASE('LAIMIN ')
- LNOCLASS_PGD0(PGD_INDEX('LAIMIN'))=.TRUE.
- XPGDLAIMIN(:,:,NPT_USER) =PFIELD (:,:)
-
-!
- CASE('SEFOLD ')
- LNOCLASS_PGD0(PGD_INDEX('SEFOLD'))=.TRUE.
- XPGDSEFOLD(:,:,NPT_USER) =PFIELD (:,:)
-
-!
- CASE('H_TREE ')
- LNOCLASS_PGD0(PGD_INDEX('H_TREE'))=.TRUE.
- XPGDH_TREE(:,:,NPT_USER) =PFIELD (:,:)
-
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Town parameters
-! ---------------
-!
- CASE('Z0_TOWN ')
- LNOCLASS_PGD0(PGD_INDEX('Z0_TOWN'))=.TRUE.
- XPGDZ0_TOWN(:,:) = PFIELD (:,:)
-!
- CASE('ALBNIR_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('ALBNIR_ROOF'))=.TRUE.
- XPGDALBNIR_ROOF(:,:) = PFIELD (:,:)
-!
- CASE('ALBVIS_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('ALBVIS_ROOF'))=.TRUE.
- XPGDALBVIS_ROOF(:,:) = PFIELD (:,:)
-!
- CASE('EMIS_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('EMIS_ROOF'))=.TRUE.
- XPGDEMIS_ROOF(:,:) = PFIELD (:,:)
-!
- CASE('HC_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('HC_ROOF'))=.TRUE.
- XPGDHC_ROOF(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDHC_ROOF,3))
-!
- CASE('TC_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('TC_ROOF'))=.TRUE.
- XPGDTC_ROOF(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDTC_ROOF,3))
-!
- CASE('D_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('D_ROOF'))=.TRUE.
- XPGDD_ROOF(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDD_ROOF,3))
-!
- CASE('ALBNIR_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('ALBNIR_ROAD'))=.TRUE.
- XPGDALBNIR_ROAD(:,:) = PFIELD (:,:)
-!
- CASE('ALBVIS_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('ALBVIS_ROAD'))=.TRUE.
- XPGDALBVIS_ROAD(:,:) = PFIELD (:,:)
-!
- CASE('EMIS_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('EMIS_ROAD'))=.TRUE.
- XPGDEMIS_ROAD(:,:) = PFIELD (:,:)
-!
- CASE('HC_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('HC_ROAD'))=.TRUE.
- XPGDHC_ROAD(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDHC_ROAD,3))
-!
- CASE('TC_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('TC_ROAD'))=.TRUE.
- XPGDTC_ROAD(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDTC_ROAD,3))
-!
- CASE('D_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('D_ROAD'))=.TRUE.
- XPGDD_ROAD(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDD_ROAD,3))
-!
- CASE('ALBNIR_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('ALBNIR_WALL'))=.TRUE.
- XPGDALBNIR_WALL(:,:) = PFIELD (:,:)
-!
- CASE('ALBVIS_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('ALBVIS_WALL'))=.TRUE.
- XPGDALBVIS_WALL(:,:) = PFIELD (:,:)
-!
- CASE('EMIS_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('EMIS_WALL'))=.TRUE.
- XPGDEMIS_WALL(:,:) = PFIELD (:,:)
-!
- CASE('HC_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('HC_WALL'))=.TRUE.
- XPGDHC_WALL(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDHC_WALL,3))
-!
- CASE('TC_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('TC_WALL'))=.TRUE.
- XPGDTC_WALL(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDTC_WALL,3))
-!
- CASE('D_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('D_WALL'))=.TRUE.
- XPGDD_WALL(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDD_WALL,3))
-!
- CASE('BLD ')
- LNOCLASS_PGD0(PGD_INDEX('BLD'))=.TRUE.
- XPGDBLD(:,:) = PFIELD (:,:)
-!
- CASE('BLD_HEIGHT ')
- LNOCLASS_PGD0(PGD_INDEX('BLD_HEIGHT'))=.TRUE.
- XPGDBLD_HEIGHT(:,:) = PFIELD (:,:)
-!
- CASE('BLD_HL_RATIO ')
- LNOCLASS_PGD0(PGD_INDEX('BLD_HL_RATIO'))=.TRUE.
- XPGDBLD_HL_RATIO(:,:) = PFIELD (:,:)
-!
- CASE('CAN_HW_RATIO ')
- LNOCLASS_PGD0(PGD_INDEX('CAN_HW_RATIO'))=.TRUE.
- XPGDCAN_HW_RATIO(:,:) = PFIELD (:,:)
-!
- CASE('H_TRAFFIC ')
- LNOCLASS_PGD0(PGD_INDEX('H_TRAFFIC'))=.TRUE.
- XPGDH_TRAFFIC(:,:) = PFIELD (:,:)
-!
- CASE('LE_TRAFFIC ')
- LNOCLASS_PGD0(PGD_INDEX('LE_TRAFFIC'))=.TRUE.
- XPGDLE_TRAFFIC(:,:) = PFIELD (:,:)
-!
- CASE('H_INDUSTRY ')
- LNOCLASS_PGD0(PGD_INDEX('H_INDUSTRY'))=.TRUE.
- XPGDH_INDUSTRY(:,:) = PFIELD (:,:)
-!
- CASE('LE_INDUSTRY ')
- LNOCLASS_PGD0(PGD_INDEX('LE_INDUSTRY'))=.TRUE.
- XPGDLE_INDUSTRY(:,:) = PFIELD (:,:)
-!
-!-------------------------------------------------------------------------------
-!
- CASE DEFAULT
-
- PRINT*, ' '
- PRINT*, 'The field ',HFIELD_NAME, ' is not yet a standard PGD field.'
- PRINT*, 'IT WILL NOT BE SAVED ON THE PGD FILE.'
- PRINT*, ' '
-
-END SELECT
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SELECT_STD_PGD
diff --git a/src/MNH/trid.f90 b/src/MNH/trid.f90
deleted file mode 100644
index db2600ee0..000000000
--- a/src/MNH/trid.f90
+++ /dev/null
@@ -1,645 +0,0 @@
-!MNH_LIC Copyright 1994-2019 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.
-!-----------------------------------------------------------------
-! ################
- MODULE MODI_TRID
-! ################
-!
-INTERFACE
-!
- SUBROUTINE TRID(HLBCX,HLBCY, &
- PMAP,PDXHAT,PDYHAT,PDXHATM,PDYHATM,PRHOM, &
- PAF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY, &
- PRHODJ,PTHVREF,PZZ,PBFY )
-!
-IMPLICIT NONE
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! x-direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference * J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
- ! Temperature of the reference state
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! scale factor
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
-!
-REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
-REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
-!
-REAL, INTENT(OUT) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(OUT) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(OUT) :: PRHOM ! mean of XRHODJ on the plane
- ! x y localized at a mass
- ! level
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBFY ! elements (yslice) of the tri-diag.
- ! matrix in the pressure eq.
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXY ! - along y
-
-!
-END SUBROUTINE TRID
-!
-END INTERFACE
-!
-END MODULE MODI_TRID
-!
-! ###################################################################
- SUBROUTINE TRID(HLBCX,HLBCY, &
- PMAP,PDXHAT,PDYHAT,PDXHATM,PDYHATM,PRHOM, &
- PAF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY, &
- PRHODJ,PTHVREF,PZZ,PBFY )
-! ####################################################################
-!
-!!**** *TRID * - Compute coefficients for the flat operator
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical time independent
-! coefficients a(k), b(k), c(k) required for the calculation of the "flat"
-! (i.e. neglecting the orography) operator Laplacian. RHOJ is averaged on
-! the whole horizontal domain. The form of the eigenvalues of the flat
-! operator depends on the lateral boundary conditions. Furthermore, this
-! routine initializes TRIGS and IFAX arrays required for the FFT transform
-! used in the routine PRECOND.
-!
-!!** METHOD
-!! ------
-!! The forms of the eigenvalues of the horizontal Laplacian are given by:
-!! Cyclic conditions:
-!! -----------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( imax ) <dyy> <dyy> ( jmax )
-!!
-!! Open conditions:
-!! -----------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( 2imax ) <dyy> <dyy> ( 2jmax )
-!!
-!! Cyclic condition along x and open condition along y:
-!! ------------------------------------------------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( imax ) <dyy> <dyy> ( 2jmax )
-!!
-!! Open condition along x and cyclic condition along y:
-!! ------------------------------------------------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( 2imax ) <dyy> <dyy> ( jmax )
-!!
-!! where m = 0,1,2....imax-1, n = 0,1,2....jmax-1
-!! Note that rhoj contains the Jacobian J = Deltax*Deltay*Deltaz = volume of
-!! an elementary mesh.
-
-!!
-!! EXTERNAL
-!! --------
-!! Function FFTFAX: initialization of TRIGSX,IFAXX,TRIGSY,IFAXY for
-!! the FFT transform
-!! GET_DIM_EXT_ll : get extended sub-domain sizes
-!! GET_INDICE_ll : get physical sub-domain bounds
-!! GET_DIM_PHYS_ll : get physical sub-domain sizes
-!! GET_GLOBALDIMS_ll : get physical global domain sizes
-!! GET_OR_ll : get origine coordonates of the physical sub-domain in global indices
-!! REDUCESUM_ll : sum into a scalar variable
-!! GET_SLICE_ll : get a slice of the global domain
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : define constants
-!! XPI : pi
-!! XCPD
-!! Module MODD_PARAMETERS: declaration of parameter variables
-!! JPHEXT, JPVEXT: define the number of marginal points out of the
-!! physical domain along horizontal and vertical directions respectively
-!! Module MODD_CONF: model configurations
-!! LCARTESIAN: logical for CARTESIAN geometry
-!! .TRUE. = Cartesian geometry used
-!! L2D: logical for 2D model version
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation (routine TRID)
-!!
-!! AUTHOR
-!! ------
-!! P. HÃ…reil and J. Stein * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 25/07/94
-!! 14/04/95 (J. Stein) bug in the ZDZM computation
-!! ( stretched case)
-!! 8/07/96 (P. Jabouille) change the FFT initialization
-!! which now works for odd number.
-!! 14/01/97 Durran anelastic equation (Stein,Lafore)
-!! 15/06/98 (D.Lugato, R.Guivarch) Parallelisation
-!! 10/08/98 (N. Asencio) add parallel code
-!! use PDXHAT, PDYHAT and not PXHAT,PYHAT
-!! PBFY is initialized
-!! 20/08/00 (J. Stein, J. Escobar) optimisation of the solver
-!! PBFY transposition
-!! 14/03/02 (P. Jabouille) set values for meaningless spectral coefficients
-!! (to avoid problem in bouissinesq configuration)
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_CST
-USE MODD_CONF
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAMETERS
-!
-USE MODE_ll
-USE MODE_MSG
-!
-!JUAN
-USE MODE_REPRO_SUM
-!JUAN
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! x-direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference * J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
- ! Temperature of the reference state
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! scale factor
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
-!
-REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
-REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
-!
-REAL, INTENT(OUT) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(OUT) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(OUT) :: PRHOM ! mean of XRHODJ on the plane
- ! x y localized at a mass
- ! level
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBFY ! elements (yslice) of the tri-diag.
-! matrix in the pressure eq. which is transposed. PBFY is a y-slices structure
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXY ! - along y
-
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IRESP ! FM return code
-INTEGER :: ILUOUT ! Logical unit number for
- ! output-listing
-INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! indice values of the physical subdomain
-INTEGER :: IKU ! size of the arrays along z
-INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll ! indice values of the physical global domain
-INTEGER :: IIMAX,IJMAX ! Number of points of the physical subdomain
-INTEGER :: IIMAX_ll,IJMAX_ll ! Number of points of Global physical domain
-!
-INTEGER :: JI,JJ,JK ! loop indexes
-!
-INTEGER :: INN ! temporary result for the computation of array TRIGS
-!
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZEIGEN_ll ! eigenvalues b(m,n) in global representation
-REAL, DIMENSION (:), ALLOCATABLE :: ZEIGENX_ll ! used for the computation of ZEIGEN_ll
-!
-REAL, DIMENSION( SIZE(PDXHAT)) :: ZWORKX ! work array to compute PDXHATM
-REAL, DIMENSION( SIZE(PDYHAT)) :: ZWORKY ! work array to compute PDYHATM
-!
-REAL :: ZGWNX,ZGWNY ! greater wave numbers allowed by the model
- ! configuration in x and y directions respectively
-!
-REAL, DIMENSION (SIZE(PZZ,3)) :: ZDZM ! mean of deltaz on the plane x y
- ! localized at a w-level
-!
-REAL :: ZANGLE,ZDEL ! needed for the initialization of the arrays used by the FFT
-!
-REAL :: ZINVMEAN ! inverse of inner points number in an horizontal grid
-!
-INTEGER :: IINFO_ll ! return code of parallel routine
-REAL, DIMENSION (SIZE(PMAP,1)) :: ZXMAP ! extraction of PMAP array along x
-REAL, DIMENSION (SIZE(PMAP,2)) :: ZYMAP ! extraction of PMAP array along y
-INTEGER :: IORXY_ll,IORYY_ll ! origin's coordinates of the y-slices subdomain
-INTEGER :: IIUY_ll,IJUY_ll ! dimensions of the y-slices subdomain
-INTEGER :: IXMODE_ll,IYMODE_ll ! number of modes in the x and y direction for global point of view
-INTEGER :: IXMODEY_ll,IYMODEY_ll ! number of modes in the x and y direction for y_slice point of view
-!JUAN16
-!TYPE(DOUBLE_DOUBLE) , DIMENSION (SIZE(PZZ,3)) :: ZRHOM_ll , ZDZM_ll
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZRHOM_2D , ZDZM_2D
-!JUAN16
-!
-!
-!
-!
-!
-!------------------------------------------------------------------------------
-!
-!* 1. INITIALIZATION
-! --------------
-!
-!* 1.1 retrieve a logical unit number
-! ------------------------------
-!
-ILUOUT = TLUOUT%NLU
-!
-!* 1.2 compute loop bounds
-! -------------------
-!
-! extended sub-domain
-CALL GET_DIM_EXT_ll ('Y',IIUY_ll,IJUY_ll)
-IKU=SIZE(PRHODJ,3)
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1 +JPVEXT
-IKE=IKU -JPVEXT
-! physical sub-domain
-CALL GET_DIM_PHYS_ll ( 'B',IIMAX,IJMAX)
-!
-! global physical domain limits
-CALL GET_GLOBALDIMS_ll ( IIMAX_ll, IJMAX_ll)
-IIB_ll = 1 + JPHEXT
-IIE_ll = IIMAX_ll + JPHEXT
-IJB_ll = 1 + JPHEXT
-IJE_ll = IJMAX_ll + JPHEXT
-!
-! the use of local array ZEIGENX and ZEIGEN would require some technical modifications
-!
-ALLOCATE (ZEIGENX_ll(IIMAX_ll + 2*JPHEXT))
-ALLOCATE (ZEIGEN_ll(IIMAX_ll + 2*JPHEXT, IJMAX_ll + 2*JPHEXT))
-ZEIGEN_ll = 0.0
-! Get the origin coordinates of the extended sub-domain in global landmarks
-CALL GET_OR_ll('Y',IORXY_ll,IORYY_ll)
-!
-!* 1.3 allocate x-slice array
-
-!
-!* 1.4 variables for the eigenvalues computation
-!
-ZGWNX = XPI/REAL(IIMAX_ll)
-ZGWNY = XPI/REAL(IJMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 2. COMPUTE THE AVERAGE OF RHOJ*CPD*THETAVREF ALONG XY
-! --------------------------------------------------
-!
-ZINVMEAN = 1./REAL(IIMAX_ll*IJMAX_ll)
-!JUAN16
-ALLOCATE(ZRHOM_2D(IIB:IIE, IJB:IJE))
-!
-DO JK = 1,SIZE(PZZ,3)
- IF ( CEQNSYS == 'DUR' .OR. CEQNSYS == 'MAE' ) THEN
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZRHOM_2D(JI,JJ) = PRHODJ(JI,JJ,JK)*XCPD*PTHVREF(JI,JJ,JK)*ZINVMEAN
- END DO
- END DO
- ELSEIF ( CEQNSYS == 'LHE' ) THEN
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZRHOM_2D(JI,JJ) = PRHODJ(JI,JJ,JK)*ZINVMEAN
- END DO
- END DO
- END IF
- ! global sum
- PRHOM(JK) = SUM_DD_R2_ll(ZRHOM_2D)
-END DO
-
-!
-! global sum
-!CALL REDUCESUM_ll(ZRHOM_ll,IINFO_ll)
-!PRHOM = ZRHOM_ll
-!JUAN16
-!
-!------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE MEAN INCREMENT BETWEEN Z LEVELS
-! -------------------------------------------
-!
-!JUAN16
-!ZDZM_ll = 0.
-ALLOCATE(ZDZM_2D(IIB:IIE, IJB:IJE))
-!
-DO JK = IKB-1,IKE
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZDZM_2D(JI,JJ) = (PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))*ZINVMEAN
- END DO
- END DO
- ZDZM(JK) = SUM_DD_R2_ll(ZDZM_2D)
-END DO
-ZDZM(IKE+1) = ZDZM(IKE)
-!
-! global sum
-!CALL REDUCESUM_ll(ZDZM_ll,IINFO_ll)
-!ZDZM = ZDZM_ll
-!JUAN16
-!
-!
-! vertical average to arrive at a w-level
-DO JK = IKE+1,IKB,-1
- ZDZM(JK) = (ZDZM(JK) + ZDZM(JK-1))*0.5
-END DO
-!
-ZDZM(IKB-1) = -999.
-!
-!------------------------------------------------------------------------------
-!
-!* 4. COMPUTE THE MEAN INCREMENT BETWEEN X LEVELS
-! -------------------------------------------
-!
-PDXHATM =0.
-! . local sum
-IF (LCARTESIAN) THEN
- PDXHATM = SUM_1DFIELD_ll ( PDXHAT,'X',IIB_ll,IIE_ll,IINFO_ll)
-ELSE
- ! Extraction of x-slice PMAP at j=(IJB_ll+IJE_ll)/2
- CALL GET_SLICE_ll (PMAP,'X',(IJB_ll+IJE_ll)/2,ZXMAP(IIB:IIE) &
- ,IIB,IIE,IINFO_ll)
- ! initialize the work array = PDXHAT/ZXMAP
- ZWORKX(IIB:IIE) = PDXHAT(IIB:IIE)/ ZXMAP (IIB:IIE)
- PDXHATM = SUM_1DFIELD_ll ( ZWORKX,'X',IIB_ll,IIE_ll,IINFO_ll)
-END IF
-! . division to complete sum
-PDXHATM = PDXHATM / REAL(IIMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 5. COMPUTE THE MEAN INCREMENT BETWEEN Y LEVELS
-! -------------------------------------------
-!
-PDYHATM = 0.
-IF (LCARTESIAN) THEN
- PDYHATM = SUM_1DFIELD_ll ( PDYHAT,'Y',IJB_ll,IJE_ll,IINFO_ll)
-ELSE
- ! Extraction of y-slice PMAP at i=IIB_ll+IIE_ll/2
- CALL GET_SLICE_ll (PMAP,'Y',(IIB_ll+IIE_ll)/2,ZYMAP(IJB:IJE) &
- ,IJB,IJE,IINFO_ll)
- ! initialize the work array = PDYHAT / ZYMAP
- ZWORKY(IJB:IJE) = PDYHAT(IJB:IJE) / ZYMAP (IJB:IJE)
- PDYHATM = SUM_1DFIELD_ll ( ZWORKY,'Y',IJB_ll,IJE_ll,IINFO_ll)
-END IF
-! . division to complete sum
-PDYHATM= PDYHATM / REAL(IJMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 6. COMPUTE THE OUT-DIAGONAL ELEMENTS A AND C OF THE MATRIX
-! -------------------------------------------------------
-!
-DO JK = IKB,IKE
- PAF(JK) = 0.5 * ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2
- PCF(JK) = 0.5 * ( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1) **2
-END DO
-!
-! at the upper and lower levels PAF and PCF are computed using the Neumann
-! conditions applying on the vertical component of the gradient
-!
-PAF(IKE+1) = -0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / ZDZM(IKE+1) **2
-PCF(IKB-1) = 0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / ZDZM(IKB) **2
-!
-PAF(IKB-1) = 999.
-PCF(IKE+1) = 999.
-!------------------------------------------------------------------------------
-!* 7. COMPUTE THE DIAGONAL ELEMENTS B OF THE MATRIX
-! ---------------------------------------------
-!
-!* 7.1 compute the horizontal eigenvalues
-!
-!
-!* 7.1.1 compute the eigenvalues along the x direction
-!
-SELECT CASE (HLBCX(1))
-! in the cyclic case, the eigenvalues are the same for two following JM values:
-! it corresponds to the real and complex parts of the FFT
- CASE('CYCL') ! cyclic case
- IXMODE_ll = IIMAX_ll+2
- IXMODEY_ll = IIUY_ll
-!
- DO JI = 1,IXMODE_ll
- ZEIGENX_ll(JI) = - ( 2. * SIN ( (JI-1)/2*ZGWNX ) / PDXHATM )**2
- END DO
- CASE DEFAULT ! other cases
- IXMODE_ll = IIMAX_ll
-!
-!
- IF (LEAST_ll(HSPLITTING='Y')) THEN
- IXMODEY_ll = IIUY_ll - 2
- ELSE
- IXMODEY_ll = IIUY_ll
- END IF
-!
-!
- DO JI = 1,IXMODE_ll
- ZEIGENX_ll(JI) = - ( 2. *SIN (0.5*REAL(JI-1)*ZGWNX ) / PDXHATM )**2
- END DO
-END SELECT
-!
-!* 7.1.2 compute the eventual eigenvalues along the y direction
-!
-IF (.NOT. L2D) THEN
-!
-! y lateral boundary conditions for three-dimensional cases
-!
- SELECT CASE (HLBCY(1))
-! in the cyclic case, the eigenvalues are the same for two following JN values:
-! it corresponds to the real and complex parts of the FFT result
-!
- CASE('CYCL') ! 3D cyclic case
- IYMODE_ll = IJMAX_ll+2
- IYMODEY_ll = IJUY_ll
-!
- DO JJ = 1,IYMODE_ll
- DO JI = 1,IXMODE_ll
- ZEIGEN_ll(JI,JJ) = ZEIGENX_ll(JI) - &
- ( 2.* SIN ( (JJ-1)/2*ZGWNY ) / PDYHATM )**2
- END DO
- END DO
-!
- CASE DEFAULT ! 3D non-cyclic cases
- IYMODE_ll = IJMAX_ll
- IYMODEY_ll = IJUY_ll - 2
-!
- DO JJ = 1,IYMODE_ll
- DO JI = 1,IXMODE_ll
- ZEIGEN_ll(JI,JJ) = ZEIGENX_ll(JI) - ( 2.* SIN (0.5*REAL(JJ-1)*ZGWNY ) / &
- PDYHATM )**2
- END DO
- END DO
-!
- END SELECT
-ELSE
-!
-! copy the x eigenvalue array in a 2D array for a 2D case
-!
- IYMODE_ll = 1
- IYMODEY_ll = 1
- ZEIGEN_ll(1:IXMODE_ll,1)=ZEIGENX_ll(1:IXMODE_ll)
-!
-END IF
-!
-DEALLOCATE(ZEIGENX_ll)
-!
-!* 7.2 compute the matrix diagonal elements
-!
-!
-PBFY = 1.
-IF (L2D) THEN
- DO JK= IKB,IKE
- DO JJ= 1, IYMODEY_ll
- DO JI= 1, IXMODEY_ll
- PBFY(JI,JJ,JK) = PRHOM(JK)* ZEIGEN_ll(JI+IORXY_ll-1,JJ+IORYY_ll-1) - 0.5 * &
- ( ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2 &
- +( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1)**2 )
- END DO
- END DO
- END DO
-! at the upper and lower levels PBFY is computed using the Neumann
-! condition
-!
- PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKB-1) = -0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / &
- ZDZM(IKB) **2
- !
- PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKE+1) = 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / &
- ZDZM(IKE+1) **2
- !
-ELSE
- DO JK= IKB,IKE
- DO JJ= 1, IYMODEY_ll
- DO JI= 1, IXMODEY_ll
- PBFY(JJ,JI,JK) = PRHOM(JK)* ZEIGEN_ll(JI+IORXY_ll-1,JJ+IORYY_ll-1) - 0.5 * &
- ( ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2 &
- +( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1)**2 )
- END DO
- END DO
- END DO
-! at the upper and lower levels PBFY is computed using the Neumann
-! condition
-!
- PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKB-1) = -0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / &
- ZDZM(IKB) **2
- !
- PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKE+1) = 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / &
- ZDZM(IKE+1) **2
- !
-END IF
-!
-DEALLOCATE(ZEIGEN_ll)
-!
-! second coefficent is meaningless in cyclic case
-IF (HLBCX(1) == 'CYCL' .AND. L2D) PBFY(2,:,:)=1.
-IF (HLBCX(1) == 'CYCL' .AND. .NOT.(L2D) .AND. LWEST_ll(HSPLITTING='Y')) PBFY(:,2,:)=1.
-IF (HLBCY(1) == 'CYCL' .AND. .NOT.(L2D)) PBFY(2,:,:)=1.
-!
-!------------------------------------------------------------------------------
-!* 8. INITIALIZATION OF THE TRIGS AND IFAX ARRAYS FOR THE FFT
-! -------------------------------------------------------
-!
-! 8.1 x lateral boundary conditions
-!
-CALL SET99(PTRIGSX,KIFAXX,IIMAX_ll)
-!
-! test on the value of KIMAX: KIMAX must be factorizable as a product
-! of powers of 2,3 and 5. KIFAXX(10) is equal to IIMAX if the decomposition
-! is correct, then KIFAXX(1) contains the number of decomposition factors
-! of KIMAX.
-!
-IF (KIFAXX(10) /= IIMAX_ll) THEN
- WRITE(UNIT=ILUOUT,FMT="(' ERROR',/, &
- &' : THE FORM OF THE FFT USED FOR THE INVERSION OF THE FLAT ',/,&
- &' OPERATOR REQUIRES THAT KIMAX MUST BE FACTORIZABLE' ,/,&
- & ' AS A PRODUCT OF POWERS OF 2, 3 AND 5.')")
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','TRID','')
-END IF
-!
-IF (HLBCX(1) /= 'CYCL') THEN
-!
-! extra trigs for shifted (co) sine transform (FFT55)
-!
- INN=2*(IIMAX_ll)
- ZDEL=ASIN(1.0)/REAL(IIMAX_ll)
- DO JI=1,IIMAX_ll
- ZANGLE=REAL(JI)*ZDEL
- PTRIGSX(INN+JI)=SIN(ZANGLE)
- END DO
-!
-ENDIF
-!
-! 8.2 y lateral boundary conditions
-!
-IF (.NOT. L2D) THEN
- CALL SET99(PTRIGSY,KIFAXY,IJMAX_ll)
- !
- ! test on the value of KJMAX: KJMAX must be factorizable as a product
- ! of powers of 2,3 and 5. KIFAXY(10) is equal to IJMAX_ll if the decomposition
- ! is correct, then KIFAXX(1) contains the number of decomposition factors
- ! of IIMAX_ll.
- !
- IF (KIFAXY(10) /= IJMAX_ll) THEN
- WRITE(UNIT=ILUOUT,FMT="(' ERROR',/, &
- &' : THE FORM OF THE FFT USED FOR THE INVERSION OF THE FLAT ',/,&
- &' OPERATOR REQUIRES THAT KJMAX MUST BE FACTORIZABLE' ,/,&
- & ' AS A PRODUCT OF POWERS OF 2, 3 AND 5.')")
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','TRID','')
- END IF
- !
- !
- ! other cases
- !
- IF (HLBCY(1) /= 'CYCL') THEN
- !
- ! extra trigs for shifted (co) sine transform
- !
- INN=2*(IJMAX_ll)
- ZDEL=ASIN(1.0)/REAL(IJMAX_ll)
- DO JJ=1,IJMAX_ll
- ZANGLE=REAL(JJ)*ZDEL
- PTRIGSY(INN+JJ)=SIN(ZANGLE)
- END DO
- !
- ENDIF
- !
-ENDIF
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE TRID
diff --git a/src/MNH/ver_dyn.f90 b/src/MNH/ver_dyn.f90
index 925c2225b..7c282a1f0 100644
--- a/src/MNH/ver_dyn.f90
+++ b/src/MNH/ver_dyn.f90
@@ -158,7 +158,6 @@ USE MODI_SHUMAN
USE MODI_VER_INT_DYN
USE MODI_VER_INTERP_LIN
USE MODI_VER_SHIFT
-USE MODI_WGUESS
!
IMPLICIT NONE
!
diff --git a/src/MNH/wguess.f90 b/src/MNH/wguess.f90
deleted file mode 100644
index d6324d607..000000000
--- a/src/MNH/wguess.f90
+++ /dev/null
@@ -1,169 +0,0 @@
-!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.
-!-----------------------------------------------------------------
-! ##################
- MODULE MODI_WGUESS
-! ##################
-INTERFACE
- SUBROUTINE WGUESS(PRHODJU,PRHODJV,PZZ,PDXX,PDYY,PDZZ,PDZX,PDZY,PRHODJW)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJU ! rhodJU on the MESO-NH grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJV ! rhodJV on the MESO-NH grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of w points
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHODJW ! rhodJw on the MESO-NH grid
-!
-END SUBROUTINE WGUESS
-END INTERFACE
-END MODULE MODI_WGUESS
-!
-! #######################################################################
- SUBROUTINE WGUESS(PRHODJU,PRHODJV,PZZ,PDXX,PDYY,PDZZ,PDZX,PDZY,PRHODJW)
-! #######################################################################
-!
-!!**** *WGUESS* - compute the first guess of w
-!!
-!! PURPOSE
-!! -------
-!! This routine computes a value of w in order to have a first guess of w
-!! for the anelastic correction routine. The bottom boundary condition is
-!! verified, not the top one.
-!!
-!!** METHOD
-!! ------
-!!
-!! 1 the vertical contravariant component Wc of the momentum is computed
-!! from the uncompressible form of the continuity equation:
-!! _ _ _
-!! d(rhodJ Uc)/dx + d(rhodJ Vc)/dy + d(rhodJ Wc)/dz = 0.
-!! with Wc=0 at ground level
-!!
-!! 2 the final value of w ( vertical catesian component) is deduced from:
-!!
-!! Wc=1/dzz * (w-Udzx/dxx-Vdzy/dyy)
-!!
-!! CAUTION: the values of rhoJw at JI=IJU-1, JJ=IJU-1,JK=IKU-1 or JK=IKB
-!! are duplicated on the points JI=IJU, JJ=IJU JK=IKU and JK=IKB-1 to JK=1
-!! respectively.
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! DXF,DYF,MXF,MYF,MZM : Shuman operators
-!! Module MODI_SHUMAN : interface for Shuman operators
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_CONF : contains configuration variables for all models.
-!! NVERB : verbosity level for output-listing
-!! Module MODD_PARAMETERS
-!! JPVEXT
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/12/94
-!! 15/05/96 spread the residual divergence on the whole domain
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODI_SHUMAN ! interface module
-USE MODD_CONF ! declaration modules
-USE MODD_PARAMETERS
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJU ! rhodJU on the MESO-NH grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJV ! rhodJV on the MESO-NH grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of w points
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHODJW ! rhodJw on the MESO-NH grid
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-INTEGER :: IIU,IJU
-INTEGER :: IKB,IKU
-INTEGER :: JK
-REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),SIZE(PDZZ,3)) :: & !
- ZRHODJWC ! rhoJ Wc
-REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2)) :: ZLAMBDA
- ! characteristic length for the weight function
-!-------------------------------------------------------------------------------
-!
-IIU=SIZE(PDZZ,1)
-IJU=SIZE(PDZZ,2)
-IKB=JPVEXT+1
-IKU=SIZE(PDZZ,3)
-!
-!* 1. INTEGRATION OF THE CONTRAVARIANT W
-! ----------------------------------
-!
-ZRHODJWC(:,:,IKB)=0.
-DO JK=IKB,IKU-1
- ZRHODJWC(:,:,JK+1:JK+1)=ZRHODJWC(:,:,JK:JK) &
- -DXF(PRHODJU(:,:,JK:JK)/PDXX(:,:,JK:JK)) &
- -DYF(PRHODJV(:,:,JK:JK)/PDYY(:,:,JK:JK))
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. COMPUTATION OF rhoJw
-! --------------------
-!
-!* 2.1 General case
-! ------------
-!
-PRHODJW= PDZZ*ZRHODJWC + MXF(PDZX*MZM(PRHODJU/PDXX)) &
- + MYF(PDZY*MZM(PRHODJV/PDYY))
-!
-!* 2.2 Copies on boundaries
-! --------------------
-!
-PRHODJW( 1 , : ,:)=PRHODJW( 2 , : ,:)
-PRHODJW(IIU, : ,:)=PRHODJW(IIU-1, : ,:)
-PRHODJW( : , 1 ,:)=PRHODJW( : , 2 ,:)
-PRHODJW( : ,IJU,:)=PRHODJW( : ,IJU-1,:)
-!
-!* 2.3 Apply a weight function
-! -----------------------
-ZLAMBDA(:,:)= (PZZ(:,:,IKU)-PZZ(:,:,IKB)) / 10
-DO JK=IKB,IKU
- PRHODJW(:,:,JK) = PRHODJW(:,:,JK) * &
- ( 1. - EXP( (PZZ(:,:,JK)-PZZ(:,:,IKU)) / ZLAMBDA(:,:) ) )
-END DO
-!
-DO JK=1,IKB-1
- PRHODJW(:,:,JK)=PRHODJW(:,:,IKB)
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE WGUESS
diff --git a/src/MNH/zs_boundaryn.f90 b/src/MNH/zs_boundaryn.f90
deleted file mode 100644
index 4e2f7935a..000000000
--- a/src/MNH/zs_boundaryn.f90
+++ /dev/null
@@ -1,204 +0,0 @@
-!MNH_LIC Copyright 1999-2019 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.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_ZS_BOUNDARY_n
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE ZS_BOUNDARY_n (KMI, &
- PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
- PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
- KDXRATIO,KDYRATIO, &
- HLBCX,HLBCY, &
- PZS )
-!
-INTEGER, INTENT(IN) :: KMI ! Model index
-REAL, DIMENSION(:), INTENT(IN) :: PBMX1,PBMX2,PBMX3,PBMX4 ! Mass points in X-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBMY1,PBMY2,PBMY3,PBMY4 ! Mass points in Y-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBFX1,PBFX2,PBFX3,PBFX4 ! Flux points in X-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBFY1,PBFY2,PBFY3,PBFY4 ! Flux points in Y-direc.
-INTEGER, INTENT(IN) :: KDXRATIO ! x and y-direction resolution RATIO
-INTEGER, INTENT(IN) :: KDYRATIO ! between inner model and outer model
-CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCX ! type of lateral
-CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCY ! boundary conditions
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZS ! orography of the fine mesh model
-!
-END SUBROUTINE ZS_BOUNDARY_n
-!
-END INTERFACE
-!
-END MODULE MODI_ZS_BOUNDARY_n
-!
-! #####################################################################
- SUBROUTINE ZS_BOUNDARY_n (KMI, &
- PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
- PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
- KDXRATIO,KDYRATIO, &
- HLBCX,HLBCY, &
- PZS )
-! #####################################################################
-!
-!!**** *ZS_BOUNDARY_n* - interpolate the orography of the DAD model to the
-!! CHILD model
-!!
-!! PURPOSE
-!! -------
-!! The purpose of ZS_BOUNDARY$n is to perform the Bikhardt interpolation
-!! from the DAD model orography toward the fine scale model KMI.
-!
-!
-!!** METHOD
-!! ------
-!!
-!! We use the Bikhardt interpolation scheme to compute the orography of
-!! the fine-mesh model from the value of its DAD orography. This intermediate
-!! smooth orography is only used to modify the orography of the fine-mesh
-!! model for the marginal points ( 1, IIU, 1, IJU). The fine-scale orography
-!! is imported in this subroutine by argument and the DAD orography by module
-!! MODD_GRID$n
-!!
-!! EXTERNAL
-!! --------
-!! BIKHARDT : horizontal interpolation scheme using 4 points in x and y
-!! directions
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! MODULE MODD_GRID$n: XZS
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! J. Stein *Meteo-France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 1/2/99
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_GRID_n ! contains the DAD model informations
-!
-use mode_bikhardt
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KMI ! Model index
-REAL, DIMENSION(:), INTENT(IN) :: PBMX1,PBMX2,PBMX3,PBMX4 ! Mass points in X-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBMY1,PBMY2,PBMY3,PBMY4 ! Mass points in Y-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBFX1,PBFX2,PBFX3,PBFX4 ! Flux points in X-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBFY1,PBFY2,PBFY3,PBFY4 ! Flux points in Y-direc.
-INTEGER, INTENT(IN) :: KDXRATIO ! x and y-direction resolution RATIO
-INTEGER, INTENT(IN) :: KDYRATIO ! between inner model and outer model
-CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCX ! type of lateral
-CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCY ! boundary conditions
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZS ! orography of the fine mesh model
-!
-!* 0.2 declarations of local variables
-!
-!REAL , DIMENSION(SIZE(PZS,1),SIZE(PZS,2)) :: ZZSLS ! interpolated orography
- ! at high resolution
-REAL , DIMENSION(SIZE(PZS,1),SIZE(PZS,2),1) :: ZZSLS
-INTEGER :: IIB,IJB,IIE,IJE
-INTEGER :: IIU,IJU ! array sizes in x and y directions of the CHILD model
-!
-! Variables used for LS communications
-TYPE(LIST_ll), POINTER :: TZLSFIELD_ll ! list of fields to exchange
-INTEGER :: IINFO_ll, IDIMX, IDIMY
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTZS,ZZS !!! provisoire
-!REAL, DIMENSION(:,:), ALLOCATABLE :: ZTZS
-INTEGER :: IMI !Current model index
-!-------------------------------------------------------------------------------
-!
-!* 0. INITIALISATION
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IIB=IIB-1
-IIE=IIE+1
-IJB=IJB-1
-IJE=IJE+1
-!
-!* 1 GATHER LS FIELD FOR THE CHILD MODEL KMI
-!
-! 1.1 Must be on the father model to call get_child_dim
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-CALL GO_TOMODEL_ll(IMI, IINFO_ll)
-CALL GET_CHILD_DIM_ll(KMI, IDIMX, IDIMY, IINFO_ll)
-!
-! 1.2 Allocate array which will receive coarse grid points
-!
-ALLOCATE(ZTZS(IDIMX,IDIMY,1))
-ALLOCATE(ZZS(SIZE(XZS,1),SIZE(XZS,2),1))
-ZZS(:,:,1)=XZS(:,:)
-!
-! 1.3 Specify the ls "source" fields and receiver fields
-!
-CALL SET_LSFIELD_1WAY_ll(ZZS, ZTZS, KMI)
-!
-!
-! 1.4 Communication
-!
-CALL LS_FORCING_ll(KMI, IINFO_ll)
-!
-! 1.5 Back to the (current) child model
-!
-CALL GO_TOMODEL_ll(KMI, IINFO_ll)
-!
-CALL UNSET_LSFIELD_1WAY_ll()
-!
-!
-!* 1. BIKARDT INTERPOLATION
-! ---------------------
-!
-CALL BIKHARDT (PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
- PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
- 2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1, &
- HLBCX,HLBCY,ZTZS,ZZSLS(IIB:IIE,IJB:IJE,:))
-!
-DEALLOCATE(ZTZS,ZZS)
-!-------------------------------------------------------------------------------
-!
-!* 2. SET THE OROGRAPHY AT THE MARGINAL POINTS
-! ----------------------------------------
-!
-!
-IIU=SIZE(PZS,1)
-IJU=SIZE(PZS,2)
-!
-IF(HLBCX(1)/='CYCL' .AND. LWEST_ll()) PZS(1,IJB:IJE) = ZZSLS(1,IJB:IJE,1)
-IF(HLBCX(2)/='CYCL' .AND. LEAST_ll()) PZS(IIU,IJB:IJE) = ZZSLS(IIU,IJB:IJE,1)
-IF(HLBCY(1)/='CYCL' .AND. LSOUTH_ll()) PZS(IIB:IIE,1) = ZZSLS(IIB:IIE,1,1)
-IF(HLBCY(2)/='CYCL' .AND. LNORTH_ll()) PZS(IIB:IIE,IJU) = ZZSLS(IIB:IIE,IJU,1)
-!
-NULLIFY(TZLSFIELD_ll)
-CALL ADD2DFIELD_ll( TZLSFIELD_ll, PZS, 'ZS_BOUNDARY_n::PZS' )
-CALL UPDATE_HALO_ll(TZLSFIELD_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZLSFIELD_ll)
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE ZS_BOUNDARY_n
--
GitLab