SUBROUTINE GPSZEN_DELAYAD(KDLEN,KLEN,KDCOUNT,KCOUNT,&
 &                      PRESH, PGEOH, PTF, PQF, &
 &                      POROGOB,PRESOB,&
 &                      KDPP,PZEN_DELAYAD,&
 &                      PRESH5,PGEOH5,PTF5,PQF5,&
 &                      PRESOB5)

! Adjoint of the tangent linear model of the observation operator GPSZEN_DELAY
! See GPSZEN_DELAYTL for details.
! 15/02/2004  P. Poli        Original code

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

USE YOMDIM   , ONLY : NFLEVG
USE YOMCST   , ONLY : RG, RMV, RMD
USE YOMDB

IMPLICIT NONE

INTEGER(KIND=JPIM), INTENT(IN) :: KDLEN, KLEN,KDCOUNT,KCOUNT(KDLEN),KDPP
REAL(KIND=JPRB), INTENT(INOUT) :: PRESH(KDLEN,0:NFLEVG),PGEOH(KDLEN,0:NFLEVG)
REAL(KIND=JPRB), INTENT(INOUT) :: PTF(KDLEN,NFLEVG),PQF(KDLEN,NFLEVG)
REAL(KIND=JPRB), INTENT(IN)    :: PRESH5(KDLEN,0:NFLEVG),PGEOH5(KDLEN,0:NFLEVG)
REAL(KIND=JPRB), INTENT(IN)    :: PTF5(KDLEN,0:NFLEVG),PQF5(KDLEN,0:NFLEVG)
REAL(KIND=JPRB), INTENT(IN)    :: POROGOB(KDLEN)
REAL(KIND=JPRB), INTENT(INOUT) :: PRESOB(KDLEN,KDCOUNT)
REAL(KIND=JPRB), INTENT(IN)    :: PRESOB5(KDLEN,KDCOUNT)
REAL(KIND=JPRB), INTENT(INOUT) :: PZEN_DELAYAD(KDLEN,KDCOUNT,KDPP)

! local variables

INTEGER(KIND=JPIM) :: JOBS,JDATA,JLEV,ILEVP1
REAL(KIND=JPRB) :: ZREFRACT,ZHUPPER,ZHLOWER
REAL(KIND=JPRB) :: ZPUPPER,ZPLOWER,ZPLOWERB,ZKAPPA,ZEPSILON
REAL(KIND=JPRB) :: ZREFRACT5,ZHUPPER5,ZHLOWER5
REAL(KIND=JPRB) :: ZPUPPER5,ZPLOWER5,ZPLOWERB5,ZKAPPA5
REAL(KIND=JPRB), PARAMETER :: AVAL = 7.76E-7_JPRB
REAL(KIND=JPRB), PARAMETER :: BVAL = 3.73E-3_JPRB
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "openmp_obs.h"

!-------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('GPSZEN_DELAYAD',0,ZHOOK_HANDLE)

! 1. initialise the variables :
! ratio of water-vapour mass/dry-air mass

ZEPSILON = RMV/RMD

!-------------------------------------------------------------------------


! assume that the refractivity varies exponentially between 
! the half-levels, as a function of geopotential height. Also assume
! the vertical integral of refrac.(N) w.r.t geopotential height ~= 
! integral w.r.t. geometric height.     

DO JDATA = 1,KDCOUNT
  DO JLEV = 0,NFLEVG-1
    ILEVP1 = JLEV+1

    DO JOBS = 1, KLEN
      IF(JDATA > KCOUNT(JOBS)) CYCLE
      
! calculate trajectory first
      ZREFRACT5 = AVAL/PTF5(JOBS,ILEVP1) + BVAL*PQF5(JOBS,ILEVP1)/ &
    &           (PTF5(JOBS,ILEVP1)**2 * &
    &            (ZEPSILON+(1.0_JPRB-ZEPSILON)*PQF5(JOBS,ILEVP1)))
      ZPUPPER5 = MAX(PRESH5(JOBS,JLEV),0.01_JPRB)
      ZPLOWER5 = PRESH5(JOBS,ILEVP1)
      ZHUPPER5 = PGEOH5(JOBS,JLEV)/RG
      ZHLOWER5 = PGEOH5(JOBS,ILEVP1)/RG
      ZKAPPA5 = LOG(ZPLOWER5/ZPUPPER5)/(ZHUPPER5-ZHLOWER5)
      IF(ZPUPPER5 >= PRESOB5(JOBS,JDATA)) CYCLE
      IF(ILEVP1 == NFLEVG .OR. &
     &   PRESH5(JOBS,ILEVP1) > PRESOB5(JOBS,JDATA)) THEN
         ZPLOWERB5 = PRESOB5(JOBS,JDATA)
      ELSE
         ZPLOWERB5 = PRESH5(JOBS,ILEVP1)
      ENDIF

