! This directive is necessary to stop pre-computing the reciprocal of ZCOSLA5
! leads to bad test of adjoint /MH
!OCL NOEVAL
SUBROUTINE LARCHEAD(KPROMA,KSTART,KPROF,KFLEV,&
 & KSTTYP,PDSTRET,PC2M1,PC2P1,PI,PDEPI,&
 & PLOCEN,PMUCEN,PCOLON,PSILON,&
 & PGEMU,PGSQM2,PGECLO,PGESLO,&
 & PCOSCO,PSINCO,PSINLA,PCOPHI,&
 & PCOSCO5,PSINCO5,PSINLA5,PCOPHI5,&
 & KROT,PLON,PLAT,PO,PQ)

!**** *LARCHEAD - semi-LAgrangian scheme:   (adjoint version)
!                 Research of the Coordinates (of the medium or origin
!                 point).

!     Purpose.
!     --------
!       Computes the longitude and latitude of the interpolation
!       point from its cartesian coordinates.
!       Then computes the vector displacement matrix
!                        I po pq I
!                        I       I
!                        I-pq po I
!       from the interpolation point to the grid point.

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

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

!        INPUT:
!          KPROMA  - horizontal dimension.
!          KSTART  - first element of arrays where computations are performed.
!          KPROF   - depth of work.
!          KFLEV   - vertical dimension.
!          KSTTYP  - 1: Not tilted pole;  2: Tilted pole.
!          PDSTRET - 2*c (where c is the stretching factor).
!          PC2M1   - c*c-1.
!          PC2P1   - c*c+1.
!          PI      - number PI
!          PDEPI   - 2 * PI
!          PLOCEN  - geographic longitude of the stretching pole.
!          PMUCEN  - sinus of the geographic latitude of the stretching pole.
!          PCOLON  - cosinus of the g.p. longitude on the computational sphere.
!          PSILON  - sinus of the g.p. longitude on the computational sphere.
!          PGEMU   - sinus of the grid-point geographic latitude.
!          PGSQM2  - cosinus of the grid-point geographic latitude.
!          PGECLO  - cosinus of the grid-point geographic longitude.
!          PGESLO  - sinus of the grid-point geographic longitude.

!        INOUT (INPUT IN TL):
!          PCOSCO  - cos(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographic lon and lat).
!          PSINCO  - sin(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographic lon and lat).
!          PSINLA  - sinus of the interpolation point geographic latitude.
!          PCOPHI  - cosinus of the geographic angle between the
!                    interpolation point and the grid-point.

!        INPUT (trajectory):
! ----------------------- trajectory variables -------------------------
!          PCOSCO5 - cos(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographic lon and lat).
!          PSINCO5 - sin(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographic lon and lat).
!          PSINLA5 - sinus of the interpolation point geographic latitude.
!          PCOPHI5 - cosinus of the geographic angle between the
!                    interpolation point and the grid-point.
! ----------------------------------------------------------------------

!        INPUT:
!          KROT    - KROT=1: computation of the elements po and pq
!                    of the wind displacement matrix.
!                    KROT=0: no computation.

!        INOUT (OUTPUT IN TL):
!          PLON    - longitude of the interpolation point in the
!                    computational sphere.
!          PLAT    - latitude of the interpolation point in the
!                    computational sphere.
!          PO      - first element of the wind displacement matrix.
!          PQ      - second element of the wind displacement matrix.

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

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------

!        No external.

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

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

