SUBROUTINE HOPTL(KDLEN,KDBDY,KSET,KHORIZ,KSCAN)

!**** *HOPTL* - Operator routine for all types of observations.

!     E. ANDERSSON            ECMWF          03/05/99
!     Based on sections of TOVCLR, UPPERAIR, SURFACEO and SATEM

!     PURPOSE
!     -------

!     Treats one set of observations, performing the following tasks:
!   1. Prepare for interpolation in vertical
!   2. Extract observed pressures and variable numbers
!   3. Perform post-processing for the required parameters
!   4. Compute departures
!   5. Calculate the cost function incorporating variational quality control

!     This routine can be used by FRENCH and ECMWF VAR.

!**   INTERFACE
!     ---------
!     *CALL* *HOPTL(KDLEN,KDBDY,KSET)*
!     WHERE KDLEN = First dimension: Max number of observations, this set
!           KDBDY= Second dimension: Max number od bodies, this set
!           KSET  = Number (numero) of the obs set to be treated (INPUT)
!           KHORIZ= Number of horizontal locations for 2D upper-air operators 
!           KSCAN= 1 or 2 for  computing and saving departure(1) or computing Jo(2)
!                  double scan is only if LOBSCOR
!        Also the contents of YOMMVO, YOMOBA, YOMOBSET are implicit
!     inputs.

!        HOPTL is called from TASKOB/TASKOBTL

!**   METHOD
!     ------
!        The method employed in this routine is to let the content of the
!     observation file determine which observation operators to call. The
!     'variable numbers' and the 'vertcal postions' of all data belonging
!     to the current set (KSET) are extracted from the observation array.
!     A 'request' is built, consisting of IVNMRQ (variable numbers) and
!     ZVERTP, both dimensioned (1:KDLEN,1:KDBDY), where KDLEN is <= NMXLEN
!     (=511) and KDBDY <= MMXBDY(KSET) (maximum number of CMA bodies in
!     this set, determined in ecset.F90 and smtov.F90). It is assumed that
!     all data in the observation array will be used.
!        All loops vectorize over the first dimension, 1:ILEN.
!        The PREINT routines are used to extract model information at
!     observation points, mostly from GOM-arrays.
!        The lists of known variable numbers, and the available obs-operators
!     are matched (in hvnmtlt.F90). There is a loop over all known variable
!     numbers (currently 68 of them). If the loop-variable-number has any
!     matching ocurrences in IVNMRQ, then the relevant vertical positions
!     are extracted (and contracted) from ZVERTP into ZVPOBS and the
!     appropriate PPOBSA-routine is called.
!        Some special treatment is necessary for two-level quantities (PWC,
!     DZ, layer-mean RH and integrated O3), for winds (U,V, U10,V10 and FF)
!     and radiances. The latter require interpolation of T, q and O3 to NLSAT
!     fix pressure levels.
!        The results from the PPOBSA-routines are accumulated in ZHOFX(:,:),
!     i.e. H(x). ZHOFX has the same layout as IVNMRQ(:,:) and ZVERTP(:,:).
!        The routine hdepart.F90 computes the departures H(x)-obs and stores
!     them in the observation array. It overwrites ZHOFX with the normalized
!     departures, [obs-H(x)]/sigma_o.
!        The routine hjo.F90 computes jo for each datum, and applies VarQC.
!     Any observation-error correlation will be taken care of inside hjo.F90,
!     when coded (not yet).

!**   EXTERNALS
!     ---------
!        HVNMTLT    - Translate varaible numbers tables
!        PREINT/TL  - Prepare interpolation
!        PREINTS/TL - Prepare interpolation, surface
!        PREINTR/TL - Prepare interpolation, radiances
!        QNEGLIM/TL - Ensure positive humidity
!        HINTH      - Get interpolation height
!        GRG_AK_OP/TL- Equivalents of observed values using averaging kernels
!        PPOBSA/TL  - Equivalents of observed values
!        PPOBSAS/TL - Equivalents of observed values, surface
!        PPOBSAZTL  - Equivalents of observed values, surface pressure
!        HRADPTL    - Radiance preparations
!        HRADP_ML_TL - Radiance preparations (for RTTOV-based interpolation)
!        RADTRTL    - Interface to radiative transfer code.
!        RADTR_ML_TL - Interface to radiative transfer code (RT on model levels)
!        HDEPART    - Obs. departures, vectorized version
!        HJO        - Cost function calculation, with VarQC
!        MEANUV_WEIGHTSTL - Calculation of weights for AMV/SATOB obs operator
!        MEANUV_AVERAGETL - Layer mean for AMV/SATOB obs operator

!**   MODIFICATIONS
!     -------------
!     Erik Andersson  99/04/01 : Original
!     E. Gerard       99/05/05 : Assimilation of SSM/I 10-m wind speed
!     Pedro Viterbo   99/09/01 : Sea-ice fraction
!     P. Moll         99/10/15 : Put Apache and ACHMT in cy22 (for MF)
!     Xu Li           00/05/23 : Add offset for VTPR1 and VTPR2
!     N. Bormann      01/09/21 : Layer-mean operator for AMV/SATOBs  
!     A. Dethof       02/07/02 : Remove check on summing up of DZ and PWC layers
!     D. Dee          03/10/22 : Support variational bias correction
!     C. Cardinali    03/12/03 : Analysis Sensitivity To Observations 
!     P. Burton       14/10/04 : Added kset arg to radtrbtl
!     S. Healy        2004/10/27 : Call to GPSRO operator
!     A. Benedetti    2005/03/31 : Call to AEROD TL operator
!     N. Bormann      2004/12/23 : Call RTLIMB for limb rad.; RARAD becomes LIMB 
!     A. Dethof       22-Feb-06: USe of averaging kernels for reo3 data
!     T. Auligne      2005/12/14 : Second metric for VarBC parameters update
!     S. Healy        2005/03/14 : 2d operator changes
!     N. Bormann      2005/12/08 : 2d operator for limb radiances
!     S.Saarinen      16/08/06 : More vectorization by use of MBODYJOBS
!     D. Salmond      06/01/08 : 4D-Var rain assimilation
!     T. Auligne      06/12/07 : Do not compute RT for passive radiances
!     R. El Khatib & NEC 01-Aug-2006 Vectorization
!     C. Payan        2006/03/23 : status passive for bodies not used (if .not.lecmwf)
!     D. Tan          2007/03/02 : Add HLoS wind, azimuth retrieved from Aux(1)@body
!     G. Radnoti      2006/02/21 : double scan because of correlated obs error model
!     P. Bauer        08/01/03 : Add Envisat MERIS TCWV
!     N. Bormann      2007/11/15 : RTTOV-9
!     V. Guidard      07/08/16 : Modify Call RADTRTL & RADTRK (after A. Collard)
!     Y.Tremolet     29-May-2008 Print Jo table by bins
!     H. Hersbach     2008/07/04 : Add ocean current and wave Charnock
!     A. Geer         03-Oct-2008 Pass zolar zenith angle to VarBC 
!     A. Geer         03-Dec-2008 Solar hour VarBC predictor for TMI
!     D. Dee        10-Oct-2008 generalise VarBC
!     A. Benedetti    09/03/11 :  Aerosol reflectance TL operator  (AER_REFL_TL) 
!     D. Li         15-Jan-2009: Add mode-based VarBC in control variable 
!     D. Dee        10-Oct-2008 generalise VarBC
!     P. Bauer        23/01/09 : Add VarBC for TCWV
!     D. Dee        10-Oct-2008 generalise VarBC
!     A. Inness     19-Aug-2009: Add Varbc for GRG
!     V. Guidard      2009/02/24 : CO2-slicing for AIRS
!     A.Inness    13-Oct-2009: Include apriori profile for GRG
!     A.Inness    18-Nov-2009: Averaging kernel operator for MOPITT v4.
!     A. Geer       10-Jun-2009 VarBC statistics by channel; All-sky flags change
!     H.Hersbach      2009/12/04 : 10-m neutral wind
!     N. Bormann     09/10/09: Boxcar average for AMVs with effects of variable P
!     A. Fouilloux   31/03/10: use new codetype for MERIS data
!     ------------------------------------------------------------------

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

USE PARCMA   , ONLY : JPMXVAR  ,JPMX_AK
USE YOMDIM   , ONLY : NFLEVG   ,NPPM
USE YOMDIMO  , ONLY : NLSAT, NPNAV
USE YOMVAR   , ONLY : NUPTRA   ,LGCVJO   ,LVARBC   ,NBGVECS  ,&
 & NSSBGV_COUNT,NSSHEV_COUNT    ,LANOBS, LCO2, LCO2ANER , NHEVECS,&
 & LTSCV, LFCOBS
USE VARBC_SETUP,ONLY : YVARBC, NHSTBINS
USE VARBC_EVAL, ONLY : VARBC_BIASTL
USE VARBC_PRED, ONLY : JPMXNPRED, VARBC_PRED_RAD, VARBC_PRED_TO3, VARBC_PRED_AIREP
USE VARBC_AIREP, ONLY : LBC_AIREP
USE YOMCST   , ONLY : RG
USE YOMOBS   , ONLY : LCAPACH  ,LCACHMT
USE YOMVNMB  , ONLY : NVNUMB
USE YOMOBSET , ONLY : MTYPOB   ,MLNSET   ,MTSLSET
USE YOMCOSJO , ONLY : LQSCATT  ,NOTVAR   ,LOBSCOR, NBCORBLK,&
 & OBSCOR_AUX, ALLOCATE_OBSCOR_AUX, NPRTBINS
USE YOMCOCTP , ONLY : NAIREP, NSATOB   ,NTEMP    ,NPILOT   ,&
 & NSSMI    ,NGTHRB   ,NTCWC   , &
 & NSCATT   ,NSYNOP   ,NDRIBU   ,NPAOB   ,&
 & NSATEM   ,NSTRO3   ,NLIMB
USE YOMCT0B, ONLY : LECMWF
USE YOMLUN   , ONLY : NULERR, NULOUT
USE YOMANCS  , ONLY : RMDI     ,NMDI     ,RDEGREES
USE YOMTVRAD , ONLY : RADPRE   ,SATGRP_TABLE,SATOBGRP_TABLE,MXSENSOR ,&
 & MSENSOR_AIRS, LRTTOV_INTERPOL, NSENSOR_MERIS, NSENSOR_MOPITT,LCO2_DIAG_AIRS
USE YOMLIMB,   ONLY : Y_LIMBGRP_TABLE
USE RANDOM_NUMBERS_MIX
USE YOMDB
USE GOMS_MIX     , ONLY : YGOMUA,YGOMS
USE TYPE_GEMS_PROFILES
USE YOM_YGFL , ONLY : NGHG,NGRG,YGHG_NL,YGRG_NL
USE YOMTS    , ONLY : TSCVX
USE YOEPHY   ,ONLY  : LERAIN, LEMWAVE 
USE YOMMKODB , ONLY : NTBMAR, NTFMAR
USE YOMMWAVE , ONLY : MWAVE_OK

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN
INTEGER(KIND=JPIM),INTENT(IN)    :: KDBDY
INTEGER(KIND=JPIM),INTENT(IN)    :: KSET
INTEGER(KIND=JPIM),INTENT(IN)    :: KHORIZ 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSCAN
INTEGER(KIND=JPIM)               :: IPOSM

!   ZPRESH5,ZPRESF5 :   Half/Full level pressure values at obs points
!   ZGEOPH5,ZGEOPF5 :   Half/Full level geopotential values at obs points
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG) :: ZPRESH ,ZGEOPH
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG)   :: ZPRESF ,ZGEOPF
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG) :: ZPRESH5,ZGEOPH5
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG)   :: ZPRESF5,ZGEOPF5


!   ZPRESH5_2D,ZPRESF5_2D :   Half/Full level pressure values at obs points
!   ZGEOPH5_2D,ZGEOPF5_2D :   Half/Full level geopotential values at obs points
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG,KHORIZ) :: ZPRESH_2D,ZGEOPH_2D
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG,KHORIZ)   :: ZPRESF_2D,ZGEOPF_2D
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG,KHORIZ) :: ZPRESH5_2D,ZGEOPH5_2D
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG,KHORIZ)   :: ZPRESF5_2D,ZGEOPF5_2D


!   ZPXP5,ZPXPD5 :   Intermediate variables (see PPINIT)
!   ZPXZ5,ZPXZD5 :   Intermediate variables (see PPINITZ)
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG,NPPM) ::ZPXP ,ZPXPD ,ZPXZ ,ZPXZD
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG,NPPM) ::ZPXP5,ZPXPD5,ZPXZ5,ZPXZD5

!   ZPXP5,ZPXPD5 :   Intermediate variables (see PPINIT)
!   ZPXZ5,ZPXZD5 :   Intermediate variables (see PPINITZ)
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG,NPPM,KHORIZ) ::ZPXP_2D ,ZPXPD_2D,ZPXZ_2D,ZPXZD_2D
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG,NPPM,KHORIZ) ::ZPXP5_2D,ZPXPD5_2D,ZPXZ5_2D,ZPXZD5_2D

!   ZALPH5  :   Coefficients of the hydrostatics (see GPXYB)
!   ZLNPR5  :   LOG. of the ratio of pressure (see GPXYB)
!   ZDELP5  :   Pressure diff. across layers (see GPXYB)
!   ZRDELP5 :   Inverse of the above
!   ZRTGR5  :   For press. grad. term and ene. conv. (see GPXYB) -
!   ZRPRE5  :   Inverse of pressure
!   ZRPP5   :   Inverse of P(j)*P(j+1)
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG) ::&
 & ZALPH ,ZLNPR ,ZDELP ,ZRDELP ,ZRTGR ,ZRPRE ,ZRPP ,&
 & ZALPH5,ZLNPR5,ZDELP5,ZRDELP5,ZRTGR5,ZRPRE5,ZRPP5  

!   ZALPH5_2D  :   Coefficients of the hydrostatics (see GPXYB)
!   ZLNPR5_2D  :   LOG. of the ratio of pressure (see GPXYB)
!   ZDELP5_ 2D :   Pressure diff. across layers (see GPXYB)
!   ZRDELP5_2D :   Inverse of the above
!   ZRTGR5_2D  :   For press. grad. term and ene. conv. (see GPXYB) -
!   ZRPRE5_2D  :   Inverse of pressure
!   ZRPP5_2D   :   Inverse of P(j)*P(j+1)
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG,KHORIZ) ::&
 & ZALPH_2D ,ZLNPR_2D ,ZDELP_2D ,ZRDELP_2D ,ZRTGR_2D ,ZRPRE_2D ,ZRPP_2D ,&
 & ZALPH5_2D,ZLNPR5_2D,ZDELP5_2D,ZRDELP5_2D,ZRTGR5_2D,ZRPRE5_2D,ZRPP5_2D  


!   ZT05    :   Surface temperature (see CTSTAR)
!   ZTSTAR5 :   Surface temperature (see CTSTAR)
!   ZTS5    :   Model's surface temperature.
!   ZOROG5  :   Model orography at obs points
!   ZLS5,ZAL5: Land/sea, Albedo, Soil wetness
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZT0 ,ZTSTAR ,ZTS,ZU10N,ZV10N
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZT05,ZTSTAR5,ZTS5,ZOROG5,ZLS5,&
 &                                   ZU05,ZV05,ZCHN5,&
 &                                   ZU10N5,ZV10N5,ZAL5,ZSST5

