SUBROUTINE gpsro_op(kdlen,kdbdy,K_IMXCOUNT,klen,K_IVNMRQ,presf5,   &
                  & P_TF5,P_QF5,P_GEOPF5,P_ZXPP, &
                  & P_ZXPP_N,P_ZXPP_DNDZ,P_ZXPP_D2NDZ2,P_ZXPP_T,K_LEVM, &
                  & LD_QC_DNDZ,LD_QC_D2NDZ2)

!**** *gpsro_op* - 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_op(kdlen,kdbdy,K_IMXCOUNT,klen,K_IVNMRQ,presf5,P_TF5,P_QF5, &
!  & P_GEOPF5,P_ZXPP, P_ZXPP_N=P_ZXPP_N, P_ZXPP_DNDZ=P_ZXPP_DNDZ, &
!  & P_ZXPP_D2NDZ2=P_ZXPP_D2NDZ2, P_ZXPP_T=P_ZXPP_T, K_LEVM=K_LEVM, &
!  & LD_QC_DNDZ=LD_QC_DNDZ, LD_QC_D2NDZ2=LD_QC_D2NDZ2)
!     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)
!           P_TF5      = Temperature on full levels (INPUT)
!           P_QF5      = Specific humidity on full levels (INPUT)
!           P_GEOPF5   = Geopotential on full levels (INPUT)
!           P_ZXPP     = Bending angle values (OUTPUT)  
!           P_ZXPP_N   = OPTIONAL Refractivity (OUTPUT)
!           P_ZXPP_DNDZ= OPTIONAL Vertical refractivity gradient (OUTPUT)
!           P_ZXPP_D2NDZ2= OPTIONAL 2nd order derivative of refract. (OUTPUT)
!           P_ZXPP_T   = OPTIONAL Temperature (OUTPUT)
!           K_LEVM     = OPTIONAL Number of the model level where lies the obs (OUTPUT)
!           LD_QC_DNDZ  = OPTIONAL False for suspicious dN/dz from model (OUTPUT)
!           LD_QC_D2NDZ2= OPTIONAL False for suspicious d2N/dz2 from model (OUTPUT)

!     gpsro_op is called from HOP

!**   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_refrac - Calculate the refractivity on model (full) levels
!        gpscalc_nr     - Calculate the refractive index - radius product on full levels
!        gpscalc_alpha  - Calculate the bending angles

!**   MODIFICATIONS
!     -------------
!     Sean Healy      2004/10/26 : Original
!     Paul Poli       2006/09/12 : Added optional outputs: refractivity, 
!                                  vertical gradient of refractivity, and
!                                  number of the model level where lies the obs
!     Paul Poli       2007/03/09 : Added quality indicators based on background
!     Paul Poli       2007/03/14 : Added temperature output
!     Sean Healy      2009/03/03 : Introduced compressibility
!     -------------------------------------------------------------------------



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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDBDY 
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) ! pressure on **full levels**
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TF5(KDLEN,0:NFLEVG) ! Z_TEMP. values     "
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_QF5(KDLEN,0:NFLEVG) ! spec.humid values "
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_GEOPF5(KDLEN,NFLEVG) ! geopotential heights "
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_ZXPP(KDLEN,K_IMXCOUNT) ! bending angles          
REAL(KIND=JPRB)   ,INTENT(OUT), OPTIONAL :: P_ZXPP_N(KDLEN,K_IMXCOUNT) ! refractivity
REAL(KIND=JPRB)   ,INTENT(OUT), OPTIONAL :: P_ZXPP_DNDZ(KDLEN,K_IMXCOUNT) ! vertical refractivity gradient
REAL(KIND=JPRB)   ,INTENT(OUT), OPTIONAL :: P_ZXPP_D2NDZ2(KDLEN,K_IMXCOUNT) ! 2nd order refractivity vertical gradient
REAL(KIND=JPRB)   ,INTENT(OUT), OPTIONAL :: P_ZXPP_T(KDLEN,K_IMXCOUNT) ! Temperature
INTEGER(KIND=JPIM),INTENT(OUT), OPTIONAL :: K_LEVM(KDLEN,K_IMXCOUNT) ! model level number
LOGICAL(KIND=JPIM),INTENT(OUT), OPTIONAL :: LD_QC_DNDZ(KDLEN,K_IMXCOUNT) ! quality control on dN/dz
LOGICAL(KIND=JPIM),INTENT(OUT), OPTIONAL :: LD_QC_D2NDZ2(KDLEN,K_IMXCOUNT) ! quality control on d2N/dz2

