!OCL NOEVAL
SUBROUTINE LACONEAD(KPROMA,KSTART,KPROF,KFLEV,KSTTYP,&
 & POMEGA,PDSTRET,PC2M1,PC2P1,PMUCEN,PRA,PI,&
 & PLON5,PLAT5,POMVR9L5,POMVR9M5,&
 & PLON,PLAT,POMVR9L,POMVR9M)  

!**** *LACONEAD*  - Analytic computation of 2.Omega.Vec.r 

!     Purpose.
!     --------
!           Computes 2.Omega.Vec.r analytically at any point of the sphere,
!           not necessary a grid-point.    (adjoint version)

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

!        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.
!          POMEGA  - Omega.
!          PDSTRET - 2*c (where c is the stretching factor).
!          PC2M1   - c*c-1.
!          PC2P1   - c*c+1.
!          PMUCEN  - sinus of the geographical latitude of the 
!                    high resolution pole.
!          PRA     - Earth radius.
!          PI      - Number PI.
!          PLON5   - computational sphere longitude. (trajectory) 
!          PLAT5   - computational sphere latitude.  (trajectory)
!          POMVR9L - zonal component of 2*Omega*Vec*r at the point of
!                    coordinates (PLON,PLAT).
!          POMVR9M - meridian component of 2*Omega*Vec*r at the point of
!                    coordinates (PLON,PLAT).

!        OUTPUT (trajectory):
!          POMVR9L5- zonal component of 2*Omega*Vec*r at the point of
!                    coordinates (PLON5,PLAT5).
!          POMVR9M5- meridian component of 2*Omega*Vec*r at the point of
!                    coordinates (PLON5,PLAT5).

!        INPUT/OUTPUT :
!          PLON    - computational sphere longitude. 
!          PLAT    - computational sphere latitude.

!        Implicit arguments :
!        --------------------
!        none.

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

!     Externals.
!     ----------
!        none.
!        Called by LAPINEBAD.

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Clive Temperton (ECMWF), after LACONE.

!     Modifications.
!     --------------
!        Original: 99-01-07.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K. Yessad: Aug 2005 : code AD+TL for variable mesh.
!     ------------------------------------------------------------------

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)    :: POMEGA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDSTRET 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PC2M1 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PC2P1 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMUCEN 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PI 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLON5(KPROMA,KFLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAT5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: POMVR9L5(KPROMA,KFLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: POMVR9M5(KPROMA,KFLEV)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLON(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLAT(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POMVR9L(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POMVR9M(KPROMA,KFLEV) 

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

INTEGER(KIND=JPIM) :: JLEV, JROF

REAL(KIND=JPRB) :: Z2OMR, Z2OMR2C, ZA, ZA5, ZB, ZB5, ZCA, ZCA5, ZCOLA,&
 & ZCOLA5, ZCOLO, ZCOLO5, ZE5, ZSA, ZSA5, ZSILA, ZSILA5, ZSILO, ZSILO5, &
 & ZSQM2CEN
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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

!        1. COMPUTATION.
!        ---------------

IF (KSTTYP == 1) THEN

  Z2OMR2C=2.0_JPRB*POMEGA*PRA*PDSTRET

  DO JLEV=1,KFLEV
    DO JROF=KSTART,KPROF
      ! * Trajectory
      ZSILA5=SIN(PLAT5(JROF,JLEV))
      ZCOLA5=SQRT(1.0_JPRB-ZSILA5*ZSILA5)
      ZA5 =1.0_JPRB/(PC2P1+PC2M1*ZSILA5)
      ! * AD code
      ZCOLA=Z2OMR2C*ZA5*POMVR9L(JROF,JLEV)
      ZA=Z2OMR2C*ZCOLA5*POMVR9L(JROF,JLEV)
      ZSILA=-PC2M1*ZA5*ZA5*ZA
      PLAT(JROF,JLEV)=PLAT(JROF,JLEV)-ZSILA5*ZCOLA+ZCOLA5*ZSILA
    ENDDO
  ENDDO

ELSEIF (KSTTYP == 2) THEN

  ZSQM2CEN = SQRT(1.0_JPRB - PMUCEN*PMUCEN)
  Z2OMR=2.0_JPRB*POMEGA*PRA

  DO JLEV=1,KFLEV
    DO JROF=KSTART,KPROF
      ! * Trajectory
      ZSILA5=SIN(PLAT5(JROF,JLEV))
      ZCOLA5=SQRT(1.0_JPRB-ZSILA5*ZSILA5)
      ZSILO5=SIN(PLON5(JROF,JLEV))
      ZA5 =1.0_JPRB/(PC2P1+PC2M1*ZSILA5)
      ZB5 =PC2P1*ZSILA5+PC2M1
      ! ZE5=sign(cos(plon5)); zcolo5=cos(plon5).
      ZE5=SIGN(1.0_JPRB,MOD(PLON5(JROF,JLEV)+1.5_JPRB*PI,2.0_JPRB*PI)-PI)
      ZCOLO5=ZE5*SQRT(1.0_JPRB-ZSILO5*ZSILO5)
      ZCA5=ZA5*(PDSTRET*PMUCEN*ZCOLA5-ZB5*ZSQM2CEN*ZCOLO5)
      ZSA5=-ZSQM2CEN*ZSILO5
      ! * AD code
      ZSA=-Z2OMR*POMVR9M(JROF,JLEV)
      ZCA=Z2OMR*POMVR9L(JROF,JLEV)
      ZSILO=-ZSQM2CEN*ZSA
      ZA=(PDSTRET*PMUCEN*ZCOLA5-ZB5*ZSQM2CEN*ZCOLO5)*ZCA
      ZCOLA=ZA5*PDSTRET*PMUCEN*ZCA
      ZCOLO=-ZA5*ZB5*ZSQM2CEN*ZCA
      ZB=-ZA5*ZSQM2CEN*ZCOLO5*ZCA
      PLON(JROF,JLEV)=PLON(JROF,JLEV)-ZSILO5*ZCOLO
      ZSILA=-PC2M1*ZA5*ZA5*ZA+PC2P1*ZB
      PLON(JROF,JLEV)=PLON(JROF,JLEV)+ZCOLO5*ZSILO
      PLAT(JROF,JLEV)=PLAT(JROF,JLEV)-ZSILA5*ZCOLA+ZCOLA5*ZSILA
    ENDDO
  ENDDO

ENDIF

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

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

