From 1eb88ba709352a634dde63dd78b1cb8eb5c64af6 Mon Sep 17 00:00:00 2001
From: Gaelle Tanguy <gaelle.tanguy@meteo.fr>
Date: Thu, 12 Dec 2013 16:17:03 +0000
Subject: [PATCH] Christine 12/12/13 : WENO
---
src/MNH/adv_boundaries.f90 | 117 ++
src/MNH/advec_3rd_order_aux.f90 | 854 ++++++++
src/MNH/advec_weno_k_1_aux.f90 | 343 +++
src/MNH/advec_weno_k_2_aux.f90 | 1421 +++++++++++++
src/MNH/advec_weno_k_3_aux.f90 | 3014 +++++++++++++++++++++++++++
src/MNH/advection.f90 | 239 +--
src/MNH/advection_metsv.f90 | 537 +++++
src/MNH/advection_uvw.f90 | 312 +++
src/MNH/advection_uvw_cen.f90 | 251 +++
src/MNH/advecuvw_2nd.f90 | 157 ++
src/MNH/advecuvw_4th.f90 | 53 -
src/MNH/advecuvw_rk.f90 | 350 ++++
src/MNH/advecuvw_weno_k.f90 | 271 +++
src/MNH/anel_balancen.f90 | 74 +-
src/MNH/boundaries.f90 | 274 +--
src/MNH/budget.f90 | 17 +-
src/MNH/budget_flags.f90 | 29 +-
src/MNH/c2r2_adjust.f90 | 10 +-
src/MNH/c3r5_adjust.f90 | 5 +-
src/MNH/ch_aqueous_sedimkhko.f90 | 20 +-
src/MNH/ch_boundaries.f90 | 27 +-
src/MNH/ch_init_fieldn.f90 | 95 +-
src/MNH/ch_monitorn.f90 | 81 +-
src/MNH/compute_function_thermo.f90 | 258 +++
src/MNH/compute_r00.f90 | 10 +-
src/MNH/deallocate_model1.f90 | 41 +-
src/MNH/default_desfmn.f90 | 53 +-
src/MNH/diag.f90 | 32 +-
src/MNH/dyn_sources.f90 | 48 +-
src/MNH/endstep.f90 | 188 +-
src/MNH/endstep_budget.f90 | 24 +-
src/MNH/error_on_temperature.f90 | 6 +-
src/MNH/exchange.f90 | 30 +-
src/MNH/fast_terms.f90 | 10 +-
src/MNH/forcing.f90 | 50 +-
src/MNH/goto_model_wrapper.f90 | 2 +
src/MNH/gravity.f90 | 184 ++
src/MNH/gravity_impl.f90 | 145 ++
src/MNH/ground_paramn.f90 | 18 +-
src/MNH/ice_adjust.f90 | 23 +-
src/MNH/ice_adjust_bis.f90 | 131 ++
src/MNH/ice_adjust_elec.f90 | 32 +-
src/MNH/ini_budget.f90 | 310 +--
src/MNH/ini_cpl.f90 | 40 +-
src/MNH/ini_elecn.f90 | 12 +-
src/MNH/ini_lesn.f90 | 49 +-
src/MNH/ini_lg.f90 | 30 +-
src/MNH/ini_micron.f90 | 34 +-
src/MNH/ini_modeln.f90 | 200 +-
src/MNH/ini_one_wayn.f90 | 73 +-
src/MNH/ini_prog_var.f90 | 87 +-
src/MNH/ini_segn.f90 | 9 +-
src/MNH/ini_tke_eps.f90 | 56 +-
src/MNH/init_for_convlfi.f90 | 361 ++++
src/MNH/init_mnh.f90 | 5 +-
src/MNH/initial_guess.f90 | 115 +-
src/MNH/interp3d.f90 | 154 ++
src/MNH/ion_boundaries.f90 | 16 +-
src/MNH/ion_drift.f90 | 53 +-
src/MNH/les_budget.f90 | 154 +-
src/MNH/les_budget_tendn.f90 | 36 +-
src/MNH/les_cloud_masksn.f90 | 33 +-
src/MNH/les_ini_timestepn.f90 | 46 +-
src/MNH/les_masksn.f90 | 2 +-
src/MNH/les_res_tr.f90 | 27 +-
src/MNH/lesn.f90 | 93 +-
src/MNH/ls_coupling.f90 | 38 +-
src/MNH/mean_field.f90 | 58 +-
src/MNH/mesonh.f90 | 12 +-
src/MNH/mf_turb.f90 | 20 +-
src/MNH/modd_advn.f90 | 42 +-
src/MNH/modd_budget.f90 | 42 +-
src/MNH/modd_conf.f90 | 8 +-
src/MNH/modd_fieldn.f90 | 75 +-
src/MNH/modd_getn.f90 | 59 +-
src/MNH/modd_les_budget.f90 | 7 +-
src/MNH/modd_past_fieldn.f90 | 81 +
src/MNH/modd_sub_modeln.f90 | 6 +-
src/MNH/modeln.f90 | 473 +++--
src/MNH/modn_advn.f90 | 35 +-
src/MNH/modn_budget.f90 | 28 +-
src/MNH/modn_conf.f90 | 2 +-
src/MNH/one_wayn.f90 | 10 +-
src/MNH/paspol.f90 | 8 +-
src/MNH/phys_paramn.f90 | 143 +-
src/MNH/ppm_met.f90 | 58 +-
src/MNH/ppm_rhodj.f90 | 114 +
src/MNH/ppm_scalar.f90 | 42 +-
src/MNH/prep_ideal_case.f90 | 109 +-
src/MNH/prep_real_case.f90 | 20 +-
src/MNH/pressure_in_prep.f90 | 66 +-
src/MNH/pressurez.f90 | 41 +-
src/MNH/rad_bound.f90 | 137 +-
src/MNH/rain_c2r2.f90 | 83 +-
src/MNH/rain_ice.f90 | 68 +-
src/MNH/rain_ice_elec.f90 | 67 +-
src/MNH/rain_khko.f90 | 75 +-
src/MNH/read_desfmn.f90 | 10 +-
src/MNH/read_exsegn.f90 | 186 +-
src/MNH/read_field.f90 | 931 +++------
src/MNH/read_precip_field.f90 | 35 +-
src/MNH/relax2fw_ion.f90 | 11 +-
src/MNH/relaxation.f90 | 87 +-
src/MNH/reset_exseg.f90 | 8 +-
src/MNH/resolved_cloud.f90 | 151 +-
src/MNH/resolved_elecn.f90 | 111 +-
src/MNH/series_cloud_elec.f90 | 8 +-
src/MNH/set_geosbal.f90 | 26 +-
src/MNH/set_grid.f90 | 4 +-
src/MNH/set_mask.f90 | 4 +-
src/MNH/set_mass.f90 | 36 +-
src/MNH/set_perturb.f90 | 96 +-
src/MNH/shallow_mf.f90 | 14 +-
src/MNH/shallow_mf_pack.f90 | 10 +-
src/MNH/slow_terms.f90 | 4 -
src/MNH/spawn_field2.f90 | 217 +-
src/MNH/spawn_model2.f90 | 127 +-
src/MNH/spawn_pressure2.f90 | 72 +-
src/MNH/spawn_surf2_rain.f90 | 8 +-
src/MNH/spawning.f90 | 6 +-
src/MNH/thlrt_from_thrvrcri.f90 | 107 +
src/MNH/thrvrcri_from_thlrtrcri.f90 | 108 +
src/MNH/tke_eps_sources.f90 | 46 +-
src/MNH/turb.f90 | 347 ++-
src/MNH/turb_hor_splt.f90 | 41 +-
src/MNH/turb_ver.f90 | 31 +-
src/MNH/two_wayn.f90 | 46 +-
src/MNH/ver_dyn.f90 | 134 +-
src/MNH/ver_interp_field.f90 | 33 +-
src/MNH/ver_thermo.f90 | 111 +-
src/MNH/version.f90 | 4 +-
131 files changed, 12055 insertions(+), 4973 deletions(-)
create mode 100644 src/MNH/adv_boundaries.f90
create mode 100644 src/MNH/advec_3rd_order_aux.f90
create mode 100644 src/MNH/advec_weno_k_1_aux.f90
create mode 100644 src/MNH/advec_weno_k_2_aux.f90
create mode 100644 src/MNH/advec_weno_k_3_aux.f90
create mode 100644 src/MNH/advection_metsv.f90
create mode 100644 src/MNH/advection_uvw.f90
create mode 100644 src/MNH/advection_uvw_cen.f90
create mode 100644 src/MNH/advecuvw_2nd.f90
create mode 100644 src/MNH/advecuvw_rk.f90
create mode 100644 src/MNH/advecuvw_weno_k.f90
create mode 100644 src/MNH/compute_function_thermo.f90
create mode 100644 src/MNH/gravity.f90
create mode 100644 src/MNH/gravity_impl.f90
create mode 100644 src/MNH/ice_adjust_bis.f90
create mode 100644 src/MNH/init_for_convlfi.f90
create mode 100644 src/MNH/interp3d.f90
create mode 100644 src/MNH/modd_past_fieldn.f90
create mode 100644 src/MNH/ppm_rhodj.f90
create mode 100644 src/MNH/thlrt_from_thrvrcri.f90
create mode 100644 src/MNH/thrvrcri_from_thlrtrcri.f90
diff --git a/src/MNH/adv_boundaries.f90 b/src/MNH/adv_boundaries.f90
new file mode 100644
index 000000000..2d83c87ed
--- /dev/null
+++ b/src/MNH/adv_boundaries.f90
@@ -0,0 +1,117 @@
+!#####################
+MODULE MODI_ADV_BOUNDARIES
+!#####################
+!
+INTERFACE
+!
+ SUBROUTINE ADV_BOUNDARIES ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIELD )
+!
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
+REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PFIELDI
+CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HFIELD ! Field type
+!
+END SUBROUTINE ADV_BOUNDARIES
+!
+END INTERFACE
+!
+
+END MODULE MODI_ADV_BOUNDARIES
+!
+!
+! ####################################################################
+ SUBROUTINE ADV_BOUNDARIES ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIELD )
+! ####################################################################
+!
+!!**** *ADV_BOUNDARIES* - routine to prepare the top and bottom Boundary Conditions
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
+REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PFIELDI
+CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HFIELD ! Field type
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: IIU, IJU ! Index End in X and Y directions
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
+! ----------------------------------------------
+IKB = 1 + JPVEXT
+IKE = SIZE(PFIELD,3) - JPVEXT
+IIU=SIZE(PFIELD,1)
+IJU=SIZE(PFIELD,2)
+!
+IF (SIZE(PFIELD)==0) RETURN
+!-------------------------------------------------------------------------------
+!
+!* 2. UPPER AND LOWER BC FILLING:
+! ---------------------------
+!
+!* 2.1 COMPUTE THE FIELD EXTRAPOLATIONS AT THE GROUND
+!
+!
+ IF (PRESENT(HFIELD) .AND. PRESENT(PFIELDI)) THEN
+ IF (HFIELD=='W') &
+ PFIELD (:,:,IKB ) = PFIELDI (:,:,IKB)
+ END IF
+!
+ PFIELD (:,:,IKB-1) = PFIELD (:,:,IKB)
+
+!
+!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
+!
+ PFIELD (:,:,IKE+1) = PFIELD (:,:,IKE)
+!
+!
+!* 3. LATERAL BC FILLING
+! ---------------------------
+!
+IF( PRESENT(PFIELDI) ) THEN
+ IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
+ PFIELD(1,:,:) = PFIELDI(1,:,:)
+ IF (PRESENT(HFIELD)) THEN
+ IF (HFIELD=='U') &
+ PFIELD(2,:,:) = PFIELDI(2,:,:)
+ END IF
+ END IF
+ IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
+ PFIELD(IIU,:,:) = PFIELDI(IIU,:,:)
+ END IF
+ IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
+ PFIELD(:,1,:) = PFIELDI(:,1,:)
+ IF (PRESENT(HFIELD)) THEN
+ IF (HFIELD=='V') &
+ PFIELD(:,2,:) = PFIELDI(:,2,:)
+ END IF
+ END IF
+ IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
+ PFIELD(:,IJU,:) = PFIELDI(:,IJU,:)
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADV_BOUNDARIES
diff --git a/src/MNH/advec_3rd_order_aux.f90 b/src/MNH/advec_3rd_order_aux.f90
new file mode 100644
index 000000000..549052246
--- /dev/null
+++ b/src/MNH/advec_3rd_order_aux.f90
@@ -0,0 +1,854 @@
+! ###############################
+ MODULE MODI_ADVEC_3RD_ORDER_AUX
+! ###############################
+!
+INTERFACE
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ADVEC_3RD_ORDER_UX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_3RD_ORDER_UX
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ADVEC_3RD_ORDER_MX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_3RD_ORDER_MX
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ADVEC_3RD_ORDER_VY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_3RD_ORDER_VY
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ADVEC_3RD_ORDER_MY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_3RD_ORDER_MY
+!
+!------------------------------------------------------------------------
+!
+ FUNCTION UP3_WZ(PSRC, PRWCT) RESULT(PR)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+END FUNCTION UP3_WZ
+!
+!-------------------------------------------------------------------------------
+!
+ FUNCTION UP3_MZ(PSRC, PRWCT) RESULT(PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!
+! output source term
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+END FUNCTION UP3_MZ
+!
+END INTERFACE
+!
+END MODULE MODI_ADVEC_3RD_ORDER_AUX
+!
+!-------------------------------------------------------------------------------
+!
+! #############################################################
+ SUBROUTINE ADVEC_3RD_ORDER_UX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+! #############################################################
+!!
+!!**** ADVEC_3RD_ORDER_UX - 3rd order upstream fluxes of U in X direction
+!! input variable PSRC is on U grid, and output PR is on mass grid
+!!
+!! AUTHOR
+!! ------
+!! C.Lac * CNRM/GMME *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+!
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IW,IE,IWF,IEF ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
+!
+!* 1.1 CYCLIC CASE IN THE X DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+!
+ IF(NHALO == 1) THEN
+ IW=IIB+1
+ IE=IIE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 3rd order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+ IWF=IW-1
+ IEF=IE-1
+!
+ PR(IWF:IEF,:,:) = 1./6. * ( (2.*PSRC(IW:IE,:,:) + 5.*PSRC(IW-1:IE-1,:,:) - &
+ PSRC(IW-2:IE-2,:,:)) * (0.5+SIGN(0.5,PRUCT(IW-1:IE-1,:,:))) &
+ + (5.*PSRC(IW:IE,:,:) + 2.*PSRC(IW-1:IE-1,:,:) - &
+ PSRC(IW+1:IE+1,:,:)) * (0.5-SIGN(0.5,PRUCT(IW-1:IE-1,:,:))) )
+!
+ PR(IEF+1,:,:) = 1./6. * ( (2.*PSRC(IE+1,:,:) + 5.*PSRC(IE,:,:) - &
+ PSRC(IE-1,:,:)) * (0.5+SIGN(0.5,PRUCT(IE,:,:))) &
+ + (5.*PSRC(IE+1,:,:) + 2.*PSRC(IE,:,:) - &
+ TPHALO2%EAST(:,:)) * (0.5-SIGN(0.5,PRUCT(IE,:,:))))
+!
+ PR(IWF-1,:,:) = 1./6. * ( (2.*PSRC(IW-1,:,:) + 5.*PSRC(IW-2,:,:) - &
+ TPHALO2%WEST(:,:)) * (0.5+SIGN(0.5,PRUCT(IW-2,:,:))) &
+ + (5.*PSRC(IW-1,:,:) + 2.*PSRC(IW-2,:,:) - &
+ PSRC(IW,:,:)) * (0.5-SIGN(0.5,PRUCT(IW-2,:,:))) )
+!
+! OPEN, WALL, NEST CASE IN THE X DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
+!
+ IF (LWEST_ll()) THEN
+ IW=IIB+2 ! special case of C grid
+ ELSE
+ IF(NHALO == 1) THEN
+ IW=IIB+1
+ ELSE
+ IW=IIB
+ ENDIF
+ ENDIF
+ IF (LEAST_ll() .OR. NHALO == 1) THEN
+ IE=IIE
+ ELSE
+ IE=IIE
+ END IF
+!
+ IWF=IW-1
+ IEF=IE-1
+!
+ IF(LWEST_ll()) THEN
+ PR(IWF-1,:,:) = PSRC(IW-2,:,:) * (0.5+SIGN(0.5,PRUCT(IW-2,:,:))) &
+ + PSRC(IW-1,:,:) * (0.5-SIGN(0.5,PRUCT(IW-2,:,:)))
+ ELSEIF (NHALO == 1) THEN
+ PR(IWF-1,:,:) = 1./6. * ( (2.*PSRC(IW-1,:,:) + 5.*PSRC(IW-2,:,:) - &
+ TPHALO2%WEST(:,:)) * (0.5+SIGN(0.5,PRUCT(IW-2,:,:))) &
+ + (5.*PSRC(IW-1,:,:) + 2.*PSRC(IW-2,:,:) - &
+ PSRC(IW,:,:)) * (0.5-SIGN(0.5,PRUCT(IW-2,:,:))) )
+ ENDIF
+!
+ IF(LEAST_ll()) THEN
+ PR(IEF+1,:,:) = PSRC(IE,:,:) * (0.5+SIGN(0.5,PRUCT(IE,:,:))) &
+ + PSRC(IE+1,:,:) * (0.5-SIGN(0.5,PRUCT(IE,:,:)))
+ ELSEIF (NHALO == 1) THEN
+ PR(IEF+1,:,:) = 1./6. * ( (2.*PSRC(IE+1,:,:) + 5.*PSRC(IE,:,:) - &
+ PSRC(IE-1,:,:)) * (0.5+SIGN(0.5,PRUCT(IE,:,:))) &
+ + (5.*PSRC(IE+1,:,:) + 2.*PSRC(IE,:,:) - &
+ TPHALO2%EAST(:,:)) * (0.5-SIGN(0.5,PRUCT(IE,:,:))))
+ ENDIF
+!
+! USE A THIRD ORDER UPSTREAM SCHEME ELSEWHERE
+!
+ PR(IWF:IEF,:,:) = 1./6. * ( (2.*PSRC(IW:IE,:,:) + 5.*PSRC(IW-1:IE-1,:,:) - &
+ PSRC(IW-2:IE-2,:,:)) * (0.5+SIGN(0.5,PRUCT(IW-1:IE-1,:,:))) &
+ + (5.*PSRC(IW:IE,:,:) + 2.*PSRC(IW-1:IE-1,:,:) - &
+ PSRC(IW+1:IE+1,:,:)) * (0.5-SIGN(0.5,PRUCT(IW-1:IE-1,:,:))) )
+!
+END SELECT
+!
+PR = PR * PRUCT
+!
+END SUBROUTINE ADVEC_3RD_ORDER_UX
+!
+!-------------------------------------------------------------------------------
+!
+! #############################################################
+ SUBROUTINE ADVEC_3RD_ORDER_MX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+! #############################################################
+!!
+!!**** ADVEC_3RD_ORDER_MX - 3rd order upstream fluxes of variable in X direction
+!! Input variable PSRC is on MASS grid, and output PR is on U grid
+!!
+!! AUTHOR
+!! ------
+!! C.Lac * CNRM/GMME *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IW,IE,IWF,IEF ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
+!
+!* 1.1 CYCLIC CASE IN THE X DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+!
+ IF(NHALO == 1) THEN
+ IW=IIB+1
+ IE=IIE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 3rd order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+ IWF=IW
+ IEF=IE
+!
+ PR(IWF:IEF,:,:) = 1./6. * ( (2.*PSRC(IW:IE,:,:) + 5.*PSRC(IW-1:IE-1,:,:) - &
+ PSRC(IW-2:IE-2,:,:)) * (0.5+SIGN(0.5,PRUCT(IW:IE,:,:))) &
+ + (5.*PSRC(IW:IE,:,:) + 2.*PSRC(IW-1:IE-1,:,:) - &
+ PSRC(IW+1:IE+1,:,:)) * (0.5-SIGN(0.5,PRUCT(IW:IE,:,:))) )
+!
+ PR(IWF-1,:,:) = 1./6. * ( (2.*PSRC(IW-1,:,:) + 5.*PSRC(IW-2,:,:) - &
+ TPHALO2%WEST(:,:)) * (0.5+SIGN(0.5,PRUCT(IW-1,:,:))) &
+ + (5.*PSRC(IW-1,:,:) + 2.*PSRC(IW-2,:,:) - &
+ PSRC(IW,:,:)) * (0.5-SIGN(0.5,PRUCT(IW-1,:,:))) )
+!
+ PR(IEF+1,:,:) = 1./6. * ( (2.*PSRC(IE+1,:,:) + 5.*PSRC(IE,:,:) - &
+ PSRC(IE-1,:,:)) * (0.5+SIGN(0.5,PRUCT(IE+1,:,:))) &
+ + (5.*PSRC(IE+1,:,:) + 2.*PSRC(IE,:,:) - &
+ TPHALO2%EAST) * (0.5-SIGN(0.5,PRUCT(IE+1,:,:))) )
+!
+! OPEN, WALL, NEST CASE IN THE X DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSCIAL BORDER
+!
+ IF (LWEST_ll()) THEN
+ IW=IIB+1
+ ELSE
+ IF(NHALO == 1) THEN
+ IW=IIB+1
+ ELSE
+ IW=IIB
+ ENDIF
+ ENDIF
+ IF (LEAST_ll() .OR. NHALO == 1) THEN
+ IE=IIE
+ ELSE
+ IE=IIE
+ END IF
+!
+ IWF=IW
+ IEF=IE
+!
+ IF(LWEST_ll()) THEN
+ PR(IWF-1,:,:) = PSRC(IW-2,:,:) * (0.5+SIGN(0.5,PRUCT(IW-1,:,:))) &
+ + PSRC(IW-1,:,:) * (0.5-SIGN(0.5,PRUCT(IW-1,:,:)))
+ ELSEIF (NHALO == 1) THEN
+ PR(IWF-1,:,:) = 1./6. * ( (2.*PSRC(IW-1,:,:) + 5.*PSRC(IW-2,:,:) - &
+ TPHALO2%WEST(:,:)) * (0.5+SIGN(0.5,PRUCT(IW-1,:,:))) &
+ + (5.*PSRC(IW-1,:,:) + 2.*PSRC(IW-2,:,:) - &
+ PSRC(IW,:,:)) * (0.5-SIGN(0.5,PRUCT(IW-1,:,:))) )
+ ENDIF
+!
+ IF(LEAST_ll()) THEN
+ PR(IEF+1,:,:) = PSRC(IE,:,:) * (0.5+SIGN(0.5,PRUCT(IE+1,:,:))) &
+ + PSRC(IE+1,:,:) * (0.5-SIGN(0.5,PRUCT(IE+1,:,:)))
+ ELSEIF (NHALO == 1) THEN
+ PR(IEF+1,:,:) = 1./6. * ( (2.*PSRC(IE+1,:,:) + 5.*PSRC(IE,:,:) - &
+ PSRC(IE-1,:,:)) * (0.5+SIGN(0.5,PRUCT(IE+1,:,:))) &
+ + (5.*PSRC(IE+1,:,:) + 2.*PSRC(IE,:,:) - &
+ TPHALO2%EAST) * (0.5-SIGN(0.5,PRUCT(IE+1,:,:))) )
+ ENDIF
+!
+! USE A THIRD ORDER UPSTREAM SCHEME ELSEWHERE
+!
+ PR(IWF:IEF,:,:) = 1./6. * ( (2.*PSRC(IW:IE,:,:) + 5.*PSRC(IW-1:IE-1,:,:) - &
+ PSRC(IW-2:IE-2,:,:)) * (0.5+SIGN(0.5,PRUCT(IW:IE,:,:))) &
+ + (5.*PSRC(IW:IE,:,:) + 2.*PSRC(IW-1:IE-1,:,:) - &
+ PSRC(IW+1:IE+1,:,:)) * (0.5-SIGN(0.5,PRUCT(IW:IE,:,:))) )
+!
+END SELECT
+!
+PR = PR * PRUCT
+!
+END SUBROUTINE ADVEC_3RD_ORDER_MX
+!
+!-------------------------------------------------------------------------------
+!
+! #############################################################
+ SUBROUTINE ADVEC_3RD_ORDER_VY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+! #############################################################
+!!
+!!**** ADVEC_3RD_ORDER_VY - 3rd order upstream fluxes of V in Y direction
+!! Input variable PSRC is on V grid, and output PR is on MASS grid
+!!
+!! AUTHOR
+!! ------
+!! C.Lac * CNRM/GMME *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IS,IN,ISF,INF ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCY(1) ) !
+!
+!* 1.1 CYCLIC CASE IN THE Y DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCY(1) == HLBCY(2)
+!
+ IF(NHALO == 1) THEN
+ IS=IJB+1
+ IN=IJE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 4th order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+ ISF=IS-1
+ INF=IN-1
+!
+ PR(:,ISF:INF,:) = 1./6. * ( (2.*PSRC(:,IS:IN,:) + 5.*PSRC(:,IS-1:IN-1,:) - &
+ PSRC(:,IS-2:IN-2,:)) * (0.5+SIGN(0.5,PRVCT(:,IS-1:IN-1,:))) &
+ + (5.*PSRC(:,IS:IN,:) + 2.*PSRC(:,IS-1:IN-1,:) - &
+ PSRC(:,IS+1:IN+1,:)) * (0.5-SIGN(0.5,PRVCT(:,IS-1:IN-1,:))) )
+!
+ PR(:,ISF-1,:) = 1./6. * ( (2.*PSRC(:,IS-1,:) + 5.*PSRC(:,IS-2,:) - &
+ TPHALO2%SOUTH(:,:)) * (0.5+SIGN(0.5,PRVCT(:,IS-2,:))) &
+ + (5.*PSRC(:,IS-1,:) + 2.*PSRC(:,IS-2,:) - &
+ PSRC(:,IS,:)) * (0.5-SIGN(0.5,PRVCT(:,IS-2,:))) )
+!
+ PR(:,INF+1,:) = 1./6. * ( (2.*PSRC(:,IN+1,:) + 5.*PSRC(:,IN,:) - &
+ PSRC(:,IN-1,:)) * (0.5+SIGN(0.5,PRVCT(:,IN,:))) &
+ + (5.*PSRC(:,IN+1,:) + 2.*PSRC(:,IN,:) - &
+ TPHALO2%NORTH(:,:)) * (0.5-SIGN(0.5,PRVCT(:,IN,:))) )
+!
+! OPEN, WALL, NEST CASES IN THE Y DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
+!
+ IF (LSOUTH_ll()) THEN
+ IS=IJB+2
+ ELSE
+ IF(NHALO == 1) THEN
+ IS=IJB+1
+ ELSE
+ IS=IJB
+ ENDIF
+ ENDIF
+ IF (LNORTH_ll() .OR. NHALO == 1) THEN
+ IN=IJE
+ ELSE
+ IN=IJE
+ END IF
+!
+ ISF=IS-1
+ INF=IN-1
+!
+ IF(LSOUTH_ll()) THEN
+ PR(:,ISF-1,:) = PSRC(:,IS-2,:) * (0.5+SIGN(0.5,PRVCT(:,IS-2,:))) &
+ + PSRC(:,IS-1,:) * (0.5-SIGN(0.5,PRVCT(:,IS-2,:)))
+ ELSEIF (NHALO == 1) THEN
+ PR(:,ISF-1,:) = 1./6. * ( (2.*PSRC(:,IS-1,:) + 5.*PSRC(:,IS-2,:) - &
+ TPHALO2%SOUTH(:,:)) * (0.5+SIGN(0.5,PRVCT(:,IS-2,:))) &
+ + (5.*PSRC(:,IS-1,:) + 2.*PSRC(:,IS-2,:) - &
+ PSRC(:,IS,:)) * (0.5-SIGN(0.5,PRVCT(:,IS-2,:))) )
+ ENDIF
+!
+ IF(LNORTH_ll()) THEN
+ PR(:,INF+1,:) = PSRC(:,IN,:) * (0.5+SIGN(0.5,PRVCT(:,IN,:))) &
+ + PSRC(:,IN+1,:) * (0.5-SIGN(0.5,PRVCT(:,IN,:)))
+ ELSEIF (NHALO == 1) THEN
+ PR(:,INF+1,:) = 1./6. * ( (2.*PSRC(:,IN+1,:) + 5.*PSRC(:,IN,:) - &
+ PSRC(:,IN-1,:)) * (0.5+SIGN(0.5,PRVCT(:,IN,:))) &
+ + (5.*PSRC(:,IN+1,:) + 2.*PSRC(:,IN,:) - &
+ TPHALO2%NORTH(:,:)) * (0.5-SIGN(0.5,PRVCT(:,IN,:))) )
+ ENDIF
+!
+! USE A 3RD ORDER UPSTREAM SCHEME ELSEWHERE
+!
+ PR(:,ISF:INF,:) = 1./6. * ( (2.*PSRC(:,IS:IN,:) + 5.*PSRC(:,IS-1:IN-1,:) - &
+ PSRC(:,IS-2:IN-2,:)) * (0.5+SIGN(0.5,PRVCT(:,IS-1:IN-1,:))) &
+ + (5.*PSRC(:,IS:IN,:) + 2.*PSRC(:,IS-1:IN-1,:) - &
+ PSRC(:,IS+1:IN+1,:)) * (0.5-SIGN(0.5,PRVCT(:,IS-1:IN-1,:))) )
+!
+END SELECT
+!
+PR = PR * PRVCT
+!
+END SUBROUTINE ADVEC_3RD_ORDER_VY
+!
+!-------------------------------------------------------------------------------
+!
+! ##############################################################
+ SUBROUTINE ADVEC_3RD_ORDER_MY(HLBCY, PSRC, PRVCT, PR, TPHALO2)
+! ##############################################################
+!!
+!!**** ADVEC_3RD_ORDER_MY - 3rd order upstream fluxes of variable in Y direction
+!! Input variable PSRC is on MASS grid, and output PR is on V grid
+!!
+!! AUTHOR
+!! ------
+!! C.Lac * CNRM/GMME *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IS,IN,ISF,INF ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCY(1) ) ! Y direction LBC type: (1) for left side
+!
+!* 1.1 CYCLIC CASE IN THE Y DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+!
+ IF(NHALO == 1) THEN
+ IS=IJB+1
+ IN=IJE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 4th order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+ ISF=IS
+ INF=IN
+!
+ PR(:,ISF:INF,:) = 1./6. * ( (2.*PSRC(:,IS:IN,:) + 5.*PSRC(:,IS-1:IN-1,:) - &
+ PSRC(:,IS-2:IN-2,:)) * (0.5+SIGN(0.5,PRVCT(:,IS:IN,:))) &
+ + (5.*PSRC(:,IS:IN,:) + 2.*PSRC(:,IS-1:IN-1,:) - &
+ PSRC(:,IS+1:IN+1,:)) * (0.5-SIGN(0.5,PRVCT(:,IS:IN,:))) )
+!
+ PR(:,ISF-1,:) = 1./6. * ( (2.*PSRC(:,IS-1,:) + 5.*PSRC(:,IS-2,:) - &
+ TPHALO2%SOUTH(:,:)) * (0.5+SIGN(0.5,PRVCT(:,IS-1,:))) &
+ + (5.*PSRC(:,IS-1,:) + 2.*PSRC(:,IS-2,:) - &
+ PSRC(:,IS,:)) * (0.5-SIGN(0.5,PRVCT(:,IS-1,:))) )
+!
+ PR(:,INF+1,:) = 1./6. * ( (2.*PSRC(:,IN+1,:) + 5.*PSRC(:,IN,:) - &
+ PSRC(:,IN-1,:)) * (0.5+SIGN(0.5,PRVCT(:,IN+1,:))) &
+ + (5.*PSRC(:,IN+1,:) + 2.*PSRC(:,IN,:) - &
+ TPHALO2%NORTH(:,:)) * (0.5-SIGN(0.5,PRVCT(:,IN+1,:))) )
+!
+! OPEN, WALL, NEST CASES IN THE Y DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
+!
+ IF (LSOUTH_ll()) THEN
+ IS=IJB+1
+ ELSE
+ IF(NHALO == 1) THEN
+ IS=IJB+1
+ ELSE
+ IS=IJB
+ ENDIF
+ ENDIF
+ IF (LNORTH_ll() .OR. NHALO == 1) THEN
+ IN=IJE
+ ELSE
+ IN=IJE
+ END IF
+!
+ ISF=IS
+ INF=IN
+!
+ IF(LSOUTH_ll()) THEN
+ PR(:,ISF-1,:) = PSRC(:,IS-2,:) * (0.5+SIGN(0.5,PRVCT(:,IS-1,:))) &
+ + PSRC(:,IS-1,:) * (0.5-SIGN(0.5,PRVCT(:,IS-1,:)))
+ ELSEIF (NHALO == 1) THEN
+ PR(:,ISF-1,:) = 1./6. * ( (2.*PSRC(:,IS-1,:) + 5.*PSRC(:,IS-2,:) - &
+ TPHALO2%SOUTH(:,:)) * (0.5+SIGN(0.5,PRVCT(:,IS-1,:))) &
+ + (5.*PSRC(:,IS-1,:) + 2.*PSRC(:,IS-2,:) - &
+ PSRC(:,IS,:)) * (0.5-SIGN(0.5,PRVCT(:,IS-1,:))) )
+ END IF
+!
+ IF(LNORTH_ll()) THEN
+ PR(:,INF+1,:) = PSRC(:,IN,:) * (0.5+SIGN(0.5,PRVCT(:,IN+1,:))) &
+ + PSRC(:,IN+1,:) * (0.5-SIGN(0.5,PRVCT(:,IN+1,:)))
+ ELSEIF (NHALO == 1) THEN
+ PR(:,INF+1,:) = 1./6. * ( (2.*PSRC(:,IN+1,:) + 5.*PSRC(:,IN,:) - &
+ PSRC(:,IN-1,:)) * (0.5+SIGN(0.5,PRVCT(:,IN+1,:))) &
+ + (5.*PSRC(:,IN+1,:) + 2.*PSRC(:,IN,:) - &
+ TPHALO2%NORTH(:,:)) * (0.5-SIGN(0.5,PRVCT(:,IN+1,:))) )
+ END IF
+!
+! USE A THIRD ORDER UPSTREAM SCHEME ELSEWHERE
+!
+ PR(:,ISF:INF,:) = 1./6. * ( (2.*PSRC(:,IS:IN,:) + 5.*PSRC(:,IS-1:IN-1,:) - &
+ PSRC(:,IS-2:IN-2,:)) * (0.5+SIGN(0.5,PRVCT(:,IS:IN,:))) &
+ + (5.*PSRC(:,IS:IN,:) + 2.*PSRC(:,IS-1:IN-1,:) - &
+ PSRC(:,IS+1:IN+1,:)) * (0.5-SIGN(0.5,PRVCT(:,IS:IN,:))) )
+!
+END SELECT
+!
+PR = PR * PRVCT
+!
+END SUBROUTINE ADVEC_3RD_ORDER_MY
+!
+!-------------------------------------------------------------------------------
+!
+! #######################################
+ FUNCTION UP3_WZ(PSRC, PRWCT) RESULT(PR)
+! #######################################
+!!
+!!**** UP3_WZ - upstream fluxes of W in Z direction
+!! input variable PSRC is on W grid, and output PR is on MASS grid
+!!
+!! AUTHOR
+!! ------
+!! C.Lac * CNRM/GMME *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_CONF
+USE MODD_PARAMETERS,ONLY: JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Begining useful area in x,y,z directions
+INTEGER :: IKE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+IKB = 1 + JPVEXT
+IKE = SIZE(PSRC,3) - JPVEXT
+!
+!-------------------------------------------------------------------------------
+!
+! upstream flux on mass points
+!
+PR(:,:,IKB:IKE-1) = 1./6. * ( (2.*PSRC(:,:,IKB+1:IKE) + 5.*PSRC(:,:,IKB:IKE-1)-&
+ PSRC(:,:,IKB-1:IKE-2)) * (0.5+SIGN(0.5,PRWCT(:,:,IKB:IKE-1))) &
+ + (5.*PSRC(:,:,IKB+1:IKE) + 2.*PSRC(:,:,IKB:IKE-1)-&
+ PSRC(:,:,IKB+2:IKE+1)) * (0.5-SIGN(0.5,PRWCT(:,:,IKB:IKE-1))) )
+!
+PR(:,:,IKB-1) = PSRC(:,:,IKB-1) * (0.5+SIGN(0.5,PRWCT(:,:,IKB-1))) &
+ + PSRC(:,:,IKB ) * (0.5-SIGN(0.5,PRWCT(:,:,IKB-1)))
+PR(:,:,IKE ) = PSRC(:,:,IKE ) * (0.5+SIGN(0.5,PRWCT(:,:,IKE ))) &
+ + PSRC(:,:,IKE+1) * (0.5-SIGN(0.5,PRWCT(:,:,IKE )))
+PR(:,:,IKE+1) = -999.
+!
+PR = PR * PRWCT
+!
+END FUNCTION UP3_WZ
+!
+!-------------------------------------------------------------------------------
+!
+! #######################################
+ FUNCTION UP3_MZ(PSRC, PRWCT) RESULT(PR)
+! #######################################
+!!
+!!**** UP3_MZ - upstream fluxes of variable in Z direction
+!! input variable PSRC is on MASS grid, and output PR is on W grid
+!!
+!! AUTHOR
+!! ------
+!! C.Lac * CNRM/GMME *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_CONF
+USE MODD_PARAMETERS,ONLY: JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!
+! output source term
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Begining useful area in x,y,z directions
+INTEGER :: IKE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+IKB = 1 + JPVEXT
+IKE = SIZE(PSRC,3) - JPVEXT
+!
+!-------------------------------------------------------------------------------
+!
+! upstream flux on mass points
+!
+PR(:,:,IKB+1:IKE) = 1./6. * ( (2.*PSRC(:,:,IKB+1:IKE) + 5.*PSRC(:,:,IKB:IKE-1)-&
+ PSRC(:,:,IKB-1:IKE-2)) * (0.5+SIGN(0.5,PRWCT(:,:,IKB+1:IKE))) &
+ + (5.*PSRC(:,:,IKB+1:IKE) + 2.*PSRC(:,:,IKB:IKE-1)-&
+ PSRC(:,:,IKB+2:IKE+1)) * (0.5-SIGN(0.5,PRWCT(:,:,IKB+1:IKE))) )
+!
+PR(:,:,IKB ) = PSRC(:,:,IKB-1) * (0.5+SIGN(0.5,PRWCT(:,:,IKB ))) &
+ + PSRC(:,:,IKB ) * (0.5-SIGN(0.5,PRWCT(:,:,IKB )))
+PR(:,:,IKE+1) = PSRC(:,:,IKE ) * (0.5+SIGN(0.5,PRWCT(:,:,IKE+1))) &
+ + PSRC(:,:,IKE+1) * (0.5-SIGN(0.5,PRWCT(:,:,IKE+1)))
+PR(:,:,IKB-1) = -999.
+!
+PR = PR * PRWCT
+!
+END FUNCTION UP3_MZ
diff --git a/src/MNH/advec_weno_k_1_aux.f90 b/src/MNH/advec_weno_k_1_aux.f90
new file mode 100644
index 000000000..90abbd47f
--- /dev/null
+++ b/src/MNH/advec_weno_k_1_aux.f90
@@ -0,0 +1,343 @@
+! ##############################
+ MODULE MODI_ADVEC_WENO_K_1_AUX
+! ##############################
+!
+INTERFACE
+!
+FUNCTION UP_UX(PSRC, PRUCT) RESULT(PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
+END FUNCTION UP_UX
+!
+FUNCTION UP_MX(PSRC, PRUCT) RESULT(PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
+END FUNCTION UP_MX
+!
+FUNCTION UP_VY(PSRC, PRVCT) RESULT(PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
+END FUNCTION UP_VY
+!
+FUNCTION UP_MY(PSRC, PRVCT) RESULT(PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
+END FUNCTION UP_MY
+!
+FUNCTION UP_WZ(PSRC, PRWCT) RESULT(PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
+END FUNCTION UP_WZ
+!
+FUNCTION UP_MZ(PSRC, PRWCT) RESULT(PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
+END FUNCTION UP_MZ
+!
+END INTERFACE
+!
+END MODULE MODI_ADVEC_WENO_K_1_AUX
+!
+!-------------------------------------------------------------------------------
+!
+! ########################################################################
+ FUNCTION UP_UX(PSRC, PRUCT) RESULT(PR)
+! ########################################################################
+!!
+!!**** UP_UX - upstream fluxes of U in X direction
+!! input variable PSRC is on U grid, and output PR is on mass grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+! upstream flux on mass points
+!
+PR(IIB:IIE,:,:) = PSRC(IIB:IIE,:,:) * (0.5+SIGN(0.5,PRUCT(IIB:IIE,:,:))) +&
+ PSRC(IIB+1:IIE+1,:,:) * (0.5-SIGN(0.5,PRUCT(IIB:IIE,:,:)))
+!
+PR(IIB-1,:,:) = PR(IIE,:,:)
+PR(IIE+1,:,:) = PR(IIB,:,:)
+!
+PR = PR * PRUCT
+!
+END FUNCTION UP_UX
+!
+!-------------------------------------------------------------------------------
+!
+! ########################################################################
+ FUNCTION UP_MX(PSRC, PRUCT) RESULT(PR)
+! ########################################################################
+!!
+!!**** UP_MX - upstream fluxes of variable in X direction
+!! input variable PSRC is on MASS grid, and output PR is on U grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS GRID at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on U GRID
+!
+! output source term
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+! upstream flux on mass points
+!
+PR(IIB:IIE,:,:) = PSRC(IIB-1:IIE-1,:,:) * (0.5 + SIGN(0.5,PRUCT(IIB:IIE,:,:))) &
+ + PSRC(IIB:IIE,:,:) * (0.5 - SIGN(0.5,PRUCT(IIB:IIE,:,:)))
+!
+PR(IIB-1,:,:) = PR(IIE,:,:)
+PR(IIE+1,:,:) = PR(IIB,:,:)
+!
+PR = PR * PRUCT
+!
+END FUNCTION UP_MX
+!
+!-------------------------------------------------------------------------------
+!
+! ########################################################################
+ FUNCTION UP_VY(PSRC, PRVCT) RESULT(PR)
+! ########################################################################
+!!
+!!**** UP_VY - upstream fluxes of V in Y direction
+!! input variable PSRC is on V grid, and output PR is on MASS grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on V grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+! upstream flux on mass points
+!
+PR(:,IJB:IJE,:) = PSRC(:,IJB:IJE,:) * (0.5+SIGN(0.5,PRVCT(:,IJB:IJE,:))) +&
+ PSRC(:,IJB+1:IJE+1,:) * (0.5-SIGN(0.5,PRVCT(:,IJB:IJE,:)))
+!
+PR(:,IJB-1,:) = PR(:,IJE,:)
+PR(:,IJE+1,:) = PR(:,IJB,:)
+!
+PR = PR * PRVCT
+!
+END FUNCTION UP_VY
+!
+!-------------------------------------------------------------------------------
+!
+! ########################################################################
+ FUNCTION UP_MY(PSRC, PRVCT) RESULT(PR)
+! ########################################################################
+!!
+!!**** UP_MY - upstream fluxes of variable in Y direction
+!! input variable PSRC is on MASS grid, and output PR is on V grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on V GRID
+!
+! output source term
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+! upstream flux on mass points
+!
+PR(:,IJB:IJE,:) = PSRC(:,IJB-1:IJE-1,:) * (0.5+SIGN(0.5,PRVCT(:,IJB:IJE,:))) +&
+ PSRC(:,IJB:IJE,:) * (0.5-SIGN(0.5,PRVCT(:,IJB:IJE,:)))
+!
+PR(:,IJB-1,:) = PR(:,IJE,:)
+PR(:,IJE+1,:) = PR(:,IJB,:)
+!
+PR = PR * PRVCT
+!
+END FUNCTION UP_MY
+!
+!-------------------------------------------------------------------------------
+!
+! ########################################################################
+ FUNCTION UP_WZ(PSRC, PRWCT) RESULT(PR)
+! ########################################################################
+!!
+!!**** UP_WZ - upstream fluxes of W in Z direction
+!! input variable PSRC is on W grid, and output PR is on MASS grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_PARAMETERS,ONLY: JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Begining useful area in x,y,z directions
+INTEGER :: IKE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+IKB = 1 + JPVEXT
+IKE = SIZE(PSRC,3) - JPVEXT
+!
+! upstream flux on mass points
+!
+PR(:,:,IKB:IKE) = PSRC(:,:,IKB:IKE) * (0.5+SIGN(0.5,PRWCT(:,:,IKB:IKE))) +&
+ PSRC(:,:,IKB+1:IKE+1) * (0.5-SIGN(0.5,PRWCT(:,:,IKB:IKE)))
+!
+PR(:,:,IKB-1) = PR(:,:,IKB)
+PR(:,:,IKE+1) = PR(:,:,IKE)
+!
+PR = PR * PRWCT
+!
+END FUNCTION UP_WZ
+!
+!-------------------------------------------------------------------------------
+!
+! ########################################################################
+ FUNCTION UP_MZ(PSRC, PRWCT) RESULT(PR)
+! ########################################################################
+!!
+!!**** UP_MZ - upstream fluxes of variable in Z direction
+!! input variable PSRC is on MASS grid, and output PR is on W grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_PARAMETERS,ONLY: JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!
+! output source term
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Begining useful area in x,y,z directions
+INTEGER :: IKE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+IKB = 1 + JPVEXT
+IKE = SIZE(PSRC,3) - JPVEXT
+!
+! upstream flux on mass points
+!
+PR(:,:,IKB:IKE) = PSRC(:,:,IKB-1:IKE-1) * (0.5+SIGN(0.5,PRWCT(:,:,IKB:IKE))) +&
+ PSRC(:,:,IKB:IKE) * (0.5-SIGN(0.5,PRWCT(:,:,IKB:IKE)))
+!
+PR(:,:,IKB-1) = PR(:,:,IKB)
+PR(:,:,IKE+1) = PR(:,:,IKE)
+!
+PR = PR * PRWCT
+!
+END FUNCTION UP_MZ
diff --git a/src/MNH/advec_weno_k_2_aux.f90 b/src/MNH/advec_weno_k_2_aux.f90
new file mode 100644
index 000000000..1f3f42fc2
--- /dev/null
+++ b/src/MNH/advec_weno_k_2_aux.f90
@@ -0,0 +1,1421 @@
+! ##############################
+ MODULE MODI_ADVEC_WENO_K_2_AUX
+! ##############################
+!
+INTERFACE
+!
+ SUBROUTINE ADVEC_WENO_K_2_UX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_WENO_K_2_UX
+!
+! ----------------------------
+!
+ SUBROUTINE ADVEC_WENO_K_2_MX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_WENO_K_2_MX
+!
+! ---------------------------
+!
+ SUBROUTINE ADVEC_WENO_K_2_VY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_WENO_K_2_VY
+!
+! ------------------------------
+!
+ SUBROUTINE ADVEC_WENO_K_2_MY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_WENO_K_2_MY
+!
+! -------------------------------
+!
+FUNCTION WENO_K_2_WZ(PSRC, PRWCT) RESULT(PR)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+END FUNCTION WENO_K_2_WZ
+!
+! ------------------------------
+!
+FUNCTION WENO_K_2_MZ(PSRC, PRWCT) RESULT(PR)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!
+! output source term
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+END FUNCTION WENO_K_2_MZ
+!
+END INTERFACE
+!
+END MODULE MODI_ADVEC_WENO_K_2_AUX
+!
+!-----------------------------------------------------------------------------
+!
+! ############################################################
+ SUBROUTINE ADVEC_WENO_K_2_UX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+! ############################################################
+!!
+!!**** Computes PRUCT * PUT. Upstream fluxes of U in X direction.
+!! Input PUT is on U Grid 'ie' (i,j,k) based on UGRID reference
+!! Output PR is on mass Grid 'ie' (i+1/2,j,k) based on UGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODI_GET_HALO
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IW,IE,IWF,IEF ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!
+! intermediate reconstruction fluxes for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!
+! smoothness indicators for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./3.
+REAL, PARAMETER :: ZGAMMA2 = 2./3.
+!
+REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!-----------------------------------------------------------------------------
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
+!
+!* 1.1 CYCLIC CASE IN THE X DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+!
+ IF(NHALO == 1) THEN
+ IW=IIB
+ IE=IIE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 3rd order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+! r: many left cells in regard to 'i' cell for each stencil
+!
+! intermediate fluxes at the mass point on Ugrid u(i+1/2,j,k) for positive wind
+! (r=1 for the first stencil ZFPOS1, r=0 for the second ZFPOS2)
+!
+ ZFPOS1(IW:IE+1,:,:) = 0.5 * (3.0*PSRC(IW:IE+1,:,:) - PSRC(IW-1:IE,:,:))
+ ZFPOS1(IW-1, :,:) = 0.5 * (3.0*PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))
+!
+ ZFPOS2(IW-1:IE,:,:) = 0.5 * (PSRC(IW-1:IE,:,:) + PSRC(IW:IE+1,:,:))
+ ZFPOS2(IE+1, :,:) = 0.5 * (PSRC(IE+1, :,:) + TPHALO2%EAST(:,:))
+!
+! intermediate flux at the mass point on Ugrid (i+1/2,j,k) for negative wind
+! case (from the right to the left)
+! (r=0 for the second stencil ZFNEG2=ZFPOS2, r=-1 for the first ZFNEG1)
+!
+ ZFNEG1(IW-1:IE-1,:,:) = 0.5 * (3.0*PSRC(IW:IE,:,:) - PSRC(IW+1:IE+1,:,:))
+ ZFNEG1(IE, :,:) = 0.5 * (3.0*PSRC(IE+1, :,:) - TPHALO2%EAST(:,:))
+ ZFNEG2(IW-1:IE,:,:) = 0.5 * (PSRC(IW-1:IE,:,:) + PSRC(IW:IE+1,:,:))
+ ZFNEG2(IE+1, :,:) = 0.5 * (PSRC(IE+1, :,:) + TPHALO2%EAST(:,:))
+!
+! smoothness indicators for positive wind case
+!
+ ZBPOS1(IW:IE+1,:,:) = (PSRC(IW:IE+1,:,:) - PSRC(IW-1:IE,:,:))**2
+ ZBPOS1(IW-1, :,:) = (PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))**2
+!
+ ZBPOS2(IW-1:IE,:,:) = (PSRC(IW:IE+1,:,:) - PSRC(IW-1:IE,:,:))**2
+ ZBPOS2(IE+1, :,:) = (TPHALO2%EAST(:,:) - PSRC(IE+1, :,:))**2
+!
+! smoothness indicators for negative wind case
+!
+ ZBNEG1(IW-1:IE-1,:,:) = (PSRC(IW:IE,:,:) - PSRC(IW+1:IE+1,:,:))**2
+ ZBNEG1(IE, :,:) = (PSRC(IE+1, :,:) - TPHALO2%EAST(:,:))**2
+ ZBNEG2(IW-1:IE,:,:) = (PSRC(IW-1:IE,:,:) - PSRC(IW:IE+1,:,:))**2
+ ZBNEG2(IE+1, :,:) = (PSRC(IE+1, :,:) - TPHALO2%EAST(:,:))**2
+!
+! WENO weights
+!
+ ZOMP1 = ZGAMMA1 / (ZEPS + ZBPOS1)**2
+ ZOMP2 = ZGAMMA2 / (ZEPS + ZBPOS2)**2
+ ZOMN1 = ZGAMMA1 / (ZEPS + ZBNEG1)**2
+ ZOMN2 = ZGAMMA2 / (ZEPS + ZBNEG2)**2
+!
+! WENO fluxes
+!
+ PR = (ZOMN2/(ZOMN1+ZOMN2) * ZFNEG2 + &
+ (ZOMN1/(ZOMN1+ZOMN2) * ZFNEG1)) * (0.5-SIGN(0.5,PRUCT)) + &
+ (ZOMP2/(ZOMP1+ZOMP2) * ZFPOS2 + &
+ (ZOMP1/(ZOMP1+ZOMP2) * ZFPOS1)) * (0.5+SIGN(0.5,PRUCT))
+!
+!
+! OPEN, WALL, NEST CASE IN THE X DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+ IW=IIB
+ IE=IIE
+!
+! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
+!
+ IF(LWEST_ll()) THEN
+ PR(IW-1,:,:) = PSRC(IW-1,:,:) * (0.5+SIGN(0.5,PRUCT(IW-1,:,:))) + PSRC(IW,:,:) * (0.5-SIGN(0.5,PRUCT(IW-1,:,:)))
+!
+ ELSEIF (NHALO == 1) THEN
+ ZFPOS1(IW-1,:,:) = 0.5 * (3.0*PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))
+ ZFPOS2(IW-1,:,:) = 0.5 * (PSRC(IW-1, :,:) + PSRC(IW,:,:))
+ ZBPOS1(IW-1,:,:) = (PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))**2
+ ZBPOS2(IW-1,:,:) = (PSRC(IW, :,:) - PSRC(IW-1,:,:))**2
+!
+ ZFNEG1(IW-1,:,:) = 0.5 * (3.0*PSRC(IW,:,:) - PSRC(IW+1,:,:))
+ ZFNEG2(IW-1,:,:) = 0.5 * (PSRC(IW-1, :,:) + PSRC(IW, :,:))
+ ZBNEG1(IW-1,:,:) = (PSRC(IW, :,:) - PSRC(IW+1,:,:))**2
+ ZBNEG2(IW-1,:,:) = (PSRC(IW-1,:,:) - PSRC(IW, :,:))**2
+!
+ ZOMP1(IW-1,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IW-1,:,:))**2
+ ZOMP2(IW-1,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IW-1,:,:))**2
+ ZOMN1(IW-1,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IW-1,:,:))**2
+ ZOMN2(IW-1,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IW-1,:,:))**2
+!
+ PR(IW-1,:,:) = (ZOMN2(IW-1,:,:)/(ZOMN1(IW-1,:,:)+ZOMN2(IW-1,:,:)) * ZFNEG2(IW-1,:,:) + &
+ (ZOMN1(IW-1,:,:)/(ZOMN1(IW-1,:,:)+ZOMN2(IW-1,:,:)) * ZFNEG1(IW-1,:,:))) * (0.5-SIGN(0.5,PRUCT(IW-1,:,:))) + &
+ (ZOMP2(IW-1,:,:)/(ZOMP1(IW-1,:,:)+ZOMP2(IW-1,:,:)) * ZFPOS2(IW-1,:,:) + &
+ (ZOMP1(IW-1,:,:)/(ZOMP1(IW-1,:,:)+ZOMP2(IW-1,:,:)) * ZFPOS1(IW-1,:,:))) * (0.5+SIGN(0.5,PRUCT(IW-1,:,:)))
+!
+ ENDIF
+!
+ IF(LEAST_ll()) THEN
+ PR(IE,:,:) = PSRC(IE,:,:) * (0.5+SIGN(0.5,PRUCT(IE,:,:))) + PSRC(IE+1,:,:) * (0.5-SIGN(0.5,PRUCT(IE,:,:)))
+!
+ ELSEIF (NHALO == 1) THEN
+ ZFPOS1(IE,:,:) = 0.5 * (3.0*PSRC(IE,:,:) - PSRC(IE-1,:,:))
+ ZFPOS2(IE,:,:) = 0.5 * (PSRC(IE, :,:) + PSRC(IE+1,:,:))
+ ZBPOS1(IE,:,:) = (PSRC(IE,:,:) - PSRC(IE-1,:,:))**2
+ ZBPOS2(IE,:,:) = (PSRC(IE+1,:,:) - PSRC(IE,:,:))**2
+!
+ ZFNEG1(IE,:,:) = 0.5 * (3.0*PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))
+ ZFNEG2(IE,:,:) = 0.5 * (PSRC(IE,:,:) + PSRC(IE+1,:,:))
+ ZBNEG1(IE,:,:) = (PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))**2
+ ZBNEG2(IE,:,:) = (PSRC(IE, :,:) - PSRC(IE+1,:,:))**2
+!
+ ZOMP1(IE,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IE,:,:))**2
+ ZOMP2(IE,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IE,:,:))**2
+ ZOMN1(IE,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IE,:,:))**2
+ ZOMN2(IE,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IE,:,:))**2
+!
+ PR(IE,:,:) = (ZOMN2(IE,:,:)/(ZOMN1(IE,:,:)+ZOMN2(IE,:,:)) * ZFNEG2(IE,:,:) + &
+ (ZOMN1(IE,:,:)/(ZOMN1(IE,:,:)+ZOMN2(IE,:,:)) * ZFNEG1(IE,:,:))) * (0.5-SIGN(0.5,PRUCT(IE,:,:))) + &
+ (ZOMP2(IE,:,:)/(ZOMP1(IE,:,:)+ZOMP2(IE,:,:)) * ZFPOS2(IE,:,:) + &
+ (ZOMP1(IE,:,:)/(ZOMP1(IE,:,:)+ZOMP2(IE,:,:)) * ZFPOS1(IE,:,:))) * (0.5+SIGN(0.5,PRUCT(IE,:,:)))
+!
+ ENDIF
+!
+! USE A THIRD ORDER UPSTREAM WENO SCHEME ELSEWHERE
+!
+ ZFPOS1(IW:IE-1,:,:) = 0.5 * (3.0*PSRC(IW:IE-1,:,:) - PSRC(IW-1:IE-2,:,:))
+ ZFPOS2(IW:IE-1,:,:) = 0.5 * (PSRC(IW:IE-1, :,:) + PSRC(IW+1:IE, :,:))
+ ZBPOS1(IW:IE-1,:,:) = (PSRC(IW:IE-1,:,:) - PSRC(IW-1:IE-2,:,:))**2
+ ZBPOS2(IW:IE-1,:,:) = (PSRC(IW+1:IE,:,:) - PSRC(IW:IE-1, :,:))**2
+!
+ ZFNEG1(IW:IE-1,:,:) = 0.5 * (3.0*PSRC(IW+1:IE,:,:) - PSRC(IW+2:IE+1,:,:))
+ ZFNEG2(IW:IE-1,:,:) = 0.5 * (PSRC(IW:IE-1, :,:) + PSRC(IW+1:IE, :,:))
+ ZBNEG1(IW:IE-1,:,:) = (PSRC(IW+1:IE,:,:) - PSRC(IW+2:IE+1,:,:))**2
+ ZBNEG2(IW:IE-1,:,:) = (PSRC(IW:IE-1,:,:) - PSRC(IW+1:IE,:,:))**2
+!
+ ZOMP1(IW:IE-1,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IW:IE-1,:,:))**2
+ ZOMP2(IW:IE-1,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IW:IE-1,:,:))**2
+ ZOMN1(IW:IE-1,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IW:IE-1,:,:))**2
+ ZOMN2(IW:IE-1,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IW:IE-1,:,:))**2
+!
+ PR(IW:IE-1,:,:) = (ZOMN2(IW:IE-1,:,:)/(ZOMN1(IW:IE-1,:,:)+ZOMN2(IW:IE-1,:,:)) * ZFNEG2(IW:IE-1,:,:) + &
+ (ZOMN1(IW:IE-1,:,:)/(ZOMN1(IW:IE-1,:,:)+ZOMN2(IW:IE-1,:,:)) * ZFNEG1(IW:IE-1,:,:))) * (0.5-SIGN(0.5,PRUCT(IW:IE-1,:,:))) + &
+ (ZOMP2(IW:IE-1,:,:)/(ZOMP1(IW:IE-1,:,:)+ZOMP2(IW:IE-1,:,:)) * ZFPOS2(IW:IE-1,:,:) + &
+ (ZOMP1(IW:IE-1,:,:)/(ZOMP1(IW:IE-1,:,:)+ZOMP2(IW:IE-1,:,:)) * ZFPOS1(IW:IE-1,:,:))) * (0.5+SIGN(0.5,PRUCT(IW:IE-1,:,:)))
+!
+END SELECT
+!
+PR = PR * PRUCT
+CALL GET_HALO(PR)
+!
+END SUBROUTINE ADVEC_WENO_K_2_UX
+!
+!------------------------------------------------------------------------------
+!
+! ############################################################
+ SUBROUTINE ADVEC_WENO_K_2_MX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+! ############################################################
+!!
+!!**** Computes PRUCT * PWT (or PRUCT * PVT). Upstream fluxes of W (or V)
+!! variables in X direction.
+!! Input PWT is on W Grid 'ie' (i,j,k) based on WGRID reference
+!! Output PR is on mass Grid 'ie' (i-1/2,j,k) based on WGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODI_GET_HALO
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IW,IE ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!
+! intermediate reconstruction fluxes for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!
+! smoothness indicators for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./3.
+REAL, PARAMETER :: ZGAMMA2 = 2./3.
+!
+REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!-----------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+!
+!------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
+!
+!* 1.1 CYCLIC CASE IN THE X DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+!
+ IF(NHALO == 1) THEN
+ IW=IIB
+ IE=IIE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 3rd order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+! intermediate fluxes for positive wind case
+!
+ ZFPOS1(IW+1:IE+1,:,:) = 0.5 * (3.0*PSRC(IW:IE,:,:) - PSRC(IW-1:IE-1,:,:))
+ ZFPOS1(IW, :,:) = 0.5 * (3.0*PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))
+!! ZFPOS1(IW-1, :,:) = - 999.
+!
+ ZFPOS2(IW:IE+1,:,:) = 0.5 * (PSRC(IW-1:IE,:,:) + PSRC(IW:IE+1,:,:))
+ ZFPOS2(IW-1, :,:) = 0.5 * (TPHALO2%WEST(:,:) + PSRC(IW-1, :,:))
+!
+! intermediate flux for negative wind case
+!
+ ZFNEG1(IW-1:IE,:,:) = 0.5 * (3.0*PSRC(IW-1:IE,:,:) - PSRC(IW:IE+1,:,:))
+ ZFNEG1(IE+1, :,:) = 0.5 * (3.0*PSRC(IE+1, :,:) - TPHALO2%EAST(:,:))
+!
+ ZFNEG2(IW:IE+1,:,:) = 0.5 * (PSRC(IW:IE+1,:,:) + PSRC(IW-1:IE,:,:))
+ ZFNEG2(IW-1, :,:) = 0.5 * (PSRC(IW-1, :,:) + TPHALO2%WEST(:,:))
+!
+! smoothness indicators for positive wind case
+!
+ ZBPOS1(IW+1:IE+1,:,:) = (PSRC(IW:IE,:,:) - PSRC(IW-1:IE-1,:,:))**2
+ ZBPOS1(IW, :,:) = (PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))**2
+!! ZBPOS1(IW-1, :,:) = - 999.
+!
+ ZBPOS2(IW:IE+1,:,:) = (PSRC(IW:IE+1,:,:) - PSRC(IW-1:IE,:,:))**2
+ ZBPOS2(IW-1, :,:) = (PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))**2
+!
+! smoothness indicators for negative wind case
+!
+ ZBNEG1(IW-1:IE,:,:) = (PSRC(IW-1:IE,:,:) - PSRC(IW:IE+1,:,:))**2
+ ZBNEG1(IE+1, :,:) = (PSRC(IE+1, :,:) - TPHALO2%EAST(:,:))**2
+!
+ ZBNEG2(IW:IE+1,:,:) = (PSRC(IW-1:IE,:,:) - PSRC(IW:IE+1,:,:))**2
+ ZBNEG2(IW-1, :,:) = (TPHALO2%WEST(:,:) - PSRC(IW-1,:,:))**2
+!
+! WENO weights
+!
+ ZOMP1 = ZGAMMA1 / (ZEPS + ZBPOS1)**2
+ ZOMP2 = ZGAMMA2 / (ZEPS + ZBPOS2)**2
+ ZOMN1 = ZGAMMA1 / (ZEPS + ZBNEG1)**2
+ ZOMN2 = ZGAMMA2 / (ZEPS + ZBNEG2)**2
+!
+! WENO fluxes
+!
+ PR = (ZOMP2/(ZOMP1+ZOMP2) * ZFPOS2 + &
+ (ZOMP1/(ZOMP1+ZOMP2) * ZFPOS1)) * (0.5+SIGN(0.5,PRUCT )) + &
+ (ZOMN2/(ZOMN1+ZOMN2) * ZFNEG2 + &
+ (ZOMN1/(ZOMN1+ZOMN2) * ZFNEG1)) * (0.5-SIGN(0.5,PRUCT ))
+!
+!
+! OPEN, WALL, NEST CASE IN THE X DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+ IW=IIB
+ IE=IIE
+!
+! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
+!
+ IF(LWEST_ll()) THEN
+ PR(IW,:,:) = PSRC(IW-1,:,:) * (0.5+SIGN(0.5,PRUCT(IW,:,:))) + PSRC(IW,:,:) * (0.5-SIGN(0.5,PRUCT(IW,:,:)))
+!
+ ELSEIF (NHALO == 1) THEN
+ ZFPOS1(IW,:,:) = 0.5 * (3.0*PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))
+ ZFPOS2(IW,:,:) = 0.5 * (PSRC(IW-1, :,:) + PSRC(IW, :,:))
+ ZBPOS1(IW,:,:) = (PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))**2
+ ZBPOS2(IW,:,:) = (PSRC(IW, :,:) - PSRC(IW-1,:,:))**2
+!
+ ZFNEG1(IW,:,:) = 0.5 * (3.0*PSRC(IW,:,:) - PSRC(IW+1,:,:))
+ ZFNEG2(IW,:,:) = 0.5 * (PSRC(IW, :,:) + PSRC(IW-1,:,:))
+ ZBNEG1(IW,:,:) = (PSRC(IW,:,:) - PSRC(IW+1,:,:))**2
+ ZBNEG2(IW,:,:) = (PSRC(IW-1,:,:) - PSRC(IW,:,:))**2
+!
+ ZOMP1(IW,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IW,:,:))**2
+ ZOMP2(IW,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IW,:,:))**2
+ ZOMN1(IW,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IW,:,:))**2
+ ZOMN2(IW,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IW,:,:))**2
+!
+ PR(IW,:,:) = (ZOMP2(IW,:,:)/(ZOMP1(IW,:,:)+ZOMP2(IW,:,:)) * ZFPOS2(IW,:,:) + &
+ (ZOMP1(IW,:,:)/(ZOMP1(IW,:,:)+ZOMP2(IW,:,:)) * ZFPOS1(IW,:,:))) * (0.5+SIGN(0.5,PRUCT(IW,:,:))) + &
+ (ZOMN2(IW,:,:)/(ZOMN1(IW,:,:)+ZOMN2(IW,:,:)) * ZFNEG2(IW,:,:) + &
+ (ZOMN1(IW,:,:)/(ZOMN1(IW,:,:)+ZOMN2(IW,:,:)) * ZFNEG1(IW,:,:))) * (0.5-SIGN(0.5,PRUCT(IW,:,:)))
+!
+ ENDIF
+!
+ IF(LEAST_ll()) THEN
+ PR(IE+1,:,:) = PSRC(IE,:,:) * (0.5+SIGN(0.5,PRUCT(IE+1,:,:))) + PSRC(IE+1,:,:) * (0.5-SIGN(0.5,PRUCT(IE+1,:,:)))
+!
+ ELSEIF (NHALO == 1) THEN
+ ZFPOS1(IE+1,:,:) = 0.5 * (3.0*PSRC(IE,:,:) - PSRC(IE-1,:,:))
+ ZFPOS2(IE+1,:,:) = 0.5 * (PSRC(IE, :,:) + PSRC(IE+1,:,:))
+ ZBPOS1(IE+1,:,:) = (PSRC(IE,:,:) - PSRC(IE-1,:,:))**2
+ ZBPOS2(IE+1,:,:) = (PSRC(IE+1,:,:) - PSRC(IE,:,:))**2
+!
+ ZFNEG1(IE+1,:,:) = 0.5 * (3.0*PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))
+ ZFNEG2(IE+1,:,:) = 0.5 * (PSRC(IE+1, :,:) + PSRC(IE,:,:))
+ ZBNEG1(IE+1,:,:) = (PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))**2
+ ZBNEG2(IE+1,:,:) = (PSRC(IE, :,:) - PSRC(IE+1,:,:))**2
+!
+ ZOMP1(IE+1,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IE+1,:,:))**2
+ ZOMP2(IE+1,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IE+1,:,:))**2
+ ZOMN1(IE+1,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IE+1,:,:))**2
+ ZOMN2(IE+1,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IE+1,:,:))**2
+!
+ PR(IE+1,:,:) = (ZOMP2(IE+1,:,:)/(ZOMP1(IE+1,:,:)+ZOMP2(IE+1,:,:)) * ZFPOS2(IE+1,:,:) + &
+ (ZOMP1(IE+1,:,:)/(ZOMP1(IE+1,:,:)+ZOMP2(IE+1,:,:)) * ZFPOS1(IE+1,:,:))) * (0.5+SIGN(0.5,PRUCT(IE+1,:,:))) + &
+ (ZOMN2(IE+1,:,:)/(ZOMN1(IE+1,:,:)+ZOMN2(IE+1,:,:)) * ZFNEG2(IE+1,:,:) + &
+ (ZOMN1(IE+1,:,:)/(ZOMN1(IE+1,:,:)+ZOMN2(IE+1,:,:)) * ZFNEG1(IE+1,:,:))) * (0.5-SIGN(0.5,PRUCT(IE+1,:,:)))
+!
+ ENDIF
+!
+! USE A THIRD ORDER UPSTREAM WENO SCHEME ELSEWHERE
+!
+ ZFPOS1(IW+1:IE,:,:) = 0.5 * (3.0*PSRC(IW:IE-1,:,:) - PSRC(IW-1:IE-2,:,:))
+ ZFPOS2(IW+1:IE,:,:) = 0.5 * (PSRC(IW:IE-1, :,:) + PSRC(IW+1:IE, :,:))
+ ZBPOS1(IW+1:IE,:,:) = (PSRC(IW:IE-1,:,:) - PSRC(IW-1:IE-2,:,:))**2
+ ZBPOS2(IW+1:IE,:,:) = (PSRC(IW+1:IE,:,:) - PSRC(IW:IE-1,:,:))**2
+!
+ ZFNEG1(IW+1:IE,:,:) = 0.5 * (3.0*PSRC(IW+1:IE,:,:) - PSRC(IW+2:IE+1,:,:))
+ ZFNEG2(IW+1:IE,:,:) = 0.5 * (PSRC(IW+1:IE, :,:) + PSRC(IW:IE-1, :,:))
+ ZBNEG1(IW+1:IE,:,:) = (PSRC(IW+1:IE,:,:) - PSRC(IW+2:IE+1,:,:))**2
+ ZBNEG2(IW+1:IE,:,:) = (PSRC(IW:IE-1,:,:) - PSRC(IW+1:IE,:,:))**2
+!
+ ZOMP1(IW+1:IE,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IW+1:IE,:,:))**2
+ ZOMP2(IW+1:IE,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IW+1:IE,:,:))**2
+ ZOMN1(IW+1:IE,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IW+1:IE,:,:))**2
+ ZOMN2(IW+1:IE,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IW+1:IE,:,:))**2
+!
+ PR(IW+1:IE,:,:) = (ZOMP2(IW+1:IE,:,:)/(ZOMP1(IW+1:IE,:,:)+ZOMP2(IW+1:IE,:,:)) * ZFPOS2(IW+1:IE,:,:) + &
+ (ZOMP1(IW+1:IE,:,:)/(ZOMP1(IW+1:IE,:,:)+ZOMP2(IW+1:IE,:,:)) * ZFPOS1(IW+1:IE,:,:))) * (0.5+SIGN(0.5,PRUCT(IW+1:IE,:,:))) + &
+ (ZOMN2(IW+1:IE,:,:)/(ZOMN1(IW+1:IE,:,:)+ZOMN2(IW+1:IE,:,:)) * ZFNEG2(IW+1:IE,:,:) + &
+ (ZOMN1(IW+1:IE,:,:)/(ZOMN1(IW+1:IE,:,:)+ZOMN2(IW+1:IE,:,:)) * ZFNEG1(IW+1:IE,:,:))) * (0.5-SIGN(0.5,PRUCT(IW+1:IE,:,:)))
+!
+END SELECT
+!
+PR = PR * PRUCT
+CALL GET_HALO(PR)
+!
+END SUBROUTINE ADVEC_WENO_K_2_MX
+!
+!-------------------------------------------------------------------------------
+!
+! ############################################################
+ SUBROUTINE ADVEC_WENO_K_2_MY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+! ############################################################
+!!
+!!**** Computes PRVCT * PUT (or PRVCT * PWT). Upstream fluxes of U (or W)
+!! variables in Y direction.
+!! Input PUT is on U Grid 'ie' (i,j,k) based on UGRID reference
+!! Output PR is on mass Grid 'ie' (i,j-1/2,k) based on UGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODI_GET_HALO
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IS,IN ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!
+! intermediate reconstruction fluxes for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!
+! smoothness indicators for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./3.
+REAL, PARAMETER :: ZGAMMA2 = 2./3.
+!
+REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!-----------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!---------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCY(1) ) !
+!
+!* 1.1 CYCLIC CASE IN THE Y DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCY(1) == HLBCY(2)
+!
+ IF(NHALO == 1) THEN
+ IS=IJB
+ IN=IJE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 4th order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+! intermediate fluxes for positive wind case
+!
+ ZFPOS1(:,IS+1:IN+1,:) = 0.5 * (3.0*PSRC(:,IS:IN,:) - PSRC(:,IS-1:IN-1,:))
+ ZFPOS1(:,IS, :) = 0.5 * (3.0*PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))
+!! ZFPOS1(:,IS-1, :) = - 999.
+!
+ ZFPOS2(:,IS:IN+1,:) = 0.5 * (PSRC(:,IS-1:IN,:) + PSRC(:,IS:IN+1,:))
+ ZFPOS2(:,IS-1, :) = 0.5 * (TPHALO2%SOUTH(:,:) + PSRC(:,IS-1, :))
+!
+ ZFNEG1(:,IS-1:IN,:) = 0.5 * (3.0*PSRC(:,IS-1:IN,:) - PSRC(:,IS:IN+1,:))
+ ZFNEG1(:,IN+1, :) = 0.5 * (3.0*PSRC(:,IN+1, :) - TPHALO2%NORTH(:,:))
+!
+ ZFNEG2(:,IS:IN+1,:) = 0.5 * (PSRC(:,IS:IN+1,:) + PSRC(:,IS-1:IN,:))
+ ZFNEG2(:,IS-1, :) = 0.5 * (PSRC(:,IS-1, :) + TPHALO2%SOUTH(:,:))
+!
+! smoothness indicators for positive wind case
+!
+ ZBPOS1(:,IS+1:IN+1,:) = (PSRC(:,IS:IN,:) - PSRC(:,IS-1:IN-1,:))**2
+ ZBPOS1(:,IS, :) = (PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))**2
+!! ZBPOS1(:,IS-1, :) = - 999.
+!
+ ZBPOS2(:,IS:IN+1,:) = (PSRC(:,IS:IN+1,:) - PSRC(:,IS-1:IN,:))**2
+ ZBPOS2(:,IS-1, :) = (PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))**2
+!
+! smoothness indicators for negative wind case
+!
+ ZBNEG1(:,IS-1:IN,:) = (PSRC(:,IS-1:IN,:) - PSRC(:,IS:IN+1,:))**2
+ ZBNEG1(:,IN+1, :) = (PSRC(:,IN+1, :) - TPHALO2%NORTH(:,:))**2
+!
+ ZBNEG2(:,IS:IN+1,:) = (PSRC(:,IS-1:IN,:) - PSRC(:,IS:IN+1,:))**2
+ ZBNEG2(:,IS-1, :) = (TPHALO2%SOUTH(:,:) - PSRC(:,IS-1,:))**2
+!
+! WENO weights
+!
+ ZOMP1 = ZGAMMA1 / (ZEPS + ZBPOS1)**2
+ ZOMP2 = ZGAMMA2 / (ZEPS + ZBPOS2)**2
+ ZOMN1 = ZGAMMA1 / (ZEPS + ZBNEG1)**2
+ ZOMN2 = ZGAMMA2 / (ZEPS + ZBNEG2)**2
+!
+! WENO fluxes
+!
+ PR = (ZOMP2/(ZOMP1+ZOMP2) * ZFPOS2 + &
+ (ZOMP1/(ZOMP1+ZOMP2) * ZFPOS1)) * (0.5+SIGN(0.5,PRVCT)) + &
+ (ZOMN2/(ZOMN1+ZOMN2) * ZFNEG2 + &
+ (ZOMN1/(ZOMN1+ZOMN2) * ZFNEG1)) * (0.5-SIGN(0.5,PRVCT))
+!
+!
+! OPEN, WALL, NEST CASE IN THE Y DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+ IS=IJB
+ IN=IJE
+!
+! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
+!
+ IF(LSOUTH_ll()) THEN
+ PR(:,IS,:) = PSRC(:,IS-1,:) * (0.5+SIGN(0.5,PRVCT(:,IS,:))) + PSRC(:,IS,:) * (0.5-SIGN(0.5,PRVCT(:,IS,:)))
+!
+ ELSEIF (NHALO == 1) THEN
+ ZFPOS1(:,IS,:) = 0.5 * (3.0*PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))
+ ZFPOS2(:,IS,:) = 0.5 * (PSRC(:,IS-1,:) + PSRC(:,IS,:))
+ ZBPOS1(:,IS,:) = (PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))**2
+ ZBPOS2(:,IS,:) = (PSRC(:,IS, :) - PSRC(:,IS-1,:))**2
+!
+ ZFNEG1(:,IS,:) = 0.5 * (3.0*PSRC(:,IS,:) - PSRC(:,IS+1,:))
+ ZFNEG2(:,IS,:) = 0.5 * (PSRC(:,IS, :) + PSRC(:,IS-1,:))
+ ZBNEG1(:,IS,:) = (PSRC(:,IS, :) - PSRC(:,IS+1,:))**2
+ ZBNEG2(:,IS,:) = (PSRC(:,IS-1,:) - PSRC(:,IS, :))**2
+!
+ ZOMP1(:,IS,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IS,:))**2
+ ZOMP2(:,IS,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IS,:))**2
+ ZOMN1(:,IS,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IS,:))**2
+ ZOMN2(:,IS,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IS,:))**2
+!
+ PR(:,IS,:) = (ZOMP2(:,IS,:)/(ZOMP1(:,IS,:)+ZOMP2(:,IS,:)) * ZFPOS2(:,IS,:) + &
+ (ZOMP1(:,IS,:)/(ZOMP1(:,IS,:)+ZOMP2(:,IS,:)) * ZFPOS1(:,IS,:))) * (0.5+SIGN(0.5,PRVCT(:,IS,:))) + &
+ (ZOMN2(:,IS,:)/(ZOMN1(:,IS,:)+ZOMN2(:,IS,:)) * ZFNEG2(:,IS,:) + &
+ (ZOMN1(:,IS,:)/(ZOMN1(:,IS,:)+ZOMN2(:,IS,:)) * ZFNEG1(:,IS,:))) * (0.5-SIGN(0.5,PRVCT(:,IS,:)))
+!
+ ENDIF
+!
+ IF(LNORTH_ll()) THEN
+ PR(:,IN+1,:) = PSRC(:,IN,:) * (0.5+SIGN(0.5,PRVCT(:,IN+1,:))) + PSRC(:,IN+1,:) * (0.5-SIGN(0.5,PRVCT(:,IN+1,:)))
+!
+ ELSEIF (NHALO == 1) THEN
+ ZFPOS1(:,IN+1,:) = 0.5 * (3.0*PSRC(:,IN,:) - PSRC(:,IN-1,:))
+ ZFPOS2(:,IN+1,:) = 0.5 * (PSRC(:,IN, :) + PSRC(:,IN+1,:))
+ ZBPOS1(:,IN+1,:) = (PSRC(:,IN,:) - PSRC(:,IN-1,:))**2
+ ZBPOS2(:,IN+1,:) = (PSRC(:,IN+1,:) - PSRC(:,IN,:))**2
+!
+ ZFNEG1(:,IN+1,:) = 0.5 * (3.0*PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))
+ ZFNEG2(:,IN+1,:) = 0.5 * (PSRC(:,IN+1, :) + PSRC(:,IN,:))
+ ZBNEG1(:,IN+1,:) = (PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))**2
+ ZBNEG2(:,IN+1,:) = (PSRC(:,IN, :) - PSRC(:,IN+1,:))**2
+!
+ ZOMP1(:,IN+1,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IN+1,:))**2
+ ZOMP2(:,IN+1,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IN+1,:))**2
+ ZOMN1(:,IN+1,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IN+1,:))**2
+ ZOMN2(:,IN+1,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IN+1,:))**2
+!
+ PR(:,IN+1,:) = (ZOMP2(:,IN+1,:)/(ZOMP1(:,IN+1,:)+ZOMP2(:,IN+1,:)) * ZFPOS2(:,IN+1,:) + &
+ (ZOMP1(:,IN+1,:)/(ZOMP1(:,IN+1,:)+ZOMP2(:,IN+1,:)) * ZFPOS1(:,IN+1,:))) * (0.5+SIGN(0.5,PRVCT(:,IN+1,:))) + &
+ (ZOMN2(:,IN+1,:)/(ZOMN1(:,IN+1,:)+ZOMN2(:,IN+1,:)) * ZFNEG2(:,IN+1,:) + &
+ (ZOMN1(:,IN+1,:)/(ZOMN1(:,IN+1,:)+ZOMN2(:,IN+1,:)) * ZFNEG1(:,IN+1,:))) * (0.5-SIGN(0.5,PRVCT(:,IN+1,:)))
+!
+ ENDIF
+!
+! USE A THIRD ORDER UPSTREAM WENO SCHEME ELSEWHERE
+!
+ ZFPOS1(:,IS+1:IN,:) = 0.5 * (3.0*PSRC(:,IS:IN-1,:) - PSRC(:,IS-1:IN-2,:))
+ ZFPOS2(:,IS+1:IN,:) = 0.5 * (PSRC(:,IS:IN-1, :) + PSRC(:,IS+1:IN, :))
+ ZBPOS1(:,IS+1:IN,:) = (PSRC(:,IS:IN-1,:) - PSRC(:,IS-1:IN-2,:))**2
+ ZBPOS2(:,IS+1:IN,:) = (PSRC(:,IS+1:IN,:) - PSRC(:,IS:IN-1, :))**2
+!
+ ZFNEG1(:,IS+1:IN,:) = 0.5 * (3.0*PSRC(:,IS+1:IN,:) - PSRC(:,IS+2:IN+1,:))
+ ZFNEG2(:,IS+1:IN,:) = 0.5 * (PSRC(:,IS+1:IN, :) + PSRC(:,IS:IN-1, :))
+ ZBNEG1(:,IS+1:IN,:) = (PSRC(:,IS+1:IN,:) - PSRC(:,IS+2:IN+1,:))**2
+ ZBNEG2(:,IS+1:IN,:) = (PSRC(:,IS:IN-1,:) - PSRC(:,IS+1:IN,:))**2
+!
+ ZOMP1(:,IS+1:IN,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IS+1:IN,:))**2
+ ZOMP2(:,IS+1:IN,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IS+1:IN,:))**2
+ ZOMN1(:,IS+1:IN,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IS+1:IN,:))**2
+ ZOMN2(:,IS+1:IN,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IS+1:IN,:))**2
+!
+ PR(:,IS+1:IN,:) = (ZOMP2(:,IS+1:IN,:)/(ZOMP1(:,IS+1:IN,:)+ZOMP2(:,IS+1:IN,:)) * ZFPOS2(:,IS+1:IN,:) + &
+ (ZOMP1(:,IS+1:IN,:)/(ZOMP1(:,IS+1:IN,:)+ZOMP2(:,IS+1:IN,:)) * ZFPOS1(:,IS+1:IN,:))) * (0.5+SIGN(0.5,PRVCT(:,IS+1:IN,:))) + &
+ (ZOMN2(:,IS+1:IN,:)/(ZOMN1(:,IS+1:IN,:)+ZOMN2(:,IS+1:IN,:)) * ZFNEG2(:,IS+1:IN,:) + &
+ (ZOMN1(:,IS+1:IN,:)/(ZOMN1(:,IS+1:IN,:)+ZOMN2(:,IS+1:IN,:)) * ZFNEG1(:,IS+1:IN,:))) * (0.5-SIGN(0.5,PRVCT(:,IS+1:IN,:)))
+!
+END SELECT
+!
+PR = PR * PRVCT
+CALL GET_HALO(PR)
+!
+END SUBROUTINE ADVEC_WENO_K_2_MY
+!-------------------------------------------------------------------------------
+!
+! #############################################################
+ SUBROUTINE ADVEC_WENO_K_2_VY(HLBCY, PSRC, PRVCT, PR, TPHALO2)
+! #############################################################
+!!
+!!**** Computes PRVCT * PVT. Upstream fluxes of V in Y direction.
+!! Input PVT is on V Grid 'ie' (i,j,k) based on VGRID reference
+!! Output PR is on mass Grid 'ie' (i,j+1/2,k) based on VGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODI_GET_HALO
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IS,IN ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!
+! intermediate reconstruction fluxes for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!
+! smoothness indicators for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./3.
+REAL, PARAMETER :: ZGAMMA2 = 2./3.
+!
+REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!----------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!--------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCY(1) ) ! Y direction LBC type: (1) for left side
+!
+!* 1.1 CYCLIC CASE IN THE Y DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+!
+ IF(NHALO == 1) THEN
+ IS=IJB
+ IN=IJE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 4th order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+! intermediate fluxes for positive wind case
+!
+ ZFPOS1(:,IS:IN+1,:) = 0.5 * (3.0*PSRC(:,IS:IN+1,:) - PSRC(:,IS-1:IN,:))
+ ZFPOS1(:,IS-1, :) = 0.5 * (3.0*PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))
+!
+ ZFPOS2(:,IS-1:IN,:) = 0.5 * (PSRC(:,IS-1:IN,:) + PSRC(:,IS:IN+1,:))
+ ZFPOS2(:,IN+1, :) = 0.5 * (PSRC(:,IN+1, :) + TPHALO2%NORTH(:,:))
+!
+! intermediate flux for negative wind case
+!
+ ZFNEG1(:,IS-1:IN-1,:) = 0.5 * (3.0*PSRC(:,IS:IN,:) - PSRC(:,IS+1:IN+1,:))
+ ZFNEG1(:,IN, :) = 0.5 * (3.0*PSRC(:,IN+1, :) - TPHALO2%NORTH(:,:))
+!
+ ZFNEG2(:,IS-1:IN,:) = 0.5 * (PSRC(:,IS-1:IN,:) + PSRC(:,IS:IN+1,:))
+ ZFNEG2(:,IN+1, :) = 0.5 * (PSRC(:,IN+1, :) + TPHALO2%NORTH(:,:))
+!
+! smoothness indicators for positive wind case
+!
+ ZBPOS1(:,IS:IN+1,:) = (PSRC(:,IS:IN+1,:) - PSRC(:,IS-1:IN,:))**2
+ ZBPOS1(:,IS-1, :) = (PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))**2
+!
+ ZBPOS2(:,IS-1:IN,:) = (PSRC(:,IS:IN+1,:) - PSRC(:,IS-1:IN,:))**2
+ ZBPOS2(:,IN+1, :) = (TPHALO2%NORTH(:,:) - PSRC(:,IN+1, :))**2
+!
+! smoothness indicators for negative wind case
+!
+ ZBNEG1(:,IS-1:IN-1,:) = (PSRC(:,IS:IN,:) - PSRC(:,IS+1:IN+1,:))**2
+ ZBNEG1(:,IN, :) = (PSRC(:,IN+1, :) - TPHALO2%NORTH(:,:))**2
+!
+ ZBNEG2(:,IS-1:IN,:) = (PSRC(:,IS-1:IN,:) - PSRC(:,IS:IN+1,:))**2
+ ZBNEG2(:,IN+1, :) = (PSRC(:,IN+1, :) - TPHALO2%NORTH(:,:))**2
+!
+! WENO weights
+!
+ ZOMP1 = ZGAMMA1 / (ZEPS + ZBPOS1)**2
+ ZOMP2 = ZGAMMA2 / (ZEPS + ZBPOS2)**2
+ ZOMN1 = ZGAMMA1 / (ZEPS + ZBNEG1)**2
+ ZOMN2 = ZGAMMA2 / (ZEPS + ZBNEG2)**2
+!
+ PR = (ZOMP2/(ZOMP1+ZOMP2) * ZFPOS2 + &
+ (ZOMP1/(ZOMP1+ZOMP2) * ZFPOS1)) * (0.5+SIGN(0.5,PRVCT)) + &
+ (ZOMN2/(ZOMN1+ZOMN2) * ZFNEG2 + &
+ (ZOMN1/(ZOMN1+ZOMN2) * ZFNEG1)) * (0.5-SIGN(0.5,PRVCT))
+!
+!
+! OPEN, WALL, NEST CASE IN THE Y DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+ IS=IJB
+ IN=IJE
+!
+! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
+!
+ IF(LSOUTH_ll()) THEN
+ PR(:,IS-1,:) = PSRC(:,IS-1,:) * (0.5+SIGN(0.5,PRVCT(:,IS-1,:))) + PSRC(:,IS,:) * (0.5-SIGN(0.5,PRVCT(:,IS-1,:)))
+!
+ ELSEIF (NHALO == 1) THEN
+ ZFPOS1(:,IS-1,:) = 0.5 * (3.0*PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))
+ ZFPOS2(:,IS-1,:) = 0.5 * (PSRC(:,IS-1, :) + PSRC(:,IS,:))
+ ZBPOS1(:,IS-1,:) = (PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))**2
+ ZBPOS2(:,IS-1,:) = (PSRC(:,IS, :) - PSRC(:,IS-1,:))**2
+!
+ ZFNEG1(:,IS-1,:) = 0.5 * (3.0*PSRC(:,IS,:) - PSRC(:,IS+1,:))
+ ZFNEG2(:,IS-1,:) = 0.5 * (PSRC(:,IS-1, :) + PSRC(:,IS,:))
+ ZBNEG1(:,IS-1,:) = (PSRC(:,IS,:) - PSRC(:,IS+1,:))**2
+ ZBNEG2(:,IS-1,:) = (PSRC(:,IS-1,:) - PSRC(:,IS,:))**2
+!
+ ZOMP1(:,IS-1,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IS-1,:))**2
+ ZOMP2(:,IS-1,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IS-1,:))**2
+ ZOMN1(:,IS-1,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IS-1,:))**2
+ ZOMN2(:,IS-1,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IS-1,:))**2
+!
+ PR(:,IS-1,:) = (ZOMP2(:,IS-1,:)/(ZOMP1(:,IS-1,:)+ZOMP2(:,IS-1,:)) * ZFPOS2(:,IS-1,:) + &
+ (ZOMP1(:,IS-1,:)/(ZOMP1(:,IS-1,:)+ZOMP2(:,IS-1,:)) * ZFPOS1(:,IS-1,:))) * (0.5+SIGN(0.5,PRVCT(:,IS-1,:))) + &
+ (ZOMN2(:,IS-1,:)/(ZOMN1(:,IS-1,:)+ZOMN2(:,IS-1,:)) * ZFNEG2(:,IS-1,:) + &
+ (ZOMN1(:,IS-1,:)/(ZOMN1(:,IS-1,:)+ZOMN2(:,IS-1,:)) * ZFNEG1(:,IS-1,:))) * (0.5-SIGN(0.5,PRVCT(:,IS-1,:)))
+!
+ ENDIF
+!
+ IF(LNORTH_ll()) THEN
+ PR(:,IN,:) = PSRC(:,IN,:) * (0.5+SIGN(0.5,PRVCT(:,IN,:))) + PSRC(:,IN+1,:) * (0.5-SIGN(0.5,PRVCT(:,IN,:)))
+!
+ ELSEIF (NHALO == 1) THEN
+ ZFPOS1(:,IN,:) = 0.5 * (3.0*PSRC(:,IN,:) - PSRC(:,IN-1,:))
+ ZFPOS2(:,IN,:) = 0.5 * (PSRC(:,IN, :) + PSRC(:,IN+1,:))
+ ZBPOS1(:,IN,:) = (PSRC(:,IN, :) - PSRC(:,IN-1,:))**2
+ ZBPOS2(:,IN,:) = (PSRC(:,IN+1,:) - PSRC(:,IN, :))**2
+!
+ ZFNEG1(:,IN,:) = 0.5 * (3.0*PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))
+ ZFNEG2(:,IN,:) = 0.5 * (PSRC(:,IN, :) + PSRC(:,IN+1,:))
+ ZBNEG1(:,IN,:) = (PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))**2
+ ZBNEG2(:,IN,:) = (PSRC(:,IN, :) - PSRC(:,IN+1,:))**2
+!
+ ZOMP1(:,IN,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IN,:))**2
+ ZOMP2(:,IN,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IN,:))**2
+ ZOMN1(:,IN,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IN,:))**2
+ ZOMN2(:,IN,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IN,:))**2
+!
+ PR(:,IN,:) = (ZOMP2(:,IN,:)/(ZOMP1(:,IN,:)+ZOMP2(:,IN,:)) * ZFPOS2(:,IN,:) + &
+ (ZOMP1(:,IN,:)/(ZOMP1(:,IN,:)+ZOMP2(:,IN,:)) * ZFPOS1(:,IN,:))) * (0.5+SIGN(0.5,PRVCT(:,IN,:))) + &
+ (ZOMN2(:,IN,:)/(ZOMN1(:,IN,:)+ZOMN2(:,IN,:)) * ZFNEG2(:,IN,:) + &
+ (ZOMN1(:,IN,:)/(ZOMN1(:,IN,:)+ZOMN2(:,IN,:)) * ZFNEG1(:,IN,:))) * (0.5-SIGN(0.5,PRVCT(:,IN,:)))
+!
+ ENDIF
+!
+! USE A THIRD ORDER UPSTREAM WENO SCHEME ELSEWHERE
+!
+ ZFPOS1(:,IS:IN-1,:) = 0.5 * (3.0*PSRC(:,IS:IN-1,:) - PSRC(:,IS-1:IN-2,:))
+ ZFPOS2(:,IS:IN-1,:) = 0.5 * (PSRC(:,IS:IN-1, :) + PSRC(:,IS+1:IN, :))
+ ZBPOS1(:,IS:IN-1,:) = (PSRC(:,IS:IN-1,:) - PSRC(:,IS-1:IN-2,:))**2
+ ZBPOS2(:,IS:IN-1,:) = (PSRC(:,IS+1:IN,:) - PSRC(:,IS:IN-1, :))**2
+!
+ ZFNEG1(:,IS:IN-1,:) = 0.5 * (3.0*PSRC(:,IS+1:IN,:) - PSRC(:,IS+2:IN+1,:))
+ ZFNEG2(:,IS:IN-1,:) = 0.5 * (PSRC(:,IS:IN-1, :) + PSRC(:,IS+1:IN, :))
+ ZBNEG1(:,IS:IN-1,:) = (PSRC(:,IS+1:IN,:) - PSRC(:,IS+2:IN+1,:))**2
+ ZBNEG2(:,IS:IN-1,:) = (PSRC(:,IS:IN-1,:) - PSRC(:,IS+1:IN, :))**2
+!
+ ZOMP1(:,IS:IN-1,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IS:IN-1,:))**2
+ ZOMP2(:,IS:IN-1,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IS:IN-1,:))**2
+ ZOMN1(:,IS:IN-1,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IS:IN-1,:))**2
+ ZOMN2(:,IS:IN-1,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IS:IN-1,:))**2
+!
+ PR(:,IS:IN-1,:) = (ZOMP2(:,IS:IN-1,:)/(ZOMP1(:,IS:IN-1,:)+ZOMP2(:,IS:IN-1,:)) * ZFPOS2(:,IS:IN-1,:) + &
+ (ZOMP1(:,IS:IN-1,:)/(ZOMP1(:,IS:IN-1,:)+ZOMP2(:,IS:IN-1,:)) * ZFPOS1(:,IS:IN-1,:))) * (0.5+SIGN(0.5,PRVCT(:,IS:IN-1,:))) + &
+ (ZOMN2(:,IS:IN-1,:)/(ZOMN1(:,IS:IN-1,:)+ZOMN2(:,IS:IN-1,:)) * ZFNEG2(:,IS:IN-1,:) + &
+ (ZOMN1(:,IS:IN-1,:)/(ZOMN1(:,IS:IN-1,:)+ZOMN2(:,IS:IN-1,:)) * ZFNEG1(:,IS:IN-1,:))) * (0.5-SIGN(0.5,PRVCT(:,IS:IN-1,:)))
+!
+END SELECT
+!
+PR = PR * PRVCT
+CALL GET_HALO(PR)
+!
+END SUBROUTINE ADVEC_WENO_K_2_VY
+!
+!-------------------------------------------------------------------------------
+!
+! ############################################
+ FUNCTION WENO_K_2_WZ(PSRC, PRWCT) RESULT(PR)
+! ############################################
+!!
+!!* Computes PRWCT * PWT. Upstream fluxes of W in Z direction.
+!! Input PWT is on W Grid 'ie' (i,j,k) based on WGRID reference
+!! Output PR is on mass Grid 'ie' (i,j,k+1/2) based on WGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_CONF
+USE MODD_PARAMETERS,ONLY: JPVEXT
+USE MODI_GET_HALO
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IB ! Begining useful area in x,y,z directions
+INTEGER :: IT ! End useful area in x,y,z directions
+!
+! WENO-related variables:
+! intermediate reconstruction fluxes for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!
+! smoothness indicators for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./3.
+REAL, PARAMETER :: ZGAMMA2 = 2./3.
+!
+REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+IB = 1 + JPVEXT
+IT = SIZE(PSRC,3) - JPVEXT
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+!
+! intermediate fluxes at the mass point on Wgrid w(i,j,k+1/2) for positive
+! wind case (L. to the R.)
+! (r=1 for the first stencil ZFPOS1, r=0 for the second ZFPOS2)
+!
+ZFPOS1(:,:,IB:IT-1) = 0.5 * (3.0*PSRC(:,:,IB:IT-1) - PSRC(:,:,IB-1:IT-2))
+ZFPOS2(:,:,IB:IT-1) = 0.5 * (PSRC(:,:,IB:IT-1) + PSRC(:,:,IB+1:IT))
+!
+! intermediate flux at the mass point on Wgrid w(i,j,k+1/2) for negative
+! wind case (R. to the L.)
+! (r=-1 for the first stencil ZFNEG1, r=0 for the second ZFNEG2=ZFPOS2)
+!
+ZFNEG1(:,:,IB-1:IT-1) = 0.5 * (3.0*PSRC(:,:,IB:IT) - PSRC(:,:,IB+1:IT+1))
+ZFNEG2(:,:,IB-1:IT) = 0.5 * (PSRC(:,:,IB-1:IT) + PSRC(:,:,IB:IT+1))
+!
+! smoothness indicators for positive wind case
+!
+ZBPOS1(:,:,IB:IT-1) = (PSRC(:,:,IB:IT-1) - PSRC(:,:,IB-1:IT-2))**2
+ZBPOS2(:,:,IB:IT-1) = (PSRC(:,:,IB+1:IT) - PSRC(:,:,IB:IT-1))**2
+!
+! smoothness indicators for negative wind case
+!
+ZBNEG1(:,:,IB-1:IT-1) = (PSRC(:,:,IB:IT) - PSRC(:,:,IB+1:IT+1))**2
+ZBNEG2(:,:,IB-1:IT) = (PSRC(:,:,IB-1:IT) - PSRC(:,:,IB:IT+1))**2
+!
+! WENO weights
+!
+ZOMP1 = ZGAMMA1 / (ZEPS + ZBPOS1)**2
+ZOMP2 = ZGAMMA2 / (ZEPS + ZBPOS2)**2
+ZOMN1 = ZGAMMA1 / (ZEPS + ZBNEG1)**2
+ZOMN2 = ZGAMMA2 / (ZEPS + ZBNEG2)**2
+!
+! WENO fluxes
+!
+PR(:,:,IB:IT-1) = (ZOMP2(:,:,IB:IT-1)/(ZOMP1(:,:,IB:IT-1)+ZOMP2(:,:,IB:IT-1))* &
+ ZFPOS2(:,:,IB:IT-1) + &
+ (ZOMP1(:,:,IB:IT-1)/(ZOMP1(:,:,IB:IT-1)+ZOMP2(:,:,IB:IT-1))* &
+ ZFPOS1(:,:,IB:IT-1))) * (0.5+SIGN(0.5,PRWCT(:,:,IB:IT-1) )) + &
+ (ZOMN2(:,:,IB:IT-1)/(ZOMN1(:,:,IB:IT-1)+ZOMN2(:,:,IB:IT-1))* &
+ ZFNEG2(:,:,IB:IT-1) + &
+ (ZOMN1(:,:,IB:IT-1)/(ZOMN1(:,:,IB:IT-1)+ZOMN2(:,:,IB:IT-1))* &
+ ZFNEG1(:,:,IB:IT-1))) * (0.5-SIGN(0.5,PRWCT(:,:,IB:IT-1) ))
+!
+PR(:,:,IB-1) = PSRC(:,:,IB-1) * (0.5+SIGN(0.5,PRWCT(:,:,IB-1) )) + &
+ PSRC(:,:,IB) * (0.5-SIGN(0.5,PRWCT(:,:,IB-1) ))
+PR(:,:,IT) = PSRC(:,:,IT) * (0.5+SIGN(0.5,PRWCT(:,:,IT) )) + &
+ PSRC(:,:,IT+1) * (0.5-SIGN(0.5,PRWCT(:,:,IT) ))
+PR(:,:,IT+1) = -999.
+!
+PR = PR * PRWCT
+CALL GET_HALO(PR)
+!
+END FUNCTION WENO_K_2_WZ
+!
+!-----------------------------------------------------------------------------
+!
+! ############################################
+ FUNCTION WENO_K_2_MZ(PSRC, PRWCT) RESULT(PR)
+! ############################################
+!!
+!!* Computes PRWCT * PUT (or PRWCT * PVT). Upstream fluxes of U (or V)
+!! variables in Z direction.
+!! Input PUT is on U Grid 'ie' (i,j,k) based on UGRID reference
+!! Output PR is on mass Grid 'ie' (i,j,k-1/2) based on UGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_CONF
+USE MODD_PARAMETERS,ONLY: JPVEXT
+USE MODI_GET_HALO
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!
+! output source term
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IB ! Begining useful area in x,y,z directions
+INTEGER :: IT ! End useful area in x,y,z directions
+!
+! WENO-related variables:
+!
+! intermediate reconstruction fluxes for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!
+! smoothness indicators for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./3.
+REAL, PARAMETER :: ZGAMMA2 = 2./3.
+!
+REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+IB = 1 + JPVEXT
+IT = SIZE(PSRC,3) - JPVEXT
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+!
+! intermediate fluxes at the flux point on the Wgrid u(i,j,k-1/2) for
+! positive wind case
+!
+ZFPOS1(:,:,IB+1:IT) = 0.5 * (3.0*PSRC(:,:,IB:IT-1) - PSRC(:,:,IB-1:IT-2))
+ZFPOS2(:,:,IB+1:IT) = 0.5 * (PSRC(:,:,IB:IT-1) + PSRC(:,:,IB+1:IT))
+!
+! intermediate flux at the flux point on the Wgrid u(i,j,k-1/2) for
+! negative wind case
+!
+ZFNEG1(:,:,IB+1:IT) = 0.5 * (3.0*PSRC(:,:,IB+1:IT) - PSRC(:,:,IB+2:IT+1))
+ZFNEG2(:,:,IB+1:IT) = 0.5 * (PSRC(:,:,IB:IT-1) + PSRC(:,:,IB+1:IT))
+!
+! smoothness indicators for positive wind case
+!
+ZBPOS1(:,:,IB+1:IT) = (PSRC(:,:,IB:IT-1) - PSRC(:,:,IB-1:IT-2))**2
+ZBPOS2(:,:,IB+1:IT) = (PSRC(:,:,IB+1:IT) - PSRC(:,:,IB:IT-1))**2
+!
+! smoothness indicators for negative wind case
+!
+ZBNEG1(:,:,IB+1:IT) = (PSRC(:,:,IB+1:IT) - PSRC(:,:,IB+2:IT+1))**2
+ZBNEG2(:,:,IB+1:IT) = (PSRC(:,:,IB:IT-1) - PSRC(:,:,IB+1:IT))**2
+!
+! WENO weights
+!
+ZOMP1(:,:,IB+1:IT) = ZGAMMA1 / (ZEPS + ZBPOS1(:,:,IB+1:IT))**2
+ZOMP2(:,:,IB+1:IT) = ZGAMMA2 / (ZEPS + ZBPOS2(:,:,IB+1:IT))**2
+ZOMN1(:,:,IB+1:IT) = ZGAMMA1 / (ZEPS + ZBNEG1(:,:,IB+1:IT))**2
+ZOMN2(:,:,IB+1:IT) = ZGAMMA2 / (ZEPS + ZBNEG2(:,:,IB+1:IT))**2
+!
+PR(:,:,IB+1:IT) = (ZOMP2(:,:,IB+1:IT)/(ZOMP1(:,:,IB+1:IT)+ZOMP2(:,:,IB+1:IT))* &
+ ZFPOS2(:,:,IB+1:IT) + &
+ (ZOMP1(:,:,IB+1:IT)/(ZOMP1(:,:,IB+1:IT)+ZOMP2(:,:,IB+1:IT))* &
+ ZFPOS1(:,:,IB+1:IT))) * (0.5+SIGN(0.5,PRWCT(:,:,IB+1:IT) )) + &
+ (ZOMN2(:,:,IB+1:IT)/(ZOMN1(:,:,IB+1:IT)+ZOMN2(:,:,IB+1:IT))* &
+ ZFNEG2(:,:,IB+1:IT) + &
+ (ZOMN1(:,:,IB+1:IT)/(ZOMN1(:,:,IB+1:IT)+ZOMN2(:,:,IB+1:IT))* &
+ ZFNEG1(:,:,IB+1:IT))) * (0.5-SIGN(0.5,PRWCT(:,:,IB+1:IT) ))
+!
+PR(:,:,IB) = PSRC(:,:,IB-1) * (0.5+SIGN(0.5,PRWCT(:,:,IB) )) + &
+ PSRC(:,:,IB) * (0.5-SIGN(0.5,PRWCT(:,:,IB) ))
+PR(:,:,IT+1) = PSRC(:,:,IT) * (0.5+SIGN(0.5,PRWCT(:,:,IT+1) )) + &
+ PSRC(:,:,IT+1) * (0.5-SIGN(0.5,PRWCT(:,:,IT+1) ))
+!
+PR = PR * PRWCT
+CALL GET_HALO(PR)
+!
+END FUNCTION WENO_K_2_MZ
diff --git a/src/MNH/advec_weno_k_3_aux.f90 b/src/MNH/advec_weno_k_3_aux.f90
new file mode 100644
index 000000000..44151ccbd
--- /dev/null
+++ b/src/MNH/advec_weno_k_3_aux.f90
@@ -0,0 +1,3014 @@
+! ##############################
+ MODULE MODI_ADVEC_WENO_K_3_AUX
+! ##############################
+!
+INTERFACE
+!
+ SUBROUTINE ADVEC_WENO_K_3_UX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_WENO_K_3_UX
+!
+! ----------------------------
+!
+ SUBROUTINE ADVEC_WENO_K_3_MX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_WENO_K_3_MX
+!
+! ---------------------------
+!
+ SUBROUTINE ADVEC_WENO_K_3_VY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_WENO_K_3_VY
+!
+! ------------------------------
+!
+ SUBROUTINE ADVEC_WENO_K_3_MY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+END SUBROUTINE ADVEC_WENO_K_3_MY
+!
+! -------------------------------
+!
+FUNCTION WENO_K_3_WZ(PSRC, PRWCT) RESULT(PR)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+END FUNCTION WENO_K_3_WZ
+!
+! ------------------------------
+!
+FUNCTION WENO_K_3_MZ(PSRC, PRWCT) RESULT(PR)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!
+! output source term
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+END FUNCTION WENO_K_3_MZ
+!
+END INTERFACE
+!
+END MODULE MODI_ADVEC_WENO_K_3_AUX
+!
+!-----------------------------------------------------------------------------
+!
+! ############################################################
+ SUBROUTINE ADVEC_WENO_K_3_UX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+! ############################################################
+!!
+!!**** Computes PRUCT * PUT. Upstream fluxes of U in X direction.
+!! Input PUT is on U Grid 'ie' (i,j,k) based on UGRID reference
+!! Output PR is on mass Grid 'ie' (i+1/2,j,k) based on UGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IW,IE,IWF,IEF ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!
+! intermediate reconstruction fluxes for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!
+! smoothness indicators for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2, ZOMN3
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./10.
+REAL, PARAMETER :: ZGAMMA2 = 3./5.
+REAL, PARAMETER :: ZGAMMA3 = 3./10.
+REAL, PARAMETER :: ZGAMMA1_PRIM = 1./3.
+REAL, PARAMETER :: ZGAMMA2_PRIM = 2./3.
+!
+REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!-----------------------------------------------------------------------------
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFPOS3 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZFNEG3 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBPOS3 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZBNEG3 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMP3 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+ZOMN3 = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
+!
+!* 1.1 CYCLIC CASE IN THE X DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+!
+ IF(NHALO == 1) THEN
+ IW=IIB
+ IE=IIE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 3rd order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+! r: many left cells in regard to 'i' cell for each stencil
+!
+! intermediate fluxes at the mass point on Ugrid u(i+1/2,j,k) for positive wind
+! case (left to the right)
+! (r=2 for the first stencil ZFPOS1, r=1 for the second ZFPOS2 and
+! r=0 for the last ZFPOS3)
+!
+ ZFPOS1(IW+1:IE-1,:,:) = 1./6 * (2.0*PSRC(IW-1:IE-3,:,:) - &
+ 7.0*PSRC(IW:IE-2,:,:) + 11.0*PSRC(IW+1:IE-1,:,:))
+ ZFPOS1(IW, :,:) = 1./6 * (2.0*TPHALO2%WEST(:,:) - &
+ 7.0*PSRC(IW-1, :,:) + 11.0*PSRC(IW, :,:))
+ ZFPOS1(IW-1, :,:) = 0.5 * (3.0*PSRC(IW-1 ,:,:) - TPHALO2%WEST(:,:))
+ ZFPOS1(IE, :,:) = 0.5 * (3.0*PSRC(IE ,:,:) - PSRC(IE-1, :,:))
+ ZFPOS1(IE+1, :,:) = 0.5 * (3.0*PSRC(IE+1 ,:,:) - PSRC(IE, :,:))
+!
+!
+ ZFPOS2(IW:IE-1,:,:) = 1./6 * (-1.0*PSRC(IW-1:IE-2,:,:) + 5.0*PSRC(IW:IE-1,:,:) + 2.0*PSRC(IW+1:IE,:,:))
+ ZFPOS2(IW-1, :,:) = 0.5 * (PSRC(IW-1 ,:,:) + PSRC(IW, :,:))
+ ZFPOS2(IE, :,:) = 0.5 * (PSRC(IE ,:,:) + PSRC(IE+1, :,:))
+ ZFPOS2(IE+1, :,:) = 0.5 * (PSRC(IE+1 ,:,:) + TPHALO2%EAST(:,:))
+!
+ ZFPOS3(IW:IE-1,:,:) = 1./6 * (2.0*PSRC(IW:IE-1,:,:) + 5.0*PSRC(IW+1:IE,:,:) &
+ - PSRC(IW+2:IE+1,:,:))
+!
+!
+! r: many left cells in regard to 'i+1' cell for each stencil
+!
+! intermediate flux at the mass point on Ugrid (i+1/2,j,k)=((i+1)-1/2,j,k) for
+! negative wind case (right to the left)
+! (r=2 for the last stencil ZFNEG3=ZFPOS2, r=1 for the second ZFNEG2=ZFPOS3
+! and r=0 for the first ZFNEG1)
+!
+ ZFNEG1(IW:IE-2,:,:) = 1./6 * (11.0*PSRC(IW+1:IE-1,:,:) - &
+ 7.0*PSRC(IW+2:IE,:,:) + 2.0*PSRC(IW+3:IE+1,:,:))
+ ZFNEG1(IE-1, :,:) = 1./6 * (11.0*PSRC(IE, :,:) - &
+ 7.0*PSRC(IE+1, :,:) + 2.0*TPHALO2%EAST(:,:))
+ ZFNEG1(IE, :,:) = 0.5 * (3.0*PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))
+ ZFNEG1(IE+1,:,:) = - 999.
+ ZFNEG1(IW-1,:,:) = 0.5 * (3.0*PSRC(IW, :,:) - PSRC(IW+1, :,:))
+!
+!
+ ZFNEG2(IW:IE-1,:,:) = 1./6 * (2.0*PSRC(IW:IE-1,:,:) + &
+ 5.0*PSRC(IW+1:IE,:,:) - PSRC(IW+2:IE+1,:,:))
+ ZFNEG2(IE, :,:) = 0.5 * (PSRC(IE, :,:) + PSRC(IE+1,:,:))
+ ZFNEG2(IE+1,:,:) = 0.5 * (PSRC(IE+1, :,:) + TPHALO2%EAST(:,:))
+ ZFNEG2(IW-1,:,:) = 0.5 * (PSRC(IW-1, :,:) + PSRC(IW,:,:))
+!
+!
+ ZFNEG3(IW:IE-1,:,:) = 1./6 * (-1.0*PSRC(IW-1:IE-2,:,:) + &
+ 5.0*PSRC(IW:IE-1,:,:) + 2.0*PSRC(IW+1:IE,:,:))
+!
+! smoothness indicators for positive wind case
+!
+ ZBPOS1(IW+1:IE-1,:,:) = 13./12 * (PSRC(IW-1:IE-3,:,:) - 2.0*PSRC(IW:IE-2,:,:)&
+ + PSRC(IW+1:IE-1,:,:))**2 + 1./4 * (PSRC(IW-1:IE-3,:,:) &
+ - 4.0*PSRC(IW:IE-2,:,:) + 3.0*PSRC(IW+1:IE-1,:,:))**2
+ ZBPOS1(IW, :,:) = 13./12 * (TPHALO2%WEST(:,:) - 2.0*PSRC(IW-1,:,:) + &
+ PSRC(IW,:,:))**2 + 1./4 * (TPHALO2%WEST(:,:) - &
+ 4.0*PSRC(IW-1,:,:) + 3.0*PSRC(IW,:,:))**2
+ ZBPOS1(IW-1, :,:) = (PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))**2
+ ZBPOS1(IE, :,:) = (PSRC(IE ,:,:) - PSRC(IE-1, :,:))**2
+ ZBPOS1(IE+1, :,:) = (PSRC(IE+1,:,:) - PSRC(IE, :,:))**2
+!
+!
+ ZBPOS2(IW:IE-1,:,:) = 13./12 * (PSRC(IW-1:IE-2,:,:) - 2.0*PSRC(IW:IE-1,:,:) +&
+ PSRC(IW+1:IE,:,:))**2 + 1./4 * (PSRC(IW-1:IE-2,:,:) - PSRC(IW+1:IE,:,:))**2
+ ZBPOS2(IW-1,:,:) = (PSRC(IW, :,:) - PSRC(IW-1,:,:))**2
+ ZBPOS2(IE, :,:) = (PSRC(IE+1,:,:) - PSRC(IE, :,:))**2
+ ZBPOS2(IE+1,:,:) = (TPHALO2%EAST(:,:) - PSRC(IE+1,:,:))**2
+!
+!
+ ZBPOS3(IW:IE-1,:,:) = 13./12 * (PSRC(IW:IE-1,:,:) - 2.0*PSRC(IW+1:IE,:,:) + &
+ PSRC(IW+2:IE+1,:,:))**2 + 1./4 * ( 3.0*PSRC(IW:IE-1,:,:) - &
+ 4.0*PSRC(IW+1:IE,:,:) + PSRC(IW+2:IE+1,:,:))**2
+!
+! smoothness indicators for negative wind case
+!
+ ZBNEG1(IW:IE-2,:,:) = 13./12 * (PSRC(IW+1:IE-1,:,:) - 2.0*PSRC(IW+2:IE,:,:) +&
+ PSRC(IW+3:IE+1,:,:))**2 + 1./4 * ( 3.0*PSRC(IW+1:IE-1,:,:) - &
+ 4.0*PSRC(IW+2:IE,:,:) + PSRC(IW+3:IE+1,:,:))**2
+ ZBNEG1(IE-1, :,:) = 13./12 * (PSRC(IE,:,:) - 2.0*PSRC(IE+1,:,:) + &
+ TPHALO2%EAST(:,:))**2 + 1./4 * ( 3.0*PSRC(IE,:,:) - &
+ 4.0*PSRC(IE+1,:,:) + TPHALO2%EAST(:,:))**2
+ ZBNEG1(IE, :,:) = (PSRC(IE+1, :,:) - TPHALO2%EAST(:,:))**2
+ ZBNEG1(IE+1, :,:) = - 999.
+ ZBNEG1(IW-1, :,:) = (PSRC(IW, :,:) - PSRC(IW+1, :,:))**2
+!
+!
+ ZBNEG2(IW:IE-1,:,:) = 13./12 * (PSRC(IW:IE-1,:,:) - 2.0*PSRC(IW+1:IE,:,:) + &
+ PSRC(IW+2:IE+1,:,:))**2 + 1./4 * (PSRC(IW:IE-1,:,:) - PSRC(IW+2:IE+1,:,:))**2
+ ZBNEG2(IW-1,:,:) = (PSRC(IW-1,:,:) - PSRC(IW, :,:))**2
+ ZBNEG2(IE ,:,:) = (PSRC(IE, :,:) - PSRC(IE+1,:,:))**2
+ ZBNEG2(IE+1,:,:) = (PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))**2
+!
+!
+ ZBNEG3(IW:IE-1,:,:) = 13./12 * (PSRC(IW-1:IE-2,:,:) - 2.0*PSRC(IW:IE-1,:,:) +&
+ PSRC(IW+1:IE,:,:))**2 + 1./4 * ( PSRC(IW-1:IE-2,:,:) - &
+ 4.0*PSRC(IW:IE-1,:,:) + 3.0*PSRC(IW+1:IE,:,:))**2
+!
+! WENO weights
+!
+ ZOMP1(IW:IE-1,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IW:IE-1,:,:))**2
+ ZOMP2(IW:IE-1,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IW:IE-1,:,:))**2
+ ZOMP3(IW:IE-1,:,:) = ZGAMMA3 / (ZEPS + ZBPOS3(IW:IE-1,:,:))**2
+ ZOMN1(IW:IE-1,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IW:IE-1,:,:))**2
+ ZOMN2(IW:IE-1,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IW:IE-1,:,:))**2
+ ZOMN3(IW:IE-1,:,:) = ZGAMMA3 / (ZEPS + ZBNEG3(IW:IE-1,:,:))**2
+!
+ ZOMP1(IW-1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IW-1,:,:))**2
+ ZOMP2(IW-1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IW-1,:,:))**2
+ ZOMP1(IE, :,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IE, :,:))**2
+ ZOMP2(IE, :,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IE, :,:))**2
+ ZOMP1(IE+1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IE+1,:,:))**2
+ ZOMP2(IE+1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IE+1,:,:))**2
+ ZOMN1(IW-1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IW-1,:,:))**2
+ ZOMN2(IW-1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IW-1,:,:))**2
+ ZOMN1(IE, :,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IE, :,:))**2
+ ZOMN2(IE, :,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IE, :,:))**2
+ ZOMN1(IE+1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IE+1,:,:))**2
+ ZOMN2(IE+1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IE+1,:,:))**2
+!
+! WENO fluxes (5th order)
+!
+ PR(IW:IE-1,:,:) = (ZOMP2(IW:IE-1,:,:)/(ZOMP1(IW:IE-1,:,:)+ZOMP2(IW:IE-1,:,:)+&
+ ZOMP3(IW:IE-1,:,:)) * ZFPOS2(IW:IE-1,:,:) &
+ + ZOMP1(IW:IE-1,:,:)/(ZOMP1(IW:IE-1,:,:)+ZOMP2(IW:IE-1,:,:)+&
+ ZOMP3(IW:IE-1,:,:)) * ZFPOS1(IW:IE-1,:,:) &
+ + ZOMP3(IW:IE-1,:,:)/(ZOMP1(IW:IE-1,:,:)+ZOMP2(IW:IE-1,:,:)+&
+ ZOMP3(IW:IE-1,:,:)) * ZFPOS3(IW:IE-1,:,:))&
+ * (0.5+SIGN(0.5,PRUCT(IW:IE-1,:,:))) &
+ + (ZOMN2(IW:IE-1,:,:)/(ZOMN1(IW:IE-1,:,:)+ZOMN2(IW:IE-1,:,:)+&
+ ZOMN3(IW:IE-1,:,:)) * ZFNEG2(IW:IE-1,:,:) &
+ + ZOMN1(IW:IE-1,:,:)/(ZOMN1(IW:IE-1,:,:)+ZOMN2(IW:IE-1,:,:)+&
+ ZOMN3(IW:IE-1,:,:)) * ZFNEG1(IW:IE-1,:,:) &
+ + ZOMN3(IW:IE-1,:,:)/(ZOMN1(IW:IE-1,:,:)+ZOMN2(IW:IE-1,:,:)+&
+ ZOMN3(IW:IE-1,:,:)) * ZFNEG3(IW:IE-1,:,:))&
+ * (0.5-SIGN(0.5,PRUCT(IW:IE-1,:,:)))
+!
+! WENO fluxes (3rd order)
+!
+ PR(IW-1,:,:) = (ZOMN2(IW-1,:,:)/(ZOMN1(IW-1,:,:)+ZOMN2(IW-1,:,:)) * &
+ ZFNEG2(IW-1,:,:) &
+ + (ZOMN1(IW-1,:,:)/(ZOMN1(IW-1,:,:)+ZOMN2(IW-1,:,:)) * &
+ ZFNEG1(IW-1,:,:))) * &
+ (0.5-SIGN(0.5,PRUCT(IW-1,:,:))) &
+ + (ZOMP2(IW-1,:,:)/(ZOMP1(IW-1,:,:)+ZOMP2(IW-1,:,:)) * &
+ ZFPOS2(IW-1,:,:) &
+ + (ZOMP1(IW-1,:,:)/(ZOMP1(IW-1,:,:)+ZOMP2(IW-1,:,:)) * &
+ ZFPOS1(IW-1,:,:))) * &
+ (0.5+SIGN(0.5,PRUCT(IW-1,:,:)))
+!
+ PR(IE, :,:) = (ZOMN2(IE, :,:)/(ZOMN1(IE, :,:)+ZOMN2(IE, :,:)) * &
+ ZFNEG2(IE, :,:) &
+ + (ZOMN1(IE, :,:)/(ZOMN1(IE, :,:)+ZOMN2(IE, :,:)) * &
+ ZFNEG1(IE, :,:))) * &
+ (0.5-SIGN(0.5,PRUCT(IE, :,:))) &
+ + (ZOMP2(IE, :,:)/(ZOMP1(IE, :,:)+ZOMP2(IE, :,:)) * &
+ ZFPOS2(IE, :,:) &
+ + (ZOMP1(IE, :,:)/(ZOMP1(IE, :,:)+ZOMP2(IE, :,:)) * &
+ ZFPOS1(IE, :,:))) * &
+ (0.5+SIGN(0.5,PRUCT(IE, :,:)))
+!
+ PR(IE+1,:,:) = (ZOMN2(IE+1,:,:)/(ZOMN1(IE+1,:,:)+ZOMN2(IE+1,:,:)) * &
+ ZFNEG2(IE+1,:,:) &
+ + (ZOMN1(IE+1,:,:)/(ZOMN1(IE+1,:,:)+ZOMN2(IE+1,:,:)) * &
+ ZFNEG1(IE+1,:,:))) * &
+ (0.5-SIGN(0.5,PRUCT(IE+1,:,:))) &
+ + (ZOMP2(IE+1,:,:)/(ZOMP1(IE+1,:,:)+ZOMP2(IE+1,:,:)) * &
+ ZFPOS2(IE+1,:,:) &
+ + (ZOMP1(IE+1,:,:)/(ZOMP1(IE+1,:,:)+ZOMP2(IE+1,:,:)) * &
+ ZFPOS1(IE+1,:,:))) * &
+ (0.5+SIGN(0.5,PRUCT(IE+1,:,:)))
+!
+!
+! OPEN, WALL, NEST CASE IN THE X DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+ IW=IIB
+ IE=IIE
+!
+! LATERAL BOUNDARY CONDITIONS
+! AT THE PHYSICAL BORDER: USE A FIRST ORDER UPSTREAM WENO SCHEME AT THE POINTS: IW-1,
+! IE /AND/ A THIRD ORDER WENO SCHEME AT THE POINTS: IW, IE-1
+! AT THE PROC. BORDER: A THIRD ORDER UPSTREAM WENO SCHEME AT THE POINTS: IW-1, IE /AND/
+! A FIFTH ORDER WENO SCHEME AT THE POINTS: IW, IE-1
+!
+! PHYSICAL BORDER (WEST)
+!
+ IF(LWEST_ll()) THEN
+!
+! FISRT ORDER WENO SCHEME
+!
+ PR(IW-1,:,:) = PSRC(IW-1,:,:) * (0.5+SIGN(0.5,PRUCT(IW-1,:,:))) + &
+ PSRC(IW,:,:) * &
+ (0.5-SIGN(0.5,PRUCT(IW-1,:,:)))
+!
+! THIRD ORDER WENO SCHEME
+!
+ ZFPOS1(IW,:,:) = 0.5 * (3.0*PSRC(IW,:,:) - PSRC(IW-1,:,:))
+ ZFPOS2(IW,:,:) = 0.5 * (PSRC(IW ,:,:) + PSRC(IW+1,:,:))
+ ZBPOS1(IW,:,:) = (PSRC(IW,:,:) - PSRC(IW-1,:,:))**2
+ ZBPOS2(IW,:,:) = (PSRC(IW+1, :,:) - PSRC(IW,:,:))**2
+!
+ ZFNEG1(IW,:,:) = 0.5 * (3.0*PSRC(IW+1,:,:) - PSRC(IW+2,:,:))
+ ZFNEG2(IW,:,:) = 0.5 * (PSRC(IW, :,:) + PSRC(IW+1,:,:))
+ ZBNEG1(IW,:,:) = (PSRC(IW+1,:,:) - PSRC(IW+2,:,:))**2
+ ZBNEG2(IW,:,:) = (PSRC(IW, :,:) - PSRC(IW+1,:,:))**2
+!
+ ZOMP1(IW,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IW,:,:))**2
+ ZOMP2(IW,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IW,:,:))**2
+ ZOMN1(IW,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IW,:,:))**2
+ ZOMN2(IW,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IW,:,:))**2
+!
+ PR(IW,:,:) = (ZOMN2(IW,:,:)/(ZOMN1(IW,:,:)+ZOMN2(IW,:,:)) * &
+ ZFNEG2(IW,:,:) + &
+ (ZOMN1(IW,:,:)/(ZOMN1(IW,:,:)+ZOMN2(IW,:,:)) * ZFNEG1(IW,:,:))) * &
+ (0.5-SIGN(0.5,PRUCT(IW,:,:))) + &
+ (ZOMP2(IW,:,:)/(ZOMP1(IW,:,:)+ZOMP2(IW,:,:)) * ZFPOS2(IW,:,:) + &
+ (ZOMP1(IW,:,:)/(ZOMP1(IW,:,:)+ZOMP2(IW,:,:)) * ZFPOS1(IW,:,:))) * &
+ (0.5+SIGN(0.5,PRUCT(IW,:,:)))
+!
+! PROC. BORDER (WEST)
+!
+ ELSEIF(NHALO == 1) THEN
+!
+! THIRD ORDER WENO SCHEME
+!
+ ZFPOS1(IW-1,:,:) = 0.5 * (3.0*PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))
+ ZFPOS2(IW-1,:,:) = 0.5 * (PSRC(IW-1, :,:) + PSRC(IW,:,:))
+ ZBPOS1(IW-1,:,:) = (PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))**2
+ ZBPOS2(IW-1,:,:) = (PSRC(IW, :,:) - PSRC(IW-1,:,:))**2
+!
+ ZFNEG1(IW-1,:,:) = 0.5 * (3.0*PSRC(IW,:,:) - PSRC(IW+1,:,:))
+ ZFNEG2(IW-1,:,:) = 0.5 * (PSRC(IW-1, :,:) + PSRC(IW, :,:))
+ ZBNEG1(IW-1,:,:) = (PSRC(IW, :,:) - PSRC(IW+1,:,:))**2
+ ZBNEG2(IW-1,:,:) = (PSRC(IW-1,:,:) - PSRC(IW, :,:))**2
+!
+ ZOMP1(IW-1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IW-1,:,:))**2
+ ZOMP2(IW-1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IW-1,:,:))**2
+ ZOMN1(IW-1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IW-1,:,:))**2
+ ZOMN2(IW-1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IW-1,:,:))**2
+!
+ PR(IW-1,:,:) = (ZOMN2(IW-1,:,:)/(ZOMN1(IW-1,:,:)+ZOMN2(IW-1,:,:)) &
+ * ZFNEG2(IW-1,:,:) &
+ + (ZOMN1(IW-1,:,:)/(ZOMN1(IW-1,:,:)+ZOMN2(IW-1,:,:)) * &
+ ZFNEG1(IW-1,:,:))) *&
+ (0.5-SIGN(0.5,PRUCT(IW-1,:,:))) &
+ + (ZOMP2(IW-1,:,:)/(ZOMP1(IW-1,:,:)+ZOMP2(IW-1,:,:)) * &
+ ZFPOS2(IW-1,:,:) &
+ + (ZOMP1(IW-1,:,:)/(ZOMP1(IW-1,:,:)+ZOMP2(IW-1,:,:)) * &
+ ZFPOS1(IW-1,:,:))) *&
+ (0.5+SIGN(0.5,PRUCT(IW-1,:,:)))
+!
+! FIFTH ORDER WENO SCHEME
+!
+ ZFPOS1(IW,:,:) = 1./6 * (2.0*TPHALO2%WEST(:,:) - 7.0*PSRC(IW-1,:,:) + &
+ 11.0*PSRC(IW, :,:))
+ ZFPOS2(IW,:,:) = 1./6 * (-1.0*PSRC(IW-1, :,:) + 5.0*PSRC(IW, :,:) + &
+ 2.0*PSRC(IW+1,:,:))
+ ZFPOS3(IW,:,:) = 1./6 * (2.0*PSRC(IW, :,:) + 5.0*PSRC(IW+1,:,:) - &
+ PSRC(IW+2,:,:))
+!
+ ZFNEG1(IW,:,:) = 1./6 * (11.0*PSRC(IW+1,:,:) - 7.0*PSRC(IW+2,:,:) + &
+ 2.0*PSRC(IW+3,:,:))
+ ZFNEG2(IW,:,:) = 1./6 * ( 2.0*PSRC(IW, :,:) + 5.0*PSRC(IW+1,:,:) - &
+ PSRC(IW+2,:,:))
+ ZFNEG3(IW,:,:) = 1./6 * (-1.0*PSRC(IW-1,:,:) + 5.0*PSRC(IW, :,:) + &
+ 2.0*PSRC(IW+1,:,:))
+!
+ ZBPOS1(IW,:,:) = 13./12 * (TPHALO2%WEST(:,:) - 2.0*PSRC(IW-1,:,:) + &
+ PSRC(IW,:,:))**2 + &
+ 1./4 * (TPHALO2%WEST(:,:) - 4.0*PSRC(IW-1,:,:) + &
+ 3.0*PSRC(IW,:,:))**2
+ ZBPOS2(IW,:,:) = 13./12 * (PSRC(IW-1,:,:) - 2.0*PSRC(IW,:,:) + &
+ PSRC(IW+1,:,:))**2 + &
+ 1./4 * (PSRC(IW-1,:,:) - PSRC(IW+1,:,:))**2
+ ZBPOS3(IW,:,:) = 13./12 * (PSRC(IW,:,:) - 2.0*PSRC(IW+1,:,:) + &
+ PSRC(IW+2,:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(IW,:,:) - 4.0*PSRC(IW+1,:,:) + &
+ PSRC(IW+2,:,:))**2
+!
+ ZBNEG1(IW,:,:) = 13./12 * (PSRC(IW+1,:,:) - 2.0*PSRC(IW+2,:,:) + &
+ PSRC(IW+3,:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(IW+1,:,:) - 4.0*PSRC(IW+2,:,:) + &
+ PSRC(IW+3,:,:))**2
+ ZBNEG2(IW,:,:) = 13./12 * (PSRC(IW,:,:) - 2.0*PSRC(IW+1,:,:) + &
+ PSRC(IW+2,:,:))**2 + &
+ 1./4 * (PSRC(IW,:,:) - PSRC(IW+2,:,:))**2
+ ZBNEG3(IW,:,:) = 13./12 * (PSRC(IW-1,:,:) - 2.0*PSRC(IW,:,:) + &
+ PSRC(IW+1,:,:))**2 + &
+ 1./4 * ( PSRC(IW-1,:,:) - 4.0*PSRC(IW,:,:) + &
+ 3.0*PSRC(IW+1,:,:))**2
+!
+ ZOMP1(IW,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IW,:,:))**2
+ ZOMP2(IW,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IW,:,:))**2
+ ZOMP3(IW,:,:) = ZGAMMA3 / (ZEPS + ZBPOS3(IW,:,:))**2
+ ZOMN1(IW,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IW,:,:))**2
+ ZOMN2(IW,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IW,:,:))**2
+ ZOMN3(IW,:,:) = ZGAMMA3 / (ZEPS + ZBNEG3(IW,:,:))**2
+!
+ PR(IW,:,:) = (ZOMP2(IW,:,:)/(ZOMP1(IW,:,:)+ZOMP2(IW,:,:)+ &
+ ZOMP3(IW,:,:)) * ZFPOS2(IW,:,:) &
+ + ZOMP1(IW,:,:)/(ZOMP1(IW,:,:)+ZOMP2(IW,:,:)+ &
+ ZOMP3(IW,:,:)) * ZFPOS1(IW,:,:) &
+ + ZOMP3(IW,:,:)/(ZOMP1(IW,:,:)+ZOMP2(IW,:,:)+ &
+ ZOMP3(IW,:,:)) * ZFPOS3(IW,:,:)) *&
+ (0.5+SIGN(0.5,PRUCT(IW,:,:))) &
+ + (ZOMN2(IW,:,:)/(ZOMN1(IW,:,:)+ZOMN2(IW,:,:)+&
+ ZOMN3(IW,:,:)) * ZFNEG2(IW,:,:) &
+ + ZOMN1(IW,:,:)/(ZOMN1(IW,:,:)+ZOMN2(IW,:,:)+ &
+ ZOMN3(IW,:,:)) * ZFNEG1(IW,:,:) &
+ + ZOMN3(IW,:,:)/(ZOMN1(IW,:,:)+ZOMN2(IW,:,:)+ &
+ ZOMN3(IW,:,:)) * ZFNEG3(IW,:,:)) *&
+ (0.5-SIGN(0.5,PRUCT(IW,:,:)))
+!
+ ENDIF
+!
+! PHYSICAL BORDER (EAST)
+!
+ IF(LEAST_ll()) THEN
+ PR(IE,:,:) = PSRC(IE,:,:) * (0.5+SIGN(0.5,PRUCT(IE,:,:))) + &
+ PSRC(IE+1,:,:) * &
+ (0.5-SIGN(0.5,PRUCT(IE,:,:)))
+!
+ ZFPOS1(IE-1,:,:) = 0.5 * (3.0*PSRC(IE-1,:,:) - PSRC(IE-2,:,:))
+ ZFPOS2(IE-1,:,:) = 0.5 * (PSRC(IE-1, :,:) + PSRC(IE, :,:))
+ ZBPOS1(IE-1,:,:) = (PSRC(IE-1,:,:) - PSRC(IE-2,:,:))**2
+ ZBPOS2(IE-1,:,:) = (PSRC(IE, :,:) - PSRC(IE-1,:,:))**2
+!
+ ZFNEG1(IE-1,:,:) = 0.5 * (3.0*PSRC(IE,:,:) - PSRC(IE+1,:,:))
+ ZFNEG2(IE-1,:,:) = 0.5 * (PSRC(IE-1, :,:) + PSRC(IE, :,:))
+ ZBNEG1(IE-1,:,:) = (PSRC(IE, :,:) - PSRC(IE+1,:,:))**2
+ ZBNEG2(IE-1,:,:) = (PSRC(IE-1,:,:) - PSRC(IE, :,:))**2
+!
+ ZOMP1(IE-1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IE-1,:,:))**2
+ ZOMP2(IE-1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IE-1,:,:))**2
+ ZOMN1(IE-1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IE-1,:,:))**2
+ ZOMN2(IE-1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IE-1,:,:))**2
+!
+ PR(IE-1,:,:) = (ZOMN2(IE-1,:,:)/(ZOMN1(IE-1,:,:)+ZOMN2(IE-1,:,:)) * &
+ ZFNEG2(IE-1,:,:)&
+ + (ZOMN1(IE-1,:,:)/(ZOMN1(IE-1,:,:)+ZOMN2(IE-1,:,:)) * &
+ ZFNEG1(IE-1,:,:))) *&
+ (0.5-SIGN(0.5,PRUCT(IE-1,:,:))) &
+ + (ZOMP2(IE-1,:,:)/(ZOMP1(IE-1,:,:)+ZOMP2(IE-1,:,:)) * &
+ ZFPOS2(IE-1,:,:) &
+ + (ZOMP1(IE-1,:,:)/(ZOMP1(IE-1,:,:)+ZOMP2(IE-1,:,:)) * &
+ ZFPOS1(IE-1,:,:))) *&
+ (0.5+SIGN(0.5,PRUCT(IE-1,:,:)))
+!
+! PROC. BORDER (EAST)
+!
+ ELSEIF(NHALO == 1) THEN
+!
+ ZFPOS1(IE,:,:) = 0.5 * (3.0*PSRC(IE,:,:) - PSRC(IE-1,:,:))
+ ZFPOS2(IE,:,:) = 0.5 * (PSRC(IE, :,:) + PSRC(IE+1,:,:))
+ ZBPOS1(IE,:,:) = (PSRC(IE, :,:) - PSRC(IE-1,:,:))**2
+ ZBPOS2(IE,:,:) = (PSRC(IE+1,:,:) - PSRC(IE, :,:))**2
+!
+ ZFNEG1(IE,:,:) = 0.5 * (3.0*PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))
+ ZFNEG2(IE,:,:) = 0.5 * (PSRC(IE, :,:) + PSRC(IE+1,:,:))
+ ZBNEG1(IE,:,:) = (PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))**2
+ ZBNEG2(IE,:,:) = (PSRC(IE, :,:) - PSRC(IE+1,:,:))**2
+!
+ ZOMP1(IE,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IE,:,:))**2
+ ZOMP2(IE,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IE,:,:))**2
+ ZOMN1(IE,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IE,:,:))**2
+ ZOMN2(IE,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IE,:,:))**2
+!
+ PR(IE,:,:) = (ZOMN2(IE,:,:)/(ZOMN1(IE,:,:)+ZOMN2(IE,:,:)) * ZFNEG2(IE,:,:)&
+ + (ZOMN1(IE,:,:)/(ZOMN1(IE,:,:)+ZOMN2(IE,:,:)) * ZFNEG1(IE,:,:))) *&
+ (0.5-SIGN(0.5,PRUCT(IE,:,:))) &
+ + (ZOMP2(IE,:,:)/(ZOMP1(IE,:,:)+ZOMP2(IE,:,:)) * ZFPOS2(IE,:,:) &
+ + (ZOMP1(IE,:,:)/(ZOMP1(IE,:,:)+ZOMP2(IE,:,:)) * ZFPOS1(IE,:,:))) *&
+ (0.5+SIGN(0.5,PRUCT(IE,:,:)))
+!
+!
+ ZFPOS1(IE-1,:,:) = 1./6 * (2.0 *PSRC(IE-3,:,:) - 7.0*PSRC(IE-2,:,:) + &
+ 11.0*PSRC(IE-1,:,:))
+ ZFPOS2(IE-1,:,:) = 1./6 * (-1.0*PSRC(IE-2,:,:) + 5.0*PSRC(IE-1,:,:) + &
+ 2.0*PSRC(IE,:,:))
+ ZFPOS3(IE-1,:,:) = 1./6 * (2.0 *PSRC(IE-1,:,:) + 5.0*PSRC(IE, :,:) - &
+ PSRC(IE+1, :,:))
+!
+ ZFNEG1(IE-1,:,:) = 1./6 * (11.0*PSRC(IE,:,:) - 7.0*PSRC(IE+1,:,:) + &
+ 2.0*TPHALO2%EAST(:,:))
+ ZFNEG2(IE-1,:,:) = 1./6 * (2.0*PSRC(IE-1,:,:) + 5.0*PSRC(IE,:,:) - &
+ PSRC(IE+1,:,:))
+ ZFNEG3(IE-1,:,:) = 1./6 * (-1.0*PSRC(IE-2,:,:) + 5.0*PSRC(IE-1,:,:) + &
+ 2.0*PSRC(IE,:,:))
+!
+ ZBPOS1(IE-1,:,:) = 13./12 * (PSRC(IE-3,:,:) - 2.0*PSRC(IE-2,:,:) + &
+ PSRC(IE-1,:,:))**2 + &
+ 1./4 * (PSRC(IE-3,:,:) - 4.0*PSRC(IE-2,:,:) + &
+ 3.0*PSRC(IE-1,:,:))**2
+ ZBPOS2(IE-1,:,:) = 13./12 * (PSRC(IE-2,:,:) - 2.0*PSRC(IE-1,:,:) + &
+ PSRC(IE,:,:))**2 + &
+ 1./4 * (PSRC(IE-2,:,:) - PSRC(IE,:,:))**2
+ ZBPOS3(IE-1,:,:) = 13./12 * (PSRC(IE-1,:,:) - 2.0*PSRC(IE,:,:) + &
+ PSRC(IE+1,:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(IE-1,:,:) - 4.0*PSRC(IE,:,:) + &
+ PSRC(IE+1,:,:))**2!
+ ZBNEG1(IE-1,:,:) = 13./12 * (PSRC(IE,:,:) - 2.0*PSRC(IE+1,:,:) + &
+ TPHALO2%EAST(:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(IE,:,:) - 4.0*PSRC(IE+1,:,:) + &
+ TPHALO2%EAST(:,:))**2
+ ZBNEG2(IE-1,:,:) = 13./12 * (PSRC(IE-1,:,:) - 2.0*PSRC(IE,:,:) + &
+ PSRC(IE+1,:,:))**2 + &
+ 1./4 * (PSRC(IE-1,:,:) - PSRC(IE+1,:,:))**2
+ ZBNEG3(IE-1,:,:) = 13./12 * (PSRC(IE-2,:,:) - 2.0*PSRC(IE-1,:,:) + &
+ PSRC(IE,:,:))**2 + &
+ 1./4 * ( PSRC(IE-2,:,:) - 4.0*PSRC(IE-1,:,:) + &
+ 3.0*PSRC(IE,:,:))**2
+!
+ ZOMP1(IE-1,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IE-1,:,:))**2
+ ZOMP2(IE-1,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IE-1,:,:))**2
+ ZOMP3(IE-1,:,:) = ZGAMMA3 / (ZEPS + ZBPOS3(IE-1,:,:))**2
+ ZOMN1(IE-1,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IE-1,:,:))**2
+ ZOMN2(IE-1,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IE-1,:,:))**2
+ ZOMN3(IE-1,:,:) = ZGAMMA3 / (ZEPS + ZBNEG3(IE-1,:,:))**2
+!
+ PR(IE-1,:,:) = (ZOMP2(IE-1,:,:)/(ZOMP1(IE-1,:,:)+ZOMP2(IE-1,:,:)+ &
+ ZOMP3(IE-1,:,:)) * ZFPOS2(IE-1,:,:) &
+ + ZOMP1(IE-1,:,:)/(ZOMP1(IE-1,:,:)+ZOMP2(IE-1,:,:)+ &
+ ZOMP3(IE-1,:,:)) * ZFPOS1(IE-1,:,:) &
+ + ZOMP3(IE-1,:,:)/(ZOMP1(IE-1,:,:)+ZOMP2(IE-1,:,:)+ &
+ ZOMP3(IE-1,:,:)) * ZFPOS3(IE-1,:,:)) * &
+ (0.5+SIGN(0.5,PRUCT(IE-1,:,:))) &
+ + (ZOMN2(IE-1,:,:)/(ZOMN1(IE-1,:,:)+ZOMN2(IE-1,:,:)+ &
+ ZOMN3(IE-1,:,:)) * ZFNEG2(IE-1,:,:) &
+ + ZOMN1(IE-1,:,:)/(ZOMN1(IE-1,:,:)+ZOMN2(IE-1,:,:)+ &
+ ZOMN3(IE-1,:,:)) * ZFNEG1(IE-1,:,:) &
+ + ZOMN3(IE-1,:,:)/(ZOMN1(IE-1,:,:)+ZOMN2(IE-1,:,:)+ &
+ ZOMN3(IE-1,:,:)) * ZFNEG3(IE-1,:,:)) * &
+ (0.5-SIGN(0.5,PRUCT(IE-1,:,:)))
+!
+ ENDIF
+!
+! USE A FIFTH ORDER UPSTREAM WENO SCHEME ELSEWHERE (IW+1 --> IE-2)
+!
+ ZFPOS1(IW+1:IE-2,:,:) = 1./6 * (2.0*PSRC(IW-1:IE-4,:,:) - &
+ 7.0*PSRC(IW:IE-3,:,:) + 11.0*PSRC(IW+1:IE-2,:,:))
+ ZFPOS2(IW+1:IE-2,:,:) = 1./6 * (-1.0*PSRC(IW:IE-3,:,:) + &
+ 5.0*PSRC(IW+1:IE-2,:,:) + 2.0*PSRC(IW+2:IE-1,:,:))
+ ZFPOS3(IW+1:IE-2,:,:) = 1./6 * (2.0*PSRC(IW+1:IE-2,:,:) + &
+ 5.0*PSRC(IW+2:IE-1,:,:) - PSRC(IW+3:IE,:,:))
+!
+ ZFNEG1(IW+1:IE-2,:,:) = 1./6 * (11.0*PSRC(IW+2:IE-1,:,:) - &
+ 7.0*PSRC(IW+3:IE,:,:) + 2.0*PSRC(IW+4:IE+1,:,:))
+ ZFNEG2(IW+1:IE-2,:,:) = 1./6 * (2.0*PSRC(IW+1:IE-2,:,:) + &
+ 5.0*PSRC(IW+2:IE-1,:,:) - PSRC(IW+3:IE,:,:))
+ ZFNEG3(IW+1:IE-2,:,:) = 1./6 * (-1.0*PSRC(IW:IE-3,:,:) + &
+ 5.0*PSRC(IW+1:IE-2,:,:) + 2.0*PSRC(IW+2:IE-1,:,:))
+!
+ ZBPOS1(IW+1:IE-2,:,:) = 13./12 * (PSRC(IW-1:IE-4,:,:) - &
+ 2.0*PSRC(IW:IE-3,:,:) + PSRC(IW+1:IE-2,:,:))**2 + &
+ 1./4 * (PSRC(IW-1:IE-4,:,:) - 4.0*PSRC(IW:IE-3,:,:) + &
+ 3.0*PSRC(IW+1:IE-2,:,:))**2
+ ZBPOS2(IW+1:IE-2,:,:) = 13./12 * (PSRC(IW:IE-3,:,:) - &
+ 2.0*PSRC(IW+1:IE-2,:,:) + PSRC(IW+2:IE-1,:,:))**2 + &
+ 1./4 * (PSRC(IW:IE-3,:,:) - PSRC(IW+2:IE-1,:,:))**2
+ ZBPOS3(IW+1:IE-2,:,:) = 13./12 * (PSRC(IW+1:IE-2,:,:) - &
+ 2.0*PSRC(IW+2:IE-1,:,:) + PSRC(IW+3:IE,:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(IW+1:IE-2,:,:) - 4.0*PSRC(IW+2:IE-1,:,:) &
+ + PSRC(IW+3:IE,:,:))**2
+!
+ ZBNEG1(IW+1:IE-2,:,:) = 13./12 * (PSRC(IW+2:IE-1,:,:) - &
+ 2.0*PSRC(IW+3:IE,:,:) + PSRC(IW+4:IE+1,:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(IW+2:IE-1,:,:) - 4.0*PSRC(IW+3:IE,:,:) + &
+ PSRC(IW+4:IE+1,:,:))**2
+ ZBNEG2(IW+1:IE-2,:,:) = 13./12 * (PSRC(IW+1:IE-2,:,:) - &
+ 2.0*PSRC(IW+2:IE-1,:,:) + PSRC(IW+3:IE,:,:))**2 + &
+ 1./4 * (PSRC(IW+1:IE-2,:,:) - PSRC(IW+3:IE,:,:))**2
+ ZBNEG3(IW+1:IE-2,:,:) = 13./12 * (PSRC(IW:IE-3,:,:) - &
+ 2.0*PSRC(IW+1:IE-2,:,:) + PSRC(IW+2:IE-1,:,:))**2 + &
+ 1./4 * ( PSRC(IW:IE-3,:,:) - 4.0*PSRC(IW+1:IE-2,:,:) + &
+ 3.0*PSRC(IW+2:IE-1,:,:))**2
+!
+ ZOMP1(IW+1:IE-2,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IW+1:IE-2,:,:))**2
+ ZOMP2(IW+1:IE-2,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IW+1:IE-2,:,:))**2
+ ZOMP3(IW+1:IE-2,:,:) = ZGAMMA3 / (ZEPS + ZBPOS3(IW+1:IE-2,:,:))**2
+ ZOMN1(IW+1:IE-2,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IW+1:IE-2,:,:))**2
+ ZOMN2(IW+1:IE-2,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IW+1:IE-2,:,:))**2
+ ZOMN3(IW+1:IE-2,:,:) = ZGAMMA3 / (ZEPS + ZBNEG3(IW+1:IE-2,:,:))**2
+!
+ PR(IW+1:IE-2,:,:) = (ZOMP2(IW+1:IE-2,:,:)/(ZOMP1(IW+1:IE-2,:,:)+ &
+ ZOMP2(IW+1:IE-2,:,:)+ &
+ ZOMP3(IW+1:IE-2,:,:)) * ZFPOS2(IW+1:IE-2,:,:) + &
+ ZOMP1(IW+1:IE-2,:,:)/(ZOMP1(IW+1:IE-2,:,:)+ZOMP2(IW+1:IE-2,:,:)+ &
+ ZOMP3(IW+1:IE-2,:,:)) * ZFPOS1(IW+1:IE-2,:,:) + &
+ ZOMP3(IW+1:IE-2,:,:)/(ZOMP1(IW+1:IE-2,:,:)+ZOMP2(IW+1:IE-2,:,:)+ &
+ ZOMP3(IW+1:IE-2,:,:)) * ZFPOS3(IW+1:IE-2,:,:)) * &
+ (0.5+SIGN(0.5,PRUCT(IW+1:IE-2,:,:))) + &
+ (ZOMN2(IW+1:IE-2,:,:)/(ZOMN1(IW+1:IE-2,:,:)+ZOMN2(IW+1:IE-2,:,:)+&
+ ZOMN3(IW+1:IE-2,:,:)) * ZFNEG2(IW+1:IE-2,:,:) + &
+ ZOMN1(IW+1:IE-2,:,:)/(ZOMN1(IW+1:IE-2,:,:)+ZOMN2(IW+1:IE-2,:,:)+ &
+ ZOMN3(IW+1:IE-2,:,:)) * ZFNEG1(IW+1:IE-2,:,:) + &
+ ZOMN3(IW+1:IE-2,:,:)/(ZOMN1(IW+1:IE-2,:,:)+ZOMN2(IW+1:IE-2,:,:)+ &
+ ZOMN3(IW+1:IE-2,:,:)) * ZFNEG3(IW+1:IE-2,:,:)) * &
+ (0.5-SIGN(0.5,PRUCT(IW+1:IE-2,:,:)))
+!
+END SELECT
+!
+PR = PR * PRUCT
+!
+END SUBROUTINE ADVEC_WENO_K_3_UX
+!
+!------------------------------------------------------------------------------
+!
+! ############################################################
+ SUBROUTINE ADVEC_WENO_K_3_MX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+! ############################################################
+!!
+!!**** Computes PRUCT * PWT (or PRUCT * PVT). Upstream fluxes of W (or V)
+!! variables in X direction.
+!! Input PWT is on W Grid 'ie' (i,j,k) based on WGRID reference
+!! Output PR is on mass Grid 'ie' (i-1/2,j,k) based on WGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IW,IE ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!
+!
+! intermediate reconstruction fluxes for positive wind case
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!
+! smoothness indicators for positive wind case
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2, ZOMN3
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./10.
+REAL, PARAMETER :: ZGAMMA2 = 3./5.
+REAL, PARAMETER :: ZGAMMA3 = 3./10.
+REAL, PARAMETER :: ZGAMMA1_PRIM = 1./3.
+REAL, PARAMETER :: ZGAMMA2_PRIM = 2./3.
+!
+REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!-----------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFPOS3 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZFNEG3 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBPOS3 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZBNEG3 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMP3 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+ZOMN3 = 0.0
+!
+!------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
+!
+!* 1.1 CYCLIC CASE IN THE X DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+!
+ IF(NHALO == 1) THEN
+ IW=IIB
+ IE=IIE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 3rd order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+! r: many left cells in regard to 'i-1' cell for each stencil
+!
+! intermediate fluxes at the mass point on Ugrid u(i-1/2,j,k)=((i-1)+1/2,j,k)
+! for positive wind case (left to the right)
+! (r=2 for the first stencil ZFPOS1, r=1 for the second ZFPOS2 and
+! r=0 for the last ZFPOS3)
+!
+ ZFPOS1(IW+2:IE,:,:) = 1./6 * (2.0*PSRC(IW-1:IE-3,:,:) - 7.0*PSRC(IW:IE-2,:,:) + &
+ 11.0*PSRC(IW+1:IE-1,:,:))
+ ZFPOS1(IW+1, :,:) = 1./6 * (2.0*TPHALO2%WEST(:,:) - 7.0*PSRC(IW-1, :,:) + &
+ 11.0*PSRC(IW, :,:))
+ ZFPOS1(IE+1,:,:) = 0.5 * (3.0*PSRC(IE, :,:) - PSRC(IE-1,:,:))
+ ZFPOS1(IW, :,:) = 0.5 * (3.0*PSRC(IW-1,:,:) - TPHALO2%WEST(:,:) )
+ ZFPOS1(IW-1,:,:) = - 999.
+!
+!
+ ZFPOS2(IW+1:IE,:,:) = 1./6 * (-1.0*PSRC(IW-1:IE-2,:,:) + 5.0*PSRC(IW:IE-1,:,:) + &
+ 2.0*PSRC(IW+1:IE,:,:))
+ ZFPOS2(IE+1,:,:) = 0.5 * (PSRC(IE+1,:,:) + PSRC(IE, :,:))
+ ZFPOS2(IW, :,:) = 0.5 * (PSRC(IW-1,:,:) + PSRC(IW, :,:))
+ ZFPOS2(IW-1,:,:) = 0.5 * (TPHALO2%WEST(:,:) + PSRC(IW-1,:,:))
+!
+!
+ ZFPOS3(IW+1:IE,:,:) = 1./6 * (2.0*PSRC(IW:IE-1,:,:) + 5.0*PSRC(IW+1:IE,:,:) - &
+ PSRC(IW+2:IE+1,:,:))
+!
+! r: many left cells in regard to 'i' cell for each stencil
+!
+! intermediate fluxes at the mass point on Ugrid u(i-1/2,j,k) for negative wind
+! case (R. to the L.)
+! (r=2 for the third stencil ZFNEG3=ZFPOS2, r=1 for the second ZFNEG2=ZFPOS3
+! and r=0 for the first ZFNEG1)
+!
+ ZFNEG1(IW+1:IE-1,:,:) = 1./6 * (11.0*PSRC(IW+1:IE-1,:,:) - 7.0*PSRC(IW+2:IE,:,:)&
+ + 2.0*PSRC(IW+3:IE+1,:,:))
+ ZFNEG1(IE, :,:) = 1./6 * (11.0*PSRC(IE, :,:) - 7.0*PSRC(IE+1, :,:)&
+ + 2.0*TPHALO2%EAST(:,:))
+ ZFNEG1(IW, :,:) = 0.5 * (3.0*PSRC(IW, :,:) - PSRC(IW+1, :,:))
+ ZFNEG1(IW-1,:,:) = 0.5 * (3.0*PSRC(IW-1,:,:) - PSRC(IW, :,:))
+ ZFNEG1(IE+1,:,:) = 0.5 * (3.0*PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))
+!
+!
+ ZFNEG2(IW+1:IE,:,:) = 1./6 * (2.0*PSRC(IW:IE-1,:,:) + 5.0*PSRC(IW+1:IE,:,:) - &
+ PSRC(IW+2:IE+1,:,:))
+ ZFNEG2(IW, :,:) = 0.5 * (PSRC(IW, :,:) + PSRC(IW-1, :,:))
+ ZFNEG2(IW-1,:,:) = 0.5 * (PSRC(IW-1,:,:) + TPHALO2%WEST(:,:))
+ ZFNEG2(IE+1,:,:) = 0.5 * (PSRC(IE+1,:,:) + PSRC(IE, :,:))
+!
+!
+ ZFNEG3(IW+1:IE,:,:) = 1./6 * (-1.0*PSRC(IW-1:IE-2,:,:) + 5.0*PSRC(IW:IE-1,:,:) + &
+ 2.0*PSRC(IW+1:IE,:,:))
+!
+! smoothness indicators for positive wind case
+!
+ ZBPOS1(IW+2:IE,:,:) = 13./12 * (PSRC(IW-1:IE-3,:,:) - 2.0*PSRC(IW:IE-2,:,:) + &
+ PSRC(IW+1:IE-1,:,:))**2 + &
+ 1./4 * (PSRC(IW-1:IE-3,:,:) - 4.0*PSRC(IW:IE-2,:,:) + &
+ 3.0*PSRC(IW+1:IE-1,:,:))**2
+ ZBPOS1(IW+1, :,:) = 13./12 * (TPHALO2%WEST(:,:) - 2.0*PSRC(IW-1,:,:) + &
+ PSRC(IW,:,:))**2 + &
+ 1./4 * (TPHALO2%WEST(:,:) - 4.0*PSRC(IW-1,:,:) + &
+ 3.0*PSRC(IW,:,:))**2
+ ZBPOS1(IE+1,:,:) = (PSRC(IE, :,:) - PSRC(IE-1,:,:))**2
+ ZBPOS1(IW, :,:) = (PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))**2
+ ZBPOS1(IW-1,:,:) = - 999.
+!
+!
+ ZBPOS2(IW+1:IE,:,:) = 13./12 * (PSRC(IW-1:IE-2,:,:) - 2.0*PSRC(IW:IE-1,:,:) + &
+ PSRC(IW+1:IE,:,:))**2 + &
+ 1./4 * (PSRC(IW-1:IE-2,:,:) - PSRC(IW+1:IE,:,:))**2
+ ZBPOS2(IE+1,:,:) = (PSRC(IE+1,:,:) - PSRC(IE,:,:))**2
+ ZBPOS2(IW, :,:) = (PSRC(IW, :,:) - PSRC(IW-1,:,:))**2
+ ZBPOS2(IW-1,:,:) = (PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))**2
+!
+!
+ ZBPOS3(IW+1:IE,:,:) = 13./12 * (PSRC(IW:IE-1,:,:) - 2.0*PSRC(IW+1:IE,:,:) + &
+ PSRC(IW+2:IE+1,:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(IW:IE-1,:,:) - 4.0*PSRC(IW+1:IE,:,:) + &
+ PSRC(IW+2:IE+1,:,:))**2
+!
+! smoothness indicators for negative wind case
+!
+ ZBNEG1(IW+1:IE-1,:,:) = 13./12 * (PSRC(IW+1:IE-1,:,:) - 2.0*PSRC(IW+2:IE,:,:) + &
+ PSRC(IW+3:IE+1,:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(IW+1:IE-1,:,:) - 4.0*PSRC(IW+2:IE,:,:)&
+ + PSRC(IW+3:IE+1,:,:))**2
+ ZBNEG1(IE, :,:) = 13./12 * (PSRC(IE,:,:) - 2.0*PSRC(IE+1,:,:) + &
+ TPHALO2%EAST(:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(IE,:,:) - 4.0*PSRC(IE+1,:,:) + &
+ TPHALO2%EAST(:,:))**2
+ ZBNEG1(IW, :,:) = (PSRC(IW, :,:) - PSRC(IW+1,:,:))**2
+ ZBNEG1(IW-1,:,:) = (PSRC(IW-1,:,:) - PSRC(IW, :,:))**2
+ ZBNEG1(IE+1,:,:) = (PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))**2
+!
+!
+ ZBNEG2(IW+1:IE,:,:) = 13./12 * (PSRC(IW:IE-1,:,:) - 2.0*PSRC(IW+1:IE,:,:) + &
+ PSRC(IW+2:IE+1,:,:))**2 + &
+ 1./4 * (PSRC(IW:IE-1,:,:) - PSRC(IW+2:IE+1,:,:))**2
+ ZBNEG2(IW, :,:) = (PSRC(IW-1,:,:) - PSRC(IW, :,:))**2
+ ZBNEG2(IE+1,:,:) = (PSRC(IE, :,:) - PSRC(IE+1,:,:))**2
+ ZBNEG2(IW-1,:,:) = (TPHALO2%WEST(:,:) - PSRC(IW-1,:,:))**2
+!
+!
+ ZBNEG3(IW+1:IE,:,:) = 13./12 * (PSRC(IW-1:IE-2,:,:) - 2.0*PSRC(IW:IE-1,:,:) + &
+ PSRC(IW+1:IE,:,:))**2 + &
+ 1./4 * ( PSRC(IW-1:IE-2,:,:) - 4.0*PSRC(IW:IE-1,:,:) + &
+ 3.0*PSRC(IW+1:IE,:,:))**2
+!
+! WENO weights
+!
+ ZOMP1(IW+1:IE,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IW+1:IE,:,:))**2
+ ZOMP2(IW+1:IE,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IW+1:IE,:,:))**2
+ ZOMP3(IW+1:IE,:,:) = ZGAMMA3 / (ZEPS + ZBPOS3(IW+1:IE,:,:))**2
+ ZOMN1(IW+1:IE,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IW+1:IE,:,:))**2
+ ZOMN2(IW+1:IE,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IW+1:IE,:,:))**2
+ ZOMN3(IW+1:IE,:,:) = ZGAMMA3 / (ZEPS + ZBNEG3(IW+1:IE,:,:))**2
+!
+ ZOMP1(IW, :,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IW, :,:))**2
+ ZOMP2(IW, :,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IW, :,:))**2
+ ZOMN1(IW, :,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IW, :,:))**2
+ ZOMN2(IW, :,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IW, :,:))**2
+ ZOMP1(IW-1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IW-1,:,:))**2
+ ZOMP2(IW-1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IW-1,:,:))**2
+ ZOMN1(IW-1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IW-1,:,:))**2
+ ZOMN2(IW-1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IW-1,:,:))**2
+ ZOMP1(IE+1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IE+1,:,:))**2
+ ZOMP2(IE+1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IE+1,:,:))**2
+ ZOMN1(IE+1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IE+1,:,:))**2
+ ZOMN2(IE+1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IE+1,:,:))**2
+!
+! WENO fluxes (5th order)
+!
+ PR(IW+1:IE,:,:) = (ZOMP2(IW+1:IE,:,:)/(ZOMP1(IW+1:IE,:,:)+ZOMP2(IW+1:IE,:,:)+&
+ ZOMP3(IW+1:IE,:,:)) * ZFPOS2(IW+1:IE,:,:) + &
+ ZOMP1(IW+1:IE,:,:)/(ZOMP1(IW+1:IE,:,:)+ZOMP2(IW+1:IE,:,:) +&
+ ZOMP3(IW+1:IE,:,:)) * ZFPOS1(IW+1:IE,:,:) + &
+ ZOMP3(IW+1:IE,:,:)/(ZOMP1(IW+1:IE,:,:)+ZOMP2(IW+1:IE,:,:)+ &
+ ZOMP3(IW+1:IE,:,:)) * &
+ ZFPOS3(IW+1:IE,:,:)) * (0.5+SIGN(0.5,PRUCT(IW+1:IE,:,:))) &
+ + (ZOMN2(IW+1:IE,:,:)/(ZOMN1(IW+1:IE,:,:)+ZOMN2(IW+1:IE,:,:)+&
+ ZOMN3(IW+1:IE,:,:)) * &
+ ZFNEG2(IW+1:IE,:,:) &
+ + ZOMN1(IW+1:IE,:,:)/(ZOMN1(IW+1:IE,:,:)+ZOMN2(IW+1:IE,:,:)+&
+ ZOMN3(IW+1:IE,:,:)) * ZFNEG1(IW+1:IE,:,:) &
+ + ZOMN3(IW+1:IE,:,:)/(ZOMN1(IW+1:IE,:,:)+ZOMN2(IW+1:IE,:,:)+&
+ ZOMN3(IW+1:IE,:,:)) * ZFNEG3(IW+1:IE,:,:)) &
+ * (0.5-SIGN(0.5,PRUCT(IW+1:IE,:,:)))
+!
+! WENO fluxes (3rd order)
+!
+ PR(IW,:,:) = (ZOMP2(IW,:,:)/(ZOMP1(IW,:,:)+ZOMP2(IW,:,:)) * ZFPOS2(IW,:,:) &
+ + ZOMP1(IW,:,:)/(ZOMP1(IW,:,:)+ZOMP2(IW,:,:)) * ZFPOS1(IW,:,:)) * &
+ (0.5+SIGN(0.5,PRUCT(IW,:,:))) &
+ + (ZOMN2(IW,:,:)/(ZOMN1(IW,:,:)+ZOMN2(IW,:,:)) * ZFNEG2(IW,:,:) &
+ + ZOMN1(IW,:,:)/(ZOMN1(IW,:,:)+ZOMN2(IW,:,:)) * ZFNEG1(IW,:,:)) * &
+ (0.5-SIGN(0.5,PRUCT(IW,:,:)))
+!
+ PR(IW-1,:,:) = (ZOMP2(IW-1,:,:)/(ZOMP1(IW-1,:,:)+ZOMP2(IW-1,:,:)) * &
+ ZFPOS2(IW-1,:,:) &
+ + ZOMP1(IW-1,:,:)/(ZOMP1(IW-1,:,:)+ZOMP2(IW-1,:,:)) * ZFPOS1(IW-1,:,:)) &
+ * (0.5+SIGN(0.5,PRUCT(IW-1,:,:))) &
+ + (ZOMN2(IW-1,:,:)/(ZOMN1(IW-1,:,:)+ZOMN2(IW-1,:,:)) * ZFNEG2(IW-1,:,:) &
+ + ZOMN1(IW-1,:,:)/(ZOMN1(IW-1,:,:)+ZOMN2(IW-1,:,:)) * ZFNEG1(IW-1,:,:)) &
+ * (0.5-SIGN(0.5,PRUCT(IW-1,:,:)))
+!
+ PR(IE+1,:,:) = (ZOMP2(IE+1,:,:)/(ZOMP1(IE+1,:,:)+ZOMP2(IE+1,:,:)) * &
+ ZFPOS2(IE+1,:,:) + &
+ ZOMP1(IE+1,:,:)/(ZOMP1(IE+1,:,:)+ZOMP2(IE+1,:,:)) * ZFPOS1(IE+1,:,:)) &
+ * (0.5+SIGN(0.5,PRUCT(IE+1,:,:))) &
+ + (ZOMN2(IE+1,:,:)/(ZOMN1(IE+1,:,:)+ZOMN2(IE+1,:,:)) * ZFNEG2(IE+1,:,:)+&
+ ZOMN1(IE+1,:,:)/(ZOMN1(IE+1,:,:)+ZOMN2(IE+1,:,:)) * ZFNEG1(IE+1,:,:)) &
+ * (0.5-SIGN(0.5,PRUCT(IE+1,:,:)))
+!
+!
+! OPEN, WALL, NEST CASE IN THE X DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+ IW=IIB
+ IE=IIE
+!
+! LATERAL BOUNDARY CONDITIONS
+! AT THE PHYSICAL BORDER: USE A FIRST ORDER UPSTREAM WENO SCHEME AT THE POINTS: IW, IE+1 /AND/ A THIRD ORDER WENO SCHEME AT THE POINTS: IW+1, IE
+! AT THE PROC. BORDER: A THIRD ORDER UPSTREAM WENO SCHEME AT THE POINTS: IW, IE+1 /AND/ A FIFTH ORDER WENO SCHEME AT THE POINTS: IW+1, IE
+!
+!
+! PHYSICAL BORDER (WEST)
+!
+ IF(LWEST_ll()) THEN
+!
+! FIRST ORDER UPSTREAM WENO SCHEME
+!
+ PR(IW,:,:) = PSRC(IW-1,:,:) * (0.5+SIGN(0.5,PRUCT(IW,:,:))) + &
+ PSRC(IW,:,:) * (0.5-SIGN(0.5,PRUCT(IW,:,:)))
+!
+! THIRD ORDER UPSTREAM WENO SCHEME
+!
+ ZFPOS1(IW+1,:,:) = 0.5 * (3.0*PSRC(IW,:,:) - PSRC(IW-1,:,:))
+ ZFPOS2(IW+1,:,:) = 0.5 * (PSRC(IW, :,:) + PSRC(IW+1,:,:))
+ ZBPOS1(IW+1,:,:) = (PSRC(IW, :,:) - PSRC(IW-1,:,:))**2
+ ZBPOS2(IW+1,:,:) = (PSRC(IW+1,:,:) - PSRC(IW, :,:))**2
+!
+ ZFNEG1(IW+1,:,:) = 0.5 * (3.0*PSRC(IW+1,:,:) - PSRC(IW+2,:,:))
+ ZFNEG2(IW+1,:,:) = 0.5 * (PSRC(IW+1, :,:) + PSRC(IW, :,:))
+ ZBNEG1(IW+1,:,:) = (PSRC(IW+1,:,:) - PSRC(IW+2,:,:))**2
+ ZBNEG2(IW+1,:,:) = (PSRC(IW, :,:) - PSRC(IW+1,:,:))**2
+!
+ ZOMP1(IW+1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IW+1,:,:))**2
+ ZOMP2(IW+1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IW+1,:,:))**2
+ ZOMN1(IW+1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IW+1,:,:))**2
+ ZOMN2(IW+1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IW+1,:,:))**2
+!
+ PR(IW+1,:,:) = (ZOMP2(IW+1,:,:)/(ZOMP1(IW+1,:,:)+ZOMP2(IW+1,:,:)) * &
+ ZFPOS2(IW+1,:,:) &
+ + ZOMP1(IW+1,:,:)/(ZOMP1(IW+1,:,:)+ZOMP2(IW+1,:,:)) * ZFPOS1(IW+1,:,:)) * &
+ (0.5+SIGN(0.5,PRUCT(IW+1,:,:))) &
+ + (ZOMN2(IW+1,:,:)/(ZOMN1(IW+1,:,:)+ZOMN2(IW+1,:,:)) * ZFNEG2(IW+1,:,:) &
+ + ZOMN1(IW+1,:,:)/(ZOMN1(IW+1,:,:)+ZOMN2(IW+1,:,:)) * ZFNEG1(IW+1,:,:)) * &
+ (0.5-SIGN(0.5,PRUCT(IW+1,:,:)))
+!
+! PROC. BORDER (WEST)
+!
+ ELSEIF (NHALO == 1) THEN
+!
+! THIRD ORDER UPSTREAM WENO SCHEME
+!
+ ZFPOS1(IW,:,:) = 0.5 * (3.0*PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))
+ ZFPOS2(IW,:,:) = 0.5 * (PSRC(IW-1, :,:) + PSRC(IW,:,:))
+ ZBPOS1(IW,:,:) = (PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))**2
+ ZBPOS2(IW,:,:) = (PSRC(IW, :,:) - PSRC(IW-1,:,:))**2
+!
+ ZFNEG1(IW,:,:) = 0.5 * (3.0*PSRC(IW,:,:) - PSRC(IW+1,:,:))
+ ZFNEG2(IW,:,:) = 0.5 * (PSRC(IW, :,:) + PSRC(IW-1,:,:))
+ ZBNEG1(IW,:,:) = (PSRC(IW, :,:) - PSRC(IW+1,:,:))**2
+ ZBNEG2(IW,:,:) = (PSRC(IW-1,:,:) - PSRC(IW, :,:))**2
+!
+ ZOMP1(IW,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IW,:,:))**2
+ ZOMP2(IW,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IW,:,:))**2
+ ZOMN1(IW,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IW,:,:))**2
+ ZOMN2(IW,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IW,:,:))**2
+!
+ PR(IW,:,:) = (ZOMP2(IW,:,:)/(ZOMP1(IW,:,:)+ZOMP2(IW,:,:)) * ZFPOS2(IW,:,:) &
+ + ZOMP1(IW,:,:)/(ZOMP1(IW,:,:)+ZOMP2(IW,:,:)) * ZFPOS1(IW,:,:))&
+ * (0.5+SIGN(0.5,PRUCT(IW,:,:))) &
+ + (ZOMN2(IW,:,:)/(ZOMN1(IW,:,:)+ZOMN2(IW,:,:)) * ZFNEG2(IW,:,:) &
+ + ZOMN1(IW,:,:)/(ZOMN1(IW,:,:)+ZOMN2(IW,:,:)) * ZFNEG1(IW,:,:))&
+ * (0.5-SIGN(0.5,PRUCT(IW,:,:)))
+!
+! FIFTH ORDER UPSTREAM WENO SCHEME
+!
+ ZFPOS1(IW+1,:,:) = 1./6. *(2.0*TPHALO2%WEST(:,:)-7.0*PSRC(IW-1,:,:)+ &
+ 11.0*PSRC(IW, :,:))
+ ZFPOS2(IW+1,:,:) = 1./6. *(-PSRC(IW-1, :,:)+ 5.0*PSRC(IW, :,:)+ &
+ 2.0*PSRC(IW+1,:,:))
+ ZFPOS3(IW+1,:,:) = 1./6. *(2.0*PSRC(IW, :,:)+5.0*PSRC(IW+1,:,:)- &
+ PSRC(IW+2, :,:))
+!
+ ZBPOS1(IW+1,:,:) = 13./12. *(TPHALO2%WEST(:,:)-2.0*PSRC(IW-1,:,:)+ &
+ PSRC(IW,:,:))**2 &
+ + 1./4. *(TPHALO2%WEST(:,:)-4.0*PSRC(IW-1,:,:)+ &
+ 3.0*PSRC(IW,:,:))**2
+ ZBPOS2(IW+1,:,:) = 13./12. *(PSRC(IW-1,:,:) -2.0*PSRC(IW,:,:)+ &
+ PSRC(IW+1,:,:))**2 &
+ + 1./4. *(PSRC(IW-1,:,:) - PSRC(IW+1,:,:))**2
+ ZBPOS3(IW+1,:,:) = 13./12. *(PSRC(IW,:,:) - 2.0*PSRC(IW+1,:,:) + &
+ PSRC(IW+2,:,:))**2 &
+ + 1./4. *(3.0*PSRC(IW,:,:) - 4.0*PSRC(IW+1,:,:) + &
+ PSRC(IW+2,:,:))**2
+!
+ ZFNEG1(IW+1,:,:) = 1./6 * (11.0*PSRC(IW+1,:,:) - 7.0*PSRC(IW+2,:,:) + &
+ 2.0*PSRC(IW+3,:,:))
+ ZFNEG2(IW+1,:,:) = 1./6 * (2.0*PSRC(IW, :,:) + 5.0*PSRC(IW+1,:,:) - &
+ PSRC(IW+2, :,:))
+ ZFNEG3(IW+1,:,:) = 1./6 * (-PSRC(IW-1 ,:,:) + 5.0*PSRC(IW, :,:) + &
+ 2.0*PSRC(IW+1,:,:))
+!
+ ZBNEG1(IW+1,:,:) = 13./12 * (PSRC(IW+1,:,:) - 2.0*PSRC(IW+2,:,:) + &
+ PSRC(IW+3,:,:))**2 &
+ + 1./4 * (3.0*PSRC(IW+1,:,:) - 4.0*PSRC(IW+2,:,:) +&
+ PSRC(IW+3,:,:))**2
+ ZBNEG2(IW+1,:,:) = 13./12 * (PSRC(IW,:,:) - 2.0*PSRC(IW+1,:,:) + &
+ PSRC(IW+2,:,:))**2 &
+ + 1./4 * (PSRC(IW,:,:) - PSRC(IW+2,:,:))**2
+ ZBNEG3(IW+1,:,:) = 13./12 * (PSRC(IW-1,:,:) - 2.0*PSRC(IW,:,:) + &
+ PSRC(IW+1,:,:))**2 &
+ + 1./4 * (PSRC(IW-1,:,:) - 4.0*PSRC(IW,:,:) + &
+ 3.0*PSRC(IW+1,:,:))**2
+!
+ ZOMP1(IW+1,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IW+1,:,:))**2
+ ZOMP2(IW+1,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IW+1,:,:))**2
+ ZOMP3(IW+1,:,:) = ZGAMMA3 / (ZEPS + ZBPOS3(IW+1,:,:))**2
+ ZOMN1(IW+1,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IW+1,:,:))**2
+ ZOMN2(IW+1,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IW+1,:,:))**2
+ ZOMN3(IW+1,:,:) = ZGAMMA3 / (ZEPS + ZBNEG3(IW+1,:,:))**2
+!
+ PR(IW+1,:,:) = (ZOMP2(IW+1,:,:)/(ZOMP1(IW+1,:,:)+ZOMP2(IW+1,:,:)+ &
+ ZOMP3(IW+1,:,:)) * ZFPOS2(IW+1,:,:) &
+ + ZOMP1(IW+1,:,:)/(ZOMP1(IW+1,:,:)+ZOMP2(IW+1,:,:)+ &
+ ZOMP3(IW+1,:,:)) * ZFPOS1(IW+1,:,:) &
+ + ZOMP3(IW+1,:,:)/(ZOMP1(IW+1,:,:)+ZOMP2(IW+1,:,:)+ &
+ ZOMP3(IW+1,:,:)) * ZFPOS3(IW+1,:,:)) * &
+ (0.5+SIGN(0.5,PRUCT(IW+1,:,:))) &
+ + (ZOMN2(IW+1,:,:)/(ZOMN1(IW+1,:,:)+ZOMN2(IW+1,:,:)+ &
+ ZOMN3(IW+1,:,:)) * ZFNEG2(IW+1,:,:) &
+ + ZOMN1(IW+1,:,:)/(ZOMN1(IW+1,:,:)+ZOMN2(IW+1,:,:)+ &
+ ZOMN3(IW+1,:,:)) * ZFNEG1(IW+1,:,:) &
+ + ZOMN3(IW+1,:,:)/(ZOMN1(IW+1,:,:)+ZOMN2(IW+1,:,:)+ &
+ ZOMN3(IW+1,:,:)) * ZFNEG3(IW+1,:,:)) * &
+ (0.5-SIGN(0.5,PRUCT(IW+1,:,:)))
+!
+ ENDIF
+!
+! PHYSICAL BORDER (EAST)
+!
+ IF(LEAST_ll()) THEN
+ PR(IE+1,:,:) = PSRC(IE,:,:) * (0.5+SIGN(0.5,PRUCT(IE+1,:,:))) + &
+ PSRC(IE+1,:,:) * (0.5-SIGN(0.5,PRUCT(IE+1,:,:)))
+!
+ ZFPOS1(IE,:,:) = 0.5 * (3.0*PSRC(IE-1,:,:) - PSRC(IE-2,:,:))
+ ZFPOS2(IE,:,:) = 0.5 * (PSRC(IE, :,:) + PSRC(IE-1,:,:))
+ ZBPOS1(IE,:,:) = (PSRC(IE-1,:,:) - PSRC(IE-2,:,:))**2
+ ZBPOS2(IE,:,:) = (PSRC(IE, :,:) - PSRC(IE-1,:,:))**2
+!
+ ZFNEG1(IE,:,:) = 0.5 * (3.0*PSRC(IE,:,:) - PSRC(IE+1,:,:))
+ ZFNEG2(IE,:,:) = 0.5 * (PSRC(IE, :,:) + PSRC(IE-1,:,:))
+ ZBNEG1(IE,:,:) = (PSRC(IE, :,:) - PSRC(IE+1,:,:))**2
+ ZBNEG2(IE,:,:) = (PSRC(IE-1,:,:) - PSRC(IE, :,:))**2
+!
+ ZOMP1(IE,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IE,:,:))**2
+ ZOMP2(IE,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IE,:,:))**2
+ ZOMN1(IE,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IE,:,:))**2
+ ZOMN2(IE,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IE,:,:))**2
+!
+ PR(IE,:,:) = (ZOMP2(IE,:,:)/(ZOMP1(IE,:,:)+ZOMP2(IE,:,:)) * ZFPOS2(IE,:,:) + &
+ ZOMP1(IE,:,:)/(ZOMP1(IE,:,:)+ZOMP2(IE,:,:)) * ZFPOS1(IE,:,:)) *&
+ (0.5+SIGN(0.5,PRUCT(IE,:,:))) &
+ + (ZOMN2(IE,:,:)/(ZOMN1(IE,:,:)+ZOMN2(IE,:,:)) * ZFNEG2(IE,:,:) + &
+ ZOMN1(IE,:,:)/(ZOMN1(IE,:,:)+ZOMN2(IE,:,:)) * ZFNEG1(IE,:,:)) *&
+ (0.5-SIGN(0.5,PRUCT(IE,:,:)))
+!
+! PROC. BORDER (EAST)
+!
+ ELSEIF(NHALO == 1) THEN
+ ZFPOS1(IE+1,:,:) = 0.5 * (3.0*PSRC(IE,:,:) - PSRC(IE-1,:,:))
+ ZFPOS2(IE+1,:,:) = 0.5 * (PSRC(IE+1, :,:) + PSRC(IE, :,:))
+ ZBPOS1(IE+1,:,:) = (PSRC(IE, :,:) - PSRC(IE-1,:,:))**2
+ ZBPOS2(IE+1,:,:) = (PSRC(IE+1,:,:) - PSRC(IE, :,:))**2
+!
+ ZFNEG1(IE+1,:,:) = 0.5 * (3.0*PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))
+ ZFNEG2(IE+1,:,:) = 0.5 * (PSRC(IE+1, :,:) + PSRC(IE, :,:))
+ ZBNEG1(IE+1,:,:) = (PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))**2
+ ZBNEG2(IE+1,:,:) = (PSRC(IE, :,:) - PSRC(IE+1, :,:))**2
+!
+ ZOMP1(IE+1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(IE+1,:,:))**2
+ ZOMP2(IE+1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(IE+1,:,:))**2
+ ZOMN1(IE+1,:,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(IE+1,:,:))**2
+ ZOMN2(IE+1,:,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(IE+1,:,:))**2
+!
+ PR(IE+1,:,:) = (ZOMP2(IE+1,:,:)/(ZOMP1(IE+1,:,:)+ZOMP2(IE+1,:,:)) * &
+ ZFPOS2(IE+1,:,:) + &
+ ZOMP1(IE+1,:,:)/(ZOMP1(IE+1,:,:)+ZOMP2(IE+1,:,:)) * &
+ ZFPOS1(IE+1,:,:)) * (0.5+SIGN(0.5,PRUCT(IE+1,:,:))) &
+ + (ZOMN2(IE+1,:,:)/(ZOMN1(IE+1,:,:)+ZOMN2(IE+1,:,:)) * &
+ ZFNEG2(IE+1,:,:) + &
+ ZOMN1(IE+1,:,:)/(ZOMN1(IE+1,:,:)+ZOMN2(IE+1,:,:)) * &
+ ZFNEG1(IE+1,:,:)) * (0.5-SIGN(0.5,PRUCT(IE+1,:,:)))
+!
+ ZFPOS1(IE,:,:) = 1./6 * (2.0*PSRC(IE-3,:,:) - 7.0*PSRC(IE-2,:,:) + &
+ 11.0*PSRC(IE-1,:,:))
+ ZFPOS2(IE,:,:) = 1./6 * (-1.0*PSRC(IE-2,:,:) + 5.0*PSRC(IE-1,:,:) + &
+ 2.0*PSRC(IE,:,:))
+ ZFPOS3(IE,:,:) = 1./6 * (2.0*PSRC(IE-1,:,:) + 5.0*PSRC(IE,:,:) - &
+ PSRC(IE+1,:,:))
+!
+ ZBPOS1(IE,:,:) = 13./12 * (PSRC(IE-3,:,:) - 2.0*PSRC(IE-2,:,:) + &
+ PSRC(IE-1,:,:))**2 + 1./4 * (PSRC(IE-3,:,:) &
+ - 4.0*PSRC(IE-2,:,:) + 3.0*PSRC(IE-1,:,:))**2
+ ZBPOS2(IE,:,:) = 13./12 * (PSRC(IE-2,:,:) - 2.0*PSRC(IE-1,:,:) + &
+ PSRC(IE,:,:))**2 + 1./4 * &
+ (PSRC(IE-2,:,:) - PSRC(IE,:,:))**2
+ ZBPOS3(IE,:,:) = 13./12 * (PSRC(IE-1,:,:) - 2.0*PSRC(IE,:,:) + &
+ PSRC(IE+1,:,:))**2 + 1./4 * &
+ ( 3.0*PSRC(IE-1,:,:) - 4.0*PSRC(IE,:,:) + PSRC(IE+1,:,:))**2
+!
+ ZFNEG1(IE,:,:) = 1./6 * (11.0*PSRC(IE, :,:) - 7.0*PSRC(IE+1,:,:) + &
+ 2.0*TPHALO2%EAST(:,:))
+ ZFNEG2(IE,:,:) = 1./6 * (2.0*PSRC(IE-1, :,:) + 5.0*PSRC(IE, :,:) - &
+ PSRC(IE+1,:,:))
+ ZFNEG3(IE,:,:) = 1./6 * (-1.0*PSRC(IE-2,:,:) + 5.0*PSRC(IE-1,:,:) + &
+ 2.0*PSRC(IE,:,:))
+!
+ ZBNEG1(IE,:,:) = 13./12 * (PSRC(IE,:,:) - 2.0*PSRC(IE+1,:,:) + &
+ TPHALO2%EAST(:,:))**2 + 1./4 * &
+ ( 3.0*PSRC(IE,:,:) - 4.0*PSRC(IE+1,:,:) + TPHALO2%EAST(:,:))**2
+ ZBNEG2(IE,:,:) = 13./12 * (PSRC(IE-1,:,:) - 2.0*PSRC(IE,:,:) + &
+ PSRC(IE+1,:,:))**2 + 1./4 * &
+ (PSRC(IE-1,:,:) - PSRC(IE+1,:,:))**2
+ ZBNEG3(IE,:,:) = 13./12 * (PSRC(IE-2,:,:) - 2.0*PSRC(IE-1,:,:) + &
+ PSRC(IE,:,:))**2 + 1./4 * &
+ ( PSRC(IE-2,:,:) - 4.0*PSRC(IE-1,:,:) + &
+ 3.0*PSRC(IE,:,:))**2
+!
+ ZOMP1(IE,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IE,:,:))**2
+ ZOMP2(IE,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IE,:,:))**2
+ ZOMP3(IE,:,:) = ZGAMMA3 / (ZEPS + ZBPOS3(IE,:,:))**2
+ ZOMN1(IE,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IE,:,:))**2
+ ZOMN2(IE,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IE,:,:))**2
+ ZOMN3(IE,:,:) = ZGAMMA3 / (ZEPS + ZBNEG3(IE,:,:))**2
+!
+ PR(IE,:,:) = (ZOMP2(IE,:,:)/(ZOMP1(IE,:,:)+ZOMP2(IE,:,:)+ &
+ ZOMP3(IE,:,:)) * ZFPOS2(IE,:,:) &
+ + ZOMP1(IE,:,:)/(ZOMP1(IE,:,:)+ZOMP2(IE,:,:)+ &
+ ZOMP3(IE,:,:)) * ZFPOS1(IE,:,:) &
+ + ZOMP3(IE,:,:)/(ZOMP1(IE,:,:)+ZOMP2(IE,:,:)+ &
+ ZOMP3(IE,:,:)) * ZFPOS3(IE,:,:)) * &
+ (0.5+SIGN(0.5,PRUCT(IE,:,:))) &
+ + (ZOMN2(IE,:,:)/(ZOMN1(IE,:,:)+ZOMN2(IE,:,:)+ &
+ ZOMN3(IE,:,:)) * ZFNEG2(IE,:,:) &
+ + ZOMN1(IE,:,:)/(ZOMN1(IE,:,:)+ZOMN2(IE,:,:)+ &
+ ZOMN3(IE,:,:)) * ZFNEG1(IE,:,:) &
+ + ZOMN3(IE,:,:)/(ZOMN1(IE,:,:)+ZOMN2(IE,:,:)+ &
+ ZOMN3(IE,:,:)) * ZFNEG3(IE,:,:)) * &
+ (0.5-SIGN(0.5,PRUCT(IE,:,:)))
+!
+ ENDIF
+!
+! USE A FIFTH ORDER UPSTREAM WENO SCHEME ELSEWHERE (IW+2 --> IE-1)
+!
+ ZFPOS1(IW+2:IE-1,:,:) = 1./6 * (2.0*PSRC(IW-1:IE-4,:,:) - &
+ 7.0*PSRC(IW:IE-3, :,:) + 11.0*PSRC(IW+1:IE-2,:,:))
+ ZFPOS2(IW+2:IE-1,:,:) = 1./6 * (-1.0*PSRC(IW:IE-3, :,:) + &
+ 5.0*PSRC(IW+1:IE-2,:,:) + 2.0*PSRC(IW+2:IE-1, :,:))
+ ZFPOS3(IW+2:IE-1,:,:) = 1./6 * (2.0*PSRC(IW+1:IE-2,:,:) + &
+ 5.0*PSRC(IW+2:IE-1,:,:) - PSRC(IW+3:IE, :,:))
+!
+ ZBPOS1(IW+2:IE-1,:,:) = 13./12 * (PSRC(IW-1:IE-4,:,:) - &
+ 2.0*PSRC(IW:IE-3,:,:) + PSRC(IW+1:IE-2,:,:))**2 + &
+ 1./4 * (PSRC(IW-1:IE-4,:,:) - 4.0*PSRC(IW:IE-3,:,:) + &
+ 3.0*PSRC(IW+1:IE-2,:,:))**2
+ ZBPOS2(IW+2:IE-1,:,:) = 13./12 * (PSRC(IW:IE-3,:,:) - &
+ 2.0*PSRC(IW+1:IE-2,:,:) + PSRC(IW+2:IE-1,:,:))**2 + &
+ 1./4 * (PSRC(IW:IE-3,:,:) - PSRC(IW+2:IE-1,:,:))**2
+ ZBPOS3(IW+2:IE-1,:,:) = 13./12 * (PSRC(IW+1:IE-2,:,:) - &
+ 2.0*PSRC(IW+2:IE-1,:,:) + PSRC(IW+3:IE,:,:))**2 + &
+ 1./4 * (3.0*PSRC(IW+1:IE-2,:,:) - 4.0*PSRC(IW+2:IE-1,:,:) + &
+ PSRC(IW+3:IE,:,:))**2
+!
+ ZFNEG1(IW+2:IE-1,:,:) = 1./6 * (11.0*PSRC(IW+2:IE-1,:,:) - &
+ 7.0*PSRC(IW+3:IE,:,:) + 2.0*PSRC(IW+4:IE+1,:,:))
+ ZFNEG2(IW+2:IE-1,:,:) = 1./6 * (2.0*PSRC(IW+1:IE-2,:,:) + &
+ 5.0*PSRC(IW+2:IE-1,:,:) - PSRC(IW+3:IE,:,:))
+ ZFNEG3(IW+2:IE-1,:,:) = 1./6 * (-1.0*PSRC(IW:IE-3,:,:) + &
+ 5.0*PSRC(IW+1:IE-2,:,:) + 2.0*PSRC(IW+2:IE-1,:,:))
+!
+ ZBNEG1(IW+2:IE-1,:,:) = 13./12 * (PSRC(IW+2:IE-1,:,:) - &
+ 2.0*PSRC(IW+3:IE,:,:) + PSRC(IW+4:IE+1,:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(IW+2:IE-1,:,:) - 4.0*PSRC(IW+3:IE,:,:) + &
+ PSRC(IW+4:IE+1,:,:))**2
+ ZBNEG2(IW+2:IE-1,:,:) = 13./12 * (PSRC(IW+1:IE-2,:,:) - &
+ 2.0*PSRC(IW+2:IE-1,:,:) + PSRC(IW+3:IE,:,:))**2 + &
+ 1./4 * (PSRC(IW+1:IE-2,:,:) - PSRC(IW+3:IE,:,:))**2
+ ZBNEG3(IW+2:IE-1,:,:) = 13./12 * (PSRC(IW:IE-3,:,:) - &
+ 2.0*PSRC(IW+1:IE-2,:,:) + PSRC(IW+2:IE-1,:,:))**2 + &
+ 1./4 * ( PSRC(IW:IE-3,:,:) - 4.0*PSRC(IW+1:IE-2,:,:) + &
+ 3.0*PSRC(IW+2:IE-1,:,:))**2
+!
+ ZOMP1(IW+2:IE-1,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IW+2:IE-1,:,:))**2
+ ZOMP2(IW+2:IE-1,:,:) = ZGAMMA2 / (ZEPS + ZBPOS2(IW+2:IE-1,:,:))**2
+ ZOMP3(IW+2:IE-1,:,:) = ZGAMMA3 / (ZEPS + ZBPOS3(IW+2:IE-1,:,:))**2
+ ZOMN1(IW+2:IE-1,:,:) = ZGAMMA1 / (ZEPS + ZBNEG1(IW+2:IE-1,:,:))**2
+ ZOMN2(IW+2:IE-1,:,:) = ZGAMMA2 / (ZEPS + ZBNEG2(IW+2:IE-1,:,:))**2
+ ZOMN3(IW+2:IE-1,:,:) = ZGAMMA3 / (ZEPS + ZBNEG3(IW+2:IE-1,:,:))**2
+!
+ PR(IW+2:IE-1,:,:) = (ZOMP2(IW+2:IE-1,:,:)/(ZOMP1(IW+2:IE-1,:,:)+ &
+ ZOMP2(IW+2:IE-1,:,:)+ &
+ ZOMP3(IW+2:IE-1,:,:)) * ZFPOS2(IW+2:IE-1,:,:) + &
+ ZOMP1(IW+2:IE-1,:,:)/(ZOMP1(IW+2:IE-1,:,:)+ZOMP2(IW+2:IE-1,:,:)+ &
+ ZOMP3(IW+2:IE-1,:,:)) * ZFPOS1(IW+2:IE-1,:,:) + &
+ ZOMP3(IW+2:IE-1,:,:)/(ZOMP1(IW+2:IE-1,:,:)+ZOMP2(IW+2:IE-1,:,:)+ &
+ ZOMP3(IW+2:IE-1,:,:)) * ZFPOS3(IW+2:IE-1,:,:)) * &
+ (0.5+SIGN(0.5,PRUCT(IW+2:IE-1,:,:))) + &
+ (ZOMN2(IW+2:IE-1,:,:)/(ZOMN1(IW+2:IE-1,:,:)+ZOMN2(IW+2:IE-1,:,:)+&
+ ZOMN3(IW+2:IE-1,:,:)) * ZFNEG2(IW+2:IE-1,:,:) + &
+ ZOMN1(IW+2:IE-1,:,:)/(ZOMN1(IW+2:IE-1,:,:)+ZOMN2(IW+2:IE-1,:,:)+ &
+ ZOMN3(IW+2:IE-1,:,:)) * ZFNEG1(IW+2:IE-1,:,:) + &
+ ZOMN3(IW+2:IE-1,:,:)/(ZOMN1(IW+2:IE-1,:,:)+ZOMN2(IW+2:IE-1,:,:)+ &
+ ZOMN3(IW+2:IE-1,:,:)) * ZFNEG3(IW+2:IE-1,:,:)) * &
+ (0.5-SIGN(0.5,PRUCT(IW+2:IE-1,:,:)))
+!
+END SELECT
+!
+PR = PR * PRUCT
+!
+END SUBROUTINE ADVEC_WENO_K_3_MX
+!
+!-------------------------------------------------------------------------------
+!
+! ########################################################################
+ SUBROUTINE ADVEC_WENO_K_3_MY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+! ########################################################################
+!!
+!!**** Computes PRVCT * PUT (or PRVCT * PWT). Upstream fluxes of U (or W)
+!! variables in Y direction.
+!! Input PUT is on U Grid 'ie' (i,j,k) based on UGRID reference
+!! Output PR is on mass Grid 'ie' (i,j-1/2,k) based on UGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IS,IN ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!
+!
+! intermediate reconstruction fluxes for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!
+! smoothness indicators for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./10.
+REAL, PARAMETER :: ZGAMMA2 = 3./5.
+REAL, PARAMETER :: ZGAMMA3 = 3./10.
+REAL, PARAMETER :: ZGAMMA1_PRIM = 1./3.
+REAL, PARAMETER :: ZGAMMA2_PRIM = 2./3.
+!
+REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!-----------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!---------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFPOS3 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZFNEG3 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBPOS3 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZBNEG3 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMP3 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+ZOMN3 = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCY(1) ) !
+!
+!* 1.1 CYCLIC CASE IN THE Y DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCY(1) == HLBCY(2)
+!
+ IF(NHALO == 1) THEN
+ IS=IJB
+ IN=IJE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 4th order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+! Same explanation than for the subroutine ADVEC_WENO_K_3_MX
+!
+! intermediate fluxes for positive wind case
+!
+ ZFPOS1(:,IS+2:IN,:) = 1./6 * (2.0*PSRC(:,IS-1:IN-3,:) - &
+ 7.0*PSRC(:,IS:IN-2,:) + 11.0*PSRC(:,IS+1:IN-1,:))
+ ZFPOS1(:,IS+1, :) = 1./6 * (2.0*TPHALO2%SOUTH(:,:) - &
+ 7.0*PSRC(:,IS-1, :) + 11.0*PSRC(:,IS, :))
+ ZFPOS1(:,IN+1,:) = 0.5 * (3.0*PSRC(:,IN,:) - PSRC(:,IN-1,:))
+ ZFPOS1(:,IS, :) = 0.5 * (3.0*PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))
+ ZFPOS1(:,IS-1, :) = - 999.
+!
+!
+ ZFPOS2(:,IS+1:IN,:) = 1./6 * (-1.0*PSRC(:,IS-1:IN-2,:) + &
+ 5.0*PSRC(:,IS:IN-1,:) + 2.0*PSRC(:,IS+1:IN,:))
+ ZFPOS2(:,IN+1,:) = 0.5 * (PSRC(:,IN, :) + PSRC(:,IN+1,:))
+ ZFPOS2(:,IS, :) = 0.5 * (PSRC(:,IS-1,:) + PSRC(:,IS, :))
+ ZFPOS2(:,IS-1,:) = 0.5 * (TPHALO2%SOUTH(:,:) + PSRC(:,IS-1,:))
+!
+!
+ ZFPOS3(:,IS+1:IN,:) = 1./6 * (2.0*PSRC(:,IS:IN-1,:) + &
+ 5.0*PSRC(:,IS+1:IN,:) - 1.0*PSRC(:,IS+2:IN+1,:))
+!
+! intermediate flux for negative wind case
+!
+ ZFNEG1(:,IS+1:IN-1,:) = 1./6 * (11.0*PSRC(:,IS+1:IN-1,:) - &
+ 7.0*PSRC(:,IS+2:IN,:) + 2.0*PSRC(:,IS+3:IN+1,:))
+ ZFNEG1(:,IN, :) = 1./6 * (11.0*PSRC(:,IN, :) - &
+ 7.0*PSRC(:,IN+1, :) + 2.0*TPHALO2%NORTH(:,:))
+ ZFNEG1(:,IS, :) = 0.5 * (3.0*PSRC(:,IS, :) - PSRC(:,IS+1,:))
+ ZFNEG1(:,IS-1,:) = 0.5 * (3.0*PSRC(:,IS-1,:) - PSRC(:,IS, :))
+ ZFNEG1(:,IN+1,:) = 0.5 * (3.0*PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))
+!
+!
+ ZFNEG2(:,IS+1:IN,:) = 1./6 * (2.0*PSRC(:,IS:IN-1,:) + &
+ 5.0*PSRC(:,IS+1:IN,:) - 1.0*PSRC(:,IS+2:IN+1,:))
+ ZFNEG2(:,IN+1,:) = 0.5 * (PSRC(:,IN+1,:) + PSRC(:,IN, :))
+ ZFNEG2(:,IS, :) = 0.5 * (PSRC(:,IS, :) + PSRC(:,IS-1,:))
+ ZFNEG2(:,IS-1,:) = 0.5 * (PSRC(:,IS-1,:) + TPHALO2%SOUTH(:,:))
+!
+!
+ ZFNEG3(:,IS+1:IN,:) = 1./6 * (-1.0*PSRC(:,IS-1:IN-2,:) + &
+ 5.0*PSRC(:,IS:IN-1,:) + 2.0*PSRC(:,IS+1:IN,:))
+!
+! smoothness indicators for positive wind case
+!
+ ZBPOS1(:,IS+2:IN,:) = 13./12 * (PSRC(:,IS-1:IN-3,:) - 2.0*PSRC(:,IS:IN-2,:) + &
+ PSRC(:,IS+1:IN-1,:))**2 + 1./4 * (PSRC(:,IS-1:IN-3,:) - 4.0*PSRC(:,IS:IN-2,:) +&
+ 3.0*PSRC(:,IS+1:IN-1,:))**2
+ ZBPOS1(:,IS+1,:) = 13./12 * (TPHALO2%SOUTH(:,:) - 2.0*PSRC(:,IS-1,:) + &
+ PSRC(:,IS,:))**2 + &
+ 1./4 * (TPHALO2%SOUTH(:,:) - 4.0*PSRC(:,IS-1,:) + 3.0*PSRC(:,IS,:))**2
+ ZBPOS1(:,IN+1,:) = (PSRC(:,IN, :) - PSRC(:,IN-1,:))**2
+ ZBPOS1(:,IS, :) = (PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))**2
+ ZBPOS1(:,IS-1,:) = - 999.
+!
+ ZBPOS2(:,IS+1:IN,:) = 13./12 * (PSRC(:,IS-1:IN-2,:) - 2.0*PSRC(:,IS:IN-1,:) + &
+ PSRC(:,IS+1:IN,:))**2 + 1./4 * (PSRC(:,IS-1:IN-2,:) - PSRC(:,IS+1:IN,:))**2
+ ZBPOS2(:,IN+1,:) = (PSRC(:,IN+1,:) - PSRC(:,IN, :))**2
+ ZBPOS2(:,IS-1,:) = (PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))**2
+ ZBPOS2(:,IS, :) = (PSRC(:,IS, :) - PSRC(:,IS-1,:))**2
+!
+!
+ ZBPOS3(:,IS+1:IN,:) = 13./12 * (PSRC(:,IS:IN-1,:) - 2.0*PSRC(:,IS+1:IN,:) + &
+ PSRC(:,IS+2:IN+1,:))**2 + 1./4 * ( 3.0*PSRC(:,IS:IN-1,:) - 4.0*PSRC(:,IS+1:IN,:) + PSRC(:,IS+2:IN+1,:))**2
+!
+! smoothness indicators for negative wind case
+!
+ ZBNEG1(:,IS+1:IN-1,:) = 13./12 * (PSRC(:,IS+1:IN-1,:) - 2.0*PSRC(:,IS+2:IN,:) + &
+ PSRC(:,IS+3:IN+1,:))**2 + 1./4 * ( 3.0*PSRC(:,IS+1:IN-1,:) - &
+ 4.0*PSRC(:,IS+2:IN,:) + PSRC(:,IS+3:IN+1,:))**2
+ ZBNEG1(:,IN, :) = 13./12 * (PSRC(:,IN,:) - 2.0*PSRC(:,IN+1,:) + &
+ TPHALO2%NORTH(:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IN,:) - 4.0*PSRC(:,IN+1,:) + TPHALO2%NORTH(:,:))**2
+ ZBNEG1(:,IS-1,:) = (PSRC(:,IS-1,:) - PSRC(:,IS,:))**2
+ ZBNEG1(:,IS, :) = (PSRC(:,IS, :) - PSRC(:,IS+1,:))**2
+ ZBNEG1(:,IN+1,:) = (PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))**2
+!
+!
+ ZBNEG2(:,IS+1:IN,:) = 13./12 * (PSRC(:,IS:IN-1,:) - 2.0*PSRC(:,IS+1:IN,:) + &
+ PSRC(:,IS+2:IN+1,:))**2 + &
+ 1./4 * (PSRC(:,IS:IN-1,:) - PSRC(:,IS+2:IN+1,:))**2
+ ZBNEG2(:,IN+1,:) = (PSRC(:,IN ,:) - PSRC(:,IN+1,:))**2
+ ZBNEG2(:,IS, :) = (PSRC(:,IS-1,:) - PSRC(:,IS, :))**2
+ ZBNEG2(:,IS-1,:) = (TPHALO2%SOUTH(:,:) - PSRC(:,IS-1,:))**2
+!
+!
+ ZBNEG3(:,IS+1:IN,:) = 13./12 * (PSRC(:,IS-1:IN-2,:) - 2.0*PSRC(:,IS:IN-1,:) + &
+ PSRC(:,IS+1:IN,:))**2 + &
+ 1./4 * ( PSRC(:,IS-1:IN-2,:) - 4.0*PSRC(:,IS:IN-1,:) + 3.0*PSRC(:,IS+1:IN,:))**2
+!
+! WENO weights
+!
+ ZOMP1(:,IS+1:IN,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IS+1:IN,:))**2
+ ZOMP2(:,IS+1:IN,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IS+1:IN,:))**2
+ ZOMP3(:,IS+1:IN,:) = ZGAMMA3 / (ZEPS + ZBPOS3(:,IS+1:IN,:))**2
+ ZOMN1(:,IS+1:IN,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IS+1:IN,:))**2
+ ZOMN2(:,IS+1:IN,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IS+1:IN,:))**2
+ ZOMN3(:,IS+1:IN,:) = ZGAMMA3 / (ZEPS + ZBNEG3(:,IS+1:IN,:))**2
+!
+ ZOMP1(:,IN+1,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IN+1,:))**2
+ ZOMP2(:,IN+1,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IN+1,:))**2
+ ZOMN1(:,IN+1,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IN+1,:))**2
+ ZOMN2(:,IN+1,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IN+1,:))**2
+ ZOMP1(:,IS, :) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IS, :))**2
+ ZOMP2(:,IS, :) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IS, :))**2
+ ZOMN1(:,IS, :) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IS, :))**2
+ ZOMN2(:,IS, :) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IS, :))**2
+ ZOMP1(:,IS-1,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IS-1,:))**2
+ ZOMP2(:,IS-1,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IS-1,:))**2
+ ZOMN1(:,IS-1,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IS-1,:))**2
+ ZOMN2(:,IS-1,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IS-1,:))**2
+!
+! WENO fluxes (5th order)
+!
+ PR(:,IS+1:IN,:) = (ZOMP2(:,IS+1:IN,:)/(ZOMP1(:,IS+1:IN,:)+ZOMP2(:,IS+1:IN,:)+&
+ ZOMP3(:,IS+1:IN,:)) * ZFPOS2(:,IS+1:IN,:) &
+ + ZOMP1(:,IS+1:IN,:)/(ZOMP1(:,IS+1:IN,:)+ZOMP2(:,IS+1:IN,:)+&
+ ZOMP3(:,IS+1:IN,:)) * ZFPOS1(:,IS+1:IN,:) &
+ + ZOMP3(:,IS+1:IN,:)/(ZOMP1(:,IS+1:IN,:)+ZOMP2(:,IS+1:IN,:)+&
+ ZOMP3(:,IS+1:IN,:)) * ZFPOS3(:,IS+1:IN,:)) * &
+ (0.5+SIGN(0.5,PRVCT(:,IS+1:IN,:))) &
+ + (ZOMN2(:,IS+1:IN,:)/(ZOMN1(:,IS+1:IN,:)+ZOMN2(:,IS+1:IN,:)+&
+ ZOMN3(:,IS+1:IN,:)) * ZFNEG2(:,IS+1:IN,:) &
+ + ZOMN1(:,IS+1:IN,:)/(ZOMN1(:,IS+1:IN,:)+ZOMN2(:,IS+1:IN,:)+&
+ ZOMN3(:,IS+1:IN,:)) * ZFNEG1(:,IS+1:IN,:) &
+ + ZOMN3(:,IS+1:IN,:)/(ZOMN1(:,IS+1:IN,:)+ZOMN2(:,IS+1:IN,:)+&
+ ZOMN3(:,IS+1:IN,:)) * ZFNEG3(:,IS+1:IN,:)) * &
+ (0.5-SIGN(0.5,PRVCT(:,IS+1:IN,:)))
+!
+! WENO fluxes (3rd order)
+!
+ PR(:,IS-1,:) = (ZOMP2(:,IS-1,:)/(ZOMP1(:,IS-1,:)+ZOMP2(:,IS-1,:)) * &
+ ZFPOS2(:,IS-1,:) &
+ + ZOMP1(:,IS-1,:)/(ZOMP1(:,IS-1,:)+ZOMP2(:,IS-1,:)) * &
+ ZFPOS1(:,IS-1,:)) * (0.5+SIGN(0.5,PRVCT(:,IS-1,:))) &
+ + (ZOMN2(:,IS-1,:)/(ZOMN1(:,IS-1,:)+ZOMN2(:,IS-1,:)) * &
+ ZFNEG2(:,IS-1,:) &
+ + ZOMN1(:,IS-1,:)/(ZOMN1(:,IS-1,:)+ZOMN2(:,IS-1,:)) * &
+ ZFNEG1(:,IS-1,:)) * (0.5-SIGN(0.5,PRVCT(:,IS-1,:)))
+!
+ PR(:,IS, :) = (ZOMP2(:,IS, :)/(ZOMP1(:,IS, :)+ZOMP2(:,IS, :)) * &
+ ZFPOS2(:,IS, :) &
+ + ZOMP1(:,IS, :)/(ZOMP1(:,IS, :)+ZOMP2(:,IS, :)) * &
+ ZFPOS1(:,IS, :)) * (0.5+SIGN(0.5,PRVCT(:,IS, :))) &
+ + (ZOMN2(:,IS, :)/(ZOMN1(:,IS, :)+ZOMN2(:,IS, :)) * &
+ ZFNEG2(:,IS, :) &
+ + ZOMN1(:,IS, :)/(ZOMN1(:,IS, :)+ZOMN2(:,IS, :)) * &
+ ZFNEG1(:,IS, :)) * (0.5-SIGN(0.5,PRVCT(:,IS, :)))
+!
+ PR(:,IN+1,:) = (ZOMP2(:,IN+1,:)/(ZOMP1(:,IN+1,:)+ZOMP2(:,IN+1,:)) * &
+ ZFPOS2(:,IN+1,:) &
+ + ZOMP1(:,IN+1,:)/(ZOMP1(:,IN+1,:)+ZOMP2(:,IN+1,:)) * &
+ ZFPOS1(:,IN+1,:)) * (0.5+SIGN(0.5,PRVCT(:,IN+1,:))) &
+ + (ZOMN2(:,IN+1,:)/(ZOMN1(:,IN+1,:)+ZOMN2(:,IN+1,:)) * &
+ ZFNEG2(:,IN+1,:) &
+ + ZOMN1(:,IN+1,:)/(ZOMN1(:,IN+1,:)+ZOMN2(:,IN+1,:)) * &
+ ZFNEG1(:,IN+1,:)) * (0.5-SIGN(0.5,PRVCT(:,IN+1,:)))
+!
+!
+! OPEN, WALL, NEST CASE IN THE Y DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+ IS=IJB
+ IN=IJE
+!
+ IF(LSOUTH_ll()) THEN
+ PR(:,IS,:) = PSRC(:,IS-1,:) * (0.5+SIGN(0.5,PRVCT(:,IS,:))) + &
+ PSRC(:,IS,:) * (0.5-SIGN(0.5,PRVCT(:,IS,:)))
+!
+ ZFPOS1(:,IS+1,:) = 0.5 * (3.0*PSRC(:,IS,:) - PSRC(:,IS-1,:))
+ ZFPOS2(:,IS+1,:) = 0.5 * (PSRC(:,IS, :) + PSRC(:,IS+1,:))
+ ZBPOS1(:,IS+1,:) = (PSRC(:,IS, :) - PSRC(:,IS-1,:))**2
+ ZBPOS2(:,IS+1,:) = (PSRC(:,IS+1,:) - PSRC(:,IS, :))**2
+!
+ ZFNEG1(:,IS+1,:) = 0.5 * (3.0*PSRC(:,IS+1,:) - PSRC(:,IS+2,:))
+ ZFNEG2(:,IS+1,:) = 0.5 * (PSRC(:,IS+1, :) + PSRC(:,IS,:))
+ ZBNEG1(:,IS+1,:) = (PSRC(:,IS+1,:) - PSRC(:,IS+2,:))**2
+ ZBNEG2(:,IS+1,:) = (PSRC(:,IS, :) - PSRC(:,IS+1,:))**2
+!
+ ZOMP1(:,IS+1,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IS+1,:))**2
+ ZOMP2(:,IS+1,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IS+1,:))**2
+ ZOMN1(:,IS+1,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IS+1,:))**2
+ ZOMN2(:,IS+1,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IS+1,:))**2
+!
+ PR(:,IS+1, :) = (ZOMP2(:,IS+1,:)/(ZOMP1(:,IS+1,:)+ZOMP2(:,IS+1,:)) * &
+ ZFPOS2(:,IS+1,:) &
+ + ZOMP1(:,IS+1,:)/(ZOMP1(:,IS+1,:)+ZOMP2(:,IS+1,:)) * &
+ ZFPOS1(:,IS+1,:)) * (0.5+SIGN(0.5,PRVCT(:,IS+1,:))) &
+ + (ZOMN2(:,IS+1,:)/(ZOMN1(:,IS+1,:)+ZOMN2(:,IS+1,:)) * &
+ ZFNEG2(:,IS+1,:) &
+ + ZOMN1(:,IS+1,:)/(ZOMN1(:,IS+1,:)+ZOMN2(:,IS+1,:)) * &
+ ZFNEG1(:,IS+1,:)) * (0.5-SIGN(0.5,PRVCT(:,IS+1,:)))
+!
+ ELSEIF(NHALO == 1) THEN
+ ZFPOS1(:,IS,:) = 0.5 * (3.0*PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))
+ ZFPOS2(:,IS,:) = 0.5 * (PSRC(:,IS-1, :) + PSRC(:,IS,:))
+ ZBPOS1(:,IS,:) = (PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))**2
+ ZBPOS2(:,IS,:) = (PSRC(:,IS, :) - PSRC(:,IS-1,:))**2
+!
+ ZFNEG1(:,IS,:) = 0.5 * (3.0*PSRC(:,IS, :) - PSRC(:,IS+1,:))
+ ZFNEG2(:,IS,:) = 0.5 * (PSRC(:,IS, :) + PSRC(:,IS-1,:))
+ ZBNEG1(:,IS,:) = (PSRC(:,IS, :) - PSRC(:,IS+1,:))**2
+ ZBNEG2(:,IS,:) = (PSRC(:,IS-1,:) - PSRC(:,IS, :))**2
+!
+ ZOMP1(:,IS,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IS,:))**2
+ ZOMP2(:,IS,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IS,:))**2
+ ZOMN1(:,IS,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IS,:))**2
+ ZOMN2(:,IS,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IS,:))**2
+!
+ PR(:,IS,:) = (ZOMP2(:,IS,:)/(ZOMP1(:,IS,:)+ZOMP2(:,IS,:)) * ZFPOS2(:,IS,:) &
+ + ZOMP1(:,IS,:)/(ZOMP1(:,IS,:)+ZOMP2(:,IS,:)) * ZFPOS1(:,IS,:)) *&
+ (0.5+SIGN(0.5,PRVCT(:,IS,:))) &
+ + (ZOMN2(:,IS,:)/(ZOMN1(:,IS,:)+ZOMN2(:,IS,:)) * ZFNEG2(:,IS,:) &
+ + ZOMN1(:,IS,:)/(ZOMN1(:,IS,:)+ZOMN2(:,IS,:)) * ZFNEG1(:,IS,:)) *&
+ (0.5-SIGN(0.5,PRVCT(:,IS,:)))
+!
+ ZFPOS1(:,IS+1,:) = 1./6 * (2.0*TPHALO2%SOUTH(:,:) - 7.0*PSRC(:,IS-1,:) + &
+ 11.0*PSRC(:,IS,:))
+ ZFPOS2(:,IS+1,:) = 1./6 * (-1.0*PSRC(:,IS-1,:) + 5.0*PSRC(:,IS,:) + &
+ 2.0*PSRC(:,IS+1,:))
+ ZFPOS3(:,IS+1,:) = 1./6 * (2.0*PSRC(:,IS,:) + 5.0*PSRC(:,IS+1,:) - &
+ 1.0*PSRC(:,IS+2,:))
+!
+ ZBPOS1(:,IS+1,:) = 13./12 * (TPHALO2%SOUTH(:,:) - 2.0*PSRC(:,IS-1,:) + &
+ PSRC(:,IS,:))**2 + &
+ 1./4 * (TPHALO2%SOUTH(:,:) - 4.0*PSRC(:,IS-1,:) + 3.0*PSRC(:,IS,:))**2
+ ZBPOS2(:,IS+1,:) = 13./12 * (PSRC(:,IS-1,:) - 2.0*PSRC(:,IS,:) + &
+ PSRC(:,IS+1,:))**2 + &
+ 1./4 * (PSRC(:,IS-1,:) - PSRC(:,IS+1,:))**2
+ ZBPOS3(:,IS+1,:) = 13./12 * (PSRC(:,IS,:) - 2.0*PSRC(:,IS+1,:) + &
+ PSRC(:,IS+2,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IS,:) - 4.0*PSRC(:,IS+1,:) + PSRC(:,IS+2,:))**2
+!
+ ZFNEG1(:,IS+1,:) = 1./6 * (11.0*PSRC(:,IS+1,:) - 7.0*PSRC(:,IS+2,:) + &
+ 2.0*PSRC(:,IS+3,:))
+ ZFNEG2(:,IS+1,:) = 1./6 * (2.0*PSRC(:,IS,:) + 5.0*PSRC(:,IS+1,:) - &
+ 1.0*PSRC(:,IS+2,:))
+ ZFNEG3(:,IS+1,:) = 1./6 * (-1.0*PSRC(:,IS-1,:) + 5.0*PSRC(:,IS,:) + &
+ 2.0*PSRC(:,IS+1,:))
+!
+ ZBNEG1(:,IS+1,:) = 13./12 * (PSRC(:,IS+1,:) - 2.0*PSRC(:,IS+2,:) + &
+ PSRC(:,IS+3,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IS+1,:) - 4.0*PSRC(:,IS+2,:) + PSRC(:,IS+3,:))**2
+ ZBNEG2(:,IS+1,:) = 13./12 * (PSRC(:,IS,:) - 2.0*PSRC(:,IS+1,:) + &
+ PSRC(:,IS+2,:))**2 + &
+ 1./4 * (PSRC(:,IS,:) - PSRC(:,IS+2,:))**2
+ ZBNEG3(:,IS+1,:) = 13./12 * (PSRC(:,IS-1,:) - 2.0*PSRC(:,IS,:) + &
+ PSRC(:,IS+1,:))**2 + &
+ 1./4 * ( PSRC(:,IS-1,:) - 4.0*PSRC(:,IS,:) + 3.0*PSRC(:,IS+1,:))**2
+!
+ ZOMP1(:,IS+1,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IS+1,:))**2
+ ZOMP2(:,IS+1,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IS+1,:))**2
+ ZOMP3(:,IS+1,:) = ZGAMMA3 / (ZEPS + ZBPOS3(:,IS+1,:))**2
+ ZOMN1(:,IS+1,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IS+1,:))**2
+ ZOMN2(:,IS+1,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IS+1,:))**2
+ ZOMN3(:,IS+1,:) = ZGAMMA3 / (ZEPS + ZBNEG3(:,IS+1,:))**2
+!
+ PR(:,IS+1,:) = (ZOMP2(:,IS+1,:)/(ZOMP1(:,IS+1,:)+ZOMP2(:,IS+1,:)+ &
+ ZOMP3(:,IS+1,:)) * ZFPOS2(:,IS+1,:) &
+ + ZOMP1(:,IS+1,:)/(ZOMP1(:,IS+1,:)+ZOMP2(:,IS+1,:)+ &
+ ZOMP3(:,IS+1,:)) * ZFPOS1(:,IS+1,:) &
+ + ZOMP3(:,IS+1,:)/(ZOMP1(:,IS+1,:)+ZOMP2(:,IS+1,:)+ &
+ ZOMP3(:,IS+1,:)) * ZFPOS3(:,IS+1,:)) *&
+ (0.5+SIGN(0.5,PRVCT(:,IS+1,:))) &
+ + (ZOMN2(:,IS+1,:)/(ZOMN1(:,IS+1,:)+ZOMN2(:,IS+1,:)+ &
+ ZOMN3(:,IS+1,:)) * ZFNEG2(:,IS+1,:) &
+ + ZOMN1(:,IS+1,:)/(ZOMN1(:,IS+1,:)+ZOMN2(:,IS+1,:)+ &
+ ZOMN3(:,IS+1,:)) * ZFNEG1(:,IS+1,:) &
+ + ZOMN3(:,IS+1,:)/(ZOMN1(:,IS+1,:)+ZOMN2(:,IS+1,:)+ &
+ ZOMN3(:,IS+1,:)) * ZFNEG3(:,IS+1,:)) *&
+ (0.5-SIGN(0.5,PRVCT(:,IS+1,:)))
+!
+ ENDIF
+!
+ IF(LNORTH_ll()) THEN
+ PR(:,IN+1,:) = PSRC(:,IN,:) * (0.5+SIGN(0.5,PRVCT(:,IN+1,:))) + &
+ PSRC(:,IN+1,:) * (0.5-SIGN(0.5,PRVCT(:,IN+1,:)))
+!
+ ZFPOS1(:,IN,:) = 0.5 * (3.0*PSRC(:,IN-1,:) - PSRC(:,IN-2,:))
+ ZFPOS2(:,IN,:) = 0.5 * (PSRC(:,IN-1, :) + PSRC(:,IN, :))
+ ZBPOS1(:,IN,:) = (PSRC(:,IN-1,:) - PSRC(:,IN-2,:))**2
+ ZBPOS2(:,IN,:) = (PSRC(:,IN, :) - PSRC(:,IN-1,:))**2
+!
+ ZFNEG1(:,IN,:) = 0.5 * (3.0*PSRC(:,IN,:) - PSRC(:,IN+1,:))
+ ZFNEG2(:,IN,:) = 0.5 * (PSRC(:,IN, :) + PSRC(:,IN-1,:))
+ ZBNEG1(:,IN,:) = (PSRC(:,IN, :) - PSRC(:,IN+1,:))**2
+ ZBNEG2(:,IN,:) = (PSRC(:,IN-1,:) - PSRC(:,IN, :))**2
+!
+ ZOMP1(:,IN,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IN,:))**2
+ ZOMP2(:,IN,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IN,:))**2
+ ZOMN1(:,IN,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IN,:))**2
+ ZOMN2(:,IN,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IN,:))**2
+!
+ PR(:,IN,:) = (ZOMP2(:,IN,:)/(ZOMP1(:,IN,:)+ZOMP2(:,IN,:)) * ZFPOS2(:,IN,:) &
+ + ZOMP1(:,IN,:)/(ZOMP1(:,IN,:)+ZOMP2(:,IN,:)) * ZFPOS1(:,IN,:)) *&
+ (0.5+SIGN(0.5,PRVCT(:,IN,:))) &
+ + (ZOMN2(:,IN,:)/(ZOMN1(:,IN,:)+ZOMN2(:,IN,:)) * ZFNEG2(:,IN,:) &
+ + ZOMN1(:,IN,:)/(ZOMN1(:,IN,:)+ZOMN2(:,IN,:)) * ZFNEG1(:,IN,:)) *&
+ (0.5-SIGN(0.5,PRVCT(:,IN,:)))
+!
+ ELSEIF(NHALO == 1) THEN
+ ZFPOS1(:,IN+1,:) = 0.5 * (3.0*PSRC(:,IN,:) - PSRC(:,IN-1,:))
+ ZFPOS2(:,IN+1,:) = 0.5 * (PSRC(:,IN, :) + PSRC(:,IN+1,:))
+ ZBPOS1(:,IN+1,:) = (PSRC(:,IN, :) - PSRC(:,IN-1,:))**2
+ ZBPOS2(:,IN+1,:) = (PSRC(:,IN+1,:) - PSRC(:,IN, :))**2
+!
+ ZFNEG1(:,IN+1,:) = 0.5 * (3.0*PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))
+ ZFNEG2(:,IN+1,:) = 0.5 * (PSRC(:,IN+1, :) + PSRC(:,IN, :))
+ ZBNEG1(:,IN+1,:) = (PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))**2
+ ZBNEG2(:,IN+1,:) = (PSRC(:,IN ,:) - PSRC(:,IN+1,:))**2
+!
+ ZOMP1(:,IN+1,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IN+1,:))**2
+ ZOMP2(:,IN+1,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IN+1,:))**2
+ ZOMN1(:,IN+1,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IN+1,:))**2
+ ZOMN2(:,IN+1,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IN+1,:))**2
+!
+ PR(:,IN+1,:) = (ZOMP2(:,IN+1,:)/(ZOMP1(:,IN+1,:)+ZOMP2(:,IN+1,:))*&
+ ZFPOS2(:,IN+1,:) &
+ + ZOMP1(:,IN+1,:)/(ZOMP1(:,IN+1,:)+ZOMP2(:,IN+1,:)) * &
+ ZFPOS1(:,IN+1,:)) * (0.5+SIGN(0.5,PRVCT(:,IN+1,:))) &
+ + (ZOMN2(:,IN+1,:)/(ZOMN1(:,IN+1,:)+ZOMN2(:,IN+1,:)) * &
+ ZFNEG2(:,IN+1,:) &
+ + ZOMN1(:,IN+1,:)/(ZOMN1(:,IN+1,:)+ZOMN2(:,IN+1,:)) * &
+ ZFNEG1(:,IN+1,:)) * (0.5-SIGN(0.5,PRVCT(:,IN+1,:)))
+!
+ ZFPOS1(:,IN,:) = 1./6 * (2.0*PSRC(:,IN-3,:) - 7.0*PSRC(:,IN-2,:) + &
+ 11.0*PSRC(:,IN-1,:))
+ ZFPOS2(:,IN,:) = 1./6 * (-1.0*PSRC(:,IN-2,:) + 5.0*PSRC(:,IN-1,:) + &
+ 2.0*PSRC(:,IN,:))
+ ZFPOS3(:,IN,:) = 1./6 * (2.0*PSRC(:,IN-1,:) + 5.0*PSRC(:,IN,:) - &
+ 1.0*PSRC(:,IN+1,:))
+!
+ ZBPOS1(:,IN,:) = 13./12 * (PSRC(:,IN-3,:) - 2.0*PSRC(:,IN-2,:) + &
+ PSRC(:,IN-1,:))**2 + &
+ 1./4 * (PSRC(:,IN-3,:) - 4.0*PSRC(:,IN-2,:) + 3.0*PSRC(:,IN-1,:))**2
+ ZBPOS2(:,IN,:) = 13./12 * (PSRC(:,IN-2,:) - 2.0*PSRC(:,IN-1,:) + &
+ PSRC(:,IN,:))**2 + &
+ 1./4 * (PSRC(:,IN-2,:) - PSRC(:,IN,:))**2
+ ZBPOS3(:,IN,:) = 13./12 * (PSRC(:,IN-1,:) - 2.0*PSRC(:,IN,:) + &
+ PSRC(:,IN+1,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IN-1,:) - 4.0*PSRC(:,IN,:) + PSRC(:,IN+1,:))**2
+!
+ ZFNEG1(:,IN,:) = 1./6 * (11.0*PSRC(:,IN,:) - 7.0*PSRC(:,IN+1,:) + &
+ 2.0*TPHALO2%NORTH(:,:))
+ ZFNEG2(:,IN,:) = 1./6 * (2.0*PSRC(:,IN-1,:) + 5.0*PSRC(:,IN,:) - &
+ 1.0*PSRC(:,IN+1,:))
+ ZFNEG3(:,IN,:) = 1./6 * (-1.0*PSRC(:,IN-2,:) + 5.0*PSRC(:,IN-1,:) + &
+ 2.0*PSRC(:,IN,:))
+!
+ ZBNEG1(:,IN,:) = 13./12 * (PSRC(:,IN,:) - 2.0*PSRC(:,IN+1,:) + &
+ TPHALO2%NORTH(:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IN,:) - 4.0*PSRC(:,IN+1,:) + TPHALO2%NORTH(:,:))**2
+ ZBNEG2(:,IN,:) = 13./12 * (PSRC(:,IN-1,:) - 2.0*PSRC(:,IN,:) + &
+ PSRC(:,IN+1,:))**2 + &
+ 1./4 * (PSRC(:,IN-1,:) - PSRC(:,IN+1,:))**2
+ ZBNEG3(:,IN,:) = 13./12 * (PSRC(:,IN-2,:) - 2.0*PSRC(:,IN-1,:) +&
+ PSRC(:,IN,:))**2 + &
+ 1./4 * ( PSRC(:,IN-2,:) - 4.0*PSRC(:,IN-1,:) + 3.0*PSRC(:,IN,:))**2
+!
+ ZOMP1(:,IN,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IN,:))**2
+ ZOMP2(:,IN,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IN,:))**2
+ ZOMP3(:,IN,:) = ZGAMMA3 / (ZEPS + ZBPOS3(:,IN,:))**2
+ ZOMN1(:,IN,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IN,:))**2
+ ZOMN2(:,IN,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IN,:))**2
+ ZOMN3(:,IN,:) = ZGAMMA3 / (ZEPS + ZBNEG3(:,IN,:))**2
+!
+ PR(:,IN,:) = (ZOMP2(:,IN,:)/(ZOMP1(:,IN,:)+ZOMP2(:,IN,:)+ZOMP3(:,IN,:)) * &
+ ZFPOS2(:,IN,:) &
+ + ZOMP1(:,IN,:)/(ZOMP1(:,IN,:)+ZOMP2(:,IN,:)+ZOMP3(:,IN,:)) * ZFPOS1(:,IN,:) &
+ + ZOMP3(:,IN,:)/(ZOMP1(:,IN,:)+ZOMP2(:,IN,:)+ZOMP3(:,IN,:)) * ZFPOS3(:,IN,:)) &
+ * (0.5+SIGN(0.5,PRVCT(:,IN,:))) &
+ + (ZOMN2(:,IN,:)/(ZOMN1(:,IN,:)+ZOMN2(:,IN,:)+ZOMN3(:,IN,:)) * ZFNEG2(:,IN,:) &
+ + ZOMN1(:,IN,:)/(ZOMN1(:,IN,:)+ZOMN2(:,IN,:)+ZOMN3(:,IN,:)) * ZFNEG1(:,IN,:) &
+ + ZOMN3(:,IN,:)/(ZOMN1(:,IN,:)+ZOMN2(:,IN,:)+ZOMN3(:,IN,:)) * ZFNEG3(:,IN,:)) &
+ * (0.5-SIGN(0.5,PRVCT(:,IN,:)))
+!
+ ENDIF
+!
+! USE A FIFTH ORDER UPSTREAM WENO SCHEME ELSEWHERE (IS+2 --> IN-1)
+!
+ ZFPOS1(:,IS+2:IN-1,:) = 1./6 * (2.0*PSRC(:,IS-1:IN-4,:) - &
+ 7.0*PSRC(:,IS:IN-3, :) + 11.0*PSRC(:,IS+1:IN-2,:))
+ ZFPOS2(:,IS+2:IN-1,:) = 1./6 * (-1.0*PSRC(:,IS:IN-3, :) + &
+ 5.0*PSRC(:,IS+1:IN-2,:) + 2.0*PSRC(:,IS+2:IN-1, :))
+ ZFPOS3(:,IS+2:IN-1,:) = 1./6 * (2.0*PSRC(:,IS+1:IN-2,:) + &
+ 5.0*PSRC(:,IS+2:IN-1,:) - 1.0*PSRC(:,IS+3:IN, :))
+!
+ ZBPOS1(:,IS+2:IN-1,:) = 13./12 * (PSRC(:,IS-1:IN-4,:) - &
+ 2.0*PSRC(:,IS:IN-3,:) + PSRC(:,IS+1:IN-2,:))**2 + &
+ 1./4 * (PSRC(:,IS-1:IN-4,:) - 4.0*PSRC(:,IS:IN-3,:) + &
+ 3.0*PSRC(:,IS+1:IN-2,:))**2
+ ZBPOS2(:,IS+2:IN-1,:) = 13./12 * (PSRC(:,IS:IN-3,:) - &
+ 2.0*PSRC(:,IS+1:IN-2,:) + PSRC(:,IS+2:IN-1,:))**2 + &
+ 1./4 * (PSRC(:,IS:IN-3,:) - PSRC(:,IS+2:IN-1,:))**2
+ ZBPOS3(:,IS+2:IN-1,:) = 13./12 * (PSRC(:,IS+1:IN-2,:) - &
+ 2.0*PSRC(:,IS+2:IN-1,:) + PSRC(:,IS+3:IN,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IS+1:IN-2,:) - 4.0*PSRC(:,IS+2:IN-1,:) +&
+ PSRC(:,IS+3:IN,:))**2
+!
+ ZFNEG1(:,IS+2:IN-1,:) = 1./6 * (11.0*PSRC(:,IS+2:IN-1,:) - &
+ 7.0*PSRC(:,IS+3:IN,:) + 2.0*PSRC(:,IS+4:IN+1,:))
+ ZFNEG2(:,IS+2:IN-1,:) = 1./6 * (2.0*PSRC(:,IS+1:IN-2,:) + &
+ 5.0*PSRC(:,IS+2:IN-1,:) - 1.0*PSRC(:,IS+3:IN,:))
+ ZFNEG3(:,IS+2:IN-1,:) = 1./6 * (-1.0*PSRC(:,IS:IN-3,:) + &
+ 5.0*PSRC(:,IS+1:IN-2,:) + 2.0*PSRC(:,IS+2:IN-1,:))
+!
+ ZBNEG1(:,IS+2:IN-1,:) = 13./12 * (PSRC(:,IS+2:IN-1,:) - &
+ 2.0*PSRC(:,IS+3:IN,:) + PSRC(:,IS+4:IN+1,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IS+2:IN-1,:) - 4.0*PSRC(:,IS+3:IN,:) + &
+ PSRC(:,IS+4:IN+1,:))**2
+ ZBNEG2(:,IS+2:IN-1,:) = 13./12 * (PSRC(:,IS+1:IN-2,:) - &
+ 2.0*PSRC(:,IS+2:IN-1,:) + PSRC(:,IS+3:IN,:))**2 + &
+ 1./4 * (PSRC(:,IS+1:IN-2,:) - PSRC(:,IS+3:IN,:))**2
+ ZBNEG3(:,IS+2:IN-1,:) = 13./12 * (PSRC(:,IS:IN-3,:) - &
+ 2.0*PSRC(:,IS+1:IN-2,:) + PSRC(:,IS+2:IN-1,:))**2 + &
+ 1./4 * ( PSRC(:,IS:IN-3,:) - 4.0*PSRC(:,IS+1:IN-2,:) + &
+ 3.0*PSRC(:,IS+2:IN-1,:))**2
+!
+ ZOMP1(:,IS+2:IN-1,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IS+2:IN-1,:))**2
+ ZOMP2(:,IS+2:IN-1,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IS+2:IN-1,:))**2
+ ZOMP3(:,IS+2:IN-1,:) = ZGAMMA3 / (ZEPS + ZBPOS3(:,IS+2:IN-1,:))**2
+ ZOMN1(:,IS+2:IN-1,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IS+2:IN-1,:))**2
+ ZOMN2(:,IS+2:IN-1,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IS+2:IN-1,:))**2
+ ZOMN3(:,IS+2:IN-1,:) = ZGAMMA3 / (ZEPS + ZBNEG3(:,IS+2:IN-1,:))**2
+!
+ PR(:,IS+2:IN-1,:) = (ZOMP2(:,IS+2:IN-1,:)/(ZOMP1(:,IS+2:IN-1,:)+&
+ ZOMP2(:,IS+2:IN-1,:)+ZOMP3(:,IS+2:IN-1,:)) * ZFPOS2(:,IS+2:IN-1,:) &
+ + ZOMP1(:,IS+2:IN-1,:)/(ZOMP1(:,IS+2:IN-1,:)+&
+ ZOMP2(:,IS+2:IN-1,:)+ZOMP3(:,IS+2:IN-1,:)) * ZFPOS1(:,IS+2:IN-1,:) &
+ + ZOMP3(:,IS+2:IN-1,:)/(ZOMP1(:,IS+2:IN-1,:)+ZOMP2(:,IS+2:IN-1,:)+ &
+ ZOMP3(:,IS+2:IN-1,:)) * ZFPOS3(:,IS+2:IN-1,:)) &
+ * (0.5+SIGN(0.5,PRVCT(:,IS+2:IN-1,:))) &
+ + (ZOMN2(:,IS+2:IN-1,:)/(ZOMN1(:,IS+2:IN-1,:)+ZOMN2(:,IS+2:IN-1,:)+ &
+ ZOMN3(:,IS+2:IN-1,:)) * ZFNEG2(:,IS+2:IN-1,:) &
+ + ZOMN1(:,IS+2:IN-1,:)/(ZOMN1(:,IS+2:IN-1,:)+ZOMN2(:,IS+2:IN-1,:)+ &
+ ZOMN3(:,IS+2:IN-1,:)) * ZFNEG1(:,IS+2:IN-1,:) &
+ + ZOMN3(:,IS+2:IN-1,:)/(ZOMN1(:,IS+2:IN-1,:)+ZOMN2(:,IS+2:IN-1,:)+&
+ ZOMN3(:,IS+2:IN-1,:)) * ZFNEG3(:,IS+2:IN-1,:)) &
+ * (0.5-SIGN(0.5,PRVCT(:,IS+2:IN-1,:)))
+!
+END SELECT
+!
+PR = PR * PRVCT
+!
+END SUBROUTINE ADVEC_WENO_K_3_MY
+!
+!-------------------------------------------------------------------------------
+!
+! #############################################################
+ SUBROUTINE ADVEC_WENO_K_3_VY(HLBCY, PSRC, PRVCT, PR, TPHALO2)
+! #############################################################
+!!
+!!**** Computes PRVCT * PVT. Upstream fluxes of V in Y direction.
+!! Input PVT is on V Grid 'ie' (i,j,k) based on VGRID reference
+!! Output PR is on mass Grid 'ie' (i,j+1/2,k) based on VGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+INTEGER:: IS,IN ! Coordinate of third order diffusion area
+!
+INTEGER:: ILUOUT,IRESP ! for prints
+!
+! intermediate reconstruction fluxes for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!
+! smoothness indicators for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2, ZOMN3
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./10.
+REAL, PARAMETER :: ZGAMMA2 = 3./5.
+REAL, PARAMETER :: ZGAMMA3 = 3./10.
+REAL, PARAMETER :: ZGAMMA1_PRIM = 1./3.
+REAL, PARAMETER :: ZGAMMA2_PRIM = 2./3.
+!
+ REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!----------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!--------------------------------------------------------------------------
+!
+!* 0.4. INITIALIZE THE FIELD
+! ---------------------
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFPOS3 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZFNEG3 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBPOS3 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZBNEG3 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMP3 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+ZOMN3 = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HLBCY(1) ) ! Y direction LBC type: (1) for left side
+!
+!* 1.1 CYCLIC CASE IN THE Y DIRECTION:
+!
+CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+!
+ IF(NHALO == 1) THEN
+ IS=IJB
+ IN=IJE
+ ELSE
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
+ WRITE(ILUOUT,*) 'ERROR : 4th order advection in CYCLic case '
+ WRITE(ILUOUT,*) 'cannot be used with NHALO=2'
+ CALL ABORT
+ STOP
+ END IF
+!
+! Same explanation than for the subroutine ADVEC_WENO_K_3_UX
+!
+! intermediate fluxes for positive wind case
+!
+ ZFPOS1(:,IS+1:IN-1,:) = 1./6 * (2.0*PSRC(:,IS-1:IN-3,:) - 7.0*PSRC(:,IS:IN-2,:) +&
+ 11.0*PSRC(:,IS+1:IN-1,:))
+ ZFPOS1(:,IS, :) = 1./6 * (2.0*TPHALO2%SOUTH(:,:) - 7.0*PSRC(:,IS-1, :) +&
+ 11.0*PSRC(:,IS, :))
+ ZFPOS1(:,IS-1,:) = 0.5 * (3.0*PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))
+ ZFPOS1(:,IN, :) = 0.5 * (3.0*PSRC(:,IN, :) - PSRC(:,IN-1,:))
+ ZFPOS1(:,IN+1,:) = 0.5 * (3.0*PSRC(:,IN+1,:) - PSRC(:,IN, :))
+!
+!
+ ZFPOS2(:,IS:IN-1,:) = 1./6 * (-1.0*PSRC(:,IS-1:IN-2,:) + 5.0*PSRC(:,IS:IN-1,:) +&
+ 2.0*PSRC(:,IS+1:IN,:))
+ ZFPOS2(:,IS-1,:) = 0.5 * (PSRC(:,IS-1,:) + PSRC(:,IS, :))
+ ZFPOS2(:,IN, :) = 0.5 * (PSRC(:,IN, :) + PSRC(:,IN+1,:))
+ ZFPOS2(:,IN+1,:) = 0.5 * (PSRC(:,IN+1,:) + TPHALO2%NORTH(:,:))
+!
+!
+ ZFPOS3(:,IS:IN-1,:) = 1./6 * (2.0*PSRC(:,IS:IN-1,:) + 5.0*PSRC(:,IS+1:IN,:) - &
+ 1.0*PSRC(:,IS+2:IN+1,:))
+!
+! intermediate flux for negative wind case
+!
+ ZFNEG1(:,IS:IN-2,:) = 1./6 * (11.0*PSRC(:,IS+1:IN-1,:) - 7.0*PSRC(:,IS+2:IN,:) +&
+ 2.0*PSRC(:,IS+3:IN+1,:))
+ ZFNEG1(:,IN-1, :) = 1./6 * (11.0*PSRC(:,IN, :) - 7.0*PSRC(:,IN+1, :) +&
+ 2.0*TPHALO2%NORTH(:,:))
+ ZFNEG1(:,IS-1,:) = 0.5 * (3.0*PSRC(:,IS,:) - PSRC(:,IS+1,:))
+ ZFNEG1(:,IN+1,:) = - 999.
+ ZFNEG1(:,IN, :) = 0.5 * (3.0*PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))
+!
+!
+ ZFNEG2(:,IS:IN-1,:) = 1./6 * (2.0*PSRC(:,IS:IN-1,:) + 5.0*PSRC(:,IS+1:IN,:) - &
+ 1.0*PSRC(:,IS+2:IN+1,:))
+ ZFNEG2(:,IS-1,:) = 0.5 * (PSRC(:,IS-1,:) + PSRC(:,IS, :))
+ ZFNEG2(:,IN, :) = 0.5 * (PSRC(:,IN, :) + PSRC(:,IN+1,:))
+ ZFNEG2(:,IN+1,:) = 0.5 * (PSRC(:,IN+1,:) + TPHALO2%NORTH(:,:))
+!
+!
+ ZFNEG3(:,IS:IN-1,:) = 1./6 * (-1.0*PSRC(:,IS-1:IN-2,:) + 5.0*PSRC(:,IS:IN-1,:) + &
+ 2.0*PSRC(:,IS+1:IN,:))
+!
+! smoothness indicators for positive wind case
+!
+ ZBPOS1(:,IS+1:IN-1,:) = 13./12 * (PSRC(:,IS-1:IN-3,:) - 2.0*PSRC(:,IS:IN-2,:) +&
+ PSRC(:,IS+1:IN-1,:))**2 + &
+ 1./4 * (PSRC(:,IS-1:IN-3,:) - 4.0*PSRC(:,IS:IN-2,:) + 3.0*PSRC(:,IS+1:IN-1,:))**2
+ ZBPOS1(:,IS, :) = 13./12 * (TPHALO2%SOUTH(:,:) - 2.0*PSRC(:,IS-1,:) +&
+ PSRC(:,IS,:))**2 + &
+ 1./4 * (TPHALO2%SOUTH(:,:) - 4.0*PSRC(:,IS-1,:) + 3.0*PSRC(:,IS,:))**2
+ ZBPOS1(:,IN+1,:) = (PSRC(:,IN+1,:) - PSRC(:,IN, :))**2
+ ZBPOS1(:,IN, :) = (PSRC(:,IN, :) - PSRC(:,IN-1,:))**2
+ ZBPOS1(:,IS-1,:) = (PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))**2
+!
+!
+ ZBPOS2(:,IS:IN-1,:) = 13./12 * (PSRC(:,IS-1:IN-2,:) - 2.0*PSRC(:,IS:IN-1,:) + &
+ PSRC(:,IS+1:IN,:))**2 + &
+ 1./4 * (PSRC(:,IS-1:IN-2,:) - PSRC(:,IS+1:IN,:))**2
+ ZBPOS2(:,IS-1,:) = (PSRC(:,IS, :) - PSRC(:,IS-1,:))**2
+ ZBPOS2(:,IN, :) = (PSRC(:,IN+1,:) - PSRC(:,IN, :))**2
+ ZBPOS2(:,IN+1,:) = (TPHALO2%NORTH(:,:) - PSRC(:,IN+1,:))**2
+!
+ ZBPOS3(:,IS:IN-1,:) = 13./12 * (PSRC(:,IS:IN-1,:) - 2.0*PSRC(:,IS+1:IN,:) + &
+ PSRC(:,IS+2:IN+1,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IS:IN-1,:) - 4.0*PSRC(:,IS+1:IN,:) + PSRC(:,IS+2:IN+1,:))**2
+!
+! smoothness indicators for negative wind case
+!
+ ZBNEG1(:,IS:IN-2,:) = 13./12 * (PSRC(:,IS+1:IN-1,:) - 2.0*PSRC(:,IS+2:IN,:) + &
+ PSRC(:,IS+3:IN+1,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IS+1:IN-1,:) - 4.0*PSRC(:,IS+2:IN,:) + &
+ PSRC(:,IS+3:IN+1,:))**2
+ ZBNEG1(:,IN-1,:) = 13./12 * (PSRC(:,IN,:) - 2.0*PSRC(:,IN+1,:) + &
+ TPHALO2%NORTH(:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IN,:) - 4.0*PSRC(:,IN+1,:) + TPHALO2%NORTH(:,:))**2
+ ZBNEG1(:,IS-1,:) = (PSRC(:,IS,:) - PSRC(:,IS+1,:))**2
+ ZBNEG1(:,IN+1,:) = - 999.
+ ZBNEG1(:,IN, :) = (PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))**2
+!
+ ZBNEG2(:,IS:IN-1,:) = 13./12 * (PSRC(:,IS:IN-1,:) - 2.0*PSRC(:,IS+1:IN,:) + &
+ PSRC(:,IS+2:IN+1,:))**2 + &
+ 1./4 * (PSRC(:,IS:IN-1,:) - PSRC(:,IS+2:IN+1,:))**2
+ ZBNEG2(:,IS-1,:) = (PSRC(:,IS-1,:) - PSRC(:,IS ,:))**2
+ ZBNEG2(:,IN, :) = (PSRC(:,IN, :) - PSRC(:,IN+1,:))**2
+ ZBNEG2(:,IN+1,:) = (PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))**2
+!
+!
+ ZBNEG3(:,IS:IN-1,:) = 13./12 * (PSRC(:,IS-1:IN-2,:) - 2.0*PSRC(:,IS:IN-1,:) + &
+ PSRC(:,IS+1:IN,:))**2 + &
+ 1./4 * ( PSRC(:,IS-1:IN-2,:) - 4.0*PSRC(:,IS:IN-1,:) + 3.0*PSRC(:,IS+1:IN,:))**2
+!
+! WENO weights
+!
+ ZOMP1(:,IS:IN-1,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IS:IN-1,:))**2
+ ZOMP2(:,IS:IN-1,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IS:IN-1,:))**2
+ ZOMP3(:,IS:IN-1,:) = ZGAMMA3 / (ZEPS + ZBPOS3(:,IS:IN-1,:))**2
+ ZOMN1(:,IS:IN-1,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IS:IN-1,:))**2
+ ZOMN2(:,IS:IN-1,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IS:IN-1,:))**2
+ ZOMN3(:,IS:IN-1,:) = ZGAMMA3 / (ZEPS + ZBNEG3(:,IS:IN-1,:))**2
+!
+ ZOMP1(:,IS-1,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IS-1,:))**2
+ ZOMP1(:,IN, :) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IN, :))**2
+ ZOMP1(:,IN+1,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IN+1,:))**2
+ ZOMN1(:,IS-1,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IS-1,:))**2
+ ZOMN1(:,IN, :) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IN, :))**2
+ ZOMN1(:,IN+1,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IN+1,:))**2
+ ZOMP2(:,IS-1,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IS-1,:))**2
+ ZOMP2(:,IN, :) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IN, :))**2
+ ZOMP2(:,IN+1,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IN+1,:))**2
+ ZOMN2(:,IS-1,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IS-1,:))**2
+ ZOMN2(:,IN, :) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IN, :))**2
+ ZOMN2(:,IN+1,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IN+1,:))**2
+!
+! WENO fluxes (5th order)
+!
+ PR(:,IS:IN-1,:) = (ZOMP2(:,IS:IN-1,:)/(ZOMP1(:,IS:IN-1,:)+ZOMP2(:,IS:IN-1,:)+&
+ ZOMP3(:,IS:IN-1,:)) * ZFPOS2(:,IS:IN-1,:) &
+ + ZOMP1(:,IS:IN-1,:)/(ZOMP1(:,IS:IN-1,:)+ZOMP2(:,IS:IN-1,:)+&
+ ZOMP3(:,IS:IN-1,:)) * ZFPOS1(:,IS:IN-1,:) &
+ + ZOMP3(:,IS:IN-1,:)/(ZOMP1(:,IS:IN-1,:)+ZOMP2(:,IS:IN-1,:)+&
+ ZOMP3(:,IS:IN-1,:)) * ZFPOS3(:,IS:IN-1,:))&
+ * (0.5+SIGN(0.5,PRVCT(:,IS:IN-1,:))) &
+ + (ZOMN2(:,IS:IN-1,:)/(ZOMN1(:,IS:IN-1,:)+ZOMN2(:,IS:IN-1,:)+&
+ ZOMN3(:,IS:IN-1,:)) * ZFNEG2(:,IS:IN-1,:) &
+ + ZOMN1(:,IS:IN-1,:)/(ZOMN1(:,IS:IN-1,:)+ZOMN2(:,IS:IN-1,:)+&
+ ZOMN3(:,IS:IN-1,:)) * ZFNEG1(:,IS:IN-1,:) &
+ + ZOMN3(:,IS:IN-1,:)/(ZOMN1(:,IS:IN-1,:)+ZOMN2(:,IS:IN-1,:)+&
+ ZOMN3(:,IS:IN-1,:)) * ZFNEG3(:,IS:IN-1,:))&
+ * (0.5-SIGN(0.5,PRVCT(:,IS:IN-1,:)))
+!
+ PR(:,IS-1,:) = (ZOMP2(:,IS-1,:)/(ZOMP1(:,IS-1,:)+ZOMP2(:,IS-1,:)) * &
+ ZFPOS2(:,IS-1,:) &
+ + ZOMP1(:,IS-1,:)/(ZOMP1(:,IS-1,:)+ZOMP2(:,IS-1,:)) * &
+ ZFPOS1(:,IS-1,:)) * (0.5+SIGN(0.5,PRVCT(:,IS-1,:))) &
+ + (ZOMN2(:,IS-1,:)/(ZOMN1(:,IS-1,:)+ZOMN2(:,IS-1,:)) * &
+ ZFNEG2(:,IS-1,:) &
+ + ZOMN1(:,IS-1,:)/(ZOMN1(:,IS-1,:)+ZOMN2(:,IS-1,:)) * &
+ ZFNEG1(:,IS-1,:)) * (0.5-SIGN(0.5,PRVCT(:,IS-1,:)))
+!
+ PR(:,IN, :) = (ZOMP2(:,IN, :)/(ZOMP1(:,IN, :)+ZOMP2(:,IN, :)) * &
+ ZFPOS2(:,IN, :) &
+ + ZOMP1(:,IN, :)/(ZOMP1(:,IN, :)+ZOMP2(:,IN, :)) * &
+ ZFPOS1(:,IN, :)) * (0.5+SIGN(0.5,PRVCT(:,IN, :))) &
+ + (ZOMN2(:,IN, :)/(ZOMN1(:,IN, :)+ZOMN2(:,IN, :)) * &
+ ZFNEG2(:,IN, :) &
+ + ZOMN1(:,IN, :)/(ZOMN1(:,IN, :)+ZOMN2(:,IN, :)) * &
+ ZFNEG1(:,IN, :)) * (0.5-SIGN(0.5,PRVCT(:,IN, :)))
+!
+ PR(:,IN+1,:) = (ZOMP2(:,IN+1,:)/(ZOMP1(:,IN+1,:)+ZOMP2(:,IN+1,:)) * &
+ ZFPOS2(:,IN+1,:) &
+ + ZOMP1(:,IN+1,:)/(ZOMP1(:,IN+1,:)+ZOMP2(:,IN+1,:)) * &
+ ZFPOS1(:,IN+1,:)) * (0.5+SIGN(0.5,PRVCT(:,IN+1,:))) &
+ + (ZOMN2(:,IN+1,:)/(ZOMN1(:,IN+1,:)+ZOMN2(:,IN+1,:)) * &
+ ZFNEG2(:,IN+1,:) &
+ + ZOMN1(:,IN+1,:)/(ZOMN1(:,IN+1,:)+ZOMN2(:,IN+1,:)) * &
+ ZFNEG1(:,IN+1,:)) * (0.5-SIGN(0.5,PRVCT(:,IN+1,:)))
+!
+!
+! OPEN, WALL, NEST CASE IN THE Y DIRECTION
+!
+CASE ('OPEN','WALL','NEST')
+!
+ IS=IJB
+ IN=IJE
+!
+! USE A FIRST ORDER UPSTREAM SCHEME AT THE PHYSICAL BORDER
+!
+ IF(LSOUTH_ll()) THEN
+ PR(:,IS-1,:) = PSRC(:,IS-1,:) * (0.5+SIGN(0.5,PRVCT(:,IS-1,:))) + &
+ PSRC(:,IS,:) * (0.5-SIGN(0.5,PRVCT(:,IS-1,:)))
+!
+ ZFPOS1(:,IS,:) = 0.5 * (3.0*PSRC(:,IS,:) - PSRC(:,IS-1,:))
+ ZFPOS2(:,IS,:) = 0.5 * (PSRC(:,IS, :) + PSRC(:,IS+1,:))
+ ZBPOS1(:,IS,:) = (PSRC(:,IS, :) - PSRC(:,IS-1,:))**2
+ ZBPOS2(:,IS,:) = (PSRC(:,IS+1,:) - PSRC(:,IS, :))**2
+!
+ ZFNEG1(:,IS,:) = 0.5 * (3.0*PSRC(:,IS+1,:) - PSRC(:,IS+2,:))
+ ZFNEG2(:,IS,:) = 0.5 * (PSRC(:,IS, :) + PSRC(:,IS+1,:))
+ ZBNEG1(:,IS,:) = (PSRC(:,IS+1,:) - PSRC(:,IS+2,:))**2
+ ZBNEG2(:,IS,:) = (PSRC(:,IS, :) - PSRC(:,IS+1,:))**2
+!
+ ZOMP1(:,IS,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IS,:))**2
+ ZOMP2(:,IS,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IS,:))**2
+ ZOMN1(:,IS,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IS,:))**2
+ ZOMN2(:,IS,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IS,:))**2
+!
+ PR(:,IS,:) = (ZOMP2(:,IS,:)/(ZOMP1(:,IS,:)+ZOMP2(:,IS,:)) * ZFPOS2(:,IS,:) &
+ + ZOMP1(:,IS,:)/(ZOMP1(:,IS,:)+ZOMP2(:,IS,:)) * ZFPOS1(:,IS,:)) *&
+ (0.5+SIGN(0.5,PRVCT(:,IS,:))) &
+ + (ZOMN2(:,IS,:)/(ZOMN1(:,IS,:)+ZOMN2(:,IS,:)) * ZFNEG2(:,IS,:) &
+ + ZOMN1(:,IS,:)/(ZOMN1(:,IS,:)+ZOMN2(:,IS,:)) * ZFNEG1(:,IS,:)) *&
+ (0.5-SIGN(0.5,PRVCT(:,IS,:)))
+!
+ ELSEIF(NHALO == 1) THEN
+ ZFPOS1(:,IS-1,:) = 0.5 * (3.0*PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))
+ ZFPOS2(:,IS-1,:) = 0.5 * (PSRC(:,IS-1, :) + PSRC(:,IS,:))
+ ZBPOS1(:,IS-1,:) = (PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))**2
+ ZBPOS2(:,IS-1,:) = (PSRC(:,IS, :) - PSRC(:,IS-1,:))**2
+!
+ ZFNEG1(:,IS-1,:) = 0.5 * (3.0*PSRC(:,IS,:) - PSRC(:,IS+1,:))
+ ZFNEG2(:,IS-1,:) = 0.5 * (PSRC(:,IS-1, :) + PSRC(:,IS, :))
+ ZBNEG1(:,IS-1,:) = (PSRC(:,IS, :) - PSRC(:,IS+1,:))**2
+ ZBNEG2(:,IS-1,:) = (PSRC(:,IS-1,:) - PSRC(:,IS, :))**2
+!
+ ZOMP1(:,IS-1,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IS-1,:))**2
+ ZOMN1(:,IS-1,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IS-1,:))**2
+ ZOMP2(:,IS-1,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IS-1,:))**2
+ ZOMN2(:,IS-1,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IS-1,:))**2
+!
+ PR(:,IS-1,:) = (ZOMP2(:,IS-1,:)/(ZOMP1(:,IS-1,:)+ZOMP2(:,IS-1,:)) * &
+ ZFPOS2(:,IS-1,:) &
+ + ZOMP1(:,IS-1,:)/(ZOMP1(:,IS-1,:)+ZOMP2(:,IS-1,:)) * &
+ ZFPOS1(:,IS-1,:)) * (0.5+SIGN(0.5,PRVCT(:,IS-1,:))) &
+ + (ZOMN2(:,IS-1,:)/(ZOMN1(:,IS-1,:)+ZOMN2(:,IS-1,:)) * &
+ ZFNEG2(:,IS-1,:) &
+ + ZOMN1(:,IS-1,:)/(ZOMN1(:,IS-1,:)+ZOMN2(:,IS-1,:)) * &
+ ZFNEG1(:,IS-1,:)) * (0.5-SIGN(0.5,PRVCT(:,IS-1,:)))
+!
+ ZFPOS1(:,IS,:) = 1./6 * (2.0*TPHALO2%SOUTH(:,:) - 7.0*PSRC(:,IS-1,:) + &
+ 11.0*PSRC(:,IS,:))
+ ZFPOS2(:,IS,:) = 1./6 * (-1.0*PSRC(:,IS-1,:) + 5.0*PSRC(:,IS, :) + &
+ 2.0*PSRC(:,IS+1,:))
+ ZFPOS3(:,IS,:) = 1./6 * (2.0*PSRC(:,IS, :) + 5.0*PSRC(:,IS+1,:) - &
+ 1.0*PSRC(:,IS+2,:))
+!
+ ZFNEG1(:,IS,:) = 1./6 * (11.0*PSRC(:,IS+1,:) - 7.0*PSRC(:,IS+2,:) + &
+ 2.0*PSRC(:,IS+3,:))
+ ZFNEG2(:,IS,:) = 1./6 * (2.0*PSRC(:,IS, :) + 5.0*PSRC(:,IS+1,:) - &
+ 1.0*PSRC(:,IS+2,:))
+ ZFNEG3(:,IS,:) = 1./6 * (-1.0*PSRC(:,IS-1,:) + 5.0*PSRC(:,IS, :) + &
+ 2.0*PSRC(:,IS+1,:))
+!
+ ZBPOS1(:,IS,:) = 13./12 * (TPHALO2%SOUTH(:,:) - 2.0*PSRC(:,IS-1,:) + &
+ PSRC(:,IS,:))**2 + &
+ 1./4 * (TPHALO2%SOUTH(:,:) - 4.0*PSRC(:,IS-1,:) + 3.0*PSRC(:,IS,:))**2
+ ZBPOS2(:,IS,:) = 13./12 * (PSRC(:,IS-1,:) - 2.0*PSRC(:,IS,:) + &
+ PSRC(:,IS+1,:))**2 + &
+ 1./4 * (PSRC(:,IS-1,:) - PSRC(:,IS+1,:))**2
+ ZBPOS3(:,IS,:) = 13./12 * (PSRC(:,IS,:) - 2.0*PSRC(:,IS+1,:) + &
+ PSRC(:,IS+2,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IS,:) - 4.0*PSRC(:,IS+1,:) + PSRC(:,IS+2,:))**2
+!
+ ZBNEG1(:,IS,:) = 13./12 * (PSRC(:,IS+1,:) - 2.0*PSRC(:,IS+2,:) + &
+ PSRC(:,IS+3,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IS+1,:) - 4.0*PSRC(:,IS+2,:) + PSRC(:,IS+3,:))**2
+ ZBNEG2(:,IS,:) = 13./12 * (PSRC(:,IS,:) - 2.0*PSRC(:,IS+1,:) + &
+ PSRC(:,IS+2,:))**2 + &
+ 1./4 * (PSRC(:,IS,:) - PSRC(:,IS+2,:))**2
+ ZBNEG3(:,IS,:) = 13./12 * (PSRC(:,IS-1,:) - 2.0*PSRC(:,IS,:) + &
+ PSRC(:,IS+1,:))**2 + &
+ 1./4 * ( PSRC(:,IS-1,:) - 4.0*PSRC(:,IS,:) + 3.0*PSRC(:,IS+1,:))**2
+!
+ ZOMP1(:,IS,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IS,:))**2
+ ZOMP2(:,IS,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IS,:))**2
+ ZOMP3(:,IS,:) = ZGAMMA3 / (ZEPS + ZBPOS3(:,IS,:))**2
+ ZOMN1(:,IS,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IS,:))**2
+ ZOMN2(:,IS,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IS,:))**2
+ ZOMN3(:,IS,:) = ZGAMMA3 / (ZEPS + ZBNEG3(:,IS,:))**2
+!
+ PR(:,IS,:) = (ZOMP2(:,IS,:)/(ZOMP1(:,IS,:)+ZOMP2(:,IS,:)+ZOMP3(:,IS,:)) * &
+ ZFPOS2(:,IS,:) &
+ + ZOMP1(:,IS,:)/(ZOMP1(:,IS,:)+ZOMP2(:,IS,:)+ZOMP3(:,IS,:)) * ZFPOS1(:,IS,:)&
+ + ZOMP3(:,IS,:)/(ZOMP1(:,IS,:)+ZOMP2(:,IS,:)+ZOMP3(:,IS,:)) * ZFPOS3(:,IS,:))&
+ * (0.5+SIGN(0.5,PRVCT(:,IS,:))) &
+ + (ZOMN2(:,IS,:)/(ZOMN1(:,IS,:)+ZOMN2(:,IS,:)+ZOMN3(:,IS,:)) * ZFNEG2(:,IS,:)&
+ + ZOMN1(:,IS,:)/(ZOMN1(:,IS,:)+ZOMN2(:,IS,:)+ZOMN3(:,IS,:)) * ZFNEG1(:,IS,:)&
+ + ZOMN3(:,IS,:)/(ZOMN1(:,IS,:)+ZOMN2(:,IS,:)+ZOMN3(:,IS,:)) * ZFNEG3(:,IS,:))&
+ * (0.5-SIGN(0.5,PRVCT(:,IS,:)))
+!
+ ENDIF
+!
+ IF(LNORTH_ll()) THEN
+ PR(:,IN,:) = PSRC(:,IN,:) * (0.5+SIGN(0.5,PRVCT(:,IN,:))) + PSRC(:,IN+1,:) *&
+ (0.5-SIGN(0.5,PRVCT(:,IN,:)))
+!
+ ZFPOS1(:,IN-1,:) = 0.5 * (3.0*PSRC(:,IN-1,:) - PSRC(:,IN-2,:))
+ ZFPOS2(:,IN-1,:) = 0.5 * (PSRC(:,IN-1, :) + PSRC(:,IN, :))
+ ZBPOS1(:,IN-1,:) = (PSRC(:,IN-1,:) - PSRC(:,IN-2,:))**2
+ ZBPOS2(:,IN-1,:) = (PSRC(:,IN, :) - PSRC(:,IN-1,:))**2
+!
+ ZFNEG1(:,IN-1,:) = 0.5 * (3.0*PSRC(:,IN,:) - PSRC(:,IN+1,:))
+ ZFNEG2(:,IN-1,:) = 0.5 * (PSRC(:,IN-1, :) + PSRC(:,IN, :))
+ ZBNEG1(:,IN-1,:) = (PSRC(:,IN,:) - PSRC(:,IN+1,:))**2
+ ZBNEG2(:,IN-1,:) = (PSRC(:,IN-1,:) - PSRC(:,IN,:))**2
+!
+ ZOMP1(:,IN-1,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IN-1,:))**2
+ ZOMN1(:,IN-1,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IN-1,:))**2
+ ZOMP2(:,IN-1,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IN-1,:))**2
+ ZOMN2(:,IN-1,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IN-1,:))**2
+!
+ PR(:,IN-1,:) = (ZOMP2(:,IN-1,:)/(ZOMP1(:,IN-1,:)+ZOMP2(:,IN-1,:)) * &
+ ZFPOS2(:,IN-1,:) &
+ + ZOMP1(:,IN-1,:)/(ZOMP1(:,IN-1,:)+ZOMP2(:,IN-1,:)) * &
+ ZFPOS1(:,IN-1,:)) * (0.5+SIGN(0.5,PRVCT(:,IN-1,:))) &
+ + (ZOMN2(:,IN-1,:)/(ZOMN1(:,IN-1,:)+ZOMN2(:,IN-1,:)) * &
+ ZFNEG2(:,IN-1,:) &
+ + ZOMN1(:,IN-1,:)/(ZOMN1(:,IN-1,:)+ZOMN2(:,IN-1,:)) * &
+ ZFNEG1(:,IN-1,:)) * (0.5-SIGN(0.5,PRVCT(:,IN-1,:)))
+!
+ ELSEIF(NHALO == 1) THEN
+ ZFPOS1(:,IN,:) = 0.5 * (3.0*PSRC(:,IN,:) - PSRC(:,IN-1,:))
+ ZFPOS2(:,IN,:) = 0.5 * (PSRC(:,IN, :) + PSRC(:,IN+1,:))
+ ZBPOS1(:,IN,:) = (PSRC(:,IN, :) - PSRC(:,IN-1,:))**2
+ ZBPOS2(:,IN,:) = (PSRC(:,IN+1,:) - PSRC(:,IN, :))**2
+!
+ ZFNEG1(:,IN,:) = 0.5 * (3.0*PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))
+ ZFNEG2(:,IN,:) = 0.5 * (PSRC(:,IN, :) + PSRC(:,IN+1,:))
+ ZBNEG1(:,IN,:) = (PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))**2
+ ZBNEG2(:,IN,:) = (PSRC(:,IN, :) - PSRC(:,IN+1,:))**2
+ !
+ ZOMP1(:,IN,:) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,IN,:))**2
+ ZOMN1(:,IN,:) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,IN,:))**2
+ ZOMP2(:,IN,:) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,IN,:))**2
+ ZOMN2(:,IN,:) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,IN,:))**2
+!
+ PR(:,IN,:) = (ZOMP2(:,IN,:)/(ZOMP1(:,IN,:)+ZOMP2(:,IN,:)) * ZFPOS2(:,IN,:) &
+ + ZOMP1(:,IN,:)/(ZOMP1(:,IN,:)+ZOMP2(:,IN,:)) * ZFPOS1(:,IN,:)) *&
+ (0.5+SIGN(0.5,PRVCT(:,IN,:))) &
+ + (ZOMN2(:,IN,:)/(ZOMN1(:,IN,:)+ZOMN2(:,IN,:)) * ZFNEG2(:,IN,:) &
+ + ZOMN1(:,IN,:)/(ZOMN1(:,IN,:)+ZOMN2(:,IN,:)) * ZFNEG1(:,IN,:)) *&
+ (0.5-SIGN(0.5,PRVCT(:,IN,:)))
+!
+ ZFPOS1(:,IN-1,:) = 1./6 * (2.0*PSRC(:,IN-3,:) - 7.0*PSRC(:,IN-2,:) + &
+ 11.0*PSRC(:,IN-1,:))
+ ZFPOS2(:,IN-1,:) = 1./6 * (-1.0*PSRC(:,IN-2,:) + 5.0*PSRC(:,IN-1,:) + &
+ 2.0*PSRC(:,IN,:))
+ ZFPOS3(:,IN-1,:) = 1./6 * (2.0*PSRC(:,IN-1,:) + 5.0*PSRC(:,IN,:) - &
+ 1.0*PSRC(:,IN+1,:))
+!
+ ZFNEG1(:,IN-1,:) = 1./6 * (11.0*PSRC(:,IN, :) - 7.0*PSRC(:,IN+1,:) + &
+ 2.0*TPHALO2%NORTH(:,:))
+ ZFNEG2(:,IN-1,:) = 1./6 * (2.0*PSRC(:,IN-1, :) + 5.0*PSRC(:,IN, :) - &
+ 1.0*PSRC(:,IN+1,:))
+ ZFNEG3(:,IN-1,:) = 1./6 * (-1.0*PSRC(:,IN-2,:) + 5.0*PSRC(:,IN-1,:) + &
+ 2.0*PSRC(:,IN, :))
+!
+ ZBPOS1(:,IN-1,:) = 13./12 * (PSRC(:,IN-3,:) - 2.0*PSRC(:,IN-2,:) + &
+ PSRC(:,IN-1,:))**2 + &
+ 1./4 * (PSRC(:,IN-3,:) - 4.0*PSRC(:,IN-2,:) + 3.0*PSRC(:,IN-1,:))**2
+ ZBPOS2(:,IN-1,:) = 13./12 * (PSRC(:,IN-2,:) - 2.0*PSRC(:,IN-1,:) + &
+ PSRC(:,IN,:))**2 + &
+ 1./4 * (PSRC(:,IN-2,:) - PSRC(:,IN,:))**2
+ ZBPOS3(:,IN-1,:) = 13./12 * (PSRC(:,IN-1,:) - 2.0*PSRC(:,IN,:) + &
+ PSRC(:,IN+1,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IN-1,:) - 4.0*PSRC(:,IN,:) + PSRC(:,IN+1,:))**2
+!
+ ZBNEG1(:,IN-1,:) = 13./12 * (PSRC(:,IN,:) - 2.0*PSRC(:,IN+1,:) + &
+ TPHALO2%NORTH(:,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IN,:) - 4.0*PSRC(:,IN+1,:) + TPHALO2%NORTH(:,:))**2
+ ZBNEG2(:,IN-1,:) = 13./12 * (PSRC(:,IN-1,:) - 2.0*PSRC(:,IN,:) + &
+ PSRC(:,IN+1,:))**2 + &
+ 1./4 * (PSRC(:,IN-1,:) - PSRC(:,IN+1,:))**2
+ ZBNEG3(:,IN-1,:) = 13./12 * (PSRC(:,IN-2,:) - 2.0*PSRC(:,IN-1,:) + &
+ PSRC(:,IN,:))**2 + &
+ 1./4 * ( PSRC(:,IN-2,:) - 4.0*PSRC(:,IN-1,:) + 3.0*PSRC(:,IN,:))**2
+!
+ ZOMP1(:,IN-1,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IN-1,:))**2
+ ZOMP2(:,IN-1,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IN-1,:))**2
+ ZOMP3(:,IN-1,:) = ZGAMMA3 / (ZEPS + ZBPOS3(:,IN-1,:))**2
+ ZOMN1(:,IN-1,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IN-1,:))**2
+ ZOMN2(:,IN-1,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IN-1,:))**2
+ ZOMN3(:,IN-1,:) = ZGAMMA3 / (ZEPS + ZBNEG3(:,IN-1,:))**2
+!
+ PR(:,IN-1,:) = (ZOMP2(:,IN-1,:)/(ZOMP1(:,IN-1,:)+ZOMP2(:,IN-1,:)+ &
+ ZOMP3(:,IN-1,:)) * ZFPOS2(:,IN-1,:) &
+ + ZOMP1(:,IN-1,:)/(ZOMP1(:,IN-1,:)+ZOMP2(:,IN-1,:)+&
+ ZOMP3(:,IN-1,:)) * ZFPOS1(:,IN-1,:) &
+ + ZOMP3(:,IN-1,:)/(ZOMP1(:,IN-1,:)+ZOMP2(:,IN-1,:)+&
+ ZOMP3(:,IN-1,:)) * ZFPOS3(:,IN-1,:)) &
+ * (0.5+SIGN(0.5,PRVCT(:,IN-1,:))) &
+ + (ZOMN2(:,IN-1,:)/(ZOMN1(:,IN-1,:)+ZOMN2(:,IN-1,:)+&
+ ZOMN3(:,IN-1,:)) * ZFNEG2(:,IN-1,:) &
+ + ZOMN1(:,IN-1,:)/(ZOMN1(:,IN-1,:)+ZOMN2(:,IN-1,:)+&
+ ZOMN3(:,IN-1,:)) * ZFNEG1(:,IN-1,:) &
+ + ZOMN3(:,IN-1,:)/(ZOMN1(:,IN-1,:)+ZOMN2(:,IN-1,:)+&
+ ZOMN3(:,IN-1,:)) * ZFNEG3(:,IN-1,:)) &
+ * (0.5-SIGN(0.5,PRVCT(:,IN-1,:)))
+!
+ ENDIF
+!
+ ZFPOS1(:,IS+1:IN-2,:) = 1./6 * (2.0*PSRC(:,IS-1:IN-4,:) - 7.0*PSRC(:,IS:IN-3,:) +&
+ 11.0*PSRC(:,IS+1:IN-2,:))
+ ZFPOS2(:,IS+1:IN-2,:) = 1./6 * (-1.0*PSRC(:,IS:IN-3,:) + 5.0*PSRC(:,IS+1:IN-2,:)+&
+ 2.0*PSRC(:,IS+2:IN-1,:))
+ ZFPOS3(:,IS+1:IN-2,:) = 1./6 * (2.0*PSRC(:,IS+1:IN-2,:) + 5.0*PSRC(:,IS+2:IN-1,:)&
+ - 1.0*PSRC(:,IS+3:IN,:))
+!
+ ZBPOS1(:,IS+1:IN-2,:) = 13./12 * (PSRC(:,IS-1:IN-4,:) - 2.0*PSRC(:,IS:IN-3,:) + &
+ PSRC(:,IS+1:IN-2,:))**2 + &
+ 1./4 * (PSRC(:,IS-1:IN-4,:) - 4.0*PSRC(:,IS:IN-3,:) + 3.0*PSRC(:,IS+1:IN-2,:))**2
+ ZBPOS2(:,IS+1:IN-2,:) = 13./12 * (PSRC(:,IS:IN-3,:) - 2.0*PSRC(:,IS+1:IN-2,:) + &
+ PSRC(:,IS+2:IN-1,:))**2 + &
+ 1./4 * (PSRC(:,IS:IN-3,:) - PSRC(:,IS+2:IN-1,:))**2
+ ZBPOS3(:,IS+1:IN-2,:) = 13./12 * (PSRC(:,IS+1:IN-2,:) - 2.0*PSRC(:,IS+2:IN-1,:) +&
+ PSRC(:,IS+3:IN,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IS+1:IN-2,:) - 4.0*PSRC(:,IS+2:IN-1,:) + &
+ PSRC(:,IS+3:IN,:))**2
+!
+ ZFNEG1(:,IS+1:IN-2,:) = 1./6 * (11.0*PSRC(:,IS+2:IN-1,:) - &
+ 7.0*PSRC(:,IS+3:IN,:) + 2.0*PSRC(:,IS+4:IN+1,:))
+ ZFNEG2(:,IS+1:IN-2,:) = 1./6 * (2.0*PSRC(:,IS+1:IN-2,:) + &
+ 5.0*PSRC(:,IS+2:IN-1,:) - 1.0*PSRC(:,IS+3:IN,:))
+ ZFNEG3(:,IS+1:IN-2,:) = 1./6 * (-1.0*PSRC(:,IS:IN-3,:) + &
+ 5.0*PSRC(:,IS+1:IN-2,:) + 2.0*PSRC(:,IS+2:IN-1,:))
+!
+ ZBNEG1(:,IS+1:IN-2,:) = 13./12 * (PSRC(:,IS+2:IN-1,:) - &
+ 2.0*PSRC(:,IS+3:IN,:) + PSRC(:,IS+4:IN+1,:))**2 + &
+ 1./4 * ( 3.0*PSRC(:,IS+2:IN-1,:) - 4.0*PSRC(:,IS+3:IN,:) + &
+ PSRC(:,IS+4:IN+1,:))**2
+ ZBNEG2(:,IS+1:IN-2,:) = 13./12 * (PSRC(:,IS+1:IN-2,:) - &
+ 2.0*PSRC(:,IS+2:IN-1,:) + PSRC(:,IS+3:IN,:))**2 + &
+ 1./4 * (PSRC(:,IS+1:IN-2,:) - PSRC(:,IS+3:IN,:))**2
+ ZBNEG3(:,IS+1:IN-2,:) = 13./12 * (PSRC(:,IS:IN-3,:) - &
+ 2.0*PSRC(:,IS+1:IN-2,:) + PSRC(:,IS+2:IN-1,:))**2 + &
+ 1./4 * ( PSRC(:,IS:IN-3,:) - 4.0*PSRC(:,IS+1:IN-2,:) + &
+ 3.0*PSRC(:,IS+2:IN-1,:))**2
+!
+ ZOMP1(:,IS+1:IN-2,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IS+1:IN-2,:))**2
+ ZOMP2(:,IS+1:IN-2,:) = ZGAMMA2 / (ZEPS + ZBPOS2(:,IS+1:IN-2,:))**2
+ ZOMP3(:,IS+1:IN-2,:) = ZGAMMA3 / (ZEPS + ZBPOS3(:,IS+1:IN-2,:))**2
+ ZOMN1(:,IS+1:IN-2,:) = ZGAMMA1 / (ZEPS + ZBNEG1(:,IS+1:IN-2,:))**2
+ ZOMN2(:,IS+1:IN-2,:) = ZGAMMA2 / (ZEPS + ZBNEG2(:,IS+1:IN-2,:))**2
+ ZOMN3(:,IS+1:IN-2,:) = ZGAMMA3 / (ZEPS + ZBNEG3(:,IS+1:IN-2,:))**2
+!
+ PR(:,IS+1:IN-2,:) = (ZOMP2(:,IS+1:IN-2,:)/(ZOMP1(:,IS+1:IN-2,:)+ &
+ ZOMP2(:,IS+1:IN-2,:)+ZOMP3(:,IS+1:IN-2,:)) * ZFPOS2(:,IS+1:IN-2,:) &
+ + ZOMP1(:,IS+1:IN-2,:)/(ZOMP1(:,IS+1:IN-2,:)+ &
+ ZOMP2(:,IS+1:IN-2,:)+ZOMP3(:,IS+1:IN-2,:)) * ZFPOS1(:,IS+1:IN-2,:) &
+ + ZOMP3(:,IS+1:IN-2,:)/(ZOMP1(:,IS+1:IN-2,:)+ZOMP2(:,IS+1:IN-2,:)+ &
+ ZOMP3(:,IS+1:IN-2,:)) * ZFPOS3(:,IS+1:IN-2,:)) &
+ * (0.5+SIGN(0.5,PRVCT(:,IS+1:IN-2,:))) &
+ + (ZOMN2(:,IS+1:IN-2,:)/(ZOMN1(:,IS+1:IN-2,:)+ZOMN2(:,IS+1:IN-2,:)+ &
+ ZOMN3(:,IS+1:IN-2,:)) * ZFNEG2(:,IS+1:IN-2,:) &
+ + ZOMN1(:,IS+1:IN-2,:)/(ZOMN1(:,IS+1:IN-2,:)+ZOMN2(:,IS+1:IN-2,:)+ &
+ ZOMN3(:,IS+1:IN-2,:)) * ZFNEG1(:,IS+1:IN-2,:) &
+ + ZOMN3(:,IS+1:IN-2,:)/(ZOMN1(:,IS+1:IN-2,:)+ZOMN2(:,IS+1:IN-2,:)+ &
+ ZOMN3(:,IS+1:IN-2,:)) * ZFNEG3(:,IS+1:IN-2,:)) &
+ * (0.5-SIGN(0.5,PRVCT(:,IS+1:IN-2,:)))
+!
+END SELECT
+!
+PR = PR * PRVCT
+!
+END SUBROUTINE ADVEC_WENO_K_3_VY
+!
+!-------------------------------------------------------------------------------
+!
+! ############################################
+ FUNCTION WENO_K_3_WZ(PSRC, PRWCT) RESULT(PR)
+! ############################################
+!!
+!!* Computes PRWCT * PWT. Upstream fluxes of W in Z direction.
+!! Input PWT is on W Grid 'ie' (i,j,k) based on WGRID reference
+!! Output PR is on mass Grid 'ie' (i,j,k+1/2) based on WGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_CONF
+USE MODD_PARAMETERS,ONLY: JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IB ! Begining useful area in x,y,z directions
+INTEGER :: IT ! End useful area in x,y,z directions
+!
+! WENO-related variables:
+!
+! intermediate reconstruction fluxes for positive wind case
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!
+! smoothness indicators for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./10.
+REAL, PARAMETER :: ZGAMMA2 = 3./5.
+REAL, PARAMETER :: ZGAMMA3 = 3./10.
+REAL, PARAMETER :: ZGAMMA1_PRIM = 1./3.
+REAL, PARAMETER :: ZGAMMA2_PRIM = 2./3.
+!
+REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+IB = 1 + JPVEXT
+IT = SIZE(PSRC,3) - JPVEXT
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFPOS3 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZFNEG3 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBPOS3 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZBNEG3 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMP3 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+ZOMN3 = 0.0
+!
+! r: many left cells in regard to 'k' cell for each stencil
+!
+! intermediate fluxes at the mass point on Wgrid u(i,j,k+1/2) for positive wind
+! case (left to the right)
+! (r=2 for the first stencil ZFPOS1, r=1 for the second ZFPOS2 and
+! r=0 for the last ZFPOS3)
+!
+ZFPOS1(:,:,IB+1:IT-2) = 1./6 * (2.0*PSRC(:,:,IB-1:IT-4) - 7.0*PSRC(:,:,IB:IT-3) + &
+ 11.0*PSRC(:,:,IB+1:IT-2))
+ZFPOS1(:,:,IB) = 0.5 * (3.0*PSRC(:,:,IB) - PSRC(:,:,IB-1))
+ZFPOS1(:,:,IT-1) = 0.5 * (3.0*PSRC(:,:,IT-1) - PSRC(:,:,IT-2))
+!
+!
+ZFPOS2(:,:,IB+1:IT-2) = 1./6 * (-1.0*PSRC(:,:,IB:IT-3) + 5.0*PSRC(:,:,IB+1:IT-2) +&
+ 2.0*PSRC(:,:,IB+2:IT-1))
+ZFPOS2(:,:,IB) = 0.5 * (PSRC(:,:,IB) + PSRC(:,:,IB+1))
+ZFPOS2(:,:,IT-1) = 0.5 * (PSRC(:,:,IT) + PSRC(:,:,IT+1))
+!
+ZFPOS3(:,:,IB+1:IT-2) = 1./6 * (2.0*PSRC(:,:,IB+1:IT-2) + 5.0*PSRC(:,:,IB+2:IT-1) -&
+ 1.0*PSRC(:,:,IB+3:IT))
+!
+! r: many left cells in regard to 'k+1' cell for each stencil
+!
+! intermediate flux at the mass point on Wgrid (i,j,k+1/2)=(i,j,(k+1)-1/2)
+! for negative wind case (right to the left)
+! (r=2 for the last stencil ZFNEG3=ZFPOS2, r=1 for the second ZFNEG2=ZFPOS3
+! and r=0 for the first ZFNEG1)
+!
+ZFNEG1(:,:,IB+1:IT-2) = 1./6 * (11.0*PSRC(:,:,IB+2:IT-1) - 7.0*PSRC(:,:,IB+3:IT) +&
+ 2.0*PSRC(:,:,IB+4:IT+1))
+ZFNEG1(:,:,IT-1) = 0.5 * (3.0*PSRC(:,:,IT) - PSRC(:,:,IT+1))
+ZFNEG1(:,:,IB) = 0.5 * (3.0*PSRC(:,:,IB+1) - PSRC(:,:,IB+2))
+!
+!
+ZFNEG2(:,:,IB+1:IT-2) = 1./6 * (2.0*PSRC(:,:,IB+1:IT-2) + 5.0*PSRC(:,:,IB+2:IT-1) -&
+ 1.0*PSRC(:,:,IB+3:IT))
+ZFNEG2(:,:,IB) = 0.5 * (PSRC(:,:,IB) + PSRC(:,:,IB+1))
+ZFNEG2(:,:,IT-1) = 0.5 * (PSRC(:,:,IT-1) + PSRC(:,:,IT))
+!
+!
+ZFNEG3(:,:,IB+1:IT-2) = 1./6 * (-1.0*PSRC(:,:,IB:IT-3) + 5.0*PSRC(:,:,IB+1:IT-2) + &
+ 2.0*PSRC(:,:,IB+2:IT-1))
+!
+! smoothness indicators for positive wind case
+!
+ZBPOS1(:,:,IB+1:IT-2) = 13./12 * (PSRC(:,:,IB-1:IT-4) - 2.0*PSRC(:,:,IB:IT-3) + &
+ PSRC(:,:,IB+1:IT-2))**2 + &
+ 1./4 * (PSRC(:,:,IB-1:IT-4) - 4.0*PSRC(:,:,IB:IT-3) + 3.0*PSRC(:,:,IB+1:IT-2))**2
+ZBPOS1(:,:,IB) = (PSRC(:,:,IB) - PSRC(:,:,IB-1))**2
+ZBPOS1(:,:,IT-1) = (PSRC(:,:,IT-1) - PSRC(:,:,IT-2))**2
+!
+!
+ZBPOS2(:,:,IB+1:IT-2) = 13./12 * (PSRC(:,:,IB:IT-3) - 2.0*PSRC(:,:,IB+1:IT-2) + &
+ PSRC(:,:,IB+2:IT-1))**2 + &
+ 1./4 * (PSRC(:,:,IB:IT-3) - PSRC(:,:,IB+2:IT-1))**2
+ZBPOS2(:,:,IB) = (PSRC(:,:,IB+1) - PSRC(:,:,IB))**2
+ZBPOS2(:,:,IT-1) = (PSRC(:,:,IT) - PSRC(:,:,IT-1))**2
+!
+!
+ZBPOS3(:,:,IB+1:IT-2) = 13./12 * (PSRC(:,:,IB+1:IT-2) - 2.0*PSRC(:,:,IB+2:IT-1) + &
+ PSRC(:,:,IB+3:IT))**2 + &
+ 1./4 * ( 3.0*PSRC(:,:,IB+1:IT-2) - 4.0*PSRC(:,:,IB+2:IT-1) + PSRC(:,:,IB+3:IT))**2
+!
+! smoothness indicators for negative wind case
+!
+ZBNEG1(:,:,IB+1:IT-2) = 13./12 * (PSRC(:,:,IB+2:IT-1) - 2.0*PSRC(:,:,IB+3:IT) + &
+ PSRC(:,:,IB+4:IT+1))**2 + &
+ 1./4 * ( 3.0*PSRC(:,:,IB+2:IT-1) - 4.0*PSRC(:,:,IB+3:IT) + PSRC(:,:,IB+4:IT+1))**2
+ZBNEG1(:,:,IB) = (PSRC(:,:,IB+1) - PSRC(:,:,IB+2))**2
+ZBNEG1(:,:,IT-1) = (PSRC(:,:,IT) - PSRC(:,:,IT+1))**2
+!
+ZBNEG2(:,:,IB+1:IT-2) = 13./12 * (PSRC(:,:,IB+1:IT-2) - 2.0*PSRC(:,:,IB+2:IT-1) + &
+ PSRC(:,:,IB+3:IT))**2 + &
+ 1./4 * (PSRC(:,:,IB+1:IT-2) - PSRC(:,:,IB+3:IT))**2
+ZBNEG2(:,:,IB) = (PSRC(:,:,IB) - PSRC(:,:,IB+1))**2
+ZBNEG2(:,:,IT-1) = (PSRC(:,:,IT-1) - PSRC(:,:,IT))**2
+!
+!
+ZBNEG3(:,:,IB+1:IT-2) = 13./12 * (PSRC(:,:,IB:IT-3) - 2.0*PSRC(:,:,IB+1:IT-2) + &
+ PSRC(:,:,IB+2:IT-1))**2 + &
+ 1./4 * ( PSRC(:,:,IB:IT-3) - 4.0*PSRC(:,:,IB+1:IT-2) + 3.0*PSRC(:,:,IB+2:IT-1))**2
+!
+! WENO weights
+!
+ZOMP1(:,:,IB+1:IT-2) = ZGAMMA1 / (ZEPS + ZBPOS1(:,:,IB+1:IT-2))**2
+ZOMP2(:,:,IB+1:IT-2) = ZGAMMA2 / (ZEPS + ZBPOS2(:,:,IB+1:IT-2))**2
+ZOMP3(:,:,IB+1:IT-2) = ZGAMMA3 / (ZEPS + ZBPOS3(:,:,IB+1:IT-2))**2
+ZOMN1(:,:,IB+1:IT-2) = ZGAMMA1 / (ZEPS + ZBNEG1(:,:,IB+1:IT-2))**2
+ZOMN2(:,:,IB+1:IT-2) = ZGAMMA2 / (ZEPS + ZBNEG2(:,:,IB+1:IT-2))**2
+ZOMN3(:,:,IB+1:IT-2) = ZGAMMA3 / (ZEPS + ZBNEG3(:,:,IB+1:IT-2))**2
+!
+ZOMP1(:,:, IB) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,:, IB))**2
+ZOMP2(:,:, IB) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,:, IB))**2
+ZOMN1(:,:, IB) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,:, IB))**2
+ZOMN2(:,:, IB) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,:, IB))**2
+ZOMP1(:,:,IT-1) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,:,IT-1))**2
+ZOMP2(:,:,IT-1) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,:,IT-1))**2
+ZOMN1(:,:,IT-1) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,:,IT-1))**2
+ZOMN2(:,:,IT-1) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,:,IT-1))**2
+!
+! WENO fluxes (5th order)
+!
+PR(:,:,IB+1:IT-2) = (ZOMP2(:,:,IB+1:IT-2)/(ZOMP1(:,:,IB+1:IT-2)+&
+ ZOMP2(:,:,IB+1:IT-2)+ZOMP3(:,:,IB+1:IT-2)) * ZFPOS2(:,:,IB+1:IT-2) &
+ + ZOMP1(:,:,IB+1:IT-2)/(ZOMP1(:,:,IB+1:IT-2)+ZOMP2(:,:,IB+1:IT-2)+ &
+ ZOMP3(:,:,IB+1:IT-2)) * ZFPOS1(:,:,IB+1:IT-2) &
+ + ZOMP3(:,:,IB+1:IT-2)/(ZOMP1(:,:,IB+1:IT-2)+ZOMP2(:,:,IB+1:IT-2)+ &
+ ZOMP3(:,:,IB+1:IT-2)) * ZFPOS3(:,:,IB+1:IT-2)) &
+ * (0.5+SIGN(0.5,PRWCT(:,:,IB+1:IT-2))) &
+ + (ZOMN2(:,:,IB+1:IT-2)/(ZOMN1(:,:,IB+1:IT-2)+ZOMN2(:,:,IB+1:IT-2)+&
+ ZOMN3(:,:,IB+1:IT-2)) * ZFNEG2(:,:,IB+1:IT-2) &
+ + ZOMN1(:,:,IB+1:IT-2)/(ZOMN1(:,:,IB+1:IT-2)+ZOMN2(:,:,IB+1:IT-2)+ &
+ ZOMN3(:,:,IB+1:IT-2)) * ZFNEG1(:,:,IB+1:IT-2) &
+ + ZOMN3(:,:,IB+1:IT-2)/(ZOMN1(:,:,IB+1:IT-2)+ZOMN2(:,:,IB+1:IT-2)+ &
+ ZOMN3(:,:,IB+1:IT-2)) * ZFNEG3(:,:,IB+1:IT-2)) &
+ * (0.5-SIGN(0.5,PRWCT(:,:,IB+1:IT-2)))
+!
+! WENO fluxes (3rd order)
+!
+PR(:,:,IB) = (ZOMP2(:,:,IB)/(ZOMP1(:,:,IB)+ZOMP2(:,:,IB)) * ZFPOS2(:,:,IB) &
+ + ZOMP1(:,:,IB)/(ZOMP1(:,:,IB)+ZOMP2(:,:,IB)) * ZFPOS1(:,:,IB)) * &
+ (0.5+SIGN(0.5,PRWCT(:,:,IB) )) &
+ + (ZOMN2(:,:,IB)/(ZOMN1(:,:,IB)+ZOMN2(:,:,IB)) * ZFNEG2(:,:,IB) &
+ + ZOMN1(:,:,IB)/(ZOMN1(:,:,IB)+ZOMN2(:,:,IB)) * ZFNEG1(:,:,IB)) * &
+ (0.5-SIGN(0.5,PRWCT(:,:,IB) ))
+!
+PR(:,:,IT-1) = (ZOMP2(:,:,IT-1)/(ZOMP1(:,:,IT-1)+ZOMP2(:,:,IT-1)) * &
+ ZFPOS2(:,:,IT-1) &
+ + ZOMP1(:,:,IT-1)/(ZOMP1(:,:,IT-1)+ZOMP2(:,:,IT-1)) * &
+ ZFPOS1(:,:,IT-1)) * (0.5+SIGN(0.5,PRWCT(:,:,IT-1) ))&
+ + (ZOMN2(:,:,IT-1)/(ZOMN1(:,:,IT-1)+ZOMN2(:,:,IT-1)) * &
+ ZFNEG2(:,:,IT-1) &
+ + ZOMN1(:,:,IT-1)/(ZOMN1(:,:,IT-1)+ZOMN2(:,:,IT-1)) * &
+ ZFNEG1(:,:,IT-1)) * (0.5-SIGN(0.5,PRWCT(:,:,IT-1) ))
+!
+PR(:,:,IB-1) = PSRC(:,:,IB-1) * (0.5+SIGN(0.5,PRWCT(:,:,IB-1) )) &
+ + PSRC(:,:,IB ) * (0.5-SIGN(0.5,PRWCT(:,:,IB-1) ))
+!
+PR(:,:,IT) = PSRC(:,:,IT ) * (0.5+SIGN(0.5,PRWCT(:,:,IT) )) &
+ + PSRC(:,:,IT+1) * (0.5-SIGN(0.5,PRWCT(:,:,IT) ))
+!
+PR(:,:,IT+1) = -999.
+!
+PR = PR * PRWCT
+!
+END FUNCTION WENO_K_3_WZ
+!
+!-----------------------------------------------------------------------------
+!
+! ########################################################################
+ FUNCTION WENO_K_3_MZ(PSRC, PRWCT) RESULT(PR)
+! ########################################################################
+!!
+!!* Computes PRWCT * PUT (or PRWCT * PVT). Upstream fluxes of U (or V)
+!! variables in Z direction.
+!! Input PUT is on U Grid 'ie' (i,j,k) based on UGRID reference
+!! Output PR is on mass Grid 'ie' (i,j,k-1/2) based on UGRID reference
+!!
+!! AUTHOR
+!! ------
+!! F. Visentin *CNRS/LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_CONF
+USE MODD_PARAMETERS,ONLY: JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!
+! output source term
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IB ! Begining useful area in x,y,z directions
+INTEGER :: IT ! End useful area in x,y,z directions
+!
+! WENO-related variables:
+!
+! intermediate reconstruction fluxes for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!
+! intermediate reconstruction fluxes for negative wind case
+! we need only one since ZFNEG2 = ZFPOS2
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!
+! smoothness indicators for positive wind case
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!
+! WENO weights
+!
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
+!
+! standard weights
+!
+REAL, PARAMETER :: ZGAMMA1 = 1./10.
+REAL, PARAMETER :: ZGAMMA2 = 3./5.
+REAL, PARAMETER :: ZGAMMA3 = 3./10.
+REAL, PARAMETER :: ZGAMMA1_PRIM = 1./3.
+REAL, PARAMETER :: ZGAMMA2_PRIM = 2./3.
+!
+REAL, PARAMETER :: ZEPS = 1.0E-15
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
+! ------------------------------
+!
+IB = 1 + JPVEXT
+IT = SIZE(PSRC,3) - JPVEXT
+!
+PR(:,:,:) = 0.0
+!
+ZFPOS1 = 0.0
+ZFPOS2 = 0.0
+ZFPOS3 = 0.0
+ZFNEG1 = 0.0
+ZFNEG2 = 0.0
+ZFNEG3 = 0.0
+ZBPOS1 = 0.0
+ZBPOS2 = 0.0
+ZBPOS3 = 0.0
+ZBNEG1 = 0.0
+ZBNEG2 = 0.0
+ZBNEG3 = 0.0
+ZOMP1 = 0.0
+ZOMP2 = 0.0
+ZOMP3 = 0.0
+ZOMN1 = 0.0
+ZOMN2 = 0.0
+ZOMN3 = 0.0
+!
+! r: many left cells in regard to 'k-1' cell for each stencil
+!
+! intermediate fluxes at the mass point on Wgrid u(i,j,k-1/2)=(i,j,(k-1)-1/2)
+! for positive wind case (left to the right)
+! (r=2 for the first stencil ZFPOS1, r=1 for the second ZFPOS2 and
+! r=0 for the last ZFPOS3)
+!
+ZFPOS1(:,:,IB+2:IT-1) = 1./6 * (2.0*PSRC(:,:,IB-1:IT-4) - 7.0*PSRC(:,:,IB:IT-3) + &
+ 11.0*PSRC(:,:,IB+1:IT-2))
+ZFPOS1(:,:,IB+1) = 0.5 * (3.0*PSRC(:,:, IB) - PSRC(:,:,IB-1))
+ZFPOS1(:,:, IT) = 0.5 * (3.0*PSRC(:,:,IT-1) - PSRC(:,:,IT-2))
+!
+!
+ZFPOS2(:,:,IB+2:IT-1) = 1./6 * (-1.0*PSRC(:,:,IB:IT-3) + 5.0*PSRC(:,:,IB+1:IT-2) + &
+ 2.0*PSRC(:,:,IB+2:IT-1))
+ZFPOS2(:,:,IB+1) = 0.5 * (PSRC(:,:, IB) + PSRC(:,:,IB+1))
+ZFPOS2(:,:, IT) = 0.5 * (PSRC(:,:,IT-1) + PSRC(:,:, IT))
+!
+!
+ZFPOS3(:,:,IB+2:IT-1) = 1./6 * (2.0*PSRC(:,:,IB+1:IT-2) + 5.0*PSRC(:,:,IB+2:IT-1) -&
+ 1.0*PSRC(:,:,IB+3:IT))
+!
+! r: many left cells in regard to 'k' cell for each stencil
+!
+! intermediate fluxes at the mass point on Ugrid u(i,j,k-1/2) for negative wind
+! case (R. to the L.)
+! (r=2 for the third stencil ZFNEG3=ZFPOS2, r=1 for the second ZFNEG2=ZFPOS3
+! and r=0 for the first ZFNEG1)
+!
+ZFNEG1(:,:,IB+2:IT-1) = 1./6 * (11.0*PSRC(:,:,IB+2:IT-1) - 7.0*PSRC(:,:,IB+3:IT) + &
+ 2.0*PSRC(:,:,IB+4:IT+1))
+ZFNEG1(:,:,IB+1) = 0.5 * (3.0*PSRC(:,:,IB+1) - PSRC(:,:,IB+2))
+ZFNEG1(:,:, IT) = 0.5 * (3.0*PSRC(:,:, IT) - PSRC(:,:,IT+1))
+!
+ZFNEG2(:,:,IB+2:IT-1) = 1./6 * (2.0*PSRC(:,:,IB+1:IT-2) + 5.0*PSRC(:,:,IB+2:IT-1) -&
+ 1.0*PSRC(:,:,IB+3:IT))
+ZFNEG2(:,:,IB+1) = 0.5 * (PSRC(:,:, IB) + PSRC(:,:,IB+1))
+ZFNEG2(:,:, IT) = 0.5 * (PSRC(:,:,IT-1) + PSRC(:,:, IT))
+!
+!
+ZFNEG3(:,:,IB+2:IT-1) = 1./6 * (-1.0*PSRC(:,:,IB:IT-3) + 5.0*PSRC(:,:,IB+1:IT-2) + &
+ 2.0*PSRC(:,:,IB+2:IT-1))
+!
+! smoothness indicators for positive wind case
+!
+ZBPOS1(:,:,IB+2:IT-1) = 13./12 * (PSRC(:,:,IB-1:IT-4) - 2.0*PSRC(:,:,IB:IT-3) + &
+ PSRC(:,:,IB+1:IT-2))**2 + &
+ 1./4 * (PSRC(:,:,IB-1:IT-4) - 4.0*PSRC(:,:,IB:IT-3) + 3.0*PSRC(:,:,IB+1:IT-2))**2
+ZBPOS1(:,:,IB+1) = (PSRC(:,:, IB) - PSRC(:,:,IB-1))**2
+ZBPOS1(:,:, IT) = (PSRC(:,:,IT-1) - PSRC(:,:,IT-2))**2
+!
+!
+ZBPOS2(:,:,IB+2:IT-1) = 13./12 * (PSRC(:,:,IB:IT-3) - 2.0*PSRC(:,:,IB+1:IT-2) + &
+ PSRC(:,:,IB+2:IT-1))**2 + &
+ 1./4 * (PSRC(:,:,IB:IT-3) - PSRC(:,:,IB+2:IT-1))**2
+ZBPOS2(:,:,IB+1) = (PSRC(:,:,IB+1) - PSRC(:,:, IB))**2
+ZBPOS2(:,:, IT) = (PSRC(:,:, IT) - PSRC(:,:,IT-1))**2
+!
+!
+ZBPOS3(:,:,IB+2:IT-1) = 13./12 * (PSRC(:,:,IB+1:IT-2) - 2.0*PSRC(:,:,IB+2:IT-1) + &
+ PSRC(:,:,IB+3:IT))**2 + &
+ 1./4 * ( 3.0*PSRC(:,:,IB+1:IT-2) - 4.0*PSRC(:,:,IB+2:IT-1) + PSRC(:,:,IB+3:IT))**2
+!
+! smoothness indicators for negative wind case
+!
+ZBNEG1(:,:,IB+2:IT-1) = 13./12 * (PSRC(:,:,IB+2:IT-1) - 2.0*PSRC(:,:,IB+3:IT) + &
+ PSRC(:,:,IB+4:IT+1))**2 + &
+ 1./4 * ( 3.0*PSRC(:,:,IB+2:IT-1) - 4.0*PSRC(:,:,IB+3:IT) + PSRC(:,:,IB+4:IT+1))**2
+ZBNEG1(:,:,IB+1) = (PSRC(:,:,IB+1) - PSRC(:,:,IB+2))**2
+ZBNEG1(:,:, IT) = (PSRC(:,:, IT) - PSRC(:,:,IT+1))**2
+!
+ZBNEG2(:,:,IB+2:IT-1) = 13./12 * (PSRC(:,:,IB+1:IT-2) - 2.0*PSRC(:,:,IB+2:IT-1) + &
+ PSRC(:,:,IB+3:IT))**2 + &
+ 1./4 * (PSRC(:,:,IB+1:IT-2) - PSRC(:,:,IB+3:IT))**2
+ZBNEG2(:,:,IB+1) = (PSRC(:,:, IB) - PSRC(:,:,IB+1))**2
+ZBNEG2(:,:, IT) = (PSRC(:,:,IT-1) - PSRC(:,:, IT))**2
+!
+!
+ZBNEG3(:,:,IB+2:IT-1) = 13./12 * (PSRC(:,:,IB:IT-3) - 2.0*PSRC(:,:,IB+1:IT-2) + &
+ PSRC(:,:,IB+2:IT-1))**2 + &
+ 1./4 * ( PSRC(:,:,IB:IT-3) - 4.0*PSRC(:,:,IB+1:IT-2) + 3.0*PSRC(:,:,IB+2:IT-1))**2
+!
+! WENO weights
+!
+ZOMP1(:,:,IB+2:IT-1) = ZGAMMA1 / (ZEPS + ZBPOS1(:,:,IB+2:IT-1))**2
+ZOMP2(:,:,IB+2:IT-1) = ZGAMMA2 / (ZEPS + ZBPOS2(:,:,IB+2:IT-1))**2
+ZOMP3(:,:,IB+2:IT-1) = ZGAMMA3 / (ZEPS + ZBPOS3(:,:,IB+2:IT-1))**2
+ZOMN1(:,:,IB+2:IT-1) = ZGAMMA1 / (ZEPS + ZBNEG1(:,:,IB+2:IT-1))**2
+ZOMN2(:,:,IB+2:IT-1) = ZGAMMA2 / (ZEPS + ZBNEG2(:,:,IB+2:IT-1))**2
+ZOMN3(:,:,IB+2:IT-1) = ZGAMMA3 / (ZEPS + ZBNEG3(:,:,IB+2:IT-1))**2
+!
+ZOMP1(:,:,IB+1) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,:,IB+1))**2
+ZOMP2(:,:,IB+1) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,:,IB+1))**2
+ZOMN1(:,:,IB+1) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,:,IB+1))**2
+ZOMN2(:,:,IB+1) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,:,IB+1))**2
+ZOMP1(:,:, IT) = ZGAMMA1_PRIM / (ZEPS + ZBPOS1(:,:, IT))**2
+ZOMP2(:,:, IT) = ZGAMMA2_PRIM / (ZEPS + ZBPOS2(:,:, IT))**2
+ZOMN1(:,:, IT) = ZGAMMA1_PRIM / (ZEPS + ZBNEG1(:,:, IT))**2
+ZOMN2(:,:, IT) = ZGAMMA2_PRIM / (ZEPS + ZBNEG2(:,:, IT))**2
+!
+PR(:,:,IB+2:IT-1) = (ZOMP1(:,:,IB+2:IT-1)/(ZOMP1(:,:,IB+2:IT-1)+ &
+ ZOMP2(:,:,IB+2:IT-1)+ZOMP3(:,:,IB+2:IT-1)) * &
+ ZFPOS1(:,:,IB+2:IT-1) &
+ + ZOMP2(:,:,IB+2:IT-1)/(ZOMP1(:,:,IB+2:IT-1)+ &
+ ZOMP2(:,:,IB+2:IT-1)+ZOMP3(:,:,IB+2:IT-1)) * &
+ ZFPOS2(:,:,IB+2:IT-1) &
+ + ZOMP3(:,:,IB+2:IT-1)/(ZOMP1(:,:,IB+2:IT-1)+ &
+ ZOMP2(:,:,IB+2:IT-1)+ZOMP3(:,:,IB+2:IT-1)) * &
+ ZFPOS3(:,:,IB+2:IT-1)) &
+ * (0.5+SIGN(0.5,PRWCT(:,:,IB+2:IT-1))) &
+ + (ZOMN1(:,:,IB+2:IT-1)/(ZOMN1(:,:,IB+2:IT-1)+ &
+ ZOMN2(:,:,IB+2:IT-1)+ZOMN3(:,:,IB+2:IT-1)) * &
+ ZFNEG1(:,:,IB+2:IT-1) &
+ + ZOMN2(:,:,IB+2:IT-1)/(ZOMN1(:,:,IB+2:IT-1)+ &
+ ZOMN2(:,:,IB+2:IT-1)+ZOMN3(:,:,IB+2:IT-1)) * &
+ ZFNEG2(:,:,IB+2:IT-1) &
+ + ZOMN3(:,:,IB+2:IT-1)/(ZOMN1(:,:,IB+2:IT-1)+ &
+ ZOMN2(:,:,IB+2:IT-1)+ZOMN3(:,:,IB+2:IT-1)) * &
+ ZFNEG3(:,:,IB+2:IT-1)) &
+ * (0.5-SIGN(0.5,PRWCT(:,:,IB+2:IT-1) ))
+!
+PR(:,:,IB+1) = (ZOMP2(:,:,IB+1)/(ZOMP1(:,:,IB+1)+ZOMP2(:,:,IB+1)) * &
+ ZFPOS2(:,:,IB+1) &
+ + ZOMP1(:,:,IB+1)/(ZOMP1(:,:,IB+1)+ZOMP2(:,:,IB+1)) * &
+ ZFPOS1(:,:,IB+1)) * (0.5+SIGN(0.5,PRWCT(:,:,IB+1) ))&
+ + (ZOMN2(:,:,IB+1)/(ZOMN1(:,:,IB+1)+ZOMN2(:,:,IB+1)) * &
+ ZFNEG2(:,:,IB+1) &
+ + ZOMN1(:,:,IB+1)/(ZOMN1(:,:,IB+1)+ZOMN2(:,:,IB+1)) * &
+ ZFNEG1(:,:,IB+1)) * (0.5-SIGN(0.5,PRWCT(:,:,IB+1) ))
+!
+PR(:,:,IT) = (ZOMP2(:,:,IT)/(ZOMP1(:,:,IT)+ZOMP2(:,:,IT)) * ZFPOS2(:,:,IT) &
+ + ZOMP1(:,:,IT)/(ZOMP1(:,:,IT)+ZOMP2(:,:,IT)) * ZFPOS1(:,:,IT)) * &
+ (0.5+SIGN(0.5,PRWCT(:,:,IT) )) &
+ + (ZOMN2(:,:,IT)/(ZOMN1(:,:,IT)+ZOMN2(:,:,IT)) * ZFNEG2(:,:,IT) &
+ + ZOMN1(:,:,IT)/(ZOMN1(:,:,IT)+ZOMN2(:,:,IT)) * ZFNEG1(:,:,IT)) * &
+ (0.5-SIGN(0.5,PRWCT(:,:,IT) ))
+!
+PR(:,:,IB) = PSRC(:,:,IB-1) * (0.5+SIGN(0.5,PRWCT(:,:,IB) )) &
+ + PSRC(:,:,IB ) * (0.5-SIGN(0.5,PRWCT(:,:,IB) ))
+!
+PR(:,:,IT+1) = PSRC(:,:,IT ) * (0.5+SIGN(0.5,PRWCT(:,:,IT+1) )) &
+ + PSRC(:,:,IT+1) * (0.5-SIGN(0.5,PRWCT(:,:,IT+1) ))
+!
+!PR(:,:,IB-1) = - 999.
+!
+PR = PR * PRWCT
+!
+END FUNCTION WENO_K_3_MZ
diff --git a/src/MNH/advection.f90 b/src/MNH/advection.f90
index 04b8f7638..4025bf18f 100644
--- a/src/MNH/advection.f90
+++ b/src/MNH/advection.f90
@@ -10,10 +10,8 @@ INTERFACE
PUM, PVM, PWM, PTHM, PRM, PTKEM, PSVM, &
PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, &
PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
- PRUS,PRVS, PRWS, PRTHS, PRRS, PRTKES, PRSVS, &
- TPHALO2MLIST, TPHALO2LIST, TPHALO2SLIST )
+ PRUS,PRVS, PRWS, PRTHS, PRRS, PRTKES, PRSVS )
!
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
!
CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
HSV_ADV_SCHEME, & ! scheme applied
@@ -50,10 +48,6 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
! Sources terms
!
-! halo lists for 4th order advection
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2MLIST ! momentum variables
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! meteorological scalar variables
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2SLIST ! tracer scalar variables
!
END SUBROUTINE ADVECTION
!
@@ -67,8 +61,7 @@ END MODULE MODI_ADVECTION
PUM, PVM, PWM, PTHM, PRM, PTKEM, PSVM, &
PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, &
PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
- PRUS,PRVS, PRWS, PRTHS, PRRS, PRTKES, PRSVS, &
- TPHALO2MLIST, TPHALO2LIST, TPHALO2SLIST )
+ PRUS,PRVS, PRWS, PRTHS, PRRS, PRTKES, PRSVS )
! ##########################################################################
!
!!**** *ADVECTION * - routine to call the specialized advection routines
@@ -132,26 +125,6 @@ END MODULE MODI_ADVECTION
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
-USE MODD_CONF
-USE MODD_BLANK
-USE MODD_GRID_n
-!
-USE MODI_SHUMAN
-USE MODI_CONTRAV
-USE MODI_ADVECUVW
-USE MODI_ADVECUVW_4TH
-USE MODI_ADVECMET
-USE MODI_ADVECMET_4TH
-USE MODI_FCT_MET
-USE MODI_MPDATA
-USE MODI_ADVECSCALAR
-USE MODI_ADVECSCALAR_4TH
-USE MODI_FCT_SCALAR
-USE MODI_MPDATA_SCALAR
-USE MODI_PPM_MET
-USE MODI_PPM_SCALAR
!
!
!-------------------------------------------------------------------------------
@@ -198,213 +171,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
! Sources terms
!
!
-!* 0.2 declarations of local variables
-!
-!
-!
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUT
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVT
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWT
- ! cartesian
- ! components of
- ! momentum
-!
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCT
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCT
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCT
- ! contravariant
- ! components
- ! of momentum
-!
-INTEGER :: IINFO_ll ! return code of parallel routine
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-! halo lists for 4th order advection
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2MLIST ! momentum variables
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! meteorological scalar variables
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2SLIST ! tracer scalar variables
-INTEGER :: IKU
-!
-!-------------------------------------------------------------------------------
-!
-!
-IKU=SIZE(XZHAT)
-!* 1. COMPUTES THE CONTRAVARIANT COMPONENTS
-! -------------------------------------
-!
-ZRUT = PUT(:,:,:) * MXM(PRHODJ)
-ZRVT = PVT(:,:,:) * MYM(PRHODJ)
-ZRWT = PWT(:,:,:) * MZM(1,IKU,1,PRHODJ)
-!
-IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
- CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
- ZRUCT,ZRVCT,ZRWCT,2)
-ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
- CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
- ZRUCT,ZRVCT,ZRWCT,4)
-ENDIF
-!
-NULLIFY(TZFIELDS_ll)
-IF(NHALO == 1) THEN
- CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRWCT)
- CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRUCT)
- CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRVCT)
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. CALLS THE ADVECTION ROUTINES FOR THE MOMENTUM
-! ---------------------------------------------
-!
-! choose between 2nd and 4th order momentum advection.
-IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
-!
- CALL ADVECUVW (PUT,PVT,PWT,ZRUCT,ZRVCT,ZRWCT,PRUS,PRVS,PRWS)
-!
-ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
-!
- CALL ADVECUVW_4TH ( HLBCX, HLBCY, ZRUCT, ZRVCT, ZRWCT, &
- PUT, PVT, PWT, PRUS, PRVS, PRWS, TPHALO2MLIST )
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. CALLS THE ADVECTION ROUTINES FOR THE METEOROLOGICAL SCALARS
-! -----------------------------------------------------------
-!
-! 3.1. 2nd order scheme
-!
-IF (HMET_ADV_SCHEME=='CEN2ND') THEN
-!
- CALL ADVECMET (KRR, PTHT,PRT,PTKET, &
- ZRUCT,ZRVCT,ZRWCT, &
- PRTHS,PRRS,PRTKES )
-!
-! 3.2. 4th order scheme
-!
-ELSEIF (HMET_ADV_SCHEME =='CEN4TH' ) THEN
-!
- CALL ADVECMET_4TH (HLBCX,HLBCY, KRR, &
- ZRUCT, ZRVCT, ZRWCT, &
- PTHT, PTKET, PRT, &
- PRTHS, PRTKES, PRRS, TPHALO2LIST )
-!
-! 3.3. Flux-Corrected Transport scheme
-!
-ELSEIF ( HMET_ADV_SCHEME=='FCT2ND') THEN
-!
- CALL FCT_MET (HLBCX, HLBCY,KRR, &
- PTSTEP_MET, PRHODJ, PTHM, PRM, PTKEM, &
- PTHT, PRT, PTKET, &
- ZRUCT, ZRVCT, ZRWCT, &
- PRTHS, PRRS, PRTKES )
-!
-! 3.4. MPDATA scheme
-!
-ELSEIF (HMET_ADV_SCHEME=='MPDATA') THEN
-!
- CALL MPDATA (KLITER, HLBCX, HLBCY, KRR, &
- PTSTEP_MET, PRHODJ, PTHM, PRM, PTKEM, &
- PTHT, PRT, PTKET, &
- ZRUCT, ZRVCT, ZRWCT, &
- PRTHS, PRRS, PRTKES )
-!
-! 3.5. PPM schemes
-!
-ELSEIF (HMET_ADV_SCHEME(1:3)=='PPM') THEN
-!
-! extrapolate velocity field to t+dt/2 to use in forward in time PPM
-! advection scheme
-!
- ZRUT = (1.5*PUT(:,:,:) - 0.5*PUM(:,:,:))
- ZRVT = (1.5*PVT(:,:,:) - 0.5*PVM(:,:,:))
- ZRWT = (1.5*PWT(:,:,:) - 0.5*PWM(:,:,:))
-! calculate Courant numbers
- IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
- CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
- ZRUCT,ZRVCT,ZRWCT,2)
- ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
- CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
- ZRUCT,ZRVCT,ZRWCT,4)
- ENDIF
-!
- ZRUCT = ZRUCT*PTSTEP_MET
- ZRVCT = ZRVCT*PTSTEP_MET
- ZRWCT = ZRWCT*PTSTEP_MET
-
- CALL PPM_MET (HLBCX,HLBCY, KRR, KTCOUNT, &
- ZRUCT, ZRVCT, ZRWCT, PTSTEP_MET, PRHODJ, &
- PTHT, PTKET, PRT, PRTHS, PRTKES, PRRS, &
- HMET_ADV_SCHEME )
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. CALLS THE ADVECTION ROUTINES FOR TRACERS
-! ----------------------------------------
-!
-! 4.1. 2nd order scheme
-!
-IF (HSV_ADV_SCHEME=='CEN2ND') THEN
-!
- CALL ADVECSCALAR (KSV, PSVT, ZRUCT,ZRVCT,ZRWCT,PRSVS )
-!
-! 4.2. 4th order scheme
-!
-ELSEIF (HSV_ADV_SCHEME =='CEN4TH' ) THEN
-!
- CALL ADVECSCALAR_4TH (HLBCX,HLBCY, KSV, &
- ZRUCT, ZRVCT, ZRWCT, &
- PSVT, PRSVS, TPHALO2SLIST )
-!
-! 4.3. Flux-Corrected Transport scheme
-!
-ELSEIF ( HSV_ADV_SCHEME=='FCT2ND') THEN
-!
- CALL FCT_SCALAR (HLBCX, HLBCY, KSV, &
- PTSTEP_SV, PRHODJ, PSVM,PSVT, &
- ZRUCT, ZRVCT, ZRWCT, PRSVS )
-!
-! 4.4. MPDATA scheme
-!
-ELSEIF (HSV_ADV_SCHEME=='MPDATA') THEN
-!
- CALL MPDATA_SCALAR ( KLITER, HLBCX, HLBCY, KSV, &
- PTSTEP_SV, PRHODJ, PSVM, PSVT, &
- ZRUCT, ZRVCT, ZRWCT, PRSVS )
-!
-! 4.5. PPM schemes
-!
-ELSEIF (HSV_ADV_SCHEME(1:3)=='PPM') THEN
-!
-! extrapolate velocity field to t+dt/2 to use in forward in time PPM
-! advection scheme
-!
- ZRUT = (1.5*PUT(:,:,:) - 0.5*PUM(:,:,:))
- ZRVT = (1.5*PVT(:,:,:) - 0.5*PVM(:,:,:))
- ZRWT = (1.5*PWT(:,:,:) - 0.5*PWM(:,:,:))
-! calculate Courant numbers
- IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
- CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
- ZRUCT,ZRVCT,ZRWCT,2)
- ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
- CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
- ZRUCT,ZRVCT,ZRWCT,4)
- ENDIF
-!
- ZRUCT = ZRUCT*PTSTEP_SV
- ZRVCT = ZRVCT*PTSTEP_SV
- ZRWCT = ZRWCT*PTSTEP_SV
-
- CALL PPM_SCALAR(HLBCX,HLBCY, KSV, KTCOUNT, &
- ZRUCT, ZRVCT, ZRWCT, PTSTEP_SV, PRHODJ, &
- PSVT, PRSVS, HSV_ADV_SCHEME )
-!
-END IF
-!
+! ROUTINE TO REMOVE
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADVECTION
diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90
new file mode 100644
index 000000000..cd246c742
--- /dev/null
+++ b/src/MNH/advection_metsv.f90
@@ -0,0 +1,537 @@
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_ADVECTION_METSV
+! ###########################
+!
+INTERFACE
+ SUBROUTINE ADVECTION_METSV (HLUOUT, HFMFILE, OCLOSE_OUT,HUVW_ADV_SCHEME, &
+ HMET_ADV_SCHEME,HSV_ADV_SCHEME, KSPLIT, &
+ OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
+ HLBCX, HLBCY, KRR, KSV, KTCOUNT, PTSTEP, &
+ PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, &
+ PTHVREF, PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
+ PRTHS, PRRS, PRTKES, PRSVS, &
+ PRTHS_CLD, PRRS_CLD, PRSVS_CLD, PRTKES_ADV )
+!
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
+ ! file opening
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
+ ! FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
+ HSV_ADV_SCHEME, & ! scheme applied
+ HUVW_ADV_SCHEME
+!
+INTEGER, INTENT(INOUT):: KSPLIT ! Number of time splitting
+ ! for PPM advection
+LOGICAL, INTENT(IN) :: OSPLIT_CFL ! flag to automatically chose number of iterations
+REAL, INTENT(IN) :: PSPLIT_CFL ! maximum CFL to automatically chose number of iterations
+LOGICAL, INTENT(IN) :: OCFL_WRIT ! flag to write CFL fields in output files
+!
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+!
+INTEGER, INTENT(IN) :: KTCOUNT
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT , PSVT
+ ! Variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
+ ! Sources terms
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS_CLD
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS_CLD,PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKES_ADV ! Advection TKE source term
+!
+END SUBROUTINE ADVECTION_METSV
+!
+END INTERFACE
+!
+END MODULE MODI_ADVECTION_METSV
+! ##########################################################################
+ SUBROUTINE ADVECTION_METSV (HLUOUT, HFMFILE, OCLOSE_OUT,HUVW_ADV_SCHEME, &
+ HMET_ADV_SCHEME,HSV_ADV_SCHEME, KSPLIT, &
+ OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
+ HLBCX, HLBCY, KRR, KSV, KTCOUNT, PTSTEP, &
+ PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, &
+ PTHVREF, PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
+ PRTHS, PRRS, PRTKES, PRSVS, &
+ PRTHS_CLD, PRRS_CLD, PRSVS_CLD, PRTKES_ADV )
+! ##########################################################################
+!
+!!**** *ADVECTION_METSV * - routine to call the specialized advection routines
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to control the advection routines.
+!! For that, it is first necessary to compute the metric coefficients
+!! and the contravariant components of the momentum.
+!!
+!!** METHOD
+!! ------
+!! Once the scheme is selected, it is applied to the following group of
+!! variables: METeorologicals (temperature, water substances, TKE,
+!! dissipation TKE) and Scalar Variables. It is possible to select different
+!! advection schemes for each group of variables.
+!!
+!! EXTERNAL
+!! --------
+!! CONTRAV : computes the contravariant components.
+!! ADVECUVW : computes the advection terms for momentum.
+!! ADVECSCALAR : computes the advection terms for scalar fields.
+!! ADD3DFIELD_ll : add a field to 3D-list
+!! ADVEC_4TH_ORDER : 4th order advection scheme
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book1 and book2 ( routine ADVECTION )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! J.-P. Lafore * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/07/94
+!! 01/04/95 (Ph. Hereil J. Nicolau) add the model number
+!! 23/10/95 (J. Vila and JP Lafore) advection schemes scalar
+!! 16/01/97 (JP Pinty) change presentation
+!! 30/04/98 (J. Stein P Jabouille) extrapolation for the cyclic
+!! case and parallelisation
+!! 24/06/99 (P Jabouille) case of NHALO>1
+!! 25/10/05 (JP Pinty) 4th order scheme
+!! 24/04/06 (C.Lac) Split scalar and passive
+!! tracer routines
+!! 08/06 (T.Maric) PPM scheme
+!! 04/2011 (V.Masson & C. Lac) splits the routine and add time splitting
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_ll
+USE MODE_IO_ll
+USE MODD_PARAM_n
+USE MODD_CONF, ONLY : LNEUTRAL,NHALO
+USE MODD_CTURB, ONLY : XTKEMIN
+USE MODD_BUDGET
+!
+USE MODI_CONTRAV
+USE MODI_PPM_RHODJ
+USE MODI_PPM_MET
+USE MODI_PPM_SCALAR
+USE MODI_ADV_BOUNDARIES
+USE MODI_BUDGET
+!
+USE MODE_FMWRIT
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
+ ! file opening
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
+ ! FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
+ HSV_ADV_SCHEME, & ! scheme applied
+ HUVW_ADV_SCHEME
+!
+INTEGER, INTENT(INOUT):: KSPLIT ! Number of time splitting
+ ! for PPM advection
+LOGICAL, INTENT(IN) :: OSPLIT_CFL ! flag to automatically chose number of iterations
+REAL, INTENT(IN) :: PSPLIT_CFL ! maximum CFL to automatically chose number of iterations
+LOGICAL, INTENT(IN) :: OCFL_WRIT ! flag to write CFL fields in output files
+!
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+!
+INTEGER, INTENT(IN) :: KTCOUNT
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT , PSVT
+ ! Variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
+ ! Sources terms
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS_CLD
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS_CLD, PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKES_ADV ! Advection TKE source term
+!
+!
+!* 0.2 declarations of local variables
+!
+!
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCPPM
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCPPM
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCPPM
+ ! contravariant
+ ! components
+ ! of momentum
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLU
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLV
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLW
+! ! CFL numbers on each direction
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFL
+! ! CFL number
+!
+REAL :: ZCFLU_MAX, ZCFLV_MAX, ZCFLW_MAX, ZCFL_MAX ! maximum CFL numbers
+!
+REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZTH
+REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZTKE
+REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZRTHS_OTHER
+REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZRTKES_OTHER
+REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZRTHS_PPM
+REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZRTKES_PPM
+REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZR
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSV
+! Guess at the sub time step
+REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZRRS_OTHER
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZRSVS_OTHER
+! Tendencie since the beginning of the time step
+REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZRRS_PPM
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZRSVS_PPM
+! Guess at the end of the sub time step
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOX1,ZRHOX2
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOY1,ZRHOY2
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOZ1,ZRHOZ2
+! Temporary advected rhodj for PPM routines
+!
+INTEGER :: JS,JR,JSV,JSPL ! Loop index
+REAL :: ZTSTEP_PPM ! Sub Time step
+LOGICAL :: GTKE
+!
+INTEGER :: IINFO_ll ! return code of parallel routine
+TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS1_ll ! list of fields to exchange
+!
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: IGRID ! C-grid indicator in LFIFM file
+INTEGER :: ILENCH ! Length of comment string in LFIFM file
+CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
+CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
+INTEGER :: ILUOUT ! logical unit
+INTEGER :: ISPLIT_PPM ! temporal time splitting
+
+!-------------------------------------------------------------------------------
+!
+!* 0. INITIALIZATION
+! --------------
+!
+!
+!
+GTKE=(SIZE(PTKET)/=0)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTES THE CONTRAVARIANT COMPONENTS (FOR PPM ONLY)
+! --------------------------------------
+!
+!* 2.1 computes contravariant components
+!
+IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
+ CALL CONTRAV (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,2)
+ELSE
+ CALL CONTRAV (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,4)
+END IF
+!
+!
+!* 2.2 computes CFL numbers
+!
+ZCFLU = ABS(ZRUCPPM * PTSTEP)
+ZCFLV = ABS(ZRVCPPM * PTSTEP)
+ZCFLW = ABS(ZRWCPPM * PTSTEP)
+ZCFL = SQRT(ZCFLU**2+ZCFLV**2+ZCFLW**2)
+!
+!* prints in the file the 3D Courant numbers (one should flag this)
+!
+IF (OCLOSE_OUT .AND. OCFL_WRIT) THEN
+ YRECFM ='CFLU'
+ YCOMMENT='X_Y_Z_CFLU (-)'
+ IGRID = 1
+ ILENCH=LEN(YCOMMENT)
+ CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZCFLU,IGRID,ILENCH,YCOMMENT,IRESP)
+
+ YRECFM ='CFLV'
+ YCOMMENT='X_Y_Z_CFLV (-)'
+ IGRID = 1
+ ILENCH=LEN(YCOMMENT)
+ CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZCFLV,IGRID,ILENCH,YCOMMENT,IRESP)
+
+ YRECFM ='CFLW'
+ YCOMMENT='X_Y_Z_CFLW (-)'
+ IGRID = 1
+ ILENCH=LEN(YCOMMENT)
+ CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZCFLW,IGRID,ILENCH,YCOMMENT,IRESP)
+
+ YRECFM ='CFL'
+ YCOMMENT='X_Y_Z_CFL (-)'
+ IGRID = 1
+ ILENCH=LEN(YCOMMENT)
+ CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZCFL,IGRID,ILENCH,YCOMMENT,IRESP)
+END IF
+!
+!* prints in the output file the maximum CFL
+!
+CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
+!
+ZCFLU_MAX = MAX_ll(ZCFLU,IINFO_ll)
+ZCFLV_MAX = MAX_ll(ZCFLV,IINFO_ll)
+ZCFLW_MAX = MAX_ll(ZCFLW,IINFO_ll)
+ZCFL_MAX = MAX_ll(ZCFL,IINFO_ll)
+!
+WRITE(ILUOUT,FMT='(A24,F5.2,A5,F5.2,A5,F5.2,A9,F5.2)') &
+ 'Max. CFL number for U : ',ZCFLU_MAX, &
+ ' V : ',ZCFLV_MAX,' W : ', ZCFLW_MAX,&
+ 'global : ',ZCFL_MAX
+!
+!
+!* 2.3 updates time step splitting loop
+!
+IF (OSPLIT_CFL) THEN
+!
+ ISPLIT_PPM = INT(ZCFL_MAX/PSPLIT_CFL)+1
+ IF ( KSPLIT /= ISPLIT_PPM ) &
+ WRITE(ILUOUT,FMT='(A37,I2,A4,I2,A11)') &
+ 'PPM time spliting loop changed from ', &
+ KSPLIT,' to ',ISPLIT_PPM, ' iterations'
+!
+ KSPLIT = ISPLIT_PPM
+!
+END IF
+! ---------------------------------------------------------------
+IF ( (ZCFLU_MAX>=3. .OR. ZCFLV_MAX>=3.) .OR. ZCFLW_MAX>=8. ) THEN
+ WRITE(ILUOUT,*) ' '
+ WRITE(ILUOUT,*) ' +---------------------------------------------------+'
+ WRITE(ILUOUT,*) ' | MODEL ERROR |'
+ WRITE(ILUOUT,*) ' +---------------------------------------------------+'
+ WRITE(ILUOUT,*) ' | |'
+ WRITE(ILUOUT,*) ' | The model wind speed becomes too high |'
+ WRITE(ILUOUT,*) ' | |'
+ IF ( ZCFLU_MAX>=3. .OR. ZCFLV_MAX>=3. ) &
+ WRITE(ILUOUT,*) ' | The horizontal CFL value reaches 3. or more |'
+ IF ( ZCFLW_MAX>=8. ) &
+ WRITE(ILUOUT,*) ' | The vertical CFL value reaches 8. or more |'
+ WRITE(ILUOUT,*) ' | |'
+ WRITE(ILUOUT,*) ' | This can be due either to : |'
+ WRITE(ILUOUT,*) ' | - a numerical explosion of the model |'
+ WRITE(ILUOUT,*) ' | - or a too high wind speed for an |'
+ WRITE(ILUOUT,*) ' | acceptable accuracy of the advection |'
+ WRITE(ILUOUT,*) ' | |'
+ WRITE(ILUOUT,*) ' | Please decrease your time-step |'
+ WRITE(ILUOUT,*) ' | |'
+ WRITE(ILUOUT,*) ' +---------------------------------------------------+'
+ WRITE(ILUOUT,*) ' '
+ WRITE(ILUOUT,*) ' +---------------------------------------------------+'
+ WRITE(ILUOUT,*) ' | MODEL STOPS |'
+ WRITE(ILUOUT,*) ' +---------------------------------------------------+'
+! CALL ABORT
+! STOP
+END IF
+!
+!
+ZTSTEP_PPM = PTSTEP / REAL(KSPLIT)
+!
+!
+!* 2.4 normalized contravariant components for splitted PPM time-step
+!
+ZRUCPPM = ZRUCPPM*ZTSTEP_PPM
+ZRVCPPM = ZRVCPPM*ZTSTEP_PPM
+ZRWCPPM = ZRWCPPM*ZTSTEP_PPM
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. COMPUTES THE TENDENCIES SINCE THE BEGINNING OF THE TIME STEP
+! ------------------------------------------------------------
+!
+!* This represent the effects of all OTHER processes
+! Clouds related processes from previous time-step are taken into account in PRTHS_CLD
+! Advection related processes from previous time-step will be taken into account in ZRTHS_PPM
+!
+ZRTHS_OTHER = PRTHS - PTHT * PRHODJ / PTSTEP
+IF (GTKE) ZRTKES_OTHER = PRTKES - PTKET * PRHODJ / PTSTEP
+DO JR = 1, KRR
+ ZRRS_OTHER(:,:,:,JR) = PRRS(:,:,:,JR) - PRT(:,:,:,JR) * PRHODJ(:,:,:) / PTSTEP
+END DO
+DO JSV = 1, KSV
+ ZRSVS_OTHER(:,:,:,JSV) = PRSVS(:,:,:,JSV) - PSVT(:,:,:,JSV) * PRHODJ / PTSTEP
+END DO
+!
+! Top and bottom Boundaries
+!
+CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRTHS_OTHER)
+IF (GTKE) CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRTKES_OTHER)
+DO JR = 1, KRR
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRRS_OTHER(:,:,:,JR))
+END DO
+DO JSV = 1, KSV
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRSVS_OTHER(:,:,:,JSV))
+END DO
+!
+! Exchanges on processors
+!
+NULLIFY(TZFIELDS0_ll)
+IF(NHALO == 1) THEN
+ CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRTHS_OTHER)
+ IF (GTKE) CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRTKES_OTHER)
+ DO JR=1,KRR
+ CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRRS_OTHER(:,:,:,JR))
+ END DO
+ DO JSV=1,KSV
+ CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRSVS_OTHER(:,:,:,JSV))
+ END DO
+ CALL UPDATE_HALO_ll(TZFIELDS0_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS0_ll)
+END IF
+!
+!
+
+!-------------------------------------------------------------------------------
+!
+!* 4. CALLS THE PPM ADVECTION INSIDE A TIME SPLITTING
+! --------------------------------------
+!
+CALL PPM_RHODJ(HLBCX,HLBCY, ZRUCPPM, ZRVCPPM, ZRWCPPM, &
+ ZTSTEP_PPM, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, &
+ ZRHOZ1, ZRHOZ2 )
+!
+!* valuesw of the fields at the beginning of the time splitting loop
+ZTH = PTHT
+ZTKE = PTKET
+IF (KRR /=0 ) ZR = PRT
+IF (KSV /=0 ) ZSV = PSVT
+!
+IF (GTKE) PRTKES_ADV(:,:,:) = 0.
+!
+!* time splitting loop
+DO JSPL=1,KSPLIT
+!
+ ZRTHS_PPM(:,:,:) = 0.
+ ZRTKES_PPM(:,:,:) = 0.
+ IF (KRR /=0) ZRRS_PPM(:,:,:,:) = 0.
+ IF (KSV /=0) ZRSVS_PPM(:,:,:,:) = 0.
+!
+ IF (LNEUTRAL) ZTH=ZTH-PTHVREF !* To be removed with the new PPM scheme ?
+ CALL PPM_MET (HLBCX,HLBCY, KRR, KTCOUNT, ZRUCPPM, ZRVCPPM, ZRWCPPM, ZTSTEP_PPM, &
+ PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
+ ZTH, ZTKE, ZR, ZRTHS_PPM, ZRTKES_PPM, ZRRS_PPM, HMET_ADV_SCHEME)
+ IF (LNEUTRAL) ZTH=ZTH+PTHVREF !* To be removed with the new PPM scheme ?
+!
+ CALL PPM_SCALAR (HLBCX,HLBCY, KSV, KTCOUNT, ZRUCPPM, ZRVCPPM, ZRWCPPM, &
+ ZTSTEP_PPM, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
+ ZSV, ZRSVS_PPM, HSV_ADV_SCHEME )
+!
+! Tendencies of PPM
+!
+ PRTHS(:,:,:) = PRTHS (:,:,:) + ZRTHS_PPM (:,:,:) / KSPLIT
+ IF (GTKE) PRTKES_ADV(:,:,:) = PRTKES_ADV(:,:,:) + ZRTKES_PPM(:,:,:) / KSPLIT
+ IF (KRR /=0) PRRS (:,:,:,:) = PRRS (:,:,:,:) + ZRRS_PPM (:,:,:,:) / KSPLIT
+ IF (KSV /=0 ) PRSVS (:,:,:,:) = PRSVS (:,:,:,:) + ZRSVS_PPM (:,:,:,:) / KSPLIT
+!
+!
+! Guesses of the field inside the time splitting loop
+!
+ ZTH = ZTH + ( ZRTHS_PPM(:,:,:) + ZRTHS_OTHER(:,:,:) + PRTHS_CLD(:,:,:)) * &
+ ZTSTEP_PPM / PRHODJ(:,:,:)
+ IF (GTKE) ZTKE = ZTKE + ( ZRTKES_PPM(:,:,:) + ZRTKES_OTHER(:,:,:) ) * ZTSTEP_PPM / PRHODJ(:,:,:)
+ DO JR = 1, KRR
+ ZR(:,:,:,JR) = ZR(:,:,:,JR) + ( ZRRS_PPM(:,:,:,JR) + ZRRS_OTHER(:,:,:,JR) + PRRS_CLD(:,:,:,JR) ) &
+ * ZTSTEP_PPM / PRHODJ(:,:,:)
+ END DO
+ DO JSV = 1, KSV
+ ZSV(:,:,:,JSV) = ZSV(:,:,:,JSV) + ( ZRSVS_PPM(:,:,:,JSV) + ZRSVS_OTHER(:,:,:,JSV) + &
+ PRSVS_CLD(:,:,:,JSV) ) * ZTSTEP_PPM / PRHODJ(:,:,:)
+ END DO
+!
+! Top and bottom Boundaries and LBC for the guesses
+!
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTH, PTHT )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTKE, PTKET)
+ DO JR = 1, KRR
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZR(:,:,:,JR), PRT(:,:,:,JR))
+ END DO
+ DO JSV = 1, KSV
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZSV(:,:,:,JSV), PSVT(:,:,:,JSV))
+ END DO
+!
+! Exchanges fields between processors
+!
+ NULLIFY(TZFIELDS1_ll)
+ IF(NHALO == 1) THEN
+ CALL ADD3DFIELD_ll(TZFIELDS1_ll, ZTH)
+ IF (GTKE) CALL ADD3DFIELD_ll(TZFIELDS1_ll, ZTKE)
+ DO JR=1,KRR
+ CALL ADD3DFIELD_ll(TZFIELDS1_ll, ZR(:,:,:,JR))
+ END DO
+ DO JSV=1,KSV
+ CALL ADD3DFIELD_ll(TZFIELDS1_ll, ZSV(:,:,:,JSV))
+ END DO
+ CALL UPDATE_HALO_ll(TZFIELDS1_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS1_ll)
+ END IF
+!
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+! TKE special case: advection is the last process for TKE
+!
+! TKE must be greater than its minimum value
+! (previously done in tke_eps_sources)
+!
+IF (GTKE) THEN
+ PRTKES(:,:,:) = PRTKES(:,:,:) + PRTKES_ADV(:,:,:)
+ PRTKES(:,:,:) = MAX (PRTKES(:,:,:) , XTKEMIN * PRHODJ(:,:,:) / PTSTEP )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. BUDGETS
+! -------
+!
+IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADV_BU_RTH')
+IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADV_BU_RTKE')
+IF (KRR>=1.AND.LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'ADV_BU_RRV')
+IF (KRR>=2.AND.LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'ADV_BU_RRC')
+IF (KRR>=3.AND.LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8,'ADV_BU_RRR')
+IF (KRR>=4.AND.LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'ADV_BU_RRI')
+IF (KRR>=5.AND.LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADV_BU_RRS')
+IF (KRR>=6.AND.LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADV_BU_RRG')
+IF (KRR>=7.AND.LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADV_BU_RRH')
+DO JSV=1,KSV
+ IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADV_BU_RSV')
+END DO
+
+
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADVECTION_METSV
diff --git a/src/MNH/advection_uvw.f90 b/src/MNH/advection_uvw.f90
new file mode 100644
index 000000000..d3e59b80f
--- /dev/null
+++ b/src/MNH/advection_uvw.f90
@@ -0,0 +1,312 @@
+!-----------------------------------------------------------------
+! #########################
+ MODULE MODI_ADVECTION_UVW
+! #########################
+!
+INTERFACE
+ SUBROUTINE ADVECTION_UVW (HUVW_ADV_SCHEME, &
+ HTEMP_SCHEME, KWENO_ORDER, KSPLIT_PPM, &
+ HLBCX, HLBCY, PTSTEP, &
+ PUT, PVT, PWT, &
+ PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
+ PRUS, PRVS, PRWS, &
+ PRUS_PRES, PRVS_PRES, PRWS_PRES )
+!
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! to the selected
+CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme
+!
+INTEGER, INTENT(IN) :: KWENO_ORDER ! Order of the WENO
+ ! scheme (3 or 5)
+INTEGER, INTENT(IN) :: KSPLIT_PPM ! Number of time splitting
+ ! for PPM advection
+!
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
+ ! Variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS, PRWS
+ ! Sources terms
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
+!
+END SUBROUTINE ADVECTION_UVW
+!
+END INTERFACE
+!
+END MODULE MODI_ADVECTION_UVW
+! ##########################################################################
+ SUBROUTINE ADVECTION_UVW (HUVW_ADV_SCHEME, &
+ HTEMP_SCHEME, KWENO_ORDER, KSPLIT_PPM, &
+ HLBCX, HLBCY, PTSTEP, &
+ PUT, PVT, PWT, &
+ PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
+ PRUS, PRVS, PRWS, &
+ PRUS_PRES, PRVS_PRES, PRWS_PRES )
+! ##########################################################################
+!
+!!**** *ADVECTION_UVW * - routine to call the specialized advection routines for wind
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book1 and book2 ( routine ADVECTION )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! J.-P. Lafore * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/07/94
+!! 01/04/95 (Ph. Hereil J. Nicolau) add the model number
+!! 23/10/95 (J. Vila and JP Lafore) advection schemes scalar
+!! 16/01/97 (JP Pinty) change presentation
+!! 30/04/98 (J. Stein P Jabouille) extrapolation for the cyclic
+!! case and parallelisation
+!! 24/06/99 (P Jabouille) case of NHALO>1
+!! 25/10/05 (JP Pinty) 4th order scheme
+!! 04/2011 (V. Masson & C. Lac) splits the routine and adds
+!! time splitting
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
+USE MODD_PARAMETERS, ONLY : JPVEXT
+USE MODD_CONF, ONLY : NHALO
+USE MODD_BUDGET
+!
+USE MODI_SHUMAN
+USE MODI_CONTRAV
+USE MODI_ADVECUVW_RK
+USE MODI_ADV_BOUNDARIES
+USE MODI_BUDGET
+!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! to the selected
+CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme
+!
+INTEGER, INTENT(IN) :: KWENO_ORDER ! Order of the WENO
+ ! scheme (3 or 5)
+INTEGER, INTENT(IN) :: KSPLIT_PPM ! Number of time splitting
+ ! for PPM advection
+!
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
+ ! Variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS, PRWS
+ ! Sources terms
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
+!
+!
+!* 0.2 declarations of local variables
+!
+!
+!
+INTEGER :: IKE ! indice K End in z direction
+!
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUT
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVT
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWT
+ ! cartesian
+ ! components of
+ ! momentum
+!
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCT
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCT
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCT
+ ! contravariant
+ ! components
+ ! of momentum
+!
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZU, ZV, ZW
+! Guesses at the end of the sub time step
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUS_OTHER
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVS_OTHER
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWS_OTHER
+! Contribution of the RK time step
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUS_ADV
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVS_ADV
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWS_ADV
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMXM_RHODJ
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMYM_RHODJ
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMZM_RHODJ
+!
+! Momentum tendencies due to advection
+INTEGER :: ISPLIT ! Number of splitting loops
+INTEGER :: JSPL ! Loop index
+REAL :: ZTSTEP ! Sub Time step
+INTEGER :: IIU, IJU, IKU ! array sizes
+!
+INTEGER :: IINFO_ll ! return code of parallel routine
+TYPE(LIST_ll), POINTER :: TZFIELD_ll ! list of fields to exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. INITIALIZATION
+! --------------
+!
+IKE = SIZE(PWT,3) - JPVEXT
+!
+IIU = SIZE(PWT,1)
+IJU = SIZE(PWT,2)
+IKU = SIZE(PWT,3)
+!
+!
+ZMXM_RHODJ = MXM(PRHODJ)
+ZMYM_RHODJ = MYM(PRHODJ)
+ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTES THE CONTRAVARIANT COMPONENTS
+! -------------------------------------
+!
+ZRUT = PUT(:,:,:) * ZMXM_RHODJ
+ZRVT = PVT(:,:,:) * ZMYM_RHODJ
+ZRWT = PWT(:,:,:) * ZMZM_RHODJ
+!
+NULLIFY(TZFIELD_ll)
+IF(NHALO == 1) THEN
+ CALL ADD3DFIELD_ll(TZFIELD_ll, ZRUT)
+ CALL ADD3DFIELD_ll(TZFIELD_ll, ZRVT)
+ CALL UPDATE_HALO_ll(TZFIELD_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELD_ll)
+END IF
+!
+CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,4)
+!
+NULLIFY(TZFIELDS_ll)
+IF(NHALO == 1) THEN
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRWCT)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRUCT)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRVCT)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. COMPUTES THE TENDENCIES SINCE THE BEGINNING OF THE TIME STEP
+! ------------------------------------------------------------
+!
+ZRUS_OTHER = PRUS - ZRUT / PTSTEP + PRUS_PRES
+ZRVS_OTHER = PRVS - ZRVT / PTSTEP + PRVS_PRES
+ZRWS_OTHER = PRWS - ZRWT / PTSTEP + PRWS_PRES
+!
+! Top and bottom Boundaries
+!
+CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRUS_OTHER)
+CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRVS_OTHER)
+CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRWS_OTHER)
+ZRWS_OTHER(:,:,IKE+1) = 0.
+
+NULLIFY(TZFIELDS0_ll)
+IF(NHALO == 1) THEN
+ CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRUS_OTHER)
+ CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRVS_OTHER)
+ CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRWS_OTHER)
+ CALL UPDATE_HALO_ll(TZFIELDS0_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS0_ll)
+END IF
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+ISPLIT = 2 * KSPLIT_PPM
+ZTSTEP = PTSTEP / REAL(ISPLIT)
+!
+!-------------------------------------------------------------------------------
+!
+ZU = PUT
+ZV = PVT
+ZW = PWT
+!
+!
+!* 3. TIME SPLITTING
+! --------------
+!
+DO JSPL=1,ISPLIT
+!
+ CALL ADVECUVW_RK (HUVW_ADV_SCHEME, &
+ HTEMP_SCHEME, KWENO_ORDER, &
+ HLBCX, HLBCY, ZTSTEP, &
+ ZU, ZV, ZW, &
+ PUT, PVT, PWT, &
+ ZMXM_RHODJ, ZMYM_RHODJ, ZMZM_RHODJ, &
+ ZRUCT, ZRVCT, ZRWCT, &
+ ZRUS_ADV, ZRVS_ADV, ZRWS_ADV, &
+ ZRUS_OTHER, ZRVS_OTHER, ZRWS_OTHER )
+!
+! Tendencies on wind
+
+ PRUS(:,:,:) = PRUS(:,:,:) + ZRUS_ADV(:,:,:) / ISPLIT
+ PRVS(:,:,:) = PRVS(:,:,:) + ZRVS_ADV(:,:,:) / ISPLIT
+ PRWS(:,:,:) = PRWS(:,:,:) + ZRWS_ADV(:,:,:) / ISPLIT
+
+!
+! Guesses for next time splitting loop
+!
+ ZU(:,:,:) = ZU(:,:,:) + ZTSTEP / ZMXM_RHODJ * &
+ (ZRUS_OTHER(:,:,:) + ZRUS_ADV(:,:,:))
+ ZV(:,:,:) = ZV(:,:,:) + ZTSTEP / ZMYM_RHODJ * &
+ (ZRVS_OTHER(:,:,:) + ZRVS_ADV(:,:,:))
+ ZW(:,:,:) = ZW(:,:,:) + ZTSTEP / ZMZM_RHODJ * &
+ (ZRWS_OTHER(:,:,:) + ZRWS_ADV(:,:,:))
+!
+! Top and bottom Boundaries
+!
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZU, PUT, 'U' )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZV, PVT, 'V' )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZW, PWT, 'W' )
+ ZW (:,:,IKE+1 ) = 0.
+!
+! End of the time splitting loop
+END DO
+!
+!
+!* 4. BUDGETS
+! -------
+!
+IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADV_BU_RU')
+IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADV_BU_RV')
+IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADV_BU_RW')
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADVECTION_UVW
diff --git a/src/MNH/advection_uvw_cen.f90 b/src/MNH/advection_uvw_cen.f90
new file mode 100644
index 000000000..cc12e5e7c
--- /dev/null
+++ b/src/MNH/advection_uvw_cen.f90
@@ -0,0 +1,251 @@
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_ADVECTION_UVW_CEN
+! #####################
+!
+INTERFACE
+ SUBROUTINE ADVECTION_UVW_CEN(HUVW_ADV_SCHEME, &
+ HLBCX, HLBCY, &
+ PTSTEP, KTCOUNT, &
+ PUM, PVM, PWM, &
+ PDUM, PDVM, PDWM, &
+ PUT, PVT, PWT, &
+ PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
+ PRUS,PRVS, PRWS, &
+ TPHALO2MLIST )
+!
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
+!
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+!
+REAL, INTENT(IN) :: PTSTEP! time step
+INTEGER, INTENT(IN) :: KTCOUNT
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM, PVM, PWM
+ ! Variables at t-dt
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDUM, PDVM, PDWM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT, PRHODJ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS , PRWS
+ ! Sources terms
+!
+! halo lists for 4th order advection
+TYPE(HALO2LIST_ll), POINTER :: TPHALO2MLIST ! momentum variables
+!
+END SUBROUTINE ADVECTION_UVW_CEN
+!
+END INTERFACE
+!
+END MODULE MODI_ADVECTION_UVW_CEN
+! ##########################################################################
+ SUBROUTINE ADVECTION_UVW_CEN(HUVW_ADV_SCHEME, &
+ HLBCX, HLBCY, &
+ PTSTEP, KTCOUNT, &
+ PUM, PVM, PWM, &
+ PDUM, PDVM, PDWM, &
+ PUT, PVT, PWT, &
+ PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
+ PRUS,PRVS, PRWS, &
+ TPHALO2MLIST )
+! ##########################################################################
+!
+!!**** *ADVECTION * - routine to call the specialized advection routines
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to control the advection routines.
+!! For that, it is first necessary to compute the metric coefficients
+!! and the contravariant components of the momentum.
+!!
+!!** METHOD
+!! ------
+!! The advection of momenta is calculated using a centred (second order)
+!! scheme.
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book1 and book2 ( routine ADVECTION )
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2013 (from ADVECTION routine)
+!
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
+USE MODD_CONF
+USE MODD_PARAMETERS
+USE MODD_GRID_n
+!
+USE MODI_SHUMAN
+USE MODI_CONTRAV
+USE MODI_ADVECUVW_2ND
+USE MODI_ADVECUVW_4TH
+!
+USE MODD_BUDGET
+USE MODI_BUDGET
+!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
+!
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+!
+REAL, INTENT(IN) :: PTSTEP! time step
+INTEGER, INTENT(IN) :: KTCOUNT
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM, PVM, PWM
+ ! Variables at t-dt
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDUM, PDVM, PDWM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT, PRHODJ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS , PRWS
+ ! Sources terms
+!
+! halo lists for 4th order advection
+TYPE(HALO2LIST_ll), POINTER :: TPHALO2MLIST ! momentum variables
+!
+!
+!* 0.2 declarations of local variables
+!
+!
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZUS
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZVS
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZWS
+ ! guess of cartesian components of
+ ! momentum at future (+PTSTEP) timestep
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUS
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVS
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWS
+ ! cartesian components of
+ ! rhodJ times the tendency of
+ ! momentum from previous (-PTSTEP)
+ ! to future (+PTSTEP) timestep
+!
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUT
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVT
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWT
+ ! cartesian
+ ! components of
+ ! momentum
+!
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCT
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCT
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCT
+ ! contravariant
+ ! components
+ ! of momentum
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMXM_RHODJ
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMYM_RHODJ
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMZM_RHODJ
+!
+INTEGER :: IINFO_ll ! return code of parallel routine
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+INTEGER :: IKU
+INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! index values for the physical subdomain
+
+!
+!-------------------------------------------------------------------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKU = SIZE(XZHAT)
+IKB=1+JPVEXT
+IKE=IKU-JPVEXT
+ZMXM_RHODJ = MXM(PRHODJ)
+ZMYM_RHODJ = MYM(PRHODJ)
+ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
+!
+!* 1. COMPUTES THE CONTRAVARIANT COMPONENTS
+! -------------------------------------
+!
+ZRUT = PUT(:,:,:) * ZMXM_RHODJ
+ZRVT = PVT(:,:,:) * ZMYM_RHODJ
+ZRWT = PWT(:,:,:) * ZMZM_RHODJ
+!
+IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
+ CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,2)
+ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
+ CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,4)
+END IF
+
+!
+NULLIFY(TZFIELDS_ll)
+IF(NHALO == 1) THEN
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRWCT)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRUCT)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRVCT)
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. TERM FROM PREVIOUS TIME-STEP (from initial_guess)
+! ----------------------------
+!
+ZRUS(:,:,:) = PUM(:,:,:) * ZMXM_RHODJ/(2.*PTSTEP)
+ZRVS(:,:,:) = PVM(:,:,:) * ZMYM_RHODJ/(2.*PTSTEP)
+ZRWS(:,:,:) = PWM(:,:,:) * ZMZM_RHODJ/(2.*PTSTEP)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. CALLS THE ADVECTION ROUTINES FOR THE MOMENTUM
+! ---------------------------------------------
+!
+! choose between 2nd and 4th order momentum advection.
+IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
+!
+ CALL ADVECUVW_2ND (PUT,PVT,PWT,ZRUCT,ZRVCT,ZRWCT,ZRUS,ZRVS,ZRWS)
+!
+ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
+!
+ CALL ADVECUVW_4TH ( HLBCX, HLBCY, ZRUCT, ZRVCT, ZRWCT, &
+ PUT, PVT, PWT, ZRUS, ZRVS, ZRWS, TPHALO2MLIST )
+!
+END IF
+!
+ZUS = ZRUS(:,:,:)/ZMXM_RHODJ*2.*PTSTEP
+ZVS = ZRVS(:,:,:)/ZMYM_RHODJ*2.*PTSTEP
+ZWS = ZRWS(:,:,:)/ZMZM_RHODJ*2.*PTSTEP
+!-------------------------------------------------------------------------------
+!
+!* 5. Extracts the variation between current and future time step
+! -----------------------------------------------------------
+!
+PRUS(:,:,:) = PRUS(:,:,:) + ( ZUS(:,:,:) - PUM(:,:,:) - 0.5* PDUM) * ZMXM_RHODJ/(PTSTEP)
+PRVS(:,:,:) = PRVS(:,:,:) + ( ZVS(:,:,:) - PVM(:,:,:) - 0.5* PDVM) * ZMYM_RHODJ/(PTSTEP)
+PRWS(:,:,:) = PRWS(:,:,:) + ( ZWS(:,:,:) - PWM(:,:,:) - 0.5* PDWM) * ZMZM_RHODJ/(PTSTEP)
+!
+PDUM = ZUS(:,:,:) - PUM(:,:,:)
+PDVM = ZVS(:,:,:) - PVM(:,:,:)
+PDWM = ZWS(:,:,:) - PWM(:,:,:)
+!
+IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADV_BU_RU')
+IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADV_BU_RV')
+IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADV_BU_RW')
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADVECTION_UVW_CEN
diff --git a/src/MNH/advecuvw_2nd.f90 b/src/MNH/advecuvw_2nd.f90
new file mode 100644
index 000000000..c684a076f
--- /dev/null
+++ b/src/MNH/advecuvw_2nd.f90
@@ -0,0 +1,157 @@
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 adiab 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_ADVECUVW_2ND
+! ####################
+!
+INTERFACE
+!
+ SUBROUTINE ADVECUVW_2ND ( 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_2ND
+!
+END INTERFACE
+!
+END MODULE MODI_ADVECUVW_2ND
+!
+!
+!
+! ###########################################################
+ SUBROUTINE ADVECUVW_2ND ( PUT, PVT, PWT, &
+ PRUCT, PRVCT, PRWCT, &
+ PRUS, PRVS, PRWS )
+! ###########################################################
+!
+!!**** *ADVECUVW_2ND * - 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.
+!!
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine ADVECUVW_2ND )
+!!
+!! 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
+!! 17/01/13 (V. Masson) remove the budget calls
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_GRID_n
+!
+USE MODI_SHUMAN
+!
+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
+!
+INTEGER :: IKU
+!
+!
+!-------------------------------------------------------------------------------
+!
+IKU=SIZE(XZHAT)
+!
+!* 1. COMPUTES THE ADVECTIVE TENDANCIES
+! ---------------------------------
+!
+PRUS(:,:,:) = PRUS(:,:,:) &
+ -DXM( MXF(PRUCT(:,:,:))*MXF(PUT(:,:,:)) )
+!
+PRUS(:,:,:) = PRUS(:,:,:) &
+ -DYF( MXM(PRVCT(:,:,:))*MYM(PUT(:,:,:)) )
+!
+PRUS(:,:,:) = PRUS(:,:,:) &
+ -DZF(1,IKU,1, MXM(PRWCT(:,:,:))*MZM(1,IKU,1,PUT(:,:,:)) )
+!
+!
+PRVS(:,:,:) = PRVS(:,:,:) &
+ -DXF( MYM(PRUCT(:,:,:))*MXM(PVT(:,:,:)) )
+!
+PRVS(:,:,:) = PRVS(:,:,:) &
+ -DYM( MYF(PRVCT(:,:,:))*MYF(PVT(:,:,:)) )
+!
+PRVS(:,:,:) = PRVS(:,:,:) &
+ -DZF(1,IKU,1, MYM(PRWCT(:,:,:))*MZM(1,IKU,1,PVT(:,:,:)) )
+!
+!
+PRWS(:,:,:) = PRWS(:,:,:) &
+ -DXF( MZM(1,IKU,1,PRUCT(:,:,:))*MXM(PWT(:,:,:)) )
+!
+PRWS(:,:,:) = PRWS(:,:,:) &
+ -DYF( MZM(1,IKU,1,PRVCT(:,:,:))*MYM(PWT(:,:,:)) )
+!
+PRWS(:,:,:) = PRWS(:,:,:) &
+ -DZM(1,IKU,1, MZF(1,IKU,1,PRWCT(:,:,:))*MZF(1,IKU,1,PWT(:,:,:)) )
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADVECUVW_2ND
diff --git a/src/MNH/advecuvw_4th.f90 b/src/MNH/advecuvw_4th.f90
index ff27817c9..bb65cb32c 100644
--- a/src/MNH/advecuvw_4th.f90
+++ b/src/MNH/advecuvw_4th.f90
@@ -85,48 +85,6 @@ END MODULE MODI_ADVECUVW_4TH
!! 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
-!! 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"
!!
@@ -152,11 +110,9 @@ 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
!
USE MODI_ADVEC_4TH_ORDER_AUX
!
@@ -214,15 +170,12 @@ ENDIF
!
PRUS(:,:,:) = PRUS(:,:,:) &
-DXM( MXF(PRUCT(:,:,:))*ZMEANX(:,:,:) )
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVX_BU_RU')
!
PRUS(:,:,:) = PRUS(:,:,:) &
-DYF( MXM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVY_BU_RU')
!
PRUS(:,:,:) = PRUS(:,:,:) &
-DZF(1,IKU,1, MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) )
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVZ_BU_RU')
!
!
IGRID = 3
@@ -236,15 +189,12 @@ ENDIF
!
PRVS(:,:,:) = PRVS(:,:,:) &
-DXF( MYM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVX_BU_RV')
!
PRVS(:,:,:) = PRVS(:,:,:) &
-DYM( MYF(PRVCT(:,:,:))*ZMEANY(:,:,:) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVY_BU_RV')
!
PRVS(:,:,:) = PRVS(:,:,:) &
-DZF(1,IKU,1, MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVZ_BU_RV')
!
!
IGRID = 4
@@ -259,15 +209,12 @@ ENDIF
!
PRWS(:,:,:) = PRWS(:,:,:) &
-DXF( MZM(1,IKU,1,PRUCT(:,:,:))*ZMEANX(:,:,:) )
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVX_BU_RW')
!
PRWS(:,:,:) = PRWS(:,:,:) &
-DYF( MZM(1,IKU,1,PRVCT(:,:,:))*ZMEANY(:,:,:) )
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVY_BU_RW')
!
PRWS(:,:,:) = PRWS(:,:,:) &
-DZM(1,IKU,1, MZF(1,IKU,1,PRWCT(:,:,:))*MZF4(PWT(:,:,:)) )
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVZ_BU_RW')
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/advecuvw_rk.f90 b/src/MNH/advecuvw_rk.f90
new file mode 100644
index 000000000..e5383668b
--- /dev/null
+++ b/src/MNH/advecuvw_rk.f90
@@ -0,0 +1,350 @@
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_ADVECUVW_RK
+! #####################
+!
+INTERFACE
+ SUBROUTINE ADVECUVW_RK (HUVW_ADV_SCHEME, &
+ HTEMP_SCHEME, KWENO_ORDER, &
+ HLBCX, HLBCY, PTSTEP, &
+ PU, PV, PW, &
+ PUT, PVT, PWT, &
+ PMXM_RHODJ, PMYM_RHODJ, PMZM_RHODJ, &
+ PRUCT, PRVCT, PRWCT, &
+ PRUS_ADV, PRVS_ADV, PRWS_ADV, &
+ PRUS_OTHER, PRVS_OTHER, PRWS_OTHER )
+!
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME! to the selected
+CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme
+!
+INTEGER, INTENT(IN) :: KWENO_ORDER ! Order of the WENO
+ ! scheme (3 or 5)
+!
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PU , PV , PW
+ ! Variables to advect
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT , PWT
+ ! Variables for boundary
+ ! conditions
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMXM_RHODJ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMYM_RHODJ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_RHODJ
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT , PRVCT, PRWCT
+ ! Contravariant wind components
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUS_ADV , PRVS_ADV, PRWS_ADV
+ ! Tendency due to advection
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_OTHER , PRVS_OTHER, PRWS_OTHER
+! ! tendencies from other processes
+!
+END SUBROUTINE ADVECUVW_RK
+!
+END INTERFACE
+!
+END MODULE MODI_ADVECUVW_RK
+! ##########################################################################
+ SUBROUTINE ADVECUVW_RK (HUVW_ADV_SCHEME, &
+ HTEMP_SCHEME, KWENO_ORDER, &
+ HLBCX, HLBCY, PTSTEP, &
+ PU, PV, PW, &
+ PUT, PVT, PWT, &
+ PMXM_RHODJ, PMYM_RHODJ, PMZM_RHODJ, &
+ PRUCT, PRVCT, PRWCT, &
+ PRUS_ADV, PRVS_ADV, PRWS_ADV, &
+ PRUS_OTHER, PRVS_OTHER, PRWS_OTHER )
+! ##########################################################################
+!
+!!**** *ADVECUVW_RK * - routine to call the specialized advection routines for wind
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book1 and book2 ( routine ADVECTION )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! J.-P. Lafore * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/07/94
+!! 01/04/95 (Ph. Hereil J. Nicolau) add the model number
+!! 23/10/95 (J. Vila and JP Lafore) advection schemes scalar
+!! 16/01/97 (JP Pinty) change presentation
+!! 30/04/98 (J. Stein P Jabouille) extrapolation for the cyclic
+!! case and parallelisation
+!! 24/06/99 (P Jabouille) case of NHALO>1
+!! 25/10/05 (JP Pinty) 4th order scheme
+!! 24/04/06 (C.Lac) Split scalar and passive
+!! tracer routines
+!! 08/06 (T.Maric) PPM scheme
+!! 04/2011 (V. Masson & C. Lac) splits the routine and adds
+!! time splitting
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
+USE MODD_PARAMETERS, ONLY : JPVEXT
+USE MODD_CONF, ONLY : NHALO
+!
+USE MODI_SHUMAN
+USE MODI_ADVECUVW_WENO_K
+USE MODI_ADV_BOUNDARIES
+USE MODI_GET_HALO
+!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME! to the selected
+CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme
+!
+INTEGER, INTENT(IN) :: KWENO_ORDER ! Order of the WENO
+ ! scheme (3 or 5)
+!
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PU , PV , PW
+ ! Variables to advect
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT , PWT
+ ! Variables for boundary
+ ! conditions
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMXM_RHODJ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMYM_RHODJ
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_RHODJ
+ ! metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT , PRVCT, PRWCT
+ ! Contravariant wind components
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUS_ADV , PRVS_ADV, PRWS_ADV
+ ! Tendency due to advection
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_OTHER , PRVS_OTHER, PRWS_OTHER
+! ! tendencies from other processes
+!
+!
+!
+!* 0.2 declarations of local variables
+!
+!
+!
+INTEGER :: IKE ! indice K End in z direction
+!
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZU, ZV, ZW
+! Guesses at the beginning of the RK loop
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZUT, ZVT, ZWT
+! Intermediate Guesses inside the RK loop
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRUS,ZRVS,ZRWS
+! Momentum tendencies due to advection
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZBUT ! Butcher array coefficients
+ ! at the RK sub time step
+REAL, DIMENSION(:), ALLOCATABLE :: ZBUTS! Butcher array coefficients
+ ! at the end of the RK loop
+
+!JUAN
+TYPE(LIST_ll), POINTER :: TZFIELDMT_ll ! list of fields to exchange
+TYPE(HALO2LIST_ll), POINTER :: TZHALO2MT_ll ! momentum variables
+INTEGER :: INBVAR
+INTEGER :: IIU, IJU, IKU ! array sizes
+!JUAN
+
+! Momentum tendencies due to advection
+INTEGER :: ISPL ! Number of RK splitting loops
+INTEGER :: JI, JS ! Loop index
+!
+INTEGER :: IINFO_ll ! return code of parallel routine
+TYPE(LIST_ll), POINTER :: TZFIELD_ll ! list of fields to exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS4_ll ! list of fields to exchange
+!
+!
+REAL :: XPRECISION
+!-------------------------------------------------------------------------------
+!
+!* 0. INITIALIZATION
+! --------------
+!
+IKE = SIZE(PWT,3) - JPVEXT
+IIU=SIZE(PUT,1)
+IJU=SIZE(PUT,2)
+IKU=SIZE(PUT,3)
+!
+SELECT CASE (HTEMP_SCHEME)
+ CASE('RK11')
+ ISPL = 1
+ CASE('RK21')
+ ISPL = 2
+ CASE('RK33')
+ ISPL = 3
+ CASE('RK53')
+ ISPL = 5
+END SELECT
+!
+!
+ALLOCATE(ZBUT(ISPL-1,ISPL-1))
+ALLOCATE(ZBUTS(ISPL))
+!
+IF (ISPL == 1 ) ZBUTS = (/ 1. /)
+IF (ISPL == 2 ) THEN
+ ZBUTS = (/ 0. , 1. /)
+ ZBUT(1,1) = 3./4.
+END IF
+IF (ISPL == 3 ) THEN
+ ZBUTS = (/ 1./6. , 1./6. , 2./3. /)
+ ZBUT(1,1) = 1.
+ ZBUT(1,2) = 0.
+ ZBUT(2,:) = 1./4.
+END IF
+IF (ISPL == 5 ) THEN
+ ZBUTS = (/ 1./4. , 0., 0., 0., 3./4. /)
+ ZBUT = 0.
+ ZBUT(1,1) = 1./7.
+ ZBUT(2,2) = 3./16.
+ ZBUT(3,3) = 1./3.
+ ZBUT(4,4) = 2./3.
+END IF
+!
+ALLOCATE(ZRUS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
+ALLOCATE(ZRVS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
+ALLOCATE(ZRWS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
+!
+PRUS_ADV = 0.
+PRVS_ADV = 0.
+PRWS_ADV = 0.
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Wind guess before RK loop
+! -------------------------
+!
+ZUT = PU
+ZVT = PV
+ZWT = PW
+!
+CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZUT, PUT, 'U' )
+CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZVT, PVT, 'V' )
+CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZWT, PWT, 'W' )
+ZWT (:,:,IKE+1 ) = 0.
+
+ZU = PU
+ZV = PV
+ZW = PW
+!
+NULLIFY(TZFIELDMT_ll)
+IF( NHALO==1 ) THEN
+!
+ CALL ADD3DFIELD_ll(TZFIELDMT_ll, ZUT)
+ CALL ADD3DFIELD_ll(TZFIELDMT_ll, ZVT)
+ CALL ADD3DFIELD_ll(TZFIELDMT_ll, ZWT)
+!
+ INBVAR = 3
+ IF( NHALO==1 ) CALL INIT_HALO2_ll(TZHALO2MT_ll,INBVAR,SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3))
+!
+ END IF
+!
+ZRUS = 0.
+ZRVS = 0.
+ZRWS = 0.
+!-------------------------------------------------------------------------------
+!
+!* 3. BEGINNING of Runge-Kutta loop
+! -----------------------------
+!
+ DO JS = 1, ISPL
+!
+!
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZUT, PUT, 'U' )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZVT, PVT, 'V' )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZWT, PWT, 'W' )
+ ZW (:,:,IKE+1 ) = 0.
+ !JUAN
+ IF ( NHALO == 1 ) THEN
+ CALL UPDATE_HALO_ll(TZFIELDMT_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELDMT_ll, TZHALO2MT_ll, IINFO_ll)
+ ENDIF
+ !JUAN
+!
+!* 4. Advection with WENO
+! -------------------
+!
+ CALL ADVECUVW_WENO_K (HLBCX, HLBCY, KWENO_ORDER, ZUT, ZVT, ZWT, &
+ PRUCT, PRVCT, PRWCT, &
+ ZRUS(:,:,:,JS), ZRVS(:,:,:,JS), ZRWS(:,:,:,JS), &
+ TZHALO2MT_ll )
+!
+!
+! ==> verifier si c'est utile !
+!
+ NULLIFY(TZFIELDS4_ll)
+ IF(NHALO == 1) THEN
+ CALL ADD3DFIELD_ll(TZFIELDS4_ll, ZRUS(:,:,:,JS))
+ CALL ADD3DFIELD_ll(TZFIELDS4_ll, ZRVS(:,:,:,JS))
+ CALL ADD3DFIELD_ll(TZFIELDS4_ll, ZRWS(:,:,:,JS))
+ CALL UPDATE_HALO_ll(TZFIELDS4_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS4_ll)
+ END IF
+
+ IF ( JS /= ISPL ) THEN
+!
+
+ DO JI = 1, JS
+
+!
+! Intermediate guesses inside the RK loop
+!
+ ZUT(:,:,:) = ZU(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
+ ( ZRUS(:,:,:,JI) + PRUS_OTHER(:,:,:) ) / PMXM_RHODJ
+ ZVT(:,:,:) = ZV(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
+ ( ZRVS(:,:,:,JI) + PRVS_OTHER(:,:,:) ) / PMYM_RHODJ
+ ZWT(:,:,:) = ZW(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
+ ( ZRWS(:,:,:,JI) + PRWS_OTHER(:,:,:) ) / PMZM_RHODJ
+!
+ END DO
+!
+ ELSE
+!
+! Guesses at the end of the RK loop
+!
+ DO JI = 1, ISPL
+ PRUS_ADV(:,:,:) = PRUS_ADV(:,:,:) + ZBUTS(JI) * ZRUS(:,:,:,JI)
+ PRVS_ADV(:,:,:) = PRVS_ADV(:,:,:) + ZBUTS(JI) * ZRVS(:,:,:,JI)
+ PRWS_ADV(:,:,:) = PRWS_ADV(:,:,:) + ZBUTS(JI) * ZRWS(:,:,:,JI)
+ END DO
+!
+ END IF
+!
+! End of the RK loop
+ END DO
+
+!
+!
+DEALLOCATE(ZBUT, ZBUTS, ZRUS, ZRVS, ZRWS)
+CALL CLEANLIST_ll(TZFIELDMT_ll)
+CALL DEL_HALO2_ll(TZHALO2MT_ll)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADVECUVW_RK
diff --git a/src/MNH/advecuvw_weno_k.f90 b/src/MNH/advecuvw_weno_k.f90
new file mode 100644
index 000000000..3912fc72e
--- /dev/null
+++ b/src/MNH/advecuvw_weno_k.f90
@@ -0,0 +1,271 @@
+! ###########################
+ MODULE MODI_ADVECUVW_WENO_K
+! ###########################
+!
+INTERFACE
+!
+ SUBROUTINE ADVECUVW_WENO_K(HLBCX, HLBCY, KWENO_ORDER, PUT, PVT, PWT, &
+ PRUCT, PRVCT, PRWCT, PRUS, PRVS, PRWS, 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) :: KWENO_ORDER ! Order of the WENO
+ ! scheme (3 or 5)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! U,V,W at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
+!
+TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
+!
+END SUBROUTINE ADVECUVW_WENO_K
+!
+END INTERFACE
+!
+END MODULE MODI_ADVECUVW_WENO_K
+!
+! ##########################################################################
+ SUBROUTINE ADVECUVW_WENO_K(HLBCX, HLBCY, KWENO_ORDER, PUT, PVT, PWT, &
+ PRUCT, PRVCT, PRWCT, PRUS, PRVS, PRWS, TPHALO2LIST)
+! ##########################################################################
+!
+!! AUTHOR
+!! ------
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_ll
+!
+USE MODD_PARAMETERS
+USE MODD_CONF
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+!
+USE MODI_SHUMAN
+USE MODI_ADVEC_WENO_K_1_AUX
+USE MODI_ADVEC_WENO_K_2_AUX
+USE MODI_ADVEC_WENO_K_3_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) :: KWENO_ORDER ! Order of the WENO
+ ! scheme (3 or 5)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Variables at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
+!
+TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
+!
+!* 0.2 Declarations of local variables :
+!
+TYPE(HALO2LIST_ll), POINTER :: TZHALO2_UT,TZHALO2_VT,TZHALO2_WT
+!
+REAL, DIMENSION(SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3)) :: ZMEAN, ZWORK
+!
+INTEGER :: K_SCHEME
+INTEGER :: IKU
+!
+!------------------------- ADVECTION OF MOMENTUM ------------------------------
+!
+!
+TZHALO2_UT => TPHALO2LIST ! 1rst add3dfield in model_n
+TZHALO2_VT => TPHALO2LIST%NEXT ! 2nd add3dfield in model_n
+TZHALO2_WT => TPHALO2LIST%NEXT%NEXT ! 3rst add3dfield in model_n
+!
+IKU=SIZE(PUT,3)
+! -------------------------------------------------------
+!
+SELECT CASE(KWENO_ORDER)
+!
+CASE(1)
+!
+! U component
+!
+ PRUS = PRUS - DXM(UP_UX(PUT,MXF(PRUCT)))
+!
+ PRUS = PRUS - DYF(UP_MY(PUT,MXM(PRVCT)))
+!
+ PRUS = PRUS - DZF(1,IKU,1,UP_MZ(PUT,MXM(PRWCT)))
+!
+! V component
+!
+ PRVS = PRVS - DXF(UP_MX(PVT,MYM(PRUCT)))
+!
+ PRVS = PRVS - DYM(UP_VY(PVT,MYF(PRVCT)))
+!
+ PRVS = PRVS - DZF(1,IKU,1,UP_MZ(PVT,MYM(PRWCT)))
+!
+! W component
+!
+ PRWS = PRWS - DXF(UP_MX(PWT,MZM(1,IKU,1,PRUCT)))
+!
+ PRWS = PRWS - DYF(UP_MY(PWT,MZM(1,IKU,1,PRVCT)))
+!
+ PRWS = PRWS - DZM(1,IKU,1,UP_WZ(PWT,MZF(1,IKU,1,PRWCT)))
+!
+!
+CASE(3)
+!
+! U component
+!
+ ZWORK = MXF(PRUCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_2_UX(HLBCX, PUT, ZWORK, ZMEAN, TZHALO2_UT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_2_UX(HLBCX, PUT, ZWORK, ZMEAN)
+ ENDIF
+ PRUS = PRUS - DXM(ZMEAN)
+
+!
+ IF (.NOT.L2D) THEN
+ ZWORK = MXM(PRVCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_2_MY(HLBCY, PUT, ZWORK, ZMEAN, TZHALO2_UT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_2_MY(HLBCY, PUT, ZWORK, ZMEAN)
+ ENDIF
+ PRUS = PRUS - DYF(ZMEAN)
+ END IF
+!
+ PRUS = PRUS - DZF(1,IKU,1,WENO_K_2_MZ(PUT, MXM(PRWCT)))
+!
+! V component
+!
+ IF (.NOT.L2D) THEN
+ ZWORK = MYM(PRUCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_2_MX(HLBCX, PVT, ZWORK, ZMEAN, TZHALO2_VT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_2_MX(HLBCX, PVT, ZWORK, ZMEAN)
+ ENDIF
+ PRVS = PRVS - DXF(ZMEAN)
+!
+ ZWORK = MYF(PRVCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_2_VY(HLBCY, PVT, ZWORK, ZMEAN, TZHALO2_VT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_2_VY(HLBCY, PVT, ZWORK, ZMEAN)
+ ENDIF
+ PRVS = PRVS - DYM(ZMEAN)
+!
+ PRVS = PRVS - DZF(1,IKU,1,WENO_K_2_MZ(PVT, MYM(PRWCT)))
+ END IF
+!
+! W component
+!
+ ZWORK = MZM(1,IKU,1,PRUCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_2_MX(HLBCX, PWT, ZWORK, ZMEAN, TZHALO2_WT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_2_MX(HLBCX, PWT, ZWORK, ZMEAN)
+ ENDIF
+ PRWS = PRWS - DXF(ZMEAN)
+!
+ IF (.NOT.L2D) THEN
+ ZWORK = MZM(1,IKU,1,PRVCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_2_MY(HLBCY, PWT, ZWORK, ZMEAN, TZHALO2_WT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_2_MY(HLBCY, PWT, ZWORK, ZMEAN)
+ ENDIF
+ PRWS = PRWS - DYF(ZMEAN)
+ END IF
+!
+ PRWS = PRWS - DZM(1,IKU,1,WENO_K_2_WZ(PWT,MZF(1,IKU,1,PRWCT)))
+!
+!
+CASE(5)
+!
+! U component
+!
+ ZWORK = MXF(PRUCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_3_UX(HLBCX, PUT, ZWORK, ZMEAN, TZHALO2_UT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_3_UX(HLBCX, PUT, ZWORK, ZMEAN)
+ ENDIF
+ PRUS = PRUS - DXM(ZMEAN)
+!
+ IF (.NOT.L2D) THEN
+ ZWORK = MXM(PRVCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_3_MY(HLBCY, PUT, ZWORK, ZMEAN, TZHALO2_UT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_3_MY(HLBCY, PUT, ZWORK, ZMEAN)
+ ENDIF
+ PRUS = PRUS - DYM(ZMEAN)
+ END IF
+!
+ PRUS = PRUS - DZF(1,IKU,1,WENO_K_3_MZ(PUT, MXM(PRWCT)))
+!
+! V component
+!
+ IF (.NOT.L2D) THEN
+ ZWORK = MYM(PRUCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_3_MX(HLBCX, PVT, ZWORK, ZMEAN, TZHALO2_VT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_3_MX(HLBCX, PVT, ZWORK, ZMEAN)
+ ENDIF
+ PRVS = PRVS - DXF(ZMEAN)
+!
+ ZWORK = MYF(PRVCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_3_VY(HLBCY, PVT, ZWORK, ZMEAN, TZHALO2_VT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_3_VY(HLBCY, PVT, ZWORK, ZMEAN)
+ ENDIF
+ PRVS = PRVS - DYM(ZMEAN)
+!
+ PRVS = PRVS - DZF(1,IKU,1,WENO_K_3_MZ(PVT, MYM(PRWCT)))
+ END IF
+!
+! W component
+!
+ ZWORK = MZM(1,IKU,1,PRUCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_3_MX(HLBCX, PWT, ZWORK, ZMEAN, TZHALO2_WT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_3_MX(HLBCX, PWT, ZWORK, ZMEAN)
+ ENDIF
+ PRWS = PRWS - DXF(ZMEAN)
+!
+ IF (.NOT.L2D) THEN
+ ZWORK = MZM(1,IKU,1,PRVCT)
+ IF(NHALO == 1) THEN
+ CALL ADVEC_WENO_K_3_MY(HLBCY, PWT, ZWORK, ZMEAN, TZHALO2_WT%HALO2)
+ ELSE
+ CALL ADVEC_WENO_K_3_MY(HLBCY, PWT, ZWORK, ZMEAN)
+ ENDIF
+ PRWS = PRWS - DYF(ZMEAN)
+ END IF
+!
+ PRWS = PRWS - DZM(1,IKU,1,WENO_K_3_WZ(PWT,MZF(1,IKU,1,PRWCT)))
+!
+!
+END SELECT
+! ---------------------------------
+!
+END SUBROUTINE ADVECUVW_WENO_K
+
diff --git a/src/MNH/anel_balancen.f90 b/src/MNH/anel_balancen.f90
index 31619b8ee..ca072a194 100644
--- a/src/MNH/anel_balancen.f90
+++ b/src/MNH/anel_balancen.f90
@@ -10,13 +10,9 @@
!
INTERFACE
!
-SUBROUTINE ANEL_BALANCE_n(OINST,PRESIDUAL)
+SUBROUTINE ANEL_BALANCE_n(PRESIDUAL)
!
-CHARACTER (LEN=1), INTENT(IN) :: OINST ! selected instant to enforce the
- ! anelastic constraint
-!JUAN
REAL, OPTIONAL :: PRESIDUAL
-!JUAN
END SUBROUTINE ANEL_BALANCE_n
!
END INTERFACE
@@ -26,7 +22,8 @@ END MODULE MODI_ANEL_BALANCE_n
!
!
! ################################
- SUBROUTINE ANEL_BALANCE_n(OINST,PRESIDUAL)
+ SUBROUTINE ANEL_BALANCE_n(PRESIDUAL)
+!
! ################################
!
!
@@ -128,26 +125,17 @@ USE MODD_DYN_n
USE MODD_LBC_n
USE MODD_LUNIT_n
!
-! interface modules
-!JUANZ
-!USE MODI_TRID
-USE MODI_TRIDZ
-!USE MODI_PRESSURE
+USE MODI_TRIDZ ! interface modules
USE MODI_PRESSUREZ
USE MODE_SPLITTINGZ_ll
-!JUANZ
USE MODI_SHUMAN
!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments :
!
-!
-CHARACTER (LEN=1), INTENT(IN) :: OINST ! selected instant to enforce the
- ! anelastic constraint
-!JUAN
REAL, OPTIONAL :: PRESIDUAL
-!JUAN
+!
!
!* 0.2 Declarations of local variables :
!
@@ -170,8 +158,8 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZTRIGSY ! the FFT in x and y directions
INTEGER, DIMENSION(19) :: IIFAXX ! decomposition in prime numbers
INTEGER, DIMENSION(19) :: IIFAXY ! for the FFT in x and y
! directions
-REAL, DIMENSION(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3)) :: ZPABSM,ZPABST
- ! Potential at time t-dt and t
+REAL, DIMENSION(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3)) :: ZPABST
+ ! Potential at time t
REAL, DIMENSION(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3)) :: ZRU,ZRV,ZRW
! Rhod * (U,V,W)
REAL, DIMENSION(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3)) :: ZTH
@@ -236,26 +224,12 @@ CALL TRIDZ(CLUOUT0,CLBCX,CLBCY,XMAP,XDXHAT,XDYHAT,ZDXHATM,ZDYHATM,ZRHOM, &
!
!* 3.1 multiplication by RHODJ
!
-IF (OINST == 'T') THEN
- ZRU(:,:,:) = MXM(XRHODJ) * XUT(:,:,:)
- ZRV(:,:,:) = MYM(XRHODJ) * XVT(:,:,:)
- ZRW(:,:,:) = MZM(1,IKU,1,XRHODJ) * XWT(:,:,:)
- ZTH(:,:,:) = XTHT(:,:,:)
- ALLOCATE(ZRR(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),SIZE(XRT,4)))
- ZRR(:,:,:,:) = XRT(:,:,:,:)
-ELSEIF (OINST == 'M') THEN
- ZRU(:,:,:) = MXM(XRHODJ) * XUM(:,:,:)
- ZRV(:,:,:) = MYM(XRHODJ) * XVM(:,:,:)
- ZRW(:,:,:) = MZM(1,IKU,1,XRHODJ) * XWM(:,:,:)
- ZTH(:,:,:) = XTHM(:,:,:)
- ALLOCATE(ZRR(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),SIZE(XRM,4)))
- ZRR(:,:,:,:) = XRM(:,:,:,:)
-ELSE
-!callabortstop
- CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
- CALL ABORT
- STOP
-END IF
+ZRU(:,:,:) = MXM(XRHODJ) * XUT(:,:,:)
+ZRV(:,:,:) = MYM(XRHODJ) * XVT(:,:,:)
+ZRW(:,:,:) = MZM(1,IKU,1,XRHODJ) * XWT(:,:,:)
+ZTH(:,:,:) = XTHT(:,:,:)
+ALLOCATE(ZRR(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),SIZE(XRT,4)))
+ZRR(:,:,:,:) = XRT(:,:,:,:)
!
!
!
@@ -263,7 +237,7 @@ END IF
!* 3.2 satisfy the anelastic constraint
!
ITCOUNT =-1 ! no first guess of the pressure is available
-ZPABSM(:,:,:)= 0. ! ==================CAUTION=====================
+ZPABST(:,:,:)= 0. ! ==================CAUTION=====================
ZDRYMASST = 0. ! | Initialization necessary for the |
ZREFMASS = 0. ! | computation of the absolute pressure, |
ZMASS_O_PHI0 = 1. ! | which is here not needed |
@@ -274,29 +248,21 @@ GCLOSE_OUT=.FALSE.
YFMFILE='UNUSED'
!
IMI = GET_CURRENT_MODEL_INDEX()
-CALL PRESSUREZ(CLUOUT, &
+CALL PRESSUREZ(CLUOUT, &
CLBCX,CLBCY,CPRESOPT,NITR,LITRADJ,ITCOUNT,XRELAX,IMI, &
XRHODJ,XDXX,XDYY,XDZZ,XDZX,XDZY,ZDXHATM,ZDYHATM,ZRHOM, &
- ZAF,ZBFY,ZCF,ZTRIGSX,ZTRIGSY,IIFAXX,IIFAXY,ZPABSM, &
+ ZAF,ZBFY,ZCF,ZTRIGSX,ZTRIGSY,IIFAXX,IIFAXY, &
IRR,IRRL,IRRI,ZDRYMASST,ZREFMASS,ZMASS_O_PHI0, &
ZTH,ZRR,XRHODREF,XTHVREF,XRVREF,XEXNREF, XLINMASS, &
ZRU,ZRV,ZRW,ZPABST, &
- ZBFB, &
- ZBF_SXP2_YP1_Z, &
- PRESIDUAL )
+ ZBFB,ZBF_SXP2_YP1_Z,PRESIDUAL )
!
DEALLOCATE(ZBFY,ZTRIGSX,ZTRIGSY,ZRR,ZBF_SXP2_YP1_Z)
!* 3.2 return to the historical variables
!
-IF (OINST == 'T') THEN
- XUT(:,:,:) = ZRU(:,:,:) / MXM(XRHODJ)
- XVT(:,:,:) = ZRV(:,:,:) / MYM(XRHODJ)
- XWT(:,:,:) = ZRW(:,:,:) / MZM(1,IKU,1,XRHODJ)
-ELSEIF (OINST == 'M') THEN
- XUM(:,:,:) = ZRU(:,:,:) / MXM(XRHODJ)
- XVM(:,:,:) = ZRV(:,:,:) / MYM(XRHODJ)
- XWM(:,:,:) = ZRW(:,:,:) / MZM(1,IKU,1,XRHODJ)
-END IF
+XUT(:,:,:) = ZRU(:,:,:) / MXM(XRHODJ)
+XVT(:,:,:) = ZRV(:,:,:) / MYM(XRHODJ)
+XWT(:,:,:) = ZRW(:,:,:) / MZM(1,IKU,1,XRHODJ)
!
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/boundaries.f90 b/src/MNH/boundaries.f90
index 58d6bd7bd..5800cbc77 100644
--- a/src/MNH/boundaries.f90
+++ b/src/MNH/boundaries.f90
@@ -16,8 +16,7 @@ INTERFACE
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
PRHODJ, &
- PUM,PVM,PWM,PTHM,PTKEM,PRM,PSVM,PSRCM, &
- PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT )
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
!
REAL, INTENT(IN) :: PTSTEP ! time step dt
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
@@ -49,10 +48,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-di
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
! the reference state
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM,PTHM,PTKEM,PSRCM
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRM,PSVM
- ! Variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
! Variables at t
!
@@ -72,8 +68,7 @@ END MODULE MODI_BOUNDARIES
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
PRHODJ, &
- PUM,PVM,PWM,PTHM,PTKEM,PRM,PSVM,PSRCM, &
- PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT )
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
! ####################################################################
!
!!**** *BOUNDARIES* - routine to prepare the Lateral Boundary Conditions for
@@ -166,6 +161,7 @@ END MODULE MODI_BOUNDARIES
!! Modification 05/06 Remove EPS
!! Modification 12/2010 (Chong) Add boundary condition for ions
!! (fair weather profiles)
+!! Modification 04/2013 (C.Lac) Remove instant M
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -175,15 +171,15 @@ USE MODD_CTURB
USE MODD_CONF
USE MODD_NSV
USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHIC
-USE MODD_CH_AEROSOL ,ONLY : LORILAM
+USE MODD_CH_AEROSOL , ONLY : LORILAM
USE MODD_DUST
-USE MODD_SALT, ONLY : LSALT
-USE MODD_PASPOL, ONLY : LPASPOL
-USE MODD_CONDSAMP, ONLY : LCONDSAMP
+USE MODD_SALT, ONLY : LSALT
+USE MODD_PASPOL, ONLY : LPASPOL
+USE MODD_CONDSAMP, ONLY : LCONDSAMP
USE MODD_ELEC_DESCR
USE MODD_ELEC_n
USE MODD_REF_n
-USE MODD_PARAM_n, ONLY : CELEC
+USE MODD_PARAM_n, ONLY : CELEC
!
USE MODE_MODELN_HANDLER
!
@@ -231,10 +227,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-di
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
! the reference state
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM,PTHM,PTKEM,PSRCM
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRM,PSVM
- ! Variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
! Variables at t
!
@@ -289,7 +282,7 @@ LOGICAL :: GCSTMP
! ----------------------------------------------
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB = 1 + JPVEXT
-IKE = SIZE(PUM,3) - JPVEXT
+IKE = SIZE(PUT,3) - JPVEXT
IMI = GET_CURRENT_MODEL_INDEX()
!
!-------------------------------------------------------------------------------
@@ -310,17 +303,7 @@ IF(SIZE(PTHT) /= 0) PTHT (:,:,IKB-1) = PTHT (:,:,IKB)
IF(SIZE(PTKET) /= 0) PTKET(:,:,IKB-1) = PTKET(:,:,IKB)
IF(SIZE(PRT) /= 0) PRT (:,:,IKB-1,:)= PRT (:,:,IKB,:)
IF(SIZE(PSVT)/= 0) PSVT (:,:,IKB-1,:)= PSVT (:,:,IKB,:)
-!
-! at the instant t-dt
-!
-PUM (:,:,IKB-1) = PUM (:,:,IKB)
-PVM (:,:,IKB-1) = PVM (:,:,IKB)
-PWM (:,:,IKB-1) = PWM (:,:,IKB)
-PTHM (:,:,IKB-1) = PTHM (:,:,IKB)
-IF(SIZE(PTKEM) /= 0) PTKEM(:,:,IKB-1) = PTKEM(:,:,IKB)
-IF (KRR>0) PRM (:,:,IKB-1,:) = PRM (:,:,IKB,:)
-IF (KSV>0) PSVM (:,:,IKB-1,:) = PSVM (:,:,IKB,:)
-IF(SIZE(PSRCM) /= 0) PSRCM(:,:,IKB-1) = PSRCM(:,:,IKB)
+IF(SIZE(PSRCT) /= 0) PSRCT(:,:,IKB-1) = PSRCT(:,:,IKB)
!
!
!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
@@ -334,25 +317,14 @@ IF(SIZE(PTHT) /= 0) PTHT (:,:,IKE+1) = PTHT (:,:,IKE)
IF(SIZE(PTKET) /= 0) PTKET(:,:,IKE+1) = PTKET(:,:,IKE)
IF(SIZE(PRT) /= 0) PRT (:,:,IKE+1,:) = PRT (:,:,IKE,:)
IF(SIZE(PSVT)/= 0) PSVT (:,:,IKE+1,:) = PSVT (:,:,IKE,:)
-!
-! at the instant t-dt
-!
-PWM (:,:,IKE+1) = 0.
-PUM (:,:,IKE+1) = PUM (:,:,IKE)
-PVM (:,:,IKE+1) = PVM (:,:,IKE)
-PTHM (:,:,IKE+1) = PTHM (:,:,IKE)
-IF(SIZE(PTKEM) /= 0) PTKEM(:,:,IKE+1) = PTKEM(:,:,IKE)
-IF (KRR>0) PRM (:,:,IKE+1,:) = PRM (:,:,IKE,:)
-IF (KSV>0) PSVM (:,:,IKE+1,:) = PSVM (:,:,IKE,:)
-IF(SIZE(PSRCM) /= 0) PSRCM(:,:,IKE+1) = PSRCM(:,:,IKE)
+IF(SIZE(PSRCT) /= 0) PSRCT(:,:,IKE+1) = PSRCT(:,:,IKE)
! specific for positive and negative ions mixing ratios (1/kg)
-! valid for PPM advection scheme
IF (NSV_ELEC .NE. 0) THEN
-
+!
IF (SIZE(PWT) /= 0) THEN
- WHERE ( (1.5*PWT(:,:,IKE+1) - 0.5*PWM(:,:,IKE+1)) .GE. 0.) ! Outflow
+ WHERE ( PWT(:,:,IKE+1) .GE. 0.) ! Outflow
PSVT (:,:,IKE+1,NSV_ELECBEG) = 2.*PSVT (:,:,IKE,NSV_ELECBEG) - &
PSVT (:,:,IKE-1,NSV_ELECBEG)
PSVT (:,:,IKE+1,NSV_ELECEND) = 2.*PSVT (:,:,IKE,NSV_ELECEND) - &
@@ -362,8 +334,9 @@ IF (NSV_ELEC .NE. 0) THEN
PSVT (:,:,IKE+1,NSV_ELECEND) = XCION_NEG_FW(:,:,IKE+1)
END WHERE
ENDIF
-
+!
END IF
+
!
!
!-------------------------------------------------------------------------------
@@ -372,7 +345,7 @@ END IF
! ---------------------------
!
!
-IF ( CCONF == 'START' .AND. KTCOUNT == 1) THEN
+IF ( KTCOUNT == 1) THEN
ZTSTEP = 0.
ELSE
ZTSTEP = PTSTEP
@@ -384,7 +357,7 @@ IF ( SIZE(PLBXTHS,1) /= 0 .AND. &
ZLBXVT(:,:,:) = PLBXVM(:,:,:) + ZTSTEP * PLBXVS(:,:,:)
ZLBXWT(:,:,:) = PLBXWM(:,:,:) + ZTSTEP * PLBXWS(:,:,:)
ZLBXTHT(:,:,:) = PLBXTHM(:,:,:) + ZTSTEP * PLBXTHS(:,:,:)
- IF ( SIZE(PTKEM,1) /= 0 ) THEN
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
ZLBXTKET(:,:,:) = PLBXTKEM(:,:,:) + ZTSTEP * PLBXTKES(:,:,:)
END IF
IF ( KRR > 0) THEN
@@ -399,7 +372,7 @@ ELSE
ZLBXVT(:,:,:) = PLBXVM(:,:,:)
ZLBXWT(:,:,:) = PLBXWM(:,:,:)
ZLBXTHT(:,:,:) = PLBXTHM(:,:,:)
- IF ( SIZE(PTKEM,1) /= 0 ) THEN
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
ZLBXTKET(:,:,:) = PLBXTKEM(:,:,:)
END IF
IF ( KRR > 0) THEN
@@ -416,7 +389,7 @@ IF ( SIZE(PLBYTHS,1) /= 0 .AND. &
ZLBYUT(:,:,:) = PLBYUM(:,:,:) + ZTSTEP * PLBYUS(:,:,:)
ZLBYWT(:,:,:) = PLBYWM(:,:,:) + ZTSTEP * PLBYWS(:,:,:)
ZLBYTHT(:,:,:) = PLBYTHM(:,:,:) + ZTSTEP * PLBYTHS(:,:,:)
- IF ( SIZE(PTKEM,1) /= 0 ) THEN
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
ZLBYTKET(:,:,:) = PLBYTKEM(:,:,:) + ZTSTEP * PLBYTKES(:,:,:)
END IF
IF ( KRR > 0) THEN
@@ -431,7 +404,7 @@ ELSE
ZLBYUT(:,:,:) = PLBYUM(:,:,:)
ZLBYWT(:,:,:) = PLBYWM(:,:,:)
ZLBYTHT(:,:,:) = PLBYTHM(:,:,:)
- IF ( SIZE(PTKEM,1) /= 0 ) THEN
+ IF ( SIZE(PTKET,1) /= 0 ) THEN
ZLBYTKET(:,:,:) = PLBYTKEM(:,:,:)
END IF
IF ( KRR > 0) THEN
@@ -466,20 +439,11 @@ SELECT CASE ( HLBCX(1) )
IF(SIZE(PTKET)/= 0) PTKET(IIB-JEXT,:,:) = PTKET(IIB-1+JEXT,:,:)
IF(SIZE(PRT) /= 0) PRT (IIB-JEXT,:,:,:) = PRT (IIB-1+JEXT,:,:,:)
IF(SIZE(PSVT) /= 0) PSVT(IIB-JEXT,:,:,:) = PSVT (IIB-1+JEXT,:,:,:)
-!
- PUM (IIB-JEXT,:,:) = PUM (IIB ,:,:) ! never used during run
- PVM (IIB-JEXT,:,:) = PVM (IIB-1+JEXT,:,:)
- PWM (IIB-JEXT,:,:) = PWM (IIB-1+JEXT,:,:)
- PTHM (IIB-JEXT,:,:) = PTHM (IIB-1+JEXT,:,:)
- IF(SIZE(PTKEM) /= 0) PTKEM(IIB-JEXT,:,:) = PTKEM(IIB-1+JEXT,:,:)
- PRM (IIB-JEXT,:,:,:) = PRM (IIB-1+JEXT,:,:,:)
- PSVM (IIB-JEXT,:,:,:) = PSVM (IIB-1+JEXT,:,:,:)
- IF(SIZE(PSRCM) /= 0) PSRCM (IIB-JEXT,:,:) = PSRCM (IIB-1+JEXT,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT (IIB-JEXT,:,:) = PSRCT (IIB-1+JEXT,:,:)
!
END DO
!
IF(SIZE(PUT) /= 0) PUT(IIB ,:,:) = 0. ! set the normal velocity
- PUM (IIB ,:,:) = 0. ! to zero
!
!
!* 4.2 OPEN CASE:
@@ -501,17 +465,6 @@ SELECT CASE ( HLBCX(1) )
ENDWHERE
ENDIF
!
- PUM(IIB-JPHEXT,:,:)=0.
- WHERE ( PUM(IIB,:,:) <= 0. ) ! OUTFLOW condition
- PVM (IIB-1,:,:) = 2.*PVM (IIB,:,:) -PVM (IIB+1,:,:)
- PWM (IIB-1,:,:) = 2.*PWM (IIB,:,:) -PWM (IIB+1,:,:)
- PTHM (IIB-1,:,:) = 2.*PTHM (IIB,:,:) -PTHM (IIB+1,:,:)
-!
- ELSEWHERE ! INFLOW condition
- PVM (IIB-1,:,:) = PLBXVM (1,:,:)
- PWM (IIB-1,:,:) = PLBXWM (1,:,:)
- PTHM (IIB-1,:,:) = PLBXTHM (1,:,:)
- ENDWHERE
!
IF(SIZE(PTKET) /= 0) THEN
WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
@@ -521,14 +474,6 @@ SELECT CASE ( HLBCX(1) )
ENDWHERE
END IF
!
- IF(SIZE(PTKEM) /= 0) THEN
- WHERE ( PUM(IIB,:,:) <= 0. ) ! OUTFLOW condition
- PTKEM(IIB-1,:,:) = MAX(XTKEMIN, 2.*PTKEM(IIB,:,:)-PTKEM(IIB+1,:,:))
- ELSEWHERE ! INFLOW condition
- PTKEM(IIB-1,:,:) = MAX(XTKEMIN,PLBXTKEM(1,:,:))
- ENDWHERE
- END IF
-!
! Case with KRR moist variables
!
!
@@ -542,15 +487,9 @@ SELECT CASE ( HLBCX(1) )
END WHERE
END IF
!
- WHERE ( PUM(IIB,:,:) <= 0. ) ! OUTFLOW condition
- PRM(IIB-1,:,:,JRR) = MAX(0.,2.*PRM(IIB,:,:,JRR) -PRM(IIB+1,:,:,JRR))
- ELSEWHERE ! INFLOW condition
- PRM(IIB-1,:,:,JRR) = MAX(0.,PLBXRM(1,:,:,JRR))
- END WHERE
- !
END DO
!
- IF(SIZE(PSRCM) /= 0) PSRCM (IIB-1,:,:) = PSRCM (IIB,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT (IIB-1,:,:) = PSRCT (IIB,:,:)
!
! Case with KSV scalar variables
DO JSV=1 ,KSV
@@ -563,13 +502,6 @@ SELECT CASE ( HLBCX(1) )
END WHERE
END IF
!
- WHERE ( PUM(IIB,:,:) <= 0. ) ! OUTFLOW condition
- PSVM(IIB-1,:,:,JSV) = MAX(XSVMIN(JSV),2.*PSVM(IIB,:,:,JSV) - &
- PSVM(IIB+1,:,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVM(IIB-1,:,:,JSV) = MAX(XSVMIN(JSV),PLBXSVM(1,:,:,JSV))
- END WHERE
- !
END DO
!
!
@@ -598,20 +530,11 @@ SELECT CASE ( HLBCX(2) )
IF(SIZE(PTKET) /= 0) PTKET(IIE+JEXT,:,:) = PTKET(IIE+1-JEXT,:,:)
IF(SIZE(PRT) /= 0) PRT (IIE+JEXT,:,:,:) = PRT (IIE+1-JEXT,:,:,:)
IF(SIZE(PSVT) /= 0) PSVT(IIE+JEXT,:,:,:) = PSVT (IIE+1-JEXT,:,:,:)
-!
- PUM (IIE+JEXT,:,:) = PUM (IIE ,:,:) ! never used during run
- PVM (IIE+JEXT,:,:) = PVM (IIE+1-JEXT,:,:)
- PWM (IIE+JEXT,:,:) = PWM (IIE+1-JEXT,:,:)
- PTHM (IIE+JEXT,:,:) = PTHM (IIE+1-JEXT,:,:)
- IF(SIZE(PTKEM) /= 0) PTKEM(IIE+JEXT,:,:) = PTKEM(IIE+1-JEXT,:,:)
- PRM (IIE+JEXT,:,:,:) = PRM (IIE+1-JEXT,:,:,:)
- PSVM (IIE+JEXT,:,:,:) = PSVM (IIE+1-JEXT,:,:,:)
- IF(SIZE(PSRCM) /= 0) PSRCM (IIE+JEXT,:,:) = PSRCM (IIE+1-JEXT,:,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT (IIE+JEXT,:,:)= PSRCT (IIE+1-JEXT,:,:)
!
END DO
!
IF(SIZE(PUT) /= 0) PUT(IIE+1 ,:,:) = 0. ! set the normal velocity
- PUM (IIE+1 ,:,:) = 0. ! to zero
!
!* 5.2 OPEN CASE:
! =========
@@ -631,17 +554,6 @@ SELECT CASE ( HLBCX(2) )
PTHT (IIE+1,:,:) = ZLBXTHT (ILBX,:,:)
ENDWHERE
ENDIF
-!
- WHERE ( PUM(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
- PVM (IIE+1,:,:) = 2.*PVM (IIE,:,:) -PVM (IIE-1,:,:)
- PWM (IIE+1,:,:) = 2.*PWM (IIE,:,:) -PWM (IIE-1,:,:)
- PTHM (IIE+1,:,:) = 2.*PTHM (IIE,:,:) -PTHM (IIE-1,:,:)
-!
- ELSEWHERE ! INFLOW condition
- PVM (IIE+1,:,:) = PLBXVM (ILBX,:,:)
- PWM (IIE+1,:,:) = PLBXWM (ILBX,:,:)
- PTHM (IIE+1,:,:) = PLBXTHM (ILBX,:,:)
- ENDWHERE
!
IF(SIZE(PTKET) /= 0) THEN
ILBX = SIZE(PLBXTKEM,1)
@@ -652,13 +564,6 @@ SELECT CASE ( HLBCX(2) )
ENDWHERE
END IF
!
- IF(SIZE(PTKEM) /= 0) THEN
- WHERE ( PUM(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
- PTKEM(IIE+1,:,:) = MAX(XTKEMIN, 2.*PTKEM(IIE,:,:)-PTKEM(IIE-1,:,:))
- ELSEWHERE ! INFLOW condition
- PTKEM(IIE+1,:,:) = MAX(XTKEMIN,PLBXTKEM(ILBX,:,:))
- ENDWHERE
- END IF
!
! Case with KRR moist variables
!
@@ -674,15 +579,9 @@ SELECT CASE ( HLBCX(2) )
END WHERE
END IF
!
- WHERE ( PUM(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
- PRM(IIE+1,:,:,JRR) = MAX(0.,2.*PRM(IIE,:,:,JRR) -PRM(IIE-1,:,:,JRR))
- ELSEWHERE ! INFLOW condition
- PRM(IIE+1,:,:,JRR) = MAX(0.,PLBXRM(ILBX,:,:,JRR))
- END WHERE
END DO
!
- IF(SIZE(PSRCM) /= 0) PSRCM (IIE+1,:,:) = PSRCM (IIE,:,:)
-!
+ IF(SIZE(PSRCT) /= 0) PSRCT (IIE+1,:,:) = PSRCT (IIE,:,:)
! Case with KSV scalar variables
DO JSV=1 ,KSV
ILBX=SIZE(PLBXSVM,1)
@@ -695,12 +594,6 @@ SELECT CASE ( HLBCX(2) )
END WHERE
END IF
!
- WHERE ( PUM(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
- PSVM(IIE+1,:,:,JSV) = MAX(XSVMIN(JSV),2.*PSVM(IIE,:,:,JSV) - &
- PSVM(IIE-1,:,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVM(IIE+1,:,:,JSV) = MAX(XSVMIN(JSV),PLBXSVM(ILBX,:,:,JSV))
- END WHERE
END DO
!
!
@@ -728,20 +621,11 @@ SELECT CASE ( HLBCY(1) )
IF(SIZE(PTKET) /= 0) PTKET(:,IJB-JEXT,:) = PTKET(:,IJB-1+JEXT,:)
IF(SIZE(PRT) /= 0) PRT (:,IJB-JEXT,:,:) = PRT (:,IJB-1+JEXT,:,:)
IF(SIZE(PSVT) /= 0) PSVT (:,IJB-JEXT,:,:)= PSVT (:,IJB-1+JEXT,:,:)
-!
- PUM (:,IJB-JEXT,:) = PUM (:,IJB-1+JEXT,:)
- PVM (:,IJB-JEXT,:) = PVM (:,IJB ,:) ! never used during run
- PWM (:,IJB-JEXT,:) = PWM (:,IJB-1+JEXT,:)
- PTHM (:,IJB-JEXT,:) = PTHM (:,IJB-1+JEXT,:)
- IF(SIZE(PTKEM) /= 0) PTKEM(:,IJB-JEXT,:) = PTKEM(:,IJB-1+JEXT,:)
- PRM (:,IJB-JEXT,:,:) = PRM (:,IJB-1+JEXT,:,:)
- PSVM (:,IJB-JEXT,:,:) = PSVM (:,IJB-1+JEXT,:,:)
- IF(SIZE(PSRCM) /= 0) PSRCM(:,IJB-JEXT,:) = PSRCM(:,IJB-1+JEXT,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT(:,IJB-JEXT,:) = PSRCT(:,IJB-1+JEXT,:)
!
END DO
!
IF(SIZE(PVT) /= 0) PVT(:,IJB ,:) = 0. ! set the normal velocity
- PVM (:,IJB ,:) = 0. ! to zero
!
!* 6.2 OPEN CASE:
! =========
@@ -760,17 +644,6 @@ SELECT CASE ( HLBCY(1) )
PTHT (:,IJB-1,:) = ZLBYTHT (:,1,:)
ENDWHERE
ENDIF
-!
- PVM(:,IJB-JPHEXT,:)=0.
- WHERE ( PVM(:,IJB,:) <= 0. ) ! OUTFLOW condition
- PUM (:,IJB-1,:) = 2.*PUM (:,IJB,:) -PUM (:,IJB+1,:)
- PWM (:,IJB-1,:) = 2.*PWM (:,IJB,:) -PWM (:,IJB+1,:)
- PTHM (:,IJB-1,:) = 2.*PTHM (:,IJB,:) -PTHM (:,IJB+1,:)
- ELSEWHERE ! INFLOW condition
- PUM (:,IJB-1,:) = PLBYUM (:,1,:)
- PWM (:,IJB-1,:) = PLBYWM (:,1,:)
- PTHM (:,IJB-1,:) = PLBYTHM (:,1,:)
- ENDWHERE
!
IF(SIZE(PTKET) /= 0) THEN
WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
@@ -780,13 +653,6 @@ SELECT CASE ( HLBCY(1) )
ENDWHERE
END IF
!
- IF(SIZE(PTKEM) /= 0) THEN
- WHERE ( PVM(:,IJB,:) <= 0. ) ! OUTFLOW condition
- PTKEM(:,IJB-1,:) = MAX(XTKEMIN, 2.*PTKEM(:,IJB,:)-PTKEM(:,IJB+1,:))
- ELSEWHERE ! INFLOW condition
- PTKEM(:,IJB-1,:) = MAX(XTKEMIN,PLBYTKEM(:,1,:))
- ENDWHERE
- END IF
!
! Case with KRR moist variables
!
@@ -800,14 +666,9 @@ SELECT CASE ( HLBCY(1) )
END WHERE
END IF
!
- WHERE ( PVM(:,IJB,:) <= 0. ) ! OUTFLOW condition
- PRM(:,IJB-1,:,JRR) = MAX(0.,2.*PRM(:,IJB,:,JRR) -PRM(:,IJB+1,:,JRR))
- ELSEWHERE ! INFLOW condition
- PRM(:,IJB-1,:,JRR) = MAX(0.,PLBYRM(:,1,:,JRR))
- END WHERE
END DO
!
- IF(SIZE(PSRCM) /= 0) PSRCM(:,IJB-1,:) = PSRCM(:,IJB,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT(:,IJB-1,:) = PSRCT(:,IJB,:)
!
! Case with KSV scalar variables
!
@@ -821,12 +682,6 @@ SELECT CASE ( HLBCY(1) )
END WHERE
END IF
!
- WHERE ( PVM(:,IJB,:) <= 0. ) ! OUTFLOW condition
- PSVM(:,IJB-1,:,JSV) = MAX(XSVMIN(JSV),2.*PSVM(:,IJB,:,JSV) - &
- PSVM(:,IJB+1,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVM(:,IJB-1,:,JSV) = MAX(XSVMIN(JSV),PLBYSVM(:,1,:,JSV))
- END WHERE
END DO
!
!
@@ -855,20 +710,11 @@ SELECT CASE ( HLBCY(2) )
IF(SIZE(PTKET) /= 0) PTKET(:,IJE+JEXT,:) = PTKET(:,IJE+1-JEXT,:)
IF(SIZE(PRT) /= 0) PRT (:,IJE+JEXT,:,:) = PRT (:,IJE+1-JEXT,:,:)
IF(SIZE(PSVT) /= 0) PSVT (:,IJE+JEXT,:,:)= PSVT (:,IJE+1-JEXT,:,:)
-!
- PUM (:,IJE+JEXT,:) = PUM (:,IJE+1-JEXT,:)
- PVM (:,IJE+JEXT,:) = PVM (:,IJE ,:) ! never used during run
- PWM (:,IJE+JEXT,:) = PWM (:,IJE+1-JEXT,:)
- PTHM (:,IJE+JEXT,:) = PTHM (:,IJE+1-JEXT,:)
- IF(SIZE(PTKEM) /= 0) PTKEM(:,IJE+JEXT,:) = PTKEM(:,IJE+1-JEXT,:)
- PRM (:,IJE+JEXT,:,:) = PRM (:,IJE+1-JEXT,:,:)
- PSVM (:,IJE+JEXT,:,:) = PSVM (:,IJE+1-JEXT,:,:)
- IF(SIZE(PSRCM) /= 0) PSRCM(:,IJE+JEXT,:) = PSRCM(:,IJE+1-JEXT,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT(:,IJE+JEXT,:) = PSRCT(:,IJE+1-JEXT,:)
!
END DO
!
IF(SIZE(PVT) /= 0) PVT(:,IJE+1 ,:) = 0. ! set the normal velocity
- PVM (:,IJE+1 ,:) = 0. ! to zero
!
!* 4.3.2 OPEN CASE:
! =========
@@ -888,16 +734,6 @@ SELECT CASE ( HLBCY(2) )
PTHT (:,IJE+1,:) = ZLBYTHT (:,ILBY,:)
ENDWHERE
ENDIF
-!
- WHERE ( PVM(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
- PUM (:,IJE+1,:) = 2.*PUM (:,IJE,:) -PUM (:,IJE-1,:)
- PWM (:,IJE+1,:) = 2.*PWM (:,IJE,:) -PWM (:,IJE-1,:)
- PTHM (:,IJE+1,:) = 2.*PTHM (:,IJE,:) -PTHM (:,IJE-1,:)
- ELSEWHERE ! INFLOW condition
- PUM (:,IJE+1,:) = PLBYUM (:,ILBY,:)
- PWM (:,IJE+1,:) = PLBYWM (:,ILBY,:)
- PTHM (:,IJE+1,:) = PLBYTHM (:,ILBY,:)
- ENDWHERE
!
IF(SIZE(PTKET) /= 0) THEN
ILBY=SIZE(PLBYTKEM,2)
@@ -908,14 +744,6 @@ SELECT CASE ( HLBCY(2) )
ENDWHERE
ENDIF
!
- IF(SIZE(PTKEM) /= 0) THEN
- WHERE ( PVM(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
- PTKEM(:,IJE+1,:) = MAX(XTKEMIN, 2.*PTKEM(:,IJE,:)-PTKEM(:,IJE-1,:))
- ELSEWHERE ! INFLOW condition
- PTKEM(:,IJE+1,:) = MAX(XTKEMIN,PLBYTKEM(:,ILBY,:))
- ENDWHERE
- END IF
-!
! Case with KRR moist variables
!
!
@@ -930,14 +758,9 @@ SELECT CASE ( HLBCY(2) )
END WHERE
END IF
!
- WHERE ( PVM(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
- PRM(:,IJE+1,:,JRR) = MAX(0.,2.*PRM(:,IJE,:,JRR) -PRM(:,IJE-1,:,JRR))
- ELSEWHERE ! INFLOW condition
- PRM(:,IJE+1,:,JRR) = MAX(0.,PLBYRM(:,ILBY,:,JRR))
- END WHERE
END DO
!
- IF(SIZE(PSRCM) /= 0) PSRCM(:,IJE+1,:) = PSRCM(:,IJE,:)
+ IF(SIZE(PSRCT) /= 0) PSRCT(:,IJE+1,:) = PSRCT(:,IJE,:)
!
! Case with KSV scalar variables
DO JSV=1 ,KSV
@@ -952,12 +775,6 @@ SELECT CASE ( HLBCY(2) )
END WHERE
END IF
!
- WHERE ( PVM(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
- PSVM(:,IJE+1,:,JSV) = MAX(XSVMIN(JSV),2.*PSVM(:,IJE,:,JSV) - &
- PSVM(:,IJE-1,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVM(:,IJE+1,:,JSV) = MAX(XSVMIN(JSV),PLBYSVM(:,ILBY,:,JSV))
- END WHERE
END DO
!
!
@@ -982,9 +799,7 @@ IF (LUSECHEM .AND. IMI == 1) THEN
DO JSV=NSV_CHEMBEG,NSV_CHEMEND
IF (GCHBOUNDARY(JSV-NSV_CHEMBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVT(:,:,:,JSV))
- ELSE
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVM(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
ENDIF
ENDIF
ENDDO
@@ -1007,14 +822,11 @@ IF (LUSECHIC .AND. IMI == 1) THEN
DO JSV=NSV_CHICBEG,NSV_CHICEND
IF (GICBOUNDARY(JSV-NSV_CHICBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVT(:,:,:,JSV))
- ELSE
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVM(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
ENDIF
ENDIF
ENDDO
ENDIF
-!
IF (LORILAM .AND. IMI == 1) THEN
IF (GFIRSTCALL2) THEN
ALLOCATE(GAERBOUNDARY(NSV_AER))
@@ -1032,9 +844,7 @@ IF (LORILAM .AND. IMI == 1) THEN
DO JSV=NSV_AERBEG,NSV_AEREND
IF (GAERBOUNDARY(JSV-NSV_AERBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVT(:,:,:,JSV))
- ELSE
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVM(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
ENDIF
ENDIF
ENDDO
@@ -1057,9 +867,7 @@ IF (LDUST .AND. IMI == 1) THEN
DO JSV=NSV_DSTBEG,NSV_DSTEND
IF (GDSTBOUNDARY(JSV-NSV_DSTBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVT(:,:,:,JSV))
- ELSE
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVM(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
ENDIF
ENDIF
ENDDO
@@ -1082,9 +890,7 @@ IF (LSALT .AND. IMI == 1) THEN
DO JSV=NSV_SLTBEG,NSV_SLTEND
IF (GSLTBOUNDARY(JSV-NSV_SLTBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVT(:,:,:,JSV))
- ELSE
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVM(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
ENDIF
ENDIF
ENDDO
@@ -1107,9 +913,7 @@ IF ( LPASPOL .AND. IMI == 1) THEN
DO JSV=NSV_PPBEG,NSV_PPEND
IF (GPPBOUNDARY(JSV-NSV_PPBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUT,PVT,PSVT(:,:,:,JSV))
- ELSE
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVM(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
ENDIF
ENDIF
ENDDO
@@ -1132,16 +936,14 @@ IF ( LCONDSAMP .AND. IMI == 1) THEN
DO JSV=NSV_CSBEG,NSV_CSEND
IF (GCSBOUNDARY(JSV-NSV_CSBEG+1)) THEN
IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUT,PVT,PSVT(:,:,:,JSV))
- ELSE
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PSVM(:,:,:,JSV),PUM,PVM,PSVM(:,:,:,JSV))
+ CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV))
ENDIF
ENDIF
ENDDO
ENDIF
!
IF ( CELEC /= 'NONE' .AND. IMI == 1) THEN
- CALL ION_BOUNDARIES (HLBCX,HLBCY,PUM,PVM,PUT,PVT,PSVT)
+ CALL ION_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT)
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/budget.f90 b/src/MNH/budget.f90
index 9728b6628..c3606691e 100644
--- a/src/MNH/budget.f90
+++ b/src/MNH/budget.f90
@@ -85,7 +85,8 @@ END MODULE MODI_BUDGET
USE MODD_BUDGET
USE MODD_LUNIT
!USE MODD_CONF_n
-USE MODD_NSV, ONLY : NSV
+USE MODD_CONF, ONLY : LCHECK
+USE MODD_NSV, ONLY : NSV
USE MODD_LES
!
USE MODE_FM
@@ -95,6 +96,8 @@ USE MODI_LES_BUDGET
USE MODI_CART_COMPRESS
USE MODI_MASK_COMPRESS
!
+USE MODE_MPPDB
+!
USE MODI_SECOND_MNH
!
IMPLICIT NONE
@@ -114,8 +117,20 @@ INTEGER :: IRESP ! Return code of FM-routines
REAL :: ZTIME1 ! CPU time counter
REAL :: ZTIME2 ! CPU time counter
!
+REAL :: XPRECISION ! for reproductibility checks
+
!-------------------------------------------------------------------------------
!
+!* Reproductivity checks
+! Warning: requires an adaptation of the makefile in order to run two runs in
+! parallel for comparison
+!
+XPRECISION = 1E-10
+IF (LCHECK) THEN
+ CALL MPPDB_CHECK3D(PVARS,HBUVAR,XPRECISION)
+END IF
+!
+!
!* call to LES budgets
!
IF (LLES_CALL) CALL LES_BUDGET(PVARS,KBUDN,HBUVAR)
diff --git a/src/MNH/budget_flags.f90 b/src/MNH/budget_flags.f90
index c074952ae..95f565e96 100644
--- a/src/MNH/budget_flags.f90
+++ b/src/MNH/budget_flags.f90
@@ -72,6 +72,7 @@ SUBROUTINE BUDGET_FLAGS(OUSERV, OUSERC, OUSERR, &
USE MODD_BUDGET
USE MODD_NSV, ONLY : NSV
USE MODD_LES
+USE MODD_CONF, ONLY : LCHECK
!
IMPLICIT NONE
!
@@ -86,21 +87,23 @@ LOGICAL, INTENT(IN) :: OUSERS ! flag to use snow
LOGICAL, INTENT(IN) :: OUSERG ! flag to use graupel
LOGICAL, INTENT(IN) :: OUSERH ! flag to use hail
+!* 0.2 Declarations of local variables :
+!
!-------------------------------------------------------------------------------
!
-LBUDGET_U = (LBU_ENABLE .AND. LBU_RU ) .OR. LLES_CALL
-LBUDGET_V = (LBU_ENABLE .AND. LBU_RV ) .OR. LLES_CALL
-LBUDGET_W = (LBU_ENABLE .AND. LBU_RW ) .OR. LLES_CALL
-LBUDGET_TH = (LBU_ENABLE .AND. LBU_RTH ) .OR. LLES_CALL
-LBUDGET_TKE= (LBU_ENABLE .AND. LBU_RTKE) .OR. LLES_CALL
-LBUDGET_RV = (LBU_ENABLE .AND. LBU_RRV ) .OR. (LLES_CALL .AND. OUSERV)
-LBUDGET_RC = (LBU_ENABLE .AND. LBU_RRC ) .OR. (LLES_CALL .AND. OUSERC)
-LBUDGET_RR = (LBU_ENABLE .AND. LBU_RRR ) .OR. (LLES_CALL .AND. OUSERR)
-LBUDGET_RI = (LBU_ENABLE .AND. LBU_RRI ) .OR. (LLES_CALL .AND. OUSERI)
-LBUDGET_RS = (LBU_ENABLE .AND. LBU_RRS ) .OR. (LLES_CALL .AND. OUSERS)
-LBUDGET_RG = (LBU_ENABLE .AND. LBU_RRG ) .OR. (LLES_CALL .AND. OUSERG)
-LBUDGET_RH = (LBU_ENABLE .AND. LBU_RRH ) .OR. (LLES_CALL .AND. OUSERH)
-LBUDGET_SV = (LBU_ENABLE .AND. LBU_RSV ) .OR. (LLES_CALL .AND. NSV>0 )
+LBUDGET_U = (LBU_ENABLE .AND. LBU_RU ) .OR. (LLES_CALL .OR. LCHECK )
+LBUDGET_V = (LBU_ENABLE .AND. LBU_RV ) .OR. (LLES_CALL .OR. LCHECK )
+LBUDGET_W = (LBU_ENABLE .AND. LBU_RW ) .OR. (LLES_CALL .OR. LCHECK )
+LBUDGET_TH = (LBU_ENABLE .AND. LBU_RTH ) .OR. (LLES_CALL .OR. LCHECK )
+LBUDGET_TKE= (LBU_ENABLE .AND. LBU_RTKE) .OR. (LLES_CALL .OR. LCHECK )
+LBUDGET_RV = (LBU_ENABLE .AND. LBU_RRV ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERV)
+LBUDGET_RC = (LBU_ENABLE .AND. LBU_RRC ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERC)
+LBUDGET_RR = (LBU_ENABLE .AND. LBU_RRR ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERR)
+LBUDGET_RI = (LBU_ENABLE .AND. LBU_RRI ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERI)
+LBUDGET_RS = (LBU_ENABLE .AND. LBU_RRS ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERS)
+LBUDGET_RG = (LBU_ENABLE .AND. LBU_RRG ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERG)
+LBUDGET_RH = (LBU_ENABLE .AND. LBU_RRH ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERH)
+LBUDGET_SV = (LBU_ENABLE .AND. LBU_RSV ) .OR. ((LLES_CALL .OR. LCHECK ).AND. NSV>0 )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/c2r2_adjust.f90 b/src/MNH/c2r2_adjust.f90
index 92f46ca98..1e25d6267 100644
--- a/src/MNH/c2r2_adjust.f90
+++ b/src/MNH/c2r2_adjust.f90
@@ -12,7 +12,7 @@ INTERFACE
!
SUBROUTINE C2R2_ADJUST(KRR, HFMFILE, HLUOUT, HRAD, &
HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
- PRHODJ, PPABSM, PSIGS, PPABST, &
+ PRHODJ, PSIGS, PPABST, &
PTHS, PRVS, PRCS, PCNUCS, &
PCCS, PSRCS, PCLDFR, PRRS )
!
@@ -31,7 +31,6 @@ REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
!
@@ -55,7 +54,7 @@ END MODULE MODI_C2R2_ADJUST
! ##########################################################################
SUBROUTINE C2R2_ADJUST(KRR, HFMFILE, HLUOUT, HRAD, &
HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
- PRHODJ, PPABSM, PSIGS, PPABST, &
+ PRHODJ, PSIGS, PPABST, &
PTHS, PRVS, PRCS, PCNUCS, &
PCCS, PSRCS, PCLDFR, PRRS )
! ##########################################################################
@@ -183,7 +182,6 @@ REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
!
@@ -267,7 +265,7 @@ END WHERE
!
!* 2.2 estimate the Exner function at t+1
!
-ZEXNS(:,:,:) = ( (2. * PPABST(:,:,:) - PPABSM(:,:,:)) / XP00 ) ** (XRD/XCPD)
+ZEXNS(:,:,:) = ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
!
! beginning of the iterative loop
!
@@ -298,7 +296,7 @@ DO JITER =1,ITERMAX
!* 2.7 compute the saturation mixing ratio at t+1
!
ZW2(:,:,:) = ZW1(:,:,:) * ZEPS / &
- ( 2. * PPABST(:,:,:) - PPABSM(:,:,:) - ZW1(:,:,:) )
+ ( PPABST(:,:,:) - ZW1(:,:,:) )
!
!* 2.8 compute the saturation mixing ratio derivative (rvs')
!
diff --git a/src/MNH/c3r5_adjust.f90 b/src/MNH/c3r5_adjust.f90
index 6a4daa6a9..d784fc95e 100644
--- a/src/MNH/c3r5_adjust.f90
+++ b/src/MNH/c3r5_adjust.f90
@@ -12,7 +12,7 @@ INTERFACE
!
SUBROUTINE C3R5_ADJUST( KRR, KMI, HFMFILE, HLUOUT, HRAD, &
HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, &
+ 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, &
@@ -36,7 +36,6 @@ 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) :: PPABSM ! Absolute Pressure at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
!
@@ -78,7 +77,7 @@ END MODULE MODI_C3R5_ADJUST
! ##########################################################################
SUBROUTINE C3R5_ADJUST( KRR, KMI, HFMFILE, HLUOUT, HRAD, &
HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, &
+ 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, &
diff --git a/src/MNH/ch_aqueous_sedimkhko.f90 b/src/MNH/ch_aqueous_sedimkhko.f90
index 5dcdc770a..7d8791276 100644
--- a/src/MNH/ch_aqueous_sedimkhko.f90
+++ b/src/MNH/ch_aqueous_sedimkhko.f90
@@ -3,18 +3,16 @@
! ################################
!
INTERFACE
- SUBROUTINE CH_AQUEOUS_SEDIMKHKO (PTSTEP, PZZ, PRHODREF, PRHODJ, PRRM, &
- PRRT, PRRS, PCRM, PCRT, PCRS, PSVT, PRSVS )
+ SUBROUTINE CH_AQUEOUS_SEDIMKHKO (PTSTEP, PZZ, PRHODREF, PRHODJ, &
+ PRRT, PRRS, PCRT, PCRS, PSVT, PRSVS )
!
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) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRM ! Rain water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRT ! Rain water C. at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Precip. aq. species at t
@@ -25,8 +23,8 @@ END INTERFACE
END MODULE MODI_CH_AQUEOUS_SEDIMKHKO
!
! #############################################################################
- SUBROUTINE CH_AQUEOUS_SEDIMKHKO (PTSTEP, PZZ, PRHODREF, PRHODJ, PRRM, &
- PRRT, PRRS, PCRM, PCRT, PCRS, PSVT, PRSVS )
+ SUBROUTINE CH_AQUEOUS_SEDIMKHKO (PTSTEP, PZZ, PRHODREF, PRHODJ, &
+ PRRT, PRRS, PCRT, PCRS, PSVT, PRSVS )
! #############################################################################
!
!!**** * - compute the explicit microphysical sources
@@ -88,10 +86,8 @@ 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) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRM ! Rain water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRT ! Rain water C. at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Precip. aq. species at t
@@ -209,11 +205,11 @@ ZTSPLITR = PTSTEP / FLOAT(ISPLITR) ! Small time step
! the precipitating fields are larger than a minimal value only !!!
!
ZZRRS(:,:,:) = 0.0
-ZZRRS(:,:,:) = ZRRS(:,:,:) - PRRM(:,:,:) / PTSTEP
-ZRRS(:,:,:) = PRRM(:,:,:) / PTSTEP
+ZZRRS(:,:,:) = ZRRS(:,:,:) - PRRT(:,:,:) / PTSTEP
+ZRRS(:,:,:) = PRRT(:,:,:) / PTSTEP
ZZCRS(:,:,:) = 0.0
-ZZCRS(:,:,:) = ZCRS(:,:,:) - PCRM(:,:,:) / PTSTEP
-ZCRS(:,:,:) = PCRM(:,:,:) / PTSTEP
+ZZCRS(:,:,:) = ZCRS(:,:,:) - PCRT(:,:,:) / PTSTEP
+ZCRS(:,:,:) = PCRT(:,:,:) / PTSTEP
ZSV_SEDIM_FACT(:,:,:) = 1.0
DO JN = 1 , ISPLITR
!
diff --git a/src/MNH/ch_boundaries.f90 b/src/MNH/ch_boundaries.f90
index 96d06fe49..b5fb879ba 100644
--- a/src/MNH/ch_boundaries.f90
+++ b/src/MNH/ch_boundaries.f90
@@ -11,10 +11,10 @@ MODULE MODI_CH_BOUNDARIES
INTERFACE
!
SUBROUTINE CH_BOUNDARIES (HLBCX,HLBCY, &
- PSVBM,PUT,PVT,PSVBT )
+ PUT,PVT,PSVBT )
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVBT,PSVBM
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVBT
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT
!
END SUBROUTINE CH_BOUNDARIES
@@ -26,7 +26,7 @@ END MODULE MODI_CH_BOUNDARIES
!
! ####################################################################
SUBROUTINE CH_BOUNDARIES (HLBCX,HLBCY, &
- PSVBM,PUT,PVT,PSVBT )
+ PUT,PVT,PSVBT )
! ####################################################################
!
!!**** *CH_BOUNDARIES* - routine to prepare the Lateral Boundary Conditions for
@@ -84,7 +84,7 @@ IMPLICIT NONE
!
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVBT,PSVBM
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVBT
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT
!
!
@@ -173,12 +173,8 @@ IF (LWEST_ll( ) .AND. HLBCX(1)=='OPEN') THEN
(PSVBT(IIB+1,IJ,IZZW(1,IJ,IK)+1)-&
PSVBT(IIB+1,IJ,IZZW(1,IJ,IK))) * ZZZW(1,IJ,IK)
!
- PSVBM(IIB-1,IJ,IK) = PSVBM(IIB+1,IJ,IZZW(1,IJ,IK))+&
- (PSVBM(IIB+1,IJ,IZZW(1,IJ,IK)+1)-&
- PSVBM(IIB+1,IJ,IZZW(1,IJ,IK))) * ZZZW(1,IJ,IK)
ELSE
PSVBT(IIB-1,IJ,IK) = PSVBT(IIB+1,IJ,IK)
- PSVBM(IIB-1,IJ,IK) = PSVBM(IIB+1,IJ,IK)
END IF
END IF
END DO
@@ -226,13 +222,8 @@ IF (LEAST_ll( ) .AND. HLBCX(1)=='OPEN') THEN
(PSVBT(IIE-1,IJ,IZZE(1,IJ,IK)+1)-&
PSVBT(IIE-1,IJ,IZZE(1,IJ,IK))) * ZZZE(1,IJ,IK)
!
- PSVBM(IIE+1,IJ,IK) = &
- PSVBM(IIE-1,IJ,IZZE(1,IJ,IK))+&
- (PSVBM(IIE-1,IJ,IZZE(1,IJ,IK)+1)-&
- PSVBM(IIE-1,IJ,IZZE(1,IJ,IK))) * ZZZE(1,IJ,IK)
ELSE
PSVBT(IIE+1,IJ,IK) = PSVBT(IIE-1,IJ,IK)
- PSVBM(IIE+1,IJ,IK) = PSVBM(IIE-1,IJ,IK)
END IF
END IF
END DO
@@ -281,13 +272,8 @@ IF (LSOUTH_ll( ) .AND. HLBCY(1)=='OPEN') THEN
(PSVBT(II,IJB+1,IZZS(II,1,IK)+1)-&
PSVBT(II,IJB+1,IZZS(II,1,IK))) * ZZZS(II,1,IK)
!
- PSVBM(II,IJB-1,IK) = &
- PSVBM(II,IJB+1,IZZS(II,1,IK))+&
- (PSVBM(II,IJB+1,IZZS(II,1,IK)+1)-&
- PSVBM(II,IJB+1,IZZS(II,1,IK))) * ZZZS(II,1,IK)
ELSE
PSVBT(II,IJB-1,IK) = PSVBT(II,IJB+1,IK)
- PSVBM(II,IJB-1,IK) = PSVBM(II,IJB+1,IK)
END IF
END IF
END DO
@@ -337,13 +323,8 @@ IF (LNORTH_ll( ) .AND. HLBCY(2)=='OPEN') THEN
(PSVBT(II,IJE-1,IZZN(II,1,IK)+1)-&
PSVBT(II,IJE-1,IZZN(II,1,IK))) * ZZZN(II,1,IK)
!
- PSVBM(II,IJE+1,IK) = &
- PSVBM(II,IJE-1,IZZN(II,1,IK))+&
- (PSVBM(II,IJE-1,IZZN(II,1,IK)+1)-&
- PSVBM(II,IJE-1,IZZN(II,1,IK))) * ZZZN(II,1,IK)
ELSE
PSVBT(II,IJE+1,IK) = PSVBT(II,IJE-1,IK)
- PSVBM(II,IJE+1,IK) = PSVBM(II,IJE-1,IK)
END IF
END IF
END DO
diff --git a/src/MNH/ch_init_fieldn.f90 b/src/MNH/ch_init_fieldn.f90
index 7af2e08e6..468277f93 100644
--- a/src/MNH/ch_init_fieldn.f90
+++ b/src/MNH/ch_init_fieldn.f90
@@ -95,12 +95,11 @@ USE MODD_NSV, ONLY : NSV_CHEM, NSV_CHEMBEG,NSV_CHEMEND, &
NSV_AER, NSV_AERBEG,NSV_AEREND
USE MODD_CST, ONLY : XMD, XAVOGADRO
-USE MODD_FIELD_n, ONLY : XSVM, &! scalar variable at t-dt
- XSVT ! scalar variable at t
+USE MODD_FIELD_n, ONLY : XSVT ! scalar variable at t
USE MODD_PARAMETERS, ONLY : JPVEXT, JPHEXT ! number of External points
USE MODD_ARGSLIST_ll, ONLY : LIST_ll ! for update_halo
USE MODD_CH_CONST_n ! for Chemical constants
-USE MODD_CONF, ONLY : CCONF, CPROGRAM, L1D, L2D
+USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D
USE MODD_CONF_n, ONLY : NRRL
USE MODD_CH_MNHC_n
USE MODD_CH_M9_n, ONLY : CNAMES, NEQ
@@ -187,7 +186,7 @@ IIU = IIE + 2 * JPHEXT
IJU = IJE + 2 * JPHEXT
CALL GET_INTERSECTION_ll(1+JPHEXT, 1+JPHEXT, IIU-JPHEXT , IJU-JPHEXT, IOR, JOR, IEND, JEND, "EXTE", KINFO)
IKB = 1 + JPVEXT
-IKU = SIZE(XSVM,3)
+IKU = SIZE(XSVT,3)
IKE = IKU - JPVEXT
CALL GET_DIM_EXT_ll('B',NIU,NJU)
!
@@ -211,33 +210,34 @@ ZDEN2MOL = 1E-6 * XAVOGADRO / XMD
!* 2. INITIALIZE T FIELDS AND CONVERT CONC. TO MIXING RATIO
! -----------------------
!
+
YUNIT="MIX"
-!
+
IF (LORILAM) THEN
- IF (.NOT.(ASSOCIATED(XN3D))) ALLOCATE(XN3D(SIZE(XSVM,1),SIZE(XSVM,2),IKU,JPMODE))
- IF (.NOT.(ASSOCIATED(XRG3D))) ALLOCATE(XRG3D(SIZE(XSVM,1),SIZE(XSVM,2),IKU,JPMODE))
- IF (.NOT.(ASSOCIATED(XSIG3D))) ALLOCATE(XSIG3D(SIZE(XSVM,1),SIZE(XSVM,2),IKU,JPMODE))
- IF (.NOT.(ASSOCIATED(XRHOP3D))) ALLOCATE(XRHOP3D(SIZE(XSVM,1),SIZE(XSVM,2),IKU,JPMODE))
- IF (.NOT.(ASSOCIATED(XM3D))) ALLOCATE(XM3D(SIZE(XSVM,1),SIZE(XSVM,2),IKU,JPMODE*3))
- IF (.NOT.(ASSOCIATED(XSEDA))) ALLOCATE(XSEDA(SIZE(XSVM,1),SIZE(XSVM,2),IKU,JPMODE*3))
+ IF (.NOT.(ASSOCIATED(XN3D))) ALLOCATE(XN3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE))
+ IF (.NOT.(ASSOCIATED(XRG3D))) ALLOCATE(XRG3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE))
+ IF (.NOT.(ASSOCIATED(XSIG3D))) ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE))
+ IF (.NOT.(ASSOCIATED(XRHOP3D))) ALLOCATE(XRHOP3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE))
+ IF (.NOT.(ASSOCIATED(XM3D))) ALLOCATE(XM3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE*3))
+ IF (.NOT.(ASSOCIATED(XSEDA))) ALLOCATE(XSEDA(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE*3))
IF (.NOT.(ASSOCIATED(XCTOTA3D))) &
- ALLOCATE(XCTOTA3D(SIZE(XSVM,1),SIZE(XSVM,2),IKU,NSP+NCARB+NSOA,JPMODE))
- IF (.NOT.(ASSOCIATED(XVDEPAERO))) ALLOCATE(XVDEPAERO(SIZE(XSVM,1),SIZE(XSVM,2),JPIN))
- IF (.NOT.(ALLOCATED(XFAC))) ALLOCATE(XFAC(NSP+NSOA+NCARB))
- IF (.NOT.(ALLOCATED(XRHOI))) ALLOCATE(XRHOI(NSP+NSOA+NCARB))
+ ALLOCATE(XCTOTA3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,NSP+NCARB+NSOA,JPMODE))
+ IF (.NOT.(ASSOCIATED(XVDEPAERO))) ALLOCATE(XVDEPAERO(SIZE(XSVT,1),SIZE(XSVT,2),JPIN))
+ IF (.NOT.(ALLOCATED(XFAC))) ALLOCATE(XFAC(NSP+NSOA+NCARB))
+ IF (.NOT.(ALLOCATED(XRHOI))) ALLOCATE(XRHOI(NSP+NSOA+NCARB))
IF (.NOT.(ASSOCIATED(XFRAC))) THEN
- ALLOCATE(XFRAC(SIZE(XSVM,1),SIZE(XSVM,2),IKU,NEQ))
+ ALLOCATE(XFRAC(SIZE(XSVT,1),SIZE(XSVT,2),IKU,NEQ))
XFRAC(:,:,:,:) = 0.
END IF
IF (.NOT.(ASSOCIATED(XMI))) THEN
- ALLOCATE(XMI(SIZE(XSVM,1),SIZE(XSVM,2),IKU,NSP+NCARB+NSOA))
+ ALLOCATE(XMI(SIZE(XSVT,1),SIZE(XSVT,2),IKU,NSP+NCARB+NSOA))
END IF
END IF
!
!* print info for user
IF ((LCH_INIT_FIELD).AND.(CPROGRAM/='DIAG ')) THEN
!
- WRITE(KLUOUT,*) "CH_INIT_FIELD_n will now initialize XSVM fields"
+ WRITE(KLUOUT,*) "CH_INIT_FIELD_n will now initialize XSVT fields"
!
!
jlev_loop : DO JLEV=1,ILEVMAX
@@ -253,28 +253,28 @@ IF ((LCH_INIT_FIELD).AND.(CPROGRAM/='DIAG ')) THEN
END DO jn_loop
END DO jlev_loop
- XSVM(:,:,:,NSV_CHEMBEG:NSV_CHEMEND) = 0.
+ XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND) = 0.
jk_loop : DO JK = IKB, IKE
jj_loop : DO JJ = JOR, JEND
ji_loop : DO JI = IOR, IEND
JLEV=INT(MAX(XZZ(JI,JJ,JK),0.)/10.)+1
- XSVM(JI,JJ,JK,NSV_CHEMBEG:NSV_CHEMEND) = ZSVINIT(JLEV,:)
+ XSVT(JI,JJ,JK,NSV_CHEMBEG:NSV_CHEMEND) = ZSVINIT(JLEV,:)
END DO ji_loop
END DO jj_loop
END DO jk_loop
DO JN = NSV_CHEMBEG,NSV_CHEMEND
DO JK=1,JPVEXT
- XSVM(:,:,IKB-JPVEXT,JN) = XSVM(:,:,IKB,JN)
- XSVM(:,:,IKE+JPVEXT,JN) = XSVM(:,:,IKE,JN)
+ XSVT(:,:,IKB-JPVEXT,JN) = XSVT(:,:,IKB,JN)
+ XSVT(:,:,IKE+JPVEXT,JN) = XSVT(:,:,IKE,JN)
END DO
END DO
!
IF (YUNIT .EQ. "CON") THEN
WRITE(KLUOUT,*) "CH_INIT_FIELD_n: converting initial values to mixing ratio"
DO JN = NSV_CHEMBEG,NSV_CHEMEND
- XSVM(:,:,:,JN) = XSVM(:,:,:,JN)/(XRHODREF(:,:,:)*ZDEN2MOL)
+ XSVT(:,:,:,JN) = XSVT(:,:,:,JN)/(XRHODREF(:,:,:)*ZDEN2MOL)
ENDDO
ELSE
WRITE(KLUOUT,*)"CH_INIT_FIELD_n: initial values are used as is (mixing ratio)"
@@ -295,28 +295,28 @@ IF ((LCH_INIT_FIELD).AND.(CPROGRAM/='DIAG ')) THEN
END DO jn_loop2
END DO jlev_loop2
!
- XSVM(:,:,:,NSV_AERBEG:NSV_AEREND) = 0.
+ XSVT(:,:,:,NSV_AERBEG:NSV_AEREND) = 0.
jk_loop2 : DO JK = IKB, IKE
jj_loop2 : DO JJ = JOR, JEND
ji_loop2 : DO JI = IOR, IEND
JLEV=INT(MAX(XZZ(JI,JJ,JK),0.)/10.)+1
- XSVM(JI,JJ,JK,NSV_AERBEG:NSV_AEREND) = ZSVINITA(JLEV,:)
+ XSVT(JI,JJ,JK,NSV_AERBEG:NSV_AEREND) = ZSVINITA(JLEV,:)
END DO ji_loop2
END DO jj_loop2
END DO jk_loop2
DO JN = NSV_AERBEG,NSV_AEREND
DO JK=1,JPVEXT
- XSVM(:,:,IKB-JPVEXT,JN) = XSVM(:,:,IKB,JN)
- XSVM(:,:,IKE+JPVEXT,JN) = XSVM(:,:,IKE,JN)
+ XSVT(:,:,IKB-JPVEXT,JN) = XSVT(:,:,IKB,JN)
+ XSVT(:,:,IKE+JPVEXT,JN) = XSVT(:,:,IKE,JN)
END DO
END DO
!
IF (YUNIT .EQ. "CON") THEN
WRITE(KLUOUT,*) "CH_INIT_FIELD_n (ORILAM): converting initial values to mixing ratio"
DO JN = NSV_AERBEG,NSV_AEREND
- XSVM(:,:,:,JN) = XSVM(:,:,:,JN)/(XRHODREF(:,:,:)*ZDEN2MOL)
+ XSVT(:,:,:,JN) = XSVT(:,:,:,JN)/(XRHODREF(:,:,:)*ZDEN2MOL)
ENDDO
ELSE
WRITE(KLUOUT,*)"CH_INIT_FIELD_n (ORILAM): initial values are used as is (mixing ratio)"
@@ -328,10 +328,10 @@ ENDIF
!
!
DO JN = NSV_CHEMBEG,NSV_CHEMEND
- CALL ADD3DFIELD_ll(TZFIELDS_ll, XSVM(:,:,:,JN))
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XSVT(:,:,:,JN))
END DO
DO JN = NSV_AERBEG,NSV_AEREND
- CALL ADD3DFIELD_ll(TZFIELDS_ll, XSVM(:,:,:,JN))
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XSVT(:,:,:,JN))
END DO
!
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
@@ -349,8 +349,8 @@ CALL CH_INIT_CONST_n(KLUOUT, KVERB)
! -------------------
!
IF (LORILAM) THEN
- CALL CH_AER_EQM_INIT_n(XSVM(:,:,:,NSV_CHEMBEG:NSV_CHEMEND),&
- XSVM(:,:,:,NSV_AERBEG:NSV_AEREND),&
+ CALL CH_AER_EQM_INIT_n(XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND),&
+ XSVT(:,:,:,NSV_AERBEG:NSV_AEREND),&
XM3D,XRHOP3D,XSIG3D,&
XRG3D,XN3D, XRHODREF, XCTOTA3D)
DO JN = 1,JPIN
@@ -359,28 +359,19 @@ IF (LORILAM) THEN
END DO
!
DO JN = NSV_CHEMBEG,NSV_CHEMEND
- CALL ADD3DFIELD_ll(TZFIELDS_ll, XSVM(:,:,:,JN))
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XSVT(:,:,:,JN))
END DO
DO JN = NSV_AERBEG,NSV_AEREND
- CALL ADD3DFIELD_ll(TZFIELDS_ll, XSVM(:,:,:,JN))
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XSVT(:,:,:,JN))
END DO
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
END IF
!
-!-------------------------------------------------------------------------------
-!
-!* 5. INITIALIZE T-DT FIELDS
-! ----------------------
-!
-IF ((LCH_INIT_FIELD).AND.(CPROGRAM=='MESONH')) THEN
- XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND) = XSVM(:,:,:,NSV_CHEMBEG:NSV_CHEMEND)
- IF (LORILAM) XSVT(:,:,:,NSV_AERBEG:NSV_AEREND) = XSVM(:,:,:,NSV_AERBEG:NSV_AEREND)
-ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 6. INITIALIZE LB IN CASE OF LCH_INIT_FIELD
+!* 5. INITIALIZE LB IN CASE OF LCH_INIT_FIELD
! ---------------------------------------
!
IF ((LCH_INIT_FIELD).AND.(CPROGRAM/='DIAG ').AND.(KMI .EQ. 1)) THEN
@@ -390,24 +381,24 @@ IF ((LCH_INIT_FIELD).AND.(CPROGRAM/='DIAG ').AND.(KMI .EQ. 1)) THEN
IRIMY = INT(ILBY/2)
DO JN = NSV_CHEMBEG,NSV_CHEMEND
IF(LWEST_ll() .AND. .NOT. L1D) &
- XLBXSVM(1:IRIMX+1, :,:,JN) = XSVM(1:IRIMX+1, :,:,JN)
+ XLBXSVM(1:IRIMX+1, :,:,JN) = XSVT(1:IRIMX+1, :,:,JN)
IF(LEAST_ll() .AND. .NOT. L1D) &
- XLBXSVM(ILBX-IRIMX:ILBX,:,:,JN) = XSVM(NIU-IRIMX:NIU, :,:,JN)
+ XLBXSVM(ILBX-IRIMX:ILBX,:,:,JN) = XSVT(NIU-IRIMX:NIU, :,:,JN)
IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
- XLBYSVM(:,1:IRIMY+1, :,JN) = XSVM(:,1:IRIMY+1, :,JN)
+ XLBYSVM(:,1:IRIMY+1, :,JN) = XSVT(:,1:IRIMY+1, :,JN)
IF(LNORTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
- XLBYSVM(:,ILBY-IRIMY:ILBY,:,JN) = XSVM(:,NJU-IRIMY:NJU, :,JN)
+ XLBYSVM(:,ILBY-IRIMY:ILBY,:,JN) = XSVT(:,NJU-IRIMY:NJU, :,JN)
END DO
IF (LORILAM) THEN
DO JN = NSV_AERBEG,NSV_AEREND
IF(LWEST_ll() .AND. .NOT. L1D) &
- XLBXSVM(1:IRIMX+1, :,:,JN) = XSVM(1:IRIMX+1, :,:,JN)
+ XLBXSVM(1:IRIMX+1, :,:,JN) = XSVT(1:IRIMX+1, :,:,JN)
IF(LEAST_ll() .AND. .NOT. L1D) &
- XLBXSVM(ILBX-IRIMX:ILBX,:,:,JN) = XSVM(NIU-IRIMX:NIU, :,:,JN)
+ XLBXSVM(ILBX-IRIMX:ILBX,:,:,JN) = XSVT(NIU-IRIMX:NIU, :,:,JN)
IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
- XLBYSVM(:,1:IRIMY+1, :,JN) = XSVM(:,1:IRIMY+1, :,JN)
+ XLBYSVM(:,1:IRIMY+1, :,JN) = XSVT(:,1:IRIMY+1, :,JN)
IF(LNORTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
- XLBYSVM(:,ILBY-IRIMY:ILBY,:,JN) = XSVM(:,NJU-IRIMY:NJU, :,JN)
+ XLBYSVM(:,ILBY-IRIMY:ILBY,:,JN) = XSVT(:,NJU-IRIMY:NJU, :,JN)
END DO
ENDIF
!
diff --git a/src/MNH/ch_monitorn.f90 b/src/MNH/ch_monitorn.f90
index fe5c5e8d9..415cb84f2 100644
--- a/src/MNH/ch_monitorn.f90
+++ b/src/MNH/ch_monitorn.f90
@@ -175,10 +175,8 @@ USE MODD_CH_SOLVER_n
!
USE MODD_CH_PH_n ! pH value in 3D
!
-USE MODD_FIELD_n, ONLY: XSVM, &! scalar variable at t-dt
- XSVT, &! scalar variable at t
+USE MODD_FIELD_n, ONLY: XSVT, &! scalar variable at t
XRSVS, &! source of scalar variable
- XRM, &! water mixing ratio at t-dt
XRT, &! water mixing ratio at t
XCIT, &! pristine conc. at t
XRRS, &! source of water mixing ratio
@@ -289,8 +287,6 @@ TYPE(METEOTRANSTYPE), DIMENSION(:), ALLOCATABLE :: TZM
!
!
LOGICAL :: GSPLIT ! use timesplitting as temporal discretization
-LOGICAL :: GCENTER ! if not timesplitting, use centered rather than
- ! lagged tendencies
!
INTEGER :: IIU ! Upper dimension in x direction
INTEGER :: IJU ! Upper dimension in y direction
@@ -556,15 +552,12 @@ ZDEN2MOL = 1E-6 * XAVOGADRO / XMD
SELECT CASE (CCH_TDISCRETIZATION)
CASE ("SPLIT")
GSPLIT = .TRUE.
- GCENTER = .FALSE.
IF (KVERB >= 10) WRITE(KLUOUT,*) "CH_MONITOR_n: using SPLIT option"
CASE ("CENTER")
GSPLIT = .FALSE.
- GCENTER = .TRUE.
IF (KVERB >= 10) WRITE(KLUOUT,*) "CH_MONITOR_n: using CENTER option"
CASE ("LAGGED")
GSPLIT = .FALSE.
- GCENTER = .FALSE.
IF (KVERB >= 10) WRITE(KLUOUT,*) "CH_MONITOR_n: using LAGGED option"
CASE DEFAULT
! the following line should never be reached:
@@ -756,16 +749,15 @@ IF (LUSECHAQ.AND.(NRRL>=2) ) THEN
CASE ('C2R2','C3R5')
CALL CH_AQUEOUS_SEDIMC2R2(TDTCUR%TIME, PTSTEP, XRTMIN_AQ, &
XZZ, XRHODREF, XRHODJ, &
- XRM(:,:,:,3),XRRS(:,:,:,3), &
- XSVM(:,:,:,NSV_C2R2BEG+2), &
+ XRT(:,:,:,3),XRRS(:,:,:,3), &
+ XSVT(:,:,:,NSV_C2R2BEG+2), &
XRSVS(:,:,:,NSV_C2R2BEG+2), &
XSVT(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND), &
XRSVS(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND) )
CASE ('KHKO')
CALL CH_AQUEOUS_SEDIMKHKO(PTSTEP , XZZ, XRHODREF, XRHODJ, &
- XRM(:,:,:,3), XRT(:,:,:,3), XRRS(:,:,:,3), &
- XSVM(:,:,:,NSV_C2R2BEG+2), &
+ XRT(:,:,:,3), XRRS(:,:,:,3), &
XSVT(:,:,:,NSV_C2R2BEG+2), &
XRSVS(:,:,:,NSV_C2R2BEG+2), &
XSVT(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND), &
@@ -836,10 +828,8 @@ DO JL=1,ISVECNMASK
ZCONV(JM+1) = (XRHODREF(JI,JJ,JK)/XRHODJ(JI,JJ,JK))*ZDEN2MOL
IF (GSPLIT) THEN
ZAERO(JM+1,JN) = XRSVS(JI,JJ,JK,NSV_AERBEG+JN-1)*PTSTEP*ZCONV(JM+1)
- ELSE IF (GCENTER) THEN
+ ELSE
ZAERO(JM+1,JN) = XSVT(JI,JJ,JK,NSV_AERBEG+JN-1)*ZDEN2MOL*XRHODREF(JI,JJ,JK)
- ELSE
- ZAERO(JM+1,JN) = XSVM(JI,JJ,JK,NSV_AERBEG+JN-1)*ZDEN2MOL*XRHODREF(JI,JJ,JK)
END IF
END DO
END DO
@@ -876,7 +866,7 @@ DO JL=1,ISVECNMASK
ENDIF
END DO
END DO
- ELSE IF (GCENTER) THEN
+ ELSE
DO JM = 0, ISVECNPT-1
!Vectorization:
!ocl novrec
@@ -899,29 +889,6 @@ DO JL=1,ISVECNMASK
ENDIF
END DO
END DO
- ELSE
- DO JM = 0, ISVECNPT-1
-!Vectorization:
-!ocl novrec
-!cdir nodep
- JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL)
- JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL)
- JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL)
-!
- ZCONV(JM+1) = (XRHODREF(JI,JJ,JK)/XRHODJ(JI,JJ,JK))*ZDEN2MOL
- DO JN = 1, LU_DIM_SPECIES(JM+1)
- ZCHEM(JM+1,JN) = XSVM(JI,JJ,JK,NSV_CHEMBEG+JN-1) * ZDEN2MOL &
- * XRHODREF(JI,JJ,JK)
- END DO
- DO JN = 1, NEQAQ/2 ! set aqueous concentrations to zero where LW<XRTMIN_AQ
- IF (((XRM(JI,JJ,JK,2)*XRHODREF(JI,JJ,JK))/1.e3) < XRTMIN_AQ) THEN ! cloud
- ZCHEM(JM+1,NEQ-NEQAQ+JN) = 0.
- ENDIF
- IF (((XRM(JI,JJ,JK,3)*XRHODREF(JI,JJ,JK))/1.e3) < XRTMIN_AQ) THEN ! rain
- ZCHEM(JM+1,NEQ-NEQAQ/2+JN) = 0.
- ENDIF
- END DO
- END DO
END IF
!
!* 4.2 transfer meteo data into chemical core system
@@ -934,18 +901,12 @@ DO JL=1,ISVECNMASK
TDTCUR%TDATE%MONTH, TDTCUR%TDATE%YEAR, &
XLAT, XLON, XLAT0, XLON0, LUSERV, LUSERC, &
LUSERR, KLUOUT, CCLOUD, PTSTEP )
- ELSE IF (GCENTER) THEN
+ ELSE
CALL CH_METEO_TRANS_KESS(JL, XRHODJ, XRHODREF, XRT, XTHT, XPABST, &
ISVECNPT, ISVECMASK, TZM, TDTCUR%TDATE%DAY, &
TDTCUR%TDATE%MONTH, TDTCUR%TDATE%YEAR, &
XLAT, XLON, XLAT0, XLON0, LUSERV, LUSERC, &
LUSERR, KLUOUT, CCLOUD )
- ELSE
- CALL CH_METEO_TRANS_KESS(JL, XRHODJ, XRHODREF, XRM, XTHT, XPABST, &
- ISVECNPT, ISVECMASK, TZM, TDTCUR%TDATE%DAY, &
- TDTCUR%TDATE%MONTH, TDTCUR%TDATE%YEAR, &
- XLAT, XLON, XLAT0, XLON0, LUSERV, LUSERC, &
- LUSERR, KLUOUT, CCLOUD )
ENDIF
CASE ('C2R2','KHKO','C3R5') !add cloud and rain C. for mean radius
@@ -955,18 +916,12 @@ DO JL=1,ISVECNMASK
ISVECMASK, TZM, TDTCUR%TDATE%DAY, TDTCUR%TDATE%MONTH, &
TDTCUR%TDATE%YEAR, XLAT,XLON, XLAT0, XLON0, LUSERV, &
LUSERC, LUSERR, KLUOUT, CCLOUD, PTSTEP )
- ELSE IF (GCENTER) THEN
+ ELSE
CALL CH_METEO_TRANS_C2R2(JL, XRHODJ, XRHODREF, XRT, XSVT(:,:,:,NSV_C2R2BEG+1), &
XSVT(:,:,:,NSV_C2R2BEG+2), XTHT, XPABST, ISVECNPT, &
ISVECMASK, TZM, TDTCUR%TDATE%DAY, TDTCUR%TDATE%MONTH, &
TDTCUR%TDATE%YEAR, XLAT,XLON, XLAT0, XLON0, LUSERV, &
LUSERC, LUSERR, KLUOUT, CCLOUD )
- ELSE
- CALL CH_METEO_TRANS_C2R2(JL, XRHODJ, XRHODREF, XRM, XSVM(:,:,:,NSV_C2R2BEG+1), &
- XSVM(:,:,:,NSV_C2R2BEG+2), XTHT, XPABST, ISVECNPT, &
- ISVECMASK, TZM, TDTCUR%TDATE%DAY, TDTCUR%TDATE%MONTH, &
- TDTCUR%TDATE%YEAR, XLAT, XLON, XLAT0, XLON0, LUSERV, &
- LUSERC, LUSERR, KLUOUT, CCLOUD )
ENDIF
END SELECT
!
@@ -1341,7 +1296,7 @@ END DO
.OR. XRRS(JI,JJ,JK,3)>(ZRTMIN_AQ*1.e3/XRHODREF(JI,JJ,JK))
END DO
END SELECT
- ELSE IF (GCENTER) THEN
+ ELSE
SELECT CASE ( CCLOUD )
CASE('REVE')
DO JM=0,ISVECNPT-1
@@ -1359,24 +1314,6 @@ END DO
.OR. XRT(JI,JJ,JK,3)>(XRTMIN_AQ*1.e3/XRHODREF(JI,JJ,JK))
END DO
END SELECT
- ELSE
- SELECT CASE ( CCLOUD )
- CASE('REVE')
- DO JM=0,ISVECNPT-1
- JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL)
- JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL)
- JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL)
- GWATER(JM+1) = XRM(JI,JJ,JK,2)>(XRTMIN_AQ*1.e3/XRHODREF(JI,JJ,JK))
- END DO
- CASE('KESS','ICE3','ICE4','C2R2','C3R5','KHKO')
- DO JM=0,ISVECNPT-1
- JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL)
- JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL)
- JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL)
- GWATER(JM+1) = XRM(JI,JJ,JK,2)>(XRTMIN_AQ*1.e3/XRHODREF(JI,JJ,JK)) &
- .OR. XRM(JI,JJ,JK,3)>(XRTMIN_AQ*1.e3/XRHODREF(JI,JJ,JK))
- END DO
- END SELECT
END IF
IWATER = COUNT(GWATER(:))
ALLOCATE(IMASKAQ(ISVECNPT)); IMASKAQ(:) = 0
diff --git a/src/MNH/compute_function_thermo.f90 b/src/MNH/compute_function_thermo.f90
new file mode 100644
index 000000000..b36b55ff4
--- /dev/null
+++ b/src/MNH/compute_function_thermo.f90
@@ -0,0 +1,258 @@
+! ######################################
+ MODULE MODI_COMPUTE_FUNCTION_THERMO
+! ######################################
+!
+INTERFACE
+
+! #################################################################
+ SUBROUTINE COMPUTE_FUNCTION_THERMO( KRR, &
+ PTH, PR, PEXN, PPABS, &
+ PT,PLVOCPEXN,PLSOCPEXN, &
+ PAMOIST,PATHETA )
+! #################################################################
+
+!* 1.1 Declaration of Arguments
+!
+
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(:,:,:) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct.
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PT ! temperature
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLVOCPEXN,PLSOCPEXN ! L/(cp*Pi)
+
+REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PAMOIST,PATHETA
+!
+END SUBROUTINE COMPUTE_FUNCTION_THERMO
+
+END INTERFACE
+!
+END MODULE MODI_COMPUTE_FUNCTION_THERMO
+
+
+! #################################################################
+ SUBROUTINE COMPUTE_FUNCTION_THERMO( KRR, &
+ PTH, PR, PEXN, PPABS, &
+ PT,PLVOCPEXN,PLSOCPEXN, &
+ PAMOIST,PATHETA )
+! #################################################################
+!
+!!
+!!**** *COMPUTE_FUNCTION_THERMO* -
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! JP Pinty *LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/02/03
+!! Externalisation of computations done in TURB and MF_TURB (Malardel and Pergaud, fev. 2007)
+!! Optimization : V.Masson, 09/2010
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(:,:,:) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct.
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PT ! temperature
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLVOCPEXN,PLSOCPEXN ! L/(cp*Pi)
+
+REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PAMOIST,PATHETA
+!
+!-------------------------------------------------------------------------------
+!
+!* 0.2 Declarations of local variables
+!
+REAL :: ZEPS ! XMV / XMD
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: &
+ ZCP, & ! Cp
+ ZE, & ! Saturation mixing ratio
+ ZDEDT, & ! Saturation mixing ratio derivative
+ ZFRAC_ICE, & ! Ice fraction
+ ZAMOIST_W, & ! Coefficients for s = f (Thetal,Rnp)
+ ZATHETA_W, & !
+ ZAMOIST_I, & !
+ ZATHETA_I !
+
+INTEGER :: JRR
+INTEGER :: IRRL, IRRI
+!
+!-------------------------------------------------------------------------------
+!
+ IRRI=0
+ IRRL=0
+ IF (KRR>=2) IRRL=MIN(KRR-1,2)
+ IF (KRR>=4) IRRI=KRR-3
+!
+ ZEPS = XMV / XMD
+
+ PLVOCPEXN(:,:,:) = 0.
+ PLSOCPEXN(:,:,:) = 0.
+ ZFRAC_ICE(:,:,:) = 0.0
+
+!
+!* Cph
+!
+ZCP=XCPD
+
+IF (KRR > 0) ZCP(:,:,:) = ZCP(:,:,:) + XCPV * PR(:,:,:,1)
+
+DO JRR = 2,1+IRRL ! loop on the liquid components
+ ZCP(:,:,:) = ZCP(:,:,:) + XCL * PR(:,:,:,JRR)
+END DO
+
+DO JRR = 2+IRRL,1+IRRL+IRRI ! loop on the solid components
+ ZCP(:,:,:) = ZCP(:,:,:) + XCI * PR(:,:,:,JRR)
+END DO
+
+!* Temperature
+!
+PT(:,:,:) = PTH(:,:,:) * PEXN(:,:,:)
+!
+!
+!! Liquid water
+!
+IF ( IRRL >= 1 ) THEN
+!
+!* Lv/Cph
+!
+ PLVOCPEXN(:,:,:) = (XLVTT + (XCPV-XCL) * (PT(:,:,:)-XTT) ) / ZCP(:,:,:)
+!
+ IF (PRESENT(PAMOIST)) THEN
+!
+!* Saturation vapor pressure with respect to water
+!
+ ZE(:,:,:) = EXP( XALPW - XBETAW/PT(:,:,:) - XGAMW*ALOG( PT(:,:,:) ) )
+!
+!* Saturation mixing ratio with respect to water
+!
+ ZE(:,:,:) = ZE(:,:,:) * ZEPS / ( PPABS(:,:,:) - ZE(:,:,:) )
+!
+!* Compute the saturation mixing ratio derivative (rvs')
+!
+ ZDEDT(:,:,:) = ( XBETAW / PT(:,:,:) - XGAMW ) / PT(:,:,:) &
+ * ZE(:,:,:) * ( 1. + ZE(:,:,:) / ZEPS )
+!
+!* Compute Amoist
+!
+ PAMOIST(:,:,:) = 0.
+ PATHETA(:,:,:) = 0.
+ ZAMOIST_W(:,:,:)= 0.5 / ( 1.0 + ZDEDT(:,:,:) * PLVOCPEXN(:,:,:) )
+!
+!* Compute Atheta
+!
+ ZATHETA_W(:,:,:)= ZAMOIST_W(:,:,:) * PEXN(:,:,:) * &
+ ( ( ZE(:,:,:) - PR(:,:,:,1) ) * PLVOCPEXN(:,:,:) / &
+ ( 1. + ZDEDT(:,:,:) * PLVOCPEXN(:,:,:) ) * &
+ ( &
+ ZE(:,:,:) * (1. + ZE(:,:,:)/ZEPS) &
+ * ( -2.*XBETAW/PT(:,:,:) + XGAMW ) / PT(:,:,:)**2 &
+ +ZDEDT(:,:,:) * (1. + 2. * ZE(:,:,:)/ZEPS) &
+ * ( XBETAW/PT(:,:,:) - XGAMW ) / PT(:,:,:) &
+ ) &
+ - ZDEDT(:,:,:) &
+ )
+ END IF
+!
+!! Solid water
+!
+ IF ( IRRI >= 1 ) THEN
+
+!
+!* Fraction of ice
+!
+ WHERE(PR(:,:,:,2)+PR(:,:,:,4)>0.0)
+ ZFRAC_ICE(:,:,:) = PR(:,:,:,4) / ( PR(:,:,:,2)+PR(:,:,:,4) )
+ END WHERE
+!
+!* Ls/Cph
+!
+ PLSOCPEXN(:,:,:) = (XLSTT + (XCPV-XCI) * (PT(:,:,:)-XTT) ) / ZCP(:,:,:)
+!
+ IF (PRESENT(PAMOIST)) THEN
+!
+!* Saturation vapor pressure with respect to ice
+!
+ ZE(:,:,:) = EXP( XALPI - XBETAI/PT(:,:,:) - XGAMI*ALOG( PT(:,:,:) ) )
+!
+!* Saturation mixing ratio with respect to ice
+!
+ ZE(:,:,:) = ZE(:,:,:) * ZEPS / ( PPABS(:,:,:) - ZE(:,:,:) )
+!
+!* Compute the saturation mixing ratio derivative (rvs')
+!
+ ZDEDT(:,:,:) = ( XBETAI / PT(:,:,:) - XGAMI ) / PT(:,:,:) &
+ * ZE(:,:,:) * ( 1. + ZE(:,:,:) / ZEPS )
+!
+!* Compute Amoist
+!
+ ZAMOIST_I(:,:,:)= 0.5 / ( 1.0 + ZDEDT(:,:,:) * PLSOCPEXN(:,:,:) )
+!
+!* Compute Atheta
+!
+ ZATHETA_I(:,:,:)= ZAMOIST_I(:,:,:) * PEXN(:,:,:) * &
+ ( ( ZE(:,:,:) - PR(:,:,:,1) ) * PLSOCPEXN(:,:,:) / &
+ ( 1. + ZDEDT(:,:,:) * PLSOCPEXN(:,:,:) ) * &
+ ( &
+ ZE(:,:,:) * (1. + ZE(:,:,:)/ZEPS) &
+ * ( -2.*XBETAI/PT(:,:,:) + XGAMI ) / PT(:,:,:)**2 &
+ +ZDEDT(:,:,:) * (1. + 2. * ZE(:,:,:)/ZEPS) &
+ * ( XBETAI/PT(:,:,:) - XGAMI ) / PT(:,:,:) &
+ ) &
+ - ZDEDT(:,:,:) &
+ )
+
+
+ ENDIF
+ ENDIF
+
+ IF (PRESENT(PAMOIST)) THEN
+ PAMOIST(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZAMOIST_W(:,:,:) &
+ +ZFRAC_ICE(:,:,:) *ZAMOIST_I(:,:,:)
+ PATHETA(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZATHETA_W(:,:,:) &
+ +ZFRAC_ICE(:,:,:) *ZATHETA_I(:,:,:)
+ ENDIF
+
+!
+!* Lv/Cph/Exner and Ls/Cph/Exner
+!
+ PLVOCPEXN(:,:,:) = PLVOCPEXN(:,:,:) / PEXN(:,:,:)
+ PLSOCPEXN(:,:,:) = PLSOCPEXN(:,:,:) / PEXN(:,:,:)
+!
+ENDIF
+
+END SUBROUTINE COMPUTE_FUNCTION_THERMO
diff --git a/src/MNH/compute_r00.f90 b/src/MNH/compute_r00.f90
index 21293bda7..509c67414 100644
--- a/src/MNH/compute_r00.f90
+++ b/src/MNH/compute_r00.f90
@@ -212,9 +212,9 @@ ZXMAX=ZXMAX*1.E-3
ZYMAX=ZYMAX*1.E-3
ZZMAX=ZZMAX*1.E-3
!
-ZX00(:,:,:)=XSVM(:,:,:,NSV_LGBEG)*1.E-3 ! ZX0 in km
-ZY00(:,:,:)=XSVM(:,:,:,NSV_LGBEG+1)*1.E-3 ! ZY0 in km
-ZZ00(:,:,:)=XSVM(:,:,:,NSV_LGEND)*1.E-3 ! ZZ0 in km
+ZX00(:,:,:)=XSVT(:,:,:,NSV_LGBEG)*1.E-3 ! ZX0 in km
+ZY00(:,:,:)=XSVT(:,:,:,NSV_LGBEG+1)*1.E-3 ! ZY0 in km
+ZZ00(:,:,:)=XSVT(:,:,:,NSV_LGEND)*1.E-3 ! ZZ0 in km
!
IF (L2D) THEN
WHERE ( ZX00<ZXOR .OR. ZX00>ZXMAX .OR. &
@@ -270,11 +270,11 @@ DO JFILECUR=1,NFILES
WRITE(YDATE,FMT='(1X,I4.4,I2.2,I2.2,2X,I2.2,"H",I2.2,"M", &
& F5.2,"S")') TDTCUR_START%TDATE, IHOUR,IMINUTE,ZSECOND
!
- YRECFM='THM'
+ YRECFM='THT'
CALL FMREAD(CFILES(NBRFILES(JFILECUR)),YRECFM,CLUOUT,'XY', &
ZTH0(:,:,:),IGRID,ILENCH,YCOMMENT,IRESP)
!
- YRECFM='RVM'
+ YRECFM='RVT'
CALL FMREAD(CFILES(NBRFILES(JFILECUR)),YRECFM,CLUOUT,'XY', &
ZRV0(:,:,:),IGRID,ILENCH,YCOMMENT,IRESP)
!
diff --git a/src/MNH/deallocate_model1.f90 b/src/MNH/deallocate_model1.f90
index 08eef4d13..d2986dbb8 100644
--- a/src/MNH/deallocate_model1.f90
+++ b/src/MNH/deallocate_model1.f90
@@ -97,6 +97,8 @@ USE MODD_DEF_EDDYUV_FLUX_n ! For EDDY FLUXES
USE MODD_2D_FRC
USE MODD_ADVFRC_n ! For ADVFRC and EDDY FLUXES
USE MODD_RELFRC_n
+USE MODD_ADV_n
+USE MODD_PAST_FIELD_n
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -114,14 +116,18 @@ CALL GOTO_MODEL(1)
!* 1. Module MODD_FIELD$n
!
IF ( KCALL==3 ) THEN
- DEALLOCATE(XUM)
- DEALLOCATE(XVM)
- DEALLOCATE(XWM)
- DEALLOCATE(XTHM)
- IF (ASSOCIATED(XUT)) DEALLOCATE(XUT)
- IF (ASSOCIATED(XVT)) DEALLOCATE(XVT)
- IF (ASSOCIATED(XWT)) DEALLOCATE(XWT)
- IF (ASSOCIATED(XTHT)) DEALLOCATE(XTHT)
+ IF (CUVW_ADV_SCHEME(1:3)=='CEN') THEN
+ DEALLOCATE(XUM)
+ DEALLOCATE(XVM)
+ DEALLOCATE(XWM)
+ DEALLOCATE(XDUM)
+ DEALLOCATE(XDVM)
+ DEALLOCATE(XDWM)
+ END IF
+ DEALLOCATE(XUT)
+ DEALLOCATE(XVT)
+ DEALLOCATE(XWT)
+ DEALLOCATE(XTHT)
IF (L2D_ADV_FRC) THEN
IF (ASSOCIATED(XDTHFRC)) DEALLOCATE(XDTHFRC)
IF (ASSOCIATED(XDRVFRC)) DEALLOCATE(XDRVFRC)
@@ -146,10 +152,11 @@ IF ( KCALL==1 ) THEN
DEALLOCATE(XRVS)
DEALLOCATE(XRWS)
DEALLOCATE(XRTHS)
+ DEALLOCATE(XRUS_PRES, XRVS_PRES, XRWS_PRES )
+ DEALLOCATE(XRTHS_CLD )
END IF
!
IF ( KCALL==3 ) THEN
- IF (ASSOCIATED(XTKEM)) DEALLOCATE(XTKEM)
IF (ASSOCIATED(XTKET)) DEALLOCATE(XTKET)
END IF
IF ( ASSOCIATED(XRTKES) .AND. KCALL==1 ) THEN
@@ -157,20 +164,18 @@ IF ( ASSOCIATED(XRTKES) .AND. KCALL==1 ) THEN
END IF
!
IF ( KCALL==3 ) THEN
- DEALLOCATE(XPABSM)
- IF (ASSOCIATED(XPABST)) DEALLOCATE(XPABST)
+ DEALLOCATE(XPABST)
!
- DEALLOCATE(XRM)
- IF (ASSOCIATED(XRT)) DEALLOCATE(XRT)
+ DEALLOCATE(XRT)
END IF
!
IF ( KCALL==1 ) THEN
DEALLOCATE(XRRS)
+ DEALLOCATE(XRRS_CLD)
END IF
!
-IF ( ASSOCIATED(XSRCM) .AND. KCALL==3 ) THEN
- DEALLOCATE(XSRCM)
- IF (ASSOCIATED(XSRCT)) DEALLOCATE(XSRCT)
+IF ( ASSOCIATED(XSRCT) .AND. KCALL==3 ) THEN
+ DEALLOCATE(XSRCT)
DEALLOCATE(XSIGS)
END IF
!
@@ -179,11 +184,11 @@ IF ( ASSOCIATED(XCLDFR) .AND. KCALL==2 ) THEN
END IF
!
IF ( KCALL == 3 ) THEN
- DEALLOCATE(XSVM)
- IF (ASSOCIATED(XSVT)) DEALLOCATE(XSVT)
+ DEALLOCATE(XSVT)
END IF
IF ( KCALL == 1 ) THEN
DEALLOCATE(XRSVS)
+ DEALLOCATE(XRSVS_CLD)
END IF
!
!
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 61600184f..9d06c614a 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -298,6 +298,7 @@ IF (KMI == 1) THEN
LINIT_LG = .FALSE.
CINIT_LG = 'FMOUT'
LNOMIXLG = .FALSE.
+ LCHECK = .FALSE.
END IF
!
CCLOUD = 'NONE'
@@ -395,10 +396,15 @@ END IF
!* 5. SET DEFAULT VALUES FOR MODD_ADV_n :
! ----------------------------------
!
-CUVW_ADV_SCHEME = 'CEN4TH'
+CUVW_ADV_SCHEME = 'WENO_K'
CMET_ADV_SCHEME = 'PPM_01'
CSV_ADV_SCHEME = 'PPM_01'
-NLITER = 2
+CTEMP_SCHEME = 'RK21'
+NWENO_ORDER = 3
+NSPLIT = 1
+LSPLIT_CFL = .TRUE.
+XSPLIT_CFL = 0.8
+LCFL_WRIT = .FALSE.
!
!-------------------------------------------------------------------------------
!
@@ -424,7 +430,6 @@ CLBCY(2) ='CYCL'
NLBLX(:) = 1
NLBLY(:) = 1
XCPHASE = 20.
-XCPHASE_PBL = 0.
!
!-------------------------------------------------------------------------------
!
@@ -500,9 +505,7 @@ IF (KMI == 1) THEN
LBU_RU = .FALSE.
NASSEU = 0
NNESTU = 0
- NADVXU = 0
- NADVYU = 0
- NADVZU = 0
+ NADVU = 0
NFRCU = 0
NNUDU = 0
NCURVU = 0
@@ -519,9 +522,7 @@ IF (KMI == 1) THEN
LBU_RV = .FALSE.
NASSEV = 0
NNESTV = 0
- NADVXV = 0
- NADVYV = 0
- NADVZV = 0
+ NADVV = 0
NFRCV = 0
NNUDV = 0
NCURVV = 0
@@ -538,9 +539,7 @@ IF (KMI == 1) THEN
LBU_RW = .FALSE.
NASSEW = 0
NNESTW = 0
- NADVXW = 0
- NADVYW = 0
- NADVZW = 0
+ NADVW = 0
NFRCW = 0
NNUDW = 0
NCURVW = 0
@@ -557,9 +556,6 @@ IF (KMI == 1) THEN
NASSETH = 0
NNESTTH = 0
NADVTH = 0
- NADVXTH = 0
- NADVYTH = 0
- NADVZTH = 0
NFRCTH = 0
NNUDTH = 0
NPREFTH = 0
@@ -596,9 +592,6 @@ IF (KMI == 1) THEN
LBU_RTKE = .FALSE.
NASSETKE = 0
NADVTKE = 0
- NADVXTKE = 0
- NADVYTKE = 0
- NADVZTKE = 0
NFRCTKE = 0
NDIFTKE = 0
NRELTKE = 0
@@ -613,9 +606,6 @@ IF (KMI == 1) THEN
NASSERV = 0
NNESTRV = 0
NADVRV = 0
- NADVXRV = 0
- NADVYRV = 0
- NADVZRV = 0
NFRCRV = 0
NNUDRV = 0
NDIFRV = 0
@@ -638,9 +628,6 @@ IF (KMI == 1) THEN
NASSERC = 0
NNESTRC = 0
NADVRC = 0
- NADVXRC = 0
- NADVYRC = 0
- NADVZRC = 0
NFRCRC = 0
NDIFRC = 0
NRELRC = 0
@@ -667,9 +654,6 @@ IF (KMI == 1) THEN
NASSERR = 0
NNESTRR = 0
NADVRR = 0
- NADVXRR = 0
- NADVYRR = 0
- NADVZRR = 0
NFRCRR = 0
NDIFRR = 0
NRELRR = 0
@@ -692,9 +676,6 @@ IF (KMI == 1) THEN
NASSERI = 0
NNESTRI = 0
NADVRI = 0
- NADVXRI = 0
- NADVYRI = 0
- NADVZRI = 0
NFRCRI = 0
NDIFRI = 0
NRELRI = 0
@@ -720,9 +701,6 @@ IF (KMI == 1) THEN
NASSERS = 0
NNESTRS = 0
NADVRS = 0
- NADVXRS = 0
- NADVYRS = 0
- NADVZRS = 0
NFRCRS = 0
NDIFRS = 0
NRELRS = 0
@@ -743,9 +721,6 @@ IF (KMI == 1) THEN
NASSERG = 0
NNESTRG = 0
NADVRG = 0
- NADVXRG = 0
- NADVYRG = 0
- NADVZRG = 0
NFRCRG = 0
NDIFRG = 0
NRELRG = 0
@@ -767,9 +742,6 @@ IF (KMI == 1) THEN
NASSERH = 0
NNESTRH = 0
NADVRH = 0
- NADVXRH = 0
- NADVYRH = 0
- NADVZRH = 0
NFRCRH = 0
NDIFRH = 0
NRELRH = 0
@@ -783,9 +755,6 @@ IF (KMI == 1) THEN
NASSESV = 0
NNESTSV = 0
NADVSV = 0
- NADVXSV = 0
- NADVYSV = 0
- NADVZSV = 0
NFRCSV = 0
NDIFSV = 0
NRELSV = 0
diff --git a/src/MNH/diag.f90 b/src/MNH/diag.f90
index 7c438f350..8d72a3fc4 100644
--- a/src/MNH/diag.f90
+++ b/src/MNH/diag.f90
@@ -591,18 +591,18 @@ IF ( .NOT. LTURB_FLX .AND. .NOT. LTURB_DIAG .AND. &
CTURB = 'NONE'
END IF
! no way to compute the turbulent tendencies.
-IF ( ( LTURB_FLX .OR. LTURB_DIAG .OR. LMF_FLX ) &
- .AND. CSTORAGE_TYPE/='MT' ) THEN
- CTURB = 'NONE'
- PRINT*, '******************* WARNING in DIAG ***********************'
- PRINT*, ' '
- PRINT*, 'You wanted to compute turbulence fluxes or diagnostics,'
- PRINT*, 'But the initial file comes from PREP_REAL_CASE.'
- PRINT*, 'Therefore, the boundary layer turbulence is meaningless.'
- PRINT*, 'Turbulence fluxes and diagnostics will NOT be computed'
- PRINT*, 'Please make your turbulence diagnostics from a meso-NH file'
- PRINT*, 'coming from a MESO-NH simulation.'
-END IF
+!IF ( ( LTURB_FLX .OR. LTURB_DIAG .OR. LMF_FLX ) &
+! .AND. CSTORAGE_TYPE/='MT' ) THEN
+! CTURB = 'NONE'
+! PRINT*, '******************* WARNING in DIAG ***********************'
+! PRINT*, ' '
+! PRINT*, 'You wanted to compute turbulence fluxes or diagnostics,'
+! PRINT*, 'But the initial file comes from PREP_REAL_CASE.'
+! PRINT*, 'Therefore, the boundary layer turbulence is meaningless.'
+! PRINT*, 'Turbulence fluxes and diagnostics will NOT be computed'
+! PRINT*, 'Please make your turbulence diagnostics from a meso-NH file'
+! PRINT*, 'coming from a MESO-NH simulation.'
+!END IF
!
!* convective scheme
!
@@ -640,7 +640,7 @@ END IF
!
IF ( CTURB /= 'NONE' .OR. CDCONV /= 'NONE' .OR. CSCONV /= 'NONE' &
.OR. CRAD /= 'NONE' ) THEN
- IF (CSTORAGE_TYPE/='MT') THEN
+! IF (CSTORAGE_TYPE/='MT') THEN
IF (XDTSTEP==XUNDEF) THEN
PRINT*, ' '
PRINT*, '******************* WARNING in DIAG ***********************'
@@ -652,7 +652,7 @@ IF ( CTURB /= 'NONE' .OR. CDCONV /= 'NONE' .OR. CSCONV /= 'NONE' &
ELSE
XTSTEP=XDTSTEP
END IF
- END IF
+! END IF
PRINT*,' XTSTEP= ', XTSTEP
PRINT*, ' '
PRINT*, 'DIAG BEFORE PHYS_PARAM1: CTURB=',CTURB,' CDCONV=',CDCONV, &
@@ -675,8 +675,7 @@ XTIME_LES=0.
XTIME_LES_BU_PROCESS=0.
XTIME_BU_PROCESS=0.
!
-CALL PHYS_PARAM_n(1,XTSTEP,XTSTEP,XTSTEP,YFMFILE,GCLOSE_OUT, &
- CUVW_ADV_SCHEME,CMET_ADV_SCHEME,CSV_ADV_SCHEME, &
+CALL PHYS_PARAM_n(1,YFMFILE,GCLOSE_OUT, &
ZRAD,ZSHADOWS,ZDCONV,ZGROUND,ZMAFL,ZDRAG, &
ZTURB,ZTRACER, ZCHEM,ZTIME_BU,GMASKkids)
PRINT*, 'DIAG AFTER PHYS_PARAM1'
@@ -767,6 +766,7 @@ ZTIME1=ZTIME2
!
!* 9.0 Closes the FM files
!
+DEALLOCATE(GMASKkids)
IF (GCLOSE_OUT) THEN
GCLOSE_OUT=.FALSE.
CALL FMCLOS_ll(YFMFILE,'KEEP',CLUOUT,IRESP)
diff --git a/src/MNH/dyn_sources.f90 b/src/MNH/dyn_sources.f90
index 77591a042..3a1169ea8 100644
--- a/src/MNH/dyn_sources.f90
+++ b/src/MNH/dyn_sources.f90
@@ -10,7 +10,7 @@
!
INTERFACE
!
- SUBROUTINE DYN_SOURCES( KRR,KRRL, KRRI, KMI, &
+ SUBROUTINE DYN_SOURCES( KRR,KRRL, KRRI, &
PUT, PVT, PWT, PTHT, PRT, &
PCORIOX, PCORIOY, PCORIOZ, PCURVX, PCURVY, &
PRHODJ, PZZ, PTHVREF, PEXNREF, &
@@ -19,7 +19,6 @@ INTERFACE
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.
-INTEGER, INTENT(IN) :: KMI ! Model number
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! at
@@ -47,7 +46,7 @@ END INTERFACE
!
END MODULE MODI_DYN_SOURCES
! ######################################################################
- SUBROUTINE DYN_SOURCES( KRR,KRRL, KRRI, KMI, &
+ SUBROUTINE DYN_SOURCES( KRR,KRRL, KRRI, &
PUT, PVT, PWT, PTHT, PRT, &
PCORIOX, PCORIOY, PCORIOZ, PCURVX, PCURVY, &
PRHODJ, PZZ, PTHVREF, PEXNREF, &
@@ -147,7 +146,7 @@ END MODULE MODI_DYN_SOURCES
!! Corrections 19/12/96 (J.-P. Pinty) Update the CALL BUDGET
!! Corrections 03/12/02 (P. Jabouille) add no thinshell condition
!! Correction 06/10 (C.Lac) Exclude L1D for Coriolis term
-!!
+!! Modification 03/11 (C.Lac) Split the gravity term due to buoyancy
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -169,7 +168,6 @@ IMPLICIT NONE
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.
-INTEGER, INTENT(IN) :: KMI ! Model index
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! at
@@ -194,7 +192,6 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS ! Sources of theta
!
!* 0.2 Declarations of local variables :
!
-REAL :: ZRV_OV_RD ! = RV / RD
REAL :: ZCPD_OV_RD ! = CPD / RD
REAL :: ZG_OV_CPD ! =-XG / XCPD
INTEGER :: JWATER ! loop index on the different types of water
@@ -292,45 +289,8 @@ IF (LBUDGET_V) CALL BUDGET (PRVS,2,'COR_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,3,'COR_BU_RW')
!
!-------------------------------------------------------------------------------
-!* 4. COMPUTES THE GRAVITY TERM
-! -------------------------
-!
-IF( .NOT.L1D ) THEN ! no buoyancy for 1D case
-!
- IF(KRR > 0) THEN
-!
-! compute the ratio : 1 + total water mass / dry air mass
-!
- ZRV_OV_RD = XRV / XRD
- ZWORK1(:,:,:) = 1.
- DO JWATER = 1 , 1+KRRL+KRRI
- ZWORK1(:,:,:) = ZWORK1(:,:,:) + PRT(:,:,:,JWATER)
- END DO
-!
-! compute the virtual potential temperature when water is present in any form
-!
- ZWORK2(:,:,:) = PTHT(:,:,:) * (1. + PRT(:,:,:,1)*ZRV_OV_RD) / ZWORK1(:,:,:)
- ELSE
-!
-! compute the virtual potential temperature when water is absent
-!
- ZWORK2(:,:,:) = PTHT(:,:,:)
- END IF
-!
-! compute the gravity term
-!
- PRWS(:,:,:) = PRWS + XG * MZM(1,IKU,1, ( (ZWORK2/PTHVREF) - 1. ) * PRHODJ )
-!
-! the extrapolation for the PTHT and the THVREF must be the same at the
-! ground
-!
- IF (LBUDGET_W) CALL BUDGET (PRWS,3,'GRAV_BU_RW')
-!
-END IF
-!
-!-------------------------------------------------------------------------------
!
-!* 5. COMPUTES THE THETA SOURCE TERM DUE TO THE REFERENCE PRESSURE
+!* 4. COMPUTES THE THETA SOURCE TERM DUE TO THE REFERENCE PRESSURE
! ------------------------------------------------------------
!
IF (LCARTESIAN .OR. LTHINSHELL) THEN
diff --git a/src/MNH/endstep.f90 b/src/MNH/endstep.f90
index 54b516d93..07a6dbf2d 100644
--- a/src/MNH/endstep.f90
+++ b/src/MNH/endstep.f90
@@ -9,8 +9,8 @@
!
INTERFACE
!
- SUBROUTINE ENDSTEP (PTSTEP,PTSTEP_UVW,PTSTEP_MET,PTSTEP_SV, &
- KRR,KSV,KTCOUNT,KMI,PRHODJ, &
+ SUBROUTINE ENDSTEP (PTSTEP,KRR,KSV,KTCOUNT,KMI, &
+ HUVW_ADV_SCHEME,PRHODJ, &
PUS,PVS,PWS,PDRYMASSS, &
PTHS,PRS,PTKES,PSVS, &
PLSUS,PLSVS,PLSWS, &
@@ -19,29 +19,22 @@ INTERFACE
PLBXTHS,PLBXRS,PLBXTKES,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS, &
PLBYTHS,PLBYRS,PLBYTKES,PLBYSVS, &
- PUM,PVM,PWM,PPABSM, &
- PTHM,PRM,PTKEM,PSVM,PSRCM, &
+ PUM,PVM,PWM, &
PUT,PVT,PWT,PPABST,PDRYMASST, &
- PTHT,PRT,PTKET,PSVT,PSRCT, &
+ PTHT,PRT,PTHM,PRCM,PPABSM,PTKET,PSVT, &
PLSUM,PLSVM,PLSWM, &
PLSTHM,PLSRVM, &
PLBXUM,PLBXVM,PLBXWM, &
PLBXTHM,PLBXRM,PLBXTKEM,PLBXSVM, &
PLBYUM,PLBYVM,PLBYWM, &
- PLBYTHM,PLBYRM,PLBYTKEM,PLBYSVM, &
- HMET_ADV_SCHEME,HSV_ADV_SCHEME )
+ PLBYTHM,PLBYRM,PLBYTKEM,PLBYSVM )
!
REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, INTENT(IN) :: PTSTEP_UVW ! Effective time step for
- ! momentum advection
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective time step for
- ! meteorological variables advection
-REAL, INTENT(IN) :: PTSTEP_SV ! Effective time step for
- ! scalar variables advection
INTEGER, INTENT(IN) :: KRR ! Number of water var.
INTEGER, INTENT(IN) :: KSV ! Number of scal. var.
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUS,PVS,PWS, & !
@@ -61,14 +54,12 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS,& !
PLBYTHS,PLBYTKES ! LBY tendancy
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS,PLBYSVS !
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM,PPABSM,PTHM,&! Variables at
- PTKEM,PSRCM ! t-dt
-REAL, DIMENSION(:,:,:,:),INTENT(INOUT):: PRM,PSVM !
-!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM! Variables at t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PPABST,PTHT,&!
- PTKET,PSRCT ! Variables at
+ PTKET ! Variables at
REAL, DIMENSION(:,:,:,:),INTENT(INOUT):: PRT,PSVT ! t
-REAL, INTENT(INOUT):: PDRYMASST !
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHM, PRCM,PPABSM ! Variables at t-Dt
+REAL, INTENT(INOUT):: PDRYMASST !
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM,PLSVM,PLSWM,& ! Large Scale fields
PLSTHM,PLSRVM ! at t-dt
@@ -80,8 +71,6 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBXRM,PLBXSVM !
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBYUM,PLBYVM,PLBYWM, & !
PLBYTHM,PLBYTKEM ! LBY fields
REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBYRM,PLBYSVM !
-CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME ! Scalar meteorological advection scheme
-CHARACTER(LEN=6), INTENT(IN) :: HSV_ADV_SCHEME ! Scalar tracer advection scheme
!
END SUBROUTINE ENDSTEP
!
@@ -92,8 +81,8 @@ END MODULE MODI_ENDSTEP
!
!
! ######################################################################
- SUBROUTINE ENDSTEP (PTSTEP,PTSTEP_UVW,PTSTEP_MET,PTSTEP_SV, &
- KRR,KSV,KTCOUNT,KMI,PRHODJ, &
+ SUBROUTINE ENDSTEP (PTSTEP,KRR,KSV,KTCOUNT,KMI, &
+ HUVW_ADV_SCHEME,PRHODJ, &
PUS,PVS,PWS,PDRYMASSS, &
PTHS,PRS,PTKES,PSVS, &
PLSUS,PLSVS,PLSWS, &
@@ -102,17 +91,15 @@ END MODULE MODI_ENDSTEP
PLBXTHS,PLBXRS,PLBXTKES,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS, &
PLBYTHS,PLBYRS,PLBYTKES,PLBYSVS, &
- PUM,PVM,PWM,PPABSM, &
- PTHM,PRM,PTKEM,PSVM,PSRCM, &
+ PUM,PVM,PWM, &
PUT,PVT,PWT,PPABST,PDRYMASST, &
- PTHT,PRT,PTKET,PSVT,PSRCT, &
+ PTHT,PRT,PTHM,PRCM,PPABSM,PTKET,PSVT, &
PLSUM,PLSVM,PLSWM, &
PLSTHM,PLSRVM, &
PLBXUM,PLBXVM,PLBXWM, &
PLBXTHM,PLBXRM,PLBXTKEM,PLBXSVM, &
PLBYUM,PLBYVM,PLBYWM, &
- PLBYTHM,PLBYRM,PLBYTKEM,PLBYSVM, &
- HMET_ADV_SCHEME,HSV_ADV_SCHEME )
+ PLBYTHM,PLBYRM,PLBYTKEM,PLBYSVM )
! ######################################################################
!
!!**** *ENDSTEP* - temporal advance and asselin filter for all variables
@@ -194,10 +181,10 @@ END MODULE MODI_ENDSTEP
!! 06/11/02 (V. Masson) update the budget calls
!! 01/2004 (V. Masson) surface externalization
!! 05/2006 Remove KEPS
-!! 10/2006 (Maric, Lac) modification for PPM schemes
+!! 10/2006 (Maric, Lac) modification for PPM schemes
!! 10/2009 (C.Lac) Correction on FIT temporal scheme for variables
!! advected with PPM
-
+!! 04/2013 (C.Lac) FIT for all the variables
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -214,6 +201,7 @@ USE MODD_NSV, ONLY : XSVMIN, NSV_CHEMBEG, NSV_CHEMEND, &
USE MODD_CH_AEROSOL, ONLY : LORILAM
USE MODD_DUST, ONLY : LDUST
+USE MODD_PARAM_C2R2, ONLY : LACTIT
USE MODI_BUDGET
USE MODI_SHUMAN
!
@@ -223,16 +211,11 @@ IMPLICIT NONE
!
!
REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, INTENT(IN) :: PTSTEP_UVW ! Effective time step for
- ! momentum advection
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective time step for
- ! meteorological variables advection
-REAL, INTENT(IN) :: PTSTEP_SV ! Effective time step for
- ! scalar variables advection
INTEGER, INTENT(IN) :: KRR ! Number of water var.
INTEGER, INTENT(IN) :: KSV ! Number of scal. var.
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUS,PVS,PWS, & !
@@ -252,12 +235,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS,& !
PLBYTHS,PLBYTKES ! LBY tendancy
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS,PLBYSVS !
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM,PPABSM,PTHM,&! Variables at
- PTKEM,PSRCM ! t-dt
-REAL, DIMENSION(:,:,:,:),INTENT(INOUT):: PRM,PSVM !
-!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM! Variables at t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PPABST,PTHT,&!
- PTKET,PSRCT ! Variables at
+ PTKET ! Variables at
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHM, PRCM, PPABSM ! Variables at t-Dt
REAL, DIMENSION(:,:,:,:),INTENT(INOUT):: PRT,PSVT ! t
REAL, INTENT(INOUT):: PDRYMASST !
!
@@ -271,14 +252,11 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBXRM,PLBXSVM !
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBYUM,PLBYVM,PLBYWM, & !
PLBYTHM,PLBYTKEM ! LBY fields
REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBYRM,PLBYSVM !
-CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME ! Scalar meteorological advection scheme
-CHARACTER(LEN=6), INTENT(IN) :: HSV_ADV_SCHEME ! Scalar tracer advection scheme
!
!
!* 0.2 DECLARATIONS OF LOCAL VARIABLES
!
INTEGER:: JSV ! loop counters
-REAL, DIMENSION(SIZE(PSRCM,1),SIZE(PSRCM,2),SIZE(PSRCM,3)) :: ZSRC_STORE
INTEGER :: IKU
!
!------------------------------------------------------------------------------
@@ -286,54 +264,15 @@ INTEGER :: IKU
IKU=SIZE(XZHAT)
!* 1. ASSELIN FILTER
!
-IF( KTCOUNT /= 1 .OR. CCONF /= 'START' ) THEN
-!
-! Basic variables
-!
+IF (HUVW_ADV_SCHEME(1:3)=='CEN') THEN
+ IF( KTCOUNT /= 1 .OR. CCONF /= 'START' ) THEN
PUM(:,:,:)=(1.-XASSELIN)*PUT(:,:,:)+0.5*XASSELIN*(PUM(:,:,:)+PUS(:,:,:))
PVM(:,:,:)=(1.-XASSELIN)*PVT(:,:,:)+0.5*XASSELIN*(PVM(:,:,:)+PVS(:,:,:))
PWM(:,:,:)=(1.-XASSELIN)*PWT(:,:,:)+0.5*XASSELIN*(PWM(:,:,:)+PWS(:,:,:))
-! if using PPM advection for acalars, skip Asselin filter
-!
- IF (HMET_ADV_SCHEME(1:3) == 'PPM') THEN
- PTHM(:,:,:) = PTHT(:,:,:)
-! Moisture
- PRM(:,:,:,1:KRR) = PRT(:,:,:,1:KRR)
-! Turbulent kinetic energy
- IF (SIZE(PTKEM,1) /= 0) PTKEM(:,:,:) = PTKET(:,:,:)
- ELSE
- PTHM(:,:,:)=(1.-XASSELIN)*PTHT(:,:,:)+0.5*XASSELIN*(PTHM(:,:,:)+PTHS(:,:,:))
-! Moisture
- PRM(:,:,:,1:KRR)=(1.-XASSELIN)*PRT(:,:,:,1:KRR)+ &
- 0.5*XASSELIN*(PRM(:,:,:,1:KRR)+PRS(:,:,:,1:KRR))
-!
-! Turbulence kinetic energy
- IF (SIZE(PTKEM,1) /= 0) &
- PTKEM(:,:,:)=(1.-XASSELIN)*PTKET(:,:,:)+0.5*XASSELIN*(PTKEM(:,:,:)+PTKES(:,:,:))
- END IF
-!
-!
-! Other scalars
-!
- IF (HSV_ADV_SCHEME(1:3) == 'PPM') THEN
- PSVM(:,:,:,1:KSV) = PSVT(:,:,:,1:KSV)
-!
- ELSE ! other advection schemes
-!
- PSVM(:,:,:,1:KSV)=(1.-XASSELIN_SV)*PSVT(:,:,:,1:KSV)+ &
- 0.5*XASSELIN_SV*(PSVM(:,:,:,1:KSV)+PSVS(:,:,:,1:KSV))
- END IF
-!
-ENDIF
-!------------------------------------------------------------------------------
-!
-!* 2. SWAPPING FOR THE ABSOLUTE PRESSURE
-!
-PPABSM(:,:,:)=PPABST(:,:,:)
-!
-!------------------------------------------------------------------------------
-!
-!* 3. TEMPORAL ADVANCE OF PROGNOSTIC VARIABLES
+ END IF
+END IF
+
+!* 1. TEMPORAL ADVANCE OF PROGNOSTIC VARIABLES
!
PUT(:,:,:)=PUS(:,:,:)
PVT(:,:,:)=PVS(:,:,:)
@@ -347,22 +286,20 @@ PTHT(:,:,:)=PTHS(:,:,:)
!
PRT(:,:,:,1:KRR)=PRS(:,:,:,1:KRR)
!
+PPABSM(:,:,:) = PPABST(:,:,:)
+!
+IF (LACTIT) THEN
+ PTHM(:,:,:) = PTHT(:,:,:)
+ PRCM(:,:,:) = PRT(:,:,:,2)
+END IF
! Turbulence
!
-IF (SIZE(PTKEM,1) /= 0) PTKET(:,:,:)=PTKES(:,:,:)
+IF (SIZE(PTKET,1) /= 0) PTKET(:,:,:)=PTKES(:,:,:)
!
! Other scalars
!
PSVT(:,:,:,1:KSV)=PSVS(:,:,:,1:KSV)
!
-! PSRC
-!
-IF ( SIZE(PSRCM,1) /= 0 ) THEN
- ZSRC_STORE(:,:,:) = PSRCM(:,:,:)
- PSRCM(:,:,:) = PSRCT(:,:,:)
- PSRCT(:,:,:) = ZSRC_STORE(:,:,:)
-END IF
-!
!------------------------------------------------------------------------------
!
!* 4. TEMPORAL ADVANCE OF THE LARGE SCALE FIELDS
@@ -437,9 +374,6 @@ IF (SIZE(PRT,4) > 1) THEN
WHERE(PRT(:,:,:,2:)<1.E-20)
PRT(:,:,:,2:)=0.
END WHERE
- WHERE(PRM(:,:,:,2:)<1.E-20)
- PRM(:,:,:,2:)=0.
- END WHERE
END IF
IF (SIZE(PLBXRM,4) > 1) THEN
WHERE(PLBXRM(:,:,:,2:)<1.E-20)
@@ -509,42 +443,42 @@ IF (LBU_ENABLE) THEN
NBUPROCCTR(1:12+KSV)=3
NBUCTR_ACTV(1:12+KSV)=3
!
- IF (LBUDGET_U) CALL BUDGET (PUM(:,:,:)*PRHODJ(:,:,:)/PTSTEP,1,'AVEF_BU_RU')
- IF (LBUDGET_V) CALL BUDGET (PVM(:,:,:)*PRHODJ(:,:,:)/PTSTEP,2,'AVEF_BU_RV')
- IF (LBUDGET_W) CALL BUDGET (PWM(:,:,:)*PRHODJ(:,:,:)/PTSTEP,3,'AVEF_BU_RW')
- IF (LBUDGET_TH) CALL BUDGET (PTHM(:,:,:)*PRHODJ(:,:,:)/PTSTEP,4,'AVEF_BU_RTH')
- IF (LBUDGET_TKE) CALL BUDGET (PTKEM(:,:,:)*PRHODJ(:,:,:)/PTSTEP,5,'AVEF_BU_RTKE')
- IF (LBUDGET_RV) CALL BUDGET (PRM(:,:,:,1)*PRHODJ(:,:,:)/PTSTEP,6,'AVEF_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRM(:,:,:,2)*PRHODJ(:,:,:)/PTSTEP,7,'AVEF_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRM(:,:,:,3)*PRHODJ(:,:,:)/PTSTEP,8,'AVEF_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRM(:,:,:,4)*PRHODJ(:,:,:)/PTSTEP,9,'AVEF_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRM(:,:,:,5)*PRHODJ(:,:,:)/PTSTEP,10,'AVEF_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRM(:,:,:,6)*PRHODJ(:,:,:)/PTSTEP,11,'AVEF_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRM(:,:,:,7)*PRHODJ(:,:,:)/PTSTEP,12,'AVEF_BU_RRH')
+ IF (LBUDGET_U) CALL BUDGET (PUT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,1,'AVEF_BU_RU')
+ IF (LBUDGET_V) CALL BUDGET (PVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,2,'AVEF_BU_RV')
+ IF (LBUDGET_W) CALL BUDGET (PWT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,3,'AVEF_BU_RW')
+ IF (LBUDGET_TH) CALL BUDGET (PTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,4,'AVEF_BU_RTH')
+ IF (LBUDGET_TKE) CALL BUDGET (PTKET(:,:,:)*PRHODJ(:,:,:)/PTSTEP,5,'AVEF_BU_RTKE')
+ IF (LBUDGET_RV) CALL BUDGET (PRT(:,:,:,1)*PRHODJ(:,:,:)/PTSTEP,6,'AVEF_BU_RRV')
+ IF (LBUDGET_RC) CALL BUDGET (PRT(:,:,:,2)*PRHODJ(:,:,:)/PTSTEP,7,'AVEF_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET (PRT(:,:,:,3)*PRHODJ(:,:,:)/PTSTEP,8,'AVEF_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET (PRT(:,:,:,4)*PRHODJ(:,:,:)/PTSTEP,9,'AVEF_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET (PRT(:,:,:,5)*PRHODJ(:,:,:)/PTSTEP,10,'AVEF_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET (PRT(:,:,:,6)*PRHODJ(:,:,:)/PTSTEP,11,'AVEF_BU_RRG')
+ IF (LBUDGET_RH) CALL BUDGET (PRT(:,:,:,7)*PRHODJ(:,:,:)/PTSTEP,12,'AVEF_BU_RRH')
IF (LBUDGET_SV) THEN
DO JSV=1,KSV
- CALL BUDGET (PSVM(:,:,:,JSV)*PRHODJ(:,:,:)/PTSTEP,12+JSV,'AVEF_BU_RSV')
+ CALL BUDGET (PSVT(:,:,:,JSV)*PRHODJ(:,:,:)/PTSTEP,12+JSV,'AVEF_BU_RSV')
END DO
END IF
!
NBUPROCCTR(1:12+KSV)=2
NBUCTR_ACTV(1:12+KSV)=2
!
- IF (LBUDGET_U) CALL BUDGET (PUS*MXM(PRHODJ)/PTSTEP_UVW,1,'ENDF_BU_RU')
- IF (LBUDGET_V) CALL BUDGET (PVS*MYM(PRHODJ)/PTSTEP_UVW,2,'ENDF_BU_RV')
- IF (LBUDGET_W) CALL BUDGET (PWS*MZM(1,IKU,1,PRHODJ)/PTSTEP_UVW,3,'ENDF_BU_RW')
- IF (LBUDGET_TH) CALL BUDGET (PTHS*PRHODJ/PTSTEP_MET,4,'ENDF_BU_RTH')
- IF (LBUDGET_TKE) CALL BUDGET (PTKES*PRHODJ/PTSTEP_MET,5,'ENDF_BU_RTKE')
- IF (LBUDGET_RV) CALL BUDGET (PRS(:,:,:,1)*PRHODJ/PTSTEP_MET,6,'ENDF_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRS(:,:,:,2)*PRHODJ/PTSTEP_MET,7,'ENDF_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRS(:,:,:,3)*PRHODJ/PTSTEP_MET,8,'ENDF_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRS(:,:,:,4)*PRHODJ/PTSTEP_MET,9,'ENDF_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRS(:,:,:,5)*PRHODJ/PTSTEP_MET,10,'ENDF_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRS(:,:,:,6)*PRHODJ/PTSTEP_MET,11,'ENDF_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRS(:,:,:,7)*PRHODJ/PTSTEP_MET,12,'ENDF_BU_RRH')
+ IF (LBUDGET_U) CALL BUDGET (PUS*MXM(PRHODJ)/PTSTEP,1,'ENDF_BU_RU')
+ IF (LBUDGET_V) CALL BUDGET (PVS*MYM(PRHODJ)/PTSTEP,2,'ENDF_BU_RV')
+ IF (LBUDGET_W) CALL BUDGET (PWS*MZM(1,IKU,1,PRHODJ)/PTSTEP,3,'ENDF_BU_RW')
+ IF (LBUDGET_TH) CALL BUDGET (PTHS*PRHODJ/PTSTEP,4,'ENDF_BU_RTH')
+ IF (LBUDGET_TKE) CALL BUDGET (PTKES*PRHODJ/PTSTEP,5,'ENDF_BU_RTKE')
+ IF (LBUDGET_RV) CALL BUDGET (PRS(:,:,:,1)*PRHODJ/PTSTEP,6,'ENDF_BU_RRV')
+ IF (LBUDGET_RC) CALL BUDGET (PRS(:,:,:,2)*PRHODJ/PTSTEP,7,'ENDF_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET (PRS(:,:,:,3)*PRHODJ/PTSTEP,8,'ENDF_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET (PRS(:,:,:,4)*PRHODJ/PTSTEP,9,'ENDF_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET (PRS(:,:,:,5)*PRHODJ/PTSTEP,10,'ENDF_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET (PRS(:,:,:,6)*PRHODJ/PTSTEP,11,'ENDF_BU_RRG')
+ IF (LBUDGET_RH) CALL BUDGET (PRS(:,:,:,7)*PRHODJ/PTSTEP,12,'ENDF_BU_RRH')
IF (LBUDGET_SV) THEN
DO JSV=1,KSV
- CALL BUDGET (PSVS(:,:,:,JSV)*PRHODJ/PTSTEP_SV,JSV+12,'ENDF_BU_RSV')
+ CALL BUDGET (PSVS(:,:,:,JSV)*PRHODJ/PTSTEP,JSV+12,'ENDF_BU_RSV')
END DO
END IF
END IF
diff --git a/src/MNH/endstep_budget.f90 b/src/MNH/endstep_budget.f90
index cbf5af18a..55ee6d304 100644
--- a/src/MNH/endstep_budget.f90
+++ b/src/MNH/endstep_budget.f90
@@ -11,8 +11,7 @@
INTERFACE
!
SUBROUTINE ENDSTEP_BUDGET(HFMDIAC,HLUOUT,KTCOUNT, &
- TPDTCUR,TPDTMOD,PTSTEP, &
- PTSTEP_UVW,PTSTEP_MET,PTSTEP_SV,KSV )
+ TPDTCUR,TPDTMOD,PTSTEP,KSV )
!
USE MODD_TYPE_DATE
!
@@ -22,12 +21,6 @@ INTEGER, INTENT(IN) :: KTCOUNT ! temporal loop counter
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
TYPE (DATE_TIME), INTENT(IN) :: TPDTMOD ! Creation date and time
REAL, INTENT(IN) :: PTSTEP ! time step
-REAL, INTENT(IN) :: PTSTEP_UVW ! Effective time step for
- ! momentum advection
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective time step for
- ! meteorological variables advection
-REAL, INTENT(IN) :: PTSTEP_SV ! Effective time step for
- ! scalar variables advection
INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
!
@@ -39,8 +32,7 @@ END MODULE MODI_ENDSTEP_BUDGET
!
! ###############################################################
SUBROUTINE ENDSTEP_BUDGET(HFMDIAC,HLUOUT,KTCOUNT, &
- TPDTCUR,TPDTMOD,PTSTEP, &
- PTSTEP_UVW,PTSTEP_MET,PTSTEP_SV,KSV )
+ TPDTCUR,TPDTMOD,PTSTEP,KSV )
! ###############################################################
!
!!**** *ENDSTEP_BUDGET* - routine to call the routine write_budget
@@ -126,12 +118,6 @@ INTEGER, INTENT(IN) :: KTCOUNT ! temporal loop counter
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
TYPE (DATE_TIME), INTENT(IN) :: TPDTMOD ! Creation date and time
REAL, INTENT(IN) :: PTSTEP ! time step
-REAL, INTENT(IN) :: PTSTEP_UVW ! Effective time step for
- ! momentum advection
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective time step for
- ! meteorological variables advection
-REAL, INTENT(IN) :: PTSTEP_SV ! Effective time step for
- ! scalar variables advection
INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
!
!-------------------------------------------------------------------------------
@@ -147,8 +133,7 @@ SELECT CASE(CBUTYPE)
!* 1.1 storage of the budget fields
!
IF( MODULO(KTCOUNT+1,NBUSTEP*NBUWRNB) == 0 ) THEN
- CALL WRITE_BUDGET(HFMDIAC,HLUOUT,TPDTCUR,TPDTMOD,PTSTEP, &
- PTSTEP_UVW,PTSTEP_MET,PTSTEP_SV,KSV )
+ CALL WRITE_BUDGET(HFMDIAC,HLUOUT,TPDTCUR,TPDTMOD,PTSTEP, KSV )
!
!* 1.2 resetting the budget arrays to 0.
!
@@ -184,8 +169,7 @@ SELECT CASE(CBUTYPE)
!
!* 2.1 storage of the budget fields
!
- CALL WRITE_BUDGET(HFMDIAC,HLUOUT,TPDTCUR,TPDTMOD,PTSTEP, &
- PTSTEP_UVW,PTSTEP_MET,PTSTEP_SV,KSV )
+ CALL WRITE_BUDGET(HFMDIAC,HLUOUT,TPDTCUR,TPDTMOD,PTSTEP, KSV)
!
!* 2.2 reset the budget fields to 0.
!
diff --git a/src/MNH/error_on_temperature.f90 b/src/MNH/error_on_temperature.f90
index 0162d19d3..f41faa5fc 100644
--- a/src/MNH/error_on_temperature.f90
+++ b/src/MNH/error_on_temperature.f90
@@ -74,7 +74,7 @@ USE MODD_CONF ! declaration modules
USE MODD_LUNIT
USE MODD_CST
USE MODD_REF_n
-USE MODD_FIELD_n, ONLY: XTHM
+USE MODD_FIELD_n, ONLY: XTHT
USE MODD_VER_INTERP_LIN
!
IMPLICIT NONE
@@ -112,7 +112,7 @@ INTEGER :: JP
IIU=SIZE(PT_LS,1)
IJU=SIZE(PT_LS,2)
ILU=SIZE(PT_LS,3)
-IKU=SIZE(XTHM,3)
+IKU=SIZE(XTHT,3)
!
ALLOCATE(ZPLEVELS(20))
ZPLEVELS(:) = (/ (5000.*JP,JP=20,1,-1) /)
@@ -155,7 +155,7 @@ ALLOCATE(ZT1(IIU,IJU,IKU))
ALLOCATE(ZP2(IIU,IJU,20))
ALLOCATE(ZT2(IIU,IJU,20))
!
-ZT1(:,:,:)=XTHM(:,:,IKU:1:-1)*(PPABS(:,:,IKU:1:-1)/XP00)**(XRD/XCPD)
+ZT1(:,:,:)=XTHT(:,:,IKU:1:-1)*(PPABS(:,:,IKU:1:-1)/XP00)**(XRD/XCPD)
ZP1(:,:,:)=PPABS(:,:,IKU:1:-1)
ZP2(:,:,:)=SPREAD(SPREAD(ZPLEVELS(20:1:-1),1,IIU),2,IJU)
CALL COEF_VER_INTERP_LIN(ZP1(:,:,:),ZP2(:,:,:))
diff --git a/src/MNH/exchange.f90 b/src/MNH/exchange.f90
index 593e7c8b0..2925cc4b9 100644
--- a/src/MNH/exchange.f90
+++ b/src/MNH/exchange.f90
@@ -12,18 +12,13 @@
INTERFACE
!
! ##############################################################################
- SUBROUTINE EXCHANGE (PTSTEP,PTSTEP_MET,PTSTEP_SV,KRR,KSV,PRHODJ,TPFIELDS_ll, &
+ SUBROUTINE EXCHANGE (PTSTEP,KRR,KSV,PRHODJ,TPFIELDS_ll, &
PRUS,PRVS,PRWS,PRTHS,PRRS,PRTKES,PRSVS )
! ##############################################################################
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (or single if cold start)
-REAL, INTENT(IN) :: PTSTEP_MET ! Time step for
- ! scalar meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Time step for
- ! scalar tracer variables
+REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KRR ! Number of water var.
INTEGER, INTENT(IN) :: KSV ! Number of scal. var.
! (=1 at the segment beginning)
@@ -43,8 +38,8 @@ END MODULE MODI_EXCHANGE
!
!
! #######################################################################
- SUBROUTINE EXCHANGE (PTSTEP,PTSTEP_MET,PTSTEP_SV,KRR,KSV,PRHODJ,TPFIELDS_ll, &
- PRUS,PRVS,PRWS,PRTHS,PRRS,PRTKES,PRSVS )
+ SUBROUTINE EXCHANGE (PTSTEP,KRR,KSV,PRHODJ,TPFIELDS_ll, &
+ PRUS,PRVS,PRWS,PRTHS,PRRS,PRTKES,PRSVS )
! #######################################################################
!
!!**** * EXCHANGE* - update the halo of each subdomains for the variables at time step t+dt
@@ -93,7 +88,6 @@ END MODULE MODI_EXCHANGE
USE MODE_ll
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_CONF, ONLY : CCONF
USE MODD_GRID_n
USE MODI_SHUMAN
!
@@ -101,12 +95,7 @@ IMPLICIT NONE
!
!* 0.1 DECLARATIONS OF ARGUMENTS
!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (or single if cold start)
-REAL, INTENT(IN) :: PTSTEP_MET ! Time step for
- ! scalar meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Time step for
- ! scalar tracer variables
+REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KRR ! Number of water var.
INTEGER, INTENT(IN) :: KSV ! Number of scal. var.
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
@@ -121,7 +110,6 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS,PRSVS !
!
INTEGER :: IINFO_ll ! return code of parallel routine
INTEGER :: JRR,JSV ! loop counters
-REAL :: ZTSTEP ! Time step for temporal advance
!
INTEGER :: IKU
!------------------------------------------------------------------------------
@@ -138,16 +126,16 @@ PRWS(:,:,:) = PRWS(:,:,:)*PTSTEP / MZM(1,IKU,1,PRHODJ)
!
! 1.b Meteorological scalar variables
!
-PRTHS(:,:,:) = PRTHS(:,:,:)*PTSTEP_MET/PRHODJ
+PRTHS(:,:,:) = PRTHS(:,:,:)*PTSTEP/PRHODJ
DO JRR=1,KRR
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR)*PTSTEP_MET/PRHODJ
+ PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR)*PTSTEP/PRHODJ
END DO
-IF (SIZE(PRTKES,1) /= 0) PRTKES(:,:,:) = PRTKES(:,:,:)*PTSTEP_MET/PRHODJ
+IF (SIZE(PRTKES,1) /= 0) PRTKES(:,:,:) = PRTKES(:,:,:)*PTSTEP/PRHODJ
!
! 1.c Tracer scalar variables
!
DO JSV=1,KSV
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV)*PTSTEP_SV/PRHODJ
+ PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV)*PTSTEP/PRHODJ
END DO
!
!------------------------------------------------------------------------------
diff --git a/src/MNH/fast_terms.f90 b/src/MNH/fast_terms.f90
index 08f2ea5a0..853ca65fc 100644
--- a/src/MNH/fast_terms.f90
+++ b/src/MNH/fast_terms.f90
@@ -13,7 +13,7 @@ INTERFACE
SUBROUTINE FAST_TERMS( KRR, KMI, HFMFILE, HLUOUT, HRAD, &
HTURBDIM, HSCONV, HMF_CLOUD, &
OCLOSE_OUT, OSUBG_COND, PTSTEP, &
- PRHODJ, PPABSM, PSIGS, PPABST, &
+ PRHODJ, PSIGS, PPABST, &
PCF_MF,PRC_MF, &
PRVT, PRCT, PRVS, PRCS, PRRS, &
PTHS, PSRCS, PCLDFR )
@@ -35,7 +35,6 @@ LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
REAL, INTENT(IN) :: PTSTEP ! Time step
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
!
@@ -66,7 +65,7 @@ END MODULE MODI_FAST_TERMS
SUBROUTINE FAST_TERMS( KRR, KMI, HFMFILE, HLUOUT, HRAD, &
HTURBDIM, HSCONV, HMF_CLOUD, &
OCLOSE_OUT, OSUBG_COND, PTSTEP, &
- PRHODJ, PPABSM, PSIGS, PPABST, &
+ PRHODJ, PSIGS, PPABST, &
PCF_MF,PRC_MF, &
PRVT, PRCT, PRVS, PRCS, PRRS, &
PTHS, PSRCS, PCLDFR )
@@ -191,7 +190,6 @@ LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
REAL, INTENT(IN) :: PTSTEP ! Time step
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
!
@@ -284,7 +282,7 @@ END WHERE
!
!* 2.2 estimate the Exner function at t+1
!
-ZEXNS(:,:,:) = ( (2. * PPABST(:,:,:) - PPABSM(:,:,:)) / XP00 ) ** (XRD/XCPD)
+ZEXNS(:,:,:) = ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
!
! beginning of the iterative loop
!
@@ -315,7 +313,7 @@ DO JITER =1,ITERMAX
!* 2.7 compute the saturation mixing ratio at t+1
!
ZW2(:,:,:) = ZW1(:,:,:) * ZEPS / &
- ( 2. * PPABST(:,:,:) - PPABSM(:,:,:) - ZW1(:,:,:) )
+ ( PPABST(:,:,:) - ZW1(:,:,:) )
!
!* 2.8 compute the saturation mixing ratio derivative (rvs')
!
diff --git a/src/MNH/forcing.f90 b/src/MNH/forcing.f90
index c17bc2e75..e066d3e6e 100644
--- a/src/MNH/forcing.f90
+++ b/src/MNH/forcing.f90
@@ -10,18 +10,16 @@
!
INTERFACE
!
- SUBROUTINE FORCING ( PTSTEP, PTSTEP_UVW, OUSERV, PRHODJ, PCORIOZ, &
+ SUBROUTINE FORCING ( PTSTEP, OUSERV, PRHODJ, PCORIOZ, &
PZHAT, PZZ, TPDTCUR, &
PUFRC_PAST, PVFRC_PAST, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
- PUM, PVM, PWM, PTHM, PTKEM, PRM, PSVM, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
KMI)
!
USE MODD_TIME, ONLY: DATE_TIME
!
REAL, INTENT(IN) :: PTSTEP ! time-step
-REAL, INTENT(IN) :: PTSTEP_UVW ! time-step
LOGICAL , INTENT(IN) :: OUSERV ! Logical to use rv
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! ( rhod J ) = dry density
! for reference state * Jacobian of the GCS transformation.
@@ -37,11 +35,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT,PTHT,PTKET
! TKE at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! moist variables at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT! scalar variables at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHM,PTKEM
- ! wind, potential temperature and
- ! TKE at time t-dt
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! moist variables at time t-dt
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM! scalar variables at time t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHS,PRTKES
! wind, potential temperature and
! TKE tendencies at time t
@@ -57,11 +50,10 @@ END INTERFACE
END MODULE MODI_FORCING
!
! ######################################################################
- SUBROUTINE FORCING ( PTSTEP, PTSTEP_UVW, OUSERV, PRHODJ, PCORIOZ, &
+ SUBROUTINE FORCING ( PTSTEP, OUSERV, PRHODJ, PCORIOZ, &
PZHAT, PZZ, TPDTCUR, &
PUFRC_PAST, PVFRC_PAST, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
- PUM, PVM, PWM, PTHM, PTKEM, PRM, PSVM, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
KMI)
! ######################################################################
@@ -175,7 +167,6 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
REAL, INTENT(IN) :: PTSTEP ! time-step
-REAL, INTENT(IN) :: PTSTEP_UVW ! time-step
LOGICAL , INTENT(IN) :: OUSERV ! Logical to use rv
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! ( rhod J ) = dry density
! for reference state * Jacobian of the GCS transformation.
@@ -191,11 +182,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT,PTHT,PTKET
! TKE at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! moist variables at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT! scalar variables at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHM,PTKEM
- ! wind, potential temperature and
- ! TKE at time t-dt
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! moist variables at time t-dt
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM! scalar variables at time t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHS,PRTKES
! wind, potential temperature and
! TKE tendencies at time t
@@ -606,41 +592,41 @@ IF (LVERT_MOTION_FRC) THEN
!
! forced vertical transport of U and V
!
- ZDZZ(:,:,:) = MXF(ZRWCF(:,:,:)) *DZM(1,IKU,1,PUM(:,:,:))
+ ZDZZ(:,:,:) = MXF(ZRWCF(:,:,:)) *DZM(1,IKU,1,PUT(:,:,:))
PRUS(:,:,:) = PRUS(:,:,:) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
- ZDZZ(:,:,:) = MYF(ZRWCF(:,:,:)) *DZM(1,IKU,1,PVM(:,:,:))
+ ZDZZ(:,:,:) = MYF(ZRWCF(:,:,:)) *DZM(1,IKU,1,PVT(:,:,:))
PRVS(:,:,:) = PRVS(:,:,:) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
!
! forced vertical transport of W
!
IF( .NOT.L1D ) THEN
- ZDZZ(:,:,:) = MZF(1,IKU,1,ZRWCF(:,:,:)) *DZF(1,IKU,1,PWM(:,:,:))
+ ZDZZ(:,:,:) = MZF(1,IKU,1,ZRWCF(:,:,:)) *DZF(1,IKU,1,PWT(:,:,:))
PRWS(:,:,:) = PRWS(:,:,:) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
END IF
!
! forced vertical transport of THETA
!
- ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PTHM(:,:,:))
+ ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PTHT(:,:,:))
PRTHS(:,:,:) = PRTHS(:,:,:) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
!
! forced vertical transport of TKE (if allocated)
!
- IF( SIZE(PTKEM) == SIZE(ZDZZ) ) THEN
- ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PTKEM(:,:,:))
+ IF( SIZE(PTKET) == SIZE(ZDZZ) ) THEN
+ ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PTKET(:,:,:))
PRTKES(:,:,:) = PRTKES(:,:,:) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
END IF
!
! forced vertical transport of water variables
!
DO JL = 1 , SIZE(PRRS,4)
- ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PRM(:,:,:,JL))
+ ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PRT(:,:,:,JL))
PRRS(:,:,:,JL) = PRRS(:,:,:,JL) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
END DO
!
! forced vertical transport of scalar variables
!
DO JL = 1 , SIZE(PRSVS,4)
- ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PSVM(:,:,:,JL))
+ ZDZZ(:,:,:) = ZRWCF(:,:,:) *DZM(1,IKU,1,PSVT(:,:,:,JL))
PRSVS(:,:,:,JL) = PRSVS(:,:,:,JL) - UPSTREAM_Z(ZDZZ(:,:,:),ZRWCF(:,:,:))
END DO
!
@@ -684,12 +670,12 @@ IF( LCORIO ) THEN
!
ZCOEF(:,:,:) = MIN(1.,SQRT(ZCOEF))
!
- ZDUT(:,:,:) = ZDUF(:,:,:) * MXM(ZCOEF) * PTSTEP_UVW / PTSTEP
- ZDVT(:,:,:) = ZDVF(:,:,:) * MYM(ZCOEF) * PTSTEP_UVW / PTSTEP
+ ZDUT(:,:,:) = ZDUF(:,:,:) * MXM(ZCOEF)
+ ZDVT(:,:,:) = ZDVF(:,:,:) * MYM(ZCOEF)
!
- PRUS(:,:,:) = PRUS(:,:,:) + ZDUT(:,:,:) * MXM(PRHODJ) / PTSTEP_UVW
+ PRUS(:,:,:) = PRUS(:,:,:) + ZDUT(:,:,:) * MXM(PRHODJ) / PTSTEP
!
- PRVS(:,:,:) = PRVS(:,:,:) + ZDVT(:,:,:) * MYM(PRHODJ) / PTSTEP_UVW
+ PRVS(:,:,:) = PRVS(:,:,:) + ZDVT(:,:,:) * MYM(PRHODJ) / PTSTEP
!
!
! Takes into acount the Coriolis force due to this evolution
@@ -738,7 +724,7 @@ IF( LRELAX_THRV_FRC .OR. LRELAX_UV_FRC ) THEN
! apply THETA relaxation
!
WHERE( GRELAX_MASK_FRC )
- PRTHS(:,:,:) = PRTHS(:,:,:) - PRHODJ(:,:,:)*(PTHM(:,:,:)-ZTHF(:,:,:)) &
+ PRTHS(:,:,:) = PRTHS(:,:,:) - PRHODJ(:,:,:)*(PTHT(:,:,:)-ZTHF(:,:,:)) &
/ XRELAX_TIME_FRC
END WHERE
!
@@ -747,7 +733,7 @@ IF( LRELAX_THRV_FRC .OR. LRELAX_UV_FRC ) THEN
IF( OUSERV ) THEN
WHERE( GRELAX_MASK_FRC )
PRRS(:,:,:,1) = PRRS(:,:,:,1) &
- - PRHODJ(:,:,:)*(PRM(:,:,:,1)-ZRVF(:,:,:)) &
+ - PRHODJ(:,:,:)*(PRT(:,:,:,1)-ZRVF(:,:,:)) &
/ XRELAX_TIME_FRC
END WHERE
!
@@ -760,9 +746,9 @@ IF( LRELAX_THRV_FRC .OR. LRELAX_UV_FRC ) THEN
! apply UV relaxation
!
WHERE( GRELAX_MASK_FRC )
- PRUS(:,:,:) = PRUS(:,:,:) - MXM(PRHODJ(:,:,:))*(PUM(:,:,:)-ZUF(:,:,:)) &
+ PRUS(:,:,:) = PRUS(:,:,:) - MXM(PRHODJ(:,:,:))*(PUT(:,:,:)-ZUF(:,:,:)) &
/ XRELAX_TIME_FRC
- PRVS(:,:,:) = PRVS(:,:,:) - MYM(PRHODJ(:,:,:))*(PVM(:,:,:)-ZVF(:,:,:)) &
+ PRVS(:,:,:) = PRVS(:,:,:) - MYM(PRHODJ(:,:,:))*(PVT(:,:,:)-ZVF(:,:,:)) &
/ XRELAX_TIME_FRC
END WHERE
!
diff --git a/src/MNH/goto_model_wrapper.f90 b/src/MNH/goto_model_wrapper.f90
index d942980b2..8d1efd7cc 100644
--- a/src/MNH/goto_model_wrapper.f90
+++ b/src/MNH/goto_model_wrapper.f90
@@ -37,6 +37,7 @@ USE MODD_DUMMY_GR_FIELD_n
USE MODD_DYN_n
USE MODD_DYNZD_n
USE MODD_FIELD_n
+USE MODD_PAST_FIELD_n
USE MODD_GET_n
USE MODD_GR_FIELD_n
USE MODD_GRID_n
@@ -111,6 +112,7 @@ CALL DUMMY_GR_FIELD_GOTO_MODEL(KFROM, KTO)
CALL DYN_GOTO_MODEL(KFROM, KTO)
CALL DYNZD_GOTO_MODEL(KFROM,KTO)
CALL FIELD_GOTO_MODEL(KFROM, KTO)
+CALL PAST_FIELD_GOTO_MODEL(KFROM, KTO)
CALL GET_GOTO_MODEL(KFROM, KTO)
CALL GR_FIELD_GOTO_MODEL(KFROM, KTO)
CALL GRID_GOTO_MODEL(KFROM, KTO)
diff --git a/src/MNH/gravity.f90 b/src/MNH/gravity.f90
new file mode 100644
index 000000000..90d5e4ef6
--- /dev/null
+++ b/src/MNH/gravity.f90
@@ -0,0 +1,184 @@
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 adiab 2006/06/06 15:20:45
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_GRAVITY
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE GRAVITY ( KRR,KRRL, KRRI, PTHT, PRT, &
+ PRHODJ, PTHVREF, PRWS )
+!
+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, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! at
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRWS ! Sources of Momentum
+!
+END SUBROUTINE GRAVITY
+!
+END INTERFACE
+!
+END MODULE MODI_GRAVITY
+! ######################################################################
+ SUBROUTINE GRAVITY( KRR,KRRL, KRRI, PTHT, PRT, &
+ PRHODJ, PTHVREF, PRWS )
+! ######################################################################
+!
+!!**** *GRAVITY * - routine to compute the curvature, coriolis and gravity terms
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the gravity on the vertical
+!! component of the momentum.
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! MXM,MYM,MZM : Shuman functions (mean operators)
+!! MXF,MYF,MZF : Shuman functions (mean operators)
+!! GZ_M_W : projection along the vertical direction of the gradient
+!! vector. It acts on a field localized in mass point and
+!! the result is localized in w point.
+!! BUDGET : Stores the different budget components
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CONF : contains configuration variables for all models
+!! LTHINSHELL = .TRUE. if the THINSHELL approximation is made
+!! LCARTESIAN = .TRUE. if the CARTESIAN approximation is made
+!! Module MODD_CST :
+!! XG gravity acceleration
+!! XRADIUS Earth radius
+!! XRD,XRV Gas constant for dry air and wator vapor
+!! XCPD,XCPV Cp for dry air and wator vapor
+!! XCL,XCI C (calorific capacity) for liquid and solid water
+!! Module MODD_DYN : contains the parameters for the dynamics
+!! LCORIO = .FALSE. if the earth rotation is neglected
+!!
+!! 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_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 DYN_SOURCE )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! C.Lac - March 2011 - Splitted from dyn_sources
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BUDGET
+USE MODD_CONF
+USE MODD_CST
+!
+USE MODI_SHUMAN
+USE MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+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, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! at
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRWS ! Sources of Momentum
+!
+!
+!* 0.2 Declarations of local variables :
+!
+REAL :: ZRV_OV_RD ! = RV / RD
+INTEGER :: JWATER ! loop index on the different types of water
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
+ ZWORK1, ZWORK2
+INTEGER :: IKU
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTES THE GRAVITY TERM
+! -------------------------
+!
+IKU=SIZE(PTHT,3)
+!
+IF( .NOT.L1D ) THEN ! no buoyancy for 1D case
+!
+ IF(KRR > 0) THEN
+!
+! compute the ratio : 1 + total water mass / dry air mass
+!
+ ZRV_OV_RD = XRV / XRD
+ ZWORK1(:,:,:) = 1.
+ DO JWATER = 1 , 1+KRRL+KRRI
+ ZWORK1(:,:,:) = ZWORK1(:,:,:) + PRT(:,:,:,JWATER)
+ END DO
+!
+! compute the virtual potential temperature when water is present in any form
+!
+ ZWORK2(:,:,:) = PTHT(:,:,:) * (1. + PRT(:,:,:,1)*ZRV_OV_RD) / ZWORK1(:,:,:)
+ ELSE
+!
+! compute the virtual potential temperature when water is absent
+!
+ ZWORK2(:,:,:) = PTHT(:,:,:)
+ END IF
+!
+! compute the gravity term
+!
+ PRWS(:,:,:) = PRWS + XG * MZM(1,IKU,1, ( (ZWORK2/PTHVREF) - 1. ) * PRHODJ )
+!
+! the extrapolation for the PTHT and the THVREF must be the same at the
+! ground
+!
+ IF (LBUDGET_W) CALL BUDGET (PRWS,3,'GRAV_BU_RW')
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE GRAVITY
diff --git a/src/MNH/gravity_impl.f90 b/src/MNH/gravity_impl.f90
new file mode 100644
index 000000000..cc8812de1
--- /dev/null
+++ b/src/MNH/gravity_impl.f90
@@ -0,0 +1,145 @@
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_GRAVITY_IMPL
+! #####################
+!
+INTERFACE
+ SUBROUTINE GRAVITY_IMPL (HLBCX, HLBCY,KRR,KRRL,KRRI, PTSTEP, &
+ PTHT, PRT, PTHVREF, PRHODJ, &
+ PRWS, PRTHS, PRRS, PRTHS_CLD, PRRS_CLD )
+!
+CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KRRL ! Number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! Number of ice water var.
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PRHODJ
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
+ ! Variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRWS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS
+ ! Sources terms
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS_CLD
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS_CLD
+ ! tendencies from previous time-step
+ ! cloud processes
+!
+END SUBROUTINE GRAVITY_IMPL
+!
+END INTERFACE
+!
+END MODULE MODI_GRAVITY_IMPL
+! ##########################################################################
+ SUBROUTINE GRAVITY_IMPL (HLBCX, HLBCY,KRR,KRRL,KRRI, PTSTEP, &
+ PTHT, PRT, PTHVREF, PRHODJ, &
+ PRWS, PRTHS, PRRS, PRTHS_CLD, PRRS_CLD )
+! ##########################################################################
+!
+!!**** *GRAVITY_IMPL * - routine to estimate gravity term using future buoyancy
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/2011
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_GRAVITY
+USE MODI_ADV_BOUNDARIES
+!
+!-------------------------------------------------------------------------------
+!
+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
+INTEGER, INTENT(IN) :: KRRL ! Number of liquid water var.
+INTEGER, INTENT(IN) :: KRRI ! Number of ice water var.
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PRHODJ
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
+ ! Variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRWS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS
+ ! Sources terms
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS_CLD
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS_CLD
+ ! tendencies from previous time-step
+ ! cloud processes
+!
+!
+!* 0.2 declarations of local variables
+!
+!
+! Tendencies of W due to gravity
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZRWS_GRAV
+! Guess of future theta
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZTH
+! Guess of future mixing ratios
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) :: ZR
+!
+INTEGER :: JR
+!
+!-------------------------------------------------------------------------------
+!
+ZRWS_GRAV = 0.
+!
+! guess of Theta at future time-step
+ZTH(:,:,:) = (PRTHS(:,:,:) + PRTHS_CLD(:,:,:)) / PRHODJ * PTSTEP
+DO JR = 1, KRR
+ ZR(:,:,:,JR) = (PRRS(:,:,:,JR) + PRRS_CLD(:,:,:,JR)) / PRHODJ * PTSTEP
+END DO
+!
+CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTH, PTHT )
+DO JR = 1, KRR
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZR(:,:,:,JR), PRT(:,:,:,JR))
+END DO
+!
+! ====> A vérifier si c'est nécessaire d'échanger les champs
+! A priori, je dirai non.
+!
+! gravity effect on vertical speed
+CALL GRAVITY ( KRR,KRRL, KRRI, ZTH, ZR, PRHODJ, PTHVREF, ZRWS_GRAV(:,:,:) )
+!
+PRWS(:,:,:) = PRWS(:,:,:) + ZRWS_GRAV(:,:,:)
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE GRAVITY_IMPL
diff --git a/src/MNH/ground_paramn.f90 b/src/MNH/ground_paramn.f90
index 02cf2794f..bec72ae4c 100644
--- a/src/MNH/ground_paramn.f90
+++ b/src/MNH/ground_paramn.f90
@@ -108,7 +108,7 @@ USE MODD_CST, ONLY : XP00, XCPD, XRD, XRV,XRHOLW, XDAY, XPI, XLVTT, XMD,
USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF
USE MODD_DYN_n, ONLY : XTSTEP
USE MODD_CH_MNHC_n, ONLY : LCH_SURFACE_FLUX
-USE MODD_FIELD_n, ONLY : XUM, XVM, XWM, XTHM, XRM, XPABSM, XSVM
+USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT
USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ
USE MODD_DIM_n, ONLY : NKMAX
USE MODD_GRID_n, ONLY : XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
@@ -331,7 +331,7 @@ PTSRAD = XUNDEF
ALLOCATE(ZRV(SIZE(PSFTH,1),SIZE(PSFTH,2),IKU))
!
IF(NRR>0) THEN
- ZRV(:,:,:)=XRM(:,:,:,1)
+ ZRV(:,:,:)=XRT(:,:,:,1)
ELSE
ZRV(:,:,:)=0.
END IF
@@ -339,8 +339,8 @@ END IF
! 1.2 Horizontal wind direction (rad from N clockwise)
! -------------------------
!
-ZU2D(:,:,:)=MXF(XUM(:,:,IKB:IKB))
-ZV2D(:,:,:)=MYF(XVM(:,:,IKB:IKB))
+ZU2D(:,:,:)=MXF(XUT(:,:,IKB:IKB))
+ZV2D(:,:,:)=MYF(XVT(:,:,IKB:IKB))
!
!* angle between Y axis and wind (rad., clockwise)
!
@@ -362,7 +362,7 @@ END IF
! 1.3 Rotate the wind
! ---------------
!
-CALL ROTATE_WIND(XUM,XVM,XWM, &
+CALL ROTATE_WIND(XUT,XVT,XWT, &
XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
XCOSSLOPE,XSINSLOPE, &
XDXX,XDYY,XDZZ, &
@@ -380,7 +380,7 @@ ZV(:,:) = ZWIND(:,:) * COS(ZDIR)
! 1.5 Horizontal interpolation the thermodynamic fields
! -------------------------------------------------
!
-CALL NORMAL_INTERPOL(XTHM,ZRV,XPABSM, &
+CALL NORMAL_INTERPOL(XTHT,ZRV,XPABST, &
XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
XCOSSLOPE,XSINSLOPE, &
XDXX,XDYY,XDZZ, &
@@ -395,8 +395,8 @@ DEALLOCATE(ZRV)
!
ZPA(:,:) = XP00 * ZEXNA(:,:) **(XCPD/XRD)
!
-ZEXNS(:,:) = 0.5 * ( (XPABSM(:,:,IKB-1)/XP00)**(XRD/XCPD) &
- +(XPABSM(:,:,IKB )/XP00)**(XRD/XCPD) &
+ZEXNS(:,:) = 0.5 * ( (XPABST(:,:,IKB-1)/XP00)**(XRD/XCPD) &
+ +(XPABST(:,:,IKB )/XP00)**(XRD/XCPD) &
)
ZPS(:,:) = XP00 * ZEXNS(:,:) **(XCPD/XRD)
!
@@ -704,7 +704,7 @@ ZP_RAIN(:) = RESHAPE(ZRAIN(IIB:IIE,IJB:IJE), ISHAPE_1)
ZP_ZREF(:) = RESHAPE(ZZREF(IIB:IIE,IJB:IJE), ISHAPE_1)
DO JLAYER=1,NSV
- ZP_SV(:,JLAYER) = RESHAPE(XSVM(IIB:IIE,IJB:IJE,IKB,JLAYER), ISHAPE_1)
+ ZP_SV(:,JLAYER) = RESHAPE(XSVT(IIB:IIE,IJB:IJE,IKB,JLAYER), ISHAPE_1)
END DO
!
!chemical conversion : from part/part to molec./m3
diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index a9202d11d..4bf0723e0 100644
--- a/src/MNH/ice_adjust.f90
+++ b/src/MNH/ice_adjust.f90
@@ -11,8 +11,8 @@ INTERFACE
!
SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, KMI, HFMFILE, HLUOUT, HRAD, &
HTURBDIM, OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PPABSM, PSIGS,PMFCONV,PPABST,PZZ,&
- PCF_MF,PRC_MF,PRI_MF, &
+ PRHODJ, PEXNREF, PSIGS,PMFCONV,PPABST,PZZ, &
+ PCF_MF,PRC_MF, PRI_MF, &
PRVT, PRCT, PRVS, PRCS, PTHS, PSRCS, PCLDFR , &
PRRT, PRRS, PRIT, PRIS, PRST,PRSS, PRGT, PRGS, &
PRHT, PRHS )
@@ -40,8 +40,6 @@ REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat vari
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at
- ! time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
@@ -79,9 +77,9 @@ END INTERFACE
END MODULE MODI_ICE_ADJUST
!
! ##########################################################################
- SUBROUTINE ICE_ADJUST (KKA,KKU,KKL,KRR, KMI, HFMFILE, HLUOUT, HRAD, &
+ SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, KMI, HFMFILE, HLUOUT, HRAD, &
HTURBDIM, OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PPABSM, PSIGS,PMFCONV,PPABST,PZZ,&
+ PRHODJ, PEXNREF, PSIGS,PMFCONV,PPABST,PZZ, &
PCF_MF,PRC_MF,PRI_MF, &
PRVT, PRCT, PRVS, PRCS, PTHS, PSRCS, PCLDFR , &
PRRT, PRRS, PRIT, PRIS, PRST,PRSS, PRGT, PRGS, &
@@ -158,6 +156,7 @@ END MODULE MODI_ICE_ADJUST
!! JP Pinty 29/11/02 add ICE2 and IC4 cases
!! (P. Jabouille) 27/05/04 safety test for case where esw/i(T)> pabs (~Z>40km)
!! J.Pergaud and S.Malardel Add EDKF case
+!! (E.Perraud) 06/08 add correction to avoid ice when T >0
!! S. Riette ice for EDKF
!! 2012-02 Y. Seity, add possibility to run with reversed vertical levels
!!
@@ -204,8 +203,6 @@ REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat vari
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at
- ! time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
@@ -298,7 +295,7 @@ ZT00 = XTT-40. ! Usefull if LPRETREATMENT=T or LNEW_ADJUST=T
!
!* 2.1 estimate the pressure at t+1
!
-ZEXNS(:,:,:) = ((2. * PPABST(:,:,:) - PPABSM(:,:,:))/XP00)**(XRD/XCPD)
+ZEXNS(:,:,:) = ( PPABST(:,:,:) /XP00)**(XRD/XCPD)
!
! beginning of the iterative loop
!
@@ -384,9 +381,9 @@ END IF
!* compute the saturation mixing ratios at t+1
!
ZW3(:,:,:) = ZW1(:,:,:) * ZEPS &
- / ( 2. * PPABST(:,:,:) - PPABSM(:,:,:) - ZW1(:,:,:) ) ! r_sw
+ / ( PPABST(:,:,:) - ZW1(:,:,:) ) ! r_sw
ZW4(:,:,:) = ZW2(:,:,:) * ZEPS &
- / ( 2. * PPABST(:,:,:) - PPABSM(:,:,:) - ZW2(:,:,:) ) ! r_si
+ / ( PPABST(:,:,:) - ZW2(:,:,:) ) ! r_si
!
WHERE(PRVS(:,:,:)*PTSTEP.LT.ZW4(:,:,:).AND. PRCS(:,:,:).GT.0..AND. ZT(:,:,:).LT.XTT)
!
@@ -439,9 +436,9 @@ END IF
!* 4.4 compute the saturation mixing ratios at t+1
!
ZW3(:,:,:) = ZW1(:,:,:) * ZEPS &
- / ( 2. * PPABST(:,:,:) - PPABSM(:,:,:) - ZW1(:,:,:) ) ! r_sw
+ / ( PPABST(:,:,:) - ZW1(:,:,:) ) ! r_sw
ZW4(:,:,:) = ZW2(:,:,:) * ZEPS &
- / ( 2. * PPABST(:,:,:) - PPABSM(:,:,:) - ZW2(:,:,:) ) ! r_si
+ / ( PPABST(:,:,:) - ZW2(:,:,:) ) ! r_si
!
!* 4.5 compute the saturation mixing ratio derivatives (r'_vs)
!
diff --git a/src/MNH/ice_adjust_bis.f90 b/src/MNH/ice_adjust_bis.f90
new file mode 100644
index 000000000..f9ec1532f
--- /dev/null
+++ b/src/MNH/ice_adjust_bis.f90
@@ -0,0 +1,131 @@
+! ######spl
+ MODULE MODI_ICE_ADJUST_BIS
+! ###############################
+!
+INTERFACE
+!
+! #################################################################
+ SUBROUTINE ICE_ADJUST_BIS(PP,PTH,PR)
+! #################################################################
+!
+!!
+!* 1.1 Declaration of Arguments
+!!
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTH ! thetal to transform into th
+REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PR ! Total mixing ratios to transform into rv,rc and ri
+!
+END SUBROUTINE ICE_ADJUST_BIS
+
+END INTERFACE
+!
+END MODULE MODI_ICE_ADJUST_BIS
+! ######spl
+ SUBROUTINE ICE_ADJUST_BIS(PP,PTH,PR)
+! #################################################################
+!
+!
+!!**** *ICE_ADJUST_BIS* - computes an adjusted state of thermodynamical variables
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Valery Masson & C. Lac * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/2012
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XCPD, XRD, XP00
+!
+USE MODI_COMPUTE_FUNCTION_THERMO
+USE MODI_TH_R_FROM_THL_RT_3D
+USE MODI_THLRT_FROM_THRVRCRI
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTH ! thetal to transform into th
+REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PR ! Total mixing ratios to transform into rv,rc and ri
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZTHL, ZRW, ZRV, ZRC, &
+ ZRI, ZWORK
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZFRAC_ICE, ZRSATW, ZRSATI
+REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZT, ZEXN, ZLVOCPEXN,ZLSOCPEXN
+INTEGER :: IRR
+CHARACTER(LEN=1) :: YFRAC_ICE
+!----------------------------------------------------------------------------
+!
+!* 1 Initialisation
+! --------------
+!
+IRR = SIZE(PR,4)
+!
+ZRV(:,:,:)=0.
+IF (IRR>=1) &
+ZRV(:,:,:)=PR(:,:,:,1)
+ZRC(:,:,:)=0.
+IF (IRR>=2) &
+ZRC(:,:,:)=PR(:,:,:,2)
+ZRI(:,:,:)=0.
+IF (IRR>=4) &
+ZRI(:,:,:)=PR(:,:,:,4)
+!
+YFRAC_ICE='T'
+ZFRAC_ICE(:,:,:) = 0.
+!
+!* 2 Computation
+! -----------
+!
+ZEXN(:,:,:)=(PP(:,:,:)/XP00)**(XRD/XCPD)
+!
+CALL COMPUTE_FUNCTION_THERMO( IRR, &
+ PTH, PR, ZEXN, PP, &
+ ZT,ZLVOCPEXN,ZLSOCPEXN )
+
+!
+CALL THLRT_FROM_THRVRCRI( IRR, PTH, PR, ZLVOCPEXN, ZLSOCPEXN,&
+ ZTHL, ZRW )
+!
+CALL TH_R_FROM_THL_RT_3D(YFRAC_ICE,ZFRAC_ICE(:,:,:),PP(:,:,:), &
+ ZTHL(:,:,:), ZRW(:,:,:), PTH(:,:,:), &
+ ZRV(:,:,:), ZRC(:,:,:), ZRI(:,:,:), &
+ ZRSATW(:,:,:), ZRSATI(:,:,:) )
+!
+
+IF (IRR>=1) &
+PR(:,:,:,1) = ZRV(:,:,:)
+IF (IRR>=2) &
+PR(:,:,:,2) = ZRC(:,:,:)
+IF (IRR>=4) &
+PR(:,:,:,4) = ZRI(:,:,:)
+!
+END SUBROUTINE ICE_ADJUST_BIS
diff --git a/src/MNH/ice_adjust_elec.f90 b/src/MNH/ice_adjust_elec.f90
index 34f7adf79..8724f1092 100644
--- a/src/MNH/ice_adjust_elec.f90
+++ b/src/MNH/ice_adjust_elec.f90
@@ -12,7 +12,7 @@ INTERFACE
SUBROUTINE ICE_ADJUST_ELEC (KRR, KMI, HFMFILE, HLUOUT, HRAD, &
HTURBDIM, HSCONV, HMF_CLOUD, &
OCLOSE_OUT, OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT,&
- PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, PZZ, &
+ PRHODJ, PEXNREF, PSIGS, PPABST, PZZ, &
PMFCONV, PCF_MF, PRC_MF, PRI_MF, &
PRVT, PRCT, PRVS, PRCS, PTHS, PSRCS, PCLDFR , &
PRRT, PRRS, PRIT, PRIS, PRST, PRSS, PRGT, PRGS, &
@@ -44,8 +44,6 @@ REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat vari
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at
- ! time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
@@ -100,7 +98,7 @@ END MODULE MODI_ICE_ADJUST_ELEC
SUBROUTINE ICE_ADJUST_ELEC (KRR, KMI, HFMFILE, HLUOUT, HRAD, &
HTURBDIM, HSCONV, HMF_CLOUD, &
OCLOSE_OUT, OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT,&
- PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, PZZ, &
+ PRHODJ, PEXNREF, PSIGS, PPABST, PZZ, &
PMFCONV, PCF_MF, PRC_MF, PRI_MF, &
PRVT, PRCT, PRVS, PRCS, PTHS, PSRCS, PCLDFR , &
PRRT, PRRS, PRIT, PRIS, PRST, PRSS, PRGT, PRGS, &
@@ -219,8 +217,6 @@ REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat vari
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at
- ! time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
@@ -339,7 +335,7 @@ ZT00 = XTT-40. ! Usefull if LPRETREATMENT=T or LNEW_ADJUST=T
!
!* 2.1 estimate the pressure at t+1
!
-ZEXNS(:,:,:) = ((2. * PPABST(:,:,:) - PPABSM(:,:,:)) / XP00)**(XRD/XCPD)
+ZEXNS(:,:,:) = ( PPABST(:,:,:) / XP00)**(XRD/XCPD)
!
! beginning of the iterative loop
!
@@ -389,9 +385,9 @@ DO JITER = 1, ITERMAX
! ZW3=water vapor ZW1=rc (INOUT) ZW2=ri (INOUT) PSRC= s'rci'/Sigma_s^2
ZW3 = PRVS * PTSTEP; ZW1 = PRCS * PTSTEP; ZW2 = PRIS * PTSTEP
- CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE,1, &
- PPABST, PZZ, ZT, ZW3, ZW1, ZW2, PSIGS, PMFCONV, PCLDFR, PSRCS, .TRUE., OSIGMAS,&
- PSIGQSAT )
+ CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE,1, &
+ PPABST, PZZ, ZT, ZW3, ZW1, ZW2, PSIGS, PMFCONV, PCLDFR, PSRCS, .TRUE., &
+ OSIGMAS, PSIGQSAT )
!
!* 3.2 compute the variation of mixing ratio
!
@@ -423,9 +419,9 @@ DO JITER = 1, ITERMAX
! compute the saturation mixing ratios at t+1
!
ZW3(:,:,:) = ZW1(:,:,:) * ZEPS / &
- (2. * PPABST(:,:,:) - PPABSM(:,:,:) - ZW1(:,:,:)) ! r_sw
+ ( PPABST(:,:,:) - ZW1(:,:,:)) ! r_sw
ZW4(:,:,:) = ZW2(:,:,:) * ZEPS / &
- (2. * PPABST(:,:,:) - PPABSM(:,:,:) - ZW2(:,:,:)) ! r_si
+ ( PPABST(:,:,:) - ZW2(:,:,:)) ! r_si
!
WHERE(PRVS(:,:,:)*PTSTEP .LT. ZW4(:,:,:) .AND. &
PRCS(:,:,:) .GT. 0. .AND. ZT(:,:,:) .LT. XTT)
@@ -479,9 +475,9 @@ DO JITER = 1, ITERMAX
!* 4.4 compute the saturation mixing ratios at t+1
!
ZW3(:,:,:) = ZW1(:,:,:) * ZEPS &
- / ( 2. * PPABST(:,:,:) - PPABSM(:,:,:) - ZW1(:,:,:) ) ! r_sw
+ / ( PPABST(:,:,:) - ZW1(:,:,:) ) ! r_sw
ZW4(:,:,:) = ZW2(:,:,:) * ZEPS &
- / ( 2. * PPABST(:,:,:) - PPABSM(:,:,:) - ZW2(:,:,:) ) ! r_si
+ / ( PPABST(:,:,:) - ZW2(:,:,:) ) ! r_si
!
!* 4.5 compute the saturation mixing ratio derivatives (r'_vs)
!
@@ -632,10 +628,10 @@ ELSE
IF (HSCONV == 'EDKF' .AND. HMF_CLOUD == 'DIRE') THEN
PCLDFR(:,:,:) = MIN(1.,PCLDFR(:,:,:)+PCF_MF(:,:,:))
PRCS(:,:,:) = PRCS(:,:,:) + PRC_MF(:,:,:) / PTSTEP
- PRIS(:,:,:) = PRIS(:,:,:) + PRI_MF(:,:,:) / PTSTEP
- PRVS(:,:,:) = PRVS(:,:,:) - ( PRC_MF(:,:,:) + PRI_MF(:,:,:)) / PTSTEP
- PTHS(:,:,:) = PTHS(:,:,:) + ( PRC_MF(:,:,:) * ZLV(:,:,:) + &
- PRI_MF(:,:,:) * ZLS(:,:,:) ) / ZCPH(:,:,:) / &
+ PRIS(:,:,:) = PRIS(:,:,:)+PRI_MF(:,:,:)/PTSTEP
+ PRVS(:,:,:) = PRVS(:,:,:)- ( PRC_MF(:,:,:) + PRI_MF(:,:,:)) /PTSTEP
+ PTHS(:,:,:) = PTHS(:,:,:) + ( PRC_MF(:,:,:) * ZLV(:,:,:) + &
+ PRI_MF(:,:,:) * ZLS(:,:,:) ) / ZCPH(:,:,:) / &
PEXNREF(:,:,:) / PTSTEP
END IF
ENDIF
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index ade24fbae..b6d0c1d42 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -13,8 +13,7 @@ INTERFACE
OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, &
OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
OHORELAX_SV,OVE_RELAX,OCHTRANS,ONUDGING,ODRAGTREE, &
- HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD, &
- HMET_ADV_SCHEME,HSV_ADV_SCHEME)
+ HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD )
!
INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name of output listing
@@ -58,10 +57,6 @@ CHARACTER (LEN=*), INTENT(IN) :: HTURB ! type of the turbulence scheme
CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence
! scheme
CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme
-CHARACTER (LEN=*), INTENT(IN) :: HMET_ADV_SCHEME ! type of advection scheme
- ! for meteorological scalar variables
-CHARACTER (LEN=*), INTENT(IN) :: HSV_ADV_SCHEME ! type of advection scheme
- ! for tracer scalar variables
!
END SUBROUTINE INI_BUDGET
!
@@ -77,8 +72,7 @@ END MODULE MODI_INI_BUDGET
OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, &
OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
OHORELAX_SV,OVE_RELAX,OCHTRANS,ONUDGING,ODRAGTREE, &
- HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD, &
- HMET_ADV_SCHEME,HSV_ADV_SCHEME)
+ HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD )
! #################################################################
!
!!**** *INI_BUDGET* - routine to initialize the parameters for the budgets
@@ -149,7 +143,6 @@ END MODULE MODI_INI_BUDGET
!! of each direction
!! C. Barthe 19/11/09 Add atmospheric electricity
!! C.Lac 01/07/11 Add vegetation drag
-!!
!! P. Peyrille, M. Tomasini : include in the forcing term the 2D forcing
!! terms in term 2DFRC search for modif PP . but Not very clean!
!-------------------------------------------------------------------------------
@@ -218,10 +211,6 @@ CHARACTER (LEN=*), INTENT(IN) :: HTURB ! type of the turbulence scheme
CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence
! scheme
CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme
-CHARACTER (LEN=*), INTENT(IN) :: HMET_ADV_SCHEME ! type of advection scheme
- ! for meteorological scalar variables
-CHARACTER (LEN=*), INTENT(IN) :: HSV_ADV_SCHEME ! type of advection scheme
- ! for tracer scalar variables
!
!* 0.2 declarations of local variables
!
@@ -421,12 +410,6 @@ IF (LBU_RU) THEN
IPROC=IPROC+1
IF( NMODEL>1 ) IPROACTV(1,IPROC) = NNESTU
IPROC=IPROC+1
- IPROACTV(1,IPROC) = NADVXU
- IPROC=IPROC+1
- IPROACTV(1,IPROC) = NADVYU
- IPROC=IPROC+1
- IPROACTV(1,IPROC) = NADVZU
- IPROC=IPROC+1
IF( LFORCING ) IPROACTV(1,IPROC) = NFRCU
IPROC=IPROC+1
IF( ONUDGING ) IPROACTV(1,IPROC) = NNUDU
@@ -473,6 +456,8 @@ IF (LBU_RU) THEN
IPROC=IPROC+1
IF ( HSCONV == 'EDKF' ) IPROACTV(1,IPROC) = NMAFLU
IPROC=IPROC+1
+ IPROACTV(1,IPROC) = NADVU
+ IPROC=IPROC+1
IPROACTV(1,IPROC) = NPRESU
!
YWORK2(1,1) = 'INIF_'
@@ -483,12 +468,6 @@ IF (LBU_RU) THEN
IPROC=IPROC+1
YWORK2(1,IPROC) = 'NEST_'
IPROC=IPROC+1
- YWORK2(1,IPROC) = 'ADVX_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'ADVY_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'ADVZ_'
- IPROC=IPROC+1
YWORK2(1,IPROC) = 'FRC_'
IPROC=IPROC+1
YWORK2(1,IPROC) = 'NUD_'
@@ -509,6 +488,8 @@ IF (LBU_RU) THEN
IPROC=IPROC+1
YWORK2(1,IPROC) = 'MAFL_'
IPROC=IPROC+1
+ YWORK2(1,IPROC) = 'ADV_'
+ IPROC=IPROC+1
YWORK2(1,IPROC) = 'PRES_'
!
YEND_COMMENT(1) = 'BU_RU'
@@ -532,12 +513,6 @@ IF (LBU_RV) THEN
IPROC=IPROC+1
IF( NMODEL>1 ) IPROACTV(2,IPROC) = NNESTV
IPROC=IPROC+1
- IPROACTV(2,IPROC) = NADVXV
- IPROC=IPROC+1
- IPROACTV(2,IPROC) = NADVYV
- IPROC=IPROC+1
- IPROACTV(2,IPROC) = NADVZV
- IPROC=IPROC+1
IF( LFORCING ) IPROACTV(2,IPROC) = NFRCV
IPROC=IPROC+1
IF( ONUDGING ) IPROACTV(2,IPROC) = NNUDV
@@ -583,6 +558,8 @@ IF (LBU_RV) THEN
END IF
IPROC=IPROC+1
IF ( HSCONV == 'EDKF' ) IPROACTV(2,IPROC) = NMAFLV
+ IPROC=IPROC+1
+ IPROACTV(2,IPROC) = NADVV
IPROC=IPROC+1
IPROACTV(2,IPROC) = NPRESV
!
@@ -594,12 +571,6 @@ IF (LBU_RV) THEN
IPROC=IPROC+1
YWORK2(2,IPROC) = 'NEST_'
IPROC=IPROC+1
- YWORK2(2,IPROC) = 'ADVX_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'ADVY_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'ADVZ_'
- IPROC=IPROC+1
YWORK2(2,IPROC) = 'FRC_'
IPROC=IPROC+1
YWORK2(2,IPROC) = 'NUD_'
@@ -620,6 +591,8 @@ IF (LBU_RV) THEN
IPROC=IPROC+1
YWORK2(2,IPROC) = 'MAFL_'
IPROC=IPROC+1
+ YWORK2(2,IPROC) = 'ADV_'
+ IPROC=IPROC+1
YWORK2(2,IPROC) = 'PRES_'
!
YEND_COMMENT(2) = 'BU_RV'
@@ -643,12 +616,6 @@ IF (LBU_RW) THEN
IPROC=IPROC+1
IF( NMODEL>1 ) IPROACTV(3,IPROC) = NNESTW
IPROC=IPROC+1
- IPROACTV(3,IPROC) = NADVXW
- IPROC=IPROC+1
- IPROACTV(3,IPROC) = NADVYW
- IPROC=IPROC+1
- IPROACTV(3,IPROC) = NADVZW
- IPROC=IPROC+1
IF( LFORCING ) IPROACTV(3,IPROC) = NFRCW
IPROC=IPROC+1
IF( ONUDGING ) IPROACTV(3,IPROC) = NNUDW
@@ -664,8 +631,6 @@ IF (LBU_RW) THEN
ELSE
IPROACTV(3,IPROC) = 4
END IF
- IPROC=IPROC+1
- IPROACTV(3,IPROC) = NGRAVW
IPROC=IPROC+1
IF ( ONUMDIFU ) IPROACTV(3,IPROC) = NDIFW
IPROC=IPROC+1
@@ -693,6 +658,10 @@ IF (LBU_RW) THEN
END IF
END IF
IPROC=IPROC+1
+ IPROACTV(3,IPROC) = NGRAVW
+ IPROC=IPROC+1
+ IPROACTV(3,IPROC) = NADVW
+ IPROC=IPROC+1
IPROACTV(3,IPROC) = NPRESW
!
YWORK2(3,1) = 'INIF_'
@@ -703,12 +672,6 @@ IF (LBU_RW) THEN
IPROC=IPROC+1
YWORK2(3,IPROC) = 'NEST_'
IPROC=IPROC+1
- YWORK2(3,IPROC) = 'ADVX_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'ADVY_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'ADVZ_'
- IPROC=IPROC+1
YWORK2(3,IPROC) = 'FRC_'
IPROC=IPROC+1
YWORK2(3,IPROC) = 'NUD_'
@@ -717,8 +680,6 @@ IF (LBU_RW) THEN
IPROC=IPROC+1
YWORK2(3,IPROC) = 'COR_'
IPROC=IPROC+1
- YWORK2(3,IPROC) = 'GRAV_'
- IPROC=IPROC+1
YWORK2(3,IPROC) = 'DIF_'
IPROC=IPROC+1
YWORK2(3,IPROC) = 'REL_'
@@ -727,6 +688,10 @@ IF (LBU_RW) THEN
IPROC=IPROC+1
YWORK2(3,IPROC) = 'HTURB_'
IPROC=IPROC+1
+ YWORK2(3,IPROC) = 'GRAV_'
+ IPROC=IPROC+1
+ YWORK2(3,IPROC) = 'ADV_'
+ IPROC=IPROC+1
YWORK2(3,IPROC) = 'PRES_'
!
YEND_COMMENT(3) = 'BU_RW'
@@ -750,18 +715,6 @@ IF (LBU_RTH) THEN
IPROC=IPROC+1
IF( NMODEL>1 ) IPROACTV(4,IPROC) = NNESTTH
IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) == 'PPM' ) &
- IPROACTV(4,IPROC) = NADVTH
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(4,IPROC) = NADVXTH
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(4,IPROC) = NADVYTH
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(4,IPROC) = NADVZTH
- IPROC=IPROC+1
IF( LFORCING ) IPROACTV(4,IPROC) = NFRCTH
IPROC=IPROC+1
IF( L2D_ADV_FRC ) IPROACTV(4,IPROC) = N2DADVTH
@@ -810,6 +763,8 @@ IF (LBU_RTH) THEN
IPROC=IPROC+1
IF ( HSCONV == 'EDKF' ) IPROACTV(4,IPROC) = NMAFLTH
IPROC=IPROC+1
+ IPROACTV(4,IPROC) = NADVTH
+ IPROC=IPROC+1
IF (HCLOUD /= 'NONE') IPROACTV(4,IPROC) = NNEGATH
IPROC=IPROC+1
IF (HCLOUD(1:3) == 'ICE' .OR. HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' ) &
@@ -860,14 +815,6 @@ IF (LBU_RTH) THEN
IPROC=IPROC+1
YWORK2(4,IPROC) = 'NEST_'
IPROC=IPROC+1
- YWORK2(4,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'ADVX_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'ADVY_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'ADVZ_'
- IPROC=IPROC+1
YWORK2(4,IPROC) = 'FRC_'
IPROC=IPROC+1
YWORK2(4,IPROC) = '2DADV_'
@@ -894,6 +841,8 @@ IF (LBU_RTH) THEN
IPROC=IPROC+1
YWORK2(4,IPROC) = 'MAFL_'
IPROC=IPROC+1
+ YWORK2(4,IPROC) = 'ADV_'
+ IPROC=IPROC+1
YWORK2(4,IPROC) = 'NEGA_'
IPROC=IPROC+1
YWORK2(4,IPROC) = 'HENU_'
@@ -951,18 +900,6 @@ IF (LBU_RTKE) THEN
IPROC=4
IPROACTV(5,IPROC) = NASSETKE
IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) == 'PPM' ) &
- IPROACTV(5,IPROC) = NADVTKE
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(5,IPROC) = NADVXTKE
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(5,IPROC) = NADVYTKE
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(5,IPROC) = NADVZTKE
- IPROC=IPROC+1
IF( LFORCING ) IPROACTV(5,IPROC) = NFRCTKE
IPROC=IPROC+1
IF ( ONUMDIFTH ) IPROACTV(5,IPROC) = NDIFTKE
@@ -988,6 +925,8 @@ IF (LBU_RTKE) THEN
IPROACTV(5,IPROC) = NDISSTKE
IPROC=IPROC+1
IPROACTV(5,IPROC) = NTRTKE
+ IPROC=IPROC+1
+ IPROACTV(5,IPROC) = NADVTKE
!
YWORK2(5,1) = 'INIF_'
YWORK2(5,2) = 'ENDF_'
@@ -995,14 +934,6 @@ IF (LBU_RTKE) THEN
IPROC=4
YWORK2(5,IPROC) = 'ASSE_'
IPROC=IPROC+1
- YWORK2(5,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'ADVX_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'ADVY_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'ADVZ_'
- IPROC=IPROC+1
YWORK2(5,IPROC) = 'FRC_'
IPROC=IPROC+1
YWORK2(5,IPROC) = 'DIF_'
@@ -1018,6 +949,8 @@ IF (LBU_RTKE) THEN
YWORK2(5,IPROC) = 'DISS_'
IPROC=IPROC+1
YWORK2(5,IPROC) = 'TR_'
+ IPROC=IPROC+1
+ YWORK2(5,IPROC) = 'ADV_'
!
YEND_COMMENT(5) = 'BU_RTKE'
NBUPROCNBR(5) = 3
@@ -1039,18 +972,6 @@ IF (LBU_RRV) THEN
IPROACTV(6,IPROC) = NASSERV
IPROC=IPROC+1
IF( NMODEL>1 ) IPROACTV(6,IPROC) = NNESTRV
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) == 'PPM' ) &
- IPROACTV(6,IPROC) = NADVRV
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(6,IPROC) = NADVXRV
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(6,IPROC) = NADVYRV
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(6,IPROC) = NADVZRV
IPROC=IPROC+1
IF( LFORCING ) IPROACTV(6,IPROC) = NFRCRV
IPROC=IPROC+1
@@ -1090,6 +1011,8 @@ IF (LBU_RRV) THEN
IPROC=IPROC+1
IF ( HSCONV == 'EDKF' ) IPROACTV(6,IPROC) = NMAFLRV
IPROC=IPROC+1
+ IPROACTV(6,IPROC) = NADVRV
+ IPROC=IPROC+1
IF ( HCLOUD /= 'NONE' ) IPROACTV(6,IPROC) = NNEGARV
IPROC=IPROC+1
IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' .OR. HCLOUD(1:3) == 'ICE') &
@@ -1116,14 +1039,6 @@ IF (LBU_RRV) THEN
IPROC=IPROC+1
YWORK2(6,IPROC) = 'NEST_'
IPROC=IPROC+1
- YWORK2(6,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'ADVX_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'ADVY_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'ADVZ_'
- IPROC=IPROC+1
YWORK2(6,IPROC) = 'FRC_'
IPROC=IPROC+1
YWORK2(6,IPROC) = '2DADV_'
@@ -1144,6 +1059,8 @@ IF (LBU_RRV) THEN
IPROC=IPROC+1
YWORK2(6,IPROC) = 'MAFL_'
IPROC=IPROC+1
+ YWORK2(6,IPROC) = 'ADV_'
+ IPROC=IPROC+1
YWORK2(6,IPROC) = 'NEGA_'
IPROC=IPROC+1
YWORK2(6,IPROC) = 'HENU_'
@@ -1179,18 +1096,6 @@ IF (LBU_RRC) THEN
IPROC=IPROC+1
IF( NMODEL>1 ) IPROACTV(7,IPROC) = NNESTRC
IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) == 'PPM' ) &
- IPROACTV(7,IPROC) = NADVRC
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(7,IPROC) = NADVXRC
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(7,IPROC) = NADVYRC
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(7,IPROC) = NADVZRC
- IPROC=IPROC+1
IF( LFORCING ) IPROACTV(7,IPROC) = NFRCRC
IPROC=IPROC+1
IF ( ONUMDIFTH ) IPROACTV(7,IPROC) = NDIFRC
@@ -1221,6 +1126,8 @@ IF (LBU_RRC) THEN
END IF
END IF
IPROC=IPROC+1
+ IPROACTV(7,IPROC) = NADVRC
+ IPROC=IPROC+1
IF( HCLOUD /= 'NONE' ) IPROACTV(7,IPROC) = NNEGARC
IPROC=IPROC+1
IF (HCLOUD(1:3) == 'KES' ) IPROACTV(7,IPROC ) = NACCRRC
@@ -1268,14 +1175,6 @@ IF (LBU_RRC) THEN
IPROC=IPROC+1
YWORK2(7,IPROC) = 'NEST_'
IPROC=IPROC+1
- YWORK2(7,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'ADVX_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'ADVY_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'ADVZ_'
- IPROC=IPROC+1
YWORK2(7,IPROC) = 'FRC_'
IPROC=IPROC+1
YWORK2(7,IPROC) = 'DIF_'
@@ -1288,6 +1187,8 @@ IF (LBU_RRC) THEN
IPROC=IPROC+1
YWORK2(7,IPROC) = 'HTURB_'
IPROC=IPROC+1
+ YWORK2(7,IPROC) = 'ADV_'
+ IPROC=IPROC+1
YWORK2(7,IPROC) = 'NEGA_'
IPROC=IPROC+1
YWORK2(7,IPROC) = 'ACCR_'
@@ -1341,18 +1242,6 @@ IF (LBU_RRR) THEN
IPROC=IPROC+1
IF( NMODEL>1 ) IPROACTV(8,IPROC) = NNESTRR
IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) == 'PPM' ) &
- IPROACTV(8,IPROC) = NADVRR
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(8,IPROC) = NADVXRR
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(8,IPROC) = NADVYRR
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(8,IPROC) = NADVZRR
- IPROC=IPROC+1
IF( LFORCING ) IPROACTV(8,IPROC) = NFRCRR
IPROC=IPROC+1
IF ( ONUMDIFTH ) IPROACTV(8,IPROC) = NDIFRR
@@ -1369,6 +1258,8 @@ IF (LBU_RRR) THEN
END IF
END IF
IPROC=IPROC+1
+ IPROACTV(8,IPROC) = NADVRR
+ IPROC=IPROC+1
IF ( HCLOUD /= 'NONE' ) IPROACTV(8,IPROC) = NNEGARR
IPROC=IPROC+1
IF (HCLOUD(1:3) == 'KES' ) IPROACTV(8,IPROC) = NSEDIRR
@@ -1423,20 +1314,14 @@ IF (LBU_RRR) THEN
IPROC=IPROC+1
YWORK2(8,IPROC) = 'NEST_'
IPROC=IPROC+1
- YWORK2(8,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'ADVX_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'ADVY_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'ADVZ_'
- IPROC=IPROC+1
YWORK2(8,IPROC) = 'FRC_'
IPROC=IPROC+1
YWORK2(8,IPROC) = 'DIF_'
IPROC=IPROC+1
YWORK2(8,IPROC) = 'REL_'
IPROC=IPROC+1
+ YWORK2(8,IPROC) = 'ADV_'
+ IPROC=IPROC+1
YWORK2(8,IPROC) = 'NEGA_'
IPROC=IPROC+1
YWORK2(8,IPROC) = 'SEDI_'
@@ -1498,18 +1383,6 @@ IF (LBU_RRI) THEN
IPROC=IPROC+1
IF( NMODEL>1 ) IPROACTV(9,IPROC) = NNESTRI
IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) == 'PPM' ) &
- IPROACTV(9,IPROC) = NADVRI
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(9,IPROC) = NADVXRI
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(9,IPROC) = NADVYRI
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(9,IPROC) = NADVZRI
- IPROC=IPROC+1
IF( LFORCING ) IPROACTV(9,IPROC) = NFRCRI
IPROC=IPROC+1
IF( ONUMDIFTH ) IPROACTV(9,IPROC) = NDIFRI
@@ -1540,6 +1413,8 @@ IF (LBU_RRI) THEN
END IF
END IF
IPROC=IPROC+1
+ IPROACTV(9,IPROC) = NADVRI
+ IPROC=IPROC+1
IF( HCLOUD /= 'NONE' ) IPROACTV(9,IPROC) = NNEGARI
IPROC=IPROC+1
IF( HCLOUD(1:3) == 'ICE') IPROACTV(9,IPROC) = NHENURI
@@ -1575,14 +1450,6 @@ IF (LBU_RRI) THEN
IPROC= IPROC+1
YWORK2(9,IPROC) = 'NEST_'
IPROC= IPROC+1
- YWORK2(9,IPROC) = 'ADV_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'ADVX_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'ADVY_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'ADVZ_'
- IPROC= IPROC+1
YWORK2(9,IPROC) = 'FRC_'
IPROC= IPROC+1
YWORK2(9,IPROC) = 'DIF_'
@@ -1594,6 +1461,8 @@ IF (LBU_RRI) THEN
YWORK2(9,IPROC) = 'VTURB_'
IPROC=IPROC+1
YWORK2(9,IPROC) = 'HTURB_'
+ IPROC= IPROC+1
+ YWORK2(9,IPROC) = 'ADV_'
IPROC=IPROC+1
YWORK2(9,IPROC) = 'NEGA_'
IPROC= IPROC+1
@@ -1641,19 +1510,7 @@ IF (LBU_RRS) THEN
IPROACTV(10,IPROC) = NASSERS
IPROC= IPROC+1
IF( NMODEL>1 ) IPROACTV(10,IPROC) = NNESTRS
- IPROC= IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) == 'PPM' ) &
- IPROACTV(10,IPROC) = NADVRS
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(10,IPROC) = NADVXRS
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(10,IPROC) = NADVYRS
IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(10,IPROC) = NADVZRS
- IPROC= IPROC+1
IF( LFORCING ) IPROACTV(10,IPROC) = NFRCRS
IPROC= IPROC+1
IF( ONUMDIFTH ) IPROACTV(10,IPROC) = NDIFRS
@@ -1670,6 +1527,8 @@ IF (LBU_RRS) THEN
END IF
END IF
IPROC= IPROC+1
+ IPROACTV(10,IPROC) = NADVRS
+ IPROC= IPROC+1
IF( HCLOUD /= 'NONE' ) IPROACTV(10,IPROC) = NNEGARS
IPROC=IPROC+1
IF( HCLOUD(1:3) == 'ICE') IPROACTV(10,IPROC) = NDEPSRS
@@ -1701,19 +1560,13 @@ IF (LBU_RRS) THEN
IPROC= IPROC+1
YWORK2(10,IPROC) = 'NEST_'
IPROC= IPROC+1
- YWORK2(10,IPROC) = 'ADV_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'ADVX_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'ADVY_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'ADVZ_'
- IPROC= IPROC+1
YWORK2(10,IPROC) = 'FRC_'
IPROC= IPROC+1
YWORK2(10,IPROC) = 'DIF_'
IPROC= IPROC+1
YWORK2(10,IPROC) = 'REL_'
+ IPROC= IPROC+1
+ YWORK2(10,IPROC) = 'ADV_'
IPROC=IPROC+1
YWORK2(10,IPROC) = 'NEGA_'
IPROC= IPROC+1
@@ -1758,18 +1611,6 @@ IF (LBU_RRG) THEN
IPROC=IPROC+1
IF( NMODEL>1 ) IPROACTV(11,IPROC) = NNESTRG
IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) == 'PPM' ) &
- IPROACTV(11,IPROC) = NADVRG
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(11,IPROC) = NADVXRG
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(11,IPROC) = NADVYRG
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(11,IPROC) = NADVZRG
- IPROC=IPROC+1
IF( LFORCING ) IPROACTV(11,IPROC) = NFRCRG
IPROC=IPROC+1
IF( ONUMDIFTH ) IPROACTV(11,IPROC) = NDIFRG
@@ -1786,6 +1627,8 @@ IF (LBU_RRG) THEN
END IF
END IF
IPROC=IPROC+1
+ IPROACTV(11,IPROC) = NADVRG
+ IPROC=IPROC+1
IF( HCLOUD /= 'NONE' ) IPROACTV(11,IPROC) = NNEGARG
IPROC=IPROC+1
IF( HCLOUD(1:3) == 'ICE') IPROACTV(11,IPROC) = NSFRRG
@@ -1819,20 +1662,14 @@ IF (LBU_RRG) THEN
IPROC=IPROC+1
YWORK2(11,IPROC) = 'NEST_'
IPROC=IPROC+1
- YWORK2(11,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'ADVX_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'ADVY_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'ADVZ_'
- IPROC=IPROC+1
YWORK2(11,IPROC) = 'FRC_'
IPROC=IPROC+1
YWORK2(11,IPROC) = 'DIF_'
IPROC=IPROC+1
YWORK2(11,IPROC) = 'REL_'
IPROC=IPROC+1
+ YWORK2(11,IPROC) = 'ADV_'
+ IPROC=IPROC+1
YWORK2(11,IPROC) = 'NEGA_'
IPROC=IPROC+1
YWORK2(11,IPROC)= 'SFR_'
@@ -1881,18 +1718,6 @@ IF (LBU_RRH) THEN
ELSE
IPROACTV(12,IPROC) = 3
END IF
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) == 'PPM' ) &
- IPROACTV(12,IPROC) = NADVRH
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(12,IPROC) = NADVXRH
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(12,IPROC) = NADVYRH
- IPROC=IPROC+1
- IF ( HMET_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(12,IPROC) = NADVZRH
IPROC=IPROC+1
IF( LFORCING ) THEN
IPROACTV(12,IPROC) = NFRCRH
@@ -1918,6 +1743,8 @@ IF (LBU_RRH) THEN
END IF
END IF
IPROC=IPROC+1
+ IPROACTV(12,IPROC) = NADVRH
+ IPROC=IPROC+1
IF( HCLOUD /= 'NONE' ) THEN
IPROACTV(12,IPROC) = NNEGARH
ELSE
@@ -1940,20 +1767,14 @@ IF (LBU_RRH) THEN
IPROC=IPROC+1
YWORK2(12,IPROC) = 'NEST_'
IPROC=IPROC+1
- YWORK2(12,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'ADVX_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'ADVY_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'ADVZ_'
- IPROC=IPROC+1
YWORK2(12,IPROC) = 'FRC_'
IPROC=IPROC+1
YWORK2(12,IPROC) = 'DIF_'
IPROC=IPROC+1
YWORK2(12,IPROC) = 'REL_'
IPROC=IPROC+1
+ YWORK2(12,IPROC) = 'ADV_'
+ IPROC=IPROC+1
YWORK2(12,IPROC) = 'NEGA_'
IPROC=IPROC+1
YWORK2(12,IPROC) = 'WETG_'
@@ -1988,18 +1809,6 @@ IF (LBU_RSV) THEN
IPROC=IPROC+1
IF( NMODEL>1 ) IPROACTV(12+JSV,IPROC) = NNESTSV
IPROC=IPROC+1
- IF ( HSV_ADV_SCHEME(1:3) == 'PPM' ) &
- IPROACTV(12+JSV,IPROC) = NADVSV
- IPROC=IPROC+1
- IF ( HSV_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(12+JSV,IPROC) = NADVXSV
- IPROC=IPROC+1
- IF ( HSV_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(12+JSV,IPROC) = NADVYSV
- IPROC=IPROC+1
- IF ( HSV_ADV_SCHEME(1:3) /= 'PPM' ) &
- IPROACTV(12+JSV,IPROC) = NADVZSV
- IPROC=IPROC+1
IF( LFORCING ) IPROACTV(12+JSV,IPROC) = NFRCSV
IPROC=IPROC+1
IF ( ONUMDIFSV ) IPROACTV(12+JSV,IPROC) = NDIFSV
@@ -2033,6 +1842,7 @@ IF (LBU_RSV) THEN
IPROC=IPROC+1
IF ( HSCONV == 'EDKF' ) IPROACTV(12+JSV,IPROC)= NMAFLSV
IPROC=IPROC+1
+ IPROACTV(12+JSV,IPROC) = NADVSV
!
YWORK2(12+JSV,1) = 'INIF_'
YWORK2(12+JSV,2) = 'ENDF_'
@@ -2042,14 +1852,6 @@ IF (LBU_RSV) THEN
IPROC=IPROC+1
YWORK2(12+JSV,IPROC) = 'NEST_'
IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'ADVX_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'ADVY_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'ADVZ_'
- IPROC=IPROC+1
YWORK2(12+JSV,IPROC) = 'FRC_'
IPROC=IPROC+1
YWORK2(12+JSV,IPROC) = 'DIF_'
@@ -2063,6 +1865,8 @@ IF (LBU_RSV) THEN
YWORK2(12+JSV,IPROC) = 'HTURB_'
IPROC=IPROC+1
YWORK2(12+JSV,IPROC) = 'MAFL_'
+ IPROC=IPROC+1
+ YWORK2(12+JSV,IPROC) = 'ADV_'
!
! complete with the budget of other processes
!
diff --git a/src/MNH/ini_cpl.f90 b/src/MNH/ini_cpl.f90
index 187015a48..9ae86ee27 100644
--- a/src/MNH/ini_cpl.f90
+++ b/src/MNH/ini_cpl.f90
@@ -321,9 +321,7 @@ LOGICAL, DIMENSION(JPCPLFILEMAX) :: GSKIP ! array to skip or not after
REAL :: ZDIST ! temporal distance in secunds
! between 2 dates
LOGICAL :: GLSOURCE ! switch for the source term (for ini_ls and ini_lb)
-!! CL !!
-CHARACTER(LEN=4), DIMENSION(KSV) :: YGETSVM
-!! CL !!
+!CHARACTER(LEN=4), DIMENSION(KSV) :: YGETSVM
!
!-------------------------------------------------------------------------------
!
@@ -499,23 +497,23 @@ CALL INI_LS(CCPLFILE(NCPL_CUR),HLUOUT,HGETRVM,GLSOURCE,PLSUS,PLSVS,PLSWS,PLSTHS,
!
!* 3.2 Initialize the LB sources
!
-YGETSVM(1:KSV) = HGETSVM(1:KSV)
-IF ( LUSECHEM .AND. (.NOT. OCH_INIT_FIELD) ) &
- YGETSVM(NSV_CHEMBEG: NSV_CHEMEND) = 'INIT'
-IF (HCONF == 'RESTA') THEN
- IF (NSV_USER /= 0) YGETSVM(1/NSV_USER) = 'INIT'
- IF (NSV_C2R2 /= 0) YGETSVM(NSV_C2R2BEG: NSV_C2R2END) = 'INIT'
- IF (NSV_C1R3 /= 0) YGETSVM(NSV_C1R3BEG: NSV_C1R3END) = 'INIT'
- IF (NSV_ELEC /= 0) YGETSVM(NSV_ELECBEG: NSV_ELECEND) = 'INIT'
- IF (NSV_LG /= 0) YGETSVM(NSV_LGBEG: NSV_LGEND) = 'INIT'
- IF (NSV_LNOX /= 0) YGETSVM(NSV_LNOXBEG: NSV_LNOXEND) = 'INIT'
- IF (NSV_DST /= 0) YGETSVM(NSV_DSTBEG: NSV_DSTEND) = 'INIT'
- IF (NSV_SLT /= 0) YGETSVM(NSV_SLTBEG: NSV_SLTEND) = 'INIT'
- IF (NSV_DSTDEP /= 0) YGETSVM(NSV_DSTDEPBEG: NSV_DSTDEPEND) = 'INIT'
- IF (NSV_SLTDEP /= 0) YGETSVM(NSV_SLTDEPBEG: NSV_SLTDEPEND) = 'INIT'
- IF (NSV_PP /= 0) YGETSVM(NSV_PPBEG: NSV_PPEND) = 'INIT'
- IF (NSV_CS /= 0) YGETSVM(NSV_CSBEG: NSV_CSEND) = 'INIT'
-END IF
+!YGETSVM(1:KSV) = HGETSVM(1:KSV)
+!IF ( LUSECHEM .AND. (.NOT. OCH_INIT_FIELD) ) &
+! YGETSVM(NSV_CHEMBEG: NSV_CHEMEND) = 'INIT'
+!IF (HCONF == 'RESTA') THEN
+! IF (NSV_USER /= 0) YGETSVM(1/NSV_USER) = 'INIT'
+! IF (NSV_C2R2 /= 0) YGETSVM(NSV_C2R2BEG: NSV_C2R2END) = 'INIT'
+! IF (NSV_C1R3 /= 0) YGETSVM(NSV_C1R3BEG: NSV_C1R3END) = 'INIT'
+! IF (NSV_ELEC /= 0) YGETSVM(NSV_ELECBEG: NSV_ELECEND) = 'INIT'
+! IF (NSV_LG /= 0) YGETSVM(NSV_LGBEG: NSV_LGEND) = 'INIT'
+! IF (NSV_LNOX /= 0) YGETSVM(NSV_LNOXBEG: NSV_LNOXEND) = 'INIT'
+! IF (NSV_DST /= 0) YGETSVM(NSV_DSTBEG: NSV_DSTEND) = 'INIT'
+! IF (NSV_SLT /= 0) YGETSVM(NSV_SLTBEG: NSV_SLTEND) = 'INIT'
+! IF (NSV_DSTDEP /= 0) YGETSVM(NSV_DSTDEPBEG: NSV_DSTDEPEND) = 'INIT'
+! IF (NSV_SLTDEP /= 0) YGETSVM(NSV_SLTDEPBEG: NSV_SLTDEPEND) = 'INIT'
+! IF (NSV_PP /= 0) YGETSVM(NSV_PPBEG: NSV_PPEND) = 'INIT'
+! IF (NSV_CS /= 0) YGETSVM(NSV_CSBEG: NSV_CSEND) = 'INIT'
+!END IF
GLSOURCE=.TRUE.
CALL INI_LB(CCPLFILE(NCPL_CUR),HLUOUT,GLSOURCE,KSV, &
@@ -523,7 +521,7 @@ CALL INI_LB(CCPLFILE(NCPL_CUR),HLUOUT,GLSOURCE,KSV, &
KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
HGETTKEM,HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM, &
- HGETRGM,HGETRHM,YGETSVM, &
+ HGETRGM,HGETRHM,HGETSVM, &
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
diff --git a/src/MNH/ini_elecn.f90 b/src/MNH/ini_elecn.f90
index 9b00bea40..c9a7be45a 100644
--- a/src/MNH/ini_elecn.f90
+++ b/src/MNH/ini_elecn.f90
@@ -87,12 +87,12 @@ USE MODD_ELEC_n, ONLY : XRHOM_E, XAF_E, XCF_E, XBFY_E
USE MODD_CONF_n, ONLY : NRR
USE MODD_PARAMETERS, ONLY : JPVEXT, JPHEXT
USE MODD_CST
-USE MODD_CONF, ONLY : CEQNSYS
+USE MODD_CONF, ONLY : CEQNSYS,CCONF,CPROGRAM
USE MODD_DYN
USE MODD_REF
USE MODD_TIME
-USE MODD_GET_n, ONLY : CGETRCT,CGETRRT, CGETRST, CGETRGT, CGETRHT, CGETCLOUD, &
- CGETSVM
+USE MODD_GET_n, ONLY : CGETINPRC, CGETINPRR, CGETINPRS, CGETINPRG, CGETINPRH, &
+ CGETCLOUD, CGETSVT
USE MODD_PRECIP_n, ONLY : XINPRR, XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, &
XINPRH, XACPRH, XINPRC, XACPRC, XINPRR3D, XEVAP3D
USE MODD_CLOUDPAR_n, ONLY : NSPLITR
@@ -207,8 +207,8 @@ IF(SIZE(XINPRR) == 0) RETURN
!* 2. Initialize MODD_PRECIP_n variables
! -----------------------------------
!
-CALL READ_PRECIP_FIELD (HINIFILE, HLUOUT, &
- CGETRCT, CGETRRT, CGETRST, CGETRGT, CGETRHT, &
+CALL READ_PRECIP_FIELD (HINIFILE, HLUOUT, CPROGRAM, CCONF, &
+ CGETINPRC,CGETINPRR,CGETINPRS,CGETINPRG,CGETINPRH, &
XINPRC, XACPRC, XINPRR, XINPRR3D, XEVAP3D, &
XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, XINPRH, XACPRH)
!
@@ -249,7 +249,7 @@ IF (HELEC(1:3) == 'ELE') THEN
!
ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
!
- CALL INI_PARAM_ELEC (HINIFILE, HLUOUT, CGETSVM, ZRHO00, NRR, IINTVL, &
+ CALL INI_PARAM_ELEC (HINIFILE, HLUOUT, CGETSVT, ZRHO00, NRR, IINTVL, &
ZFDINFTY, IIU, IJU, IKU)
!
!
diff --git a/src/MNH/ini_lesn.f90 b/src/MNH/ini_lesn.f90
index ca8156717..c30fe0e2d 100644
--- a/src/MNH/ini_lesn.f90
+++ b/src/MNH/ini_lesn.f90
@@ -100,31 +100,30 @@ IJU_ll = IJMAX_ll+2*JPHEXT
!
CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
!
-NLES_TOTADVH = 1
-NLES_TOTADVV = 2
-NLES_RELA = 3
-NLES_RAD = 4
-NLES_GRAV = 5
-NLES_COR = 6
-NLES_MICR = 7
-NLES_HTURB = 8
-NLES_VTURB = 9
-NLES_FORC = 10
-NLES_PRES = 11
-NLES_DIFF = 12
-NLES_CURV = 13
-NLES_PREF = 14
-NLES_DP = 15
-NLES_TP = 16
-NLES_TR = 17
-NLES_DISS = 18
-NLES_TEND = 19
-NLES_ADVR = 20
-NLES_ADVM = 21
-NLES_NEST = 22
-NLES_MISC = 23
-!
-NLES_TOT = 23
+NLES_TOTADV = 1
+NLES_RELA = 2
+NLES_RAD = 3
+NLES_GRAV = 4
+NLES_COR = 5
+NLES_MICR = 6
+NLES_HTURB = 7
+NLES_VTURB = 8
+NLES_FORC = 9
+NLES_PRES = 10
+NLES_DIFF = 11
+NLES_CURV = 12
+NLES_PREF = 13
+NLES_DP = 14
+NLES_TP = 15
+NLES_TR = 16
+NLES_DISS = 17
+NLES_TEND = 18
+NLES_ADVR = 19
+NLES_ADVM = 20
+NLES_NEST = 21
+NLES_MISC = 22
+!
+NLES_TOT = 22
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_lg.f90 b/src/MNH/ini_lg.f90
index 415c7e173..64b0f0a9c 100644
--- a/src/MNH/ini_lg.f90
+++ b/src/MNH/ini_lg.f90
@@ -9,11 +9,11 @@
! ##################
INTERFACE
!
- SUBROUTINE INI_LG(PXHAT,PYHAT,PZZ,PSVM,PSVT,PLBXSVM,PLBYSVM)
+ SUBROUTINE INI_LG(PXHAT,PYHAT,PZZ,PSVT,PLBXSVM,PLBYSVM)
!
REAL,DIMENSION(:), INTENT(IN) :: PXHAT,PYHAT ! Positions x,y in the cartesian plane
REAL,DIMENSION(:,:,:), INTENT(IN) :: PZZ ! True altitude of the w grid-point
-REAL,DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVM,PSVT ! scalar var. at t-1 and t
+REAL,DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! scalar var. at t
REAL,DIMENSION(:,:,:,:), INTENT(INOUT) :: PLBXSVM,PLBYSVM ! LB in x and y-dir.
!
END SUBROUTINE INI_LG
@@ -25,7 +25,7 @@ END MODULE MODI_INI_LG
!
!
! ############################################################
- SUBROUTINE INI_LG(PXHAT,PYHAT,PZZ,PSVM,PSVT,PLBXSVM,PLBYSVM)
+ SUBROUTINE INI_LG(PXHAT,PYHAT,PZZ,PSVT,PLBXSVM,PLBYSVM)
! ############################################################
!
!!**** *INI_LG* - routine to initialize lagrangian variables
@@ -76,7 +76,7 @@ IMPLICIT NONE
!
REAL,DIMENSION(:), INTENT(IN) :: PXHAT,PYHAT ! Positions x,y in the cartesian plane
REAL,DIMENSION(:,:,:), INTENT(IN) :: PZZ ! True altitude of the w grid-point
-REAL,DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVM,PSVT ! scalar var. at t-1 and t
+REAL,DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! scalar var. at t
REAL,DIMENSION(:,:,:,:), INTENT(INOUT) :: PLBXSVM,PLBYSVM ! LB in x and y-dir.
!
!
@@ -99,40 +99,38 @@ IKU=SIZE(PZZ,3)
DO JK=1,IKU
DO JJ=1,IJU
DO JI=1,IIU-1
- PSVM(JI,JJ,JK,NSV_LGBEG)=0.5*(PXHAT(JI)+PXHAT(JI+1))
+ PSVT(JI,JJ,JK,NSV_LGBEG)=0.5*(PXHAT(JI)+PXHAT(JI+1))
END DO
- PSVM(IIU,JJ,JK,NSV_LGBEG)=2.*PSVM(IIU-1,JJ,JK,NSV_LGBEG)-PSVM(IIU-2,JJ,JK,NSV_LGBEG)
+ PSVT(IIU,JJ,JK,NSV_LGBEG)=2.*PSVT(IIU-1,JJ,JK,NSV_LGBEG)-PSVT(IIU-2,JJ,JK,NSV_LGBEG)
END DO
END DO
!
DO JK=1,IKU
DO JI=1,IIU
DO JJ=1,IJU-1
- PSVM(JI,JJ,JK,NSV_LGBEG+1)=0.5*(PYHAT(JJ)+PYHAT(JJ+1))
+ PSVT(JI,JJ,JK,NSV_LGBEG+1)=0.5*(PYHAT(JJ)+PYHAT(JJ+1))
END DO
- PSVM(JI,IJU,JK,NSV_LGBEG+1)=2.*PSVM(JI,IJU-1,JK,NSV_LGBEG+1)-PSVM(JI,IJU-2,JK,NSV_LGBEG+1)
+ PSVT(JI,IJU,JK,NSV_LGBEG+1)=2.*PSVT(JI,IJU-1,JK,NSV_LGBEG+1)-PSVT(JI,IJU-2,JK,NSV_LGBEG+1)
END DO
END DO
!
DO JI=1,IIU
DO JJ=1,IJU
DO JK=1,IKU-1
- PSVM(JI,JJ,JK,NSV_LGEND)=0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+1))
+ PSVT(JI,JJ,JK,NSV_LGEND)=0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+1))
END DO
- PSVM(JI,JJ,IKU,NSV_LGEND)=2.*PSVM(JI,JJ,IKU-1,NSV_LGEND)-PSVM(JI,JJ,IKU-2,NSV_LGEND)
+ PSVT(JI,JJ,IKU,NSV_LGEND)=2.*PSVT(JI,JJ,IKU-1,NSV_LGEND)-PSVT(JI,JJ,IKU-2,NSV_LGEND)
END DO
END DO
!
-PSVT(:,:,:,NSV_LGBEG:NSV_LGEND)=PSVM(:,:,:,NSV_LGBEG:NSV_LGEND)
-!
!* 3. SET LB
! ------
!
-IF (LWEST_ll()) PLBXSVM(1,:,:,NSV_LGBEG:NSV_LGEND)=PSVM(1,:,:,NSV_LGBEG:NSV_LGEND)
-IF (LEAST_ll()) PLBXSVM(SIZE(PLBXSVM,1),:,:,NSV_LGBEG:NSV_LGEND)=PSVM(IIU,:,:,NSV_LGBEG:NSV_LGEND)
+IF (LWEST_ll()) PLBXSVM(1,:,:,NSV_LGBEG:NSV_LGEND)=PSVT(1,:,:,NSV_LGBEG:NSV_LGEND)
+IF (LEAST_ll()) PLBXSVM(SIZE(PLBXSVM,1),:,:,NSV_LGBEG:NSV_LGEND)=PSVT(IIU,:,:,NSV_LGBEG:NSV_LGEND)
IF ( SIZE(PLBYSVM,1) >0 ) THEN
- IF(LSOUTH_ll()) PLBYSVM(:,1,:,NSV_LGBEG:NSV_LGEND)=PSVM(:,1,:,NSV_LGBEG:NSV_LGEND)
- IF(LNORTH_ll()) PLBYSVM(:,SIZE(PLBYSVM,2),:,NSV_LGBEG:NSV_LGEND)=PSVM(:,IJU,:,NSV_LGBEG:NSV_LGEND)
+ IF(LSOUTH_ll()) PLBYSVM(:,1,:,NSV_LGBEG:NSV_LGEND)=PSVT(:,1,:,NSV_LGBEG:NSV_LGEND)
+ IF(LNORTH_ll()) PLBYSVM(:,SIZE(PLBYSVM,2),:,NSV_LGBEG:NSV_LGEND)=PSVT(:,IJU,:,NSV_LGBEG:NSV_LGEND)
END IF
!
END SUBROUTINE INI_LG
diff --git a/src/MNH/ini_micron.f90 b/src/MNH/ini_micron.f90
index d8c3b213a..2ce036302 100644
--- a/src/MNH/ini_micron.f90
+++ b/src/MNH/ini_micron.f90
@@ -55,6 +55,7 @@ END MODULE MODI_INI_MICRO_n
!
USE MODD_NSV, ONLY : NSV,NSV_CHEM,NSV_C2R2BEG,NSV_C2R2END, &
NSV_C1R3BEG,NSV_C1R3END
+USE MODD_CONF, ONLY : CCONF,CPROGRAM
USE MODD_LUNIT_n, ONLY : CINIFILE,CLUOUT
USE MODD_GET_n, ONLY : CGETRCT,CGETRRT, CGETRST, CGETRGT, CGETRHT, CGETCLOUD
USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll
@@ -62,7 +63,7 @@ USE MODD_PARAMETERS, ONLY : JPVEXT, JPHEXT
USE MODD_PARAM_n, ONLY : CCLOUD
USE MODD_PRECIP_n, ONLY : XINPRR, XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, &
XINPRH, XACPRH, XINPRC, XACPRC, XINPRR3D, XEVAP3D
-USE MODD_FIELD_n, ONLY : XRM, XSVM, XRT, XSVT, XTHT, XPABST
+USE MODD_FIELD_n, ONLY : XRT, XSVT, XTHT, XPABST, XTHM, XRCM
USE MODD_GRID_n, ONLY : XZZ
USE MODD_METRICS_n, ONLY : XDXX,XDYY,XDZZ,XDZX,XDZY
USE MODD_REF_n, ONLY : XRHODREF
@@ -70,7 +71,7 @@ USE MODD_DYN_n, ONLY : XTSTEP
USE MODD_CLOUDPAR_n, ONLY : NSPLITR, NSPLITG
USE MODD_PARAM_n, ONLY : CELEC
USE MODD_PARAM_ICE, ONLY : LSEDIC
-USE MODD_PARAM_C2R2, ONLY : LSEDC
+USE MODD_PARAM_C2R2, ONLY : LSEDC, LACTIT
!
USE MODI_READ_PRECIP_FIELD
USE MODI_INI_CLOUD
@@ -179,10 +180,23 @@ END IF
!
IF(SIZE(XINPRR) == 0) RETURN
!
+!* 2b. ALLOCATION for Radiative cooling
+! ------------------------------
+IF (LACTIT) THEN
+ ALLOCATE( XTHM(IIU,IJU,IKU) )
+ ALLOCATE( XRCM(IIU,IJU,IKU) )
+ XTHM = XTHT
+ XRCM(:,:,:) = XRT(:,:,:,2)
+ ELSE
+ ALLOCATE( XTHM(0,0,0) )
+ ALLOCATE( XRCM(0,0,0) )
+END IF
+!
!* 3. INITIALIZE MODD_PRECIP_n variables
! ----------------------------------
!
-CALL READ_PRECIP_FIELD(CINIFILE,CLUOUT,CGETRCT,CGETRRT,CGETRST,CGETRGT,CGETRHT, &
+CALL READ_PRECIP_FIELD(CINIFILE,CLUOUT,CPROGRAM,CCONF, &
+ CGETRCT,CGETRRT,CGETRST,CGETRGT,CGETRHT, &
XINPRC,XACPRC,XINPRR,XINPRR3D,XEVAP3D, &
XACPRR,XINPRS,XACPRS,XINPRG,XACPRG, XINPRH,XACPRH )
!
@@ -217,23 +231,17 @@ END IF
!
IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
IF (CGETCLOUD=='READ') THEN
- CALL CLEAN_CONC_RAIN_C2R2 (CLUOUT,XRM,XSVM(:,:,:,NSV_C2R2BEG:NSV_C2R2END))
CALL CLEAN_CONC_RAIN_C2R2 (CLUOUT,XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C2R2END))
ELSE IF (CGETCLOUD=='INI1'.OR.CGETCLOUD=='INI2') THEN
CALL SET_CONC_RAIN_C2R2 (CLUOUT,CGETCLOUD,XRHODREF,&
&XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C2R2END))
- CALL SET_CONC_RAIN_C2R2 (CLUOUT,CGETCLOUD,XRHODREF,&
- &XRM,XSVM(:,:,:,NSV_C2R2BEG:NSV_C2R2END))
ENDIF
IF (CCLOUD == 'C3R5' ) THEN
IF (CGETCLOUD=='READ') THEN
- CALL CLEAN_CONC_ICE_C1R3 (CLUOUT,XRM,XSVM(:,:,:,NSV_C2R2BEG:NSV_C1R3END))
CALL CLEAN_CONC_ICE_C1R3 (CLUOUT,XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C1R3END))
ELSE
CALL SET_CONC_ICE_C1R3 (CLUOUT,XRHODREF,&
&XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C1R3END))
- CALL SET_CONC_ICE_C1R3 (CLUOUT,XRHODREF,&
- &XRM,XSVM(:,:,:,NSV_C2R2BEG:NSV_C1R3END))
ENDIF
ENDIF
ENDIF
@@ -244,10 +252,10 @@ ENDIF
!
!
IMI = GET_CURRENT_MODEL_INDEX()
-IF (CELEC /= 'NONE') THEN
-!!$ CALL INI_ELEC(IMI,CINIFILE,CLUOUT,XTSTEP,ZDZMIN,NSPLITR, &
-!!$ XDXX,XDYY,XDZZ,XDZX,XDZY )
-END IF
+!IF (CELEC /= 'NONE') THEN
+! CALL INI_ELEC(IMI,CINIFILE,CLUOUT,XTSTEP,ZDZMIN,NSPLITR, &
+! XDXX,XDYY,XDZZ,XDZX,XDZY )
+!END IF
!
!
END SUBROUTINE INI_MICRO_n
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index ed2144a2e..04bfe2efa 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -1,4 +1,4 @@
-! $Source$ $Revision$ $Date: 2010/11/16 15:45:48
+! $Source$ $Revision$ $Date$
!-----------------------------------------------------------------
! #######################
MODULE MODI_INI_MODEL_n
@@ -6,10 +6,9 @@
!
INTERFACE
!
- SUBROUTINE INI_MODEL_n(KMI,PTSTEP_OLD,HLUOUT,HINIFILE,HINIFILEPGD)
+ SUBROUTINE INI_MODEL_n(KMI,HLUOUT,HINIFILE,HINIFILEPGD)
!
INTEGER, INTENT(IN) :: KMI ! Model index
- REAL, INTENT(IN) :: PTSTEP_OLD ! OLD Time STEP
CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
! of nested models
CHARACTER (LEN=28), INTENT(IN) :: HINIFILE ! name of
@@ -21,7 +20,7 @@ END INTERFACE
!
END MODULE MODI_INI_MODEL_n
! ######################################################
- SUBROUTINE INI_MODEL_n(KMI,PTSTEP_OLD,HLUOUT,HINIFILE,HINIFILEPGD)
+ SUBROUTINE INI_MODEL_n(KMI,HLUOUT,HINIFILE,HINIFILEPGD)
! ######################################################
!
!!**** *INI_MODEL_n* - routine to initialize the nested model _n
@@ -284,6 +283,7 @@ USE MODD_METRICS_n
USE MODD_DYN_n
USE MODD_DYNZD_n
USE MODD_FIELD_n
+USE MODD_PAST_FIELD_n
USE MODD_MEAN_FIELD_n
USE MODD_MEAN_FIELD
USE MODD_ADV_n
@@ -397,7 +397,6 @@ IMPLICIT NONE
!
!
INTEGER, INTENT(IN) :: KMI ! Model Index
-REAL, INTENT(IN) :: PTSTEP_OLD ! OLD Time STEP
CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
! of nested models
@@ -490,6 +489,7 @@ CLUOUT = HLUOUT
CINIFILE=HINIFILE
CINIFILEPGD=HINIFILEPGD
!
+CALL FMREAD(HINIFILE,'MASDEV',HLUOUT,'--',IMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
!-------------------------------------------------------------------------------
!
!* 2. END OF READING
@@ -583,30 +583,30 @@ CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
NRR=0
NRRL=0
NRRI=0
-IF ((CGETRVM /= 'SKIP' ).OR.(CGETRVT /= 'SKIP' )) THEN
+IF (CGETRVT /= 'SKIP' ) THEN
NRR = NRR+1
END IF
-IF ((CGETRCM /= 'SKIP' ).OR.(CGETRCT /= 'SKIP' )) THEN
+IF (CGETRCT /= 'SKIP' ) THEN
NRR = NRR+1
NRRL = NRRL+1
END IF
-IF ((CGETRRM /= 'SKIP').OR.(CGETRRT /= 'SKIP' )) THEN
+IF (CGETRRT /= 'SKIP' ) THEN
NRR = NRR+1
NRRL = NRRL+1
END IF
-IF ((CGETRIM /= 'SKIP').OR.(CGETRIT /= 'SKIP' )) THEN
+IF (CGETRIT /= 'SKIP' ) THEN
NRR = NRR+1
NRRI = NRRI+1
END IF
-IF ((CGETRSM /= 'SKIP').OR.(CGETRST /= 'SKIP' )) THEN
+IF (CGETRST /= 'SKIP' ) THEN
NRR = NRR+1
NRRI = NRRI+1
END IF
-IF ((CGETRGM /= 'SKIP').OR.(CGETRGT /= 'SKIP' )) THEN
+IF (CGETRGT /= 'SKIP' ) THEN
NRR = NRR+1
NRRI = NRRI+1
END IF
-IF ((CGETRHM /= 'SKIP').OR.(CGETRHT /= 'SKIP' )) THEN
+IF (CGETRHT /= 'SKIP' ) THEN
NRR = NRR+1
NRRI = NRRI+1
END IF
@@ -628,11 +628,6 @@ CALL UPDATE_NSV(KMI)
!
!* 3.1 Module MODD_FIELD_n
!
-ALLOCATE(XUM(IIU,IJU,IKU)) ; XUM = 0.0
-ALLOCATE(XVM(IIU,IJU,IKU)) ; XVM = 0.0
-ALLOCATE(XWM(IIU,IJU,IKU)) ; XWM = 0.0
-ALLOCATE(XTHM(IIU,IJU,IKU)) ; XTHM = 0.0
-!
IF (LMEAN_FIELD) THEN
!
MEAN_COUNT = 0
@@ -654,6 +649,15 @@ IF (LMEAN_FIELD) THEN
!
END IF
!
+IF (CUVW_ADV_SCHEME(1:3)=='CEN') THEN
+ ALLOCATE(XUM(IIU,IJU,IKU)) ; XUM = 0.0
+ ALLOCATE(XVM(IIU,IJU,IKU)) ; XVM = 0.0
+ ALLOCATE(XWM(IIU,IJU,IKU)) ; XWM = 0.0
+ ALLOCATE(XDUM(IIU,IJU,IKU)) ; XDUM = 0.0
+ ALLOCATE(XDVM(IIU,IJU,IKU)) ; XDVM = 0.0
+ ALLOCATE(XDWM(IIU,IJU,IKU)) ; XDWM = 0.0
+END IF
+!
ALLOCATE(XUT(IIU,IJU,IKU)) ; XUT = 0.0
ALLOCATE(XVT(IIU,IJU,IKU)) ; XVT = 0.0
ALLOCATE(XWT(IIU,IJU,IKU)) ; XWT = 0.0
@@ -661,15 +665,18 @@ ALLOCATE(XTHT(IIU,IJU,IKU)) ; XTHT = 0.0
ALLOCATE(XRUS(IIU,IJU,IKU)) ; XRUS = 0.0
ALLOCATE(XRVS(IIU,IJU,IKU)) ; XRVS = 0.0
ALLOCATE(XRWS(IIU,IJU,IKU)) ; XRWS = 0.0
-ALLOCATE(XRTHS(IIU,IJU,IKU))
+ALLOCATE(XRUS_PRES(IIU,IJU,IKU)); XRUS_PRES = 0.0
+ALLOCATE(XRVS_PRES(IIU,IJU,IKU)); XRVS_PRES = 0.0
+ALLOCATE(XRWS_PRES(IIU,IJU,IKU)); XRWS_PRES = 0.0
+ALLOCATE(XRTHS(IIU,IJU,IKU)) ; XRTHS = 0.0
+ALLOCATE(XRTHS_CLD(IIU,IJU,IKU)); XRTHS_CLD = 0.0
IF (CTURB /= 'NONE') THEN
- ALLOCATE(XTKEM(IIU,IJU,IKU))
ALLOCATE(XTKET(IIU,IJU,IKU))
ALLOCATE(XRTKES(IIU,IJU,IKU))
+ ALLOCATE(XRTKEMS(IIU,IJU,IKU)); XRTKEMS = 0.0
ALLOCATE(XWTHVMF(IIU,IJU,IKU))
- XTKEMIN=XKEMIN
+ XTKEMIN=XKEMIN
ELSE
- ALLOCATE(XTKEM(0,0,0))
ALLOCATE(XTKET(0,0,0))
ALLOCATE(XRTKES(0,0,0))
ALLOCATE(XWTHVMF(0,0,0))
@@ -688,16 +695,14 @@ END IF
ALLOCATE(XPABSM(IIU,IJU,IKU)) ; XPABSM = 0.0
ALLOCATE(XPABST(IIU,IJU,IKU)) ; XPABST = 0.0
!
-ALLOCATE(XRM(IIU,IJU,IKU,NRR))
ALLOCATE(XRT(IIU,IJU,IKU,NRR))
ALLOCATE(XRRS(IIU,IJU,IKU,NRR))
+ALLOCATE(XRRS_CLD(IIU,IJU,IKU,NRR)); XRRS_CLD = 0.0
!
IF (CTURB /= 'NONE' .AND. NRR>1) THEN
- ALLOCATE(XSRCM(IIU,IJU,IKU))
ALLOCATE(XSRCT(IIU,IJU,IKU))
ALLOCATE(XSIGS(IIU,IJU,IKU))
ELSE
- ALLOCATE(XSRCM(0,0,0))
ALLOCATE(XSRCT(0,0,0))
ALLOCATE(XSIGS(0,0,0))
END IF
@@ -708,9 +713,9 @@ ELSE
ALLOCATE(XCLDFR(0,0,0))
END IF
!
-ALLOCATE(XSVM(IIU,IJU,IKU,NSV))
ALLOCATE(XSVT(IIU,IJU,IKU,NSV))
ALLOCATE(XRSVS(IIU,IJU,IKU,NSV))
+ALLOCATE(XRSVS_CLD(IIU,IJU,IKU,NSV)); XRSVS_CLD = 0.0
!
IF (LPASPOL) THEN
ALLOCATE( XATC(IIU,IJU,IKU,NSV_PP) )
@@ -720,20 +725,7 @@ IF (LPASPOL) THEN
XATC = 0.
END IF
!
-!* 3.2 Module MODD_ADV_n
-!
-IF (CMET_ADV_SCHEME(1:3) == 'PPM' .OR. CSV_ADV_SCHEME(1:3) == 'PPM') THEN
- ALLOCATE(XRTHMS(IIU,IJU,IKU)) ; XRTHMS = 0.
- IF (CTURB /= 'NONE') THEN
- ALLOCATE(XRTKEMS(IIU,IJU,IKU))
- XRTKEMS = 0.
- ENDIF
- ALLOCATE(XRRMS(IIU,IJU,IKU,NRR)); XRRMS = 0.
- ALLOCATE(XRSVMS(IIU,IJU,IKU,NSV)) ; XRSVMS = 0.
-END IF
-!
-!
-!* 3.3 Module MODD_GRID_n and MODD_METRICS_n
+!* 3.2 Module MODD_GRID_n and MODD_METRICS_n
!
IF (LCARTESIAN) THEN
ALLOCATE(XLON(0,0))
@@ -764,7 +756,7 @@ ALLOCATE(XDZX(IIU,IJU,IKU))
ALLOCATE(XDZY(IIU,IJU,IKU))
ALLOCATE(XDZZ(IIU,IJU,IKU))
!
-!* 3.4 Modules MODD_REF and MODD_REF_n
+!* 3.3 Modules MODD_REF and MODD_REF_n
!
IF (KMI == 1) THEN
ALLOCATE(XRHODREFZ(IKU),XTHVREFZ(IKU))
@@ -779,7 +771,7 @@ ELSE
ALLOCATE(XRVREF(0,0,0))
END IF
!
-!* 3.5 Module MODD_CURVCOR_n
+!* 3.4 Module MODD_CURVCOR_n
!
IF (LTHINSHELL) THEN
ALLOCATE(XCORIOX(0,0))
@@ -797,7 +789,7 @@ ELSE
ALLOCATE(XCURVY(IIU,IJU))
END IF
!
-!* 3.6 Module MODD_DYN_n
+!* 3.5 Module MODD_DYN_n
!
CALL GET_DIM_EXT_ll('Y',IIY,IJY)
IF (L2D) THEN
@@ -841,7 +833,7 @@ ELSE
CALL INIT_TYPE_ZDIFFU_HALO2(XZDIFFU_HALO2,0)
ENDIF
!
-!* 3.7 Larger Scale variables (Module MODD_LSFIELD$n)
+!* 3.6 Larger Scale variables (Module MODD_LSFIELD$n)
!
!
! upper relaxation part
@@ -1164,7 +1156,7 @@ ELSE
END IF
!
!
-!* 4.8 Module MODD_RADIATIONS_n (except XOZON and XAER)
+!* 3.7 Module MODD_RADIATIONS_n (except XOZON and XAER)
!
!
NSWB_MNH = 6
@@ -1232,7 +1224,7 @@ ELSE
ALLOCATE(XSTATM(0,0))
END IF
!
-!* 4.9 Module MODD_DEEP_CONVECTION_n
+!* 3.8 Module MODD_DEEP_CONVECTION_n
!
IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
ALLOCATE(NCOUNTCONV(IIU,IJU))
@@ -1296,11 +1288,11 @@ ALLOCATE(XCF_MF(IIU,IJU,IKU)) ; XCF_MF=0.0
ALLOCATE(XRC_MF(IIU,IJU,IKU)) ; XRC_MF=0.0
ALLOCATE(XRI_MF(IIU,IJU,IKU)) ; XRI_MF=0.0
!
-!* 4.10 Local variables
+!* 3.9 Local variables
!
ALLOCATE(ZJ(IIU,IJU,IKU))
!
-!* 4.11 Forcing variables (Module MODD_FRC)
+!* 3.10 Forcing variables (Module MODD_FRC)
!
IF (KMI == 1) THEN
IF ( LFORCING ) THEN
@@ -1388,7 +1380,7 @@ ELSE
ALLOCATE(XVU_FLUX_M(0,0,0)) ; XVU_FLUX_M = 0.
END IF
!
-!* 4.12 Module MODD_ICE_CONC_n
+!* 3.11 Module MODD_ICE_CONC_n
!
IF ( (CCLOUD == 'ICE3'.OR.CCLOUD == 'ICE4') .AND. &
(CPROGRAM == 'DIAG '.OR.CPROGRAM == 'MESONH')) THEN
@@ -1397,7 +1389,7 @@ ELSE
ALLOCATE(XCIT(0,0,0))
END IF
!
-!* 4.13 Module MODD_TURB_CLOUD
+!* 3.12 Module MODD_TURB_CLOUD
!
IF (.NOT.(ALLOCATED(XCEI))) ALLOCATE(XCEI(0,0,0))
IF (KMI == NMODEL_CLOUD .AND. CTURBLEN_CLOUD/='NONE' ) THEN
@@ -1405,7 +1397,7 @@ IF (KMI == NMODEL_CLOUD .AND. CTURBLEN_CLOUD/='NONE' ) THEN
ALLOCATE(XCEI(IIU,IJU,IKU))
ENDIF
!
-!* 4.14 Module MODD_CH_PH_n
+!* 3.13 Module MODD_CH_PH_n
!
IF ( (LUSECHAQ.AND.LCH_PH) .AND. &
(CPROGRAM == 'DIAG '.OR.CPROGRAM == 'MESONH')) THEN
@@ -1417,7 +1409,7 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 5. INITIALIZE BUDGET VARIABLES
+!* 4. INITIALIZE BUDGET VARIABLES
! ---------------------------
!
IF ( CBUTYPE /= "NONE" .AND. NBUMOD == KMI ) THEN
@@ -1426,20 +1418,19 @@ IF ( CBUTYPE /= "NONE" .AND. NBUMOD == KMI ) THEN
LHORELAX_UVWTH,LHORELAX_RV, LHORELAX_RC,LHORELAX_RR, &
LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, LHORELAX_RH,LHORELAX_TKE, &
LHORELAX_SV,LVE_RELAX,LCHTRANS,LNUDGING,LDRAGTREE, &
- CRAD,CDCONV,CSCONV,CTURB,CTURBDIM,CCLOUD, &
- CMET_ADV_SCHEME,CSV_ADV_SCHEME )
+ CRAD,CDCONV,CSCONV,CTURB,CTURBDIM,CCLOUD )
END IF
!
!-------------------------------------------------------------------------------
!
!
-!* 6. INITIALIZE INTERPOLATION COEFFICIENTS
+!* 5. INITIALIZE INTERPOLATION COEFFICIENTS
!
CALL INI_BIKHARDT_n (NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI),KMI)
!
!-------------------------------------------------------------------------------
!
-!* 7. INITIALIZE GRIDS AND METRIC COEFFICIENTS
+!* 6. INITIALIZE GRIDS AND METRIC COEFFICIENTS
! ----------------------------------------
!
CALL SET_GRID(KMI,HINIFILE,HLUOUT,IIU,IJU,IKU,NIMAX_ll,NJMAX_ll, &
@@ -1475,7 +1466,7 @@ NDT_2_WAY(KMI)=4
!
!-------------------------------------------------------------------------------
!
-!* 8. INITIALIZE DATA FOR JVALUES AND AEROSOLS
+!* 7. INITIALIZE DATA FOR JVALUES AND AEROSOLS
!
IF ( LUSECHEM .OR. LCHEMDIAG ) THEN
IF ((KMI==1).AND.(CPROGRAM == "MESONH".OR.CPROGRAM == "DIAG ")) &
@@ -1495,20 +1486,18 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!* 9. INITIALIZE THE PROGNOSTIC FIELDS
+!* 8. INITIALIZE THE PROGNOSTIC FIELDS
! --------------------------------
!
-CALL READ_FIELD(HINIFILE,HLUOUT,IIU,IJU,IKU,PTSTEP_OLD,XTSTEP, &
- CGETTKEM,CGETRVM,CGETRCM,CGETRRM,CGETRIM,CGETRSM, &
- CGETRGM,CGETRHM,CGETSVM,CGETSRCM, &
+CALL READ_FIELD(HINIFILE,HLUOUT,IMASDEV, IIU,IJU,IKU,XTSTEP, &
CGETTKET,CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETCIT, &
CGETRST,CGETRGT,CGETRHT,CGETSVT,CGETSRCT,CGETSIGS,CGETCLDFR, &
- CGETBL_DEPTH,CGETSBL_DEPTH,CGETPHC,CGETPHR, &
+ CGETBL_DEPTH,CGETSBL_DEPTH,CGETPHC,CGETPHR,CUVW_ADV_SCHEME, &
NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, &
NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
- XUM,XVM,XWM,XTHM,XPABSM,XTKEM,XRM,XSVM,XSRCM, &
- XUT,XVT,XWT,XTHT,XPABST,XTKET,XRT,XSVT,XCIT,XDRYMASST, &
+ XUM,XVM,XWM, &
+ XUT,XVT,XWT,XTHT,XPABST,XPABSM,XTKET,XRT,XSVT,XCIT,XDRYMASST, &
XSIGS,XSRCT,XCLDFR,XBL_DEPTH,XSBL_DEPTH,XWTHVMF,XPHC,XPHR, &
XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM, &
@@ -1520,12 +1509,13 @@ CALL READ_FIELD(HINIFILE,HLUOUT,IIU,IJU,IKU,PTSTEP_OLD,XTSTEP, &
XPGROUNDFRC, XATC, &
NADVFRC,TDTADVFRC,XDTHFRC,XDRVFRC, &
NRELFRC,TDTRELFRC,XTHREL,XRVREL, &
- XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M )
+ XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M, &
+ XRUS_PRES,XRVS_PRES,XRWS_PRES,XRTHS_CLD,XRRS_CLD,XRSVS_CLD )
!
!-------------------------------------------------------------------------------
!
!
-!* 10. INITIALIZE REFERENCE STATE
+!* 9. INITIALIZE REFERENCE STATE
! ---------------------------
!
!
@@ -1536,25 +1526,24 @@ CALL SET_REF(KMI,HINIFILE,HLUOUT, &
!
!-------------------------------------------------------------------------------
!
-!* 11.1 INITIALIZE THE TURBULENCE VARIABLES
+!* 10.1 INITIALIZE THE TURBULENCE VARIABLES
! -----------------------------------
!
IF ((CTURB == 'TKEL').AND.(CCONF=='START')) THEN
- CALL INI_TKE_EPS(CGETTKEM,CGETTKET,XTHVREF,XZZ, &
- XUM,XVM,XTHM, &
+ CALL INI_TKE_EPS(CGETTKET,XTHVREF,XZZ, &
XUT,XVT,XTHT, &
- XTKEM,XTKET,TZINITHALO3D_ll )
+ XTKET,TZINITHALO3D_ll )
END IF
!
!
-!* 11.2 INITIALIZE THE LES VARIABLES
+!* 10.2 INITIALIZE THE LES VARIABLES
! ----------------------------
!
CALL INI_LES_n
!
!-------------------------------------------------------------------------------
!
-!* 12. INITIALIZE THE SOURCE OF TOTAL DRY MASS Md
+!* 11. INITIALIZE THE SOURCE OF TOTAL DRY MASS Md
! ------------------------------------------
!
IF((KMI==1).AND.LSTEADYLS) THEN
@@ -1563,7 +1552,7 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!* 13. INITIALIZE THE MICROPHYSICS
+!* 12. INITIALIZE THE MICROPHYSICS
! ----------------------------
!
IF (CELEC == 'NONE') THEN
@@ -1571,7 +1560,7 @@ IF (CELEC == 'NONE') THEN
!
!-------------------------------------------------------------------------------
!
-!* 14. INITIALIZE THE ATMOSPHERIC ELECTRICITY
+!* 13. INITIALIZE THE ATMOSPHERIC ELECTRICITY
! --------------------------------------
!
ELSE
@@ -1583,39 +1572,28 @@ ELSE
FMT='(/,"ELECTRIC VARIABLES ARE BETWEEN INDEX",I2," AND ",I2)')&
NSV_ELECBEG, NSV_ELECEND
!
- IF( CCONF == 'START' ) THEN
- XSVM(:,:,:,NSV_ELECBEG) = XCION_POS_FW(:,:,:) ! Nb/kg
- XSVM(:,:,:,NSV_ELECEND) = XCION_NEG_FW(:,:,:)
- XSVT(:,:,:,NSV_ELECBEG) = XSVM(:,:,:,NSV_ELECBEG)
- XSVT(:,:,:,NSV_ELECEND) = XSVM(:,:,:,NSV_ELECEND)
- ELSE ! Convert elec_variables per m3 into elec_variables per kg of air
- IF( CGETSVM(NSV_ELECBEG)=='INIT' .OR. CGETSVT(NSV_ELECBEG)=='INIT' ) THEN
- XSVM(:,:,:,NSV_ELECBEG) = XCION_POS_FW(:,:,:) ! Nb/kg
- XSVM(:,:,:,NSV_ELECEND) = XCION_NEG_FW(:,:,:)
- XSVT(:,:,:,NSV_ELECBEG) = XSVM(:,:,:,NSV_ELECBEG)
- XSVT(:,:,:,NSV_ELECEND) = XSVM(:,:,:,NSV_ELECEND)
-!
- XSVM(:,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ IF( CGETSVT(NSV_ELECBEG)=='INIT' ) THEN
+ XSVT(:,:,:,NSV_ELECBEG) = XCION_POS_FW(:,:,:) ! Nb/kg
+ XSVT(:,:,:,NSV_ELECEND) = XCION_NEG_FW(:,:,:)
+!
XSVT(:,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
- ELSE
+ ELSE ! Convert elec_variables per m3 into elec_variables per kg of air
DO JSV = NSV_ELECBEG, NSV_ELECEND
- XSVM(:,:,:,JSV) = XSVM(:,:,:,JSV) / XRHODREF(:,:,:)
XSVT(:,:,:,JSV) = XSVT(:,:,:,JSV) / XRHODREF(:,:,:)
ENDDO
END IF
- END IF
END IF
!
!-------------------------------------------------------------------------------
!
-!* 15. INITIALIZE THE LARGE SCALE SOURCES
+!* 14. INITIALIZE THE LARGE SCALE SOURCES
! ----------------------------------
!
IF ((KMI==1).AND.(.NOT. LSTEADYLS)) THEN
CALL INI_CPL(HLUOUT,NSTOP,XTSTEP,LSTEADYLS,CCONF, &
- CGETTKEM, &
- CGETRVM,CGETRCM,CGETRRM,CGETRIM, &
- CGETRSM,CGETRGM,CGETRHM,CGETSVM,LCH_INIT_FIELD, &
+ CGETTKET, &
+ CGETRVT,CGETRCT,CGETRRT,CGETRIT, &
+ CGETRST,CGETRGT,CGETRHT,CGETSVT,LCH_INIT_FIELD, &
NSV,NIMAX_ll,NJMAX_ll, &
NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, &
NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
@@ -1725,14 +1703,14 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!* 16. INITIALIZE THE SCALAR VARIABLES
+!* 15. INITIALIZE THE SCALAR VARIABLES
! -------------------------------
!
IF (LLG .AND. LINIT_LG .AND. CPROGRAM=='MESONH') &
- CALL INI_LG(XXHAT,XYHAT,XZZ,XSVM,XSVT,XLBXSVM,XLBYSVM)
+ CALL INI_LG(XXHAT,XYHAT,XZZ,XSVT,XLBXSVM,XLBYSVM)
!
-!* 17. BUILT THE GENERIC OUTPUT NAME
+!* 16. BUILT THE GENERIC OUTPUT NAME
! ----------------------------
!
WRITE(COUTFILE,'(A,".",I1,".",A)') CEXP,KMI,TRIM(ADJUSTL(CSEG))
@@ -1750,7 +1728,7 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!* 18. INITIALIZE THE PARAMETERS FOR THE DYNAMICS
+!* 17. INITIALIZE THE PARAMETERS FOR THE DYNAMICS
! ------------------------------------------
!
CALL INI_DYNAMICS(HLUOUT,XLON,XLAT,XRHODJ,XTHVREF,XMAP,XZZ,XDXHAT,XDYHAT, &
@@ -1774,10 +1752,10 @@ CALL INI_DYNAMICS(HLUOUT,XLON,XLAT,XRHODJ,XTHVREF,XMAP,XZZ,XDXHAT,XDYHAT, &
!
!-------------------------------------------------------------------------------
!
-!* 19. SURFACE FIELDS
+!* 18. SURFACE FIELDS
! --------------
!
-!* 19.1 Radiative setup
+!* 18.1 Radiative setup
! ---------------
!
IF (CRAD /= 'NONE') THEN
@@ -1824,13 +1802,13 @@ END IF
CALL INI_SW_SETUP (CRAD,NSWB_MNH,XSW_BANDS)
!
!
-! 19.1.1 Special initialisation for CO2 content
+! 18.1.1 Special initialisation for CO2 content
! CO2 (molar mass=44) horizontally and vertically homogeneous at 360 ppm
!
XCCO2 = 360.0E-06 * 44.0E-03 / XMD
!
!
-!* 19.2 Externalized surface fields
+!* 18.2 Externalized surface fields
! ---------------------------
!
ALLOCATE(ZCO2(IIU,IJU))
@@ -1842,7 +1820,6 @@ ALLOCATE(ZSCA_ALB(IIU,IJU,NSWB_MNH))
ALLOCATE(ZEMIS (IIU,IJU))
ALLOCATE(ZTSRAD (IIU,IJU))
!
-CALL FMREAD(HINIFILE,'MASDEV',HLUOUT,'--',IMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
IF (IMASDEV>=46) THEN
CALL FMREAD(HINIFILE,'SURF',HLUOUT,'--',CSURF,IGRID,ILENCH,YCOMMENT,IRESP)
ELSE
@@ -1921,14 +1898,14 @@ IF (CRAD == 'ECMW' .AND. CGETRAD=='READ') THEN
END IF
!
!
-!* 19.3 Mesonh fields
+!* 18.3 Mesonh fields
! -------------
!
IF (CPROGRAM/='REAL ') CALL MNHREAD_ZS_DUMMY_n(CINIFILEPGD)
!
!-------------------------------------------------------------------------------
!
-!* 20. INITIALIZE THE PARAMETERS FOR THE PHYSICS
+!* 19. INITIALIZE THE PARAMETERS FOR THE PHYSICS
! -----------------------------------------
!
IF (CRAD == 'ECMW') THEN
@@ -1996,7 +1973,7 @@ END IF
!-------------------------------------------------------------------------------
!
!
-!* 21. ALLOCATION OF THE TEMPORAL SERIES
+!* 19. ALLOCATION OF THE TEMPORAL SERIES
! ---------------------------------
!
IF (LSERIES .AND. CPROGRAM/='DIAG ') CALL INI_SERIES_n
@@ -2004,7 +1981,7 @@ IF (LSERIES .AND. CPROGRAM/='DIAG ') CALL INI_SERIES_n
!-------------------------------------------------------------------------------
!
!
-!* 22. (re)initialize scalar variables
+!* 20. (re)initialize scalar variables
! -------------------------------
!
!
@@ -2016,7 +1993,7 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!* 23. UPDATE HALO
+!* 22. UPDATE HALO
! -----------
!
!
@@ -2028,7 +2005,7 @@ CALL CLEANLIST_ll(TZINITHALO2D_ll)
!
!-------------------------------------------------------------------------------
!
-!* 24. DEALLOCATION
+!* 23. DEALLOCATION
! -------------
!
DEALLOCATE(ZJ)
@@ -2041,7 +2018,7 @@ DEALLOCATE(XSPOWATM)
!
!-------------------------------------------------------------------------------
!
-!* 25. BALLOON and AIRCRAFT initializations
+!* 24. BALLOON and AIRCRAFT initializations
! ------------------------------------
!
CALL INI_AIRCRAFT_BALLOON(HINIFILE,CLUOUT,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
@@ -2050,7 +2027,7 @@ CALL INI_AIRCRAFT_BALLOON(HINIFILE,CLUOUT,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
!
!-------------------------------------------------------------------------------
!
-!* 26. STATION initializations
+!* 25. STATION initializations
! -----------------------
!
CALL INI_SURFSTATION_n(CLUOUT,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
@@ -2059,7 +2036,7 @@ CALL INI_SURFSTATION_n(CLUOUT,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
!
!-------------------------------------------------------------------------------
!
-!* 27. PROFILER initializations
+!* 26. PROFILER initializations
! ------------------------
!
CALL INI_POSPROFILER_n(CLUOUT,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
@@ -2080,4 +2057,3 @@ CALL INI_AEROSET6
!
END SUBROUTINE INI_MODEL_n
-
diff --git a/src/MNH/ini_one_wayn.f90 b/src/MNH/ini_one_wayn.f90
index 36db201f9..d71e80cb1 100644
--- a/src/MNH/ini_one_wayn.f90
+++ b/src/MNH/ini_one_wayn.f90
@@ -2,6 +2,7 @@
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$
+! MASDEV4_7 init 2006/10/16 14:23:23
!-----------------------------------------------------------------
! #######################
MODULE MODI_INI_ONE_WAY_n
@@ -263,7 +264,7 @@ ENDIF
!
GVERT_INTERP=.TRUE.
!
-IRR=MIN(SIZE(XRM,4),SIZE(PLBXRM,4))
+IRR=MIN(SIZE(XRT,4),SIZE(PLBXRM,4))
ISV_USER=MIN(NSV_USER_A(KDAD),NSV_USER_A(KMI))
!
IF(LWEST_ll()) THEN
@@ -299,35 +300,31 @@ CALL GET_CHILD_DIM_ll(KMI, IDIMX, IDIMY, IINFO_ll)
!
! 1.2 Allocate array which will receive coarse grid points
!
-ALLOCATE(ZTUM(IDIMX,IDIMY,SIZE(XUM,3)))
-ZTUM(:,:,:)=0.
-ALLOCATE(ZTVM(IDIMX,IDIMY,SIZE(XVM,3)))
-ZTVM(:,:,:)=0.
-ALLOCATE(ZTWM(IDIMX,IDIMY,SIZE(XWM,3)))
-ZTWM(:,:,:)=0.
-ALLOCATE(ZTTHM(IDIMX,IDIMY,SIZE(XTHM,3)))
-ZTTHM(:,:,:)=0.
-IF (SIZE(XTKEM) /= 0) ALLOCATE(ZTTKEM(IDIMX,IDIMY,SIZE(XTKEM,3)))
-IF (IRR /= 0) ALLOCATE(ZTRM(IDIMX,IDIMY,SIZE(XRM,3),IRR))
-IF (NSV_A(KMI)/= 0) ALLOCATE(ZTSVM(IDIMX,IDIMY,SIZE(XRM,3),NSV_A(KMI)))
+ALLOCATE(ZTUM(IDIMX,IDIMY,SIZE(XUT,3)))
+ALLOCATE(ZTVM(IDIMX,IDIMY,SIZE(XVT,3)))
+ALLOCATE(ZTWM(IDIMX,IDIMY,SIZE(XWT,3)))
+ALLOCATE(ZTTHM(IDIMX,IDIMY,SIZE(XTHT,3)))
+IF (SIZE(XTKET) /= 0) ALLOCATE(ZTTKEM(IDIMX,IDIMY,SIZE(XTKET,3)))
+IF (IRR /= 0) ALLOCATE(ZTRM(IDIMX,IDIMY,SIZE(XRT,3),IRR))
+IF (NSV_A(KMI)/= 0) ALLOCATE(ZTSVM(IDIMX,IDIMY,SIZE(XRT,3),NSV_A(KMI)))
!
! 1.3 Specify the ls "source" fields and receiver fields
!
-CALL SET_LSFIELD_1WAY_ll(XUM,ZTUM,KMI)
-CALL SET_LSFIELD_1WAY_ll(XVM,ZTVM,KMI)
-CALL SET_LSFIELD_1WAY_ll(XWM,ZTWM,KMI)
-CALL SET_LSFIELD_1WAY_ll(XTHM,ZTTHM,KMI)
-IF (ALLOCATED(ZTTKEM)) CALL SET_LSFIELD_1WAY_ll(XTKEM,ZTTKEM,KMI)
+CALL SET_LSFIELD_1WAY_ll(XUT,ZTUM,KMI)
+CALL SET_LSFIELD_1WAY_ll(XVT,ZTVM,KMI)
+CALL SET_LSFIELD_1WAY_ll(XWT,ZTWM,KMI)
+CALL SET_LSFIELD_1WAY_ll(XTHT,ZTTHM,KMI)
+IF (ALLOCATED(ZTTKEM)) CALL SET_LSFIELD_1WAY_ll(XTKET,ZTTKEM,KMI)
!
DO JRR=1,IRR
- CALL SET_LSFIELD_1WAY_ll(XRM(:,:,:,JRR),ZTRM(:,:,:,JRR),KMI)
+ CALL SET_LSFIELD_1WAY_ll(XRT(:,:,:,JRR),ZTRM(:,:,:,JRR),KMI)
ENDDO
!
! USERs scalar variables
!
IF (ALLOCATED(ZTSVM)) ZTSVM=0.
DO JSV=1,ISV_USER
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV),ZTSVM(:,:,:,JSV),KMI)
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV),ZTSVM(:,:,:,JSV),KMI)
ENDDO
! Checking if it is necessary to compute the Nc and Nr
! concentrations to use the C2R2 microphysical scheme
@@ -341,14 +338,14 @@ IF ( HCLOUD=="C2R2" .OR. HCLOUD=="KHKO" ) THEN
ELSE IF (CCLOUD == "KESS" ) THEN
ZINIT_TYPE = "INI2"
END IF
- CALL SET_CONC_RAIN_C2R2 (HLUOUT,ZINIT_TYPE,XRHODREF,XRM,ZCONCM)
+ CALL SET_CONC_RAIN_C2R2 (HLUOUT,ZINIT_TYPE,XRHODREF,XRT,ZCONCM)
DO JSV=1,3
CALL SET_LSFIELD_1WAY_ll(ZCONCM(:,:,:,JSV),&
&ZTSVM(:,:,:,JSV-1+NSV_C2R2BEG_A(KMI)),KMI)
ENDDO
ELSE
DO JSV=1,NSV_C2R2_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_C2R2BEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_C2R2BEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_C2R2BEG_A(KMI)),KMI)
END DO
ENDIF
@@ -367,7 +364,7 @@ IF (HCLOUD=="C3R5" ) THEN
ELSE IF (CCLOUD == "KESS" ) THEN
ZINIT_TYPE = "INI2"
END IF
- CALL SET_CONC_RAIN_C2R2 (HLUOUT,ZINIT_TYPE,XRHODREF,XRM,ZCONCM)
+ CALL SET_CONC_RAIN_C2R2 (HLUOUT,ZINIT_TYPE,XRHODREF,XRT,ZCONCM)
DO JSV=1,3
CALL SET_LSFIELD_1WAY_ll(ZCONCM(:,:,:,JSV),&
&ZTSVM(:,:,:,JSV-1+NSV_C2R2BEG_A(KMI)),KMI)
@@ -380,11 +377,11 @@ IF (HCLOUD=="C3R5" ) THEN
ENDDO
ELSE
DO JSV=1,NSV_C2R2_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_C2R2BEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_C2R2BEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_C2R2BEG_A(KMI)),KMI)
END DO
DO JSV=1,NSV_C1R3_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_C1R3BEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_C1R3BEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_C1R3BEG_A(KMI)),KMI)
END DO
ENDIF
@@ -393,7 +390,7 @@ ENDIF
! electrical variables
!
DO JSV=1,MIN(NSV_ELEC_A(KMI),NSV_ELEC_A(KDAD))
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_ELECBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_ELECBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_ELECBEG_A(KMI)),KMI)
END DO
!
@@ -407,20 +404,20 @@ IF (OUSECHAQ) THEN
ALLOCATE(ZCHEMM(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),&
NSV_CHEM_A(KMI)))
CALL SET_CHEMAQ_1WAY(HLUOUT,XRHODREF,&
- XSVM(:,:,:,NSV_CHEMBEG_A(KDAD):NSV_CHEMEND_A(KDAD)),ZCHEMM)
+ XSVT(:,:,:,NSV_CHEMBEG_A(KDAD):NSV_CHEMEND_A(KDAD)),ZCHEMM)
DO JSV=1,NSV_CHEM_A(KMI)
CALL SET_LSFIELD_1WAY_ll(ZCHEMM(:,:,:,JSV),&
&ZTSVM(:,:,:,JSV-1+NSV_CHEMBEG_A(KMI)),KMI)
ENDDO
ELSE
DO JSV=1,NSV_CHEM_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_CHEMBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_CHEMBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_CHEMBEG_A(KMI)),KMI)
END DO
ENDIF
ELSE
DO JSV=1,NSV_CHEM_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_CHEMBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_CHEMBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_CHEMBEG_A(KMI)),KMI)
END DO
ENDIF
@@ -439,13 +436,13 @@ IF (OUSECHIC) THEN
ENDDO
ELSE
DO JSV=1,NSV_CHIC_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_CHICBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_CHICBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_CHICBEG_A(KMI)),KMI)
END DO
ENDIF
ELSE
DO JSV=1,NSV_CHIC_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_CHICBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_CHICBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_CHICBEG_A(KMI)),KMI)
END DO
ENDIF
@@ -453,44 +450,44 @@ ENDIF
!
! lagrangian variables
DO JSV=1,NSV_LG_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_LGBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_LGBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_LGBEG_A(KMI)),KMI)
END DO
!
! NOX
DO JSV=1,NSV_LNOX_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_LNOXBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_LNOXBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_LNOXBEG_A(KMI)),KMI)
END DO
!
! Dust Scalar variables
DO JSV=1,NSV_DST_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_DSTBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_DSTBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_DSTBEG_A(KMI)),KMI)
END DO
!
! Moist Dust Scalar variables
DO JSV=1,NSV_DSTDEP_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_DSTDEPBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_DSTDEPBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_DSTDEPBEG_A(KMI)),KMI)
END DO
! Sea Salt Scalar variables
DO JSV=1,NSV_SLT_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_SLTBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_SLTBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_SLTBEG_A(KMI)),KMI)
END DO
!
! Moist Sea Salt Scalar variables
DO JSV=1,NSV_SLTDEP_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_SLTDEPBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_SLTDEPBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_SLTDEPBEG_A(KMI)),KMI)
END DO
!
!
! Passive pollutant
DO JSV=1,NSV_PP_A(KMI)
- CALL SET_LSFIELD_1WAY_ll(XSVM(:,:,:,JSV-1+NSV_PPBEG_A(KDAD)),&
+ CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_PPBEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_PPBEG_A(KMI)),KMI)
END DO
! 1.4 Communication
@@ -699,7 +696,7 @@ DEALLOCATE(ZTTHM)
! --------------------------------------------------------
!
!
-IF (SIZE(XTKEM,3) == 0 .OR. SIZE(PLBXTKEM,3) == 0) THEN
+IF (SIZE(XTKET,3) == 0 .OR. SIZE(PLBXTKEM,3) == 0) THEN
PLBXTKEM(:,:,:) = 0. ! turbulence not activated
PLBYTKEM(:,:,:) = 0.
ELSE
diff --git a/src/MNH/ini_prog_var.f90 b/src/MNH/ini_prog_var.f90
index 996d0eea7..118fe7998 100644
--- a/src/MNH/ini_prog_var.f90
+++ b/src/MNH/ini_prog_var.f90
@@ -161,47 +161,40 @@ CALL GET_MODEL_NUMBER_ll(IMI)
CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
!
IIB=JPHEXT+1
-IIE=SIZE(XWM,1)-JPHEXT
-IIU=SIZE(XWM,1)
+IIE=SIZE(XWT,1)-JPHEXT
+IIU=SIZE(XWT,1)
IJB=JPHEXT+1
-IJE=SIZE(XWM,2)-JPHEXT
-IJU=SIZE(XWM,2)
-IKU=SIZE(XWM,3)
+IJE=SIZE(XWT,2)-JPHEXT
+IJU=SIZE(XWT,2)
+IKU=SIZE(XWT,3)
IIU_ll=NIMAX_ll + 2 * JPHEXT
IJU_ll=NJMAX_ll + 2 * JPHEXT
!-------------------------------------------------------------------------------
!
-!* 1. FIELDS AT TIME T
-! ----------------
-!
-ALLOCATE(XUT(0,0,0),XVT(0,0,0),XWT(0,0,0))
-ALLOCATE(XTHT(0,0,0),XRT(0,0,0,0))
-!-------------------------------------------------------------------------------
-!
-!* 2. TURBULENCE FIELDS
+!* 1. TURBULENCE FIELDS
! -----------------
!
ALLOCATE(XTKET(0,0,0))
ALLOCATE(XSRCT(0,0,0))
IF (CTURB=='TKEL' ) THEN
- ALLOCATE(XTKEM(IIU,IJU,IKU))
- XTKEM(:,:,:)=PTKE_MX(:,:,:)
+ ALLOCATE(XTKET(IIU,IJU,IKU))
+ XTKET(:,:,:)=PTKE_MX(:,:,:)
IF (NRR>1) THEN
- ALLOCATE(XSRCM(IIU,IJU,IKU))
+ ALLOCATE(XSRCT(IIU,IJU,IKU))
ALLOCATE(XSIGS(IIU,IJU,IKU))
- WHERE (XRM(:,:,:,2)>1.E-10)
- XSRCM(:,:,:)=1.
+ WHERE (XRT(:,:,:,2)>1.E-10)
+ XSRCT(:,:,:)=1.
ELSEWHERE
- XSRCM(:,:,:)=0.
+ XSRCT(:,:,:)=0.
END WHERE
XSIGS(:,:,:)=0.
ELSE
- ALLOCATE(XSRCM(0,0,0))
+ ALLOCATE(XSRCT(0,0,0))
ALLOCATE(XSIGS(0,0,0))
END IF
ELSE
- ALLOCATE(XTKEM(0,0,0))
- ALLOCATE(XSRCM(0,0,0))
+ ALLOCATE(XTKET(0,0,0))
+ ALLOCATE(XSRCT(0,0,0))
ALLOCATE(XSIGS(0,0,0))
END IF
!
@@ -229,7 +222,7 @@ IF(PRESENT(HCHEMFILE)) THEN
END IF ! lorilam
! initialise NSV_* variables
CALL INI_NSV(1)
- ALLOCATE(XSVM(IIU,IJU,IKU,NSV))
+ ALLOCATE(XSVT(IIU,IJU,IKU,NSV))
! Read dimensions in chem file and checks with output file
CALL FMOPEN_ll(HCHEMFILE,'READ',HLUOUT,0,2,NVERB,ININAR,IRESP)
YRECFM='IMAX'
@@ -283,16 +276,16 @@ IF(PRESENT(HCHEMFILE)) THEN
IF (.NOT.LDUST) THEN
! Read scalars in chem file
DO JSV = NSV_CHEMBEG,NSV_CHEMEND
- YRECFM=TRIM(CNAMES(JSV-NSV_CHEMBEG+1))//'M'
+ YRECFM=TRIM(CNAMES(JSV-NSV_CHEMBEG+1))//'T'
YDIR='XY'
- CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVM(:,:,:,JSV),IGRID,ILENCH, &
+ CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVT(:,:,:,JSV),IGRID,ILENCH, &
YCOMMENT,IRESP)
IF (IRESP/=0) THEN
WRITE(ILUOUT,*) TRIM(YRECFM),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE
- XSVM(:,:,:,JSV) = 0.
+ XSVT(:,:,:,JSV) = 0.
END IF !IRESP
END DO ! JSV
- IF (ALL(XSVM(:,:,:,NSV_CHEMBEG:NSV_CHEMEND) == 0.)) THEN
+ IF (ALL(XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND) == 0.)) THEN
LUSECHEM=.FALSE.
NEQ = 0
END IF
@@ -316,7 +309,7 @@ IF(PRESENT(HCHEMFILE)) THEN
+ (NSV_DSTBEG -1) !Previous list of tracers
YRECFM = TRIM(YPDUST_INI(ISV_NAME_IDX))//'M'
YDIR='XY'
- CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVM(:,:,:,JSV),IGRID,ILENCH, &
+ CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVT(:,:,:,JSV),IGRID,ILENCH, &
YCOMMENT,IRESP)
IF (IRESP/=0) THEN
WRITE(ILUOUT,FMT=9000)
@@ -333,10 +326,10 @@ IF(PRESENT(HCHEMFILE)) THEN
JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
+ JMOM & !Number of moments in this mode
+ (NSV_DSTBEG -1) !Previous list of tracers
- YRECFM = TRIM(YPDUST_INI(ISV_NAME_IDX))//'M'
+ YRECFM = TRIM(YPDUST_INI(ISV_NAME_IDX))//'T'
YDIR='XY'
WRITE(ILUOUT,*) 'JPC titi ',YRECFM
- CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVM(:,:,:,JSV),IGRID,ILENCH, &
+ CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVT(:,:,:,JSV),IGRID,ILENCH, &
YCOMMENT,IRESP)
IF (IRESP/=0) THEN
WRITE(ILUOUT,FMT=9000)
@@ -362,9 +355,9 @@ IF(PRESENT(HCHEMFILE)) THEN
JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
+ 1 & !Number of moments in this mode
+ (NSV_SLTBEG -1) !Previous list of tracers
- YRECFM = TRIM(YPSALT_INI(ISV_NAME_IDX))//'M'
+ YRECFM = TRIM(YPSALT_INI(ISV_NAME_IDX))//'T'
YDIR='XY'
- CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVM(:,:,:,JSV),IGRID,ILENCH, &
+ CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVT(:,:,:,JSV),IGRID,ILENCH, &
YCOMMENT,IRESP)
IF (IRESP/=0) THEN
WRITE(ILUOUT,FMT=9000)
@@ -381,9 +374,9 @@ IF(PRESENT(HCHEMFILE)) THEN
JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
+ JMOM & !Number of moments in this mode
+ (NSV_SLTBEG -1) !Previous list of tracers
- YRECFM = TRIM(YPSALT_INI(ISV_NAME_IDX))//'M'
+ YRECFM = TRIM(YPSALT_INI(ISV_NAME_IDX))//'T'
YDIR='XY'
- CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVM(:,:,:,JSV),IGRID,ILENCH, &
+ CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVT(:,:,:,JSV),IGRID,ILENCH, &
YCOMMENT,IRESP)
IF (IRESP/=0) THEN
WRITE(ILUOUT,FMT=9000)
@@ -396,9 +389,9 @@ IF(PRESENT(HCHEMFILE)) THEN
END IF ! LSALT
DO JSV = NSV_AERBEG,NSV_AEREND
- YRECFM=TRIM(CAERONAMES(JSV-NSV_AERBEG+1))//'M'
+ YRECFM=TRIM(CAERONAMES(JSV-NSV_AERBEG+1))//'T'
YDIR='XY'
- CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVM(:,:,:,JSV),IGRID,ILENCH, &
+ CALL FMREAD(HCHEMFILE,YRECFM,HLUOUT,YDIR,XSVT(:,:,:,JSV),IGRID,ILENCH, &
YCOMMENT,IRESP)
IF (IRESP/=0) THEN
WRITE(ILUOUT,FMT=9000)
@@ -413,10 +406,10 @@ IF(PRESENT(HCHEMFILE)) THEN
ELSE ! HCHEMFILE
IF (NSV >=1) THEN
- ALLOCATE(XSVM(IIU,IJU,IKU,NSV))
- XSVM(:,:,:,:)=PSV_MX(:,:,:,:)
+ ALLOCATE(XSVT(IIU,IJU,IKU,NSV))
+ XSVT(:,:,:,:)=PSV_MX(:,:,:,:)
ELSE !NSV
- ALLOCATE(XSVM(0,0,0,0))
+ ALLOCATE(XSVT(0,0,0,0))
END IF ! NSV
ENDIF ! HCHEMFILE
!-------------------------------------------------------------------------------
@@ -435,11 +428,11 @@ IF (CTURB /= 'NONE') THEN
END IF
!
ILBX=SIZE(XLBXTKEM,1)/2-1
- XLBXTKEM(1:ILBX+1,:,:) = XTKEM(IIB-1:IIB-1+ILBX,:,:)
- XLBXTKEM(ILBX+2:2*ILBX+2,:,:) = XTKEM(IIE+1-ILBX:IIE+1,:,:)
+ XLBXTKEM(1:ILBX+1,:,:) = XTKET(IIB-1:IIB-1+ILBX,:,:)
+ XLBXTKEM(ILBX+2:2*ILBX+2,:,:) = XTKET(IIE+1-ILBX:IIE+1,:,:)
ILBY=SIZE(XLBYTKEM,2)/2-1
- XLBYTKEM(:,1:ILBY+1,:) = XTKEM(:,IJB-1:IJB-1+ILBY,:)
- XLBYTKEM(:,ILBY+2:2*ILBY+2,:) = XTKEM(:,IJE+1-ILBY:IJE+1,:)
+ XLBYTKEM(:,1:ILBY+1,:) = XTKET(:,IJB-1:IJB-1+ILBY,:)
+ XLBYTKEM(:,ILBY+2:2*ILBY+2,:) = XTKET(:,IJE+1-ILBY:IJE+1,:)
ELSE
ALLOCATE(XLBXTKEM(0,0,0))
ALLOCATE(XLBYTKEM(0,0,0))
@@ -455,11 +448,11 @@ IF ( NSV > 0 ) THEN
END IF
!
ILBX=SIZE(XLBXSVM,1)/2-1
- XLBXSVM(1:ILBX+1,:,:,:) = XSVM(IIB-1:IIB-1+ILBX,:,:,:)
- XLBXSVM(ILBX+2:2*ILBX+2,:,:,:) = XSVM(IIE+1-ILBX:IIE+1,:,:,:)
+ XLBXSVM(1:ILBX+1,:,:,:) = XSVT(IIB-1:IIB-1+ILBX,:,:,:)
+ XLBXSVM(ILBX+2:2*ILBX+2,:,:,:) = XSVT(IIE+1-ILBX:IIE+1,:,:,:)
ILBY=SIZE(XLBYSVM,2)/2-1
- XLBYSVM(:,1:ILBY+1,:,:) = XSVM(:,IJB-1:IJB-1+ILBY,:,:)
- XLBYSVM(:,ILBY+2:2*ILBY+2,:,:) = XSVM(:,IJE+1-ILBY:IJE+1,:,:)
+ XLBYSVM(:,1:ILBY+1,:,:) = XSVT(:,IJB-1:IJB-1+ILBY,:,:)
+ XLBYSVM(:,ILBY+2:2*ILBY+2,:,:) = XSVT(:,IJE+1-ILBY:IJE+1,:,:)
ELSE
ALLOCATE(XLBXSVM(0,0,0,0))
ALLOCATE(XLBYSVM(0,0,0,0))
diff --git a/src/MNH/ini_segn.f90 b/src/MNH/ini_segn.f90
index 3b2dedf45..1d9e40710 100644
--- a/src/MNH/ini_segn.f90
+++ b/src/MNH/ini_segn.f90
@@ -10,7 +10,7 @@
!
INTERFACE
!
-SUBROUTINE INI_SEG_n(KMI,HLUOUT,HINIFILE,HINIFILEPGD,PTSTEP_OLD,PTSTEP_ALL)
+SUBROUTINE INI_SEG_n(KMI,HLUOUT,HINIFILE,HINIFILEPGD,PTSTEP_ALL)
INTEGER, INTENT(IN) :: KMI ! Model index
CHARACTER(LEN=16), INTENT(OUT) :: HLUOUT ! name of the listing-
@@ -18,7 +18,6 @@ CHARACTER(LEN=16), INTENT(OUT) :: HLUOUT ! name of the listing-
CHARACTER (LEN=28), INTENT(OUT) :: HINIFILE! name of
! the initial file
CHARACTER (LEN=28), INTENT(OUT) :: HINIFILEPGD
-REAL, INTENT(OUT) :: PTSTEP_OLD ! OLD Time STEP (DESFM)
REAL,DIMENSION(:), INTENT(INOUT) :: PTSTEP_ALL ! Time STEP of ALL models
END SUBROUTINE INI_SEG_n
!
@@ -30,7 +29,7 @@ END MODULE MODI_INI_SEG_n
!
!
! #############################################################
- SUBROUTINE INI_SEG_n(KMI,HLUOUT,HINIFILE,HINIFILEPGD,PTSTEP_OLD,PTSTEP_ALL)
+ SUBROUTINE INI_SEG_n(KMI,HLUOUT,HINIFILE,HINIFILEPGD,PTSTEP_ALL)
! #############################################################
!
!!**** *INI_SEG_n * - routine to read and update the descriptor files for
@@ -191,7 +190,6 @@ CHARACTER(LEN=16), INTENT(OUT) :: HLUOUT ! name of the listing-
CHARACTER (LEN=28), INTENT(OUT) :: HINIFILE! name of
! the initial file
CHARACTER (LEN=28), INTENT(OUT) :: HINIFILEPGD
-REAL, INTENT(OUT) :: PTSTEP_OLD ! OLD Time STEP (DESFM)
REAL,DIMENSION(:), INTENT(INOUT) :: PTSTEP_ALL ! Time STEP of ALL models
!
!* 0.1 declarations of local variables
@@ -401,8 +399,7 @@ CALL READ_DESFM_n(KMI,YDESFM,HLUOUT,YCONF,GFLAT,GUSERV,GUSERC, &
GUSECHIC,GCH_PH,GCH_CONV_LINOX,GSALT,GDEPOS_SLT,GDUST, &
GDEPOS_DST, GORILAM, &
GDEPOS_AER, GLG, GPASPOL, GCONDSAMP, IRIMX,IRIMY,ISV, &
- YTURB,YTOM,GRMC01,YRAD,YDCONV,YSCONV,YCLOUD,YELEC,YEQNSYS, &
- PTSTEP_OLD )
+ YTURB,YTOM,GRMC01,YRAD,YDCONV,YSCONV,YCLOUD,YELEC,YEQNSYS )
!
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/ini_tke_eps.f90 b/src/MNH/ini_tke_eps.f90
index 66f86b45b..e4e13aed5 100644
--- a/src/MNH/ini_tke_eps.f90
+++ b/src/MNH/ini_tke_eps.f90
@@ -9,26 +9,22 @@
! #######################
INTERFACE
!
- SUBROUTINE INI_TKE_EPS(HGETTKEM,HGETTKET,PTHVREF,PZZ, &
- PUM,PVM,PTHM, &
+ SUBROUTINE INI_TKE_EPS(HGETTKET,PTHVREF,PZZ, &
PUT,PVT,PTHT, &
- PTKEM,PTKET,TPINITHALO3D_ll )
+ PTKET,TPINITHALO3D_ll )
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-CHARACTER (LEN=*), INTENT(IN) :: HGETTKEM,HGETTKET
+CHARACTER (LEN=*), INTENT(IN) :: HGETTKET
! character string indicating whether TKE must be
! initialized or not
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! virtual potential
! temperature
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height for
! w-point
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PUM ! x-component of wind
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PVM ! y-component of wind
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTHM ! potential temperature
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PUT ! x-component of wind
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PVT ! y-component of wind
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTHT ! potential temperature
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTKEM,PTKET ! TKE fields
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTKET ! TKE fields
TYPE(LIST_ll), POINTER :: TPINITHALO3D_ll ! pointer for the list of fields
! which must be communicated in INIT
!
@@ -39,10 +35,9 @@ END INTERFACE
END MODULE MODI_INI_TKE_EPS
!
! ###################################################################
- SUBROUTINE INI_TKE_EPS(HGETTKEM,HGETTKET,PTHVREF,PZZ, &
- PUM,PVM,PTHM, &
+ SUBROUTINE INI_TKE_EPS(HGETTKET,PTHVREF,PZZ, &
PUT,PVT,PTHT, &
- PTKEM,PTKET,TPINITHALO3D_ll )
+ PTKET,TPINITHALO3D_ll )
! ###################################################################
!
!
@@ -106,20 +101,17 @@ IMPLICIT NONE
!
!* 0.1. declarations of arguments
!
-CHARACTER (LEN=*), INTENT(IN) :: HGETTKEM,HGETTKET
+CHARACTER (LEN=*), INTENT(IN) :: HGETTKET
! character string indicating whether TKE must be
! initialized or not
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! virtual potential
! temperature
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height for
! w-point
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PUM ! x-component of wind
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PVM ! y-component of wind
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTHM ! potential temperature
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PUT ! x-component of wind
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PVT ! y-component of wind
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTHT ! potential temperature
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTKEM,PTKET ! TKE fields
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTKET ! TKE field
TYPE(LIST_ll), POINTER :: TPINITHALO3D_ll ! pointer for the list of fields
! which must be communicated in INIT
!
@@ -128,15 +120,15 @@ TYPE(LIST_ll), POINTER :: TPINITHALO3D_ll ! pointer for the
INTEGER :: IKB,IKE,IKU! index value for the first and last inner
! mass points
INTEGER :: JKK ! vertical loop index
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZDELTZ ! vertical
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZDELTZ ! vertical
! increment
!
! ---------------------------------------------------------------------
!
!
IKB=1+JPVEXT
-IKE=SIZE(PTHM,3)-JPVEXT
-IKU=SIZE(PTHM,3)
+IKE=SIZE(PTHT,3)-JPVEXT
+IKU=SIZE(PTHT,3)
!
!* 1. TKE DETERMINATION
! -----------------
@@ -146,32 +138,6 @@ DO JKK=IKB-1,IKE
END DO
ZDELTZ(:,:,IKE+1) = ZDELTZ(:,:,IKE)
!
-IF (HGETTKEM == 'INIT' ) THEN
-! instant t-deltat
- PTHM(:,:,IKB-1) = PTHM(:,:,IKB)
- PUM(:,:,IKB-1) = PUM(:,:,IKB)
- PVM(:,:,IKB-1) = PVM(:,:,IKB)
- !
- PTHM(:,:,IKE+1) = PTHM(:,:,IKE)
- PUM(:,:,IKE+1) = PUM(:,:,IKE)
- PVM(:,:,IKE+1) = PVM(:,:,IKE)
- !
- ! determines TKE
- PTKEM(:,:,:)=(XLINI**2/XCED)*( &
- XCMFS*( DZF(1,IKU,1,MXF(MZM(1,IKU,1,PUM)))**2 &
- +DZF(1,IKU,1,MYF(MZM(1,IKU,1,PVM)))**2) / ZDELTZ &
- -(XG/PTHVREF)*XCSHF*DZF(1,IKU,1,MZM(1,IKU,1,PTHM)) &
- ) / ZDELTZ
- ! positivity control
- WHERE (PTKEM < XTKEMIN) PTKEM=XTKEMIN
- !
- !
- ! Add PTKEM to TPINITHALO3D_ll list of fields updated at the
- ! end of initialization
- CALL ADD3DFIELD_ll (TPINITHALO3D_ll,PTKEM)
-!
-END IF
-!
IF (HGETTKET == 'INIT' ) THEN
! instant t
PTHT(:,:,IKB-1) = PTHT(:,:,IKB)
diff --git a/src/MNH/init_for_convlfi.f90 b/src/MNH/init_for_convlfi.f90
new file mode 100644
index 000000000..3ef992e2e
--- /dev/null
+++ b/src/MNH/init_for_convlfi.f90
@@ -0,0 +1,361 @@
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 convert 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+!###########################
+MODULE MODI_INIT_FOR_CONVLFI
+!###########################
+!
+!
+INTERFACE
+ SUBROUTINE INIT_FOR_CONVLFI(HINIFILE,HLUOUT)
+!
+CHARACTER(LEN=28), INTENT(IN) :: HINIFILE ! file being read
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! output listing
+!
+END SUBROUTINE INIT_FOR_CONVLFI
+END INTERFACE
+END MODULE MODI_INIT_FOR_CONVLFI
+!
+! ############################################
+ SUBROUTINE INIT_FOR_CONVLFI(HINIFILE,HLUOUT)
+! ############################################
+!
+!!**** *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
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+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
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_VAR_ll, ONLY : NPROC
+!
+USE MODE_TIME
+USE MODE_GRIDPROJ
+USE MODE_GRIDCART
+!
+USE MODE_FM
+USE MODE_FMREAD
+USE MODE_IO_ll
+USE MODE_ll
+!
+USE MODI_GATHER_ll
+USE MODI_INI_CST
+!JUANZ
+USE MODE_SPLITTINGZ_ll
+!JUANZ
+!
+IMPLICIT NONE
+!
+!* 0.1 Arguments variables
+!
+CHARACTER(LEN=28), INTENT(IN) :: HINIFILE ! file being read
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! output listing
+!
+!* 0.2 Local variables
+!
+INTEGER :: IGRID,ILENCH,IRESP,ILUOUT ! return code of file management
+CHARACTER (LEN=16) :: YRECFM ! management
+CHARACTER (LEN=100) :: YCOMMENT ! variables
+CHARACTER (LEN=2) :: YDIR !
+INTEGER, DIMENSION(3) :: ITDATE ! date array
+CHARACTER (LEN=40) :: YTITLE ! Title for date print
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOEF
+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 :: IMASDEV ! masdev of the file
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZE EACH MODEL SIZES AND DEPENDENCY (ini_sizen)
+! ------------------------------------------
+!
+!* 1.1 Read the geometry kind in the LFIFM file (Cartesian or spherical)
+!
+YRECFM = 'CARTESIAN'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,LCARTESIAN,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+!* 1.2 Read configuration and dimensions in initial file and initialize
+! subdomain dimensions and parallel variables
+!
+YRECFM='IMAX'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,NIMAX_ll,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YRECFM='JMAX'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,NJMAX_ll,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YRECFM = 'L1D'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,L1D,IGRID,ILENCH,YCOMMENT,IRESP)
+IF (IRESP/=0) THEN
+ L1D=.FALSE.
+ IF( (NIMAX_ll == 1).AND.(NJMAX_ll == 1) ) L1D=.TRUE.
+ENDIF
+!
+YRECFM = 'L2D'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,L2D,IGRID,ILENCH,YCOMMENT,IRESP)
+IF (IRESP/=0) THEN
+ L2D=.FALSE.
+ IF( (NIMAX_ll /= 1).AND.(NJMAX_ll == 1) ) L2D=.TRUE.
+ENDIF
+!
+YRECFM = 'PACK'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,LPACK,IGRID,ILENCH,YCOMMENT,IRESP)
+IF (IRESP/=0) LPACK=.TRUE.
+!
+CALL SET_FMPACK_ll(L1D,L2D,LPACK)
+!
+YRECFM='KMAX'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,NKMAX,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+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 SET_FMPACK_ll(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
+!
+YRECFM='LON0'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XLON0,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YRECFM='LAT0'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XLAT0,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YRECFM='BETA'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XBETA,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YRECFM='XHAT'
+ALLOCATE(XXHAT(IIU))
+YDIR='XX'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YRECFM='YHAT'
+ALLOCATE(XYHAT(IJU))
+YDIR='YY'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+IF (.NOT.LCARTESIAN) THEN
+ YRECFM='MASDEV'
+ YDIR='--'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,IMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
+ !
+ YRECFM='RPK'
+ YDIR='--'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XRPK,IGRID,ILENCH,YCOMMENT,IRESP)
+ !
+ YRECFM='LONORI'
+ YDIR='--'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XLONORI,IGRID,ILENCH,YCOMMENT,IRESP)
+ !
+ YRECFM='LATORI'
+ YDIR='--'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XLATORI,IGRID,ILENCH,YCOMMENT,IRESP)
+ !
+ IF (IMASDEV<=45) THEN
+ CALL FMREAD(HINIFILE,'LONOR',HLUOUT,'--',XLONORI,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(HINIFILE,'LATOR',HLUOUT,'--',XLATORI,IGRID,ILENCH,YCOMMENT,IRESP)
+ 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
+!
+YRECFM='ZS'
+ALLOCATE(XZS(IIU,IJU))
+YDIR='XY'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XZS,IGRID,ILENCH,YCOMMENT,IRESP)
+IF (IRESP/=0) XZS(:,:)=0.
+!
+YRECFM='ZSMT'
+ALLOCATE(XZSMT(IIU,IJU))
+YDIR='XY'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XZSMT,IGRID,ILENCH,YCOMMENT,IRESP)
+IF (IRESP/=0) XZSMT(:,:)=XZS(:,:)
+!
+YRECFM='ZHAT'
+ALLOCATE(XZHAT(IKU))
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XZHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YRECFM='SLEVE'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,LSLEVE,IGRID,ILENCH,YCOMMENT,IRESP)
+IF (IRESP/=0) LSLEVE = .FALSE.
+!
+IF (LSLEVE) THEN
+ YRECFM='LEN1'
+ YDIR='--'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XLEN1,IGRID,ILENCH,YCOMMENT,IRESP)
+ YRECFM='LEN2'
+ YDIR='--'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XLEN2,IGRID,ILENCH,YCOMMENT,IRESP)
+END IF
+!
+YRECFM='DTEXP%TDATE'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
+TDTEXP%TDATE=DATE(ITDATE(1),ITDATE(2),ITDATE(3))
+!
+YRECFM='DTEXP%TIME'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,TDTEXP%TIME,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YRECFM='DTMOD%TDATE'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
+TDTMOD%TDATE=DATE(ITDATE(1),ITDATE(2),ITDATE(3))
+!
+YRECFM='DTMOD%TIME'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,TDTMOD%TIME,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YRECFM='DTSEG%TDATE'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
+TDTSEG%TDATE=DATE(ITDATE(1),ITDATE(2),ITDATE(3))
+!
+YRECFM='DTSEG%TIME'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,TDTSEG%TIME,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YRECFM='DTCUR%TDATE'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,ITDATE,IGRID,ILENCH,YCOMMENT,IRESP)
+TDTCUR%TDATE=DATE(ITDATE(1),ITDATE(2),ITDATE(3))
+!
+YRECFM='DTCUR%TIME'
+YDIR='--'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,TDTCUR%TIME,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+YTITLE='CURRENT DATE AND TIME'
+CALL SM_PRINT_TIME(TDTCUR,HLUOUT,YTITLE)
+!
+!* 2.2 Spatial grid
+!
+ALLOCATE(XDXHAT(IIU))
+ALLOCATE(XDYHAT(IJU))
+ALLOCATE(XZZ(IIU,IJU,IKU))
+ALLOCATE(ZJ(IIU,IJU,IKU))
+ALLOCATE(ZCOEF(IIU,IJU))
+!
+CALL INI_CST
+!
+IF (LCARTESIAN) THEN
+ CALL SM_GRIDCART(HLUOUT,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(HLUOUT,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))
+!
+YDIR='XY'
+YRECFM = 'PABST'
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XPABST,IGRID,ILENCH,YCOMMENT,IRESP)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE INIT_FOR_CONVLFI
diff --git a/src/MNH/init_mnh.f90 b/src/MNH/init_mnh.f90
index 0c4a5b16f..267becc19 100644
--- a/src/MNH/init_mnh.f90
+++ b/src/MNH/init_mnh.f90
@@ -112,7 +112,6 @@ INTEGER :: ILUOUT0,IRESP ! Logical unit number for
! output-listing common
! to all models and return
! code of file management
-REAL, DIMENSION(JPMODELMAX) :: ZTSTEP_OLD ! OLD Time STEP (DESFM)
REAL, DIMENSION(JPMODELMAX) :: ZTSTEP_ALL ! Time STEP of ALL models
INTEGER :: IINFO_ll ! return code of // routines
!
@@ -163,7 +162,7 @@ CALL INI_NEB
!
DO JMI=1,JPMODELMAX
CALL GOTO_MODEL(JMI)
- CALL INI_SEG_n(JMI,YLUOUT(JMI),YINIFILE(JMI),YINIFILEPGD(JMI),ZTSTEP_OLD(JMI),ZTSTEP_ALL)
+ CALL INI_SEG_n(JMI,YLUOUT(JMI),YINIFILE(JMI),YINIFILEPGD(JMI),ZTSTEP_ALL)
IF (JMI.EQ.NMODEL) EXIT
END DO
!
@@ -211,7 +210,7 @@ ENDIF
DO JMI=1,NMODEL
CALL GO_TOMODEL_ll(JMI,IINFO_ll)
CALL GOTO_MODEL(JMI)
- CALL INI_MODEL_n(JMI,ZTSTEP_OLD(JMI),YLUOUT(JMI),YINIFILE(JMI),YINIFILEPGD(JMI))
+ CALL INI_MODEL_n(JMI,YLUOUT(JMI),YINIFILE(JMI),YINIFILEPGD(JMI))
END DO
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/initial_guess.f90 b/src/MNH/initial_guess.f90
index ca2e6d7ca..5cf4f9297 100644
--- a/src/MNH/initial_guess.f90
+++ b/src/MNH/initial_guess.f90
@@ -4,18 +4,14 @@
! $Source$ $Revision$ $Date$
!-----------------------------------------------------------------
!-----------------------------------------------------------------
-!-----------------------------------------------------------------
! #########################
MODULE MODI_INITIAL_GUESS
! #########################
!
INTERFACE
!
- SUBROUTINE INITIAL_GUESS ( KRR, KSV, KTCOUNT,PRHODJ, KMI, &
- PUM, PVM, PWM, PTHM, PRM, PTKEM, PSVM, &
- PTSTEP, PTSTEP_MET, PTSTEP_SV, &
- PRUS, PRVS, PRWS, PRTHS, PRRS, PRTKES, PRSVS, &
- HMET_ADV_SCHEME,HSV_ADV_SCHEME, HUVW_ADV_SCHEME, &
+ SUBROUTINE INITIAL_GUESS ( KRR, KSV, KTCOUNT,PRHODJ, KMI, PTSTEP, &
+ PRUS, PRVS, PRWS, PRTHS, PRRS, PRTKES, PRSVS, &
PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT )
!
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
@@ -26,30 +22,12 @@ INTEGER, INTENT(IN) :: KMI ! Model index
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM ! variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM, PSVM
-!
-REAL, INTENT(IN) :: PTSTEP ! Double timestep except for
- ! cold start (single)
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective time step for
- ! meteorological scalar variables
- ! (depending on advection scheme)
-REAL, INTENT(IN) :: PTSTEP_SV ! Effective time step for
- ! tracer scalar variables
- ! (depending on advection scheme)
+REAL, INTENT(IN) :: PTSTEP ! timestep
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUS, PRVS, PRWS ! Source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTHS, PRTKES
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRRS, PRSVS ! terms
!
-! scalar meteorological advection scheme used
-CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME
-! scalar tracer advection scheme used
-CHARACTER(LEN=6), INTENT(IN) :: HSV_ADV_SCHEME
-! advection scheme for momentum
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
-!
! variables at time t (needed for PPM schemes)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET
@@ -61,14 +39,9 @@ END INTERFACE
!
END MODULE MODI_INITIAL_GUESS
!
-!
-!
! #########################################################################
- SUBROUTINE INITIAL_GUESS ( KRR, KSV, KTCOUNT,PRHODJ, KMI, &
- PUM, PVM, PWM, PTHM, PRM, PTKEM, PSVM, &
- PTSTEP, PTSTEP_MET, PTSTEP_SV, &
- PRUS, PRVS, PRWS, PRTHS, PRRS, PRTKES, PRSVS, &
- HMET_ADV_SCHEME,HSV_ADV_SCHEME, HUVW_ADV_SCHEME, &
+ SUBROUTINE INITIAL_GUESS ( KRR, KSV, KTCOUNT,PRHODJ, KMI, PTSTEP, &
+ PRUS, PRVS, PRWS, PRTHS, PRRS, PRTKES, PRSVS, &
PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT )
! #########################################################################
!
@@ -166,6 +139,7 @@ END MODULE MODI_INITIAL_GUESS
!! 06/11/02 (V. Masson) update the budget calls
!! 20/05/06 Remove KEPS
!! 10/09 (C.Lac) FIT for variables advected with PPM
+!! 04/13 (C.Lac) FIT for all variables
!!
!-------------------------------------------------------------------------------
!
@@ -191,29 +165,12 @@ INTEGER, INTENT(IN) :: KMI ! Model index
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM ! Variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM, PSVM
-!
-REAL, INTENT(IN) :: PTSTEP ! Double timestep except for
- ! cold start (single)
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective time step for
- ! meteorological scalar variables
- ! (depending on advection scheme)
-REAL, INTENT(IN) :: PTSTEP_SV ! Effective time step for
- ! tracer scalar variables
- ! (depending on advection scheme)
+REAL, INTENT(IN) :: PTSTEP ! timestep
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUS, PRVS, PRWS ! Source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTHS, PRTKES
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRRS, PRSVS ! terms
!
-! scalar meteorological advection scheme used
-CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME
-! scalar tracer advection scheme used
-CHARACTER(LEN=6), INTENT(IN) :: HSV_ADV_SCHEME
-! advection scheme for momentum
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
!
! variables at time t (needed for PPM schemes)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT
@@ -224,7 +181,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT, PSVT
!
INTEGER :: JRR, JSV
INTEGER :: IKU
-REAL :: ZINVTSTEP,ZINVTSTEP_MET,ZINVTSTEP_SV
+REAL :: ZINVTSTEP
!
!-------------------------------------------------------------------------------
!
@@ -233,63 +190,35 @@ IKU=SIZE(XZHAT)
! -----------------------------------------------
!
ZINVTSTEP = 1./PTSTEP
-ZINVTSTEP_MET = 1./PTSTEP_MET
-ZINVTSTEP_SV = 1./PTSTEP_SV
!
!
!* 2. COMPUTES THE FIRST SOURCE TERMS
! -------------------------------
!
! *** momentum
-PRUS(:,:,:) = PUM(:,:,:) * ZINVTSTEP * MXM (PRHODJ)
-PRVS(:,:,:) = PVM(:,:,:) * ZINVTSTEP * MYM (PRHODJ)
-PRWS(:,:,:) = PWM(:,:,:) * ZINVTSTEP * MZM (1,IKU,1,PRHODJ)
+! forward-in-time time-marching scheme
+PRUS = PUT * ZINVTSTEP * MXM(PRHODJ)
+PRVS = PVT * ZINVTSTEP * MYM(PRHODJ)
+PRWS = PWT * ZINVTSTEP * MZM(1,IKU,1,PRHODJ)
!
! *** meteorological variables
-IF (HMET_ADV_SCHEME(1:3) == 'PPM') THEN
-!
- PRTHS(:,:,:) = PTHT(:,:,:) * ZINVTSTEP_MET * PRHODJ(:,:,:)
-!
- IF (SIZE(PTKEM,1) /= 0) THEN
- PRTKES(:,:,:) = PTKET(:,:,:) * ZINVTSTEP_MET * PRHODJ(:,:,:)
- END IF
-!
-! Case with KRR moist variables
- DO JRR=1,KRR
- PRRS(:,:,:,JRR) = PRT(:,:,:,JRR) * ZINVTSTEP_MET * PRHODJ(:,:,:)
- END DO
-!
-ELSE ! other advection schemes
!
- PRTHS(:,:,:) = PTHM(:,:,:) * ZINVTSTEP_MET * PRHODJ(:,:,:)
-!
- IF (SIZE(PTKEM,1) /= 0) THEN
- PRTKES(:,:,:) = PTKEM(:,:,:) * ZINVTSTEP_MET * PRHODJ(:,:,:)
- END IF
+PRTHS(:,:,:) = PTHT(:,:,:) * ZINVTSTEP * PRHODJ(:,:,:)
+IF (SIZE(PTKET,1) /= 0) THEN
+ PRTKES(:,:,:) = PTKET(:,:,:) * ZINVTSTEP * PRHODJ(:,:,:)
+END IF
!
! Case with KRR moist variables
- DO JRR=1,KRR
- PRRS(:,:,:,JRR) = PRM(:,:,:,JRR) * ZINVTSTEP_MET * PRHODJ(:,:,:)
- END DO
-!
-END IF
+DO JRR=1,KRR
+ PRRS(:,:,:,JRR) = PRT(:,:,:,JRR) * ZINVTSTEP * PRHODJ(:,:,:)
+END DO
!
! *** passive tracers
-IF ( (HSV_ADV_SCHEME(1:3) == 'PPM') .OR. (HSV_ADV_SCHEME == '4TH_RK')) THEN
!
! Case with KSV Scalar Variables
- DO JSV=1,KSV
- PRSVS(:,:,:,JSV) = PSVT(:,:,:,JSV) * ZINVTSTEP_SV * PRHODJ(:,:,:)
- END DO
-!
-ELSE ! other advection schemes
-!
- DO JSV=1,KSV
- PRSVS(:,:,:,JSV) = PSVM(:,:,:,JSV) * ZINVTSTEP_SV * PRHODJ(:,:,:)
- END DO
-!
-END IF
-!
+DO JSV=1,KSV
+ PRSVS(:,:,:,JSV) = PSVT(:,:,:,JSV) * ZINVTSTEP * PRHODJ(:,:,:)
+END DO
!
IF (LBU_ENABLE) THEN
IF (LBU_BEG) THEN
diff --git a/src/MNH/interp3d.f90 b/src/MNH/interp3d.f90
new file mode 100644
index 000000000..b0fa32750
--- /dev/null
+++ b/src/MNH/interp3d.f90
@@ -0,0 +1,154 @@
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 convert 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ######spl
+MODULE MODI_INTERP3D
+!#################################
+!
+INTERFACE
+ SUBROUTINE INTERP3D(PFIELD,KGRID,PSVAL,PPLEV,PFIELDAP)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! values of the field
+INTEGER, INTENT(IN) :: KGRID ! Mesonh grid indicator
+REAL, INTENT(IN) :: PSVAL ! value for missing data
+REAL, DIMENSION(:), INTENT(IN) :: PPLEV ! list of vertical levels
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PFIELDAP ! values of the field on the pressure levels
+END SUBROUTINE INTERP3D
+END INTERFACE
+END MODULE MODI_INTERP3D
+! ######spl
+ SUBROUTINE INTERP3D(PFIELD,KGRID,PSVAL,PPLEV,PFIELDAP)
+! #####################
+!
+!!**** *INTERP3D* - interpole 3D fields on pressure levels
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! Functions MXF, MYF, MZF
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_FIELD1 : contains prognostics variables
+!! XPASBM
+!! Module MODD_GRID1
+!! XZZ
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V.Ducrocq Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/03/97
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_DIM_n
+USE MODD_FIELD_n
+USE MODD_GRID_n
+!
+USE MODI_SHUMAN ! interface modules
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! values of the field
+INTEGER, INTENT(IN) :: KGRID ! Mesonh grid indicator
+REAL, INTENT(IN) :: PSVAL ! value for missing data
+REAL, DIMENSION(:), INTENT(IN) :: PPLEV ! list of vertical levels
+REAL, DIMENSION(:,:,:), INTENT(OUT):: PFIELDAP ! values of the field on the pressure levels
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: JKP,JKLOOP,JJLOOP,JILOOP,IJ,II ! loop indices
+INTEGER :: IIE,IJE,IPU ! End of usefull area
+INTEGER :: IIB,IJB,IKB ! Begining of usefull area
+REAL, DIMENSION(SIZE(XPABST,1),SIZE(XPABST,2),SIZE(XPABST,3)) :: ZPTH ! pressure for grid points corresponding to KGRID type
+REAL :: ZREF,ZXP,ZXM,ZDIXEPS ! pressure values and epsilon value
+INTEGER :: IKU
+!-------------------------------------------------------------------------------
+!
+!* 1.
+! ------------
+IPU=SIZE(PFIELDAP,3)
+IKB=1 +JPVEXT
+IKU=SIZE(XZHAT)
+IIB=JPHEXT+1
+IIE=NIMAX+JPHEXT
+IJB=JPHEXT+1
+IJE=NJMAX+JPHEXT
+ZDIXEPS=10.*EPSILON(1.)
+!
+SELECT CASE (KGRID)
+ CASE(1)
+ ZPTH=XPABST
+ CASE(2)
+ ZPTH(:,:,:)=MXM(XPABST(:,:,:))
+ ZPTH(1,:,:)=2.*ZPTH(2,:,:) - ZPTH(3,:,:)
+ CASE(3)
+ ZPTH(:,:,:)=MYM(XPABST(:,:,:))
+ ZPTH(:,1,:)=2.*ZPTH(:,2,:) - ZPTH(:,3,:)
+ CASE(4)
+ ZPTH(:,:,:)=MZM(1,IKU,1,XPABST(:,:,:))
+ ZPTH(:,:,1)=2.*ZPTH(:,:,2) - ZPTH(:,:,3)
+END SELECT
+!
+DO JKP= 1, IPU
+ ZREF=ALOG10(PPLEV(JKP))
+ DO JILOOP = IIB,IIE
+ DO JJLOOP = IJB,IJE
+ IJ=JJLOOP-IJB+1
+ II=JILOOP-IIB+1
+ PFIELDAP(II,IJ,JKP)=PSVAL
+ DO JKLOOP = 1,NKMAX+2*JPVEXT
+ ZXM=ALOG10(ZPTH(JILOOP,JJLOOP,JKLOOP))
+ ZXP=ALOG10(ZPTH(JILOOP,JJLOOP,MIN(NKMAX+2*JPVEXT,JKLOOP+1)))
+ IF ((ZXP-ZREF)*(ZREF-ZXM) .GE.0.) THEN
+ IF (JKLOOP+1 == IKB) THEN
+ CYCLE
+ ELSE
+ GO TO 4
+ ENDIF
+ ELSE IF (ZXP.GE.ZXM-ZDIXEPS.AND.ZXP.LE.ZXM+ZDIXEPS.AND. &
+ ZREF.GE.ZXM-ZDIXEPS.AND.ZREF.LE.ZXM+ZDIXEPS) THEN
+ IF(JKLOOP+1 == IKB)THEN
+ CYCLE
+ ELSE
+ GO TO 4
+ ENDIF
+ END IF
+ END DO
+ GO TO 3
+4 CONTINUE
+!
+! We interpolate
+ PFIELDAP(II,IJ,JKP)= (PFIELD(II,IJ,JKLOOP)* (ZXP-ZREF)+ &
+ PFIELD(II,IJ,MIN(NKMAX+2*JPVEXT,JKLOOP+1))* (ZREF-ZXM)) &
+ / MIN(-1.E-08,(ZXP-ZXM))
+ GO TO 3
+3 CONTINUE
+ END DO
+ END DO
+END DO
+!
+END SUBROUTINE INTERP3D
diff --git a/src/MNH/ion_boundaries.f90 b/src/MNH/ion_boundaries.f90
index a79d491f7..d8a5cf8b9 100644
--- a/src/MNH/ion_boundaries.f90
+++ b/src/MNH/ion_boundaries.f90
@@ -5,11 +5,11 @@ MODULE MODI_ION_BOUNDARIES
!
INTERFACE
!
- SUBROUTINE ION_BOUNDARIES (HLBCX,HLBCY,PUM,PVM,PUT,PVT,PSVT)
+ SUBROUTINE ION_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT)
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PUM,PVM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT
!
END SUBROUTINE ION_BOUNDARIES
!
@@ -19,7 +19,7 @@ END MODULE MODI_ION_BOUNDARIES
!
!
! ####################################################################
- SUBROUTINE ION_BOUNDARIES (HLBCX,HLBCY,PUM,PVM,PUT,PVT,PSVT)
+ SUBROUTINE ION_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT)
! ####################################################################
!
!!**** *ION_BOUNDARIES* - routine to force the Lateral Boundary Conditions for
@@ -71,7 +71,7 @@ IMPLICIT NONE
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PUM,PVM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT
!
!
!* 0.2 declarations of local variables
@@ -88,9 +88,9 @@ INTEGER :: IJB, IJE ! index of first and last inner mass points along y
!
! beginning and end indexes of the physical subdomain
IIB = 1 + JPHEXT
-IIE = SIZE(PUM,1) - JPHEXT
+IIE = SIZE(PUT,1) - JPHEXT
IJB = 1 + JPHEXT
-IJE = SIZE(PUM,2) - JPHEXT
+IJE = SIZE(PUT,2) - JPHEXT
!
!
!-------------------------------------------------------------------------------
@@ -98,8 +98,8 @@ IJE = SIZE(PUM,2) - JPHEXT
!* 2. EXTRAPOLATE VELOCITY COMPONENTS TO T + DT/2 (PPM advection scheme)
! ------------------------------------------------------------------
!
-ZUX = (1.5 * PUT - 0.5 * PUM)
-ZVY = (1.5 * PVT - 0.5 * PVM)
+ZUX = PUT
+ZVY = PVT
!
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/ion_drift.f90 b/src/MNH/ion_drift.f90
index d20ae4e83..9c52246da 100644
--- a/src/MNH/ion_drift.f90
+++ b/src/MNH/ion_drift.f90
@@ -4,9 +4,8 @@
INTERFACE
!
- SUBROUTINE ION_DRIFT(PDRIFTP, PDRIFTM, PSVT, PRHODREF, PRHODJ, &
- HLBCX, HLBCY, KTCOUNT, PTSTEP, HDRIFT, &
- HUVW_ADV_SCHEME)
+ SUBROUTINE ION_DRIFT(PDRIFTP, PDRIFTM, PSVT, PRHODREF, PRHODJ, &
+ HLBCX, HLBCY, KTCOUNT, PTSTEP, HDRIFT)
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
CHARACTER(LEN=3), INTENT(IN) :: HDRIFT
@@ -15,7 +14,6 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF, PRHODJ
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
!
END SUBROUTINE ION_DRIFT
END INTERFACE
@@ -23,8 +21,7 @@ END MODULE MODI_ION_DRIFT
!
! ################################################################
SUBROUTINE ION_DRIFT(PDRIFTP, PDRIFTM, PSVT, PRHODREF, PRHODJ, &
- HLBCX, HLBCY, KTCOUNT, PTSTEP, HDRIFT, &
- HUVW_ADV_SCHEME)
+ HLBCX, HLBCY, KTCOUNT, PTSTEP, HDRIFT)
! ################################################################
!
!! PURPOSE
@@ -75,7 +72,6 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF, PRHODJ
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
REAL, INTENT(IN) :: PTSTEP
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
!
!
!* 0.2 declarations of local variables
@@ -94,6 +90,11 @@ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZADVS, ZSVT !for advection form
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXCT, ZYCT, ZZCT !
CHARACTER (LEN=6) :: HSV_ADV_SCHEME
! of drift source
+!
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZRHOX1,ZRHOX2
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZRHOY1,ZRHOY2
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZRHOZ1,ZRHOZ2
+!
REAL :: ZMIN_DRIFT, ZMAX_DRIFT
REAL :: ZMAX__POS, ZMAX__NEG
INTEGER :: IPROC, IPROCMIN, ISV
@@ -207,13 +208,8 @@ ELSE
ALLOCATE (ZYCT(SIZE(PDRIFTP,1),SIZE(PDRIFTP,2),SIZE(PDRIFTP,3)))
ALLOCATE (ZZCT(SIZE(PDRIFTP,1),SIZE(PDRIFTP,2),SIZE(PDRIFTP,3)))
!
- IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
- CALL CONTRAV (HLBCX,HLBCY,ZDRIFTX,ZDRIFTY,ZDRIFTZ,XDXX,XDYY,XDZZ,XDZX,XDZY, &
- ZXCT,ZYCT,ZZCT,2)
- ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
- CALL CONTRAV (HLBCX,HLBCY,ZDRIFTX,ZDRIFTY,ZDRIFTZ,XDXX,XDYY,XDZZ,XDZX,XDZY, &
- ZXCT,ZYCT,ZZCT,4)
- ENDIF
+ CALL CONTRAV (HLBCX,HLBCY,ZDRIFTX,ZDRIFTY,ZDRIFTZ,XDXX,XDYY,XDZZ, &
+ XDZX,XDZY,ZXCT,ZYCT,ZZCT,4)
!
ZXCT = ZXCT*PTSTEP
ZYCT = ZYCT*PTSTEP
@@ -223,9 +219,13 @@ ELSE
ZSVT(:,:,:,1) = PSVT(:,:,:,NSV_ELECBEG)
HSV_ADV_SCHEME = 'PPM_01'
!
- CALL PPM_SCALAR(HLBCX,HLBCY,ISV,KTCOUNT, &
- ZXCT, ZYCT, ZZCT, PTSTEP, PRHODJ, &
- ZSVT, ZADVS, HSV_ADV_SCHEME )
+ CALL PPM_RHODJ(HLBCX,HLBCY, ZXCT, ZYCT, ZZCT, &
+ PTSTEP, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, &
+ ZRHOZ1, ZRHOZ2 )
+!
+ CALL PPM_SCALAR (HLBCX,HLBCY, ISV, KTCOUNT, ZXCT, ZYCT, ZZCT, &
+ PTSTEP, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
+ ZSVT, ZADVS, HSV_ADV_SCHEME )
!
PDRIFTP(:,:,:) = ZADVS(:,:,:,1)
!
@@ -270,13 +270,8 @@ ZDRIFTZ(:,:,IKB-1) = ZDRIFTZ(:,:,IKB)
IF (HDRIFT /= 'PPM') THEN
CALL GDIV(HLBCX,HLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ,ZDRIFTX,ZDRIFTY,ZDRIFTZ,PDRIFTM)
ELSE
- IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
- CALL CONTRAV (HLBCX,HLBCY,ZDRIFTX,ZDRIFTY,ZDRIFTZ,XDXX,XDYY,XDZZ,XDZX,XDZY, &
- ZXCT,ZYCT,ZZCT,2)
- ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
- CALL CONTRAV (HLBCX,HLBCY,ZDRIFTX,ZDRIFTY,ZDRIFTZ,XDXX,XDYY,XDZZ,XDZX,XDZY, &
- ZXCT,ZYCT,ZZCT,4)
- ENDIF
+ CALL CONTRAV (HLBCX,HLBCY,ZDRIFTX,ZDRIFTY,ZDRIFTZ,XDXX,XDYY,XDZZ, &
+ XDZX,XDZY,ZXCT,ZYCT,ZZCT,4)
!
ZXCT = ZXCT * PTSTEP
ZYCT = ZYCT * PTSTEP
@@ -286,9 +281,13 @@ ELSE
ZSVT(:,:,:,1) = PSVT(:,:,:,NSV_ELECEND)
HSV_ADV_SCHEME = 'PPM_01'
!
- CALL PPM_SCALAR(HLBCX,HLBCY,ISV,KTCOUNT, &
- ZXCT, ZYCT, ZZCT, PTSTEP, PRHODJ, &
- ZSVT, ZADVS, HSV_ADV_SCHEME )
+ CALL PPM_RHODJ(HLBCX,HLBCY, ZXCT, ZYCT, ZZCT, &
+ PTSTEP, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, &
+ ZRHOZ1, ZRHOZ2 )
+!
+ CALL PPM_SCALAR (HLBCX,HLBCY, ISV, KTCOUNT, ZXCT, ZYCT, ZZCT, &
+ PTSTEP, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
+ ZSVT, ZADVS, HSV_ADV_SCHEME )
!
PDRIFTM(:,:,:) = ZADVS(:,:,:,1)
!
diff --git a/src/MNH/les_budget.f90 b/src/MNH/les_budget.f90
index 20447fbf7..11c768566 100644
--- a/src/MNH/les_budget.f90
+++ b/src/MNH/les_budget.f90
@@ -90,7 +90,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEND
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK_LES ! work array
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZANOM ! field anomaly after process occured
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL_ANOM ! Thl anomaly after process occured
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL_ANOM ! THL anomaly after process occured
REAL, DIMENSION(NLES_K) :: ZLES_PROF
@@ -126,7 +126,7 @@ SELECT CASE (KBUDN)
CALL LES_BUDGET_ANOMALY(PVARS,'X',ZANOM)
!
!* action in KE budget
- ZWORK_LES = ( ZANOM ** 2 - XU_ANOM ** 2 ) / XCURRENT_TSTEP_UVW
+ ZWORK_LES = ( ZANOM ** 2 - XU_ANOM ** 2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_KE(:,ILES_BU) = X_LES_BU_RES_KE(:,ILES_BU) + ZLES_PROF(:)
!
@@ -140,7 +140,7 @@ SELECT CASE (KBUDN)
CALL LES_BUDGET_ANOMALY(PVARS,'Y',ZANOM)
!
!* action in KE budget
- ZWORK_LES = ( ZANOM ** 2 - XV_ANOM ** 2 ) / XCURRENT_TSTEP_UVW
+ ZWORK_LES = ( ZANOM ** 2 - XV_ANOM ** 2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_KE(:,ILES_BU) = X_LES_BU_RES_KE(:,ILES_BU) + ZLES_PROF(:)
!
@@ -154,27 +154,27 @@ SELECT CASE (KBUDN)
CALL LES_BUDGET_ANOMALY(PVARS,'Z',ZANOM)
!
!* action in KE budget
- ZWORK_LES = ( ZANOM ** 2 - XW_ANOM ** 2 ) / XCURRENT_TSTEP_UVW
+ ZWORK_LES = ( ZANOM ** 2 - XW_ANOM ** 2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
X_LES_BU_RES_KE(:,ILES_BU) = X_LES_BU_RES_KE(:,ILES_BU) + ZLES_PROF(:)
!
- !* action in WThl budget
- ZWORK_LES = ( ZANOM * XTHl_ANOM - XW_ANOM * XTHl_ANOM ) / XCURRENT_TSTEP_MET
+ !* action in WTHL budget
+ ZWORK_LES = ( ZANOM * XTHL_ANOM - XW_ANOM * XTHL_ANOM ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_WThl(:,ILES_BU) = X_LES_BU_RES_WThl(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_WTHL(:,ILES_BU) = X_LES_BU_RES_WTHL(:,ILES_BU) + ZLES_PROF(:)
!
- !* action in WRt budget
+ !* action in WRT budget
IF (LCURRENT_USERV) THEN
- ZWORK_LES = ( ZANOM * XRt_ANOM - XW_ANOM * XRt_ANOM ) / XCURRENT_TSTEP_MET
+ ZWORK_LES = ( ZANOM * XRT_ANOM - XW_ANOM * XRT_ANOM ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_WRt(:,ILES_BU) = X_LES_BU_RES_WRt(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_WRT(:,ILES_BU) = X_LES_BU_RES_WRT(:,ILES_BU) + ZLES_PROF(:)
END IF
!
- !* action in WSv budget
+ !* action in WSV budget
DO JSV=1,NSV
- ZWORK_LES = ( ZANOM * XSv_ANOM(:,:,:,JSV) - XW_ANOM * XSv_ANOM(:,:,:,JSV)) / XCURRENT_TSTEP_SV
+ ZWORK_LES = ( ZANOM * XSV_ANOM(:,:,:,JSV) - XW_ANOM * XSV_ANOM(:,:,:,JSV)) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_WSv(:,ILES_BU,JSV) = X_LES_BU_RES_WSv(:,ILES_BU,JSV) + ZLES_PROF(:)
+ X_LES_BU_RES_WSV(:,ILES_BU,JSV) = X_LES_BU_RES_WSV(:,ILES_BU,JSV) + ZLES_PROF(:)
END DO
!
!* update fields
@@ -187,27 +187,27 @@ SELECT CASE (KBUDN)
XCURRENT_RTHLS = XCURRENT_RTHLS + PVARS - XCURRENT_RTHS
CALL LES_BUDGET_ANOMALY(XCURRENT_RTHLS,'-',ZANOM)
!
- !* action in WThl budget
- ZWORK_LES = ( ZANOM * XW_ANOM - XW_ANOM * XTHl_ANOM ) / XCURRENT_TSTEP_MET
+ !* action in WTHL budget
+ ZWORK_LES = ( ZANOM * XW_ANOM - XW_ANOM * XTHL_ANOM ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_WThl(:,ILES_BU) = X_LES_BU_RES_WThl(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_WTHL(:,ILES_BU) = X_LES_BU_RES_WTHL(:,ILES_BU) + ZLES_PROF(:)
!
- !* action in Thl2 budget
- ZWORK_LES = ( ZANOM ** 2 - XTHl_ANOM**2 ) / XCURRENT_TSTEP_MET
+ !* action in THL2 budget
+ ZWORK_LES = ( ZANOM ** 2 - XTHL_ANOM**2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_Thl2(:,ILES_BU) = X_LES_BU_RES_Thl2(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_THL2(:,ILES_BU) = X_LES_BU_RES_THL2(:,ILES_BU) + ZLES_PROF(:)
!
- !* action in ThlRt budget
+ !* action in THLRT budget
IF (LCURRENT_USERV) THEN
- ZWORK_LES = ( ZANOM * XRt_ANOM - XRt_ANOM * XTHl_ANOM ) / &
- XCURRENT_TSTEP_MET
+ ZWORK_LES = ( ZANOM * XRT_ANOM - XRT_ANOM * XTHL_ANOM ) / &
+ XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_ThlRt(:,ILES_BU) = X_LES_BU_RES_ThlRt(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_THLRT(:,ILES_BU) = X_LES_BU_RES_THLRT(:,ILES_BU) + ZLES_PROF(:)
END IF
!
!* update fields
XCURRENT_RTHS = PVARS
- XThl_ANOM = ZANOM
+ XTHL_ANOM = ZANOM
!
!* Tke
!
@@ -223,99 +223,99 @@ SELECT CASE (KBUDN)
!* Rv, Rr, Ri, Rs, Rg, Rh
!
CASE(6,8,9,10,11,12)
- !* transformation into conservative variables: Rt
+ !* transformation into conservative variables: RT
XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-5)
CALL LES_BUDGET_ANOMALY(XCURRENT_RRTS,'-',ZANOM)
!
- !* action in WRt budget
- ZWORK_LES = ( ZANOM * XW_ANOM - XW_ANOM * XRt_ANOM ) / XCURRENT_TSTEP_MET
+ !* action in WRT budget
+ ZWORK_LES = ( ZANOM * XW_ANOM - XW_ANOM * XRT_ANOM ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_WRt(:,ILES_BU) = X_LES_BU_RES_WRt(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_WRT(:,ILES_BU) = X_LES_BU_RES_WRT(:,ILES_BU) + ZLES_PROF(:)
!
- !* action in Rt2 budget
- ZWORK_LES = ( ZANOM **2 - XRt_ANOM **2 ) / XCURRENT_TSTEP_MET
+ !* action in RT2 budget
+ ZWORK_LES = ( ZANOM **2 - XRT_ANOM **2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_Rt2(:,ILES_BU) = X_LES_BU_RES_Rt2(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_RT2(:,ILES_BU) = X_LES_BU_RES_RT2(:,ILES_BU) + ZLES_PROF(:)
!
- !* action in ThlRt budget
- ZWORK_LES = ( ZANOM * XThl_ANOM - XThl_ANOM * XRt_ANOM ) / &
- XCURRENT_TSTEP_MET
+ !* action in THLRT budget
+ ZWORK_LES = ( ZANOM * XTHL_ANOM - XTHL_ANOM * XRT_ANOM ) / &
+ XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_ThlRt(:,ILES_BU) = X_LES_BU_RES_ThlRt(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_THLRT(:,ILES_BU) = X_LES_BU_RES_THLRT(:,ILES_BU) + ZLES_PROF(:)
!
!* update fields
XCURRENT_RRS(:,:,:,KBUDN-5) = PVARS
- XRt_ANOM = ZANOM
+ XRT_ANOM = ZANOM
!
!* Rc
!
CASE(7)
- !* transformation into conservative variables: theta_l; Rt
+ !* transformation into conservative variables: theta_l; RT
XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-5)
XCURRENT_RTHLS = XCURRENT_RTHLS - XCURRENT_L_O_EXN_CP &
* (PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-5))
- !* anomaly of Thl
+ !* anomaly of THL
ALLOCATE(ZTHL_ANOM(IIU,IJU,NLES_K))
CALL LES_BUDGET_ANOMALY(XCURRENT_RTHLS,'-',ZTHL_ANOM)
- !* anomaly of Rt
+ !* anomaly of RT
CALL LES_BUDGET_ANOMALY(XCURRENT_RRTS,'-',ZANOM)
!
- !* action in WThl budget
- ZWORK_LES = ( ZTHL_ANOM * XW_ANOM - XThl_ANOM * XW_ANOM ) / &
- XCURRENT_TSTEP_MET
+ !* action in WTHL budget
+ ZWORK_LES = ( ZTHL_ANOM * XW_ANOM - XTHL_ANOM * XW_ANOM ) / &
+ XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_WThl(:,ILES_BU) = X_LES_BU_RES_WThl(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_WTHL(:,ILES_BU) = X_LES_BU_RES_WTHL(:,ILES_BU) + ZLES_PROF(:)
!
- !* action in Thl2 budget
- ZWORK_LES = ( ZTHL_ANOM **2 - XThl_ANOM **2 ) / XCURRENT_TSTEP_MET
+ !* action in THL2 budget
+ ZWORK_LES = ( ZTHL_ANOM **2 - XTHL_ANOM **2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_Thl2(:,ILES_BU) = X_LES_BU_RES_Thl2(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_THL2(:,ILES_BU) = X_LES_BU_RES_THL2(:,ILES_BU) + ZLES_PROF(:)
!
- !* action in ThlRt budget
- ZWORK_LES = ( ZANOM * ZTHL_ANOM - XRt_ANOM * XThl_ANOM ) / &
- XCURRENT_TSTEP_MET
+ !* action in THLRT budget
+ ZWORK_LES = ( ZANOM * ZTHL_ANOM - XRT_ANOM * XTHL_ANOM ) / &
+ XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_ThlRt(:,ILES_BU) = X_LES_BU_RES_ThlRt(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_THLRT(:,ILES_BU) = X_LES_BU_RES_THLRT(:,ILES_BU) + ZLES_PROF(:)
!
- !* action in WRt budget
- ZWORK_LES = ( ZANOM * XW_ANOM - XRt_ANOM * XW_ANOM ) / &
- XCURRENT_TSTEP_MET
+ !* action in WRT budget
+ ZWORK_LES = ( ZANOM * XW_ANOM - XRT_ANOM * XW_ANOM ) / &
+ XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_WRt(:,ILES_BU) = X_LES_BU_RES_WRt(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_WRT(:,ILES_BU) = X_LES_BU_RES_WRT(:,ILES_BU) + ZLES_PROF(:)
!
- !* action in Rt2 budget
- ZWORK_LES = ( ZANOM **2 - XRt_ANOM **2 ) / XCURRENT_TSTEP_MET
+ !* action in RT2 budget
+ ZWORK_LES = ( ZANOM **2 - XRT_ANOM **2 ) / XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_Rt2(:,ILES_BU) = X_LES_BU_RES_Rt2(:,ILES_BU) + ZLES_PROF(:)
+ X_LES_BU_RES_RT2(:,ILES_BU) = X_LES_BU_RES_RT2(:,ILES_BU) + ZLES_PROF(:)
!
!
!* update fields
XCURRENT_RRS(:,:,:,KBUDN-5) = PVARS
- XRt_ANOM = ZANOM
- XThl_ANOM = ZTHL_ANOM
+ XRT_ANOM = ZANOM
+ XTHL_ANOM = ZTHL_ANOM
DEALLOCATE(ZTHL_ANOM)
!
-!* Sv
+!* SV
!
CASE(13:)
CALL LES_BUDGET_ANOMALY(PVARS,'-',ZANOM)
!
- !* action in WSv budget
- ZWORK_LES = ( ZANOM * XW_ANOM - XSv_ANOM(:,:,:,KBUDN-12) * XW_ANOM ) / &
- XCURRENT_TSTEP_SV
+ !* action in WSV budget
+ ZWORK_LES = ( ZANOM * XW_ANOM - XSV_ANOM(:,:,:,KBUDN-12) * XW_ANOM ) / &
+ XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_WSv(:,ILES_BU,KBUDN-12) = X_LES_BU_RES_WSv(:,ILES_BU,KBUDN-12) + ZLES_PROF(:)
+ X_LES_BU_RES_WSV(:,ILES_BU,KBUDN-12) = X_LES_BU_RES_WSV(:,ILES_BU,KBUDN-12) + ZLES_PROF(:)
!
- !* action in Sv2 budget
- ZWORK_LES = ( ZANOM **2 - XSv_ANOM(:,:,:,KBUDN-12) **2 ) / &
- XCURRENT_TSTEP_SV
+ !* action in SV2 budget
+ ZWORK_LES = ( ZANOM **2 - XSV_ANOM(:,:,:,KBUDN-12) **2 ) / &
+ XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_Sv2(:,ILES_BU,KBUDN-12) = X_LES_BU_RES_Sv2(:,ILES_BU,KBUDN-12) + ZLES_PROF(:)
+ X_LES_BU_RES_SV2(:,ILES_BU,KBUDN-12) = X_LES_BU_RES_SV2(:,ILES_BU,KBUDN-12) + ZLES_PROF(:)
!
!* update fields
XCURRENT_RSVS(:,:,:,KBUDN-12) = PVARS
- XSv_ANOM(:,:,:,KBUDN-12) = ZANOM
+ XSV_ANOM(:,:,:,KBUDN-12) = ZANOM
END SELECT
!
@@ -338,12 +338,8 @@ CHARACTER (LEN=*), INTENT(IN) :: HBU ! Identifier of the Budget of the
! variable that is considered
INTEGER, INTENT(OUT) :: KLES_BU ! LES budget identifier
!
-IF (HBU(1:4)=='ADVX') THEN
- KLES_BU = NLES_TOTADVH
-ELSE IF (HBU(1:4)=='ADVY') THEN
- KLES_BU = NLES_TOTADVH
-ELSE IF (HBU(1:4)=='ADVZ') THEN
- KLES_BU = NLES_TOTADVV
+IF (HBU(1:3)=='ADV') THEN
+ KLES_BU = NLES_TOTADV
ELSE IF (HBU(1:3)=='REL') THEN
KLES_BU = NLES_RELA
ELSE IF (HBU(1:5)=='VTURB') THEN
@@ -397,16 +393,16 @@ INTEGER :: IINFO_ll
SELECT CASE (HGRID)
CASE ('X')
ZRHODJ(:,:,:) = MXM(XCURRENT_RHODJ)
- ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP_UVW
+ ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP
CASE ('Y')
ZRHODJ(:,:,:) = MYM(XCURRENT_RHODJ)
- ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP_UVW
+ ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP
CASE ('Z')
ZRHODJ(:,:,:) = MZM(1,IKU,1,XCURRENT_RHODJ)
- ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP_UVW
+ ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP
CASE DEFAULT
ZRHODJ(:,:,:) = XCURRENT_RHODJ
- ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP_MET
+ ZS(:,:,:) = PVARS(:,:,:) / ZRHODJ * XCURRENT_TSTEP
END SELECT
NULLIFY(TZFIELDS_ll)
diff --git a/src/MNH/les_budget_tendn.f90 b/src/MNH/les_budget_tendn.f90
index a906e957f..c8709c461 100644
--- a/src/MNH/les_budget_tendn.f90
+++ b/src/MNH/les_budget_tendn.f90
@@ -114,11 +114,11 @@ ALLOCATE(ZRT (IIU,IJU,IKU))
CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
LUSERI, LUSERS, LUSERG, LUSERH, &
XCURRENT_L_O_EXN_CP, &
- XTHM, XRM, &
+ XTHT, XRT, &
ZTHL, ZRT )
!
-!* anomalies at previous time-step (instant 'M')
+!* anomalies at time-step
! ---------------------------------------------
!
ALLOCATE(ZU_ANOM (IIU,IJU,NLES_K))
@@ -128,13 +128,13 @@ ALLOCATE(ZTHL_ANOM (IIU,IJU,NLES_K))
ALLOCATE(ZRT_ANOM (IIU,IJU,NLES_K))
ALLOCATE(ZSV_ANOM (IIU,IJU,NLES_K,NSV))
-CALL LES_ANOMALY_FIELD(MXF(XUM),ZU_ANOM)
-CALL LES_ANOMALY_FIELD(MYF(XVM),ZV_ANOM)
-CALL LES_ANOMALY_FIELD(MZF(1,IKU,1,XWM),ZW_ANOM)
+CALL LES_ANOMALY_FIELD(MXF(XUT),ZU_ANOM)
+CALL LES_ANOMALY_FIELD(MYF(XVT),ZV_ANOM)
+CALL LES_ANOMALY_FIELD(MZF(1,IKU,1,XWT),ZW_ANOM)
CALL LES_ANOMALY_FIELD(ZTHL,ZTHL_ANOM)
CALL LES_ANOMALY_FIELD(ZRT,ZRT_ANOM)
DO JSV=1,NSV
- CALL LES_ANOMALY_FIELD(XSVM(:,:,:,JSV),ZSV_ANOM(:,:,:,JSV))
+ CALL LES_ANOMALY_FIELD(XSVT(:,:,:,JSV),ZSV_ANOM(:,:,:,JSV))
END DO
DEALLOCATE(ZTHL)
DEALLOCATE(ZRT)
@@ -143,52 +143,50 @@ ALLOCATE(ZWORK_LES(IIU,IJU,NLES_K))
!
!* KE budget
!
-ZWORK_LES = (XU_ANOM * XU_ANOM - ZU_ANOM * ZU_ANOM) / XCURRENT_TSTEP_UVW &
- +(XV_ANOM * XV_ANOM - ZV_ANOM * ZV_ANOM) / XCURRENT_TSTEP_UVW &
- +(XW_ANOM * XW_ANOM - ZW_ANOM * ZW_ANOM) / XCURRENT_TSTEP_UVW
+ZWORK_LES = (XU_ANOM * XU_ANOM - ZU_ANOM * ZU_ANOM) / XCURRENT_TSTEP &
+ +(XV_ANOM * XV_ANOM - ZV_ANOM * ZV_ANOM) / XCURRENT_TSTEP &
+ +(XW_ANOM * XW_ANOM - ZW_ANOM * ZW_ANOM) / XCURRENT_TSTEP
CALL LES_MEAN_ll(-ZWORK_LES,LLES_CURRENT_CART_MASK,X_LES_BU_RES_KE(:,NLES_TEND))
!* WThl budget
-ZWORK_LES = (XW_ANOM * XTHL_ANOM - ZW_ANOM * ZTHL_ANOM) / XCURRENT_TSTEP_MET
+ZWORK_LES = (XW_ANOM * XTHL_ANOM - ZW_ANOM * ZTHL_ANOM) / XCURRENT_TSTEP
CALL LES_MEAN_ll(-ZWORK_LES,LLES_CURRENT_CART_MASK,X_LES_BU_RES_WThl(:,NLES_TEND))
!* Thl2 budget
-ZWORK_LES = (XTHL_ANOM * XTHL_ANOM - ZTHL_ANOM * ZTHL_ANOM) / XCURRENT_TSTEP_MET
+ZWORK_LES = (XTHL_ANOM * XTHL_ANOM - ZTHL_ANOM * ZTHL_ANOM) / XCURRENT_TSTEP
CALL LES_MEAN_ll(-ZWORK_LES,LLES_CURRENT_CART_MASK,X_LES_BU_RES_Thl2(:,NLES_TEND))
IF (LUSERV) THEN
!* ThlRt budget
- ZWORK_LES = (XRT_ANOM * XTHL_ANOM - ZRT_ANOM * ZTHL_ANOM) / XCURRENT_TSTEP_MET
+ ZWORK_LES = (XRT_ANOM * XTHL_ANOM - ZRT_ANOM * ZTHL_ANOM) / XCURRENT_TSTEP
CALL LES_MEAN_ll(-ZWORK_LES,LLES_CURRENT_CART_MASK,X_LES_BU_RES_ThlRt(:,NLES_TEND))
!* Rt2 budget
- ZWORK_LES = (XRT_ANOM * XRT_ANOM - ZRT_ANOM * ZRT_ANOM) / XCURRENT_TSTEP_MET
+ ZWORK_LES = (XRT_ANOM * XRT_ANOM - ZRT_ANOM * ZRT_ANOM) / XCURRENT_TSTEP
CALL LES_MEAN_ll(-ZWORK_LES,LLES_CURRENT_CART_MASK,X_LES_BU_RES_Rt2(:,NLES_TEND))
!* WRt budget
- ZWORK_LES = (XRT_ANOM * XW_ANOM - ZRT_ANOM * ZW_ANOM) / XCURRENT_TSTEP_MET
+ ZWORK_LES = (XRT_ANOM * XW_ANOM - ZRT_ANOM * ZW_ANOM) / XCURRENT_TSTEP
CALL LES_MEAN_ll(-ZWORK_LES,LLES_CURRENT_CART_MASK,X_LES_BU_RES_WRt(:,NLES_TEND))
END IF
DO JSV=1,NSV
!* WSv budget
- ZWORK_LES = (XW_ANOM * XSV_ANOM(:,:,:,JSV) - ZW_ANOM * ZSV_ANOM(:,:,:,JSV)) / &
- XCURRENT_TSTEP_SV
+ ZWORK_LES = (XW_ANOM * XSV_ANOM(:,:,:,JSV) - ZW_ANOM * ZSV_ANOM(:,:,:,JSV)) / XCURRENT_TSTEP
CALL LES_MEAN_ll(-ZWORK_LES,LLES_CURRENT_CART_MASK,X_LES_BU_RES_WSv(:,NLES_TEND,JSV))
!* Sv2 budget
- ZWORK_LES = (XSV_ANOM(:,:,:,JSV)**2 - ZSV_ANOM(:,:,:,JSV)**2) / &
- XCURRENT_TSTEP_SV
+ ZWORK_LES = (XSV_ANOM(:,:,:,JSV)**2 - ZSV_ANOM(:,:,:,JSV)**2) / XCURRENT_TSTEP
CALL LES_MEAN_ll(-ZWORK_LES,LLES_CURRENT_CART_MASK,X_LES_BU_RES_Sv2(:,NLES_TEND,JSV))
END DO
!* Tke budget
ALLOCATE(ZTEND(IIU,IJU,IKU))
-ZTEND(:,:,:) = -(XRTKES*XCURRENT_TSTEP_UVW/XRHODJ-XTKEM) / XCURRENT_TSTEP_UVW
+ZTEND(:,:,:) = -(XRTKES*XCURRENT_TSTEP/XRHODJ-XTKET) / XCURRENT_TSTEP
CALL LES_VER_INT( ZTEND, ZWORK_LES )
CALL LES_MEAN_ll(ZWORK_LES,LLES_CURRENT_CART_MASK,X_LES_BU_SBG_Tke(:,NLES_TEND))
DEALLOCATE(ZTEND)
diff --git a/src/MNH/les_cloud_masksn.f90 b/src/MNH/les_cloud_masksn.f90
index 4ed7e339d..f23baf7c5 100644
--- a/src/MNH/les_cloud_masksn.f90
+++ b/src/MNH/les_cloud_masksn.f90
@@ -88,7 +88,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZMEANRC
!
CALL GET_DIM_EXT_ll('B',IIU,IJU)
!
-IKU = SIZE(XTHM,3)
+IKU = SIZE(XTHT,3)
!
!-------------------------------------------------------------------------------
!
@@ -102,40 +102,40 @@ ZRT = 0.
IRR=0
IF (LUSERV) THEN
IRR=IRR+1
- ZRT = ZRT + XRM(:,:,:,1)
+ ZRT = ZRT + XRT(:,:,:,1)
END IF
IF (LUSERC) THEN
IRR=IRR+1
IRRC=IRR
- ZRT = ZRT + XRM(:,:,:,IRRC)
+ ZRT = ZRT + XRT(:,:,:,IRRC)
END IF
IF (LUSERR) THEN
IRR=IRR+1
IRRR=IRR
- ZRT = ZRT + XRM(:,:,:,IRRR)
+ ZRT = ZRT + XRT(:,:,:,IRRR)
END IF
IF (LUSERI) THEN
IRR=IRR+1
IRRI=IRR
- ZRT = ZRT + XRM(:,:,:,IRRI)
+ ZRT = ZRT + XRT(:,:,:,IRRI)
END IF
IF (LUSERS) THEN
IRR=IRR+1
IRRS=IRR
- ZRT = ZRT + XRM(:,:,:,IRRS)
+ ZRT = ZRT + XRT(:,:,:,IRRS)
END IF
IF (LUSERG) THEN
IRR=IRR+1
IRRG=IRR
- ZRT = ZRT + XRM(:,:,:,IRRG)
+ ZRT = ZRT + XRT(:,:,:,IRRG)
END IF
!
!
!* computes fields on the LES grid in order to compute masks
!
ALLOCATE(ZTHV (IIU,IJU,IKU))
-ZTHV = XTHM
-IF (LUSERV) ZTHV=ZTHV*(1.+XRV/XRD*XRM(:,:,:,1))/(1.+ZRT(:,:,:))
+ZTHV = XTHT
+IF (LUSERV) ZTHV=ZTHV*(1.+XRV/XRD*XRT(:,:,:,1))/(1.+ZRT(:,:,:))
!
!-------------------------------------------------------------------------------
!
@@ -163,20 +163,20 @@ ZWORK1D=0.
ZWORK3D=0.
ZWORK3DB=0.
!
-CALL LES_VER_INT(MZF(1,IKU,1,XWM), ZW_LES)
+CALL LES_VER_INT(MZF(1,IKU,1,XWT), ZW_LES)
IF (NSV_CS>0) THEN
DO JSV=NSV_CSBEG, NSV_CSEND
- CALL LES_VER_INT( XSVM(:,:,:,JSV), &
+ CALL LES_VER_INT( XSVT(:,:,:,JSV), &
ZSV_LES(:,:,:,JSV-NSV_CSBEG+1) )
END DO
END IF
IF (LUSERC) THEN
- CALL LES_VER_INT(XRM(:,:,:,IRRC), ZRC_LES)
+ CALL LES_VER_INT(XRT(:,:,:,IRRC), ZRC_LES)
ELSE
ZRC_LES = 0.
END IF
IF (LUSERI) THEN
- CALL LES_VER_INT(XRM(:,:,:,IRRI), ZRI_LES)
+ CALL LES_VER_INT(XRT(:,:,:,IRRI), ZRI_LES)
ELSE
ZRI_LES = 0.
END IF
@@ -186,7 +186,7 @@ CALL LES_ANOMALY_FIELD(ZTHV,ZTHV_ANOM)
!
IF (NSV_CS>0) THEN
DO JSV=NSV_CSBEG, NSV_CSEND
- ZWORK3D(:,:,:)=XSVM(:,:,:,JSV)
+ ZWORK3D(:,:,:)=XSVT(:,:,:,JSV)
CALL LES_ANOMALY_FIELD(ZWORK3D,ZWORK3DB)
ZSV_ANOM(:,:,:,JSV-NSV_CSBEG+1)=ZWORK3DB(:,:,:)
CALL LES_STDEV(ZWORK3DB,ZWORK1D)
@@ -350,9 +350,6 @@ IF (LLES_MY_MASK) THEN
ALLOCATE(LLES_CURRENT_MY_MASK(IIU,IJU,NLES_K))
DO JI=1,NLES_MASKS_USER
LLES_CURRENT_MY_MASKS (:,:,:,JI) = .FALSE.
-! IF (JI==1) LLES_CURRENT_MY_MASKS (12:17,52:57,:,JI) = .TRUE.
-! IF (JI==2) LLES_CURRENT_MY_MASKS (12:17,57:62,:,JI) = .TRUE.
-! IF (JI==3) LLES_CURRENT_MY_MASKS (12:17,62:67,:,JI) = .TRUE.
END DO
!
END IF
@@ -415,6 +412,4 @@ END DO
END SUBROUTINE LES_STDEV
!-------------------------------------------------------------------------------
!
-!-------------------------------------------------------------------------------
-!
END SUBROUTINE LES_CLOUD_MASKS_n
diff --git a/src/MNH/les_ini_timestepn.f90 b/src/MNH/les_ini_timestepn.f90
index 8bf40a2af..0b53ad024 100644
--- a/src/MNH/les_ini_timestepn.f90
+++ b/src/MNH/les_ini_timestepn.f90
@@ -11,12 +11,9 @@ MODULE MODI_LES_INI_TIMESTEP_n
!
INTERFACE LES_INI_TIMESTEP_n
!
- SUBROUTINE LES_INI_TIMESTEP_n(KTCOUNT,PTSTEP_UVW,PTSTEP_MET,PTSTEP_SV)
+ SUBROUTINE LES_INI_TIMESTEP_n(KTCOUNT)
!
INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
-REAL, INTENT(IN) :: PTSTEP_UVW ! leap-frog time-step
-REAL, INTENT(IN) :: PTSTEP_MET ! forward-in-time time-step
-REAL, INTENT(IN) :: PTSTEP_SV ! forward-in-time time-step
!
END SUBROUTINE LES_INI_TIMESTEP_n
!
@@ -25,7 +22,7 @@ END INTERFACE
END MODULE MODI_LES_INI_TIMESTEP_n
! ##############################
- SUBROUTINE LES_INI_TIMESTEP_n(KTCOUNT,PTSTEP_UVW,PTSTEP_MET,PTSTEP_SV)
+ SUBROUTINE LES_INI_TIMESTEP_n(KTCOUNT)
! ##############################
!
!
@@ -90,9 +87,6 @@ IMPLICIT NONE
!
!
INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
-REAL, INTENT(IN) :: PTSTEP_UVW ! leap-frog time-step
-REAL, INTENT(IN) :: PTSTEP_MET ! forward-in-time time-step
-REAL, INTENT(IN) :: PTSTEP_SV ! forward-in-time time-step
!
!
! 0.2 declaration of local variables
@@ -170,11 +164,9 @@ XLES_DATIME(16,NLES_TCOUNT) = TDTCUR%TIME
!
XLES_TRAJT(NLES_TCOUNT,1) = (KTCOUNT-1) * XTSTEP
!
-!* time-step
+!* forward-in-time time-step
!
-XCURRENT_TSTEP_UVW = PTSTEP_UVW
-XCURRENT_TSTEP_MET = PTSTEP_MET
-XCURRENT_TSTEP_SV = PTSTEP_SV
+XCURRENT_TSTEP = XTSTEP
!
!-------------------------------------------------------------------------------
!
@@ -187,7 +179,7 @@ IJB_ll=IYOR_ll+IJB-1
IIE_ll=IXOR_ll+IIE-1
IJE_ll=IYOR_ll+IJE-1
!
-IKU = SIZE(XTHM,3)
+IKU = SIZE(XTHT,3)
!
IMI = GET_CURRENT_MODEL_INDEX()
!
@@ -250,37 +242,37 @@ IF (LUSERC) THEN
!
!* Exner function
!
- ZEXN(:,:,:) = (XPABSM/XP00)**(XRD/XCPD)
+ ZEXN(:,:,:) = (XPABST/XP00)**(XRD/XCPD)
!
!* Latent heat of vaporization
!
- ZL(:,:,:) = XLVTT + (XCPD-XCL) * (XTHM(:,:,:)*ZEXN(:,:,:)-XTT)
+ ZL(:,:,:) = XLVTT + (XCPD-XCL) * (XTHT(:,:,:)*ZEXN(:,:,:)-XTT)
!
!* heat capacity at constant pressure of the humid air
!
ZCP(:,:,:) = XCPD
IRR=2
- ZCP(:,:,:) = ZCP(:,:,:) + XCPV * XRM(:,:,:,1)
- ZCP(:,:,:) = ZCP(:,:,:) + XCL * XRM(:,:,:,2)
+ ZCP(:,:,:) = ZCP(:,:,:) + XCPV * XRT(:,:,:,1)
+ ZCP(:,:,:) = ZCP(:,:,:) + XCL * XRT(:,:,:,2)
IF (LUSERR) THEN
IRR=IRR+1
- ZCP(:,:,:) = ZCP(:,:,:) + XCL * XRM(:,:,:,IRR)
+ ZCP(:,:,:) = ZCP(:,:,:) + XCL * XRT(:,:,:,IRR)
END IF
IF (LUSERI) THEN
IRR=IRR+1
- ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRM(:,:,:,IRR)
+ ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
END IF
IF (LUSERS) THEN
IRR=IRR+1
- ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRM(:,:,:,IRR)
+ ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
END IF
IF (LUSERG) THEN
IRR=IRR+1
- ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRM(:,:,:,IRR)
+ ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
END IF
IF (LUSERH) THEN
IRR=IRR+1
- ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRM(:,:,:,IRR)
+ ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
END IF
!
!* L / (Exn * Cp)
@@ -373,19 +365,19 @@ ALLOCATE(ZRT (IIU,IJU,IKU))
CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
LUSERI, LUSERS, LUSERG, LUSERH, &
XCURRENT_L_O_EXN_CP, &
- XTHM, XRM, &
+ XTHT, XRT, &
ZTHL, ZRT )
!
!* 4.2 anomaly fields on the LES grid
! ------------------------------
!
-CALL LES_ANOMALY_FIELD(MXF(XUM),XU_ANOM)
-CALL LES_ANOMALY_FIELD(MYF(XVM),XV_ANOM)
-CALL LES_ANOMALY_FIELD(MZF(1,IKU,1,XWM),XW_ANOM)
+CALL LES_ANOMALY_FIELD(MXF(XUT),XU_ANOM)
+CALL LES_ANOMALY_FIELD(MYF(XVT),XV_ANOM)
+CALL LES_ANOMALY_FIELD(MZF(1,IKU,1,XWT),XW_ANOM)
CALL LES_ANOMALY_FIELD(ZTHL,XTHL_ANOM)
IF (LUSERV) CALL LES_ANOMALY_FIELD(ZRT,XRT_ANOM)
DO JSV=1,NSV
- CALL LES_ANOMALY_FIELD(XSVM(:,:,:,JSV),XSV_ANOM(:,:,:,JSV))
+ CALL LES_ANOMALY_FIELD(XSVT(:,:,:,JSV),XSV_ANOM(:,:,:,JSV))
END DO
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/les_masksn.f90 b/src/MNH/les_masksn.f90
index 06ff0a97f..3ab2c06fd 100644
--- a/src/MNH/les_masksn.f90
+++ b/src/MNH/les_masksn.f90
@@ -148,7 +148,7 @@ IJB_ll=IYOR_ll+IJB-1
IIE_ll=IXOR_ll+IIE-1
IJE_ll=IYOR_ll+IJE-1
!
-IKU = SIZE(XTHM,3)
+IKU = SIZE(XTHT,3)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/les_res_tr.f90 b/src/MNH/les_res_tr.f90
index 46f0f8a61..966e6cd54 100644
--- a/src/MNH/les_res_tr.f90
+++ b/src/MNH/les_res_tr.f90
@@ -232,8 +232,7 @@ CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, X_LES_BU_SBG_Tke(:,NLES_ADV
!* 4. Advection by resolved flow
! --------------------------
!
-X_LES_BU_SBG_Tke(:,NLES_ADVR) = X_LES_BU_SBG_Tke(:,NLES_TOTADVH) &
- + X_LES_BU_SBG_Tke(:,NLES_TOTADVV) &
+X_LES_BU_SBG_Tke(:,NLES_ADVR) = X_LES_BU_SBG_Tke(:,NLES_TOTADV) &
- X_LES_BU_SBG_Tke(:,NLES_ADVM)
!
!-------------------------------------------------------------------------------
@@ -241,46 +240,38 @@ X_LES_BU_SBG_Tke(:,NLES_ADVR) = X_LES_BU_SBG_Tke(:,NLES_TOTADVH) &
!* 5. Turbulent transport
! -------------------
!
-X_LES_BU_RES_Ke(:,NLES_TR ) = X_LES_BU_RES_Ke(:,NLES_TOTADVH) &
- + X_LES_BU_RES_Ke(:,NLES_TOTADVV) &
+X_LES_BU_RES_Ke(:,NLES_TR ) = X_LES_BU_RES_Ke(:,NLES_TOTADV) &
- X_LES_BU_RES_Ke(:,NLES_ADVM) &
- X_LES_BU_RES_Ke(:,NLES_DP)
!
-X_LES_BU_RES_Thl2(:,NLES_TR ) = X_LES_BU_RES_Thl2(:,NLES_TOTADVH) &
- + X_LES_BU_RES_Thl2(:,NLES_TOTADVV) &
+X_LES_BU_RES_Thl2(:,NLES_TR ) = X_LES_BU_RES_Thl2(:,NLES_TOTADV) &
- X_LES_BU_RES_Thl2(:,NLES_ADVM) &
- X_LES_BU_RES_Thl2(:,NLES_DP)
!
-X_LES_BU_RES_WThl(:,NLES_TR ) = X_LES_BU_RES_WThl(:,NLES_TOTADVH) &
- + X_LES_BU_RES_WThl(:,NLES_TOTADVV) &
+X_LES_BU_RES_WThl(:,NLES_TR ) = X_LES_BU_RES_WThl(:,NLES_TOTADV) &
- X_LES_BU_RES_WThl(:,NLES_ADVM) &
- X_LES_BU_RES_WThl(:,NLES_DP)
!
IF (OUSERV) THEN
- X_LES_BU_RES_Rt2(:,NLES_TR ) = X_LES_BU_RES_Rt2(:,NLES_TOTADVH) &
- + X_LES_BU_RES_Rt2(:,NLES_TOTADVV) &
+ X_LES_BU_RES_Rt2(:,NLES_TR ) = X_LES_BU_RES_Rt2(:,NLES_TOTADV) &
- X_LES_BU_RES_Rt2(:,NLES_ADVM) &
- X_LES_BU_RES_Rt2(:,NLES_DP)
!
- X_LES_BU_RES_WRt(:,NLES_TR ) = X_LES_BU_RES_WRt(:,NLES_TOTADVH) &
- + X_LES_BU_RES_WRt(:,NLES_TOTADVV) &
+ X_LES_BU_RES_WRt(:,NLES_TR ) = X_LES_BU_RES_WRt(:,NLES_TOTADV) &
- X_LES_BU_RES_WRt(:,NLES_ADVM) &
- X_LES_BU_RES_WRt(:,NLES_DP)
!
- X_LES_BU_RES_ThlRt(:,NLES_TR) = X_LES_BU_RES_ThlRt(:,NLES_TOTADVH) &
- + X_LES_BU_RES_ThlRt(:,NLES_TOTADVV) &
+ X_LES_BU_RES_ThlRt(:,NLES_TR) = X_LES_BU_RES_ThlRt(:,NLES_TOTADV) &
- X_LES_BU_RES_ThlRt(:,NLES_ADVM) &
- X_LES_BU_RES_ThlRt(:,NLES_DP)
END IF
!
DO JSV=1,NSV
- X_LES_BU_RES_Sv2(:,NLES_TR ,JSV) = X_LES_BU_RES_Sv2(:,NLES_TOTADVH,JSV) &
- + X_LES_BU_RES_Sv2(:,NLES_TOTADVV,JSV) &
+ X_LES_BU_RES_Sv2(:,NLES_TR ,JSV) = X_LES_BU_RES_Sv2(:,NLES_TOTADV,JSV) &
- X_LES_BU_RES_Sv2(:,NLES_ADVM,JSV) &
- X_LES_BU_RES_Sv2(:,NLES_DP,JSV)
!
- X_LES_BU_RES_WSv(:,NLES_TR ,JSV) = X_LES_BU_RES_WSv(:,NLES_TOTADVH,JSV) &
- + X_LES_BU_RES_WSv(:,NLES_TOTADVV,JSV) &
+ X_LES_BU_RES_WSv(:,NLES_TR ,JSV) = X_LES_BU_RES_WSv(:,NLES_TOTADV,JSV) &
- X_LES_BU_RES_WSv(:,NLES_ADVM,JSV) &
- X_LES_BU_RES_WSv(:,NLES_DP,JSV)
END DO
diff --git a/src/MNH/lesn.f90 b/src/MNH/lesn.f90
index d4110abab..835eb70d1 100644
--- a/src/MNH/lesn.f90
+++ b/src/MNH/lesn.f90
@@ -44,7 +44,6 @@
USE MODD_CST
USE MODD_CTURB, ONLY : XFTOP_O_FSURF
!
-USE MODD_PARAMETERS
USE MODD_LES
USE MODD_LES_BUDGET
USE MODD_CONF
@@ -206,7 +205,7 @@ IIU_ll = IIMAX_ll+JPHEXT
IJU_ll = IJMAX_ll+JPHEXT
IIA_ll=JPHEXT+1
IJA_ll=JPHEXT+1
-IKU=SIZE(XVM,3)
+IKU=SIZE(XVT,3)
IKE=IKU-JPVEXT
IKB=1+JPVEXT
CALL GET_DIM_EXT_ll('B',IIU,IJU)
@@ -405,15 +404,15 @@ ELSE
END IF
!
!
-ALLOCATE(ZEXN (IIU,IJU,SIZE(XTHM,3)))
-ALLOCATE(ZRHO (IIU,IJU,SIZE(XTHM,3)))
-ALLOCATE(ZRT (IIU,IJU,SIZE(XTHM,3)))
-ALLOCATE(ZTHV (IIU,IJU,SIZE(XTHM,3)))
-ALLOCATE(ZTHL (IIU,IJU,SIZE(XTHM,3)))
-ALLOCATE(ZEW (IIU,IJU,SIZE(XTHM,3)))
-ALLOCATE(ZMASSF (IIU,IJU,SIZE(XTHM,3)))
-ALLOCATE(ZTEMP (IIU,IJU,SIZE(XTHM,3)))
-ALLOCATE(ZREHU (IIU,IJU,SIZE(XTHM,3)))
+ALLOCATE(ZEXN (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZRHO (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZRT (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZTHV (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZTHL (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZEW (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZMASSF (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZTEMP (IIU,IJU,SIZE(XTHT,3)))
+ALLOCATE(ZREHU (IIU,IJU,SIZE(XTHT,3)))
ALLOCATE(CHAMPXY1 (IIU,IJU,1))
!
!-------------------------------------------------------------------------------
@@ -421,14 +420,14 @@ ALLOCATE(CHAMPXY1 (IIU,IJU,1))
!* 1.2 preliminary calculations
! ------------------------
!
-ZEXN(:,:,:) = (XPABSM/XP00)**(XRD/XCPD)
+ZEXN(:,:,:) = (XPABST/XP00)**(XRD/XCPD)
!
!
!* computation of relative humidity
-ZTEMP=XTHM*ZEXN
+ZTEMP=XTHT*ZEXN
ZEW=EXP (XALPW -XBETAW/ZTEMP-XGAMW*ALOG(ZTEMP))
IF (LUSERV) THEN
- ZREHU(:,:,:)=100.*XRM(:,:,:,1)*XPABSM(:,:,:)/((XRD/XRV+XRM(:,:,:,1))*ZEW(:,:,:))
+ ZREHU(:,:,:)=100.*XRT(:,:,:,1)*XPABST(:,:,:)/((XRD/XRV+XRT(:,:,:,1))*ZEW(:,:,:))
ELSE
ZREHU(:,:,:)=0.
END IF
@@ -436,22 +435,22 @@ END IF
CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
LUSERI, LUSERS, LUSERG, LUSERH, &
XCURRENT_L_O_EXN_CP, &
- XTHM, XRM, &
+ XTHT, XRT, &
ZTHL, ZRT )
!
!* computation of density and virtual potential temperature
!
-ZTHV=XTHM
-IF (LUSERV) ZTHV=ZTHV*(1.+XRV/XRD*XRM(:,:,:,1))/(1.+ZRT(:,:,:))
+ZTHV=XTHT
+IF (LUSERV) ZTHV=ZTHV*(1.+XRV/XRD*XRT(:,:,:,1))/(1.+ZRT(:,:,:))
!
IF (CEQNSYS=='DUR') THEN
- ZRHO=XPABSM/(XRD*ZTHV*ZEXN)
+ ZRHO=XPABST/(XRD*ZTHV*ZEXN)
ELSE
ZRHO=XRHODREF*( 1. + (XCPD-XRD)/XRD*(ZEXN/XEXNREF - 1.) - (ZTHV/XTHVREF - 1.) )
END IF
!
! computation of mass flux
-ZMASSF=MZM(1,IKU,1,ZRHO)*XWM
+ZMASSF=MZM(1,IKU,1,ZRHO)*XWT
!
!-------------------------------------------------------------------------------
!
@@ -472,20 +471,20 @@ IF (CRAD /= 'NONE') THEN
END IF
!
CALL LES_VER_INT( XZZ , ZZZ_LES)
-CALL LES_VER_INT( XPABSM, ZP_LES )
-CALL LES_VER_INT( GZ_M_M(1,IKU,1,XPABSM,XDZZ), ZDPDZ_LES )
+CALL LES_VER_INT( XPABST, ZP_LES )
+CALL LES_VER_INT( GZ_M_M(1,IKU,1,XPABST,XDZZ), ZDPDZ_LES )
!
-CALL LES_VER_INT( MXF(XUM) ,ZU_LES )
-CALL LES_VER_INT( MYF(XVM) ,ZV_LES )
-CALL LES_VER_INT( MZF(1,IKU,1,XWM) ,ZW_LES )
+CALL LES_VER_INT( MXF(XUT) ,ZU_LES )
+CALL LES_VER_INT( MYF(XVT) ,ZV_LES )
+CALL LES_VER_INT( MZF(1,IKU,1,XWT) ,ZW_LES )
CALL LES_VER_INT( MZF(1,IKU,1,ZMASSF) ,ZMF_LES)
-CALL LES_VER_INT( XTHM ,ZTH_LES )
-CALL LES_VER_INT( MXF(MZF(1,IKU,1,GZ_U_UW(1,IKU,1,XUM,XDZZ))), ZDUDZ_LES )
-CALL LES_VER_INT( MYF(MZF(1,IKU,1,GZ_V_VW(1,IKU,1,XVM,XDZZ))), ZDVDZ_LES )
-CALL LES_VER_INT( GZ_W_M(1,IKU,1,XWM,XDZZ), ZDWDZ_LES )
+CALL LES_VER_INT( XTHT ,ZTH_LES )
+CALL LES_VER_INT( MXF(MZF(1,IKU,1,GZ_U_UW(1,IKU,1,XUT,XDZZ))), ZDUDZ_LES )
+CALL LES_VER_INT( MYF(MZF(1,IKU,1,GZ_V_VW(1,IKU,1,XVT,XDZZ))), ZDVDZ_LES )
+CALL LES_VER_INT( GZ_W_M(1,IKU,1,XWT,XDZZ), ZDWDZ_LES )
CALL LES_VER_INT( ZEXN, ZEXN_LES)
!
-CALL LES_VER_INT( GZ_M_M(1,IKU,1,XTHM,XDZZ), ZDTHDZ_LES )
+CALL LES_VER_INT( GZ_M_M(1,IKU,1,XTHT,XDZZ), ZDTHDZ_LES )
!
CALL LES_VER_INT(ZRHO, ZRHO_LES)
!
@@ -493,18 +492,18 @@ IF (LUSERV) CALL LES_VER_INT(ZTHV, ZTHV_LES)
CALL LES_VER_INT(ZTHL, ZTHL_LES)
CALL LES_VER_INT( GZ_M_M(1,IKU,1,ZTHL,XDZZ), ZDTHLDZ_LES )
!
-CALL LES_VER_INT( XTKEM ,ZTKE_LES)
+CALL LES_VER_INT( XTKET ,ZTKE_LES)
IRR = 0
IF (LUSERV) THEN
IRR = IRR + 1
- CALL LES_VER_INT( XRM(:,:,:,IRR) ,ZRV_LES )
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRV_LES )
CALL LES_VER_INT( ZRT(:,:,:) ,ZRT_LES )
CALL LES_VER_INT( GZ_M_M(1,IKU,1,ZRT,XDZZ), ZDRTDZ_LES )
CALL LES_VER_INT( ZREHU(:,:,:) ,ZREHU_LES)
END IF
IF (LUSERC) THEN
IRR = IRR + 1
- CALL LES_VER_INT( XRM(:,:,:,IRR) ,ZRC_LES )
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRC_LES )
ALLOCATE(ZINDCLD (IIU,IJU,NLES_K))
ALLOCATE(ZINDCLD2(IIU,IJU,NLES_K))
ZINDCLD = CEILING(ZRC_LES-1.E-6)
@@ -516,7 +515,7 @@ ELSE
END IF
IF (LUSERR) THEN
IRR = IRR + 1
- CALL LES_VER_INT( XRM(:,:,:,IRR) ,ZRR_LES )
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRR_LES )
CALL LES_VER_INT( XINPRR3D(:,:,:), ZINPRR3D_LES)
CALL LES_VER_INT( XEVAP3D(:,:,:), ZEVAP3D_LES)
END IF
@@ -552,24 +551,24 @@ ENDIF
!
IF (LUSERI) THEN
IRR = IRR + 1
- CALL LES_VER_INT( XRM(:,:,:,IRR) ,ZRI_LES )
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRI_LES )
END IF
IF (LUSERS) THEN
IRR = IRR + 1
- CALL LES_VER_INT( XRM(:,:,:,IRR) ,ZRS_LES )
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRS_LES )
END IF
IF (LUSERG) THEN
IRR = IRR + 1
- CALL LES_VER_INT( XRM(:,:,:,IRR) ,ZRG_LES )
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRG_LES )
END IF
IF (LUSERH) THEN
IRR = IRR + 1
- CALL LES_VER_INT( XRM(:,:,:,IRR) ,ZRH_LES )
+ CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRH_LES )
END IF
IF (NSV>0) THEN
DO JSV=1,NSV
- CALL LES_VER_INT( XSVM(:,:,:,JSV), ZSV_LES(:,:,:,JSV) )
- CALL LES_VER_INT( GZ_M_M(1,IKU,1,XSVM(:,:,:,JSV),XDZZ), ZDSVDZ_LES(:,:,:,JSV) )
+ CALL LES_VER_INT( XSVT(:,:,:,JSV), ZSV_LES(:,:,:,JSV) )
+ CALL LES_VER_INT( GZ_M_M(1,IKU,1,XSVT(:,:,:,JSV),XDZZ), ZDSVDZ_LES(:,:,:,JSV) )
END DO
END IF
!
@@ -780,30 +779,30 @@ END IF
!
!* note that velocity fields are previously localized on the MASS points
!
-CALL SPEC_VER_INT(IMI, MXF(XUM) ,ZU_SPEC )
-CALL SPEC_VER_INT(IMI, MYF(XVM) ,ZV_SPEC )
-CALL SPEC_VER_INT(IMI, MZF(1,IKU,1,XWM) ,ZW_SPEC )
-CALL SPEC_VER_INT(IMI, XTHM ,ZTH_SPEC )
+CALL SPEC_VER_INT(IMI, MXF(XUT) ,ZU_SPEC )
+CALL SPEC_VER_INT(IMI, MYF(XVT) ,ZV_SPEC )
+CALL SPEC_VER_INT(IMI, MZF(1,IKU,1,XWT) ,ZW_SPEC )
+CALL SPEC_VER_INT(IMI, XTHT ,ZTH_SPEC )
IF (LUSERC) CALL SPEC_VER_INT(IMI, ZTHL ,ZTHL_SPEC)
IRR = 0
IF (LUSERV) THEN
IRR = IRR + 1
- CALL SPEC_VER_INT(IMI, XRM(:,:,:,IRR) ,ZRV_SPEC )
+ CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRV_SPEC )
END IF
IF (LUSERC) THEN
IRR = IRR + 1
- CALL SPEC_VER_INT(IMI, XRM(:,:,:,IRR) ,ZRC_SPEC )
+ CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRC_SPEC )
END IF
IF (LUSERR) THEN
IRR = IRR + 1
END IF
IF (LUSERI) THEN
IRR = IRR + 1
- CALL SPEC_VER_INT(IMI, XRM(:,:,:,IRR) ,ZRI_SPEC )
+ CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRI_SPEC )
END IF
IF (NSV>0) THEN
DO JSV=1,NSV
- CALL SPEC_VER_INT(IMI, XSVM(:,:,:,JSV), ZSV_SPEC(:,:,:,JSV) )
+ CALL SPEC_VER_INT(IMI, XSVT(:,:,:,JSV), ZSV_SPEC(:,:,:,JSV) )
END DO
END IF
!
diff --git a/src/MNH/ls_coupling.f90 b/src/MNH/ls_coupling.f90
index b9f61e799..43ceae651 100644
--- a/src/MNH/ls_coupling.f90
+++ b/src/MNH/ls_coupling.f90
@@ -265,7 +265,7 @@ INTEGER :: IIMAX,IJMAX,IKMAX ! Dimensions of the physical
INTEGER :: IKU ! Dimensions of arrays in
! initial file
LOGICAL :: GLSOURCE ! switch for the source term (for ini_ls and ini_lb)
-CHARACTER(LEN=4), DIMENSION(KSV) :: YGETSVM
+!CHARACTER(LEN=4), DIMENSION(KSV) :: YGETSVM
!
!-------------------------------------------------------------------------------
!
@@ -318,30 +318,30 @@ CALL INI_LS(CCPLFILE(NCPL_CUR),HLUOUT,HGETRVM,GLSOURCE,PLSUS,PLSVS,PLSWS,PLSTHS,
!
GLSOURCE=.TRUE.
!
-YGETSVM(1:KSV) = HGETSVM(1:KSV)
-IF ( LUSECHEM .AND. (.NOT. OCH_INIT_FIELD) ) &
- YGETSVM(NSV_CHEMBEG: NSV_CHEMEND) = 'INIT'
-IF (HCONF == 'RESTA') THEN
- IF (NSV_USER /= 0) YGETSVM(1/NSV_USER) = 'INIT'
- IF (NSV_C2R2 /= 0) YGETSVM(NSV_C2R2BEG: NSV_C2R2END) = 'INIT'
- IF (NSV_C1R3 /= 0) YGETSVM(NSV_C1R3BEG: NSV_C1R3END) = 'INIT'
- IF (NSV_ELEC /= 0) YGETSVM(NSV_ELECBEG: NSV_ELECEND) = 'INIT'
- IF (NSV_LG /= 0) YGETSVM(NSV_LGBEG: NSV_LGEND) = 'INIT'
- IF (NSV_LNOX /= 0) YGETSVM(NSV_LNOXBEG: NSV_LNOXEND) = 'INIT'
- IF (NSV_DST /= 0) YGETSVM(NSV_DSTBEG: NSV_DSTEND) = 'INIT'
- IF (NSV_SLT /= 0) YGETSVM(NSV_SLTBEG: NSV_SLTEND) = 'INIT'
- IF (NSV_DSTDEP /= 0) YGETSVM(NSV_DSTDEPBEG: NSV_DSTDEPEND) = 'INIT'
- IF (NSV_SLTDEP /= 0) YGETSVM(NSV_SLTDEPBEG: NSV_SLTDEPEND) = 'INIT'
- IF (NSV_PP /= 0) YGETSVM(NSV_PPBEG: NSV_PPEND) = 'INIT'
- IF (NSV_CS /= 0) YGETSVM(NSV_CSBEG: NSV_CSEND) = 'INIT'
-END IF
+!YGETSVM(1:KSV) = HGETSVM(1:KSV)
+!IF ( LUSECHEM .AND. (.NOT. OCH_INIT_FIELD) ) &
+! YGETSVM(NSV_CHEMBEG: NSV_CHEMEND) = 'INIT'
+!IF (HCONF == 'RESTA') THEN
+! IF (NSV_USER /= 0) YGETSVM(1/NSV_USER) = 'INIT'
+! IF (NSV_C2R2 /= 0) YGETSVM(NSV_C2R2BEG: NSV_C2R2END) = 'INIT'
+! IF (NSV_C1R3 /= 0) YGETSVM(NSV_C1R3BEG: NSV_C1R3END) = 'INIT'
+! IF (NSV_ELEC /= 0) YGETSVM(NSV_ELECBEG: NSV_ELECEND) = 'INIT'
+! IF (NSV_LG /= 0) YGETSVM(NSV_LGBEG: NSV_LGEND) = 'INIT'
+! IF (NSV_LNOX /= 0) YGETSVM(NSV_LNOXBEG: NSV_LNOXEND) = 'INIT'
+! IF (NSV_DST /= 0) YGETSVM(NSV_DSTBEG: NSV_DSTEND) = 'INIT'
+! IF (NSV_SLT /= 0) YGETSVM(NSV_SLTBEG: NSV_SLTEND) = 'INIT'
+! IF (NSV_DSTDEP /= 0) YGETSVM(NSV_DSTDEPBEG: NSV_DSTDEPEND) = 'INIT'
+! IF (NSV_SLTDEP /= 0) YGETSVM(NSV_SLTDEPBEG: NSV_SLTDEPEND) = 'INIT'
+! IF (NSV_PP /= 0) YGETSVM(NSV_PPBEG: NSV_PPEND) = 'INIT'
+! IF (NSV_CS /= 0) YGETSVM(NSV_CSBEG: NSV_CSEND) = 'INIT'
+!END IF
!
CALL INI_LB(CCPLFILE(NCPL_CUR),HLUOUT,GLSOURCE,KSV, &
KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
HGETTKEM,HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM, &
- HGETRGM,HGETRHM,YGETSVM, &
+ HGETRGM,HGETRHM,HGETSVM, &
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
diff --git a/src/MNH/mean_field.f90 b/src/MNH/mean_field.f90
index ac9c0ecde..32a63739e 100755
--- a/src/MNH/mean_field.f90
+++ b/src/MNH/mean_field.f90
@@ -6,31 +6,21 @@
!
INTERFACE
- SUBROUTINE MEAN_FIELD(PUM, PVM, PWM, PTHM, PTKEM,PPABSM,PUT, PVT, &
- PWT, PTHT, PPABST,KTCOUNT,PTSTEP)
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM ! variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! variables
+ SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! variables
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
-
END SUBROUTINE MEAN_FIELD
END INTERFACE
END MODULE MODI_MEAN_FIELD
!
-! ##################################################################################
- SUBROUTINE MEAN_FIELD(PUM, PVM, PWM, PTHM, PTKEM, PPABSM,PUT, PVT, &
- PWT, PTHT, PPABST,KTCOUNT,PTSTEP)
-! ###############################################################################
+! #######################################################
+ SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST)
+! #######################################################
!
!!**** *MEAN_FIELD * -
!!
@@ -66,40 +56,32 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM ! variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! variables
-
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! variables
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
-REAL, INTENT(IN) :: PTSTEP ! Effective Time step
!
!* 0.2 Declarations of local variables :
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZTEMPM, ZTEMPT
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZTEMPT
!-----------------------------------------------------------------------
!1. MEAN
!
- ZTEMPM = PTHM*(((PPABSM)/XP00)**(XRD/XCPD))
ZTEMPT = PTHT*(((PPABST)/XP00)**(XRD/XCPD))
!
- XUM_MEAN = PUM + XUM_MEAN
- XVM_MEAN = PVM + XVM_MEAN
- XWM_MEAN = PWM + XWM_MEAN
- XTHM_MEAN = PTHM + XTHM_MEAN
- XTEMPM_MEAN = ZTEMPM + XTEMPM_MEAN
- XTKEM_MEAN = PTKEM + XTKEM_MEAN
- XPABSM_MEAN = PPABSM + XPABSM_MEAN
+ XUM_MEAN = PUT + XUM_MEAN
+ XVM_MEAN = PVT + XVM_MEAN
+ XWM_MEAN = PWT + XWM_MEAN
+ XTHM_MEAN = PTHT + XTHM_MEAN
+ XTEMPM_MEAN = ZTEMPT + XTEMPM_MEAN
+ XTKEM_MEAN = PTKET + XTKEM_MEAN
+ XPABSM_MEAN = PPABST + XPABSM_MEAN
!
- XU2_MEAN = PUM**2 + XU2_MEAN
- XV2_MEAN = PVM**2 + XV2_MEAN
- XW2_MEAN = PWM**2 + XW2_MEAN
- XTH2_MEAN = PTHM**2 + XTH2_MEAN
- XTEMP2_MEAN = ZTEMPM**2 + XTEMP2_MEAN
- XPABS2_MEAN = PPABSM**2 + XPABS2_MEAN
+ XU2_MEAN = PUT**2 + XU2_MEAN
+ XV2_MEAN = PVT**2 + XV2_MEAN
+ XW2_MEAN = PWT**2 + XW2_MEAN
+ XTH2_MEAN = PTHT**2 + XTH2_MEAN
+ XTEMP2_MEAN = ZTEMPT**2 + XTEMP2_MEAN
+ XPABS2_MEAN = PPABST**2 + XPABS2_MEAN
!
MEAN_COUNT = MEAN_COUNT + 1
!
diff --git a/src/MNH/mesonh.f90 b/src/MNH/mesonh.f90
index 76ed87604..ae1c70378 100644
--- a/src/MNH/mesonh.f90
+++ b/src/MNH/mesonh.f90
@@ -92,6 +92,8 @@ USE MODI_VERSION
USE MODI_INIT_MNH
USE MODI_DEALLOC_SURFEX
!
+USE MODE_MPPDB
+!
IMPLICIT NONE
!
!* 0.1 declarations of local variables
@@ -107,6 +109,7 @@ INTEGER :: IINFO_ll ! return code of // routines
!* 1. INITIALIZATION
! --------------
! Switch to model 1 variables
+CALL MPPDB_INIT()
CALL GOTO_MODEL(1)
!
CALL INITIO_ll()
@@ -127,7 +130,7 @@ GEXIT=.FALSE.
DO JMODEL=1,NMODEL
CALL GO_TOMODEL_ll(JMODEL,IINFO_ll)
CALL GOTO_MODEL(JMODEL)
- CSTORAGE_TYPE='MT'
+ CSTORAGE_TYPE='TT'
CALL MODEL_n(1,GEXIT)
END DO
!
@@ -156,7 +159,12 @@ END DO
!* 3. FINALIZE THE PARALLEL SESSION
! -----------------------------
!
-CALL END_PARA_ll(IINFO_ll)
+IF (LCHECK) THEN
+ CALL MPPDB_BARRIER()
+ CALL MPPDB_BARRIER()
+ELSE
+ CALL END_PARA_ll(IINFO_ll)
+END IF
!
!
CALL DEALLOC_SURFEX
diff --git a/src/MNH/mf_turb.f90 b/src/MNH/mf_turb.f90
index 39e38a202..7871f0c5b 100644
--- a/src/MNH/mf_turb.f90
+++ b/src/MNH/mf_turb.f90
@@ -6,7 +6,7 @@ INTERFACE
! #################################################################
SUBROUTINE MF_TURB(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL, PTSTEP, PTSTEP_MET, PTSTEP_SV, &
+ PIMPL, PTSTEP, &
PDZZ, &
PRHODJ, &
PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, &
@@ -33,8 +33,6 @@ INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
REAL, INTENT(IN) :: PIMPL ! degree of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables
!
REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients
@@ -80,7 +78,7 @@ END MODULE MODI_MF_TURB
! #################################################################
SUBROUTINE MF_TURB(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL, PTSTEP, PTSTEP_MET, PTSTEP_SV, &
+ PIMPL, PTSTEP, &
PDZZ, &
PRHODJ, &
PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, &
@@ -154,8 +152,6 @@ INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
REAL, INTENT(IN) :: PIMPL ! degree of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables
!
REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients
@@ -253,25 +249,25 @@ ENDIF
! 3.1 Compute the tendency for the conservative potential temperature
! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
!
-CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PTHLM,PFLXZTHMF,-PEMF,PTSTEP_MET,PIMPL, &
+CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PTHLM,PFLXZTHMF,-PEMF,PTSTEP,PIMPL, &
PDZZ,PRHODJ,ZVARS )
! compute new flux
PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
!!! compute THL tendency
!
-PTHLDT(:,:)= (ZVARS(:,:)-PTHLM(:,:))/PTSTEP_MET
+PTHLDT(:,:)= (ZVARS(:,:)-PTHLM(:,:))/PTSTEP
!
! 3.2 Compute the tendency for the conservative mixing ratio
!
-CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP_MET,PIMPL, &
+CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP,PIMPL, &
PDZZ,PRHODJ,ZVARS )
! compute new flux
PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
!!! compute RT tendency
-PRTDT(:,:) = (ZVARS(:,:)-PRTM(:,:))/PTSTEP_MET
+PRTDT(:,:) = (ZVARS(:,:)-PRTM(:,:))/PTSTEP
!
IF (OMIXUV) THEN
@@ -320,12 +316,12 @@ DO JSV=1,ISV
! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
!
CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PSVM(:,:,JSV),PFLXZSVMF(:,:,JSV),&
- -PEMF,PTSTEP_SV,PIMPL,PDZZ,PRHODJ,ZVARS )
+ -PEMF,PTSTEP,PIMPL,PDZZ,PRHODJ,ZVARS )
! compute new flux
PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(KKA,KKU,KKL,ZVARS))
! compute Sv tendency
- PSVDT(:,:,JSV)= (ZVARS(:,:)-PSVM(:,:,JSV))/PTSTEP_SV
+ PSVDT(:,:,JSV)= (ZVARS(:,:)-PSVM(:,:,JSV))/PTSTEP
ENDDO
!
diff --git a/src/MNH/modd_advn.f90 b/src/MNH/modd_advn.f90
index a5184e54a..128ed4e0e 100644
--- a/src/MNH/modd_advn.f90
+++ b/src/MNH/modd_advn.f90
@@ -33,6 +33,8 @@
!! Original 23/10/95 (Vila, lafore) For new scalar advection schemes
!! C.Lac 24/04/06 Introduction of CUVW_ADV_SCHEME and
!! removal of CFV_ADV_SCHEME
+!! J.-P. Pinty 20/03/10 Add NWENO_ORDER
+!! C.Lac and V.Masson Add CTEMP_SCHEME and TIME SPLITTING
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -46,24 +48,31 @@ TYPE ADV_t
CHARACTER(LEN=6) :: CMET_ADV_SCHEME, CSV_ADV_SCHEME, CUVW_ADV_SCHEME
! Control the selected advection scheme
! for the scalar variables
+ CHARACTER(LEN=4) :: CTEMP_SCHEME
!
- INTEGER :: NLITER ! Number iterations MPDATA
- REAL, DIMENSION(:,:,:), POINTER :: XRTHMS=>NULL() ! Source of (rho theta)
- ! advection for PPM
- REAL, DIMENSION(:,:,:), POINTER :: XRTKEMS=>NULL() ! Idem for kinetic energy
- REAL, DIMENSION(:,:,:,:), POINTER :: XRRMS=>NULL() ! Idem for Moist variables
- REAL, DIMENSION(:,:,:,:), POINTER :: XRSVMS=>NULL() ! Idem for addi. scalar
+ INTEGER :: NWENO_ORDER ! Order of the WENO scheme (3 or 5)
!
+ INTEGER :: NSPLIT ! Number of time splitting
+ ! for advection
+!
+ LOGICAL :: LSPLIT_CFL ! Flag to automatically choose number of iterations
+ REAL :: XSPLIT_CFL ! Limit of CFL to automatically choose number of iterations
+!
+ LOGICAL :: LCFL_WRIT ! Flag to write CFL fields in output file
+!
+REAL, DIMENSION(:,:,:), POINTER :: XRTKEMS=>NULL() ! Advection TKE source term
END TYPE ADV_t
TYPE(ADV_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: ADV_MODEL
CHARACTER(LEN=6), POINTER :: CMET_ADV_SCHEME=>NULL(), CSV_ADV_SCHEME=>NULL(), CUVW_ADV_SCHEME=>NULL()
-INTEGER, POINTER :: NLITER=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XRTHMS=>NULL()
+CHARACTER(LEN=4), POINTER :: CTEMP_SCHEME=>NULL()
+INTEGER, POINTER :: NWENO_ORDER=>NULL()
+INTEGER, POINTER :: NSPLIT=>NULL()
+LOGICAL, POINTER :: LSPLIT_CFL=>NULL()
+LOGICAL, POINTER :: LCFL_WRIT=>NULL()
+REAL, POINTER :: XSPLIT_CFL=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRTKEMS=>NULL()
-REAL, DIMENSION(:,:,:,:), POINTER :: XRRMS=>NULL()
-REAL, DIMENSION(:,:,:,:), POINTER :: XRSVMS=>NULL()
CONTAINS
@@ -72,20 +81,19 @@ SUBROUTINE ADV_GOTO_MODEL(KFROM, KTO)
INTEGER, INTENT(IN) :: KFROM, KTO
!
! Save current state for allocated arrays
-ADV_MODEL(KFROM)%XRTHMS=>XRTHMS
ADV_MODEL(KFROM)%XRTKEMS=>XRTKEMS
-ADV_MODEL(KFROM)%XRRMS=>XRRMS
-ADV_MODEL(KFROM)%XRSVMS=>XRSVMS
!
! Current model is set to model KTO
CUVW_ADV_SCHEME=>ADV_MODEL(KTO)%CUVW_ADV_SCHEME
CMET_ADV_SCHEME=>ADV_MODEL(KTO)%CMET_ADV_SCHEME
CSV_ADV_SCHEME=>ADV_MODEL(KTO)%CSV_ADV_SCHEME
-NLITER=>ADV_MODEL(KTO)%NLITER
-XRTHMS=>ADV_MODEL(KTO)%XRTHMS
+CTEMP_SCHEME=>ADV_MODEL(KTO)%CTEMP_SCHEME
+NWENO_ORDER=>ADV_MODEL(KTO)%NWENO_ORDER
+NSPLIT=>ADV_MODEL(KTO)%NSPLIT
+LSPLIT_CFL=>ADV_MODEL(KTO)%LSPLIT_CFL
+LCFL_WRIT=>ADV_MODEL(KTO)%LCFL_WRIT
+XSPLIT_CFL=>ADV_MODEL(KTO)%XSPLIT_CFL
XRTKEMS=>ADV_MODEL(KTO)%XRTKEMS
-XRRMS=>ADV_MODEL(KTO)%XRRMS
-XRSVMS=>ADV_MODEL(KTO)%XRSVMS
END SUBROUTINE ADV_GOTO_MODEL
diff --git a/src/MNH/modd_budget.f90 b/src/MNH/modd_budget.f90
index 6e8058eab..4c872ca99 100644
--- a/src/MNH/modd_budget.f90
+++ b/src/MNH/modd_budget.f90
@@ -169,9 +169,7 @@ LOGICAL, SAVE :: LBU_RU ! True when the budget of RU is performed
!
INTEGER, SAVE :: NASSEU ! time filter
INTEGER, SAVE :: NNESTU ! Efffect of 2way nesting on U
-INTEGER, SAVE :: NADVXU ! advection along X
-INTEGER, SAVE :: NADVYU ! advection along Y
-INTEGER, SAVE :: NADVZU ! advection along Z
+INTEGER, SAVE :: NADVU ! advection
INTEGER, SAVE :: NFRCU ! forcing
INTEGER, SAVE :: NNUDU ! nudging
INTEGER, SAVE :: NCURVU ! curvature
@@ -192,9 +190,7 @@ LOGICAL, SAVE :: LBU_RV ! True when the budget of RV is performed
!
INTEGER, SAVE :: NASSEV ! time filter
INTEGER, SAVE :: NNESTV ! Efffect of 2way nesting on V
-INTEGER, SAVE :: NADVXV ! advection along X
-INTEGER, SAVE :: NADVYV ! advection along Y
-INTEGER, SAVE :: NADVZV ! advection along Z
+INTEGER, SAVE :: NADVV ! advection
INTEGER, SAVE :: NFRCV ! forcing
INTEGER, SAVE :: NNUDV ! nudging
INTEGER, SAVE :: NCURVV ! curvature
@@ -215,9 +211,7 @@ LOGICAL, SAVE :: LBU_RW ! True when the budget of RW is performed
!
INTEGER, SAVE :: NASSEW ! time filter
INTEGER, SAVE :: NNESTW ! Efffect of 2way nesting on W
-INTEGER, SAVE :: NADVXW ! advection along X
-INTEGER, SAVE :: NADVYW ! advection along Y
-INTEGER, SAVE :: NADVZW ! advection along Z
+INTEGER, SAVE :: NADVW ! advection
INTEGER, SAVE :: NFRCW ! forcing
INTEGER, SAVE :: NNUDW ! nudging
INTEGER, SAVE :: NCURVW ! curvature
@@ -238,9 +232,6 @@ LOGICAL, SAVE :: LBU_RTH ! True when the budget of RTH is performed
INTEGER, SAVE :: NASSETH ! time filter
INTEGER, SAVE :: NNESTTH ! Efffect of 2way nesting on Th
INTEGER, SAVE :: NADVTH ! Total advection for PPM
-INTEGER, SAVE :: NADVXTH ! advection along X (all except PPM)
-INTEGER, SAVE :: NADVYTH ! advection along Y (all except PPM)
-INTEGER, SAVE :: NADVZTH ! advection along Z (all except PPM)
INTEGER, SAVE :: NFRCTH ! forcing
INTEGER, SAVE :: N2DADVTH ! 2d advecting forcing
INTEGER, SAVE :: N2DRELTH ! 2d relaxation forcing
@@ -283,9 +274,6 @@ LOGICAL, SAVE :: LBU_RTKE ! True when the budget of RTKE is performed
!
INTEGER, SAVE :: NASSETKE ! time filter
INTEGER, SAVE :: NADVTKE ! Total advection for PPM
-INTEGER, SAVE :: NADVXTKE ! advection along X (all except PPM)
-INTEGER, SAVE :: NADVYTKE ! advection along Y (all except PPM)
-INTEGER, SAVE :: NADVZTKE ! advection along Z (all except PPM)
INTEGER, SAVE :: NFRCTKE ! forcing
INTEGER, SAVE :: NDIFTKE ! numerical diffusion
INTEGER, SAVE :: NRELTKE ! relaxation
@@ -305,9 +293,6 @@ LOGICAL, SAVE :: LBU_RRV ! true when the budget of RRV is performed
INTEGER, SAVE :: NASSERV ! time filter
INTEGER, SAVE :: NNESTRV ! Effect of 2way nesting on Rv
INTEGER, SAVE :: NADVRV ! Total advection for PPM
-INTEGER, SAVE :: NADVXRV ! advection along X (all except PPM)
-INTEGER, SAVE :: NADVYRV ! advection along Y (all except PPM)
-INTEGER, SAVE :: NADVZRV ! advection along Z (all except PPM)
INTEGER, SAVE :: NFRCRV ! forcing
INTEGER, SAVE :: N2DADVRV ! 2d advecting forcing
INTEGER, SAVE :: N2DRELRV ! 2d relaxation forcing
@@ -335,9 +320,6 @@ LOGICAL, SAVE :: LBU_RRC ! True when the budget of RRC is performed
INTEGER, SAVE :: NASSERC ! time filter
INTEGER, SAVE :: NNESTRC ! Efffect of 2way nesting on Rc
INTEGER, SAVE :: NADVRC ! Total advection for PPM
-INTEGER, SAVE :: NADVXRC ! advection along X (all except PPM)
-INTEGER, SAVE :: NADVYRC ! advection along Y (all except PPM)
-INTEGER, SAVE :: NADVZRC ! advection along Z (all except PPM)
INTEGER, SAVE :: NFRCRC ! forcing
INTEGER, SAVE :: NDIFRC ! numerical diffusion
INTEGER, SAVE :: NRELRC ! relaxation
@@ -368,9 +350,6 @@ LOGICAL, SAVE :: LBU_RRR ! True when the budget of RRR is performed
INTEGER, SAVE :: NASSERR ! time filter
INTEGER, SAVE :: NNESTRR ! Efffect of 2way nesting on Rr
INTEGER, SAVE :: NADVRR ! Total advection for PPM
-INTEGER, SAVE :: NADVXRR ! advection along X (all except PPM)
-INTEGER, SAVE :: NADVYRR ! advection along Y (all except PPM)
-INTEGER, SAVE :: NADVZRR ! advection along Z (all except PPM)
INTEGER, SAVE :: NFRCRR ! forcing
INTEGER, SAVE :: NDIFRR ! numerical diffusion
INTEGER, SAVE :: NRELRR ! relaxation
@@ -397,9 +376,6 @@ LOGICAL, SAVE :: LBU_RRI ! True when the budget of RRI is performed
INTEGER, SAVE :: NASSERI ! time filter
INTEGER, SAVE :: NNESTRI ! Efffect of 2way nesting on Ri
INTEGER, SAVE :: NADVRI ! Total advection for PPM
-INTEGER, SAVE :: NADVXRI ! advection along X (all except PPM)
-INTEGER, SAVE :: NADVYRI ! advection along Y (all except PPM)
-INTEGER, SAVE :: NADVZRI ! advection along Z (all except PPM)
INTEGER, SAVE :: NFRCRI ! forcing
INTEGER, SAVE :: NDIFRI ! numerical diffusion
INTEGER, SAVE :: NRELRI ! relaxation
@@ -429,9 +405,6 @@ LOGICAL, SAVE :: LBU_RRS ! True when the budget of RRS is performed
INTEGER, SAVE :: NASSERS ! time filter
INTEGER, SAVE :: NNESTRS ! Efffect of 2way nesting on Rs
INTEGER, SAVE :: NADVRS ! Total advection for PPM
-INTEGER, SAVE :: NADVXRS ! advection along X (all except PPM)
-INTEGER, SAVE :: NADVYRS ! advection along Y (all except PPM)
-INTEGER, SAVE :: NADVZRS ! advection along Z (all except PPM)
INTEGER, SAVE :: NFRCRS ! forcing
INTEGER, SAVE :: NDIFRS ! numerical diffusion
INTEGER, SAVE :: NRELRS ! relaxation
@@ -456,9 +429,6 @@ LOGICAL, SAVE :: LBU_RRG ! True when the budget of RRG is performed
INTEGER, SAVE :: NASSERG ! time filter
INTEGER, SAVE :: NNESTRG ! Efffect of 2way nesting on Rg
INTEGER, SAVE :: NADVRG ! Total advection for PPM
-INTEGER, SAVE :: NADVXRG ! advection along X (all except PPM)
-INTEGER, SAVE :: NADVYRG ! advection along Y (all except PPM)
-INTEGER, SAVE :: NADVZRG ! advection along Z (all except PPM)
INTEGER, SAVE :: NFRCRG ! forcing
INTEGER, SAVE :: NDIFRG ! numerical diffusion
INTEGER, SAVE :: NRELRG ! relaxation
@@ -484,9 +454,6 @@ LOGICAL, SAVE :: LBU_RRH ! True when the budget of RRH is performed
INTEGER, SAVE :: NASSERH ! time filter
INTEGER, SAVE :: NNESTRH ! Efffect of 2way nesting on Rh
INTEGER, SAVE :: NADVRH ! Total advection for PPM
-INTEGER, SAVE :: NADVXRH ! advection along X (all except PPM)
-INTEGER, SAVE :: NADVYRH ! advection along Y (all except PPM)
-INTEGER, SAVE :: NADVZRH ! advection along Z (all except PPM)
INTEGER, SAVE :: NFRCRH ! forcing
INTEGER, SAVE :: NDIFRH ! numerical diffusion
INTEGER, SAVE :: NRELRH ! relaxation
@@ -503,9 +470,6 @@ LOGICAL, SAVE :: LBU_RSV ! True when the budget of RSVx is performed
INTEGER, SAVE :: NASSESV ! Asselin-Robert time filter
INTEGER, SAVE :: NNESTSV ! Efffect of 2way nesting on Sv
INTEGER, SAVE :: NADVSV ! Total advection for PPM
-INTEGER, SAVE :: NADVXSV ! advection along X (all except PPM)
-INTEGER, SAVE :: NADVYSV ! advection along Y (all except PPM)
-INTEGER, SAVE :: NADVZSV ! advection along Z (all except PPM)
INTEGER, SAVE :: NFRCSV ! forcing
INTEGER, SAVE :: NDIFSV ! numerical diffusion
INTEGER, SAVE :: NRELSV ! relaxation
diff --git a/src/MNH/modd_conf.f90 b/src/MNH/modd_conf.f90
index 71e5b94ba..f3213f702 100644
--- a/src/MNH/modd_conf.f90
+++ b/src/MNH/modd_conf.f90
@@ -53,12 +53,8 @@
IMPLICIT NONE
!
CHARACTER (LEN=5),SAVE :: CCONF ! Configuration of models
- ! 'START' for start configuration (variables
- ! at time t and t-dt are the same in the
- ! initial file)
+ ! 'START' for start configuration
! 'RESTART' for restart configuration
- ! (variables at time t and t-dt are different)
- ! 'POST' for post-treatment configuration
LOGICAL,SAVE :: LTHINSHELL ! Logical for thinshell approximation
! .TRUE. = thinshell approximation
! .FALSE. = no thinshell approximation
@@ -118,4 +114,6 @@ LOGICAL,SAVE :: LNEUTRAL ! True if ref. theta field is uniform
!
LOGICAL,SAVE :: LCPL_AROME ! true if coupling file are issued from AROME
!
+LOGICAL,SAVE :: LCHECK ! To test reproducibility
+!
END MODULE MODD_CONF
diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90
index 0f6d36b1d..0161ce516 100644
--- a/src/MNH/modd_fieldn.f90
+++ b/src/MNH/modd_fieldn.f90
@@ -43,6 +43,11 @@
!! 11/04/96 (J.-P. Pinty) add the ice concentration
!! 25/07/97 (J. Stein) Change the variable pressure
!! 20/05/06 Remove EPS
+!! 11/11 (C.Lac) FIT version : Remove t-Dt fields except for
+!! radiative cooling (microphysics) +
+!! add pressure contribution to the tendencies for
+!! momentum (noted _PRES) + microphysics contrib
+!! for Theta and r (noted _CLD)
!!
!-------------------------------------------------------------------------------
!
@@ -53,78 +58,72 @@ USE MODD_PARAMETERS, ONLY: JPMODELMAX
IMPLICIT NONE
TYPE FIELD_t
- REAL, DIMENSION(:,:,:), POINTER :: XUM=>NULL(),XVM=>NULL(),XWM=>NULL()
- ! U,V,W at time t-dt
REAL, DIMENSION(:,:,:), POINTER :: XUT=>NULL(),XVT=>NULL(),XWT=>NULL()
! U,V,W at time t
REAL, DIMENSION(:,:,:), POINTER :: XRUS=>NULL(),XRVS=>NULL(),XRWS=>NULL()
! Source of (rho U), (rho V), (rho w)
- REAL, DIMENSION(:,:,:), POINTER :: XTHM=>NULL() ! (rho theta) at time t-dt
+ REAL, DIMENSION(:,:,:), POINTER :: XRUS_PRES=>NULL(),XRVS_PRES=>NULL(),XRWS_PRES=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTHT=>NULL() ! (rho theta) at time t
REAL, DIMENSION(:,:,:), POINTER :: XRTHS=>NULL() ! Source of (rho theta)
- REAL, DIMENSION(:,:,:), POINTER :: XTKEM=>NULL() ! Kinetic energy
- ! at time t-dt
+ REAL, DIMENSION(:,:,:), POINTER :: XRTHS_CLD=>NULL() ! Source of (rho theta) from resolved_cloud
REAL, DIMENSION(:,:,:), POINTER :: XTKET=>NULL() ! Kinetic energy
! at time t
REAL, DIMENSION(:,:,:), POINTER :: XRTKES=>NULL() ! Source of kinetic energy
! (rho e)
- REAL, DIMENSION(:,:,:), POINTER :: XPABSM=>NULL() ! absolute pressure at
- ! time t-dt
REAL, DIMENSION(:,:,:), POINTER :: XPABST=>NULL() ! absolute pressure at
! time t
- REAL, DIMENSION(:,:,:,:), POINTER :: XRM=>NULL() ! Moist variables
- ! at time t-dt
REAL, DIMENSION(:,:,:,:), POINTER :: XRT=>NULL() ! Moist variables (rho Rn)
! at time t
REAL, DIMENSION(:,:,:,:), POINTER :: XRRS=>NULL() ! Source of Moist variables
! (rho Rn)
- REAL, DIMENSION(:,:,:,:), POINTER :: XSVM=>NULL() ! Additionnal scalar
- ! variables at time t-dt
+ REAL, DIMENSION(:,:,:,:), POINTER :: XRRS_CLD=>NULL() ! Source of Moist variables
REAL, DIMENSION(:,:,:,:), POINTER :: XSVT=>NULL() ! Additionnal scalar
! variables at time t
REAL, DIMENSION(:,:,:,:), POINTER :: XRSVS=>NULL() ! Source of addi. scalar
! variables (rho Sn.)
+ REAL, DIMENSION(:,:,:,:), POINTER :: XRSVS_CLD=>NULL() ! Source of (rho Sn) from resolved_cloud
REAL :: XDRYMASST ! Mass of dry air Md
REAL :: XDRYMASSS ! LS sources of Md
REAL, DIMENSION(:,:,:), POINTER :: XSRC=>NULL() ! turbulent flux <s'Rc'>
REAL, DIMENSION(:,:,:), POINTER :: XSIGS=>NULL() ! =sqrt(<s's'>) for the
! Subgrid Condensation
REAL, DIMENSION(:,:,:), POINTER :: XCLDFR=>NULL() ! cloud fraction
- REAL, DIMENSION(:,:,:), POINTER :: XSRCM=>NULL() ! turbulent flux <s'Rc'>
- ! at t- delta t
REAL, DIMENSION(:,:,:), POINTER :: XSRCT=>NULL() ! turbulent flux <s'Rc'>
! at t
REAL, DIMENSION(:,:,:), POINTER :: XCIT=>NULL() ! Pristine ice concentration
+ REAL, DIMENSION(:,:,:), POINTER :: XTHM=>NULL() ! Theta at Previous time step
+ REAL, DIMENSION(:,:,:), POINTER :: XRCM=>NULL() ! Cloud mixing ratio at Previous time step
+ REAL, DIMENSION(:,:,:), POINTER :: XPABSM=>NULL() ! Theta at Previous time step
!
END TYPE FIELD_t
TYPE(FIELD_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: FIELD_MODEL
-REAL, DIMENSION(:,:,:), POINTER :: XUM=>NULL(),XVM=>NULL(),XWM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XUT=>NULL(),XVT=>NULL(),XWT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRUS=>NULL(),XRVS=>NULL(),XRWS=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XTHM=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XRUS_PRES=>NULL(),XRVS_PRES=>NULL(),XRWS_PRES=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTHT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRTHS=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XTKEM=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XRTHS_CLD=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTKET=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRTKES=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XPABSM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABST=>NULL()
-REAL, DIMENSION(:,:,:,:), POINTER :: XRM=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER :: XRT=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER :: XRRS=>NULL()
-REAL, DIMENSION(:,:,:,:), POINTER :: XSVM=>NULL()
+REAL, DIMENSION(:,:,:,:), POINTER :: XRRS_CLD=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER :: XSVT=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER :: XRSVS=>NULL()
+REAL, DIMENSION(:,:,:,:), POINTER :: XRSVS_CLD=>NULL()
REAL, POINTER :: XDRYMASST=>NULL()
REAL, POINTER :: XDRYMASSS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSRC=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSIGS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XCLDFR=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XSRCM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSRCT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XCIT=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XTHM=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XPABSM=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XRCM=>NULL()
CONTAINS
@@ -132,68 +131,68 @@ SUBROUTINE FIELD_GOTO_MODEL(KFROM, KTO)
INTEGER, INTENT(IN) :: KFROM, KTO
!
! Save current state for allocated arrays
-FIELD_MODEL(KFROM)%XUM=>XUM
-FIELD_MODEL(KFROM)%XVM=>XVM
-FIELD_MODEL(KFROM)%XWM=>XWM
FIELD_MODEL(KFROM)%XUT=>XUT
FIELD_MODEL(KFROM)%XVT=>XVT
FIELD_MODEL(KFROM)%XWT=>XWT
FIELD_MODEL(KFROM)%XRUS=>XRUS
FIELD_MODEL(KFROM)%XRVS=>XRVS
FIELD_MODEL(KFROM)%XRWS=>XRWS
-FIELD_MODEL(KFROM)%XTHM=>XTHM
+FIELD_MODEL(KFROM)%XRUS_PRES=>XRUS_PRES
+FIELD_MODEL(KFROM)%XRVS_PRES=>XRVS_PRES
+FIELD_MODEL(KFROM)%XRWS_PRES=>XRWS_PRES
FIELD_MODEL(KFROM)%XTHT=>XTHT
FIELD_MODEL(KFROM)%XRTHS=>XRTHS
-FIELD_MODEL(KFROM)%XTKEM=>XTKEM
+FIELD_MODEL(KFROM)%XRTHS_CLD=>XRTHS_CLD
FIELD_MODEL(KFROM)%XTKET=>XTKET
FIELD_MODEL(KFROM)%XRTKES=>XRTKES
-FIELD_MODEL(KFROM)%XPABSM=>XPABSM
FIELD_MODEL(KFROM)%XPABST=>XPABST
-FIELD_MODEL(KFROM)%XRM=>XRM
FIELD_MODEL(KFROM)%XRT=>XRT
FIELD_MODEL(KFROM)%XRRS=>XRRS
-FIELD_MODEL(KFROM)%XSVM=>XSVM
+FIELD_MODEL(KFROM)%XRRS_CLD=>XRRS_CLD
FIELD_MODEL(KFROM)%XSVT=>XSVT
FIELD_MODEL(KFROM)%XRSVS=>XRSVS
+FIELD_MODEL(KFROM)%XRSVS_CLD=>XRSVS_CLD
FIELD_MODEL(KFROM)%XSRC=>XSRC
FIELD_MODEL(KFROM)%XSIGS=>XSIGS
FIELD_MODEL(KFROM)%XCLDFR=>XCLDFR
-FIELD_MODEL(KFROM)%XSRCM=>XSRCM
FIELD_MODEL(KFROM)%XSRCT=>XSRCT
FIELD_MODEL(KFROM)%XCIT=>XCIT
+FIELD_MODEL(KFROM)%XTHM=>XTHM
+FIELD_MODEL(KFROM)%XPABSM=>XPABSM
+FIELD_MODEL(KFROM)%XRCM=>XRCM
!
! Current model is set to model KTO
-XUM=>FIELD_MODEL(KTO)%XUM
-XVM=>FIELD_MODEL(KTO)%XVM
-XWM=>FIELD_MODEL(KTO)%XWM
XUT=>FIELD_MODEL(KTO)%XUT
XVT=>FIELD_MODEL(KTO)%XVT
XWT=>FIELD_MODEL(KTO)%XWT
XRUS=>FIELD_MODEL(KTO)%XRUS
XRVS=>FIELD_MODEL(KTO)%XRVS
XRWS=>FIELD_MODEL(KTO)%XRWS
-XTHM=>FIELD_MODEL(KTO)%XTHM
+XRUS_PRES=>FIELD_MODEL(KTO)%XRUS_PRES
+XRVS_PRES=>FIELD_MODEL(KTO)%XRVS_PRES
+XRWS_PRES=>FIELD_MODEL(KTO)%XRWS_PRES
XTHT=>FIELD_MODEL(KTO)%XTHT
XRTHS=>FIELD_MODEL(KTO)%XRTHS
-XTKEM=>FIELD_MODEL(KTO)%XTKEM
+XRTHS_CLD=>FIELD_MODEL(KTO)%XRTHS_CLD
XTKET=>FIELD_MODEL(KTO)%XTKET
XRTKES=>FIELD_MODEL(KTO)%XRTKES
-XPABSM=>FIELD_MODEL(KTO)%XPABSM
XPABST=>FIELD_MODEL(KTO)%XPABST
-XRM=>FIELD_MODEL(KTO)%XRM
XRT=>FIELD_MODEL(KTO)%XRT
XRRS=>FIELD_MODEL(KTO)%XRRS
-XSVM=>FIELD_MODEL(KTO)%XSVM
+XRRS_CLD=>FIELD_MODEL(KTO)%XRRS_CLD
XSVT=>FIELD_MODEL(KTO)%XSVT
XRSVS=>FIELD_MODEL(KTO)%XRSVS
+XRSVS_CLD=>FIELD_MODEL(KTO)%XRSVS_CLD
XDRYMASST=>FIELD_MODEL(KTO)%XDRYMASST
XDRYMASSS=>FIELD_MODEL(KTO)%XDRYMASSS
XSRC=>FIELD_MODEL(KTO)%XSRC
XSIGS=>FIELD_MODEL(KTO)%XSIGS
XCLDFR=>FIELD_MODEL(KTO)%XCLDFR
-XSRCM=>FIELD_MODEL(KTO)%XSRCM
XSRCT=>FIELD_MODEL(KTO)%XSRCT
XCIT=>FIELD_MODEL(KTO)%XCIT
+XTHM=>FIELD_MODEL(KTO)%XTHM
+XPABSM=>FIELD_MODEL(KTO)%XPABSM
+XRCM=>FIELD_MODEL(KTO)%XRCM
END SUBROUTINE FIELD_GOTO_MODEL
diff --git a/src/MNH/modd_getn.f90 b/src/MNH/modd_getn.f90
index 414a01219..22135986b 100644
--- a/src/MNH/modd_getn.f90
+++ b/src/MNH/modd_getn.f90
@@ -58,27 +58,23 @@ IMPLICIT NONE
TYPE GET_t
!
- CHARACTER (LEN=4) :: CGETUM, CGETVM, CGETWM ! Get indicator for
- ! U,V,W at time t-dt
CHARACTER (LEN=4) :: CGETUT, CGETVT, CGETWT ! Get indicator for
! U,V,W at time t
- CHARACTER (LEN=4) :: CGETTHM,CGETTHT ! Get indicator for theta
+ CHARACTER (LEN=4) :: CGETTHT ! Get indicator for theta
! at time t-dt and at time t
- CHARACTER (LEN=4) :: CGETPABSM, CGETPABST ! Get indicator for
+ CHARACTER (LEN=4) :: CGETPABST ! Get indicator for
! the absolute pressure at
! time t-dt and t
- CHARACTER (LEN=4) :: CGETTKEM,CGETTKET ! Get indicator for TKE
+ CHARACTER (LEN=4) :: CGETTKET ! Get indicator for TKE
! at time t-dt and at time t
- CHARACTER (LEN=4) :: CGETRVM,CGETRCM,CGETRRM ! Get indicator for Rv
- CHARACTER (LEN=4) :: CGETRIM,CGETRSM,CGETRGM ! Rc,Rr,Ri,Rs,Rg,Rh
- CHARACTER (LEN=4) :: CGETRHM ! at time t-dt
CHARACTER (LEN=4) :: CGETRVT,CGETRCT,CGETRRT ! Get indicator for Rv
CHARACTER (LEN=4) :: CGETRIT,CGETRST,CGETRGT ! Rc,Rr,Ri,Rs,Rg,Rh
CHARACTER (LEN=4) :: CGETRHT ! at time t
-!JUAN
- CHARACTER (LEN=4), DIMENSION(:), POINTER :: CGETSVM=>NULL(),CGETSVT=>NULL() ! Get indicator
- ! for the Scalar Var. at time t-dt and t
-!JUAN
+ CHARACTER (LEN=4) :: CGETINPRC,CGETINPRR,CGETINPRS ! Get indicator for
+ ! 2D precip fields
+ CHARACTER (LEN=4) :: CGETINPRG,CGETINPRH
+ CHARACTER (LEN=4), DIMENSION(:), POINTER :: CGETSVT=>NULL() ! Get indicator
+ ! for the Scalar Var. at time t
CHARACTER (LEN=4) :: CGETLSUM, CGETLSVM, CGETLSWM ! Get indicator for
! U,V,W for Larger Scales at time t-dt
CHARACTER (LEN=4) :: CGETLSTHM, CGETLSRVM ! Get indicator for
@@ -87,7 +83,7 @@ TYPE GET_t
! and SRC related to the subgrid condensation
CHARACTER (LEN=4) :: CGETCLDFR ! Get indicator for the
! CLouD FRaction
- CHARACTER (LEN=4) :: CGETSRCM, CGETSRCT ! Get indicator for SRCM
+ CHARACTER (LEN=4) :: CGETSRCT ! Get indicator for SRCM
! and SRCT related to the subgrid condensation
CHARACTER (LEN=4) :: CGETCIT ! Get indicator for the
! primary ice concentration
@@ -107,23 +103,21 @@ END TYPE GET_t
TYPE(GET_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: GET_MODEL
LOGICAL , DIMENSION(JPMODELMAX), SAVE :: GET_FIRST_CALL = .TRUE.
-CHARACTER (LEN=4), POINTER :: CGETUM=>NULL(), CGETVM=>NULL(), CGETWM=>NULL()
CHARACTER (LEN=4), POINTER :: CGETUT=>NULL(), CGETVT=>NULL(), CGETWT=>NULL()
-CHARACTER (LEN=4), POINTER :: CGETTHM=>NULL(),CGETTHT=>NULL()
-CHARACTER (LEN=4), POINTER :: CGETPABSM=>NULL(), CGETPABST=>NULL()
-CHARACTER (LEN=4), POINTER :: CGETTKEM=>NULL(),CGETTKET=>NULL()
-CHARACTER (LEN=4), POINTER :: CGETRVM=>NULL(),CGETRCM=>NULL(),CGETRRM=>NULL()
-CHARACTER (LEN=4), POINTER :: CGETRIM=>NULL(),CGETRSM=>NULL(),CGETRGM=>NULL()
-CHARACTER (LEN=4), POINTER :: CGETRHM=>NULL()
+CHARACTER (LEN=4), POINTER :: CGETTHT=>NULL()
+CHARACTER (LEN=4), POINTER :: CGETPABST=>NULL()
+CHARACTER (LEN=4), POINTER :: CGETTKET=>NULL()
CHARACTER (LEN=4), POINTER :: CGETRVT=>NULL(),CGETRCT=>NULL(),CGETRRT=>NULL()
CHARACTER (LEN=4), POINTER :: CGETRIT=>NULL(),CGETRST=>NULL(),CGETRGT=>NULL()
CHARACTER (LEN=4), POINTER :: CGETRHT=>NULL()
-CHARACTER (LEN=4), DIMENSION(:), POINTER :: CGETSVM=>NULL(),CGETSVT=>NULL()
+CHARACTER (LEN=4), POINTER :: CGETINPRC=>NULL(), CGETINPRR=>NULL(), CGETINPRS=>NULL()
+CHARACTER (LEN=4), POINTER :: CGETINPRG=>NULL(), CGETINPRH=>NULL()
+CHARACTER (LEN=4), DIMENSION(:), POINTER :: CGETSVT=>NULL()
CHARACTER (LEN=4), POINTER :: CGETLSUM=>NULL(), CGETLSVM=>NULL(), CGETLSWM=>NULL()
CHARACTER (LEN=4), POINTER :: CGETLSTHM=>NULL(), CGETLSRVM=>NULL()
CHARACTER (LEN=4), POINTER :: CGETSIGS=>NULL(),CGETSRC=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCLDFR=>NULL()
-CHARACTER (LEN=4), POINTER :: CGETSRCM=>NULL(), CGETSRCT=>NULL()
+CHARACTER (LEN=4), POINTER :: CGETSRCT=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCIT=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCONV=>NULL()
CHARACTER (LEN=4), POINTER :: CGETRAD=>NULL()
@@ -140,7 +134,6 @@ INTEGER, INTENT(IN) :: KFROM, KTO
!
!JUAN
IF (GET_FIRST_CALL(KTO)) THEN
-ALLOCATE (GET_MODEL(KTO)%CGETSVM(JPSVMAX))
ALLOCATE (GET_MODEL(KTO)%CGETSVT(JPSVMAX))
GET_FIRST_CALL(KTO) = .FALSE.
ENDIF
@@ -149,25 +142,12 @@ ENDIF
! Save current state for allocated arrays
!
! Current model is set to model KTO
-CGETUM=>GET_MODEL(KTO)%CGETUM
-CGETVM=>GET_MODEL(KTO)%CGETVM
-CGETWM=>GET_MODEL(KTO)%CGETWM
CGETUT=>GET_MODEL(KTO)%CGETUT
CGETVT=>GET_MODEL(KTO)%CGETVT
CGETWT=>GET_MODEL(KTO)%CGETWT
-CGETTHM=>GET_MODEL(KTO)%CGETTHM
CGETTHT=>GET_MODEL(KTO)%CGETTHT
-CGETPABSM=>GET_MODEL(KTO)%CGETPABSM
CGETPABST=>GET_MODEL(KTO)%CGETPABST
-CGETTKEM=>GET_MODEL(KTO)%CGETTKEM
CGETTKET=>GET_MODEL(KTO)%CGETTKET
-CGETRVM=>GET_MODEL(KTO)%CGETRVM
-CGETRCM=>GET_MODEL(KTO)%CGETRCM
-CGETRRM=>GET_MODEL(KTO)%CGETRRM
-CGETRIM=>GET_MODEL(KTO)%CGETRIM
-CGETRSM=>GET_MODEL(KTO)%CGETRSM
-CGETRGM=>GET_MODEL(KTO)%CGETRGM
-CGETRHM=>GET_MODEL(KTO)%CGETRHM
CGETRVT=>GET_MODEL(KTO)%CGETRVT
CGETRCT=>GET_MODEL(KTO)%CGETRCT
CGETRRT=>GET_MODEL(KTO)%CGETRRT
@@ -175,7 +155,11 @@ CGETRIT=>GET_MODEL(KTO)%CGETRIT
CGETRST=>GET_MODEL(KTO)%CGETRST
CGETRGT=>GET_MODEL(KTO)%CGETRGT
CGETRHT=>GET_MODEL(KTO)%CGETRHT
-CGETSVM=>GET_MODEL(KTO)%CGETSVM
+CGETINPRC=>GET_MODEL(KTO)%CGETINPRC
+CGETINPRR=>GET_MODEL(KTO)%CGETINPRR
+CGETINPRS=>GET_MODEL(KTO)%CGETINPRS
+CGETINPRG=>GET_MODEL(KTO)%CGETINPRG
+CGETINPRH=>GET_MODEL(KTO)%CGETINPRH
CGETSVT=>GET_MODEL(KTO)%CGETSVT
CGETLSUM=>GET_MODEL(KTO)%CGETLSUM
CGETLSVM=>GET_MODEL(KTO)%CGETLSVM
@@ -185,7 +169,6 @@ CGETLSRVM=>GET_MODEL(KTO)%CGETLSRVM
CGETSIGS=>GET_MODEL(KTO)%CGETSIGS
CGETSRC=>GET_MODEL(KTO)%CGETSRC
CGETCLDFR=>GET_MODEL(KTO)%CGETCLDFR
-CGETSRCM=>GET_MODEL(KTO)%CGETSRCM
CGETSRCT=>GET_MODEL(KTO)%CGETSRCT
CGETCIT=>GET_MODEL(KTO)%CGETCIT
CGETCONV=>GET_MODEL(KTO)%CGETCONV
diff --git a/src/MNH/modd_les_budget.f90 b/src/MNH/modd_les_budget.f90
index 7f1d9c96c..19c00aca4 100644
--- a/src/MNH/modd_les_budget.f90
+++ b/src/MNH/modd_les_budget.f90
@@ -48,9 +48,7 @@ REAL :: XTIME_LES_BU_PROCESS
! time spent in subgrid LES computations in this time-step for budgets
! for this process only (advection, microphysics, etc...)
!
-REAL :: XCURRENT_TSTEP_UVW
-REAL :: XCURRENT_TSTEP_MET
-REAL :: XCURRENT_TSTEP_SV
+REAL :: XCURRENT_TSTEP
!-------------------------------------------------------------------------------
!
!* variables of current model needed in budget computations
@@ -111,8 +109,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: X_LES_BU_SBG_Tke
!
!* index for each processus taken into account in the budgets
!
-INTEGER :: NLES_TOTADVH
-INTEGER :: NLES_TOTADVV
+INTEGER :: NLES_TOTADV
INTEGER :: NLES_RELA
INTEGER :: NLES_RAD
INTEGER :: NLES_GRAV
diff --git a/src/MNH/modd_past_fieldn.f90 b/src/MNH/modd_past_fieldn.f90
new file mode 100644
index 000000000..0930cc843
--- /dev/null
+++ b/src/MNH/modd_past_fieldn.f90
@@ -0,0 +1,81 @@
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 modd 2006/06/27 14:17:24
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODD_PAST_FIELD_n
+! ###################
+!
+!!**** *MODD_PAST_FIELD$n* - declaration of prognostic variables
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to specify the
+! prognostic variables.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_PAST_FIELDn)
+!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2013
+
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+
+TYPE FIELD_t
+ REAL, DIMENSION(:,:,:), POINTER :: XUM=>NULL(),XVM=>NULL(),XWM=>NULL()
+ ! U,V,W at time t-dt
+ REAL, DIMENSION(:,:,:), POINTER :: XDUM=>NULL(),XDVM=>NULL(),XDWM=>NULL()
+!
+END TYPE FIELD_t
+
+TYPE(FIELD_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: FIELD_MODEL
+
+REAL, DIMENSION(:,:,:), POINTER :: XUM=>NULL(),XVM=>NULL(),XWM=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XDUM=>NULL(),XDVM=>NULL(),XDWM=>NULL()
+
+CONTAINS
+
+SUBROUTINE PAST_FIELD_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+FIELD_MODEL(KFROM)%XUM=>XUM
+FIELD_MODEL(KFROM)%XVM=>XVM
+FIELD_MODEL(KFROM)%XWM=>XWM
+FIELD_MODEL(KFROM)%XDUM=>XDUM
+FIELD_MODEL(KFROM)%XDVM=>XDVM
+FIELD_MODEL(KFROM)%XDWM=>XDWM
+!
+! Current model is set to model KTO
+XUM=>FIELD_MODEL(KTO)%XUM
+XVM=>FIELD_MODEL(KTO)%XVM
+XWM=>FIELD_MODEL(KTO)%XWM
+XDUM=>FIELD_MODEL(KTO)%XDUM
+XDVM=>FIELD_MODEL(KTO)%XDVM
+XDWM=>FIELD_MODEL(KTO)%XDWM
+
+END SUBROUTINE PAST_FIELD_GOTO_MODEL
+
+END MODULE MODD_PAST_FIELD_n
diff --git a/src/MNH/modd_sub_modeln.f90 b/src/MNH/modd_sub_modeln.f90
index 0bec31b55..387496fe3 100644
--- a/src/MNH/modd_sub_modeln.f90
+++ b/src/MNH/modd_sub_modeln.f90
@@ -31,6 +31,7 @@ TYPE SUB_MODEL_t
REAL*8,DIMENSION(2) :: XT_START
REAL*8,DIMENSION(2) :: XT_STORE,XT_BOUND,XT_GUESS
REAL*8,DIMENSION(2) :: XT_ADV,XT_SOURCES,XT_DRAG
+ REAL*8,DIMENSION(2) :: XT_ADVUVW,XT_GRAV
REAL*8,DIMENSION(2) :: XT_DIFF,XT_RELAX,XT_PARAM,XT_SPECTRA
REAL*8,DIMENSION(2) :: XT_HALO,XT_RAD_BOUND,XT_PRESS
REAL*8,DIMENSION(2) :: XT_CLOUD,XT_STEP_SWA,XT_STEP_MISC
@@ -39,7 +40,7 @@ TYPE SUB_MODEL_t
REAL*8,DIMENSION(2) :: XT_RAD,XT_DCONV,XT_GROUND,XT_TRACER,XT_MAFL
REAL*8,DIMENSION(2) :: XT_TURB,XT_2WAY,XT_SHADOWS
REAL*8,DIMENSION(2) :: XT_FORCING,XT_NUDGING,XT_CHEM
-!
+
REAL, DIMENSION(:,:,:), POINTER :: ZWT_ACT_NUC=>NULL()
! Vertical motion used for ACTivation/NUCleation
LOGICAL, DIMENSION(:,:), POINTER :: GMASKkids=>NULL() ! kids domains mask
@@ -57,6 +58,7 @@ INTEGER, POINTER :: IOUT=>NULL()
REAL*8,DIMENSION(:), POINTER :: XT_START=>NULL()
REAL*8,DIMENSION(:), POINTER :: XT_STORE=>NULL(),XT_BOUND=>NULL(),XT_GUESS=>NULL()
REAL*8,DIMENSION(:), POINTER :: XT_ADV=>NULL(),XT_SOURCES=>NULL(),XT_DRAG=>NULL()
+REAL*8,DIMENSION(:), POINTER :: XT_ADVUVW=>NULL(),XT_GRAV=>NULL()
REAL*8,DIMENSION(:), POINTER :: XT_DIFF=>NULL(),XT_RELAX=>NULL(),XT_PARAM=>NULL(),XT_SPECTRA=>NULL()
REAL*8,DIMENSION(:), POINTER :: XT_HALO=>NULL(),XT_RAD_BOUND=>NULL(),XT_PRESS=>NULL()
REAL*8,DIMENSION(:), POINTER :: XT_CLOUD=>NULL(),XT_STEP_SWA=>NULL(),XT_STEP_MISC=>NULL()
@@ -107,6 +109,8 @@ XT_STORE=>SUB_MODEL_MODEL(KTO)%XT_STORE
XT_BOUND=>SUB_MODEL_MODEL(KTO)%XT_BOUND
XT_GUESS=>SUB_MODEL_MODEL(KTO)%XT_GUESS
XT_ADV=>SUB_MODEL_MODEL(KTO)%XT_ADV
+XT_ADVUVW=>SUB_MODEL_MODEL(KTO)%XT_ADVUVW
+XT_GRAV=>SUB_MODEL_MODEL(KTO)%XT_GRAV
XT_SOURCES=>SUB_MODEL_MODEL(KTO)%XT_SOURCES
XT_DRAG=>SUB_MODEL_MODEL(KTO)%XT_DRAG
XT_DIFF=>SUB_MODEL_MODEL(KTO)%XT_DIFF
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 344190c08..ee6754b46 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -2,11 +2,10 @@
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$
-! masdev4_7 BUG1 2007/06/15 17:47:18
!-----------------------------------------------------------------
-! #################
+! ###################
MODULE MODI_MODEL_n
-! #################
+! ###################
!
INTERFACE
!
@@ -220,7 +219,8 @@ END MODULE MODI_MODEL_n
!! 10/11/2009 (P. Aumond) Add mean moments
!! Nov, 12, 2009 (C. Barthe) add cloud electrification and lightning flashes
!! July 2010 (M. Leriche) add ice phase chemical species
-!!
+!! April 2011 (C.Lac) : Remove instant M
+!! April 2011 (C.Lac, V.Masson) : Time splitting for advection
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -263,6 +263,7 @@ USE MODD_DYN_n
USE MODD_DYNZD_n
USE MODD_ADV_n
USE MODD_FIELD_n
+USE MODD_PAST_FIELD_n
USE MODD_MEAN_FIELD_n
USE MODD_MEAN_FIELD
USE MODD_LSFIELD_n
@@ -294,7 +295,10 @@ USE MODD_CLOUD_MF_n
USE MODI_INITIAL_GUESS
USE MODI_MEAN_FIELD
USE MODI_BOUNDARIES
-USE MODI_ADVECTION
+USE MODI_ADVECTION_METSV
+USE MODI_ADVECTION_UVW
+USE MODI_ADVECTION_UVW_CEN
+USE MODI_GRAVITY_IMPL
USE MODI_DYN_SOURCES
USE MODI_RELAXATION
USE MODI_NUM_DIFF
@@ -362,6 +366,7 @@ USE MODI_LES_N
USE MODN_NCOUT
USE MODE_UTIL
#endif
+USE MODI_GET_HALO
!
IMPLICIT NONE
!
@@ -376,6 +381,7 @@ LOGICAL, INTENT(INOUT):: OEXIT
!
INTEGER :: ILUOUT ! Logical unit number for the output listing
INTEGER :: IIU,IJU,IKU ! array size in first, second and third dimensions
+INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! index values for the physical subdomain
INTEGER :: JSV,JRR ! Loop index for scalar and moist variables
CHARACTER (LEN=28) :: YFMFILE ! name of the OUTPUT FM-file
CHARACTER (LEN=28) :: YDADFILE ! name of the corresponding DAD model OUTPUT FM-file
@@ -465,6 +471,14 @@ REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XRM,DPTR_XSVM,DPTR_XRRS,DPTR_XRSVS
REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG
REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV
LOGICAL, DIMENSION(:,:),POINTER :: DPTR_GMASKkids
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZRUS,ZRVS,ZRWS
+!
+! for various testing
+INTEGER :: IK
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZTMP
+!
+TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange
+TYPE(HALO2LIST_ll), POINTER :: TZHALO2C_ll ! list of fields to exchange
!
!-------------------------------------------------------------------------------
!
@@ -473,24 +487,6 @@ LOGICAL, DIMENSION(:,:),POINTER :: DPTR_GMASKkids
ITYPE = 1
IMI = GET_CURRENT_MODEL_INDEX()
!
-IF ((CCONF=='START').AND.(KTCOUNT==1)) THEN
- ZTSTEP_UVW = XTSTEP
-ELSE
- ZTSTEP_UVW = 2.*XTSTEP
-END IF
-!
-IF (CMET_ADV_SCHEME(1:3) == 'PPM') THEN
- ZTSTEP_MET = XTSTEP
-ELSE
- ZTSTEP_MET = 2.*XTSTEP
-END IF
-!
-IF (CSV_ADV_SCHEME(1:3) == 'PPM') THEN
- ZTSTEP_SV = XTSTEP
-ELSE
- ZTSTEP_SV = 2.*XTSTEP
-END IF
-!
!* 1.0 update NSV_* variables for current model
! ----------------------------------------
!
@@ -504,6 +500,9 @@ CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
!
CALL GET_DIM_EXT_ll('B',IIU,IJU)
IKU=NKMAX+2*JPVEXT
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=IKU-JPVEXT
!
IF (IMI==1) THEN
GSTEADY_DMASS=LSTEADYLS
@@ -515,15 +514,10 @@ END IF
!
IF (KTCOUNT == 1) THEN
!
- NULLIFY(TZFIELDS_ll,TZLSFIELD_ll,TZFIELDM_ll)
- NULLIFY(TZHALO2M_ll)
- NULLIFY(TZLSHALO2_ll)
- NULLIFY(TZFIELDT_ll)
+ NULLIFY(TZFIELDS_ll,TZLSFIELD_ll,TZFIELDT_ll)
NULLIFY(TZHALO2T_ll)
- NULLIFY(TZFIELDMT_ll)
- NULLIFY(TZHALO2MT_ll)
+ NULLIFY(TZLSHALO2_ll)
NULLIFY(TZFIELDSC_ll)
- NULLIFY(TZHALO2SC_ll)
!
ALLOCATE(ZWT_ACT_NUC(SIZE(XWT,1),SIZE(XWT,2),SIZE(XWT,3)))
ALLOCATE(GMASKkids(SIZE(XWT,1),SIZE(XWT,2)))
@@ -557,14 +551,20 @@ IF (KTCOUNT == 1) THEN
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRVS)
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRWS)
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRTHS)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XRUS_PRES)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XRVS_PRES)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XRWS_PRES)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XRTHS_CLD)
IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll(TZFIELDS_ll, XRTKES)
DO JRR=1,NRR
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRRS(:,:,:,JRR))
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XRRS_CLD(:,:,:,JRR))
ENDDO
DO JSV=1,NSV
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRSVS(:,:,:,JSV))
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XRSVS_CLD(:,:,:,JSV))
ENDDO
- IF (SIZE(XSRCM,1) /= 0) CALL ADD3DFIELD_ll(TZFIELDS_ll, XSRCM)
+ IF (SIZE(XSRCT,1) /= 0) CALL ADD3DFIELD_ll(TZFIELDS_ll, XSRCT)
!
IF ((LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) .AND. NHALO==1 ) THEN
!
@@ -578,25 +578,25 @@ IF (KTCOUNT == 1) THEN
CALL ADD3DFIELD_ll(TZLSFIELD_ll, XLSRVM)
ENDIF
!
- ! c) Fields at t-dt
+ ! c) Fields at t
!
- CALL ADD3DFIELD_ll(TZFIELDM_ll, XUM)
- CALL ADD3DFIELD_ll(TZFIELDM_ll, XVM)
- CALL ADD3DFIELD_ll(TZFIELDM_ll, XWM)
- CALL ADD3DFIELD_ll(TZFIELDM_ll, XTHM)
- IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll(TZFIELDM_ll, XTKEM)
+ CALL ADD3DFIELD_ll(TZFIELDT_ll, XUT)
+ CALL ADD3DFIELD_ll(TZFIELDT_ll, XVT)
+ CALL ADD3DFIELD_ll(TZFIELDT_ll, XWT)
+ CALL ADD3DFIELD_ll(TZFIELDT_ll, XTHT)
+ IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll(TZFIELDT_ll, XTKET)
DO JRR=1,NRR
- CALL ADD3DFIELD_ll(TZFIELDM_ll, XRM(:,:,:,JRR))
+ CALL ADD3DFIELD_ll(TZFIELDT_ll, XRT(:,:,:,JRR))
ENDDO
DO JSV=1,NSV
- CALL ADD3DFIELD_ll(TZFIELDM_ll, XSVM(:,:,:,JSV))
+ CALL ADD3DFIELD_ll(TZFIELDT_ll, XSVT(:,:,:,JSV))
ENDDO
!
!* 1.5 Initialize the list of fields for the halo updates (2nd layer)
!
INBVAR = 4+NRR+NSV
IF (SIZE(XRTKES,1) /= 0) INBVAR=INBVAR+1
- IF( NHALO==1 ) CALL INIT_HALO2_ll(TZHALO2M_ll,INBVAR,IIU,IJU,IKU)
+ IF( NHALO==1 ) CALL INIT_HALO2_ll(TZHALO2T_ll,INBVAR,IIU,IJU,IKU)
IF( NHALO==1 ) CALL INIT_HALO2_ll(TZLSHALO2_ll,4+MIN(1,NRR),IIU,IJU,IKU)
!
!* 1.6 Initialise the 2nd layer of the halo of the LS fields
@@ -604,44 +604,6 @@ IF (KTCOUNT == 1) THEN
IF ( LSTEADYLS .AND. NHALO==1 ) CALL UPDATE_HALO2_ll(TZLSFIELD_ll, TZLSHALO2_ll, IINFO_ll)
END IF
!
- ! 1.7 Initialize the list of fields (2nd layer) time t if 4th order
-! advection schemes are used
-!
- IF( CUVW_ADV_SCHEME == "CEN4TH" .AND. NHALO==1 ) THEN
-!
- CALL ADD3DFIELD_ll(TZFIELDMT_ll, XUT)
- CALL ADD3DFIELD_ll(TZFIELDMT_ll, XVT)
- CALL ADD3DFIELD_ll(TZFIELDMT_ll, XWT)
-!
- INBVAR = 3
- IF( NHALO==1 ) CALL INIT_HALO2_ll(TZHALO2MT_ll,INBVAR,IIU,IJU,IKU)
-!
- END IF
-!
- IF( CMET_ADV_SCHEME == "CEN4TH" .AND. NHALO==1 ) THEN
-!
- CALL ADD3DFIELD_ll(TZFIELDT_ll, XTHT)
- IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll(TZFIELDT_ll, XTKET)
- DO JRR=1,NRR
- CALL ADD3DFIELD_ll(TZFIELDT_ll, XRT(:,:,:,JRR))
- ENDDO
-!
- INBVAR = 1+NRR
- IF (SIZE(XRTKES,1) /= 0) INBVAR=INBVAR+1
- IF( NHALO==1 ) CALL INIT_HALO2_ll(TZHALO2T_ll,INBVAR,IIU,IJU,IKU)
-!
- END IF
-!
- IF( CSV_ADV_SCHEME == "CEN4TH" .AND. NHALO==1 ) THEN
-!
- DO JSV=1,NSV
- CALL ADD3DFIELD_ll(TZFIELDSC_ll, XSVT(:,:,:,JSV))
- ENDDO
-
- INBVAR = NSV
- IF( NHALO==1 ) CALL INIT_HALO2_ll(TZHALO2SC_ll,INBVAR,IIU,IJU,IKU)
-!
- END IF
!
!
XT_START = 0.0
@@ -652,6 +614,8 @@ IF (KTCOUNT == 1) THEN
XT_FORCING = 0.0
XT_NUDGING = 0.0
XT_ADV = 0.0
+ XT_ADVUVW = 0.0
+ XT_GRAV = 0.0
XT_SOURCES = 0.0
!
XT_DIFF = 0.0
@@ -849,8 +813,7 @@ CALL BOUNDARIES ( &
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
XRHODJ, &
- XUM, XVM, XWM, XTHM, XTKEM, XRM, XSVM,XSRCM, &
- XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT )
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -935,7 +898,7 @@ DO JOUT = 1,NOUT_NUMB
!
! Reinitialize Lagragian variables at every model output
IF (LLG .AND. LINIT_LG .AND. CINIT_LG=='FMOUT') THEN
- CALL INI_LG(XXHAT,XYHAT,XZZ,XSVM,XSVT,XLBXSVM,XLBYSVM)
+ CALL INI_LG(XXHAT,XYHAT,XZZ,XSVT,XLBXSVM,XLBYSVM)
IF (NVERB>=5) THEN
WRITE(UNIT=ILUOUT,FMT=*) '************************************'
WRITE(UNIT=ILUOUT,FMT=*) '*** Lagrangian variables refreshed after ',TRIM(YFMFILE),' output'
@@ -1004,12 +967,9 @@ XTIME_BU = 0.0
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
!
-CALL INITIAL_GUESS ( NRR, NSV, KTCOUNT, XRHODJ,IMI, &
- XUM, XVM, XWM, XTHM, XRM, XTKEM, XSVM, &
- ZTSTEP_UVW, ZTSTEP_MET, ZTSTEP_SV, &
+CALL INITIAL_GUESS ( NRR, NSV, KTCOUNT, XRHODJ,IMI, XTSTEP, &
XRUS, XRVS, XRWS, XRTHS, XRRS, XRTKES, XRSVS, &
- CMET_ADV_SCHEME,CSV_ADV_SCHEME, CUVW_ADV_SCHEME, &
- XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT )
+ XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT )
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1022,7 +982,7 @@ XT_GUESS = XT_GUESS + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS
!
XTIME_LES_BU = 0.0
XTIME_LES = 0.0
-IF (LLES) CALL LES_INI_TIMESTEP_n(KTCOUNT,ZTSTEP_UVW,ZTSTEP_MET,ZTSTEP_SV)
+IF (LLES) CALL LES_INI_TIMESTEP_n(KTCOUNT)
!
!-------------------------------------------------------------------------------
!
@@ -1039,13 +999,13 @@ GMASKkids(:,:)=.FALSE.
IF (NMODEL>1) THEN
! correct an ifort bug
DPTR_XRHODJ=>XRHODJ
- DPTR_XUM=>XUM
- DPTR_XVM=>XVM
- DPTR_XWM=>XWM
- DPTR_XTHM=>XTHM
- DPTR_XRM=>XRM
- DPTR_XTKEM=>XTKEM
- DPTR_XSVM=>XSVM
+ DPTR_XUM=>XUT
+ DPTR_XVM=>XVT
+ DPTR_XWM=>XWT
+ DPTR_XTHM=>XTHT
+ DPTR_XRM=>XRT
+ DPTR_XTKEM=>XTKET
+ DPTR_XSVM=>XSVT
DPTR_XRUS=>XRUS
DPTR_XRVS=>XRVS
DPTR_XRWS=>XRWS
@@ -1076,50 +1036,6 @@ CALL SECOND_MNH2(ZTIME2)
XT_2WAY = XT_2WAY + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
!
!-------------------------------------------------------------------------------
-!
-!* 9. ADVECTION
-! ---------
-!
-ZTIME1 = ZTIME2
-XTIME_BU_PROCESS = 0.
-XTIME_LES_BU_PROCESS = 0.
-!
-IF (LNEUTRAL) XTHT=XTHT-XTHVREF
-!
-IF (CUVW_ADV_SCHEME == "CEN4TH" .AND. NHALO == 1 ) THEN
- CALL UPDATE_HALO2_ll(TZFIELDMT_ll, TZHALO2MT_ll, IINFO_ll)
-ENDIF
-!
-IF (CMET_ADV_SCHEME == "CEN4TH" .AND. NHALO == 1 ) THEN
- CALL UPDATE_HALO2_ll(TZFIELDT_ll, TZHALO2T_ll, IINFO_ll)
-ENDIF
-!
-IF (CSV_ADV_SCHEME == "CEN4TH" .AND. NHALO == 1 ) THEN
- CALL UPDATE_HALO2_ll(TZFIELDSC_ll, TZHALO2SC_ll, IINFO_ll)
-ENDIF
-!
-CALL ADVECTION ( CUVW_ADV_SCHEME, CMET_ADV_SCHEME, CSV_ADV_SCHEME, &
- NLITER, CLBCX, CLBCY, &
- NRR, NSV, KTCOUNT, ZTSTEP_MET, ZTSTEP_SV, &
- XUM, XVM, XWM, XTHM, XRM, XTKEM, XSVM, &
- XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT, &
- XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
- XRUS, XRVS, XRWS, XRTHS, XRRS, XRTKES, &
- XRSVS, TZHALO2MT_ll, TZHALO2T_ll, TZHALO2SC_ll )
-!
-IF (LNEUTRAL) XTHT=XTHT+XTHVREF
-!
-IF (NMODEL_CLOUD==IMI .AND. CTURBLEN_CLOUD/='NONE') THEN
- CALL TURB_CLOUD_INDEX(ZTSTEP_MET,YFMFILE,CLUOUT, &
- LTURB_DIAG,GCLOSE_OUT,NRRI, &
- XRRS,XRM,XRHODJ,XDXX,XDYY,XDZZ,XDZX,XDZY, &
- XCEI )
-END IF
-!
-CALL SECOND_MNH2(ZTIME2)
-!
-XT_ADV = XT_ADV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
-!
!-------------------------------------------------------------------------------
!
!* 10. FORCING
@@ -1131,18 +1047,17 @@ XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
IF ( LFORCING ) THEN
- CALL FORCING(XTSTEP, ZTSTEP_UVW,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,&
+ CALL FORCING(XTSTEP,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,&
XUFRC_PAST, XVFRC_PAST, &
XUT,XVT,XWT,XTHT,XTKET,XRT,XSVT, &
- XUM,XVM,XWM,XTHM,XTKEM,XRM,XSVM, &
XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI)
END IF
!
IF ( L2D_ADV_FRC ) THEN
- CALL ADV_FORCING_n(XRHODJ,TDTCUR,XTHM,XRM,XZZ,XRTHS,XRRS)
+ CALL ADV_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS)
END IF
IF ( L2D_REL_FRC ) THEN
- CALL REL_FORCING_n(XRHODJ,TDTCUR,XTHM,XRM,XZZ,XRTHS,XRRS)
+ CALL REL_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS)
END IF
!
CALL SECOND_MNH2(ZTIME2)
@@ -1162,7 +1077,7 @@ XTIME_LES_BU_PROCESS = 0.
!
IF ( LNUDGING ) THEN
CALL NUDGING(LUSERV,XRHODJ,XTNUDGING, &
- XUM,XVM,XWM,XTHM,XRM, &
+ XUT,XVT,XWT,XTHT,XRT, &
XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
XRUS,XRVS,XRWS,XRTHS,XRRS)
@@ -1187,7 +1102,7 @@ IF( LTRANS ) THEN
XVT(:,:,:) = XVT(:,:,:) + XVTRANS
END IF
!
-CALL DYN_SOURCES( NRR,NRRL, NRRI,IMI, &
+CALL DYN_SOURCES( NRR,NRRL, NRRI, &
XUT, XVT, XWT, XTHT, XRT, &
XCORIOX, XCORIOY, XCORIOZ, XCURVX, XCURVY, &
XRHODJ, XZZ, XTHVREF, XEXNREF, &
@@ -1215,16 +1130,16 @@ XTIME_LES_BU_PROCESS = 0.
IF ( LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV ) THEN
!
IF( NHALO==1 ) THEN
- CALL UPDATE_HALO2_ll(TZFIELDM_ll, TZHALO2M_ll, IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELDT_ll, TZHALO2T_ll, IINFO_ll)
IF ( .NOT. LSTEADYLS) CALL UPDATE_HALO2_ll(TZLSFIELD_ll, TZLSHALO2_ll, IINFO_ll)
ENDIF
CALL NUM_DIFF ( CLBCX, CLBCY, NRR, NSV, &
XDK2U, XDK4U, XDK2TH, XDK4TH, XDK2SV, XDK4SV, IMI, &
- XUM, XVM, XWM, XTHM, XTKEM, XRM, XSVM, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, &
XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XRHODJ, &
XRUS, XRVS, XRWS, XRTHS, XRTKES, XRRS, XRSVS, &
LZDIFFU,LNUMDIFU, LNUMDIFTH, LNUMDIFSV, &
- TZHALO2M_ll, TZLSHALO2_ll,XZDIFFU_HALO2 )
+ TZHALO2T_ll, TZLSHALO2_ll,XZDIFFU_HALO2 )
END IF
!
DO JSV = NSV_CHEMBEG,NSV_CHEMEND
@@ -1277,7 +1192,7 @@ ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
-IF(LVE_RELAX .OR. LVE_RELAX_GRD .OR. LHORELAX_UVWTH .OR. LHORELAX_RV .OR. &
+IF(LVE_RELAX .OR. LVE_RELAX_GRD .OR. LHORELAX_UVWTH .OR. LHORELAX_RV .OR.&
LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI .OR. LHORELAX_RS .OR. &
LHORELAX_RG .OR. LHORELAX_RH .OR. LHORELAX_TKE .OR. &
ANY(LHORELAX_SV)) THEN
@@ -1289,7 +1204,7 @@ IF(LVE_RELAX .OR. LVE_RELAX_GRD .OR. LHORELAX_UVWTH .OR. LHORELAX_RV .OR.
LHORELAX_SVCHEM,LHORELAX_SVCHIC,LHORELAX_SVAER, &
LHORELAX_SVDST,LHORELAX_SVSLT,LHORELAX_SVPP, &
LHORELAX_SVCS, KTCOUNT,NRR,NSV,XTSTEP,XRHODJ, &
- XUM, XVM, XWM, XTHM, XRM, XSVM, XTKEM, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
XLSUM, XLSVM, XLSWM, XLSTHM, &
XLBXUM, XLBXVM, XLBXWM, XLBXTHM, &
XLBXRM, XLBXSVM, XLBXTKEM, &
@@ -1303,7 +1218,7 @@ IF(LVE_RELAX .OR. LVE_RELAX_GRD .OR. LHORELAX_UVWTH .OR. LHORELAX_RV .OR.
END IF
IF (CELEC.NE.'NONE' .AND. LRELAX2FW_ION) THEN
- CALL RELAX2FW_ION (KTCOUNT, IMI, XTSTEP, XRHODJ, XSVM, NALBOT, &
+ CALL RELAX2FW_ION (KTCOUNT, IMI, XTSTEP, XRHODJ, XSVT, NALBOT, &
XALK, LMASK_RELAX, XKWRELAX, XRSVS )
END IF
!
@@ -1329,16 +1244,16 @@ IF ( LNETCDF .AND. GCLOSE_OUT ) THEN
DEF_NC=.FALSE.
LLFIFM = .TRUE.
END IF
-CALL PHYS_PARAM_n(KTCOUNT,ZTSTEP_UVW,ZTSTEP_MET,ZTSTEP_SV,YFMFILE, &
- GCLOSE_OUT,CUVW_ADV_SCHEME,CMET_ADV_SCHEME,CSV_ADV_SCHEME, &
- XT_RAD,XT_SHADOWS,XT_DCONV,XT_GROUND,XT_MAFL,XT_DRAG, &
- XT_TURB,XT_TRACER,XT_CHEM,ZTIME,GMASKkids)
+CALL PHYS_PARAM_n(KTCOUNT,YFMFILE, GCLOSE_OUT, &
+ XT_RAD,XT_SHADOWS,XT_DCONV,XT_GROUND,XT_MAFL, &
+ XT_DRAG,XT_TURB,XT_TRACER, &
+ XT_CHEM,ZTIME,GMASKkids)
DEF_NC=.TRUE.
#else
-CALL PHYS_PARAM_n(KTCOUNT,ZTSTEP_UVW,ZTSTEP_MET,ZTSTEP_SV,YFMFILE, &
- GCLOSE_OUT,CUVW_ADV_SCHEME,CMET_ADV_SCHEME,CSV_ADV_SCHEME, &
- XT_RAD,XT_SHADOWS,XT_DCONV,XT_GROUND,XT_MAFL,XT_DRAG, &
- XT_TURB,XT_TRACER,XT_CHEM,ZTIME,GMASKkids)
+CALL PHYS_PARAM_n(KTCOUNT,YFMFILE, GCLOSE_OUT, &
+ XT_RAD,XT_SHADOWS,XT_DCONV,XT_GROUND,XT_MAFL, &
+ XT_DRAG,XT_TURB,XT_TRACER, &
+ XT_CHEM,ZTIME,GMASKkids)
#endif
!
IF (CDCONV/='NONE') THEN
@@ -1405,9 +1320,9 @@ IF (.NOT. LSTEADYLS) THEN
NCPL_CUR=NCPL_CUR+1 ! coupling one, LS sources are refreshed
!
CALL LS_COUPLING(CLUOUT,XTSTEP,GSTEADY_DMASS,CCONF, &
- CGETTKEM, &
- CGETRVM,CGETRCM,CGETRRM,CGETRIM, &
- CGETRSM,CGETRGM,CGETRHM,CGETSVM,LCH_INIT_FIELD,NSV, &
+ CGETTKET, &
+ CGETRVT,CGETRCT,CGETRRT,CGETRIT, &
+ CGETRST,CGETRGT,CGETRHT,CGETSVT,LCH_INIT_FIELD, NSV, &
NIMAX_ll,NJMAX_ll, &
NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, &
NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
@@ -1473,17 +1388,124 @@ XT_COUPL = XT_COUPL + ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
+!
+!* 9. ADVECTION
+! ---------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+!
+!
+ CALL ADVECTION_METSV ( CLUOUT, YFMFILE, GCLOSE_OUT,CUVW_ADV_SCHEME, &
+ CMET_ADV_SCHEME, CSV_ADV_SCHEME, NSPLIT, &
+ LSPLIT_CFL, XSPLIT_CFL, LCFL_WRIT, &
+ CLBCX, CLBCY, NRR, NSV, KTCOUNT, XTSTEP, &
+ XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT, &
+ XTHVREF, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRTHS, XRRS, XRTKES, XRSVS, &
+ XRTHS_CLD, XRRS_CLD, XRSVS_CLD, XRTKEMS )
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ADV = XT_ADV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+ZRWS = XRWS
+!
+CALL GRAVITY_IMPL ( CLBCX, CLBCY, NRR, NRRL, NRRI,XTSTEP, &
+ XTHT, XRT, XTHVREF, XRHODJ, XRWS, XRTHS, XRRS, &
+ XRTHS_CLD, XRRS_CLD )
+!
+! At the initial instant the difference with the ref state creates a
+! vertical velocity production that must not be advected as it is
+! compensated by the pressure gradient
+!
+IF (KTCOUNT == 1 .AND. CCONF=='START') XRWS_PRES = - (XRWS - ZRWS)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_GRAV = XT_GRAV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (CUVW_ADV_SCHEME(1:3)=='CEN') THEN
+ IF (NHALO==1 .AND. CUVW_ADV_SCHEME=='CEN4TH') THEN
+ NULLIFY(TZFIELDC_ll)
+ NULLIFY(TZHALO2C_ll)
+ CALL ADD3DFIELD_ll(TZFIELDC_ll, XUT)
+ CALL ADD3DFIELD_ll(TZFIELDC_ll, XVT)
+ CALL ADD3DFIELD_ll(TZFIELDC_ll, XWT)
+ CALL INIT_HALO2_ll(TZHALO2C_ll,3,IIU,IJU,IKU)
+ CALL UPDATE_HALO_ll(TZFIELDC_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELDC_ll, TZHALO2C_ll, IINFO_ll)
+ END IF
+ CALL ADVECTION_UVW_CEN(CUVW_ADV_SCHEME, &
+ CLBCX, CLBCY, &
+ XTSTEP, KTCOUNT, &
+ XUM, XVM, XWM, XDUM, XDVM, XDWM, &
+ XUT, XVT, XWT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS,XRVS, XRWS, &
+ TZHALO2C_ll )
+ IF (NHALO==1 .AND. CUVW_ADV_SCHEME=='CEN4TH') THEN
+ CALL CLEANLIST_ll(TZFIELDC_ll)
+ NULLIFY(TZFIELDC_ll)
+ CALL DEL_HALO2_ll(TZHALO2C_ll)
+ NULLIFY(TZHALO2C_ll)
+ END IF
+ELSE
+
+ CALL ADVECTION_UVW(CUVW_ADV_SCHEME, CTEMP_SCHEME, &
+ NWENO_ORDER, NSPLIT, &
+ CLBCX, CLBCY, XTSTEP, &
+ XUT, XVT, XWT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS, XRVS, XRWS, &
+ XRUS_PRES, XRVS_PRES, XRWS_PRES )
+END IF
+!
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ADVUVW = XT_ADVUVW + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+IF (NMODEL_CLOUD==IMI .AND. CTURBLEN_CLOUD/='NONE') THEN
+ CALL TURB_CLOUD_INDEX(XTSTEP,YFMFILE,CLUOUT, &
+ LTURB_DIAG,GCLOSE_OUT,NRRI, &
+ XRRS,XRT,XRHODJ,XDXX,XDYY,XDZZ,XDZX,XDZY, &
+ XCEI )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
!* 18. LATERAL BOUNDARY CONDITION FOR THE NORMAL VELOCITY
! --------------------------------------------------
!
ZTIME1 = ZTIME2
+!
+ZRUS=XRUS
+ZRVS=XRVS
+ZRWS=XRWS
!
CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XRIMKMAX, &
- ZTSTEP_UVW, XDXHAT, XDYHAT, XZHAT, &
- XUM, XVM, XUT, XVT, &
+ XTSTEP, &
+ XDXHAT, XDYHAT, XZHAT, &
+ XUT, XVT, &
XLBXUM, XLBYVM, XLBXUS, XLBYVS, &
XCPHASE, XCPHASE_PBL, XRHODJ, &
- XTKEM,XRUS, XRVS, XRWS )
+ XTKET,XRUS, XRVS, XRWS )
+ZRUS=XRUS-ZRUS
+ZRVS=XRVS-ZRVS
+ZRWS=XRWS-ZRWS
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1500,15 +1522,25 @@ XTIME_LES_BU_PROCESS = 0.
!
!
IF(.NOT. L1D) THEN
- CALL PRESSUREZ (CLUOUT, &
+!
+ XRUS_PRES = XRUS
+ XRVS_PRES = XRVS
+ XRWS_PRES = XRWS
+!
+ CALL PRESSUREZ( CLUOUT, &
CLBCX,CLBCY,CPRESOPT,NITR,LITRADJ,KTCOUNT, XRELAX,IMI, &
XRHODJ,XDXX,XDYY,XDZZ,XDZX,XDZY,XDXHATM,XDYHATM,XRHOM, &
- XAF,XBFY,XCF,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY,XPABSM, &
+ XAF,XBFY,XCF,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY, &
NRR,NRRL,NRRI,XDRYMASST,XREFMASS,XMASS_O_PHI0, &
XTHT,XRT,XRHODREF,XTHVREF,XRVREF,XEXNREF, XLINMASS, &
XRUS, XRVS, XRWS, XPABST, &
XBFB,&
XBF_SXP2_YP1_Z) !JUAN Z_SPLITING
+!
+ XRUS_PRES = XRUS - XRUS_PRES + ZRUS
+ XRVS_PRES = XRVS - XRVS_PRES + ZRVS
+ XRWS_PRES = XRWS - XRWS_PRES + ZRWS
+!
END IF
!
CALL SECOND_MNH2(ZTIME2)
@@ -1540,6 +1572,9 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
ZWT_ACT_NUC(:,:,:) = 0.
END IF
!
+ XRTHS_CLD = XRTHS
+ XRRS_CLD = XRRS
+ XRSVS_CLD = XRSVS
IF (CSURF=='EXTE') THEN
ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
@@ -1552,13 +1587,12 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
CLBCX,CLBCY,YFMFILE, CLUOUT, CRAD, CTURBDIM, &
- GCLOSE_OUT, LSUBG_COND,LSIGMAS,CSUBG_AUCV,ZTSTEP_MET,&
- XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
- XPABSM, XPABST, XTHM, XTHT,XRM,XRT,XSIGS,VSIGQSAT, &
- XMFCONV, &
- ZWT_ACT_NUC, XRTHS, XRRS, &
- XSVM, XSVT, XRSVS, &
- XSRCM, XCLDFR,XCIT, &
+ GCLOSE_OUT, LSUBG_COND,LSIGMAS,CSUBG_AUCV,XTSTEP, &
+ XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ XPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABSM, ZWT_ACT_NUC, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR,XCIT, &
LSEDIC,LACTIT, LSEDC, LSEDI, LRAIN, LWARM, LHHONI, &
XCF_MF,XRC_MF, XRI_MF, &
XINPRC,XINPRR, XINPRR3D, XEVAP3D, &
@@ -1568,13 +1602,12 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
CLBCX,CLBCY,YFMFILE, CLUOUT, CRAD, CTURBDIM, &
- GCLOSE_OUT, LSUBG_COND,LSIGMAS,CSUBG_AUCV,ZTSTEP_MET,&
- XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
- XPABSM, XPABST, XTHM, XTHT,XRM,XRT,XSIGS,VSIGQSAT, &
- XMFCONV, &
- ZWT_ACT_NUC, XRTHS, XRRS, &
- XSVM, XSVT, XRSVS, &
- XSRCM, XCLDFR,XCIT, &
+ GCLOSE_OUT, LSUBG_COND,LSIGMAS,CSUBG_AUCV,XTSTEP, &
+ XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ XPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABSM, ZWT_ACT_NUC, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR,XCIT, &
LSEDIC,LACTIT, LSEDC, LSEDI, LRAIN, LWARM, LHHONI, &
XCF_MF,XRC_MF, XRI_MF, &
XINPRC,XINPRR, XINPRR3D, XEVAP3D, &
@@ -1588,13 +1621,12 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
CLBCX,CLBCY,YFMFILE, CLUOUT, CRAD, CTURBDIM, &
- GCLOSE_OUT, LSUBG_COND,LSIGMAS,CSUBG_AUCV,ZTSTEP_MET,&
+ GCLOSE_OUT, LSUBG_COND,LSIGMAS,CSUBG_AUCV, &
XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
- XPABSM, XPABST, XTHM, XTHT,XRM,XRT,XSIGS,VSIGQSAT, &
- XMFCONV, &
- ZWT_ACT_NUC, XRTHS, XRRS, &
- XSVM, XSVT, XRSVS, &
- XSRCM, XCLDFR,XCIT, &
+ XPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABSM, ZWT_ACT_NUC, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR,XCIT, &
LSEDIC, LACTIT, LSEDC, LSEDI, LRAIN, LWARM, LHHONI, &
XCF_MF,XRC_MF, XRI_MF, &
XINPRC,XINPRR, XINPRR3D, XEVAP3D, &
@@ -1604,19 +1636,21 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
CLBCX,CLBCY,YFMFILE, CLUOUT, CRAD, CTURBDIM, &
- GCLOSE_OUT, LSUBG_COND,LSIGMAS,CSUBG_AUCV,ZTSTEP_MET,&
+ GCLOSE_OUT, LSUBG_COND,LSIGMAS,CSUBG_AUCV, &
XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
- XPABSM, XPABST, XTHM, XTHT,XRM,XRT,XSIGS,VSIGQSAT, &
- XMFCONV, &
- ZWT_ACT_NUC, XRTHS, XRRS, &
- XSVM, XSVT, XRSVS, &
- XSRCM, XCLDFR,XCIT, &
+ XPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABSM, ZWT_ACT_NUC, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR,XCIT, &
LSEDIC, LACTIT, LSEDC, LSEDI, LRAIN, LWARM, LHHONI, &
XCF_MF,XRC_MF, XRI_MF, &
XINPRC,XINPRR, XINPRR3D, XEVAP3D, &
XINPRS, XINPRG, XINPRH, XSOLORG, XMI )
#endif
END IF
+ XRTHS_CLD = XRTHS - XRTHS_CLD
+ XRRS_CLD = XRRS - XRRS_CLD
+ XRSVS_CLD = XRSVS - XRSVS_CLD
!
IF (CCLOUD /= 'REVE' ) THEN
XACPRR = XACPRR + XINPRR * XTSTEP
@@ -1652,6 +1686,9 @@ XTIME_LES_BU_PROCESS = 0.
IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
ZWT_ACT_NUC(:,:,:) = 0.
!
+ XRTHS_CLD = XRTHS
+ XRRS_CLD = XRRS
+ XRSVS_CLD = XRRS
IF (CSURF=='EXTE') THEN
ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
@@ -1659,14 +1696,13 @@ IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
ZTOWN(:,:)= 0.
CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
- NRR, NSPLITR, IMI, KTCOUNT,CUVW_ADV_SCHEME, &
+ NRR, NSPLITR, IMI, KTCOUNT, &
CLBCX, CLBCY, YFMFILE, CLUOUT, CRAD, CTURBDIM, &
GCLOSE_OUT, LSUBG_COND, LSIGMAS,VSIGQSAT,CSUBG_AUCV, &
- ZTSTEP_MET, XZZ, XRHODJ, XRHODREF, XEXNREF, &
- XPABSM, XPABST, XTHM, XTHT, XRTHS, XWT, &
- XRM, XRT, XRRS, &
- XSVM, XSVT, XRSVS, XCIT, &
- XSIGS, XSRCM, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ XPABST, XTHT, XRTHS, XWT, XRT, XRRS, &
+ XSVT, XRSVS, XCIT, &
+ XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
XRI_MF, LSEDIC, LWARM, &
XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
XINPRS, XINPRG, XINPRH, &
@@ -1674,18 +1710,20 @@ IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
DEALLOCATE(ZTOWN)
ELSE
CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
- NRR, NSPLITR, IMI, KTCOUNT,CUVW_ADV_SCHEME, &
+ NRR, NSPLITR, IMI, KTCOUNT, &
CLBCX, CLBCY, YFMFILE, CLUOUT, CRAD, CTURBDIM, &
GCLOSE_OUT, LSUBG_COND, LSIGMAS,VSIGQSAT, CSUBG_AUCV, &
- ZTSTEP_MET, XZZ, XRHODJ, XRHODREF, XEXNREF, &
- XPABSM, XPABST, XTHM, XTHT, XRTHS, XWT, &
- XRM, XRT, XRRS, &
- XSVM, XSVT, XRSVS, XCIT, &
- XSIGS, XSRCM, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ XPABST, XTHT, XRTHS, XWT, &
+ XRT, XRRS, XSVT, XRSVS, XCIT, &
+ XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
XRI_MF, LSEDIC, LWARM, &
XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
XINPRS, XINPRG, XINPRH )
END IF
+ XRTHS_CLD = XRTHS - XRTHS_CLD
+ XRRS_CLD = XRRS - XRRS_CLD
+ XRSVS_CLD = XRSVS - XRSVS_CLD
!
XACPRR = XACPRR + XINPRR * XTSTEP
IF ((CCLOUD(1:3) == 'ICE' .AND. LSEDIC)) &
@@ -1721,8 +1759,7 @@ XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES
! --------------------
!
IF (LMEAN_FIELD) THEN
- CALL MEAN_FIELD(XUM, XVM, XWM, XTHM, XTKEM, XPABSM,&
- XUT, XVT, XWT, XTHT, XPABST,KTCOUNT,ZTSTEP_UVW)
+ CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST)
END IF
!
!-------------------------------------------------------------------------------
@@ -1732,7 +1769,7 @@ END IF
!
ZTIME1 = ZTIME2
!
-CALL EXCHANGE (ZTSTEP_UVW,ZTSTEP_MET,ZTSTEP_SV,NRR,NSV,XRHODJ,TZFIELDS_ll, &
+CALL EXCHANGE (XTSTEP,NRR,NSV,XRHODJ,TZFIELDS_ll, &
XRUS, XRVS,XRWS,XRTHS,XRRS,XRTKES,XRSVS)
!
CALL SECOND_MNH2(ZTIME2)
@@ -1747,8 +1784,8 @@ XT_HALO = XT_HALO + ZTIME2 - ZTIME1
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
!
-CALL ENDSTEP ( XTSTEP,ZTSTEP_UVW,ZTSTEP_MET,ZTSTEP_SV, &
- NRR,NSV,KTCOUNT,IMI,XRHODJ, &
+CALL ENDSTEP ( XTSTEP,NRR,NSV,KTCOUNT,IMI, &
+ CUVW_ADV_SCHEME,XRHODJ, &
XRUS,XRVS,XRWS,XDRYMASSS, &
XRTHS,XRRS,XRTKES,XRSVS, &
XLSUS,XLSVS,XLSWS, &
@@ -1757,17 +1794,15 @@ CALL ENDSTEP ( XTSTEP,ZTSTEP_UVW,ZTSTEP_MET,ZTSTEP_SV, &
XLBXTHS,XLBXRS,XLBXTKES,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS, &
XLBYTHS,XLBYRS,XLBYTKES,XLBYSVS, &
- XUM,XVM,XWM,XPABSM, &
- XTHM,XRM,XTKEM,XSVM,XSRCM, &
+ XUM,XVM,XWM, &
XUT,XVT,XWT,XPABST,XDRYMASST, &
- XTHT, XRT, XTKET, XSVT,XSRCT, &
+ XTHT, XRT, XTHM, XRCM, XPABSM,XTKET, XSVT,&
XLSUM,XLSVM,XLSWM, &
XLSTHM,XLSRVM, &
XLBXUM,XLBXVM,XLBXWM, &
XLBXTHM,XLBXRM,XLBXTKEM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM, &
- XLBYTHM,XLBYRM,XLBYTKEM,XLBYSVM, &
- CMET_ADV_SCHEME, CSV_ADV_SCHEME )
+ XLBYTHM,XLBYRM,XLBYTKEM,XLBYSVM )
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1832,8 +1867,7 @@ CALL END_DIAG_IN_RUN
ZTIME1 = ZTIME2
!
IF (NBUMOD==IMI .AND. CBUTYPE/='NONE') THEN
- CALL ENDSTEP_BUDGET(CFMDIAC,CLUOUT,KTCOUNT,TDTCUR,TDTMOD,XTSTEP, &
- ZTSTEP_UVW,ZTSTEP_MET,ZTSTEP_SV,NSV )
+ CALL ENDSTEP_BUDGET(CFMDIAC,CLUOUT,KTCOUNT,TDTCUR,TDTMOD,XTSTEP,NSV)
END IF
!
CALL SECOND_MNH2(ZTIME2)
@@ -1853,7 +1887,7 @@ END IF
!-------------------------------------------------------------------------------
!
!* 27. CURRENT TIME REFRESH
-! -------------------
+! --------------------
!
TDTCUR%TIME=TDTCUR%TIME + XTSTEP
CALL ADD_FORECAST_TO_DATE(TDTCUR%TDATE%YEAR, &
@@ -1941,7 +1975,9 @@ IF (OEXIT) THEN
CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_ALL ,ZTOT, ' W2D_ALL ','-')
CALL TIME_STAT_ll(XT_GUESS,ZTOT, ' INITIAL_GUESS','=')
CALL TIME_STAT_ll(XT_2WAY,ZTOT, ' TWO WAY','=')
- CALL TIME_STAT_ll(XT_ADV,ZTOT, ' ADVECTION','=')
+ CALL TIME_STAT_ll(XT_ADV,ZTOT, ' ADVECTION MET','=')
+ CALL TIME_STAT_ll(XT_ADVUVW,ZTOT, ' ADVECTION UVW','=')
+ CALL TIME_STAT_ll(XT_GRAV,ZTOT, ' GRAVITY','=')
CALL TIME_STAT_ll(XT_FORCING,ZTOT, ' FORCING','=')
CALL TIME_STAT_ll(XT_NUDGING,ZTOT, ' NUDGING','=')
CALL TIME_STAT_ll(XT_SOURCES,ZTOT, ' DYN_SOURCES','=')
@@ -1986,6 +2022,7 @@ IF (OEXIT) THEN
!
ZALL = XT_1WAY + XT_BOUND + XT_STORE + XT_GUESS + XT_2WAY + &
XT_ADV + XT_FORCING + XT_NUDGING + XT_SOURCES + XT_DIFF + &
+ XT_ADVUVW + XT_GRAV + &
XT_RELAX+ XT_PARAM + XT_COUPL + XT_RAD_BOUND+XT_PRESS + &
XT_CLOUD+ XT_HALO + XT_SPECTRA + XT_STEP_SWA +XT_STEP_MISC+ &
XT_STEP_BUD
diff --git a/src/MNH/modn_advn.f90 b/src/MNH/modn_advn.f90
index e6df66b7c..49d9807df 100644
--- a/src/MNH/modn_advn.f90
+++ b/src/MNH/modn_advn.f90
@@ -27,9 +27,11 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original 23/10/95 (Vila, Lafore) Implementation scalar advection scheme
-!! C.Lac 24/04/06 Introduction of CUVW_ADV_SCHEME and
-!! removal of CFV_ADV_SCHEME
+!! Original 23/10/95 (Vila, lafore) For new scalar advection schemes
+!! C.Lac 24/04/06 Introduction of CUVW_ADV_SCHEME and
+!! removal of CFV_ADV_SCHEME
+!! J.-P. Pinty 20/03/10 Add NWENO_ORDER
+!! C.Lac, V.Masson Add CTEMP_SCHEME and time splitting
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -39,16 +41,25 @@ USE MODD_ADV_n, ONLY: &
CUVW_ADV_SCHEME_n => CUVW_ADV_SCHEME, &
CMET_ADV_SCHEME_n => CMET_ADV_SCHEME, &
CSV_ADV_SCHEME_n => CSV_ADV_SCHEME, &
- NLITER_n => NLITER
+ CTEMP_SCHEME_n => CTEMP_SCHEME, &
+ NWENO_ORDER_n => NWENO_ORDER, &
+ LSPLIT_CFL_n => LSPLIT_CFL, &
+ LCFL_WRIT_n => LCFL_WRIT, &
+ XSPLIT_CFL_n => XSPLIT_CFL
!
IMPLICIT NONE
!
CHARACTER(LEN=6) :: CUVW_ADV_SCHEME
CHARACTER(LEN=6) :: CMET_ADV_SCHEME
CHARACTER(LEN=6) :: CSV_ADV_SCHEME
-INTEGER :: NLITER
+CHARACTER(LEN=4) :: CTEMP_SCHEME
+INTEGER :: NWENO_ORDER
+LOGICAL :: LSPLIT_CFL
+LOGICAL :: LCFL_WRIT
+REAL :: XSPLIT_CFL
!
-NAMELIST/NAM_ADVn/CUVW_ADV_SCHEME,CMET_ADV_SCHEME,CSV_ADV_SCHEME,NLITER
+NAMELIST/NAM_ADVn/CUVW_ADV_SCHEME,CMET_ADV_SCHEME,CSV_ADV_SCHEME,CTEMP_SCHEME, &
+ NWENO_ORDER,LSPLIT_CFL,XSPLIT_CFL,LCFL_WRIT
!
CONTAINS
!
@@ -56,14 +67,22 @@ SUBROUTINE INIT_NAM_ADVn
CUVW_ADV_SCHEME = CUVW_ADV_SCHEME_n
CMET_ADV_SCHEME = CMET_ADV_SCHEME_n
CSV_ADV_SCHEME = CSV_ADV_SCHEME_n
- NLITER = NLITER_n
+ CTEMP_SCHEME = CTEMP_SCHEME_n
+ NWENO_ORDER = NWENO_ORDER_n
+ LSPLIT_CFL = LSPLIT_CFL_n
+ LCFL_WRIT = LCFL_WRIT_n
+ XSPLIT_CFL = XSPLIT_CFL_n
END SUBROUTINE INIT_NAM_ADVn
SUBROUTINE UPDATE_NAM_ADVn
CUVW_ADV_SCHEME_n = CUVW_ADV_SCHEME
CMET_ADV_SCHEME_n = CMET_ADV_SCHEME
CSV_ADV_SCHEME_n = CSV_ADV_SCHEME
- NLITER_n = NLITER
+ CTEMP_SCHEME_n = CTEMP_SCHEME
+ NWENO_ORDER_n = NWENO_ORDER
+ LSPLIT_CFL_n = LSPLIT_CFL
+ LCFL_WRIT_n = LCFL_WRIT
+ XSPLIT_CFL_n = XSPLIT_CFL
END SUBROUTINE UPDATE_NAM_ADVn
END MODULE MODN_ADV_n
diff --git a/src/MNH/modn_budget.f90 b/src/MNH/modn_budget.f90
index 0410d481f..ecc42f680 100644
--- a/src/MNH/modn_budget.f90
+++ b/src/MNH/modn_budget.f90
@@ -233,59 +233,57 @@ IMPLICIT NONE
NAMELIST/NAM_BUDGET/CBUTYPE, NBUMOD, XBULEN, NBUKL, NBUKH, LBU_KCP, XBUWRI, &
NBUIL, NBUIH, NBUJL, NBUJH, LBU_ICP, LBU_JCP, NBUMASK
!
-NAMELIST/NAM_BU_RU/LBU_RU, NASSEU, NNESTU, NADVXU, NADVYU, NADVZU, NFRCU, NNUDU, &
+NAMELIST/NAM_BU_RU/LBU_RU, NASSEU, NNESTU, NADVU, NFRCU, NNUDU, &
NCURVU, NCORU, NDIFU, NRELU, NDRAGU, NHTURBU, NVTURBU, NMAFLU, NPRESU
!
-NAMELIST/NAM_BU_RV/LBU_RV, NASSEV, NNESTV, NADVXV, NADVYV, NADVZV, NFRCV, NNUDV, &
+NAMELIST/NAM_BU_RV/LBU_RV, NASSEV, NNESTV, NADVV, NFRCV, NNUDV, &
NCURVV, NCORV, NDIFV, NRELV, NDRAGV, NHTURBV, NVTURBV, NMAFLV, NPRESV
-NAMELIST/NAM_BU_RW/LBU_RW, NASSEW, NNESTW, NADVXW, NADVYW, NADVZW, NFRCW, NNUDW, &
+NAMELIST/NAM_BU_RW/LBU_RW, NASSEW, NNESTW, NADVW, NFRCW, NNUDW, &
NCURVW, NCORW, NGRAVW, NDIFW, NRELW, NHTURBW, NVTURBW, NPRESW
!
-NAMELIST/NAM_BU_RTH/LBU_RTH, NASSETH, NNESTTH, NADVTH, NADVXTH, NADVYTH, NADVZTH, NFRCTH, &
- N2DADVTH,N2DRELTH, &
+NAMELIST/NAM_BU_RTH/LBU_RTH, NASSETH, NNESTTH, NADVTH, NFRCTH, &
NNUDTH, NPREFTH, NDIFTH, NRELTH, NRADTH, NDCONVTH, NHTURBTH, &
NVTURBTH, NDISSHTH, NNEGATH, NREVATH, NCONDTH, NHENUTH, NHONTH, &
NSFRTH, NDEPSTH, NDEPGTH,NRIMTH, NACCTH, NCFRZTH, NWETGTH, &
NDRYGTH, NGMLTTH, NIMLTTH, NBERFITH, NCDEPITH, NWETHTH, NHMLTTH, &
NMAFLTH
!
-NAMELIST/NAM_BU_RTKE/LBU_RTKE, NASSETKE, NADVTKE, NADVXTKE, NADVYTKE, NADVZTKE, &
+NAMELIST/NAM_BU_RTKE/LBU_RTKE, NASSETKE, NADVTKE, &
NFRCTKE, NDIFTKE, NRELTKE, NDRAGTKE, &
NDPTKE, NTPTKE, NDISSTKE, NTRTKE
!
-NAMELIST/NAM_BU_RRV/LBU_RRV, NASSERV, NNESTRV, NADVRV, NADVXRV, NADVYRV, NADVZRV, NFRCRV, &
- N2DADVRV,N2DRELRV, &
+NAMELIST/NAM_BU_RRV/LBU_RRV, NASSERV, NNESTRV, NADVRV, NFRCRV, &
NNUDRV, NDIFRV, NRELRV, NDCONVRV, NHTURBRV, NVTURBRV, NNEGARV, &
NREVARV, NCONDRV, NHENURV, NDEPSRV, NDEPGRV, NCDEPIRV, NMAFLRV
!
-NAMELIST/NAM_BU_RRC/LBU_RRC, NASSERC, NNESTRC, NADVRC, NADVXRC, NADVYRC, NADVZRC, NFRCRC, &
+NAMELIST/NAM_BU_RRC/LBU_RRC, NASSERC, NNESTRC, NADVRC, NFRCRC, &
NDIFRC, NRELRC, NDCONVRC, NHTURBRC, NVTURBRC, NNEGARC, NACCRRC, &
NAUTORC, NCONDRC, NHONRC, NRIMRC, NWETGRC, NDRYGRC, NIMLTRC, &
NBERFIRC, NCDEPIRC, NHENURC, NSEDIRC, NWETHRC
!
-NAMELIST/NAM_BU_RRR/LBU_RRR, NASSERR, NNESTRR, NADVRR, NADVXRR, NADVYRR, NADVZRR, NFRCRR, &
+NAMELIST/NAM_BU_RRR/LBU_RRR, NASSERR, NNESTRR, NADVRR, NFRCRR, &
NDIFRR, NRELRR, NNEGARR, NACCRRR, NAUTORR, NREVARR, NSEDIRR, &
NSFRRR, NACCRR, NCFRZRR, NWETGRR, NDRYGRR, NGMLTRR, NWETHRR, &
NHMLTRR
!
-NAMELIST/NAM_BU_RRI/LBU_RRI, NASSERI, NNESTRI, NADVRI, NADVXRI, NADVYRI, NADVZRI, NFRCRI, &
+NAMELIST/NAM_BU_RRI/LBU_RRI, NASSERI, NNESTRI, NADVRI, NFRCRI, &
NDIFRI, NRELRI, NDCONVRI, NHTURBRI, NVTURBRI, NNEGARI, NSEDIRI, &
NHENURI, NHONRI, NAGGSRI, NAUTSRI, NCFRZRI, NWETGRI, NDRYGRI, &
NIMLTRI, NBERFIRI, NCDEPIRI, NWETHRI
!
-NAMELIST/NAM_BU_RRS/LBU_RRS, NASSERS, NNESTRS, NADVRS, NADVXRS, NADVYRS, NADVZRS, NFRCRS, &
+NAMELIST/NAM_BU_RRS/LBU_RRS, NASSERS, NNESTRS, NADVRS, NFRCRS, &
NDIFRS, NRELRS, NNEGARS, NSEDIRS, NDEPSRS, NAGGSRS, NAUTSRS, &
NRIMRS, NACCRS, NCMELRS, NWETGRS, NDRYGRS, NWETHRS
!
-NAMELIST/NAM_BU_RRG/LBU_RRG, NASSERG, NNESTRG, NADVRG, NADVXRG, NADVYRG, NADVZRG, NFRCRG, &
+NAMELIST/NAM_BU_RRG/LBU_RRG, NASSERG, NNESTRG, NADVRG, NFRCRG, &
NDIFRG, NRELRG, NNEGARG, NSEDIRG, NSFRRG, NDEPGRG, NRIMRG, NACCRG, &
NCMELRG, NCFRZRG, NWETGRG, NDRYGRG, NGMLTRG, NWETHRG
!
-NAMELIST/NAM_BU_RRH/LBU_RRH, NASSERH, NNESTRH, NADVRH, NADVXRH, NADVYRH, NADVZRH, NFRCRH, &
+NAMELIST/NAM_BU_RRH/LBU_RRH, NASSERH, NNESTRH, NADVRH, NFRCRH, &
NDIFRH, NRELRH, NNEGARH, NSEDIRH, NWETGRH, NWETHRH, NHMLTRH
!
-NAMELIST/NAM_BU_RSV/ LBU_RSV, NASSESV, NNESTSV, NADVSV, NADVXSV, NADVYSV, NADVZSV, NFRCSV, &
+NAMELIST/NAM_BU_RSV/ LBU_RSV, NASSESV, NNESTSV, NADVSV, NFRCSV, &
NDIFSV, NRELSV, NDCONVSV, NVTURBSV, NHTURBSV, NCHEMSV, NMAFLSV, &
NNEGASV, &
NAUTOQC, NACCRQC, NRIMQC, NWETGQC, NDRYGQC, NIMLTQC, NBERFIQC, &
diff --git a/src/MNH/modn_conf.f90 b/src/MNH/modn_conf.f90
index 424425c47..f78ef558a 100644
--- a/src/MNH/modn_conf.f90
+++ b/src/MNH/modn_conf.f90
@@ -78,6 +78,6 @@ USE MODD_CONF
IMPLICIT NONE
!
NAMELIST/NAM_CONF/CCONF,LFLAT,NMODEL,CEQNSYS,NVERB,CEXP,CSEG,LFORCING, &
- NHALO,CSPLIT,LLG,LINIT_LG,CINIT_LG,LNOMIXLG
+ NHALO,CSPLIT,LLG,LINIT_LG,CINIT_LG,LNOMIXLG,LCHECK
!
END MODULE MODN_CONF
diff --git a/src/MNH/one_wayn.f90 b/src/MNH/one_wayn.f90
index 26025ad4b..66d26b3b5 100644
--- a/src/MNH/one_wayn.f90
+++ b/src/MNH/one_wayn.f90
@@ -319,7 +319,7 @@ GVERT_INTERP=.TRUE.
ZJ(:,:,:) =0.
ZRHOD(:,:,:)=0.
!
-IRR=MIN(SIZE(XRM,4),SIZE(PLBXRM,4))
+IRR=MIN(SIZE(XRT,4),SIZE(PLBXRM,4))
ISV_USER=MIN(NSV_USER_A(KDAD),NSV_USER_A(KMI))
!
IF (LWEST_ll() .AND. LEAST_ll()) THEN
@@ -822,14 +822,14 @@ IF(.NOT. OSTEADY_DMASS) THEN
!
!* 4.5 segment beginning (we have first to recover the dry mass at T-DT)
!
- IF(SIZE(XRM,4) == 0) THEN
+ IF(SIZE(XRT,4) == 0) THEN
! dry air case
! ------------
- ZRHOD(:,:,:) = XPABSM(:,:,:)/(XPABSM(:,:,:)/XP00)**ZRD_O_CPD/(XRD*XTHM(:,:,:))
+ ZRHOD(:,:,:) = XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**ZRD_O_CPD/(XRD*XTHT(:,:,:))
ELSE ! moist air case
! --------------
- ZRHOD(:,:,:) = XPABSM(:,:,:)/(XPABSM(:,:,:)/XP00)**ZRD_O_CPD/(XRD*XTHM(:,:,:) &
- *(1.+ZRV_O_RD*XRM(:,:,:,1)))
+ ZRHOD(:,:,:) = XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**ZRD_O_CPD/(XRD*XTHT(:,:,:) &
+ *(1.+ZRV_O_RD*XRT(:,:,:,1)))
ENDIF
!
!
diff --git a/src/MNH/paspol.f90 b/src/MNH/paspol.f90
index 6041caa91..d7f3c5ca2 100644
--- a/src/MNH/paspol.f90
+++ b/src/MNH/paspol.f90
@@ -54,6 +54,7 @@ END MODULE MODI_PASPOL
!! C.Lac 30/09/2010 Bugs for reproducibility : position of release +
!! GET_INDICE_ll replaced by GET_PHYSICAL_ll +
!! remove the diffusion at the release
+!! C.Lac 11/11 Remove instant M
!! --------------------------------------------------------------------------
!
!! EXTERNAL
@@ -461,8 +462,6 @@ ZSSCUR=TDTCUR%TIME
!
WHERE (XSVT(:,:,:,NSV_PPBEG:NSV_PPEND) <0.0) &
XSVT(:,:,:,NSV_PPBEG:NSV_PPEND)=0.0
-WHERE (XSVM(:,:,:,NSV_PPBEG:NSV_PPEND) <0.0) &
- XSVM(:,:,:,NSV_PPBEG:NSV_PPEND)=0.0
!
DO JSV=1,NSV_PP
!
@@ -536,9 +535,8 @@ DO JSV=1,NSV_PP
!
!
IF (.NOT.GBEGEMIS(JSV)) THEN
- XSVM(:,:,:,IP) = XSVT(:,:,:,IP)
XRSVS(:,:,:,IP) = XRSVS(:,:,:,IP) &
- +XRHODJ(:,:,:)*XSVM(:,:,:,IP)/PTSTEP
+ +XRHODJ(:,:,:)*XSVT(:,:,:,IP)/PTSTEP
GBEGEMIS(JSV)= .TRUE.
ELSE
XRSVS(:,:,:,IP) = XRSVS(:,:,:,IP) &
@@ -563,7 +561,7 @@ END DO ! BOUCLE sur les rejets.
!
!* 3.1 Calcul de la masse volumique de l'air en Kg/m3.
!
-ZRHOM(:,:,:)=XPABSM(:,:,:)/(XRD*XTHM(:,:,:)*((XPABSM(:,:,:)/XP00)**(XRD/XCPD)))
+ZRHOM(:,:,:)=XPABST(:,:,:)/(XRD*XTHT(:,:,:)*((XPABST(:,:,:)/XP00)**(XRD/XCPD)))
!
!
!* 3.2 Passage en g/m3.
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 5fd03a7ca..eb0f6e215 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -5,24 +5,17 @@
!
INTERFACE
!
- SUBROUTINE PHYS_PARAM_n(KTCOUNT,PTSTEP,PTSTEP_MET,PTSTEP_SV,HFMFILE,OCLOSE_OUT, &
- HUVW_ADV_SCHEME,HMET_ADV_SCHEME,HSV_ADV_SCHEME, &
+ SUBROUTINE PHYS_PARAM_n(KTCOUNT,HFMFILE,OCLOSE_OUT, &
PRAD,PSHADOWS,PKAFR,PGROUND,PMAFL,PDRAG,PTURB,PTRACER,PCHEM, &
PTIME_BU, OMASKkids )
!
INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
-REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables
CHARACTER (LEN=28),INTENT(IN) :: HFMFILE ! name of the synchronous
! OUTPUT FM-file
LOGICAL, INTENT(IN) :: OCLOSE_OUT! conditional closure of the
! OUTPUT FM-file
! advection schemes
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
-CHARACTER(LEN=6), INTENT(IN) :: HSV_ADV_SCHEME
-CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME
REAL*8,DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
! time for computing time
@@ -37,8 +30,7 @@ END INTERFACE
END MODULE MODI_PHYS_PARAM_n
!
! ######################################################################
- SUBROUTINE PHYS_PARAM_n(KTCOUNT,PTSTEP,PTSTEP_MET,PTSTEP_SV,HFMFILE,OCLOSE_OUT, &
- HUVW_ADV_SCHEME,HMET_ADV_SCHEME,HSV_ADV_SCHEME, &
+ SUBROUTINE PHYS_PARAM_n(KTCOUNT,HFMFILE,OCLOSE_OUT, &
PRAD,PSHADOWS,PKAFR,PGROUND,PMAFL,PDRAG,PTURB,PTRACER,PCHEM, &
PTIME_BU, OMASKkids )
! ######################################################################
@@ -218,7 +210,8 @@ END MODULE MODI_PHYS_PARAM_n
!! 06/2010 (P.Peyrille) add Call to aerozon.f90 if LAERO_FT=T
!! to update
!! aerosols and ozone climatology at each call to
-!! phys_param otherwise it is constant to monthly average
+!! phys_param otherwise it is constant to monthly average
+!! 03/2013 (C.Lac) FIT temporal scheme
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -276,6 +269,7 @@ USE MODD_SUB_PHYS_PARAM_n
USE MODD_PARAM_MFSHALL_n
USE MODI_SHALLOW_MF_PACK
USE MODD_CLOUD_MF_n
+USE MODD_ADV_n, ONLY : XRTKEMS
!
USE MODI_SURF_RAD_MODIF
USE MODI_GROUND_PARAM_n
@@ -326,17 +320,11 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
-REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables
CHARACTER (LEN=28),INTENT(IN) :: HFMFILE ! name of the synchronous
! OUTPUT FM-file
LOGICAL, INTENT(IN) :: OCLOSE_OUT! conditional closure of the
! OUTPUT FM-file
! advection schemes
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
-CHARACTER(LEN=6), INTENT(IN) :: HSV_ADV_SCHEME
-CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME
REAL*8,DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
! time for computing time
! statistics
@@ -398,11 +386,10 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC, ZRI, ZWT ! additional dummies
REAL, DIMENSION(:,:), ALLOCATABLE :: ZDXDY ! grid area
! for rc, ri, w required if main variables not allocated
!
-INTEGER :: IIU, IJU, IKU, II ! dimensional indexes
+INTEGER :: IIU, IJU, IKU ! dimensional indexes
!
INTEGER :: JSV ! Loop index for Scalar Variables
INTEGER :: JSWB ! loop on SW spectral bands
-CHARACTER(LEN=1) :: YINST_SFU ! temporal location of the surface friction flux
INTEGER :: IIB,IIE,IJB,IJE, IKB, IKE
INTEGER :: IMODEIDX
! index values for the Beginning or the End of the physical
@@ -433,7 +420,6 @@ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSAVE_DIRFLASWD, ZSAVE_SCAFLASWD,ZSAVE
!
!-----------------------------------------------------------------------------
!
-YINST_SFU ='M'
NULLIFY(TZFIELDS_ll)
IMI=GET_CURRENT_MODEL_INDEX()
!
@@ -903,7 +889,7 @@ IF( CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) THEN
ENDDO
!
DO JSV=NSV_DSTBEG,NSV_DSTEND
- ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * PTSTEP_SV / XRHODJ(:,:,:)
+ ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
ENDDO
CALL PPP2DUST(ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE),&
PSIG3D=ZSIGDST(IIB:IIE,IJB:IJE,IKB:IKE,:), PRG3D=ZRGDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
@@ -930,7 +916,7 @@ IF( CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) THEN
ENDDO
!
DO JSV=NSV_SLTBEG,NSV_SLTEND
- ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * PTSTEP_SV / XRHODJ(:,:,:)
+ ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
ENDDO
CALL PPP2SALT(ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE),&
PSIG3D=ZSIGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), PRG3D=ZRGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
@@ -955,7 +941,7 @@ IF( CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) THEN
IF ((LDUST).AND.(LCHTRANS)) THEN ! dust convective balance
IF (CPROGRAM == "MESONH") THEN
DO JSV=NSV_DSTBEG,NSV_DSTEND
- ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * PTSTEP_SV / XRHODJ(:,:,:)
+ ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
ENDDO
ELSE
DO JSV=NSV_DSTBEG,NSV_DSTEND
@@ -966,7 +952,7 @@ IF( CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) THEN
XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), ZSIGDST(IIB:IIE,IJB:IJE,IKB:IKE,:),&
ZRGDST(IIB:IIE,IJB:IJE,IKB:IKE,:))
DO JSV=NSV_DSTBEG,NSV_DSTEND
- XRSVS(:,:,:,JSV) = ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) * XRHODJ(:,:,:) / PTSTEP_SV
+ XRSVS(:,:,:,JSV) = ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) * XRHODJ(:,:,:) / XTSTEP
ENDDO
!
DEALLOCATE(ZSVDST)
@@ -978,7 +964,7 @@ IF( CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) THEN
IF ((LSALT).AND.(LCHTRANS)) THEN ! sea salt convective balance
IF (CPROGRAM == "MESONH") THEN
DO JSV=NSV_SLTBEG,NSV_SLTEND
- ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * PTSTEP_SV / XRHODJ(:,:,:)
+ ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
ENDDO
ELSE
DO JSV=NSV_SLTBEG,NSV_SLTEND
@@ -989,7 +975,7 @@ IF( CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) THEN
XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), ZSIGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
ZRGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:))
DO JSV=NSV_SLTBEG,NSV_SLTEND
- XRSVS(:,:,:,JSV) = ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) * XRHODJ(:,:,:) / PTSTEP_SV
+ XRSVS(:,:,:,JSV) = ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) * XRHODJ(:,:,:) / XTSTEP
ENDDO
!
DEALLOCATE(ZSVSLT)
@@ -1065,8 +1051,6 @@ IF (CSURF=='EXTE') THEN
IF( LTRANS ) THEN
XUT(:,:,1+JPVEXT) = XUT(:,:,1+JPVEXT) + XUTRANS
XVT(:,:,1+JPVEXT) = XVT(:,:,1+JPVEXT) + XVTRANS
- XUM(:,:,1+JPVEXT) = XUM(:,:,1+JPVEXT) + XUTRANS
- XVM(:,:,1+JPVEXT) = XVM(:,:,1+JPVEXT) + XVTRANS
END IF
!
ALLOCATE(ZDIR_ALB(IIU,IJU,NSWB_MNH))
@@ -1145,13 +1129,10 @@ IF (CSURF=='EXTE') THEN
DEALLOCATE(ZEMIS )
DEALLOCATE(ZTSRAD )
!
- YINST_SFU='M'
!
IF( LTRANS ) THEN
XUT(:,:,1+JPVEXT) = XUT(:,:,1+JPVEXT) - XUTRANS
XVT(:,:,1+JPVEXT) = XVT(:,:,1+JPVEXT) - XVTRANS
- XUM(:,:,1+JPVEXT) = XUM(:,:,1+JPVEXT) - XUTRANS
- XVM(:,:,1+JPVEXT) = XVM(:,:,1+JPVEXT) - XVTRANS
END IF
!
ELSE
@@ -1175,10 +1156,10 @@ PGROUND = PGROUND + ZTIME2 - ZTIME1
IF (IMI==1) THEN ! On calcule les flus turb. comme preconise par PP
! Heat eddy fluxes
- IF ( LTH_FLX ) CALL EDDY_FLUX_n(IMI,KTCOUNT,XVM,XTHM,XRHODJ,XRTHS,XVTH_FLUX_M,XWTH_FLUX_M)
+ IF ( LTH_FLX ) CALL EDDY_FLUX_n(IMI,KTCOUNT,XVT,XTHT,XRHODJ,XRTHS,XVTH_FLUX_M,XWTH_FLUX_M)
!
! Momentum eddy fluxes
- IF ( LUV_FLX ) CALL EDDYUV_FLUX_n(IMI,CLUOUT,KTCOUNT,XVM,XTHM,XRHODJ,XRHODREF,XPABSM,XRVS,XVU_FLUX_M)
+ IF ( LUV_FLX ) CALL EDDYUV_FLUX_n(IMI,CLUOUT,KTCOUNT,XVT,XTHT,XRHODJ,XRHODREF,XPABSM,XRVS,XVU_FLUX_M)
ELSE
! TEST pour maille infèrieure à 20km ?
@@ -1198,7 +1179,7 @@ END IF
!
ZTIME1 = ZTIME2
!
-IF (LPASPOL) CALL PASPOL(PTSTEP_SV, ZSFSV, ILUOUT, NVERB, OCLOSE_OUT, HFMFILE, CLUOUT )
+IF (LPASPOL) CALL PASPOL(XTSTEP, ZSFSV, ILUOUT, NVERB, OCLOSE_OUT, HFMFILE, CLUOUT )
!
!
!* 4b. PASSIVE POLLUTANTS FOR MASS-FLUX SCHEME DIAGNOSTICS
@@ -1301,77 +1282,43 @@ IF ( CTURB == 'TKEL' ) THEN
IF( LTRANS ) THEN
XUT(:,:,:) = XUT(:,:,:) + XUTRANS
XVT(:,:,:) = XVT(:,:,:) + XVTRANS
- XUM(:,:,:) = XUM(:,:,:) + XUTRANS
- XVM(:,:,:) = XVM(:,:,:) + XVTRANS
END IF
!
!
IF(ALLOCATED(XTHW_FLUX)) THEN
DEALLOCATE(XTHW_FLUX)
- ALLOCATE(XTHW_FLUX(SIZE(XTHM,1),SIZE(XTHM,2),SIZE(XTHM,3)))
+ ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
ELSE
- ALLOCATE(XTHW_FLUX(SIZE(XTHM,1),SIZE(XTHM,2),SIZE(XTHM,3)))
+ ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
END IF
IF(ALLOCATED(XRCW_FLUX)) THEN
DEALLOCATE(XRCW_FLUX)
- ALLOCATE(XRCW_FLUX(SIZE(XTHM,1),SIZE(XTHM,2),SIZE(XTHM,3)))
+ ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
ELSE
- ALLOCATE(XRCW_FLUX(SIZE(XTHM,1),SIZE(XTHM,2),SIZE(XTHM,3)))
+ ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
END IF
!
IF(ALLOCATED(XSVW_FLUX)) THEN
DEALLOCATE(XSVW_FLUX)
- ALLOCATE(XSVW_FLUX(SIZE(XSVM,1),SIZE(XSVM,2),SIZE(XSVM,3),SIZE(XSVM,4)))
+ ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
ELSE
- ALLOCATE(XSVW_FLUX(SIZE(XSVM,1),SIZE(XSVM,2),SIZE(XSVM,3),SIZE(XSVM,4)))
+ ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
END IF
!
-IF (HMET_ADV_SCHEME(1:3) == 'PPM') THEN
- IF (HSV_ADV_SCHEME(1:3) == 'PPM') THEN
- CALL TURB(1,IKU,1,IMI,NRR, NRRL, NRRI, CLBCX, CLBCY, 1,NMODEL_CLOUD, &
+ CALL TURB(1,IKU,1,IMI,NRR, NRRL, NRRI, CLBCX, CLBCY, 1,NMODEL_CLOUD, &
OCLOSE_OUT,LTURB_FLX,LTURB_DIAG,LSUBG_COND,LRMC01, &
- CTURBDIM,CTURBLEN,CTOM,CTURBLEN_CLOUD,YINST_SFU,XIMPL, &
- PTSTEP,PTSTEP_MET, PTSTEP_SV,HFMFILE,CLUOUT, &
+ CTURBDIM,CTURBLEN,CTOM,CTURBLEN_CLOUD,XIMPL, &
+ XTSTEP,HFMFILE,CLUOUT, &
XDXX,XDYY,XDZZ,XDZX,XDZY,XZZ, &
XDIRCOSXW,XDIRCOSYW,XDIRCOSZW,XCOSSLOPE,XSINSLOPE, &
XRHODJ,XTHVREF,XRHODREF, &
ZSFTH,ZSFRV,ZSFSV,ZSFU,ZSFV, &
- XPABSM,XUM,XVM,XWM,XTKET,XSVT,XSRCM,XBL_DEPTH,XSBL_DEPTH, &
- XUT,XVT,XWT,XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT, &
+ XPABST,XUT,XVT,XWT,XTKET,XSVT,XSRCT,XBL_DEPTH,XSBL_DEPTH, &
+ XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT, &
XTHT,XRT, &
- XRUS,XRVS,XRWS,XRTHS,XRRS,XRSVS,XRTKES,XSIGS, XWTHVMF, &
+ XRUS,XRVS,XRWS,XRTHS,XRRS,XRSVS,XRTKES,XRTKEMS, XSIGS, XWTHVMF, &
XTHW_FLUX, XRCW_FLUX, XSVW_FLUX )
- ELSE
- CALL TURB(1,IKU,1,IMI,NRR, NRRL, NRRI, CLBCX, CLBCY, 1,NMODEL_CLOUD, &
- OCLOSE_OUT,LTURB_FLX,LTURB_DIAG,LSUBG_COND,LRMC01, &
- CTURBDIM,CTURBLEN,CTOM,CTURBLEN_CLOUD,YINST_SFU,XIMPL, &
- PTSTEP,PTSTEP_MET, PTSTEP_SV,HFMFILE,CLUOUT, &
- XDXX,XDYY,XDZZ,XDZX,XDZY,XZZ, &
- XDIRCOSXW,XDIRCOSYW,XDIRCOSZW,XCOSSLOPE,XSINSLOPE, &
- XRHODJ,XTHVREF,XRHODREF, &
- ZSFTH,ZSFRV,ZSFSV,ZSFU,ZSFV, &
- XPABSM,XUM,XVM,XWM,XTKET,XSVM,XSRCM,XBL_DEPTH,XSBL_DEPTH, &
- XUT,XVT,XWT,XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT, &
- XTHT,XRT, &
- XRUS,XRVS,XRWS,XRTHS,XRRS,XRSVS,XRTKES,XSIGS, XWTHVMF, &
- XTHW_FLUX, XRCW_FLUX, XSVW_FLUX )
- END IF
-ELSE
- CALL TURB(1,IKU,1,IMI,NRR, NRRL, NRRI, CLBCX, CLBCY, 1,NMODEL_CLOUD, &
- OCLOSE_OUT,LTURB_FLX,LTURB_DIAG,LSUBG_COND,LRMC01, &
- CTURBDIM,CTURBLEN,CTOM,CTURBLEN_CLOUD,YINST_SFU,XIMPL, &
- PTSTEP,PTSTEP_MET, PTSTEP_SV,HFMFILE,CLUOUT, &
- XDXX,XDYY,XDZZ,XDZX,XDZY,XZZ, &
- XDIRCOSXW,XDIRCOSYW,XDIRCOSZW,XCOSSLOPE,XSINSLOPE, &
- XRHODJ,XTHVREF,XRHODREF, &
- ZSFTH,ZSFRV,ZSFSV,ZSFU,ZSFV, &
- XPABSM,XUM,XVM,XWM,XTKEM,XSVM,XSRCM,XBL_DEPTH,XSBL_DEPTH, &
- XUT,XVT,XWT,XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT, &
- XTHM,XRM, &
- XRUS,XRVS,XRWS,XRTHS,XRRS,XRSVS,XRTKES,XSIGS, XWTHVMF, &
- XTHW_FLUX, XRCW_FLUX, XSVW_FLUX )
-END IF
!
IF (LRMC01) THEN
CALL ADD2DFIELD_ll(TZFIELDS_ll,XSBL_DEPTH)
@@ -1402,37 +1349,15 @@ IF (CSCONV == 'EDKF') THEN
ALLOCATE(ZEXN (IIU,IJU,IKU))
ALLOCATE(ZSIGMF (IIU,IJU,IKU))
ZSIGMF(:,:,:)=0.
- ZEXN(:,:,:)=(XPABSM(:,:,:)/XP00)**(XRD/XCPD)
- IF (HMET_ADV_SCHEME(1:3) == 'PPM') THEN
- IF (HSV_ADV_SCHEME(1:3) == 'PPM') THEN
- CALL SHALLOW_MF_PACK(NRR,NRRL,NRRI, CMF_UPDRAFT, CMF_CLOUD, LMIXUV, &
- OCLOSE_OUT,LMF_FLX,HFMFILE,CLUOUT,ZTIME_LES_MF, &
- XIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, &
- XDZZ, XZZ, &
- XRHODJ, XRHODREF, XPABSM, ZEXN, ZSFTH, ZSFRV, &
- XTHT,XRT,XUM,XVM,XTKET,XSVT, &
- XRTHS,XRRS,XRUS,XRVS,XRSVS, &
- ZSIGMF,XRC_MF, XRI_MF, XCF_MF, XWTHVMF)
- ELSE
+ ZEXN(:,:,:)=(XPABST(:,:,:)/XP00)**(XRD/XCPD)
CALL SHALLOW_MF_PACK(NRR,NRRL,NRRI, CMF_UPDRAFT, CMF_CLOUD, LMIXUV, &
OCLOSE_OUT,LMF_FLX,HFMFILE,CLUOUT,ZTIME_LES_MF, &
- XIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, &
+ XIMPL_MF, XTSTEP, &
XDZZ, XZZ, &
- XRHODJ, XRHODREF, XPABSM, ZEXN, ZSFTH, ZSFRV, &
- XTHT,XRT,XUM,XVM,XTKET,XSVM, &
+ XRHODJ, XRHODREF, XPABST, ZEXN, ZSFTH, ZSFRV, &
+ XTHT,XRT,XUT,XVT,XTKET,XSVT, &
XRTHS,XRRS,XRUS,XRVS,XRSVS, &
ZSIGMF,XRC_MF, XRI_MF, XCF_MF, XWTHVMF)
- END IF
- ELSE
- CALL SHALLOW_MF_PACK(NRR,NRRL,NRRI, CMF_UPDRAFT, CMF_CLOUD, LMIXUV, &
- OCLOSE_OUT,LMF_FLX,HFMFILE,CLUOUT,ZTIME_LES_MF, &
- XIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, &
- XDZZ, XZZ, &
- XRHODJ, XRHODREF, XPABSM, ZEXN, ZSFTH, ZSFRV, &
- XTHM,XRM,XUM,XVM,XTKEM,XSVM, &
- XRTHS,XRRS,XRUS,XRVS,XRSVS, &
- ZSIGMF,XRC_MF, XRI_MF, XCF_MF, XWTHVMF)
- END IF
!
ELSE
XWTHVMF(:,:,:)=0.
@@ -1446,8 +1371,6 @@ CALL SECOND_MNH2(ZTIME4)
IF( LTRANS ) THEN
XUT(:,:,:) = XUT(:,:,:) - XUTRANS
XVT(:,:,:) = XVT(:,:,:) - XVTRANS
- XUM(:,:,:) = XUM(:,:,:) - XUTRANS
- XVM(:,:,:) = XVM(:,:,:) - XVTRANS
END IF
IF (CMF_CLOUD == 'STAT') THEN
@@ -1480,7 +1403,7 @@ XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
IF (LUSECHEM) THEN
- CALL CH_MONITOR_n(ZWETDEPAER,KTCOUNT,PTSTEP_SV, ILUOUT, NVERB)
+ CALL CH_MONITOR_n(ZWETDEPAER,KTCOUNT,XTSTEP, ILUOUT, NVERB)
END IF
!
! For inert aerosol (dust and sea salt) => aer_monitor_n
@@ -1514,7 +1437,7 @@ IF ((LDUST).OR.(LSALT)) THEN
END IF
!
- CALL AER_MONITOR_n(KTCOUNT,PTSTEP_SV, ILUOUT, NVERB, GCLD)
+ CALL AER_MONITOR_n(KTCOUNT,XTSTEP, ILUOUT, NVERB, GCLD)
END IF
!
!
diff --git a/src/MNH/ppm_met.f90 b/src/MNH/ppm_met.f90
index dd222013f..db973e51b 100644
--- a/src/MNH/ppm_met.f90
+++ b/src/MNH/ppm_met.f90
@@ -7,11 +7,10 @@ INTERFACE
!
SUBROUTINE PPM_MET (HLBCX,HLBCY, KRR, KTCOUNT, &
PCRU, PCRV, PCRW, PTSTEP, PRHODJ, &
- PTHT, PTKET, PRT, &
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, &
+ PRHOZ1, PRHOZ2, PTHT, PTKET, PRT, &
PRTHS, PRTKES, PRRS, HMET_ADV_SCHEME )
!
-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
CHARACTER (LEN=6), INTENT(IN) :: HMET_ADV_SCHEME
@@ -23,6 +22,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! Courant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV ! numbers
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW !
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+! Temporary advected rhodj
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1,PRHOX2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1,PRHOY2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1,PRHOZ2
!
REAL, INTENT(IN) :: PTSTEP ! Single Time step
!
@@ -41,7 +44,8 @@ END MODULE MODI_PPM_MET
! ######################################################################
SUBROUTINE PPM_MET (HLBCX,HLBCY, KRR, KTCOUNT, &
PCRU, PCRV, PCRW, PTSTEP, PRHODJ, &
- PTHT, PTKET, PRT, &
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, &
+ PRHOZ1, PRHOZ2, PTHT, PTKET, PRT, &
PRTHS, PRTKES, PRRS, HMET_ADV_SCHEME )
! ######################################################################
!
@@ -71,6 +75,7 @@ END MODULE MODI_PPM_MET
!! MODIFICATIONS
!! -------------
!! Original 11.05.2006. T.Maric
+!! Modification : 11.2011 C.Lac, V.Masson : Advection of (theta_l,r_t)
!!
!-------------------------------------------------------------------------------
!
@@ -81,11 +86,8 @@ END MODULE MODI_PPM_MET
!
USE MODD_PARAMETERS
USE MODD_CONF
-USE MODD_BUDGET
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
!
USE MODI_SHUMAN
-USE MODI_BUDGET
USE MODI_PPM
USE MODI_ADVEC_PPM_ALGO
!
@@ -108,6 +110,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW ! of momentum
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+! Temporary advected rhodj
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1,PRHOX2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1,PRHOY2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1,PRHOZ2
!
REAL, INTENT(IN) :: PTSTEP ! Time step
!
@@ -130,12 +136,6 @@ INTEGER :: IGRID ! localisation on the model grid
! Advection source term calulated in the PPM algorithm
REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZSRC
!
-! Temporary advected rhodj
-REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZRHOX1,ZRHOX2
-REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZRHOY1,ZRHOY2
-REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZRHOZ1,ZRHOZ2
-REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZUNIT
-!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTES THE DOMAIN DIMENSIONS
@@ -150,36 +150,24 @@ GTKEALLOC = SIZE(PTKET,1) /= 0
!
IGRID = 1
!
-! Calculate the advection of the density RHODJ to pass to the algorithm
-!
-ZUNIT = 1.0
-ZRHOX1 = PPM_S0_X(HLBCX, IGRID, ZUNIT, PCRU, PRHODJ, PTSTEP)
-ZRHOY1 = PPM_S0_Y(HLBCY, IGRID, ZUNIT, PCRV, ZRHOX1, PTSTEP)
-ZRHOZ1 = PPM_S0_Z(IGRID, ZUNIT, PCRW, ZRHOY1, PTSTEP)
-ZRHOZ2 = PPM_S0_Z(IGRID, ZUNIT, PCRW, PRHODJ, PTSTEP)
-ZRHOY2 = PPM_S0_Y(HLBCY, IGRID, ZUNIT, PCRV, ZRHOZ2, PTSTEP)
-ZRHOX2 = PPM_S0_X(HLBCX, IGRID, ZUNIT, PCRU, ZRHOY2, PTSTEP)
-!
!
! Potential temperature
!
CALL ADVEC_PPM_ALGO(HMET_ADV_SCHEME, HLBCX, HLBCY, IGRID, PTHT, PRHODJ, PTSTEP, &
- ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1, PRHOZ2, &
ZSRC, KTCOUNT, PCRU, PCRV, PCRW)
! add the advection to the sources
PRTHS = PRTHS + ZSRC
!
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADV_BU_RTH')
!
! Turbulence variables
!
IF (GTKEALLOC) THEN
CALL ADVEC_PPM_ALGO(HMET_ADV_SCHEME, HLBCX, HLBCY, IGRID, PTKET,PRHODJ,PTSTEP, &
- ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1, PRHOZ2, &
ZSRC, KTCOUNT, PCRU, PCRV, PCRW)
PRTKES = PRTKES + ZSRC
!
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADV_BU_RTKE')
!
END IF
!
@@ -189,19 +177,11 @@ END IF
!
DO JRR=1,KRR
!
- CALL ADVEC_PPM_ALGO(HMET_ADV_SCHEME, HLBCX, HLBCY, IGRID, PRT(:,:,:,JRR), &
- PRHODJ, PTSTEP, &
- ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
- ZSRC, KTCOUNT, PCRU, PCRV, PCRW)
+ CALL ADVEC_PPM_ALGO(HMET_ADV_SCHEME, HLBCX, HLBCY, IGRID, &
+ PRT(:,:,:,JRR), PRHODJ, PTSTEP, &
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1, PRHOZ2, &
+ ZSRC, KTCOUNT, PCRU, PCRV, PCRW )
PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) + ZSRC(:,:,:)
-!
- IF (JRR==1.AND.LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'ADV_BU_RRV')
- IF (JRR==2.AND.LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'ADV_BU_RRC')
- IF (JRR==3.AND.LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8,'ADV_BU_RRR')
- IF (JRR==4.AND.LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'ADV_BU_RRI')
- IF (JRR==5.AND.LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADV_BU_RRS')
- IF (JRR==6.AND.LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADV_BU_RRG')
- IF (JRR==7.AND.LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADV_BU_RRH')
!
END DO
!
diff --git a/src/MNH/ppm_rhodj.f90 b/src/MNH/ppm_rhodj.f90
new file mode 100644
index 000000000..1b328780b
--- /dev/null
+++ b/src/MNH/ppm_rhodj.f90
@@ -0,0 +1,114 @@
+!
+! #####################
+ MODULE MODI_PPM_RHODJ
+! #####################
+!
+INTERFACE
+!
+ SUBROUTINE PPM_RHODJ (HLBCX,HLBCY, &
+ PCRU, PCRV, PCRW, PTSTEP, PRHODJ, &
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, &
+ PRHOZ1, PRHOZ2 )
+!
+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) :: PCRU ! Contravariants compon.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+!
+REAL, INTENT(IN) :: PTSTEP ! Single Time step
+! Temporary advected rhodj
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOX1,PRHOX2
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOY1,PRHOY2
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOZ1,PRHOZ2
+!
+END SUBROUTINE PPM_RHODJ
+!
+END INTERFACE
+!
+END MODULE MODI_PPM_RHODJ
+!
+! ######################################################################
+ SUBROUTINE PPM_RHODJ (HLBCX,HLBCY, &
+ PCRU, PCRV, PCRW, PTSTEP, PRHODJ, &
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, &
+ PRHOZ1, PRHOZ2 )
+! ######################################################################
+!
+!!**** *PPM_RHODJ *
+!!
+!! PURPOSE
+!! -------
+!! Calculate the advection of the density RHODJ to pass to the algorithm PPM
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 11.05.2006. T.Maric
+!! C.Lac 04.2011 Splitted from ppm_met.f90 and ppm_scalar.f90
+!! to limit duplication in the time splitting
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_PPM
+!
+!
+!
+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
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! contravariant
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV ! components
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW ! of momentum
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+! Temporary advected rhodj
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOX1,PRHOX2
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOY1,PRHOY2
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOZ1,PRHOZ2
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IGRID ! localisation on the model grid
+!
+REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZUNIT
+!
+!-------------------------------------------------------------------------------
+!
+!
+IGRID = 1
+!
+ZUNIT = 1.0
+PRHOX1 = PPM_S0_X(HLBCX, IGRID, ZUNIT, PCRU, PRHODJ, PTSTEP)
+PRHOY1 = PPM_S0_Y(HLBCY, IGRID, ZUNIT, PCRV, PRHOX1, PTSTEP)
+PRHOZ1 = PPM_S0_Z(IGRID, ZUNIT, PCRW, PRHOY1, PTSTEP)
+PRHOZ2 = PPM_S0_Z(IGRID, ZUNIT, PCRW, PRHODJ, PTSTEP)
+PRHOY2 = PPM_S0_Y(HLBCY, IGRID, ZUNIT, PCRV, PRHOZ2, PTSTEP)
+PRHOX2 = PPM_S0_X(HLBCX, IGRID, ZUNIT, PCRU, PRHOY2, PTSTEP)
+!
+!
+END SUBROUTINE PPM_RHODJ
diff --git a/src/MNH/ppm_scalar.f90 b/src/MNH/ppm_scalar.f90
index a366043c8..cf61579a2 100644
--- a/src/MNH/ppm_scalar.f90
+++ b/src/MNH/ppm_scalar.f90
@@ -8,7 +8,9 @@ INTERFACE
!
SUBROUTINE PPM_SCALAR (HLBCX,HLBCY, KSV, KTCOUNT, &
PCRU, PCRV, PCRW, PTSTEP, PRHODJ, &
- PSVT, PRSVS, HSV_ADV_SCHEME )
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, &
+ PRHOZ1, PRHOZ2, &
+ PSVT, PRSVS, HSV_ADV_SCHEME )
!
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
!
@@ -23,6 +25,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! Courant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV ! numbers
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW !
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+! Temporary advected rhodj
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1,PRHOX2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1,PRHOY2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1,PRHOZ2
!
REAL, INTENT(IN) :: PTSTEP ! Time step
!
@@ -38,9 +44,11 @@ END INTERFACE
END MODULE MODI_PPM_SCALAR
!
! ######################################################################
- SUBROUTINE PPM_SCALAR (HLBCX,HLBCY, KSV, KTCOUNT, &
- PCRU, PCRV, PCRW, PTSTEP, PRHODJ, &
- PSVT, PRSVS, HSV_ADV_SCHEME )
+ SUBROUTINE PPM_SCALAR (HLBCX,HLBCY, KSV, KTCOUNT, &
+ PCRU, PCRV, PCRW, PTSTEP, PRHODJ, &
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, &
+ PRHOZ1, PRHOZ2, &
+ PSVT, PRSVS, HSV_ADV_SCHEME )
! ######################################################################
!
!!**** *PPM_SCALAR *
@@ -69,6 +77,7 @@ END MODULE MODI_PPM_SCALAR
!! MODIFICATIONS
!! -------------
!! Original 11.05.2006. T.Maric
+!! Modification : 11.2011 C.Lac, V.Masson : Advection of (theta_l,r_t)
!!
!-------------------------------------------------------------------------------
!
@@ -79,11 +88,9 @@ END MODULE MODI_PPM_SCALAR
!
USE MODD_PARAMETERS
USE MODD_CONF
-USE MODD_BUDGET
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
!
USE MODI_SHUMAN
-USE MODI_BUDGET
USE MODI_PPM
USE MODI_ADVEC_PPM_ALGO
!
@@ -103,6 +110,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW ! of momentum
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+! Temporary advected rhodj
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1,PRHOX2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1,PRHOY2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1,PRHOZ2
!
REAL, INTENT(IN) :: PTSTEP ! Time step
!
@@ -122,11 +133,6 @@ INTEGER :: IGRID ! localisation on the model grid
! Advection source term calulated in the PPM algorithm
REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZSRC
!
-! Temporary advected rhodj
-REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZRHOX1,ZRHOX2
-REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZRHOY1,ZRHOY2
-REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZRHOZ1,ZRHOZ2
-REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZUNIT
!
!-------------------------------------------------------------------------------
!
@@ -135,28 +141,16 @@ REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZUNIT
!
IGRID = 1
!
-! Calculate the advection of the density RHODJ to pass to the algorithm
-!
-ZUNIT = 1.0
-ZRHOX1 = PPM_S0_X(HLBCX, IGRID, ZUNIT, PCRU, PRHODJ, PTSTEP)
-ZRHOY1 = PPM_S0_Y(HLBCY, IGRID, ZUNIT, PCRV, ZRHOX1, PTSTEP)
-ZRHOZ1 = PPM_S0_Z(IGRID, ZUNIT, PCRW, ZRHOY1, PTSTEP)
-ZRHOZ2 = PPM_S0_Z(IGRID, ZUNIT, PCRW, PRHODJ, PTSTEP)
-ZRHOY2 = PPM_S0_Y(HLBCY, IGRID, ZUNIT, PCRV, ZRHOZ2, PTSTEP)
-ZRHOX2 = PPM_S0_X(HLBCX, IGRID, ZUNIT, PCRU, ZRHOY2, PTSTEP)
-!
! Case with KSV tracers
!
DO JSV=1,KSV
!
CALL ADVEC_PPM_ALGO(HSV_ADV_SCHEME, HLBCX, HLBCY, IGRID, PSVT(:,:,:,JSV), &
PRHODJ, PTSTEP, &
- ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1, PRHOZ2, &
ZSRC, KTCOUNT, PCRU, PCRV, PCRW)
! add the advection to the sources
PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + ZSRC(:,:,:)
-!
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADV_BU_RSV')
!
END DO
!
diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90
index ef79ccd22..07dd4fcab 100644
--- a/src/MNH/prep_ideal_case.f90
+++ b/src/MNH/prep_ideal_case.f90
@@ -380,6 +380,7 @@ USE MODI_GOTO_SURFEX
USE MODI_PGD_GRID_SURF_ATM
USE MODI_SPLIT_GRID
USE MODI_PGD_SURF_ATM
+USE MODI_ICE_ADJUST_BIS
USE MODI_WRITE_PGD_SURF_ATM_n
USE MODI_PREP_SURF_MNH
USE MODI_ALLOC_SURFEX
@@ -848,10 +849,7 @@ 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)
-!JUAN
-! CALL INI_PARA_ll(IINFO_ll)
CALL INI_PARAZ_ll(IINFO_ll)
-!JUAN
!
! sizes of arrays of the extended sub-domain
!
@@ -861,7 +859,6 @@ CALL GET_INDICE_ll(NIB,NJB,NIE,NJE)
CALL GET_OR_ll('B',IXOR,IYOR)
NKB=1+JPVEXT
NKU=NKMAX+2*JPVEXT
-!JUAN
!
!* 4.3 Global variables absent from the modules :
!
@@ -880,13 +877,13 @@ END SELECT
!
!* 4.4 Prognostic variables at M instant (module MODD_FIELD1):
!
-ALLOCATE(XUM(NIU,NJU,NKU))
-ALLOCATE(XVM(NIU,NJU,NKU))
-ALLOCATE(XWM(NIU,NJU,NKU))
-ALLOCATE(XTHM(NIU,NJU,NKU))
-ALLOCATE(XPABSM(NIU,NJU,NKU))
-ALLOCATE(XRM(NIU,NJU,NKU,NRR))
-ALLOCATE(XSVM(NIU,NJU,NKU,NSV))
+ALLOCATE(XUT(NIU,NJU,NKU))
+ALLOCATE(XVT(NIU,NJU,NKU))
+ALLOCATE(XWT(NIU,NJU,NKU))
+ALLOCATE(XTHT(NIU,NJU,NKU))
+ALLOCATE(XPABST(NIU,NJU,NKU))
+ALLOCATE(XRT(NIU,NJU,NKU,NRR))
+ALLOCATE(XSVT(NIU,NJU,NKU,NSV))
!
!* 4.5 Grid variables (module MODD_GRID1 and MODD_METRICS1):
!
@@ -1481,20 +1478,20 @@ CALL TOTAL_DMASS(CLUOUT,XJ,XRHODREF,XDRYMASST)
!* 5.6 Complete prognostic variables (multipliy by rhoJ) at time t :
!
! U grid : gridpoint 2
-IF (LWEST_ll()) XUM(1,:,:) = 2.*XUM(2,:,:) - XUM(3,:,:)
+IF (LWEST_ll()) XUT(1,:,:) = 2.*XUT(2,:,:) - XUT(3,:,:)
! V grid : gridpoint 3
-IF (LSOUTH_ll()) XVM(:,1,:) = 2.*XVM(:,2,:) - XVM(:,3,:)
+IF (LSOUTH_ll()) XVT(:,1,:) = 2.*XVT(:,2,:) - XVT(:,3,:)
! SV : gridpoint 1
-XSVM(:,:,:,:) = 0.
+XSVT(:,:,:,:) = 0.
!
!
!* 5.7 Larger scale fields initialization :
!
-XLSUM(:,:,:) = XUM(:,:,:) ! these fields do not satisfy the
-XLSVM(:,:,:) = XVM(:,:,:) ! lower boundary condition but are
-XLSWM(:,:,:) = XWM(:,:,:) ! in equilibrium
-XLSTHM(:,:,:)= XTHM(:,:,:)
-XLSRVM(:,:,:)= XRM(:,:,:,1)
+XLSUM(:,:,:) = XUT(:,:,:) ! these fields do not satisfy the
+XLSVM(:,:,:) = XVT(:,:,:) ! lower boundary condition but are
+XLSWM(:,:,:) = XWT(:,:,:) ! in equilibrium
+XLSTHM(:,:,:)= XTHT(:,:,:)
+XLSRVM(:,:,:)= XRT(:,:,:,1)
!
! enforce the vertical homogeneity under the ground and above the top of
! the model for the LS fields
@@ -1515,42 +1512,42 @@ END IF
ILBX=SIZE(XLBXUM,1)
ILBY=SIZE(XLBYUM,2)
IF(LWEST_ll() .AND. .NOT. L1D) THEN
- XLBXUM(1:NRIMX+1, :,:) = XUM(2:NRIMX+2, :,:)
- XLBXVM(1:NRIMX+1, :,:) = XVM(1:NRIMX+1, :,:)
- XLBXWM(1:NRIMX+1, :,:) = XWM(1:NRIMX+1, :,:)
- XLBXTHM(1:NRIMX+1, :,:) = XTHM(1:NRIMX+1, :,:)
- XLBXRM(1:NRIMX+1, :,:,:) = XRM(1:NRIMX+1, :,:,:)
+ XLBXUM(1:NRIMX+1, :,:) = XUT(2:NRIMX+2, :,:)
+ XLBXVM(1:NRIMX+1, :,:) = XVT(1:NRIMX+1, :,:)
+ XLBXWM(1:NRIMX+1, :,:) = XWT(1:NRIMX+1, :,:)
+ XLBXTHM(1:NRIMX+1, :,:) = XTHT(1:NRIMX+1, :,:)
+ XLBXRM(1:NRIMX+1, :,:,:) = XRT(1:NRIMX+1, :,:,:)
ENDIF
IF(LEAST_ll() .AND. .NOT. L1D) THEN
- XLBXUM(ILBX-NRIMX:ILBX,:,:) = XUM(NIU-NRIMX:NIU, :,:)
- XLBXVM(ILBX-NRIMX:ILBX,:,:) = XVM(NIU-NRIMX:NIU, :,:)
- XLBXWM(ILBX-NRIMX:ILBX,:,:) = XWM(NIU-NRIMX:NIU, :,:)
- XLBXTHM(ILBX-NRIMX:ILBX,:,:) = XTHM(NIU-NRIMX:NIU, :,:)
- XLBXRM(ILBX-NRIMX:ILBX,:,:,:) = XRM(NIU-NRIMX:NIU, :,:,:)
+ XLBXUM(ILBX-NRIMX:ILBX,:,:) = XUT(NIU-NRIMX:NIU, :,:)
+ XLBXVM(ILBX-NRIMX:ILBX,:,:) = XVT(NIU-NRIMX:NIU, :,:)
+ XLBXWM(ILBX-NRIMX:ILBX,:,:) = XWT(NIU-NRIMX:NIU, :,:)
+ XLBXTHM(ILBX-NRIMX:ILBX,:,:) = XTHT(NIU-NRIMX:NIU, :,:)
+ XLBXRM(ILBX-NRIMX:ILBX,:,:,:) = XRT(NIU-NRIMX:NIU, :,:,:)
ENDIF
IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) THEN
- XLBYUM(:,1:NRIMY+1, :) = XUM(:,1:NRIMY+1, :)
- XLBYVM(:,1:NRIMY+1, :) = XVM(:,2:NRIMY+2, :)
- XLBYWM(:,1:NRIMY+1, :) = XWM(:,1:NRIMY+1, :)
- XLBYTHM(:,1:NRIMY+1, :) = XTHM(:,1:NRIMY+1, :)
- XLBYRM(:,1:NRIMY+1, :,:) = XRM(:,1:NRIMY+1, :,:)
+ XLBYUM(:,1:NRIMY+1, :) = XUT(:,1:NRIMY+1, :)
+ XLBYVM(:,1:NRIMY+1, :) = XVT(:,2:NRIMY+2, :)
+ XLBYWM(:,1:NRIMY+1, :) = XWT(:,1:NRIMY+1, :)
+ XLBYTHM(:,1:NRIMY+1, :) = XTHT(:,1:NRIMY+1, :)
+ XLBYRM(:,1:NRIMY+1, :,:) = XRT(:,1:NRIMY+1, :,:)
ENDIF
IF(LNORTH_ll().AND. .NOT. L1D .AND. .NOT. L2D) THEN
- XLBYUM(:,ILBY-NRIMY:ILBY,:) = XUM(:,NJU-NRIMY:NJU, :)
- XLBYVM(:,ILBY-NRIMY:ILBY,:) = XVM(:,NJU-NRIMY:NJU, :)
- XLBYWM(:,ILBY-NRIMY:ILBY,:) = XWM(:,NJU-NRIMY:NJU, :)
- XLBYTHM(:,ILBY-NRIMY:ILBY,:) = XTHM(:,NJU-NRIMY:NJU, :)
- XLBYRM(:,ILBY-NRIMY:ILBY,:,:) = XRM(:,NJU-NRIMY:NJU, :,:)
+ XLBYUM(:,ILBY-NRIMY:ILBY,:) = XUT(:,NJU-NRIMY:NJU, :)
+ XLBYVM(:,ILBY-NRIMY:ILBY,:) = XVT(:,NJU-NRIMY:NJU, :)
+ XLBYWM(:,ILBY-NRIMY:ILBY,:) = XWT(:,NJU-NRIMY:NJU, :)
+ XLBYTHM(:,ILBY-NRIMY:ILBY,:) = XTHT(:,NJU-NRIMY:NJU, :)
+ XLBYRM(:,ILBY-NRIMY:ILBY,:,:) = XRT(:,NJU-NRIMY:NJU, :,:)
ENDIF
DO JSV = 1, NSV
IF(LWEST_ll() .AND. .NOT. L1D) &
- XLBXSVM(1:NRIMX+1, :,:,JSV) = XSVM(1:NRIMX+1, :,:,JSV)
+ XLBXSVM(1:NRIMX+1, :,:,JSV) = XSVT(1:NRIMX+1, :,:,JSV)
IF(LEAST_ll() .AND. .NOT. L1D) &
- XLBXSVM(ILBX-NRIMX:ILBX,:,:,JSV) = XSVM(NIU-NRIMX:NIU, :,:,JSV)
+ XLBXSVM(ILBX-NRIMX:ILBX,:,:,JSV) = XSVT(NIU-NRIMX:NIU, :,:,JSV)
IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
- XLBYSVM(:,1:NRIMY+1, :,JSV) = XSVM(:,1:NRIMY+1, :,JSV)
+ XLBYSVM(:,1:NRIMY+1, :,JSV) = XSVT(:,1:NRIMY+1, :,JSV)
IF(LNORTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
- XLBYSVM(:,ILBY-NRIMY:ILBY,:,JSV) = XSVM(:,NJU-NRIMY:NJU, :,JSV)
+ XLBYSVM(:,ILBY-NRIMY:ILBY,:,JSV) = XSVT(:,NJU-NRIMY:NJU, :,JSV)
END DO
!
!
@@ -1561,7 +1558,9 @@ IF(LPERTURB) CALL SET_PERTURB(CEXPRE)
!
!* 5.9 Anelastic correction and pressure:
!
+CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
IF ( .NOT. L1D ) CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ)
+CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
!
!
!* 5.10 Compute THETA, vapor and cloud mixing ratio
@@ -1577,40 +1576,40 @@ IF (CIDEAL == 'RSOU') THEN
ALLOCATE(ZFRAC_ICE(NIU,NJU,NKU))
ALLOCATE(ZRSATW(NIU,NJU,NKU))
ALLOCATE(ZRSATI(NIU,NJU,NKU))
- ZRT=XRM(:,:,:,1)+XRM(:,:,:,2)+XRM(:,:,:,4)
- ZEXN=(XPABSM/XP00) ** (XRD/XCPD)
- ZT=XTHM*(XPABSM/XP00)**(XRD/XCPD)
- ZCPH=XCPD+ XCPV * XRM(:,:,:,1)+ XCL *XRM(:,:,:,2) + XCI * XRM(:,:,:,4)
+ ZRT=XRT(:,:,:,1)+XRT(:,:,:,2)+XRT(:,:,:,4)
+ ZEXN=(XPABST/XP00) ** (XRD/XCPD)
+ ZT=XTHT*(XPABST/XP00)**(XRD/XCPD)
+ ZCPH=XCPD+ XCPV * XRT(:,:,:,1)+ XCL *XRT(:,:,:,2) + XCI * XRT(:,:,:,4)
ZLVOCPEXN = (XLVTT + (XCPV-XCL) * (ZT-XTT))/(ZCPH*ZEXN)
ZLSOCPEXN = (XLSTT + (XCPV-XCI) * (ZT-XTT))/(ZCPH*ZEXN)
- ZTHL=XTHM-ZLVOCPEXN*XRM(:,:,:,2)-ZLSOCPEXN*XRM(:,:,:,4)
+ ZTHL=XTHT-ZLVOCPEXN*XRT(:,:,:,2)-ZLSOCPEXN*XRT(:,:,:,4)
DEALLOCATE(ZEXN)
DEALLOCATE(ZT)
DEALLOCATE(ZCPH)
DEALLOCATE(ZLVOCPEXN)
DEALLOCATE(ZLSOCPEXN)
- CALL TH_R_FROM_THL_RT_3D('T',ZFRAC_ICE,XPABSM,ZTHL,ZRT,XTHM,XRM(:,:,:,1), &
- XRM(:,:,:,2),XRM(:,:,:,4),ZRSATW, ZRSATI)
+ CALL TH_R_FROM_THL_RT_3D('T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
+ XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI)
DEALLOCATE(ZTHL)
DEALLOCATE(ZRT)
! Coherence test
IF ((.NOT. LUSERI) ) THEN
- IF (MAXVAL(XRM(:,:,:,4))/= 0) THEN
+ IF (MAXVAL(XRT(:,:,:,4))/= 0) THEN
WRITE(NLUOUT,FMT=*) "*********************************"
WRITE(NLUOUT,FMT=*) 'WARNING'
WRITE(NLUOUT,FMT=*) 'YOU HAVE LUSERI=FALSE '
WRITE(NLUOUT,FMT=*) ' BUT WITH YOUR RADIOSOUNDING Ri/=0'
- WRITE(NLUOUT,FMT=*) MINVAL(XRM(:,:,:,4)),MAXVAL(XRM(:,:,:,4))
+ WRITE(NLUOUT,FMT=*) MINVAL(XRT(:,:,:,4)),MAXVAL(XRT(:,:,:,4))
WRITE(NLUOUT,FMT=*) "*********************************"
ENDIF
ENDIF
IF ((.NOT. LUSERC)) THEN
- IF (MAXVAL(XRM(:,:,:,2))/= 0) THEN
+ IF (MAXVAL(XRT(:,:,:,2))/= 0) THEN
WRITE(NLUOUT,FMT=*) "*********************************"
WRITE(NLUOUT,FMT=*) 'WARNING'
WRITE(NLUOUT,FMT=*) 'YOU HAVE LUSERC=FALSE '
WRITE(NLUOUT,FMT=*) 'BUT WITH YOUR RADIOSOUNDING RC/=0'
- WRITE(NLUOUT,FMT=*) MINVAL(XRM(:,:,:,2)),MAXVAL(XRM(:,:,:,2))
+ WRITE(NLUOUT,FMT=*) MINVAL(XRT(:,:,:,2)),MAXVAL(XRT(:,:,:,2))
WRITE(NLUOUT,FMT=*) "*********************************"
ENDIF
ENDIF
@@ -1626,7 +1625,7 @@ END IF
!
! before calling chemistry
CCONF = 'START'
-CSTORAGE_TYPE='TT' ! instant t and t-dt are the same
+CSTORAGE_TYPE='TT'
CALL CLOSE_ll(CEXPRE,IOSTAT=NRESP) ! Close the EXPRE file
!
IF ( LCH_INIT_FIELD ) CALL CH_INIT_FIELD_n(1, NLUOUT, NVERB)
diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90
index 5623df432..9c2bd1256 100644
--- a/src/MNH/prep_real_case.f90
+++ b/src/MNH/prep_real_case.f90
@@ -407,6 +407,7 @@ USE MODI_MNHREAD_ZS_DUMMY_n
USE MODI_MNHWRITE_ZS_DUMMY_n
USE MODI_COMPARE_DAD
USE MODI_PREP_SURF_MNH
+USE MODI_ICE_ADJUST_BIS
!
USE MODD_CONF ! declaration modules
USE MODD_CONF_n
@@ -942,6 +943,13 @@ IF (ALLOCATED(XZSMT_LS)) DEALLOCATE(XZSMT_LS)
!
!-------------------------------------------------------------------------------
!
+!
+!* 13. MICROPHYSICAL ADJUSTMENT
+! ------------------------
+!CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+!
+!-------------------------------------------------------------------------------
+!
!* 13. ANELASTIC CORRECTION
! --------------------
!
@@ -952,6 +960,13 @@ ZDYN = ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
+!* 13. MICROPHYSICAL ADJUSTMENT
+! ------------------------
+!
+!CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+!
+!-------------------------------------------------------------------------------
+!
!* 14. INITIALIZATION OF THE REMAINING PROGNOSTIC VARIABLES (COPIES)
! -------------------------------------------------------------
!
@@ -978,8 +993,7 @@ CALL BOUNDARIES ( &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
XRHODJ, &
- XUM, XVM, XWM, XTHM, XTKEM, XRM, XSVM,XSRCM, &
- XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT )
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
!
CALL SECOND_MNH(ZTIME2)
ZMISC = ZMISC + ZTIME2 - ZTIME1
@@ -992,7 +1006,7 @@ ZMISC = ZMISC + ZTIME2 - ZTIME1
ZTIME1 = ZTIME2
!
IF (YATMFILETYPE=='GRIBEX' .AND. NVERB>1) THEN
- CALL ERROR_ON_TEMPERATURE(XT_LS,XPMASS_LS,XPABSM,XPS_LS,XPSURF)
+ CALL ERROR_ON_TEMPERATURE(XT_LS,XPMASS_LS,XPABST,XPS_LS,XPSURF)
END IF
!
IF (YATMFILETYPE=='GRIBEX') THEN
diff --git a/src/MNH/pressure_in_prep.f90 b/src/MNH/pressure_in_prep.f90
index 5a7c8e7ea..e11e41b68 100644
--- a/src/MNH/pressure_in_prep.f90
+++ b/src/MNH/pressure_in_prep.f90
@@ -82,13 +82,11 @@ USE MODD_DIM_n
USE MODD_GRID_n
USE MODD_LBC_n
USE MODD_PARAMETERS
-USE MODD_FIELD_n, ONLY: XUM,XVM,XWM
+USE MODD_FIELD_n, ONLY: XUT,XVT,XWT
USE MODD_DYN_n
USE MODD_REF_n
USE MODD_CST
-!JUAN REALZ
USE MODE_MPPDB
-!JUAN REALZ
!
IMPLICIT NONE
!
@@ -123,11 +121,9 @@ INTEGER :: IKU
INTEGER :: IINFO_ll
REAL :: ZMAXRES
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-!JUAN
REAL :: ZMAXVAL,ZRESIDUAL
INTEGER, DIMENSION(3) :: IMAXLOC
INTEGER :: I,J,K
-!JUAN
!-------------------------------------------------------------------------------
!
!* 1. Initialisations
@@ -143,10 +139,9 @@ IKB=1+JPVEXT
IKE=NKMAX+JPVEXT
IKU=IKE+JPVEXT
!
-ZU(:,:,:) = XUM(:,:,:)
-ZV(:,:,:) = XVM(:,:,:)
-ZW(:,:,:) = XWM(:,:,:)
-
+ZU(:,:,:) = XUT(:,:,:)
+ZV(:,:,:) = XVT(:,:,:)
+ZW(:,:,:) = XWT(:,:,:)
!
NULLIFY(TZFIELDS_ll)
!
@@ -156,22 +151,19 @@ NULLIFY(TZFIELDS_ll)
! ----
!
DO
- XUM(:,:,:) = ZU(:,:,:)
- XVM(:,:,:) = ZV(:,:,:)
- XWM(:,:,:) = ZW(:,:,:)
-!JUAN REALZ
- CALL ADD3DFIELD_ll(TZFIELDS_ll, XUM)
- CALL ADD3DFIELD_ll(TZFIELDS_ll, XVM)
- CALL ADD3DFIELD_ll(TZFIELDS_ll, XWM)
+ XUT(:,:,:) = ZU(:,:,:)
+ XVT(:,:,:) = ZV(:,:,:)
+ XWT(:,:,:) = ZW(:,:,:)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XUT)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XVT)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll, XWT)
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
- CALL MPPDB_CHECK3D(XUM,"PREP::XUM",PRECISION)
- CALL MPPDB_CHECK3D(XVM,"PREP::XVM",PRECISION)
- CALL MPPDB_CHECK3D(XWM,"PREP::XWM",PRECISION)
+ CALL MPPDB_CHECK3D(XUT,"PREP::XUM",PRECISION)
+ CALL MPPDB_CHECK3D(XVT,"PREP::XVM",PRECISION)
+ CALL MPPDB_CHECK3D(XWT,"PREP::XWM",PRECISION)
CALL MPPDB_CHECK3D(XRHODJ,"PREP::XRHODJ",PRECISION)
-
-!JUAN REALZ
!
!-------------------------------------------------------------------------------
!
@@ -184,16 +176,16 @@ DO
IF (CPRESOPT=='RICHA') &
WRITE(ILUOUT0,*) 'XRELAX = ',XRELAX
!
- CALL ANEL_BALANCE_n('M',ZRESIDUAL)
+ CALL ANEL_BALANCE_n(ZRESIDUAL)
!
!-------------------------------------------------------------------------------
!
!* 4. compute the residual divergence
! -------------------------------
!
- ZRU(:,:,:) = XUM(:,:,:) * MXM(XRHODJ)
- ZRV(:,:,:) = XVM(:,:,:) * MYM(XRHODJ)
- ZRW(:,:,:) = XWM(:,:,:) * MZM(1,IKU,1,XRHODJ)
+ ZRU(:,:,:) = XUT(:,:,:) * MXM(XRHODJ)
+ ZRV(:,:,:) = XVT(:,:,:) * MYM(XRHODJ)
+ ZRW(:,:,:) = XWT(:,:,:) * MZM(1,IKU,1,XRHODJ)
!
CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRU)
CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRV)
@@ -208,32 +200,8 @@ DO
ELSE
ZDIV=ZDIV/XRHODJ/XTH00*XRHODREF*XTHVREF*(1.+XRVREF)
END IF
- !JUAN FAUX ZMAXVAL=MAX_ll( ABS(ZDIV),IINFO_ll)
- !JUAN FAUX IMAXLOC=MAXLOC( ABS(ZDIV(IIB:IIE,IJB:IJE,IKB:IKE)))
- !JUAN FAUX WRITE(ILUOUT0,*) 'JUAN1 residual divergence / 2 DT = ', &
- !JUAN FAUX ZMAXVAL, ' located at ', &
- !JUAN FAUX IMAXLOC
- !WRITE(ILUOUT0,*) 'JUAN1 residual divergence / 2 DT = ', &
- !ZRESIDUAL
-!!$ DO K=1,size(ZDIV,3)
-!!$ DO J=1,size(ZDIV,2)
-!!$ DO I=1,size(ZDIV,1)
-!!$ IF ( ABS(ZDIV(I,J,K)) .EQ. ZMAXVAL ) THEN
-!!$ PRINT*,"I=",I," J=",J," K=",K," ZMAXVAL=",ZDIV(I,J,K)
-!!$ PRINT*,"SI=",size(ZDIV,1)," SJ=",size(ZDIV,2)," SK=",size(ZDIV,3)
-!!$ ENDIF
-!!$ ENDDO
-!!$ ENDDO
-!!$ ENDDO
ELSEIF( CEQNSYS=='MAE' .OR. CEQNSYS=='LHE' ) THEN
ZDIV=ZDIV/XRHODJ*XRHODREF
- !JUAN FAUX ZMAXVAL=MAX_ll( ABS(ZDIV),IINFO_ll)
- !JUAN FAUX IMAXLOC=MAXLOC( ABS(ZDIV(IIB:IIE,IJB:IJE,IKB:IKE)))
- !JUAN FAUX WRITE(ILUOUT0,*) 'JUAN2 residual divergence / 2 DT = ', &
- !JUAN FAUX ZMAXVAL, ' located at ', &
- !JUAN FAUX IMAXLOC
- !WRITE(ILUOUT0,*) 'JUAN2 residual divergence / 2 DT = ', &
- !ZRESIDUAL
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index 646d87c89..5cfac5aa5 100644
--- a/src/MNH/pressurez.f90
+++ b/src/MNH/pressurez.f90
@@ -9,10 +9,10 @@ MODULE MODI_PRESSUREZ
!
INTERFACE
!
- SUBROUTINE PRESSUREZ(HLUOUT, &
+ SUBROUTINE PRESSUREZ(HLUOUT, &
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, &
+ PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY,PDXHATM,PDYHATM,PRHOT, &
+ PAF,PBF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY, &
KRR,KRRL,KRRI,PDRYMASST,PREFMASS,PMASS_O_PHI0, &
PTHT,PRT,PRHODREF,PTHVREF,PRVREF,PEXNREF,PLINMASS, &
PRUS,PRVS,PRWS,PPABST, &
@@ -48,7 +48,7 @@ REAL, INTENT(IN) :: PDXHATM ! mean grid increment in the x
REAL, INTENT(IN) :: PDYHATM ! mean grid increment in the y
! direction
!
-REAL, DIMENSION (:), INTENT(IN) :: PRHOM ! mean of XRHODJ on the plane x y
+REAL, DIMENSION (:), INTENT(IN) :: PRHOT ! mean of XRHODJ on the plane x y
! localized at a mass level
!
REAL, DIMENSION(:), INTENT(IN) :: PAF,PCF ! vectors giving the nonvanishing
@@ -65,7 +65,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PTRIGSY ! - along y
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.
@@ -107,10 +106,10 @@ END INTERFACE
!
END MODULE MODI_PRESSUREZ
! ######################################################################
- SUBROUTINE PRESSUREZ(HLUOUT, &
+ SUBROUTINE PRESSUREZ(HLUOUT, &
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, &
+ PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY,PDXHATM,PDYHATM,PRHOT, &
+ PAF,PBF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY, &
KRR,KRRL,KRRI,PDRYMASST,PREFMASS,PMASS_O_PHI0, &
PTHT,PRT,PRHODREF,PTHVREF,PRVREF,PEXNREF,PLINMASS, &
PRUS,PRVS,PRWS,PPABST, &
@@ -277,7 +276,7 @@ REAL, INTENT(IN) :: PDXHATM ! mean grid increment in the x
REAL, INTENT(IN) :: PDYHATM ! mean grid increment in the y
! direction
!
-REAL, DIMENSION (:), INTENT(IN) :: PRHOM ! mean of XRHODJ on the plane x y
+REAL, DIMENSION (:), INTENT(IN) :: PRHOT ! mean of XRHODJ on the plane x y
! localized at a mass level
!
REAL, DIMENSION(:), INTENT(IN) :: PAF,PCF ! vectors giving the nonvanishing
@@ -294,8 +293,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PTRIGSY ! - along y
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.
@@ -335,7 +332,7 @@ REAL, OPTIONAL :: PRESIDUAL
!
! Metric coefficients:
!
-REAL, DIMENSION(SIZE(PPABSM,1),SIZE(PPABSM,2),SIZE(PPABSM,3)) :: ZDV_SOURCE
+REAL, DIMENSION(SIZE(PPABST,1),SIZE(PPABST,2),SIZE(PPABST,3)) :: ZDV_SOURCE
! ! divergence of the sources
!
INTEGER :: IIB ! indice I for the first inner mass point along x
@@ -347,7 +344,7 @@ INTEGER :: IKE ! indice K for the last inner mass point along z
INTEGER :: ILUOUT ! Logical unit of output listing
INTEGER :: IRESP ! Return code of FM routines
!
-REAL, DIMENSION(SIZE(PPABSM,1),SIZE(PPABSM,2),SIZE(PPABSM,3)) :: ZTHETAV, &
+REAL, DIMENSION(SIZE(PPABST,1),SIZE(PPABST,2),SIZE(PPABST,3)) :: ZTHETAV, &
! virtual potential temperature
ZPHIT
! MAE + DUR => Exner function perturbation
@@ -381,7 +378,7 @@ CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
CALL GET_DIM_EXT_ll('B',IIU,IJU)
!
IKB= 1+JPVEXT
-IKU= SIZE(PPABSM,3)
+IKU= SIZE(PPABST,3)
IKE= IKU - JPVEXT
!
ZPABS_S(:,:) = 0.
@@ -452,10 +449,10 @@ IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
ZTHETAV(:,:,:) = PTHT(:,:,:)
END IF
!
- ZPHIT(:,:,:)=(PPABSM(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)
+ ZPHIT(:,:,:)=(PPABST(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)
!
ELSEIF(CEQNSYS=='LHE') THEN
- ZPHIT(:,:,:)= ((PPABSM(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)) &
+ ZPHIT(:,:,:)= ((PPABST(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)) &
* XCPD * PTHVREF(:,:,:)
!
END IF
@@ -463,10 +460,10 @@ END IF
IF(CEQNSYS=='LHE'.AND. LFLAT .AND. LCARTESIAN) THEN
! flat cartesian LHE case -> exact solution
IF ( HPRESOPT /= "ZRESI" ) THEN
- CALL FLAT_INV(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
+ CALL FLAT_INV(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOT,PAF,PBF,PCF, &
PTRIGSX,PTRIGSY,KIFAXX,KIFAXY,ZDV_SOURCE,ZPHIT)
ELSE
- CALL FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
+ CALL FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOT,PAF,PBF,PCF, &
PTRIGSX,PTRIGSY,KIFAXX,KIFAXY,ZDV_SOURCE,ZPHIT,&
PBFB,&
PBF_SXP2_YP1_Z)
@@ -476,22 +473,22 @@ ELSE
CASE('RICHA') ! Richardson's method
!
CALL RICHARDSON(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRHODJ,ZTHETAV, &
- PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF,PTRIGSX,PTRIGSY, &
+ PDXHATM,PDYHATM,PRHOT,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, &
+ PDXHATM,PDYHATM,PRHOT,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, &
+ PDXHATM,PDYHATM,PRHOT,PAF,PBF,PCF,PTRIGSX,PTRIGSY, &
KIFAXX,KIFAXY,KITR,ZDV_SOURCE,ZPHIT)
!
CASE('ZRESI') ! Conjugate Residual method
CALL CONRESOLZ(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRHODJ,ZTHETAV, &
- PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF,PTRIGSX,PTRIGSY, &
+ PDXHATM,PDYHATM,PRHOT,PAF,PBF,PCF,PTRIGSX,PTRIGSY, &
KIFAXX,KIFAXY,KITR,ZDV_SOURCE,ZPHIT, &
PBFB,&
PBF_SXP2_YP1_Z) !JUAN Z_SPLITING
diff --git a/src/MNH/rad_bound.f90 b/src/MNH/rad_bound.f90
index dd102ea70..9d33f8315 100644
--- a/src/MNH/rad_bound.f90
+++ b/src/MNH/rad_bound.f90
@@ -12,10 +12,10 @@ INTERFACE
!
SUBROUTINE RAD_BOUND (HLBCX,HLBCY,HTURB,PRIMKMAX, &
PTSTEP,PDXHAT,PDYHAT,PZHAT, &
- PUM,PVM,PUT,PVT, &
+ PUT,PVT, &
PLBXUM,PLBYVM,PLBXUS,PLBYVS, &
PCPHASE,PCPHASE_PBL,PRHODJ, &
- PTKEM,PRUS,PRVS,PRWS )
+ PTKET,PRUS,PRVS,PRWS )
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
CHARACTER(LEN=4), INTENT(IN) :: HTURB ! Turbulence scheme
@@ -27,8 +27,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! X-direc. meshlength
REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Y-direc. meshlength
REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM ! Horizontal momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT ! at t-dt , t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT ! at t
!
! Lateral Boundary fields at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBYVM
@@ -40,7 +39,7 @@ REAL, INTENT(IN) :: PCPHASE_PBL ! prescribed PBL phase veloc
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density
! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! TKE at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRUS,PRVS ! Horizontal and Vertical
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRWS ! momentum tendencies
@@ -54,10 +53,10 @@ END MODULE MODI_RAD_BOUND
! #################################################################
SUBROUTINE RAD_BOUND (HLBCX,HLBCY,HTURB,PRIMKMAX, &
PTSTEP,PDXHAT,PDYHAT,PZHAT, &
- PUM,PVM,PUT,PVT, &
+ PUT,PVT, &
PLBXUM,PLBYVM,PLBXUS,PLBYVS, &
PCPHASE,PCPHASE_PBL,PRHODJ, &
- PTKEM,PRUS,PRVS,PRWS )
+ PTKET,PRUS,PRVS,PRWS )
! #################################################################
!
!!**** *RAD_BOUND* - routine computing the velocity components normal to
@@ -146,7 +145,8 @@ END MODULE MODI_RAD_BOUND
!! in the PBL
!! Juan 25/02/2010: BUG add ZTKEX = 0.0
!! Modification 08/10 (V.Masson) Bug correction and add cphase_profile
-!! Escobar 9/11/2010 : cphas_profile : array bound problem if NO Turb => PTKEM optional
+!! Escobar 9/11/2010 : cphas_profile : array bound problem if NO Turb => PTKET optional
+!! Lac.C. 2011 : Adaptation to FIT temporal scheme
!! Modification 06/13 (C.Lac) Introduction of cphase_pbl
!!
!-------------------------------------------------------------------------------
@@ -179,8 +179,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! X-direc. meshlength
REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Y-direc. meshlength
REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM ! Horizontal momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT ! at t-dt , t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT ! at t
!
! Lateral Boundary fields at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBYVM
@@ -192,7 +191,7 @@ REAL, INTENT(IN) :: PCPHASE_PBL ! prescribed PBL phase veloc
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density
! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! TKE at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRUS,PRVS ! Horizontal and Vertical
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRWS ! momentum tendancies
@@ -225,6 +224,7 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,3)) :: ZCPHASY! Normalized Phase velocity
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,3)) :: ZPHASY ! Phase velocity
! ! for V field at Y-boundaries
REAL :: ZTSTEP ! effective time step
+REAL :: ZALPHA2! implicitness of the damping
!
!-------------------------------------------------------------------------------
!
@@ -241,9 +241,11 @@ IKE = SIZE(PUT,3) - JPVEXT
!* 1.2 Compute the inverse of the applicable timestep
!
!
-ZTSTEP = PTSTEP / 2.
-ZINVTSTEP = 0.5/ZTSTEP
+ZTSTEP = PTSTEP
+ZINVTSTEP = 1./PTSTEP
ZKTSTEP = PRIMKMAX*ZTSTEP
+! ZALPHA2 = O : explicit ; ZALPHA2 = 1 : implicit ; ZALPHA2 = 0.5 SI
+ZALPHA2 = 1.
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
@@ -270,14 +272,14 @@ SELECT CASE ( HLBCX(1) )
CASE ('OPEN')
!
IF (HTURB /= "NONE" ) THEN
- CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASX,PTKEM(IIB,:,:))
+ CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASX,PTKET(IIB,:,:))
ELSE
CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASX)
END IF
ZCPHASX(:,:) = MAX ( 0., MIN ( 1., &
- (-PUM(IIB,:,:) + ZPHASX(:,:) ) * ZTSTEP / PDXHAT(IIB) ) )
- ! notice that ZCPHASX=0. when ZPHASX < PUM(IIB,:,:)
+ (-PUT(IIB,:,:) + ZPHASX(:,:) ) * ZTSTEP / PDXHAT(IIB) ) )
+ ! notice that ZCPHASX=0. when ZPHASX < PUT(IIB,:,:)
!
!
IF ( SIZE(PLBXUS,1) == 0 ) THEN
@@ -293,14 +295,22 @@ SELECT CASE ( HLBCX(1) )
!
! ============================================================
!
- PRUS (IIB,:,:) =(PRHODJ(IIB-1,:,:) + PRHODJ(IIB,:,:)) * 0.5 * &
- ( (1. - ZCPHASX(:,:) - ZKTSTEP) * PUM(IIB ,:,:) &
- + 2. * ZCPHASX(:,:) * PUT(IIB+1,:,:) &
- +2.* ( ZLBEU (:,:) * ZTSTEP &
- - ZLBGU (:,:) * ZCPHASX(:,:) &
- + ZKTSTEP*( ZLBXU(:,:) ) ) &
- ) * ZINVTSTEP / (1.+ ZCPHASX(:,:) +ZKTSTEP)
-!
+! PRUS (IIB,:,:) =(PRHODJ(IIB-1,:,:) + PRHODJ(IIB,:,:)) * 0.5 * &
+! ( (1. - ZCPHASX(:,:) - ZKTSTEP) * PUM(IIB ,:,:) &
+! + 2. * ZCPHASX(:,:) * PUT(IIB+1,:,:) &
+! +2.* ( ZLBEU (:,:) * ZTSTEP &
+! - ZLBGU (:,:) * ZCPHASX(:,:) &
+! + ZKTSTEP*( ZLBXU(:,:) ) ) &
+! ) * ZINVTSTEP / (1.+ ZCPHASX(:,:) +ZKTSTEP)
+!
+ PRUS (IIB,:,:) =(PRHODJ(IIB-1,:,:) + PRHODJ(IIB,:,:)) * 0.5 * &
+ ZINVTSTEP / (1.+ ZKTSTEP * ZALPHA2 ) * &
+ ( (1. - ZCPHASX(:,:) - ZKTSTEP * (1. - ZALPHA2)) * PUT(IIB,:,:) &
+ + ZCPHASX(:,:) * PUT(IIB+1 ,:,:) &
+ + ( ZLBEU (:,:) * ZTSTEP &
+ - ZLBGU (:,:) * ZCPHASX(:,:) &
+ + ZKTSTEP*ZLBXU(:,:) ) )
+
!
!
END SELECT
@@ -331,13 +341,13 @@ SELECT CASE ( HLBCX(2) )
CASE ('OPEN')
!
IF (HTURB /= "NONE" ) THEN
- CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASX,PTKEM(IIE,:,:))
+ CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASX,PTKET(IIE,:,:))
ELSE
CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASX)
END IF
!
ZCPHASX(:,:) = MAX ( 0., MIN ( 1., &
- ( PUM(IIE+1,:,:) + ZPHASX(:,:) ) * ZTSTEP/PDXHAT(IIE) ) )
+ ( PUT(IIE+1,:,:) + ZPHASX(:,:) ) * ZTSTEP/PDXHAT(IIE) ) )
!
!
ILBX=SIZE(PLBXUM,1)
@@ -354,13 +364,21 @@ SELECT CASE ( HLBCX(2) )
!
! ============================================================
!
- PRUS (IIE+1,:,:) =(PRHODJ(IIE+1,:,:) + PRHODJ(IIE,:,:)) * 0.5 * &
- ( (1. - ZCPHASX(:,:) - ZKTSTEP) * PUM(IIE+1,:,:) &
- + 2. * ZCPHASX(:,:) * PUT(IIE ,:,:) &
- +2.* ( ZLBEU (:,:) * ZTSTEP &
- + ZLBGU (:,:) * ZCPHASX(:,:) &
- + ZKTSTEP*ZLBXU(:,:) ) &
- ) * ZINVTSTEP / (1.+ZCPHASX(:,:) +ZKTSTEP)
+! PRUS (IIE+1,:,:) =(PRHODJ(IIE+1,:,:) + PRHODJ(IIE,:,:)) * 0.5 * &
+! ( (1. - ZCPHASX(:,:) - ZKTSTEP) * PUM(IIE+1,:,:) &
+! + 2. * ZCPHASX(:,:) * PUT(IIE ,:,:) &
+! +2.* ( ZLBEU (:,:) * ZTSTEP &
+! + ZLBGU (:,:) * ZCPHASX(:,:) &
+! + ZKTSTEP*ZLBXU(:,:) ) &
+! ) * ZINVTSTEP / (1.+ZCPHASX(:,:) +ZKTSTEP)
+!
+ PRUS (IIE+1,:,:) =(PRHODJ(IIE+1,:,:) + PRHODJ(IIE,:,:)) * 0.5 * &
+ ZINVTSTEP / (1.+ ZKTSTEP * ZALPHA2 ) * &
+ ( (1. - ZCPHASX(:,:) - ZKTSTEP * (1. - ZALPHA2) ) * PUT(IIE+1,:,:) &
+ + ZCPHASX(:,:) * PUT(IIE ,:,:) &
+ + ( ZLBEU (:,:) * ZTSTEP &
+ + ZLBGU (:,:) * ZCPHASX(:,:) &
+ + ZKTSTEP*ZLBXU(:,:) ) )
!
!
!
@@ -393,13 +411,13 @@ SELECT CASE ( HLBCY(1) )
CASE ('OPEN')
!
IF (HTURB /= "NONE" ) THEN
- CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASY,PTKEM(:,IJB,:))
+ CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASY,PTKET(:,IJB,:))
ELSE
CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASY)
END IF
!
ZCPHASY(:,:) = MAX ( 0., MIN ( 1., &
- (-PVM(:,IJB,:) + ZPHASY(:,:) ) * ZTSTEP/ PDYHAT(IJB) ) )
+ (-PVT(:,IJB,:) + ZPHASY(:,:) ) * ZTSTEP/ PDYHAT(IJB) ) )
!
IF ( SIZE(PLBYVS,1) == 0 ) THEN
ZLBEV (:,:) = 0.
@@ -414,13 +432,22 @@ SELECT CASE ( HLBCY(1) )
!
! ============================================================
!
- PRVS (:,IJB,:) =(PRHODJ(:,IJB-1,:) + PRHODJ(:,IJB,:)) * 0.5 * &
- ( (1. - ZCPHASY(:,:) - ZKTSTEP) * PVM(:,IJB ,:) &
- + 2. * ZCPHASY(:,:) * PVT(:,IJB+1,:) &
- +2.* ( ZLBEV (:,:) * ZTSTEP &
- - ZLBGV (:,:) * ZCPHASY(:,:) &
- + ZKTSTEP*ZLBYV(:,:) ) &
- ) * ZINVTSTEP / (1.+ ZCPHASY(:,:) +ZKTSTEP)
+! PRVS (:,IJB,:) =(PRHODJ(:,IJB-1,:) + PRHODJ(:,IJB,:)) * 0.5 * &
+! ( (1. - ZCPHASY(:,:) - ZKTSTEP) * PVM(:,IJB ,:) &
+! + 2. * ZCPHASY(:,:) * PVT(:,IJB+1,:) &
+! +2.* ( ZLBEV (:,:) * ZTSTEP &
+! - ZLBGV (:,:) * ZCPHASY(:,:) &
+! + ZKTSTEP*ZLBYV(:,:) ) &
+! ) * ZINVTSTEP / (1.+ ZCPHASY(:,:) +ZKTSTEP)
+ PRVS (:,IJB,:) =(PRHODJ(:,IJB-1,:) + PRHODJ(:,IJB,:)) * 0.5 * &
+ ZINVTSTEP / (1.+ ZKTSTEP * ZALPHA2 ) * &
+ ( (1. - ZCPHASY(:,:) - ZKTSTEP * (1. - ZALPHA2) ) * PVT(:,IJB,:)&
+ + ZCPHASY(:,:) * PVT(:,IJB+1,:) &
+ + ( ZLBEV (:,:) * ZTSTEP &
+ - ZLBGV (:,:) * ZCPHASY(:,:) &
+ + ZKTSTEP*ZLBYV(:,:) ) )
+!
+!
!
!
END SELECT
@@ -451,13 +478,13 @@ SELECT CASE ( HLBCY(2) )
CASE ('OPEN')
!
IF (HTURB /= "NONE" ) THEN
- CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASY,PTKEM(:,IJE,:))
+ CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASY,PTKET(:,IJE,:))
ELSE
CALL CPHASE_PROFILE(PZHAT,PCPHASE,PCPHASE_PBL,ZPHASY)
END IF
!
ZCPHASY(:,:) = MAX ( 0., MIN ( 1., &
- ( PVM(:,IJE+1,:) + ZPHASY(:,:) ) * ZTSTEP/PDYHAT(IJE) ) )
+ ( PVT(:,IJE+1,:) + ZPHASY(:,:) ) * ZTSTEP/PDYHAT(IJE) ) )
!
ILBY=SIZE(PLBYVM,2)
IF ( SIZE(PLBYVS,1) == 0 ) THEN
@@ -473,14 +500,22 @@ SELECT CASE ( HLBCY(2) )
!
! ============================================================
!
- PRVS (:,IJE+1,:) =(PRHODJ(:,IJE+1,:) + PRHODJ(:,IJE,:)) * 0.5 * &
- ( (1. - ZCPHASY(:,:) - ZKTSTEP) * PVM(:,IJE+1,:) &
- + 2. * ZCPHASY(:,:) * PVT(:,IJE ,:) &
- +2.* ( ZLBEV (:,:) * ZTSTEP &
+! PRVS (:,IJE+1,:) =(PRHODJ(:,IJE+1,:) + PRHODJ(:,IJE,:)) * 0.5 * &
+! ( (1. - ZCPHASY(:,:) - ZKTSTEP) * PVM(:,IJE+1,:) &
+! + 2. * ZCPHASY(:,:) * PVT(:,IJE ,:) &
+! +2.* ( ZLBEV (:,:) * ZTSTEP &
+! + ZLBGV (:,:) * ZCPHASY(:,:) &
+! + ZKTSTEP* ZLBYV(:,:) ) &
+! ) * ZINVTSTEP / (1.+ ZCPHASY(:,:) +ZKTSTEP)
+!
+ PRVS (:,IJE+1,:) =(PRHODJ(:,IJE+1,:) + PRHODJ(:,IJE,:)) * 0.5 * &
+ ZINVTSTEP / (1.+ ZKTSTEP * ZALPHA2 ) * &
+ ( (1. - ZCPHASY(:,:) - ZKTSTEP * (1. - ZALPHA2) ) * PVT(:,IJE+1,:)&
+ + ZCPHASY(:,:) * PVT(:,IJE,:) &
+ + ( ZLBEV (:,:) * ZTSTEP &
+ ZLBGV (:,:) * ZCPHASY(:,:) &
- + ZKTSTEP* ZLBYV(:,:) ) &
- ) * ZINVTSTEP / (1.+ ZCPHASY(:,:) +ZKTSTEP)
-!
+ + ZKTSTEP*ZLBYV(:,:) ) )
+!
!
END SELECT
!
diff --git a/src/MNH/rain_c2r2.f90 b/src/MNH/rain_c2r2.f90
index ba6d73d43..d9de848d7 100644
--- a/src/MNH/rain_c2r2.f90
+++ b/src/MNH/rain_c2r2.f90
@@ -9,13 +9,13 @@
! ######################
!
INTERFACE
- SUBROUTINE RAIN_C2R2 (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP_MET, PTSTEP, &
+ SUBROUTINE RAIN_C2R2 (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, &
KMI, HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, &
PRHODREF, PEXNREF, &
- PPABSM, PPABST, PTHM, PTHT, PRVT, PRCM, PRCT, &
- PRRT, PRRM, &
+ PPABST, PTHT, PRVT, PRCT, &
+ PRRT, PTHM, PRCM, PPABSM, &
PW_NU, PTHS, PRVS, PRCS, PRRS, &
- PCNT, PCCT, PCRM, PCRT, PCNS, PCCS, PCRS, &
+ PCNT, PCCT, PCRT, PCNS, PCCS, PCRS, &
PINPRC, PINPRR, PINPRR3D, PEVAP3D,PAEROT, &
PSOLORG, PMI, HACTCCN )
!
@@ -30,8 +30,6 @@ LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
! rain formation by coalescence
INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
! integration for rain sedimendation
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective Time step
- ! for meteorological scalar variables
REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
INTEGER, INTENT(IN) :: KMI ! Model index
CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
@@ -45,15 +43,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
!
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -64,7 +61,6 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCNT ! Water vapor C. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRM ! Rain water C. at t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRT ! Rain water C. at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCNS ! Water vapor C. source
@@ -84,13 +80,13 @@ END SUBROUTINE RAIN_C2R2
END INTERFACE
END MODULE MODI_RAIN_C2R2
! ######################################################################
- SUBROUTINE RAIN_C2R2 (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP_MET, PTSTEP, &
+ SUBROUTINE RAIN_C2R2 (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, &
KMI, HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, &
PRHODREF, PEXNREF, &
- PPABSM, PPABST, PTHM, PTHT, PRVT, PRCM, PRCT, &
- PRRT, PRRM, &
+ PPABST, PTHT, PRVT, PRCT, &
+ PRRT, PTHM, PRCM, PPABSM, &
PW_NU, PTHS, PRVS, PRCS, PRRS, &
- PCNT, PCCT, PCRM, PCRT, PCNS, PCCS, PCRS, &
+ PCNT, PCCT, PCRT, PCNS, PCCS, PCRS, &
PINPRC, PINPRR, PINPRR3D, PEVAP3D,PAEROT, &
PSOLORG, PMI, HACTCCN )
! ######################################################################
@@ -230,8 +226,6 @@ LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
! rain formation by coalescence
INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
! integration for rain sedimendation
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective Time step
- ! for meteorological scalar variables
REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
INTEGER, INTENT(IN) :: KMI ! Model index
CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
@@ -245,15 +239,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
!
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -264,7 +257,6 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCNT ! Water vapor C. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRM ! Rain water C. at t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRT ! Rain water C. at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCNS ! Water vapor C. source
@@ -396,8 +388,8 @@ IKE=SIZE(PZZ,3) - JPVEXT
!
ISIZE = SIZE(XRTMIN);ALLOCATE(ZRTMIN(ISIZE))
ISIZE = SIZE(XCTMIN);ALLOCATE(ZCTMIN(ISIZE))
-ZRTMIN(:) = XRTMIN(:) / PTSTEP_MET
-ZCTMIN(:) = XCTMIN(:) / PTSTEP_MET
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
!
ZWLBDC3(:,:,:) = 1.E30
ZWLBDC(:,:,:) = 1.E10
@@ -414,7 +406,6 @@ WHERE (PRRT(:,:,:)>XRTMIN(3) .AND. PCRT(:,:,:)>XCTMIN(3))
ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
END WHERE
ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
-ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
!
!-------------------------------------------------------------------------------
!
@@ -422,9 +413,9 @@ ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
! --------------------------------------
!
IF ((HACTCCN == 'ABRK').AND.((LORILAM).OR.(LDUST).OR.(LSALT))) THEN
-CALL AER_NUCLEATION
+ CALL AER_NUCLEATION
ELSE
-CALL C2R2_NUCLEATION
+ CALL C2R2_NUCLEATION
ENDIF
!
@@ -506,7 +497,7 @@ END IF
!
!* 6.2 time splitting loop initialization
!
-ZTSPLITR= PTSTEP_MET / FLOAT(KSPLITR)
+ZTSPLITR= PTSTEP / FLOAT(KSPLITR)
!
CALL C2R2_SEDIMENTATION
!
@@ -541,11 +532,11 @@ INTEGER :: JL ! and PACK intrinsics
! the precipitating fields are larger than a minimal value only !!!
ZPRRS(:,:,:) = 0.0
-ZPRRS(:,:,:) = PRRS(:,:,:)-PRRM(:,:,:)/PTSTEP_MET
-PRRS(:,:,:) = PRRM(:,:,:)/PTSTEP_MET
+ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)/PTSTEP
+PRRS(:,:,:) = PRRT(:,:,:)/PTSTEP
ZPCRS(:,:,:) = 0.0
-ZPCRS(:,:,:) = PCRS(:,:,:)-PCRM(:,:,:)/PTSTEP_MET
-PCRS(:,:,:) = PCRM(:,:,:)/PTSTEP_MET
+ZPCRS(:,:,:) = PCRS(:,:,:)-PCRT(:,:,:)/PTSTEP
+PCRS(:,:,:) = PCRT(:,:,:)/PTSTEP
!
DO JN = 1 , KSPLITR
GSEDIM(:,:,:) = .FALSE.
@@ -566,11 +557,11 @@ DO JN = 1 , KSPLITR
PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)/KSPLITR
PCRS(:,:,:) = PCRS(:,:,:) + ZPCRS(:,:,:)/KSPLITR
IF( OSEDC ) THEN
- PCCS(:,:,:) = PCCS(:,:,:) * PTSTEP_MET
- PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP_MET
+ PCCS(:,:,:) = PCCS(:,:,:) * PTSTEP
+ PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
END IF
- PCRS(:,:,:) = PCRS(:,:,:) * PTSTEP_MET
- PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP_MET
+ PCRS(:,:,:) = PCRS(:,:,:) * PTSTEP
+ PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
DO JK = IKB , IKE
ZW(:,:,JK)=ZTSPLITR/(PZZ(:,:,JK+1)-PZZ(:,:,JK))
END DO
@@ -625,7 +616,7 @@ DO JN = 1 , KSPLITR
END IF
!
END IF
-!
+!
IF( OSEDC ) THEN
DO JK = IKB , IKE
PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)* &
@@ -696,11 +687,11 @@ DO JN = 1 , KSPLITR
!
IF( JN==KSPLITR ) THEN
IF( OSEDC ) THEN
- PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP_MET
- PCCS(:,:,:) = PCCS(:,:,:) / PTSTEP_MET
+ PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP
+ PCCS(:,:,:) = PCCS(:,:,:) / PTSTEP
END IF
- PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP_MET
- PCRS(:,:,:) = PCRS(:,:,:) / PTSTEP_MET
+ PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP
+ PCRS(:,:,:) = PCRS(:,:,:) / PTSTEP
END IF
!
IF ( OSEDC .AND. OCLOSE_OUT ) THEN
@@ -783,6 +774,7 @@ ZTDT(:,:,:) = 0.
ZDRC(:,:,:) = 0.
IF (OACTIT) THEN
+ ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
@@ -935,9 +927,9 @@ IF( INUCT >= 1 ) THEN
! the CCN spectra formula uses ZSMAX in percent
!
IF (XCONC_CCN > 0.) THEN
- ZZW1(:) = MIN( ZCONC_CCN(:),ZCHEN_TMP(:) * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) ) / PTSTEP_MET
+ ZZW1(:) = MIN( ZCONC_CCN(:),ZCHEN_TMP(:) * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) ) / PTSTEP
ELSE
- ZZW1(:) = ZCHEN_TMP(:) * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) / PTSTEP_MET
+ ZZW1(:) = ZCHEN_TMP(:) * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) / PTSTEP
ENDIF
ZW(:,:,:) = PCNS(:,:,:)
PCNS(:,:,:) = UNPACK( MAX( ZZW1(:),ZCNS(:) ),MASK=GNUCT(:,:,:), &
@@ -1058,6 +1050,7 @@ ZZW1LOG(:,:,:)= 0. ! supersaturation
ZTDT(:,:,:) = 0.
ZDRC(:,:,:) = 0.
IF (OACTIT) THEN
+ ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
@@ -1078,7 +1071,7 @@ ELSE
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))
END IF
!
- INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
+INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
IF( INUCT >= 1 ) THEN
ALLOCATE(ZRVT(INUCT))
@@ -1139,7 +1132,7 @@ CALL CH_AER_ACTIVATION(ZAERO, ZZT, ZZW2, ZTDTBIS, ZRHODREF, ZPABST,&
! Nb de goutelettes activées
!test
-ZZW1(:) = MAX(ZNCN(:)/PTSTEP_MET - ZCNS(:), 0.)
+ZZW1(:) = MAX(ZNCN(:)/PTSTEP - ZCNS(:), 0.)
!
ZW(:,:,:) = UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
PCNS(:,:,:) = PCNS(:,:,:) + ZW(:,:,:)
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index 67f26e72e..3525350c5 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -12,11 +12,11 @@ INTERFACE
SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
KSPLITR, PTSTEP, KMI, KRR, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PTHT, PRVT, PRCT, PRCM, PRRT, PRRM, PRIT, PRST, PRSM, &
- PRGT, PRGM, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
PINPRS, PINPRG, PSIGS, PSEA, PTOWN, &
- PRHT, PRHM, PRHS, PINPRH )
+ PRHT, PRHS, PINPRH )
!
!
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
@@ -49,14 +49,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
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) :: PRCM ! Cloud water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSM ! Snow/aggregate m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGM ! Graupel/hail m.r. at t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
!
@@ -78,7 +74,6 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG! Graupel instant precip
REAL, DIMENSION(:,:),OPTIONAL,INTENT(IN) :: PSEA
REAL, DIMENSION(:,:),OPTIONAL,INTENT(IN) :: PTOWN
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHM ! Hail m.r. at t-dt
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH! Hail instant precip
@@ -90,11 +85,11 @@ END MODULE MODI_RAIN_ICE
SUBROUTINE RAIN_ICE ( OSEDIC, HSEDIM, HSUBG_AUCV, OWARM,KKA,KKU,KKL, &
KSPLITR, PTSTEP, KMI, KRR, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
- PTHT, PRVT, PRCT, PRCM, PRRT, PRRM, PRIT, PRST, PRSM, &
- PRGT, PRGM, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
PINPRS, PINPRG, PSIGS, PSEA, PTOWN, &
- PRHT, PRHM, PRHS, PINPRH )
+ PRHT, PRHS, PINPRH )
! ######################################################################
!
!!**** * - compute the explicit microphysical sources
@@ -229,6 +224,7 @@ END MODULE MODI_RAIN_ICE
!! (S. Riette) Oct 2010 Better vectorisation of RAIN_ICE_SEDIMENTATION_STAT
!! (Y. Seity), 02-2012 add possibility to run with reversed vertical levels
!! Juan 24/09/2012: for BUG Pgi rewrite PACK function on mode_pack_pgi
+!! (C. Lac) FIT temporal scheme : instant M removed
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -244,6 +240,7 @@ USE MODD_BUDGET
USE MODD_LES
USE MODI_BUDGET
USE MODI_GAMMA
+USE MODE_FMWRIT
!
#ifdef MNH_PGI
USE MODE_PACK_PGI
@@ -285,14 +282,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR! Convective Mass Flux Cloud fr
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) :: PRCM ! Cloud water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSM ! Snow/aggregate m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGM ! Graupel/hail m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
@@ -312,7 +305,6 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG! Graupel instant precip
REAL, DIMENSION(:,:),OPTIONAL,INTENT(IN) :: PSEA
REAL, DIMENSION(:,:),OPTIONAL,INTENT(IN) :: PTOWN
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHM ! Hail m.r. at t-dt
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH! Hail instant precip
!
@@ -434,8 +426,6 @@ REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
!
INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
-CHARACTER (LEN=100) :: YCOMMENT ! Comment string in LFIFM file
-CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
!
!-------------------------------------------------------------------------------
!
@@ -568,7 +558,7 @@ IF( IMICRO >= 0 ) THEN
ALLOCATE(ZZW1(IMICRO,6))
ENDIF
!
- IF (LBU_ENABLE .OR. LLES_CALL) THEN
+ IF (LBU_ENABLE .OR. LLES_CALL .OR. LCHECK) THEN
ALLOCATE(ZRHODJ(IMICRO))
ZRHODJ(:) = PACK( PRHODJ(:,:,:),MASK=GMICRO(:,:,:) )
END IF
@@ -918,22 +908,22 @@ IF ( KRR == 7 ) ILENALLOCH = 0
!
IF (OSEDIC) THEN
ZPRCS(:,:,:) = 0.0
- ZPRCS(:,:,:) = PRCS(:,:,:)-PRCM(:,:,:)* ZINVTSTEP
- PRCS(:,:,:) = PRCM(:,:,:)* ZINVTSTEP
+ ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:)* ZINVTSTEP
END IF
ZPRRS(:,:,:) = 0.0
ZPRSS(:,:,:) = 0.0
ZPRGS(:,:,:) = 0.0
IF ( KRR == 7 ) ZPRHS(:,:,:) = 0.0
!
-ZPRRS(:,:,:) = PRRS(:,:,:)-PRRM(:,:,:)* ZINVTSTEP
-ZPRSS(:,:,:) = PRSS(:,:,:)-PRSM(:,:,:)* ZINVTSTEP
-ZPRGS(:,:,:) = PRGS(:,:,:)-PRGM(:,:,:)* ZINVTSTEP
-IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHM(:,:,:)* ZINVTSTEP
-PRRS(:,:,:) = PRRM(:,:,:)* ZINVTSTEP
-PRSS(:,:,:) = PRSM(:,:,:)* ZINVTSTEP
-PRGS(:,:,:) = PRGM(:,:,:)* ZINVTSTEP
-IF ( KRR == 7 ) PRHS(:,:,:) = PRHM(:,:,:)* ZINVTSTEP
+ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP
+ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP
+ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)* ZINVTSTEP
+PRRS(:,:,:) = PRRT(:,:,:)* ZINVTSTEP
+PRSS(:,:,:) = PRST(:,:,:)* ZINVTSTEP
+PRGS(:,:,:) = PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) PRHS(:,:,:) = PRHT(:,:,:)* ZINVTSTEP
!
! PRiS = Source of the previous time step + source created during the subtime
! step
@@ -1325,22 +1315,22 @@ ZRTMIN(:) = XRTMIN(:) * ZINVTSTEP
!
IF (OSEDIC) THEN
ZPRCS(:,:,:) = 0.0
- ZPRCS(:,:,:) = PRCS(:,:,:)-PRCM(:,:,:)* ZINVTSTEP
- PRCS(:,:,:) = PRCM(:,:,:)* ZINVTSTEP
+ ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:)* ZINVTSTEP
END IF
ZPRRS(:,:,:) = 0.0
ZPRSS(:,:,:) = 0.0
ZPRGS(:,:,:) = 0.0
IF ( KRR == 7 ) ZPRHS(:,:,:) = 0.0
!
-ZPRRS(:,:,:) = PRRS(:,:,:)-PRRM(:,:,:)* ZINVTSTEP
-ZPRSS(:,:,:) = PRSS(:,:,:)-PRSM(:,:,:)* ZINVTSTEP
-ZPRGS(:,:,:) = PRGS(:,:,:)-PRGM(:,:,:)* ZINVTSTEP
-IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHM(:,:,:)* ZINVTSTEP
-PRRS(:,:,:) = PRRM(:,:,:)* ZINVTSTEP
-PRSS(:,:,:) = PRSM(:,:,:)* ZINVTSTEP
-PRGS(:,:,:) = PRGM(:,:,:)* ZINVTSTEP
-IF ( KRR == 7 ) PRHS(:,:,:) = PRHM(:,:,:)* ZINVTSTEP
+ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP
+ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP
+ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)* ZINVTSTEP
+PRRS(:,:,:) = PRRT(:,:,:)* ZINVTSTEP
+PRSS(:,:,:) = PRST(:,:,:)* ZINVTSTEP
+PRGS(:,:,:) = PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) PRHS(:,:,:) = PRHT(:,:,:)* ZINVTSTEP
!
IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)
diff --git a/src/MNH/rain_ice_elec.f90 b/src/MNH/rain_ice_elec.f90
index f2f875416..22be7b4e3 100644
--- a/src/MNH/rain_ice_elec.f90
+++ b/src/MNH/rain_ice_elec.f90
@@ -12,15 +12,14 @@ INTERFACE
SUBROUTINE RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
KSPLITR, PTSTEP, KMI, KRR, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
- PTHT, PRVT, PRCT, PRCM, PRRT, PRRM, PRIT, PRST, PRSM, &
- PRGT, PRGM, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
PINPRS, PINPRG, PSIGS, &
PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
PSEA, PTOWN, &
- PRHT, PRHM, PRHS, PINPRH, &
- PQHT, PQHM, PQHS )
+ PRHT, PRHS, PINPRH, PQHT, PQHS )
!
!
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
@@ -49,14 +48,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
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) :: PRCM ! Cloud water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSM ! Snow/aggregate m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGM ! Graupel/hail m.r. at t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
!
@@ -95,11 +90,9 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQGS ! Graupel CMR source
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHM ! Hail m.r. at t-dt
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHT ! Hail CMR at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHM ! Hail CMR at t-dt
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail CMR source
!
END SUBROUTINE RAIN_ICE_ELEC
@@ -110,15 +103,14 @@ END MODULE MODI_RAIN_ICE_ELEC
SUBROUTINE RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
KSPLITR, PTSTEP, KMI, KRR, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
- PTHT, PRVT, PRCT, PRCM, PRRT, PRRM, PRIT, PRST, PRSM, &
- PRGT, PRGM, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
PINPRS, PINPRG, PSIGS, &
PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
PSEA, PTOWN, &
- PRHT, PRHM, PRHS, PINPRH, &
- PQHT, PQHM, PQHS )
+ PRHT, PRHS, PINPRH, PQHT, PQHS )
! ######################################################################
!
!!**** * - compute the explicit microphysical sources
@@ -214,6 +206,7 @@ END MODULE MODI_RAIN_ICE_ELEC
!! C. Barthe (LACy) Nov. 2009 : update to V4.8.1
!! M. Chong 26/01/10 Add Small ions parameters
!! J-P Pinty 31/03/11 Add hail
+!! C. Lac 2011 : Adaptation to FIT temporal scheme
!! B. Tsenova June 2012 Add new NI parameterizations
!! C. Barthe June 2012 Dependance of RAR on the RELATIVE terminal velocity
!!
@@ -275,14 +268,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR! Convective Mass Flux Cloud fracti
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) :: PRCM ! Cloud water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSM ! Snow/aggregate m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGM ! Graupel/hail m.r. at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
@@ -320,11 +309,9 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQGS ! Graupel CMR source
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHM ! Hail m.r. at t-dt
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHT ! Hail CMR at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHM ! Hail CMR at t-dt
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail CMR source
!
!
@@ -1361,22 +1348,22 @@ INTEGER, DIMENSION(:), ALLOCATABLE :: ZCIS
!
IF (OSEDIC) THEN
ZPRCS(:,:,:) = 0.0
- ZPRCS(:,:,:) = PRCS(:,:,:) - PRCM(:,:,:) / PTSTEP
- PRCS(:,:,:) = PRCM(:,:,:) / PTSTEP
+ ZPRCS(:,:,:) = PRCS(:,:,:) - PRCT(:,:,:) / PTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:) / PTSTEP
END IF
ZPRRS(:,:,:) = 0.0
ZPRSS(:,:,:) = 0.0
ZPRGS(:,:,:) = 0.0
IF (KRR == 7) ZPRHS(:,:,:) = 0.0
!
- ZPRRS(:,:,:) = PRRS(:,:,:) - PRRM(:,:,:) / PTSTEP
- ZPRSS(:,:,:) = PRSS(:,:,:) - PRSM(:,:,:) / PTSTEP
- ZPRGS(:,:,:) = PRGS(:,:,:) - PRGM(:,:,:) / PTSTEP
- IF (KRR == 7) ZPRHS(:,:,:) = PRHS(:,:,:) - PRHM(:,:,:) / PTSTEP
- PRRS(:,:,:) = PRRM(:,:,:) / PTSTEP
- PRSS(:,:,:) = PRSM(:,:,:) / PTSTEP
- PRGS(:,:,:) = PRGM(:,:,:) / PTSTEP
- IF (KRR == 7) PRHS(:,:,:) = PRHM(:,:,:) / PTSTEP
+ ZPRRS(:,:,:) = PRRS(:,:,:) - PRRT(:,:,:) / PTSTEP
+ ZPRSS(:,:,:) = PRSS(:,:,:) - PRST(:,:,:) / PTSTEP
+ ZPRGS(:,:,:) = PRGS(:,:,:) - PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) ZPRHS(:,:,:) = PRHS(:,:,:) - PRHT(:,:,:) / PTSTEP
+ PRRS(:,:,:) = PRRT(:,:,:) / PTSTEP
+ PRSS(:,:,:) = PRST(:,:,:) / PTSTEP
+ PRGS(:,:,:) = PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) PRHS(:,:,:) = PRHT(:,:,:) / PTSTEP
ZPQRS(:,:,:) = 0.0
ZPQSS(:,:,:) = 0.0
ZPQGS(:,:,:) = 0.0
@@ -1910,22 +1897,22 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D !
!
IF (OSEDIC) THEN
ZPRCS(:,:,:) = 0.0
- ZPRCS(:,:,:) = PRCS(:,:,:) - PRCM(:,:,:) / PTSTEP
- PRCS(:,:,:) = PRCM(:,:,:) / PTSTEP
+ ZPRCS(:,:,:) = PRCS(:,:,:) - PRCT(:,:,:) / PTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:) / PTSTEP
END IF
ZPRRS(:,:,:) = 0.0
ZPRSS(:,:,:) = 0.0
ZPRGS(:,:,:) = 0.0
IF (KRR == 7) ZPRHS(:,:,:) = 0.0
!
- ZPRRS(:,:,:) = PRRS(:,:,:) - PRRM(:,:,:) / PTSTEP
- ZPRSS(:,:,:) = PRSS(:,:,:) - PRSM(:,:,:) / PTSTEP
- ZPRGS(:,:,:) = PRGS(:,:,:) - PRGM(:,:,:) / PTSTEP
- IF (KRR == 7) ZPRHS(:,:,:) = PRHS(:,:,:) - PRHM(:,:,:) / PTSTEP
- PRRS(:,:,:) = PRRM(:,:,:) / PTSTEP
- PRSS(:,:,:) = PRSM(:,:,:) / PTSTEP
- PRGS(:,:,:) = PRGM(:,:,:) / PTSTEP
- IF (KRR == 7) PRHS(:,:,:) = PRHM(:,:,:) / PTSTEP
+ ZPRRS(:,:,:) = PRRS(:,:,:) - PRRT(:,:,:) / PTSTEP
+ ZPRSS(:,:,:) = PRSS(:,:,:) - PRST(:,:,:) / PTSTEP
+ ZPRGS(:,:,:) = PRGS(:,:,:) - PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) ZPRHS(:,:,:) = PRHS(:,:,:) - PRHT(:,:,:) / PTSTEP
+ PRRS(:,:,:) = PRRT(:,:,:) / PTSTEP
+ PRSS(:,:,:) = PRST(:,:,:) / PTSTEP
+ PRGS(:,:,:) = PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) PRHS(:,:,:) = PRHT(:,:,:) / PTSTEP
!
IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)
diff --git a/src/MNH/rain_khko.f90 b/src/MNH/rain_khko.f90
index dba38cd42..71088f8fb 100644
--- a/src/MNH/rain_khko.f90
+++ b/src/MNH/rain_khko.f90
@@ -9,9 +9,10 @@
! ######################
!
INTERFACE
- SUBROUTINE RAIN_KHKO (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP_MET, PTSTEP, &
+ SUBROUTINE RAIN_KHKO (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, &
KMI, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABSM, PPABST, PTHM, PTHT, PRVT, PRCM, PRCT, PRRT,&
+ PPABST, PTHT, PRVT, PRCT, PRRT, &
+ PTHM, PRCM, PPABSM, &
PW_NU, PTHS, PRVS, PRCS, PRRS, &
PCNT, PCCT, PCRT, PCNS, PCCS, PCRS, PINPRC,PINPRR, &
PINPRR3D, PEVAP3D, PAEROT, &
@@ -28,8 +29,6 @@ LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
! rain formation by coalescence
INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
! integration for rain sedimendation
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective Time step
- ! for meteorological scalar variables
REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
INTEGER, INTENT(IN) :: KMI ! Model index
!
@@ -39,14 +38,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
!
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
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) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -76,9 +75,10 @@ END SUBROUTINE RAIN_KHKO
END INTERFACE
END MODULE MODI_RAIN_KHKO
! ######################################################################
- SUBROUTINE RAIN_KHKO (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP_MET, PTSTEP, &
+ SUBROUTINE RAIN_KHKO (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, &
KMI, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABSM, PPABST, PTHM, PTHT, PRVT, PRCM, PRCT, PRRT,&
+ PPABST, PTHT, PRVT, PRCT, PRRT, &
+ PTHM, PRCM, PPABSM, &
PW_NU, PTHS, PRVS, PRCS, PRRS, &
PCNT, PCCT, PCRT, PCNS, PCCS, PCRS, PINPRC,PINPRR, &
PINPRR3D, PEVAP3D, PAEROT, &
@@ -207,8 +207,6 @@ LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
! rain formation by coalescence
INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
! integration for rain sedimendation
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective Time step
- ! for meteorological scalar variables
REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
INTEGER, INTENT(IN) :: KMI ! Model index
!
@@ -218,14 +216,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
!
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
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) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -351,8 +349,8 @@ ISIZE = SIZE(XRTMIN)
ISIZE = SIZE(XCTMIN)
ALLOCATE(ZCTMIN(ISIZE))
ALLOCATE(ZRTMIN(ISIZE))
-ZRTMIN(:) = XRTMIN(:) / PTSTEP_MET
-ZCTMIN(:) = XCTMIN(:) / PTSTEP_MET
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
!
ZWLBDC3(:,:,:) = 1.E30
ZWLBDC(:,:,:) = 1.E10
@@ -389,7 +387,6 @@ ELSE
ELSE
ZEPS= XMV / XMD
ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
- ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
!
ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*LOG(ZT(:,:,:))) - 1.0)
@@ -441,7 +438,7 @@ IF (LBUDGET_SV) &
!
!* 6.1 time splitting loop initialization
!
-ZTSPLITR = PTSTEP_MET / FLOAT(KSPLITR) ! Small time step
+ZTSPLITR = PTSTEP / FLOAT(KSPLITR) ! Small time step
!
!
!* 6.2 compute the sedimentation velocities for rain
@@ -496,14 +493,14 @@ INTEGER :: JL ! and PACK intrinsics
DO JN = 1 , KSPLITR
GSEDIM(:,:,:) = .FALSE.
IF( OSEDC ) THEN
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = &
- PRCT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP_MET>ZRTMIN(2) .OR. &
- (PRRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP_MET>ZRTMIN(3) .AND. &
- PCRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP_MET>ZCTMIN(3))
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRCT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP>ZRTMIN(2) .OR. &
+ (PRRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP>ZRTMIN(3) .AND. &
+ PCRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP>ZCTMIN(3))
ELSE
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = &
- PRRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP_MET>ZRTMIN(3) .AND. &
- PCRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP_MET>ZCTMIN(3)
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP>ZRTMIN(3) .AND. &
+ PCRT(IIB:IIE,IJB:IJE,IKB:IKE)/PTSTEP>ZCTMIN(3)
END IF
!
ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
@@ -512,11 +509,11 @@ DO JN = 1 , KSPLITR
!
IF( JN==1 ) THEN
IF( OSEDC ) THEN
- PCCS(:,:,:) = PCCS(:,:,:) * PTSTEP_MET
- PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP_MET
+ PCCS(:,:,:) = PCCS(:,:,:) * PTSTEP
+ PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
END IF
- PCRS(:,:,:) = PCRS(:,:,:) * PTSTEP_MET
- PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP_MET
+ PCRS(:,:,:) = PCRS(:,:,:) * PTSTEP
+ PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
DO JK = IKB , IKE
ZW(:,:,JK) = ZTSPLITR/(PZZ(:,:,JK+1) -PZZ(:,:,JK))
END DO
@@ -627,11 +624,11 @@ DO JN = 1 , KSPLITR
DEALLOCATE(ZZW3)
IF( JN==KSPLITR ) THEN
IF( OSEDC ) THEN
- PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP_MET
- PCCS(:,:,:) = PCCS(:,:,:) / PTSTEP_MET
+ PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP
+ PCCS(:,:,:) = PCCS(:,:,:) / PTSTEP
END IF
- PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP_MET
- PCRS(:,:,:) = PCRS(:,:,:) / PTSTEP_MET
+ PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP
+ PCRS(:,:,:) = PCRS(:,:,:) / PTSTEP
END IF
END IF
END DO
@@ -676,13 +673,13 @@ INTEGER :: J1
ZEPS= XMV / XMD
!
ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
-ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
!
ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
ZZW1LOG(:,:,:)= 0. ! supersaturation
ZTDT(:,:,:) = 0.
IF (OACTIT) THEN
+ ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
@@ -830,9 +827,9 @@ IF( INUCT >= 1 ) THEN
! the CCN spectra formula uses ZSMAX in percent
!
IF (XCONC_CCN > 0) THEN
- ZZW1(:) = MIN( XCONC_CCN,XCHEN * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) ) / PTSTEP_MET
+ ZZW1(:) = MIN( XCONC_CCN,XCHEN * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) ) / PTSTEP
ELSE
- ZZW1(:) = XCHEN * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) / PTSTEP_MET
+ ZZW1(:) = XCHEN * (100.0*ZSMAX(:))**XKHEN * ZZW3(:) / PTSTEP
ENDIF
ZW(:,:,:) = PCNS(:,:,:)
PCNS(:,:,:) = UNPACK( MAX( ZZW1(:),ZCNS(:) ),MASK=GNUCT(:,:,:), &
@@ -918,7 +915,6 @@ INTEGER :: JSV
ZEPS= XMV / XMD
!
ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
-ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
!
ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
@@ -926,6 +922,7 @@ ZZW1LOG(:,:,:)= 0. ! supersaturation
ZTDT(:,:,:) = 0.
ZDRC(:,:,:) = 0.
IF (OACTIT) THEN
+ ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
! Ratio 2 due to leap-frog
@@ -1008,7 +1005,7 @@ CALL CH_AER_ACTIVATION(ZAERO, ZZT, ZZW2, ZTDTBIS, ZRHODREF, ZPABST,&
!test
-ZZW1(:) = MAX(ZNCN(:)/PTSTEP_MET - ZCNS(:), 0.)
+ZZW1(:) = MAX(ZNCN(:)/PTSTEP - ZCNS(:), 0.)
!
ZW(:,:,:) = UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
@@ -1018,7 +1015,7 @@ PCNS(:,:,:) = PCNS(:,:,:) + ZW(:,:,:)
! Modification reservoir eau (gaz et liquide)
!
! valeur de petites goutelettes type brouillard (test)
-ZZW2(:) = MAX(ZNCN(:)/PTSTEP_MET - ZCNS(:), 0.)
+ZZW2(:) = MAX(ZNCN(:)/PTSTEP - ZCNS(:), 0.)
ZZW1(:)=0.
WHERE(ZZW2(:).gt.0.0)
! ZZW1(:) =(4.0/3.0)*XPI*1E3*ZZW2(:)*1E-6/ZRHODREF(:)
diff --git a/src/MNH/read_desfmn.f90 b/src/MNH/read_desfmn.f90
index ea7396a49..073f626ed 100644
--- a/src/MNH/read_desfmn.f90
+++ b/src/MNH/read_desfmn.f90
@@ -14,8 +14,7 @@ INTERFACE
OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
ODEPOS_SLT,ODUST,ODEPOS_DST, &
OORILAM,ODEPOS_AER,OLG,OPASPOL,OCONDSAMP,KRIMX,KRIMY,KSV_USER,&
- HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC,HEQNSYS, &
- PTSTEP_OLD )
+ HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC,HEQNSYS )
USE MODD_PARAMETERS
INTEGER, INTENT(IN) :: KMI ! Model index
CHARACTER (LEN=32), INTENT(IN) :: HDESFM ! name of the DESFM file
@@ -58,7 +57,6 @@ CHARACTER (LEN=4), INTENT(OUT) :: HSCONV ! Kind of shallow convection scheme
CHARACTER (LEN=4), INTENT(OUT) :: HCLOUD ! Kind of microphysical scheme
CHARACTER (LEN=4), INTENT(OUT) :: HELEC ! Kind of electrical scheme
CHARACTER (LEN=*), INTENT(OUT) :: HEQNSYS! type of equations' system
-REAL, INTENT(OUT) :: PTSTEP_OLD ! OLD Time STEP (DESFM)
END SUBROUTINE READ_DESFM_n
!
END INTERFACE
@@ -70,8 +68,7 @@ END MODULE MODI_READ_DESFM_n
OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
ODEPOS_SLT,ODUST,ODEPOS_DST, &
OORILAM,ODEPOS_AER,OLG,OPASPOL,OCONDSAMP,KRIMX,KRIMY,KSV_USER,&
- HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC,HEQNSYS, &
- PTSTEP_OLD )
+ HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC,HEQNSYS )
! #########################################################################
!
!!**** *READ_DESFM_n * - routine to read the descriptor file DESFM
@@ -255,7 +252,6 @@ CHARACTER (LEN=4), INTENT(OUT) :: HSCONV ! Kind of shallow convection scheme
CHARACTER (LEN=4), INTENT(OUT) :: HCLOUD ! Kind of microphysical scheme
CHARACTER (LEN=4), INTENT(OUT) :: HELEC ! Kind of electrical scheme
CHARACTER (LEN=*), INTENT(OUT) :: HEQNSYS! type of equations' system
-REAL, INTENT(OUT) :: PTSTEP_OLD ! OLD Time STEP (DESFM)
LOGICAL, INTENT(OUT) :: OSALT ! Sea Salt flag
LOGICAL, INTENT(OUT) :: OPASPOL ! Passive pollutant flag
LOGICAL, INTENT(OUT) :: OCONDSAMP! Conditional sampling flag
@@ -492,8 +488,6 @@ HCLOUD = CCLOUD
HELEC = CELEC
HEQNSYS = CEQNSYS
!
-PTSTEP_OLD = XTSTEP
-!
!-------------------------------------------------------------------------------
!
!* 3. WRITE DESFM ON OUTPUT LISTING
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index 924b0edf7..f3b4d3a6c 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -252,6 +252,7 @@ END MODULE MODI_READ_EXSEG_n
!! convection scheme MODN_PARAM_MFSHALL_n
!! Modification 09/2009 (J.Escobar) add more info on relaxation problems
!! Modification 09/2011 (J.Escobar) re-add 'ZRESI' choose
+!! Modification 12/2011 (C.Lac) Adaptation to FIT temporal scheme
!! Modification 12/2012 (S.Bielli) add NAM_NCOUT for netcdf output
!!------------------------------------------------------------------------------
!
@@ -530,11 +531,14 @@ END IF
!
CALL TEST_NAM_VAR(ILUOUT,'CPRESOPT',CPRESOPT,'RICHA','CGRAD','CRESI','ZRESI')
!
-CALL TEST_NAM_VAR(ILUOUT,'CUVW_ADV_SCHEME',CUVW_ADV_SCHEME,'CEN2ND','CEN4TH')
-CALL TEST_NAM_VAR(ILUOUT,'CMET_ADV_SCHEME',CMET_ADV_SCHEME,'CEN2ND','CEN4TH','FCT2ND','MPDATA', &
- 'PPM_00','PPM_01','PPM_02')
-CALL TEST_NAM_VAR(ILUOUT,'CSV_ADV_SCHEME',CSV_ADV_SCHEME,'CEN2ND','CEN4TH','FCT2ND','MPDATA', &
- 'PPM_00','PPM_01','PPM_02')
+CALL TEST_NAM_VAR(ILUOUT,'CUVW_ADV_SCHEME',CUVW_ADV_SCHEME, &
+ 'CEN4TH','CEN2ND','WENO_K' )
+CALL TEST_NAM_VAR(ILUOUT,'CMET_ADV_SCHEME',CMET_ADV_SCHEME, &
+ &'PPM_00','PPM_01','PPM_02')
+CALL TEST_NAM_VAR(ILUOUT,'CSV_ADV_SCHEME',CSV_ADV_SCHEME, &
+ &'PPM_00','PPM_01','PPM_02')
+CALL TEST_NAM_VAR(ILUOUT,'CTEMP_SCHEME',CTEMP_SCHEME, &
+ & 'RK11','RK21','RK33','RK53' )
!
CALL TEST_NAM_VAR(ILUOUT,'CTURB',CTURB,'NONE','TKEL')
CALL TEST_NAM_VAR(ILUOUT,'CRAD',CRAD,'NONE','FIXE','ECMW','TOPA')
@@ -992,7 +996,6 @@ END IF
!* 3.1 Turbulence variable
!
IF ((CTURB /= 'NONE').AND.(HTURB == 'NONE')) THEN
- CGETTKEM ='INIT'
CGETTKET ='INIT'
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE TURBULENCE KINETIC ENERGY TKE'
@@ -1000,14 +1003,12 @@ IF ((CTURB /= 'NONE').AND.(HTURB == 'NONE')) THEN
WRITE(UNIT=ILUOUT,FMT=*)'TKE WILL BE INITIALIZED TO ZERO'
ELSE
IF (CTURB /= 'NONE') THEN
- CGETTKEM ='READ'
CGETTKET ='READ'
- IF(HSTORAGE_TYPE=='TT') CGETTKET='INIT'
- ELSE
- CGETTKEM ='SKIP'
- CGETTKET ='SKIP'
+ IF ((CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETTKET='INIT'
+ ELSE
+ CGETTKET ='SKIP'
END IF
-END IF
+END IF
!
!
IF ((CTOM == 'TM06').AND.(HTOM /= 'TM06')) THEN
@@ -1046,15 +1047,11 @@ IF (LUSERV.AND. (.NOT.OUSERV)) THEN
WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE VAPOR VARIABLE Rv WHEREAS IT ", &
& "IS NOT IN INITIAL FMFILE",/, &
& "Rv WILL BE INITIALIZED TO ZERO")')
- CGETRVM='INIT'
CGETRVT='INIT'
ELSE
IF (LUSERV) THEN
- CGETRVM='READ'
CGETRVT='READ'
- IF(HSTORAGE_TYPE=='TT') CGETRVT='INIT'
ELSE
- CGETRVM='SKIP'
CGETRVT='SKIP'
END IF
END IF
@@ -1064,15 +1061,12 @@ IF (LUSERC.AND. (.NOT.OUSERC)) THEN
WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE CLOUD VARIABLE Rc WHEREAS IT ", &
& " IS NOT IN INITIAL FMFILE",/, &
& "Rc WILL BE INITIALIZED TO ZERO")')
- CGETRCM='INIT'
CGETRCT='INIT'
ELSE
IF (LUSERC) THEN
- CGETRCM='READ'
CGETRCT='READ'
- IF(HSTORAGE_TYPE=='TT') CGETRCT='INIT'
+! IF(CCONF=='START') CGETRCT='INIT'
ELSE
- CGETRCM='SKIP'
CGETRCT='SKIP'
END IF
END IF
@@ -1083,15 +1077,12 @@ IF (LUSERR.AND. (.NOT.OUSERR)) THEN
& "IS NOT IN INITIAL FMFILE",/, &
& " Rr WILL BE INITIALIZED TO ZERO")')
- CGETRRM='INIT'
CGETRRT='INIT'
ELSE
IF (LUSERR) THEN
- CGETRRM='READ'
CGETRRT='READ'
- IF(HSTORAGE_TYPE=='TT') CGETRRT='INIT'
+! IF( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRRT='INIT'
ELSE
- CGETRRM='SKIP'
CGETRRT='SKIP'
END IF
END IF
@@ -1101,15 +1092,12 @@ IF (LUSERI.AND. (.NOT.OUSERI)) THEN
WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE ICE VARIABLE Ri WHEREAS IT ", &
& "IS NOT IN INITIAL FMFILE",/, &
& " Ri WILL BE INITIALIZED TO ZERO")')
- CGETRIM='INIT'
CGETRIT='INIT'
ELSE
IF (LUSERI) THEN
- CGETRIM='READ'
CGETRIT='READ'
- IF(HSTORAGE_TYPE=='TT') CGETRIT='INIT'
+! IF(CCONF=='START') CGETRIT='INIT'
ELSE
- CGETRIM='SKIP'
CGETRIT='SKIP'
END IF
END IF
@@ -1133,15 +1121,12 @@ IF (LUSERS.AND. (.NOT.OUSERS)) THEN
WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE SNOW VARIABLE Rs WHEREAS IT ",&
& "IS NOT IN INITIAL FMFILE",/, &
& " Rs WILL BE INITIALIZED TO ZERO")')
- CGETRSM='INIT'
CGETRST='INIT'
ELSE
IF (LUSERS) THEN
- CGETRSM='READ'
CGETRST='READ'
- IF(HSTORAGE_TYPE=='TT') CGETRST='INIT'
+! IF ( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRST='INIT'
ELSE
- CGETRSM='SKIP'
CGETRST='SKIP'
END IF
END IF
@@ -1151,15 +1136,12 @@ IF (LUSERG.AND. (.NOT.OUSERG)) THEN
WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE GRAUPEL VARIABLE Rg WHEREAS ",&
& " IT IS NOTIN INITIAL FMFILE",/, &
& "Rg WILL BE INITIALIZED TO ZERO")')
- CGETRGM='INIT'
CGETRGT='INIT'
ELSE
IF (LUSERG) THEN
- CGETRGM='READ'
CGETRGT='READ'
- IF(HSTORAGE_TYPE=='TT') CGETRGT='INIT'
+! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRGT='INIT'
ELSE
- CGETRGM='SKIP'
CGETRGT='SKIP'
END IF
END IF
@@ -1169,15 +1151,12 @@ IF (LUSERH.AND. (.NOT.OUSERH)) THEN
WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE HAIL VARIABLE Rh WHEREAS",&
& "IT IS NOT IN INITIAL FMFILE",/, &
& " Rh WILL BE INITIALIZED TO ZERO")')
- CGETRHM='INIT'
CGETRHT='INIT'
ELSE
IF (LUSERH) THEN
- CGETRHM='READ'
CGETRHT='READ'
- IF(HSTORAGE_TYPE=='TT') CGETRHT='INIT'
+! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRHT='INIT'
ELSE
- CGETRHM='SKIP'
CGETRHT='SKIP'
END IF
END IF
@@ -1190,7 +1169,7 @@ IF (LUSERC.AND. (.NOT.OUSERC)) THEN
ELSE
IF ( LUSERC ) THEN
CGETCLDFR = 'READ'
- IF(HSTORAGE_TYPE=='TT') CGETCLDFR='INIT'
+! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETCLDFR='INIT'
ELSE
CGETCLDFR = 'SKIP'
END IF
@@ -1205,17 +1184,14 @@ IF ( LUSERC .AND. CTURB /= 'NONE' ) THEN
WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MOIST TURBULENCE WHEREAS IT ",/, &
& " WAS NOT THE CASE FOR THE INITIAL FMFILE GENERATION",/, &
& "SRC AND SIGS ARE INITIALIZED TO 0")')
- CGETSRCM ='INIT'
CGETSRCT ='INIT'
CGETSIGS ='INIT'
ELSE
- CGETSRCM ='READ'
CGETSRCT ='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSRCT ='INIT'
+ IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETSRCT ='INIT'
CGETSIGS ='READ'
END IF
ELSE
- CGETSRCM ='SKIP'
CGETSRCT ='SKIP'
CGETSIGS ='SKIP'
END IF
@@ -1268,35 +1244,34 @@ END IF
!
IF (NSV_USER == KSV_USER) THEN
DO JS = 1,KSV_USER ! to read all the variables in initial file
- CGETSVM(JS)='READ' ! and to initialize them
CGETSVT(JS)='READ' ! and to initialize them
- IF(HSTORAGE_TYPE=='TT')CGETSVT(JS)='INIT' ! with these values
+ IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values
END DO
ELSEIF (NSV_USER > KSV_USER) THEN
+ IF (KSV_USER == 0) THEN
+ CGETSVT(1:NSV_USER)='INIT'
+ ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MORE ADDITIONAL SCALAR " ,&
&" VARIABLES THAN THERE ARE IN INITIAL FMFILE",/, &
& "THE SUPPLEMENTARY VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
DO JS = 1,KSV_USER ! to read all the variables in initial file
- CGETSVM(JS)='READ' ! and to initialize them
CGETSVT(JS)='READ' ! and to initialize them
- IF(HSTORAGE_TYPE=='TT')CGETSVT(JS)='INIT' ! with these values
+ IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values
END DO
DO JS = KSV_USER+1, NSV_USER ! to initialize to zero supplementary
- CGETSVM(JS)='INIT' ! variables (more variables needed than in
CGETSVT(JS)='INIT' ! initial file)
END DO
+ END IF
ELSE
WRITE(UNIT=ILUOUT,FMT=9000) KMI
WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE LESS ADDITIONAL SCALAR " ,&
&" VARIABLES THAN THERE ARE IN INITIAL FMFILE")')
DO JS = 1,NSV_USER ! to read the first NSV_USER variables in initial file
- CGETSVM(JS)='READ' ! and to initialize with these values
CGETSVT(JS)='READ' ! and to initialize with these values
- IF(HSTORAGE_TYPE=='TT') CGETSVT(JS)='INIT'
+ IF(CCONF=='START') CGETSVT(JS)='INIT'
END DO
DO JS = NSV_USER + 1, KSV_USER ! to skip the last (KSV_USER-NSV_USER) variables
- CGETSVM(JS)='SKIP' ! in initial file
CGETSVT(JS)='SKIP'
END DO
END IF
@@ -1305,15 +1280,13 @@ END IF
!
IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
- CGETSVM(NSV_C2R2BEG:NSV_C2R2END)='READ'
CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT'
+ IF(CCONF=='START') CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C2R2 &
& (or KHKO) SCHEME IN INITIAL FMFILE",/,&
& "THE C2R2 (or KHKO) VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_C2R2BEG:NSV_C2R2END)='INIT'
CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT'
END IF
END IF
@@ -1322,15 +1295,13 @@ END IF
!
IF (CCLOUD == 'C3R5') THEN
IF (HCLOUD == 'C3R5') THEN
- CGETSVM(NSV_C1R3BEG:NSV_C1R3END)='READ'
CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT'
+ IF(CCONF=='START') CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C3R5 &
&SCHEME IN INITIAL FMFILE",/,&
& "THE C1R3 VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_C1R3BEG:NSV_C1R3END)='INIT'
CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT'
END IF
END IF
@@ -1339,15 +1310,13 @@ END IF
!
IF (CELEC /= 'NONE') THEN
IF (HELEC /= 'NONE') THEN
- CGETSVM(NSV_ELECBEG:NSV_ELECEND)='READ'
CGETSVT(NSV_ELECBEG:NSV_ELECEND)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
+ IF(CCONF=='START') CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR ELECTRICAL &
&SCHEME IN INITIAL FMFILE",/,&
& "THE ELECTRICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_ELECBEG:NSV_ELECEND)='INIT'
CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
END IF
END IF
@@ -1356,30 +1325,26 @@ END IF
!
IF (LUSECHEM) THEN
IF (OUSECHEM) THEN
- CGETSVM(NSV_CHEMBEG:NSV_CHEMEND)='READ'
CGETSVT(NSV_CHEMBEG:NSV_CHEMEND)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_CHEMBEG:NSV_CHEMEND)='INIT'
+ IF(CCONF=='START' .AND. LCH_INIT_FIELD ) CGETSVT(NSV_CHEMBEG:NSV_CHEMEND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
&SCHEME IN INITIAL FMFILE",/,&
& "THE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_CHEMBEG:NSV_CHEMEND)='INIT'
CGETSVT(NSV_CHEMBEG:NSV_CHEMEND)='INIT'
END IF
END IF
! add ice phase chemical species
IF (LUSECHIC) THEN
IF (OUSECHIC) THEN
- CGETSVM(NSV_CHICBEG:NSV_CHICEND)='READ'
CGETSVT(NSV_CHICBEG:NSV_CHICEND)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT'
+ IF(CCONF=='START') CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
&SPECIES IN ICE PHASE IN INITIAL FMFILE",/,&
& "THE ICE PHASE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_CHICBEG:NSV_CHICEND)='INIT'
CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT'
END IF
END IF
@@ -1409,15 +1374,13 @@ END IF
!
IF (LDUST) THEN
IF (ODUST) THEN
- CGETSVM(NSV_DSTBEG:NSV_DSTEND)='READ'
CGETSVT(NSV_DSTBEG:NSV_DSTEND)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT'
+ IF(CCONF=='START') CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR DUST &
&SCHEME IN INITIAL FMFILE",/,&
& "THE DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_DSTBEG:NSV_DSTEND)='INIT'
CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT'
END IF
IF (LDEPOS_DST(KMI)) THEN
@@ -1434,20 +1397,18 @@ IF (LDUST) THEN
END IF
IF (ODEPOS_DST(KMI) ) THEN
- CGETSVM(NSV_DSTDEPBEG:NSV_DSTDEPEND)='READ'
CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
+ IF(CCONF=='START') CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD DUST &
& SCHEME IN INITIAL FMFILE",/,&
& "THE MOIST DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
END IF
END IF
- IF(NMODE_DST.gt.3 .OR. NMODE_DST.lt.1) THEN
+ IF(NMODE_DST.GT.3 .OR. NMODE_DST.LT.1) THEN
WRITE(UNIT=ILUOUT,FMT=9003) KMI
WRITE(UNIT=ILUOUT,FMT='("DUST MODES MUST BE BETWEEN 1 and 3 ")')
!callabortstop
@@ -1498,15 +1459,13 @@ END IF
!
IF (LSALT) THEN
IF (OSALT) THEN
- CGETSVM(NSV_SLTBEG:NSV_SLTEND)='READ'
CGETSVT(NSV_SLTBEG:NSV_SLTEND)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
+ IF(CCONF=='START') CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR SALT &
&SCHEME IN INITIAL FMFILE",/,&
& "THE SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_SLTBEG:NSV_SLTEND)='INIT'
CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
END IF
IF (LDEPOS_SLT(KMI)) THEN
@@ -1523,19 +1482,17 @@ IF (LSALT) THEN
END IF
IF (ODEPOS_SLT(KMI) ) THEN
- CGETSVM(NSV_SLTDEPBEG:NSV_SLTDEPEND)='READ'
CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
+ IF(CCONF=='START') CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD SEA SALT &
& SCHEME IN INITIAL FMFILE",/,&
& "THE MOIST SEA SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
END IF
END IF
- IF(NMODE_SLT.gt.3 .OR. NMODE_SLT.lt.1) THEN
+ IF(NMODE_SLT.GT.3 .OR. NMODE_SLT.LT.1) THEN
WRITE(UNIT=ILUOUT,FMT=9003) KMI
WRITE(UNIT=ILUOUT,FMT='("SALT MODES MUST BE BETWEEN 1 and 3 ")')
!callabortstop
@@ -1585,15 +1542,13 @@ END IF
!
IF (LORILAM) THEN
IF (OORILAM) THEN
- CGETSVM(NSV_AERBEG:NSV_AEREND)='READ'
CGETSVT(NSV_AERBEG:NSV_AEREND)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT'
+ IF(CCONF=='START') CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR AEROSOL &
&SCHEME IN INITIAL FMFILE",/,&
& "THE AEROSOLS VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_AERBEG:NSV_AEREND)='INIT'
CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT'
END IF
IF (LDEPOS_AER(KMI)) THEN
@@ -1610,15 +1565,13 @@ IF (LORILAM) THEN
END IF
IF (ODEPOS_AER(KMI) ) THEN
- CGETSVM(NSV_AERDEPBEG:NSV_AERDEPEND)='READ'
CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
+ IF(CCONF=='START') CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and IN CLOUD &
& AEROSOL SCHEME IN INITIAL FMFILE",/,&
& "THE MOIST AEROSOL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
END IF
END IF
@@ -1640,9 +1593,8 @@ IF (LINIT_LG .AND. .NOT.(LLG)) THEN
ENDIF
IF (LLG) THEN
IF (OLG .AND. .NOT.(LINIT_LG .AND. CPROGRAM=='MESONH')) THEN
- CGETSVM(NSV_LGBEG:NSV_LGEND)='READ'
CGETSVT(NSV_LGBEG:NSV_LGEND)='READ'
- IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT'
+ IF(CCONF=='START') CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT'
ELSE
IF(.NOT.(LINIT_LG) .AND. CPROGRAM=='MESONH') THEN
WRITE(UNIT=ILUOUT,FMT=9001) KMI
@@ -1650,14 +1602,8 @@ IF (LLG) THEN
& "THE LAGRANGIAN VARIABLES HAVE BEEN REINITIALIZED")')
LINIT_LG=.TRUE.
ENDIF
- CGETSVM(NSV_LGBEG:NSV_LGEND)='INIT'
CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT'
END IF
- IF (CSV_ADV_SCHEME /= CMET_ADV_SCHEME) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("WITH LAGRANGIAN VARIABLES CSV_ADV_SCHEME = CMET_ADV_SCHEME")')
- CSV_ADV_SCHEME = CMET_ADV_SCHEME
- END IF
END IF
!
!
@@ -1665,14 +1611,12 @@ END IF
!
IF (.NOT.LUSECHEM .AND. LCH_CONV_LINOX) THEN
IF (.NOT.OUSECHEM .AND. OCH_CONV_LINOX) THEN
- CGETSVM(NSV_LNOXBEG:NSV_LNOXEND)='READ'
CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='READ'
ELSE
WRITE(UNIT=ILUOUT,FMT=9002) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LINOX &
&IN INITIAL FMFILE",/,&
& "THE LINOX VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVM(NSV_LNOXBEG:NSV_LNOXEND)='INIT'
CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='INIT'
END IF
END IF
@@ -1681,17 +1625,12 @@ END IF
!
IF (LPASPOL) THEN
IF (OPASPOL) THEN
- CGETSVM(NSV_PPBEG:NSV_PPEND)='READ'
CGETSVT(NSV_PPBEG:NSV_PPEND)='READ'
- IF (HSTORAGE_TYPE=='TT') THEN
- CGETSVM(NSV_PPBEG:NSV_PPEND)='INIT'
- CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT'
- END IF
+ IF(CCONF=='START') CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,&
& "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
- CGETSVM(NSV_PPBEG:NSV_PPEND)='INIT'
CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT'
END IF
END IF
@@ -1700,17 +1639,12 @@ END IF
!
IF (LCONDSAMP) THEN
IF (OCONDSAMP) THEN
- CGETSVM(NSV_CSBEG:NSV_CSEND)='READ'
CGETSVT(NSV_CSBEG:NSV_CSEND)='READ'
- IF(HSTORAGE_TYPE=='TT') THEN
- CGETSVM(NSV_CSBEG:NSV_CSEND)='INIT'
- CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT'
- END IF
+ IF(CCONF=='START') CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,&
& "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
- CGETSVM(NSV_CSBEG:NSV_CSEND)='INIT'
CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT'
END IF
END IF
@@ -1790,7 +1724,7 @@ IF( CRAD == 'ECMW' .AND. CPROGRAM=='MESONH' ) THEN
END IF
END IF
!
-IF( CRAD /= 'NONE' .AND. CPROGRAM=='MESONH' ) THEN
+IF ( CRAD /= 'NONE' .AND. CPROGRAM=='MESONH' ) THEN
CGETRAD='READ'
IF( HRAD == 'NONE' .AND. CCONF=='RESTA') THEN
WRITE(UNIT=ILUOUT,FMT=9001) KMI
@@ -1886,7 +1820,7 @@ END SELECT
!
CGETCONV = 'SKIP'
!
-IF( (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) .AND. CPROGRAM=='MESONH') THEN
+IF ( (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) .AND. CPROGRAM=='MESONH') THEN
CGETCONV = 'READ'
IF( HDCONV == 'NONE' .AND. CCONF=='RESTA') THEN
WRITE(UNIT=ILUOUT,FMT=9001) KMI
@@ -1904,26 +1838,6 @@ END IF
!* 3.7 configuration and model version
!
IF (KMI == 1) THEN
- IF ( CPROGRAM=='MESONH' ) THEN
- IF ( CCONF=='START' .AND. HCONF=='RESTA') THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("VARIABLES IN INITIAL FMFILE ARE NOT THE SAME ", &
- & "AT TIME T AND T-DT")')
- WRITE(UNIT=ILUOUT,FMT=*) 'AN EULER SCHEME IS NEVERTHELESS USED FOR THE FIRST TIME STEP.'
- WRITE(UNIT=ILUOUT,FMT=*) 'THUS, THE RESULT OF THE FIRST TIME STEP WILL REPLACE THE INFORMATION'
- WRITE(UNIT=ILUOUT,FMT=*) 'AT TIME T WHICH WILL BE LOST FOR THIS SEGMENT'
- END IF
- IF (CSTORAGE_TYPE/="MT" .AND. CCONF=="RESTA") THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO RESTART a SIMULATION")')
- WRITE(UNIT=ILUOUT,FMT='("but the initial file was not produced by a MESO-NH simulation.",&
- & "The type of this file is ",A2," instead of MT")') CSTORAGE_TYPE
- !callabortstop
- CALL CLOSE_ll(HLUOUT,IOSTAT=IRESP)
- CALL ABORT
- STOP
- END IF
- END IF
!
IF (L1D.AND.(CLBCX(1)/='CYCL'.AND.CLBCX(2)/='CYCL' &
.AND.CLBCY(1)/='CYCL'.AND.CLBCY(2)/='CYCL')) THEN
@@ -2012,14 +1926,6 @@ IF (KMI == 1) THEN
ENDIF
END IF
!
-!* 4.2 stop for MPDATA using too much iterations
-!
-IF (NLITER > 3) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'USING MPDATA WITH ITERATIONS NUMBER GREATER THAN 3 IS &
- & EXPENSIVE'
-END IF
-!
!* 4.3 check consistency in forcing switches
!
IF ( LFORCING ) THEN
diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90
index 9c9637ef0..326ffdfca 100644
--- a/src/MNH/read_field.f90
+++ b/src/MNH/read_field.f90
@@ -4,17 +4,15 @@
!
INTERFACE
!
- SUBROUTINE READ_FIELD(HINIFILE,HLUOUT,KIU,KJU,KKU,PTSTEP_OLD,PTSTEP, &
- HGETTKEM,HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM, &
- HGETRGM,HGETRHM,HGETSVM,HGETSRCM, &
+ SUBROUTINE READ_FIELD(HINIFILE,HLUOUT,KMASDEV,KIU,KJU,KKU,PTSTEP, &
HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT, &
HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR, &
- HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR, &
+ HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, &
KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- PUM,PVM,PWM,PTHM,PPABSM,PTKEM,PRM,PSVM,PSRCM, &
- PUT,PVT,PWT,PTHT,PPABST,PTKET,PRT,PSVT,PCIT,PDRYMASST, &
+ PUM,PVM,PWM, &
+ PUT,PVT,PWT,PTHT,PPABST,PPABSM,PTKET,PRT,PSVT,PCIT,PDRYMASST, &
PSIGS,PSRCT,PCLDFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, &
PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
@@ -23,8 +21,8 @@ INTERFACE
PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
- PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M )
-
+ PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
+ PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD )
!
USE MODD_TIME ! for type DATE_TIME
!
@@ -33,19 +31,13 @@ CHARACTER (LEN=*), INTENT(IN) :: HINIFILE
! name of the initial file
CHARACTER (LEN=*), INTENT(IN) :: HLUOUT
! name for output-listing of nested models
+INTEGER, INTENT(IN) :: KMASDEV
+ ! version of the input file
INTEGER, INTENT(IN) :: KIU, KJU, KKU
! array sizes in x, y and z directions
-REAL, INTENT(IN) :: PTSTEP_OLD
- ! OLD Time STEP (DESFM)
REAL, INTENT(IN) :: PTSTEP
! current Time STEP
!
-CHARACTER (LEN=*), INTENT(IN) :: HGETTKEM, &
- HGETRVM,HGETRCM,HGETRRM, &
- HGETRIM,HGETRSM,HGETRGM,HGETRHM, &
- HGETSRCM
-CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
-!
CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
HGETRVT,HGETRCT,HGETRRT, &
HGETRIT,HGETRST,HGETRGT,HGETRHT, &
@@ -56,6 +48,7 @@ CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
!
! GET indicators to know wether a given variable should or not be read in the
! FM file at time t-deltat and t
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
!
! sizes of the West-east total LB area
INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u
@@ -66,13 +59,6 @@ INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v
INTEGER, INTENT(IN):: KSIZELBYTKE_ll ! for TKE
INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUM,PVM,PWM ! U,V,W at t-dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHM,PTKEM ! theta, tke and
- ! eps at t-dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABSM ! pressure at t-dt
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRM,PSVM ! moist and scalar
- ! variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCM ! turbulent flux
- ! <s'Rc'> at t-dt
REAL, DIMENSION(:,:), INTENT(OUT) :: PBL_DEPTH ! BL depth
REAL, DIMENSION(:,:), INTENT(OUT) :: PSBL_DEPTH ! SBL depth
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHVMF ! MassFlux buoyancy flux
@@ -81,6 +67,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! U,V,W at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHT,PTKET ! theta, tke and
! eps at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! pressure at t
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABSM ! pressure at t-1
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT ! moist and scalar
! variables at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux
@@ -119,6 +106,9 @@ INTEGER, INTENT(IN) :: KRELFRC ! number of forcing
TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTRELFRC ! date of forcing profs.
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL, PRVREL
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M ! Eddy fluxes
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
!
!
END SUBROUTINE READ_FIELD
@@ -127,17 +117,15 @@ END INTERFACE
!
END MODULE MODI_READ_FIELD
! ######spl
- SUBROUTINE READ_FIELD(HINIFILE,HLUOUT,KIU,KJU,KKU,PTSTEP_OLD,PTSTEP, &
- HGETTKEM,HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM, &
- HGETRGM,HGETRHM,HGETSVM,HGETSRCM, &
+ SUBROUTINE READ_FIELD(HINIFILE,HLUOUT,KMASDEV,KIU,KJU,KKU,PTSTEP, &
HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT, &
HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR, &
- HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR, &
+ HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, &
KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- PUM,PVM,PWM,PTHM,PPABSM,PTKEM,PRM,PSVM,PSRCM, &
- PUT,PVT,PWT,PTHT,PPABST,PTKET,PRT,PSVT,PCIT,PDRYMASST, &
+ PUM,PVM,PWM, &
+ PUT,PVT,PWT,PTHT,PPABST,PPABSM,PTKET,PRT,PSVT,PCIT,PDRYMASST, &
PSIGS,PSRCT,PCLDFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, &
PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
@@ -146,7 +134,8 @@ END MODULE MODI_READ_FIELD
PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
- PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M )
+ PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
+ PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD, PRSVS_CLD )
! ########################################################################
!
!!**** *READ_FIELD* - routine to read prognostic and surface fields
@@ -226,10 +215,11 @@ END MODULE MODI_READ_FIELD
!! 05/06 Remove EPS
!! M. Leriche 04/10 add pH in cloud water and rainwater
!! M. Leriche 07/10 treat NSV_* for ice phase chemical species
+!! C.Lac 11/11 Suppress all the t-Dt fields
!! M.Tomasini,
!! P. Peyrille 06/12 2D west african monsoon : add reading of ADV forcing and addy fluxes
!! C.Lac 03/13 add prognostic supersaturation for C2R2/KHKO
-!!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -271,19 +261,13 @@ CHARACTER (LEN=*), INTENT(IN) :: HINIFILE
! name of the initial file
CHARACTER (LEN=*), INTENT(IN) :: HLUOUT
! name for output-listing of nested models
+INTEGER, INTENT(IN) :: KMASDEV
+ ! version of the input file
INTEGER, INTENT(IN) :: KIU, KJU, KKU
! array sizes in x, y and z directions
-REAL, INTENT(IN) :: PTSTEP_OLD
- ! OLD Time STEP (DESFM)
REAL, INTENT(IN) :: PTSTEP
! current Time STEP
!
-CHARACTER (LEN=*), INTENT(IN) :: HGETTKEM, &
- HGETRVM,HGETRCM,HGETRRM, &
- HGETRIM,HGETRSM,HGETRGM,HGETRHM, &
- HGETSRCM
-CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
-!
CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
HGETRVT,HGETRCT,HGETRRT, &
HGETRIT,HGETRST,HGETRGT,HGETRHT, &
@@ -295,6 +279,8 @@ CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
! GET indicators to know wether a given variable should or not be read in the
! FM file at time t-deltat and t
!
+CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
+!
! sizes of the West-east total LB area
INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u
INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE
@@ -305,13 +291,6 @@ INTEGER, INTENT(IN):: KSIZELBYTKE_ll ! for TKE
INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUM,PVM,PWM ! U,V,W at t-dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHM,PTKEM ! theta, tke and
- ! eps at t-dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABSM ! pressure at t-dt
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRM,PSVM ! moist and scalar
- ! variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCM ! turbulent flux
- ! <s'Rc'> at t-dt
REAL, DIMENSION(:,:), INTENT(OUT) :: PBL_DEPTH ! BL depth
REAL, DIMENSION(:,:), INTENT(OUT) :: PSBL_DEPTH ! SBL depth
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHVMF ! MassFlux buoyancy flux
@@ -320,6 +299,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! U,V,W at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHT,PTKET ! theta, tke and
! eps at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! pressure at t
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABSM ! pressure at t-1
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT ! moist and scalar
! variables at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux
@@ -354,14 +334,17 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PTHFRC,PRVFRC
REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC
REAL, DIMENSION(:), INTENT(OUT) :: PPGROUNDFRC
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PATC
-!
+INTEGER, INTENT(IN) :: KADVFRC ! number of forcing
+TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTADVFRC ! date of forcing profs.
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC, PDRVFRC
+INTEGER, INTENT(IN) :: KRELFRC ! number of forcing
+TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTRELFRC ! date of forcing profs.
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL, PRVREL
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M ! Eddy fluxes
-INTEGER, INTENT(IN) :: KADVFRC ! number of forcing
-TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTADVFRC ! date of forcing profs.
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC, PDRVFRC ! advective forcing
-INTEGER, INTENT(IN) :: KRELFRC ! number of forcing
-TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTRELFRC ! date of forcing profs.
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL, PRVREL ! relaxation forcing
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
+!
!
!* 0.2 declarations of local variables
!
@@ -412,465 +395,123 @@ IF (IRESP /= 0) YSTORAGE_TYPE='TT'
!* 2. READ PROGNOSTIC VARIABLES
! -------------------------
!
-!* 2.1 Time t-dt:
+!* 2.1 Time t:
!
-YRECFM = 'UM'
+IF (KMASDEV<50) THEN
+ YRECFM = 'UM'
+ELSE
+ YRECFM = 'UT'
+ENDIF
YDIR='XY'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PUM,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PUT,IGRID,ILENCH,YCOMMENT,IRESP)
!
-YRECFM = 'VM'
+IF (KMASDEV<50) THEN
+ YRECFM = 'VM'
+ELSE
+ YRECFM = 'VT'
+END IF
YDIR='XY'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PVM,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PVT,IGRID,ILENCH,YCOMMENT,IRESP)
!
-YRECFM = 'WM'
+IF (KMASDEV<50) THEN
+ YRECFM = 'WM'
+ELSE
+ YRECFM = 'WT'
+END IF
YDIR='XY'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PWM,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PWT,IGRID,ILENCH,YCOMMENT,IRESP)
!
-YRECFM = 'THM'
+IF (KMASDEV<50) THEN
+ YRECFM = 'THM'
+ELSE
+ YRECFM = 'THT'
+END IF
YDIR='XY'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PTHM,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PTHT,IGRID,ILENCH,YCOMMENT,IRESP)
!
-YRECFM = 'PABSM'
+IF (KMASDEV<50) THEN
+ YRECFM = 'PABSM'
+ELSE
+ YRECFM = 'PABST'
+END IF
YDIR='XY'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PPABSM,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PPABST,IGRID,ILENCH,YCOMMENT,IRESP)
+PPABSM = PPABST
!
-SELECT CASE(HGETTKEM)
- CASE('READ')
- YRECFM = 'TKEM'
+SELECT CASE(HGETTKET)
+ CASE('READ')
+ IF (KMASDEV<50) THEN
+ YRECFM = 'TKEM'
+ ELSE
+ YRECFM = 'TKET'
+ END IF
YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PTKEM,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PTKET,IGRID,ILENCH,YCOMMENT,IRESP)
CASE('INIT')
- PTKEM(:,:,:)=XTKEMIN
+ PTKET(:,:,:)=XTKEMIN
END SELECT
!
IRR=0
!
-SELECT CASE(HGETRVM) ! vapor
+SELECT CASE(HGETRVT) ! vapor
CASE('READ')
IRR=IRR+1
- YRECFM='RVM'
+ IF (KMASDEV<50) THEN
+ YRECFM = 'RVM'
+ ELSE
+ YRECFM='RVT'
+ END IF
YDIR='XY'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
- PRM(:,:,:,IRR)=Z3D(:,:,:)
+ PRT(:,:,:,IRR)=Z3D(:,:,:)
CASE('INIT')
IRR=IRR+1
- PRM(:,:,:,IRR)=0.
+ PRT(:,:,:,IRR)=0.
END SELECT
!
-SELECT CASE(HGETRCM) ! cloud
- CASE('READ')
- IRR=IRR+1
- YRECFM='RCM'
- YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PRM(:,:,:,IRR)=Z3D(:,:,:)
- CASE('INIT')
- IRR=IRR+1
- PRM(:,:,:,IRR) = 0.
-END SELECT
-!
-SELECT CASE(HGETRRM) ! rain
- CASE('READ')
- IRR=IRR+1
- YRECFM='RRM'
- YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PRM(:,:,:,IRR)=Z3D(:,:,:)
- CASE('INIT')
- IRR=IRR+1
- PRM(:,:,:,IRR) = 0.
-END SELECT
-!
-SELECT CASE(HGETRIM) ! cloud ice
- CASE('READ')
- IRR=IRR+1
- YRECFM='RIM'
- YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PRM(:,:,:,IRR)=Z3D(:,:,:)
- CASE('INIT')
- IRR=IRR+1
- PRM(:,:,:,IRR)=0.
-END SELECT
-!
-SELECT CASE(HGETRSM) ! snow
- CASE('READ')
- IRR=IRR+1
- YRECFM='RSM'
- YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PRM(:,:,:,IRR)=Z3D(:,:,:)
- CASE('INIT')
- IRR=IRR+1
- PRM(:,:,:,IRR)=0.
-END SELECT
-!
-SELECT CASE(HGETRGM) ! graupel
- CASE('READ')
- IRR=IRR+1
- YRECFM='RGM'
- YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PRM(:,:,:,IRR)=Z3D(:,:,:)
- CASE('INIT')
- IRR=IRR+1
- PRM(:,:,:,IRR)=0.
-END SELECT
-!
-SELECT CASE(HGETRHM) ! hail
+SELECT CASE(HGETRCT) ! cloud
CASE('READ')
- IRR=IRR+1
- YRECFM='RHM'
- YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PRM(:,:,:,IRR)=Z3D(:,:,:)
- CASE('INIT')
- IRR=IRR+1
- PRM(:,:,:,IRR)=0.
-END SELECT
-!
-! Scalar Variables Reading : Users, C2R2, C1R3, ELEC, Chemical SV
-!
-YDIR='XY'
-ISV= SIZE(PSVM,4)
-!
-DO JSV = 1, NSV_USER ! initialize according to the get indicators
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- WRITE(YRECFM,'(A3,I3.3)')'SVM',JSV
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_C2R2BEG,NSV_C2R2END
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- YRECFM=TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- IF (LSUPSAT .AND. (HGETRVM == 'READ') ) THEN
- ZWORK(:,:,:) = (PPABSM(:,:,:)/XP00 )**(XRD/XCPD)
- ZWORK(:,:,:) = PTHM(:,:,:)*ZWORK(:,:,:)
- ZWORK(:,:,:) = EXP(XALPW-XBETAW/ZWORK(:,:,:)-XGAMW*ALOG(ZWORK(:,:,:)))
- !rvsat
- ZWORK(:,:,:) = (XMV / XMD)*ZWORK(:,:,:)/(PPABSM(:,:,:)-ZWORK(:,:,:))
- ZWORK(:,:,:) = PRM(:,:,:,1)/ZWORK(:,:,:)
- PSVM(:,:,:,NSV_C2R2END ) = ZWORK(:,:,:)
- END IF
- END SELECT
-END DO
-!
-DO JSV = NSV_C1R3BEG,NSV_C1R3END
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- YRECFM=TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_ELECBEG,NSV_ELECEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- YRECFM=TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_CHEMBEG,NSV_CHEMEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- CNAMES(JSV-NSV_CHEMBEG+1) = UPCASE(CNAMES(JSV-NSV_CHEMBEG+1))
- YRECFM=TRIM(CNAMES(JSV-NSV_CHEMBEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_CHICBEG,NSV_CHICEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- CICNAMES(JSV-NSV_CHICBEG+1) = UPCASE(CICNAMES(JSV-NSV_CHICBEG+1))
- YRECFM=TRIM(CICNAMES(JSV-NSV_CHICBEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_SLTBEG,NSV_SLTEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- YRECFM=TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- YRECFM=TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_DSTBEG,NSV_DSTEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- YRECFM=TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- YRECFM=TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
-END SELECT
-END DO
-
-DO JSV = NSV_AERBEG,NSV_AEREND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- YRECFM=TRIM(CAERONAMES(JSV-NSV_AERBEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- YRECFM=TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
-END SELECT
-END DO
-!
-DO JSV = NSV_LGBEG,NSV_LGEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- YRECFM=TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'M'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_PPBEG,NSV_PPEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- WRITE(YRECFM,'(A3,I3.3)')'SVM',JSV
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF ( IRESP ==0 ) THEN
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
+ IRR=IRR+1
+ IF (KMASDEV<50) THEN
+ YRECFM = 'RCM'
ELSE
- PSVM(:,:,:,JSV) = 0.
+ YRECFM='RCT'
END IF
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_CSBEG,NSV_CSEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- WRITE(YRECFM,'(A3,I3.3)')'SVM',JSV
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF ( IRESP ==0 ) THEN
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- ELSE
- PSVM(:,:,:,JSV) = 0.
- END IF
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-DO JSV = NSV_LNOXBEG,NSV_LNOXEND
- SELECT CASE(HGETSVM(JSV))
- CASE ('READ')
- YRECFM='LINOXM'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVM(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!
-!* 2.2 LS fields at time t-dt:
-!
-!* 2.2a 3D LS fields
-!
-!
-CALL INI_LS(HINIFILE,HLUOUT,HGETRVM,GLSOURCE,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM)
-!
-!
-!* 2.2b 2D "surfacic" LB fields
-!
-!
-CALL INI_LB(HINIFILE,HLUOUT,GLSOURCE,ISV, &
- KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
- KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
- KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- HGETTKEM,HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM, &
- HGETRGM,HGETRHM,HGETSVM, &
- PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
- PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM )
-!
-!* 2.3 Time t:
-!
-YRECFM = 'UT'
-YDIR='XY'
-IF (YSTORAGE_TYPE=='TT') THEN
- PUT(:,:,:) =PUM(:,:,:)
-ELSE
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PUT,IGRID,ILENCH,YCOMMENT,IRESP)
-ENDIF
-!
-YRECFM = 'VT'
-YDIR='XY'
-IF (YSTORAGE_TYPE=='TT') THEN
- PVT(:,:,:) =PVM(:,:,:)
-ELSE
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PVT,IGRID,ILENCH,YCOMMENT,IRESP)
-ENDIF
-!
-YRECFM = 'WT'
-YDIR='XY'
-IF (YSTORAGE_TYPE=='TT') THEN
- PWT(:,:,:) =PWM(:,:,:)
-ELSE
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PWT,IGRID,ILENCH,YCOMMENT,IRESP)
-ENDIF
-!
-YRECFM = 'THT'
-YDIR='XY'
-IF (YSTORAGE_TYPE=='TT') THEN
- PTHT(:,:,:) =PTHM(:,:,:)
-ELSE
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PTHT,IGRID,ILENCH,YCOMMENT,IRESP)
-ENDIF
-!
-YRECFM = 'PABST'
-YDIR='XY'
-IF (YSTORAGE_TYPE=='TT') THEN
- PPABST(:,:,:)=PPABSM(:,:,:)
-ELSE
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PPABST,IGRID,ILENCH,YCOMMENT,IRESP)
-ENDIF
-!
-SELECT CASE(HGETTKET)
- CASE('READ')
- YRECFM = 'TKET'
- YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PTKET,IGRID,ILENCH,YCOMMENT,IRESP)
- CASE('INIT')
- PTKET(:,:,:)=XTKEMIN
- IF (YSTORAGE_TYPE=='TT') PTKET(:,:,:)=PTKEM(:,:,:)
-END SELECT
-!
-IRR=0
-SELECT CASE(HGETRVT) ! vapor
- CASE('READ')
- IRR=IRR+1
- YRECFM='RVT'
YDIR='XY'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
PRT(:,:,:,IRR)=Z3D(:,:,:)
CASE('INIT')
IRR=IRR+1
- PRT(:,:,:,IRR)=0.
- IF (YSTORAGE_TYPE=='TT') PRT(:,:,:,IRR)=PRM(:,:,:,IRR)
+ PRT(:,:,:,IRR) = 0.
END SELECT
!
-SELECT CASE(HGETRCT) ! cloud
- CASE('READ')
- IRR=IRR+1
- YRECFM='RCT'
- YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PRT(:,:,:,IRR)=Z3D(:,:,:)
- CASE('INIT')
- IRR=IRR+1
- PRT(:,:,:,IRR)=0.
- IF (YSTORAGE_TYPE=='TT') PRT(:,:,:,IRR)=PRM(:,:,:,IRR)
-END SELECT
-!
-SELECT CASE(HGETRRT) ! rain
- CASE('READ')
- IRR=IRR+1
- YRECFM='RRT'
+SELECT CASE(HGETRRT) ! rain
+ CASE('READ')
+ IRR=IRR+1
+ IF (KMASDEV<50) THEN
+ YRECFM = 'RRM'
+ ELSE
+ YRECFM ='RRT'
+ END IF
YDIR='XY'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
PRT(:,:,:,IRR)=Z3D(:,:,:)
CASE('INIT')
IRR=IRR+1
- PRT(:,:,:,IRR)=0.
- IF (YSTORAGE_TYPE=='TT') PRT(:,:,:,IRR)=PRM(:,:,:,IRR)
+ PRT(:,:,:,IRR) = 0.
END SELECT
!
SELECT CASE(HGETRIT) ! cloud ice
- CASE('READ')
+ CASE('READ')
IRR=IRR+1
- YRECFM='RIT'
+ IF (KMASDEV<50) THEN
+ YRECFM = 'RIM'
+ ELSE
+ YRECFM ='RIT'
+ END IF
YDIR='XY'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
@@ -878,13 +519,16 @@ SELECT CASE(HGETRIT) ! cloud ice
CASE('INIT')
IRR=IRR+1
PRT(:,:,:,IRR)=0.
- IF (YSTORAGE_TYPE=='TT') PRT(:,:,:,IRR)=PRM(:,:,:,IRR)
END SELECT
!
SELECT CASE(HGETRST) ! snow
- CASE('READ')
+ CASE('READ')
IRR=IRR+1
- YRECFM='RST'
+ IF (KMASDEV<50) THEN
+ YRECFM = 'RSM'
+ ELSE
+ YRECFM ='RST'
+ END IF
YDIR='XY'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
@@ -892,13 +536,16 @@ SELECT CASE(HGETRST) ! snow
CASE('INIT')
IRR=IRR+1
PRT(:,:,:,IRR)=0.
- IF (YSTORAGE_TYPE=='TT') PRT(:,:,:,IRR)=PRM(:,:,:,IRR)
END SELECT
!
SELECT CASE(HGETRGT) ! graupel
CASE('READ')
IRR=IRR+1
- YRECFM='RGT'
+ IF (KMASDEV<50) THEN
+ YRECFM = 'RGM'
+ ELSE
+ YRECFM ='RGT'
+ END IF
YDIR='XY'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
@@ -906,13 +553,16 @@ SELECT CASE(HGETRGT) ! graupel
CASE('INIT')
IRR=IRR+1
PRT(:,:,:,IRR)=0.
- IF (YSTORAGE_TYPE=='TT') PRT(:,:,:,IRR)=PRM(:,:,:,IRR)
END SELECT
!
-SELECT CASE(HGETRHT) ! hail
- CASE('READ')
+SELECT CASE(HGETRHT) ! hail
+ CASE('READ')
IRR=IRR+1
- YRECFM='RHT'
+ IF (KMASDEV<50) THEN
+ YRECFM = 'RHM'
+ ELSE
+ YRECFM ='RHT'
+ END IF
YDIR='XY'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
@@ -920,7 +570,6 @@ SELECT CASE(HGETRHT) ! hail
CASE('INIT')
IRR=IRR+1
PRT(:,:,:,IRR)=0.
- IF (YSTORAGE_TYPE=='TT') PRT(:,:,:,IRR)=PRM(:,:,:,IRR)
END SELECT
!
SELECT CASE(HGETCIT) ! ice concentration
@@ -934,10 +583,12 @@ SELECT CASE(HGETCIT) ! ice concentration
PCIT(:,:,:)=0.
END SELECT
!
-! Scalar Variables : Users, C2R2, C1R3, ELEC, Chemical
+! Scalar Variables Reading : Users, C2R2, C1R3, ELEC, Chemical SV
!
YDIR='XY'
-DO JSV = 1, NSV_USER ! initialize according to the get indicators
+ISV= SIZE(PSVT,4)
+!
+DO JSV = 1, NSV_USER ! initialize according to the get indicators
SELECT CASE(HGETSVT(JSV))
CASE ('READ')
WRITE(YRECFM,'(A3,I3.3)')'SVT',JSV
@@ -946,7 +597,6 @@ DO JSV = 1, NSV_USER ! initialize according to the get indicators
PSVT(:,:,:,JSV) = Z3D(:,:,:)
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
END SELECT
END DO
!
@@ -958,8 +608,16 @@ DO JSV = NSV_C2R2BEG,NSV_C2R2END
YCOMMENT,IRESP)
PSVT(:,:,:,JSV) = Z3D(:,:,:)
CASE ('INIT')
- PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
+ PSVT(:,:,:,JSV) = 0.
+ IF (LSUPSAT .AND. (HGETRVT == 'READ') ) THEN
+ ZWORK(:,:,:) = (PPABST(:,:,:)/XP00 )**(XRD/XCPD)
+ ZWORK(:,:,:) = PTHT(:,:,:)*ZWORK(:,:,:)
+ ZWORK(:,:,:) = EXP(XALPW-XBETAW/ZWORK(:,:,:)-XGAMW*ALOG(ZWORK(:,:,:)))
+ !rvsat
+ ZWORK(:,:,:) = (XMV / XMD)*ZWORK(:,:,:)/(PPABST(:,:,:)-ZWORK(:,:,:))
+ ZWORK(:,:,:) = PRT(:,:,:,1)/ZWORK(:,:,:)
+ PSVT(:,:,:,NSV_C2R2END ) = ZWORK(:,:,:)
+ END IF
END SELECT
END DO
!
@@ -971,8 +629,7 @@ DO JSV = NSV_C1R3BEG,NSV_C1R3END
YCOMMENT,IRESP)
PSVT(:,:,:,JSV) = Z3D(:,:,:)
CASE ('INIT')
- PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
+ PSVT(:,:,:,JSV) = 0.
END SELECT
END DO
!
@@ -984,8 +641,7 @@ DO JSV = NSV_ELECBEG,NSV_ELECEND
YCOMMENT,IRESP)
PSVT(:,:,:,JSV) = Z3D(:,:,:)
CASE ('INIT')
- PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
+ PSVT(:,:,:,JSV) = 0.
END SELECT
END DO
!
@@ -998,11 +654,10 @@ DO JSV = NSV_CHEMBEG,NSV_CHEMEND
YCOMMENT,IRESP)
PSVT(:,:,:,JSV) = Z3D(:,:,:)
CASE ('INIT')
- PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
- END SELECT
+ PSVT(:,:,:,JSV) = 0.
+ END SELECT
END DO
-!
+!
DO JSV = NSV_CHICBEG,NSV_CHICEND
SELECT CASE(HGETSVT(JSV))
CASE ('READ')
@@ -1013,8 +668,7 @@ DO JSV = NSV_CHICBEG,NSV_CHICEND
PSVT(:,:,:,JSV) = Z3D(:,:,:)
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
- END SELECT
+ END SELECT
END DO
!
DO JSV = NSV_SLTBEG,NSV_SLTEND
@@ -1026,7 +680,6 @@ DO JSV = NSV_SLTBEG,NSV_SLTEND
PSVT(:,:,:,JSV) = Z3D(:,:,:)
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
END SELECT
END DO
!
@@ -1039,7 +692,6 @@ DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND
PSVT(:,:,:,JSV) = Z3D(:,:,:)
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
END SELECT
END DO
!
@@ -1052,7 +704,6 @@ DO JSV = NSV_DSTBEG,NSV_DSTEND
PSVT(:,:,:,JSV) = Z3D(:,:,:)
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
END SELECT
END DO
!
@@ -1062,14 +713,12 @@ DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND
YRECFM=TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))//'T'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
- PSVT(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
+ PSVT(:,:,:,JSV) = Z3D(:,:,:)
+ CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
- END SELECT
+END SELECT
END DO
-!
DO JSV = NSV_AERBEG,NSV_AEREND
SELECT CASE(HGETSVT(JSV))
CASE ('READ')
@@ -1079,7 +728,6 @@ DO JSV = NSV_AERBEG,NSV_AEREND
PSVT(:,:,:,JSV) = Z3D(:,:,:)
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
END SELECT
END DO
!
@@ -1089,13 +737,12 @@ DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND
YRECFM=TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1))//'T'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
- PSVT(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
+ PSVT(:,:,:,JSV) = Z3D(:,:,:)
+ CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
- END SELECT
+END SELECT
END DO
-!
+!
DO JSV = NSV_LGBEG,NSV_LGEND
SELECT CASE(HGETSVT(JSV))
CASE ('READ')
@@ -1105,20 +752,6 @@ DO JSV = NSV_LGBEG,NSV_LGEND
PSVT(:,:,:,JSV) = Z3D(:,:,:)
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
- END SELECT
-END DO
-!
-DO JSV = NSV_LNOXBEG,NSV_LNOXEND
- SELECT CASE(HGETSVT(JSV))
- CASE ('READ')
- YRECFM='LINOXT'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- PSVT(:,:,:,JSV) = Z3D(:,:,:)
- CASE ('INIT')
- PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
END SELECT
END DO
!
@@ -1128,7 +761,7 @@ DO JSV = NSV_PPBEG,NSV_PPEND
WRITE(YRECFM,'(A3,I3.3)')'SVT',JSV
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
- IF (IRESP == 0) THEN
+ IF ( IRESP ==0 ) THEN
PSVT(:,:,:,JSV) = Z3D(:,:,:)
ELSE
PSVT(:,:,:,JSV) = 0.
@@ -1142,10 +775,8 @@ DO JSV = NSV_PPBEG,NSV_PPEND
ENDIF
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
- PATC(:,:,:,JSV-NSV_PPBEG+1) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
+ PATC(:,:,:,JSV-NSV_PPBEG+1) = 0.
END SELECT
-!
END DO
!
DO JSV = NSV_CSBEG,NSV_CSEND
@@ -1154,42 +785,149 @@ DO JSV = NSV_CSBEG,NSV_CSEND
WRITE(YRECFM,'(A3,I3.3)')'SVT',JSV
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
- IF (IRESP == 0) THEN
+ IF ( IRESP ==0 ) THEN
PSVT(:,:,:,JSV) = Z3D(:,:,:)
ELSE
PSVT(:,:,:,JSV) = 0.
END IF
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
- IF (YSTORAGE_TYPE=='TT') PSVT(:,:,:,JSV)=PSVM(:,:,:,JSV)
END SELECT
END DO
!
+DO JSV = NSV_LNOXBEG,NSV_LNOXEND
+ SELECT CASE(HGETSVT(JSV))
+ CASE ('READ')
+ YRECFM='LINOXT'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ PSVT(:,:,:,JSV) = Z3D(:,:,:)
+ CASE ('INIT')
+ PSVT(:,:,:,JSV) = 0.
+ END SELECT
+END DO
!
-!* 2.4 Some special variables:
+IF (CCONF == 'RESTA') THEN
+ YRECFM = 'US_PRES'
+ YDIR='XY'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PRUS_PRES,IGRID,ILENCH,YCOMMENT,IRESP)
+ YRECFM = 'VS_PRES'
+ YDIR='XY'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PRVS_PRES,IGRID,ILENCH,YCOMMENT,IRESP)
+ YRECFM = 'WS_PRES'
+ YDIR='XY'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PRWS_PRES,IGRID,ILENCH,YCOMMENT,IRESP)
+ YRECFM = 'THS_CLD'
+ YDIR='XY'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PRTHS_CLD,IGRID,ILENCH,YCOMMENT,IRESP)
+ DO JRR = 1, SIZE(PRT,4)
+ IF (JRR == 1 ) THEN
+ YRECFM='RVS_CLD'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ PRRS_CLD(:,:,:,JRR) = Z3D(:,:,:)
+ END IF
+ IF (JRR == 2 ) THEN
+ YRECFM='RCS_CLD'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ PRRS_CLD(:,:,:,JRR) = Z3D(:,:,:)
+ END IF
+ IF (JRR == 3 ) THEN
+ YRECFM='RRS_CLD'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ PRRS_CLD(:,:,:,JRR) = Z3D(:,:,:)
+ END IF
+ IF (JRR == 4 ) THEN
+ YRECFM='RIS_CLD'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ PRRS_CLD(:,:,:,JRR) = Z3D(:,:,:)
+ END IF
+ IF (JRR == 5 ) THEN
+ YRECFM='RSS_CLD'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ PRRS_CLD(:,:,:,JRR) = Z3D(:,:,:)
+ END IF
+ IF (JRR == 6 ) THEN
+ YRECFM='RGS_CLD'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ PRRS_CLD(:,:,:,JRR) = Z3D(:,:,:)
+ END IF
+ IF (JRR == 7 ) THEN
+ YRECFM='RHS_CLD'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ PRRS_CLD(:,:,:,JRR) = Z3D(:,:,:)
+ END IF
+ END DO
+ DO JSV = NSV_C2R2BEG,NSV_C2R2END
+ IF (JSV == NSV_C2R2BEG ) THEN
+ YRECFM='RSVS_CLD1'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ PRSVS_CLD(:,:,:,JSV) = Z3D(:,:,:)
+ END IF
+ IF (JSV == NSV_C2R2BEG ) THEN
+ YRECFM='RSVS_CLD2'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
+ YCOMMENT,IRESP)
+ PRSVS_CLD(:,:,:,JSV) = Z3D(:,:,:)
+ END IF
+ END DO
+END IF
+!
+!* 2.1 Time t-dt:
+!
+IF (CPROGRAM=='MODEL' .AND. HUVW_ADV_SCHEME(1:3)=='CEN') THEN
+ IF (CCONF=='RESTA') THEN
+ YRECFM = 'UM'
+ YDIR='XY'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PUM,IGRID,ILENCH,YCOMMENT,IRESP)
+ !
+ YRECFM = 'VM'
+ YDIR='XY'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PVM,IGRID,ILENCH,YCOMMENT,IRESP)
+ !
+ YRECFM = 'WM'
+ YDIR='XY'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PWM,IGRID,ILENCH,YCOMMENT,IRESP)
+ ELSE
+ PUM = PUT
+ PVM = PVT
+ PWM = PWT
+ END IF
+END IF
+!
+!* 2.2a 3D LS fields
+!
+!
+CALL INI_LS(HINIFILE,HLUOUT,HGETRVT,GLSOURCE,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM)
+!
+!
+!* 2.2b 2D "surfacic" LB fields
+!
+!
+CALL INI_LB(HINIFILE,HLUOUT,GLSOURCE,ISV, &
+ KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
+ KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
+ KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
+ HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETRST, &
+ HGETRGT,HGETRHT,HGETSVT, &
+ PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
+ PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM )
+!
+!
+!* 2.3 Some special variables:
!
YRECFM = 'DRYMASST' ! dry mass
YDIR='--'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PDRYMASST,IGRID,ILENCH,YCOMMENT,IRESP)
!
-SELECT CASE(HGETSRCM) ! turbulent flux SRC at time t-dt
- CASE('READ')
- YRECFM='SRCM'
- YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF( IRESP /= 0 ) THEN
- YRECFM='SRC'
- YDIR='XY'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- END IF
- PSRCM(:,:,:)=Z3D(:,:,:)
- CASE('INIT')
- PSRCM(:,:,:)=0.
-END SELECT
-!
-SELECT CASE(HGETSRCT) ! turbulent flux SRC at time t
+SELECT CASE(HGETSRCT) ! turbulent flux SRC at time t
CASE('READ')
YRECFM='SRCT'
YDIR='XY'
@@ -1204,7 +942,6 @@ SELECT CASE(HGETSRCT) ! turbulent flux SRC at time t
PSRCT(:,:,:)=Z3D(:,:,:)
CASE('INIT')
PSRCT(:,:,:)=0.
- IF (YSTORAGE_TYPE=='TT') PSRCT(:,:,:)=PSRCM(:,:,:)
END SELECT
!
SELECT CASE(HGETSIGS) ! subgrid condensation
@@ -1221,7 +958,6 @@ SELECT CASE(HGETPHC) ! pH in cloud water
CASE('READ')
YRECFM='PHC'
YDIR='XY'
-! IF (SIZE(PCIT) /= 0 ) &
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PPHC,IGRID,ILENCH, &
YCOMMENT,IRESP)
CASE('INIT')
@@ -1232,7 +968,6 @@ SELECT CASE(HGETPHR) ! pH in rainwater
CASE('READ')
YRECFM='PHR'
YDIR='XY'
-! IF (SIZE(PCIT) /= 0 ) &
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PPHR,IGRID,ILENCH, &
YCOMMENT,IRESP)
CASE('INIT')
@@ -1294,7 +1029,7 @@ SELECT CASE(HGETTKET)
END SELECT
!-------------------------------------------------------------------------------
!
-!* 2.5 READ FORCING VARIABLES
+!* 2.4 READ FORCING VARIABLES
! ----------------------
!
!
@@ -1457,43 +1192,8 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 3. TIME STEP CHANGE OR EXOTIC START CONFIGURATION
-! ----------------------------------------------
-!
-IF ( (ABS(PTSTEP -PTSTEP_OLD) >1.E-16) .AND. (CCONF /= 'START') ) THEN
- Z1 = PTSTEP / PTSTEP_OLD
- Z2 = 1. - Z1
-!
- PUM (:,:,:) = Z1 * PUM (:,:,:) + Z2 * PUT (:,:,:)
- PVM (:,:,:) = Z1 * PVM (:,:,:) + Z2 * PVT (:,:,:)
- PWM (:,:,:) = Z1 * PWM (:,:,:) + Z2 * PWT (:,:,:)
- PTHM (:,:,:) = Z1 * PTHM (:,:,:) + Z2 * PTHT (:,:,:)
- PTKEM(:,:,:) = MAX(XTKEMIN,Z1 * PTKEM(:,:,:) + Z2 * PTKET(:,:,:))
- PRM (:,:,:,:) = MAX(0.,Z1 * PRM (:,:,:,:) + Z2 * PRT (:,:,:,:))
- PSVM (:,:,:,:) = MAX(0.,Z1 * PSVM (:,:,:,:) + Z2 * PSVT (:,:,:,:))
- PPABSM(:,:,:) = Z1 * PPABSM(:,:,:) + Z2 * PPABST(:,:,:)
-!
-END IF
!
-IF (YSTORAGE_TYPE=='MT' .AND. CCONF=='START' .AND. CPROGRAM=='MESONH') THEN
- CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
- WRITE(ILUOUT,FMT=*) '*******************************************************'
- WRITE(ILUOUT,FMT=*) 'THE 2 INSTANTS M AND T ARE DIFFERENT IN FILE ',HINIFILE
- WRITE(ILUOUT,FMT=*) 'BUT YOU WANT TO PERFORM A START THEREFORE ALL THE'
- WRITE(ILUOUT,FMT=*) 'FIELDS OF INSTANT M ARE SET EQUAL TO THOSE OF INSTANT T'
- WRITE(ILUOUT,FMT=*) '*******************************************************'
- PUM(:,:,:) =PUT(:,:,:)
- PVM(:,:,:) =PVT(:,:,:)
- PWM(:,:,:) =PWT(:,:,:)
- PTHM(:,:,:) =PTHT(:,:,:)
- PPABSM(:,:,:)=PPABST(:,:,:)
- PTKEM(:,:,:) =PTKET(:,:,:)
- PRM(:,:,:,:) =PRT(:,:,:,:)
- PSVM(:,:,:,:)=PSVT(:,:,:,:)
-ENDIF
-!-------------------------------------------------------------------------------
-!
-!* 4. PRINT ON OUTPUT-LISTING
+!* 3. PRINT ON OUTPUT-LISTING
! ----------------------
!
IF (NVERB >= 10 .AND. .NOT. L1D) THEN
@@ -1507,13 +1207,6 @@ IF (NVERB >= 10 .AND. .NOT. L1D) THEN
WRITE(ILUOUT,FMT=*) PUT(1,1,JKLOOP),PUT(IIUP/2,IJUP/2,JKLOOP), &
PUT(IIUP,KJU,JKLOOP),JKLOOP
END DO
-!
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PUM values:'
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PUM(1,1,JKLOOP),PUM(IIUP/2,IJUP/2,JKLOOP), &
- PUM(IIUP,IJUP,JKLOOP),JKLOOP
- END DO
!
WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PVT values:'
WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
@@ -1521,13 +1214,6 @@ IF (NVERB >= 10 .AND. .NOT. L1D) THEN
WRITE(ILUOUT,FMT=*) PVT(1,1,JKLOOP),PVT(IIUP/2,IJUP/2,JKLOOP), &
PVT(IIUP,IJUP,JKLOOP),JKLOOP
END DO
-!
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PVM values:'
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PVM(1,1,JKLOOP),PVM(IIUP/2,IJUP/2,JKLOOP), &
- PVM(IIUP,IJUP,JKLOOP),JKLOOP
- END DO
!
WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PWT values:'
WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
@@ -1535,13 +1221,6 @@ IF (NVERB >= 10 .AND. .NOT. L1D) THEN
WRITE(ILUOUT,FMT=*) PWT(1,1,JKLOOP),PWT(IIUP/2,IJUP/2,JKLOOP), &
PWT(IIUP,IJUP,JKLOOP),JKLOOP
END DO
-!
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PWM values:'
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PWM(1,1,JKLOOP),PWM(IIUP/2,IJUP/2,JKLOOP), &
- PWM(IIUP,IJUP,JKLOOP),JKLOOP
- END DO
!
WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTHT values:'
WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
@@ -1550,32 +1229,18 @@ IF (NVERB >= 10 .AND. .NOT. L1D) THEN
PTHT(IIUP,IJUP,JKLOOP),JKLOOP
END DO
!
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTHM values:'
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PTHM(1,1,JKLOOP),PTHM(IIUP/2,IJUP/2,JKLOOP), &
- PTHM(IIUP,IJUP,JKLOOP),JKLOOP
- END DO
-!
- IF(SIZE(PTKEM,1) /=0) THEN
+ IF(SIZE(PTKET,1) /=0) THEN
WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTKET values:'
WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
DO JKLOOP=1,KKU
WRITE(ILUOUT,FMT=*) PTKET(1,1,JKLOOP),PTKET(IIUP/2,IJUP/2,JKLOOP), &
PTKET(IIUP,IJUP,JKLOOP),JKLOOP
END DO
-!
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTKEM values:'
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PTKEM(1,1,JKLOOP),PTKEM(IIUP/2,IJUP/2,JKLOOP), &
- PTKEM(IIUP,IJUP,JKLOOP),JKLOOP
- END DO
END IF
!
- IF (SIZE(PRM,4) /= 0) THEN
+ IF (SIZE(PRT,4) /= 0) THEN
WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PRT values:'
- DO JRR = 1, SIZE(PRM,4)
+ DO JRR = 1, SIZE(PRT,4)
WRITE(ILUOUT,FMT=*) 'JRR = ',JRR
WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
DO JKLOOP=1,KKU
@@ -1584,20 +1249,11 @@ IF (NVERB >= 10 .AND. .NOT. L1D) THEN
END DO
END DO
!
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PRM values:'
- DO JRR = 1, SIZE(PRM,4)
- WRITE(ILUOUT,FMT=*) 'JRR = ',JRR
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PRM(1,1,JKLOOP,JRR),PRM(IIUP/2,IJUP/2,JKLOOP,JRR), &
- PRM(IIUP,IJUP,JKLOOP,JRR),JKLOOP
- END DO
- END DO
END IF
!
- IF (SIZE(PSVM,4) /= 0) THEN
+ IF (SIZE(PSVT,4) /= 0) THEN
WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PSVT values:'
- DO JRR = 1, SIZE(PSVM,4)
+ DO JRR = 1, SIZE(PSVT,4)
WRITE(ILUOUT,FMT=*) 'JRR = ',JRR
WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
DO JKLOOP=1,KKU
@@ -1606,18 +1262,9 @@ IF (NVERB >= 10 .AND. .NOT. L1D) THEN
END DO
END DO
!
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PSVM values:'
- DO JRR = 1, SIZE(PSVM,4)
- WRITE(ILUOUT,FMT=*) 'JRR = ',JRR
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PSVM(1,1,JKLOOP,JRR),PSVM(IIUP/2,IJUP/2,JKLOOP,JRR), &
- PSVM(IIUP,IJUP,JKLOOP,JRR),JKLOOP
- END DO
- END DO
END IF
END IF
!-------------------------------------------------------------------------------
-!
+!
!
END SUBROUTINE READ_FIELD
diff --git a/src/MNH/read_precip_field.f90 b/src/MNH/read_precip_field.f90
index 2b1b57a9f..29b3f206e 100644
--- a/src/MNH/read_precip_field.f90
+++ b/src/MNH/read_precip_field.f90
@@ -12,7 +12,8 @@
!
INTERFACE
!
- SUBROUTINE READ_PRECIP_FIELD(HINIFILE,HLUOUT,HGETRCT,HGETRRT,HGETRST,HGETRGT,HGETRHT, &
+ SUBROUTINE READ_PRECIP_FIELD(HINIFILE,HLUOUT,HPROGRAM,HCONF, &
+ HGETRCT,HGETRRT,HGETRST,HGETRGT,HGETRHT, &
PINPRC,PACPRC,PINPRR,PINPRR3D,PEVAP3D, &
PACPRR,PINPRS,PACPRS,PINPRG,PACPRG,PINPRH,PACPRH )
!
@@ -22,6 +23,8 @@ INTERFACE
CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! name of the initial file
CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
! of nested models
+CHARACTER (LEN=*), INTENT(IN) :: HPROGRAM !
+CHARACTER (LEN=*), INTENT(IN) :: HCONF !
!
CHARACTER (LEN=*), INTENT(IN) :: HGETRCT, HGETRRT, HGETRST, HGETRGT, HGETRHT
! Get indicator RCT,RRT,RST,RGT,RHT
@@ -46,7 +49,8 @@ END INTERFACE
END MODULE MODI_READ_PRECIP_FIELD
!
! ################################################################################
- SUBROUTINE READ_PRECIP_FIELD(HINIFILE,HLUOUT,HGETRCT,HGETRRT,HGETRST,HGETRGT,HGETRHT, &
+ SUBROUTINE READ_PRECIP_FIELD(HINIFILE,HLUOUT,HPROGRAM,HCONF, &
+ HGETRCT,HGETRRT,HGETRST,HGETRGT,HGETRHT, &
PINPRC,PACPRC,PINPRR,PINPRR3D,PEVAP3D, &
PACPRR,PINPRS,PACPRS,PINPRG,PACPRG,PINPRH,PACPRH )
! ################################################################################
@@ -85,6 +89,7 @@ END MODULE MODI_READ_PRECIP_FIELD
!! (J. Viviand) 04/02/97 convert precipitation rates in m/s
!! (V. Ducrocq) 14/08/98 // remove KIINF,KJINF,KISUP,KJSUP
!! (JP Pinty) 29/11/02 add C3R5, ICE2, ICE4
+!! (C.Lac) 04/03/13 add YGETxxx for FIT scheme
!!
!-----------------------------------------------------------------------------
!
@@ -103,6 +108,8 @@ CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
!
CHARACTER (LEN=*), INTENT(IN) :: HGETRCT,HGETRRT, HGETRST, HGETRGT, HGETRHT
! Get indicator RRT,RST,RGT,RHT
+CHARACTER (LEN=*), INTENT(IN) :: HPROGRAM !
+CHARACTER (LEN=*), INTENT(IN) :: HCONF !
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC! Droplet instant precip
REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRC! Droplet accumulated precip
@@ -126,6 +133,7 @@ INTEGER :: IGRID,ILENCH,IRESP ! File
CHARACTER (LEN=16) :: YRECFM ! management
CHARACTER (LEN=100) :: YCOMMENT ! variables
CHARACTER(LEN=2) :: YDIR
+CHARACTER(LEN=4) :: YGETRCT,YGETRRT,YGETRST,YGETRGT,YGETRHT
INTEGER :: ILUOUT ! Unit number for prints
!
!-------------------------------------------------------------------------------
@@ -137,13 +145,26 @@ CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
!
YDIR='XY'
!
+IF ((HPROGRAM == 'MESONH') .AND. (HCONF == 'START')) THEN
+ YGETRCT = 'INIT'
+ YGETRRT = 'INIT'
+ YGETRST = 'INIT'
+ YGETRGT = 'INIT'
+ YGETRHT = 'INIT'
+ELSE
+ YGETRCT = HGETRCT
+ YGETRRT = HGETRRT
+ YGETRST = HGETRST
+ YGETRGT = HGETRGT
+ YGETRHT = HGETRHT
+END IF
!-------------------------------------------------------------------------------
!
!* 2.. READ PROGNOSTIC VARIABLES
! -------------------------
!
IF (SIZE(PINPRC) /= 0 ) THEN
- SELECT CASE(HGETRCT)
+ SELECT CASE(YGETRCT)
CASE ('READ')
YRECFM = 'INPRC'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z2D,IGRID,ILENCH,YCOMMENT,IRESP)
@@ -158,7 +179,7 @@ IF (SIZE(PINPRC) /= 0 ) THEN
END IF
!
IF (SIZE(PINPRR) /= 0 ) THEN
- SELECT CASE(HGETRRT)
+ SELECT CASE(YGETRRT)
CASE ('READ')
YRECFM = 'INPRR'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z2D,IGRID,ILENCH,YCOMMENT,IRESP)
@@ -181,7 +202,7 @@ IF (SIZE(PINPRR) /= 0 ) THEN
END IF
!
IF (SIZE(PINPRS) /= 0 ) THEN
- SELECT CASE(HGETRST)
+ SELECT CASE(YGETRST)
CASE ('READ')
YRECFM = 'INPRS'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z2D,IGRID,ILENCH,YCOMMENT,IRESP)
@@ -196,7 +217,7 @@ IF (SIZE(PINPRS) /= 0 ) THEN
END IF
!
IF (SIZE(PINPRG) /= 0 ) THEN
- SELECT CASE(HGETRGT)
+ SELECT CASE(YGETRGT)
CASE ('READ')
YRECFM = 'INPRG'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z2D,IGRID,ILENCH,YCOMMENT,IRESP)
@@ -211,7 +232,7 @@ IF (SIZE(PINPRG) /= 0 ) THEN
END IF
!
IF (SIZE(PINPRH) /= 0 ) THEN
- SELECT CASE(HGETRHT)
+ SELECT CASE(YGETRHT)
CASE ('READ')
YRECFM = 'INPRH'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z2D,IGRID,ILENCH,YCOMMENT,IRESP)
diff --git a/src/MNH/relax2fw_ion.f90 b/src/MNH/relax2fw_ion.f90
index 792f20fc1..ab82f4937 100644
--- a/src/MNH/relax2fw_ion.f90
+++ b/src/MNH/relax2fw_ion.f90
@@ -90,6 +90,7 @@ END MODULE MODI_RELAX2FW_ION
!! MODIFICATIONS
!! -------------
!! C.Lac, 07/11 : Avoid the horizontal relaxation if not father model
+!! C.Lac, 11/11 : Adaptation to FIT temporal scheme
!!
!!
!-------------------------------------------------------------------------------
@@ -161,11 +162,7 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
!* 2.1 set the top-level damping coef. (upstream or leapfrog)
!
-IF ((KTCOUNT.EQ.1) .AND. (CCONF.EQ.'START') ) THEN
ZKV(:) = PALK(:) / (1. - PTSTEP * PALK(:))
-ELSE
- ZKV(:) = PALK(:)
-ENDIF
!
!
!* 2.2 applies the damping in the uppermost levels
@@ -188,11 +185,7 @@ ENDIF
!
IF (KMI == 1) THEN
!
-IF( (KTCOUNT.EQ.1) .AND. (CCONF.EQ.'START') ) THEN
ZKH(:,:) = PKWRELAX(:,:) / (1. - PTSTEP * PKWRELAX(:,:))
-ELSE
- ZKH(:,:) = PKWRELAX(:,:)
-END IF
!
!
!* 3.2 applies the damping near the lateral boundaries
@@ -204,7 +197,7 @@ DO JK = 1, IKU
PRSVS(:,:,JK,NSV_ELECEND) = PRSVS(:,:,JK,NSV_ELECEND) - ZKH(:,:) * &
(PSVM(:,:,JK,NSV_ELECEND) - XCION_NEG_FW(:,:,JK)) * PRHODJ(:,:,JK)
END WHERE
-ENDDO
+ENDDO
!
END IF
!
diff --git a/src/MNH/relaxation.f90 b/src/MNH/relaxation.f90
index c13d8668b..79846b80d 100644
--- a/src/MNH/relaxation.f90
+++ b/src/MNH/relaxation.f90
@@ -14,7 +14,7 @@ INTERFACE
OHORELAX_SVDST, OHORELAX_SVSLT, OHORELAX_SVPP, &
OHORELAX_SVCS, &
KTCOUNT,KRR,KSV,PTSTEP,PRHODJ, &
- PUM, PVM, PWM, PTHM, PRM, PSVM, PTKEM, &
+ PUT, PVT, PWT, PTHT, PRT, PSVT, PTKET, &
PLSUM, PLSVM, PLSWM, PLSTHM, &
PLBXUM, PLBXVM, PLBXWM, PLBXTHM, PLBXRM, PLBXSVM, &
PLBXTKEM, &
@@ -78,11 +78,11 @@ INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KSV ! Number of scalar variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! effective dry rho * Jacobian
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM ! Variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! at
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! t-dt
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM !
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET
!
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUM, PLSVM ! Large Scale
@@ -147,7 +147,7 @@ END MODULE MODI_RELAXATION
OHORELAX_SVDST, OHORELAX_SVSLT, OHORELAX_SVPP, &
OHORELAX_SVCS, &
KTCOUNT,KRR,KSV,PTSTEP,PRHODJ, &
- PUM, PVM, PWM, PTHM, PRM, PSVM, PTKEM, &
+ PUT, PVT, PWT, PTHT, PRT, PSVT, PTKET, &
PLSUM, PLSVM, PLSWM, PLSTHM, &
PLBXUM, PLBXVM, PLBXWM, PLBXTHM, PLBXRM, PLBXSVM, &
PLBXTKEM, &
@@ -237,6 +237,7 @@ END MODULE MODI_RELAXATION
!! 06/11/02 (V. Masson) update the budget calls
!! 05/2006 Remove EPS
!! 06/2011 (M.Chong) Case of ELEC
+!! 11/2011 (C.Lac) Adaptation to FIT temporal scheme
!!
!-------------------------------------------------------------------------------
!
@@ -312,11 +313,11 @@ INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KSV ! Number of scalar variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! effective dry rho * Jacobian
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM ! Variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! at
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! t-dt
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM !
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET
!
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUM, PLSVM ! Large Scale
@@ -385,14 +386,14 @@ REAL, DIMENSION(SIZE(PALKBAS)) :: ZKVBAS ! Function of the upper absor
! layer damping coefficient for u,v,theta and qv
REAL, DIMENSION(SIZE(PALKBAS)) :: ZKVWBAS !Idem but for w
!
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZKHU,ZKHV,ZKHW, &
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZKHU,ZKHV,ZKHW, &
! Function of the lateral absorbing layer damping
! for u,v and mass points respectively
ZRHODJU,ZRHODJV,ZRHODJW, &
! averages along x,y,z of the PRHODJ field
ZWORK
! work array used to expand the LB fields
-LOGICAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: GMASK3D_RELAX ! 3D
+LOGICAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: GMASK3D_RELAX ! 3D
! mask for hor. relax.
LOGICAL, DIMENSION(7) :: GHORELAXR ! local array of logical
LOGICAL, DIMENSION(11) :: GHORELAXSV! local array of logical
@@ -402,7 +403,7 @@ LOGICAL, DIMENSION(11) :: GHORELAXSV! local array of logical
!
!* 1. PRELIMINARIES
! -------------
-IKU=SIZE(PUM,3)
+IKU=SIZE(PUT,3)
IKE=IKU-JPVEXT
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
CALL GET_GLOBALDIMS_ll(IIU_ll,IJU_ll)
@@ -441,29 +442,29 @@ IF(OVE_RELAX) THEN
!
!* 2.1 SET THE TOP-LEVEL DAMPING COEF. (UPSTREAM OR LEAPFROG)
!
- IF ((KTCOUNT.EQ.1) .AND. (CCONF.EQ.'START') ) THEN
+! IF (KTCOUNT.EQ.1) THEN
ZKV(:) = PALK(:) /(1. - PTSTEP * PALK(:))
ZKVW(:) = PALKW(:)/(1. - PTSTEP * PALKW(:))
- ELSE
- ZKV(:) = PALK(:)
- ZKVW(:) = PALKW(:)
- ENDIF
+! ELSE
+! ZKV(:) = PALK(:)
+! ZKVW(:) = PALKW(:)
+! ENDIF
!
!
!* 2.2 APPLIES THE DAMPING IN THE UPPERMOST LEVELS
!
DO JK = KALBOT, IKE+1
!
- PRUS(:,:,JK) = PRUS(:,:,JK) - ZKV(JK) *(PUM(:,:,JK) -PLSUM(:,:,JK) )&
+ PRUS(:,:,JK) = PRUS(:,:,JK) - ZKV(JK) *(PUT(:,:,JK) -PLSUM(:,:,JK) )&
* ZRHODJU(:,:,JK)
!
- PRVS(:,:,JK) = PRVS(:,:,JK) - ZKV(JK) *(PVM(:,:,JK) -PLSVM(:,:,JK) )&
+ PRVS(:,:,JK) = PRVS(:,:,JK) - ZKV(JK) *(PVT(:,:,JK) -PLSVM(:,:,JK) )&
* ZRHODJV(:,:,JK)
!
- PRWS(:,:,JK) = PRWS(:,:,JK) - ZKVW(JK) *(PWM(:,:,JK) -PLSWM(:,:,JK) )&
+ PRWS(:,:,JK) = PRWS(:,:,JK) - ZKVW(JK) *(PWT(:,:,JK) -PLSWM(:,:,JK) )&
* ZRHODJW(:,:,JK)
!
- PRTHS(:,:,JK) = PRTHS(:,:,JK) - ZKV(JK) *(PTHM(:,:,JK) -PLSTHM(:,:,JK) )&
+ PRTHS(:,:,JK) = PRTHS(:,:,JK) - ZKV(JK) *(PTHT(:,:,JK) -PLSTHM(:,:,JK) )&
* PRHODJ(:,:,JK)
!
END DO
@@ -491,16 +492,16 @@ IF(OVE_RELAX_GRD) THEN
!
DO JK = 1,KALBAS
!
- PRUS(:,:,JK) = PRUS(:,:,JK) - ZKVBAS(JK) *(PUM(:,:,JK) -PLSUM(:,:,JK) )&
+ PRUS(:,:,JK) = PRUS(:,:,JK) - ZKVBAS(JK) *(PUT(:,:,JK) -PLSUM(:,:,JK) )&
* ZRHODJU(:,:,JK)
!
- PRVS(:,:,JK) = PRVS(:,:,JK) - ZKVBAS(JK) *(PVM(:,:,JK) -PLSVM(:,:,JK) )&
+ PRVS(:,:,JK) = PRVS(:,:,JK) - ZKVBAS(JK) *(PVT(:,:,JK) -PLSVM(:,:,JK) )&
* ZRHODJV(:,:,JK)
!
- PRWS(:,:,JK) = PRWS(:,:,JK) - ZKVWBAS(JK) *(PWM(:,:,JK) -PLSWM(:,:,JK) )&
+ PRWS(:,:,JK) = PRWS(:,:,JK) - ZKVWBAS(JK) *(PWT(:,:,JK) -PLSWM(:,:,JK) )&
* ZRHODJW(:,:,JK)
!
- PRTHS(:,:,JK) = PRTHS(:,:,JK) - ZKVBAS(JK) *(PTHM(:,:,JK) -PLSTHM(:,:,JK) )&
+ PRTHS(:,:,JK) = PRTHS(:,:,JK) - ZKVBAS(JK) *(PTHT(:,:,JK) -PLSTHM(:,:,JK) )&
* PRHODJ(:,:,JK)
!
END DO
@@ -518,19 +519,19 @@ END IF
!
IF ( ANY(GHORELAXR) .OR. ANY(GHORELAXSV) .OR. ANY(OHORELAX_SV) &
.OR. OHORELAX_UVWTH .OR. OHORELAX_TKE ) THEN
- IF( (KTCOUNT.EQ.1) .AND. (CCONF.EQ.'START') ) THEN
+! IF (KTCOUNT.EQ.1) THEN
DO JK=1,IKU
ZKHU(:,:,JK) = PKURELAX(:,:) /(1. - PTSTEP * PKURELAX(:,:))
ZKHV(:,:,JK) = PKVRELAX(:,:) /(1. - PTSTEP * PKVRELAX(:,:))
ZKHW(:,:,JK) = PKWRELAX(:,:) /(1. - PTSTEP * PKWRELAX(:,:))
END DO
- ELSE
- DO JK=1,IKU
- ZKHU(:,:,JK) = PKURELAX(:,:)
- ZKHV(:,:,JK) = PKVRELAX(:,:)
- ZKHW(:,:,JK) = PKWRELAX(:,:)
- END DO
- END IF
+! ELSE
+! DO JK=1,IKU
+! ZKHU(:,:,JK) = PKURELAX(:,:)
+! ZKHV(:,:,JK) = PKVRELAX(:,:)
+! ZKHW(:,:,JK) = PKWRELAX(:,:)
+! END DO
+! END IF
ENDIF
!
!
@@ -574,7 +575,7 @@ IF ( OHORELAX_UVWTH ) THEN
END IF
!
WHERE (GMASK3D_RELAX)
- PRUS(:,:,:) = PRUS(:,:,:) - ZKHU(:,:,:)*(PUM(:,:,:)-ZWORK(:,:,:)) &
+ PRUS(:,:,:) = PRUS(:,:,:) - ZKHU(:,:,:)*(PUT(:,:,:)-ZWORK(:,:,:)) &
* ZRHODJU(:,:,:)
END WHERE
!
@@ -607,7 +608,7 @@ IF ( OHORELAX_UVWTH ) THEN
ENDIF
!
WHERE (GMASK3D_RELAX)
- PRVS(:,:,:) = PRVS(:,:,:) - ZKHV(:,:,:)*(PVM(:,:,:)-ZWORK(:,:,:)) &
+ PRVS(:,:,:) = PRVS(:,:,:) - ZKHV(:,:,:)*(PVT(:,:,:)-ZWORK(:,:,:)) &
* ZRHODJV(:,:,:)
END WHERE
!
@@ -615,7 +616,7 @@ IF ( OHORELAX_UVWTH ) THEN
IF (SIZE(PLBYWM,2) > 0) CALL EXPAND_LBY (PLBYWM,ZWORK)
!
WHERE (GMASK3D_RELAX)
- PRWS(:,:,:) = PRWS(:,:,:) - ZKHW(:,:,:)*(PWM(:,:,:)-ZWORK(:,:,:)) &
+ PRWS(:,:,:) = PRWS(:,:,:) - ZKHW(:,:,:)*(PWT(:,:,:)-ZWORK(:,:,:)) &
* ZRHODJW(:,:,:)
END WHERE
!
@@ -624,7 +625,7 @@ IF ( OHORELAX_UVWTH ) THEN
IF (SIZE(PLBYTHM,2) > 0) CALL EXPAND_LBY (PLBYTHM,ZWORK)
!
WHERE (GMASK3D_RELAX)
- PRTHS(:,:,:) = PRTHS(:,:,:) - ZKHW(:,:,:)*(PTHM(:,:,:)-ZWORK(:,:,:)) &
+ PRTHS(:,:,:) = PRTHS(:,:,:) - ZKHW(:,:,:)*(PTHT(:,:,:)-ZWORK(:,:,:)) &
* PRHODJ(:,:,:)
END WHERE
END IF
@@ -634,7 +635,7 @@ DO JRR = 1,KRR
IF (SIZE(PLBXRM,1) > 0) CALL EXPAND_LBX (PLBXRM(:,:,:,JRR),ZWORK)
IF (SIZE(PLBYRM,2) > 0) CALL EXPAND_LBY (PLBYRM(:,:,:,JRR),ZWORK)
WHERE (GMASK3D_RELAX)
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) - ZKHW(:,:,:)*(PRM(:,:,:,JRR)-ZWORK(:,:,:)) &
+ PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) - ZKHW(:,:,:)*(PRT(:,:,:,JRR)-ZWORK(:,:,:)) &
* PRHODJ(:,:,:)
END WHERE
END IF
@@ -644,7 +645,7 @@ IF ( OHORELAX_TKE ) THEN
IF (SIZE(PLBXTKEM,1) > 0) CALL EXPAND_LBX (PLBXTKEM,ZWORK)
IF (SIZE(PLBYTKEM,2) > 0) CALL EXPAND_LBY (PLBYTKEM,ZWORK)
WHERE (GMASK3D_RELAX)
- PRTKES(:,:,:) = PRTKES(:,:,:) - ZKHW(:,:,:)*(PTKEM(:,:,:)-ZWORK(:,:,:)) &
+ PRTKES(:,:,:) = PRTKES(:,:,:) - ZKHW(:,:,:)*(PTKET(:,:,:)-ZWORK(:,:,:)) &
* PRHODJ(:,:,:)
END WHERE
END IF
@@ -655,7 +656,7 @@ DO JSV=1,KSV
IF (SIZE(PLBXSVM,1) > 0) CALL EXPAND_LBX (PLBXSVM(:,:,:,JSV),ZWORK)
IF (SIZE(PLBYSVM,2) > 0) CALL EXPAND_LBY (PLBYSVM(:,:,:,JSV),ZWORK)
WHERE (GMASK3D_RELAX)
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - ZKHW(:,:,:)*(PSVM(:,:,:,JSV)-ZWORK(:,:,:)) &
+ PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - ZKHW(:,:,:)*(PSVT(:,:,:,JSV)-ZWORK(:,:,:)) &
* PRHODJ(:,:,:)
END WHERE
END IF
diff --git a/src/MNH/reset_exseg.f90 b/src/MNH/reset_exseg.f90
index 0d0094fba..25e89fddc 100644
--- a/src/MNH/reset_exseg.f90
+++ b/src/MNH/reset_exseg.f90
@@ -85,7 +85,6 @@ CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! Name for output listing
CHARACTER (LEN=9) :: YNAM ! name of the namelist file
INTEGER :: IRESP,ILUNAM ! return code of FMLOOK and logical unit number
LOGICAL :: GFOUND ! Return code when searching namelist
-CHARACTER(LEN=2) :: YSTORAGE_TYPE
CHARACTER(LEN=100):: YCOMMENT ! Comment string
INTEGER :: IGRID ! IGRID : grid indicator
INTEGER :: ILENCH ! ILENCH : length of comment string
@@ -151,13 +150,8 @@ IF(NRAD_3D>=1) THEN
END IF
ENDIF
!
-CALL FMREAD(CINIFILE,'STORAGE_TYPE',HLUOUT,'--',YSTORAGE_TYPE,IGRID,ILENCH,YCOMMENT,IRESP)
-IF (IRESP/=0) THEN
- PRINT*,'RESET_EXSEG: STORAGE_TYPE forced to MT'
- YSTORAGE_TYPE='MT'
-END IF
-IF(YSTORAGE_TYPE/='MT' .OR. NRAD_3D>=1) THEN
+IF ( NRAD_3D>=1 ) THEN
CRAD='ECMW'
CGETRAD='INIT'
END IF
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index b5f274601..972fe6001 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -8,10 +8,10 @@ INTERFACE
KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
HLBCX, HLBCY, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
OCLOSE_OUT, OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
- PTSTEP_MET, PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABSM, PPABST, PTHM, PTHT, PRM, PRT, PSIGS,PSIGQSAT,&
- PMFCONV, &
- PW_ACT, PTHS, PRS, PSVM, PSVT, PSVS, PSRCS, PCLDFR, &
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
+ PTHM, PRCM, PPABSM, &
+ PW_ACT, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR, &
PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, &
ORAIN, OWARM, OHHONI, &
PCF_MF,PRC_MF, PRI_MF, &
@@ -45,8 +45,6 @@ LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
! or that from turbulence scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
! Kind of Subgrid autoconversion method
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective Time step
- ! for meteorological scalar variables
REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
!
!
@@ -56,21 +54,20 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
!
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Moist variables at time t-dt
REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
!
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVM ! Scalar variable at time t-dt
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
!
@@ -124,10 +121,10 @@ END MODULE MODI_RESOLVED_CLOUD
KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
HLBCX, HLBCY, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
OCLOSE_OUT, OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
- PTSTEP_MET, PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABSM, PPABST, PTHM, PTHT, PRM, PRT, PSIGS,PSIGQSAT,&
- PMFCONV, &
- PW_ACT, PTHS, PRS, PSVM, PSVT, PSVS, PSRCS, PCLDFR, &
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
+ PTHM, PRCM, PPABSM, &
+ PW_ACT, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR, &
PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, &
ORAIN, OWARM, OHHONI, &
PCF_MF,PRC_MF, PRI_MF, &
@@ -296,8 +293,6 @@ LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
! or that from turbulence scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
! Kind of Subgrid autoconversion method
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective Time step
- ! for meteorological scalar variables
REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
!
!
@@ -307,21 +302,20 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
!
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Moist variables at time t-dt
REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
!
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVM ! Scalar variable at time t-dt
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
!
@@ -396,7 +390,6 @@ REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
INTEGER :: ISVBEG ! first scalar index for microphysics
INTEGER :: ISVEND ! last scalar index for microphysics
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVM ! scalar variable for microphysics only
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVS ! scalar tendency for microphysics only
!
!------------------------------------------------------------------------------
@@ -425,10 +418,8 @@ END IF
!
IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1))
- ALLOCATE(ZSVM(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1))
ALLOCATE(ZSVS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1))
ZSVT(:,:,:,:) = PSVT(:,:,:,ISVBEG:ISVEND)
- ZSVM(:,:,:,:) = PSVM(:,:,:,ISVBEG:ISVEND)
ZSVS(:,:,:,:) = PSVS(:,:,:,ISVBEG:ISVEND)
END IF
!
@@ -680,8 +671,8 @@ SELECT CASE ( HCLOUD )
! -------------------------------
!
CALL FAST_TERMS ( KRR, KMI, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
- HSCONV, HMF_CLOUD, OCLOSE_OUT, OSUBG_COND, PTSTEP_MET, &
- PRHODJ, PPABSM, PSIGS, PPABST, &
+ HSCONV, HMF_CLOUD, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
PCF_MF,PRC_MF, &
PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
@@ -695,9 +686,8 @@ SELECT CASE ( HCLOUD )
!
!* 5.1 Compute the explicit microphysical sources
!
- CALL SLOW_TERMS ( KSPLITR, PTSTEP_MET, KMI, HSUBG_AUCV, &
+ CALL SLOW_TERMS ( KSPLITR, PTSTEP, KMI, HSUBG_AUCV, &
PZZ, PRHODJ, PRHODREF, PCLDFR, &
- PRM(:,:,:,3), &
PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), PPABST, &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PINPRR, PINPRR3D, PEVAP3D )
@@ -705,8 +695,8 @@ SELECT CASE ( HCLOUD )
!* 5.2 Perform the saturation adjustment
!
CALL FAST_TERMS ( KRR, KMI, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
- HSCONV, HMF_CLOUD, OCLOSE_OUT, OSUBG_COND, PTSTEP_MET, &
- PRHODJ, PPABSM, PSIGS, PPABST, &
+ HSCONV, HMF_CLOUD, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
PCF_MF,PRC_MF, &
PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), PRRS=PRS(:,:,:,3), &
@@ -722,13 +712,12 @@ SELECT CASE ( HCLOUD )
!* 7.1 Compute the explicit microphysical sources
!
!
- CALL RAIN_C2R2 ( OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP_MET, PTSTEP, KMI, &
+ CALL RAIN_C2R2 ( OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABSM, PPABST, PTHM, PTHT, &
- PRT(:,:,:,1), PRM(:,:,:,2), PRT(:,:,:,2), &
- PRT(:,:,:,3), PRM(:,:,:,3), &
+ PPABST, PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
+ PTHM, PRCM, PPABSM, &
PW_ACT, PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
- ZSVT(:,:,:,1), ZSVT(:,:,:,2), ZSVM(:,:,:,3), ZSVT(:,:,:,3), &
+ ZSVT(:,:,:,1), ZSVT(:,:,:,2), ZSVT(:,:,:,3), &
ZSVS(:,:,:,1), ZSVS(:,:,:,2), ZSVS(:,:,:,3), &
PINPRC, PINPRR, PINPRR3D, PEVAP3D , &
PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN )
@@ -738,7 +727,7 @@ SELECT CASE ( HCLOUD )
!
IF (LSUPSAT) THEN
CALL KHKO_NOTADJUST (KRR, KTCOUNT,HFMFILE, HLUOUT, HRAD, OCLOSE_OUT, &
- PTSTEP_MET, PRHODJ, PPABSM, PPABST, PRHODREF, PZZ, &
+ PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PZZ, &
PTHT,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3), &
PTHS,PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
ZSVS(:,:,:,2),ZSVS(:,:,:,1), &
@@ -746,10 +735,9 @@ SELECT CASE ( HCLOUD )
!
ELSE
CALL C2R2_ADJUST ( KRR,HFMFILE, HLUOUT, HRAD, &
- HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP_MET, &
- PRHODJ, PPABSM, PSIGS, PPABST, &
- PTHS=PTHS, PRVS=PRS(:,:,:,1), &
- PRCS=PRS(:,:,:,2), &
+ HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PTHS=PTHS, PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
PCNUCS=ZSVS(:,:,:,1), PCCS=ZSVS(:,:,:,2), &
PSRCS=PSRCS, PCLDFR=PCLDFR, PRRS=PRS(:,:,:,3) )
!
@@ -764,10 +752,11 @@ SELECT CASE ( HCLOUD )
!* 8.1 Compute the explicit microphysical sources!
!
!
- CALL RAIN_KHKO ( OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP_MET, PTSTEP, KMI, &
+ CALL RAIN_KHKO ( OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABSM, PPABST, PTHM, PTHT, &
- PRT(:,:,:,1), PRM(:,:,:,2), PRT(:,:,:,2), PRT(:,:,:,3), &
+ PPABST, PTHT, &
+ PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
+ PTHM, PRCM, PPABSM, &
PW_ACT, PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
ZSVT(:,:,:,1), ZSVT(:,:,:,2), ZSVT(:,:,:,3), &
ZSVS(:,:,:,1), ZSVS(:,:,:,2), ZSVS(:,:,:,3), &
@@ -778,16 +767,16 @@ SELECT CASE ( HCLOUD )
!
IF (LSUPSAT) THEN
CALL KHKO_NOTADJUST (KRR, KTCOUNT,HFMFILE, HLUOUT, HRAD, OCLOSE_OUT, &
- PTSTEP_MET, PRHODJ, PPABSM, PPABST, PRHODREF, PZZ, &
+ PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PZZ, &
PTHT,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3), &
PTHS,PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
ZSVS(:,:,:,2),ZSVS(:,:,:,1), &
ZSVS(:,:,:,4), PCLDFR, PSRCS )
!
ELSE
- CALL C2R2_ADJUST ( KRR, HFMFILE, HLUOUT, HRAD, &
- HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP_MET, &
- PRHODJ, PPABSM, PSIGS, PPABST, &
+ CALL C2R2_ADJUST ( KRR, HFMFILE, HLUOUT, HRAD, &
+ HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
PTHS=PTHS, PRVS=PRS(:,:,:,1), &
PRCS=PRS(:,:,:,2), &
PCNUCS=ZSVS(:,:,:,1), PCCS=ZSVS(:,:,:,2), &
@@ -797,34 +786,33 @@ SELECT CASE ( HCLOUD )
!
CASE ('ICE3')
!
-!* 10. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
+!* 9. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
! -----------------------------------------------------
!
!
-!* 10.1 Compute the explicit microphysical sources
+!* 9.1 Compute the explicit microphysical sources
+!
!
-!
DO JK=IKB,IKE
ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
ENDDO
- CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
- KSPLITR, PTSTEP_MET, KMI, KRR, &
- ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR, &
- PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRM(:,:,:,2), &
- PRT(:,:,:,3), PRM(:,:,:,3), &
- PRT(:,:,:,4), PRT(:,:,:,5), PRM(:,:,:,5), &
- PRT(:,:,:,6), PRM(:,:,:,6), &
+ CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
+ KSPLITR, PTSTEP, KMI, KRR, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,&
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
PINPRS, PINPRG, PSIGS, PSEA,PTOWN)
!
-!* 10.2 Perform the saturation adjustment over cloud ice and cloud water
+!* 9.2 Perform the saturation adjustment over cloud ice and cloud water
!
ZZZ = MZF(1,IKU,1, PZZ )
- CALL ICE_ADJUST (1,IKU,1, KRR, KMI, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
- OSUBG_COND, OSIGMAS, PTSTEP_MET,PSIGQSAT, &
- PRHODJ, PEXNREF, PPABSM, PSIGS, PMFCONV, PPABST, ZZZ, &
+ CALL ICE_ADJUST (1,IKU,1, KRR, KMI, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
+ OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
+ PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
PCF_MF,PRC_MF,PRI_MF, &
PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
@@ -846,26 +834,25 @@ SELECT CASE ( HCLOUD )
DO JK=IKB,IKE
ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
ENDDO
- CALL RAIN_ICE ( OSEDIC, CSEDIM,HSUBG_AUCV, OWARM,1,IKU,1, &
- KSPLITR, PTSTEP_MET, KMI, KRR, &
- ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
- PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRM(:,:,:,2), &
- PRT(:,:,:,3), PRM(:,:,:,3), &
- PRT(:,:,:,4), PRT(:,:,:,5), PRM(:,:,:,5), &
- PRT(:,:,:,6), PRM(:,:,:,6), &
+ CALL RAIN_ICE ( OSEDIC, CSEDIM,HSUBG_AUCV, OWARM,1,IKU,1, &
+ KSPLITR, PTSTEP, KMI, KRR, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PSEA, PTOWN, &
- PRT(:,:,:,7), PRM(:,:,:,7), PRS(:,:,:,7), PINPRH )
+ PINPRS, PINPRG, PSIGS, PSEA, PTOWN, &
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH )
!
!* 10.2 Perform the saturation adjustment over cloud ice and cloud water
!
ZZZ = MZF(1,IKU,1, PZZ )
CALL ICE_ADJUST (1,IKU,1, KRR, KMI, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
- OSUBG_COND, OSIGMAS, PTSTEP_MET,PSIGQSAT, &
- PRHODJ, PEXNREF, PPABSM, PSIGS, PMFCONV, PPABST, ZZZ, &
+ OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
+ PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
PCF_MF,PRC_MF,PRI_MF, &
PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
@@ -884,23 +871,24 @@ SELECT CASE ( HCLOUD )
!
!* 11.1 Compute the explicit microphysical sources
!
- CALL RAIN_C2R2 ( OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP_MET, PTSTEP, KMI, &
+ CALL RAIN_C2R2 ( OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABSM, PPABST, PTHM, PTHT, &
- PRT(:,:,:,1), PRM(:,:,:,2), PRT(:,:,:,2), &
- PRT(:,:,:,3), PRM(:,:,:,3), &
+ PPABST, PTHT, &
+ PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), &
+ PTHM, PRCM, PPABSM, &
PW_ACT, PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
- ZSVT(:,:,:,1), ZSVT(:,:,:,2), ZSVM(:,:,:,3), ZSVT(:,:,:,3), &
+ ZSVT(:,:,:,1), ZSVT(:,:,:,2), ZSVT(:,:,:,3), &
ZSVS(:,:,:,1), ZSVS(:,:,:,2), ZSVS(:,:,:,3), &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN )
!
- CALL ICE_C1R3 ( OSEDI, OHHONI, KSPLITG, PTSTEP_MET, KMI, &
+ CALL ICE_C1R3 ( OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABST, PW_ACT, PTHT, &
+ PPABST, PW_ACT, PTHT, &
PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
PRT(:,:,:,4), PRT(:,:,:,5), PRT(:,:,:,6), &
- PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
ZSVT(:,:,:,2), ZSVT(:,:,:,3), &
ZSVT(:,:,:,4), &
@@ -912,8 +900,8 @@ SELECT CASE ( HCLOUD )
!* 11.2 Perform the saturation adjustment
!
CALL C3R5_ADJUST ( KRR, KMI, HFMFILE, HLUOUT, HRAD, &
- HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP_MET, &
- PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, &
+ HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PSIGS, PPABST, &
PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), PRRT=PRT(:,:,:,3),&
PRIT=PRT(:,:,:,4), PRST=PRT(:,:,:,5), PRGT=PRT(:,:,:,6),&
PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), PRRS=PRS(:,:,:,3),&
@@ -945,7 +933,6 @@ IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
PSVT(:,:,:,JSV+ISVBEG-1) = ZSVT(:,:,:,JSV)
ENDDO
DEALLOCATE(ZSVS)
- DEALLOCATE(ZSVM)
DEALLOCATE(ZSVT)
ENDIF
!
diff --git a/src/MNH/resolved_elecn.f90 b/src/MNH/resolved_elecn.f90
index 4ad6703a7..0fa503f4f 100644
--- a/src/MNH/resolved_elecn.f90
+++ b/src/MNH/resolved_elecn.f90
@@ -3,18 +3,18 @@
! ###########################
!
INTERFACE
- SUBROUTINE RESOLVED_ELEC_n (HCLOUD, HSCONV, HMF_CLOUD, &
- KRR, KSPLITR, KMI, KTCOUNT, HUVW_ADV_SCHEME, &
- HLBCX, HLBCY, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
+ SUBROUTINE RESOLVED_ELEC_n (HCLOUD, HSCONV, HMF_CLOUD, &
+ KRR, KSPLITR, KMI, KTCOUNT, &
+ HLBCX, HLBCY, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
OCLOSE_OUT, OSUBG_COND, OSIGMAS,PSIGQSAT, HSUBG_AUCV, &
- PTSTEP_MET, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABSM, PPABST, PTHM, PTHT, PTHS, PWT, &
- PRM, PRT, PRS, PSVM, PSVT, PSVS, PCIT, &
- PSIGS, PSRCS, PCLDFR, PMFCONV, PCF_MF, PRC_MF, &
- PRI_MF, OSEDIC, OWARM, &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PINPRH, &
- PSEA, PTOWN )
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PTHS, PWT, &
+ PRT, PRS, PSVT, PSVS, PCIT, &
+ PSIGS, PSRCS, PCLDFR, PMFCONV, PCF_MF, PRC_MF, &
+ PRI_MF, OSEDIC, OWARM, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PINPRH, &
+ PSEA, PTOWN )
!
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
@@ -24,7 +24,6 @@ INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
! integrations for rain sedimendation
INTEGER, INTENT(IN) :: KMI ! Model index
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
@@ -41,7 +40,7 @@ LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
! Kind of Subgrid autoconversion method
-REAL, INTENT(IN) :: PTSTEP_MET ! Double Time step
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
@@ -49,18 +48,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Moist variables at time t-dt
REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalar variable at time t-dt
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
!
@@ -98,20 +93,20 @@ END SUBROUTINE RESOLVED_ELEC_n
END INTERFACE
END MODULE MODI_RESOLVED_ELEC_n
!
-! ############################################################################
- SUBROUTINE RESOLVED_ELEC_n (HCLOUD, HSCONV, HMF_CLOUD, &
- KRR, KSPLITR, KMI, KTCOUNT, HUVW_ADV_SCHEME, &
- HLBCX, HLBCY, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
- OCLOSE_OUT, OSUBG_COND, OSIGMAS,PSIGQSAT, HSUBG_AUCV, &
- PTSTEP_MET, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABSM, PPABST, PTHM, PTHT, PTHS, PWT, &
- PRM, PRT, PRS, PSVM, PSVT, PSVS, PCIT, &
- PSIGS, PSRCS, PCLDFR, PMFCONV, PCF_MF, PRC_MF, &
- PRI_MF, OSEDIC, OWARM, &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PINPRH, &
- PSEA, PTOWN )
-! ############################################################################
+! #####################################################################################
+ SUBROUTINE RESOLVED_ELEC_n (HCLOUD, HSCONV, HMF_CLOUD, &
+ KRR, KSPLITR, KMI, KTCOUNT, &
+ HLBCX, HLBCY, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
+ OCLOSE_OUT, OSUBG_COND, OSIGMAS,PSIGQSAT, HSUBG_AUCV, &
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PTHS, PWT, &
+ PRT, PRS, PSVT, PSVS, PCIT, &
+ PSIGS, PSRCS, PCLDFR, PMFCONV, PCF_MF, PRC_MF, &
+ PRI_MF, OSEDIC, OWARM, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PINPRH, &
+ PSEA, PTOWN )
+! #####################################################################################
!
!! PURPOSE
!! -------
@@ -219,7 +214,6 @@ INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
! integrations for ice sedimendation
INTEGER, INTENT(IN) :: KMI ! Model index
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
@@ -236,7 +230,7 @@ LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
! Kind of Subgrid autoconversion method
-REAL, INTENT(IN) :: PTSTEP_MET ! Double Time step
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
!
!
@@ -246,11 +240,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
!
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Moist variables at time t-dt
REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
@@ -258,7 +249,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalar variable at time t-dt
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
!
@@ -459,7 +449,7 @@ ZEXN(:,:,:) = (PPABST(:,:,:) / XP00)**(XRD / XCPD)
ZT(:,:,:) = PTHT(:,:,:) * ZEXN(:,:,:)
ZLV(:,:,:) = XLVTT + (XCPV - XCL) * (ZT(:,:,:) - XTT)
ZLS(:,:,:) = XLSTT + (XCPV - XCI) * (ZT(:,:,:) - XTT)
-ZCPH(:,:,:) = XCPD + XCPV * PTSTEP_MET * PRS(:,:,:,1)
+ZCPH(:,:,:) = XCPD + XCPV * PTSTEP * PRS(:,:,:,1)
!
!
!------------------------------------------------------------------------------
@@ -644,7 +634,7 @@ CALL MYPROC_ELEC_ll (IPROC)
! of the positive and negative ions, respectively
CALL ION_DRIFT(ZCPH, ZCOR, PSVT, PRHODREF, PRHODJ, HLBCX, HLBCY, &
- KTCOUNT, PTSTEP_MET, CDRIFT, HUVW_ADV_SCHEME )
+ KTCOUNT, PTSTEP, CDRIFT)
PSVS(:,:,:,NSV_ELECBEG) = PSVS(:,:,:,NSV_ELECBEG) + ZCPH(:,:,:)/PRHODJ(:,:,:)
PSVS(:,:,:,NSV_ELECEND) = PSVS(:,:,:,NSV_ELECEND) + ZCOR(:,:,:)/PRHODJ(:,:,:)
@@ -669,12 +659,10 @@ SELECT CASE (HCLOUD)
!* the explicit charging rates
!
CALL RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
- KSPLITR, PTSTEP_MET, KMI, KRR, &
+ KSPLITR, PTSTEP, KMI, KRR, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
- PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRM(:,:,:,2), &
- PRT(:,:,:,3), PRM(:,:,:,3), &
- PRT(:,:,:,4), PRT(:,:,:,5), PRM(:,:,:,5), &
- PRT(:,:,:,6), PRM(:,:,:,6), &
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
+ PRT(:,:,:,4), PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
@@ -695,8 +683,8 @@ SELECT CASE (HCLOUD)
ZZZ = MZF(1,IKU,1, PZZ )
CALL ICE_ADJUST_ELEC (KRR, KMI, HFMFILE, HLUOUT, HRAD, HTURBDIM, &
HSCONV, HMF_CLOUD, &
- OCLOSE_OUT, OSUBG_COND, OSIGMAS, PTSTEP_MET,PSIGQSAT,&
- PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, ZZZ, &
+ OCLOSE_OUT, OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
+ PRHODJ, PEXNREF, PSIGS, PPABST, ZZZ, &
PMFCONV, PCF_MF, PRC_MF, PRI_MF, &
PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
@@ -732,12 +720,10 @@ SELECT CASE (HCLOUD)
CASE ('ICE4')
!
CALL RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
- KSPLITR, PTSTEP_MET, KMI, KRR, &
+ KSPLITR, PTSTEP, KMI, KRR, &
PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
- PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRM(:,:,:,2), &
- PRT(:,:,:,3), PRM(:,:,:,3), &
- PRT(:,:,:,4), PRT(:,:,:,5), PRM(:,:,:,5), &
- PRT(:,:,:,6), PRM(:,:,:,6), &
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
+ PRT(:,:,:,4), PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
@@ -751,9 +737,8 @@ SELECT CASE (HCLOUD)
PSVS(:,:,:,NSV_ELECBEG+4), PSVS(:,:,:,NSV_ELECBEG+5), &
PSVS(:,:,:,NSV_ELECEND), &
PSEA, PTOWN, &
- PRT(:,:,:,7), PRM(:,:,:,7), PRS(:,:,:,7), PINPRH, &
- PSVT(:,:,:,NSV_ELECBEG+6), PSVM(:,:,:,NSV_ELECBEG+6), &
- PSVS(:,:,:,NSV_ELECBEG+6) )
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, &
+ PSVT(:,:,:,NSV_ELECBEG+6), PSVS(:,:,:,NSV_ELECBEG+6) )
! Index NSV_ELECBEG: Positive ion , NSV_ELECEND: Negative ion
!
!
@@ -762,8 +747,8 @@ SELECT CASE (HCLOUD)
ZZZ = MZF(1,IKU,1, PZZ )
CALL ICE_ADJUST_ELEC (KRR, KMI, HFMFILE, HLUOUT, HRAD, &
HTURBDIM, HSCONV, HMF_CLOUD, &
- OCLOSE_OUT, OSUBG_COND, OSIGMAS, PTSTEP_MET,PSIGQSAT,&
- PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, ZZZ, &
+ OCLOSE_OUT,OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
+ PRHODJ, PEXNREF, PSIGS, PPABST, ZZZ, &
PMFCONV, PCF_MF, PRC_MF, PRI_MF, &
PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
@@ -803,7 +788,7 @@ IF(KTCOUNT .EQ. 1 .AND. IPROC.EQ.0) PRINT *,'KSPLITR=', KSPLITR
!
PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:)
!
-DO JRR = 1, KRR
+DO JRR = 1,KRR
PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:)
END DO
!
@@ -823,12 +808,12 @@ GATTACH(:,:,:) = .FALSE.
GATTACH(IIB:IIE, IJB:IJE, IKB:IKE) = .TRUE.
!
IF (PRESENT(PSEA)) THEN
- CALL ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP_MET, PRHODREF, &
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
PRHODJ, PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
PRS, PTHT, PCIT, PPABST, XEFIELDU, &
XEFIELDV, XEFIELDW, GATTACH, PTOWN, PSEA )
ELSE
- CALL ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP_MET, PRHODREF, &
+ CALL ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
PRHODJ, PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
PRS, PTHT, PCIT, PPABST, XEFIELDU, &
XEFIELDV, XEFIELDW, GATTACH )
@@ -954,7 +939,7 @@ END IF
IF ((.NOT. LOCG) .AND. LELEC_FIELD .AND. MAX_ll(ABS(ZQTOT),IINFO_ll)>0.) THEN
IF (PRESENT(PSEA)) THEN
IF (LFLASH_GEOM) THEN
- CALL FLASH_GEOM_ELEC_n (KTCOUNT, KRR, PTSTEP_MET, PRHODJ, PRHODREF, &
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KRR, PTSTEP, PRHODJ, PRHODREF, &
PRT, PCIT, &
PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
PRS, PTHT, PPABST, &
@@ -966,7 +951,7 @@ IF ((.NOT. LOCG) .AND. LELEC_FIELD .AND. MAX_ll(ABS(ZQTOT),IINFO_ll)>0.) THEN
END IF
ELSE
IF (LFLASH_GEOM) THEN
- CALL FLASH_GEOM_ELEC_n (KTCOUNT, KRR, PTSTEP_MET, PRHODJ, PRHODREF, &
+ CALL FLASH_GEOM_ELEC_n (KTCOUNT, KRR, PTSTEP, PRHODJ, PRHODREF, &
PRT, PCIT, &
PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
PRS, PTHT, PPABST, &
@@ -1000,9 +985,9 @@ END IF
! ---------------------------
!
IF (LSERIES_ELEC) THEN
- CALL SERIES_CLOUD_ELEC (KTCOUNT, PTSTEP_MET, &
+ CALL SERIES_CLOUD_ELEC (KTCOUNT, PTSTEP, &
PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PRM, PRT, PRS, PSVT, &
+ PRT, PRS, PSVT, &
PTHT, PWT, PPABST, PCIT, PINPRR )
END IF
!
diff --git a/src/MNH/series_cloud_elec.f90 b/src/MNH/series_cloud_elec.f90
index 1b07a4bb8..a394ca1fb 100644
--- a/src/MNH/series_cloud_elec.f90
+++ b/src/MNH/series_cloud_elec.f90
@@ -5,7 +5,7 @@
INTERFACE
SUBROUTINE SERIES_CLOUD_ELEC (KTCOUNT, PTSTEP, &
PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PRM, PRT, PRS, PSVT, &
+ PRT, PRS, PSVT, &
PTHT, PWT, PPABST, PCIT, PINPRR )
!
!
@@ -18,7 +18,6 @@ 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) :: PRM ! Moist variables at time t-dt
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS ! Moist variable sources
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variable at time t
@@ -38,7 +37,7 @@ END MODULE MODI_SERIES_CLOUD_ELEC
! ###############################################################
SUBROUTINE SERIES_CLOUD_ELEC (KTCOUNT, PTSTEP, &
PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PRM, PRT, PRS, PSVT, &
+ PRT, PRS, PSVT, &
PTHT, PWT, PPABST, PCIT, PINPRR )
! ###############################################################
!
@@ -116,7 +115,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice number
! concentration at time t
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Moist variables at time t-dt
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS ! Moist variable sources
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variable at time t
@@ -223,7 +221,7 @@ ZCLOUD(IIB:IIE,IJB:IJE,IKB:IKE) = PRT(IIB:IIE,IJB:IJE,IKB:IKE,2) + &
!* 1.3 compute the terminal fall speed
!
! the mean terminal fall speed is computed following:
-! V_mean = Int(v(D) m(D) n(D) dD) / Int(m(D) n(D) dD)
+! V_mean = Int(v(D) n(D) dD) / Int(n(D) dD)
!
ALLOCATE(ZLAMBDAS(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3)))
ALLOCATE(ZLAMBDAG(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3)))
diff --git a/src/MNH/set_geosbal.f90 b/src/MNH/set_geosbal.f90
index 9070bcbac..4da388590 100644
--- a/src/MNH/set_geosbal.f90
+++ b/src/MNH/set_geosbal.f90
@@ -673,11 +673,11 @@ DO JI = 1,IIU
!
IF (ZZM(JI,JJ,JK) >= ZZHATM(IKU)) THEN ! copy out when
PTHV(JI,JJ,JK) = ZTHV3D (JI,JJ,IKU) ! ZZM(IKU)= ZZHATM(IKU)
- XRM(JI,JJ,JK,1) = PMRM(IKU) ! (in case zs=0.)
+ XRT(JI,JJ,JK,1) = PMRM(IKU) ! (in case zs=0.)
!
ELSEIF (ZZM(JI,JJ,JK) < ZZHATM(1)) THEN ! copy out when
PTHV(JI,JJ,JK) = ZTHV3D (JI,JJ,1) ! ZZM(1)< ZZHATM(1)
- XRM(JI,JJ,JK,1) = PMRM(1) ! (in case zs=0.)
+ XRT(JI,JJ,JK,1) = PMRM(1) ! (in case zs=0.)
!
ELSE ! search levels on the mass grid without orography
DO JKS = 2,IKU ! that surrounded JK
@@ -688,7 +688,7 @@ DO JI = 1,IIU
ZDZ2SDH = 1. - ZDZ1SDH
PTHV(JI,JJ,JK) = (ZDZ1SDH * ZTHV3D(JI,JJ,JKS) ) &
+ (ZDZ2SDH * ZTHV3D(JI,JJ,JKS-1) )
- XRM(JI,JJ,JK,1) = (ZDZ1SDH * PMRM(JKS) ) &
+ XRT(JI,JJ,JK,1) = (ZDZ1SDH * PMRM(JKS) ) &
+ (ZDZ2SDH * PMRM(JKS-1) )
END IF
END DO
@@ -702,7 +702,7 @@ END DO
!* 5. DEDUCE THETA FROM THETAV AND MR ON MODEL GRID
! ---------------------------------------------
!
-XTHM(:,:,:) = PTHV(:,:,:) * (1.+SUM(XRM(:,:,:,:),DIM=4)) /(1. + ZRVSRD *XRM(:,:,:,1))
+XTHT(:,:,:) = PTHV(:,:,:) * (1.+SUM(XRT(:,:,:,:),DIM=4)) /(1. + ZRVSRD *XRT(:,:,:,1))
!
!
!-------------------------------------------------------------------------------
@@ -725,14 +725,14 @@ DO JI = 2,IIU
!
IF (ZZUM(JI,JJ,JK) >= XZHAT(IKU)) THEN ! extrapolation
ZDZ1SDH = (ZZUM(JI,JJ,JK)-XZHAT(IKU))/ (XZHAT(IKU)-XZHAT(IKU-1))
- XUM(JI,JJ,JK) = 0.5*( PU3D(JI,JJ,IKU) + PU3D(JI-1,JJ,IKU) ) &
+ XUT(JI,JJ,JK) = 0.5*( PU3D(JI,JJ,IKU) + PU3D(JI-1,JJ,IKU) ) &
* (1.+ ZDZ1SDH) &
-0.5*(PU3D(JI,JJ,IKU-1)+ PU3D(JI-1,JJ,IKU-1)) &
* ZDZ1SDH
!
ELSE IF (ZZUM(JI,JJ,JK) < XZHAT(1)) THEN ! extrapolation
ZDZ1SDH = (ZZUM(JI,JJ,JK)-XZHAT(1))/ (XZHAT(2)-XZHAT(1))
- XUM(JI,JJ,JK) = 0.5*( PU3D(JI,JJ,1) + PU3D(JI-1,JJ,1) ) &
+ XUT(JI,JJ,JK) = 0.5*( PU3D(JI,JJ,1) + PU3D(JI-1,JJ,1) ) &
* (1.- ZDZ1SDH) &
+0.5*(PU3D(JI,JJ,2)+ PU3D(JI-1,JJ,2) ) &
* ZDZ1SDH
@@ -744,7 +744,7 @@ DO JI = 2,IIU
! orography
ZDZ1SDH = (ZZUM(JI,JJ,JK)-XZHAT(JKS-1))/ (XZHAT(JKS)-XZHAT(JKS-1))
ZDZ2SDH = 1. - ZDZ1SDH
- XUM(JI,JJ,JK) = ZDZ1SDH *.5 *( PU3D(JI,JJ,JKS) + PU3D(JI-1,JJ,JKS)) &
+ XUT(JI,JJ,JK) = ZDZ1SDH *.5 *( PU3D(JI,JJ,JKS) + PU3D(JI-1,JJ,JKS)) &
+ZDZ2SDH *.5 *( PU3D(JI,JJ,JKS-1)+ PU3D(JI-1,JJ,JKS-1))
END IF
END DO
@@ -753,7 +753,7 @@ DO JI = 2,IIU
END DO
END DO
!
-XUM(1,:,:)=-999.
+XUT(1,:,:)=-999.
!
!
!* 6.2 V interpolation
@@ -765,14 +765,14 @@ DO JI = 1,IIU
!
IF (ZZVM(JI,JJ,JK) >= XZHAT(IKU)) THEN ! extrapolation
ZDZ1SDH = (ZZVM(JI,JJ,JK)-XZHAT(IKU))/ (XZHAT(IKU)-XZHAT(IKU-1))
- XVM(JI,JJ,JK) = 0.5*( PV3D(JI,JJ,IKU) + PV3D(JI,JJ-1,IKU) ) &
+ XVT(JI,JJ,JK) = 0.5*( PV3D(JI,JJ,IKU) + PV3D(JI,JJ-1,IKU) ) &
* (1.+ ZDZ1SDH) &
-0.5*(PV3D(JI,JJ,IKU-1)+ PV3D(JI,JJ-1,IKU-1)) &
* ZDZ1SDH
!
ELSE IF (ZZVM(JI,JJ,JK) < XZHAT(1)) THEN ! extrapolation
ZDZ1SDH = (ZZVM(JI,JJ,JK)-XZHAT(1))/ (XZHAT(2)-XZHAT(1))
- XVM(JI,JJ,JK) = 0.5*( PV3D(JI,JJ,1) + PV3D(JI,JJ-1,1) ) &
+ XVT(JI,JJ,JK) = 0.5*( PV3D(JI,JJ,1) + PV3D(JI,JJ-1,1) ) &
* (1.- ZDZ1SDH) &
+0.5*(PV3D(JI,JJ,2)+ PV3D(JI,JJ-1,2) ) &
* ZDZ1SDH
@@ -784,7 +784,7 @@ DO JI = 1,IIU
! orography
ZDZ1SDH = (ZZVM(JI,JJ,JK)-XZHAT(JKS-1))/ (XZHAT(JKS)-XZHAT(JKS-1))
ZDZ2SDH = 1. - ZDZ1SDH
- XVM(JI,JJ,JK) = ZDZ1SDH *.5 *( PV3D(JI,JJ,JKS) + PV3D(JI,JJ-1,JKS)) &
+ XVT(JI,JJ,JK) = ZDZ1SDH *.5 *( PV3D(JI,JJ,JKS) + PV3D(JI,JJ-1,JKS)) &
+ZDZ2SDH *.5 *( PV3D(JI,JJ,JKS-1)+ PV3D(JI,JJ-1,JKS-1))
END IF
END DO
@@ -794,11 +794,11 @@ DO JI = 1,IIU
END DO
END DO
!
-XVM(:,1,:)=-999.
+XVT(:,1,:)=-999.
!
!* 6.3 W initialization
!
-XWM(:,:,:)=0.
+XWT(:,:,:)=0.
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/set_grid.f90 b/src/MNH/set_grid.f90
index 87757f8c6..f3056410a 100644
--- a/src/MNH/set_grid.f90
+++ b/src/MNH/set_grid.f90
@@ -353,7 +353,7 @@ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,IMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
YRECFM='STORAGE_TYPE'
YDIR='--'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,CSTORAGE_TYPE,IGRID,ILENCH,YCOMMENT,IRESP)
- IF (IRESP /= 0) CSTORAGE_TYPE='MT'
+ IF (IRESP /= 0) CSTORAGE_TYPE='TT'
!
IF (KMI == 1) THEN
YRECFM='LON0' ! this parameter is also useful in the cartesian to
@@ -391,7 +391,7 @@ IF (.NOT.LCARTESIAN) THEN
YDIR='--'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PLATORI,IGRID,ILENCH,YCOMMENT,IRESP)
!
- ELSE
+ ELSE
CALL FMREAD(HINIFILE,'LONOR',HLUOUT,'--',PLONORI,IGRID,ILENCH,YCOMMENT,IRESP)
CALL FMREAD(HINIFILE,'LATOR',HLUOUT,'--',PLATORI,IGRID,ILENCH,YCOMMENT,IRESP)
ALLOCATE(ZXHAT_ll(KIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(KJMAX_ll+2 * JPHEXT))
diff --git a/src/MNH/set_mask.f90 b/src/MNH/set_mask.f90
index 59249a0b4..ccb835942 100644
--- a/src/MNH/set_mask.f90
+++ b/src/MNH/set_mask.f90
@@ -90,11 +90,11 @@ LBU_MASK(:,:,:)=.FALSE.
! Change the following lines to set the criterion for each of the NBUMASK masks
!
! 1st mask on vertical velocity at level k=10
-LBU_MASK(IIB:IIE,IJB:IJE,1)=FIELD_MODEL(NBUMOD)%XWM(IIB:IIE,IJB:IJE,10)>0.
+LBU_MASK(IIB:IIE,IJB:IJE,1)=FIELD_MODEL(NBUMOD)%XWT(IIB:IIE,IJB:IJE,10)>0.
!
!2rd mask on rain mixing ratio at level k=2
IF (NBUMASK>=2) &
- LBU_MASK(IIB:IIE,IJB:IJE,2)=FIELD_MODEL(NBUMOD)%XRM(IIB:IIE,IJB:IJE,2,3)>1.E-8
+ LBU_MASK(IIB:IIE,IJB:IJE,2)=FIELD_MODEL(NBUMOD)%XRT(IIB:IIE,IJB:IJE,2,3)>1.E-8
!
!==============================================================================
!
diff --git a/src/MNH/set_mass.f90 b/src/MNH/set_mass.f90
index b0a978ea6..471007536 100644
--- a/src/MNH/set_mass.f90
+++ b/src/MNH/set_mass.f90
@@ -399,30 +399,24 @@ ELSE
!
! Interpolation of theta and r
!
- ALLOCATE(XTHM(IIU,IJU,IKU))
- ALLOCATE(XRM(IIU,IJU,IKU,NRR))
IF (SIZE(ZTHV3D_MX,3) > 3) THEN
CALL VER_INT_THERMO(OSHIFT,ZTHV3D_MX,ZMR3D_MX,PZS_MX,PZS_MX,PZMASS_MX,&
PZFLUX_MX,ZPMHP_MX,ZEXNTOP2D, &
- ZTHV3D,XRM,ZPMHP,ZDIAG)
+ ZTHV3D,XRT,ZPMHP,ZDIAG)
ELSE
ZTHV3D = ZTHV3D_MX
- XRM = ZMR3D_MX
+ XRT = ZMR3D_MX
ZDIAG = 0.
END IF
- XTHM(:,:,:)=ZTHV3D(:,:,:)*(1.+WATER_SUM(XRM(:,:,:,:)))/(1.+XRV/XRD*XRM(:,:,:,1))
+ XTHT(:,:,:)=ZTHV3D(:,:,:)*(1.+WATER_SUM(XRT(:,:,:,:)))/(1.+XRV/XRD*XRT(:,:,:,1))
ZTHV3D(:,:,1)=ZTHV3D(:,:,2)
- XTHM(:,:,1)=XTHM(:,:,2)
- XRM(:,:,1,:)=XRM(:,:,2,:)
-
- CALL MPPDB_CHECK3D(ZTHV3D,"SET_MASS:ZTHV3D:",PRECISION)
- CALL MPPDB_CHECK3D(XRM(:,:,:,1),"SET_MASS:XRM:",PRECISION)
- CALL MPPDB_CHECK3D(XTHM,"SET_MASS::XTHM",PRECISION)
+ XTHT(:,:,1)=XTHT(:,:,2)
+ XRT(:,:,1,:)=XRT(:,:,2,:)
!
IF (NRR>=3) THEN
- WHERE (XRM(:,:,:,3)<1.E-20)
- XRM(:,:,:,3)=0.
+ WHERE (XRT(:,:,:,3)<1.E-20)
+ XRT(:,:,:,3)=0.
END WHERE
END IF
!
@@ -434,12 +428,12 @@ ELSE
ZRHODJU(:,:,:)=MXM(ZRHODUA(:,:,:)*PJ(:,:,:))
ZRHODJV(:,:,:)=MYM(ZRHODVA(:,:,:)*PJ(:,:,:))
CALL COMPUTE_EXNER_FROM_TOP(ZTHV3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
- XPABSM(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
- ZRHOD(:,:,:)=XPABSM(:,:,:)/(XPABSM(:,:,:)/XP00)**(XRD/XCPD) &
- /(XRD*XTHM(:,:,:)*(1.+XRV/XRD*XRM(:,:,:,1)))
- XUM(:,:,:)=ZRHODJU(:,:,:)/MXM(ZRHOD(:,:,:)*PJ(:,:,:))
- XVM(:,:,:)=ZRHODJV(:,:,:)/MYM(ZRHOD(:,:,:)*PJ(:,:,:))
- XWM(:,:,:)=0
+ XPABST(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
+ ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
+ /(XRD*XTHT(:,:,:)*(1.+XRV/XRD*XRT(:,:,:,1)))
+ XUT(:,:,:)=ZRHODJU(:,:,:)/MXM(ZRHOD(:,:,:)*PJ(:,:,:))
+ XVT(:,:,:)=ZRHODJV(:,:,:)/MYM(ZRHOD(:,:,:)*PJ(:,:,:))
+ XWT(:,:,:)=0
ENDIF
!
@@ -450,7 +444,7 @@ ENDIF
IF (.NOT. OBOUSS) THEN
DEALLOCATE(XTHVREFZ)
DEALLOCATE(XRHODREFZ)
- CALL SET_REFZ(ZTHV3D,XRM(:,:,:,1))
+ CALL SET_REFZ(ZTHV3D,XRT(:,:,:,1))
ELSE
IF (OPROFILE_IN_PROC) THEN
XTHVREFZ(:) = ZTHV3D(KILOC-IXOR_ll+1,KJLOC-IYOR_ll+1,2)
@@ -470,7 +464,7 @@ ELSE
ZEXNTOP2D=ZHEXNFLUX(:,:,IKE+1)
CALL COMPUTE_EXNER_FROM_TOP(ZTHVREF3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
- XPABSM(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
+ XPABST(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
ENDIF
!---------------------------------------------------------------------------------
END SUBROUTINE SET_MASS
diff --git a/src/MNH/set_perturb.f90 b/src/MNH/set_perturb.f90
index 1e32483ef..b14103558 100644
--- a/src/MNH/set_perturb.f90
+++ b/src/MNH/set_perturb.f90
@@ -177,6 +177,7 @@ REAL :: XRADX= 10000. ! X-Radius of the perturbation
REAL :: XRADY= 10000. ! Y-Radius of the perturbation
REAL :: XRADZ= 2200. ! Z-Radius of the perturbation
!
+REAL :: ZOMEGA
INTEGER, PARAMETER :: i_seed_param = 26032012
INTEGER, DIMENSION(:), ALLOCATABLE :: i_seed
INTEGER :: ni_seed
@@ -269,33 +270,33 @@ SELECT CASE(CPERT_KIND)
!
! save the actual relative humidity
!
- ZT(:,:,:) =XTHM(:,:,:)*(XPABSM(:,:,:)/XP00) **(XRD/XCPD)
- ZHU(:,:,:) = (XRM(:,:,:,1)*XPABSM(:,:,:)) / (((XMV/XMD)+XRM(:,:,:,1))* &
+ ZT(:,:,:) =XTHT(:,:,:)*(XPABST(:,:,:)/XP00) **(XRD/XCPD)
+ ZHU(:,:,:) = (XRT(:,:,:,1)*XPABST(:,:,:)) / (((XMV/XMD)+XRT(:,:,:,1))* &
EXP( XALPW - XBETAW/ZT(:,:,:) - XGAMW*ALOG(ZT(:,:,:)) ))
!
! set the perturbation for Theta
!
- XTHM(:,:,:) = XTHM(:,:,:) + XAMPLITH * COS (XPI*0.5*ZDIST(:,:,:)) **2
+ XTHT(:,:,:) = XTHT(:,:,:) + XAMPLITH * COS (XPI*0.5*ZDIST(:,:,:)) **2
!
! compute the new vapor pressure (stored in ZHU!)
!
- ZT(:,:,:) =XTHM(:,:,:)*(XPABSM(:,:,:)/XP00) **(XRD/XCPD)
+ ZT(:,:,:) =XTHT(:,:,:)*(XPABST(:,:,:)/XP00) **(XRD/XCPD)
ZHU(:,:,:) = ZHU(:,:,:)* &
EXP( XALPW - XBETAW/ZT(:,:,:) - XGAMW*ALOG(ZT(:,:,:)) )
!
! set the perturbation for r_v such that the relative humidity is conserved
!
- XRM(:,:,:,1) = (XMV/XMD) * ZHU(:,:,:) / ( XPABSM(:,:,:) - ZHU(:,:,:) )
+ XRT(:,:,:,1) = (XMV/XMD) * ZHU(:,:,:) / ( XPABST(:,:,:) - ZHU(:,:,:) )
END WHERE
CALL MPPDB_CHECK3D(ZT,"SET_PERTURB::ZT",PRECISION)
CALL MPPDB_CHECK3D(ZHU,"SET_PERTURB::ZHU",PRECISION)
ELSE
WHERE ( ZDIST(:,:,:) <= 1.)
- XTHM(:,:,:) = XTHM(:,:,:) + XAMPLITH * COS (XPI*0.5*ZDIST(:,:,:)) **2
- XRM(:,:,:,1) = XRM(:,:,:,1) + XAMPLIRV * COS (XPI*0.5*ZDIST(:,:,:)) **2
+ XTHT(:,:,:) = XTHT(:,:,:) + XAMPLITH * COS (XPI*0.5*ZDIST(:,:,:)) **2
+ XRT(:,:,:,1) = XRT(:,:,:,1) + XAMPLIRV * COS (XPI*0.5*ZDIST(:,:,:)) **2
END WHERE
END IF
- CALL MPPDB_CHECK3D(XRM(:,:,:,1),"SET_PERTURB::XRM",PRECISION)
+ CALL MPPDB_CHECK3D(XRT(:,:,:,1),"SET_PERTURB::XRT",PRECISION)
CALL MPPDB_CHECK3D(XTHM,"SET_PERTURB::XTHM",PRECISION)
!
!-------------------------------------------------------------------------------
@@ -346,18 +347,18 @@ SELECT CASE(CPERT_KIND)
DEALLOCATE(ZPU_ll,ZPV_ll)
DO JI = 1,IIU
DO JJ = 1,IJU
- XUM(JI,JJ,:) = XUM(JI,JJ,:) + ZPU(JI,JJ)
+ XUT(JI,JJ,:) = XUT(JI,JJ,:) + ZPU(JI,JJ)
END DO
END DO
DO JJ = 1,IJU
DO JI = 1,IIU
- XVM(JI,JJ,:) = XVM(JI,JJ,:) + ZPV(JI,JJ)
+ XVT(JI,JJ,:) = XVT(JI,JJ,:) + ZPV(JI,JJ)
END DO
END DO
DEALLOCATE(ZPU,ZPV)
!
!
- CASE('WH','WW') ! white noise is computed on global domain
+ CASE('WH','WW') ! white noise is computed on global domain
! J.Escobar optim => need only identical random on all domain
!
DO JK = IKB, NKWH
@@ -428,27 +429,27 @@ SELECT CASE(CPERT_KIND)
CALL MPPDB_CHECK2D(ZWHITE,"SET_PERTURB::ZWHITE",PRECISION)
IF (CPERT_KIND=='WH') THEN ! white noise on theta
- XTHM(:,:,JK) = XTHM(:,:,JK) + XAMPLIWH * ZWHITE(:,:)
- CALL MPPDB_CHECK2D(XTHM(:,:,JK),"SET_PERTURB::XTHM",PRECISION)
+ XTHT(:,:,JK) = XTHT(:,:,JK) + XAMPLIWH * ZWHITE(:,:)
+ CALL MPPDB_CHECK2D(XTHT(:,:,JK),"SET_PERTURB::XTHT",PRECISION)
ELSE ! white noise on wind
- XWM(:,:,JK) = XWM(:,:,JK) + XAMPLIWH * ZWHITE(:,:)
- XUM(:,:,JK) = XUM(:,:,JK) + XAMPLIWH * ZWHITE(:,:)
- XVM(:,:,JK) = XVM(:,:,JK) + XAMPLIWH * ZWHITE(:,:)
+ XWT(:,:,JK) = XWT(:,:,JK) + XAMPLIWH * ZWHITE(:,:)
+ XUT(:,:,JK) = XUT(:,:,JK) + XAMPLIWH * ZWHITE(:,:)
+ XVT(:,:,JK) = XVT(:,:,JK) + XAMPLIWH * ZWHITE(:,:)
ENDIF
DEALLOCATE(ZWHITE)
!
END DO
- CALL GET_HALO(XTHM)
- CALL GET_HALO(XUM)
- CALL GET_HALO(XVM)
- CALL GET_HALO(XWM)
+ CALL GET_HALO(XTHT)
+ CALL GET_HALO(XUT)
+ CALL GET_HALO(XVT)
+ CALL GET_HALO(XWT)
- CALL MPPDB_CHECK3D(XTHM,"SET_PERTURB::XTHM",PRECISION)
- CALL MPPDB_CHECK3D(XUM,"SET_PERTURB::XUM",PRECISION)
- CALL MPPDB_CHECK3D(XVM,"SET_PERTURB::XVM",PRECISION)
- CALL MPPDB_CHECK3D(XWM,"SET_PERTURB::XWM",PRECISION)
- CALL MPPDB_CHECK3D(XRM(:,:,:,1),"SET_PERTURB::XRM",PRECISION)
+ CALL MPPDB_CHECK3D(XTHT,"SET_PERTURB::XTHT",PRECISION)
+ CALL MPPDB_CHECK3D(XUT,"SET_PERTURB::XUT",PRECISION)
+ CALL MPPDB_CHECK3D(XVT,"SET_PERTURB::XVT",PRECISION)
+ CALL MPPDB_CHECK3D(XWT,"SET_PERTURB::XWT",PRECISION)
+ CALL MPPDB_CHECK3D(XRT(:,:,:,1),"SET_PERTURB::XRT",PRECISION)
!-------------------------------------------------------------------------------
!
@@ -458,41 +459,53 @@ SELECT CASE(CPERT_KIND)
!
IF (CPERT_KIND=='WH') THEN ! white noise on theta
IF (LWEST_ll() .AND. CLBCX(1)/='CYCL') &
- XTHM(IIB-1,:,IKB) = 2. * XTHM(IIB,:,IKB) - XTHM(IIB+1,:,IKB)
+ XTHT(IIB-1,:,IKB) = 2. * XTHT(IIB,:,IKB) - XTHT(IIB+1,:,IKB)
IF (LEAST_ll() .AND. CLBCX(1)/='CYCL') &
- XTHM(IIE+1,:,IKB) = 2. * XTHM(IIE,:,IKB) - XTHM(IIE-1,:,IKB)
+ XTHT(IIE+1,:,IKB) = 2. * XTHT(IIE,:,IKB) - XTHT(IIE-1,:,IKB)
IF (LSOUTH_ll() .AND. CLBCY(1)/='CYCL') &
- XTHM(:,IJB-1,IKB) = 2. * XTHM(:,IJB,IKB) - XTHM(:,IJB+1,IKB)
+ XTHT(:,IJB-1,IKB) = 2. * XTHT(:,IJB,IKB) - XTHT(:,IJB+1,IKB)
IF (LNORTH_ll() .AND. CLBCY(1)/='CYCL') &
- XTHM(:,IJE+1,IKB) = 2. * XTHM(:,IJE,IKB) - XTHM(:,IJE-1,IKB)
+ XTHT(:,IJE+1,IKB) = 2. * XTHT(:,IJE,IKB) - XTHT(:,IJE-1,IKB)
ELSE ! white noise on wind
IF (LWEST_ll() .AND. CLBCX(1)/='CYCL') &
- XWM(IIB-1,:,IKB) = 2. * XWM(IIB,:,IKB) - XWM(IIB+1,:,IKB)
+ XWT(IIB-1,:,IKB) = 2. * XWT(IIB,:,IKB) - XWT(IIB+1,:,IKB)
IF (LEAST_ll() .AND. CLBCX(1)/='CYCL') &
- XWM(IIE+1,:,IKB) = 2. * XWM(IIE,:,IKB) - XWM(IIE-1,:,IKB)
+ XWT(IIE+1,:,IKB) = 2. * XWT(IIE,:,IKB) - XWT(IIE-1,:,IKB)
IF (LSOUTH_ll() .AND. CLBCY(1)/='CYCL') &
- XWM(:,IJB-1,IKB) = 2. * XWM(:,IJB,IKB) - XWM(:,IJB+1,IKB)
+ XWT(:,IJB-1,IKB) = 2. * XWT(:,IJB,IKB) - XWT(:,IJB+1,IKB)
IF (LNORTH_ll() .AND. CLBCY(1)/='CYCL') &
- XWM(:,IJE+1,IKB) = 2. * XWM(:,IJE,IKB) - XWM(:,IJE-1,IKB)
+ XWT(:,IJE+1,IKB) = 2. * XWT(:,IJE,IKB) - XWT(:,IJE-1,IKB)
!
IF (LWEST_ll() .AND. CLBCX(1)/='CYCL') &
- XUM(IIB-1,:,IKB) = 2. * XUM(IIB,:,IKB) - XUM(IIB+1,:,IKB)
+ XUT(IIB-1,:,IKB) = 2. * XUT(IIB,:,IKB) - XUT(IIB+1,:,IKB)
IF (LEAST_ll() .AND. CLBCX(1)/='CYCL') &
- XUM(IIE+1,:,IKB) = 2. * XUM(IIE,:,IKB) - XUM(IIE-1,:,IKB)
+ XUT(IIE+1,:,IKB) = 2. * XUT(IIE,:,IKB) - XUT(IIE-1,:,IKB)
IF (LSOUTH_ll() .AND. CLBCY(1)/='CYCL') &
- XUM(:,IJB-1,IKB) = 2. * XUM(:,IJB,IKB) - XUM(:,IJB+1,IKB)
+ XUT(:,IJB-1,IKB) = 2. * XUT(:,IJB,IKB) - XUT(:,IJB+1,IKB)
IF (LNORTH_ll() .AND. CLBCY(1)/='CYCL') &
- XUM(:,IJE+1,IKB) = 2. * XUM(:,IJE,IKB) - XUM(:,IJE-1,IKB)
+ XUT(:,IJE+1,IKB) = 2. * XUT(:,IJE,IKB) - XUT(:,IJE-1,IKB)
!
IF (LWEST_ll() .AND. CLBCX(1)/='CYCL') &
- XVM(IIB-1,:,IKB) = 2. * XVM(IIB,:,IKB) - XVM(IIB+1,:,IKB)
+ XVT(IIB-1,:,IKB) = 2. * XVT(IIB,:,IKB) - XVT(IIB+1,:,IKB)
IF (LEAST_ll() .AND. CLBCX(1)/='CYCL') &
- XVM(IIE+1,:,IKB) = 2. * XVM(IIE,:,IKB) - XVM(IIE-1,:,IKB)
+ XVT(IIE+1,:,IKB) = 2. * XVT(IIE,:,IKB) - XVT(IIE-1,:,IKB)
IF (LSOUTH_ll() .AND. CLBCY(1)/='CYCL') &
- XVM(:,IJB-1,IKB) = 2. * XVM(:,IJB,IKB) - XVM(:,IJB+1,IKB)
+ XVT(:,IJB-1,IKB) = 2. * XVT(:,IJB,IKB) - XVT(:,IJB+1,IKB)
IF (LNORTH_ll() .AND. CLBCY(1)/='CYCL') &
- XVM(:,IJE+1,IKB) = 2. * XVM(:,IJE,IKB) - XVM(:,IJE-1,IKB)
+ XVT(:,IJE+1,IKB) = 2. * XVT(:,IJE,IKB) - XVT(:,IJE-1,IKB)
ENDIF
+!
+!
+ CASE('SH') ! Shock (Burger's Equation)
+!
+ ZOMEGA = 2.0*XPI/FLOAT(IIE-IIB)
+ DO JI = IIB, IIE
+ XUT(JI,:,:) = XUT(JI,:,:) + XAMPLIUV*SIN( ZOMEGA*FLOAT(JI-IIB) )
+ END DO
+ XVT(:,:,:) = 0.0
+ XWT(:,:,:) = 0.0
+!
+!
END SELECT
!
DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
@@ -500,4 +513,3 @@ DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
!-------------------------------------------------------------------------------
!
END SUBROUTINE SET_PERTURB
-
diff --git a/src/MNH/shallow_mf.f90 b/src/MNH/shallow_mf.f90
index e538bd06a..5d876ea2a 100644
--- a/src/MNH/shallow_mf.f90
+++ b/src/MNH/shallow_mf.f90
@@ -7,7 +7,7 @@ INTERFACE
SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, &
HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, &
+ PIMPL_MF, PTSTEP, &
PDZZ, PZZ, &
PRHODJ, PRHODREF, &
PPABSM, PEXNM, &
@@ -44,8 +44,6 @@ INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables
REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height of flux point
REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficients
@@ -77,7 +75,7 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZUMF
REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZVMF
REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRV_UP ! Vapor updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics
REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
@@ -100,7 +98,7 @@ END MODULE MODI_SHALLOW_MF
SUBROUTINE SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, &
HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, &
+ PIMPL_MF, PTSTEP, &
PDZZ, PZZ, &
PRHODJ, PRHODREF, &
PPABSM, PEXNM, &
@@ -188,8 +186,6 @@ INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables
REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height of flux point
REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metric coefficients
@@ -221,7 +217,7 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZUMF
REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZVMF
REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRV_UP ! Vapor updraft characteristics
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics
REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
@@ -339,7 +335,7 @@ CALL COMPUTE_MF_CLOUD(KKA,IKB,IKE,KKU,KKL,KRR,KRRL,KRRI,&
ZEMF_O_RHODREF=PEMF/PRHODREF
CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, &
+ PIMPL_MF, PTSTEP, &
PDZZ, &
PRHODJ, &
ZTHLM,ZTHVM,ZRTM,PUM,PVM,PSVM, &
diff --git a/src/MNH/shallow_mf_pack.f90 b/src/MNH/shallow_mf_pack.f90
index cccacdca3..666b03087 100644
--- a/src/MNH/shallow_mf_pack.f90
+++ b/src/MNH/shallow_mf_pack.f90
@@ -7,7 +7,7 @@ INTERFACE
SUBROUTINE SHALLOW_MF_PACK(KRR,KRRL,KRRI, &
HMF_UPDRAFT, HMF_CLOUD, OMIXUV, &
OCLOSE_OUT,OMF_FLX,HFMFILE,HLUOUT,PTIME_LES, &
- PIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, &
+ PIMPL_MF, PTSTEP, &
PDZZ, PZZ, &
PRHODJ, PRHODREF, &
PPABSM, PEXN, &
@@ -40,8 +40,6 @@ CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
REAL*8,DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height of flux point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
@@ -76,7 +74,7 @@ END MODULE MODI_SHALLOW_MF_PACK
SUBROUTINE SHALLOW_MF_PACK(KRR,KRRL,KRRI, &
HMF_UPDRAFT, HMF_CLOUD, OMIXUV, &
OCLOSE_OUT,OMF_FLX,HFMFILE,HLUOUT,PTIME_LES, &
- PIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, &
+ PIMPL_MF, PTSTEP, &
PDZZ, PZZ, &
PRHODJ, PRHODREF, &
PPABSM, PEXN, &
@@ -155,8 +153,6 @@ CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
REAL*8,DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV! Timestep for tracer variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height of flux point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
@@ -303,7 +299,7 @@ ZSFRV(:)=RESHAPE(PSFRV(:,:),(/ IIU*IJU /) )
CALL SHALLOW_MF(1,IKU,1,KRR,KRRL,KRRI, &
HMF_UPDRAFT, HMF_CLOUD, 'T', OMIXUV, &
LNOMIXLG,NSV_LGBEG,NSV_LGEND, &
- PIMPL_MF, PTSTEP, PTSTEP_MET, PTSTEP_SV, &
+ PIMPL_MF, PTSTEP, &
ZDZZ, ZZZ, &
ZRHODJ,ZRHODREF, &
ZPABSM, ZEXN, &
diff --git a/src/MNH/slow_terms.f90 b/src/MNH/slow_terms.f90
index 2b441059b..a91c24a30 100644
--- a/src/MNH/slow_terms.f90
+++ b/src/MNH/slow_terms.f90
@@ -10,7 +10,6 @@
INTERFACE
SUBROUTINE SLOW_TERMS ( KSPLITR, PTSTEP, KMI, HSUBG_AUCV, &
PZZ, PRHODJ, PRHODREF, PCLDFR, &
- PRRM, &
PTHT, PRVT, PRCT, PRRT, PPABST, &
PTHS, PRVS, PRCS, PRRS, PINPRR, &
PINPRR3D, PEVAP3D )
@@ -29,7 +28,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
@@ -55,7 +53,6 @@ END MODULE MODI_SLOW_TERMS
!OPTION! -Ni
SUBROUTINE SLOW_TERMS ( KSPLITR, PTSTEP, KMI, HSUBG_AUCV, &
PZZ, PRHODJ, PRHODREF, PCLDFR, &
- PRRM, &
PTHT, PRVT, PRCT, PRRT, PPABST, &
PTHS, PRVS, PRCS, PRRS, PINPRR, &
PINPRR3D, PEVAP3D )
@@ -184,7 +181,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
diff --git a/src/MNH/spawn_field2.f90 b/src/MNH/spawn_field2.f90
index b70978bfc..921652fe8 100644
--- a/src/MNH/spawn_field2.f90
+++ b/src/MNH/spawn_field2.f90
@@ -5,9 +5,8 @@ MODULE MODI_SPAWN_FIELD2
INTERFACE
!
SUBROUTINE SPAWN_FIELD2(KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,HTURB, &
- PUM,PVM,PWM,PTHVM,PRM,PHUM,PTKEM,PSVM, &
PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT,PATC, &
- PSRCM,PSRCT,PSIGS, &
+ PSRCT,PSIGS, &
PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
PDTHFRC,PDRVFRC,PTHREL,PRVREL, &
PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M, &
@@ -21,17 +20,12 @@ INTEGER, INTENT(IN) :: KDXRATIO ! x and y-direction Resolution ratio
INTEGER, INTENT(IN) :: KDYRATIO ! between model 2 and model 1
CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUM,PVM,PWM ! model 2
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTKEM ! variables
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRM,PSVM ! at t-dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHVM,PHUM !
-!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! model 2
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTKET ! variables
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT,PATC ! at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHVT,PHUT !
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCM,PSRCT,PSIGS ! secondary
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT,PSIGS ! secondary
! prognostic variables
! Larger Scale fields for relaxation and diffusion
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM, PLSVM, PLSWM
@@ -55,9 +49,8 @@ END INTERFACE
END MODULE MODI_SPAWN_FIELD2
! ######spl
SUBROUTINE SPAWN_FIELD2(KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,HTURB, &
- PUM,PVM,PWM,PTHVM,PRM,PHUM,PTKEM,PSVM, &
PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT,PATC, &
- PSRCM,PSRCT,PSIGS, &
+ PSRCT,PSIGS, &
PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
PDTHFRC,PDRVFRC,PTHREL,PRVREL, &
PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M, &
@@ -140,8 +133,6 @@ END MODULE MODI_SPAWN_FIELD2
!! Modification 01/02/01 (D.Gazen) add module MODD_NSV for NSV variable
!! Modification 07/07/05 (D.Barbary) spawn with 2 input files (father+son1)
!! Modification 05/06 Remove EPS, Clark and Farley
-!! Modification 06/12 (M.Tomasini) Interpolation of turbulent fluxes (EDDY_FLUX)
-!! for 2D west african monsoon
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -197,21 +188,16 @@ INTEGER, INTENT(IN) :: KDXRATIO ! x and y-direction Resolution ratio
INTEGER, INTENT(IN) :: KDYRATIO ! between model 2 and model 1
CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUM,PVM,PWM ! model 2
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTKEM ! variables
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRM,PSVM ! at t-dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHVM,PHUM !
-!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! model 2
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTKET ! variables
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT,PATC ! at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHVT,PHUT !
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCM,PSRCT,PSIGS ! secondary
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT,PSIGS ! secondary
! prognostic variables
! Larger Scale fields for relaxation and diffusion
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM, PLSVM, PLSWM
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC,PDRVFRC
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL,PRVREL
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M
@@ -231,20 +217,16 @@ INTEGER :: IRESP ! Return codes in FM routines
INTEGER :: JRR,JSV ! Loop index for moist and scalar variables
INTEGER :: IRR ! Number of moist variables
!
-REAL, DIMENSION(SIZE(FIELD_MODEL(1)%XRT,1),SIZE(FIELD_MODEL(1)%XRT,2),SIZE(FIELD_MODEL(1)%XRT,3)) :: ZHUM ! relative humidity
- ! (model 1)
REAL, DIMENSION(SIZE(FIELD_MODEL(1)%XRT,1),SIZE(FIELD_MODEL(1)%XRT,2),SIZE(FIELD_MODEL(1)%XRT,3)) :: ZHUT ! relative humidity
! (model 1)
-REAL, DIMENSION(SIZE(FIELD_MODEL(1)%XTHT,1),SIZE(FIELD_MODEL(1)%XTHT,2),SIZE(FIELD_MODEL(1)%XTHT,3)) :: ZTHVM! virtual pot. T
- ! (model 1)
REAL, DIMENSION(SIZE(FIELD_MODEL(1)%XTHT,1),SIZE(FIELD_MODEL(1)%XTHT,2),SIZE(FIELD_MODEL(1)%XTHT,3)) :: ZTHVT! virtual pot. T
! (model 1)
INTEGER :: IMI
! Arrays for reading fields of input SON 1 file
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHM1,ZTHT1,ZTHVM1,ZTHVT1
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPABSM1,ZPABST1,ZHUM1,ZHUT1
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRM1,ZRT1
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHT1,ZTHVT1
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPABST1,ZHUT1
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRT1
LOGICAL :: GUSERV
!
INTEGER :: IGRID,ILENCH ! File
@@ -266,24 +248,18 @@ CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
!
!* 1.1 Secondary variables
!
-CALL COMPUTE_THV_HU(CONF_MODEL(1)%LUSERV,FIELD_MODEL(1)%XRM,FIELD_MODEL(1)%XTHM,FIELD_MODEL(1)%XPABSM,ZTHVM,ZHUM)
CALL COMPUTE_THV_HU(CONF_MODEL(1)%LUSERV,FIELD_MODEL(1)%XRT,FIELD_MODEL(1)%XTHT,FIELD_MODEL(1)%XPABST,ZTHVT,ZHUT)
!
!* 1.2 Working arrays for reading in SON input file
!
IF (PRESENT(HSONFILE)) THEN
- ALLOCATE(ZWORK3D(KIUSON,KJUSON,SIZE(PUM,3)))
- ALLOCATE(ZPABSM1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUM,3)))
- ALLOCATE(ZPABST1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUM,3)))
- ALLOCATE(ZTHM1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUM,3)))
- ALLOCATE(ZTHT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUM,3)))
- ALLOCATE(ZTHVM1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUM,3)))
- ALLOCATE(ZTHVT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUM,3)))
+ ALLOCATE(ZWORK3D(KIUSON,KJUSON,SIZE(PUT,3)))
+ ALLOCATE(ZPABST1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
+ ALLOCATE(ZTHT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
+ ALLOCATE(ZTHVT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
IF (CONF_MODEL(1)%NRR /= 0) THEN
- ALLOCATE(ZHUM1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUM,3)))
- ALLOCATE(ZHUT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUM,3)))
- ALLOCATE(ZRM1(KIE1-KIB1+1,KJE1-KJB1+1, SIZE(PUM,3),SIZE(PRM,4)))
- ALLOCATE(ZRT1(KIE1-KIB1+1,KJE1-KJB1+1, SIZE(PUM,3),SIZE(PRM,4)))
+ ALLOCATE(ZHUT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
+ ALLOCATE(ZRT1(KIE1-KIB1+1,KJE1-KJB1+1, SIZE(PUT,3),SIZE(PRT,4)))
END IF
END IF
!
@@ -298,11 +274,6 @@ IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
!* 2.1 special case of spawning - no change of resolution :
!
!* 2.1.1 variables which always exist
-!
- PUM (:,:,:) = FIELD_MODEL(1)%XUM (KXOR:KXEND,KYOR:KYEND,:)
- PVM (:,:,:) = FIELD_MODEL(1)%XVM (KXOR:KXEND,KYOR:KYEND,:)
- PWM (:,:,:) = FIELD_MODEL(1)%XWM (KXOR:KXEND,KYOR:KYEND,:)
- PTHVM(:,:,:) = ZTHVM(KXOR:KXEND,KYOR:KYEND,:)
!
PUT (:,:,:) = FIELD_MODEL(1)%XUT (KXOR:KXEND,KYOR:KYEND,:)
PVT (:,:,:) = FIELD_MODEL(1)%XVT (KXOR:KXEND,KYOR:KYEND,:)
@@ -319,31 +290,26 @@ IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
!* 2.1.2 TKE variable
!
IF (HTURB /= 'NONE') THEN
- PTKEM(:,:,:) = FIELD_MODEL(1)%XTKEM(KXOR:KXEND,KYOR:KYEND,:)
PTKET(:,:,:) = FIELD_MODEL(1)%XTKET(KXOR:KXEND,KYOR:KYEND,:)
ENDIF
!
!* 2.1.3 moist variables
!
IF (CONF_MODEL(1)%NRR /= 0) THEN
- PRM (:,:,:,:) = FIELD_MODEL(1)%XRM (KXOR:KXEND,KYOR:KYEND,:,:)
PRT (:,:,:,:) = FIELD_MODEL(1)%XRT (KXOR:KXEND,KYOR:KYEND,:,:)
PLSRVM(:,:,:) = FIELD_MODEL(1)%XRT (KXOR:KXEND,KYOR:KYEND,:,1)
- PHUM (:,:,:) = ZHUM (KXOR:KXEND,KYOR:KYEND,:)
PHUT (:,:,:) = ZHUT (KXOR:KXEND,KYOR:KYEND,:)
ENDIF
!
!* 2.1.4 scalar variables
!
IF (NSV /= 0) THEN
- PSVM (:,:,:,:) = FIELD_MODEL(1)%XSVM (KXOR:KXEND,KYOR:KYEND,:,:)
PSVT (:,:,:,:) = FIELD_MODEL(1)%XSVT (KXOR:KXEND,KYOR:KYEND,:,:)
ENDIF
!
!* 2.1.5 secondary prognostic variables
!
IF (CONF_MODEL(1)%NRR > 1) THEN
- PSRCM (:,:,:) = FIELD_MODEL(1)%XSRCM (KXOR:KXEND,KYOR:KYEND,:)
PSRCT (:,:,:) = FIELD_MODEL(1)%XSRCT (KXOR:KXEND,KYOR:KYEND,:)
PSIGS(:,:,:) = FIELD_MODEL(1)%XSIGS(KXOR:KXEND,KYOR:KYEND,:)
ENDIF
@@ -389,12 +355,8 @@ ELSE
!* 2.2 general case - change of resolution :
! -----------------------------------
!
-! Interpolation of the U variable at t-dt and t
+! Interpolation of the U variable at t
!
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,2, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XUM,PUM)
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,2, &
@@ -404,12 +366,8 @@ ELSE
KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,2, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,LSFIELD_MODEL(1)%XLSUM,PLSUM)
!
-! Interpolation of the V variable at t-dt and t
+! Interpolation of the V variable at t
!
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,3, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XVM,PVM)
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,3, &
@@ -419,49 +377,22 @@ ELSE
KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,3, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,LSFIELD_MODEL(1)%XLSVM,PLSVM)
!
-! Interpolation of variables at t-dt
+! Interpolation of variables at t
!
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,4, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XWM,PWM)
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,4, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,LSFIELD_MODEL(1)%XLSWM,PLSWM)
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZTHVM,PTHVM)
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,LSFIELD_MODEL(1)%XLSTHM,PLSTHM)
- IF (HTURB /= 'NONE') &
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XTKEM,PTKEM)
- IF (CONF_MODEL(1)%NRR>=1) &
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XRM,PRM)
IF (CONF_MODEL(1)%NRR>=1) &
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,LSFIELD_MODEL(1)%XLSRVM,PLSRVM)
IF (CONF_MODEL(1)%NRR>=1) &
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZHUM,PHUM)
- IF (NSV>=1) &
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XSVM,PSVM)
!
! Interpolation of variables at t
!
@@ -496,11 +427,6 @@ ELSE
KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XSVT,PSVT)
IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') &
- CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
- XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
- KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
- LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,FIELD_MODEL(1)%XSRCM,PSRCM)
- IF (CONF_MODEL(1)%NRR>1 .AND. HTURB /='NONE') &
CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,1, &
@@ -561,9 +487,6 @@ ELSE
END IF
!
IF (CONF_MODEL(1)%NRR>=3) THEN
- WHERE (PRM(:,:,:,3)<1.E-20)
- PRM(:,:,:,3)=0.
- END WHERE
WHERE (PRT(:,:,:,3)<1.E-20)
PRT(:,:,:,3)=0.
END WHERE
@@ -578,21 +501,12 @@ IF (PRESENT(HSONFILE)) THEN
!
!variables which always exist
!
- YRECFM='UM' ! U wind component at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- PUM(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='UT' ! U wind component at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
PUT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
- YRECFM='VM' ! V wind component at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- PVM(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='VT' ! V wind component at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
PVT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
- YRECFM='WM' ! W wind component at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- PWM(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='WT' ! W wind component at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
PWT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
@@ -602,63 +516,42 @@ IF (PRESENT(HSONFILE)) THEN
IRR=1
IF (IRR<=CONF_MODEL(1)%NRR) THEN
GUSERV=.TRUE.
- YRECFM='RVM' ! Vapor at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- IF(IRESP==0) ZRM1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='RVT' ! Vapor at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- YRECFM='RCM' ! Cloud at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- IF(IRESP==0) ZRM1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='RCT' ! Cloud at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- YRECFM='RRM' ! Rain at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- IF(IRESP==0) ZRM1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='RRT' ! Rain at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- YRECFM='RIM' ! Ice at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- IF(IRESP==0) ZRM1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='RIT' ! Ice at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- YRECFM='RSM' ! Snow at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- IF(IRESP==0) ZRM1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='RST' ! Snow at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- YRECFM='RGM' ! Graupel at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- IF(IRESP==0) ZRM1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='RGT' ! Graupel at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- YRECFM='RHM' ! Hail at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- IF(IRESP==0) ZRM1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='RHT' ! Hail at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
@@ -668,37 +561,24 @@ IF (PRESENT(HSONFILE)) THEN
WRITE(ILUOUT,FMT=*) 'SPAWN_FIELD2: spawing with a SON input file'
WRITE(ILUOUT,FMT=*) ' ',CONF_MODEL(1)%NRR,' moist variables in model1 and model2, ', &
IRR,' moist variables in input SON'
- YRECFM='THM' ! Theta at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- ZTHM1(:,:,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='THT' ! Theta at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
ZTHT1(:,:,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
- YRECFM='PABSM' ! Pressure at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- ZPABSM1(:,:,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='PABST' ! Pressure at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
ZPABST1(:,:,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
!
- CALL COMPUTE_THV_HU(GUSERV,ZRM1,ZTHM1,ZPABSM1,ZTHVM1,ZHUM1)
CALL COMPUTE_THV_HU(GUSERV,ZRT1,ZTHT1,ZPABST1,ZTHVT1,ZHUT1)
!
- PTHVM(KIB2:KIE2,KJB2:KJE2,:) = ZTHVM1(:,:,:)
PTHVT(KIB2:KIE2,KJB2:KJE2,:) = ZTHVT1(:,:,:)
IF (CONF_MODEL(1)%NRR /= 0) THEN
- PHUM(KIB2:KIE2,KJB2:KJE2,:) = ZHUM1(:,:,:)
PHUT(KIB2:KIE2,KJB2:KJE2,:) = ZHUT1(:,:,:)
- PRM(KIB2:KIE2,KJB2:KJE2,:,:) = ZRM1(:,:,:,:)
PRT(KIB2:KIE2,KJB2:KJE2,:,:) = ZRT1(:,:,:,:)
END IF
!
! TKE variables
!
IF (HTURB/='NONE') THEN
- YRECFM='TKEM' ! Turbulence Kinetic Energy at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- IF(IRESP==0) PTKEM(KIB2:KIE2,KJB2:KJE2,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='TKET' ! Turbulence Kinetic Energy at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
IF(IRESP==0) PTKET(KIB2:KIE2,KJB2:KJE2,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
@@ -708,110 +588,66 @@ IF (PRESENT(HSONFILE)) THEN
!
IF (NSV /= 0) THEN
DO JSV = 1, NSV_USER ! Users Scalar Variables
- WRITE(YRECFM,'(A3,I3.3)')'SVM',JSV
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF(IRESP==0) PSVM(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
WRITE(YRECFM,'(A3,I3.3)')'SVT',JSV
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
DO JSV = NSV_C2R2BEG,NSV_C2R2END ! C2R2 Scalar Variables
- YRECFM=TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//'M'
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF(IRESP==0) PSVM(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM=TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//'T'
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
DO JSV = NSV_ELECBEG,NSV_ELECEND ! ELEC Scalar Variables
- YRECFM=TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))//'M'
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF(IRESP==0) PSVM(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM=TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))//'T'
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
DO JSV = NSV_CHEMBEG,NSV_CHEMEND ! Chemical Scalar Variables
- YRECFM=TRIM(CNAMES(JSV-NSV_CHEMBEG+1))//'M'
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF(IRESP==0) PSVM(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM=TRIM(CNAMES(JSV-NSV_CHEMBEG+1))//'T'
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
DO JSV = NSV_CHICBEG,NSV_CHICEND ! Ice phase chemical Scalar Variables
- YRECFM=TRIM(CICNAMES(JSV-NSV_CHICBEG+1))//'M'
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF(IRESP==0) PSVM(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM=TRIM(CICNAMES(JSV-NSV_CHICBEG+1))//'T'
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
DO JSV = NSV_AERBEG,NSV_AEREND ! Orilam Scalar Variables
- YRECFM=TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))//'M'
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF(IRESP==0) PSVM(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM=TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))//'T'
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
DO JSV = NSV_DSTBEG,NSV_DSTEND ! Dust Scalar Variables
- YRECFM=TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'M'
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF(IRESP==0) PSVM(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM=TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'T'
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
DO JSV = NSV_SLTBEG,NSV_SLTEND ! Sea Salt Scalar Variables
- YRECFM=TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))//'M'
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF(IRESP==0) PSVM(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM=TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))//'T'
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
DO JSV = NSV_LGBEG,NSV_LGEND ! LG Scalar Variables
- YRECFM=TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'M'
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF(IRESP==0) PSVM(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM=TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'T'
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
DO JSV = NSV_PPBEG,NSV_PPEND ! Passive scalar variables
- WRITE(YRECFM,'(A3,I3.3)')'SVM',JSV
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF(IRESP==0) PSVM(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
WRITE(YRECFM,'(A3,I3.3)')'SVT',JSV
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
DO JSV = NSV_CSBEG,NSV_CSEND ! Passive scalar variables
- WRITE(YRECFM,'(A3,I3.3)')'SVM',JSV
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- IF(IRESP==0) PSVM(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
WRITE(YRECFM,'(A3,I3.3)')'SVT',JSV
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
YCOMMENT,IRESP)
@@ -827,15 +663,6 @@ IF (PRESENT(HSONFILE)) THEN
! Secondary pronostic variables
!
IF (HTURB /= 'NONE' .AND. IRR>1) THEN
- YRECFM='SRCM' ! turbulent flux SRC at time t-dt
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- IF( IRESP /= 0 ) THEN
- YRECFM='SRC'
- CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH, &
- YCOMMENT,IRESP)
- END IF
- IF(IRESP == 0) PSRCM(KIB2:KIE2,KJB2:KJE2,:) = &
- ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
YRECFM='SRCT' ! turbulent flux SRC at time t
CALL FMREAD(HSONFILE,YRECFM,CLUOUT,YDIR,ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
IF( IRESP /= 0 ) THEN
@@ -851,23 +678,13 @@ IF (PRESENT(HSONFILE)) THEN
IF(IRESP == 0) PSIGS(KIB2:KIE2,KJB2:KJE2,:) = &
ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END IF
-
- IF (LUV_FLX .OR. LTH_FLX) THEN ! MT adding for ADVFRC
- WRITE(ILUOUT,FMT=*) '****************************** WARNING ****************************'
- WRITE(ILUOUT,FMT=*) 'SPAWN_FIELD2: spawning with a SON input file not forseen for EDDY_FLUX'
- WRITE(ILUOUT,FMT=*) ' Do like the lecture in read_field.f90 if necessary'
- WRITE(ILUOUT,FMT=*) '****************************** WARNING ****************************'
- ENDIF
-
END IF
!
!* 2.2.4 secondary prognostic variables correction
!
-IF (CONF_MODEL(1)%NRR > 1 .AND. HTURB /= 'NONE') PSRCM(:,:,:) = MIN( 1.0, MAX( 0.0, PSRCM(:,:,:)) )
IF (CONF_MODEL(1)%NRR > 1 .AND. HTURB /= 'NONE') PSRCT(:,:,:) = MIN( 1.0, MAX( 0.0, PSRCT(:,:,:)) )
!
IF ( CONF_MODEL(1)%NRR == 0 ) THEN
- PHUM (:,:,:)= 0.
PHUT (:,:,:)= 0.
END IF
!-------------------------------------------------------------------------------
diff --git a/src/MNH/spawn_model2.f90 b/src/MNH/spawn_model2.f90
index b7fb31a26..21c3c59d0 100644
--- a/src/MNH/spawn_model2.f90
+++ b/src/MNH/spawn_model2.f90
@@ -310,11 +310,8 @@ INTEGER :: JRR ! loop index for moist variables
REAL, DIMENSION(:,:), ALLOCATABLE :: ZZS_LS ! large scale interpolated zs
REAL, DIMENSION(:,:), ALLOCATABLE :: ZZSMT_LS ! large scale interpolated smooth zs
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZZ_LS ! large scale interpolated z
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHVM ! virtual potential temperature
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHVT ! virtual potential temperature
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZHUM ! relative humidity
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZHUT ! relative humidity
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSUMRM ! sum of water ratios
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSUMRT ! sum of water ratios
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHOD ! dry density
!
@@ -560,12 +557,6 @@ CDCONV = 'NONE' ! deep convection will have to be restarted
CSCONV = 'NONE' ! shallow convection will have to be restarted
!
!
-IF ( CSTORAGE_TYPE == 'MT' ) THEN
- CCONF = 'RESTA'
-ELSE
- CCONF = 'START'
-END IF
-!
!* 3.5 model 2 configuration in MODD_NESTING to be written
!* on the FM-file to allow nesting or coupling
!
@@ -627,34 +618,23 @@ ALLOCATE(ZJ(IIU,IJU,IKU))
!
!* 4.2 Prognostic (and diagnostic) variables (module MODD_FIELD2) :
!
-ALLOCATE(XUM(IIU,IJU,IKU))
ALLOCATE(XUT(IIU,IJU,IKU))
-ALLOCATE(XVM(IIU,IJU,IKU))
ALLOCATE(XVT(IIU,IJU,IKU))
-ALLOCATE(XWM(IIU,IJU,IKU))
ALLOCATE(XWT(IIU,IJU,IKU))
-ALLOCATE(XTHM(IIU,IJU,IKU))
ALLOCATE(XTHT(IIU,IJU,IKU))
IF (CTURB/='NONE') THEN
- ALLOCATE(XTKEM(IIU,IJU,IKU))
ALLOCATE(XTKET(IIU,IJU,IKU))
ELSE
- ALLOCATE(XTKEM(0,0,0))
ALLOCATE(XTKET(0,0,0))
END IF
-ALLOCATE(XPABSM(IIU,IJU,IKU))
ALLOCATE(XPABST(IIU,IJU,IKU))
-ALLOCATE(XRM(IIU,IJU,IKU,NRR))
ALLOCATE(XRT(IIU,IJU,IKU,NRR))
-ALLOCATE(XSVM(IIU,IJU,IKU,NSV))
ALLOCATE(XSVT(IIU,IJU,IKU,NSV))
!
IF (CTURB /= 'NONE' .AND. NRR>1) THEN
- ALLOCATE(XSRCM(IIU,IJU,IKU))
ALLOCATE(XSRCT(IIU,IJU,IKU))
ALLOCATE(XSIGS(IIU,IJU,IKU))
ELSE
- ALLOCATE(XSRCM(0,0,0))
ALLOCATE(XSRCT(0,0,0))
ALLOCATE(XSIGS(0,0,0))
END IF
@@ -970,24 +950,20 @@ ZTIME1 = ZTIME2
!
!* horizontal interpolation
!
-ALLOCATE(ZTHVM(IIU,IJU,IKU))
ALLOCATE(ZTHVT(IIU,IJU,IKU))
-ALLOCATE(ZHUM(IIU,IJU,IKU))
ALLOCATE(ZHUT(IIU,IJU,IKU))
!
IF (GNOSON) THEN
CALL SPAWN_FIELD2 (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,CTURB, &
- XUM,XVM,XWM,ZTHVM,XRM,ZHUM,XTKEM,XSVM, &
XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XATC, &
- XSRCM,XSRCT,XSIGS, &
+ XSRCT,XSIGS, &
XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
XDTHFRC,XDRVFRC,XTHREL,XRVREL, &
XVU_FLUX_M,XVTH_FLUX_M,XWTH_FLUX_M )
ELSE
CALL SPAWN_FIELD2 (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,CTURB, &
- XUM,XVM,XWM,ZTHVM,XRM,ZHUM,XTKEM,XSVM, &
XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XATC, &
- XSRCM,XSRCT,XSIGS, &
+ XSRCT,XSIGS, &
XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
XDTHFRC,XDRVFRC,XTHREL,XRVREL, &
XVU_FLUX_M, XVTH_FLUX_M,XWTH_FLUX_M, &
@@ -998,11 +974,7 @@ END IF
!
!* correction of positivity
!
-IF (SIZE(XRM,1)>0) XRM = MAX(0.,XRM)
-IF (SIZE(ZHUM,1)>0) ZHUM = MIN(MAX(ZHUM,0.),100.)
-IF (SIZE(XTKEM,1)>0) XTKEM = MAX(XTKEMIN,XTKEM)
IF (SIZE(XLSRVM,1)>0) XLSRVM = MAX(0.,XLSRVM)
-!
IF (SIZE(XRT,1)>0) XRT = MAX(0.,XRT)
IF (SIZE(ZHUT,1)>0) ZHUT = MIN(MAX(ZHUT,0.),100.)
IF (SIZE(XTKET,1)>0) XTKET = MAX(XTKEMIN,XTKET)
@@ -1016,11 +988,10 @@ ZTIME1 = ZTIME2
!* vertical interpolation
!
IF (ANY(XZS(:,:)>0.) .AND. (NDXRATIO/=1 .OR. NDYRATIO/=1) ) THEN
- CALL VER_INTERP_FIELD (CTURB,NRR,NSV,ZZZ_LS,XZZ, &
- XUM,XVM,XWM,ZTHVM,XRM,ZHUM,XTKEM,XSVM, &
- XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT, &
- XSRCM,XSRCT,XSIGS, &
- XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM )
+ CALL VER_INTERP_FIELD (CTURB,NRR,NSV,ZZZ_LS,XZZ, &
+ XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT, &
+ XSRCT,XSIGS, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM )
ENDIF
!
CALL SECOND_MNH(ZTIME2)
@@ -1032,13 +1003,10 @@ ZVER = ZTIME2 - ZTIME1
ZTIME1 = ZTIME2
!
CALL SPAWN_PRESSURE2(NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO, &
- ZZZ_LS,XZZ,ZTHVM,ZTHVT, &
- XPABSM,XPABST )
+ ZZZ_LS,XZZ,ZTHVT,XPABST )
!
IF (.NOT.GNOSON) THEN
ALLOCATE(ZWORK3D(IIUSON,IJUSON,IKU))
- CALL FMREAD(HSONFILE,'PABSM',CLUOUT,'XY',ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
- XPABSM(IIB2:IIE2,IJB2:IJE2,:) = ZWORK3D(IIB1:IIE1,IJB1:IJE1,:)
CALL FMREAD(HSONFILE,'PABST',CLUOUT,'XY',ZWORK3D,IGRID,ILENCH,YCOMMENT,IRESP)
XPABST(IIB2:IIE2,IJB2:IJE2,:) = ZWORK3D(IIB1:IIE1,IJB1:IJE1,:)
DEALLOCATE(ZWORK3D)
@@ -1046,15 +1014,15 @@ END IF
!
IF (NVERB>=2) THEN
IK4000 = COUNT(XZHAT(:)<4000.)
- IIJ = MAXLOC( SUM(ZHUM(IIB:IIE,IJB:IJE,JPVEXT+1:IK4000),3), &
- MASK=COUNT(ZHUM(IIB:IIE,IJB:IJE,JPVEXT+1:IKE) &
- >=MAXVAL(ZHUM(IIB:IIE,IJB:IJE,JPVEXT+1:IKE))-0.01,DIM=3 ) &
+ IIJ = MAXLOC( SUM(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IK4000),3), &
+ MASK=COUNT(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE) &
+ >=MAXVAL(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE))-0.01,DIM=3 ) &
>=1 ) &
+ JPHEXT
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) 'humidity (I=',IIJ(1),';J=',IIJ(2),')'
DO JK=IKB,IKE
- WRITE(ILUOUT,'(F6.2,2H %)') ZHUM(IIJ(1),IIJ(2),JK)
+ WRITE(ILUOUT,'(F6.2,2H %)') ZHUT(IIJ(1),IIJ(2),JK)
END DO
END IF
!* 5.8 Retrieve model thermodynamical variables :
@@ -1062,31 +1030,20 @@ END IF
ALLOCATE(ZSUMRT(IIU,IJU,IKU))
ZSUMRT(:,:,:) = 0.
IF (NRR==0) THEN
- XTHM(:,:,:) = ZTHVM(:,:,:)
XTHT(:,:,:) = ZTHVT(:,:,:)
ELSE
IF (NDXRATIO/=1 .OR. NDYRATIO/=1) THEN
- XRM(:,:,:,1) = SM_PMR_HU(CLUOUT,XPABSM(:,:,:), &
- ZTHVM(:,:,:)*(XPABSM(:,:,:)/XP00)**(XRD/XCPD), &
- ZHUM(:,:,:),XRM(:,:,:,:),KITERMAX=100 )
XRT(:,:,:,1) = SM_PMR_HU(CLUOUT,XPABST(:,:,:), &
ZTHVT(:,:,:)*(XPABST(:,:,:)/XP00)**(XRD/XCPD), &
ZHUT(:,:,:),XRT(:,:,:,:),KITERMAX=100 )
END IF
!
- ALLOCATE(ZSUMRM(IIU,IJU,IKU))
- ZSUMRM(:,:,:) = 0.
DO JRR=1,NRR
- ZSUMRM(:,:,:) = ZSUMRM(:,:,:) + XRM(:,:,:,JRR)
ZSUMRT(:,:,:) = ZSUMRT(:,:,:) + XRT(:,:,:,JRR)
END DO
- XTHM(:,:,:) = ZTHVM(:,:,:)/(1.+XRV/XRD*XRM(:,:,:,1))*(1.+ZSUMRM(:,:,:))
XTHT(:,:,:) = ZTHVT(:,:,:)/(1.+XRV/XRD*XRT(:,:,:,1))*(1.+ZSUMRT(:,:,:))
- DEALLOCATE (ZSUMRM)
END IF
!
-DEALLOCATE (ZTHVM)
-DEALLOCATE (ZHUM)
DEALLOCATE (ZHUT)
!
CALL SECOND_MNH(ZTIME2)
@@ -1099,52 +1056,52 @@ ZPRESSURE2=ZTIME2-ZTIME1
!
!
!
-XLBXUM(1:NRIMX+1,:,:) = XUM(IIB:IIB+NRIMX,:,:)
-XLBXUM(NRIMX+2:2*NRIMX+2,:,:) = XUM(IIE+1-NRIMX:IIE+1,:,:)
+XLBXUM(1:NRIMX+1,:,:) = XUT(IIB:IIB+NRIMX,:,:)
+XLBXUM(NRIMX+2:2*NRIMX+2,:,:) = XUT(IIE+1-NRIMX:IIE+1,:,:)
IF( .NOT. L2D ) THEN
- XLBYUM(:,1:NRIMY+1,:) = XUM(:,IJB-1:IJB-1+NRIMY,:)
- XLBYUM(:,NRIMY+2:2*NRIMY+2,:) = XUM(:,IJE+1-NRIMY:IJE+1,:)
+ XLBYUM(:,1:NRIMY+1,:) = XUT(:,IJB-1:IJB-1+NRIMY,:)
+ XLBYUM(:,NRIMY+2:2*NRIMY+2,:) = XUT(:,IJE+1-NRIMY:IJE+1,:)
END IF
!
!* 5.9.2 V variable
!
!
-XLBXVM(1:NRIMX+1,:,:) = XVM(IIB-1:IIB-1+NRIMX,:,:)
-XLBXVM(NRIMX+2:2*NRIMX+2,:,:) = XVM(IIE+1-NRIMX:IIE+1,:,:)
+XLBXVM(1:NRIMX+1,:,:) = XVT(IIB-1:IIB-1+NRIMX,:,:)
+XLBXVM(NRIMX+2:2*NRIMX+2,:,:) = XVT(IIE+1-NRIMX:IIE+1,:,:)
IF( .NOT. L2D ) THEN
- XLBYVM(:,1:NRIMY+1,:) = XVM(:,IJB:IJB+NRIMY,:)
- XLBYVM(:,NRIMY+2:2*NRIMY+2,:) = XVM(:,IJE+1-NRIMY:IJE+1,:)
+ XLBYVM(:,1:NRIMY+1,:) = XVT(:,IJB:IJB+NRIMY,:)
+ XLBYVM(:,NRIMY+2:2*NRIMY+2,:) = XVT(:,IJE+1-NRIMY:IJE+1,:)
END IF
!
!* 5.9.3 W variable
!
!
-XLBXWM(1:NRIMX+1,:,:) = XWM(IIB-1:IIB-1+NRIMX,:,:)
-XLBXWM(NRIMX+2:2*NRIMX+2,:,:) = XWM(IIE+1-NRIMX:IIE+1,:,:)
+XLBXWM(1:NRIMX+1,:,:) = XWT(IIB-1:IIB-1+NRIMX,:,:)
+XLBXWM(NRIMX+2:2*NRIMX+2,:,:) = XWT(IIE+1-NRIMX:IIE+1,:,:)
IF( .NOT. L2D ) THEN
- XLBYWM(:,1:NRIMY+1,:) = XWM(:,IJB-1:IJB-1+NRIMY,:)
- XLBYWM(:,NRIMY+2:2*NRIMY+2,:) = XWM(:,IJE+1-NRIMY:IJE+1,:)
+ XLBYWM(:,1:NRIMY+1,:) = XWT(:,IJB-1:IJB-1+NRIMY,:)
+ XLBYWM(:,NRIMY+2:2*NRIMY+2,:) = XWT(:,IJE+1-NRIMY:IJE+1,:)
END IF
!
!* 5.9.4 TH variable
!
!
-XLBXTHM(1:NRIMX+1,:,:) = XTHM(IIB-1:IIB-1+NRIMX,:,:)
-XLBXTHM(NRIMX+2:2*NRIMX+2,:,:) = XTHM(IIE+1-NRIMX:IIE+1,:,:)
+XLBXTHM(1:NRIMX+1,:,:) = XTHT(IIB-1:IIB-1+NRIMX,:,:)
+XLBXTHM(NRIMX+2:2*NRIMX+2,:,:) = XTHT(IIE+1-NRIMX:IIE+1,:,:)
IF( .NOT. L2D ) THEN
- XLBYTHM(:,1:NRIMY+1,:) = XTHM(:,IJB-1:IJB-1+NRIMY,:)
- XLBYTHM(:,NRIMY+2:2*NRIMY+2,:) = XTHM(:,IJE+1-NRIMY:IJE+1,:)
+ XLBYTHM(:,1:NRIMY+1,:) = XTHT(:,IJB-1:IJB-1+NRIMY,:)
+ XLBYTHM(:,NRIMY+2:2*NRIMY+2,:) = XTHT(:,IJE+1-NRIMY:IJE+1,:)
END IF
!
!* 5.9.5 TKE variable
!
!
IF (HTURB /= 'NONE') THEN
- XLBXTKEM(1:NRIMX+1,:,:) = XTKEM(IIB-1:IIB-1+NRIMX,:,:)
- XLBXTKEM(NRIMX+2:2*NRIMX+2,:,:) = XTKEM(IIE+1-NRIMX:IIE+1,:,:)
+ XLBXTKEM(1:NRIMX+1,:,:) = XTKET(IIB-1:IIB-1+NRIMX,:,:)
+ XLBXTKEM(NRIMX+2:2*NRIMX+2,:,:) = XTKET(IIE+1-NRIMX:IIE+1,:,:)
IF( .NOT. L2D ) THEN
- XLBYTKEM(:,1:NRIMY+1,:) = XTKEM(:,IJB-1:IJB-1+NRIMY,:)
- XLBYTKEM(:,NRIMY+2:2*NRIMY+2,:) = XTKEM(:,IJE+1-NRIMY:IJE+1,:)
+ XLBYTKEM(:,1:NRIMY+1,:) = XTKET(:,IJB-1:IJB-1+NRIMY,:)
+ XLBYTKEM(:,NRIMY+2:2*NRIMY+2,:) = XTKET(:,IJE+1-NRIMY:IJE+1,:)
END IF
ENDIF
!
@@ -1153,11 +1110,11 @@ ENDIF
!
IF (NRR >= 1) THEN
DO JRR =1,NRR
- XLBXRM(1:NRIMX+1,:,:,JRR) = XRM(IIB-1:IIB-1+NRIMX,:,:,JRR)
- XLBXRM(NRIMX+2:2*NRIMX+2,:,:,JRR) = XRM(IIE+1-NRIMX:IIE+1,:,:,JRR)
+ XLBXRM(1:NRIMX+1,:,:,JRR) = XRT(IIB-1:IIB-1+NRIMX,:,:,JRR)
+ XLBXRM(NRIMX+2:2*NRIMX+2,:,:,JRR) = XRT(IIE+1-NRIMX:IIE+1,:,:,JRR)
IF( .NOT. L2D ) THEN
- XLBYRM(:,1:NRIMY+1,:,JRR) = XRM(:,IJB-1:IJB-1+NRIMY,:,JRR)
- XLBYRM(:,NRIMY+2:2*NRIMY+2,:,JRR) = XRM(:,IJE+1-NRIMY:IJE+1,:,JRR)
+ XLBYRM(:,1:NRIMY+1,:,JRR) = XRT(:,IJB-1:IJB-1+NRIMY,:,JRR)
+ XLBYRM(:,NRIMY+2:2*NRIMY+2,:,JRR) = XRT(:,IJE+1-NRIMY:IJE+1,:,JRR)
END IF
END DO
END IF
@@ -1166,11 +1123,11 @@ END IF
!
IF (NSV /= 0) THEN
DO JSV = 1, NSV
- XLBXSVM(1:NRIMX+1,:,:,JSV) = XSVM(IIB-1:IIB-1+NRIMX,:,:,JSV)
- XLBXSVM(NRIMX+2:2*NRIMX+2,:,:,JSV) = XSVM(IIE+1-NRIMX:IIE+1,:,:,JSV)
+ XLBXSVM(1:NRIMX+1,:,:,JSV) = XSVT(IIB-1:IIB-1+NRIMX,:,:,JSV)
+ XLBXSVM(NRIMX+2:2*NRIMX+2,:,:,JSV) = XSVT(IIE+1-NRIMX:IIE+1,:,:,JSV)
IF( .NOT. L2D ) THEN
- XLBYSVM(:,1:NRIMY+1,:,JSV) = XSVM(:,IJB-1:IJB-1+NRIMY,:,JSV)
- XLBYSVM(:,NRIMY+2:2*NRIMY+2,:,JSV) = XSVM(:,IJE+1-NRIMY:IJE+1,:,JSV)
+ XLBYSVM(:,1:NRIMY+1,:,JSV) = XSVT(:,IJB-1:IJB-1+NRIMY,:,JSV)
+ XLBYSVM(:,NRIMY+2:2*NRIMY+2,:,JSV) = XSVT(:,IJE+1-NRIMY:IJE+1,:,JSV)
END IF
END DO
ENDIF
@@ -1224,8 +1181,7 @@ ZMISC = ZMISC + ZTIME2 - ZTIME1
CALL SECOND_MNH(ZTIME1)
!
IF (.NOT. L1D) THEN
- CALL ANEL_BALANCE_n('M') ! for wind field at t-dt
- CALL ANEL_BALANCE_n('T') ! for wind field at t
+ CALL ANEL_BALANCE_n
CALL BOUNDARIES ( &
0.,CLBCX,CLBCY,NRR,NSV,1, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
@@ -1233,8 +1189,7 @@ IF (.NOT. L1D) THEN
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
XRHODJ, &
- XUM, XVM, XWM, XTHM, XTKEM, XRM, XSVM,XSRCM, &
- XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT )
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
END IF
!
CALL SECOND_MNH(ZTIME2)
diff --git a/src/MNH/spawn_pressure2.f90 b/src/MNH/spawn_pressure2.f90
index 48bc661aa..48e8a2e62 100644
--- a/src/MNH/spawn_pressure2.f90
+++ b/src/MNH/spawn_pressure2.f90
@@ -11,8 +11,7 @@ MODULE MODI_SPAWN_PRESSURE2
INTERFACE
!
SUBROUTINE SPAWN_PRESSURE2(KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO, &
- PZZ_LS,PZZ,PTHVM,PTHVT, &
- PPABSM,PPABST )
+ PZZ_LS,PZZ,PTHVT, PPABST )
!
INTEGER, INTENT(IN) :: KXOR,KXEND ! horizontal position (i,j) of the ORigin and END
INTEGER, INTENT(IN) :: KYOR,KYEND ! of the model 2 domain, relative to model 1
@@ -21,12 +20,8 @@ INTEGER, INTENT(IN) :: KDYRATIO ! between model 2 and model 1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ_LS ! purely interpolated alt.
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! model 2 altitudes
! ! model 2
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVM ! virt. pot. temp. at t-dt
-!
-! ! model 2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVT ! virt. pot. temp. at t
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABSM ! model 2 pressure a t-dt
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! model 2 pressure a t
!
END SUBROUTINE SPAWN_PRESSURE2
@@ -37,8 +32,7 @@ END MODULE MODI_SPAWN_PRESSURE2
!
! #######################################################################
SUBROUTINE SPAWN_PRESSURE2(KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO, &
- PZZ_LS,PZZ,PTHVM,PTHVT, &
- PPABSM,PPABST )
+ PZZ_LS,PZZ,PTHVT, PPABST )
! #######################################################################
!
!!**** *SPAWN_PRESSURE2 * - subroutine generating the model 2 pressure
@@ -145,12 +139,8 @@ INTEGER, INTENT(IN) :: KDYRATIO ! between model 2 and model 1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ_LS ! purely interpolated alt.
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! model 2 altitudes
! ! model 2
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVM ! virt. pot. temp. at t-dt
-!
-! ! model 2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVT ! virt. pot. temp. at t
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABSM ! model 2 pressure a t-dt
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! model 2 pressure a t
!
!* 0.2 Declarations of local variables
@@ -192,8 +182,8 @@ INTEGER :: IMI
IMI = GET_CURRENT_MODEL_INDEX()
CALL GOTO_MODEL(2)
!
-IIU = SIZE(PTHVM,1)
-IJU = SIZE(PTHVM,2)
+IIU = SIZE(PTHVT,1)
+IJU = SIZE(PTHVT,2)
IIU1= SIZE(FIELD_MODEL(1)%XTHT,1)
IJU1= SIZE(FIELD_MODEL(1)%XTHT,2)
IKU=SIZE(PZZ,3)
@@ -207,7 +197,6 @@ IKE=IKU-JPVEXT
!
IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
!
- PPABSM (:,:,:) = FIELD_MODEL(1)%XPABSM (KXOR:KXEND,KYOR:KYEND,:)
PPABST (:,:,:) = FIELD_MODEL(1)%XPABST (KXOR:KXEND,KYOR:KYEND,:)
!
CALL GOTO_MODEL(IMI)
@@ -220,42 +209,24 @@ END IF
!* 2. GENERAL CASE: CHANGE OF RESOLUTION
! ----------------------------------
!
-DO JINSTANT=1,2
-!
!* 2.1 Model 1 Pi and thetav
! ---------------------
!
ALLOCATE(ZEXN1(IIU1,IJU1,IKU))
ALLOCATE(ZTHV1(IIU1,IJU1,IKU))
- IF (JINSTANT==1) THEN
- ALLOCATE(ZSUMR(IIU1,IJU1,IKU))
- ZSUMR(:,:,:) = 0.
- DO JRR=1,CONF_MODEL(1)%NRR
- ZSUMR(:,:,:) = ZSUMR(:,:,:) + FIELD_MODEL(1)%XRM(:,:,:,JRR)
- END DO
- !
- ZEXN1(:,:,:)=(FIELD_MODEL(1)%XPABSM(:,:,:)/XP00)**(XRD/XCPD)
- IF (CONF_MODEL(1)%LUSERV) THEN
- ZTHV1(:,:,:)=FIELD_MODEL(1)%XTHM(:,:,:)*(1.+XRV/XRD*FIELD_MODEL(1)%XRM(:,:,:,1))/(1.+ZSUMR)
- ELSE
- ZTHV1(:,:,:)=FIELD_MODEL(1)%XTHM(:,:,:)
- END IF
- DEALLOCATE(ZSUMR)
- ELSE IF (JINSTANT==2) THEN
- ALLOCATE(ZSUMR(IIU1,IJU1,IKU))
- ZSUMR(:,:,:) = 0.
- DO JRR=1,CONF_MODEL(1)%NRR
- ZSUMR(:,:,:) = ZSUMR(:,:,:) + FIELD_MODEL(1)%XRT(:,:,:,JRR)
- END DO
+ ALLOCATE(ZSUMR(IIU1,IJU1,IKU))
+ ZSUMR(:,:,:) = 0.
+ DO JRR=1,CONF_MODEL(1)%NRR
+ ZSUMR(:,:,:) = ZSUMR(:,:,:) + FIELD_MODEL(1)%XRT(:,:,:,JRR)
+ END DO
!
- ZEXN1(:,:,:)=(FIELD_MODEL(1)%XPABST(:,:,:)/XP00)**(XRD/XCPD)
- IF (CONF_MODEL(1)%LUSERV) THEN
- ZTHV1(:,:,:)=FIELD_MODEL(1)%XTHT(:,:,:)*(1.+XRV/XRD*FIELD_MODEL(1)%XRT(:,:,:,1))/(1.+ZSUMR)
- ELSE
- ZTHV1(:,:,:)=FIELD_MODEL(1)%XTHT(:,:,:)
- END IF
- DEALLOCATE(ZSUMR)
+ ZEXN1(:,:,:)=(FIELD_MODEL(1)%XPABST(:,:,:)/XP00)**(XRD/XCPD)
+ IF (CONF_MODEL(1)%LUSERV) THEN
+ ZTHV1(:,:,:)=FIELD_MODEL(1)%XTHT(:,:,:)*(1.+XRV/XRD*FIELD_MODEL(1)%XRT(:,:,:,1))/(1.+ZSUMR)
+ ELSE
+ ZTHV1(:,:,:)=FIELD_MODEL(1)%XTHT(:,:,:)
END IF
+ DEALLOCATE(ZSUMR)
!
!* 2.2 Model 1 top Exner function (guess)
! --------------------------
@@ -330,11 +301,7 @@ DO JINSTANT=1,2
! --------------
!
ALLOCATE(ZTHV2(IIU,IJU,IKU))
- IF (JINSTANT==1) THEN
- ZTHV2(:,:,:)=PTHVM(:,:,:)
- ELSE IF (JINSTANT==2) THEN
- ZTHV2(:,:,:)=PTHVT(:,:,:)
- END IF
+ ZTHV2(:,:,:)=PTHVT(:,:,:)
!
!* 2.7 Model 2 hydrostatic pressure
! ----------------------------
@@ -350,16 +317,11 @@ DO JINSTANT=1,2
!* 2.8 Model 2 pressure
! ----------------
!
- IF (JINSTANT==1) THEN
- PPABSM(:,:,:)=XP00*(ZEXNMHEXN2(:,:,:)+ZHYDEXN2(:,:,:))**(XCPD/XRD)
- ELSE IF (JINSTANT==2) THEN
- PPABST(:,:,:)=XP00*(ZEXNMHEXN2(:,:,:)+ZHYDEXN2(:,:,:))**(XCPD/XRD)
- END IF
+ PPABST(:,:,:)=XP00*(ZEXNMHEXN2(:,:,:)+ZHYDEXN2(:,:,:))**(XCPD/XRD)
!
DEALLOCATE(ZEXNMHEXN2)
DEALLOCATE(ZHYDEXN2)
!
-END DO
!-------------------------------------------------------------------------------
!
CALL GOTO_MODEL(IMI)
diff --git a/src/MNH/spawn_surf2_rain.f90 b/src/MNH/spawn_surf2_rain.f90
index e01534f17..23254eb5d 100644
--- a/src/MNH/spawn_surf2_rain.f90
+++ b/src/MNH/spawn_surf2_rain.f90
@@ -109,8 +109,9 @@ END MODULE MODI_SPAWN_SURF2_RAIN
USE MODD_LBC_n, ONLY : LBC_MODEL
USE MODD_PRECIP_n,ONLY : PRECIP_MODEL
USE MODD_BIKHARDT_n
-USE MODD_LUNIT_n, ONLY:CLUOUT
+USE MODD_LUNIT_n, ONLY : CLUOUT
USE MODD_FIELD_n, ONLY : XTHT
+USE MODD_CONF, ONLY : CCONF,CPROGRAM
!
USE MODI_BIKHARDT ! Interface modules
!
@@ -361,9 +362,10 @@ IF (PRESENT(HSONFILE)) THEN
ALLOCATE(ZACPRH1(0,0))
YGETRHT='SKIP'
END IF
- CALL READ_PRECIP_FIELD(HSONFILE,CLUOUT,YGETRCT,YGETRRT,YGETRST,YGETRGT,YGETRHT, &
+ CALL READ_PRECIP_FIELD(HSONFILE,CLUOUT,CPROGRAM,CCONF, &
+ YGETRCT,YGETRRT,YGETRST,YGETRGT,YGETRHT, &
ZINPRC1,ZACPRC1,ZINPRR1,ZINPRR3D1,ZEVAP3D1, &
- ZACPRR1,ZINPRS1,ZACPRS1, &
+ ZACPRR1,ZINPRS1,ZACPRS1, &
ZINPRG1,ZACPRG1,ZINPRH1,ZACPRH1 )
IF (SIZE(PRECIP_MODEL(1)%XINPRC) /= 0 ) THEN
PINPRC(KIB2:KIE2,KJB2:KJE2) = ZINPRC1(KIB1:KIE1,KJB1:KJE1)
diff --git a/src/MNH/spawning.f90 b/src/MNH/spawning.f90
index e20b1b71d..5e8e1b470 100644
--- a/src/MNH/spawning.f90
+++ b/src/MNH/spawning.f90
@@ -114,7 +114,6 @@ USE MODI_VERSION
USE MODI_INIT_MNH
USE MODI_DEALLOC_SURFEX
!
-!
IMPLICIT NONE
!
!* 0.3 Local variables
@@ -178,7 +177,7 @@ IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_SPAWN_SURF)
CALL UPDATE_MODD_FROM_NMLVAR
CALL POSNAM(ILUSPA,'NAM_BLANK',GFOUND)
IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_BLANK)
-!!$CALL CLOSE_ll(YEXSPA)
+!!CALL CLOSE_ll(YEXSPA)
!
!-------------------------------------------------------------------------------
!
@@ -192,8 +191,7 @@ CALL BOUNDARIES &
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
XRHODJ, &
- XUM, XVM, XWM, XTHM, XTKEM, XRM, XSVM,XSRCM, &
- XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT )
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/thlrt_from_thrvrcri.f90 b/src/MNH/thlrt_from_thrvrcri.f90
new file mode 100644
index 000000000..fe0b35b7c
--- /dev/null
+++ b/src/MNH/thlrt_from_thrvrcri.f90
@@ -0,0 +1,107 @@
+! ######################################
+ MODULE MODI_THLRT_FROM_THRVRCRI
+! ######################################
+!
+INTERFACE
+
+! #################################################################
+ SUBROUTINE THLRT_FROM_THRVRCRI( KRR, &
+ PTH, PR, PLVOCPEXN,PLSOCPEXN, &
+ PTHL, PRT )
+! #################################################################
+
+!* 1.1 Declaration of Arguments
+!
+
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLVOCPEXN,PLSOCPEXN ! L/(cp*Pi)
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHL, PRT
+!
+END SUBROUTINE THLRT_FROM_THRVRCRI
+
+END INTERFACE
+!
+END MODULE MODI_THLRT_FROM_THRVRCRI
+
+
+! #################################################################
+ SUBROUTINE THLRT_FROM_THRVRCRI( KRR, &
+ PTH, PR, PLVOCPEXN,PLSOCPEXN, &
+ PTHL, PRT )
+! #################################################################
+!
+!!
+!!**** *THLRT_FROM_THRVRCRI* -
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson *CNRM*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/2011
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! theta
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLVOCPEXN,PLSOCPEXN ! L/(cp*Pi)
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHL, PRT
+!
+!-------------------------------------------------------------------------------
+!
+!
+IF ( KRR == 0 ) THEN
+ PTHL(:,:,:) = PTH(:,:,:)
+ PRT (:,:,:) = 0.
+ELSE IF (KRR==1) THEN
+ PTHL(:,:,:) = PTH(:,:,:)
+ PRT (:,:,:) = PR (:,:,:,1)
+ELSE IF ( KRR>= 4 ) THEN
+ ! Rnp at t
+ PRT(:,:,:) = PR(:,:,:,1) + PR(:,:,:,2) + PR(:,:,:,4)
+ ! Theta_l at t
+ PTHL(:,:,:) = PTH(:,:,:) - PLVOCPEXN(:,:,:) * PR(:,:,:,2) &
+ - PLSOCPEXN(:,:,:) * PR(:,:,:,4)
+ELSE IF ( KRR>= 2 ) THEN
+ ! Rnp at t
+ PRT(:,:,:) = PR(:,:,:,1) + PR(:,:,:,2)
+ ! Theta_l at t
+ PTHL(:,:,:) = PTH(:,:,:) - PLVOCPEXN(:,:,:) * PR(:,:,:,2)
+END IF
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE THLRT_FROM_THRVRCRI
diff --git a/src/MNH/thrvrcri_from_thlrtrcri.f90 b/src/MNH/thrvrcri_from_thlrtrcri.f90
new file mode 100644
index 000000000..ce08f33ff
--- /dev/null
+++ b/src/MNH/thrvrcri_from_thlrtrcri.f90
@@ -0,0 +1,108 @@
+! ######################################
+ MODULE MODI_THRVRCRI_FROM_THLRTRCRI
+! ######################################
+!
+INTERFACE
+
+! #################################################################
+ SUBROUTINE THRVRCRI_FROM_THLRTRCRI( KRR, &
+ PTHL, PR, PLVOCPEXN,PLSOCPEXN, &
+ PTH, PRV )
+! #################################################################
+
+!* 1.1 Declaration of Arguments
+!
+
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHL ! theta
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLVOCPEXN,PLSOCPEXN ! L/(cp*Pi)
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTH, PRV
+!
+END SUBROUTINE THRVRCRI_FROM_THLRTRCRI
+
+END INTERFACE
+!
+END MODULE MODI_THRVRCRI_FROM_THLRTRCRI
+
+
+! #################################################################
+ SUBROUTINE THRVRCRI_FROM_THLRTRCRI( KRR, &
+ PTHL, PR, PLVOCPEXN,PLSOCPEXN, &
+ PTH, PRV )
+! #################################################################
+!
+!!
+!!**** *THRVRCRI_FROM_THLRTRCRI* -
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson *CNRM*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/2011
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHL ! theta
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water species
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLVOCPEXN,PLSOCPEXN ! L/(cp*Pi)
+
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTH, PRV
+!
+!-------------------------------------------------------------------------------
+!
+!
+IF ( KRR == 0 ) THEN
+ PTH(:,:,:) = PTHL(:,:,:)
+ PRV(:,:,:) = 0.
+ELSE IF (KRR==1) THEN
+ PTH(:,:,:) = PTHL(:,:,:)
+ PRV(:,:,:) = PR (:,:,:,1)
+ELSE IF (KRR>=4) THEN
+ ! Rnp at t
+ PRV(:,:,:) = PR(:,:,:,1) - PR(:,:,:,2) - PR(:,:,:,4)
+ ! Theta_l at t
+ PTH(:,:,:) = PTHL(:,:,:) + PLVOCPEXN(:,:,:) * PR(:,:,:,2) &
+ + PLSOCPEXN(:,:,:) * PR(:,:,:,4)
+ELSE IF (KRR>=2) THEN
+ ! Rnp at t
+ PRV(:,:,:) = PR(:,:,:,1) - PR(:,:,:,2)
+ ! Theta_l at t
+ PTH(:,:,:) = PTHL(:,:,:) + PLVOCPEXN(:,:,:) * PR(:,:,:,2)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE THRVRCRI_FROM_THLRTRCRI
diff --git a/src/MNH/tke_eps_sources.f90 b/src/MNH/tke_eps_sources.f90
index 9fe4fef03..4ca17dfc6 100644
--- a/src/MNH/tke_eps_sources.f90
+++ b/src/MNH/tke_eps_sources.f90
@@ -10,15 +10,15 @@
INTERFACE
!
SUBROUTINE TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,PLM,PLEPS,PDP,PTRH, &
- PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
- PTSTEP,PIMPL,PEXPL, &
- HTURBLEN,HTURBDIM, &
- HFMFILE,HLUOUT,OCLOSE_OUT,OTURB_DIAG, &
- PTP,PRTKES,PRTHLS,PCOEF_DISS )
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+ PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
+ PTSTEP,PIMPL,PEXPL, &
+ HTURBLEN,HTURBDIM, &
+ HFMFILE,HLUOUT,OCLOSE_OUT,OTURB_DIAG, &
+ PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS )
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KMI ! model index number
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at t-deltat
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
@@ -27,8 +27,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height w-pt
-REAL, INTENT(IN) :: PTSTEP ! Double Time step ( *.5 for
- ! the first time step )
+REAL, INTENT(IN) :: PTSTEP ! Time step
REAL, INTENT(IN) :: PEXPL, PIMPL ! Coef. temporal. disc.
CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
@@ -45,6 +44,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP, PTRH ! Dyn. prod. of TKE
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTP ! Ther. prod. of TKE
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
! TKE at t+deltat
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKESM ! Advection source
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
!
@@ -62,7 +62,7 @@ END MODULE MODI_TKE_EPS_SOURCES
PTSTEP,PIMPL,PEXPL, &
HTURBLEN,HTURBDIM, &
HFMFILE,HLUOUT,OCLOSE_OUT,OTURB_DIAG, &
- PTP,PRTKES,PRTHLS,PCOEF_DISS )
+ PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS )
! ##################################################################
!
!
@@ -116,7 +116,7 @@ END MODULE MODI_TKE_EPS_SOURCES
!!
!! Module MODD_PARAMETERS:
!!
-!! JPVEXT_TURB
+!! JPVEXT
!! Module MODD_BUDGET:
!! NBUMOD : model in which budget is calculated
!! CBUTYPE : type of desired budget
@@ -210,8 +210,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height w-pt
-REAL, INTENT(IN) :: PTSTEP ! Double Time step ( *.5 for
- ! the first time step )
+REAL, INTENT(IN) :: PTSTEP ! Time step
REAL, INTENT(IN) :: PEXPL, PIMPL ! Coef. temporal. disc.
CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
@@ -230,6 +229,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
! TKE at t+deltat
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKESM ! Advection source
!
!
!
@@ -308,7 +308,8 @@ PDP(:,:,IKB) = PDP(:,:,IKB) * (1. + PDZZ(:,:,IKB+KKL)/PDZZ(:,:,IKB))
! Compute the source terms for TKE: ( ADVECtion + NUMerical DIFFusion + ..)
! + (Dynamical Production) + (Thermal Production) - (dissipation)
ZFLX(:,:,:) = XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:)
-ZSOURCE(:,:,:) = PRTKES(:,:,:) / PRHODJ(:,:,:) - PTKEM(:,:,:) / PTSTEP &
+ZSOURCE(:,:,:) = PRTKES(:,:,:) / PRHODJ(:,:,:) + PRTKESM(:,:,:) / PRHODJ(:,:,:) &
+ - PTKEM(:,:,:) / PTSTEP &
+ PDP(:,:,:) + PTP(:,:,:) + ZTR(:,:,:) - PEXPL * ZFLX(:,:,:) * PTKEM(:,:,:)
!
!* 2.2 implicit vertical TKE transport
@@ -337,10 +338,11 @@ ENDIF
!
! TKE must be greater than its minimum value
!
-GTKENEG = ZRES <= XTKEMIN
-WHERE ( GTKENEG )
- ZRES = XTKEMIN
-END WHERE
+! CL : Now done at the end of the time step in ADVECTION_METSV
+!GTKENEG = ZRES <= XTKEMIN
+!WHERE ( GTKENEG )
+! ZRES = XTKEMIN
+!END WHERE
!
IF ( LLES_CALL .OR. &
(OTURB_DIAG .AND. OCLOSE_OUT) ) THEN
@@ -389,8 +391,8 @@ CALL BUDGET (PRTKES(:,:,:),5,'DISS_BU_RTKE')
END IF
!
!* 2.5 computes the final RTKE and stores the whole turbulent transport
-!
-PRTKES(:,:,:) = ZRES(:,:,:) * PRHODJ(:,:,:) / PTSTEP
+! with the removal of the advection part
+PRTKES(:,:,:) = ZRES(:,:,:) * PRHODJ(:,:,:) / PTSTEP - PRTKESM(:,:,:)
!
! stores the whole turbulent transport
!
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index cdf4bdcf9..b3e8b737a 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -7,17 +7,16 @@ INTERFACE
SUBROUTINE TURB(KKA, KKU, KKL, KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
KSPLIT,KMODEL_CL, &
OCLOSE_OUT,OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
- HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HINST_SFU,PIMPL, &
- PTSTEP_UVW, PTSTEP_MET,PTSTEP_SV, &
- HFMFILE,HLUOUT,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,PIMPL, &
+ PTSTEP,HFMFILE,HLUOUT,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF,PRHODREF, &
PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
- PPABSM,PUM,PVM,PWM,PTKEM,PSVM,PSRCM, &
+ PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
PBL_DEPTH, PSBL_DEPTH, &
- PUT,PVT,PWT,PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
- PTHLM,PRM, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PSIGS, &
+ PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
+ PTHLT,PRT, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PRTKEMS,PSIGS,&
PFLXZTHVMF,PWTH,PWRC,PWSV )
!
@@ -45,12 +44,9 @@ CHARACTER*4 , INTENT(IN) :: HTURBDIM ! dimensionality of the
CHARACTER*4 , INTENT(IN) :: HTURBLEN ! kind of mixing length
CHARACTER*4 , INTENT(IN) :: HTOM ! kind of Third Order Moment
CHARACTER*4 , INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
-CHARACTER*1 , INTENT(IN) :: HINST_SFU ! temporal location of the
! surface friction flux
REAL, INTENT(IN) :: PIMPL ! degree of implicitness
-REAL, INTENT(IN) :: PTSTEP_UVW ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET ! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Timestep for tracer variables
+REAL, INTENT(IN) :: PTSTEP ! timestep
CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
! FM-file
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
@@ -80,16 +76,15 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSV
! normal surface fluxes of Scalar var.
!
! prognostic variables at t- deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! passive scal. var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Second-order flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! wind components
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! TKE
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! passive scal. var.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCT ! Second-order flux
! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! BL depth for TOMS
REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! Wind at t
!
! variables for cloud mixing length
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCEI ! Cloud Entrainment instability
@@ -99,15 +94,16 @@ REAL, INTENT(IN) :: PCEI_MIN ! minimum threshold for the instability index
REAL, INTENT(IN) :: PCEI_MAX ! maximum threshold for the instability index CEI
REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coefficient
! thermodynamical variables which are transformed in conservative var.
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRM ! water var. where
- ! PRM(:,:,:,1) is the conservative mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
+ ! PRT(:,:,:,1) is the conservative mixing ratio
!
! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
! TKE dissipation
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
! mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKEMS
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
! Source terms for all passive scalar variables
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
@@ -133,17 +129,16 @@ END MODULE MODI_TURB
! #################################################################
SUBROUTINE TURB(KKA,KKU,KKL,KMI,KRR,KRRL,KRRI,HLBCX,HLBCY,KSPLIT,KMODEL_CL, &
OCLOSE_OUT,OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
- HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HINST_SFU,PIMPL, &
- PTSTEP_UVW, PTSTEP_MET,PTSTEP_SV, &
- HFMFILE,HLUOUT,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,PIMPL, &
+ PTSTEP,HFMFILE,HLUOUT,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF,PRHODREF, &
PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
- PPABSM,PUM,PVM,PWM,PTKEM,PSVM,PSRCM, &
+ PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
PBL_DEPTH,PSBL_DEPTH, &
- PUT,PVT,PWT,PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
- PTHLM,PRM, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PSIGS, &
+ PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
+ PTHLT,PRT, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PRTKEMS,PSIGS,&
PFLXZTHVMF,PWTH,PWRC,PWSV )
! #################################################################
!
@@ -228,7 +223,7 @@ END MODULE MODI_TURB
!! IMPLICIT ARGUMENTS
!! ------------------
!!
-!! MODD_PARAMETERS : JPVEXT_TURB number of marginal vertical points
+!! MODD_PARAMETERS : JPVEXT number of marginal vertical points
!!
!! MODD_CONF : CCONF model configuration (start/restart)
!! L1D switch for 1D model version
@@ -400,12 +395,8 @@ CHARACTER*4 , INTENT(IN) :: HTURBDIM ! dimensionality of the
CHARACTER*4 , INTENT(IN) :: HTURBLEN ! kind of mixing length
CHARACTER*4 , INTENT(IN) :: HTOM ! kind of Third Order Moment
CHARACTER*4 , INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
-CHARACTER*1 , INTENT(IN) :: HINST_SFU ! temporal location of the
- ! surface friction flux
REAL, INTENT(IN) :: PIMPL ! degree of implicitness
-REAL, INTENT(IN) :: PTSTEP_UVW ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET ! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Timestep for tracer variables
+REAL, INTENT(IN) :: PTSTEP ! timestep
CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
! FM-file
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
@@ -435,16 +426,15 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSV
! normal surface fluxes of Scalar var.
!
! prognostic variables at t- deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! passive scal. var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Second-order flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! wind components
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! TKE
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! passive scal. var.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCT ! Second-order flux
! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! Wind at t
! variables for cloud mixing length
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCEI ! Cloud Entrainment instability
! index to emphasize localy
@@ -454,15 +444,16 @@ REAL, INTENT(IN) :: PCEI_MAX ! maximum threshold for the instability index
REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coefficient
!
! thermodynamical variables which are transformed in conservative var.
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRM ! water var. where
- ! PRM(:,:,:,1) is the conservative mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
+ ! PRT(:,:,:,1) is the conservative mixing ratio
!
! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
! TKE dissipation
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
! mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKEMS
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
! Source terms for all passive scalar variables
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
@@ -481,8 +472,6 @@ REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
!
! 0.2 declaration of local variables
!
-!JUAN BUG PGI
-!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
REAL, ALLOCATABLE, DIMENSION(:,:,:) ::&
ZCP, & ! Cp at t-1
ZEXN, & ! EXN at t-1
@@ -497,11 +486,8 @@ REAL, ALLOCATABLE, DIMENSION(:,:,:) ::&
ZMWTH,ZMWR,ZMTH2,ZMR2,ZMTHR,& ! 3rd order moments
ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,& ! opposite of verticale derivate of 3rd order moments
ZTHLM ! initial potential temp.
-!!$REAL, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3),SIZE(PRM,4)) :: &
REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: &
ZRM ! initial mixing ratio
-
-!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZTAU11M,ZTAU12M, &
REAL, ALLOCATABLE, DIMENSION(:,:) :: ZTAU11M,ZTAU12M, &
ZTAU22M,ZTAU33M, &
! tangential surface fluxes in the axes following the orography
@@ -543,45 +529,45 @@ REAL :: ZTIME1, ZTIME2
!
!------------------------------------------------------------------------------------------
ALLOCATE ( &
- ZCP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZEXN(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZT(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZLOCPEXNM(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZLM(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZLEPS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZDP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZTP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZTRH(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZATHETA(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZAMOIST(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZCOEF_DISS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZFRAC_ICE(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZMWTH(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZMWR(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZMTH2(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZMR2(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZMTHR(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZFWTH(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZFWR(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZFTH2(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZFR2(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZFTHR(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), &
- ZTHLM(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) )
+ ZCP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZEXN(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZT(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZLOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZLM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZLEPS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZDP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZTP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZTRH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZATHETA(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZAMOIST(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZCOEF_DISS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFRAC_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZMWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZMWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZMTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZMR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZMTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZFTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+ ZTHLM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) )
-ALLOCATE ( ZRM(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3),SIZE(PRM,4)) )
+ALLOCATE ( ZRM(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) )
ALLOCATE ( &
- ZTAU11M(SIZE(PTHLM,1),SIZE(PTHLM,2)), &
- ZTAU12M(SIZE(PTHLM,1),SIZE(PTHLM,2)), &
- ZTAU22M(SIZE(PTHLM,1),SIZE(PTHLM,2)), &
- ZTAU33M(SIZE(PTHLM,1),SIZE(PTHLM,2)), &
- ZUSLOPE(SIZE(PTHLM,1),SIZE(PTHLM,2)), &
- ZVSLOPE(SIZE(PTHLM,1),SIZE(PTHLM,2)), &
- ZCDUEFF(SIZE(PTHLM,1),SIZE(PTHLM,2)), &
- ZUSTAR(SIZE(PTHLM,1),SIZE(PTHLM,2)), &
- ZLMO(SIZE(PTHLM,1),SIZE(PTHLM,2)), &
- ZRVM(SIZE(PTHLM,1),SIZE(PTHLM,2)), &
- ZSFRV(SIZE(PTHLM,1),SIZE(PTHLM,2)) )
+ ZTAU11M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZTAU12M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZTAU22M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZTAU33M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZUSLOPE(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZVSLOPE(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZCDUEFF(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZUSTAR(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZLMO(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZRVM(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
+ ZSFRV(SIZE(PTHLT,1),SIZE(PTHLT,2)) )
!------------------------------------------------------------------------------------------
!
@@ -591,7 +577,7 @@ ALLOCATE ( &
!* 1.1 Set the internal domains, ZEXPL
!
!
-IKT=SIZE(PTHLM,3)
+IKT=SIZE(PTHLT,3)
IKTB=1+JPVEXT_TURB
IKTE=IKT-JPVEXT_TURB
IKB=KKA+JPVEXT_TURB*KKL
@@ -601,8 +587,8 @@ ZEXPL = 1.- PIMPL
ZRVORD= XRV / XRD
!
!
-ZTHLM(:,:,:) = PTHLM(:,:,:)
-ZRM(:,:,:,:) = PRM(:,:,:,:)
+ZTHLM(:,:,:) = PTHLT(:,:,:)
+ZRM(:,:,:,:) = PRT(:,:,:,:)
!
!
!
@@ -615,18 +601,18 @@ ZRM(:,:,:,:) = PRM(:,:,:,:)
!
ZCP=XCPD
!
-IF (KRR > 0) ZCP(:,:,:) = ZCP(:,:,:) + XCPV * PRM(:,:,:,1)
+IF (KRR > 0) ZCP(:,:,:) = ZCP(:,:,:) + XCPV * PRT(:,:,:,1)
DO JRR = 2,1+KRRL ! loop on the liquid components
- ZCP(:,:,:) = ZCP(:,:,:) + XCL * PRM(:,:,:,JRR)
+ ZCP(:,:,:) = ZCP(:,:,:) + XCL * PRT(:,:,:,JRR)
END DO
!
DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
- ZCP(:,:,:) = ZCP(:,:,:) + XCI * PRM(:,:,:,JRR)
+ ZCP(:,:,:) = ZCP(:,:,:) + XCI * PRT(:,:,:,JRR)
END DO
!
!* 2.2 Exner function at t
!
-ZEXN(:,:,:) = (PPABSM(:,:,:)/XP00) ** (XRD/XCPD)
+ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
!
!* 2.3 dissipative heating coeff a t
!
@@ -641,23 +627,23 @@ IF (KRRL >=1) THEN
!
!* 2.4 Temperature at t
!
- ZT(:,:,:) = PTHLM(:,:,:) * ZEXN(:,:,:)
+ ZT(:,:,:) = PTHLT(:,:,:) * ZEXN(:,:,:)
!
!* 2.5 Lv/Cph/Exn
!
IF ( KRRI >= 1 ) THEN
- ALLOCATE(ZLVOCPEXNM(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)))
- ALLOCATE(ZLSOCPEXNM(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)))
- ALLOCATE(ZAMOIST_ICE(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)))
- ALLOCATE(ZATHETA_ICE(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)))
+ ALLOCATE(ZLVOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
+ ALLOCATE(ZLSOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
+ ALLOCATE(ZAMOIST_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
+ ALLOCATE(ZATHETA_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)))
!
CALL COMPUTE_FUNCTION_THERMO(XALPW,XBETAW,XGAMW,XLVTT,XCL,ZT,ZEXN,ZCP, &
ZLVOCPEXNM,ZAMOIST,ZATHETA)
CALL COMPUTE_FUNCTION_THERMO(XALPI,XBETAI,XGAMI,XLSTT,XCI,ZT,ZEXN,ZCP, &
ZLSOCPEXNM,ZAMOIST_ICE,ZATHETA_ICE)
!
- WHERE(PRM(:,:,:,2)+PRM(:,:,:,4)>0.0)
- ZFRAC_ICE(:,:,:) = PRM(:,:,:,4) / ( PRM(:,:,:,2)+PRM(:,:,:,4) )
+ WHERE(PRT(:,:,:,2)+PRT(:,:,:,4)>0.0)
+ ZFRAC_ICE(:,:,:) = PRT(:,:,:,4) / ( PRT(:,:,:,2)+PRT(:,:,:,4) )
END WHERE
!
ZLOCPEXNM(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZLVOCPEXNM(:,:,:) &
@@ -697,20 +683,20 @@ END IF ! loop end on KRRL >= 1
!
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
- ! Rnp at t-1
- PRM(:,:,:,1) = PRM(:,:,:,1) + PRM(:,:,:,2) + PRM(:,:,:,4)
+ ! Rnp at t
+ PRT(:,:,:,1) = PRT(:,:,:,1) + PRT(:,:,:,2) + PRT(:,:,:,4)
PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2) + PRRS(:,:,:,4)
- ! Theta_l at t-1
- PTHLM(:,:,:) = PTHLM(:,:,:) - ZLVOCPEXNM(:,:,:) * PRM(:,:,:,2) &
- - ZLSOCPEXNM(:,:,:) * PRM(:,:,:,4)
+ ! Theta_l at t
+ PTHLT(:,:,:) = PTHLT(:,:,:) - ZLVOCPEXNM(:,:,:) * PRT(:,:,:,2) &
+ - ZLSOCPEXNM(:,:,:) * PRT(:,:,:,4)
PRTHLS(:,:,:) = PRTHLS(:,:,:) - ZLVOCPEXNM(:,:,:) * PRRS(:,:,:,2) &
- ZLSOCPEXNM(:,:,:) * PRRS(:,:,:,4)
ELSE
- ! Rnp at t-1
- PRM(:,:,:,1) = PRM(:,:,:,1) + PRM(:,:,:,2)
+ ! Rnp at t
+ PRT(:,:,:,1) = PRT(:,:,:,1) + PRT(:,:,:,2)
PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2)
- ! Theta_l at t-1
- PTHLM(:,:,:) = PTHLM(:,:,:) - ZLOCPEXNM(:,:,:) * PRM(:,:,:,2)
+ ! Theta_l at t
+ PTHLT(:,:,:) = PTHLT(:,:,:) - ZLOCPEXNM(:,:,:) * PRT(:,:,:,2)
PRTHLS(:,:,:) = PRTHLS(:,:,:) - ZLOCPEXNM(:,:,:) * PRRS(:,:,:,2)
END IF
END IF
@@ -727,7 +713,7 @@ SELECT CASE (HTURBLEN)
! ------------------
CASE ('BL89')
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKEM,ZLM)
+ CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZLM)
!
!* 3.2 Delta mixing length
! -------------------
@@ -805,19 +791,18 @@ END IF
!
!* 4.1 rotate the wind at time t
!
-IF ( HINST_SFU == 'T' ) THEN
!
!
IF (CPROGRAM=='AROME ') THEN
- ZUSLOPE=PUM(:,:,KKA)
- ZVSLOPE=PVM(:,:,KKA)
+ ZUSLOPE=PUT(:,:,KKA)
+ ZVSLOPE=PVT(:,:,KKA)
ELSE
CALL ROTATE_WIND(PUT,PVT,PWT, &
PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
PDXX,PDYY,PDZZ, &
ZUSLOPE,ZVSLOPE )
-
+!
CALL UPDATE_ROTATE_WIND(ZUSLOPE,ZVSLOPE)
END IF
!
@@ -828,28 +813,10 @@ IF ( HINST_SFU == 'T' ) THEN
(XMNH_TINY + ZUSLOPE(:,:)**2 + ZVSLOPE(:,:)**2 ) &
)
!
-!* 4.3 rotate the wind at time t-delta t
+!* 4.3 rotate the wind at time t
!
IF (CPROGRAM/='AROME ') THEN
- CALL ROTATE_WIND(PUM,PVM,PWM, &
- PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
- PCOSSLOPE,PSINSLOPE, &
- PDXX,PDYY,PDZZ, &
- ZUSLOPE,ZVSLOPE )
-!
- CALL UPDATE_ROTATE_WIND(ZUSLOPE,ZVSLOPE)
- END IF
-!
-ELSE
-!
-!* 4.4 rotate the wind at time t-delta t
-!
- IF (CPROGRAM=='AROME ') THEN
- ZUSLOPE=PUM(:,:,KKA)
- ZVSLOPE=PVM(:,:,KKA)
- ELSE
-!
- CALL ROTATE_WIND(PUM,PVM,PWM, &
+ CALL ROTATE_WIND(PUT,PVT,PWT, &
PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
PDXX,PDYY,PDZZ, &
@@ -858,19 +825,13 @@ ELSE
CALL UPDATE_ROTATE_WIND(ZUSLOPE,ZVSLOPE)
END IF
!
-!* 4.5 compute the proportionality coefficient between wind and stress
-!
- ZCDUEFF(:,:) =-SQRT ( (PSFU(:,:)**2 + PSFV(:,:)**2) / &
- (XMNH_TINY + ZUSLOPE(:,:)**2 + ZVSLOPE(:,:)**2 ) &
- )
-END IF
!
!* 4.6 compute the surface tangential fluxes
!
ZTAU11M(:,:) =2./3.*( (1.+ (PZZ (:,:,IKB+KKL)-PZZ (:,:,IKB)) &
/(PDZZ(:,:,IKB+KKL)+PDZZ(:,:,IKB)) &
- ) *PTKEM(:,:,IKB) &
- -0.5 *PTKEM(:,:,IKB+KKL) &
+ ) *PTKET(:,:,IKB) &
+ -0.5 *PTKET(:,:,IKB+KKL) &
)
ZTAU12M(:,:) =0.0
ZTAU22M(:,:) =ZTAU11M(:,:)
@@ -913,16 +874,15 @@ ZFTHR(:,:,:IKTB) = 0.
CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
OCLOSE_OUT,OTURB_FLX, &
HTURBDIM,HTOM,PIMPL,ZEXPL, &
- PTSTEP_UVW, PTSTEP_MET, PTSTEP_SV, &
- HFMFILE,HLUOUT, &
+ PTSTEP,HFMFILE,HLUOUT, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF, &
PSFTH,PSFRV,PSFSV,PSFTH,PSFRV,PSFSV, &
ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU33M, &
- PUM,PVM,PWM,ZUSLOPE,ZVSLOPE,PTHLM,PRM,PSVM, &
- PTKEM,ZLM,ZLEPS, &
- ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCM,ZFRAC_ICE, &
+ PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
+ PTKET,ZLM,ZLEPS, &
+ ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,PBL_DEPTH, &
PSBL_DEPTH,ZLMO, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
@@ -960,9 +920,8 @@ IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'VTURB_BU_RRI')
!
!
IF (HTURBDIM=='3DIM') THEN
- CALL TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP_UVW, &
- PTSTEP_MET, PTSTEP_SV, HLBCX,HLBCY, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ CALL TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
+ HLBCX,HLBCY,OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
HFMFILE,HLUOUT, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -970,9 +929,9 @@ IF (HTURBDIM=='3DIM') THEN
PRHODJ,PTHVREF, &
PSFTH,PSFRV,PSFSV, &
ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU22M,ZTAU33M, &
- PUM,PVM,PWM,ZUSLOPE,ZVSLOPE,PTHLM,PRM,PSVM, &
- PTKEM,ZLM,ZLEPS, &
- ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCM,ZFRAC_ICE, &
+ PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
+ PTKET,ZLM,ZLEPS, &
+ ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
ZDP,ZTP,PSIGS, &
ZTRH, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
@@ -984,7 +943,8 @@ IF (LBUDGET_V) CALL BUDGET (PRVS,2,'HTURB_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,3,'HTURB_BU_RW')
IF (LBUDGET_TH) THEN
IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'HTURB_BU_RTH')
+ CALL BUDGET (PRTHLS+ZLVOCPEXNM*PRRS(:,:,:,2)+ZLSOCPEXNM*PRRS(:,:,:,4) &
+ ,4,'HTURB_BU_RTH')
ELSE IF ( KRRL >= 1 ) THEN
CALL BUDGET (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'HTURB_BU_RTH')
ELSE
@@ -1020,17 +980,18 @@ IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'HTURB_BU_RRI')
! 6.2 TKE evolution equation
-CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,ZLM,ZLEPS,ZDP,ZTRH, &
+CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKET,ZLM,ZLEPS,ZDP,ZTRH, &
PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
- PTSTEP_MET,PIMPL,ZEXPL, &
+ PTSTEP,PIMPL,ZEXPL, &
HTURBLEN,HTURBDIM, &
HFMFILE,HLUOUT,OCLOSE_OUT,OTURB_DIAG, &
- ZTP,PRTKES,PRTHLS,ZCOEF_DISS )
+ ZTP,PRTKES,PRTKEMS,PRTHLS,ZCOEF_DISS )
IF (LBUDGET_TH) THEN
IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'DISSH_BU_RTH')
+ CALL BUDGET (PRTHLS+ZLVOCPEXNM*PRRS(:,:,:,2)+ZLSOCPEXNM*PRRS(:,:,:,4) &
+ ,4,'DISSH_BU_RTH')
ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'DISSH_BU_RTH')
+ CALL BUDGET (PRTHLS+ZLOCPEXNM* PRRS(:,:,:,2),4,'DISSH_BU_RTH')
ELSE
CALL BUDGET (PRTHLS,4,'DISSH_BU_RTH')
END IF
@@ -1060,7 +1021,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
YCOMMENT='X_Y_Z_THLM (KELVIN)'
IGRID = 1
ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PTHLM,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PTHLT,IGRID,ILENCH,YCOMMENT,IRESP)
!
! stores the conservative mixing ratio
!
@@ -1068,7 +1029,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
YCOMMENT='X_Y_Z_RNPM (KG/KG)'
IGRID = 1
ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PRM(:,:,:,1),IGRID,ILENCH, &
+ CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PRT(:,:,:,1),IGRID,ILENCH, &
YCOMMENT,IRESP)
END IF
END IF
@@ -1080,19 +1041,19 @@ END IF
!
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
- PRM(:,:,:,1) = PRM(:,:,:,1) - PRM(:,:,:,2) - PRM(:,:,:,4)
+ PRT(:,:,:,1) = PRT(:,:,:,1) - PRT(:,:,:,2) - PRT(:,:,:,4)
PRRS(:,:,:,1) = PRRS(:,:,:,1) - PRRS(:,:,:,2) - PRRS(:,:,:,4)
- PTHLM(:,:,:) = PTHLM(:,:,:) + ZLVOCPEXNM(:,:,:) * PRM(:,:,:,2) &
- + ZLSOCPEXNM(:,:,:) * PRM(:,:,:,4)
+ PTHLT(:,:,:) = PTHLT(:,:,:) + ZLVOCPEXNM(:,:,:) * PRT(:,:,:,2) &
+ + ZLSOCPEXNM(:,:,:) * PRT(:,:,:,4)
PRTHLS(:,:,:) = PRTHLS(:,:,:) + ZLVOCPEXNM(:,:,:) * PRRS(:,:,:,2) &
+ ZLSOCPEXNM(:,:,:) * PRRS(:,:,:,4)
!
DEALLOCATE(ZLVOCPEXNM)
DEALLOCATE(ZLSOCPEXNM)
ELSE
- PRM(:,:,:,1) = PRM(:,:,:,1) - PRM(:,:,:,2)
+ PRT(:,:,:,1) = PRT(:,:,:,1) - PRT(:,:,:,2)
PRRS(:,:,:,1) = PRRS(:,:,:,1) - PRRS(:,:,:,2)
- PTHLM(:,:,:) = PTHLM(:,:,:) + ZLOCPEXNM(:,:,:) * PRM(:,:,:,2)
+ PTHLT(:,:,:) = PTHLT(:,:,:) + ZLOCPEXNM(:,:,:) * PRT(:,:,:,2)
PRTHLS(:,:,:) = PRTHLS(:,:,:) + ZLOCPEXNM(:,:,:) * PRRS(:,:,:,2)
END IF
END IF
@@ -1131,17 +1092,17 @@ IF (LLES_CALL) THEN
! ------------------------------------------------
!
IF (HTURBDIM=="1DIM") THEN
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM,X_LES_SUBGRID_U2)
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM,X_LES_SUBGRID_V2)
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM,X_LES_SUBGRID_W2)
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM*MZF(KKA,KKU,KKL,&
- & GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)),X_LES_RES_ddz_Thl_SBG_W2)
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET,X_LES_SUBGRID_U2)
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET,X_LES_SUBGRID_V2)
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET,X_LES_SUBGRID_W2)
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(KKA,KKU,KKL,&
+ & GZ_M_W(KKA,KKU,KKL,PTHLT,PDZZ)),X_LES_RES_ddz_Thl_SBG_W2)
IF (KRR>=1) &
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM*MZF(KKA,KKU,KKL,&
- & GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)),X_LES_RES_ddz_Rt_SBG_W2)
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(KKA,KKU,KKL,&
+ & GZ_M_W(KKA,KKU,KKL,PRT(:,:,:,1),PDZZ)),X_LES_RES_ddz_Rt_SBG_W2)
DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM*MZF(KKA,KKU,KKL,&
- & GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)),X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(KKA,KKU,KKL,&
+ & GZ_M_W(KKA,KKU,KKL,PSVT(:,:,:,JSV),PDZZ)),X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
END DO
END IF
@@ -1294,7 +1255,7 @@ REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZDRVSATDT
!
!* 1.3 saturation mixing ratio at t
!
- ZRVSAT(:,:,:) = ZRVSAT(:,:,:) * ZEPS / ( PPABSM(:,:,:) - ZRVSAT(:,:,:) )
+ ZRVSAT(:,:,:) = ZRVSAT(:,:,:) * ZEPS / ( PPABST(:,:,:) - ZRVSAT(:,:,:) )
!
!* 1.4 compute the saturation mixing ratio derivative (rvs')
!
@@ -1308,7 +1269,7 @@ REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZDRVSATDT
!* 1.6 compute Atheta
!
PATHETA(:,:,:)= PAMOIST(:,:,:) * PEXN(:,:,:) * &
- ( ( ZRVSAT(:,:,:) - PRM(:,:,:,1) ) * PLOCPEXN(:,:,:) / &
+ ( ( ZRVSAT(:,:,:) - PRT(:,:,:,1) ) * PLOCPEXN(:,:,:) / &
( 1. + ZDRVSATDT(:,:,:) * PLOCPEXN(:,:,:) ) * &
( &
ZRVSAT(:,:,:) * (1. + ZRVSAT(:,:,:)/ZEPS) &
@@ -1374,8 +1335,8 @@ END IF
IF (.NOT. ORMC01) THEN
ZALPHA=0.5**(-1.5)
!
- DO JJ=1,SIZE(PUM,2)
- DO JI=1,SIZE(PUM,1)
+ DO JJ=1,SIZE(PUT,2)
+ DO JI=1,SIZE(PUT,1)
DO JK=IKTB,IKTE
ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))&
-PZZ(JI,JJ,IKB)) *PDIRCOSZW(JI,JJ)
@@ -1425,7 +1386,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
REAL :: ZD ! distance to the surface
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D
!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+REAL, DIMENSION(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) :: &
ZDTHLDZ,ZDRTDZ, &!dtheta_l/dz, drt_dz used for computing the stablity
! ! criterion
ZETHETA,ZEMOIST !coef ETHETA and EMOIST
@@ -1448,18 +1409,18 @@ IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
END IF
! compute a mixing length limited by the stability
!
-ALLOCATE(ZWORK2D(SIZE(PUM,1),SIZE(PUM,2)))
+ALLOCATE(ZWORK2D(SIZE(PUT,1),SIZE(PUT,2)))
!
-ZETHETA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,ZLOCPEXNM,ZATHETA,PSRCM)
-ZEMOIST(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,ZLOCPEXNM,ZAMOIST,PSRCM)
+ZETHETA(:,:,:) = ETHETA(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZATHETA,PSRCT)
+ZEMOIST(:,:,:) = EMOIST(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZAMOIST,PSRCT)
!
DO JK = IKTB+1,IKTE-1
- ZDTHLDZ(:,:,JK)= 0.5*((PTHLM(:,:,JK+KKL)-PTHLM(:,:,JK))/PDZZ(:,:,JK+KKL)+ &
- (PTHLM(:,:,JK)-PTHLM(:,:,JK-KKL))/PDZZ(:,:,JK))
+ ZDTHLDZ(:,:,JK)= 0.5*((PTHLT(:,:,JK+KKL)-PTHLT(:,:,JK))/PDZZ(:,:,JK+KKL)+ &
+ (PTHLT(:,:,JK)-PTHLT(:,:,JK-KKL))/PDZZ(:,:,JK))
! For dry simulations
IF (KRR>0) THEN
- ZDRTDZ(:,:,JK)= 0.5*((PRM(:,:,JK+KKL,1)-PRM(:,:,JK,1))/PDZZ(:,:,JK+KKL)+ &
- (PRM(:,:,JK,1)-PRM(:,:,JK-KKL,1))/PDZZ(:,:,JK))
+ ZDRTDZ(:,:,JK)= 0.5*((PRT(:,:,JK+KKL,1)-PRT(:,:,JK,1))/PDZZ(:,:,JK+KKL)+ &
+ (PRT(:,:,JK,1)-PRT(:,:,JK-KKL,1))/PDZZ(:,:,JK))
ELSE
ZDRTDZ(:,:,JK)=0
ENDIF
@@ -1468,14 +1429,14 @@ ENDIF
!
WHERE(ZWORK2D(:,:)>0.)
PLM(:,:,JK)=MAX(XMNH_EPSILON,MIN(PLM(:,:,JK), &
- 0.76* SQRT(PTKEM(:,:,JK)/ZWORK2D(:,:))))
+ 0.76* SQRT(PTKET(:,:,JK)/ZWORK2D(:,:))))
END WHERE
END DO
! special case near the surface
-ZDTHLDZ(:,:,IKB)=(PTHLM(:,:,IKB+KKL)-PTHLM(:,:,IKB))/PDZZ(:,:,IKB+KKL)
+ZDTHLDZ(:,:,IKB)=(PTHLT(:,:,IKB+KKL)-PTHLT(:,:,IKB))/PDZZ(:,:,IKB+KKL)
! For dry simulations
IF (KRR>0) THEN
- ZDRTDZ(:,:,IKB)=(PRM(:,:,IKB+KKL,1)-PRM(:,:,IKB,1))/PDZZ(:,:,IKB+KKL)
+ ZDRTDZ(:,:,IKB)=(PRT(:,:,IKB+KKL,1)-PRT(:,:,IKB,1))/PDZZ(:,:,IKB+KKL)
ELSE
ZDRTDZ(:,:,IKB)=0
ENDIF
@@ -1484,7 +1445,7 @@ ZWORK2D(:,:)=XG/PTHVREF(:,:,IKB)* &
(ZETHETA(:,:,IKB)*ZDTHLDZ(:,:,IKB)+ZEMOIST(:,:,IKB)*ZDRTDZ(:,:,IKB))
WHERE(ZWORK2D(:,:)>0.)
PLM(:,:,IKB)=MAX(XMNH_EPSILON,MIN( PLM(:,:,IKB), &
- 0.76* SQRT(PTKEM(:,:,IKB)/ZWORK2D(:,:))))
+ 0.76* SQRT(PTKET(:,:,IKB)/ZWORK2D(:,:))))
END WHERE
!
DEALLOCATE(ZWORK2D)
@@ -1494,8 +1455,8 @@ DEALLOCATE(ZWORK2D)
IF (.NOT. ORMC01) THEN
ZALPHA=0.5**(-1.5)
!
- DO JJ=1,SIZE(PUM,2)
- DO JI=1,SIZE(PUM,1)
+ DO JJ=1,SIZE(PUT,2)
+ DO JI=1,SIZE(PUT,1)
DO JK=IKTB,IKTE
ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))-PZZ(JI,JJ,IKB)) &
*PDIRCOSZW(JI,JJ)
@@ -1569,10 +1530,10 @@ IMPLICIT NONE
REAL :: ZPENTE ! Slope of the amplification straight line
REAL :: ZCOEF_AMPL_CEI_NUL! Ordonnate at the origin of the
! amplification straight line
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZCOEF_AMPL
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCOEF_AMPL
! Amplification coefficient of the mixing length
! when the instability criterium is verified
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZLM_CLOUD
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZLM_CLOUD
! Turbulent mixing length in the clouds
!
!-------------------------------------------------------------------------------
@@ -1611,7 +1572,7 @@ ELSE
!* 3.1 BL89 mixing length
! ------------------
CASE ('BL89')
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKEM,ZLM_CLOUD)
+ CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZLM_CLOUD)
!
!* 3.2 Delta mixing length
! -------------------
diff --git a/src/MNH/turb_hor_splt.f90 b/src/MNH/turb_hor_splt.f90
index bc2a12391..437f15cf6 100644
--- a/src/MNH/turb_hor_splt.f90
+++ b/src/MNH/turb_hor_splt.f90
@@ -10,9 +10,8 @@
!
INTERFACE
!
- SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP_UVW, &
- PTSTEP_MET, PTSTEP_SV,HLBCX,HLBCY, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
+ HLBCX,HLBCY,OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
HFMFILE,HLUOUT, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -32,9 +31,7 @@ INTEGER, INTENT(IN) :: KSPLIT ! number of time splitting
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, INTENT(IN) :: PTSTEP_UVW ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET ! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Timestep for tracer variables
+REAL, INTENT(IN) :: PTSTEP ! timestep
CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX,HLBCY
LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
! file opening
@@ -110,9 +107,8 @@ END INTERFACE
!
END MODULE MODI_TURB_HOR_SPLT
! ################################################################
- SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP_UVW, &
- PTSTEP_MET, PTSTEP_SV,HLBCX,HLBCY, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
+ HLBCX,HLBCY,OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
HFMFILE,HLUOUT, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -253,7 +249,6 @@ END MODULE MODI_TURB_HOR_SPLT
!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
!! Oct.2009 (C.Lac) Introduction of different PTSTEP according to the
!! advection schemes
-!! 06/2011 (J.escobar ) Bypass Bug with ifort11/12 on HLBCX,HLBC
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -281,9 +276,7 @@ INTEGER, INTENT(IN) :: KSPLIT ! number of time splitting
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, INTENT(IN) :: PTSTEP_UVW ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET ! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Timestep for tracer variables
+REAL, INTENT(IN) :: PTSTEP ! timestep
CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX,HLBCY
LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
! file opening
@@ -363,7 +356,7 @@ REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZMZM_PRHODJ ! MZM(PRHODJ)
!
INTEGER :: JSPLT ! current split
!
-INTEGER :: IKB, IKE, IIB, IIE, IJB, IJE,IKU
+INTEGER :: IKB, IKE, IIB, IIE, IJB, IJE, IKU
INTEGER :: JRR, JSV
!
INTEGER :: ISV
@@ -477,7 +470,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
DO JSPLT=1,KSPLIT
!
! compute the turbulent tendencies for the small time step
- CALL TURB_HOR(JSPLT, KRR, KRRL, KRRI, PTSTEP_UVW, &
+ CALL TURB_HOR(JSPLT, KRR, KRRL, KRRI, PTSTEP, &
OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
HFMFILE,HLUOUT, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
@@ -505,18 +498,18 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
!
! split temporal advance
- ZUM=PUM+(ZRUS/KSPLIT-PRUS)/MXM(PRHODJ)*PTSTEP_UVW
- ZVM=PVM+(ZRVS/KSPLIT-PRVS)/MYM(PRHODJ)*PTSTEP_UVW
- ZWM=PWM+(ZRWS/KSPLIT-PRWS)/ZMZM_PRHODJ*PTSTEP_UVW
+ ZUM=PUM+(ZRUS/KSPLIT-PRUS)/MXM(PRHODJ)*PTSTEP
+ ZVM=PVM+(ZRVS/KSPLIT-PRVS)/MYM(PRHODJ)*PTSTEP
+ ZWM=PWM+(ZRWS/KSPLIT-PRWS)/ZMZM_PRHODJ*PTSTEP
DO JSV=1,ISV
ZSVM(:,:,:,JSV)=PSVM(:,:,:,JSV)+ &
- (ZRSVS(:,:,:,JSV)/KSPLIT-PRSVS(:,:,:,JSV))/PRHODJ*PTSTEP_SV
+ (ZRSVS(:,:,:,JSV)/KSPLIT-PRSVS(:,:,:,JSV))/PRHODJ*PTSTEP
END DO
- ZTHLM=PTHLM+(ZRTHLS/KSPLIT-PRTHLS)/PRHODJ*PTSTEP_MET
- ZTKEM=ZTKEM+PTRH*PTSTEP_MET/KSPLIT
+ ZTHLM=PTHLM+(ZRTHLS/KSPLIT-PRTHLS)/PRHODJ*PTSTEP
+ ZTKEM=ZTKEM+PTRH*PTSTEP/KSPLIT
DO JRR=1,KRR
ZRM(:,:,:,JRR)=PRM(:,:,:,JRR)+ &
- (ZRRS(:,:,:,JRR)/KSPLIT-PRRS(:,:,:,JRR))/PRHODJ*PTSTEP_MET
+ (ZRRS(:,:,:,JRR)/KSPLIT-PRRS(:,:,:,JRR))/PRHODJ*PTSTEP
END DO
!
! reinforce boundary conditions
@@ -590,7 +583,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
IF (ISV>0) PRSVS=ZRSVS/KSPLIT
PRTHLS=ZRTHLS/KSPLIT
IF (KRR>0) PRRS=ZRRS/KSPLIT
- PTRH=(ZTKEM-PTKEM)/PTSTEP_MET
+ PTRH=(ZTKEM-PTKEM)/PTSTEP
!
!* 2.6 deallocations
! -------------
@@ -618,7 +611,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
!
ELSE
!
- CALL TURB_HOR(1, KRR, KRRL, KRRI, PTSTEP_UVW, &
+ CALL TURB_HOR(1, KRR, KRRL, KRRI, PTSTEP, &
OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
HFMFILE,HLUOUT, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
diff --git a/src/MNH/turb_ver.f90 b/src/MNH/turb_ver.f90
index 2cf598d01..3c0144806 100644
--- a/src/MNH/turb_ver.f90
+++ b/src/MNH/turb_ver.f90
@@ -13,8 +13,7 @@ INTERFACE
SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR,KRRL,KRRI, &
OCLOSE_OUT,OTURB_FLX, &
HTURBDIM,HTOM,PIMPL,PEXPL, &
- PTSTEP_UVW,PTSTEP_MET, PTSTEP_SV, &
- HFMFILE,HLUOUT, &
+ PTSTEP, HFMFILE,HLUOUT, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF, &
@@ -29,9 +28,6 @@ INTERFACE
PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
@@ -43,9 +39,7 @@ CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
CHARACTER*4, INTENT(IN) :: HTOM ! type of Third Order Moment
REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP_UVW ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET ! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Timestep for tracer variables
+REAL, INTENT(IN) :: PTSTEP ! timestep
CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
! FM-file
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
@@ -127,11 +121,10 @@ END MODULE MODI_TURB_VER
!
!
! ###############################################################
- SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
+ SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
OCLOSE_OUT,OTURB_FLX, &
HTURBDIM,HTOM,PIMPL,PEXPL, &
- PTSTEP_UVW,PTSTEP_MET, PTSTEP_SV, &
- HFMFILE,HLUOUT, &
+ PTSTEP, HFMFILE,HLUOUT, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF, &
@@ -272,7 +265,7 @@ END MODULE MODI_TURB_VER
!! XCTV,XCHV : cts for the T and moisture variances
!!
!! Module MODD_PARAMETERS
-!!
+!!
!! JPVEXT_TURB : number of vertical external points
!! JPHEXT : number of horizontal external points
!!
@@ -377,9 +370,7 @@ CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
CHARACTER*4, INTENT(IN) :: HTOM ! type of Third Order Moment
REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP_UVW ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET ! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Timestep for tracer variables
+REAL, INTENT(IN) :: PTSTEP ! timestep
CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
! FM-file
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
@@ -554,6 +545,7 @@ CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OCLOSE_OUT,OTURB_FLX, &
ZREDS1,ZRED2THS, ZRED2RS, &
ZBLL_O_E, &
ZETHETA, ZEMOIST )
+!
! Buoyancy coefficient
!
ZBETA = XG/PTHVREF
@@ -613,8 +605,7 @@ END IF
!
CALL TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- PTSTEP_MET, &
+ PIMPL,PEXPL,PTSTEP, &
HFMFILE,HLUOUT, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PRHODJ,PTHVREF, &
@@ -659,8 +650,7 @@ END IF
!
CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
OCLOSE_OUT,OTURB_FLX,KRR, &
- HTURBDIM,PIMPL,PEXPL, &
- PTSTEP_UVW, &
+ HTURBDIM,PIMPL,PEXPL,PTSTEP, &
HFMFILE,HLUOUT, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
@@ -680,8 +670,7 @@ CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
IF (SIZE(PSVM,4)>0) &
CALL TURB_VER_SV_FLUX(KKA,KKU,KKL, &
OCLOSE_OUT,OTURB_FLX,HTURBDIM, &
- PIMPL,PEXPL, &
- PTSTEP_SV, &
+ PIMPL,PEXPL,PTSTEP, &
HFMFILE,HLUOUT, &
PDZZ,PDIRCOSZW, &
PRHODJ,PWM, &
diff --git a/src/MNH/two_wayn.f90 b/src/MNH/two_wayn.f90
index 9b48a6507..89bb1818f 100644
--- a/src/MNH/two_wayn.f90
+++ b/src/MNH/two_wayn.f90
@@ -217,10 +217,8 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
CALL GO_TOMODEL_ll(KMI, IINFO_ll)
CALL GET_CHILD_DIM_ll(IMI, IDIMX, IDIMY, IINFO_ll)
!
-!JUAN
! here we need to go back to SON domain for boundaries test
CALL GO_TOMODEL_ll(IMI, IINFO_ll)
-!JUAN
!
IKU = SIZE(PTHM,3)
IKB = JPVEXT+1
@@ -328,7 +326,7 @@ DO JX=1,IDXRATIO
IJ2 = IJE+JY-IDYRATIO
ZTTHM(3:IDIMX-2,3:IDIMY-2,:) = ZTTHM(3:IDIMX-2,3:IDIMY-2,:) &
+XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
- *XTHM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
+ *XTHT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
!
END DO
END DO
@@ -346,7 +344,7 @@ DO JVAR=1,IRR
IJ2 = IJE+JY-IDYRATIO
ZTRM(3:IDIMX-2,3:IDIMY-2,:,JVAR) = ZTRM(3:IDIMX-2,3:IDIMY-2,:,JVAR) &
+XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
- *XRM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR)
+ *XRT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR)
END DO
END DO
END DO
@@ -365,7 +363,7 @@ IF (KSV /= 0) THEN
IJ2 = IJE+JY-IDYRATIO
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR) = ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR) &
+XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
- *XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR)
+ *XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR)
END DO
END DO
END DO
@@ -383,7 +381,7 @@ IF (NSV_C2R2_A(IMI) > 0) THEN
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_C2R2BEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_C2R2BEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_C2R2BEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_C2R2BEG_A(IMI))
END DO
END DO
END DO
@@ -402,7 +400,7 @@ IF (NSV_C1R3_A(IMI) > 0) THEN
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_C1R3BEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_C1R3BEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_C1R3BEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_C1R3BEG_A(IMI))
END DO
END DO
END DO
@@ -421,7 +419,7 @@ IF (NSV_ELEC_A(IMI) > 0) THEN
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_ELECBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_ELECBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_ELECBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_ELECBEG_A(IMI))
END DO
END DO
END DO
@@ -438,7 +436,7 @@ DO JVAR=1,NSV_CHEM_A(KMI)
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_CHEMBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_CHEMBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CHEMBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CHEMBEG_A(IMI))
END DO
END DO
END DO
@@ -456,7 +454,7 @@ IF (NSV_CHIC_A(IMI) > 0) THEN
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_CHICBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_CHICBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CHICBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CHICBEG_A(IMI))
END DO
END DO
END DO
@@ -473,7 +471,7 @@ DO JVAR=1,NSV_LNOX_A(KMI)
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_LNOXBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_LNOXBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_LNOXBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_LNOXBEG_A(IMI))
END DO
END DO
END DO
@@ -489,7 +487,7 @@ DO JVAR=1,NSV_AER_A(KMI)
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_AERBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_AERBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_AERBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_AERBEG_A(IMI))
END DO
END DO
END DO
@@ -504,7 +502,7 @@ DO JVAR=1,NSV_AERDEP_A(KMI)
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_AERDEPBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_AERDEPBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_AERDEPBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_AERDEPBEG_A(IMI))
END DO
END DO
END DO
@@ -520,7 +518,7 @@ DO JVAR=1,NSV_DST_A(KMI)
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_DSTBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_DSTBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_DSTBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_DSTBEG_A(IMI))
END DO
END DO
END DO
@@ -535,7 +533,7 @@ DO JVAR=1,NSV_DSTDEP_A(KMI)
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_DSTDEPBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_DSTDEPBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_DSTDEPBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_DSTDEPBEG_A(IMI))
END DO
END DO
END DO
@@ -551,7 +549,7 @@ DO JVAR=1,NSV_SLT_A(KMI)
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_SLTBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_SLTBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_SLTBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_SLTBEG_A(IMI))
END DO
END DO
END DO
@@ -566,7 +564,7 @@ DO JVAR=1,NSV_SLTDEP_A(KMI)
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_SLTDEPBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_SLTDEPBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_SLTDEPBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_SLTDEPBEG_A(IMI))
END DO
END DO
END DO
@@ -582,7 +580,7 @@ DO JVAR=1,NSV_LG_A(KMI)
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_LGBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_LGBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_LGBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_LGBEG_A(IMI))
END DO
END DO
END DO
@@ -600,7 +598,7 @@ DO JVAR=1,NSV_PP_A(KMI)
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_PPBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_PPBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_PPBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_PPBEG_A(IMI))
END DO
END DO
END DO
@@ -618,7 +616,7 @@ DO JVAR=1,NSV_CS_A(KMI)
ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_CSBEG_A(KMI)) = &
&ZTSVM(3:IDIMX-2,3:IDIMY-2,:,JVAR-1+NSV_CSBEG_A(KMI))+&
&XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CSBEG_A(IMI))
+ &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CSBEG_A(IMI))
END DO
END DO
END DO
@@ -758,12 +756,12 @@ DO JX=1,IDXRATIO
IJ2 = IJE+JY-IDYRATIO
ZTWM(3:IDIMX-2,3:IDIMY-2,IKB) = ZTWM(3:IDIMX-2,3:IDIMY-2,IKB) &
+2.*XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB) &
- *XWM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB)
+ *XWT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB)
!
ZTWM(3:IDIMX-2,3:IDIMY-2,IKB+1:IKU) = ZTWM(3:IDIMX-2,3:IDIMY-2,IKB+1:IKU) &
+(XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB+1:IKU ) &
+ XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB :IKU-1))&
- *XWM(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB+1:IKU)
+ *XWT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB+1:IKU)
END DO
END DO
!
@@ -797,7 +795,7 @@ DO JY=1,IDYRATIO
ZTUM(IWEST:IDIMX-2,3:IDIMY-2,:) = ZTUM(IWEST:IDIMX-2,3:IDIMY-2,:) &
+(XRHODJ(II1U :II2 :IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
+XRHODJ(II1U-1:II2-1:IDXRATIO,IJ1:IJ2:IDYRATIO,:)) &
- *XUM(II1U :II2 :IDXRATIO,IJ1:IJ2:IDYRATIO,:)
+ *XUT(II1U :II2 :IDXRATIO,IJ1:IJ2:IDYRATIO,:)
END DO
!
!
@@ -831,7 +829,7 @@ DO JX=1,IDXRATIO
ZTVM(3:IDIMX-2,ISOUTH:IDIMY-2,:) = ZTVM(3:IDIMX-2,ISOUTH:IDIMY-2,:) &
+(XRHODJ(II1:II2:IDXRATIO,IJ1V :IJ2 :IDYRATIO,:) &
+ XRHODJ(II1:II2:IDXRATIO,IJ1V-1:IJ2-1:IDYRATIO,:)) &
- *XVM(II1:II2:IDXRATIO,IJ1V :IJ2 :IDYRATIO,:)
+ *XVT(II1:II2:IDXRATIO,IJ1V :IJ2 :IDYRATIO,:)
END DO
!
!
diff --git a/src/MNH/ver_dyn.f90 b/src/MNH/ver_dyn.f90
index a341f6344..3566b1c7a 100644
--- a/src/MNH/ver_dyn.f90
+++ b/src/MNH/ver_dyn.f90
@@ -2,6 +2,7 @@
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$
+! MASDEV4_7 prep_real 2006/07/07 12:19:27
!-----------------------------------------------------------------
! ######spl
MODULE MODI_VER_DYN
@@ -139,13 +140,12 @@ USE MODI_VER_INTERP_LIN
USE MODI_WGUESS
USE MODI_VER_SHIFT
USE MODI_VER_INT_DYN
-USE MODI_ANEL_BALANCE_n
USE MODI_SHUMAN
!
USE MODD_CONF ! declaration modules
USE MODD_CST
USE MODD_LUNIT
-USE MODD_FIELD_n, ONLY: XUM,XVM,XWM,XPABSM,XTHM,XRM
+USE MODD_FIELD_n, ONLY: XUT,XVT,XWT,XPABST,XTHT,XRT
USE MODD_LSFIELD_n
USE MODD_LBC_n
USE MODD_REF_n
@@ -153,12 +153,10 @@ USE MODD_DYN_n
USE MODD_GRID_n
USE MODD_PARAMETERS
USE MODD_VER_INTERP_LIN
-!JUAN REALZ
USE MODD_DIM_n
USE MODE_MPPDB
USE MODE_ll
USE MODE_EXTRAPOL
-!JUAN REALZ
!
IMPLICIT NONE
!
@@ -213,7 +211,6 @@ INTEGER :: IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU ! dimensions of the
INTEGER :: IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2 ! West-east LB arrays
INTEGER :: IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV ! dimensions of the
INTEGER :: IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2 ! North-south LB arrays
-
!-------------------------------------------------------------------------------
!
IIB=JPHEXT+1
@@ -267,18 +264,18 @@ CALL MPPDB_CHECK3D(ZRHODJV,"VERDYN::ZRHODJV",PRECISION)
!* 4. STORAGE IN MODD_FIELD1
! ----------------------
!
-ALLOCATE(XUM(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
-ALLOCATE(XVM(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
-ALLOCATE(XWM(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
+ALLOCATE(XUT(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
+ALLOCATE(XVT(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
+ALLOCATE(XWT(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
!
-ZRHOD(:,:,:)=XPABSM(:,:,:)/(XPABSM(:,:,:)/XP00)**(XRD/XCPD) &
- /(XRD*XTHM(:,:,:)*(1.+XRV/XRD*XRM(:,:,:,1)))
+ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
+ /(XRD*XTHT(:,:,:)*(1.+XRV/XRD*XRT(:,:,:,1)))
!
-XUM(:,:,:)=ZRHODJU(:,:,:)/MXM(ZRHOD(:,:,:)*PJ(:,:,:))
-XVM(:,:,:)=ZRHODJV(:,:,:)/MYM(ZRHOD(:,:,:)*PJ(:,:,:))
+XUT(:,:,:)=ZRHODJU(:,:,:)/MXM(ZRHOD(:,:,:)*PJ(:,:,:))
+XVT(:,:,:)=ZRHODJV(:,:,:)/MYM(ZRHOD(:,:,:)*PJ(:,:,:))
-CALL EXTRAPOL('W',XUM)
-CALL EXTRAPOL('S',XVM)
+CALL EXTRAPOL('W',XUT)
+CALL EXTRAPOL('S',XVT)
!
!
@@ -311,7 +308,7 @@ END IF
!
ZZFLUX_SH(:,:,:)=VER_SHIFT(PZFLUX_MX,PZS_LS,XZS)
CALL COEF_VER_INTERP_LIN(ZZFLUX_SH(:,:,:),XZZ(:,:,:))
-XWM(:,:,:)=VER_INTERP_LIN(PW_MX(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+XWT(:,:,:)=VER_INTERP_LIN(PW_MX(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
!
IF ( HATMFILETYPE == 'MESONH' ) THEN
ALLOCATE(XLSWM(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
@@ -325,19 +322,19 @@ DEALLOCATE(XCOEFLIN)
!
ZCOEF(:,:,:)=( XZZ(:,:,:) -SPREAD(XZZ(:,:,IKB),3,IKU)) &
/(SPREAD(XZZ(:,:,IKE+1),3,IKU)-SPREAD(XZZ(:,:,IKB),3,IKU))
-XWM(:,:,:)=XWM(:,:,:)*MAX(MIN( (4.-4.*ZCOEF(:,:,:)) ,1.),0.)
+XWT(:,:,:)=XWT(:,:,:)*MAX(MIN( (4.-4.*ZCOEF(:,:,:)) ,1.),0.)
!-------------------------------------------------------------------------------
!
!* 6. STORAGE OF LARGE SCALE FIELDS
! ------------------------------
!
IF ( HATMFILETYPE == 'GRIBEX' ) THEN
- ALLOCATE(XLSUM(SIZE(XUM,1),SIZE(XUM,2),SIZE(XUM,3)))
- ALLOCATE(XLSVM(SIZE(XVM,1),SIZE(XVM,2),SIZE(XVM,3)))
- ALLOCATE(XLSWM(SIZE(XWM,1),SIZE(XWM,2),SIZE(XWM,3)))
- XLSUM(:,:,:)=XUM(:,:,:)
- XLSVM(:,:,:)=XVM(:,:,:)
- XLSWM(:,:,:)=XWM(:,:,:)
+ ALLOCATE(XLSUM(SIZE(XUT,1),SIZE(XUT,2),SIZE(XUT,3)))
+ ALLOCATE(XLSVM(SIZE(XVT,1),SIZE(XVT,2),SIZE(XVT,3)))
+ ALLOCATE(XLSWM(SIZE(XWT,1),SIZE(XWT,2),SIZE(XWT,3)))
+ XLSUM(:,:,:)=XUT(:,:,:)
+ XLSVM(:,:,:)=XVT(:,:,:)
+ XLSWM(:,:,:)=XWT(:,:,:)
END IF
! enforce zero gradient along the vertical under and above the vertical
! boundaries
@@ -353,8 +350,6 @@ CALL EXTRAPOL('E',XLSUM)
CALL EXTRAPOL('S',XLSVM)
CALL EXTRAPOL('E',XLSVM)
-
-
! FROM PREP_IDEAL_CASE
!
! 3D case
@@ -397,98 +392,31 @@ CALL EXTRAPOL('E',XLSVM)
ILBX=SIZE(XLBXUM,1)
ILBY=SIZE(XLBYUM,2)
IF(LWEST_ll() .AND. .NOT. L1D) THEN
- XLBXUM(1:NRIMX+1, :,:) = XUM(2:NRIMX+2, :,:)
- XLBXVM(1:NRIMX+1, :,:) = XVM(1:NRIMX+1, :,:)
- XLBXWM(1:NRIMX+1, :,:) = XWM(1:NRIMX+1, :,:)
+ XLBXUM(1:NRIMX+1, :,:) = XUT(2:NRIMX+2, :,:)
+ XLBXVM(1:NRIMX+1, :,:) = XVT(1:NRIMX+1, :,:)
+ XLBXWM(1:NRIMX+1, :,:) = XWT(1:NRIMX+1, :,:)
ENDIF
IF(LEAST_ll() .AND. .NOT. L1D) THEN
- XLBXUM(ILBX-NRIMX:ILBX,:,:) = XUM(IIU-NRIMX:IIU, :,:)
- XLBXVM(ILBX-NRIMX:ILBX,:,:) = XVM(IIU-NRIMX:IIU, :,:)
- XLBXWM(ILBX-NRIMX:ILBX,:,:) = XWM(IIU-NRIMX:IIU, :,:)
+ XLBXUM(ILBX-NRIMX:ILBX,:,:) = XUT(IIU-NRIMX:IIU, :,:)
+ XLBXVM(ILBX-NRIMX:ILBX,:,:) = XVT(IIU-NRIMX:IIU, :,:)
+ XLBXWM(ILBX-NRIMX:ILBX,:,:) = XWT(IIU-NRIMX:IIU, :,:)
ENDIF
IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) THEN
- XLBYUM(:,1:NRIMY+1, :) = XUM(:,1:NRIMY+1, :)
- XLBYVM(:,1:NRIMY+1, :) = XVM(:,2:NRIMY+2, :)
- XLBYWM(:,1:NRIMY+1, :) = XWM(:,1:NRIMY+1, :)
+ XLBYUM(:,1:NRIMY+1, :) = XUT(:,1:NRIMY+1, :)
+ XLBYVM(:,1:NRIMY+1, :) = XVT(:,2:NRIMY+2, :)
+ XLBYWM(:,1:NRIMY+1, :) = XWT(:,1:NRIMY+1, :)
ENDIF
IF(LNORTH_ll().AND. .NOT. L1D .AND. .NOT. L2D) THEN
- XLBYUM(:,ILBY-NRIMY:ILBY,:) = XUM(:,IJU-NRIMY:IJU, :)
- XLBYVM(:,ILBY-NRIMY:ILBY,:) = XVM(:,IJU-NRIMY:IJU, :)
- XLBYWM(:,ILBY-NRIMY:ILBY,:) = XWM(:,IJU-NRIMY:IJU, :)
+ XLBYUM(:,ILBY-NRIMY:ILBY,:) = XUT(:,IJU-NRIMY:IJU, :)
+ XLBYVM(:,ILBY-NRIMY:ILBY,:) = XVT(:,IJU-NRIMY:IJU, :)
+ XLBYWM(:,ILBY-NRIMY:ILBY,:) = XWT(:,IJU-NRIMY:IJU, :)
ENDIF
-!!$IF ( LHORELAX_UVWTH ) THEN
-!!$ ALLOCATE(XLBXUM(2*NRIMX+2,IJU,IKU))
-!!$ ALLOCATE(XLBYUM(IIU,2*NRIMY+2,IKU))
-!!$ ALLOCATE(XLBXVM(2*NRIMX+2,IJU,IKU))
-!!$ ALLOCATE(XLBYVM(IIU,2*NRIMY+2,IKU))
-!!$ ALLOCATE(XLBXWM(2*NRIMX+2,IJU,IKU))
-!!$ ALLOCATE(XLBYWM(IIU,2*NRIMY+2,IKU))
-!!$ELSE
-!!$ ALLOCATE(XLBXUM(4,IJU,IKU))
-!!$ ALLOCATE(XLBYUM(IIU,2,IKU))
-!!$ ALLOCATE(XLBXVM(2,IJU,IKU))
-!!$ ALLOCATE(XLBYVM(IIU,4,IKU))
-!!$ ALLOCATE(XLBXWM(2,IJU,IKU))
-!!$ ALLOCATE(XLBYWM(IIU,2,IKU))
-!!$END IF
-
-
!
-!!$NSIZELBX_ll=SIZE(XLBXWM,1)
-!!$NSIZELBXU_ll=SIZE(XLBXUM,1)
-!!$NSIZELBY_ll=SIZE(XLBYWM,2)
-!!$NSIZELBYV_ll=SIZE(XLBYVM,2)
-!!$!
-!!$!
-!!$ILBX=SIZE(XLBXUM,1)/2-1
-!!$ILBY=SIZE(XLBYUM,2)/2-1
-!!$!
-!!$IF(LWEST_ll() .AND. .NOT. L1D) THEN
-!!$ XLBXUM(1:ILBX+1,:,:) = XUM( IIB:IIB+ILBX ,:,:)
-!!$ XLBXVM(1:ILBX+1,:,:) = XVM(IIB-1:IIB-1+ILBX,:,:)
-!!$ XLBXWM(1:ILBX+1,:,:) = XWM(IIB-1:IIB-1+ILBX,:,:)
-!!$ENDIF
-!!$!
-!!$!
-!!$!
-!!$ILBX=SIZE(XLBXVM,1)/2-1
-!!$ILBY=SIZE(XLBYVM,2)/2-1
-!!$!
-!!$IF(LEAST_ll() .AND. .NOT. L1D) THEN
-!!$ XLBXUM(ILBX+2:2*ILBX+2,:,:) = XUM(IIE+1-ILBX:IIE+1,:,:)
-!!$ XLBXVM(ILBX+2:2*ILBX+2,:,:) = XVM(IIE+1-ILBX:IIE+1,:,:)
-!!$ XLBXWM(ILBX+2:2*ILBX+2,:,:) = XWM(IIE+1-ILBX:IIE+1,:,:)
-!!$END IF
-!!$!
-!!$!
-!!$ILBX=SIZE(XLBXWM,1)/2-1
-!!$ILBY=SIZE(XLBYWM,2)/2-1
-!!$!
-!!$IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) THEN
-!!$ XLBYUM(:,1:ILBY+1,:) = XUM(:,IJB-1:IJB-1+ILBY,:)
-!!$ XLBYVM(:,1:ILBY+1,:) = XVM(:,IJB :IJB+ILBY ,:)
-!!$ XLBYWM(:,1:ILBY+1,:) = XWM(:,IJB-1:IJB-1+ILBY,:)
-!!$ENDIF
-!!$
-!!$IF(LNORTH_ll().AND. .NOT. L1D .AND. .NOT. L2D) THEN
-!!$ XLBYUM(:,ILBY+2:2*ILBY+2,:) = XUM(:,IJE+1-ILBY:IJE+1,:)
-!!$ XLBYVM(:,ILBY+2:2*ILBY+2,:) = XVM(:,IJE+1-ILBY:IJE+1,:)
-!!$ XLBYWM(:,ILBY+2:2*ILBY+2,:) = XWM(:,IJE+1-ILBY:IJE+1,:)
-!!$END IF
-
-CALL MPPDB_CHECKLB(XLBXUM,"ver_dyn::XLBXUM::",PRECISION,'LBXU',NRIMX)
-CALL MPPDB_CHECKLB(XLBXVM,"ver_dyn::XLBXVM::",PRECISION,'LBXU',NRIMX)
-CALL MPPDB_CHECKLB(XLBXWM,"ver_dyn::XLBXWM::",PRECISION,'LBXU',NRIMX)
-
-
-CALL MPPDB_CHECKLB(XLBYUM,"ver_dyn::XLBYUM::",PRECISION,'LBYV',NRIMY)
-CALL MPPDB_CHECKLB(XLBYVM,"ver_dyn::XLBYVM::",PRECISION,'LBYV',NRIMY)
-CALL MPPDB_CHECKLB(XLBYWM,"ver_dyn::XLBYWM::",PRECISION,'LBYV',NRIMY)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ver_interp_field.f90 b/src/MNH/ver_interp_field.f90
index 37b0b3bd2..61a6e6ee0 100644
--- a/src/MNH/ver_interp_field.f90
+++ b/src/MNH/ver_interp_field.f90
@@ -11,9 +11,8 @@ MODULE MODI_VER_INTERP_FIELD
INTERFACE
!
SUBROUTINE VER_INTERP_FIELD(HTURB,KRR,KSV,PZZ_LS,PZZ, &
- PUM,PVM,PWM,PTHVM,PRM,PHUM,PTKEM,PSVM, &
PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT, &
- PSRCM,PSRCT,PSIGS, &
+ PSRCT,PSIGS, &
PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM )
!
CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
@@ -22,17 +21,12 @@ INTEGER, INTENT(IN) :: KSV ! number of scalar variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ_LS ! initial 3D grid
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! new 3D grid
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM ! model 2
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTKEM ! variables
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRM,PSVM ! at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHVM,PHUM !
-!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT ! model 2
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTKET ! variables
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT ! at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHVT,PHUT !
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRCM,PSRCT,PSIGS ! secondary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRCT,PSIGS ! secondary
! prognostic variables
! Larger Scale fields
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM, PLSVM, PLSWM ! Wind
@@ -45,9 +39,8 @@ END MODULE MODI_VER_INTERP_FIELD
!
! ##########################################################################
SUBROUTINE VER_INTERP_FIELD(HTURB,KRR,KSV,PZZ_LS,PZZ, &
- PUM,PVM,PWM,PTHVM,PRM,PHUM,PTKEM,PSVM, &
PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT, &
- PSRCM,PSRCT,PSIGS, &
+ PSRCT,PSIGS, &
PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM )
! ##########################################################################
!
@@ -113,17 +106,12 @@ INTEGER, INTENT(IN) :: KSV ! number of scalar variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ_LS ! initial 3D grid
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! new 3D grid
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM ! model 2
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTKEM ! variables
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRM,PSVM ! at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHVM,PHUM !
-!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT ! model 2
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTKET ! variables
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT ! at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHVT,PHUT !
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRCM,PSRCT,PSIGS ! secondary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRCT,PSIGS ! secondary
! prognostic variables
! Larger Scale fields
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM, PLSVM, PLSWM ! Wind
@@ -166,7 +154,6 @@ ZGRID2(1,:,:)=2.*ZGRID2(2,:,:)-ZGRID2(3,:,:)
!
CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
!
-PUM (:,:,:) = VER_INTERP_LIN(PUM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PUT (:,:,:) = VER_INTERP_LIN(PUT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PLSUM (:,:,:) = VER_INTERP_LIN(PLSUM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
!
@@ -188,7 +175,6 @@ ZGRID2(:,1,:)=2.*ZGRID2(:,2,:)-ZGRID2(:,3,:)
!
CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
!
-PVM (:,:,:) = VER_INTERP_LIN(PVM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PVT (:,:,:) = VER_INTERP_LIN(PVT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PLSVM (:,:,:) = VER_INTERP_LIN(PLSVM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
!
@@ -202,7 +188,6 @@ ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
!
CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
!
-PWM (:,:,:) = VER_INTERP_LIN(PWM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PWT (:,:,:) = VER_INTERP_LIN(PWT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PLSWM (:,:,:) = VER_INTERP_LIN(PLSWM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
!
@@ -217,7 +202,6 @@ ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
!
CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
!
-PTHVM (:,:,:) = VER_INTERP_LIN(PTHVM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PTHVT (:,:,:) = VER_INTERP_LIN(PTHVT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PLSTHM(:,:,:) = VER_INTERP_LIN(PLSTHM(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
!
@@ -232,16 +216,12 @@ END IF
! ---------------
!
DO JRR=1,KRR
- PRM (:,:,:,JRR) = VER_INTERP_LIN(PRM (:,:,:,JRR),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PRT (:,:,:,JRR) = VER_INTERP_LIN(PRT (:,:,:,JRR),NKLIN(:,:,:),XCOEFLIN(:,:,:))
- PRM (:,:,:,JRR) = MAX(PRM(:,:,:,JRR),0.)
PRT (:,:,:,JRR) = MAX(PRT(:,:,:,JRR),0.)
END DO
!
IF (CONF_MODEL(1)%NRR>=1) THEN
- PHUM(:,:,:) = VER_INTERP_LIN(PHUM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PHUT(:,:,:) = VER_INTERP_LIN(PHUT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
- PHUM(:,:,:) = MIN(MAX(PHUM(:,:,:),0.),100.)
PHUT(:,:,:) = MIN(MAX(PHUT(:,:,:),0.),100.)
END IF
!
@@ -251,9 +231,7 @@ END IF
! ----------------
!
DO JSV=1,KSV
- PSVM (:,:,:,JSV) = VER_INTERP_LIN(PSVM (:,:,:,JSV),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PSVT (:,:,:,JSV) = VER_INTERP_LIN(PSVT (:,:,:,JSV),NKLIN(:,:,:),XCOEFLIN(:,:,:))
- PSVM (:,:,:,JSV) = MAX(PSVM(:,:,:,JSV),0.)
PSVT (:,:,:,JSV) = MAX(PSVT(:,:,:,JSV),0.)
END DO
!
@@ -273,9 +251,7 @@ ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
!
IF (HTURB /= 'NONE') THEN
- PTKEM(:,:,:) = VER_INTERP_LIN(PTKEM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PTKET(:,:,:) = VER_INTERP_LIN(PTKET (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
- PTKEM=MAX(PTKEM,XTKEMIN)
PTKET=MAX(PTKET,XTKEMIN)
ENDIF
!
@@ -286,7 +262,6 @@ ENDIF
! ------------------------------
!
IF (KRR > 1 .AND. HTURB /= 'NONE') THEN
- PSRCM (:,:,:) = VER_INTERP_LIN(PSRCM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PSRCT (:,:,:) = VER_INTERP_LIN(PSRCT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
PSIGS (:,:,:) = VER_INTERP_LIN(PSIGS (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
ENDIF
diff --git a/src/MNH/ver_thermo.f90 b/src/MNH/ver_thermo.f90
index 96cf37ae1..6dd494a03 100644
--- a/src/MNH/ver_thermo.f90
+++ b/src/MNH/ver_thermo.f90
@@ -2,6 +2,7 @@
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$
+! MASDEV4_7 prep_real 2006/07/07 12:04:57
!-----------------------------------------------------------------
! ######spl
MODULE MODI_VER_THERMO
@@ -157,7 +158,7 @@ USE MODD_CONF ! declaration modules
USE MODD_CONF_n
USE MODD_LUNIT
USE MODD_CST
-USE MODD_FIELD_n, ONLY: XTHM,XRM,XPABSM,XDRYMASST
+USE MODD_FIELD_n, ONLY: XTHT,XRT,XPABST,XDRYMASST
USE MODD_LSFIELD_n
USE MODD_DYN_n
USE MODD_REF_n
@@ -169,12 +170,10 @@ USE MODD_PARAMETERS
!
USE MODE_FMWRIT
USE MODE_FM
-!JUAN REALZ
USE MODD_DIM_n
USE MODE_MPPDB
USE MODE_ll
USE MODE_EXTRAPOL
-!JUAN REALZ
!
!
IMPLICIT NONE
@@ -218,7 +217,6 @@ REAL,DIMENSION(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)) :: ZRHOD,ZSUMRT
CHARACTER(LEN=100) :: YCOMMENT
INTEGER :: ILENCH ! ILENCH : length of comment string
CHARACTER(LEN=16) :: YRECFM
-!JUAN REALZ
INTEGER :: IINFO_ll
TYPE(LIST_ll), POINTER :: TZFIELDS_ll => NULL() ! list of fields to exchange
!
@@ -227,7 +225,6 @@ INTEGER :: IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2 ! West-east LB arrays
INTEGER :: IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV ! dimensions of the
INTEGER :: IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2 ! North-south LB arrays
-!JUAN REALZ
!-------------------------------------------------------------------------------
!
IIB=JPHEXT+1
@@ -245,8 +242,8 @@ IKU=SIZE(PJ,3)
!* 1. SHIFT AND INTERPOLATION TO MESONH GRID
! --------------------------------------
!
-ALLOCATE(XTHM(IIU,IJU,IKU))
-ALLOCATE(XRM(IIU,IJU,IKU,NRR))
+ALLOCATE(XTHT(IIU,IJU,IKU))
+ALLOCATE(XRT(IIU,IJU,IKU,NRR))
CALL MPPDB_CHECK3D(PTHV_MX,"ver_thermo:PTHV_MX",PRECISION)
CALL MPPDB_CHECK3D(PR_MX(:,:,:,1),"ver_thermo:PR_MX",PRECISION)
@@ -265,32 +262,29 @@ IF ( PRESENT(PLSTH_MX)) THEN
CALL MPPDB_CHECK3D(PLSRV_MX,"PLSRV_MX",PRECISION)
!
CALL VER_INT_THERMO(OSHIFT,PTHV_MX,PR_MX,PZS_LS,PZSMT_LS,PZMASS_MX,PZFLUX_MX,PPMHP_MX,PEXNTOP2D, &
- ZTHV,XRM,ZPMHP,PDIAG,PLSTH_MX,PLSRV_MX,XLSTHM,XLSRVM)
+ ZTHV,XRT,ZPMHP,PDIAG,PLSTH_MX,PLSRV_MX,XLSTHM,XLSRVM)
ELSE
CALL VER_INT_THERMO(OSHIFT,PTHV_MX,PR_MX,PZS_LS,PZSMT_LS,PZMASS_MX,PZFLUX_MX,PPMHP_MX,PEXNTOP2D, &
- ZTHV,XRM,ZPMHP,PDIAG)
+ ZTHV,XRT,ZPMHP,PDIAG)
END IF
!
-XTHM(:,:,:)=ZTHV(:,:,:)*(1.+WATER_SUM(XRM(:,:,:,:)))/(1.+XRV/XRD*XRM(:,:,:,1))
+XTHT(:,:,:)=ZTHV(:,:,:)*(1.+WATER_SUM(XRT(:,:,:,:)))/(1.+XRV/XRD*XRT(:,:,:,1))
!
ZTHV(:,:,1)=ZTHV(:,:,2)
-XTHM(:,:,1)=XTHM(:,:,2)
-XRM(:,:,1,:)=XRM(:,:,2,:)
+XTHT(:,:,1)=XTHT(:,:,2)
+XRT(:,:,1,:)=XRT(:,:,2,:)
!
IF (NRR>=3) THEN
- WHERE (XRM(:,:,:,3)<1.E-20)
- XRM(:,:,:,3)=0.
+ WHERE (XRT(:,:,:,3)<1.E-20)
+ XRT(:,:,:,3)=0.
END WHERE
END IF
+CALL EXTRAPOL('E',XTHT)
-!CALL EXTRAPOL('W',XTHM)
-!CALL EXTRAPOL('S',XTHM)
-CALL EXTRAPOL('E',XTHM)
+CALL MPPDB_CHECK3D(XTHT,"VERTHERMO::XTHT",PRECISION)
-CALL MPPDB_CHECK3D(XTHM,"VERTHERMO::XTHM",PRECISION)
-
-DO JRR=1,SIZE(XRM,4)
- CALL EXTRAPOL('E',XRM(:,:,:,JRR))
+DO JRR=1,SIZE(XRT,4)
+ CALL EXTRAPOL('E',XRT(:,:,:,JRR))
END DO
!
IF (NVERB>=10) THEN
@@ -304,10 +298,10 @@ END IF
!* 2. COMPUTATION OF 1D REFERENCE STATE VARIABLES
! -------------------------------------------
!
-CALL SET_REFZ(ZTHV,XRM(:,:,:,1))
+CALL SET_REFZ(ZTHV,XRT(:,:,:,1))
CALL MPPDB_CHECK3D(ZTHV,"VERTHERMO::ZTHV",PRECISION)
-CALL MPPDB_CHECK3D(XRM(:,:,:,1),"VERTHERMO::XRM",PRECISION)
+CALL MPPDB_CHECK3D(XRT(:,:,:,1),"VERTHERMO::XRT",PRECISION)
!
!-------------------------------------------------------------------------------
!
@@ -337,7 +331,6 @@ CALL MPPDB_CHECK3D(XRVREF,"VERTHERMO::XRVREF",PRECISION)
CALL MPPDB_CHECK3D(XEXNREF,"VERTHERMO::XEXNREF",PRECISION)
CALL MPPDB_CHECK3D(XRHODJ,"VERTHERMO::XRHODJ",PRECISION)
-
!
!-------------------------------------------------------------------------------
!
@@ -349,10 +342,10 @@ CALL COMPUTE_EXNER_FROM_TOP(ZTHV,XZZ,PEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
PPSURF(:,:) = 1.5*ZPMHP(:,:,JPVEXT+1) - 0.5*ZPMHP(:,:,JPVEXT+2) &
+ XP00*ZHEXNFLUX(:,:,JPVEXT+1) ** (XCPD/XRD)
!
-ALLOCATE(XPABSM(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
-XPABSM(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
+ALLOCATE(XPABST(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)))
+XPABST(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
-CALL EXTRAPOL('E',XPABSM)
+CALL EXTRAPOL('E',XPABST)
!
!-------------------------------------------------------------------------------
!
@@ -360,11 +353,11 @@ CALL EXTRAPOL('E',XPABSM)
! -----------------------------
!
ZSUMRT(:,:,:) = 0.
-DO JRR=1,SIZE(XRM,4)
- ZSUMRT(:,:,:) = ZSUMRT(:,:,:) + XRM(:,:,:,JRR)
+DO JRR=1,SIZE(XRT,4)
+ ZSUMRT(:,:,:) = ZSUMRT(:,:,:) + XRT(:,:,:,JRR)
END DO
!
-ZRHOD(:,:,:)=XPABSM(:,:,:)/(XPABSM(:,:,:)/XP00)**(XRD/XCPD) &
+ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
/(XRD*ZTHV(:,:,:)*(1.+ZSUMRT(:,:,:)))
!
CALL TOTAL_DMASS(CLUOUT0,PJ,ZRHOD,XDRYMASST)
@@ -386,8 +379,8 @@ CALL TOTAL_DMASS(CLUOUT0,PJ,ZRHOD,XDRYMASST)
IF ( .NOT. PRESENT(PLSTH_MX) ) THEN
ALLOCATE(XLSTHM(IIU,IJU,IKU))
ALLOCATE(XLSRVM(IIU,IJU,IKU))
- XLSTHM=XTHM
- XLSRVM=XRM(:,:,:,1)
+ XLSTHM=XTHT
+ XLSRVM=XRT(:,:,:,1)
END IF
! copy at the external levels
XLSTHM(:,:,IKB-1)=XLSTHM(:,:,IKB)
@@ -404,8 +397,6 @@ IF ( LHORELAX_UVWTH ) THEN
NSIZELBYV_ll=2*NRIMY+2
ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,IKU))
ALLOCATE(XLBYTHM(IISIZEYF,IJSIZEYF,IKU))
-!!$ ALLOCATE(XLBXTHM(2*NRIMX+2,IJU,IKU))
-!!$ ALLOCATE(XLBYTHM(IIU,2*NRIMY+2,IKU))
ELSE
NSIZELBX_ll=2
NSIZELBXU_ll=4
@@ -413,26 +404,24 @@ ELSE
NSIZELBYV_ll=4
ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,IKU))
ALLOCATE(XLBYTHM(IISIZEY2,IJSIZEY2,IKU))
-!!$ ALLOCATE(XLBXTHM(2,IJU,IKU))
-!!$ ALLOCATE(XLBYTHM(IIU,2,IKU))
END IF
!
-!!$ILBX=SIZE(XLBXTHM,1)/2-1
-!!$XLBXTHM(1:ILBX+1,:,:) = XTHM(IIB-1:IIB-1+ILBX,:,:)
-!!$XLBXTHM(ILBX+2:2*ILBX+2,:,:) = XTHM(IIE+1-ILBX:IIE+1,:,:)
-!!$ILBY=SIZE(XLBYTHM,2)/2-1
-!!$XLBYTHM(:,1:ILBY+1,:) = XTHM(:,IJB-1:IJB-1+ILBY,:)
-!!$XLBYTHM(:,ILBY+2:2*ILBY+2,:) = XTHM(:,IJE+1-ILBY:IJE+1,:)
+!ILBX=SIZE(XLBXTHM,1)/2-1
+!XLBXTHM(1:ILBX+1,:,:) = XTHT(IIB-1:IIB-1+ILBX,:,:)
+!XLBXTHM(ILBX+2:2*ILBX+2,:,:) = XTHT(IIE+1-ILBX:IIE+1,:,:)
+!ILBY=SIZE(XLBYTHM,2)/2-1
+!XLBYTHM(:,1:ILBY+1,:) = XTHT(:,IJB-1:IJB-1+ILBY,:)
+!XLBYTHM(:,ILBY+2:2*ILBY+2,:) = XTHT(:,IJE+1-ILBY:IJE+1,:)
!
IF ( NRR > 0 ) THEN
IF ( LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI &
.OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH &
) THEN
-!!$ ALLOCATE(XLBXRM(2*NRIMX+2,IJU,IKU,NRR))
-!!$ ALLOCATE(XLBYRM(IIU,2*NRIMY+2,IKU,NRR))
-!!$ ELSE
-!!$ ALLOCATE(XLBXRM(2,IJU,IKU,NRR))
-!!$ ALLOCATE(XLBYRM(IIU,2,IKU,NRR))
+! ALLOCATE(XLBXRM(2*NRIMX+2,IJU,IKU,NRR))
+! ALLOCATE(XLBYRM(IIU,2*NRIMY+2,IKU,NRR))
+! ELSE
+! ALLOCATE(XLBXRM(2,IJU,IKU,NRR))
+! ALLOCATE(XLBYRM(IIU,2,IKU,NRR))
NSIZELBXR_ll=2*NRIMX+2
NSIZELBYR_ll=2*NRIMY+2
ALLOCATE(XLBXRM(IISIZEXF,IJSIZEXF,IKU,NRR))
@@ -446,13 +435,13 @@ IF ( NRR > 0 ) THEN
!
IF (SIZE(XLBXRM) .NE. 0 ) THEN
ILBX=SIZE(XLBXRM,1)/2-1
- XLBXRM(1:ILBX+1,:,:,:) = XRM(IIB-1:IIB-1+ILBX,:,:,:)
- XLBXRM(ILBX+2:2*ILBX+2,:,:,:) = XRM(IIE+1-ILBX:IIE+1,:,:,:)
+ XLBXRM(1:ILBX+1,:,:,:) = XRT(IIB-1:IIB-1+ILBX,:,:,:)
+ XLBXRM(ILBX+2:2*ILBX+2,:,:,:) = XRT(IIE+1-ILBX:IIE+1,:,:,:)
ENDIF
IF (SIZE(XLBYRM) .NE. 0 ) THEN
ILBY=SIZE(XLBYRM,2)/2-1
- XLBYRM(:,1:ILBY+1,:,:) = XRM(:,IJB-1:IJB-1+ILBY,:,:)
- XLBYRM(:,ILBY+2:2*ILBY+2,:,:) = XRM(:,IJE+1-ILBY:IJE+1,:,:)
+ XLBYRM(:,1:ILBY+1,:,:) = XRT(:,IJB-1:IJB-1+ILBY,:,:)
+ XLBYRM(:,ILBY+2:2*ILBY+2,:,:) = XRT(:,IJE+1-ILBY:IJE+1,:,:)
ENDIF
ELSE
NSIZELBXR_ll=0
@@ -461,26 +450,26 @@ ELSE
ALLOCATE(XLBYRM(0,0,0,0))
END IF
!
-!!$NSIZELBXR_ll=SIZE(XLBXRM,1)
-!!$NSIZELBYR_ll=SIZE(XLBYRM,2) !! coding for one processor
+!NSIZELBXR_ll=SIZE(XLBXRM,1)
+!NSIZELBYR_ll=SIZE(XLBYRM,2) !! coding for one processor
ILBX=SIZE(XLBXTHM,1)
ILBY=SIZE(XLBYTHM,2)
IF(LWEST_ll() .AND. .NOT. L1D) THEN
- XLBXTHM(1:NRIMX+1, :,:) = XTHM(1:NRIMX+1, :,:)
- XLBXRM(1:NRIMX+1, :,:,:) = XRM(1:NRIMX+1, :,:,:)
+ XLBXTHM(1:NRIMX+1, :,:) = XTHT(1:NRIMX+1, :,:)
+ XLBXRM(1:NRIMX+1, :,:,:) = XRT(1:NRIMX+1, :,:,:)
ENDIF
IF(LEAST_ll() .AND. .NOT. L1D) THEN
- XLBXTHM(ILBX-NRIMX:ILBX,:,:) = XTHM(IIU-NRIMX:IIU, :,:)
- XLBXRM(ILBX-NRIMX:ILBX,:,:,:) = XRM(IIU-NRIMX:IIU, :,:,:)
+ XLBXTHM(ILBX-NRIMX:ILBX,:,:) = XTHT(IIU-NRIMX:IIU, :,:)
+ XLBXRM(ILBX-NRIMX:ILBX,:,:,:) = XRT(IIU-NRIMX:IIU, :,:,:)
ENDIF
IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) THEN
- XLBYTHM(:,1:NRIMY+1, :) = XTHM(:,1:NRIMY+1, :)
- XLBYRM(:,1:NRIMY+1, :,:) = XRM(:,1:NRIMY+1, :,:)
+ XLBYTHM(:,1:NRIMY+1, :) = XTHT(:,1:NRIMY+1, :)
+ XLBYRM(:,1:NRIMY+1, :,:) = XRT(:,1:NRIMY+1, :,:)
ENDIF
IF(LNORTH_ll().AND. .NOT. L1D .AND. .NOT. L2D) THEN
- XLBYTHM(:,ILBY-NRIMY:ILBY,:) = XTHM(:,IJU-NRIMY:IJU, :)
- XLBYRM(:,ILBY-NRIMY:ILBY,:,:) = XRM(:,IJU-NRIMY:IJU, :,:)
+ XLBYTHM(:,ILBY-NRIMY:ILBY,:) = XTHT(:,IJU-NRIMY:IJU, :)
+ XLBYRM(:,ILBY-NRIMY:ILBY,:,:) = XRT(:,IJU-NRIMY:IJU, :,:)
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/version.f90 b/src/MNH/version.f90
index cdf620bd8..6ddac0f74 100644
--- a/src/MNH/version.f90
+++ b/src/MNH/version.f90
@@ -38,8 +38,8 @@ USE MODD_CONF, ONLY : NMASDEV,NBUGFIX,CBIBUSER
!
IMPLICIT NONE
!
-NMASDEV=410
-NBUGFIX=1
+NMASDEV=50
+NBUGFIX=0
CBIBUSER=''
!
END SUBROUTINE VERSION
--
GitLab