modeln.f90

!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!     ###################
      MODULE MODI_MODEL_n
!     ###################
!
INTERFACE
!
       SUBROUTINE MODEL_n( KTCOUNT, TPBAKFILE, TPDTMODELN, OEXIT )
!
USE MODD_IO,        ONLY: TFILEDATA
USE MODD_TYPE_DATE, ONLY: DATE_TIME
!
INTEGER,                  INTENT(IN)    :: KTCOUNT    ! Temporal loop index of model KMODEL
TYPE(TFILEDATA), POINTER, INTENT(OUT)   :: TPBAKFILE  ! Pointer for backup file
TYPE(DATE_TIME),          INTENT(OUT)   :: TPDTMODELN ! Time of current model computation
LOGICAL,                  INTENT(INOUT) :: OEXIT      ! Switch for the end of the temporal loop
!
END SUBROUTINE MODEL_n
!
END INTERFACE
!
END MODULE MODI_MODEL_n

!     ################################### 
      SUBROUTINE MODEL_n( KTCOUNT, TPBAKFILE, TPDTMODELN, OEXIT )
!     ###################################
!
!!****  *MODEL_n * -monitor of the model version _n 
!!
!!    PURPOSE
!!    -------
!       The purpose of this routine is to build up a typical model version
!     by sequentially calling the specialized routines.
!
!!**  METHOD
!!    ------
!!      Some preliminary initializations are performed in the first section.
!!    Then, specialized routines are called to update the guess of the future
!!    instant XRxxS of the variable xx by adding the effects of all the
!!    different sources of evolution.
!!
!!              (guess of xx at t+dt) * Rhod_ref * Jacobian
!!      XRxxS = -------------------------------------------
!!                           2 dt
!!
!!      At this level, the informations are transferred with a USE association
!!    from the INIT step, where the modules have been previously filled. The
!!    transfer to the subroutines computing each source term is performed by
!!    argument in order to avoid repeated compilations of these subroutines.
!!      This monitor model_n, must therefore be duplicated for each model,
!!    model1 corresponds in this case to the outermost model, model2 is used
!!    for the first level of gridnesting,....  
!!      The effect of all parameterizations is computed in PHYS_PARAM_n, which
!!    is itself a monitor. This is due to a possible large number of
!!    parameterizations, which can be activated and therefore, will require a
!!    very large list of arguments. To circumvent this problem, we transfer by
!!    a USE association, the necessary informations in this monitor, which will
!!    dispatch the pertinent information to every parametrization.
!!      Some elaborated diagnostics, LES tools, budget storages are also called
!!    at this level because they require informations about the fields at every
!!    timestep.
!!
!!
!!    EXTERNAL
!!    --------
!!      Subroutine IO_File_open: to open a file
!!      Subroutine WRITE_DESFM: to write the descriptive part of a FMfile
!!      Subroutine WRITE_LFIFM: to write the binary part of a FMfile
!!      Subroutine SET_MASK   : to compute all the masks selected for budget
!!                         computations
!!      Subroutine BOUNDARIES   : set the fields at the marginal points in every
!!                         directions according the selected boundary conditions
!!      Subroutine INITIAL_GUESS: initializes the guess of the future instant
!!      Subroutine LES_FLX_SPECTRA: computes the resolved fluxes and the
!!                     spectra of some quantities when running in LES mode.
!!      Subroutine ADVECTION: computes the advection terms.
!!      Subroutine DYN_SOURCES: computes the curvature, Coriolis, gravity terms.
!!      Subroutine NUM_DIFF: applies the fourth order numerical diffusion.
!!      Subroutine RELAXATION: performs the relaxation to Larger Scale fields
!!                             in the upper levels and outermost vertical planes
!!      Subroutine PHYS_PARAM_n : computes the parameterized physical terms
!!      Subroutine RAD_BOUND: prepares the velocity normal components for the bc.
!!      Subroutine RESOLVED_CLOUD : computes the sources terms for water in any
!!                                  form
!!      Subroutine PRESSURE : computes the pressure gradient term and the
!!                            absolute pressure
!!      Subroutine EXCHANGE : updates the halo of each subdomains
!!      Subroutine ENDSTEP : advances in time the  fields.
!!      Subroutines UVW_LS_COUPLING and SCALAR_LS_COUPLING:
!!                                 compute the large scale fields, used to
!!                                 couple Model_n with outer informations.
!!      Subroutine ENDSTEP_BUDGET: writes the budget informations.
!!      Subroutine IO_File_close: closes a file
!!      Subroutine DATETIME_CORRECTDATE: transform the current time in GMT
!!      Subroutine FORCING : computes forcing terms
!!      Subroutine ADD3DFIELD_ll : add a field to 3D-list
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!          MODD_DYN
!!          MODD_CONF
!!          MODD_NESTING
!!          MODD_BUDGET
!!          MODD_PARAMETERS
!!          MODD_CONF_n
!!          MODD_CURVCOR_n
!!          MODD_DYN_n
!!          MODD_DIM_n
!!          MODD_ADV_n
!!          MODD_FIELD_n
!!          MODD_LSFIELD_n
!!          MODD_GRID_n
!!          MODD_METRICS_n
!!          MODD_LBC_n
!!          MODD_PARAM_n
!!          MODD_REF_n
!!          MODD_LUNIT_n
!!          MODD_OUT_n
!!          MODD_TIME_n
!!          MODD_TURB_n
!!          MODD_CLOUDPAR_n
!!          MODD_TIME
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!      J.-P. Pinty                  * LA *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    15/09/94
!!      Modification 20/10/94  (J.Stein) for the outputs and abs_layers routines
!!      Modification 10/11/94  (J.Stein) change ABS_LAYER_FIELDS call
!!      Modification 16/11/94  (J.Stein) add call to the renormalization
!!      Modification 17/11/94  (J.-P. Lafore and J.-P. Pinty) call NUM_DIFF
!!      Modification 08/12/94  (J.Stein) cleaning + remove (RENORM + ABS_LAYER..
!!                             ..) + add RELAXATION + LS fiels in the arguments
!!      Modification 19/12/94  (J.Stein) switch for the num diff
!!      Modification 22/12/94  (J.Stein) update tdtcur + change dyn_source call
!!      Modification 05/01/95  (J.Stein) add the parameterization monitor
!!      Modification 09/01/95  (J.Stein) add the 1D switch
!!      Modification 10/01/95  (J.Stein) displace the TDTCUR computation
!!      Modification 03/01/95  (J.-P. Lafore) Absolute pressure diagnosis
!!      Modification Jan 19, 1995 (J. Cuxart) Shunt the DYN_SOURCES in 1D cases.
!!      Modification Jan 24, 1995 (J. Stein)  Interchange Boundaries and
!!                           Initial_guess to correct a bug in 2D configuration
!!      Modification Feb 02, 1995 (I.Mallet) update BOUNDARIES and RAD_BOUND
!!                                           calls
!!      Modification Mar 10, 1995 (I.Mallet) add call to SET_COUPLING
!!                   March,21, 1995 (J. Stein) remove R from the historical var.
!!                   March,26, 1995 (J. Stein) add the EPS variable
!!                   April 18, 1995 (J. Cuxart) add the LES call
!!                   Sept 20,1995 (Lafore) coupling for the dry mass Md
!!                   Nov   2,1995 (Stein) displace the temporal counter increase
!!                   Jan   2,1996 (Stein) rm the test on the temporal counter
!!      Modification Feb   5,1996 (J. Vila) implementation new advection
!!                                          schemes for scalars
!!      Modification Feb  20,1996 (J.Stein) doctor norm
!!                   Dec95 - Jul96 (Georgelin, Pinty, Mari, Suhre) FORCING
!!                   June 17,1996 (Vincent, Lafore, Jabouille)
!!                                        statistics of computing time
!!                   Aug 8, 1996 (K. Suhre) add chemistry
!!                   October 12, 1996 (J. Stein) save the PSRC value
!!                   Sept 05,1996 (V.Masson) print of loop index for debugging
!!                                           purposes
!!                   July 22,1996 (Lafore) improve write of computing time statistics
!!                   July 29,1996 (Lafore) nesting introduction
!!                   Aug.  1,1996 (Lafore) synchronization between models
!!                   Sept. 4,1996 (Lafore) modification of call to routine SET_COUPLING
!!                                         now split in 2 routines
!!                                         (UVW_LS_COUPLING and SCALAR_LS_COUPLING)
!!                   Sept  5,1996 (V.Masson) print of loop index for debugging
!!                                           purposes
!!                   Sept 25,1996 (V.Masson) test for coupling performed here
!!                   Oct. 29,1996 (Lafore)   one-way nesting implementation
!!                   Oct. 12,1996 (J. Stein) save the PSRC value
!!                   Dec. 12,1996 (Lafore)   change call to RAD_BOUND
!!                   Dec. 21,1996 (Lafore)   two-way nesting implementation
!!                   Mar. 12,1997 (Lafore)   introduction of "surfacic" LS fields
!!                   Nov 18, 1996 (J.-P. Pinty) FORCING revisited (translation)
!!                   Dec 04, 1996 (J.-P. Pinty) include mixed-phase clouds
!!                   Dec 20, 1996 (J.-P. Pinty) update the budgets
!!                   Dec 23, 1996 (J.-P. Pinty) add the diachronic file control
!!                   Jan 11, 1997 (J.-P. Pinty) add the deep convection control
!!                   Dec  20,1996 (V.Masson) call boundaries before the writing
!!                   Fev 25, 1997 (P.Jabouille) modify the LES tools
!!                   April 3,1997 (Lafore)      merging of the nesting
!!                                              developments on MASTER3
!!                   Jul.  8,1997 (Lafore)  print control for nesting (NVERB>=7)
!!                   Jul. 28,1997 (Masson)  supress LSTEADY_DMASS
!!                   Aug. 19,1997 (Lafore)  full Clark's formulation introduction
!!                   Sept 26,1997 (Lafore)  LS source calculation at restart
!!                                          (temporarily test to have LS at instant t)
!!                   Jan. 28,1998 (Bechtold) add SST forcing
!!                   fev. 10,1998 (Lafore)  RHODJ computation and storage for budget
!!                   Jul. 10,1998 (Stein )  sequentiel loop for nesting
!!                   Apr. 07,1999 (Stein )  cleaning of the nesting subroutines
!!                   oct. 20,1998 (Jabouille) //
!!                   oct. 20,2000 (J.-P. Pinty) add the C2R2 scheme
!!                   fev. 01,2001 (D.Gazen) add module MODD_NSV for NSV variables
!!                   mar,  4,2002 (V.Ducrocq) call to temporal series
!!                   mar, 8, 2001 (V. Masson) advection of perturbation of theta in neutral cases.
!!                   Nov, 6, 2002 (V. Masson) time counters for budgets & LES
!!                   mars 20,2001 (Pinty)   add ICE4 and C3R5 options
!!                   jan. 2004    (Masson)  surface externalization
!!                   sept 2004 (M. Tomasini) Cloud mixing length modification
!!                   june 2005 (P. Tulet)  add aerosols / dusts
!!                   Jul. 2005 (N. Asencio)  two_way and phys_param calls: 
!!                             Add the surface parameters : precipitating 
!!                             hydrometeors, Short and Long Wave , MASKkids array 
!!                   Fev. 2006 (M. Leriche) add aqueous phase chemistry
!!                   april 2006 (T.Maric) Add halo related to 4th order advection scheme
!!                   May 2006 Remove KEPS
!!                   Oct 2008 (C.Lac) FIT for variables advected with PPM
!!                   July 2009 : Displacement of surface diagnostics call to be
!!                               coherent with  surface diagnostics obtained with DIAG
!!                   10/11/2009 (P. Aumond) Add mean moments
!!                   Nov, 12, 2009 (C. Barthe) add cloud electrification and lightning flashes
!!                   July 2010 (M. Leriche) add ice phase chemical species
!!                   April 2011 (C.Lac) : Remove instant M 
!!                   April 2011 (C.Lac, V.Masson) : Time splitting for advection
!!      J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
!!       P. Tulet      Nov 2014 accumulated moles of aqueous species that fall at the surface   
!!                   Dec 2014 (C.Lac) : For reproducibility START/RESTA
!!      J.Escobar 20/04/2015: missing UPDATE_HALO before UPDATE_HALO2
!!              July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
!!                                      aircraft, ballon and profiler
!!       C.Lac    11/09/2015: correction of the budget due to FIT temporal scheme
!!      J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!!                   Sep 2015 (S. Bielli) : Remove YDADFILE from argument call 
!                              of write_phys_param
!!      J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
!!      M.Mazoyer : 04/2016      DTHRAD used for radiative cooling when LACTIT
!!!      Modification    01/2016  (JP Pinty) Add LIMA
!!  06/2016     (G.Delautier) phasage surfex 8
!!      M.Leriche : 03/2016 Move computation of accumulated chem. in rain to ch_monitor
!!                  09/2016 Add filter on negative values on AERDEP SV before relaxation
!!                  10/2016  (C.Lac) _ Correction on the flag for Strang splitting
!!                                  to insure reproducibility between START and RESTA
!!                                  _  Add OSPLIT_WENO
!!                                  _ Add droplet deposition 
!!                   10/2016 (M.Mazoyer) New KHKO output fields
!!      P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
!!                   09/2017 Q.Rodier add LTEND_UV_FRC
!!                   10/2017 (C.Lac) Necessity to have chemistry processes as
!!                            the las process modifying XRSVS
!!  01/2018      (G.Delautier) SURFEX 8.1
!!  03/2018     (P.Wautelet)   replace ADD_FORECAST_TO_DATE by DATETIME_CORRECTDATE
!!  Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!!                  07/2017  (V. Vionnet) : Add blowing snow scheme 
!!      S. Riette : 11/2016 Add ZPABST to keep pressure constant during timestep
!!                   01/2018 (C.Lac) Add VISCOSITY
!!  Philippe Wautelet: 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll
!                                  to allow to disable writes (for bench purposes)
!  P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
!                          (nsubfiles_ioz is now determined in IO_File_add2list)
!!                   02/2019 C.Lac add rain fraction as an output field
!!      Bielli S. 02/2019  Sea salt : significant sea wave height influences salt emission; 5 salt modes
!  P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
!  P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing
!  P. Wautelet 19/04/2019: removed unused dummy arguments and variables
!  P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
!  P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
!  J. Escobar  09/07/2019: norme Doctor -> Rename Module Type variable TZ -> T
!  J. Escobar  09/07/2019: for bug in management of XLSZWSM variable, add/use specific 2D TLSFIELD2D_ll pointer
!  P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
!  J. Escobar  27/09/2019: add missing report timing of RESOLVED_ELEC
!  P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
!  P. Wautelet 12/10/2020: Write_les_n: remove HLES_AVG dummy argument and group all 4 calls
!  F. Auguste  01/02/2021: add IBM
!  T. Nagel    01/02/2021: add turbulence recycling
!  P. Wautelet 19/02/2021: add NEGA2 term for SV budgets
!  J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version)
!  A. Costes      12/2021: add Blaze fire model
!  C. Barthe   07/04/2022: deallocation of ZSEA
!  P. Wautelet 08/12/2022: bugfix if no TDADFILE
!  P. Wautelet 13/01/2023: manage close of backup files outside of MODEL_n
!                          (useful to close them in reverse model order (child before parent, needed by WRITE_BALLOON_n)
!!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE MODD_2D_FRC
USE MODD_ADV_n
USE MODD_AIRCRAFT_BALLOON
USE MODD_ARGSLIST_ll,     ONLY : LIST_ll
USE MODD_BAKOUT
USE MODD_BIKHARDT_n
USE MODD_BLANK_n
USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
use modd_budget,          only: cbutype, lbu_ru, lbu_rv, lbu_rw, lbudget_u, lbudget_v, lbudget_w, lbudget_sv, lbu_enable, &
                                NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_SV1, nbumod, nbutime,                            &
                                tbudgets, tbuconf, tburhodj,                                                                       &
                                xtime_bu, xtime_bu_process
USE MODD_CH_AERO_n,      ONLY: XSOLORG, XMI
USE MODD_CH_MNHC_n,      ONLY: LUSECHEM,LCH_CONV_LINOX,LUSECHAQ,LUSECHIC, &
                               LCH_INIT_FIELD
USE MODD_CLOUD_MF_n
USE MODD_CLOUDPAR_n
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST,            ONLY: CST
USE MODD_CURVCOR_n
USE MODD_DEEP_CONVECTION_n
USE MODD_DIM_n
USE MODD_DIMPHYEX,       ONLY: DIMPHYEX_t
USE MODD_DRAG_n
USE MODD_DUST,           ONLY: LDUST
USE MODD_DYN
USE MODD_DYN_n
USE MODD_DYNZD
USE MODD_DYNZD_n
USE MODD_ELEC_DESCR
USE MODD_EOL_MAIN
USE MODD_FIELD_n
USE MODD_FRC
USE MODD_FRC_n
USE MODD_GET_n
USE MODD_GRID,           ONLY: XLONORI,XLATORI
USE MODD_GRID_n
USE MODD_IBM_PARAM_n,    ONLY: CIBM_ADV, LIBM, LIBM_TROUBLE, XIBM_LS
USE MODD_ICE_C1R3_DESCR, ONLY: XRTMIN_C1R3=>XRTMIN
USE MODD_IO,             ONLY: LIO_NO_WRITE, TFILEDATA, TFILE_SURFEX, TFILE_DUMMY
USE MODD_LBC_n
USE MODD_LES
USE MODD_LES_BUDGET
USE MODD_LIMA_PRECIP_SCAVENGING_n
USE MODD_LSFIELD_n
USE MODD_LUNIT,          ONLY: TOUTDATAFILE
USE MODD_LUNIT_n,        ONLY: TDIAFILE,TINIFILE,TINIFILEPGD,TLUOUT
USE MODD_MEAN_FIELD
USE MODD_MEAN_FIELD_n
USE MODD_METRICS_n
USE MODD_MNH_SURFEX_n
USE MODD_NESTING
USE MODD_NSV
USE MODD_NUDGING_n
USE MODD_OUT_n
USE MODD_PARAM_C1R3,     ONLY: NSEDI => LSEDI, NHHONI => LHHONI
USE MODD_PARAM_C2R2,     ONLY: NSEDC => LSEDC, NRAIN => LRAIN, NACTIT => LACTIT,LACTTKE,LDEPOC
USE MODD_PARAMETERS
USE MODD_PARAM_ICE,      ONLY: LWARM,LSEDIC,LCONVHG,LDEPOSC
USE MODD_PARAM_LIMA,     ONLY: MSEDC => LSEDC, NMOM_C, NMOM_R, &
                               MACTIT => LACTIT, LSCAV, NMOM_I,                 &
                               MSEDI => LSEDI, MHHONI => LHHONI, NMOM_H,        &
                               XRTMIN_LIMA=>XRTMIN, MACTTKE=>LACTTKE
USE MODD_PARAM_MFSHALL_n
USE MODD_PARAM_n
USE MODD_PAST_FIELD_n
USE MODD_PRECIP_n
use modd_precision,      only: MNHTIME
USE MODD_PROFILER_n
USE MODD_RADIATIONS_n,   ONLY: XTSRAD,XSCAFLASWD,XDIRFLASWD,XDIRSRFSWD, XAER, XDTHRAD
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_RECYCL_PARAM_n, ONLY: LRECYCL
USE MODD_REF,            ONLY: LCOUPLES
USE MODD_REF_n
USE MODD_SALT,           ONLY: LSALT
USE MODD_SERIES,         ONLY: LSERIES
USE MODD_SERIES_n,       ONLY: NFREQSERIES
USE MODD_STATION_n
USE MODD_SUB_MODEL_n
USE MODD_TIME
USE MODD_TIME_n 
USE MODD_TIMEZ
USE MODD_TURB_CLOUD,     ONLY: NMODEL_CLOUD,CTURBLEN_CLOUD,XCEI
USE MODD_TURB_n
USE MODD_TYPE_DATE,      ONLY: DATE_TIME
USE MODD_VISCOSITY
!
USE MODE_AIRCRAFT_BALLOON
use mode_budget,           only: Budget_store_init, Budget_store_end
USE MODE_DATETIME
USE MODE_ELEC_ll
USE MODE_GRIDCART
USE MODE_GRIDPROJ
USE MODE_IO_FIELD_WRITE,   only: IO_Field_user_write, IO_Fieldlist_write, IO_Header_write
USE MODE_IO_FILE,          only: IO_File_close, IO_File_open
USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_ll
#ifdef MNH_IOLFI
use mode_menu_diachro,     only: MENU_DIACHRO
#endif
USE MODE_MNH_TIMING
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
USE MODE_MSG
USE MODE_ONE_WAY_n
USE MODE_WRITE_AIRCRAFT_BALLOON
use mode_write_les_n,               only: Write_les_n
use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
USE MODE_WRITE_PROFILER_n,          ONLY: WRITE_PROFILER_n
USE MODE_WRITE_STATION_n,           ONLY: WRITE_STATION_n
!
USE MODI_ADDFLUCTUATIONS
USE MODI_ADVECTION_METSV
USE MODI_ADVECTION_UVW
USE MODI_ADVECTION_UVW_CEN
USE MODI_ADV_FORCING_n
USE MODI_AER_MONITOR_n
USE MODI_BLOWSNOW
USE MODI_BOUNDARIES
USE MODI_BUDGET_FLAGS
USE MODI_CART_COMPRESS
USE MODI_CH_MONITOR_n
USE MODI_DIAG_SURF_ATM_N
USE MODI_DYN_SOURCES
USE MODI_END_DIAG_IN_RUN
USE MODI_ENDSTEP
USE MODI_ENDSTEP_BUDGET
USE MODI_EXCHANGE
USE MODI_FORCING
USE MODI_FORC_SQUALL_LINE
USE MODI_FORC_WIND
USE MODI_GET_HALO
USE MODI_GRAVITY_IMPL
USE MODI_IBM_INIT
USE MODI_IBM_FORCING
USE MODI_IBM_FORCING_TR
USE MODI_IBM_FORCING_ADV
USE MODI_INI_DIAG_IN_RUN
USE MODI_INI_LG
USE MODI_INI_MEAN_FIELD
USE MODI_INITIAL_GUESS
USE MODI_LES_INI_TIMESTEP_n
USE MODI_LES_N
USE MODI_LIMA_PRECIP_SCAVENGING
USE MODI_LS_COUPLING
USE MODI_MASK_COMPRESS
USE MODI_MEAN_FIELD
USE MODI_MNHGET_SURF_PARAM_n
USE MODI_MNHWRITE_ZS_DUMMY_n
USE MODI_NUDGING
USE MODI_NUM_DIFF
USE MODI_PHYS_PARAM_n
USE MODI_PRESSUREZ
USE MODI_PROFILER_n
USE MODI_RAD_BOUND
USE MODI_RECYCLING
USE MODI_RELAX2FW_ION 
USE MODI_RELAXATION
USE MODI_REL_FORCING_n
USE MODI_RESOLVED_CLOUD
USE MODI_RESOLVED_ELEC_n
USE MODI_SERIES_N
USE MODI_SETLB_LG
USE MODI_SET_MASK
USE MODI_SHUMAN
USE MODI_SPAWN_LS_n
USE MODI_STATION_n
USE MODI_TURB_CLOUD_INDEX
USE MODI_TWO_WAY
USE MODI_UPDATE_NSV
USE MODI_VISCOSITY
USE MODI_WRITE_DESFM_n
USE MODI_WRITE_DIAG_SURF_ATM_N
USE MODI_WRITE_LFIFM_n
USE MODI_WRITE_SERIES_n
USE MODI_WRITE_SURF_ATM_N
!
USE MODD_FIRE_n
IMPLICIT NONE
!
!*       0.1   declarations of arguments
!
!
!
INTEGER,                  INTENT(IN)    :: KTCOUNT    ! Temporal loop index of model KMODEL
TYPE(TFILEDATA), POINTER, INTENT(OUT)   :: TPBAKFILE  ! Pointer for backup file
TYPE(DATE_TIME),          INTENT(OUT)   :: TPDTMODELN ! Time of current model computation
LOGICAL,                  INTENT(INOUT) :: OEXIT      ! Switch for the end of the temporal loop
!
!*       0.2   declarations of local variables
!
INTEGER :: ILUOUT      ! Logical unit number for the output listing
INTEGER :: IIU,IJU,IKU ! array size in first, second and third dimensions
INTEGER :: IIB,IIE,IJB,IJE ! index values for the physical subdomain
INTEGER :: JSV,JRR     ! Loop index for scalar and moist variables
INTEGER  :: INBVAR              ! number of HALO2_lls to allocate
INTEGER  :: IINFO_ll            ! return code of parallel routine
INTEGER :: IVERB                ! LFI verbosity level
LOGICAL :: GSTEADY_DMASS        ! conditional call to mass computation
!
                                ! for computing time analysis
REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME, ZTIME1, ZTIME2, ZEND, ZTOT, ZALL, ZTOT_PT, ZBLAZETOT
REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_STEP,ZTIME_STEP_PTS
CHARACTER                 :: YMI
INTEGER                   :: IPOINTS
CHARACTER(len=16)         :: YTCOUNT,YPOINTS
CHARACTER(LEN=:), ALLOCATABLE :: YDADNAME
!
INTEGER :: ISYNCHRO          ! model synchronic index relative to its father
                             ! = 1  for the first time step in phase with DAD
                             ! = 0  for the last  time step (out of phase)
INTEGER      :: IMI ! Current model index
REAL, DIMENSION(:,:),ALLOCATABLE          :: ZSEA
REAL, DIMENSION(:,:),ALLOCATABLE          :: ZTOWN
! Dummy pointers needed to correct an ifort Bug
REAL, DIMENSION(:), POINTER :: DPTR_XZHAT
REAL, DIMENSION(:), POINTER :: DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4
REAL, DIMENSION(:), POINTER :: DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4
REAL, DIMENSION(:), POINTER :: DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4
REAL, DIMENSION(:), POINTER :: DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4
CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_NKLIN_LBXV,DPTR_NKLIN_LBYV
INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_NKLIN_LBXM,DPTR_NKLIN_LBYM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXU,DPTR_XCOEFLIN_LBYU
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXV,DPTR_XCOEFLIN_LBYV
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXW,DPTR_XCOEFLIN_LBYW
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXM,DPTR_XCOEFLIN_LBYM
REAL, DIMENSION(:,:,:),   POINTER :: DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM
REAL, DIMENSION(:,:,:),   POINTER :: DPTR_XLBXWM,DPTR_XLBYWM,DPTR_XLBXTHM,DPTR_XLBYTHM
REAL, DIMENSION(:,:,:),   POINTER :: DPTR_XLBXTKEM,DPTR_XLBYTKEM
REAL, DIMENSION(:,:,:,:),   POINTER :: DPTR_XLBXSVM,DPTR_XLBYSVM                
REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM
REAL, DIMENSION(:,:,:),   POINTER ::  DPTR_XZZ
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS
REAL, DIMENSION(:,:),   POINTER :: DPTR_XLSZWSM,DPTR_XLSZWSS
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWS,DPTR_XLBYWS,DPTR_XLBXTHS,DPTR_XLBYTHS
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKES,DPTR_XLBYTKES
REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS
!
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRHODJ,DPTR_XUM,DPTR_XVM,DPTR_XWM,DPTR_XTHM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XTKEM,DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRTKES,DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD
REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XRM,DPTR_XSVM,DPTR_XRRS,DPTR_XRSVS
REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG
REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV
LOGICAL, DIMENSION(:,:),POINTER :: DPTR_GMASKkids
!
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3))           :: ZSPEEDC
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3))           :: ZSPEEDR
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3))           :: ZSPEEDS
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3))           :: ZSPEEDG
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3))           :: ZSPEEDH
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3))           :: ZINPRC3D
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3))           :: ZINPRS3D
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3))           :: ZINPRG3D
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3))           :: ZINPRH3D
!
LOGICAL :: KWARM        
LOGICAL :: KRAIN        
LOGICAL :: KSEDC  
LOGICAL :: KACTIT
LOGICAL :: KSEDI
LOGICAL :: KHHONI
!
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZRUS,ZRVS,ZRWS
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPABST !To give pressure at t 
                                                     ! (and not t+1) to resolved_cloud
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZJ
!
TYPE(LIST_ll), POINTER :: TZFIELDC_ll   ! list of fields to exchange
TYPE(HALO2LIST_ll), POINTER :: TZHALO2C_ll   ! list of fields to exchange
LOGICAL :: GCLD                     ! conditionnal call for dust wet deposition
LOGICAL :: GCLOUD_ONLY              ! conditionnal radiation computations for
                                !      the only cloudy columns
REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), NSV_AER)  :: ZWETDEPAER
!
TYPE(TFILEDATA),POINTER :: TZOUTFILE
! TYPE(TFILEDATA),SAVE    :: TZDIACFILE
TYPE(DIMPHYEX_t) :: YLDIMPHYEX
!-------------------------------------------------------------------------------
!
TPBAKFILE=> NULL()
TZOUTFILE=> NULL()
!
TPDTMODELN = TDTCUR
!
!*       0.    MICROPHYSICAL SCHEME
!              ------------------- 
SELECT CASE(CCLOUD)
CASE('C2R2','KHKO','C3R5')
  KWARM  = .TRUE.        
  KRAIN  = NRAIN
  KSEDC  = NSEDC
  KACTIT = NACTIT
!
  KSEDI  = NSEDI
  KHHONI = NHHONI
CASE('LIMA')
   KRAIN  = NMOM_R.GE.1
   KWARM  = NMOM_C.GE.1
  KSEDC  = MSEDC
  KACTIT = MACTIT
!
  KSEDI  = MSEDI
  KHHONI = MHHONI
CASE('ICE3','ICE4') !default values
  KWARM  = LWARM        
  KRAIN  = .TRUE.
  KSEDC  = .TRUE.
  KACTIT = .FALSE.
