SUBROUTINE BGOBS(CDCONF,KLEN,KCH,KNRCH,&
 & POROG5,PLAT,PLS5,PTS5,PWS5,PSN5,PZ05,PVEG5,PCI5,&
 & PUF ,PVF ,PTF ,PQF ,PO3F ,PGFLF,PSP ,PTS,&
 & PUF5,PVF5,PTF5,PQF5,PO3F5,PGFLF5,PSP5,&
 & PUPP,PVPP,PTPP,PRPP,PQPP,PO3PP,PGHGPP,PGRGPP,PAEROPP,&
 & PRADM,PZPP,PTCW,PTO3,PRH2M,PU10M,PV10M,PT2M)  

!**** *BGOBS* - COMPUTATION OF OBS EQUIVALENTS OF BG ERRORS

!     PURPOSE.
!     -------
!     COMPUTE THE RADIANCES FROM THE MODEL VARIABLES
!     ON THE MODEL GRID

!**   INTERFACE.
!**   ---------
!**   *CALL* * BGOBS()*  (FROM VEC2GP)

!**   EXTERNALS
!     ---------
!    ( ) PREINT: ROUTINES TO PREPARE POSTPROCESSING.
!    ( ) PPOBSATL: POSTPROCESSING ROUTINES
!    ( ) RADTRTL: INTERFACE ROUTINE TO THE TOVS RADIANCE COMPUTATION

!     AUTHOR: Erik Andersson (based on TOVCLRTL)
!     DATE  : 98-05-19

!     MODIFICATIONS
!     -------------
!     P.Viterbo   99/09/01 - Surface tiles
!        R. El Khatib : 01-08-07 Pruning options
!        G Kelly  23/11/03 for rttov 8   
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        G. Desroziers 16-Mar-2006  Do not call surface observation operators if LCACHMT=.F.
!        D. Salmond    24-Apr-2007  Switch loop order for optimisation
!        N Bormann     01-Oct-2007  RTTOV-9
!        N Bormann     05-Aug-2008  RTTOV-interpolation option for RTTOV-9
!        V. Guidard    16-Aug-2007  Modify call to RADTRTL
!        H. Hersbach   04-Jul-2008  Add ocean current and Charnock, using default values
!        H. Hersbach   04-Dec-2009  Add 10m neutral wind
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVG   ,NPPM     ,NPROMA   
USE YOMDIMO  , ONLY : NLSAT    ,NPNAV
USE YOMCST   , ONLY :       RG
USE YOMCOCTP , ONLY : NTEMP    ,NSATEM   ,NSYNOP
USE YOMOBS   , ONLY : LCACHMT
USE YOMTVRAD , ONLY : RADPRE   ,&
 & TVTSBGE_LAND,TVTSBGE_SEA,TVTSBGE_ICE ,&
 & SATGRP_TABLE,NSATGRP,MXSENSOR,&
 & MSENSOR_HIRS,MSENSOR_MSU,MSENSOR_SSU,&
 & MSENSOR_AMSUA,MSENSOR_AMSUB,MSENSOR_SSMI,&
 & MSENSOR_CHANCOUNT,MSENSOR_CHANOFFL,LRTTOV_INTERPOL
USE YOMANCS  , ONLY : RMDI, RDEGREES
USE YOMANEB  , ONLY : NANERADS
USE YOMJG , ONLY : SPJB_VARS_INFO, NAEROCV
USE YOMGRB , ONLY : NGRBO3,NGRBAERLG
USE TYPE_GEMS_PROFILES
USE YOM_YGFL , ONLY : YGHG, YGRG, YAERO, JPGRG,  YGFL, &
 & NGHG, NGRG, NAERO, JPGHG, JPAERO

IMPLICIT NONE

INTERFACE
#include "surf_inq.h"
END INTERFACE

#include "hradptl.intfb.h"
#include "hradp_ml_tl.intfb.h"
#include "ppobsa.intfb.h"
#include "ppobsas.intfb.h"
#include "ppobsastl.intfb.h"
#include "ppobsatl.intfb.h"
#include "preint.intfb.h"
#include "preints.intfb.h"
#include "preintstl.intfb.h"
#include "preinttl.intfb.h"
#include "qneglim.intfb.h"
#include "qneglimtl.intfb.h"
#include "radtrtl.intfb.h"
#include "radtr_ml_tl.intfb.h"

