SUBROUTINE LARMESAD(KSTGLO,KST,KPROF,KSTABUF,LDSETTLS,PB1,PB15,PB2,&
 & PINC,KINC,KDIM1,KDIM2,&
 & PLSDEPI,PCOLON,PSILON,PGEMU,PGSQM2,PGECLO,PGESLO,PNORDL,PNORDM,&
 & PLON,PLAT,PCOSCO,PSINCO,PSINLA,PCOPHI,PLEV,KL0,KLOCK,&
 & PLON5,PLAT5,PCOSCO5,PSINCO5,PSINLA5,PCOPHI5,PLEV5,PR5,PS5,PUF5,PVF5,&
 & PDLO5,PDLAT5,PDVER5)  

!**** *LARMESAD - semi-LAgrangian scheme:  (adjoint version)
!                Research of the MEdium point on the Sphere.
!                (and also the origin point).

!     Purpose.
!     --------

!      The computation of the location of the medium point "M" of
!     the lagrangian trajectory is performed by an iterative
!     method described by Robert and adapted to the sphere by M. Rochas.
!     Trajectories are great circles.
!     Finally we find the departure (origin) point "O".

!**   Interface.
!     ----------
!        *CALL* *LARMESAD(...)

!        Explicit arguments :
!        --------------------

!          KSTGLO  - global offset into nproma buffer.
!          KST     - first element of arrays where computations are performed.
!          KPROF   - depth of work.
!          KSTABUF - for a latitude IGL, KSTABUF(IGL) is the
!                    address of the element corresponding to
!                    (ILON=1,IGL) in the NPROMA arrays.
!          LDSETTLS- .T./.F.: Stable/Conventional algorithm of trajectory
!                    research in the 2TLSL scheme.
!          PB1     - SLBUF1-buffer for interpolations.
!          PB15    - SLBUF1-buffer for interpolations (trajectory).
!          PB2     - SLBUF2-buf to communicate info from non lag. to lag. dyn.
!          KDIM1,KDIM2 - dimensions of KINC, PINC
!          KINC    - addresses of interpolation increments in global buffer
!          PINC    - interpolation increments to global buffer (vector only)
!          PLSDEPI - (Number of points by latitude) / (2 * PI) .
!          PCOLON  - cosine of the grid-point longitude on the 
!                    computational sphere.
!          PSILON  - sine of the grid-point longitude on the
!                    computational sphere.
!          PGEMU   - sine of the grid-point geographical latitude.
!          PGSQM2  - cosine of the grid-point geographical latitude.
!          PGECLO  - cosine of the grid-point geographical longitude.
!          PGESLO  - sine of the grid-point geographical longitude.
!          PNORDL  - zonal component of the normalized vector directed
!                    towards the geographical north pole.
!          PNORDM  - meridian component of the normalized vector directed
!                    towards the geographical north pole.
!          PLON    - computational sphere longitude of interpolation point.
!          PLAT    - computational sphere latitude of interpolation point.
!          PCOSCO  - cos(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographical longitude
!                    and latitude).
!          PSINCO  - sin(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographical longitude
!                    and latitude).
!          PSINLA  - sine of the interpolation point geographical latitude.
!          PCOPHI  - cosine of the geographical angle between the
!                    interpolation point and the grid-point.
!          PLEV    - vertical coordinate of the interpolation point.
!          KL0     - index of the four western points
!                    of the 16 points interpolation grid.
!          KLOCK   - ??? (used for OpenMP purposes).

!        TRAJECTORY:
!          PLON5   - cf. PLON                                       (out)
!          PLAT5   - cf. PLAT                                       (out)
!          PCOSCO5 - cf. PCOSCO                                     (in)
!          PSINCO5 - cf. PSINCO                                     (in)
!          PSINLA5 - cf. PSINLA                                     (in)
!          PCOPHI5 - cf. PCOPHI                                     (in)
!          PLEV5   - cf. PLEV                                       (in)
!          PR5     - cf. PR                                         (in)
!          PS5     - cf. PS                                         (in)
!          PUF5    - interpolated U-wind.                           (in)
!          PVF5    - interpolated V-wind.                           (in)
!          PDLO5   - cf. PDLO                                       (in)
!          PDLAT5  - cf. PDLAT                                      (in)
!          PDVER5  - cf. PDVER                                      (in)

