SUBROUTINE gpscalc_compresstl(KLEV,PRES,PRES_PRIME,PTEMP,PTEMP_PRIME,PQ,PQ_PRIME,&
&PZCOMP_MIX,PZCOMP_MIX_PRIME,PZCOMP_DRY_INV,PZCOMP_DRY_INV_PRIME, &
&PZCOMP_WET_INV,PZCOMP_WET_INV_PRIME)

!**** *gpscalc_compress* - Operator routine for gps radio occultation observations.

!     S. Healy             ECMWF          2009/03/04
!     
!     PURPOSE
!     -------
!     Calculates the compressibility of air

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

!SUBROUTINE gpscalc_compress(KLEV,PRES,PTEMP,PQ,PZCOMP_MIX,PZCOMP_DRY_INV, &
!&PZCOMP_WET_INT)
!      KLEV   = number of model levels
!      PRES   = pressure on model levels
!      PTEMP  = temp on model levels
!      PQ     = specific humidity on model levs 
!      PZCOMP_MIX = compressibility of moist air
!      PZCOMP_DRY_INV = inverse of compressibility of dry air
!      PZCOMP_WET_INV = inverse of compressibility of moisture

!     gpscalc_compress is called from gpsro_op

!**   METHOD
!     ------
!    
!     1) See R.S. Davis, 1992, Metrologia, vol 29, pp 67-70.


!**   EXTERNALS
!     ---------
!
!**   MODIFICATIONS
!     -------------
!     Sean Healy      2009/03/04 : Original
!     -------------------------------------------------------------------------


USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMCST, ONLY : rmv, rmd   

IMPLICIT NONE

INTEGER(KIND=JPIM), INTENT(IN) :: KLEV 
REAL(KIND=JPRB),INTENT(IN)  :: PRES(KLEV)     ! pressure values
REAL(KIND=JPRB),INTENT(IN)  :: PRES_PRIME(KLEV)     ! pressure values
REAL(KIND=JPRB),INTENT(IN)  :: PTEMP(KLEV)     ! pressure values
REAL(KIND=JPRB),INTENT(IN)  :: PTEMP_PRIME(KLEV)     ! pressure values
REAL(KIND=JPRB),INTENT(IN)  :: PQ(KLEV)       ! specific humidity values
REAL(KIND=JPRB),INTENT(IN)  :: PQ_PRIME(KLEV)       ! specific humidity values
REAL(KIND=JPRB),INTENT(OUT) :: PZCOMP_MIX(KLEV)      ! comp of mixture
REAL(KIND=JPRB),INTENT(OUT) :: PZCOMP_MIX_PRIME(KLEV)      ! comp of mixture
REAL(KIND=JPRB),INTENT(OUT) :: PZCOMP_DRY_INV(KLEV)  ! inverse dry air comp.
REAL(KIND=JPRB),INTENT(OUT) :: PZCOMP_DRY_INV_PRIME(KLEV)  ! inverse dry air comp.
REAL(KIND=JPRB),INTENT(OUT) :: PZCOMP_WET_INV(KLEV)  ! inverse water vapour comp.
REAL(KIND=JPRB),INTENT(OUT) :: PZCOMP_WET_INV_PRIME(KLEV)  ! inverse water vapour comp.

! local variables

INTEGER(KIND=JPIM) :: i
REAL(KIND=JPRB) :: zcomp1(KLEV),zcomp2(KLEV),zcomp3(KLEV)
REAL(KIND=JPRB) :: zcomp1_prime(KLEV),zcomp2_prime(KLEV),zcomp3_prime(KLEV)
REAL(KIND=JPRB) :: zpd,zpwet,ztc,zx,zpot
REAL(KIND=JPRB) :: zpd_prime,zpwet_prime,ztc_prime,zx_prime,zpot_prime
REAL(KIND=JPRB) :: zterm1,zterm2,zterm3
REAL(KIND=JPRB) :: zterm1_prime,zterm2_prime,zterm3_prime
REAL(KIND=JPRB) :: z_eps
REAL(KIND=JPRB) :: ZHOOK_HANDLE

! parameters from the Davis paper

REAL(KIND=JPRB), PARAMETER :: za0=1.58123E-6_JPRB
REAL(KIND=JPRB), PARAMETER :: za1=-2.91331E-8_JPRB
REAL(KIND=JPRB), PARAMETER :: za2=1.1043E-10_JPRB
REAL(KIND=JPRB), PARAMETER :: zb0=5.707E-6_JPRB
REAL(KIND=JPRB), PARAMETER :: zb1=-2.051E-8_JPRB
REAL(KIND=JPRB), PARAMETER :: zc0=1.9898E-4_JPRB
REAL(KIND=JPRB), PARAMETER :: zc1=-2.376E-6_JPRB
REAL(KIND=JPRB), PARAMETER :: zd=1.83E-11_JPRB
REAL(KIND=JPRB), PARAMETER :: ze=-0.765E-8_JPRB



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

z_eps = rmv/rmd