! local variables           
           
INTEGER(KIND=JPIM) :: i,j,I_K,I_L,I_N,ilevg,ibot ! loops
REAL(KIND=JPRB) :: Z_LAT              ! latitude 
REAL(KIND=JPRB) :: Z_ROC              ! radius of curvature
REAL(KIND=JPRB) :: Z_PRES(nflevg)     ! pressure values
REAL(KIND=JPRB) :: Z_TEMP(nflevg)     ! temperature values
REAL(KIND=JPRB) :: Z_Q(nflevg)        ! specific humidity values
REAL(KIND=JPRB) :: zg(nflevg)         ! geopotential heights
REAL(KIND=JPRB) :: Z_DTDZG(nflevg)    ! temperature lapse rate w.r.t. geop hght
REAL(KIND=JPRB) :: Z_REFRAC(nflevg)   ! refractivity values
REAL(KIND=JPRB) :: Z_NR(nflevg)       ! radius - refractive index product  
REAL(KIND=JPRB) :: Z_Z(nflevg)        ! geometric heights
REAL(KIND=JPRB) :: Z_A(K_IMXCOUNT)    ! impact parameter values
REAL(KIND=JPRB) :: Z_ALPHA(K_IMXCOUNT)! bending angles
REAL(KIND=JPRB) :: Z_N(K_IMXCOUNT)    ! refractivity at obs level
REAL(KIND=JPRB) :: Z_DNDZ(K_IMXCOUNT) ! refrac. vertical gradient at obs level
REAL(KIND=JPRB) :: Z_D2NDZ2(K_IMXCOUNT) ! 2nd order derivative
INTEGER(KIND=JPIM) :: I_LEVM(K_IMXCOUNT) ! model level number
LOGICAL         :: LLD_QC1(K_IMXCOUNT), LLD_QC2(K_IMXCOUNT)
REAL(KIND=JPRB) :: Z_ZGT(K_IMXCOUNT)  ! obs geopotential height
REAL(KIND=JPRB) :: Z_TEMPATOBSL(K_IMXCOUNT) ! temperature at obs geop. height

! new compressibility factors

REAL(KIND=JPRB) :: ZCOMP_MIX(nflevg)            ! compressibility of moist air 
REAL(KIND=JPRB) :: ZCOMP_DRY_INV(nflevg)        ! inverse of comp. of dry air
REAL(KIND=JPRB) :: ZCOMP_WET_INV(nflevg)        ! inverse of comp. of water vap.

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "gpscalc_compress.intfb.h"
#include "gpscalc_nr.intfb.h"
#include "gpscalc_refrac.intfb.h"
#include "gpscalc_alpha.intfb.h"

#include "openmp_obs.h"

! initialise zxpp

IF (LHOOK) CALL DR_HOOK('GPSRO_OP',0,ZHOOK_HANDLE)
P_ZXPP(:,:) = RMDI

! loop through each ob

DO i = 1, klen

! set default values for optional outputs
  IF (present(P_ZXPP_N)) P_ZXPP_N(i,1:K_IMXCOUNT) = 0._JPRB
  IF (present(P_ZXPP_DNDZ)) P_ZXPP_DNDZ(i,1:K_IMXCOUNT) = 0._JPRB
  IF (present(P_ZXPP_D2NDZ2)) P_ZXPP_D2NDZ2(i,1:K_IMXCOUNT) = 0._JPRB
  IF (present(K_LEVM)) K_LEVM(i,1:K_IMXCOUNT) = 0
  IF (present(LD_QC_DNDZ)) LD_QC_DNDZ(i,1:K_IMXCOUNT) = .TRUE.
  IF (present(LD_QC_D2NDZ2)) LD_QC_D2NDZ2(i,1:K_IMXCOUNT) = .TRUE.

! 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

! copy the impact parameter value
      
      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       ! geopotential height in m 
      
    I_K = I_K-1
      
  ENDDO        
 
! calculate the compressibility factors 
 
  CALL gpscalc_compress(nflevg, &
   & Z_PRES, &
   & Z_TEMP, &
   & Z_Q,     &
   & ZCOMP_MIX, &
   & ZCOMP_DRY_INV, &
   & ZCOMP_WET_INV)   
         
 