!   ZT05_2D    :   Surface temperature (see CTSTAR)
!   ZTSTAR5_2D :   Surface temperature (see CTSTAR)
!   ZOROG5_2D  :   Model orography at obs points
REAL(KIND=JPRB), DIMENSION(KDLEN,KHORIZ) :: ZT0_2D ,ZTSTAR_2D
REAL(KIND=JPRB), DIMENSION(KDLEN,KHORIZ) :: ZT05_2D,ZTSTAR5_2D,ZOROG5_2D


!   Model surface fields, at observation points
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZSLM ,ZWS ,ZVEG ,ZCI ,ZWL ,ZSN ,ZZ0 ,ZZ0SCAT
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZSLM5,ZWS5,ZVEG5,ZCI5,ZWL5,ZSN5,ZZ05

!   ZINTH   :   Interpolation height
!   ZINTHUV :   Interpolation height, for surface wind data
!   ZOROGOB :   Elevation*RG of observation
!   ZNVANG,ZZEANG,ZAZIANG :   Nadir viewing, zenith and azimuth angle
!   ZSOLZENANG,ZSOLAZIANG : Solar zenith and azimuth angle
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZINTH,ZINTHUV,ZOROGOB
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZNVANG,ZZEANG, ZAZIANG
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZSOLZENANG,ZSOLAZIANG,ZSOLHOUR

!   Variables for the surface layer observation operators
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZCPTGZ ,ZWET ,ZQS ,ZCPTS ,ZBN ,ZBM ,ZBH
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZCPTGZ5,ZWET5,ZQS5,ZCPTS5,ZRI5,ZBN5,ZBM5,ZBH5
REAL(KIND=JPRB), DIMENSION(KDLEN,2) :: ZES5
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG) :: ZAPHI ,ZAPHI5

!   Model U/V/T/Q/O3/CLW/CIW/CC (add CS,CR and CG) at observation points, model levels
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG) ::&
 & ZUF ,ZVF ,ZTF ,ZQF ,ZO3F ,ZCLWF ,ZCIWF ,ZCCF ,ZQN
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG) ::&
 & ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,ZCLWF5,ZCIWF5,ZCCF5,ZCSWF5,ZCRWF5,ZCGWF5,ZQN5

!   Model U/V/T/Q/O3/CLW/CIW/CC at observation points, model levels
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG,KHORIZ) ::&
 & ZUF_2D ,ZVF_2D ,ZTF_2D ,ZQF_2D ,ZO3F_2D ,ZCLWF_2D ,ZCIWF_2D ,ZCCF_2D 
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG,KHORIZ) ::&
 & ZUF5_2D,ZVF5_2D,ZTF5_2D,ZQF5_2D,ZO3F5_2D,ZCLWF5_2D,ZCIWF5_2D,ZCCF5_2D,&
 & ZCSWF5_2D,ZCRWF5_2D,ZCGWF5_2D


!   Cp  R and  Kappa, at observation points
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG) :: ZCP ,ZRF ,ZKAP
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG) :: ZCP5,ZRF5,ZKAP5

!   Cp  R and  Kappa, at observation points
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG,KHORIZ) :: ZCP_2D ,ZRF_2D ,ZKAP_2D
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG,KHORIZ) :: ZCP5_2D,ZRF5_2D,ZKAP5_2D


!   ZVERTP  : Vertical position of obs datum (Pressure/Height/Channel)
!   ZVERTP_L: Vertical position of obs datum (Lower level)
!   ZHOFX   : Observation equivalents, H(x)
!   ZRANDOM : Random numbers for GCV calculation
REAL(KIND=JPRB), DIMENSION(KDLEN,KDBDY) :: ZVERTP,ZVERTP_L,ZHOFX
REAL(KIND=JPRB), DIMENSION(KDBDY) :: ZRANDOM

!   ZPRESS_AK : Pressure levels for averaging kernel calculations
!   ZWEIGHT_AK: Weights for averaging kernel calculations
!   ZPRIOR_AK: Prior profile for averaging kernel calculations
REAL(KIND=JPRB), DIMENSION(KDLEN,KDBDY,JPMX_AK) :: ZPRES_AK,ZWEIGHT_AK,ZPRIOR_AK


!   IVNM    : Variable number from observation array
!   IVAR    : Variable number from NVAR table
!   IPNLV   : Pointer to locations in ZHOFX
!   INAK     : Number of averaging kernel elements
INTEGER(KIND=JPIM), DIMENSION(KDLEN,KDBDY) :: IVNMRQ,IVAR,IPNLV,INAK

!   ICDTYP  :  Observation code type from observation array
!   ICMBDY  :  Number of data entries in each report in this KSET
!   ICOUNT  :  Number of data per obs, for call to PP-routines
!   ICOUNTA :  Number of non-passive data per obs, for call to RADTRAD
INTEGER(KIND=JPIM), DIMENSION(KDLEN) :: ICDTYP,ICMBDY,ICOUNT,ICOUNTX,ICOUNTA,INDXTIME
INTEGER(KIND=JPIM) :: INSTA, IDSTA(4)

!   IXVARBC  :  VarBC group index for bias correction
INTEGER(KIND=JPIM), ALLOCATABLE :: IXVARBC(:,:)
REAL(KIND=JPRB), DIMENSION(NHSTBINS) :: ZWPD_MODE

! For ozone bias correction
REAL(KIND=JPRB), ALLOCATABLE :: ZSOLAR(:)
REAL(KIND=JPRB)    :: ZZLON, ZZLAT
INTEGER(KIND=JPIM) :: IOBDATE, IOBTIME, IYEAR, IMONTH, IDAY, IHOUR

