SUBROUTINE LARMES25(KASLB1,KPROMA,KSTART,KPROF,KGLN,&
 & KGLX,KFLDN,KFLDX,KDLUN,KDLUX,KDGUN,KDGUX,&
 & KSTABUF,&
 & KVLAG,KWLAG,&
 & KITER,LDPLANE,LDSETTLS,LDELTRA,&
 & PURL05,PVRL05,PURL5,PVRL5,&
 & KSTTYP,PDSTRET,PC2M1,PC2P1,P4JP,PI,PDEPI,PIS2,&
 & PDTSA,PDTS62,PDTS22,&
 & PLOCEN,PMUCEN,PLSDEPI,PLATI,PIPI0,PIPI1,PIPI2,&
 & PCOLON,PSILON,PGEMU,PGSQM2,PGECLO,PGESLO,&
 & PNORDL,PNORDM,&
 & PCOSCO5,PSINCO5,PSINLA5,PCOPHI5,&
 & PR5,PS5,PUF5,PVF5)  

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

!**** *LARMES25 - semi-LAgrangian scheme:  (adjoint version)
!                Research of the MEdium point on the Sphere (2-d model)

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

!     The computation of the location of the medium point I 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.
!     (Repeat of computations in LARMES2, but useful results are
!     saved at each iteration - used by adjoint of semi-Lagrangian
!     scheme)

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

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

!        INPUT:
!          KASLB1  - horizontal dimension of SLBUF1.
!          KPROMA  - horizontal dimension.
!          KSTART  - first element of arrays where
!                    computations are performed.
!          KPROF   - depth of work.
!          KGLN    - lower dimension for latitude.
!          KGLX    - upper dimension for latitude.
!          KFLDN   - number of the first field.
!          KFLDX   - number of the last field.
!          KDLUN   - first column on the cartesian plane grid.
!          KDLUX   - last  column on the cartesian plane grid.
!          KDGUN   - first row    on the cartesian plane grid.
!          KDGUX   - last  row    on the cartesian plane grid.
!          KSTABUF - for a latitude IGL, KSTABUF(IGL) is the
!                    address of the element corresponding to
!                    (ILON=1,IGL) in the KPROMA arrays.
!          KVLAG   - Switch for discretization of continuity equation.
!          KWLAG   - Switch for discretization of momentum equation.
!          KITER   - Number of iterations for computing the medium point.
!          LDPLANE - switch: .T. = plane geometry; .F. = spherical geometry.
!          LDSETTLS- switch: .T. = SETTLS two-time-level scheme
!          LDELTRA - switch: .T. = "elegant" algorithm to find origin point
!----------------------trajectory variables-----------------------------
!          PURL05  - U-component of the wind, to be interpolated.
!          PVRL05  - V-component of the wind, to be interpolated.
!          PURL5   - U-component of the wind.
!          PVRL5   - V-component of the wind.
!-----------------------------------------------------------------------
!          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.
!          P4JP    - Approximative inverse of the differences of latitudes.
!          PI      - number PI
!          PDEPI   - 2 * PI
!          PIS2    - PI / 2
!          PDTSA   - (Delta t/a)
!          PDTS62  - (Delta t/a)*(Delta t/a)/6
!          PDTS22  - (Delta t/a)*(Delta t/a)/2
!          PLOCEN  - geographical longitude of the stretching pole.
!          PMUCEN  - sine of the geographical latitude of the pole.
!          PLSDEPI - (Number of points by latitude) / (2 * PI) .
!          PLATI   - latitude on the computational sphere.
!          PIPI0   - coefficients for the bicubic interpolations.
!          PIPI1   -      "
!          PIPI2   -      "
!          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.

!        OUTPUT:
!----------------------trajectory variables-----------------------------
!          PCOSCO5 - cos(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographical longitude
!                    and latitude).
!          PSINCO5 - sin(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographical longitude
!                    and latitude).
!          PSINLA5 - sine of the interpolation point geographical latitude.
!          PCOPHI5 - cosine of the geographical angle between the
!                    interpolation point and the grid-point.
!          PR5     - first element of the wind displacement matrix.
!          PS5     - second element of the wind displacement matrix.
!          PUF5    - interpolated U-component of the wind
!          PVF5    - interpolated V-component of the wind
!-----------------------------------------------------------------------

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

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