!        Implicit arguments :
!        --------------------

!     Method.
!     -------
!        See documentation about semi-Lagrangian scheme.

!     Externals.
!     ----------
!        Calls  LARCINAAD.
!        Is called by LAPINEAAD (3D model) 

!     Reference.
!     ----------

!     Author.
!     -------
!        C. Temperton (ECMWF)

!     Modifications.
!     --------------
!      Original : 99/10/11
!      Modified 00-02-09 by C. Temperton: changed call to LARCINAD
!      Modified 00-06-12 by C. Temperton: Bugfixes related to vertical
!                                         bounding of medium point.
!      Modified 00-06-15 by C. Temperton: KVSEP -> KVSEPC,KVSEPL.
!      Modified 01-08-30 by K. YESSAD: pruning and some other cleanings.
!      Modified 03-04-14 by D. Salmond FIX for event logic
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!      Modified 05-01-11 by C. Temperton: streamlining.
!      Modified 05-02-02 by C. Temperton: transfer computations from
!                               end of LAIDEPAD to start of LARMESAD.
!      Modified 06-09-04 by F. Vana: Bugfix of vertical bounding when
!                                    LSETTLS=LELTRA=.F.
!      Modified 08-Jan-2007 by F. Vana: - IDEP (used only in LAM)
!                                       - moving LRPLANE code to ELARMES
!      Modified 14-Aug-2008 by F. Vana: update of arguments for LARCINAAD
!      K. Yessad Nov 2008: rationalisation of dummy argument interfaces
!      F. Vana :     11-Dec-2008 OpenMP for vector platforms
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMDIM    , ONLY : NFLEVG   ,NPROMA   ,NFLSA    ,NFLEN    ,NDGSAH   ,&
 & NDGENH   ,NRLEVX
USE YOMDYN    , ONLY : NITMP    ,LELTRA   ,VETAON   ,VETAOX
USE YOMGEM    , ONLY : VETAH    ,VETAF
USE YOMMP     , ONLY : NASLB1
USE YOMRIP    , ONLY : RDTSA    ,RDTS62   ,RDTS22   ,RTDT
USE YOMSC2    , ONLY : NFLDSLB1 ,NFLDSLB15,NFLDSLB2
USE YOMSEP    , ONLY : NVSEPC   ,NVSEPL
USE PTRSLB1   , ONLY : MSLB1UR0 ,MSLB1VR0 ,MSLB1WR0
USE PTRSLB15  , ONLY : MSLB1UR05,MSLB1VR05,MSLB1WR05
USE PTRSLB2   , ONLY : MSLB2URL ,MSLB2VRL ,MSLB2WRL ,MSLB2URL5,MSLB2VRL5