!
  KSEDI  = .TRUE.
  KHHONI = .FALSE.
END SELECT
!
!
!*        1    PRELIMINARY
!              ------------
IMI = GET_CURRENT_MODEL_INDEX()
!
!*       1.0   update NSV_* variables for current model
!              ----------------------------------------
!
CALL UPDATE_NSV(IMI)
!
!*       1.1   RECOVER THE LOGICAL UNIT NUMBER FOR THE OUTPUT PRINTS
!
ILUOUT = TLUOUT%NLU
!
!*       1.2   SET ARRAY SIZE
!
CALL GET_DIM_EXT_ll('B',IIU,IJU)
IKU=NKMAX+2*JPVEXT
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!
IF (IMI==1) THEN
  GSTEADY_DMASS=LSTEADYLS
ELSE
  GSTEADY_DMASS=.FALSE.
END IF
!
!*       1.3   OPEN THE DIACHRONIC FILE
!
IF (KTCOUNT == 1) THEN
!
  NULLIFY(TFIELDS_ll,TLSFIELD_ll,TFIELDT_ll)
  NULLIFY(TLSFIELD2D_ll)
  NULLIFY(THALO2T_ll)
  NULLIFY(TLSHALO2_ll)
  NULLIFY(TFIELDSC_ll)
!
  ALLOCATE(XWT_ACT_NUC(SIZE(XWT,1),SIZE(XWT,2),SIZE(XWT,3)))
  ALLOCATE(GMASKkids(SIZE(XWT,1),SIZE(XWT,2)))
