SUBROUTINE gpscalc_nr(K_NLEV,P_ROC,P_LAT,P_ZG,P_REFRAC,PZ_COMP,P_NR,P_Z)  
 
!**** *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 , as well as 
!     geometric heights on the model levels :

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

!     CALL gpscalc_nr(K_NLEV,P_ROC,P_LAT,P_ZG,P_REFRAC,P_NR,P_Z=P_Z)  

!     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_REFRAC =  refractivity on full model levels
!           PZ_COMP  =  compressibility
!           P_NR     =  refractive index - radius product 
!           P_Z      =  geometric heights on full model levels (OPTIONAL)


!     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
!     Paul Poli       2006/09/12 : Added optional calculation of geometric heights
!     E. Sevault 06-May-2009 reorganise calculations to avoid hazardous
!                   optimisations on NEC SX9. To be re-written anyhow (REK)
!     -------------------------------------------------------------------------

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_REFRAC(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZ_COMP(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_NR(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT), OPTIONAL   :: P_Z(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) :: Z_RAD(K_NLEV)        ! radius
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   

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

IF (LHOOK) CALL DR_HOOK('GPSCALC_NR',0,ZHOOK_HANDLE)
Z_GRAT   = fcsglat(P_LAT)/RG     ! RG is gravity value 9.80...   
Z_RADIUS = fcseradi(P_LAT)

! calculate the geometric heights

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


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)
       
    ELSE 
    
       IF (ZG(i-1) == RMDI) THEN 
       
          ZG(i) = PZ_COMP(i)*P_ZG(i)
	   
       ELSE   
    
          ZG(i) = ZG(i-1) + PZ_COMP(i)*(P_ZG(i)-P_ZG(i-1))   

       ENDIF

    ENDIF 

    zed(i)=ZG(i)/(Z_GRAT - ZG(i)/Z_RADIUS)

! calculate radius value

    Z_RAD(i) = P_ROC + zed(i) 

! calculate the radius times refractive index product.

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

  ENDIF

ENDDO

! save geometric height
IF (present(P_Z)) P_Z(:) = zed(:)

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

END SUBROUTINE gpscalc_nr
