Skip to content
Snippets Groups Projects
ini_one_wayn.f90 29.4 KiB
Newer Older
  • Learn to ignore specific revisions
  • !MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
    
    !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
    
    !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
    
    !MNH_LIC for details. version 1.
    
    !-----------------------------------------------------------------
    !     #######################
          MODULE MODI_INI_ONE_WAY_n
    !     #######################
    !
    INTERFACE 
    !
          SUBROUTINE INI_ONE_WAY_n( KDAD,HLUOUT,PTSTEP,KMI,KTCOUNT,          &
                        PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4,     &
                        PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4,     &
                        KDXRATIO,KDYRATIO,KDTRATIO,                          &
                        HLBCX,HLBCY,KRIMX,KRIMY,                             &
                        KKLIN_LBXU,PCOEFLIN_LBXU,KKLIN_LBYU,PCOEFLIN_LBYU,   &
                        KKLIN_LBXV,PCOEFLIN_LBXV,KKLIN_LBYV,PCOEFLIN_LBYV,   &
                        KKLIN_LBXW,PCOEFLIN_LBXW,KKLIN_LBYW,PCOEFLIN_LBYW,   &
                        KKLIN_LBXM,PCOEFLIN_LBXM,KKLIN_LBYM,PCOEFLIN_LBYM,   &
                        HCLOUD, OUSECHAQ, OUSECHIC,                          &
                        PLBXUM,PLBYUM,PLBXVM,PLBYVM,PLBXWM,PLBYWM,           &
                        PLBXTHM,PLBYTHM,                                     &
                        PLBXTKEM,PLBYTKEM,                                   &
                        PLBXRM,PLBYRM,PLBXSVM,PLBYSVM                        )
    !
    !
    INTEGER,          INTENT(IN)    :: KDAD     !  Number of the DAD model
    CHARACTER (LEN=*),INTENT(IN)    :: HLUOUT   ! name of the output-listing
    REAL,             INTENT(IN)    :: PTSTEP   !  Time step
    INTEGER,          INTENT(IN)    :: KMI      ! model number
    INTEGER,          INTENT(IN)    :: KTCOUNT  !  Temporal loop COUNTer
                                                ! (=1 at the segment beginning)
    !
                                        ! interpolation coefficients 
    REAL, DIMENSION(:), INTENT(IN) :: PBMX1,PBMX2,PBMX3,PBMX4 ! Mass points in X-direc.
    REAL, DIMENSION(:), INTENT(IN) :: PBMY1,PBMY2,PBMY3,PBMY4 ! Mass points in Y-direc.
    REAL, DIMENSION(:), INTENT(IN) :: PBFX1,PBFX2,PBFX3,PBFX4 ! Flux points in X-direc.
    REAL, DIMENSION(:), INTENT(IN) :: PBFY1,PBFY2,PBFY3,PBFY4 ! Flux points in Y-direc.
    !
    INTEGER,   INTENT(IN)  :: KDXRATIO   !  x and y-direction resolution RATIO
    INTEGER,   INTENT(IN)  :: KDYRATIO   ! between inner model and outer model
    INTEGER,   INTENT(IN)  :: KDTRATIO   !  Time step resolution RATIO
    CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCX   ! type of lateral
    CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCY   ! boundary conditions
    INTEGER,          INTENT(IN)    :: KRIMX,KRIMY ! size of the RIM area
    !  coefficients for the vertical interpolation of the LB fields
    INTEGER, DIMENSION(:,:,:), INTENT(  IN ) :: KKLIN_LBXU,KKLIN_LBYU 
    REAL,    DIMENSION(:,:,:), INTENT(  IN ) :: PCOEFLIN_LBXU,PCOEFLIN_LBYU
    INTEGER, DIMENSION(:,:,:), INTENT(  IN ) :: KKLIN_LBXV,KKLIN_LBYV 
    REAL,    DIMENSION(:,:,:), INTENT(  IN ) :: PCOEFLIN_LBXV,PCOEFLIN_LBYV
    INTEGER, DIMENSION(:,:,:), INTENT(  IN ) :: KKLIN_LBXW,KKLIN_LBYW 
    REAL,    DIMENSION(:,:,:), INTENT(  IN ) :: PCOEFLIN_LBXW,PCOEFLIN_LBYW
    INTEGER, DIMENSION(:,:,:), INTENT(  IN ) :: KKLIN_LBXM,KKLIN_LBYM 
    REAL,    DIMENSION(:,:,:), INTENT(  IN ) :: PCOEFLIN_LBXM,PCOEFLIN_LBYM
    CHARACTER (LEN=4), INTENT(IN)           :: HCLOUD        ! Indicator of the cloud scheme
    LOGICAL,           INTENT(IN)           :: OUSECHAQ      ! logical for aqueous phase chemistry
    LOGICAL,           INTENT(IN)           :: OUSECHIC      ! logical for ice phase chemistry
    !  
    REAL, DIMENSION(:,:,:), INTENT(OUT)    :: PLBXUM,PLBXVM,PLBXWM ! Large Scale fields at t-dt
    REAL, DIMENSION(:,:,:), INTENT(OUT)    :: PLBYUM,PLBYVM,PLBYWM 
    REAL, DIMENSION(:,:,:),  INTENT(OUT)  :: PLBXTHM ,PLBYTHM  ! Large Scale fields at t-dt
    REAL, DIMENSION(:,:,:),  INTENT(OUT)  :: PLBXTKEM,PLBYTKEM ! Theta, TKE
    REAL, DIMENSION(:,:,:,:),INTENT(OUT)  :: PLBXRM  ,PLBYRM   ! Moisture and SV
    REAL, DIMENSION(:,:,:,:),INTENT(OUT)  :: PLBXSVM ,PLBYSVM  ! in x and y-dir.
    !
    END SUBROUTINE INI_ONE_WAY_n
    !
    END INTERFACE
    !
    END MODULE MODI_INI_ONE_WAY_n
    !
    
    !     ####################################################################
    SUBROUTINE INI_ONE_WAY_n(KDAD,HLUOUT,PTSTEP,KMI,KTCOUNT,                 &
                        PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4,     &
                        PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4,     &
                        KDXRATIO,KDYRATIO,KDTRATIO,                          &
                        HLBCX,HLBCY,KRIMX,KRIMY,                             &
                        KKLIN_LBXU,PCOEFLIN_LBXU,KKLIN_LBYU,PCOEFLIN_LBYU,   &
                        KKLIN_LBXV,PCOEFLIN_LBXV,KKLIN_LBYV,PCOEFLIN_LBYV,   &
                        KKLIN_LBXW,PCOEFLIN_LBXW,KKLIN_LBYW,PCOEFLIN_LBYW,   &
                        KKLIN_LBXM,PCOEFLIN_LBXM,KKLIN_LBYM,PCOEFLIN_LBYM,   &
                        HCLOUD,OUSECHAQ,OUSECHIC,                            &
                        PLBXUM,PLBYUM,PLBXVM,PLBYVM,PLBXWM,PLBYWM,           &
                        PLBXTHM,PLBYTHM,                                     &
                        PLBXTKEM,PLBYTKEM,                                   &
                        PLBXRM,PLBYRM,PLBXSVM,PLBYSVM                        )
    !     ####################################################################
    !
    !!****  *INI_ONE_WAY$n* - INItializing a nested model Large Scale sources
    !!
    !!    PURPOSE
    !!    -------
    !!      The purpose of INI_ONE_WAY$n is to initialize Large Scale sources
    !!    of all the prognostic variables of the current nested model when the
    !!    current time step is in phase with its outer (DAD) model $n.
    !
    !
    !!**  METHOD
    !!    ------
    !!      The basic task consists in interpolating fields from outer model $n
    !!    to present inner model, using horizontal Bikhardt interpolation.
    !!
    !!    EXTERNAL
    !!    --------
    !!
    !!        Function  VER_INTERP_LIN : performs the vertical interpolation
    !!
    !!        Subroutine  BIKHARDT : performs the horizontal interpolation
    !!
    !!    IMPLICIT ARGUMENTS
    !!    ------------------
    !!      Module MODD_PARAMETERS: JPHEXT,JPVEXT
    !!
    !!      Module MODD_CST: XRD,XRV,XCPD,XP00,XTH00
    !!
    !!      Module MODD_CONF: CEQNSYS
    !!
    !!      Module MODD_FIELD$n : XUM,XVM,XWM,XRM,XTHM
    !!
    !!    REFERENCE
    !!    ---------
    !!
    !!    AUTHOR
    !!    ------
    !!    J. P. Lafore and J. Stein  *Meteo-France*
    !!
    !!    MODIFICATIONS
    !!    -------------
    !!      Original     22/09/99
    !!    J.-P. Pinty    29/11/02 modify the LB*SVS for the C3R5 scheme
    !!                            and add ICE2, ICE4, CELEC
    !!    Modification   03/2006   (O.Geoffroy) add KHKO schem
    !!    Modification   05/2006   Remove KEPS
    !!    M. Leriche     11/2009  modify the LB*SVS for the aqueous phase chemistry
    !!                   07/2010  idem for ice phase chemical species
    
    !!    Bosseur & Filippi 07/2013 Adds Forefire
    
    !!    J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 
    
    !!      J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1 
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
    !!      B.VIE   2016 : LIMA
    
    !!  Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
    
    !!
    !------------------------------------------------------------------------------
    !
    !*      0.   DECLARATIONS
    !            ------------
    USE MODE_ll
    USE MODE_MODELN_HANDLER
    !
    USE MODD_ARGSLIST_ll, ONLY : LIST_ll
    USE MODD_PARAMETERS
    USE MODD_CONF
    USE MODD_CST
    USE MODD_FIELD_n      ! modules relative to the outer model $n
    USE MODD_PARAM_n
    USE MODD_CH_MNHC_n, ONLY: LUSECHAQ, LUSECHIC
    USE MODD_REF_n
    USE MODD_NSV
    !
    USE MODI_BIKHARDT
    USE MODI_VER_INTERP_LIN
    USE MODI_SET_CONC_RAIN_C2R2
    USE MODI_SET_CONC_ICE_C1R3
    USE MODI_SET_CHEMAQ_1WAY
    !
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
    USE MODI_SET_CONC_LIMA
    !
    
    IMPLICIT NONE
    !
    !*       0.1   declarations of arguments
    !
    !
    INTEGER,          INTENT(IN)    :: KDAD     !  Number of the DAD model
    CHARACTER (LEN=*),INTENT(IN)    :: HLUOUT   ! name for output-listing
    REAL,             INTENT(IN)    :: PTSTEP   !  Time step
    INTEGER,          INTENT(IN)    :: KMI      ! model number
    INTEGER,          INTENT(IN)    :: KTCOUNT  !  Temporal loop COUNTer
                                                ! (=1 at the segment beginning)
    !
                                        ! interpolation coefficients
    REAL, DIMENSION(:), INTENT(IN) :: PBMX1,PBMX2,PBMX3,PBMX4 ! Mass points in X-direc.
    REAL, DIMENSION(:), INTENT(IN) :: PBMY1,PBMY2,PBMY3,PBMY4 ! Mass points in Y-direc.
    REAL, DIMENSION(:), INTENT(IN) :: PBFX1,PBFX2,PBFX3,PBFX4 ! Flux points in X-direc.
    REAL, DIMENSION(:), INTENT(IN) :: PBFY1,PBFY2,PBFY3,PBFY4 ! Flux points in Y-direc.
    !
    INTEGER,   INTENT(IN)  :: KDXRATIO   !  x and y-direction resolution RATIO
    INTEGER,   INTENT(IN)  :: KDYRATIO   ! between inner model and outer model
    INTEGER,   INTENT(IN)  :: KDTRATIO   !  Time step resolution RATIO
    CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCX   ! type of lateral
    CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCY   ! boundary conditions
    INTEGER,          INTENT(IN)    :: KRIMX,KRIMY ! size of the RIM area
    !  coefficients for the vertical interpolation of the LB fields
    INTEGER, DIMENSION(:,:,:), INTENT(  IN ) :: KKLIN_LBXU,KKLIN_LBYU
    REAL,    DIMENSION(:,:,:), INTENT(  IN ) :: PCOEFLIN_LBXU,PCOEFLIN_LBYU
    INTEGER, DIMENSION(:,:,:), INTENT(  IN ) :: KKLIN_LBXV,KKLIN_LBYV
    REAL,    DIMENSION(:,:,:), INTENT(  IN ) :: PCOEFLIN_LBXV,PCOEFLIN_LBYV
    INTEGER, DIMENSION(:,:,:), INTENT(  IN ) :: KKLIN_LBXW,KKLIN_LBYW
    REAL,    DIMENSION(:,:,:), INTENT(  IN ) :: PCOEFLIN_LBXW,PCOEFLIN_LBYW
    INTEGER, DIMENSION(:,:,:), INTENT(  IN ) :: KKLIN_LBXM,KKLIN_LBYM
    REAL,    DIMENSION(:,:,:), INTENT(  IN ) :: PCOEFLIN_LBXM,PCOEFLIN_LBYM
    CHARACTER (LEN=4), INTENT(IN)  :: HCLOUD        ! Indicator of the cloud scheme
    LOGICAL,           INTENT(IN)  :: OUSECHAQ      ! logical for aqueous phase
    LOGICAL,           INTENT(IN)  :: OUSECHIC      ! logical for ice phase chemistry
    !
    REAL, DIMENSION(:,:,:), INTENT(OUT)    :: PLBXUM,PLBXVM,PLBXWM ! Large Scale fields at t-dt
    REAL, DIMENSION(:,:,:), INTENT(OUT)    :: PLBYUM,PLBYVM,PLBYWM
    REAL, DIMENSION(:,:,:),  INTENT(OUT)  :: PLBXTHM ,PLBYTHM  ! Large Scale fields at t-dt
    REAL, DIMENSION(:,:,:),  INTENT(OUT)  :: PLBXTKEM,PLBYTKEM ! Theta, TKE
    REAL, DIMENSION(:,:,:,:),INTENT(OUT)  :: PLBXRM  ,PLBYRM   ! Moisture and SV
    REAL, DIMENSION(:,:,:,:),INTENT(OUT)  :: PLBXSVM ,PLBYSVM  ! in x and y-dir.
    !
    !
    !*       0.2   declarations of local variables
    !
    
    INTEGER                :: IIB,IIE,IJB,IJE,IIU,IJU
    
    INTEGER                :: ILBX,ILBY,ILBX2,ILBY2
    REAL,   DIMENSION(:,:,:), ALLOCATABLE  :: ZWORK
    LOGICAL  :: GVERT_INTERP
    !
    INTEGER           :: IRR,ISV_USER          !  Number of moist and user scalar variables
    INTEGER           :: JRR,JSV          !  Loop index
    !
    ! reduced array for the interpolation coefficients
    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  ZCOEFLIN_LBXM_RED,ZCOEFLIN_LBYM_RED
    INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: IKLIN_LBXM_RED,IKLIN_LBYM_RED
    !
    ! Variables used for LS communications
    INTEGER :: IINFO_ll, IDIMX, IDIMY
    REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTUM, ZTVM, ZTWM, ZTTHM, ZTTKEM
    REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::ZTRM,ZTSVM
    !
    CHARACTER(LEN=4)                    :: ZINIT_TYPE ! type of C2R2 initialisation
    REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCONCM  ! C2R2 concentrations
    REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCHEMM  ! chemical concentrations
    REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCHEMMI  ! chemical ice phase concentrations
    !-------------------------------------------------------------------------------
    !
    !*      0.   INITIALISATION
    ! 
    CALL GOTO_MODEL(KDAD)
    !
    
    !!$CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
    CALL GET_DIM_EXT_ll ('B',IIU,IJU)
    IIB=1
    IIE=IIU
    IJB=1
    IJE=IJU
    
    
    ALLOCATE(ZWORK(IIB:IIE,IJB:IJE,SIZE(PLBXTHM,3)))  ! can be smaller than child extended subdomain
    ! LS_FORCING routine can not correctly manage extra halo zone
    ! LB will be filled only with one layer halo zone for the moment
    !
    !
    !
    IF (LWEST_ll() .AND. LEAST_ll()) THEN
      ALLOCATE (ZCOEFLIN_LBXM_RED(2,SIZE(PLBXTHM,2),SIZE(PLBXTHM,3)))
      ALLOCATE (  IKLIN_LBXM_RED(2,SIZE(PLBXTHM,2),SIZE(PLBXTHM,3)))
    ELSE
      ALLOCATE (ZCOEFLIN_LBXM_RED(1,SIZE(PLBXTHM,2),SIZE(PLBXTHM,3)))
      ALLOCATE (  IKLIN_LBXM_RED(1,SIZE(PLBXTHM,2),SIZE(PLBXTHM,3)))
    ENDIF
    !
    IF (LSOUTH_ll() .AND. LNORTH_ll()) THEN
      ALLOCATE (ZCOEFLIN_LBYM_RED(SIZE(PLBYTHM,1),2,SIZE(PLBYTHM,3)))
      ALLOCATE (  IKLIN_LBYM_RED(SIZE(PLBYTHM,1),2,SIZE(PLBYTHM,3)))
    ELSE
      ALLOCATE (ZCOEFLIN_LBYM_RED(SIZE(PLBYTHM,1),1,SIZE(PLBYTHM,3)))
      ALLOCATE (  IKLIN_LBYM_RED(SIZE(PLBYTHM,1),1,SIZE(PLBYTHM,3)))
    ENDIF
    !
    !
    GVERT_INTERP=.TRUE.
    !
    
    IRR=MIN(SIZE(XRT,4),SIZE(PLBXRM,4))
    
    ISV_USER=MIN(NSV_USER_A(KDAD),NSV_USER_A(KMI))
    !
    IF(LWEST_ll()) THEN
      ZCOEFLIN_LBXM_RED(1,:,:)=PCOEFLIN_LBXM(1,:,:)
      IKLIN_LBXM_RED(1,:,:)=KKLIN_LBXM(1,:,:)
    ENDIF
    IF(LEAST_ll()) THEN
      ZCOEFLIN_LBXM_RED(SIZE(ZCOEFLIN_LBXM_RED,1),:,:) = &
                 PCOEFLIN_LBXM(SIZE(PCOEFLIN_LBXM,1),:,:)
    
      IKLIN_LBXM_RED(SIZE(IKLIN_LBXM_RED,1),:,:) = &
                 KKLIN_LBXM(SIZE(IKLIN_LBXM_RED,1),:,:)
    ENDIF
    IF ( SIZE(PLBYTHM,2) /= 0 ) THEN
      IF(LSOUTH_ll()) THEN
        ZCOEFLIN_LBYM_RED(:,1,:)=PCOEFLIN_LBYM(:,1,:)
        IKLIN_LBYM_RED(:,1,:)=KKLIN_LBYM(:,1,:)
      ENDIF
      IF(LNORTH_ll()) THEN
        ZCOEFLIN_LBYM_RED(:,SIZE(ZCOEFLIN_LBYM_RED,2),:) = &
                   PCOEFLIN_LBYM(:,SIZE(PCOEFLIN_LBYM,2),:)
        IKLIN_LBYM_RED(:,SIZE(IKLIN_LBYM_RED,2),:) = &
                   KKLIN_LBYM(:,SIZE(IKLIN_LBYM_RED,2),:)
      ENDIF
    END IF
    !
    !*      1 GATHER LS FIELD FOR THE CHILD MODEL KMI
    !
    !       1.1  Must be on the father model to call get_child_dim
    !
    CALL GO_TOMODEL_ll(KDAD, IINFO_ll)
    CALL GET_CHILD_DIM_ll(KMI, IDIMX, IDIMY, IINFO_ll)
    !
    !       1.2  Allocate array which will receive coarse grid points
    !
    
    ALLOCATE(ZTUM(IDIMX,IDIMY,SIZE(XUT,3)))
    ALLOCATE(ZTVM(IDIMX,IDIMY,SIZE(XVT,3)))
    ALLOCATE(ZTWM(IDIMX,IDIMY,SIZE(XWT,3)))
    ALLOCATE(ZTTHM(IDIMX,IDIMY,SIZE(XTHT,3)))
    IF (SIZE(XTKET) /= 0) ALLOCATE(ZTTKEM(IDIMX,IDIMY,SIZE(XTKET,3)))
    IF (IRR /= 0) ALLOCATE(ZTRM(IDIMX,IDIMY,SIZE(XRT,3),IRR))
    IF (NSV_A(KMI)/= 0) ALLOCATE(ZTSVM(IDIMX,IDIMY,SIZE(XRT,3),NSV_A(KMI)))
    
    !
    !         1.3  Specify the ls "source" fields and receiver fields
    !
    
    CALL SET_LSFIELD_1WAY_ll(XUT,ZTUM,KMI)
    CALL SET_LSFIELD_1WAY_ll(XVT,ZTVM,KMI)
    CALL SET_LSFIELD_1WAY_ll(XWT,ZTWM,KMI)
    CALL SET_LSFIELD_1WAY_ll(XTHT,ZTTHM,KMI)
    IF (ALLOCATED(ZTTKEM)) CALL SET_LSFIELD_1WAY_ll(XTKET,ZTTKEM,KMI)
    
      CALL SET_LSFIELD_1WAY_ll(XRT(:,:,:,JRR),ZTRM(:,:,:,JRR),KMI)
    
    ENDDO
    !
    ! USERs scalar variables
    !
    IF (ALLOCATED(ZTSVM)) ZTSVM=0.
    DO JSV=1,ISV_USER
    
      CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV),ZTSVM(:,:,:,JSV),KMI)
    
    ENDDO
    !  Checking if it is necessary to compute the Nc and Nr
    !  concentrations to use the C2R2 microphysical scheme
    !  (FATHER does not use C2R2(or KHKO) and CHILD uses C2R2(or KHKO))
    IF ( HCLOUD=="C2R2" .OR. HCLOUD=="KHKO" ) THEN    
     IF ( CCLOUD/="NONE" .AND. CCLOUD/="C2R2" .AND. CCLOUD/="KHKO" ) THEN
      ZINIT_TYPE="NONE"
      ALLOCATE(ZCONCM(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),3))
      IF (CCLOUD == "REVE") THEN
        ZINIT_TYPE = "INI1"
      ELSE IF (CCLOUD == "KESS" ) THEN
        ZINIT_TYPE = "INI2"
      END IF
    
      CALL SET_CONC_RAIN_C2R2(ZINIT_TYPE,XRHODREF,XRT,ZCONCM)
    
      DO JSV=1,3
        CALL SET_LSFIELD_1WAY_ll(ZCONCM(:,:,:,JSV),&
             &ZTSVM(:,:,:,JSV-1+NSV_C2R2BEG_A(KMI)),KMI)
      ENDDO
     ELSE
      DO JSV=1,NSV_C2R2_A(KMI)
    
        CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_C2R2BEG_A(KDAD)),&
    
             &ZTSVM(:,:,:,JSV-1+NSV_C2R2BEG_A(KMI)),KMI)
      END DO
     ENDIF
    ENDIF
    !
    !  Checking also if it is necessary to compute the Ni
    !  concentrations to use the C3R5 microphysical scheme
    !  (FATHER does not use C3R5 and CHILD uses C3R5)
    !
    IF (HCLOUD=="C3R5"  ) THEN
     IF (CCLOUD(1:3)=="ICE") THEN
      ZINIT_TYPE="NONE"
      ALLOCATE(ZCONCM(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),5))
      IF (CCLOUD == "REVE") THEN
          ZINIT_TYPE = "INI1"
      ELSE IF (CCLOUD == "KESS" ) THEN
        ZINIT_TYPE = "INI2"
      END IF
    
      CALL SET_CONC_RAIN_C2R2(ZINIT_TYPE,XRHODREF,XRT,ZCONCM)
    
      DO JSV=1,3
        CALL SET_LSFIELD_1WAY_ll(ZCONCM(:,:,:,JSV),&
             &ZTSVM(:,:,:,JSV-1+NSV_C2R2BEG_A(KMI)),KMI)
      ENDDO
      ZINIT_TYPE="INI3"
    
      CALL SET_CONC_ICE_C1R3 (XRHODREF,XRT,ZCONCM)
    
      DO JSV=4,5
        CALL SET_LSFIELD_1WAY_ll(ZCONCM(:,:,:,JSV), &
             ZTSVM(:,:,:,JSV-4+NSV_C1R3BEG_A(KMI)),KMI)
      ENDDO
     ELSE
      DO JSV=1,NSV_C2R2_A(KMI)
    
        CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_C2R2BEG_A(KDAD)),&
    
             &ZTSVM(:,:,:,JSV-1+NSV_C2R2BEG_A(KMI)),KMI)
      END DO
      DO JSV=1,NSV_C1R3_A(KMI)
    
        CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_C1R3BEG_A(KDAD)),&
    
             &ZTSVM(:,:,:,JSV-1+NSV_C1R3BEG_A(KMI)),KMI)
      END DO
     ENDIF
    ENDIF
    !
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
    !  Checking if it is necessary to compute the Nc, Nr, Ni
    !  concentrations to use the LIMA microphysical scheme
    !  (FATHER does not use LIMA and CHILD uses LIMA)
    !
    IF (HCLOUD=="LIMA"  ) THEN
       IF (CCLOUD/="LIMA") THEN
          ALLOCATE(ZCONCM(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),NSV_LIMA_A(KMI)))
          IF (CCLOUD == "REVE") THEN
             ZINIT_TYPE = "INI1"
          ELSE
             ZINIT_TYPE = "NONE"
          END IF
    
          CALL SET_CONC_LIMA (ZINIT_TYPE,XRHODREF,XRT,ZCONCM)
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          DO JSV=1,NSV_LIMA_A(KMI)
             CALL SET_LSFIELD_1WAY_ll(ZCONCM(:,:,:,JSV),&
                  &ZTSVM(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
          ENDDO   
       ELSE
          IF (NSV_LIMA_A(KMI)/=NSV_LIMA_A(KDAD)) CALL ABORT
          DO JSV=1,NSV_LIMA_A(KMI)
             CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_LIMA_BEG_A(KDAD)),&
                  &ZTSVM(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
          END DO
       END IF
    ENDIF
    !
    
    ! electrical variables
    !
    DO JSV=1,MIN(NSV_ELEC_A(KMI),NSV_ELEC_A(KDAD))
    
      CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_ELECBEG_A(KDAD)),&
    
           &ZTSVM(:,:,:,JSV-1+NSV_ELECBEG_A(KMI)),KMI)
    END DO
    !
    ! chemical Scalar variables
    !  Checking if it is necessary to compute the Caq
    !  concentrations to use the aqueous phase chemistry
    !  (FATHER does not use aqueous phase chemistry and CHILD uses it)
    !
    IF (OUSECHAQ) THEN
      IF (.NOT.(LUSECHAQ)) THEN
        ALLOCATE(ZCHEMM(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),&
                       NSV_CHEM_A(KMI)))
    
        CALL SET_CHEMAQ_1WAY(XRHODREF,&
    
             XSVT(:,:,:,NSV_CHEMBEG_A(KDAD):NSV_CHEMEND_A(KDAD)),ZCHEMM)
    
        DO JSV=1,NSV_CHEM_A(KMI)
          CALL SET_LSFIELD_1WAY_ll(ZCHEMM(:,:,:,JSV),&
             &ZTSVM(:,:,:,JSV-1+NSV_CHEMBEG_A(KMI)),KMI)
        ENDDO
      ELSE
        DO JSV=1,NSV_CHEM_A(KMI)
    
          CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_CHEMBEG_A(KDAD)),&
    
                &ZTSVM(:,:,:,JSV-1+NSV_CHEMBEG_A(KMI)),KMI)
        END DO
      ENDIF
    ELSE
      DO JSV=1,NSV_CHEM_A(KMI)
    
        CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_CHEMBEG_A(KDAD)),&
    
             &ZTSVM(:,:,:,JSV-1+NSV_CHEMBEG_A(KMI)),KMI)
      END DO
    ENDIF
    !  Checking if it is necessary to compute the Cic
    !  concentrations to use the ice phase chemistry
    !  (FATHER does not use ice phase chemistry and CHILD uses it)
    !
    IF (OUSECHIC) THEN
      IF (.NOT.(LUSECHIC)) THEN
        ALLOCATE(ZCHEMMI(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),&
                       NSV_CHIC_A(KMI)))
        ZCHEMMI(:,:,:,:) = 0.
        DO JSV=1,NSV_CHIC_A(KMI)
          CALL SET_LSFIELD_1WAY_ll(ZCHEMMI(:,:,:,JSV),&
           &ZTSVM(:,:,:,JSV-1+NSV_CHICBEG_A(KMI)),KMI)
        ENDDO
      ELSE
        DO JSV=1,NSV_CHIC_A(KMI)
    
           CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_CHICBEG_A(KDAD)),&
    
             &ZTSVM(:,:,:,JSV-1+NSV_CHICBEG_A(KMI)),KMI)
        END DO
      ENDIF
    ELSE
      DO JSV=1,NSV_CHIC_A(KMI)
    
        CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_CHICBEG_A(KDAD)),&
    
             &ZTSVM(:,:,:,JSV-1+NSV_CHICBEG_A(KMI)),KMI)
      END DO
    ENDIF
    !
    !
    ! lagrangian variables
    DO JSV=1,NSV_LG_A(KMI)
    
      CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_LGBEG_A(KDAD)),&
    
           &ZTSVM(:,:,:,JSV-1+NSV_LGBEG_A(KMI)),KMI)
    END DO
    !
    ! NOX                     
    DO JSV=1,NSV_LNOX_A(KMI)
    
      CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_LNOXBEG_A(KDAD)),&
    
           &ZTSVM(:,:,:,JSV-1+NSV_LNOXBEG_A(KMI)),KMI)
    END DO
    !
    ! Dust Scalar variables
    DO JSV=1,NSV_DST_A(KMI)
    
      CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_DSTBEG_A(KDAD)),&
    
           &ZTSVM(:,:,:,JSV-1+NSV_DSTBEG_A(KMI)),KMI)
    END DO
    !
    ! Moist Dust Scalar variables
    DO JSV=1,NSV_DSTDEP_A(KMI)
    
      CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_DSTDEPBEG_A(KDAD)),&
    
           &ZTSVM(:,:,:,JSV-1+NSV_DSTDEPBEG_A(KMI)),KMI)
    END DO
    
    ! Sea Salt Scalar variables
    DO JSV=1,NSV_SLT_A(KMI)
    
      CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_SLTBEG_A(KDAD)),&
    
           &ZTSVM(:,:,:,JSV-1+NSV_SLTBEG_A(KMI)),KMI)
    END DO
    !
    ! Moist Sea Salt Scalar variables
    DO JSV=1,NSV_SLTDEP_A(KMI)
    
      CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_SLTDEPBEG_A(KDAD)),&
    
           &ZTSVM(:,:,:,JSV-1+NSV_SLTDEPBEG_A(KMI)),KMI)
    END DO
    !
    !
    ! Passive pollutant      
    DO JSV=1,NSV_PP_A(KMI)
    
      CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_PPBEG_A(KDAD)),&
    
           &ZTSVM(:,:,:,JSV-1+NSV_PPBEG_A(KMI)),KMI)
    END DO
    
    #ifdef MNH_FOREFIRE
    ! ForeFire variables      
    DO JSV=1,NSV_FF_A(KMI)
      CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_FFBEG_A(KDAD)),&
           &ZTSVM(:,:,:,JSV-1+NSV_FFBEG_A(KMI)),KMI)
    END DO
    #endif
    
    !        1.4  Communication
    !
    CALL LS_FORCING_ll(KMI,IINFO_ll)
    !
    !        1.5  Back to the (current) child model
    !
    CALL GO_TOMODEL_ll(KMI, IINFO_ll)
    !
    CALL UNSET_LSFIELD_1WAY_ll()
    IF (ALLOCATED(ZCONCM)) DEALLOCATE(ZCONCM)
    IF (ALLOCATED(ZCHEMM)) DEALLOCATE(ZCHEMM)
    IF (ALLOCATED(ZCHEMMI)) DEALLOCATE(ZCHEMMI)
    !
    !
    !-------------------------------------------------------------------------------
    !
    !*      1.   U FIELD TREATMENT
    !            -----------------
    !
    !*      1.1  Horizontal Bikhardt interpolation
    !
    PLBXUM=0.
    PLBYUM=0.
    !
    CALL BIKHARDT (PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
                   PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
                   2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,2,       &
                                               HLBCX,HLBCY,ZTUM,ZWORK)
    DEALLOCATE(ZTUM)
    !
    ILBX2=SIZE(PLBXUM,1)
    IF(LWEST_ll( ).AND.LEAST_ll( )) THEN
      ILBX=ILBX2/2
    ELSE
      ILBX=ILBX2
    ENDIF
    !
    IF(LWEST_ll( ) .AND. ILBX/=0) THEN
      PLBXUM(1:ILBX,IJB:IJE,:)=ZWORK(IIB+1:IIB+ILBX,IJB:IJE,:)  !  C grid
    ENDIF
    !
    IF(LEAST_ll( ) .AND. ILBX/=0) THEN
      PLBXUM(ILBX2-ILBX+1:ILBX2,IJB:IJE,:)=ZWORK(IIE+1-ILBX:IIE,IJB:IJE,:)
    ENDIF
    !
    ILBY2=SIZE(PLBYUM,2)
    IF(LSOUTH_ll( ).AND.LNORTH_ll( )) THEN
      ILBY=ILBY2/2
    ELSE
      ILBY=ILBY2
    ENDIF
    !
    IF(LSOUTH_ll( ) .AND. ILBY/=0) THEN
      PLBYUM(IIB:IIE,1:ILBY,:)=ZWORK(IIB:IIE,IJB:IJB-1+ILBY,:)
    ENDIF
    !
    IF(LNORTH_ll( ) .AND. ILBY/=0) THEN
      PLBYUM(IIB:IIE,ILBY2-ILBY+1:ILBY2,:)=ZWORK(IIB:IIE,IJE+1-ILBY:IJE,:)
    ENDIF
    !
    !*      1.2  Vertical interpolation
    !
    IF ( SIZE(PLBXUM,1) /= 0 .AND. GVERT_INTERP) THEN
      PLBXUM(:,:,:) = VER_INTERP_LIN(PLBXUM(:,:,:),   &
                                       KKLIN_LBXU(:,:,:),PCOEFLIN_LBXU(:,:,:))
    END IF
    !
    IF ( SIZE(PLBYUM,1) /= 0 .AND. GVERT_INTERP) THEN
      PLBYUM(:,:,:) = VER_INTERP_LIN(PLBYUM(:,:,:),   &
                                       KKLIN_LBYU(:,:,:),PCOEFLIN_LBYU(:,:,:))
    END IF
    !
    !-------------------------------------------------------------------------------
    !
    !*      2.   V FIELD TREATMENT
    !            -----------------
    !
    !*      2.1  Horizontal Bikhardt interpolation
    !
    PLBXVM=0.
    PLBYVM=0.
    !
    CALL BIKHARDT (PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
                   PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
                   2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,3,       &
                                               HLBCX,HLBCY,ZTVM,ZWORK)
    DEALLOCATE(ZTVM)
    !
    ILBX2=SIZE(PLBXVM,1)
    IF(LWEST_ll( ).AND.LEAST_ll( )) THEN
      ILBX=ILBX2/2
    ELSE
      ILBX=ILBX2
    ENDIF
    !
    IF(LWEST_ll( ) .AND. ILBX/=0) THEN
      PLBXVM(1:ILBX,IJB:IJE,:)=ZWORK(IIB:IIB-1+ILBX,IJB:IJE,:)
    ENDIF
    !
    IF(LEAST_ll( ) .AND. ILBX/=0) THEN
      PLBXVM(ILBX2-ILBX+1:ILBX2,IJB:IJE,:)=ZWORK(IIE+1-ILBX:IIE,IJB:IJE,:)
    ENDIF
    !
    ILBY2=SIZE(PLBYVM,2)
    IF(LSOUTH_ll( ).AND.LNORTH_ll( )) THEN
      ILBY=ILBY2/2
    ELSE
      ILBY=ILBY2
    ENDIF
    !
    IF(LSOUTH_ll( ) .AND. ILBY/=0) THEN
      PLBYVM(IIB:IIE,1:ILBY,:)=ZWORK(IIB:IIE,IJB+1:IJB+ILBY,:)  !  C grid
    ENDIF
    !
    IF(LNORTH_ll( ) .AND. ILBY/=0) THEN
      PLBYVM(IIB:IIE,ILBY2-ILBY+1:ILBY2,:)=ZWORK(IIB:IIE,IJE+1-ILBY:IJE,:)
    ENDIF
    !
    !*      1.2  Vertical interpolation
    !
    IF ( SIZE(PLBXVM,1) /= 0 .AND. GVERT_INTERP) THEN
      PLBXVM(:,:,:) = VER_INTERP_LIN(PLBXVM(:,:,:),   &
                                       KKLIN_LBXV(:,:,:),PCOEFLIN_LBXV(:,:,:))
    END IF
    !
    IF ( SIZE(PLBYVM,1) /= 0 .AND. GVERT_INTERP) THEN
      PLBYVM(:,:,:) = VER_INTERP_LIN(PLBYVM(:,:,:),   &
                                       KKLIN_LBYV(:,:,:),PCOEFLIN_LBYV(:,:,:))
    END IF
    
    !-------------------------------------------------------------------------------
    !
    !*      3.   W FIELD TREATMENT
    !            -----------------
    !
    !*      3.1  Horizontal Bikhardt interpolation
    !
    PLBXWM=0.
    PLBYWM=0.
    !
    CALL BIKHARDT (PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
                   PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
                   2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,4,       &
                                               HLBCX,HLBCY,ZTWM,ZWORK)
    DEALLOCATE(ZTWM)
    !
    ILBX2=SIZE(PLBXWM,1)
    IF(LWEST_ll( ).AND.LEAST_ll( )) THEN
      ILBX=ILBX2/2
    ELSE
      ILBX=ILBX2
    ENDIF
    !
    IF(LWEST_ll( ) .AND. ILBX/=0) THEN
      PLBXWM(1:ILBX,IJB:IJE,:)=ZWORK(IIB:IIB-1+ILBX,IJB:IJE,:)
    ENDIF
    !
    IF(LEAST_ll( ) .AND. ILBX/=0) THEN
      PLBXWM(ILBX2-ILBX+1:ILBX2,IJB:IJE,:)=ZWORK(IIE+1-ILBX:IIE,IJB:IJE,:)
    ENDIF
    !
    ILBY2=SIZE(PLBYWM,2)
    IF(LSOUTH_ll( ).AND.LNORTH_ll( )) THEN
      ILBY=ILBY2/2
    ELSE
      ILBY=ILBY2
    ENDIF
    !
    IF(LSOUTH_ll( ) .AND. ILBY/=0) THEN
      PLBYWM(IIB:IIE,1:ILBY,:)=ZWORK(IIB:IIE,IJB:IJB-1+ILBY,:)
    ENDIF
    !
    IF(LNORTH_ll( ) .AND. ILBY/=0) THEN
      PLBYWM(IIB:IIE,ILBY2-ILBY+1:ILBY2,:)=ZWORK(IIB:IIE,IJE+1-ILBY:IJE,:)
    ENDIF
    !
    !*      1.2  Vertical interpolation
    !
    IF ( SIZE(PLBXWM,1) /= 0 .AND. GVERT_INTERP) THEN
      PLBXWM(:,:,:) = VER_INTERP_LIN(PLBXWM(:,:,:),   &
                                       KKLIN_LBXW(:,:,:),PCOEFLIN_LBXW(:,:,:))
    END IF
    !
    IF ( SIZE(PLBYWM,1) /= 0 .AND. GVERT_INTERP) THEN
      PLBYWM(:,:,:) = VER_INTERP_LIN(PLBYWM(:,:,:),   &
                                       KKLIN_LBYW(:,:,:),PCOEFLIN_LBYW(:,:,:))
    END IF
    !
    !
    !
    !-------------------------------------------------------------------------------
    !
    !*      5.   COMPUTE LARGE SCALE SOURCES FOR POTENTIAL TEMPERATURE
    !            -----------------------------------------------------
    !
    CALL COMPUTE_LB_M(PLBXTHM,PLBYTHM,ZTTHM,XTH00)
    !
    DEALLOCATE(ZTTHM)
    !
    !
    !-------------------------------------------------------------------------------
    !
    !*      6.   COMPUTE LARGE SCALE SOURCES FOR TURBULENT KINETIC ENERGY
    !            --------------------------------------------------------
    !
    !
    
    IF (SIZE(XTKET,3) == 0 .OR. SIZE(PLBXTKEM,3) == 0) THEN
    
      PLBXTKEM(:,:,:) = 0.                      ! turbulence not activated
      PLBYTKEM(:,:,:) = 0.
    ELSE
      CALL COMPUTE_LB_M(PLBXTKEM,PLBYTKEM,ZTTKEM)
      DEALLOCATE(ZTTKEM)
    ENDIF
    !
    !-------------------------------------------------------------------------------
    !
    !*      7.   COMPUTE LARGE SCALE SOURCES FOR MOIST VARIABLES
    !            -----------------------------------------------
    !
    !
    IF (IRR == 0 ) THEN
      PLBXRM(:,:,:,:) = 0.                      ! water cycle not activated
      PLBYRM(:,:,:,:) = 0.
    ELSE
      DO JRR = 1,IRR
        CALL COMPUTE_LB_M(PLBXRM(:,:,:,JRR),PLBYRM(:,:,:,JRR),ZTRM(:,:,:,JRR))
      END DO
      DEALLOCATE(ZTRM)
    !
      IF ( SIZE(PLBXRM,1) /= 0 ) PLBXRM(:,:,:,IRR+1:SIZE(PLBXRM,4)) = 0.
      IF ( SIZE(PLBYRM,1) /= 0 ) PLBYRM(:,:,:,IRR+1:SIZE(PLBYRM,4)) = 0.
    !
    END IF
    !
    !-------------------------------------------------------------------------------
    !
    !*      8.   COMPUTE LARGE SCALE SOURCES FOR SCALAR VARIABLES
    !            ------------------------------------------------
    !
    !
    IF (NSV_A(KMI) > 0) THEN
      DO JSV = 1,NSV_A(KMI)
        CALL COMPUTE_LB_M(PLBXSVM(:,:,:,JSV),PLBYSVM(:,:,:,JSV),ZTSVM(:,:,:,JSV))
      END DO
      DEALLOCATE(ZTSVM)
    ELSE
      PLBXSVM(:,:,:,:) = 0.
      PLBYSVM(:,:,:,:) = 0.
    END IF
    !
    DEALLOCATE(ZWORK)
    DEALLOCATE(ZCOEFLIN_LBXM_RED,ZCOEFLIN_LBYM_RED,IKLIN_LBXM_RED,IKLIN_LBYM_RED)
    !
    CALL GOTO_MODEL(KMI)
    !------------------------------------------------------------------------------
    !
    CONTAINS
    !
    !
    !     ################################################
          SUBROUTINE COMPUTE_LB_M(PLBX,PLBY,PTFIELD,PTH00)
    !     ################################################
    !
    REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBX,PLBY ! source term
    REAL, DIMENSION(:,:,:), INTENT(IN)  :: PTFIELD   ! ls forcing array
    REAL, OPTIONAL, INTENT(IN)          :: PTH00 ! reference temperature
    !
    IF(PRESENT(PTH00)) THEN
      PLBX=PTH00 ! to avoid undefined computation
      PLBY=PTH00
    ELSE
      PLBX=0.
      PLBY=0.
    ENDIF
    !
    !*    Horizontal Bikhardt interpolation
    !
    !
    CALL BIKHARDT (PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
                   PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
                   2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
                                               HLBCX,HLBCY,PTFIELD,ZWORK)
    !
    ILBX2=SIZE(PLBX,1)
    IF(LWEST_ll( ).AND.LEAST_ll( )) THEN
      ILBX=ILBX2/2
    ELSE
      ILBX=ILBX2
    ENDIF
    !
    IF(LWEST_ll( ) .AND. ILBX/=0) THEN
      PLBX(1:ILBX,IJB:IJE,:)=ZWORK(IIB:IIB-1+ILBX,IJB:IJE,:)
    ENDIF
    !
    IF(LEAST_ll( ) .AND. ILBX/=0) THEN
      PLBX(ILBX2-ILBX+1:ILBX2,IJB:IJE,:)=ZWORK(IIE+1-ILBX:IIE,IJB:IJE,:)
    ENDIF
    !
    ILBY2=SIZE(PLBY,2)
    IF(LSOUTH_ll( ).AND.LNORTH_ll( )) THEN
      ILBY=ILBY2/2
    ELSE
      ILBY=ILBY2
    ENDIF
    !
    IF(LSOUTH_ll( ) .AND. ILBY/=0) THEN
      PLBY(IIB:IIE,1:ILBY,:)=ZWORK(IIB:IIE,IJB:IJB-1+ILBY,:)
    ENDIF
    !
    IF(LNORTH_ll( ) .AND. ILBY/=0) THEN
      PLBY(IIB:IIE,ILBY2-ILBY+1:ILBY2,:)=ZWORK(IIB:IIE,IJE+1-ILBY:IJE,:)
    ENDIF
    !
    !*    Vertical interpolation
    !
    IF ( SIZE(PLBX,1) /= 0 .AND. GVERT_INTERP) THEN
    
      IF ( ILBX == KRIMX+JPHEXT ) THEN
    
        PLBX(:,:,:) = VER_INTERP_LIN(PLBX(:,:,:),   &
                                 KKLIN_LBXM(:,:,:),PCOEFLIN_LBXM(:,:,:))
      ELSE
        PLBX(:,:,:) = VER_INTERP_LIN(PLBX(:,:,:),  &
                              IKLIN_LBXM_RED(:,:,:),ZCOEFLIN_LBXM_RED(:,:,:))
      END IF
    END IF
    !
    IF ( SIZE(PLBY,1) /= 0 .AND. GVERT_INTERP) THEN
    
      IF ( ILBY == KRIMY+JPHEXT ) THEN
    
        PLBY(:,:,:) = VER_INTERP_LIN(PLBY(:,:,:),   &
                                       KKLIN_LBYM(:,:,:),PCOEFLIN_LBYM(:,:,:))
      ELSE
        PLBY(:,:,:) = VER_INTERP_LIN(PLBY(:,:,:),   &
                              IKLIN_LBYM_RED(:,:,:),ZCOEFLIN_LBYM_RED(:,:,:))
      END IF
    END IF
    !
    !
    END SUBROUTINE  COMPUTE_LB_M
    !
    END SUBROUTINE INI_ONE_WAY_n