!
  IF ( .NOT. LIO_NO_WRITE ) THEN
    CALL IO_File_open(TDIAFILE)
!
    CALL IO_Header_write(TDIAFILE)
    CALL WRITE_DESFM_n(IMI,TDIAFILE)
    CALL WRITE_LFIFMN_FORDIACHRO_n(TDIAFILE)
  END IF
!
!*       1.4   Initialization of the list of fields for the halo updates
!
!                 a) Sources terms
!
  CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS,      'MODEL_n::XRUS' )
  CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS,      'MODEL_n::XRVS' )
  CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS,      'MODEL_n::XRWS' )
  CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS,     'MODEL_n::XRTHS' )
  CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS_PRES, 'MODEL_n::XRUS_PRES' )
  CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS_PRES, 'MODEL_n::XRVS_PRES' )
  CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS_PRES, 'MODEL_n::XRWS_PRES' )
  CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS_CLD, 'MODEL_n::XRTHS_CLD' )
  IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XRTKES, 'MODEL_n::XRTKES' )
  CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS     (:,:,:,1:NRR), 'MODEL_n::XRRS' )
  CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS_CLD (:,:,:,1:NRR), 'MODEL_n::XRRS_CLD' )
  CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS    (:,:,:,1:NSV), 'MODEL_n::XRSVS')
  CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS_CLD(:,:,:,1:NSV), 'MODEL_n::XRSVS_CLD')
  IF (SIZE(XSRCT,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XSRCT, 'MODEL_n::XSRCT' )
  ! Fire model parallel setup
  IF (LBLAZE) THEN
    CALL ADD3DFIELD_ll( TFIELDS_ll, XLSPHI,     'MODEL_n::XLSPHI')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XBMAP,      'MODEL_n::XBMAP')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMRFA,     'MODEL_n::XFMRFA')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWF0,     'MODEL_n::XFMWF0')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR0,      'MODEL_n::XFMR0')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR00,     'MODEL_n::XFMR00')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMIGNITION, 'MODEL_n::XFMIGNITION')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFUELTYPE, 'MODEL_n::XFMFUELTYPE')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRETAU,   'MODEL_n::XFIRETAU')
    CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMH(:,:,:,1:SIZE(XFLUXPARAMH,4)), 'MODEL_n::XFLUXPARAMH')
    CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMW(:,:,:,1:SIZE(XFLUXPARAMW,4)), 'MODEL_n::XFLUXPARAMW')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRERW,    'MODEL_n::XFIRERW')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMASE,     'MODEL_n::XFMASE')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMAWC,     'MODEL_n::XFMAWC')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWALKIG,  'MODEL_n::XFMWALKIG')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDH, 'MODEL_n::XFMFLUXHDH')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDW, 'MODEL_n::XFMFLUXHDW')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMHWS,     'MODEL_n::XFMHWS')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDU,   'MODEL_n::XFMWINDU')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDV,   'MODEL_n::XFMWINDV')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDW,   'MODEL_n::XFMWINDW')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROX, 'MODEL_n::XFMGRADOROX')
    CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROY, 'MODEL_n::XFMGRADOROY')
  END IF
  !
  IF ((LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN
  !
  !                 b) LS fields
  !
    CALL ADD3DFIELD_ll( TLSFIELD_ll,   XLSUM,   'MODEL_n::XLSUM'   )
    CALL ADD3DFIELD_ll( TLSFIELD_ll,   XLSVM,   'MODEL_n::XLSVM'   )
    CALL ADD3DFIELD_ll( TLSFIELD_ll,   XLSWM,   'MODEL_n::XLSWM'   )
    CALL ADD3DFIELD_ll( TLSFIELD_ll,   XLSTHM,  'MODEL_n::XLSTHM'  )
    CALL ADD2DFIELD_ll( TLSFIELD2D_ll, XLSZWSM, 'MODEL_n::XLSZWSM' )
    IF (NRR >= 1) THEN
      CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSRVM, 'MODEL_n::XLSRVM' )
    ENDIF
  !
  !                 c) Fields at t
  !
    CALL ADD3DFIELD_ll( TFIELDT_ll, XUT,  'MODEL_n::XUT'  )
    CALL ADD3DFIELD_ll( TFIELDT_ll, XVT,  'MODEL_n::XVT'  )
    CALL ADD3DFIELD_ll( TFIELDT_ll, XWT,  'MODEL_n::XWT'  )
    CALL ADD3DFIELD_ll( TFIELDT_ll, XTHT, 'MODEL_n::XTHT' )
    IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDT_ll, XTKET, 'MODEL_n::XTKET' )
    CALL ADD4DFIELD_ll(TFIELDT_ll, XRT (:,:,:,1:NRR), 'MODEL_n::XSV'  )
    CALL ADD4DFIELD_ll(TFIELDT_ll, XSVT(:,:,:,1:NSV), 'MODEL_n::XSVT' )
  !
  !*       1.5   Initialize the list of fields for the halo updates (2nd layer)
  !
    INBVAR = 4+NRR+NSV
    IF (SIZE(XRTKES,1) /= 0) INBVAR=INBVAR+1
    CALL INIT_HALO2_ll(THALO2T_ll,INBVAR,IIU,IJU,IKU)
    CALL INIT_HALO2_ll(TLSHALO2_ll,4+MIN(1,NRR),IIU,IJU,IKU)
  !
  !*       1.6   Initialise the 2nd layer of the halo of the LS fields
  !
    IF ( LSTEADYLS ) THEN
       CALL UPDATE_HALO_ll(TLSFIELD_ll, IINFO_ll)
       CALL UPDATE_HALO_ll(TLSFIELD2D_ll,IINFO_ll) 
       CALL UPDATE_HALO2_ll(TLSFIELD_ll, TLSHALO2_ll, IINFO_ll)
    END IF
  END IF
  !
