SUBROUTINE gpscalc_nrTL(K_NLEV,P_ROC,P_LAT,P_ZG,P_ZG_PRIME,P_REFRAC,P_REFRAC_PRIME, &
                      & PZ_COMP,PZ_COMP_PRIME,P_NR,P_NR_PRIME)  

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

!     S. Healy             ECMWF          2004/10/26
!     Based on a EUMETSAT GRAS-SAF routine that was Dr'd automatically by the CY27 merge.  

!     PURPOSE
!     -------
!     It calculates the refractive index * radius on the model levels :

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

!     CALL gpscalc_nrTL(K_NLEV,P_ROC,P_LAT,P_ZG,P_ZG_PRIME,P_REFRAC,P_REFRAC_PRIME, &
!                      & P_NR,& P_NR_PRIME)  

!     WHERE K_NLEV         =  number of full model levels
!           P_ROC          =  radius of curvature
!           P_LAT          =  pressure on the full model levels
!           P_ZG           =  geopotential height on the full model levels
!           P_ZG_PRIME     =  Perturbed geopotential height on the full model levels
!           P_REFRAC       =  refractivity on full model levels
!           P_REFRAC_PRIME =  Perturbed refractivity on full model levels
!           P_NR           =  refractive index - radius product 
!           P_NR_PRIME     =  Perturbed refractive index - radius product 



!     gpscalc_nrtl is called from gpsro_tl

!**   METHOD
!     ------
!     1) calculate the geometric and radius of full model levels
!     2) calculate the refractive index - radius product  

!**   EXTERNALS
!     ---------
!     1) fcseradi calculates the radius used to convert geopotential to geometric height
!     2) variation of gravity with latitude

!**   MODIFICATIONS
!     -------------
!     Sean Healy      2004/10/26 : Original
!     -------------------------------------------------------------------------
           

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

USE YOMANCS  , ONLY : RMDI 

USE YOMCST   , ONLY : RG           

IMPLICIT NONE

! subroutine args. 

INTEGER(KIND=JPIM),INTENT(IN)    :: K_NLEV! no. of p levels in state vec. 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ROC 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_LAT 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ZG(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ZG_PRIME(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_REFRAC(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_REFRAC_PRIME(K_NLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZ_COMP(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZ_COMP_PRIME(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_NR(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_NR_PRIME(K_NLEV) 
! local variables

INTEGER(KIND=JPIM) :: i
REAL(KIND=JPRB) :: zed(K_NLEV)            ! geometric height
REAL(KIND=JPRB) :: ZG(K_NLEV)             ! geopotential including compress
REAL(KIND=JPRB) :: ZG_PRIME(K_NLEV)       ! geopotential including compress
REAL(KIND=JPRB) :: Z_RAD(K_NLEV)          ! radius
REAL(KIND=JPRB) :: zed_prime(K_NLEV)      ! perturbed geometric height 
REAL(KIND=JPRB) :: Z_RAD_PRIME(K_NLEV)    ! perturbed radius
REAL(KIND=JPRB) :: Z_GRAT                 ! ratio of glat/g0
REAL(KIND=JPRB) :: Z_RADIUS               ! effective radius used by List
REAL(KIND=JPRB) :: fcseradi               ! function to calculate effective radius 
REAL(KIND=JPRB) :: fcsglat                ! g varying with latitude
REAL(KIND=JPRB) :: ZHOOK_HANDLE 

! calculate the radius and g values used in the geopotential/geometric height
! conversion.

IF (LHOOK) CALL DR_HOOK('GPSCALC_NRTL',0,ZHOOK_HANDLE)
Z_GRAT   = fcsglat(P_LAT)/RG
Z_RADIUS = fcseradi(P_LAT)

! calculate the geometric heights

Z_RAD(:) = RMDI
P_NR(:)  = RMDI 
ZG(:) = RMDI

Z_RAD_PRIME(:) = 0.0_JPRB
P_NR_PRIME(:) = 0.0_JPRB
ZG_PRIME(:) = 0.0_JPRB

DO i=1,K_NLEV

  IF (P_ZG(i) > 0.0_JPRB .AND. P_REFRAC(i) > 0.0_JPRB ) THEN

! include the compressibility
    
    IF (i == 1) THEN
    
       ZG(i) = PZ_COMP(i)*P_ZG(i)
       
       ZG_PRIME(i) = PZ_COMP(i)*P_ZG_PRIME(i) + &
                   & P_ZG(i)*PZ_COMP_PRIME(i)        
              
    ELSE 
    
       IF (ZG(i-1) == RMDI) THEN 
       
          ZG(i) = PZ_COMP(i)*P_ZG(i)

          ZG_PRIME(i) = PZ_COMP(i)*P_ZG_PRIME(i) + &
                   & P_ZG(i)*PZ_COMP_PRIME(i)        
       ELSE   
     
          ZG(i) = ZG(i-1) + PZ_COMP(i)*(P_ZG(i)-P_ZG(i-1))   

          ZG_PRIME(i) = ZG_PRIME(i-1) + &
                   & PZ_COMP(i)*(P_ZG_PRIME(i)-P_ZG_PRIME(i-1)) + &
                   & (P_ZG(i)-P_ZG(i-1))*PZ_COMP_PRIME(i)            

       ENDIF 

    ENDIF 

    zed(i)=ZG(i)/(Z_GRAT - ZG(i)/Z_RADIUS)
      
    zed_prime(i) = Z_GRAT/(Z_GRAT-ZG(i)/Z_RADIUS)**2 * ZG_PRIME(i)    

! calculate radius value

    Z_RAD(i) = P_ROC + zed(i) 

    Z_RAD_PRIME(i) = zed_prime(i) 

! calculate the radius times refractive index product.

    P_NR(i) = Z_RAD(i) * (1.0_JPRB+1.0E-6_JPRB*P_REFRAC(i))

    P_NR_PRIME(i) = Z_RAD_PRIME(i) * (1.0_JPRB+1.0E-6_JPRB*P_REFRAC(i)) &
     & + 1.0E-6_JPRB* Z_RAD(i)* P_REFRAC_PRIME(i)     
          
  ENDIF

ENDDO

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

END SUBROUTINE gpscalc_nrTL