!   ZXPP    : Post-processed values, i.e. outputs from obs operators.
!   ZXPRED  : Bias predictor values
!   ZXPPB   : Bias estimates for post-processed values
!   ZVPOBS  : List of pressures/heights to interpolate to.
!   ZVPOBS_L: Second list of (lower) pressures/heights to interpolate to.
!   ZPAK    : List of pressures for averaging kernel calculations
!   ZWAK    : List of weights for averaging kernel calculations
!   ZAPAK   : List of prior values for averaging kernel calculations
!   LLACTIVE : Mask for non-passive data
REAL(KIND=JPRB), ALLOCATABLE :: ZXPP(:,:,:),ZXPPB(:,:,:),ZXPRED(:,:),&
 & ZVPOBS(:,:),ZVPOBS_L(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZXPP5(:,:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZPAK(:,:,:),ZWAK(:,:,:),ZAPAK(:,:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZCOD5(:),ZTAUC5(:,:),ZTAUC(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZEM (:,:),ZPS (:),ZT2M (:),ZQ2M (:),ZCTOP(:),ZCAMT(:),&
 & ZTQOPP (:,:,:),ZPRES(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZEM5(:,:),ZPS5(:),ZT2M5(:),ZQ2M5(:),ZCTOP5(:),ZCAMT5(:),&
 & ZTQOPP5(:,:,:),ZTS5_REF(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZTBTOT(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZOMF(:,:), ZBIAS_WK(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZEMIS(:,:), ZEMIS5(:,:),ZRCH(:,:)

! LLACTIVE : Mask for non-passive data
LOGICAL, ALLOCATABLE         :: LLACTIVE(:,:)

!   Solar elevation for ozone data
REAL(KIND=JPRB), ALLOCATABLE :: ZSOLEL(:)
!   Sensor for reo3 data
INTEGER(KIND=JPIM), ALLOCATABLE :: IO3SENSOR(:)
!   ZORDIF  : Difference (orography model) minus (orography observation)
REAL(KIND=JPRB), ALLOCATABLE :: ZVPOBS5(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZORDIF(:)
REAL(KIND=JPRB)              :: ZOBALT

!   ZUV5  : U and V on model or RTTOV pressure levels
!   ZUV  : U and V on model or RTTOV pressure levels
!   ZW5   : Weights used for mean layer winds
!   ZW   : Weights used for mean layer winds
!   ZTAU : Transmittances on RTTOV pressure levels
REAL(KIND=JPRB), ALLOCATABLE :: ZUV5(:,:,:),ZUV(:,:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZW5(:,:), ZW(:,:), ztau(:,:,:)

!   IAK    : number of elements for averaging kernel calculations
INTEGER(KIND=JPIM), ALLOCATABLE :: IAK(:,:)

CHARACTER (LEN = 3) ::  CLV(JPMXVAR)
INTEGER(KIND=JPIM) :: IVARL(JPMXVAR)
INTEGER(KIND=JPIM) :: ILEN,IOBSTYPE,ICDTYP_TOVS,IGRP,IMXBDY,&
 & IIVNM,IMXCOUNT,ISLCT,IBDY,IBODY,&
 & ICOEF,IDF,IDFS,IRET,INFO(1),ISENSOR,ITSLOT,ISENSOR_GETDB,&
 & ITMO100, itime
INTEGER(KIND=JPIM) :: JOBS,JBODY,JVNM,JNLV,JLEV,JGRG
INTEGER(KIND=JPIM) :: IJB, JB1, JB2, JB3
REAL(KIND=JPRB) :: Z500HPA,ZLAYL(JPMXVAR,2),ZCMALT,ZSPEED5,ZINFO(1),ZPERT2
REAL(KIND=JPRB) :: ZHLS,ZAZIM,Zsin_azim,Zcos_azim,ZTIME,ZLEFTTM,ZRIGHTM
LOGICAL :: LLRAD1C,LL_RAIN,LL_MWAVE,LLAPACH,LL_LAYER,LL_WIND,&
 & LLEXTLI,LL_SFC_OP,LL_RAD_OP,LL_SPEED,&
 & LL_NONLINEAR,LL_MEAN_UV,LL_HLS,LL_TCWV,LL_AIREP,LLREO3,LL_AK,LLNO2,LL_MODE,LL_MOPITT
REAL(KIND=JPRB), DIMENSION(KDLEN)    :: ZLAT,ZLON
LOGICAL, DIMENSION(NGHG) :: LLGHG
LOGICAL, DIMENSION(NGRG) :: LLGRG
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG) ::ZPERT1
! For correlated observation errors
INTEGER(KIND=JPIM), ALLOCATABLE      :: IOBSCOR_COUNT(:)
INTEGER(KIND=JPIM) :: IMASK, JBLK,JGHG
! For AIRS radiances
INTEGER(KIND=JPIM), DIMENSION(KDLEN) :: IVISNIR

!BEN Extra variables for aerosol reflectance operator
!REAL(KIND=JPRB), DIMENSION(KDLEN) ::    ZSOLANG5, ZVIEANG5, ZDIFFANG5


REAL(KIND=JPRB) :: ZHOOK_HANDLE

TYPE (TYPE_GEMSPROF), DIMENSION(KDLEN,NGEMS) :: YLGEMSPROF,YLGEMSPROF5
REAL(KIND=JPRB), TARGET :: Z_MODELPROF(KDLEN,NGEMS,NFLEVG),Z_MODELPROF5(KDLEN,NGEMS,NFLEVG)
REAL(KIND=JPRB), TARGET :: Z_RTTOVPROF(KDLEN,NGEMS,NLSAT),Z_RTTOVPROF5(KDLEN,NGEMS,NLSAT)
REAL(KIND=JPRB), ALLOCATABLE :: ZNO2(:,:),ZNO25(:,:)
INTEGER(KIND=JPIM) :: JLEN,JGEMS
INTEGER(KIND=JPIM) :: ix, ib, ibin_max, imax_loc, ihist_sum, imax_dist
INTEGER(KIND=JPIM) :: JHIST, I_nhist_avg_r, I_nhist_avg_l, ibinx, ibd
REAL(KIND=JPRB)    :: zwpd

TYPE(randomNumberStream) :: YL_RANDOM_STREAM

INTERFACE
#include "getdb.h"
#include "putdb.h"
#include "abortdb.h"
END INTERFACE

#include "abor1.intfb.h"
!#include "aer_refl_tl.intfb.h"
#include "aod_tl.intfb.h"
#include "ch4_tcmr_tl.intfb.h"
#include "co2_tcmr_tl.intfb.h"
#include "cod_op.intfb.h"
#include "cod_optl.intfb.h"
#include "ghg_ak_tl.intfb.h"
#include "diurnal.intfb.h"
#include "gpsro_tl.intfb.h"
#include "grg_ak_tl.intfb.h"
#include "gpsro_2dtl.intfb.h"
#include "hdepart.intfb.h"
#include "hinth.intfb.h"
#include "hjo.intfb.h"
#include "hqscatt.intfb.h"
#include "hradptl.intfb.h"
#include "hradp_ml_tl.intfb.h"
#include "hvnmtlt.intfb.h"
#include "meanuv_average.intfb.h"
#include "meanuv_averagetl.intfb.h"
#include "mopitt_ak_tl.intfb.h"
#include "meanuv_weightstl.intfb.h"
#include "nox2no2.intfb.h"
#include "nox2no2tl.intfb.h"
#include "ppobsa.intfb.h"
#include "ppobsac.intfb.h"
#include "ppobsactl.intfb.h"
#include "ppobsas.intfb.h"
#include "ppobsastl.intfb.h"
#include "ppobsatl.intfb.h"
#include "ppobsaztl.intfb.h"
#include "pppmertl.intfb.h"
#include "gpszen_delaytl.intfb.h"
#include "preint.intfb.h"
#include "preint2d.intfb.h"
#include "preint2dtl.intfb.h"
#include "preintr.intfb.h"
#include "preintrtl.intfb.h"
#include "preints.intfb.h"
#include "preintstl.intfb.h"
#include "preinttl.intfb.h"
#include "qneglim.intfb.h"
#include "qneglimtl.intfb.h"
#include "radtrk.intfb.h"
#include "radtrtl.intfb.h"
#include "radtr_ml_tl.intfb.h"
#include "rtl_hop_1d_tl.intfb.h"
#include "rtl_hop_2d_tl.intfb.h"
#include "setran.intfb.h"
#include "dopplsim_tl.intfb.h"
#include "ngedsta.intfb.h"
#include "timdif.intfb.h"
#include "fcobs.h"
#include "openmp_obs.h"

!     ------------------------------------------------------------------
!        1.       Introduction
!                 ------------

!*          1.1   Set length (=number of observations)

IF (LHOOK) CALL DR_HOOK('HOPTL',0,ZHOOK_HANDLE)
!WRITE(NULOUT,'('' ENTER HOPTL '')')
!CALL FLUSH(NULOUT)
IF(KSCAN /=1 .AND. KSCAN /=2  ) CALL ABOR1('HOPTL: KSCAN must be 1 or 2')
IF(KSCAN /=1 .AND. .NOT. LOBSCOR  ) CALL ABOR1('HOPTL: KSCAN must be 1 if LOBSCOR=F')
ILEN   = MLNSET(KSET)
ITSLOT = MTSLSET(KSET)

DO JLEN=1,KDLEN
  DO JGEMS=1,NGEMS
    YLGEMSPROF5(JLEN,JGEMS)%MODELPROF => Z_MODELPROF5(JLEN,JGEMS,:)
    YLGEMSPROF5(JLEN,JGEMS)%RTTOVPROF => Z_RTTOVPROF5(JLEN,JGEMS,:)
    YLGEMSPROF(JLEN,JGEMS)%MODELPROF => Z_MODELPROF(JLEN,JGEMS,:)
    YLGEMSPROF(JLEN,JGEMS)%RTTOVPROF => Z_RTTOVPROF(JLEN,JGEMS,:)
  ENDDO
ENDDO

!*          1.2   Observation type and code type for TOVS data

IOBSTYPE = MOD(MTYPOB(KSET),100)
IGRP =MOD(MTYPOB(KSET)/100,100)
LL_MEAN_UV  = .FALSE.
LL_MODE = .FALSE.
ISENSOR_GETDB = -1
IF(IOBSTYPE == NSATEM) THEN
  ICDTYP_TOVS=SATGRP_TABLE(IGRP)%codetype
  ISENSOR=SATGRP_TABLE(IGRP)%sensor
  IF (ICDTYP_TOVS == NSTRO3) ISENSOR = 1
  IF (ICDTYP_TOVS == NGTHRB) ISENSOR_GETDB = ISENSOR
  IF (ICDTYP_TOVS == NSSMI ) ISENSOR_GETDB = ISENSOR
  IF (ICDTYP_TOVS == NTCWC ) ISENSOR_GETDB = ISENSOR

  IF (ISENSOR == NSENSOR_MERIS) ISENSOR = 1
ELSEIF(IOBSTYPE == NSATOB)THEN
  LL_MEAN_UV  = SATOBGRP_TABLE(IGRP)%obs_oper == 'Gauss average' &
   & .OR.SATOBGRP_TABLE(IGRP)%obs_oper == 'Boxcar average' &
   & .OR.SATOBGRP_TABLE(IGRP)%obs_oper == 'RT average'
  ICDTYP_TOVS = SATOBGRP_TABLE(IGRP)%codetype
  ISENSOR     = 1
ELSEIF(IOBSTYPE == NLIMB)THEN
  ICDTYP_TOVS = Y_LIMBGRP_TABLE(IGRP)%codetype  ! For ODB
  ISENSOR     = 1                             ! Not used
ELSE
  ICDTYP_TOVS=-1
  ISENSOR=1
ENDIF

IF (ISENSOR < 0 .OR. ISENSOR > MXSENSOR) THEN
  WRITE(NULERR,*)'*** ERROR IN HOPTL: ISENSOR=',ISENSOR,&
   & ' OUT OF RANGE FOR KSET,IOBSTYPE,IGRP,ITSLOT=',&
   & KSET,IOBSTYPE,IGRP,ITSLOT
  CALL ABORTDB('HOPTL', 'ISENSOR OUT OF RANGE', ISENSOR)
ENDIF

!*          1.3   Initialize ODB

CALL GETDB('HOPTL', NUPTRA, IRET, INFO, 0, ZINFO,0,&
 & KSET, ITSLOT, -1, IOBSTYPE, ICDTYP_TOVS, ISENSOR_GETDB)
IF (IRET /= ILEN) THEN
  WRITE(NULERR,'('' ** INCONSISTENT NO. OF OBSERVATIONS FROM GETDB'')')
  WRITE(NULERR,*)' Expecting ',ILEN,', but got =',IRET
  CALL ABORTDB('HOPTL', 'INCONSISTENCIES FROM GETDB', IRET)
ENDIF

!*          1.4   Other

Z500HPA=50000._JPRB
ZZ0SCAT(1:ILEN)=0.0_JPRB

!*          1.5   Switches

!*          1.5.1 Apach or not?

LLAPACH=LCAPACH .AND. (IOBSTYPE == NTEMP .OR. IOBSTYPE == NPILOT)

!*          1.5.2 Types of TOVS/RAD1C and SSMI/METEOSAT processing
!                 LLTOVCC=Cloud cleared radiances, with 1D-Var (obsolete)
!                 LLRAD1C=Calibrated 'raw' radiances, no 1D-Var
!                 SSMI is LLTOVCC. METEOSAT is LLRAD1C

LLRAD1C  = ICDTYP_TOVS == NGTHRB
LL_RAIN  = ICDTYP_TOVS == NSSMI .AND. LERAIN 
LL_MWAVE = ICDTYP_TOVS == NSSMI .AND. LEMWAVE
LL_TCWV  = ICDTYP_TOVS == NTCWC
LL_AIREP = IOBSTYPE    == NAIREP

LLREO3    = ICDTYP_TOVS == NSTRO3
LL_AK     = .FALSE.


!*          1.5.3 Are surface/cloud/radiance operators required or not

LL_SFC_OP=ANY(IOBSTYPE == (/NSYNOP,NDRIBU,NTEMP,NPILOT,NPAOB,NSCATT/)) .OR. LL_RAIN 
LL_RAD_OP=LLRAD1C.OR.LL_MWAVE

!*          1.5.4 Make connection between CMA-variable number,
!*                NVAR and PPOBSA-variable codes.

CALL HVNMTLT(JPMXVAR,CLV,IVARL,ZLAYL)

!     ------------------------------------------------------------------
!        2.       Interpolation preparation
!                 -------------------------

!*          2.1   Upper-air, always required

IF (KSCAN == 1 .OR. KSCAN == 2) THEN
  IF (KHORIZ > 1) THEN

    ! call the 2d planar observation routine (eg, GPSRO or RTLIMB)

    CALL PREINT2D(KDLEN,ILEN,KSET,KHORIZ,ZOROG5_2D,&
     & ZPRESH5_2D,ZPRESF5_2D,ZGEOPH5_2D,ZGEOPF5_2D,&
     & ZPXP5_2D,ZPXPD5_2D,ZPXZ5_2D,ZPXZD5_2D,ZCP5_2D,ZRF5_2D,ZKAP5_2D,&
     & ZUF5_2D,ZVF5_2D,ZTF5_2D,ZQF5_2D,ZO3F5_2D,ZCLWF5_2D,ZCIWF5_2D,ZCCF5_2D,&
     & ZCSWF5_2D,ZCRWF5_2D,ZCGWF5_2D,&
     & ZTSTAR5_2D,ZT05_2D,ZDELP5_2D,ZRDELP5_2D,ZLNPR5_2D,ZALPH5_2D,ZRTGR5_2D,&
     & ZRPRE5_2D,ZRPP5_2D)  
    CALL PREINT2D(KDLEN,ILEN,KSET,KHORIZ,ZOROG5_2D,&
     & ZPRESH5_2D,ZPRESF5_2D,ZGEOPH5_2D,ZGEOPF5_2D,&
     & ZPXP5_2D,ZPXPD5_2D,ZPXZ5_2D,ZPXZD5_2D,ZCP5_2D,ZRF5_2D,ZKAP5_2D,&
     & ZUF5_2D,ZVF5_2D,ZTF5_2D,ZQF5_2D,ZO3F5_2D,ZCLWF5_2D,ZCIWF5_2D,ZCCF5_2D,&
     & ZCSWF5_2D,ZCRWF5_2D,ZCGWF5_2D,&
     & ZTSTAR5_2D,ZT05_2D,ZDELP5_2D,ZRDELP5_2D,ZLNPR5_2D,ZALPH5_2D,ZRTGR5_2D,&
     & ZRPRE5_2D,ZRPP5_2D)  

    CALL PREINT2D(KDLEN,ILEN,KSET,KHORIZ,ZOROG5_2D,&
     & ZPRESH5_2D,ZPRESF5_2D,ZGEOPH5_2D,ZGEOPF5_2D,&
     & ZPXP5_2D,ZPXPD5_2D,ZPXZ5_2D,ZPXZD5_2D,ZCP5_2D,ZRF5_2D,ZKAP5_2D,&
     & ZUF5_2D,ZVF5_2D,ZTF5_2D,ZQF5_2D,ZO3F5_2D,ZCLWF5_2D,ZCIWF5_2D,ZCCF5_2D,&
     & ZCSWF5_2D,ZCRWF5_2D,ZCGWF5_2D,&
     & ZTSTAR5_2D,ZT05_2D,ZDELP5_2D,ZRDELP5_2D,ZLNPR5_2D,ZALPH5_2D,ZRTGR5_2D,&
     & ZRPRE5_2D,ZRPP5_2D)  

    CALL PREINT2DTL(KDLEN,ILEN,KSET,KHORIZ,ZOROG5_2D,&
     & ZPRESH_2D,ZPRESF_2D,ZGEOPH_2D,ZGEOPF_2D,&
     & ZPXP_2D,ZPXPD_2D,ZPXZ_2D,ZPXZD_2D,ZCP_2D,ZRF_2D,ZKAP_2D,&
     & ZUF_2D,ZVF_2D,ZTF_2D,ZQF_2D,ZO3F_2D,ZCLWF_2D,ZCIWF_2D,ZCCF_2D,&
     & ZTSTAR_2D,ZT0_2D,ZDELP_2D,ZRDELP_2D,ZLNPR_2D,ZALPH_2D,ZRTGR_2D,ZRPRE_2D,ZRPP_2D,&
     & ZPRESH5_2D,ZPRESF5_2D,&
     & ZPXP5_2D,ZPXPD5_2D,ZPXZ5_2D,ZCP5_2D,ZRF5_2D,&  
     & ZTF5_2D,ZQF5_2D,ZO3F5_2D,&
     & ZTSTAR5_2D,ZT05_2D,ZDELP5_2D,ZRDELP5_2D,ZLNPR5_2D,ZALPH5_2D,ZRPRE5_2D,ZRPP5_2D)

  ELSE 

    ! standard vertical profile routine

    CALL PREINT(KDLEN,ILEN,KSET,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,PAL=ZAL5)  

    CALL PREINTTL(KDLEN,ILEN,KSET,&
     & 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)


  ENDIF

  !*          Ts control variable
  IF (LTSCV) THEN
    DO JOBS = 1,ILEN
      IPOSM  = ROBHDR(JOBS,MDB_MAPOMM_AT_INDEX)
      YGOMS(IPOSM)%TS=TSCVX(IPOSM)+YGOMUA(IPOSM)%T(NFLEVG)
    ENDDO
  ENDIF


  !*          2.2   Surface
  IF(LL_SFC_OP) CALL PREINTS(KDLEN,ILEN,KSET,&
   & ZPRESH5,&
   & ZUF5,ZVF5,ZTF5,ZQF5,ZQN5,ZTS5,ZSST5,ZU05,ZV05,ZU10N5,ZV10N5,ZCHN5,&
   & ZRF5,ZWS5,ZVEG5,ZCI5,ZWL5,ZSN5,ZSLM5,ZZ05,&
   & ZES5,ZCPTGZ5,ZWET5,ZQS5,ZCPTS5,ZAPHI5,&
   & ZRI5,ZBN5,ZBM5,ZBH5,ZLNPR5,ZALPH5)
  IF(LL_SFC_OP) CALL PREINTSTL(KDLEN,ILEN,KSET,&
   & ZPRESH,&
   & ZUF,ZVF,ZTF,ZQF,ZQN,ZTS,&
   & ZU10N,ZV10N,ZRF,ZWS,ZVEG,ZCI,ZWL,ZSN,ZSLM,ZZ0,&
   & ZCPTGZ,ZWET,ZQS,ZCPTS,ZAPHI,&
   & ZBN,ZBM,ZBH,ZLNPR,ZALPH,&
   & ZPRESH5,&
   & ZUF5,ZVF5,ZTF5,ZQF5,ZQN5,ZTS5,ZU05,ZV05,ZU10N5,ZV10N5,ZCHN5,&
   & ZRF5,ZWS5,ZVEG5,ZWL5,ZSN5,ZSLM5,ZZ05,&
   & ZES5,ZWET5,ZQS5,ZAPHI5,&
   & ZRI5,ZLNPR5,ZALPH5)

  !*          2.3   Radiance, and make q positive.

  IF(LL_RAD_OP) THEN
    CALL PREINTR(KDLEN,ILEN,KSET,ZLS5,ZCI5,ZAL5,ZTS5,ZWS5,ZSN5)
    CALL PREINTRTL(KDLEN,ILEN,KSET,ZTS,ZWS,ZSN)
    CALL QNEGLIMTL(ZQF(1,1),ZQF5(1,1),1,KDLEN,1,NFLEVG,1,ILEN,1,NFLEVG)
    CALL QNEGLIM(ZQF5(1,1),1,KDLEN,1,NFLEVG,1,ILEN,1,NFLEVG)
  ENDIF
ENDIF !KSCAN
!*          2.4 Fill in solar elevation for ozone/GEMS data
LL_MOPITT=.false.
IF (LLREO3) THEN
  ALLOCATE(ZSOLEL(KDLEN))
  ALLOCATE(IO3SENSOR(KDLEN))
  DO JOBS = 1,ILEN
    ZSOLEL(JOBS)  = SATHDR(JOBS,MDBRO3SOE)
    IO3SENSOR(JOBS)= SATHDR(JOBS,MDBSSIA)
!   only MOPITT data should be in this set sorted by ecset.F90
    IF (.NOT.LL_MOPITT .AND. (IO3SENSOR(JOBS)==NSENSOR_MOPITT)) LL_MOPITT=.TRUE.
  ENDDO
ENDIF

!     ------------------------------------------------------------------
!        3.       Look in CMA to see what data is there
!                 -------------------------------------

!*          3.1   Find out number of bodies (ICMBDY)
!                 code-type (ICDTYP), 
!                 obs orography (ZOROGOB) from obs array.

ZLEFTTM = REAL(NTBMAR,JPRB)
ZRIGHTM = REAL(NTFMAR,JPRB)

DO JOBS = 1,ILEN
  ICMBDY(JOBS)=MLNKH2B(JOBS+1)-MLNKH2B(JOBS)

  ICDTYP(JOBS)=ROBHDR(JOBS,MDB_CODETYPE_AT_HDR)

  ZCMALT=ROBHDR(JOBS,MDBALT)
  IF(ZCMALT == RMDI .OR. ABS(ZCMALT) >  10000._JPRB) THEN
    ZOROGOB(JOBS) = RMDI
  ELSE
    ZOROGOB(JOBS) = ZCMALT*RG
  ENDIF
ENDDO
IMXBDY=MAXVAL(ICMBDY(1:ILEN))

!*          3.2   Extract vertical positions i.e. pressure/height/channel
!                 (ZVERTP) and variable numbers (IVNMRQ). These will constitude
!                 the 'request' for PP-calculations, later.

IVNMRQ(1:ILEN,1:IMXBDY)=0
ZVERTP(1:ILEN,1:IMXBDY)=RMDI
ZVERTP_L(1:ILEN,1:IMXBDY)=RMDI
IF(LLREO3) THEN
  INAK(1:ILEN,1:IMXBDY)=0
  ZPRES_AK(1:ILEN,1:IMXBDY,1:JPMX_AK)=RMDI
  ZWEIGHT_AK(1:ILEN,1:IMXBDY,1:JPMX_AK)=0.0_JPRB
  ZPRIOR_AK(1:ILEN,1:IMXBDY,1:JPMX_AK)=0.0_JPRB
ENDIF

!OCL NOVREC
NEW_BODY_LOOP: DO IBODY=1,MLNKH2B(ILEN+1)-1
  JOBS = MBODYJOBS(IBODY)
  JBODY = IBODY + 1 - MLNKH2B(JOBS)

  IVNMRQ(JOBS,JBODY) = ROBODY(IBODY,MDBVNM)

  !*          3.3.0 Surface analysis variables:
  !                 1. SNOW DEPTH (NVNUMB(25)=71)
  !                 2. SNOWFALL (NVNUMB(46)=92)
  !                 3. RAIN (NVNUMB(34)=80)

  IF(ROBODY(IBODY,MDBVNM) == NVNUMB(25) .OR.&
   & ROBODY(IBODY,MDBVNM) == NVNUMB(46) .OR.&
   & ROBODY(IBODY,MDBVNM) == NVNUMB(34)      ) THEN  
    IVNMRQ(JOBS,JBODY) = 0
  ELSE
    IVNMRQ(JOBS,JBODY) = ROBODY(IBODY,MDBVNM)
  ENDIF

  ZVERTP(JOBS,JBODY)  = ROBODY(IBODY,MDBPPP)
  ZVERTP_L(JOBS,JBODY)= ROBODY(IBODY,MDBPRL)

  IF(LL_RAIN .OR. LL_TCWV)THEN
    ZVERTP   (JOBS,JBODY) = ZPRESF5(JOBS,1)
    ZVERTP_L (JOBS,JBODY) = ZPRESF5(JOBS,NFLEVG)
  ENDIF

  IF(LLREO3) THEN
    INAK(JOBS,JBODY)  = SATBODY(IBODY,MDB_NAK_AT_REO3_BODY)
    IF(INAK(JOBS,JBODY) > 0) THEN
      IF (.NOT.LL_AK) LL_AK=.TRUE.
      ZPRES_AK(JOBS,JBODY,1:INAK(JOBS,JBODY))  = &
       & SATBODY(IBODY,MDB_PAK_AT_REO3_BODY(1:INAK(JOBS,JBODY)))
      ZWEIGHT_AK(JOBS,JBODY,1:INAK(JOBS,JBODY))  = &
       & SATBODY(IBODY,MDB_WAK_AT_REO3_BODY(1:INAK(JOBS,JBODY)))
      ZPRIOR_AK(JOBS,JBODY,1:INAK(JOBS,JBODY))  = &
       & SATBODY(IBODY,MDB_APAK_AT_REO3_BODY(1:INAK(JOBS,JBODY)))
    ENDIF
  ENDIF

ENDDO NEW_BODY_LOOP

!*          3.5   Surface wind data
IF (KSCAN == 1 .OR. KSCAN == 2) THEN
  IF(LL_SFC_OP) CALL HINTH(KDLEN,ILEN,KDBDY,IMXBDY,ICMBDY,IOBSTYPE,&
   & ZAPHI5(1,NFLEVG),ZINTHUV,IVNMRQ)
ENDIF
!*          3.6   Quadratic SCAT cost function requires that one of the two 
!                 ambiguous winds is chosen a priori.
!                 Use the one closest to the high resolution trajectory.

IF(IOBSTYPE == NSCATT .AND. LQSCATT) &
 & CALL HQSCATT(KDLEN,ILEN,KDBDY,IMXBDY,ICMBDY,IOBSTYPE,IVNMRQ)

!     ------------------------------------------------------------------
!        4.       Postprocessing of the model variables to
!                 obtain the equivalent of observed quantities 
!                 --------------------------------------------

!*          4.0   Preset to missing

ZHOFX(1:ILEN,:)=RMDI
IVAR(1:ILEN,:) =NMDI

!*          4.1   Loop variables, skip empty ones

VNM_LOOP: DO JVNM=1,JPMXVAR

  IIVNM=NVNUMB(JVNM)
  IF(CLV(JVNM) == 'XXX') CYCLE VNM_LOOP
  IF(CLV(JVNM) == 'V' .OR. CLV(JVNM) == 'V10') CYCLE VNM_LOOP
  IF(IVARL(JVNM) == 0) CYCLE VNM_LOOP
  IF(NOTVAR(IVARL(JVNM),IOBSTYPE) == -1) then
    if (.NOT.LECMWF) then
      do IBODY=1,MLNKH2B(ILEN+1)-1
        IF (ROBODY(IBODY,MDBVNM) == IIVNM) THEN
          ROBODY(IBODY,MDBDSTA) = ZCHSTAT_PASSIVE(ROBODY(IBODY,MDBDSTA))
        ENDIF
      enddo
    endif
    CYCLE VNM_LOOP
  endif
  ! SCAT and SSMI wind speeds require 10m surface-version of wind-speed
  IF((LL_RAIN .OR. IOBSTYPE == NSCATT) &
   & .AND. CLV(JVNM) == 'FF') CLV(JVNM) = 'FFS'

  !*          4.2   Extract positions in the volume JOBS*JBODY which
  !                 contain IIVNM. Positions are in INPLV and counts in ICOUNT.

  ICOUNT(:)=0
  DO IBODY=1,MLNKH2B(ILEN+1)-1
    JOBS = MBODYJOBS(IBODY)
    JBODY = IBODY + 1 - MLNKH2B(JOBS)
    IF(IVNMRQ(JOBS,JBODY) == IIVNM) THEN
      ICOUNT(JOBS)=ICOUNT(JOBS)+1
      IPNLV(JOBS,ICOUNT(JOBS))=JBODY
      IVAR(JOBS,JBODY)=IVARL(JVNM)
    ENDIF
  ENDDO
  IMXCOUNT=MAXVAL(ICOUNT(1:ILEN))
  IF(IMXCOUNT == 0 ) CYCLE VNM_LOOP

  !*          4.3.1 Are GHG and GRG operators required or not
  LLGHG=.false.
  DO JGHG=1,NGHG
    LLGHG(JGHG)=CLV(JVNM) == TRIM(YGHG_NL(JGHG)%cname)
  ENDDO

  LLGRG=.false.
  DO JGRG=1,NGRG
    LLGRG(JGRG)=CLV(JVNM) == TRIM(YGRG_NL(JGRG)%cname)
  ENDDO

  LLNO2=CLV(JVNM) == 'NOX'
  IF (LLNO2) THEN
    ALLOCATE(ZNO25(KDLEN,0:NFLEVG))
    ALLOCATE(ZNO2(KDLEN,0:NFLEVG))
    ZNO2(1:ILEN,:)=0.0_JPRB
  ENDIF

  !*          4.4   Layer quantities and winds need special treatment

  LL_LAYER=.NOT.(ZLAYL(JVNM,1) == 1.0_JPRB .AND. ZLAYL(JVNM,2) == 0.0_JPRB) &
   & .AND. (.NOT.LL_AK)
  LL_WIND =CLV(JVNM) == 'U'   .OR. CLV(JVNM) == 'U10' .OR. CLV(JVNM) == 'AUV'
  LL_SPEED=(CLV(JVNM) == 'FF' .OR. CLV(JVNM) == 'FFS')
  LL_NONLINEAR=CLV(JVNM) == 'H2' .OR. LL_SPEED
  LL_HLS  =(CLV(JVNM) == 'HLS')
  IF (KSCAN == 2) THEN
    DO JNLV=1,IMXCOUNT
      DO JOBS=1,ILEN
        IF(JNLV > ICOUNT(JOBS)) CYCLE
        IBDY=IPNLV(JOBS,JNLV)
        IF(LL_WIND) THEN
          IVAR( JOBS,IBDY+1)=IVAR(JOBS,IBDY)
        ENDIF
      ENDDO
    ENDDO
    CYCLE VNM_LOOP
  ENDIF

  !*          4.5   Now that we know the number of data, of this variable,
  !                 allocate the array to hold PP-values (ZXPP) and
  !                 contracted lists of vertical positions (ZVPOBS, ZVPOBS_L)
  !                 TOVS may need emissivities (ZEM5) from obs arry.

  IDF=2
  ALLOCATE(ZXPP(KDLEN,IMXCOUNT,IDF))
  ALLOCATE(ZXPP5(KDLEN,IMXCOUNT,IDF))
  ALLOCATE(ZVPOBS(KDLEN,IMXCOUNT))
  ALLOCATE(ZRCH(KDLEN,IMXCOUNT))
  ALLOCATE(LLACTIVE(KDLEN,IMXCOUNT))  
  ZVPOBS(:,:)=RMDI
  ZVPOBS(1:ILEN,:)=Z500HPA
  ALLOCATE(ZVPOBS_L(KDLEN,IMXCOUNT))
  ZVPOBS_L(1:ILEN,:)=Z500HPA
  ALLOCATE(ZVPOBS5(KDLEN,IMXCOUNT))
  ALLOCATE(ZORDIF(KDLEN))
  IF(LL_RAD_OP) THEN
    ALLOCATE(ZEM (KDLEN,IMXCOUNT))
    ZEM (1:ILEN,:)=0.0_JPRB
    ALLOCATE(ZEM5(KDLEN,IMXCOUNT))
    ZEM5(1:ILEN,:)=1.0_JPRB
    ALLOCATE(ZEMIS (KDLEN,IMXCOUNT))
    ALLOCATE(ZEMIS5 (KDLEN,IMXCOUNT))
  ENDIF
  ALLOCATE(ZTAUC5(KDLEN,NFLEVG))
  ALLOCATE(ZTAUC(KDLEN,NFLEVG))

  IF(LLREO3) THEN
    ALLOCATE(IAK(KDLEN,IMXCOUNT))
    IAK(:,:)=0.0_JPRB
    ALLOCATE(ZPAK(KDLEN,IMXCOUNT,JPMX_AK))
    ZPAK(:,:,:)=Z500HPA
    ALLOCATE(ZWAK(KDLEN,IMXCOUNT,JPMX_AK))
    ZWAK(:,:,:)=0.0_JPRB
    ALLOCATE(ZAPAK(KDLEN,IMXCOUNT,JPMX_AK))
    ZAPAK(:,:,:)=0.0_JPRB
  ENDIF

  IF(ANY(LLGRG)) THEN
    ALLOCATE(ZCOD5(KDLEN))
  ENDIF

  DO JNLV=1,IMXCOUNT
    DO JOBS=1,ILEN
      IF(JNLV <= ICOUNT(JOBS)) THEN
        IBDY=IPNLV(JOBS,JNLV)
        ZVPOBS(JOBS,JNLV)=ZVERTP(JOBS,IBDY)
        ZVPOBS_L(JOBS,JNLV)=ZVERTP_L(JOBS,IBDY)
        IF(LLREO3) THEN
          IAK(JOBS,JNLV)=INAK(JOBS,IBDY)
          IF(IAK(JOBS,JNLV) > 0) THEN
            ZPAK(JOBS,JNLV,1:IAK(JOBS,JNLV)) = &
             &   ZPRES_AK(JOBS,IBDY,1:INAK(JOBS,IBDY))
            ZWAK(JOBS,JNLV,1:IAK(JOBS,JNLV)) = &
             &   ZWEIGHT_AK(JOBS,IBDY,1:INAK(JOBS,IBDY))
            ZAPAK(JOBS,JNLV,1:IAK(JOBS,JNLV)) = &
             &   ZPRIOR_AK(JOBS,IBDY,1:INAK(JOBS,IBDY))
          ENDIF
        ENDIF
      ENDIF
    ENDDO
  ENDDO

  IF(LLRAD1C) THEN
    DO JNLV=1,IMXCOUNT
      DO IJB = 1, ILEN
        IF( JNLV <= ICOUNT(IJB) )THEN
          JB1 = MLNKH2B(IJB)
          JB2 = IPNLV(IJB,JNLV)
          JB3 = JB1 + JB2 - 1
          ZEM5(IJB,JNLV)=ROBODY(JB3,MDBPER)
          !* to avoid mismatch between preset emissivities and land/sea flag
          IF( ZEM5(IJB,JNLV) >  1.00_JPRB .AND. &
           &  ZLS5(IJB)      >= 0.01_JPRB         )THEN
            ZEM5(IJB,JNLV)=1.0
            ROBODY(JB3,MDBFOE) = 999.0_JPRB
          ENDIF
        ENDIF
      ENDDO
    ENDDO
  ENDIF

  !*          4.6   Call the appropriate PPOBSA routine

  !*          4.6.1 Upper air operators
  IF( (CLV(JVNM) == 'U' .AND. .NOT.LL_MEAN_UV)  .OR.                       &
   & CLV(JVNM) == 'HLS'.OR.&
   & CLV(JVNM) == 'T'  .OR. CLV(JVNM) == 'H'  .OR. CLV(JVNM) == 'FF' .OR.&
   & CLV(JVNM) == 'LH' .OR. CLV(JVNM) == 'PWC'.OR. CLV(JVNM) == 'Q'  .OR.&
   & CLV(JVNM) == 'Z'  .OR. CLV(JVNM) == 'DZ' .OR. CLV(JVNM) == 'TO3'.OR.&
   & CLV(JVNM) == 'CLW'.OR. CLV(JVNM) == 'CIW'.OR. CLV(JVNM) == 'CC' ) THEN

    CALL PPOBSATL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,ZVPOBS,ZOROG5,&
     & ZPXP,ZPXPD,ZUF,ZVF,ZTF,ZQF,ZO3F,&
     & ZCLWF,ZCIWF,ZCCF,ZTSTAR,ZT0,ZLNPR,ZALPH,&
     & IDF,ZXPP,&
     & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
     & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5)

    !*          4.6.1b Upper air operators, lower level

    IF(LL_LAYER) THEN
      CALL PPOBSATL(KDLEN,ILEN,&
       & IMXCOUNT,CLV(JVNM),ICOUNT,ZVPOBS_L,ZOROG5,&
       & ZPXP,ZPXPD,ZUF,ZVF,ZTF,ZQF,ZO3F,&
       & ZCLWF,ZCIWF,ZCCF,ZTSTAR,ZT0,ZLNPR,ZALPH,&
       & IDF-1,ZXPP(1,1,2),&
       & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
       & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5)
    ENDIF

    !*          4.6.1c Variational bias correction for O3

    IF (LVARBC .AND. CLV(JVNM) == 'TO3') THEN
      DO JOBS=1,ILEN
        IVISNIR(JOBS) = 0.0_JPRB
        ZLAT(JOBS)    = ROBHDR(JOBS,MDBLAT) * RDEGREES
        ZLON(JOBS)    = ROBHDR(JOBS,MDBLON) * RDEGREES
        IF (ZLON(JOBS)< 0.0) ZLON(JOBS) =ZLON(JOBS) + 360.0
      ENDDO
      ALLOCATE(ZXPPB(KDLEN,IMXCOUNT,1),ZXPRED(0:JPMXNPRED,ILEN), &
       & ZSOLAR(ILEN), &
       & ZOMF(KDLEN,IMXCOUNT),IXVARBC(KDLEN,IMXCOUNT))
      ZOMF(:,:)=RMDI
      DO JNLV=1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV > ICOUNT(JOBS)) CYCLE
          IBODY = MLNKH2B(JOBS) + (IPNLV(JOBS,JNLV)-1)
          ZOMF(JOBS,JNLV) = ROBODY(IBODY,MDBOMF)         
          IXVARBC(JOBS,JNLV) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
        ENDDO
      ENDDO
      DO JOBS= 1, ILEN
        ZZLAT   = ROBHDR(JOBS,MDBLAT) * RDEGREES
        ZZLON   = ROBHDR(JOBS,MDBLON) * RDEGREES
        IOBDATE = ROBHDR(JOBS,MDBDAT)
        IYEAR   = IOBDATE/10000
        IMONTH  = IOBDATE/100 - IYEAR*100
        IDAY    = IOBDATE - (IYEAR*10000+IMONTH*100)
        IOBTIME = ROBHDR(JOBS,MDBETM)
        IHOUR   = IOBTIME/10000
        CALL DIURNAL ( IMONTH, IDAY, IHOUR, ZZLAT, ZZLON, ZSOLAR(JOBS))
      ENDDO

      CALL VARBC_PRED_TO3 (ILEN, IMXCOUNT, ICOUNT(1:ILEN), IXVARBC(1:ILEN,:), &
        &  ZSOLAR, JPMXNPRED, ZXPRED, LSTATS=.FALSE.)

      CALL VARBC_BIASTL (IXVARBC, IMXCOUNT, ICOUNT, KDLEN, ILEN, &
       & JPMXNPRED, ZXPRED, IVISNIR, ZLAT, ZLON, ZOMF, ZXPPB(:,:,1))

      DO JNLV = 1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IF (ZXPP(JOBS,JNLV,2)/=RMDI) &
           & ZXPP(JOBS,JNLV,2) = ZXPP(JOBS,JNLV,2) + ZXPPB(JOBS,JNLV,1)
        ENDDO
      ENDDO
      DEALLOCATE(ZXPPB, ZXPRED, ZSOLAR, ZOMF, IXVARBC)
    ENDIF

    !*          4.6.1d Variational bias correction for TCWV

    IF (LVARBC .AND. LL_TCWV .AND. CLV(JVNM) == 'PWC') THEN
      DO JOBS = 1,ILEN
        ZLAT (JOBS) = ROBHDR (JOBS,MDBLAT) * RDEGREES
        ZLON (JOBS) = ROBHDR (JOBS,MDBLON) * RDEGREES
        IF (ZLON (JOBS) < 0.0) ZLON (JOBS) = ZLON (JOBS) + 360.0

        IVISNIR    (JOBS) = 0.0_JPRB
        ZNVANG     (JOBS) = RMDI
        ZSOLZENANG (JOBS) = RMDI
        ZSOLHOUR   (JOBS) = 0.0_JPRB !check this if solar hour is required
      ENDDO

      ALLOCATE(ZXPPB(KDLEN,IMXCOUNT,1),ZXPRED(0:JPMXNPRED,ILEN), &
       & ZOMF(KDLEN,IMXCOUNT),IXVARBC(KDLEN,IMXCOUNT))

      ZOMF(:,:)=RMDI
      DO JNLV=1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV > ICOUNT(JOBS)) CYCLE
          IBODY = MLNKH2B(JOBS) + (IPNLV(JOBS,JNLV)-1)
          ZOMF(JOBS,JNLV) = ROBODY(IBODY,MDBOMF)         
          IXVARBC(JOBS,JNLV) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
        ENDDO
      ENDDO

      CALL VARBC_PRED_RAD (KDLEN, ILEN, IMXCOUNT, ICOUNT(1:ILEN), IXVARBC(1:ILEN,:), &
       & ZPRESF5, ZGEOPF5(:,1:NFLEVG), ZQF5(:,1:NFLEVG), ZLS5(:), ZCI5(:), ZTF5(:,NFLEVG), &
       & ZUF5(:,NFLEVG), ZVF5(:,NFLEVG), ZNVANG, ZSOLZENANG, ZSOLHOUR, &
       & NFLEVG, JPMXNPRED, ZXPRED, LSTATS=.FALSE.)

      CALL VARBC_BIASTL (IXVARBC, IMXCOUNT, ICOUNT, KDLEN, ILEN, &
       & JPMXNPRED, ZXPRED, IVISNIR, ZLAT, ZLON, ZOMF, ZXPPB(:,:,1))

      DO JNLV = 1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IF (ZXPP(JOBS,JNLV,2)/=RMDI) &
           & ZXPP(JOBS,JNLV,2) = ZXPP(JOBS,JNLV,2) + ZXPPB(JOBS,JNLV,1)
        ENDDO
      ENDDO
      DEALLOCATE(ZXPPB, ZXPRED, ZOMF, IXVARBC)
    ENDIF

    !*          4.6.1e Variational bias correction for AIREP T

     IF (LBC_AIREP .AND. LVARBC .AND. LL_AIREP .AND. CLV(JVNM) == 'T') THEN
       DO JOBS = 1,ILEN
         ZLAT (JOBS) = ROBHDR (JOBS,MDBLAT) * RDEGREES
         ZLON (JOBS) = ROBHDR (JOBS,MDBLON) * RDEGREES
         IF (ZLON (JOBS) < 0.0) ZLON (JOBS) = ZLON (JOBS) + 360.0

         IVISNIR    (JOBS) = 0.0_JPRB
       ENDDO

       ALLOCATE(ZXPPB(KDLEN,IMXCOUNT,1),ZXPRED(0:JPMXNPRED,ILEN), &
        & ZOMF(KDLEN,IMXCOUNT),IXVARBC(KDLEN,IMXCOUNT))

       ZOMF(:,:)=RMDI
       DO JNLV=1,IMXCOUNT
         DO JOBS = 1,ILEN
           IF (JNLV > ICOUNT(JOBS)) CYCLE
           IBODY = MLNKH2B(JOBS) + (IPNLV(JOBS,JNLV)-1)
           ZOMF(JOBS,JNLV) = ROBODY(IBODY,MDBOMF)         
           IXVARBC(JOBS,JNLV) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
         ENDDO
       ENDDO

       CALL VARBC_PRED_AIREP (ILEN, IMXCOUNT, ICOUNT(1:ILEN), IXVARBC(1:ILEN,:), &
         &  JPMXNPRED, ZXPRED, LSTATS=.FALSE.)

       CALL VARBC_BIASTL (IXVARBC, IMXCOUNT, ICOUNT, KDLEN, ILEN, &
        & JPMXNPRED, ZXPRED, IVISNIR, ZLAT, ZLON, ZOMF, ZXPPB(:,:,1))
 
       DO JNLV = 1,IMXCOUNT
         DO JOBS = 1,ILEN
           IF (JNLV>ICOUNT(JOBS)) CYCLE
           IF (ZXPP(JOBS,JNLV,1)/=RMDI) &
            & ZXPP(JOBS,JNLV,1) = ZXPP(JOBS,JNLV,1) + ZXPPB(JOBS,JNLV,1)
         ENDDO
       ENDDO
       DEALLOCATE(ZXPPB, ZXPRED, ZOMF, IXVARBC)
     ENDIF


    !*          4.6.2 Surface operators

  ELSEIF(CLV(JVNM) == 'U10' .OR. CLV(JVNM) == 'T2' .OR.&
   &   CLV(JVNM) == 'H2'  .OR. CLV(JVNM) == 'AUV'.OR.&
   &   CLV(JVNM) == 'FFS'  .OR. CLV(JVNM) == 'TS') THEN
    IF(LL_WIND .OR. LL_SPEED) THEN
      ZINTH(1:ILEN)=ZINTHUV(1:ILEN)
    ELSE
      ZINTH(1:ILEN)=2.0_JPRB*RG
    ENDIF
    IF(.NOT.LL_SFC_OP) CALL ABOR1('HOPTL: PPOBSAS requires LL_SFC_OP=.T.')
    !     ZXPP5 to contain ZRH2M5, needed as H2-operator is non-linear.
    IF(.NOT.LCACHMT) THEN
      IF(LL_NONLINEAR) CALL PPOBSAS(KDLEN,ILEN,&
       & IMXCOUNT,CLV(JVNM),ZINTH,IOBSTYPE,ICOUNT,ZZ0SCAT,&
       & ZPRESF5,ZUF5,ZVF5,ZTF5,ZQN5,ZU05,ZV05,&
       & ZCPTGZ5,ZCPTS5,ZAPHI5,ZES5,ZRI5,ZBN5,ZBM5,ZBH5,&
       & IDF,ZXPP5)
      CALL PPOBSASTL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ZINTH,IOBSTYPE,ICOUNT,&
       & ZZ0SCAT,&
       & ZPRESF,ZUF,ZVF,ZTF,ZQN,&
       & ZCPTGZ,ZCPTS,ZAPHI,ZBN,ZBM,ZBH,&
       & IDF,ZXPP,&
       & ZPRESF5,ZUF5,ZVF5,ZTF5,ZQN5,ZU05,ZV05,&
       & ZCPTGZ5,ZCPTS5,ZAPHI5,ZES5,ZRI5,ZBN5,ZBM5,ZBH5,ZXPP5)
      IF(IOBSTYPE == NSCATT .AND. .NOT.LQSCATT) &
       & ZXPP(1:ILEN,2,1:2)=ZXPP(1:ILEN,1,1:2)      ! U/V-comp, 2nd ambig wind  
    ELSE
      IF(LL_NONLINEAR) CALL PPOBSAC(KDLEN,ILEN,IMXCOUNT,&
       & CLV(JVNM),ZINTH,IOBSTYPE,ICOUNT,&
       & ZOROGOB,ZOROG5,ZPRESH5,ZPRESF5,ZGEOPH5,ZGEOPF5,&
       & ZCP5,ZRF5,ZUF5,ZVF5,ZTF5,ZQF5,&
       & ZTS5,ZSST5,ZWS5,ZVEG5,ZSN5,ZSLM5,ZZ05,&
       & IDF,ZXPP5)
      CALL PPOBSACTL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ZINTH,&
       & IOBSTYPE,ICOUNT,&
       & ZPRESH,ZPRESF,ZGEOPH,ZGEOPF,&
       & ZCP,ZRF,ZUF,ZVF,ZTF,ZQF,&
       & ZTS,ZWS,ZSN,ZZ0,&
       & IDF,ZXPP,&
       & ZPRESH5,ZPRESF5,ZGEOPH5,ZGEOPF5,&
       & ZCP5,ZRF5,ZUF5,ZVF5,ZTF5,ZQF5,&
       & ZTS5,ZWS5,ZVEG5,ZSN5,ZSLM5,ZZ05,ZXPP5)
    ENDIF

    !*          4.6.3 Surface pressure, with height as vertical coordinate
    !                 ZVPOBS is height

  ELSEIF(CLV(JVNM) == 'PS') THEN
    LLEXTLI=.FALSE.
    ISLCT=1
    CALL PPOBSAZTL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),IOBSTYPE,ICOUNT,ZVPOBS,&
     & ZOROG5,ISLCT,LLEXTLI,&
     & ZPXZ,ZPXZD,ZGEOPH,ZGEOPF,ZPRESH,ZPRESF,ZTSTAR,&
     & IDF,ZXPP,&
     & ZPXZ5,ZPXZD5,ZGEOPH5,ZGEOPF5,ZPRESH5,ZPRESF5,ZTSTAR5)

    !*          4.6.5 Radiances

  ELSEIF(CLV(JVNM) == 'RAD') THEN

    !*          4.5.5a Allocates and fill lat/lon, angles

    IF(.NOT.LL_RAD_OP) CALL ABOR1('HOPTL: RADTR requires LL_RAD_OP=.T.')
    ALLOCATE(ZPS (KDLEN))
    ALLOCATE(ZT2M (KDLEN))
    ALLOCATE(ZQ2M (KDLEN))
    ALLOCATE(ZCTOP (KDLEN))
    ALLOCATE(ZCAMT (KDLEN))
    ALLOCATE(ZPS5(KDLEN))
    ALLOCATE(ZT2M5(KDLEN))
    ALLOCATE(ZQ2M5(KDLEN))
    ALLOCATE(ZCTOP5(KDLEN))
    ALLOCATE(ZCAMT5(KDLEN))
    ALLOCATE(ZTS5_REF(KDLEN))
    DO JOBS = 1,ILEN
      ZLAT(JOBS) = ROBHDR(JOBS,MDBLAT) * RDEGREES 
      ZLON(JOBS) = ROBHDR(JOBS,MDBLON) * RDEGREES
      IF (ZLON(JOBS)< 0.0_JPRB) ZLON(JOBS) =ZLON(JOBS) + 360.0_JPRB
      IF(.NOT. LL_MWAVE) THEN
        ZAZIANG(JOBS)    = SATHDR(JOBS,MDB_AZIMUTH_AT_SAT)
        ZSOLZENANG(JOBS) = SATHDR(JOBS,MDB_SOLAR_ZENITH_AT_SAT)
        ZSOLAZIANG(JOBS) = SATHDR(JOBS,MDB_SOLAR_AZIMUTH_AT_SAT)
      ELSE
        ZSOLZENANG(JOBS) = RMDI ! initialise for VarBC
      ENDIF
      IOBTIME = ROBHDR(JOBS,MDBETM)
      ZSOLHOUR(JOBS) = MOD(IOBTIME/10000 + MOD(IOBTIME/100, 100)/60.0_JPRB &
       &             + ZLON(JOBS)/15.0_JPRB + 24.0_JPRB, 24.0_JPRB) 
    ENDDO
    ZTS5_REF(:)=ZTS5(:)

    IF( LRTTOV_INTERPOL )THEN

      !*          4.5.5b Preparations if RTTOV-internal interpolation is used

      CALL HRADP_ML_TL(KDLEN,ILEN,KSET,ZNVANG,ZZEANG,ICOEF,&
       & ZPRESH,ZTF,ZQF,&
       & ZPS,ZTS,ZT2M,ZQ2M,ZCTOP,ZCAMT ,&
       & ZPRESH5,ZTF5,ZQF5,&
       & ZPS5,ZTS5,ZT2M5,ZQ2M5,ZCTOP5,ZCAMT5)  
      ALLOCATE(ZTBTOT(KDLEN,IMXCOUNT))

    ELSE

      !*          4.5.5c Interpolate T, q and O3 to fix pressure levels

      ICOUNTX(1:ILEN)=NLSAT

      IDFS=NPNAV-1
      ALLOCATE(ZPRES(KDLEN,NLSAT))
      ALLOCATE(ZTQOPP(KDLEN,NLSAT,IDFS))
      ALLOCATE(ZTQOPP5(KDLEN,NLSAT,IDFS))

      !     List of fix pressure levels to interpolate to
      DO JLEV=1,NLSAT
        ZPRES(1:ILEN,JLEV) = RADPRE(JLEV)
      ENDDO

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

      !*          4.5.5d Preparations if IFS-based interpolation is used

      CALL HRADPTL(KDLEN,ILEN,KSET,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)

    ENDIF

    !*          4.6.5d Call radiative transfer model, RTTOV5

    IF ((ISENSOR == MSENSOR_AIRS).AND.LCO2_DIAG_AIRS) THEN
      ZCTOP5(:)=500.0_JPRB
      ZCAMT5(:)=0.0_JPRB
      DO JOBS=1,ILEN
        ZCTOP5(JOBS) = SATHDR(JOBS,MDB1BCP15A)
        ZCAMT5(JOBS) = SATHDR(JOBS,MDB1BCP16A)
      ENDDO
    ENDIF

    IF(LL_MWAVE)THEN
      DO JNLV=1,IMXCOUNT
        DO JOBS=1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IBODY = MLNKH2B(JOBS)+IPNLV(JOBS,JNLV)-1
          IF(MWAVE_OK(INT(SATBODY(IBODY,MDB_DATUM_TBFLAG),JPIM)))THEN
            ZXPP(JOBS,JNLV,1)=SATBODY(IBODY,MDB_TBVALUETL)
          ELSE
            ZXPP(JOBS,JNLV,1)= RMDI
          ENDIF
        ENDDO
      ENDDO
    ELSE
      ! Do not compute TL/AD of the radiative transfer for passive data !
      ICOUNTA(:) = 0                                                   !
      LLACTIVE(:,:) = .FALSE.                                           !
      DO JNLV=1,IMXCOUNT                                               !
        DO JOBS=1,ILEN                                                 !
          IF (JNLV>ICOUNT(JOBS)) CYCLE                                 !
          IBDY=IPNLV(JOBS,JNLV)                                        !
          IBODY = MLNKH2B(JOBS)+(IBDY-1)                               !
          ! Get status of data                                         !
          CALL NGEDSTA(INT(ROBODY(IBODY,MDBDSTA)),INSTA,IDSTA)         !
          IF (IDSTA(2) == 1) CYCLE  ! Passive data                     !
          ICOUNTA(JOBS) = ICOUNTA(JOBS) + 1                            !
          LLACTIVE(JOBS,JNLV) = .TRUE.                                  !
          ! New arrays for non-passive channels only                   !
          ZRCH(JOBS,ICOUNTA(JOBS))  = ZVPOBS(JOBS,JNLV)                !
          ZEMIS(JOBS,ICOUNTA(JOBS)) = ZEM(JOBS,JNLV)                   !
          ZEMIS5(JOBS,ICOUNTA(JOBS))= ZEM5(JOBS,JNLV)                  !
        ENDDO                                                          !
      ENDDO                                                            !
      !------------------------------------------------------------------!
      IF( LRTTOV_INTERPOL )THEN
        ZTBTOT=RMDI
        CALL RADTR_ML_TL(ICOEF,ISENSOR,KDLEN,ILEN,IMXCOUNT,ICOUNTA,ZRCH,&
         & SATGRP_TABLE(IGRP)%cld_rtcalc_assim,&
         & ZZEANG,ZAZIANG,ZSOLZENANG,ZSOLAZIANG,ZLAT,ZOROG5,            &
         & ZPRESF,ZTF,ZQF,ZO3F,ZCLWF,ZCIWF,ZCCF,YLGEMSPROF,&
         & ZPS,ZTS,ZT2M,ZQ2M,ZCTOP,ZCAMT ,ZUF(1,NFLEVG),ZVF(1,NFLEVG),ZEMIS,&
         & ZPRESF5,ZTF5,ZQF5,ZO3F5,ZCLWF5,ZCIWF5,ZCCF5,YLGEMSPROF5,&
         & ZPS5,ZTS5,ZLS5,ZT2M5,ZQ2M5,ZCTOP5,ZCAMT5 ,ZUF5(1,NFLEVG),ZVF5(1,NFLEVG),ZEMIS5,&
         & ZXPP,ZTBTOT)
        IF(SATGRP_TABLE(IGRP)%cld_rtcalc_assim) ZXPP(:,:,1) = ZTBTOT
        ZXPP(:,:,1) = ZTBTOT
      ELSE
        CALL RADTRTL(ICOEF,ISENSOR,KDLEN,ILEN,IMXCOUNT,ICOUNTA,ZRCH,    &
         & ZZEANG,ZAZIANG,ZSOLZENANG,ZSOLAZIANG,ZLAT,ZOROG5,            &
         & ZTQOPP, YLGEMSPROF,ZPS, ZTS,ZT2M, ZQ2M,ZCTOP,ZCAMT ,                      &
         & ZUF (1,NFLEVG),ZVF(1,NFLEVG),ZEMIS,                          &
         & ZTQOPP5,YLGEMSPROF5,ZPS5,ZTS5,ZLS5,ZT2M5,                    &
         & ZQ2M5,ZCTOP5,ZCAMT5 ,ZUF5(1,NFLEVG),ZVF5(1,NFLEVG),ZEMIS5,ZXPP)
      ENDIF

      !------------------------------------------------------------------!
      DO JOBS=1,ILEN                                                   !
        ZXPP(JOBS,:,1) = UNPACK(ZXPP(JOBS,1:ICOUNTA(JOBS),1), &        !
         & MASK=LLACTIVE(JOBS,:), FIELD=0.0_JPRB)       !
      ENDDO                                                            !
      !------------------------------------------------------------------!  

    ENDIF

    !*          AIRS Jacobians
    IF (LCO2ANER .AND. LCO2 .AND. ISENSOR == MSENSOR_AIRS) THEN
      CALL RADTRK(ICOEF,ISENSOR,KDLEN,ILEN,IMXCOUNT,ICOUNTA,ZRCH,    &
       & ZZEANG,ZAZIANG,ZSOLZENANG,ZSOLAZIANG,ZLAT,ZOROG5,            &
       & ZTQOPP5,YLGEMSPROF5,ZPS5,ZTS5,ZLS5,ZT2M5,                    &
       & ZQ2M5,ZUF5(1,NFLEVG),ZVF5(1,NFLEVG),ZEMIS5)  
    ENDIF

    !*          4.6.5e Variational bias correction

    IF (LVARBC) THEN
      DO JOBS=1,ILEN
        IF(LL_MWAVE)THEN
          IVISNIR(JOBS) = 0.0_JPRB
        ELSE
          IVISNIR(JOBS) = SATHDR(JOBS,MDB_CLDCOVER_AT_ATOVS)
        ENDIF
      ENDDO
      ALLOCATE(ZXPPB(KDLEN,IMXCOUNT,1),ZXPRED(0:JPMXNPRED,ILEN), &
       & ZOMF(KDLEN,IMXCOUNT),IXVARBC(KDLEN,IMXCOUNT))
      ZOMF(:,:)=RMDI
      DO JNLV=1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV > ICOUNT(JOBS)) CYCLE
          IBODY = MLNKH2B(JOBS) + (IPNLV(JOBS,JNLV)-1)
          ZOMF(JOBS,JNLV) = ROBODY(IBODY,MDBOMF)         
          IXVARBC(JOBS,JNLV) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
          ix = IXVARBC(JOBS,JNLV)
          IF (ix /= 0) LL_MODE = (LL_MODE .OR. YVARBC(ix)%llmode)
        ENDDO
      ENDDO

      CALL VARBC_PRED_RAD (KDLEN, ILEN, IMXCOUNT, ICOUNT(1:ILEN), IXVARBC(1:ILEN,:), &
       & ZPRESF5, ZGEOPF5(:,1:NFLEVG), ZQF5(:,1:NFLEVG), ZLS5(:), ZCI5(:), ZTS5_REF(:), &
       & ZUF5(:,NFLEVG), ZVF5(:,NFLEVG), ZNVANG, ZSOLZENANG, ZSOLHOUR, &
       & NFLEVG, JPMXNPRED, ZXPRED, LSTATS=.FALSE.)

      CALL VARBC_BIASTL (IXVARBC, IMXCOUNT, ICOUNT, KDLEN, ILEN, &
       & JPMXNPRED, ZXPRED, IVISNIR, ZLAT, ZLON, ZOMF, ZXPPB(:,:,1))

      DO JNLV = 1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IF (ZXPP(JOBS,JNLV,1)/=RMDI) &
           & ZXPP(JOBS,JNLV,1) = ZXPP(JOBS,JNLV,1) + ZXPPB(JOBS,JNLV,1)
        ENDDO
      ENDDO
      DEALLOCATE(ZXPPB, ZXPRED, ZOMF, IXVARBC)
    ENDIF

    !*          4.6.5f Deallocate radiance arrays

    DEALLOCATE(ZPS,ZT2M,ZQ2M,ZPS5,ZT2M5,ZQ2M5,ZCTOP,ZCAMT,ZCTOP5,ZCAMT5,ZTS5_REF)
    IF( LRTTOV_INTERPOL )THEN
      DEALLOCATE(ZTBTOT)
    ELSE
      DEALLOCATE(ZPRES,ZTQOPP,ZTQOPP5)
    ENDIF

    !*          4.6.6 Mean layer wind (for SATOB/AMVs)

  ELSEIF(CLV(JVNM) == 'U' .AND. LL_MEAN_UV) THEN
    SELECT CASE (TRIM(SATOBGRP_TABLE(IGRP)%obs_oper))

      !*           4.6.6a Function averaging
    CASE ('Gauss average','Boxcar average')
      ALLOCATE(ZUV5(KDLEN,NFLEVG,2))
      ALLOCATE(ZUV(KDLEN,NFLEVG,2))
      ALLOCATE(ZW5(KDLEN,NFLEVG))
      ALLOCATE(ZW(KDLEN,NFLEVG))
      ALLOCATE(ZTAU(KDLEN,IMXBDY,NFLEVG))

      CALL MEANUV_WEIGHTSTL(KDLEN,ILEN,IMXCOUNT,NFLEVG,  &
       & SATOBGRP_TABLE(IGRP)%obs_oper,ZTAU,ZVPOBS,&
       & ZPRESF5,ZPRESF,SATOBGRP_TABLE(IGRP)%SIGMA,ZW5,ZW)  

      ZUV5(1:ILEN,1:NFLEVG,1) = ZUF5(1:ILEN,1:NFLEVG)
      ZUV5(1:ILEN,1:NFLEVG,2) = ZVF5(1:ILEN,1:NFLEVG)
      ZUV(1:ILEN,1:NFLEVG,1) = ZUF(1:ILEN,1:NFLEVG)
      ZUV(1:ILEN,1:NFLEVG,2) = ZVF(1:ILEN,1:NFLEVG)

      CALL MEANUV_AVERAGETL(KDLEN,ILEN,IMXCOUNT,NFLEVG,ZUV5,ZUV,&
       & ZW5,ZW,ZXPP)

      DEALLOCATE(ZUV5,ZUV,ZW5,ZW,ZTAU)

      !*           4.6.6b Averaging using weighting function from radiative transfer
    CASE ('RT average')
      ! Allocations
      ALLOCATE(ZPRES(KDLEN,NLSAT))
      ALLOCATE(ZUV(KDLEN,NLSAT,2))
      ALLOCATE(ZW5(KDLEN,NLSAT))

      ! RTTOV pressure levels and stored weights
      ICOUNTX(1:ILEN)=NLSAT
      DO JLEV=1,NLSAT
        ZPRES(1:ILEN,JLEV) = RADPRE(JLEV)
        ZW5(1:ILEN,JLEV)    = SATHDR(1:ILEN,MDB_WEIGHT_AT_SATOB(JLEV))
      ENDDO

      !       Interpolate U and V to fixed pressure levels
      CALL PPOBSATL(KDLEN,ILEN,NLSAT,CLV(JVNM),ICOUNTX,ZPRES,&
       & ZPRESF,ZPXP,ZPXPD,ZUF,ZVF,ZTF,ZQF,ZO3F,&
       & ZCLWF,ZCIWF,ZCCF,ZTSTAR,ZT0,ZLNPR,ZALPH,&
       & 2,ZUV,&
       & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
       & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5)
      !       Calculate weighted mean
      CALL MEANUV_AVERAGE(KDLEN,ILEN,IMXCOUNT,NLSAT,ZUV,&
       & ZW5,ZXPP)

      DEALLOCATE(ZPRES,ZUV,ZW5)
    END SELECT

    !*           4.6.7  Call the GPSRO forward model

  ELSEIF (CLV(JVNM) =='RO ') THEN

    IF (KHORIZ == 1) THEN

      CALL GPSRO_TL(KDLEN,KDBDY,IMXCOUNT,ILEN,IVNMRQ,ZPRESF5,ZPRESF,&
       & ZTF5,ZTF,ZQF5,ZQF,ZGEOPF5,ZGEOPF,ZXPP)  

    ELSE 

      CALL GPSRO_2DTL(KDLEN,KDBDY,KHORIZ,IMXCOUNT,ILEN,IVNMRQ,ZPRESF5_2D,ZPRESF_2D,&
       & ZTF5_2D,ZTF_2D,ZQF5_2D,ZQF_2D,ZGEOPF5_2D,ZGEOPF_2D,ZXPP)  


    ENDIF


    !*           4.5.8  Call the AOD tangent linear model
  ELSEIF (CLV(JVNM) =='AOD') THEN

    CALL AOD_TL(KDLEN,ILEN,IMXCOUNT,ZQF, ZTF, ZPRESH, ZPRESF, YLGEMSPROF, &
     &             ZQF5, ZTF5, ZPRESH5, ZPRESF5, YLGEMSPROF5, ZXPP)

!BEN - Variational bias correction for aerosol optical depth
    IF (LVARBC) THEN
      DO JOBS=1,ILEN
        IVISNIR(JOBS) = 0.0_JPRB
        ZLAT(JOBS)    = ROBHDR(JOBS,MDBLAT) * RDEGREES
        ZLON(JOBS)    = ROBHDR(JOBS,MDBLON) * RDEGREES
        IF (ZLON(JOBS)< 0.0) ZLON(JOBS) =ZLON(JOBS) + 360.0
      ENDDO
      ALLOCATE(ZXPPB(KDLEN,IMXCOUNT,1),ZXPRED(0:JPMXNPRED,ILEN), &
       & ZSOLAR(ILEN), &
       & ZOMF(KDLEN,IMXCOUNT),IXVARBC(KDLEN,IMXCOUNT))
      ZOMF(:,:)=RMDI
      DO JNLV=1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV > ICOUNT(JOBS)) CYCLE
          IBODY = MLNKH2B(JOBS) + (IPNLV(JOBS,JNLV)-1)
          ZOMF(JOBS,JNLV) = ROBODY(IBODY,MDBOMF)
          IXVARBC(JOBS,JNLV) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
        ENDDO
      ENDDO