!     ------------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KST 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTABUF(NDGSAH:NDGENH) 
LOGICAL           ,INTENT(IN)    :: LDSETTLS 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PB1(NASLB1,NFLDSLB1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PB15(NASLB1,NFLDSLB15)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PB2(NPROMA,NFLDSLB2)
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM1
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM2
INTEGER(KIND=JPIM),INTENT(INOUT) :: KINC(KDIM1,KDIM2,NITMP)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PINC(KDIM1,KDIM2,NITMP)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSDEPI(NDGSAH:NDGENH) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLON(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSILON(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEMU(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGSQM2(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGECLO(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGESLO(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNORDL(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNORDM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLON(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLAT(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOSCO(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINCO(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINLA(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOPHI(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLEV(NPROMA,NFLEVG) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KL0(NPROMA,NFLEVG,0:3,NITMP)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KLOCK(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLON5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLAT5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOSCO5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSINCO5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSINLA5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOPHI5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLEV5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PR5(NPROMA,NFLEVG,NITMP-1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PS5(NPROMA,NFLEVG,NITMP-1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUF5(NPROMA,NFLEVG,NITMP-1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVF5(NPROMA,NFLEVG,NITMP-1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDLO5(NPROMA,NFLEVG,0:3,NITMP)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDLAT5(NPROMA,NFLEVG,NITMP)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDVER5(NPROMA,NFLEVG,NITMP)

!     ------------------------------------------------------------------

INTEGER(KIND=JPIM) :: IROT, ITIP, JITER, JLEV, JROF, IINC

LOGICAL :: LLO
LOGICAL :: LLSLHD,LLSLHDQUAD
LOGICAL :: LLOCK_UP

REAL(KIND=JPRB) :: ZDTS22, ZDTS62, ZDTSA, ZINT, &
 & ZLEVO, ZLEVO5, ZNOR2, ZPU, ZPV, ZSPHSV, &
 & ZVETAON, ZVETAOX, ZNOR25, ZSPHSV5, ZPU5, ZPV5

REAL(KIND=JPRB) :: ZUF(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZVF(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZWF(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZR(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZS(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZDLAT(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZCLA(NPROMA,NFLEVG,3)
REAL(KIND=JPRB) :: ZDLO(NPROMA,NFLEVG,0:3)
REAL(KIND=JPRB) :: ZDVER(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZVINTW(NPROMA,NFLEVG,3)

!  unused arguments to LARCINAAD (they can be passed to LAPINEAAD
!  but there's no reason for it, as only the linear interpolation
!  is concerned at this stage)
! a) input arrays
REAL(KIND=JPRB) :: ZUN_KAPPA5(1)
! b) input/output arrays - dimensions kept for safety
REAL(KIND=JPRB) :: ZUN_KAPPA(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZUN_CLO(NPROMA,NFLEVG,3,2)
REAL(KIND=JPRB) :: ZUN_CLOSLD(NPROMA,NFLEVG,3,2)
REAL(KIND=JPRB) :: ZUN_CLASLD(NPROMA,NFLEVG,3)
REAL(KIND=JPRB) :: ZUN_VINTWSLD(NPROMA,NFLEVG,3)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

!     ------------------------------------------------------------------

#include "larcinaad.intfb.h"

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('LARMESAD',0,ZHOOK_HANDLE)

!     ------------------------------------------------------------------

!*       1.    PRELIMINARY INITIALISATIONS AND TESTS.
!              --------------------------------------

!*       1.2   Miscellaneous preliminary initialisations.

LLO=LDSETTLS

IF(LLO.OR.LELTRA) THEN
  ZDTS22=RDTS22*4
  ZDTSA=RDTSA*2
  ZDTS62=RDTS62*4
ELSE
  ZDTS22=RDTS22
  ZDTSA=RDTSA
  ZDTS62=RDTS62
ENDIF

ZVETAON=(1.0_JPRB-VETAON)*VETAH(0)+VETAON*VETAF(1)
ZVETAOX=(1.0_JPRB-VETAOX)*VETAH(NFLEVG)+VETAOX*VETAF(NFLEVG)

! deactivate computation of SLHD weights
LLSLHD     =.FALSE.
LLSLHDQUAD =.FALSE.

!     ------------------------------------------------------------------

!*       3.    COMPUTATION OF THE ORIGIN POINT "O" COORDINATES.
!              ------------------------------------------------

IF (.NOT.(LLO.OR.LELTRA)) THEN

  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF

      ! Computation of the angle <0,G>:

      PCOPHI(JROF,JLEV)=4._JPRB*PCOPHI(JROF,JLEV)*PCOPHI5(JROF,JLEV,NITMP)

      ! computations on a vertical.

      ! Use of <=, >= is necessary here because PLEV5 has already been
      ! bounded!
      IF (PLEV5(JROF,JLEV,NITMP) <= ZVETAON) THEN
        PLEV(JROF,JLEV)=0.0_JPRB
      ELSEIF (PLEV5(JROF,JLEV,NITMP) >= ZVETAOX) THEN
        PLEV(JROF,JLEV)=0.0_JPRB
      ENDIF
      PLEV(JROF,JLEV)=2.0_JPRB*PLEV(JROF,JLEV)

      ! computations on horizontal plans.

      PCOPHI(JROF,JLEV)=PCOPHI(JROF,JLEV)+     &
       & 2.0_JPRB*PCOSCO5(JROF,JLEV,NITMP)*PCOSCO(JROF,JLEV)
      PCOSCO(JROF,JLEV)=2.0_JPRB*PCOPHI5(JROF,JLEV,NITMP)*PCOSCO(JROF,JLEV)
      PCOPHI(JROF,JLEV)=PCOPHI(JROF,JLEV)+     &
       & 2.0_JPRB*PSINCO5(JROF,JLEV,NITMP)*PSINCO(JROF,JLEV)
      PSINCO(JROF,JLEV)=2.0_JPRB*PCOPHI5(JROF,JLEV,NITMP)*PSINCO(JROF,JLEV)
      PCOPHI(JROF,JLEV)=PCOPHI(JROF,JLEV)+     &
       & 2.0_JPRB*PSINLA5(JROF,JLEV,NITMP)*PSINLA(JROF,JLEV)
      PSINLA(JROF,JLEV)=2.0_JPRB*PCOPHI5(JROF,JLEV,NITMP)*PSINLA(JROF,JLEV)

    ENDDO
  ENDDO

ENDIF

!     ------------------------------------------------------------------

!*       2.    ITERATIONS.       (Adjoint)
!              -----------

DO JITER=NITMP,1,-1

  !*       2.2   DETERMINATION OF THE "(a/rs)*wind" AT "M" OR "O".

  IF(JITER /= NITMP) THEN
    LLOCK_UP=(JITER == 1)

    ! If (LLO=T or LELTRA=T)
    ! and JITER < NITMP "(a/rs)*wind" is interpolated at
    ! the origin point "O" instead of at the medium point "M".
    ! In the other cases the wind is interpolated at "M".

    IROT=1
    ITIP=1

    ! Compute number of updates for LARCINAAD:
    ! 3D-linear interpolations, 8 each :
    IINC=24

    CALL LARCINAAD(IINC,KSTGLO,KST,KPROF, &
     & KSTABUF,LLSLHD,LLSLHDQUAD,ITIP,IROT,.FALSE.,LLOCK_UP,PLSDEPI,&
     & PCOLON,PSILON,PGEMU,PGSQM2,PGECLO,PGESLO,&
     & PCOSCO,PSINCO,PSINLA,PCOPHI,PLEV,&
     & PCOSCO5(1,1,JITER),PSINCO5(1,1,JITER),&
     & PSINLA5(1,1,JITER),PCOPHI5(1,1,JITER),PLEV5(1,1,JITER),&
     & ZUN_KAPPA,ZUN_KAPPA5,&
     & PB1(1,MSLB1UR0),PB1(1,MSLB1VR0),PB1(1,MSLB1WR0),&
     & PB15(1,MSLB1UR05),PB15(1,MSLB1VR05),PB15(1,MSLB1WR05),&
     & NVSEPC,NVSEPL,KLOCK, &
     & PINC(1,1,JITER),KINC(1,1,JITER),KDIM1,KDIM2,&
     & PLON,PLAT,ZR,ZS,&
     & ZUF,ZVF,ZWF,&
     & PLON5(1,1,JITER),PLAT5(1,1,JITER),&
     & KL0(1,1,0,JITER),&
     & ZDLO,ZUN_CLO,ZUN_CLOSLD,ZDLAT,ZCLA,ZUN_CLASLD,ZDVER,ZVINTW,ZUN_VINTWSLD,&
     & PDLO5(1,1,0,JITER),PDLAT5(1,1,JITER),PDVER5(1,1,JITER))  

  ENDIF

  !*       2.1   DETERMINATION OF THE MEDIUM POINT "M" OR THE ORIGIN POINT "O".

  ! Computation of the norm of the real "(a/rs)*wind" vector.
  ! Computation of the angle (PHI=DT . NORM OF V ON RADIUS)**2
  ! then computation of the coordinates of the medium point "M".
  ! If (LLO=T or LELTRA=T) the origin point "O" is computed
  ! instead of the medium point "M".

  IF (JITER == 1) THEN

    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF

        ! computations on horizontal plans.

        ZNOR25=( PB2(JROF,MSLB2URL5+JLEV-1)*PB2(JROF,MSLB2URL5+JLEV-1)&
         & +PB2(JROF,MSLB2VRL5+JLEV-1)*PB2(JROF,MSLB2VRL5+JLEV-1) )  
        ZSPHSV5=ZDTSA*(1.0_JPRB-ZDTS62*ZNOR25)

        ZSPHSV=-( PB2(JROF,MSLB2URL5+JLEV-1)*PNORDM(JROF)&
         & -PB2(JROF,MSLB2VRL5+JLEV-1)*PNORDL(JROF) )*PSINCO(JROF,JLEV)  
        PB2(JROF,MSLB2URL+JLEV-1)=PB2(JROF,MSLB2URL+JLEV-1)&
         & -ZSPHSV5*PNORDM(JROF)*PSINCO(JROF,JLEV)  
        PB2(JROF,MSLB2VRL+JLEV-1)=PB2(JROF,MSLB2VRL+JLEV-1)&
         & +ZSPHSV5*PNORDL(JROF)*PSINCO(JROF,JLEV)  
        ZINT=PGEMU(JROF)*PCOSCO(JROF,JLEV)
        PCOPHI(JROF,JLEV)=PCOPHI(JROF,JLEV)&
         & +PGSQM2(JROF)*PCOSCO(JROF,JLEV)  
        ZINT=ZINT-PGSQM2(JROF)*PSINLA(JROF,JLEV)
        PCOPHI(JROF,JLEV)=PCOPHI(JROF,JLEV)&
         & +PGEMU(JROF)* PSINLA(JROF,JLEV)  
        ZSPHSV=ZSPHSV+( PB2(JROF,MSLB2URL5+JLEV-1)*PNORDL(JROF)&
         & +PB2(JROF,MSLB2VRL5+JLEV-1)*PNORDM(JROF) )*ZINT  
        PB2(JROF,MSLB2URL+JLEV-1)=PB2(JROF,MSLB2URL+JLEV-1)&
         & +ZSPHSV5*PNORDL(JROF)*ZINT
        PB2(JROF,MSLB2VRL+JLEV-1)=PB2(JROF,MSLB2VRL+JLEV-1)&
         & +ZSPHSV5*PNORDM(JROF)*ZINT
        ZNOR2=-ZDTSA*ZDTS62*ZSPHSV
        ZNOR2=ZNOR2-ZDTS22*PCOPHI(JROF,JLEV)
        PB2(JROF,MSLB2URL+JLEV-1)=PB2(JROF,MSLB2URL+JLEV-1)&
         & +2.0_JPRB*PB2(JROF,MSLB2URL5+JLEV-1)*ZNOR2
        PB2(JROF,MSLB2VRL+JLEV-1)=PB2(JROF,MSLB2VRL+JLEV-1)&
         & +2.0_JPRB*PB2(JROF,MSLB2VRL5+JLEV-1)*ZNOR2
        PSINCO(JROF,JLEV)=0.0_JPRB
        PCOSCO(JROF,JLEV)=0.0_JPRB
        PSINLA(JROF,JLEV)=0.0_JPRB
        PCOPHI(JROF,JLEV)=0.0_JPRB

        ! computations on a vertical.

        IF(LLO.OR.LELTRA) THEN
          ZLEVO=PLEV(JROF,JLEV)
          ZLEVO5=PLEV5(JROF,JLEV,JITER)
        ELSE
          ZLEVO=0.5_JPRB*PLEV(JROF,JLEV)
          ZLEVO5=2.0_JPRB*PLEV5(JROF,JLEV,JITER)-VETAF(JLEV)
        ENDIF

        ! Use of <=, >= is necessary here because PLEV5 has already been
        ! bounded!
        IF (ZLEVO5 <= ZVETAON) THEN
          ZLEVO=0.0_JPRB
        ELSEIF (ZLEVO5 >= ZVETAOX) THEN
          ZLEVO=0.0_JPRB
        ENDIF
        PB2(JROF,MSLB2WRL+JLEV-1)=PB2(JROF,MSLB2WRL+JLEV-1)-RTDT*ZLEVO
        PLEV(JROF,JLEV)=0.0_JPRB

      ENDDO
    ENDDO

  ELSE

    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF

        ! ZPU,ZPV are the coordinates of VM in the local repere related to G.

        IF(LLO) THEN
          ZPU5= 0.5_JPRB*(PR5(JROF,JLEV,JITER-1)*PUF5(JROF,JLEV,JITER-1)&
           & +PS5(JROF,JLEV,JITER-1)*PVF5(JROF,JLEV,JITER-1)&
           & +PB2(JROF,MSLB2URL5+JLEV-1)*PNORDM(JROF)&
           & -PB2(JROF,MSLB2VRL5+JLEV-1)*PNORDL(JROF))  
          ZPV5=0.5_JPRB*(-PS5(JROF,JLEV,JITER-1)*PUF5(JROF,JLEV,JITER-1)&
           & +PR5(JROF,JLEV,JITER-1)*PVF5(JROF,JLEV,JITER-1)&
           & +PB2(JROF,MSLB2URL5+JLEV-1)*PNORDL(JROF)&
           & +PB2(JROF,MSLB2VRL5+JLEV-1)*PNORDM(JROF))  
        ELSE
          ZPU5= PR5(JROF,JLEV,JITER-1)*PUF5(JROF,JLEV,JITER-1)&
           & +PS5(JROF,JLEV,JITER-1)*PVF5(JROF,JLEV,JITER-1)  
          ZPV5=-PS5(JROF,JLEV,JITER-1)*PUF5(JROF,JLEV,JITER-1)&
           & +PR5(JROF,JLEV,JITER-1)*PVF5(JROF,JLEV,JITER-1)  
        ENDIF
        ZNOR25            =(ZPU5*ZPU5+ZPV5*ZPV5)
        ZSPHSV5           =ZDTSA*(1.0_JPRB-ZDTS62*ZNOR25)

        ZPU=-ZSPHSV5*PSINCO(JROF,JLEV)
        ZSPHSV=-ZPU5*PSINCO(JROF,JLEV)
        ZINT=PGEMU(JROF)*PCOSCO(JROF,JLEV)
        PCOPHI(JROF,JLEV)=PCOPHI(JROF,JLEV)&
         & +PGSQM2(JROF)*PCOSCO(JROF,JLEV)  
        ZINT=ZINT-PGSQM2(JROF)*PSINLA(JROF,JLEV)
        PCOPHI(JROF,JLEV)=PCOPHI(JROF,JLEV)&
         & +PGEMU(JROF)*PSINLA(JROF,JLEV)  
        ZSPHSV=ZSPHSV+ZPV5*ZINT
        ZPV=ZSPHSV5*ZINT
        ZNOR2=-ZDTSA*ZDTS62*ZSPHSV-ZDTS22*PCOPHI(JROF,JLEV)
        ZPU=ZPU+2.0_JPRB*ZPU5*ZNOR2
        ZPV=ZPV+2.0_JPRB*ZPV5*ZNOR2
        IF(LLO) THEN
          ZR(JROF,JLEV)=0.5_JPRB*(PUF5(JROF,JLEV,JITER-1)*ZPU&
           & +PVF5(JROF,JLEV,JITER-1)*ZPV)  
          ZS(JROF,JLEV)=0.5_JPRB*(PVF5(JROF,JLEV,JITER-1)*ZPU&
           & -PUF5(JROF,JLEV,JITER-1)*ZPV)  
          ZUF(JROF,JLEV)=0.5_JPRB*(PR5(JROF,JLEV,JITER-1)*ZPU&
           & -PS5(JROF,JLEV,JITER-1)*ZPV)  
          ZVF(JROF,JLEV)=0.5_JPRB*(PS5(JROF,JLEV,JITER-1)*ZPU&
           & +PR5(JROF,JLEV,JITER-1)*ZPV)  
          PB2(JROF,MSLB2URL+JLEV-1)=PB2(JROF,MSLB2URL+JLEV-1)&
           & +0.5_JPRB*(PNORDM(JROF)*ZPU+PNORDL(JROF)*ZPV)  
          PB2(JROF,MSLB2VRL+JLEV-1)=PB2(JROF,MSLB2VRL+JLEV-1)&
           & +0.5_JPRB*(PNORDM(JROF)*ZPV-PNORDL(JROF)*ZPU)  
        ELSE
          ZR(JROF,JLEV)=PUF5(JROF,JLEV,JITER-1)*ZPU&
           & +PVF5(JROF,JLEV,JITER-1)*ZPV  
          ZS(JROF,JLEV)=PVF5(JROF,JLEV,JITER-1)*ZPU&
           & -PUF5(JROF,JLEV,JITER-1)*ZPV  
          ZUF(JROF,JLEV)=PR5(JROF,JLEV,JITER-1)*ZPU&
           & -PS5(JROF,JLEV,JITER-1)*ZPV  
          ZVF(JROF,JLEV)=PS5(JROF,JLEV,JITER-1)*ZPU&
           & +PR5(JROF,JLEV,JITER-1)*ZPV  
        ENDIF

        PSINCO(JROF,JLEV)=0.0_JPRB
        PCOSCO(JROF,JLEV)=0.0_JPRB
        PSINLA(JROF,JLEV)=0.0_JPRB
        PCOPHI(JROF,JLEV)=0.0_JPRB

        ! computations on a vertical.

        IF(LLO.OR.LELTRA) THEN
          ZLEVO=PLEV(JROF,JLEV)
          ZLEVO5=PLEV5(JROF,JLEV,JITER)
        ELSE
          ZLEVO=0.5_JPRB*PLEV(JROF,JLEV)
          ZLEVO5=2.0_JPRB*PLEV5(JROF,JLEV,JITER)-VETAF(JLEV)
        ENDIF

        ! Use of <=, >= is necessary here because PLEV5 has already been
        ! bounded!
        IF (ZLEVO5 <= ZVETAON) THEN
          ZLEVO=0.0_JPRB
        ELSEIF (ZLEVO5 >= ZVETAOX) THEN
          ZLEVO=0.0_JPRB
        ENDIF
        ZWF(JROF,JLEV)=-RTDT*ZLEVO
        IF (LLO) THEN
          PB2(JROF,MSLB2WRL+JLEV-1)=PB2(JROF,MSLB2WRL+JLEV-1) &
           & +0.5_JPRB*ZWF(JROF,JLEV)
          ZWF(JROF,JLEV)=0.5_JPRB*ZWF(JROF,JLEV)
        ENDIF
        PLEV(JROF,JLEV)=0.0_JPRB

      ENDDO
    ENDDO

  ENDIF

ENDDO

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('LARMESAD',1,ZHOOK_HANDLE)
END SUBROUTINE LARMESAD