!     Modifications.
!     --------------
!      Original : 98/10/20
!      Modified 00-06-13 by C. Temperton: More careful treatment of    
!                  strange angles (to match modifications in LARCHETL).
!      Modified 00-11-10 by C. Temperton: bugfix (compatibility with TL)
!      M.Hamrud      01-Oct-2003 CY28 Cleaning
!      K. Yessad: Aug 2005 : code AD+TL for variable mesh.
!      K. Yessad (Sep 2008): update comments + cleanings.
!     ------------------------------------------------------------------

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

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTTYP 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDSTRET
REAL(KIND=JPRB)   ,INTENT(IN)    :: PC2M1 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PC2P1
REAL(KIND=JPRB)   ,INTENT(IN)    :: PI 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDEPI 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLOCEN
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMUCEN
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLON(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSILON(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEMU(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGSQM2(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGECLO(KPROMA)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGESLO(KPROMA)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOSCO(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINCO(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINLA(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOPHI(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOSCO5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSINCO5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSINLA5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOPHI5(KPROMA,KFLEV) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KROT 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLON(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLAT(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PO(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQ(KPROMA,KFLEV) 

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

INTEGER(KIND=JPIM) :: JLEV, JROF

REAL(KIND=JPRB) :: ZPO5(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZPQ5(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZPLON5(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZPLAT5(KPROMA,KFLEV)

REAL(KIND=JPRB) :: ZCOSLA5(KPROMA)
REAL(KIND=JPRB) :: ZCOSLA(KPROMA)
REAL(KIND=JPRB) :: ZXX5(KPROMA)
REAL(KIND=JPRB) :: ZYY5(KPROMA)
REAL(KIND=JPRB) :: ZYY(KPROMA)
REAL(KIND=JPRB) :: ZZW5(KPROMA)
REAL(KIND=JPRB) :: ZZA5(KPROMA)
REAL(KIND=JPRB) :: ZCOSLR5(KPROMA)
REAL(KIND=JPRB) :: ZCOSLR(KPROMA)
REAL(KIND=JPRB) :: ZCOSL2(KPROMA)
REAL(KIND=JPRB) :: ZDECO5(KPROMA)
REAL(KIND=JPRB) :: ZDI5(KPROMA)
REAL(KIND=JPRB) :: ZDI(KPROMA)
REAL(KIND=JPRB) :: Z1ST5(KPROMA)
REAL(KIND=JPRB) :: Z1STT5(KPROMA)
REAL(KIND=JPRB) :: ZZP5(KPROMA)
REAL(KIND=JPRB) :: ZZX5(KPROMA)
REAL(KIND=JPRB) :: ZZY5(KPROMA)
REAL(KIND=JPRB) :: ZZZ5(KPROMA)
REAL(KIND=JPRB) :: ZZZ(KPROMA)
REAL(KIND=JPRB) :: ZRP5(KPROMA)
REAL(KIND=JPRB) :: ZRQ5(KPROMA)
REAL(KIND=JPRB) :: ZCA5(KPROMA)
REAL(KIND=JPRB) :: ZSA5(KPROMA)
REAL(KIND=JPRB) :: ZFACT5(KPROMA)
REAL(KIND=JPRB) :: ZZSINLA5(KPROMA)
REAL(KIND=JPRB) :: ZZCOSLA5(KPROMA)
REAL(KIND=JPRB) :: ZZSILON5(KPROMA)
REAL(KIND=JPRB) :: ZCOSL25(KPROMA)

REAL(KIND=JPRB) :: ZFACT, ZCOSCO, ZSINCO, ZSINLA, Z1ST, Z1STT, ZDECO
REAL(KIND=JPRB) :: ZPSLAP, ZPCLAP, ZPSLOP, ZPCLOP
REAL(KIND=JPRB) :: ZMU, ZXX, ZZA, ZZW, ZZY, ZZX, ZZP, ZP, ZQ, ZCA, ZSA
REAL(KIND=JPRB) :: ZEPS1

LOGICAL         :: LLSTR

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "larche5.intfb.h"

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

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

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

!*       1.    COMPUTATION OF LAT LON OF THE INTERPOLATION POINT.
!              IF KROT=1 COMPUTATION OF THE WIND DISPLACEMENT MATRIX
!              FROM THE INTERPOLATION POINT TO THE FINAL POINT.
!              ( T FOR LATITUDE THETA, L FOR LONGITUDE LAMBDA).
!              PO = ( 1 / (1+cos(PHI)) )
!                  *( cos(TG)*cos(T) + (1+sin(TG)*sin(T))*cos(L-LG) )
!              PQ = (-1 / (1+cos(PHI)) )
!                  *( sin(TG)+sin(T) ) * sin(L-LG)
!     ------------------------------------------------------------------

! K.Y.: definition of LLSTR (c>1) must be the same everywhere in the code.
ZEPS1=100.0_JPRB*TINY(1.0_JPRB)
LLSTR=(ABS(0.5_JPRB*PDSTRET-1.0_JPRB)>ZEPS1)

IF(KSTTYP == 1.AND.(.NOT.LLSTR)) THEN

!        POLE STRETCHING, NO POLE TILTING.

  DO JLEV=1,KFLEV

    CALL LARCHE5(KPROMA,KSTART,KPROF,KFLEV,JLEV,&
     & KSTTYP,PDSTRET,PC2M1,PC2P1,PI,PDEPI,&
     & PLOCEN,PMUCEN,PCOLON,PSILON,&
     & PGEMU,PGSQM2,PGECLO,PGESLO,&
     & PCOSCO5,PSINCO5,PSINLA5,PCOPHI5,&
     & KROT,ZPLON5,ZPLAT5,ZPO5,ZPQ5,&
     & ZCOSLR5,ZCOSLA5,ZCOSL25,ZXX5,ZYY5,ZZW5,ZZA5,ZDECO5,Z1ST5,&
     & ZFACT5,ZZSINLA5,ZZCOSLA5,ZZSILON5,&
     & ZZY5,ZZX5,ZDI5,ZZZ5,ZZP5,Z1STT5,ZRP5,ZRQ5,ZCA5,ZSA5)

    ZCOSLR(:) = 0.0_JPRB

    IF (KROT == 1) THEN
      DO JROF=KSTART,KPROF

        ! KY: already done in LARCHE5
        ZDECO5(JROF)=1.0_JPRB/(1.0_JPRB+PCOPHI5(JROF,JLEV))
        ! KY: already done in LARCHE5
        Z1ST5(JROF) = 1.0_JPRB/ZCOSLA5(JROF)

        PSINLA(JROF,JLEV)=PSINLA(JROF,JLEV)&
         & -PSINCO5(JROF,JLEV)*Z1ST5(JROF)*ZDECO5(JROF)*PQ(JROF,JLEV)  
        ZDECO=-(PGEMU(JROF)+PSINLA5(JROF,JLEV))*&
         & PSINCO5(JROF,JLEV)*Z1ST5(JROF)*PQ(JROF,JLEV)  
        Z1ST=-(PGEMU(JROF)+PSINLA5(JROF,JLEV))*&
         & PSINCO5(JROF,JLEV)*ZDECO5(JROF)*PQ(JROF,JLEV)  
        PSINCO(JROF,JLEV)=PSINCO(JROF,JLEV)&
         & -(PGEMU(JROF)+PSINLA5(JROF,JLEV))&
         & *Z1ST5(JROF)*ZDECO5(JROF)*PQ(JROF,JLEV)  
        ZDECO=ZDECO+(PGSQM2(JROF)*ZCOSLR5(JROF) &
         & +(1.0_JPRB+PGEMU(JROF)*PSINLA5(JROF,JLEV))&
         & *PCOSCO5(JROF,JLEV)*Z1ST5(JROF))*PO(JROF,JLEV)  
        ZCOSLR(JROF)=ZCOSLR(JROF)+ZDECO5(JROF)*PGSQM2(JROF)*PO(JROF,JLEV)
        Z1ST=Z1ST+ZDECO5(JROF)*(1.0_JPRB+PGEMU(JROF)*PSINLA5(JROF,JLEV))&
         & *PCOSCO5(JROF,JLEV)*PO(JROF,JLEV)  
        PCOSCO(JROF,JLEV)=PCOSCO(JROF,JLEV)&
         & +ZDECO5(JROF)*Z1ST5(JROF)*(1.0_JPRB+PGEMU(JROF)*&
         & PSINLA5(JROF,JLEV))*PO(JROF,JLEV)  
        PSINLA(JROF,JLEV)=PSINLA(JROF,JLEV)&
         & +ZDECO5(JROF)*Z1ST5(JROF)*PCOSCO5(JROF,JLEV)*PGEMU(JROF)&
         & *PO(JROF,JLEV)  
        PCOPHI(JROF,JLEV)=PCOPHI(JROF,JLEV)-ZDECO5(JROF)*ZDECO5(JROF)*ZDECO
        ZCOSLR(JROF)=ZCOSLR(JROF)-Z1ST5(JROF)*Z1ST5(JROF)*Z1ST
        PO(JROF,JLEV)=0.0_JPRB
        PQ(JROF,JLEV)=0.0_JPRB
      ENDDO
    ENDIF

    DO JROF=KSTART,KPROF

      IF (ABS(ZZA5(JROF)) >= SQRT(0.5_JPRB)) THEN
        ZZW = -PLON(JROF,JLEV)/ZZA5(JROF)
        ZXX = ZZW/ZCOSLA5(JROF)
        ZCOSLA(JROF) = -(ZXX5(JROF)*ZZW/ZCOSLA5(JROF))/ZCOSLA5(JROF)
        PCOSCO(JROF,JLEV)=PCOSCO(JROF,JLEV)+PCOLON(JROF)*ZXX
        PSINCO(JROF,JLEV)=PSINCO(JROF,JLEV)-PSILON(JROF)*ZXX
      ELSE
        ZZA = PLON(JROF,JLEV)/ZZW5(JROF)
        ZYY(JROF) = ZZA/ZCOSLA5(JROF)
        ZCOSLA(JROF) = -(ZYY5(JROF)*ZZA/ZCOSLA5(JROF))/ZCOSLA5(JROF)
        PCOSCO(JROF,JLEV)=PCOSCO(JROF,JLEV)+PSILON(JROF)*ZYY(JROF)
        PSINCO(JROF,JLEV)=PSINCO(JROF,JLEV)+PCOLON(JROF)*ZYY(JROF)
      ENDIF

      ZMU=PLAT(JROF,JLEV)/ZCOSLA5(JROF)
        
      PSINLA(JROF,JLEV)=PSINLA(JROF,JLEV)+ZMU
      ZCOSLR(JROF)=ZCOSLR(JROF)+ZCOSLA(JROF)
      PCOSCO(JROF,JLEV)=PCOSCO(JROF,JLEV)+PCOSCO5(JROF,JLEV)*&
       & ZCOSLR(JROF)/ZCOSLR5(JROF)  
      PSINCO(JROF,JLEV)=PSINCO(JROF,JLEV)+PSINCO5(JROF,JLEV)*&
       & ZCOSLR(JROF)/ZCOSLR5(JROF)  
      PLON(JROF,JLEV)=0.0_JPRB
      PLAT(JROF,JLEV)=0.0_JPRB

    ENDDO
  ENDDO

ELSEIF(KSTTYP == 1.AND.LLSTR) THEN

  !        POLE STRETCHING, NO POLE TILTING.

  ! K.Y.: this piece of code is also valid for ksttyp=1, c=1.

  DO JLEV=1,KFLEV

    CALL LARCHE5(KPROMA,KSTART,KPROF,KFLEV,JLEV,&
     & KSTTYP,PDSTRET,PC2M1,PC2P1,PI,PDEPI,&
     & PLOCEN,PMUCEN,PCOLON,PSILON,&
     & PGEMU,PGSQM2,PGECLO,PGESLO,&
     & PCOSCO5,PSINCO5,PSINLA5,PCOPHI5,&
     & KROT,ZPLON5,ZPLAT5,ZPO5,ZPQ5,&
     & ZCOSLR5,ZCOSLA5,ZCOSL25,ZXX5,ZYY5,ZZW5,ZZA5,ZDECO5,Z1ST5,&
     & ZFACT5,ZZSINLA5,ZZCOSLA5,ZZSILON5,&
     & ZZY5,ZZX5,ZDI5,ZZZ5,ZZP5,Z1STT5,ZRP5,ZRQ5,ZCA5,ZSA5)

    ZCOSLR(:) = 0.0_JPRB
    ZCOSLA(:) = 0.0_JPRB

    IF (KROT == 1) THEN
      ! * Compute PO and PQ when required:
      !   (code identical to the ksttyp=1, c=1 case)
      DO JROF=KSTART,KPROF

        PSINLA(JROF,JLEV)=PSINLA(JROF,JLEV) &
         & -PSINCO5(JROF,JLEV)*Z1ST5(JROF)*ZDECO5(JROF)*PQ(JROF,JLEV)
        ZDECO=-(PGEMU(JROF)+PSINLA5(JROF,JLEV))* &
         & PSINCO5(JROF,JLEV)*Z1ST5(JROF)*PQ(JROF,JLEV)
        Z1ST=-(PGEMU(JROF)+PSINLA5(JROF,JLEV))* &
         & PSINCO5(JROF,JLEV)*ZDECO5(JROF)*PQ(JROF,JLEV)
        PSINCO(JROF,JLEV)=PSINCO(JROF,JLEV) &
         & -(PGEMU(JROF)+PSINLA5(JROF,JLEV)) &
         & *Z1ST5(JROF)*ZDECO5(JROF)*PQ(JROF,JLEV)

        ZDECO=ZDECO+(PGSQM2(JROF)*ZCOSLR5(JROF) &
         & +(1.0_JPRB+PGEMU(JROF)*PSINLA5(JROF,JLEV)) &
         & *PCOSCO5(JROF,JLEV)*Z1ST5(JROF))*PO(JROF,JLEV)
        ZCOSLR(JROF)=ZCOSLR(JROF)+ZDECO5(JROF)*PGSQM2(JROF)*PO(JROF,JLEV)
        Z1ST=Z1ST+ZDECO5(JROF)*(1.0_JPRB+PGEMU(JROF)*PSINLA5(JROF,JLEV)) &
         & *PCOSCO5(JROF,JLEV)*PO(JROF,JLEV)
        PCOSCO(JROF,JLEV)=PCOSCO(JROF,JLEV) &
         & +ZDECO5(JROF)*Z1ST5(JROF)*(1.0_JPRB+PGEMU(JROF)* &
         & PSINLA5(JROF,JLEV))*PO(JROF,JLEV)
        PSINLA(JROF,JLEV)=PSINLA(JROF,JLEV) &
         & +ZDECO5(JROF)*Z1ST5(JROF)*PCOSCO5(JROF,JLEV)*PGEMU(JROF) &
         & *PO(JROF,JLEV)
        
        PCOPHI(JROF,JLEV)=PCOPHI(JROF,JLEV)-ZDECO5(JROF)*ZDECO5(JROF)*ZDECO
        ZCOSLR(JROF)=ZCOSLR(JROF)-Z1ST5(JROF)*Z1ST5(JROF)*Z1ST

        PO(JROF,JLEV)=0.0_JPRB
        PQ(JROF,JLEV)=0.0_JPRB

      ENDDO
    ENDIF

    DO JROF=KSTART,KPROF

      ! * PLON:
      ZZW=-PLON(JROF,JLEV)/ZZSILON5(JROF)
      ZXX=(ZZW5(JROF)/ZXX5(JROF))*ZZW
      ZCOSLA(JROF)=ZCOSLA(JROF)-(ZZW5(JROF)/ZCOSLA5(JROF))*ZZW
      PLON(JROF,JLEV)=0.0_JPRB

      ! * PLAT:
      ZMU=PLAT(JROF,JLEV)/ZZCOSLA5(JROF)
      ZSINLA=ZMU
      PLAT(JROF,JLEV)=0.0_JPRB

      ! * Intermediate quantities:
      ZCOSCO=PCOLON(JROF)*ZXX
      ZSINCO=-PSILON(JROF)*ZXX
      PSINLA(JROF,JLEV)=PSINLA(JROF,JLEV)+ZZSINLA5(JROF)*&
       & (PC2P1/(PC2P1*PSINLA5(JROF,JLEV)-PC2M1)&
       & +PC2M1/(PC2P1-PC2M1*PSINLA5(JROF,JLEV)))&
       & *ZSINLA
      ZFACT=ZCOSLR5(JROF)*ZCOSLA(JROF)
      ZCOSLR(JROF)=ZCOSLR(JROF)+ZFACT5(JROF)*ZCOSLA(JROF)
      ZFACT=ZFACT+PSINCO5(JROF,JLEV)*ZSINCO+PCOSCO5(JROF,JLEV)*ZCOSCO
      PSINCO(JROF,JLEV)=PSINCO(JROF,JLEV)+ZFACT5(JROF)*ZSINCO
      PCOSCO(JROF,JLEV)=PCOSCO(JROF,JLEV)+ZFACT5(JROF)*ZCOSCO
      PSINLA(JROF,JLEV)=PSINLA(JROF,JLEV) &
       & +(PC2M1/PDSTRET)*ZFACT5(JROF)*ZFACT5(JROF)*ZFACT
      PCOSCO(JROF,JLEV)=PCOSCO(JROF,JLEV)+ &
       & (PCOSCO5(JROF,JLEV)/ZCOSLR5(JROF))*ZCOSLR(JROF)
      PSINCO(JROF,JLEV)=PSINCO(JROF,JLEV)+ &
       & (PSINCO5(JROF,JLEV)/ZCOSLR5(JROF))*ZCOSLR(JROF)

    ENDDO

  ENDDO

ELSEIF(KSTTYP == 2) THEN

  !        POLE TILTING.

  ZPSLAP = PMUCEN
  ZPCLAP = SQRT(1.0_JPRB-PMUCEN*PMUCEN)
  ZPSLOP = SIN(PLOCEN)
  ZPCLOP = COS(PLOCEN)

  DO JLEV=1,KFLEV

    CALL LARCHE5(KPROMA,KSTART,KPROF,KFLEV,JLEV,&
     & KSTTYP,PDSTRET,PC2M1,PC2P1,PI,PDEPI,&
     & PLOCEN,PMUCEN,PCOLON,PSILON,&
     & PGEMU,PGSQM2,PGECLO,PGESLO,&
     & PCOSCO5,PSINCO5,PSINLA5,PCOPHI5,&
     & KROT,ZPLON5,ZPLAT5,ZPO5,ZPQ5,&
     & ZCOSLR5,ZCOSLA5,ZCOSL25,ZXX5,ZYY5,ZZW5,ZZA5,ZDECO5,Z1ST5,&
     & ZFACT5,ZZSINLA5,ZZCOSLA5,ZZSILON5,&
     & ZZY5,ZZX5,ZDI5,ZZZ5,ZZP5,Z1STT5,ZRP5,ZRQ5,ZCA5,ZSA5)

    ZCOSL2(:) = 0.0_JPRB
    ZCOSLR(:) = 0.0_JPRB
    ZCOSLA(:) = 0.0_JPRB
    ZYY(:) = 0.0_JPRB
    ZDI(:) = 0.0_JPRB
    ZZZ(:) = 0.0_JPRB

    IF (KROT == 1) THEN
      ! * Compute PO and PQ when required:
      DO JROF=KSTART,KPROF

        ZCA=ZRP5(JROF)*PO(JROF,JLEV)+ZRQ5(JROF)*PQ(JROF,JLEV)
        ZSA=ZRQ5(JROF)*PO(JROF,JLEV)-ZRP5(JROF)*PQ(JROF,JLEV)
        ZP=ZCA5(JROF)*PO(JROF,JLEV)-ZSA5(JROF)*PQ(JROF,JLEV)
        ZQ=ZSA5(JROF)*PO(JROF,JLEV)+ZCA5(JROF)*PQ(JROF,JLEV)

        Z1STT=-ZPCLAP*ZYY5(JROF)*ZSA+PDSTRET*ZDI5(JROF)* &
         & (ZPSLAP*ZCOSL25(JROF)-ZPCLAP*PSINLA5(JROF,JLEV)*ZZZ5(JROF))*ZCA
        ZYY(JROF)=ZYY(JROF)-ZPCLAP*Z1STT5(JROF)*ZSA
        ZDI(JROF)=ZDI(JROF)+PDSTRET* &
         & (ZPSLAP*ZCOSL25(JROF)-ZPCLAP*PSINLA5(JROF,JLEV)*ZZZ5(JROF)) &
         & *Z1STT5(JROF)*ZCA
        ZCOSL2(JROF)=ZCOSL2(JROF)+PDSTRET*ZDI5(JROF)*Z1STT5(JROF)*ZPSLAP*ZCA
        PSINLA(JROF,JLEV)=PSINLA(JROF,JLEV) &
         & -PDSTRET*ZDI5(JROF)*Z1STT5(JROF)*ZPCLAP*ZZZ5(JROF)*ZCA
        ZZZ(JROF)=ZZZ(JROF) &
         & -PDSTRET*ZDI5(JROF)*Z1STT5(JROF)*ZPCLAP*PSINLA5(JROF,JLEV)*ZCA
        Z1ST=(Z1STT5(JROF)/Z1ST5(JROF))*Z1STT
        ZCOSLA(JROF)=ZCOSLA(JROF)-(Z1STT5(JROF)/ZCOSLA5(JROF))*Z1STT

        PSINLA(JROF,JLEV)=PSINLA(JROF,JLEV) &
         & -PSINCO5(JROF,JLEV)*Z1ST5(JROF)*ZDECO5(JROF)*ZQ &
         & +ZDECO5(JROF)*PCOSCO5(JROF,JLEV)*Z1ST5(JROF)*PGEMU(JROF)*ZP
        PSINCO(JROF,JLEV)=PSINCO(JROF,JLEV) &
         & -(PGEMU(JROF)+PSINLA5(JROF,JLEV))*Z1ST5(JROF)*ZDECO5(JROF)*ZQ
        Z1ST=Z1ST-(PGEMU(JROF)+PSINLA5(JROF,JLEV)) &
         & *PSINCO5(JROF,JLEV)*ZDECO5(JROF)*ZQ &
         & +ZDECO5(JROF)*(1.0_JPRB+PGEMU(JROF)*PSINLA5(JROF,JLEV)) &
         & *PCOSCO5(JROF,JLEV)*ZP
        ZDECO=-(PGEMU(JROF)+PSINLA5(JROF,JLEV)) &
         & *PSINCO5(JROF,JLEV)*Z1ST5(JROF)*ZQ &
         & +(PGSQM2(JROF)*ZCOSLR5(JROF) &
         & +(1.0_JPRB+PGEMU(JROF)*PSINLA5(JROF,JLEV)) &
         & *PCOSCO5(JROF,JLEV)*Z1ST5(JROF) )*ZP
        ZCOSLR(JROF)=ZCOSLR(JROF)+ZDECO5(JROF)*PGSQM2(JROF)*ZP
        PCOSCO(JROF,JLEV)=PCOSCO(JROF,JLEV)+ZDECO5(JROF) &
         & *(1.0_JPRB+PGEMU(JROF)*PSINLA5(JROF,JLEV))*Z1ST5(JROF)*ZP

        ZCOSLR(JROF)=ZCOSLR(JROF)-Z1ST5(JROF)*Z1ST5(JROF)*Z1ST
        PCOPHI(JROF,JLEV)=PCOPHI(JROF,JLEV)-ZDECO5(JROF)*ZDECO5(JROF)*ZDECO

        PO(JROF,JLEV)=0.0_JPRB
        PQ(JROF,JLEV)=0.0_JPRB

      ENDDO
    ENDIF

    DO JROF=KSTART,KPROF

      ! * PLON:
      ZZW=-PLON(JROF,JLEV)/ZZSILON5(JROF)
      ZXX=(ZZW5(JROF)/ZXX5(JROF))*ZZW
      ZCOSLA(JROF)=ZCOSLA(JROF)-(ZZW5(JROF)/ZCOSLA5(JROF))*ZZW
      PLON(JROF,JLEV)=0.0_JPRB

      ! * PLAT:
      ZMU=PLAT(JROF,JLEV)/ZZCOSLA5(JROF)
      ZSINLA=ZMU
      PLAT(JROF,JLEV)=0.0_JPRB

      ! * Intermediate quantities:
      ZDI(JROF)=ZDI(JROF)-(PC2M1-PC2P1*ZZP5(JROF))*ZSINLA 
      ZZP=PC2P1*ZDI5(JROF)*ZSINLA
      ZXX=ZXX+(ZXX5(JROF)/ZCOSLA5(JROF))*ZCOSLA(JROF)
      ZYY(JROF)=ZYY(JROF)+(ZYY5(JROF)/ZCOSLA5(JROF))*ZCOSLA(JROF)
      PSINLA(JROF,JLEV)=PSINLA(JROF,JLEV)+PDSTRET*ZDI5(JROF)*ZPCLAP*ZXX
      ZZZ(JROF)=ZZZ(JROF)-PDSTRET*ZDI5(JROF)*ZPSLAP*ZXX
      ZDI(JROF)=ZDI(JROF) &
       & +PDSTRET*(ZPCLAP*PSINLA5(JROF,JLEV)-ZPSLAP*ZZZ5(JROF))*ZXX &
       & +PDSTRET*(-ZPCLOP*ZZY5(JROF)+ZPSLOP*ZZX5(JROF))*ZYY(JROF)
      ZZY=-PDSTRET*ZPCLOP*ZDI5(JROF)*ZYY(JROF)
      ZZX=PDSTRET*ZPSLOP*ZDI5(JROF)*ZYY(JROF)
      ZZP=ZZP+PC2M1*ZDI5(JROF)*ZDI5(JROF)*ZDI(JROF)
      PSINLA(JROF,JLEV)=PSINLA(JROF,JLEV)+ZPSLAP*ZZP
      ZZZ(JROF)=ZZZ(JROF)+ZPCLAP*ZZP
      ZZX=ZZX+ZPCLOP*ZZZ(JROF)
      ZZY=ZZY+ZPSLOP*ZZZ(JROF)
      ZCOSL2(JROF)=ZCOSL2(JROF)+(0.5_JPRB/ZCOSLR5(JROF))*ZCOSLR(JROF)
      ZZY=ZZY+2.0_JPRB*ZZY5(JROF)*ZCOSL2(JROF)
      ZZX=ZZX+2.0_JPRB*ZZX5(JROF)*ZCOSL2(JROF)
      PCOSCO(JROF,JLEV)=PCOSCO(JROF,JLEV)+PGECLO(JROF)*ZZX+PGESLO(JROF)*ZZY
      PSINCO(JROF,JLEV)=PSINCO(JROF,JLEV)-PGESLO(JROF)*ZZX+PGECLO(JROF)*ZZY

    ENDDO

  ENDDO

ENDIF

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

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