! calculate the refractivity on model levels

  CALL gpscalc_refrac(nflevg, &
   & Z_PRES, &
   & Z_TEMP, &
   & Z_Q, & 
   & ZCOMP_DRY_INV, &
   & ZCOMP_WET_INV, &     
   & Z_REFRAC)  ! output   

! calculate the nr product and geometric heights
   
  CALL gpscalc_nr(nflevg, &
   & Z_ROC,     &
   & Z_LAT,     &
   & zg,      &
   & Z_REFRAC,  &
   & ZCOMP_MIX, &   
   & Z_NR,      &
   & P_Z=Z_Z)  

! calculate the bending angles, refractivity and refractivity vertical gradient
! at observation level

  CALL gpscalc_alpha(K_IMXCOUNT, &
   & nflevg,   &
   & Z_A,        &
   & Z_REFRAC,   &
   & Z_NR,       &
   & Z_Z,        &
   & Z_ALPHA,    &
   & Z_N,        &
   & Z_DNDZ,     &
   & Z_D2NDZ2,   &
   & I_LEVM,     &
   & LLD_QC1,     &
   & LLD_QC2)

! Now store the bending angles

  P_ZXPP(i,1:K_IMXCOUNT) = Z_ALPHA(1:K_IMXCOUNT)           

! Store refractivity and refractivity vertical gradient, if required

  IF (present(P_ZXPP_N)) &
    & P_ZXPP_N(i,1:K_IMXCOUNT) = Z_N(1:K_IMXCOUNT)
  IF (present(P_ZXPP_DNDZ)) &
    & P_ZXPP_DNDZ(i,1:K_IMXCOUNT) = Z_DNDZ(1:K_IMXCOUNT)
  IF (present(P_ZXPP_D2NDZ2))  &
    & P_ZXPP_D2NDZ2(i,1:K_IMXCOUNT) = Z_D2NDZ2(1:K_IMXCOUNT)
  IF (present(K_LEVM)) &
    & K_LEVM(i,1:K_IMXCOUNT) = I_LEVM(1:K_IMXCOUNT)
  IF (present(LD_QC_DNDZ)) &
    & LD_QC_DNDZ(i,1:K_IMXCOUNT) = LLD_QC1(1:K_IMXCOUNT)
  IF (present(LD_QC_D2NDZ2)) &
    & LD_QC_D2NDZ2(i,1:K_IMXCOUNT) = LLD_QC2(1:K_IMXCOUNT)

! Calculate temperature at obs geopotential height, if required

  IF (present(P_ZXPP_T)) THEN

     ! extract geopotential heights from ROBODY

     Z_ZGT(:) = RMDI
     j=1
     I_L=1
     DO I_K = MLNKH2B(i),MLNKH2B(i+1) - 1
       IF (K_IVNMRQ(i,I_L) == nvnumb(76)) THEN
         ! copy the geopotential height value and QC check
         Z_ZGT(j) = ROBODY(I_K,MDB_OBS_ZVALUE_AT_ROBODY)
         IF (Z_ZGT(j) < -1.e3 .or. Z_ZGT(j) > 8.e4) Z_ZGT(j) = RMDI
         j=j+1
       ENDIF
       I_L = I_L + 1
       IF (j > K_IMXCOUNT) EXIT
     ENDDO

     ! calculate temperature lapse rate w.r.t. geopot. height

     Z_DTDZG(:) = RMDI
     DO ilevg=1,nflevg-1
        Z_DTDZG(ilevg) = (Z_TEMP(ilevg+1)-Z_TEMP(ilevg)) / &
         & MAX(1.0_JPRB,(zg(ilevg+1)-zg(ilevg)))
     ENDDO

     ! calculate temperature at obs geopotential height

     Z_TEMPATOBSL(:) = RMDI
     DO I_N=1,K_IMXCOUNT

        ! search for model layer

        ibot = 0
        DO ilevg = 1, nflevg-1
           IF (Z_ZGT(I_N) >= zg(ilevg) .and. Z_ZGT(I_N) < zg(ilevg+1)) &
            & ibot=ilevg
        ENDDO

        ! calculate temperature within the layer, if found

        IF (ibot /= 0) Z_TEMPATOBSL(I_N) = Z_TEMP(ibot) + &
         & Z_DTDZG(ibot) * (Z_ZGT(I_N)-zg(ibot))
     ENDDO

     ! save results

     P_ZXPP_T(i,1:K_IMXCOUNT) = Z_TEMPATOBSL(1:K_IMXCOUNT)

  ENDIF

ENDDO

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

END SUBROUTINE gpsro_op