! For now this calculation is not necessary since solar elevation is NOT used as a bias predictor
!      DO JOBS= 1, ILEN
!        ZZLAT   = ROBHDR(JOBS,MDBLAT) * RDEGREES
!        ZZLON   = ROBHDR(JOBS,MDBLON) * RDEGREES
!        IOBDATE = ROBHDR(JOBS,MDBDAT)
!        IYEAR   = IOBDATE/10000
!        IMONTH  = IOBDATE/100 - IYEAR*100
!        IDAY    = IOBDATE - (IYEAR*10000+IMONTH*100)
!        IOBTIME = ROBHDR(JOBS,MDBETM)
!        IHOUR   = IOBTIME/10000
!        CALL DIURNAL ( IMONTH, IDAY, IHOUR, ZZLAT, ZZLON, ZSOLAR(JOBS))
!      ENDDO

      ZSOLAR(:) = RMDI

      CALL VARBC_PRED_TO3 (ILEN, IMXCOUNT, ICOUNT(1:ILEN), IXVARBC(1:ILEN,:), &
        &  ZSOLAR, JPMXNPRED, ZXPRED, LSTATS=.FALSE.)

      CALL VARBC_BIASTL (IXVARBC, IMXCOUNT, ICOUNT, KDLEN, ILEN, &
       & JPMXNPRED, ZXPRED, IVISNIR, ZLAT, ZLON, ZOMF, ZXPPB(:,:,1))

      DO JNLV = 1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IF (ZXPP(JOBS,JNLV,1)/=RMDI) &
           & ZXPP(JOBS,JNLV,1) = ZXPP(JOBS,JNLV,1) + ZXPPB(JOBS,JNLV,1)
        ENDDO
      ENDDO
      DEALLOCATE(ZXPPB, ZXPRED, ZSOLAR, ZOMF, IXVARBC)
    ENDIF


    !*           4.5.11  Call the Cloud Optical Depth tangent linear model
  ELSEIF (CLV(JVNM) =='COD') THEN
    CALL COD_OPTL(KDLEN,ILEN,IMXCOUNT,ZQF, ZTF, ZPRESH, ZPRESF, ZCLWF,ZCIWF, &
     &             ZQF5, ZTF5, ZPRESH5, ZPRESF5, ZLS5, ZCLWF5,ZCIWF5, ZXPP,ZTAUC)

    !!*           4.5.12  Call the tangent linear model for the ratio fine mode to total aerosol optical depth
    !  ELSEIF (CLV(JVNM) =='RAO') THEN
    !!  No obs operator yet

    !*           4.5.13  Call the tangent linear model for multi-channel aerosol reflectance
