!OCL  NOEVAL
SUBROUTINE CPDYSLDIA(KPROMA,LDFSTEP,KSTART,KPROF,KFLEV,&
 & PGEMU,PGSQM2,PCOLON,PSP,PDELP,PRESF,PT,PGFL,PEXTRA)

!**** *CPDYSLDIA* - COMPUTATION OF semi-Lagrangian diagnostics

!     Purpose.
!     --------
!      COMPUTATION OF semi-Lagrangian diagnostics
!       - flow Jacobian
!       - Lipschitz number

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

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

!     INPUT:
!        KPROMA    : horizontal dimension.
!        LDFSTEP   : T if first step.
!        KFLEV     : vertical dimension.
!        KSTART    : first element of work.
!        KPROF     : last element of work.
!        PGEMU     : sinus of the grid-point geographical latitude.
!        PGSQM2    : cosine of the grid-point geographical latitude.
!        PCOLON    : cosine of the grid-point longitude on the
!                    computational sphere.
!        PSP       : log(prehyds).
!        PDELP     : hydrostatic pressure depth of layers.
!        PRESF     : hydrostatic pressure "prehyd" at full levels.
!        PT        : temperature at full levels.

!     INOUT:
!        PGFL      : unified_treatment grid-point fields.

!     OUTPUT:
!        PEXTRA    : output array containing diagnostics.

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

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

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

!     Reference.
!     ----------
!        ARPEGE documentation about Eulerian and semi-Lagrangian schemes.

! Author
! ------
!     2008-08-08, Nils Wedi

