SUBROUTINE gpsro_2dAD(kdlen,kdbdy,KHORIZ,K_IMXCOUNT,klen,K_IVNMRQ,presf5,   &
                  & presf5_hat,P_TF5,P_TF5_HAT,P_QF5,P_QF5_HAT, &
                  & P_GEOPF5,P_GEOPF5_HAT,P_ZXPP_HAT)  

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

!     S. Healy             ECMWF          2004/10/26
!     Based on a EUMETSAT GRAS-SAF routine that was Dr'd automatically by the CY27 merge.  

!     PURPOSE
!     -------
!     It simulates GPSRO bending angles with a 1D operator :

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

!    CALL gpsro_2dad(...)  
!     WHERE KDLEN            = First dimension: Max number of observations, this set (INPUT)
!           KDBDY            = Second dimension: Max number of bodies, this set (INPUT)
!           K_IMXCOUNT       = Maximum number of bending angles per body (INPUT)
!           klen             = Number of bodies (number of bending angle profiles) (INPUT)
!           K_IVNMRQ         = Identifier of variable type (INPUT)
!           presf5           = Pressure on full levels (INPUT)
!           presf5_HAT       = Adjoint pressure on full levels (INOUT) 
!           P_TF5            = Temperature on full levels (INPUT)
!           P_TF5_HAT        = Adjoint temperature on full levels (INOUT)
!           P_QF5            = Specific humidity on full levels (INPUT)
!           P_QF5_HAT        = Adjoint specific humidity on full levels (INOUT)
!           P_GEOPF5         = Geopotential on full levels (INPUT)
!           P_GEOPF5_HAT     = Adjoint Geopotential on full levels (INOUT)
!           P_ZXPP_HAT       = Adjoint bending angle values (INOUT)  

!     gpsro_AD is called from HOPAD

!**   METHOD
!     ------
!     1) Extract the impact parameter values from ROBODY
!     2) Copy the temperature, humidity and pressure data into temporary arrays
!     3) Calculate the refractivity on the model (full) levels
!     4) Calculate the "nr" product on full levels
!     5) Evaluate the bending angles    

!**   EXTERNALS
!     ---------
!        gpscalc_refrac2d   - Calculate the refractivity on model (full) levels
!        gpscalc_refrac2dAD - ADJOINT Calculate the refractivity on model (full) levels
!        gpscalc_nr2d       - Calculate the refractive index - radius product on full levels
!        gpscalc_nr2dAD     - ADJOINT Calculate the refractive index - radius product on full levels
!        gpscalc_alpha2dAD  - ADJOINT Calculate the bending angles

!**   MODIFICATIONS
!     -------------
!     Sean Healy      2004/10/26 : Original
!     -------------------------------------------------------------------------

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