!
  !
  XT_START     = 0.0_MNHTIME
  !
  XT_STORE     = 0.0_MNHTIME
  XT_BOUND     = 0.0_MNHTIME
  XT_GUESS     = 0.0_MNHTIME
  XT_FORCING   = 0.0_MNHTIME
  XT_NUDGING   = 0.0_MNHTIME
  XT_ADV       = 0.0_MNHTIME
  XT_ADVUVW    = 0.0_MNHTIME
  XT_GRAV      = 0.0_MNHTIME
  XT_SOURCES   = 0.0_MNHTIME
  !
  XT_DIFF      = 0.0_MNHTIME
  XT_RELAX     = 0.0_MNHTIME
  XT_PARAM     = 0.0_MNHTIME
  XT_SPECTRA   = 0.0_MNHTIME
  XT_HALO      = 0.0_MNHTIME
  XT_VISC      = 0.0_MNHTIME
  XT_RAD_BOUND = 0.0_MNHTIME
  XT_PRESS     = 0.0_MNHTIME
  !
  XT_CLOUD     = 0.0_MNHTIME
  XT_STEP_SWA  = 0.0_MNHTIME
  XT_STEP_MISC = 0.0_MNHTIME
  XT_COUPL     = 0.0_MNHTIME
  XT_1WAY      = 0.0_MNHTIME
  XT_STEP_BUD  = 0.0_MNHTIME
  !
  XT_RAD       = 0.0_MNHTIME
  XT_DCONV     = 0.0_MNHTIME
  XT_GROUND    = 0.0_MNHTIME
  XT_TURB      = 0.0_MNHTIME
  XT_MAFL      = 0.0_MNHTIME
  XT_DRAG      = 0.0_MNHTIME
  XT_EOL       = 0.0_MNHTIME
  XT_TRACER    = 0.0_MNHTIME
  XT_SHADOWS   = 0.0_MNHTIME
  XT_ELEC      = 0.0_MNHTIME
  XT_CHEM      = 0.0_MNHTIME
  XT_2WAY      = 0.0_MNHTIME
  !
  XT_IBM_FORC  = 0.0_MNHTIME
  ! Blaze fire model
  XFIREPERF    = 0.0_MNHTIME
  !
