SUBROUTINE gpscalc_nr2dtl(KLEV,KHORIZ,&
&P_ROC,P_LAT,P_ZG,P_ZG_PRIME,P_REFRAC,P_REFRAC_PRIME, &
&P_RAD,P_RAD_PRIME,P_NR,P_NR_PRIME)  
 
!**** *gpscalc_nr* - 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_nr(KLEV,KVERT,KHORIZ,P_ROC,P_LAT,P_ZG,P_REFRAC,P_NR)  

!     WHERE KLEV   =  number of full model levels
!           KHORIZ   =  no. of horizontal locations 
!           P_ROC    =  radius of curvature
!           P_LAT    =  pressure on the full model levels
!           P_ZG     =  geopotential height on the full model levels
!           P_REFRAC =  refractivity on full model levels
!           P_NR     =  refractive index - radius product 

!     gpscalc_nr is called from gpsro_op and gpsro_ad

!**   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)    :: KLEV   ! no. of p levels in state vec. 
INTEGER(KIND=JPIM),INTENT(IN)    :: KHORIZ
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ROC 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_LAT 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ZG(KLEV,KHORIZ) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ZG_PRIME(KLEV,KHORIZ) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_REFRAC(KLEV,KHORIZ)
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_REFRAC_PRIME(KLEV,KHORIZ)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_RAD(KLEV,KHORIZ) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_RAD_PRIME(KLEV,KHORIZ) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_NR(KLEV,KHORIZ)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_NR_PRIME(KLEV,KHORIZ) 

! local variables

INTEGER(KIND=JPIM) :: i,j,ibot
REAL(KIND=JPRB) :: zed(KLEV)          ! geometric height
REAL(KIND=JPRB) :: zed_prime(KLEV)    ! geometric height
REAL(KIND=JPRB) :: Z_GRAT             ! ratio of g(lat)/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   

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

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

Z_GRAT   = fcsglat(P_LAT)/RG     ! RG is gravity value 9.80...   
Z_RADIUS = fcseradi(P_LAT)

! calculate the geometric heights

P_RAD(:,:) = RMDI
P_RAD_PRIME(:,:) = 0.0_JPRB
P_NR(:,:)  = RMDI
P_NR_PRIME(:,:)  = 0.0_JPRB 
zed(:) = 0.0_JPRB
zed_prime(:) = 0.0_JPRB
 

! calculate the geometric height of the model levels and interpolate


DO j = 1,KHORIZ 

  ibot = 1
  
  DO i=1,KLEV

    IF (P_REFRAC(i,j) > 0.0_JPRB ) THEN

      zed(i)=P_ZG(i,j)/(Z_GRAT - P_ZG(i,j)/Z_RADIUS) ! geometric heights

      zed_prime(i) = Z_GRAT/(Z_GRAT - P_ZG(i,j)/Z_RADIUS)**2*P_ZG_PRIME(i,j)

    ELSE
            
      zed(i) = RMDI
      
      zed_prime(i) = 0.0_JPRB
      
      ibot = i+1 
 
    ENDIF

  ENDDO


  DO i = ibot, KLEV
      P_RAD(i,j) = P_ROC + zed(i)
      P_RAD_PRIME(i,j) = zed_prime(i)

      P_NR(i,j) = P_RAD(i,j)* &
   & (1.0_JPRB + 1.0E-6_JPRB*P_REFRAC(i,j))

      P_NR_PRIME(i,j) = &
     &P_RAD_PRIME(i,j)* &
     &(1.0_JPRB + 1.0E-6_JPRB*P_REFRAC(i,j)) + &
     &1.0E-6_JPRB*P_RAD(i,j)*P_REFRAC_PRIME(i,j)
       
   ENDDO
       
 
ENDDO

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

END SUBROUTINE gpscalc_nr2dtl