! BEN Comment out for now
!  ELSEIF (CLV(JVNM) =='RFA') THEN
!
!    ! For now define ZSOLANG5, ZVIEANG5 and ZDIFFANG5 here - in the future they have to come from ODB!!!
!
!    ZSOLANG5(:) = 0.2
!    ZVIEANG5(:) = 0.3
!    ZDIFFANG5(:) = ACOS(-1.0)/2.
!
!    CALL AER_REFL_TL( KDLEN  , ILEN  , IMXCOUNT, ZQF, ZTF, ZPRESH, ZPRESF, YLGEMSPROF, &
!     &                    ZQF5, ZTF5, ZPRESH5, ZPRESF5, YLGEMSPROF5, &
!     &                    ZSOLANG5, ZVIEANG5, ZDIFFANG5, &
!     &                    ZXPP )


    !!*           4.5.14  Call the tangent linear model for multi-channel aerosol optical depth 
    !  ELSEIF (CLV(JVNM) =='ODA') THEN
    !!  No obs operator yet


    !*           4.5.9  Limb radiances
  ELSEIF (CLV(JVNM) =='LRA') THEN

    IF (KHORIZ == 1) THEN

      CALL RTL_HOP_1D_TL(&
       & KDLEN,ILEN,IMXCOUNT,ICOUNT,IOBSTYPE,Y_LIMBGRP_TABLE(IGRP),        &
       & ZVPOBS,ZVPOBS_L,ZOROG5,                                           & 
       & ZPRESH, ZPRESF, ZPXP, ZPXPD,  ZUF, ZVF,   ZTF,   ZQF, ZO3F,       &
       & ZCLWF,  ZCIWF,  ZCCF, ZTSTAR, ZT0, ZLNPR, ZALPH,                  &
       & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5, ZUF5,ZVF5,  ZTF5,  ZQF5,ZO3F5,      &
       & ZCLWF5, ZCIWF5, ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,ZXPP)

    ELSE         

      CALL RTL_HOP_2D_TL(&
       & KDLEN,ILEN,KHORIZ,IMXCOUNT,ICOUNT,IOBSTYPE,Y_LIMBGRP_TABLE(IGRP),  &
       & ZVPOBS,ZVPOBS_L,ZOROG5_2D,                                         & 
       & ZPRESH_2D, ZPRESF_2D, ZPXP_2D,  ZPXPD_2D, ZUF_2D,   ZVF_2D,        &
       & ZTF_2D,    ZQF_2D,    ZO3F_2D,  ZCLWF_2D, ZCIWF_2D, ZCCF_2D,       &
       & ZTSTAR_2D, ZT0_2D,    ZLNPR_2D, ZALPH_2D,                          &
       & ZPRESH5_2D,ZPRESF5_2D,ZPXP5_2D, ZPXPD5_2D,ZUF5_2D,  ZVF5_2D,       &
       & ZTF5_2D,   ZQF5_2D,   ZO3F5_2D, ZCLWF5_2D,ZCIWF5_2D,ZCCF5_2D,      &
       & ZTSTAR5_2D,ZT05_2D,   ZLNPR5_2D,ZALPH5_2D,ZXPP)

    ENDIF
    !*           4.6.10  Greenhouse gases
  ELSEIF (ANY(LLGHG)) THEN

    !*          4.5.11a GHG operators using averaging kernels
    IF (LL_AK) THEN
      CALL GHG_AK_TL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,&
       & IAK,ZWAK,ZAPAK,ZPAK,ZPXP,ZPXPD,&
       & YLGEMSPROF,IDF,ZXPP,ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,YLGEMSPROF5)

      !*          4.5.11b GHG operators without averaging kernels
    ELSE

      !*           Call the CO2 tangent linear model
      IF (CLV(JVNM) =='CO2') THEN

        ZSOLEL(1:ILEN)  = SATHDR(1:ILEN,MDBRO3SOE)
        CALL CO2_TCMR_TL(KDLEN,ILEN,IMXCOUNT, ICOUNT, ZPRESH, ZPRESF, YLGEMSPROF, &
         &        ZPRESH5, ZPRESF5, ZSOLEL, YLGEMSPROF5, ZXPP)

      ENDIF

      !*           Call the CH4 tangent linear model
      IF (CLV(JVNM) =='CH4') THEN

        ZSOLEL(1:ILEN)  = SATHDR(1:ILEN,MDBRO3SOE)
        CALL CH4_TCMR_TL(KDLEN,ILEN,IMXCOUNT, ICOUNT, ZPRESH, ZPRESF, YLGEMSPROF, &
         &         ZPRESH5, ZPRESF5, ZSOLEL, YLGEMSPROF5, ZXPP)

      ENDIF

    ENDIF


    !*           4.6.10  Reactive gases
  ELSEIF (ANY(LLGRG)) THEN

    IF (LLNO2) THEN
      ! calc optical thicknes of clouds
      CALL COD_OP(KDLEN,ILEN,1,ZQF5, ZTF5, ZPRESH5, ZPRESF5, ZLS5,ZCLWF5,ZCIWF5,ZCOD5,ZTAUC5)

      CALL NOX2NO2(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),IOBSTYPE,ICOUNT,ZVPOBS,&
       & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,&
       & ZTF5,ZSOLEL,ZAL5,ZCOD5,ZTAUC5,ZCCF5,YLGEMSPROF5,&
       & ZNO25)

      ZPERT1(:,0)=0.0_JPRB
      ZPERT1(1:ILEN,1:NFLEVG)=ZTF(1:ILEN,1:NFLEVG)

      CALL NOX2NO2TL(KDLEN,ILEN,IMXCOUNT,ICOUNT,ZVPOBS,&
       & ZPXP,ZPXPD,&
       & ZPERT1,ZSOLEL,ZAL5,ZCOD5,ZTAUC5,ZCCF5,YLGEMSPROF,&
       & ZNO2,&
       & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZTF5,YLGEMSPROF5)

    ENDIF

    !*          4.5.11a GRG operators using averaging kernels
    IF (LL_AK) THEN
      IF (LLNO2) THEN
        CALL GRG_AK_TL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,&
         & IAK,ZWAK,ZPAK,ZPXP,ZPXPD,&
         & YLGEMSPROF,IDF,ZXPP,ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,YLGEMSPROF5)
      ELSE
        IF(LL_MOPITT) THEN
          CALL MOPITT_AK_TL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),IOBSTYPE,ICOUNT,&
           & IAK,ZWAK,ZAPAK,ZPAK,ZPRESH,ZPRESF,ZPXP,ZPXPD,&
           & YLGEMSPROF,IDF,ZXPP,ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,YLGEMSPROF5)
        ELSE
          CALL GRG_AK_TL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,&
           & IAK,ZWAK,ZPAK,ZPXP,ZPXPD,&
           & YLGEMSPROF,IDF,ZXPP,ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,YLGEMSPROF5,PNO2=ZNO2,PNO25=ZNO25)
        ENDIF
      ENDIF

      !*          4.5.11b GRG operators without averaging kernels
    ELSE

      IF (LLNO2) THEN
        CALL PPOBSATL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,ZVPOBS,ZOROG5,&
         & ZPXP,ZPXPD,ZUF,ZVF,ZTF,ZQF,ZO3F,&
         & ZCLWF,ZCIWF,ZCCF,ZTSTAR,ZT0,ZLNPR,ZALPH,&
         & IDF,ZXPP,&
         & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
         & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
         & YDGEMSPROF=YLGEMSPROF,YDGEMSPROF5=YLGEMSPROF5,PNO2=ZNO2,PNO25=ZNO25)

        !*          4.6.9b Upper air operators, lower level

        IF(LL_LAYER) THEN
          CALL PPOBSATL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,ZVPOBS_L,ZOROG5,&
           & ZPXP,ZPXPD,ZUF,ZVF,ZTF,ZQF,ZO3F,&
           & ZCLWF,ZCIWF,ZCCF,ZTSTAR,ZT0,ZLNPR,ZALPH,&
           & IDF-1,ZXPP(1,1,2),&
           & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
           & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
           & YDGEMSPROF=YLGEMSPROF,YDGEMSPROF5=YLGEMSPROF5,PNO2=ZNO2,PNO25=ZNO25)
        ENDIF

      ELSE
        CALL PPOBSATL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,ZVPOBS,ZOROG5,&
         & ZPXP,ZPXPD,ZUF,ZVF,ZTF,ZQF,ZO3F,&
         & ZCLWF,ZCIWF,ZCCF,ZTSTAR,ZT0,ZLNPR,ZALPH,&
         & IDF,ZXPP,&
         & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
         & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
         & YDGEMSPROF=YLGEMSPROF,YDGEMSPROF5=YLGEMSPROF5)

        !*          4.6.9b Upper air operators, lower level

        IF(LL_LAYER) THEN
          CALL PPOBSATL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,ZVPOBS_L,ZOROG5,&
           & ZPXP,ZPXPD,ZUF,ZVF,ZTF,ZQF,ZO3F,&
           & ZCLWF,ZCIWF,ZCCF,ZTSTAR,ZT0,ZLNPR,ZALPH,&
           & IDF-1,ZXPP(1,1,2),&
           & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
           & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
           & YDGEMSPROF=YLGEMSPROF,YDGEMSPROF5=YLGEMSPROF5)
        ENDIF
      ENDIF
    ENDIF

    !*          4.6.9b Upper air operators, lower level

    IF(LL_LAYER) THEN
      CALL PPOBSA(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),IOBSTYPE,ICOUNT,ZVPOBS_L,ZOROG5,&
       & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
       & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
       & IDF-1,ZXPP5(1,1,2),YDGEMSPROF5=YLGEMSPROF5)

      CALL PPOBSATL(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,ZVPOBS_L,ZOROG5,&
       & ZPXP,ZPXPD,ZUF,ZVF,ZTF,ZQF,ZO3F,&
       & ZCLWF,ZCIWF,ZCCF,ZTSTAR,ZT0,ZLNPR,ZALPH,&
       & IDF-1,ZXPP(1,1,2),&
       & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
       & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
       & YDGEMSPROF=YLGEMSPROF,YDGEMSPROF5=YLGEMSPROF5)
    ENDIF

    !*          4.6.1c Variational bias correction for GRG

    IF (LVARBC) THEN
      DO JOBS=1,ILEN
        IVISNIR(JOBS) = 0.0_JPRB
        ZLAT(JOBS)    = ROBHDR(JOBS,MDBLAT) * RDEGREES
        ZLON(JOBS)    = ROBHDR(JOBS,MDBLON) * RDEGREES
        IF (ZLON(JOBS)< 0.0) ZLON(JOBS) =ZLON(JOBS) + 360.0
      ENDDO
      ALLOCATE(ZXPPB(KDLEN,IMXCOUNT,1),ZXPRED(0:JPMXNPRED,ILEN), &
       & ZSOLAR(ILEN), &
       & ZOMF(KDLEN,IMXCOUNT),IXVARBC(KDLEN,IMXCOUNT))
      ZOMF(:,:)=RMDI
      DO JNLV=1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV > ICOUNT(JOBS)) CYCLE
          IBODY = MLNKH2B(JOBS) + (IPNLV(JOBS,JNLV)-1)
          ZOMF(JOBS,JNLV) = ROBODY(IBODY,MDBOMF)         
          IXVARBC(JOBS,JNLV) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
        ENDDO
      ENDDO
      DO JOBS= 1, ILEN
        ZZLAT   = ROBHDR(JOBS,MDBLAT) * RDEGREES
        ZZLON   = ROBHDR(JOBS,MDBLON) * RDEGREES
        IOBDATE = ROBHDR(JOBS,MDBDAT)
        IYEAR   = IOBDATE/10000
        IMONTH  = IOBDATE/100 - IYEAR*100
        IDAY    = IOBDATE - (IYEAR*10000+IMONTH*100)
        IOBTIME = ROBHDR(JOBS,MDBETM)
        IHOUR   = IOBTIME/10000
        CALL DIURNAL ( IMONTH, IDAY, IHOUR, ZZLAT, ZZLON, ZSOLAR(JOBS))
      ENDDO

      CALL VARBC_PRED_TO3 (ILEN, IMXCOUNT, ICOUNT(1:ILEN), IXVARBC(1:ILEN,:), &
        &  ZSOLAR, JPMXNPRED, ZXPRED, LSTATS=.FALSE.)

      CALL VARBC_BIASTL (IXVARBC, IMXCOUNT, ICOUNT, KDLEN, ILEN, &
       & JPMXNPRED, ZXPRED, IVISNIR, ZLAT, ZLON, ZOMF, ZXPPB(:,:,1))

      DO JNLV = 1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IF (LL_AK) THEN
            IF (ZXPP(JOBS,JNLV,1)/=RMDI) &
             & ZXPP(JOBS,JNLV,1) = ZXPP(JOBS,JNLV,1) + ZXPPB(JOBS,JNLV,1)
          ELSE
            IF (ZXPP(JOBS,JNLV,2)/=RMDI) &
             & ZXPP(JOBS,JNLV,2) = ZXPP(JOBS,JNLV,2) + ZXPPB(JOBS,JNLV,1)
          ENDIF
        ENDDO
      ENDDO
      DEALLOCATE(ZXPPB, ZXPRED, ZSOLAR, ZOMF, IXVARBC)
    ENDIF

    !*          4.5.9 GPS Atmospheric Path Delay
  ELSEIF(CLV(JVNM) == 'APD') THEN

    DO JOBS = 1,ILEN
      ZOBALT=ROBHDR(JOBS,MDBALT)
      IF(ZOBALT == RMDI .OR. ABS(ZOBALT) >  10000._JPRB) THEN
        ZORDIF(JOBS) = 0.0_JPRB
      ELSE
        ZORDIF(JOBS) = ZOROG5(JOBS)-ZOBALT*RG
      ENDIF
    ENDDO
    CALL PPPMERTL(KDLEN,1,ILEN,ZPRESH(1,NFLEVG),ZORDIF,ZTSTAR,ZT0,ZVPOBS5,&
     &             ZPRESH5(1,NFLEVG),ZTSTAR5,ZT05)
    CALL GPSZEN_DELAYTL(KDLEN,ILEN,IMXCOUNT,ICOUNT,&
     &                   ZPRESH,ZGEOPH,ZTF,ZQF,ZOROGOB,ZVPOBS5,&
     &                   IDF,ZXPP,&
     &                   ZPRESH5,ZGEOPH5,ZTF5,ZQF5,ZVPOBS)

    !*           4.5.10 Radar doppler wind
  ELSEIF(CLV(JVNM) == 'DOW') THEN
    CALL DOPPLSIM_TL(KDLEN,KDBDY,ILEN,IMXCOUNT,ICOUNT,IPNLV,ZUF,ZVF,&
     &   ZGEOPH5,IDF,ZXPP)

  ENDIF

  !*          4.7   Transfer PP-values to their location in ZHOFX

  DO JNLV=1,IMXCOUNT
    DO JOBS=1,ILEN
      IF(JNLV > ICOUNT(JOBS)) CYCLE
      IBDY=IPNLV(JOBS,JNLV)
      IBODY = MLNKH2B(JOBS)+(IBDY-1)

      IF(LL_WIND) THEN
        ZHOFX(JOBS,IBDY  )=ZXPP(JOBS,JNLV,1)
        ZHOFX(JOBS,IBDY+1)=ZXPP(JOBS,JNLV,2)
        IVAR( JOBS,IBDY+1)=IVAR(JOBS,IBDY)
      ELSEIF(LL_SPEED) THEN
        ZSPEED5 = SQRT(ZXPP5(JOBS,JNLV,1)**2+ZXPP5(JOBS,JNLV,2)**2)
        IF(ZSPEED5 < 1.E-10_JPRB) THEN
          ZHOFX(JOBS,IBDY) = 0.0_JPRB
        ELSE
          ZHOFX(JOBS,IBDY) = &
           & (ZXPP5(JOBS,JNLV,1)*ZXPP(JOBS,JNLV,1) + &
           & ZXPP5(JOBS,JNLV,2)*ZXPP(JOBS,JNLV,2)   )/ZSPEED5
        ENDIF
      ELSEIF(LL_HLS) THEN
        IBODY = MLNKH2B(JOBS)+(IBDY-1)
        ZAZIM=ROBODY(IBODY,MDB_AUX_AT_BODY(1))
        Zsin_azim=SIN(ZAZIM)
        Zcos_azim=COS(ZAZIM)
        ZHLS=-ZXPP(JOBS,JNLV,1)*Zsin_azim-ZXPP(JOBS,JNLV,2)*Zcos_azim
        ZHOFX(JOBS,IBDY)=ZHLS
      ELSEIF(LL_LAYER) THEN
        ZHOFX(JOBS,IBDY)=ZLAYL(JVNM,1)*ZXPP(JOBS,JNLV,1)&
         & +ZLAYL(JVNM,2)*ZXPP(JOBS,JNLV,2)
      ELSE
        ZHOFX(JOBS,IBDY)=ZXPP(JOBS,JNLV,1)
      ENDIF

    ENDDO
  ENDDO

  !*          4.8   DEALLOCATE

  DEALLOCATE(ZXPP,ZVPOBS,ZVPOBS_L,ZVPOBS5,ZORDIF,ZRCH,LLACTIVE,ZTAUC5,ZTAUC)
  IF(LL_RAD_OP) DEALLOCATE(ZEM,ZEM5,ZEMIS,ZEMIS5)
  DEALLOCATE(ZXPP5)
  IF(LLREO3) DEALLOCATE(IAK,ZPAK,ZWAK,ZAPAK)
  IF(ANY(LLGRG)) DEALLOCATE(ZCOD5)
  IF(LLNO2) DEALLOCATE(ZNO25,ZNO2)

