Christine 12/12/13 : WENO
authorGaelle Tanguy <gaelle.tanguy@meteo.fr>
Thu, 12 Dec 2013 16:17:03 +0000 (16:17 +0000)
committerPhilippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Thu, 19 May 2016 14:44:49 +0000 (16:44 +0200)
131 files changed:
src/MNH/adv_boundaries.f90 [new file with mode: 0644]
src/MNH/advec_3rd_order_aux.f90 [new file with mode: 0644]
src/MNH/advec_weno_k_1_aux.f90 [new file with mode: 0644]
src/MNH/advec_weno_k_2_aux.f90 [new file with mode: 0644]
src/MNH/advec_weno_k_3_aux.f90 [new file with mode: 0644]
src/MNH/advection.f90
src/MNH/advection_metsv.f90 [new file with mode: 0644]
src/MNH/advection_uvw.f90 [new file with mode: 0644]
src/MNH/advection_uvw_cen.f90 [new file with mode: 0644]
src/MNH/advecuvw_2nd.f90 [new file with mode: 0644]
src/MNH/advecuvw_4th.f90
src/MNH/advecuvw_rk.f90 [new file with mode: 0644]
src/MNH/advecuvw_weno_k.f90 [new file with mode: 0644]
src/MNH/anel_balancen.f90
src/MNH/boundaries.f90
src/MNH/budget.f90
src/MNH/budget_flags.f90
src/MNH/c2r2_adjust.f90
src/MNH/c3r5_adjust.f90
src/MNH/ch_aqueous_sedimkhko.f90
src/MNH/ch_boundaries.f90
src/MNH/ch_init_fieldn.f90
src/MNH/ch_monitorn.f90
src/MNH/compute_function_thermo.f90 [new file with mode: 0644]
src/MNH/compute_r00.f90
src/MNH/deallocate_model1.f90
src/MNH/default_desfmn.f90
src/MNH/diag.f90
src/MNH/dyn_sources.f90
src/MNH/endstep.f90
src/MNH/endstep_budget.f90
src/MNH/error_on_temperature.f90
src/MNH/exchange.f90
src/MNH/fast_terms.f90
src/MNH/forcing.f90
src/MNH/goto_model_wrapper.f90
src/MNH/gravity.f90 [new file with mode: 0644]
src/MNH/gravity_impl.f90 [new file with mode: 0644]
src/MNH/ground_paramn.f90
src/MNH/ice_adjust.f90
src/MNH/ice_adjust_bis.f90 [new file with mode: 0644]
src/MNH/ice_adjust_elec.f90
src/MNH/ini_budget.f90
src/MNH/ini_cpl.f90
src/MNH/ini_elecn.f90
src/MNH/ini_lesn.f90
src/MNH/ini_lg.f90
src/MNH/ini_micron.f90
src/MNH/ini_modeln.f90
src/MNH/ini_one_wayn.f90
src/MNH/ini_prog_var.f90
src/MNH/ini_segn.f90
src/MNH/ini_tke_eps.f90
src/MNH/init_for_convlfi.f90 [new file with mode: 0644]
src/MNH/init_mnh.f90
src/MNH/initial_guess.f90
src/MNH/interp3d.f90 [new file with mode: 0644]
src/MNH/ion_boundaries.f90
src/MNH/ion_drift.f90
src/MNH/les_budget.f90
src/MNH/les_budget_tendn.f90
src/MNH/les_cloud_masksn.f90
src/MNH/les_ini_timestepn.f90
src/MNH/les_masksn.f90
src/MNH/les_res_tr.f90
src/MNH/lesn.f90
src/MNH/ls_coupling.f90
src/MNH/mean_field.f90
src/MNH/mesonh.f90
src/MNH/mf_turb.f90
src/MNH/modd_advn.f90
src/MNH/modd_budget.f90
src/MNH/modd_conf.f90
src/MNH/modd_fieldn.f90
src/MNH/modd_getn.f90
src/MNH/modd_les_budget.f90
src/MNH/modd_past_fieldn.f90 [new file with mode: 0644]
src/MNH/modd_sub_modeln.f90
src/MNH/modeln.f90
src/MNH/modn_advn.f90
src/MNH/modn_budget.f90
src/MNH/modn_conf.f90
src/MNH/one_wayn.f90
src/MNH/paspol.f90
src/MNH/phys_paramn.f90
src/MNH/ppm_met.f90
src/MNH/ppm_rhodj.f90 [new file with mode: 0644]
src/MNH/ppm_scalar.f90
src/MNH/prep_ideal_case.f90
src/MNH/prep_real_case.f90
src/MNH/pressure_in_prep.f90
src/MNH/pressurez.f90
src/MNH/rad_bound.f90
src/MNH/rain_c2r2.f90
src/MNH/rain_ice.f90
src/MNH/rain_ice_elec.f90
src/MNH/rain_khko.f90
src/MNH/read_desfmn.f90
src/MNH/read_exsegn.f90
src/MNH/read_field.f90
src/MNH/read_precip_field.f90
src/MNH/relax2fw_ion.f90
src/MNH/relaxation.f90
src/MNH/reset_exseg.f90
src/MNH/resolved_cloud.f90
src/MNH/resolved_elecn.f90
src/MNH/series_cloud_elec.f90
src/MNH/set_geosbal.f90
src/MNH/set_grid.f90
src/MNH/set_mask.f90
src/MNH/set_mass.f90
src/MNH/set_perturb.f90
src/MNH/shallow_mf.f90
src/MNH/shallow_mf_pack.f90
src/MNH/slow_terms.f90
src/MNH/spawn_field2.f90
src/MNH/spawn_model2.f90
src/MNH/spawn_pressure2.f90
src/MNH/spawn_surf2_rain.f90
src/MNH/spawning.f90
src/MNH/thlrt_from_thrvrcri.f90 [new file with mode: 0644]
src/MNH/thrvrcri_from_thlrtrcri.f90 [new file with mode: 0644]
src/MNH/tke_eps_sources.f90
src/MNH/turb.f90
src/MNH/turb_hor_splt.f90
src/MNH/turb_ver.f90
src/MNH/two_wayn.f90
src/MNH/ver_dyn.f90
src/MNH/ver_interp_field.f90
src/MNH/ver_thermo.f90
src/MNH/version.f90

diff --git a/src/MNH/adv_boundaries.f90 b/src/MNH/adv_boundaries.f90
new file mode 100644 (file)
index 0000000..2d83c87
--- /dev/null
@@ -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 (file)
index 0000000..5490522
--- /dev/null
@@ -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 (file)
index 0000000..90abbd4
--- /dev/null
@@ -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 (file)
index 0000000..1f3f42f
--- /dev/null
@@ -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 (file)
index 0000000..44151cc
--- /dev/null
@@ -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
index 04b8f76..4025bf1 100644 (file)
@@ -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 (file)
index 0000000..cd246c7
--- /dev/null
@@ -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 (file)
index 0000000..d3e59b8
--- /dev/null
@@ -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 (file)
index 0000000..cc12e5e
--- /dev/null
@@ -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 (file)
index 0000000..c684a07
--- /dev/null
@@ -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
index ff27817..bb65cb3 100644 (file)
@@ -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 (file)
index 0000000..e538366
--- /dev/null
@@ -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 (file)
index 0000000..3912fc7
--- /dev/null
@@ -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
+
index 31619b8..ca072a1 100644 (file)
 !
 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)
 !
 !
 !-------------------------------------------------------------------------------
index 58d6bd7..5800cbc 100644 (file)
@@ -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
 !!   &nb