SUBROUTINE gpsro_2dTL(kdlen,kdbdy,KHORIZ,K_IMXCOUNT,klen,K_IVNMRQ,presf5,   &
                  & presf5_prime,P_TF5,P_TF5_PRIME,P_QF5,P_QF5_PRIME, &
                  & P_GEOPF5,P_GEOPF5_PRIME,P_ZXPP_PRIME)  

!**** *gpsro_TL* - 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_tl(kdlen,kdbdy,K_IMXCOUNT,klen,K_IVNMRQ,presf5,presf5_prime,
!    P_TF5,P_TF5_PRIME,P_QF5,P_QF5_PRIME,P_GEOPF5,P_GEOPF5,P_ZXPP_PRIME,P_ZXPP_PRIME)  
!     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_prime     = Perturbed pressure on full levels (INPUT) 
!           P_TF5            = Temperature on full levels (INPUT)
!           P_TF5_PRIME      = Perturbed temperature on full levels (INPUT)
!           P_QF5            = Specific humidity on full levels (INPUT)
!           P_QF5_PRIME      = Perturbed specific humidity on full levels (INPUT)
!           P_GEOPF5         = Geopotential on full levels (INPUT)
!           P_GEOPF5_PRIME   = Perturbed Geopotential on full levels (INPUT)
!           P_ZXPP_PRIME     = Perturbed bending angle values (OUTPUT)  

!     gpsro_tl is called from HOPTL

!**   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_refractl - Calculate the refractivity on model (full) levels
!        gpscalc_nrtl     - Calculate the refractive index - radius product on full levels
!        gpscalc_alphatl  - 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(IN)    :: PRESF5_PRIME(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(IN)    :: P_TF5_PRIME(KDLEN,NFLEVG,KHORIZ) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_QF5(KDLEN,0:NFLEVG,KHORIZ) ! spec.humid values "
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_QF5_PRIME(KDLEN,NFLEVG,KHORIZ) ! spec.humid values "
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_GEOPF5(KDLEN,NFLEVG,KHORIZ) ! geopotential heights "
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_GEOPF5_PRIME(KDLEN,NFLEVG,KHORIZ) ! geopotential heights "
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_ZXPP_PRIME(KDLEN,K_IMXCOUNT) ! bending angles       
REAL(KIND=JPRB) :: Z_ALPHA_PRIME(K_IMXCOUNT)
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_PRIME(nflevg,KHORIZ)   ! " perturbed
REAL(KIND=JPRB) :: Z_TEMP(nflevg,KHORIZ)         ! Temperature on model levels 
REAL(KIND=JPRB) :: Z_TEMP_PRIME(nflevg,KHORIZ)   ! " perturbed 
REAL(KIND=JPRB) :: Z_Q(nflevg,KHORIZ)            ! Specific humidity on model levels
REAL(KIND=JPRB) :: Z_Q_PRIME(nflevg,KHORIZ)      ! " perturbed
REAL(KIND=JPRB) :: zg(nflevg,KHORIZ)             ! geopotential height on model levels
REAL(KIND=JPRB) :: zg_prime(nflevg,KHORIZ)       ! " perturbed 
REAL(KIND=JPRB) :: Z_REFRAC(nflevg,KHORIZ)       ! refractivity on model levels
REAL(KIND=JPRB) :: Z_REFRAC_PRIME(nflevg,KHORIZ) ! " perturbed
REAL(KIND=JPRB) :: Z_RAD(nflevg,KHORIZ)           ! refractive index radius product
REAL(KIND=JPRB) :: Z_RAD_PRIME(nflevg,KHORIZ)     ! " perturbed
REAL(KIND=JPRB) :: Z_NR(nflevg,KHORIZ)           ! refractive index radius product
REAL(KIND=JPRB) :: Z_NR_PRIME(nflevg,KHORIZ)     ! " perturbed
REAL(KIND=JPRB) :: Z_A(K_IMXCOUNT)        ! impact parameter values
REAL(KIND=JPRB) :: Z_2D
REAL(KIND=JPRB) :: Z_APATH_PRIME(K_IMXCOUNT,2)

#include "gpscalc_refrac2dtl.intfb.h"
#include "gpscalc_nr2dtl.intfb.h"
#include "gpscalc_alpharkm2tl.intfb.h"

#include "openmp_obs.h"

! loop through each ob

IF (LHOOK) CALL DR_HOOK('GPSRO_2DTL',0,ZHOOK_HANDLE)
P_ZXPP_PRIME(:,:) = 0.0_JPRB


! set the splitting and the 2d calculation height limit

isplit = 4
Z_2D = 1.0E4_JPRB


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_PRES_PRIME(I_K,:) = presf5_prime(i,j,:)
 
    Z_TEMP(I_K,:)       = P_TF5(i,j,:) 
    Z_TEMP_PRIME(I_K,:) = P_TF5_PRIME(i,j,:)       
 
    Z_Q(I_K,:)          = P_QF5(i,j,:)
    Z_Q_PRIME(I_K,:)    = P_QF5_PRIME(i,j,:)
     
    zg(I_K,:)         = P_GEOPF5(i,j,:)/RG              ! in m
    zg_prime(I_K,:)   = P_GEOPF5_PRIME(i,j,:)/RG  
     
    I_K = I_K-1
        
  ENDDO        
               
! calculate the refractivity on model levels

  CALL gpscalc_refrac2dTL(nflevg, &
   & KHORIZ, &
   & Z_PRES, &
   & Z_PRES_PRIME, &
   & Z_TEMP,   &
   & Z_TEMP_PRIME, &
   & Z_Q,       &
   & Z_Q_PRIME, &
   & Z_REFRAC,       &! output
   & Z_REFRAC_PRIME)  ! output   
   
! calculate the refractive index - radius product on high-res mesh

  CALL gpscalc_nr2dTL(nflevg, &
   & KHORIZ,   &
   & Z_ROC,     &
   & Z_LAT,     &
   & zg,      &
   & zg_prime, &
   & Z_REFRAC,  &
   & Z_REFRAC_PRIME, &
   & Z_RAD,       &
   & Z_RAD_PRIME, &         
   & Z_NR,      &
   & Z_NR_PRIME)  

! bending angle
        
  CALL gpscalc_alpharkm2TL(K_IMXCOUNT, &
   & nflevg,   &
   & KHORIZ,  &
   & isplit, &
   & dtheta,  &
   & Z_A,        &
   & Z_REFRAC,   &
   & Z_REFRAC_PRIME, &
   & Z_RAD,       &
   & Z_RAD_PRIME, &   
   & Z_NR,       &
   & Z_NR_PRIME, &
   & Z_ROC,   &
   & Z_2D, &
   & Z_APATH_PRIME, &
   & Z_ALPHA_PRIME)           
        
! Now store the bending angles

  P_ZXPP_PRIME(i,1:K_IMXCOUNT) = Z_ALPHA_PRIME(1:K_IMXCOUNT)           
   
ENDDO

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

END SUBROUTINE gpsro_2dTL