ENDDO VNM_LOOP

IF(LLREO3) DEALLOCATE(ZSOLEL)

!     ------------------------------------------------------------------
!        5.       Departures (obs-model)
!                 ----------------------

!*          5.1 Compute and store the analysis sensitivity to observations

IF(LANOBS .AND. KSCAN == 1) THEN
  IF(NSSBGV_COUNT > 0 .OR. NSSHEV_COUNT > 0) THEN
    !OCL NOVREC
    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)
      JBODY = IBODY + 1 - MLNKH2B(JOBS)
      IF(ZHOFX(JOBS,JBODY) == RMDI .OR. IVNMRQ(JOBS,JBODY) == 0) CYCLE

      ZPERT2=0.0_JPRB
      ZPERT2=ZHOFX(JOBS,JBODY)**2

      IF(NSSBGV_COUNT == 1) THEN
        ROBODY(IBODY,MDBASO) = ZPERT2/NBGVECS
      ELSEIF(NSSBGV_COUNT > 1) THEN
        ROBODY(IBODY,MDBASO) = ROBODY(IBODY,MDBASO) + ZPERT2/NBGVECS
      ENDIF

      IF(NSSHEV_COUNT >= 1) THEN
        ROBODY(IBODY,MDBASO) = ROBODY(IBODY,MDBASO) - ZPERT2
        IF(NSSHEV_COUNT == NHEVECS) THEN
          ROBODY(IBODY,MDBASO)=ROBODY(IBODY,MDBASO)/(ROBODY(IBODY,MDBFOE)**2)
        ENDIF
      ENDIF

    ENDDO
  ENDIF
