SUBROUTINE gpscalc_nrAD(K_NLEV,P_ROC,P_LAT,P_ZG,P_ZG_HAT,P_REFRAC,P_REFRAC_HAT,&
                       &PZ_COMP,PZ_COMP_HAT,P_NR_HAT)  
           

!**** *gpscalc_nrAD* - 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_nrAD(K_NLEV,P_ROC,P_LAT,P_ZG,P_ZG_PRIME,P_REFRAC,P_REFRAC_PRIME, &
!                     & 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_HAT       =  Adjoint geopotential height on the full model levels
!           P_REFRAC       =  refractivity on full model levels
!           P_REFRAC_HAT   =  Adjoint refractivity on full model levels
!           P_NR_HAT       =  Adjoint refractive index - radius product 



!     gpscalc_nrad is called from 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)    :: 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(INOUT) :: P_ZG_HAT(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_REFRAC(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: P_REFRAC_HAT(K_NLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZ_COMP(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PZ_COMP_HAT(K_NLEV)  
REAL(KIND=JPRB)   ,INTENT(INOUT) :: P_NR_HAT(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_HAT(K_NLEV)       ! geopotential including compress
REAL(KIND=JPRB) :: Z_RAD(K_NLEV)        ! radius 
REAL(KIND=JPRB) :: zed_hat(K_NLEV)      ! Adjoint geometric height  
REAL(KIND=JPRB) :: Z_RAD_HAT(K_NLEV)    ! Adjoint 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 for calculating the effective radius
REAL(KIND=JPRB) :: fcsglat              ! function for g value at latitude
REAL(KIND=JPRB) :: ZHOOK_HANDLE

! initialse adjoint variables

IF (LHOOK) CALL DR_HOOK('GPSCALC_NRAD',0,ZHOOK_HANDLE)
Z_RAD_HAT(:) = 0.0_JPRB
zed_hat(:) = 0.0_JPRB
ZG_HAT(:) = 0.0_JPRB

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

Z_GRAT   = fcsglat(P_LAT)/RG
Z_RADIUS = fcseradi(P_LAT)

! calculate the geometric heights

Z_RAD(:) = 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.

  ENDIF

ENDDO

! now adjoint bit


DO i=K_NLEV,1,-1

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

! Adjoint code.

    Z_RAD_HAT(i) =  &
     & Z_RAD_HAT(i) + (1.0_JPRB+1.0E-6_JPRB*P_REFRAC(i))*P_NR_HAT(i)   
      
    P_REFRAC_HAT(i) = &
     & P_REFRAC_HAT(i) + 1.0E-6_JPRB*Z_RAD(i)*P_NR_HAT(i)  
      
    P_NR_HAT(i) = 0.0_JPRB
      
    zed_hat(i) = zed_hat(i)+Z_RAD_HAT(i)
    Z_RAD_HAT(i) = 0.0_JPRB
      
    ZG_HAT(i) = &
    & ZG_HAT(i) + Z_GRAT/(Z_GRAT-ZG(i)/Z_RADIUS)**2*zed_hat(i)  
    zed_hat(i) = 0.0_JPRB
    
    
    IF (i == 1) THEN
           
       P_ZG_HAT(i) = P_ZG_HAT(i) + PZ_COMP(i)*ZG_HAT(i)
       PZ_COMP_HAT(i) = PZ_COMP_HAT(i) + P_ZG(i)*ZG_HAT(i)
       ZG_HAT(i) = 0.0_JPRB
              
    ELSE 
    
       IF (ZG(i-1) == RMDI) THEN 
      
          P_ZG_HAT(i) = P_ZG_HAT(i) + PZ_COMP(i)*ZG_HAT(i)
          PZ_COMP_HAT(i) = PZ_COMP_HAT(i) + P_ZG(i)*ZG_HAT(i)
          ZG_HAT(i) = 0.0_JPRB
       
       ELSE
           
          ZG_HAT(i-1)    = ZG_HAT(i-1) + ZG_HAT(i)
          P_ZG_HAT(i)    = P_ZG_HAT(i) + PZ_COMP(i)*ZG_HAT(i)
          P_ZG_HAT(i-1)  = P_ZG_HAT(i-1) - PZ_COMP(i)*ZG_HAT(i)
          PZ_COMP_HAT(i) = PZ_COMP_HAT(i) + (P_ZG(i)-P_ZG(i-1))*ZG_HAT(i)
          ZG_HAT(i) = 0.0_JPRB

       ENDIF

    ENDIF 
    
    
      
  ENDIF

ENDDO

Z_RAD_HAT(:) = 0.0_JPRB
ZG_HAT(:) = 0.0_JPRB
P_NR_HAT(:) = 0.0_JPRB

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

END SUBROUTINE gpscalc_nrAD