! propagate perturbations from PZEN_DELAYAD back to local perturbations
      ZREFRACT = 0.0_JPRB
      ZPUPPER = 0.0_JPRB
      ZPLOWERB = 0.0_JPRB
      ZKAPPA  = 0.0_JPRB
      ZREFRACT = ZREFRACT + PZEN_DELAYAD(JOBS,JDATA,1)* &
     &          (ZPLOWERB5-ZPUPPER5)/ZKAPPA5
      ZPLOWERB = ZPLOWERB + PZEN_DELAYAD(JOBS,JDATA,1)* &
     &          ZREFRACT5/ZKAPPA5
      ZPUPPER = ZPUPPER - PZEN_DELAYAD(JOBS,JDATA,1)* &
     &          ZREFRACT5/ZKAPPA5
      ZKAPPA  = ZKAPPA - PZEN_DELAYAD(JOBS,JDATA,1)* &
     &          ZREFRACT5*(ZPLOWERB5-ZPUPPER5)/(ZKAPPA5**2)

! propagate to PRESOB or PRESH
      IF(ILEVP1 == NFLEVG .OR. &
     &   PRESH5(JOBS,ILEVP1) > PRESOB5(JOBS,JDATA)) THEN
         PRESOB(JOBS,JDATA) = PRESOB(JOBS,JDATA) + ZPLOWERB
         ZPLOWERB = 0.0_JPRB
      ELSE
         PRESH(JOBS,ILEVP1) = PRESH(JOBS,ILEVP1) + ZPLOWERB
         ZPLOWERB = 0.0_JPRB
      ENDIF

! propagate perturbations from Kappa to height variables
      ZHUPPER = 0.0_JPRB
      ZHLOWER = 0.0_JPRB
      ZPLOWER = 0.0_JPRB
      ZPLOWER = ZPLOWER + ZKAPPA/(ZPLOWER5*(ZHUPPER5-ZHLOWER5))
      ZPUPPER = ZPUPPER - ZKAPPA/(ZPUPPER5*(ZHUPPER5-ZHLOWER5))
      ZHUPPER = ZHUPPER - ZKAPPA*LOG(ZPLOWER5/ZPUPPER5)/&
     &          ((ZHUPPER5-ZHLOWER5)**2)
      ZHLOWER = ZHLOWER + ZKAPPA*LOG(ZPLOWER5/ZPUPPER5)/&
     &          ((ZHUPPER5-ZHLOWER5)**2)
      ZKAPPA = 0.0_JPRB

! propagate perturbations to Z,H
      IF (PRESH5(JOBS,JLEV)>0.01_JPRB) &
     &   PRESH(JOBS,JLEV) = PRESH(JOBS,JLEV) + ZPUPPER
      ZPUPPER = 0.0_JPRB
      PRESH(JOBS,ILEVP1) = PRESH(JOBS,ILEVP1) + ZPLOWER
      ZPLOWER = 0.0_JPRB
      PGEOH(JOBS,JLEV)   = PGEOH(JOBS,JLEV)   + ZHUPPER/RG
      ZHUPPER = 0.0_JPRB
      PGEOH(JOBS,ILEVP1) = PGEOH(JOBS,ILEVP1) + ZHLOWER/RG
      ZHLOWER = 0.0_JPRB

! propagate perturbations to T,Q
      PTF(JOBS,ILEVP1) = PTF(JOBS,ILEVP1) - ZREFRACT*&
     &   (AVAL/(PTF5(JOBS,ILEVP1))**2+2.*BVAL*PQF5(JOBS,ILEVP1)/&
     &    (PTF5(JOBS,ILEVP1)**3 * &
     &     (ZEPSILON+(1.0_JPRB-ZEPSILON)*PQF5(JOBS,ILEVP1))))
      PQF(JOBS,ILEVP1) = PQF(JOBS,ILEVP1) + ZREFRACT*&
     &   (BVAL*ZEPSILON)/(PTF5(JOBS,ILEVP1)**2 * &
     &    (ZEPSILON+(1.0_JPRB-ZEPSILON)*PQF5(JOBS,ILEVP1))**2)
      ZREFRACT=0.0_JPRB
    ENDDO

  ENDDO
ENDDO

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('GPSZEN_DELAYAD',1,ZHOOK_HANDLE)
END SUBROUTINE GPSZEN_DELAYAD