!   LOCAL ARRAYS FOR LATITUDE,LONGITUDE,TIME,CHANNEL NUMBERS.
CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCH(NANERADS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNRCH 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAT(NPROMA)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLS5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTS5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWS5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSN5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZ05(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVEG5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCI5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUF(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVF(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQF(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PO3F(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGFLF(NPROMA,NFLEVG,YGFL%NDIM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSP(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUF5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVF5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQF5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PO3F5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGFLF5(NPROMA,NFLEVG,YGFL%NDIM5) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSP5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUPP(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVPP(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTPP(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRPP(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQPP(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PO3PP(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGHGPP(NPROMA,NFLEVG,NGHG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGRGPP(NPROMA,NFLEVG,NGRG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PAEROPP(NPROMA,NFLEVG,NAEROCV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRADM(NPROMA,NANERADS) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PZPP(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTCW(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTO3(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRH2M(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PU10M(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PV10M(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PT2M(NPROMA) 
REAL(KIND=JPRB), DIMENSION(NPROMA) ::ZOROGOB
REAL(KIND=JPRB), DIMENSION(NPROMA) ::ZZENANG,ZAZIANG
REAL(KIND=JPRB), DIMENSION(NPROMA) ::ZSOLZENANG,ZSOLAZIANG

!   ARRAYS DESCRIBING THE CONSTANT SURFACE FIELDS...
REAL(KIND=JPRB), DIMENSION(NPROMA) ::ZOROG5,ZINTHUV,ZINTH,ZZ0SCAT,ZLAT

!   ARRAYS DESCRIBING THE PHYSICAL SURFACE FIELDS
REAL(KIND=JPRB), DIMENSION(NPROMA) ::&
 & ZSN5,ZWS5,ZTS5,ZSST5,ZWL5 &
 & ,ZSN ,ZWS ,ZTS ,ZVEG ,ZCI ,ZWL ,ZLS &
 & ,ZTSTAR5,ZT05,ZPS5,ZU05,ZV05,ZU10N5,ZV10N5,ZCHN5,ZZ05 &
 & ,ZTSTAR ,ZT0 ,ZPS ,ZU10N,ZV10N, ZZ0  
REAL(KIND=JPRB), DIMENSION(NPROMA,NANERADS) :: ZEM5,ZEM,ZRCH

!   ZUF5   :   MODEL U-COMPONENT
!   ZVF5   :   MODEL V-COMPONENT
!   ZUF,ZVF:   CORRESPONDING PERTURBATIONS
!   ZU05   :   OCEAN CURRENT U-COMPONENT
!   ZV05   :   OCEAN CURRENT V-COMPONENT
!   ZU10N5 :   U-COMP 10M NEUTRAL WIND
!   ZV10N5 :   V-COMP 10M NEUTRAL WIND
!   ZCHN5  :   WAVE CHARNOCK
!   ZQN5   :   ZQF5 WITHOUT NEGATIVE VALUES
!   ZCLWF5,ZCIWF5,ZCCF5 : Cloud fields (Not used)

REAL(KIND=JPRB), DIMENSION(NPROMA,0:NFLEVG) :: ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,ZQN5,&
 & ZCLWF5,ZCIWF5,ZCCF5,ZCSWF5,ZCRWF5,ZCGWF5  
REAL(KIND=JPRB), DIMENSION(NPROMA,NFLEVG)   :: ZUF ,ZVF ,ZTF ,ZQF ,ZO3F ,ZQN,&
 & ZCLWF ,ZCIWF ,ZCCF  
REAL(KIND=JPRB), DIMENSION(NPROMA,NFLEVG) :: ZRF5,ZCP5,ZKAP5,ZRF ,ZCP ,ZKAP

!   Z...5  :   VARIABLES FOR TRAJECTORIES
!   ZPRESH5:   HALF LEVEL PRESSURE VALUES AT OBS POINTS
!   ZPRESF5:   FULL ...............................................
!   ZGEOPH5:   HALF LEVEL GEOPOTENTIAL VALUES AT OBS POINTS OF
!   ZGEOPF5:   FULL ...............................................
!   ZPXP5  :   INTERMEDIATE VARIABLES (SEE PPINIT)
!   ZPXPD5 :   .... ...............................

REAL(KIND=JPRB), DIMENSION(NPROMA,0:NFLEVG) ::ZPRESH5,ZGEOPH5,ZPRESH ,ZGEOPH
REAL(KIND=JPRB), DIMENSION(NPROMA,NFLEVG) ::ZPRESF5,ZGEOPF5,ZPRESF ,ZGEOPF
REAL(KIND=JPRB), DIMENSION(NPROMA,0:NFLEVG,NPPM) ::&
 & ZPXP5,ZPXPD5,ZPXZ5,ZPXZD5 &
 & ,ZPXP ,ZPXPD ,ZPXZ ,ZPXZD  
REAL(KIND=JPRB), DIMENSION(NPROMA,NFLEVG) ::&
 & ZALPH5,ZLNPR5,ZDELP5,ZRDELP5,ZRTGR5,ZRPRE5,ZRPP5 &
 & ,ZALPH ,ZLNPR ,ZDELP ,ZRDELP ,ZRTGR ,ZRPRE ,ZRPP  

REAL(KIND=JPRB), DIMENSION(NPROMA) ::&
 & ZCPTGZ5,ZWET5,ZQS5,ZCPTS5,ZRI5 &
 & ,ZCPTGZ ,ZWET ,ZQS ,ZCPTS &
 & ,ZBN5,ZBM5,ZBH5 &
 & ,ZBN ,ZBM ,ZBH  
REAL(KIND=JPRB), DIMENSION(NPROMA,2) ::ZES5
REAL(KIND=JPRB), DIMENSION(NPROMA,NFLEVG) ::ZAPHI5,ZAPHI

!   COUNTERS AND "OBSERVED PRESSURES"
INTEGER(KIND=JPIM), DIMENSION(NPROMA) ::ICOUNT

!   ZSPRES: PRESSURE VALUES OF THE TOVS RAD TR MODEL FOR EACH TOVS.
!   ZSTPP5: TEMPERATURE VERTICALLY INTERPOLATED TO THE TOVS LEVELS.
!   ZSQPP5: HUMIDITY PARAMETER VERT. POSTPROCESSED TO THE TOVS LEVELS.
!   ZSTPP, ZSQPP: PERTURBATION ARRAYS
!   ZT2M5 AND ZQ2M5: 2M TEMPERATURE AND RH.
!   ZT2M AND ZQ2M: PERTURBATION ARRAYS
INTEGER(KIND=JPIM), PARAMETER :: INPP=9+JPGRG+JPGHG+JPAERO
INTEGER(KIND=JPIM) :: INPPS
REAL(KIND=JPRB), DIMENSION(NPROMA,NFLEVG) :: ZPRES
REAL(KIND=JPRB), DIMENSION(NPROMA,NFLEVG,INPP) :: ZXPP
REAL(KIND=JPRB), DIMENSION(NPROMA,NLSAT) :: ZSPRES
REAL(KIND=JPRB), DIMENSION(NPROMA,NLSAT,NPNAV-1) :: ZTQOPP5,ZTQOPP
REAL(KIND=JPRB), DIMENSION(NPROMA) ::ZT2M5,ZQ2M5,ZRH2M5,ZT2M ,ZQ2M ,ZCTOP5,ZCAMT5,ZCTOP,ZCAMT
REAL(KIND=JPRB), DIMENSION(NPROMA) ::ZCTOP5D,ZCAMT5D,ZCTOPD,ZCAMTD

!   PRADM : MODEL RADIANCES FOR EACH CHANNEL AND EACH GRID POINT.
INTEGER(KIND=JPIM) :: IOBS,INLAMTOP,ISETDUM,ICOEF,INRCH,ILEN
INTEGER(KIND=JPIM) :: ICHAN_MIN,ICHAN_MAX,ICHAN_FIRST_INDEX,IOFF
INTEGER(KIND=JPIM) :: JLEV,J,JCH,IOBSTYPE
INTEGER(KIND=JPIM) :: JGRP,JSENSOR
REAL(KIND=JPRB) :: ZDUM,ZTTOP,ZFAC,ZNVANG(1),ZZEANG(1)
REAL(KIND=JPRB) :: ZTBTTOTDUM(NPROMA,NANERADS) 
REAL(KIND=JPRB) :: ZEM5_LAND,ZEM5_ICE,ZEM5_SEA,ZEM_LAND,ZEM_ICE,ZEM_SEA

! Define SSM/I simplified emissivity model parameters
REAL(KIND=JPRB), PARAMETER :: A_SSMI    =  0.061
REAL(KIND=JPRB), PARAMETER :: B_SSMI    =  0.274
REAL(KIND=JPRB), PARAMETER :: C_SSMI    = -0.1386100
REAL(KIND=JPRB), PARAMETER :: D_SSMI    =  0.7905029
REAL(KIND=JPRB) :: ZRCIMIN
LOGICAL ::  LL_SENSOR_BGE(0:MXSENSOR), LLO3
REAL(KIND=JPRB) :: ZHOOK_HANDLE

TYPE (TYPE_GEMSPROF), DIMENSION(NPROMA,NGEMS) :: YLGEMSPROF,YLGEMSPROF5
REAL(KIND=JPRB), TARGET :: Z_MODELPROF(NPROMA,NGEMS,NFLEVG),Z_MODELPROF5(NPROMA,NGEMS,NFLEVG)
REAL(KIND=JPRB), TARGET :: Z_RTTOVPROFA(NPROMA,NGEMS,NFLEVG), Z_RTTOVPROFA5(NPROMA,NGEMS,NFLEVG)
REAL(KIND=JPRB), TARGET :: Z_RTTOVPROFB(NPROMA,NGEMS,NLSAT), Z_RTTOVPROFB5(NPROMA,NGEMS,NLSAT)
REAL(KIND=JPRB) :: ZTEMP(NPROMA)
INTEGER(KIND=JPIM) :: JLEN,IGEMS,JGHG,JGRG,JAERO,IGHG,IGRG,IAERO

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

!*       1. PREPARATION OF THE LOGISTIC PARAMETERS
!           --------------------------------------

IF (LHOOK) CALL DR_HOOK('BGOBS',0,ZHOOK_HANDLE)

LLO3 = ANY(SPJB_VARS_INFO(:)%IGRIBCODE==NGRBO3)

CALL SURF_INQ(PRCIMIN=ZRCIMIN)

DO JLEN=1,KLEN
  DO IGEMS=1,NGEMS
    YLGEMSPROF5(JLEN,IGEMS)%MODELPROF => Z_MODELPROF5(JLEN,IGEMS,:)
    YLGEMSPROF5(JLEN,IGEMS)%RTTOVPROF => Z_RTTOVPROFA5(JLEN,IGEMS,:)
    YLGEMSPROF(JLEN,IGEMS)%MODELPROF => Z_MODELPROF(JLEN,IGEMS,:)
    YLGEMSPROF(JLEN,IGEMS)%RTTOVPROF => Z_RTTOVPROFA(JLEN,IGEMS,:)
  ENDDO
ENDDO

!           1.2   Stratosphere and surface T do not contribute
!                 to the eigenvalues of the Hessian.
IF (CDCONF == 'A') THEN
  ZFAC = 1.0_JPRB
ELSE
  ZFAC = 0.0_JPRB
ENDIF

!           1.4   LAT, LONG, TIME, VIEW ANGLE, OROGRAPHY

ILEN=KLEN
ZDUM=1.0_JPRB
ZOROGOB(1:ILEN) = RMDI

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

!*       2. PREPARE MODEL DATA
!           ------------------

!*          2.1   UPPER AIR DATA
! Note that dimensions differ between ZTF5 and PTF5, etc.
! Perturbation arrays are copied, because they may be modified locally
! like PQF is modified in QNEGLIMTL, for example.

DO JLEV = 1,NFLEVG
  DO J = 1,ILEN
    ZUF5(J,JLEV)=PUF5(J,JLEV)
    ZVF5(J,JLEV)=PVF5(J,JLEV)
    ZTF5(J,JLEV)=PTF5(J,JLEV)
    ZQF5(J,JLEV)=PQF5(J,JLEV)
    ZUF (J,JLEV)=PUF (J,JLEV)
    ZVF (J,JLEV)=PVF (J,JLEV)
    ZTF (J,JLEV)=PTF (J,JLEV)
    ZQF (J,JLEV)=PQF (J,JLEV)
    IF(LLO3) THEN
      ZO3F5(J,JLEV)=PO3F5(J,JLEV)
      ZO3F (J,JLEV)=PO3F (J,JLEV)
    ENDIF
    IGEMS=0
    DO JGHG=1,NGHG
      IF(YGHG(JGHG)%LGP) THEN
        IGEMS=IGEMS+1
        YLGEMSPROF5(J,IGEMS)%MODELPROF(JLEV) = PGFLF5(J,JLEV,YGHG(JGHG)%MP5)
        YLGEMSPROF (J,IGEMS)%MODELPROF(JLEV) = PGFLF (J,JLEV,YGHG(JGHG)%MP )
        YLGEMSPROF5(J,IGEMS)%IGRIB = YGHG(JGHG)%IGRBCODE
        YLGEMSPROF5(J,IGEMS)%CSPECIES = 'GHG'
        YLGEMSPROF5(J,IGEMS)%LRTTOV = .TRUE.
      ENDIF
    ENDDO
    DO JGRG=1,NGRG
      IF(YGRG(JGRG)%LGP) THEN
        IGEMS=IGEMS+1
        YLGEMSPROF5(J,IGEMS)%MODELPROF(JLEV) = PGFLF5(J,JLEV,YGRG(JGRG)%MP5)
        YLGEMSPROF (J,IGEMS)%MODELPROF(JLEV) = PGFLF (J,JLEV,YGRG(JGRG)%MP )
        YLGEMSPROF5(J,IGEMS)%IGRIB = YGRG(JGRG)%IGRBCODE
        YLGEMSPROF5(J,IGEMS)%CSPECIES = 'GRG'
        YLGEMSPROF5(J,IGEMS)%LRTTOV = .FALSE.
      ENDIF
    ENDDO
    DO JAERO=1,NAERO
      IF(YAERO(JAERO)%LGP) THEN
        IGEMS=IGEMS+1
        YLGEMSPROF5(J,IGEMS)%MODELPROF(JLEV) = PGFLF5(J,JLEV,YAERO(JAERO)%MP5)
        YLGEMSPROF (J,IGEMS)%MODELPROF(JLEV) = PGFLF (J,JLEV,YAERO(JAERO)%MP )
        YLGEMSPROF5(J,IGEMS)%IGRIB = YAERO(JAERO)%IGRBCODE
        YLGEMSPROF5(J,IGEMS)%CSPECIES = 'AERO'
        YLGEMSPROF5(J,IGEMS)%LRTTOV = .FALSE.
      ENDIF
    ENDDO
  ENDDO
ENDDO

!*          2.2   SURFACE DATA, AND ABOVE MODEL TOP, AND PS
! Note that the 5-arrays above the model top normally are set by calling
! PPOBSA. We save some cpu-time here by setting them equal to model top.

DO J = 1,ILEN
  ZUF5(J,0)=PUF5(J,1)
  ZVF5(J,0)=PVF5(J,1)
  ZTF5(J,0)=PTF5(J,1)
  ZQF5(J,0)=PQF5(J,1)
  IF(LLO3)  ZO3F5(J,0)=PO3F5(J,1)

  ZLS(J)  = 0.0_JPRB
  ZTS(J)  = 0.0_JPRB                   !Re-set for TOVS below.
  ZWS5(J) = PWS5(J)/1000._JPRB
  ZWS(J)  = 0.0_JPRB
  ZVEG(J) = 0.0_JPRB
  ZCI(J) = 0.0_JPRB
  ZWL5(J) = 1.0_JPRB/2000._JPRB
  ZWL(J)  = 0.0_JPRB
  ZSN5(J) = PSN5(J)/1000._JPRB
  ZSN(J)  = 0.0_JPRB
  ZZ05(J) = PZ05(J)/RG
  ZZ0(J)  = 0.0_JPRB
  ZOROG5(J)=POROG5(J)
  ZU05(J)  =0.0_JPRB                   ! HH Set to default values
  ZV05(J)  =0.0_JPRB                   ! HH could be added as arguments
  ZU10N5(J)=5.0_JPRB                   ! HH Set to reasonable values
  ZV10N5(J)=0.0_JPRB                   ! HH could be added as arguments
  ZU10N(J) =0.0_JPRB
  ZV10N(J) =0.0_JPRB
  ZCHN5(J)= 0.018_JPRB                 ! HH at a later stage
  ZLAT(J) = PLAT(J) * RDEGREES

  ZPRESH5(J,NFLEVG)=PSP5(J)
  ZPRESH(J,NFLEVG)=PSP(J)
  ZPRESH5(J,NFLEVG) = EXP(ZPRESH5(J,NFLEVG))
  ZPRESH(J,NFLEVG)  = ZPRESH5(J,NFLEVG)*ZPRESH(J,NFLEVG)
ENDDO

!*          2.3   INTERPOLATION PREPARATION 

ISETDUM=1
CALL PREINT(NPROMA,ILEN,-1*ISETDUM,ZOROG5,&
 & ZPRESH5,ZPRESF5,ZGEOPH5,ZGEOPF5,&
 & ZPXP5,ZPXPD5,ZPXZ5,ZPXZD5,ZCP5,ZRF5,ZKAP5,&
 & ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,ZCLWF5,ZCIWF5,ZCCF5,&
 & ZCSWF5,ZCRWF5,ZCGWF5,&
 & ZTSTAR5,ZT05,&
 & ZDELP5,ZRDELP5,ZLNPR5,ZALPH5,ZRTGR5,&
 & ZRPRE5,ZRPP5,YDGEMSPROF5=YLGEMSPROF5)  
CALL PREINTTL(NPROMA,ILEN,-1*ISETDUM,&
 & ZPRESH,ZPRESF,ZGEOPH,ZGEOPF,&
 & ZPXP,ZPXPD,ZPXZ,ZPXZD,ZCP,ZRF,ZKAP,&
 & ZUF,ZVF,ZTF,ZQF,ZO3F,ZCLWF,ZCIWF,ZCCF,&
 & ZTSTAR,ZT0,&
 & ZDELP,ZRDELP,ZLNPR,ZALPH,ZRTGR,&
 & ZRPRE,ZRPP,&
 & ZPRESH5,ZPRESF5,&
 & ZPXP5,ZPXZ5,ZCP5,ZRF5,ZTF5,&
 & ZDELP5,ZRDELP5,ZLNPR5,ZALPH5,&
 & ZRPRE5,ZRPP5,YDGEMSPROF=YLGEMSPROF)  
CALL PREINTS(NPROMA,ILEN,-1*ISETDUM,&
 & ZPRESH5,&
 & ZUF5,ZVF5,ZTF5,ZQF5,ZQN5,PTS5,ZSST5,&
 & ZU05,ZV05,ZU10N5,ZV10N5,ZCHN5,ZRF5,&
 & ZWS5,PVEG5,PCI5,ZWL5,ZSN5,PLS5,ZZ05,&
 & ZES5,ZCPTGZ5,ZWET5,ZQS5,ZCPTS5,ZAPHI5,&
 & ZRI5,ZBN5,ZBM5,ZBH5,&
 & ZLNPR5,ZALPH5)  
CALL PREINTSTL(NPROMA,ILEN,-1*ISETDUM,&
 & ZPRESH,&
 & ZUF,ZVF,ZTF,ZQF,ZQN,ZTS,&
 & ZU10N,ZV10N,ZRF,&
 & ZWS,ZVEG,ZCI,ZWL,ZSN,ZLS,ZZ0,&
 & ZCPTGZ,ZWET,ZQS,ZCPTS,ZAPHI,&
 & ZBN,ZBM,ZBH,&
 & ZLNPR,ZALPH,&
 & ZPRESH5,&
 & ZUF5,ZVF5,ZTF5,ZQF5,ZQN5,PTS5,&
 & ZU05,ZV05,ZU10N5,ZV10N5,ZCHN5,ZRF5,&
 & ZWS5,PVEG5,ZWL5,ZSN5,PLS5,ZZ05,&
 & ZES5,ZWET5,ZQS5,ZAPHI5,&
 & ZRI5,ZLNPR5,ZALPH5)  

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

!*       3. OBSERVATION OPERATORS
!           ---------------------

!*          3.1   UpperAir. 'BG1' means Z, U, V, T, RH, Q, O3, PWC and TO3

ZPRES(1:ILEN,1:NFLEVG) = ZPRESF5(1:ILEN,1:NFLEVG)
ICOUNT(1:ILEN)=NFLEVG
IOBSTYPE=NTEMP
CALL PPOBSATL(NPROMA,ILEN,NFLEVG,'BG1',ICOUNT,ZPRES,ZOROG5,&
 & ZPXP,ZPXPD,&
 & ZUF,ZVF,ZTF,ZQF,ZO3F,ZCLWF,ZCIWF,ZCCF,&
 & ZTSTAR,ZT0,ZLNPR,ZALPH,&
 & INPP,ZXPP,&
 & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,&
 & ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,ZCLWF5,ZCIWF5,ZCCF5,&
 & ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
 & YDGEMSPROF=YLGEMSPROF,YDGEMSPROF5=YLGEMSPROF5)  

PUPP(1:ILEN,1:NFLEVG)=ZXPP(1:ILEN,1:NFLEVG,1)
PVPP(1:ILEN,1:NFLEVG)=ZXPP(1:ILEN,1:NFLEVG,2)
PTPP(1:ILEN,1:NFLEVG)=ZXPP(1:ILEN,1:NFLEVG,3)
PRPP(1:ILEN,1:NFLEVG)=ZXPP(1:ILEN,1:NFLEVG,4)
PQPP(1:ILEN,1:NFLEVG)=ZXPP(1:ILEN,1:NFLEVG,5)
PTCW(1:ILEN)         =ZXPP(1:ILEN,  NFLEVG,6)
PZPP(1:ILEN,1:NFLEVG)=ZXPP(1:ILEN,1:NFLEVG,7)
IF(LLO3) PO3PP(1:ILEN,1:NFLEVG)=ZXPP(1:ILEN,1:NFLEVG,8)
IF(LLO3) PTO3(1:ILEN)=ZXPP(1:ILEN, NFLEVG,9)
IGHG=0
IGRG=0
IAERO=0
DO IGEMS=1,NGEMS
  IF(YLGEMSPROF5(1,IGEMS)%CSPECIES == 'GHG') THEN
    IGHG=IGHG+1
    DO J=1,ILEN
      PGHGPP(J,1:NFLEVG,IGHG)=YLGEMSPROF(J,IGEMS)%RTTOVPROF(1:NFLEVG)
    ENDDO
  ENDIF
  IF(YLGEMSPROF5(1,IGEMS)%CSPECIES == 'GRG') THEN
    IGRG=IGRG+1
    DO J=1,ILEN
      PGRGPP(J,1:NFLEVG,IGRG)=YLGEMSPROF(J,IGEMS)%MODELPROF(1:NFLEVG)
    ENDDO
  ENDIF
  IF(YLGEMSPROF5(1,IGEMS)%IGRIB == NGRBAERLG) THEN
    IAERO=IAERO+1
    DO J=1,ILEN
      PAEROPP(J,1:NFLEVG,IAERO)=YLGEMSPROF(J,IGEMS)%MODELPROF(1:NFLEVG)
    ENDDO
  ENDIF
ENDDO

IF(.NOT.LCACHMT)THEN

!*          3.2   Surface. 'BG1' means H2, T2 and U10.
!*                Had to be split in 3 calls because of ZINTH.
  IOBSTYPE=NSYNOP
  ICOUNT(1:ILEN)=1
  ZINTHUV(1:ILEN) = 10._JPRB*RG
  CALL PPOBSASTL(NPROMA,ILEN,NFLEVG,'U10',ZINTHUV,IOBSTYPE,ICOUNT,ZZ0SCAT,&
   & ZPRESF,ZUF,ZVF,ZTF,ZQN,&
   & ZCPTGZ,ZCPTS,ZAPHI,&
   & ZBN,ZBM,ZBH,&
   & INPP,ZXPP,&
   & ZPRESF5,ZUF5,ZVF5,ZTF5,ZQN5,ZU05,ZV05,&
   & ZCPTGZ5,ZCPTS5,ZAPHI5,ZES5,&
   & ZRI5,ZBN5,ZBM5,ZBH5,ZRH2M5)  
  PU10M(1:ILEN)=ZXPP(1:ILEN,1,1)
  PV10M(1:ILEN)=ZXPP(1:ILEN,1,2)

  ZINTH(1:ILEN) = 2._JPRB*RG
  CALL PPOBSASTL(NPROMA,ILEN,NFLEVG,'T2 ',ZINTH,IOBSTYPE,ICOUNT,ZZ0SCAT,&
   & ZPRESF,ZUF,ZVF,ZTF,ZQN,&
   & ZCPTGZ,ZCPTS,ZAPHI,&
   & ZBN,ZBM,ZBH,&
   & INPP,ZXPP,&
   & ZPRESF5,ZUF5,ZVF5,ZTF5,ZQN5,ZU05,ZV05,&
   & ZCPTGZ5,ZCPTS5,ZAPHI5,ZES5,&
   & ZRI5,ZBN5,ZBM5,ZBH5,ZRH2M5)
  PT2M(1:ILEN)=ZXPP(1:ILEN,1,1)

  CALL PPOBSAS(NPROMA,ILEN,1,'H2 ',ZINTH,IOBSTYPE,ICOUNT,ZZ0SCAT,&
   & ZPRESF5,ZUF5,ZVF5,ZTF5,ZQN5,ZU05,ZV05,&
   & ZCPTGZ5,ZCPTS5,ZAPHI5,ZES5,&
   & ZRI5,ZBN5,ZBM5,ZBH5,&
   & 1,ZRH2M5)
  CALL PPOBSASTL(NPROMA,ILEN,NFLEVG,'H2 ',ZINTH,IOBSTYPE,ICOUNT,ZZ0SCAT,&
   & ZPRESF,ZUF,ZVF,ZTF,ZQN,&
   & ZCPTGZ,ZCPTS,ZAPHI,&
   & ZBN,ZBM,ZBH,&
   & INPP,ZXPP,&
   & ZPRESF5,ZUF5,ZVF5,ZTF5,ZQN5,ZU05,ZV05,&
   & ZCPTGZ5,ZCPTS5,ZAPHI5,ZES5,&
   & ZRI5,ZBN5,ZBM5,ZBH5,ZRH2M5)  
  PRH2M(1:ILEN)=ZXPP(1:ILEN,1,1)

ENDIF

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

!*       4. RADIANCES
!           ---------

IOBSTYPE=NSATEM

!           4.1   COPE WITH Q NEGATIVE

CALL QNEGLIMTL(ZQF(1,1),ZQF5(1,1),1,NPROMA,1,NFLEVG,1,ILEN,1,NFLEVG)
CALL QNEGLIM(ZQF5(1,1),1,NPROMA,1,NFLEVG,1,ILEN,1,NFLEVG)

!*          4.2   Various radiance preparations if the RTTOV-internal
!*                interpolation is used for radiance calculations

IF( LRTTOV_INTERPOL )THEN

  CALL HRADP_ML_TL(NPROMA,ILEN,-1*ISETDUM,ZNVANG,ZZEANG,ICOEF,&
    & ZPRESH,ZTF,ZQF,&
    & ZPS,ZTS,ZT2M,ZQ2M,ZCTOP,ZCAMT ,&
    & ZPRESH5,ZTF5,ZQF5,&
    & ZPS5,ZTS5,ZT2M5,ZQ2M5,ZCTOP5,ZCAMT5)  


ELSE

!*          4.3   Various preparations if the IFS internal interpolation
!*                is used for radiance calculations

!*          4.3a  PREPARE THE ARRAY CONTAINING THE PRESSURE LEVELS TO
!*                INTERPOLATE TO. STRAIGHT COPY OF VALUES SET UP IN
!*                RADPRE.
!*                REMEMBER WHICH LEVELS ARE ABOVE MODEL TOP

  IOBS=1
  INLAMTOP=0
  DO JLEV = 1,NLSAT
    IF(RADPRE(JLEV) < ZPRESF5(IOBS,1)) INLAMTOP=JLEV
    ZSPRES(1:ILEN,JLEV) = RADPRE(JLEV)
  ENDDO

!*          4.3b  PERFORM THE INTERPOLATION OF TEMPERATURE FROM THE
!*                NFLEVG MODEL LEVELS TO THE NLSAT SATELLITE LEVELS.
!*                'TV1' means T, Q and O3.

  DO JLEN=1,NPROMA
    DO IGEMS=1,NGEMS
      YLGEMSPROF5(JLEN,IGEMS)%RTTOVPROF => Z_RTTOVPROFB5(JLEN,IGEMS,:)
      YLGEMSPROF(JLEN,IGEMS)%RTTOVPROF => Z_RTTOVPROFB(JLEN,IGEMS,:)
    ENDDO
  ENDDO

  ICOUNT(1:ILEN)=NLSAT
  INPPS=NPNAV-1
  CALL PPOBSA(NPROMA,ILEN,NLSAT,'TV1',IOBSTYPE,ICOUNT,ZSPRES,ZOROG5,&
   & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
   & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
   & INPPS,ZTQOPP5,YDGEMSPROF5=YLGEMSPROF5)  
  CALL PPOBSATL(NPROMA,ILEN,NLSAT,'TV1',ICOUNT,ZSPRES,ZOROG5,&
   & ZPXP,ZPXPD,ZUF,ZVF,ZTF,ZQF,ZO3F,&
   & ZCLWF,ZCIWF,ZCCF,ZTSTAR,ZT0,ZLNPR,ZALPH,&
   & INPPS,ZTQOPP,&
   & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
   & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
   & YDGEMSPROF=YLGEMSPROF,YDGEMSPROF5=YLGEMSPROF5)  

!*          4.3c    Various radiance preparations

  CALL HRADPTL(NPROMA,ILEN,-1*ISETDUM,ZOROG5,ZOROGOB,&
   & ZNVANG,ZZEANG,ICOEF,&
   & ZPRESH ,ZTF ,ZTSTAR ,ZT0 ,ZTQOPP,&
   & ZPS ,ZTS ,ZT2M ,ZQ2M , ZCTOP,ZCAMT ,&
   & ZPRESH5,ZPRESF5,ZTF5,ZTSTAR5,ZT05,ZTQOPP5,&
   & ZPS5,ZTS5,ZT2M5,ZQ2M5,ZCTOP5,ZCAMT5)  

!           4.3d  ABOVE MODEL TOP, PUT CONSTANT TEMPERATURE
!                 ASSIGN PERTURBATION FOR TS-LAND+SEA+ICE,T-TOP

  ZTTOP=ZFAC*5._JPRB

  DO JLEV = 1,INLAMTOP
    DO J = 1,ILEN
      ZTQOPP5(J,JLEV,1)=ZTQOPP5(J,INLAMTOP+1,1)
      ZTQOPP (J,JLEV,1)=ZTQOPP (J,INLAMTOP+1,1)*ZTTOP
    ENDDO
  ENDDO

ENDIF

! Emissivities
ZEM5_LAND=0.95_JPRB
ZEM5_ICE =0.90_JPRB
ZEM5_SEA =0.60_JPRB

ZEM_LAND=0.05_JPRB
ZEM_ICE =0.10_JPRB
ZEM_SEA =0.10_JPRB

!*           4.4  CALL RTTOV CODE - 1C radiances

LL_SENSOR_BGE(:)=.FALSE.
LL_SENSOR_BGE(MSENSOR_HIRS)=.TRUE.
LL_SENSOR_BGE(MSENSOR_MSU)=.TRUE.
LL_SENSOR_BGE(MSENSOR_SSU)=.TRUE.
LL_SENSOR_BGE(MSENSOR_AMSUA)=.TRUE.
LL_SENSOR_BGE(MSENSOR_AMSUB)=.TRUE.
LL_SENSOR_BGE(MSENSOR_SSMI)=.TRUE.

DO JSENSOR=0,MXSENSOR
  DO JGRP=NSATGRP+1,NSATGRP+6

    IF(SATGRP_TABLE(JGRP)%sensor /= JSENSOR) CYCLE
    IF(.NOT. LL_SENSOR_BGE(JSENSOR)) CYCLE

    ICOEF = SATGRP_TABLE(JGRP)%rtcoef_pos

    ZEM=0.0_JPRB

    DO J = 1,ILEN
      IF(PCI5(J) > ZRCIMIN) THEN
        ZTEMP(J)  = ZEM5_SEA+PCI5(J)*(ZEM5_ICE-ZEM5_SEA)
        ZTS (J)   = ZFAC*PTS(J)*TVTSBGE_ICE
      ELSE
        ZTEMP(J)  = ZEM5_SEA+PLS5(J)*(ZEM5_LAND-ZEM5_SEA)
        ZTS (J)   = ZFAC*PTS(J)*(TVTSBGE_SEA+PLS5(J)*(TVTSBGE_LAND-TVTSBGE_SEA))
      ENDIF
    ENDDO

    DO JCH=1,NANERADS
      DO J = 1,ILEN
        ZEM5(J,JCH) = ZTEMP(J)
      ENDDO
    ENDDO

    ICHAN_MIN= 1+SUM(MSENSOR_CHANCOUNT(0:JSENSOR-1))
    ICHAN_MAX= SUM(MSENSOR_CHANCOUNT(0:JSENSOR))
    INRCH=0
    IOFF=MSENSOR_CHANOFFL(JSENSOR)
    IF(JSENSOR == MSENSOR_SSMI) IOFF=ICHAN_MIN-1
    DO JCH=1,KNRCH
      IF(KCH(JCH) >= ICHAN_MIN .AND. KCH(JCH) <= ICHAN_MAX) THEN   
        INRCH=INRCH+1
        ZRCH(1:ILEN,INRCH)=KCH(JCH)-IOFF
        IF(INRCH == 1) ICHAN_FIRST_INDEX=JCH
      ENDIF
    ENDDO
    ICOUNT(1:ILEN)=INRCH 

    IF(JSENSOR == MSENSOR_SSMI) THEN
      ZZENANG(1:ILEN)=53.1_JPRB
      DO J=1,ILEN
        IF(PLS5(J) < 0.01_JPRB .AND. PCI5(J) < 0.01_JPRB) THEN
          ZEM5(J,:) = 2.0_JPRB
          ZEM (J,:) = 0.0_JPRB
        ENDIF
      ENDDO
      ZAZIANG(1:ILEN)=0.0_JPRB
    ELSE
      ZZENANG(1:ILEN)=0.0_JPRB
      ZAZIANG(1:ILEN)=90.0_JPRB
    ENDIF

    ZCTOP5D(:)=555.0_JPRB
    ZCAMT5D(:)=0.0_JPRB
    ZCTOPD(:)=0.0_JPRB
    ZCAMTD(:)=0.0_JPRB
    ZSOLZENANG(1:ILEN)=180.0_JPRB    ! Night-time only for now
    ZSOLAZIANG(1:ILEN)=0.0_JPRB


    IF( LRTTOV_INTERPOL )THEN
      CALL RADTR_ML_TL(ICOEF,JSENSOR,NPROMA,ILEN,NANERADS,ICOUNT,ZRCH,&
       & SATGRP_TABLE(JGRP)%cld_rtcalc_assim,&
       & ZZENANG,ZAZIANG,ZSOLZENANG,ZSOLAZIANG,ZLAT,ZOROG5,            &
       & ZPRESF,ZTF,ZQF,ZO3F,ZCLWF,ZCIWF,ZCCF,YLGEMSPROF,&
       & ZPS,ZTS,ZT2M,ZQ2M,ZCTOPD,ZCAMTD,ZUF(1,NFLEVG),ZVF(1,NFLEVG),ZEM,&
       & ZPRESF5,ZTF5,ZQF5,ZO3F5,ZCLWF5,ZCIWF5,ZCCF5,YLGEMSPROF5,&
       & ZPS5,PTS5,PLS5,ZT2M5,ZQ2M5,ZCTOP5D,ZCAMT5D,ZUF5(1,NFLEVG),ZVF5(1,NFLEVG),ZEM5,&
       & PRADM(1,ICHAN_FIRST_INDEX),ZTBTTOTDUM(1,ICHAN_FIRST_INDEX))
    ELSE
      CALL RADTRTL(ICOEF,JSENSOR,NPROMA,ILEN,NANERADS,ICOUNT,ZRCH, &
       & ZZENANG,ZAZIANG,ZSOLZENANG,ZSOLAZIANG,ZLAT,ZOROG5,      &
       & ZTQOPP, YLGEMSPROF,ZPS,ZTS,ZT2M,ZQ2M,ZCTOPD,ZCAMTD,     &
       & ZUF (1,NFLEVG),ZVF (1,NFLEVG),ZEM ,                     &
       & ZTQOPP5,YLGEMSPROF5,ZPS5,PTS5,PLS5,ZT2M5,               &
       & ZQ2M5,ZCTOP5D,ZCAMT5D,ZUF5(1,NFLEVG),ZVF5(1,NFLEVG),ZEM5,&
       & PRADM(1,ICHAN_FIRST_INDEX))  
    ENDIF

    LL_SENSOR_BGE(JSENSOR)=.false.

  ENDDO
ENDDO

!*       9.  RETURN

IF (LHOOK) CALL DR_HOOK('BGOBS',1,ZHOOK_HANDLE)
END SUBROUTINE BGOBS