END IF
!
!*       1.7   Allocation of arrays for observation diagnostics
!
CALL INI_DIAG_IN_RUN(IIU,IJU,IKU,LFLYER,LSTATION,LPROFILER)
!
!
CALL SECOND_MNH2(ZEND)
!
!-------------------------------------------------------------------------------
!
!*       2.    ONE-WAY NESTING AND LARGE SCALE FIELD REFRESH
!              ---------------------------------------------
!
!
CALL SECOND_MNH2(ZTIME1)
!
ISYNCHRO = MODULO (KTCOUNT, NDTRATIO(IMI) )      ! test of synchronisation
!
!
IF (LCOUPLES.AND.LOCEAN) THEN
   CALL NHOA_COUPL_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT,IKU)
END IF
! No Gridnest in coupled OA LES for now
IF (.NOT. LCOUPLES .AND. IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) THEN     
!                                                                         
! Use dummy pointers to correct an ifort BUG
  DPTR_XBMX1=>XBMX1
  DPTR_XBMX2=>XBMX2
  DPTR_XBMX3=>XBMX3
  DPTR_XBMX4=>XBMX4
  DPTR_XBMY1=>XBMY1
  DPTR_XBMY2=>XBMY2
  DPTR_XBMY3=>XBMY3
  DPTR_XBMY4=>XBMY4
  DPTR_XBFX1=>XBFX1
  DPTR_XBFX2=>XBFX2
  DPTR_XBFX3=>XBFX3
  DPTR_XBFX4=>XBFX4
  DPTR_XBFY1=>XBFY1
  DPTR_XBFY2=>XBFY2
  DPTR_XBFY3=>XBFY3
  DPTR_XBFY4=>XBFY4
  DPTR_CLBCX=>CLBCX
  DPTR_CLBCY=>CLBCY
  !
  DPTR_XZZ=>XZZ
  DPTR_XZHAT=>XZHAT
  DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
  DPTR_XLSTHM=>XLSTHM
  DPTR_XLSRVM=>XLSRVM
  DPTR_XLSUM=>XLSUM
  DPTR_XLSVM=>XLSVM
  DPTR_XLSWM=>XLSWM
  DPTR_XLSZWSM=>XLSZWSM
  DPTR_XLSTHS=>XLSTHS
  DPTR_XLSRVS=>XLSRVS
  DPTR_XLSUS=>XLSUS
  DPTR_XLSVS=>XLSVS
  DPTR_XLSWS=>XLSWS
  DPTR_XLSZWSS=>XLSZWSS
  !
  IF ( LSTEADYLS                     ) THEN
    NCPL_CUR=0
  ELSE
    IF (NCPL_CUR/=1) THEN
      IF ( KTCOUNT+1 == NCPL_TIMES(NCPL_CUR-1,IMI)  ) THEN
        !
        !  LS sources are interpolated from the LS field 
        ! values of model DAD(IMI)
        CALL SPAWN_LS_n(NDAD(IMI),XTSTEP,IMI,                        &
             DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4,        &
             DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4,        &
             NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),                    &
             DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT,LSLEVE,XLEN1,XLEN2,DPTR_XCOEFLIN_LBXM, &
             DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSZWSM,                        &
             DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS, DPTR_XLSZWSS                         )
      END IF
    END IF
    !
  END IF
  !
  DPTR_NKLIN_LBXU=>NKLIN_LBXU
  DPTR_XCOEFLIN_LBXU=>XCOEFLIN_LBXU
  DPTR_NKLIN_LBYU=>NKLIN_LBYU
  DPTR_XCOEFLIN_LBYU=>XCOEFLIN_LBYU
  DPTR_NKLIN_LBXV=>NKLIN_LBXV
  DPTR_XCOEFLIN_LBXV=>XCOEFLIN_LBXV
  DPTR_NKLIN_LBYV=>NKLIN_LBYV
  DPTR_XCOEFLIN_LBYV=>XCOEFLIN_LBYV
  DPTR_NKLIN_LBXW=>NKLIN_LBXW
  DPTR_XCOEFLIN_LBXW=>XCOEFLIN_LBXW
  DPTR_NKLIN_LBYW=>NKLIN_LBYW
  DPTR_XCOEFLIN_LBYW=>XCOEFLIN_LBYW
  !
  DPTR_NKLIN_LBXM=>NKLIN_LBXM
  DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
  DPTR_NKLIN_LBYM=>NKLIN_LBYM
  DPTR_XCOEFLIN_LBYM=>XCOEFLIN_LBYM
  !
  DPTR_XLBXUM=>XLBXUM
  DPTR_XLBYUM=>XLBYUM
  DPTR_XLBXVM=>XLBXVM
  DPTR_XLBYVM=>XLBYVM
  DPTR_XLBXWM=>XLBXWM
  DPTR_XLBYWM=>XLBYWM
  DPTR_XLBXTHM=>XLBXTHM
  DPTR_XLBYTHM=>XLBYTHM
  DPTR_XLBXTKEM=>XLBXTKEM
  DPTR_XLBYTKEM=>XLBYTKEM
  DPTR_XLBXRM=>XLBXRM
  DPTR_XLBYRM=>XLBYRM
  DPTR_XLBXSVM=>XLBXSVM
  DPTR_XLBYSVM=>XLBYSVM
  !  
  DPTR_XLBXUS=>XLBXUS
  DPTR_XLBYUS=>XLBYUS
  DPTR_XLBXVS=>XLBXVS
  DPTR_XLBYVS=>XLBYVS
  DPTR_XLBXWS=>XLBXWS
  DPTR_XLBYWS=>XLBYWS
  DPTR_XLBXTHS=>XLBXTHS
  DPTR_XLBYTHS=>XLBYTHS
  DPTR_XLBXTKES=>XLBXTKES
  DPTR_XLBYTKES=>XLBYTKES
  DPTR_XLBXRS=>XLBXRS
  DPTR_XLBYRS=>XLBYRS
  DPTR_XLBXSVS=>XLBXSVS
  DPTR_XLBYSVS=>XLBYSVS
  !
  CALL ONE_WAY_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT,                   &
       DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4,        &
       DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4,        &
       NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),NDTRATIO(IMI),         &
       DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY,                                &
       DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU,      &
       DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV,      &
       DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW,      &
       DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM,      &
       GSTEADY_DMASS,CCLOUD,LUSECHAQ,LUSECHIC,                           &
       DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM,              &
       DPTR_XLBXTHM,DPTR_XLBYTHM,                                        &
       DPTR_XLBXTKEM,DPTR_XLBYTKEM,                                      &
       DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM,                          &
       XDRYMASST,XDRYMASSS,                                    &
       DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS,DPTR_XLBXWS,DPTR_XLBYWS,              &
       DPTR_XLBXTHS,DPTR_XLBYTHS,                                        &
       DPTR_XLBXTKES,DPTR_XLBYTKES,                                      &
       DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS                           )
  !