! Modifications
! -------------
!  K. Yessad (May 2009): cleanings + improve comments.
! End Modifications
!     ------------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULERR
USE YOMCST   , ONLY : RA, RPI, RD, RG
USE YOMCVER  , ONLY : LVERTFE
USE YOM_YGFL , ONLY : YGFL, YSLDIA, YSLDIA_NL, NSLDIA
USE YOMDYN   , ONLY : TSTEP
USE YOMGEM   , ONLY : VDELA, VDELB, VAH, VETAH, VETAF
USE YOMDYNCORE, ONLY: RJACSLDIA, RLIPSLDIA
USE YOMDPHY  , ONLY : NVEXTRDYN

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
LOGICAL,INTENT(IN)               :: LDFSTEP
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEMU(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGSQM2(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLON(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSP(KPROMA)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP(KPROMA,KFLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESF(KPROMA,KFLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KPROMA,KFLEV)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGFL(KPROMA,KFLEV,YGFL%NDIM)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEXTRA(KPROMA,KFLEV,NVEXTRDYN)

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

INTEGER(KIND=JPIM) :: IUTRAJ, IUTRAJL, IUTRAJM
INTEGER(KIND=JPIM) :: IVTRAJ, IVTRAJL, IVTRAJM
INTEGER(KIND=JPIM) :: IWTRAJ, IWTRAJL, IWTRAJM
INTEGER(KIND=JPIM) :: ILAMBDA0, ILAMBDA0L, ILAMBDA0M
INTEGER(KIND=JPIM) :: ITHETA0, ITHETA0L, ITHETA0M
INTEGER(KIND=JPIM) :: IETA0, IETA0L, IETA0M
INTEGER(KIND=JPIM) :: IDPDETA0

INTEGER(KIND=JPIM) :: JLEV, JROF, JGFL
INTEGER(KIND=JPIM) :: IDIA

INTEGER(KIND=JPIM) :: ISTEST0(KPROMA), ISTEST(KPROMA)

REAL(KIND=JPRB) :: ZDLONDE(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZDLATDE(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZDETADE(KPROMA,KFLEV)
 
REAL(KIND=JPRB) :: ZDUR0DE(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZDVR0DE(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZDWR0DE(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZDPDETA(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZDPDETA1(KPROMA,KFLEV)
!REAL(KIND=JPRB) :: ZDPDETA0(KPROMA,KFLEV)

REAL(KIND=JPRB) :: ZDXX, ZDXY, ZDXZ, ZDYX, ZDYY, ZDYZ, ZDZX, ZDZY, ZDZZ

REAL(KIND=JPRB) :: ZLIP, ZJAC, ZFAC

REAL(KIND=JPRB) :: ZJDIA(KPROMA,KFLEV,2)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!#include "verder.intfb.h"

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

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

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

IF( .NOT.LDFSTEP ) THEN
  
  ! dp/deta at model levels at the gridpoint
  IF( LVERTFE ) THEN
    DO JLEV=1,KFLEV
      DO JROF=KSTART,KPROF
        ZDPDETA(JROF,JLEV) = PDELP(JROF,JLEV)/(VETAH(JLEV)-VETAH(JLEV-1))
        ZDPDETA1(JROF,JLEV) = &
         & VDELA(JLEV) + EXP(PSP(JROF))*VDELB(JLEV)
      ENDDO
    ENDDO
  ELSE
    DO JLEV=1,KFLEV
      DO JROF=KSTART,KPROF
        ZDPDETA(JROF,JLEV) = PDELP(JROF,JLEV)/(VETAH(JLEV)-VETAH(JLEV-1))
        ZDPDETA1(JROF,JLEV) = &
         & (VAH(JLEV)-VAH(JLEV-1)) + EXP(PSP(JROF))*VDELB(JLEV)
      ENDDO
    ENDDO
  ENDIF

  ZJDIA(:,:,:) = 0.0_JPRB

  DO JGFL=1,NSLDIA
    IF (YSLDIA_NL(JGFL)%CNAME == 'DPDETA0         ') THEN
      IDPDETA0=YSLDIA(JGFL)%MP
    ELSEIF (YSLDIA_NL(JGFL)%CNAME == 'UTRAJ           ') THEN
      IUTRAJ=YSLDIA(JGFL)%MP
      IUTRAJL=YSLDIA(JGFL)%MPL
      IUTRAJM=YSLDIA(JGFL)%MPM
    ELSEIF(YSLDIA_NL(JGFL)%CNAME == 'VTRAJ           ') THEN
      IVTRAJ=YSLDIA(JGFL)%MP
      IVTRAJL=YSLDIA(JGFL)%MPL
      IVTRAJM=YSLDIA(JGFL)%MPM
    ELSEIF(YSLDIA_NL(JGFL)%CNAME == 'WTRAJ           ') THEN
      IWTRAJ=YSLDIA(JGFL)%MP
      IWTRAJL=YSLDIA(JGFL)%MPL
      IWTRAJM=YSLDIA(JGFL)%MPM
    ELSEIF(YSLDIA_NL(JGFL)%CNAME == 'LAMBDA0         ') THEN
      ILAMBDA0=YSLDIA(JGFL)%MP
      ILAMBDA0L=YSLDIA(JGFL)%MPL
      ILAMBDA0M=YSLDIA(JGFL)%MPM
    ELSEIF(YSLDIA_NL(JGFL)%CNAME == 'THETA0          ') THEN
      ITHETA0=YSLDIA(JGFL)%MP
      ITHETA0L=YSLDIA(JGFL)%MPL
      ITHETA0M=YSLDIA(JGFL)%MPM
    ELSEIF(YSLDIA_NL(JGFL)%CNAME == 'ETA0            ') THEN
      IETA0=YSLDIA(JGFL)%MP
      IETA0L=YSLDIA(JGFL)%MPL
      IETA0M=YSLDIA(JGFL)%MPM
    ENDIF
  ENDDO

  ! compute vertical derivative for LVERTFE, poorly working near boundaries !!!
!!$  IF( LVERTFE ) THEN
!!$
!!$    ! Jacobian
!!$    CALL VERDER(KPROMA,KSTART,KPROF,KFLEV,PGFL(1,1,ILAMBDA0),ZDLONDE)
!!$    CALL VERDER(KPROMA,KSTART,KPROF,KFLEV,PGFL(1,1,ITHETA0),ZDLATDE)
!!$    CALL VERDER(KPROMA,KSTART,KPROF,KFLEV,PGFL(1,1,IETA0),ZDETADE)
!!$
!!$    ! Lipschitz number
!!$    CALL VERDER(KPROMA,KSTART,KPROF,KFLEV,PGFL(1,1,IUTRAJ),ZDUR0DE)
!!$    CALL VERDER(KPROMA,KSTART,KPROF,KFLEV,PGFL(1,1,IVTRAJ),ZDVR0DE)
!!$    CALL VERDER(KPROMA,KSTART,KPROF,KFLEV,PGFL(1,1,IWTRAJ),ZDWR0DE)
!!$
!!$  ELSE

  ! Jacobian
  DO JLEV=2,KFLEV-1
    DO JROF=KSTART,KPROF
      ZDLONDE(JROF,JLEV) = &
       & (PGFL(JROF,JLEV+1,ILAMBDA0)-PGFL(JROF,JLEV-1,ILAMBDA0)) &
       & /(VETAF(JLEV+1)-VETAF(JLEV-1))
      ZDLATDE(JROF,JLEV) = &
       & (PGFL(JROF,JLEV+1,ITHETA0)-PGFL(JROF,JLEV-1,ITHETA0)) &
       & /(VETAF(JLEV+1)-VETAF(JLEV-1))
      ZDETADE(JROF,JLEV) = &
       & (PGFL(JROF,JLEV+1,IETA0)-PGFL(JROF,JLEV-1,IETA0)) &
       & /(VETAF(JLEV+1)-VETAF(JLEV-1))
    ENDDO
  ENDDO
  DO JROF=KSTART,KPROF
    ZDLONDE(JROF,1) = &
     & (PGFL(JROF,2,ILAMBDA0)-PGFL(JROF,1,ILAMBDA0)) &
     & /(VETAF(2)-VETAF(1))
    ZDLATDE(JROF,1) = &
     & (PGFL(JROF,2,ITHETA0)-PGFL(JROF,1,ITHETA0)) &
     & /(VETAF(2)-VETAF(1))
    ZDETADE(JROF,1) = &
     & (PGFL(JROF,2,IETA0)-PGFL(JROF,1,IETA0)) &
     & /(VETAF(2)-VETAF(1))
  ENDDO
  DO JROF=KSTART,KPROF
    ZDLONDE(JROF,KFLEV) = &
     & (PGFL(JROF,KFLEV,ILAMBDA0)-PGFL(JROF,KFLEV-1,ILAMBDA0)) &
     & /(VETAF(KFLEV)-VETAF(KFLEV-1))
    ZDLATDE(JROF,KFLEV) = &
     & (PGFL(JROF,KFLEV,ITHETA0)-PGFL(JROF,KFLEV-1,ITHETA0)) &
     & /(VETAF(KFLEV)-VETAF(KFLEV-1))
    ZDETADE(JROF,KFLEV) = &
     & (PGFL(JROF,KFLEV,IETA0)-PGFL(JROF,KFLEV-1,IETA0)) &
     & /(VETAF(KFLEV)-VETAF(KFLEV-1))
  ENDDO

  ! Lipschitz number
  DO JLEV=2,KFLEV-1
    DO JROF=KSTART,KPROF
      ZDUR0DE(JROF,JLEV) = &
       & (PGFL(JROF,JLEV+1,IUTRAJ)-PGFL(JROF,JLEV-1,IUTRAJ)) &
       & /(VETAF(JLEV+1)-VETAF(JLEV-1))
      ZDVR0DE(JROF,JLEV) = &
       & (PGFL(JROF,JLEV+1,IVTRAJ)-PGFL(JROF,JLEV-1,IVTRAJ)) &
       & /(VETAF(JLEV+1)-VETAF(JLEV-1))
      ZDWR0DE(JROF,JLEV) = &
       & (PGFL(JROF,JLEV+1,IWTRAJ)-PGFL(JROF,JLEV-1,IWTRAJ)) &
       & /(VETAF(JLEV+1)-VETAF(JLEV-1))
    ENDDO
  ENDDO
  DO JROF=KSTART,KPROF
    ZDUR0DE(JROF,1) = &
     & (PGFL(JROF,2,IUTRAJ)-PGFL(JROF,1,IUTRAJ)) &
     & /(VETAF(2)-VETAF(1))
    ZDVR0DE(JROF,1) = &
     & (PGFL(JROF,2,IVTRAJ)-PGFL(JROF,1,IVTRAJ)) &
     & /(VETAF(2)-VETAF(1))
    ZDWR0DE(JROF,1) = &
     & (PGFL(JROF,2,IWTRAJ)-PGFL(JROF,1,IWTRAJ)) &
     & /(VETAF(2)-VETAF(1))
  ENDDO
  DO JROF=KSTART,KPROF
    ZDUR0DE(JROF,KFLEV) = &
     & (PGFL(JROF,KFLEV,IUTRAJ)-PGFL(JROF,KFLEV-1,IUTRAJ)) &
     & /(VETAF(KFLEV)-VETAF(KFLEV-1))
    ZDVR0DE(JROF,KFLEV) = &
     & (PGFL(JROF,KFLEV,IVTRAJ)-PGFL(JROF,KFLEV-1,IVTRAJ)) &
     & /(VETAF(KFLEV)-VETAF(KFLEV-1))
    ZDWR0DE(JROF,KFLEV) = &
     & (PGFL(JROF,KFLEV,IWTRAJ)-PGFL(JROF,KFLEV-1,IWTRAJ)) &
     & /(VETAF(KFLEV)-VETAF(KFLEV-1))
  ENDDO

  ! compute Jacobian

  IDIA=1

  ISTEST0(:)=0
  ISTEST(:)=0
  DO JLEV=1,KFLEV
    DO JROF=KSTART,KPROF

      ! only defined for departure points away from the pole ~81 degrees 
      ! and away from +/-10 degrees around 90E/W longitude
      IF( ABS(PGFL(JROF,JLEV,ITHETA0)) < 0.99_JPRB .AND. & 
       & ABS(PGFL(JROF,JLEV,ILAMBDA0)) < 0.99_JPRB ) THEN 
        ZFAC = RA**2 * PGSQM2(JROF) &
         & /(SQRT(1._JPRB-PGFL(JROF,JLEV,ILAMBDA0)**2)&
         & *SQRT(1._JPRB-PGFL(JROF,JLEV,ITHETA0)**2))

        ZDXX=PGFL(JROF,JLEV,ILAMBDA0L)
        ZDXY=PGFL(JROF,JLEV,ILAMBDA0M)
        ZDXZ=ZDLONDE(JROF,JLEV)
        ZDYX=PGFL(JROF,JLEV,ITHETA0L)
        ZDYY=PGFL(JROF,JLEV,ITHETA0M)
        ZDYZ=ZDLATDE(JROF,JLEV)
        ZDZX=PGFL(JROF,JLEV,IETA0L)
        ZDZY=PGFL(JROF,JLEV,IETA0M)
        ZDZZ=ZDETADE(JROF,JLEV)

        ! J^-1
        ZJAC= ZDXX*ZDYY*ZDZZ+ZDXY*ZDYZ*ZDZX+ZDXZ*ZDYX*ZDZY &
         & -ZDZX*ZDYY*ZDXZ-ZDZY*ZDYZ*ZDXX-ZDZZ*ZDYX*ZDXY
        ZJDIA(JROF,JLEV,IDIA) = ABS(ZFAC * ZJAC*PGFL(JROF,JLEV,IDPDETA0)/ZDPDETA1(JROF,JLEV))
        IF( ZJDIA(JROF,JLEV,IDIA) > RJACSLDIA .OR. & 
         & ZJDIA(JROF,JLEV,IDIA) < ABS(1._JPRB-RJACSLDIA) ) THEN
          ISTEST(JROF) = ISTEST(JROF) + 1._JPRB
        ENDIF
      ELSE
        ZJDIA(JROF,JLEV,IDIA) = 1.0_JPRB
      ENDIF
    ENDDO
  ENDDO

  IF( ANY( ISTEST /= ISTEST0 ) ) THEN
    WRITE(NULERR,'(A,F5.3,A,I6,A)') ' MAX JACOBIAN LARGER ', RJACSLDIA ,&
     & ' ',MAXVAL(ISTEST),' TIMES.'
    ! print statistics
    DO JROF=KSTART,KPROF
      IF( ISTEST(JROF) /= 0 ) THEN
        WRITE(NULERR,*) ' POINT= ',JROF,' MAX (ALL LEVELS) JACOBIAN = ',&
         & MAXVAL(ZJDIA(JROF,1:KFLEV,IDIA))
        WRITE(NULERR,*) ' LON  = ',ACOS(PCOLON(JROF))*180._JPRB/RPI
        WRITE(NULERR,*) ' LAT  = ',ASIN(PGEMU(JROF))*180._JPRB/RPI
      ENDIF
    ENDDO
  ENDIF

  ! compute local Lipschitz number

  IDIA=IDIA+1
  ISTEST(:)=0

  DO JLEV=1,KFLEV
    DO JROF=KSTART,KPROF
      ! convert to d/dz via -(g\rho/m)d/d\eta with m=d\pi/d\eta
      ZFAC=RG*PRESF(JROF,JLEV)/(ZDPDETA(JROF,JLEV)*RD*PT(JROF,JLEV))      
      ZDXX=ABS(TSTEP*PGFL(JROF,JLEV,IUTRAJL))
      ZDXY=ABS(TSTEP*PGFL(JROF,JLEV,IUTRAJM))
      ZDXZ=ZFAC*ABS(TSTEP*ZDUR0DE(JROF,JLEV))
      ZDYX=ABS(TSTEP*PGFL(JROF,JLEV,IVTRAJL))
      ZDYY=ABS(TSTEP*PGFL(JROF,JLEV,IVTRAJM))
      ZDYZ=ZFAC*ABS(TSTEP*ZDVR0DE(JROF,JLEV))
      ZDZX=ABS(TSTEP*PGFL(JROF,JLEV,IWTRAJL))
      ZDZY=ABS(TSTEP*PGFL(JROF,JLEV,IWTRAJM))
      ZDZZ=ZFAC*ABS(TSTEP*ZDWR0DE(JROF,JLEV))

      ! put only horizontal derivatives
      ZLIP=MAX(ZDXX,ZDXY,ZDYX,ZDYY,ZDZX,ZDZY)
      !ZLIP=MAX(ZDXX,ZDXY,ZDXZ,ZDYX,ZDYY,ZDYZ,ZDZX,ZDZY,ZDZZ)
      ZJDIA(JROF,JLEV,IDIA) = ZLIP
      IF( ZLIP > RLIPSLDIA ) THEN
        ISTEST(JROF)   = ISTEST(JROF)+1._JPRB
      ENDIF
    ENDDO
  ENDDO

  IF( ANY( ISTEST /= ISTEST0 ) ) THEN
    WRITE(NULERR,'(A,F5.3,A,I6,A)') ' MAX LOCAL LIPSCHITZ NUMBER LARGER ',RLIPSLDIA,&
     & ' ',MAXVAL(ISTEST),' TIMES.'
    ! print statistics
    DO JROF=KSTART,KPROF
      IF( ISTEST(JROF) /= 0 ) THEN
        WRITE(NULERR,*) ' POINT= ',JROF,' MAX (ALL LEVELS) LIPSCHITZ = ',&
         & MAXVAL(ZJDIA(JROF,1:KFLEV,IDIA))
        WRITE(NULERR,*) ' LON  = ',ACOS(PCOLON(JROF))*180._JPRB/RPI
        WRITE(NULERR,*) ' LAT  = ',ASIN(PGEMU(JROF))*180._JPRB/RPI
      ENDIF
    ENDDO
  ENDIF
ENDIF

IF( NVEXTRDYN > 0 ) THEN
  DO JLEV=1,KFLEV
    DO JROF=KSTART,KPROF
      ! Jacobian
      PEXTRA(JROF,JLEV,1)=ZJDIA(JROF,JLEV,1)
      ! Lipschitz
      PEXTRA(JROF,JLEV,2)=ZJDIA(JROF,JLEV,2)
    ENDDO
  ENDDO
ENDIF

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

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