SUBROUTINE gpspderivs(klev,   & ! no.of observations
                    & khoriz, & ! no. of horizontal layers  ODD
                    & kk, &
                    & pdsep, &
                    & ptheta_min, & 
                    & ptheta_max, & 
                    & ptheta_tan, & 
                    & prtan, &
                    & pamult, &
                    & prefrac, &
                    & pradius, &
                    & py, &
                    & pdydh)



!**** *gpspderivs* - part of the GPSRO observation operator.

!     S. Healy             ECMWF          2005/08/01
!     Based on a GRAS-SAF routine.   

!     PURPOSE
!     -------
!     It evaluates the derivs for the Runge-Kutta routines

!**   INTERFACE
!     ---------

!     CALL gpspderivs(....)    

!     WHERE klev   =  number of vertical levels
!           khoriz =  number of horizontal locations
!           kk      = in the kkth box in the horizontal
!           pdsep  =  angular spacing
!            ptheta_min = minium theta 
!           ptheta_max = maximum theta 
!            ptheta_tan = theta at tangent point & 
!            prtan = radius of tangent point
!           pamult = 
!           prefrac = refractivity
!           pradius = radius value
!           py = current location
!           pdydh = derivs used in the RK calculation

!     gpspderivs is called from gpscalc_alphark

!**   METHOD
!     ------
!     1) calculate the derivs. used in the Runge-Kutta 

!**   EXTERNALS
!     ---------

!**   MODIFICATIONS
!     -------------
!     Sean Healy      2005/08/01 : Original
!     -------------------------------------------------------------------------

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

                   
IMPLICIT NONE

                   
INTEGER(KIND=JPIM), INTENT(IN)  :: klev           ! no. of refractivity levels
INTEGER(KIND=JPIM), INTENT(IN)  :: khoriz         ! no. of horizontal locations
INTEGER(KIND=JPIM), INTENT(IN)  :: kk 
REAL(KIND=JPRB),    INTENT(IN)  :: pdsep           ! angular spacing of grid
REAL(KIND=JPRB),    INTENT(IN)  :: ptheta_min
REAL(KIND=JPRB),    INTENT(IN)  :: ptheta_max
REAL(KIND=JPRB),    INTENT(IN)  :: ptheta_tan
REAL(KIND=JPRB),    INTENT(IN)  :: prtan
REAL(KIND=JPRB),    INTENT(IN)  :: pamult          !
REAL(KIND=JPRB),    INTENT(IN)  :: prefrac(klev,khoriz)   ! refractivity values on levels
REAL(KIND=JPRB),    INTENT(IN)  :: pradius(klev,khoriz)   ! radius values
REAL(KIND=JPRB),    INTENT(IN)  :: py(4)   !  current location
REAL(KIND=JPRB),    INTENT(OUT) :: pdydh(4)

! local

INTEGER(KIND=JPIM) :: ik,ikp1
REAL(KIND=JPRB) :: zhwt1,zhwt2
REAL(KIND=JPRB) :: zref_up,zref_low
REAL(KIND=JPRB) :: zrad_up,zrad_low
REAL(KIND=JPRB) :: zkval,zdndr,zdndr2
REAL(KIND=JPRB) :: zed
REAL(KIND=JPRB) :: ZHOOK_HANDLE


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


! the easy bits


pdydh(1) = MAX(1.0E-10_JPRB,COS(py(3)))

pdydh(2) = pamult*SIN(py(3))/(py(1)+prtan)


IF ( py(2) >= ptheta_min .AND. py(2) <= ptheta_max) THEN

   ik = INT((py(2) + ptheta_tan)/pdsep)+1
   ik = MIN(MAX(1,ik),khoriz)
   ikp1 = MIN(khoriz,ik+1)        

! horizontal weighting factor               
               
   zhwt1 = (REAL(ik)*pdsep - (py(2)+ptheta_tan))/pdsep   
   zhwt2 = 1.0_JPRB - zhwt1

ELSEIF (py(2) < ptheta_min ) THEN

   ik = 1
   ikp1 = 2
   zhwt1 = 1.0_JPRB
   zhwt2 = 0.0_JPRB
   
ELSEIF  (py(2) > ptheta_max) THEN

   ik = khoriz -1 
   ikp1 = khoriz
   zhwt1 = 0.0_JPRB
   zhwt2 = 1.0_JPRB
   
ENDIF    

! now calculate the local radial gradient of n
      
zref_up  = zhwt1*prefrac(kk+1,ik)+zhwt2*prefrac(kk+1,ikp1)
zref_low = zhwt1*prefrac(kk,ik) + zhwt2*prefrac(kk,ikp1)

zrad_up = zhwt1*pradius(kk+1,ik)+zhwt2*pradius(kk+1,ikp1)
zrad_low = zhwt1*pradius(kk,ik) + zhwt2*pradius(kk,ikp1)


zkval = LOG(zref_low/zref_up)/(zrad_up-zrad_low)

zed = MAX(0.0_JPRB,(py(1)+prtan-zrad_low))

zdndr = - 1.0E-6_JPRB*zkval*zref_low*EXP(-zkval*zed)

zdndr2 = MAX(-1.5E-7_JPRB,zdndr)


!!if (abs(zdndr) > 0.15E-6_JPRB) then

!   write (*,*) '################################'
   
!   write (*,*) 'biggradients',kk,ik,zhwt1,zhwt2,zkval
!   write (*,*) 'big-gradients',py(1),prtan,zrad_low,(py(1)+prtan-zrad_low)
!   write (*,*) 'big grads',pradius(kk,ik),pradius(kk,ikp1)
!   write (*,*) 'big rads2',pradius(kk+1,ik),pradius(kk+1,ikp1)
!   write (*,*) 'big ref1',prefrac(kk,ik),prefrac(kk,ikp1)
!   write (*,*) 'big ref2',prefrac(kk+1,ik),prefrac(kk+1,ikp1)
!   write (*,*) 'rads',zrad_up,zrad_low
!   write (*,*) 'refs',zref_up,zref_low
!   write (*,*) 'ref-gradient',zdndr
!   write (*,*) 'deriv3',-SIN(py(3))*(1.0_JPRB/(py(1)+prtan) + zdndr2)
!   write (*,*) 'deriv4',- SIN(py(3))*zdndr   
   

!   write (*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 

!endif 

pdydh(3) = -SIN(py(3))*(1.0_JPRB/(py(1)+prtan) + zdndr2)

pdydh(4) = - SIN(py(3))*zdndr


IF (LHOOK) CALL DR_HOOK('GPSPDERIVS',1,ZHOOK_HANDLE)

END SUBROUTINE gpspderivs