DO i = 1,KLEV

! Temp in celcius
   
   ztc = PTEMP(i) - 273.15_JPRB
   
   ztc_prime = PTEMP_PRIME(i)
   

! calculate the water vapour and dry pressure

   zpwet = PRES(i) * PQ(i) / (z_eps + (1.0_JPRB - z_eps)*PQ(i))

   zpwet_prime = zpwet/PRES(i)*PRES_PRIME(i) &
             & + PRES(i)*z_eps/(z_eps + (1.0_JPRB - z_eps)*PQ(i))**2*PQ_PRIME(i)   

! dry pressure

   zpd = PRES(i) - zpwet

   zpd_prime = PRES_PRIME(i) - zpwet_prime 

   zterm1 = za0+ztc*(za1+ztc*za2)

   zterm1_prime = (za1+2.0_JPRB*ztc*za2)*ztc_prime

   zterm2 = zb0+zb1*ztc
   
   zterm2_prime = zb1*ztc_prime
   
   zterm3 = zc0+zc1*ztc
   
   zterm3_prime = zc1*ztc_prime
   
! compressibility of moist air
  
   zpot = PRES(i)/PTEMP(i)
  
   zpot_prime = zpot/PRES(i)*PRES_PRIME(i) - zpot/PTEMP(i)*PTEMP_PRIME(i)
  
   zx = zpwet/PRES(i)
 
   zx_prime = 1.0_JPRB/PRES(i)*zpwet_prime - zx/PRES(i)*PRES_PRIME(i) 
 
   zcomp1(i) = 1.0_JPRB - zpot*(zterm1 + zx*(zterm2 + zx*zterm3)) 
   
   zcomp1_prime(i) = -(zterm1 + zx*(zterm2 + zx*zterm3))*zpot_prime  &
                &   -zpot*(zterm1_prime + (zterm2 + 2.0_JPRB*zx*zterm3)*zx_prime  &
                &   +zx*(zterm2_prime + zx*zterm3_prime))   
   
   zcomp1(i) = zcomp1(i) + zpot**2*(zd + zx**2*ze)
   
   zcomp1_prime(i) = zcomp1_prime(i) + 2.0_JPRB*zpot*(zd + zx**2*ze)*zpot_prime + &
                   & 2.0_JPRB*zpot**2*zx*ze*zx_prime   
   
        
! compressibility for dry air
   
   zpot = zpd/PTEMP(i)
   
   zpot_prime = zpot/zpd*zpd_prime - zpot/PTEMP(i)*PTEMP_PRIME(i)
    
   zcomp2(i) = 1.0_JPRB - zpot*(zterm1 - zpot*zd)
   
   zcomp2_prime(i) = - (zterm1 - 2.0_JPRB*zpot*zd)*zpot_prime  & 
                   & - zpot*zterm1_prime     
   
! compressibility of water vapour

   zpot = zpwet/PTEMP(i)
   
   zpot_prime = zpwet_prime/PTEMP(i) - zpot/PTEMP(i)*PTEMP_PRIME(i)
   
   zcomp3(i) = 1.0_JPRB - zpot*(zterm1 + zterm2 + zterm3 - zpot*(zd+ze))
   
   zcomp3_prime(i) = -(zterm1 + zterm2 + zterm3 - 2.0_JPRB*zpot*(zd+ze))*zpot_prime &
                   & -zpot*(zterm1_prime + zterm2_prime + zterm3_prime)     
   
ENDDO   

! 
    
DO i = 1, KLEV

   IF (i == 1) THEN
   
      PZCOMP_MIX(i) = zcomp1(i)
      
      PZCOMP_MIX_PRIME(i) = zcomp1_prime(i)
         
   ELSE
  
! use the mean value of the i and (i-1) levels
   
      PZCOMP_MIX(i) = 0.5_JPRB*(zcomp1(i)+zcomp1(i-1))
      
      PZCOMP_MIX_PRIME(i) = 0.5_JPRB*(zcomp1_prime(i)+zcomp1_prime(i-1))
      
   ENDIF    
   
! return the inverse of the compresibility for dry air + vapour   
   
   PZCOMP_DRY_INV(i) = 1.0_JPRB/zcomp2(i)
   
   PZCOMP_DRY_INV_PRIME(i) = - 1.0_JPRB/zcomp2(i)**2*zcomp2_prime(i)
   
   PZCOMP_WET_INV(i) = 1.0_JPRB/zcomp3(i)

   PZCOMP_WET_INV_PRIME(i) = -1.0_JPRB/zcomp3(i)**2*zcomp3_prime(i)

!!   PZCOMP_DRY_INV(i) = 1.0_JPRB
   
!!   PZCOMP_DRY_INV_PRIME(i) =  0.0_JPRB
   
!!   PZCOMP_WET_INV(i) = 1.0_JPRB

!!   PZCOMP_WET_INV_PRIME(i) = 0.0_JPRB
   
ENDDO   




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



END SUBROUTINE GPSCALC_COMPRESSTL
