SUBROUTINE gpsro_oberror(klen)

!**** *gpsro_oberror* - Assigns the observation errors.

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

!     PURPOSE
!     -------
!     It assigns the GPSRO observation errors:

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

!    CALL gpsro_oberror(klen) 
!     WHERE KLEN      = Number of observations.

!     gpsro_oberror is called from HRETR

!**   METHOD
!     ------

!**   EXTERNALS
!     ---------

!**   MODIFICATIONS
!     -------------
!     Sean Healy      2004/10/26 : Original
!     Paul Poli       2006/08/28 : Added writing of MDBOER for MF
!     Paul Poli       2007/03/06 : Added a stratospheric obs error estimate
!     A.Bogatchev : 26-Oct-2007 removing of severe breaks of coding rools
!     -------------------------------------------------------------------------


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

USE YOMCT0B  , ONLY : LECMWF
USE YOMANCS  , ONLY : RMDI
USE YOMDB

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
! local variables           
           
INTEGER(KIND=JPIM) :: i,I_K                  ! loops
REAL(KIND=JPRB) :: Z_ROC                     ! radius of curvature
REAL(KIND=JPRB) :: Z_FRAC,Z_FRAC1,Z_FRAC2,Z_FRAC3    ! fractional errors
REAL(KIND=JPRB) :: zed                       ! impact height
REAL(KIND=JPRB) :: Z_OBERROR                 ! ob error value
REAL(KIND=JPRB) :: Z_ALPHA,Z_A               ! observed bending angle and impact parameter
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "openmp_obs.h"

! loop through each ob

IF (LHOOK) CALL DR_HOOK('GPSRO_OBERROR',0,ZHOOK_HANDLE)
Z_FRAC1 = 0.2_JPRB
Z_FRAC2 = 0.01_JPRB
IF (.NOT.(LECMWF)) THEN
   ! for MF:
   ! use 6% near the surface
   ! use 2% above 10km
   ! use 3% above 15km
   Z_FRAC1 = 0.06_JPRB
   Z_FRAC2 = 0.02_JPRB
   Z_FRAC3 = 0.03_JPRB
ENDIF

DO i = 1, klen

! radius of curvature at each location

  Z_ROC = ROBHDR(i,MDBRADCURV)
   
! extract the data from ROBODY

  DO I_K = MLNKH2B(i),MLNKH2B(i+1) - 1
      
! impact parameter
      
    Z_A = ROBODY(I_K,MDBPPP) 

      
! bending angle      

    Z_ALPHA = ROBODY(I_K,MDBVAR)
      
! initially set the obs error to missing data 

    ROBODY(I_K,MDBFOE) = RMDI
    IF (.NOT.(LECMWF)) ROBODY(I_K,MDBOER) = RMDI

! check not missing data
      
    IF (ABS(Z_ALPHA-RMDI) > 1.0E3_JPRB*SPACING(Z_ALPHA) .AND. &
       & ABS(Z_A    -RMDI) > 1.0E3_JPRB*SPACING(Z_A))     THEN  
           
! zed = 'impact height'

      zed = Z_A - Z_ROC
      
      IF ( zed > 1.0E4_JPRB) THEN
 
         IF ( .NOT.(LECMWF) .AND. zed > 1.5E4_JPRB ) THEN

         ! 4% error above 15 km
            Z_FRAC = Z_FRAC3

         ELSE
      
! 1% error above 10 km
            Z_FRAC = Z_FRAC2

         ENDIF
     
      ELSE
 
! fractional error falls with height between surface and 10km.      

        Z_FRAC = Z_FRAC1 + (Z_FRAC2-Z_FRAC1)*zed/1.0E4_JPRB     
      
      ENDIF

! include 6 microradian ionospheric lower limit

      Z_OBERROR = MAX(MIN(Z_FRAC*Z_ALPHA,0.01_JPRB),3.0E-6_JPRB)

! Final observation error

      ROBODY(I_K,MDBFOE) = Z_OBERROR
   
! Observation error

      IF (LECMWF) THEN
        ROBODY(I_K,MDBOER) = Z_OBERROR
      ELSE
        ROBODY(I_K,MDBOER) = ROBODY(I_K,MDBFOE)
      ENDIF

   
    ENDIF
                
  ENDDO
              
ENDDO

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

END SUBROUTINE gpsro_oberror