!     Externals.
!     ----------
!        Calls  LARCIN2.
!        Is called by LADINEAD (2D shallow water model).

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

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

!     Modifications.
!     --------------
!     Original : 99/01/15
!     Modified 01-08-30 by K. YESSAD: pruning and some other cleanings.
!     R. El Khatib : 01-08-07 Pruning options
!     M.Hamrud      01-Oct-2003 CY28 Cleaning
!     K. Yessad Nov 2008: rationalisation of dummy argument interfaces
!     ------------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KASLB1 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGLN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGLX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KITER 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLUN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLUX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGUN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGUX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTABUF(KGLN:KGLX) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVLAG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KWLAG 
LOGICAL           ,INTENT(IN)    :: LDPLANE 
LOGICAL           ,INTENT(IN)    :: LDSETTLS 
LOGICAL           ,INTENT(IN)    :: LDELTRA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PURL05(KASLB1,KFLDN:KFLDX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVRL05(KASLB1,KFLDN:KFLDX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PURL5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVRL5(KPROMA) 
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)    :: P4JP 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PI 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDEPI 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIS2 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDTSA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDTS62 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDTS22 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLOCEN 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMUCEN 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSDEPI(KGLN:KGLX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLATI(KGLN:KGLX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIPI0(KGLN:KGLX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIPI1(KGLN:KGLX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIPI2(KGLN:KGLX) 
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(IN)    :: PNORDL(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNORDM(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOSCO5(KPROMA,KITER) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINCO5(KPROMA,KITER) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINLA5(KPROMA,KITER) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOPHI5(KPROMA,KITER) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PR5(KPROMA,KITER) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PS5(KPROMA,KITER) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUF5(KPROMA,KITER) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVF5(KPROMA,KITER) 

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

REAL(KIND=JPRB) :: ZLON5(KPROMA)
REAL(KIND=JPRB) :: ZLAT5(KPROMA)

INTEGER(KIND=JPIM) :: IWISA
INTEGER(KIND=JPIM) :: IXLAG(6)

INTEGER(KIND=JPIM) :: IROT, JITER, JROF

LOGICAL :: LLQMHP, LLQMHW

REAL(KIND=JPRB) :: ZC0(1), ZCL0(1), ZDTS22, ZDTS62, ZDTSA, ZINT5,&
 & ZNOR25, ZPU5, ZPV5, ZSPHSV5, ZU0(1), ZUL0(1), ZV0(1), &
 & ZVL0(1), ZZUZ0(1), ZZVZ0(1)  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "larcin2.intfb.h"

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

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

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

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

IXLAG(1)=KVLAG
IXLAG(4)=KWLAG

IF((LDSETTLS.OR.LDELTRA).AND.(KITER > 1)) THEN
  ZDTS22=PDTS22*4
  ZDTSA=PDTSA*2
  ZDTS62=PDTS62*4
ELSE
  ZDTS22=PDTS22
  ZDTSA=PDTSA
  ZDTS62=PDTS62
ENDIF

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

!*       2.    ITERATIONS.
!              -----------

DO JITER=1,KITER

!*       2.1   DETERMINATION OF THE MEDIUM POINT "M".

!       Computation of the norm of the real 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 (LDSETTLS=T or LDELTRA=T) and JITER < KITER, 
!       the origin point "O" is computed
!       instead of the medium point "M", and "M" is computed only at
!       the last iteration (JITER = KITER).

  IF (JITER == 1) THEN

    DO JROF=KSTART,KPROF

!             computations on horizontal plans.

      ZNOR25= ( PURL5(JROF)*PURL5(JROF)+PVRL5(JROF)*PVRL5(JROF) )
      PCOPHI5(JROF,1)=1.0_JPRB-ZDTS22*ZNOR25
      ZSPHSV5          =ZDTSA*(1.0_JPRB-ZDTS62*ZNOR25)
      ZINT5= ( PURL5(JROF)*PNORDL(JROF)+PVRL5(JROF)*PNORDM(JROF) )*ZSPHSV5
      PSINLA5(JROF,1)= PGEMU(JROF)*PCOPHI5(JROF,1)-ZINT5*PGSQM2(JROF)
      PCOSCO5(JROF,1)= PGSQM2(JROF)*PCOPHI5(JROF,1)+ZINT5* PGEMU(JROF)
      PSINCO5(JROF,1)=-( PURL5(JROF)*PNORDM(JROF)&
       & -PVRL5(JROF)*PNORDL(JROF) )*ZSPHSV5  

    ENDDO

  ELSE

    DO JROF=KSTART,KPROF

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

      IF(LDSETTLS) THEN
        ZPU5= 0.5_JPRB*(PR5(JROF,JITER-1)*PUF5(JROF,JITER-1)&
         & +PS5(JROF,JITER-1)*PVF5(JROF,JITER-1)&
         & +PURL5(JROF)*PNORDM(JROF)&
         & -PVRL5(JROF)*PNORDL(JROF))  
        ZPV5=0.5_JPRB*(-PS5(JROF,JITER-1)*PUF5(JROF,JITER-1)&
         & +PR5(JROF,JITER-1)*PVF5(JROF,JITER-1)&
         & +PURL5(JROF)*PNORDL(JROF)&
         & +PVRL5(JROF)*PNORDM(JROF))  
      ELSE
        ZPU5= PR5(JROF,JITER-1)*PUF5(JROF,JITER-1)&
         & +PS5(JROF,JITER-1)*PVF5(JROF,JITER-1)  
        ZPV5=-PS5(JROF,JITER-1)*PUF5(JROF,JITER-1)&
         & +PR5(JROF,JITER-1)*PVF5(JROF,JITER-1)  
      ENDIF
      ZNOR25            =(ZPU5*ZPU5+ZPV5*ZPV5)
      IF (JITER == KITER) THEN
        PCOPHI5(JROF,JITER) =1.0_JPRB-PDTS22*ZNOR25
        ZSPHSV5      =PDTSA*(1.0_JPRB-PDTS62*ZNOR25)
      ELSE
        PCOPHI5(JROF,JITER) =1.0_JPRB-ZDTS22*ZNOR25
        ZSPHSV5      =ZDTSA*(1.0_JPRB-ZDTS62*ZNOR25)
      ENDIF
      ZINT5             =ZPV5*ZSPHSV5
      PSINLA5(JROF,JITER) = PGEMU(JROF)*PCOPHI5(JROF,JITER)-ZINT5*PGSQM2(JROF)
      PCOSCO5(JROF,JITER) = PGSQM2(JROF)*PCOPHI5(JROF,JITER)+ZINT5*  &
       & PGEMU(JROF)  
      PSINCO5(JROF,JITER) =-ZPU5*ZSPHSV5

    ENDDO

  ENDIF

!*       2.2   DETERMINATION OF THE WIND AT THE MEDIUM POINT "I".

  IF (JITER /= KITER) THEN

!         If (LDSETTLS=T or LDELTRA=T) and JITER < KITER,
!         the 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".

    IWISA=1
    IROT=1

!          Warning: ZUL0,ZVL0,ZCL0,
!                   ZU0,ZV0,ZC0,
!                   ZZUZ0,ZZVZ0,LLQMHW,LLQMHP
!                   are not used in this call of LARCIN2.

    CALL LARCIN2(KASLB1,KPROMA,KSTART,KPROF,KGLN,KGLX,KFLDN,&
     & KFLDX,KDLUN,KDLUX,KDGUN,KDGUX,&
     & KSTABUF,&
     & IWISA,IXLAG,IROT,LDPLANE,&
     & LLQMHW,LLQMHP,&
     & KSTTYP,PDSTRET,PC2M1,PC2P1,P4JP,PI,PDEPI,PIS2,&
     & PLOCEN,PMUCEN,PLSDEPI,PLATI,PIPI0,PIPI1,PIPI2,&
     & PCOLON,PSILON,PGEMU,PGSQM2,PGECLO,PGESLO,&
     & PCOSCO5(1,JITER),PSINCO5(1,JITER),&
     & PSINLA5(1,JITER),PCOPHI5(1,JITER),&
     & PURL05,PVRL05,&
     & ZUL0,ZVL0,ZCL0,ZUL0,ZVL0,ZCL0,&
     & ZLON5,ZLAT5,&
     & PR5(1,JITER),PS5(1,JITER),&
     & PUF5(1,JITER),PVF5(1,JITER),&
     & ZU0,ZV0,ZC0,&
     & ZZUZ0,ZZVZ0)  
  ENDIF

ENDDO

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

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