USE YOMANCS, ONLY : rdegrees,RMDI
USE YOMDIM, ONLY : nflevg
USE YOMDB
USE YOMVNMB  , ONLY : NVNUMB
USE YOMCST   , ONLY : RG
USE YOMLIMB, ONLY : dtheta

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDBDY
INTEGER(KIND=JPIM),INTENT(IN)    :: KHORIZ
INTEGER(KIND=JPIM),INTENT(IN)    :: K_IMXCOUNT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_IVNMRQ(KDLEN,KDBDY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESF5(KDLEN,NFLEVG,KHORIZ) ! pressure on **full levels**
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRESF5_HAT(KDLEN,NFLEVG,KHORIZ) ! pressure on **full levels**
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TF5(KDLEN,0:NFLEVG,KHORIZ) ! Z_TEMP. values     "
REAL(KIND=JPRB)   ,INTENT(INOUT) :: P_TF5_HAT(KDLEN,NFLEVG,KHORIZ) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_QF5(KDLEN,0:NFLEVG,KHORIZ) ! spec.humid values "
REAL(KIND=JPRB)   ,INTENT(INOUT) :: P_QF5_HAT(KDLEN,NFLEVG,KHORIZ) ! spec.humid values "
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_GEOPF5(KDLEN,NFLEVG,KHORIZ) ! geopotential heights "
REAL(KIND=JPRB)   ,INTENT(INOUT) :: P_GEOPF5_HAT(KDLEN,NFLEVG,KHORIZ) ! geopotential heights "
REAL(KIND=JPRB)   ,INTENT(INOUT) :: P_ZXPP_HAT(KDLEN,K_IMXCOUNT) ! bending angles (0 on exit)    
REAL(KIND=JPRB) :: ZHOOK_HANDLE

! local variables
           
INTEGER(KIND=JPIM) :: i,j,I_K,I_L,isplit       ! loops
REAL(KIND=JPRB) :: Z_LAT                ! latitude 
REAL(KIND=JPRB) :: Z_ROC                ! radius of curvature
REAL(KIND=JPRB) :: Z_PRES(nflevg,KHORIZ)       ! pressure on model levels
REAL(KIND=JPRB) :: Z_PRES_HAT(nflevg,KHORIZ)   ! ADJOINT pressure on model levels
REAL(KIND=JPRB) :: Z_TEMP(nflevg,KHORIZ)       ! temperature on model levels
REAL(KIND=JPRB) :: Z_TEMP_HAT(nflevg,KHORIZ)   ! ADJOINT temperature on model levels
REAL(KIND=JPRB) :: Z_Q(nflevg,KHORIZ)          ! specific humidity on model levels 
REAL(KIND=JPRB) :: Z_Q_HAT(nflevg,KHORIZ)      ! ADJOINT specific humidity on model levels 
REAL(KIND=JPRB) :: zg(nflevg,KHORIZ)           ! geopotential height 
REAL(KIND=JPRB) :: zg_hat(nflevg,KHORIZ)       ! ADJOINT geopotential height  
REAL(KIND=JPRB) :: Z_REFRAC(nflevg,KHORIZ)     ! refractivity on model levels
REAL(KIND=JPRB) :: Z_REFRAC_HAT(nflevg,KHORIZ) ! ADJOINT refractivity on model levels
REAL(KIND=JPRB) :: Z_NR(nflevg,KHORIZ)         ! refractive-index radius product on model levels
REAL(KIND=JPRB) :: Z_NR_HAT(nflevg,KHORIZ)     ! ADJOINT refractive-index radius product on model levels
REAL(KIND=JPRB) :: Z_RAD(nflevg,KHORIZ)         ! radius on model levels
REAL(KIND=JPRB) :: Z_RAD_HAT(nflevg,KHORIZ)     ! ADJOINT radius on model levels
REAL(KIND=JPRB) :: Z_A(K_IMXCOUNT)      ! impact parameter values
REAL(KIND=JPRB) :: Z_ALPHA_HAT(K_IMXCOUNT)
REAL(KIND=JPRB) :: Z_APATH_HAT(K_IMXCOUNT,2)
REAL(KIND=JPRB) :: Z_2D

#include "gpscalc_refrac2d.intfb.h"
#include "gpscalc_nr2d.intfb.h"
#include "gpscalc_refrac2dad.intfb.h"
#include "gpscalc_nr2dad.intfb.h"
#include "gpscalc_alpharkm2ad.intfb.h"

#include "openmp_obs.h"

! initialise local adjoint variables

IF (LHOOK) CALL DR_HOOK('GPSRO_2DAD',0,ZHOOK_HANDLE)
Z_PRES_HAT(:,:)   = 0.0_JPRB
Z_TEMP_HAT(:,:)   = 0.0_JPRB
Z_Q_HAT(:,:)      = 0.0_JPRB
zg_hat(:,:)       = 0.0_JPRB
Z_REFRAC_HAT(:,:) = 0.0_JPRB
Z_NR_HAT(:,:)     = 0.0_JPRB
Z_RAD_HAT(:,:)    = 0.0_JPRB
Z_ALPHA_HAT(:)    = 0.0_JPRB
Z_APATH_HAT(:,:)  = 0.0_JPRB

! set the splitting and the 2d calculation height limit

isplit = 4
Z_2D = 1.0E4_JPRB

! loop through each ob

DO i = 1, klen   

! lat and radius of curvature at each location

  Z_LAT = ROBHDR(i,MDBLAT)*rdegrees
  Z_ROC = ROBHDR(i,MDBRADCURV) + ROBHDR(i,MDB_UNDULATION)
   
! extract the impact parameters from ROBODY

  Z_A(:) = RMDI
   
  j=1
  I_L=1 
       
  DO I_K = MLNKH2B(i),MLNKH2B(i+1) - 1
           
    IF (K_IVNMRQ(i,I_L) == nvnumb(76)) THEN
      
      Z_A(j) = ROBODY(I_K,MDBPPP) 
      
      j=j+1
      
    ENDIF       
      
    I_L = I_L + 1
      
    IF (j > K_IMXCOUNT) EXIT
               
  ENDDO

! copy pressure, temp, humidity and geopotential height in temporary arrays 
! and reverse ordering

  I_K = nflevg
   
  DO j = 1,nflevg
   
    Z_PRES(I_K,:) = presf5(i,j,:)
    Z_TEMP(I_K,:) = P_TF5(i,j,:) 
    Z_Q(I_K,:)    = P_QF5(i,j,:)
    zg(I_K,:)     = P_GEOPF5(i,j,:)/RG    ! in  m   
      
    I_K = I_K-1
      
  ENDDO        
               
! calculate the refractivity on model levels

  CALL gpscalc_refrac2d(nflevg, &
   & KHORIZ, &
   & Z_PRES, &
   & Z_TEMP, &
   & Z_Q,     &
   & Z_REFRAC)  ! output   
   
! calculate the refractive index - radius product

  CALL gpscalc_nr2d(nflevg, &
   & KHORIZ,    &
   & Z_ROC,     &
   & Z_LAT,     &
   & zg,      &
   & Z_REFRAC,  &
   & Z_RAD, &
   & Z_NR)  

! now do the adjoint bit

  Z_ALPHA_HAT(:) = Z_ALPHA_HAT(:) + P_ZXPP_HAT(i,1:K_IMXCOUNT) 
   
  P_ZXPP_HAT(i,1:K_IMXCOUNT) = 0.0_JPRB

! adjoint calculations  
   
  CALL gpscalc_alpharkm2AD(K_IMXCOUNT, &
   & nflevg,   &
   & KHORIZ,  &
   & isplit, &
   & dtheta, &
   & Z_A,        &
   & Z_REFRAC,   &
   & Z_REFRAC_HAT, &
   & Z_RAD, &
   & Z_RAD_HAT, &
   & Z_NR,       &
   & Z_NR_HAT, &
   & Z_ROC, &
   & Z_2D, &
   & Z_APATH_HAT, &
   & Z_ALPHA_HAT)   
           
! alpha_hat(:) should now be zero 

  CALL gpscalc_nr2dAD(nflevg, &
   & KHORIZ,   &
   & Z_ROC,     &
   & Z_LAT,     &
   & zg,      &
   & zg_hat, &
   & Z_REFRAC,  &
   & Z_REFRAC_HAT, &
   & Z_RAD_HAT, &
   & Z_NR_HAT)  

! nr_hat(:) should now be zero

  CALL gpscalc_refrac2dAD(nflevg, &
   & KHORIZ, &
   & Z_PRES, &
   & Z_PRES_HAT, &
   & Z_TEMP,   &
   & Z_TEMP_HAT, &
   & Z_Q,       &
   & Z_Q_HAT, &
   & Z_REFRAC_HAT)     

! refrac_hat(:) should now be zero

  I_K = nflevg
   
  DO j = 1,nflevg
   
    presf5_hat(i,j,:) = presf5_hat(i,j,:) + Z_PRES_HAT(I_K,:)
    Z_PRES_HAT(I_K,:) = 0.0_JPRB
      
    P_TF5_HAT(i,j,:) = P_TF5_HAT(i,j,:) + Z_TEMP_HAT(I_K,:)
    Z_TEMP_HAT(I_K,:) = 0.0_JPRB
       
    P_QF5_HAT(i,j,:) = P_QF5_HAT(i,j,:) + Z_Q_HAT(I_K,:)
    Z_Q_HAT(I_K,:) = 0.0_JPRB
           
    P_GEOPF5_HAT(i,j,:) = P_GEOPF5_HAT(i,j,:) + zg_hat(I_K,:)/RG   
    zg_hat(I_K,:) = 0.0_JPRB
      
    I_K = I_K-1
      
  ENDDO        

ENDDO

P_ZXPP_HAT(:,:)=0.0_JPRB

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

END SUBROUTINE gpsro_2dAD