ENDIF

!* 5.1.1  Compute Forecast sensitivity to Observation: dJ=dJ/dy*dy


IF(LFCOBS) THEN
  write (NULOUT,*) 'arrived in HOPTL LFCOBS= ',LFCOBS
  DO JBODY=1,IMXBDY
    DO JOBS = 1,ILEN
      IF(JBODY > ICMBDY(JOBS)) CYCLE
      IF(ZHOFX(JOBS,JBODY) == RMDI .OR. IVNMRQ(JOBS,JBODY) == 0) CYCLE
      IBODY = MLNKH2B(JOBS)+(JBODY-1)

      ROBODY(IBODY,MDBFSO)=ZHOFX(JOBS,JBODY)/ROBODY(IBODY,MDBFOE)**2&
       &                   *ROBODY(IBODY,MDBOMF)
    ENDDO
  ENDDO
ENDIF

DO JOBS = 1,ILEN
    ZTIME = 0.0_JPRB
    IOBDATE= ROBHDR(JOBS,MDBDAT)
    IOBTIME= ROBHDR(JOBS,MDBETM)
    ITMO100 = IOBTIME / 100
    CALL TIMDIF(IOBDATE,ITMO100,ZTIME)
    IF (ZTIME<ZLEFTTM .OR. ZTIME>ZRIGHTM) THEN
      write(nulerr,*)'HOPTL: Time out of range'
      write(nulerr,*)'HOPTL: ztime,zleft,zright=',ZTIME,ZLEFTTM,ZRIGHTM
      write(nulerr,*)'HOPTL: IOBDATE,IOBTIME=',IOBDATE,IOBTIME
      INDXTIME(JOBS)=-999
      ZHOFX(JOBS,:)=RMDI
      CALL ABOR1('HOPTL: Time out of range')
    ELSE
      ZTIME=(ZTIME-ZLEFTTM)/(ZRIGHTM-ZLEFTTM)
      ZTIME=ZTIME * REAL(NPRTBINS,JPRB)
      ITIME=INT(ZTIME)+1
      IF (ITIME<1 .OR. ITIME>NPRTBINS+1) THEN
        write(nulerr,*)'HOPTL: Error itime=',ITIME,ZTIME,ZLEFTTM,ZRIGHTM
        write(nulerr,*)'HOPTL: IOBDATE,IOBTIME=',IOBDATE,IOBTIME
        CALL ABOR1('HOPTL: Error itime')
      ENDIF
      INDXTIME(JOBS)=MIN(NPRTBINS,ITIME)
    ENDIF