END IF
!
CALL SECOND_MNH2(ZTIME2)                                                  
XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1 
!
!*       2.1    RECYCLING TURBULENCE
!              ---- 
IF (CTURB /= 'NONE' .AND. LRECYCL) THEN
  CALL RECYCLING(XFLUCTUNW,XFLUCTVNN,XFLUCTUTN,XFLUCTVTW,XFLUCTWTW,XFLUCTWTN, &
                 XFLUCTUNE,XFLUCTVNS,XFLUCTUTS,XFLUCTVTE,XFLUCTWTE,XFLUCTWTS, &
                 KTCOUNT)
ENDIF
!
!*       2.2    IBM
!              ----
!
IF (LIBM .AND. KTCOUNT==1) THEN
  !
  IF (.NOT.LCARTESIAN) THEN
    CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
  ENDIF
  !
  CALL IBM_INIT(XIBM_LS)
  !
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       3.    LATERAL BOUNDARY CONDITIONS EXCEPT FOR NORMAL VELOCITY
!              ------------------------------------------------------
!
ZTIME1=ZTIME2
!
!*       3.1   Set the lagragian variables values at the LB
!
IF( LLG .AND. IMI==1 ) CALL SETLB_LG
!
IF (CCONF == "START" .OR. (CCONF == "RESTA" .AND. KTCOUNT /= 1 )) THEN
CALL MPPDB_CHECK3DM("before BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
                   &  XUT, XVT, XWT, XTHT, XTKET)
CALL BOUNDARIES (                                                   &
            XTSTEP,CLBCX,CLBCY,NRR,NSV,KTCOUNT,                     &
            XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM,   &
            XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM,   &
            XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS,   &
            XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS,   &
            XRHODJ,XRHODREF,                                        &
            XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT            )
CALL MPPDB_CHECK3DM("after  BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
                   &  XUT, XVT, XWT, XTHT, XTKET)
END IF
!
CALL SECOND_MNH2(ZTIME2)
!
XT_BOUND = XT_BOUND + ZTIME2 - ZTIME1
!
!
! For START/RESTART MPPDB_CHECK use 
!IF ( (IMI==1) .AND. (CCONF == "START") .AND. (KTCOUNT == 2) ) THEN
!   CALL MPPDB_START_DEBUG()
!ENDIF
!IF ( (IMI==1) .AND. (CCONF == "RESTA") .AND. (KTCOUNT == 1) ) THEN
!   CALL MPPDB_START_DEBUG()
!ENDIF