ENDDO
IF (KSCAN == 1) THEN
  IF (IOBSTYPE == NAIREP) THEN
    CALL HDEPART(KDLEN,ILEN,KDBDY,IMXBDY,IOBSTYPE,&
     & ICMBDY,IVNMRQ,ZHOFX)
  ELSE
    CALL HDEPART(KDLEN,ILEN,KDBDY,IMXBDY,ICDTYP_TOVS,&
     & ICMBDY,IVNMRQ,ZHOFX)
  ENDIF

  !*          5.1.2  Modify departure by mode based var bias correction
  IF ( LL_MODE ) THEN
    ICOUNT(:)=0
    DO JBODY=1,IMXBDY
      DO JOBS = 1,ILEN
        IF(IVNMRQ(JOBS,JBODY) == NVNUMB(50)) THEN  !BT count
          ICOUNT(JOBS)=ICOUNT(JOBS)+1
        ENDIF
      ENDDO
    ENDDO

    ALLOCATE( ZOMF(KDLEN,IMXBDY),IXVARBC(KDLEN,IMXBDY))
    ALLOCATE( ZBIAS_WK(KDLEN,IMXBDY) )
    ZOMF(:,:)=RMDI
    ZBIAS_WK(:,:)=RMDI
    DO JBODY=1,IMXBDY
      DO JOBS = 1,ILEN
        IIVNM=IVNMRQ(JOBS,JBODY)
        IF( IIVNM /= NVNUMB(50) ) CYCLE
        IF(JBODY > ICMBDY(JOBS) .OR. JBODY > ICOUNT(JOBS) ) CYCLE
        IBODY = MLNKH2B(JOBS)+(JBODY-1)
        ZOMF(JOBS,JBODY) = ROBODY(IBODY,MDBOMF)
        ZBIAS_WK(JOBS,JBODY) = ROBODY(IBODY,MDBTORB)
        IXVARBC(JOBS,JBODY) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
      ENDDO
    ENDDO
    ZWPD_MODE(:) = 0.0_JPRB
    DO JBODY=1,IMXBDY
      DO JOBS = 1,ILEN
        IIVNM=IVNMRQ(JOBS,JBODY)
        IF( IIVNM /= NVNUMB(50)) CYCLE
        IF(JBODY > ICMBDY(JOBS) .OR. JBODY > ICOUNT(JOBS) ) CYCLE
        IF (ZHOFX(JOBS,JBODY) == RMDI .OR. ZOMF(JOBS,JBODY) == RMDI ) CYCLE 
        ix = IXVARBC(JOBS,JBODY)
        IF (ix == 0) CYCLE
        IF( YVARBC(ix)%llmode ) THEN
          IF ( SUM(yvarbc(ix)%nhstfgdep(:)) /= 0 ) THEN
            ibin_max = maxval( yvarbc(ix)%nhstfgdep(:) )
            imax_loc = maxloc( yvarbc(ix)%nhstfgdep(:), dim=1 )
            imax_dist = imax_loc
            if (imax_dist > NHSTBINS/2)imax_dist = NHSTBINS - imax_dist
            ibinx=imax_dist - 1
            if (ibinx < 0) ibinx = 0
            ihist_sum=SUM(yvarbc(ix)%nhstfgdep(imax_loc-ibinx:imax_loc+ibinx)) 
            if ( imax_dist > 2 .AND. ihist_sum /= 0 ) then
              ZWPD_MODE(imax_loc) = REAL(ibin_max)/REAL(ihist_sum)
              DO JHIST = 1, imax_dist - 1  
                if(JHIST <= ibinx )then
                  I_nhist_avg_r = yvarbc(ix)%nhstfgdep(imax_loc + JHIST)
                  I_nhist_avg_l = yvarbc(ix)%nhstfgdep(imax_loc - JHIST)
                else
                  I_nhist_avg_r = 0
                  I_nhist_avg_l = 0
                endif
                ZWPD_MODE(imax_loc + JHIST) = REAL(I_nhist_avg_l)/REAL(ihist_sum)
                ZWPD_MODE(imax_loc - JHIST) = REAL(I_nhist_avg_r)/REAL(ihist_sum)
              ENDDO
            endif
          ENDIF
          IF ( ABS(ZOMF(JOBS,JBODY)) < YVARBC(ix)%DFGDEP) THEN
            ib = NINT(REAL(NHSTBINS)*(0.5 + ZOMF(JOBS,JBODY)/YVARBC(ix)%DFGDEP))
            ibd = NINT(REAL(NHSTBINS)*(ZBIAS_WK(JOBS,JBODY)/     &
            &                    YVARBC(ix)%DFGDEP))
          ELSE
            ib=0
          ENDIF
          IF ( ((ib>1).AND.(ib<NHSTBINS)) .AND.   &
          &    ((ib+ibd)>(imax_loc-ibinx).AND.(ib+ibd)<(imax_loc+ibinx)) .AND. &
          &     ZWPD_MODE(ib+ibd) >= 0.0_JPRB ) THEN
            zwpd = ZWPD_MODE(ib + ibd) * REAL(yvarbc(ix)%ncount)
            zwpd = SQRT(zwpd)
          ELSE
            zwpd =  0.0_JPRB
          ENDIF
          ZHOFX(JOBS,JBODY) = ZHOFX(JOBS,JBODY) * zwpd
        ENDIF
      ENDDO
    ENDDO
    DEALLOCATE(ZOMF, ZBIAS_WK, IXVARBC)
  ENDIF
  !*          5.1   LGCVJO, calculate Jo gradient for random departures

  IF(LGCVJO) THEN
    DO JOBS=1,ILEN
      CALL SETRAN(INT(ROBHDR(JOBS,MDBONM)),YL_RANDOM_STREAM)
      CALL UNIFORM_DISTRIBUTION (ZRANDOM(1:ICMBDY(JOBS)),YL_RANDOM_STREAM)

      WHERE (ZRANDOM(1:ICMBDY(JOBS)) > 0.5_JPRB)
        ZRANDOM(1:ICMBDY(JOBS)) =  1.0_JPRB
      ELSEWHERE
        ZRANDOM(1:ICMBDY(JOBS)) = -1.0_JPRB
      ENDWHERE

      WHERE (ZHOFX(JOBS,1:ICMBDY(JOBS)) /= RMDI)
        ZHOFX(JOBS,1:ICMBDY(JOBS)) = ZRANDOM(1:ICMBDY(JOBS))
      ENDWHERE
    ENDDO
  ENDIF


  !*         5.2 Correlated observations
  IF (LOBSCOR) THEN
    IF (NBCORBLK > 0) THEN
      ALLOCATE(IOBSCOR_COUNT(NBCORBLK))
      IOBSCOR_COUNT(1:NBCORBLK)=0
    ENDIF
    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)
      JBODY = IBODY + 1 - MLNKH2B(JOBS)
      IF (ZHOFX(JOBS,JBODY) == RMDI) CYCLE
      ROBODY(IBODY,MDBIOM0(NUPTRA+1))=ZHOFX(JOBS,JBODY)
      ROBODY(IBODY,MDB_AUX_AT_BODY(3))=ROBODY(IBODY,MDBFOE) ! save possibly inflated obs err
      IMASK=ROBODY(IBODY,MDB_OBSCORMASK_AT_ERRSTAT)
      IF (IMASK == NMDI) CYCLE
      IF (IMASK < 1 .OR. IMASK > NBCORBLK) CALL ABORTDB('HOPTL', 'IMASK OUT OF RANGE', IMASK)
      IOBSCOR_COUNT(IMASK)=IOBSCOR_COUNT(IMASK) + 1
    ENDDO
    DO JBLK=1,NBCORBLK
      CALL ALLOCATE_OBSCOR_AUX(OBSCOR_AUX(KSET,JBLK),IOBSCOR_COUNT(JBLK))
    ENDDO
    CALL HJO(KDLEN,KDBDY,KSET,ICMBDY,IOBSTYPE,ICDTYP,&
     & IVAR,IVNMRQ,ZHOFX,ISENSOR,INDXTIME,KSCAN) 
  ELSE
    CALL HJO(KDLEN,KDBDY,KSET,ICMBDY,IOBSTYPE,ICDTYP,&
     & IVAR,IVNMRQ,ZHOFX,ISENSOR,INDXTIME,KSCAN)
  ENDIF
ELSE

  !     ------------------------------------------------------------------
  !        6.       Cost function
  !                 -------------
  DO IBODY=1,MLNKH2B(ILEN+1)-1
    JOBS = MBODYJOBS(IBODY)
    JBODY = IBODY + 1 - MLNKH2B(JOBS)
    ZHOFX(JOBS,JBODY)=ROBODY(IBODY,MDBIOM0(NUPTRA+1))
    ROBODY(IBODY,MDBIOM0(NUPTRA+1))=RMDI
    ROBODY(IBODY,MDBFOE)=ROBODY(IBODY,MDB_AUX_AT_BODY(3)) ! restore possibly inflated final_obs_error
    !                                                           temporarily to read-only word MDBFOE
    ROBODY(IBODY,MDB_AUX_AT_BODY(3))=RMDI
  ENDDO

  CALL HJO(KDLEN,KDBDY,KSET,ICMBDY,IOBSTYPE,ICDTYP,&
   & IVAR,IVNMRQ,ZHOFX,ISENSOR,INDXTIME,KSCAN)
ENDIF !KSCAN

IF(ALLOCATED(IOBSCOR_COUNT))DEALLOCATE(IOBSCOR_COUNT)
!     ------------------------------------------------------------------

CALL PUTDB('HOPTL', NUPTRA, IRET, INFO, 0,ZINFO,0)

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