SUBROUTINE HOPAD(KDLEN,KDBDY,KSET,KHORIZ)

!**** *HOPAD* - 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* *HOPAD(KDLEN,KDBDY,KSET)*
!     WHERE KDLEN = First dimension: Max number of observations, this set
!           KDBDY= Second dimension: Max number of bodies, this set
!           KSET  = Number (numero) of the obs set to be treated (INPUT)
!           KHORIZ= Number of horizontal locations for 2D upper-air operators 

!        Also the contents of YOMMVO, YOMOBA, YOMOBSET are implicit
!     inputs.

!        HOPAD 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 found in the observation array are 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 adjoint 'forcing' is the gradient with respect to H(x). It is
!     kept in the array ZHOFX(:,:). ZHOFX has the same layout as IVNMRQ(:,:)
!     and ZVERTP(:,:). It is passed as input to the adjoints of the
!     PPOBSA-routines. The output is gradients with respect to model level
!     quantities. They are summed and stored in the GOM-arrays.

!**   EXTERNALS
!     ---------
!        HVNMTLT    - Translate varaible numbers tables
!        PREINT/AD  - Prepare interpolation
!        PREINTS/AD - Prepare interpolation, surface
!        PREINTR/AD - Prepare interpolation, radiances
!        QNEGLIM/TL - Ensure positive humidity
!        HINTH      - Get interpolation height
!        GRG_AK_OP/TL- Equivalents of observed values using averaging kernels
!        PPOBSA/AD  - Equivalents of observed values
!        PPOBSAS/AD - Equivalents of observed values, surface
!        PPOBSAZA   - Equivalents of observed values, surface pressure
!        HRADP/AD   - Radiance preparations
!        HRADP_ML/_AD  - Radiance preparations (for RTTOV-based interpolation)
!        RADTRAD    - Interface to radiative transfer code.
!        RADTR_ML_AD- Interface to radiative transfer code (RT on model levels)
!        MEANUV_WEIGHTS - Calculation of weights for AMV/SATOB obs operator
!        MEANUV_AVERAGEAD - Vertical integration 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
!     P. 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 : Variational bias correction
!     P.Burton        04/09/09 : Fix reproducibility of sat. bias correction
!     S. Healy        04/10/27 : Call for GPSRO operator
!     A. Benedetti    05/03/31 : Call for AEROD adjoint operator
!     N. Bormann      04/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        05/03/14 : Changes for 2d operators
!     N. Bormann      05/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
!     V. Guidard      07/02/23 : Modify Call RADTRAD (after A. Collard)
!     D. Tan          07/03/02 : Add HLoS wind, azimuth retrieved from Aux(1)@body
!     N. Bormann      07/11/14 : Make obs error adjustment in coastal areas consistent with TL
!     D. Tan          08/02/15 : Align HLoS with Meteo-France contributions to CY33
!     P. Bauer        08/01/03 : Add Envisat MERIS TCWV
!     N. Bormann      2007/11/15 : RTTOV-9
!     Y.Tremolet    22-Feb-2008 Obs space adjoint test
!     H. Hersbach     08/07/04 : Add ocean current and wave Charnock
!     A. Geer        03-Oct-2008 Pass solar 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 ADJOINT operator (AER_REFL_AD)
!     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  ,LVARBC  ,LTSCV
USE VARBC_SETUP,ONLY : YVARBC, NHSTBINS
USE VARBC_EVAL, ONLY : VARBC_BIASAD
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, LADJOBS, MOBSENS, FJOADJ, FJOADJB
USE YOMCOCTP , ONLY : NAIREP, NSATOB   ,NTEMP    ,NPILOT   ,&
 & NSSMI    ,NGTHRB   ,NTCWC  ,&
 & NSCATT   ,NSYNOP   ,NDRIBU  ,NPAOB    ,&
 & NSATEM   ,NSTRO3   ,NLIMB  
USE YOMLUN   , ONLY : NULERR, NULOUT
USE YOMANCS  , ONLY : RMDI     ,RDEGREES
USE YOMTVRAD , ONLY : RADPRE   ,&
 & MSENSOR_AIRS, LCO2_DIAG_AIRS,&
 & SATGRP_TABLE, SATOBGRP_TABLE, MXSENSOR, LRTTOV_INTERPOL,&
 & NSENSOR_MERIS, NSENSOR_MOPITT
USE YOMLIMB,   ONLY : Y_LIMBGRP_TABLE
USE GOMS_MIX   , ONLY :  SET_GOM,YGOMUA,YGOMS
USE YOMDB
USE TYPE_GEMS_PROFILES
USE YOM_YGFL , ONLY : NGHG,NGRG,YGHG_NL,YGRG_NL
USE YOMTS, ONLY : TSCVX
USE YOEPHY    ,ONLY : LEMWAVE, LERAIN
USE TESTVAR_MIX, ONLY: LTESTADJM
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 

!   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    :   Land/sea
!   ZAL5    :   Albedo
!   ZCI5    :   Sea-ice fraction
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZT0 ,ZTSTAR ,ZTS,ZU10N,ZV10N
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZT05,ZTSTAR5,ZTS5,ZOROG5,ZLS5,ZCI5,&
 &                                   ZU05,ZV05,ZU10N5,ZV10N5,ZCHN5,&
 &                                   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) ::       ZWS ,ZVEG ,ZWL ,ZSN ,ZZ0 ,ZZ0SCAT
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZSLM5,ZWS5,ZVEG5,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 ,           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/CRW/CSW/CGW 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 ,ZQN_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

REAL(KIND=JPRB), ALLOCATABLE :: ZQF5_REF(:,:)

!   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)
REAL(KIND=JPRB), DIMENSION(KDLEN,KDBDY) :: ZVERTP,ZVERTP_L,ZHOFX

!   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
!   IPNLV   : Pointer to locations in ZHOFX
!   INAK     : Number of averaging kernel elements
INTEGER(KIND=JPIM), DIMENSION(KDLEN,KDBDY) :: IVNMRQ,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
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.
!   ZXPPB   : Bias estimates for post-processed values
!   ZXPRED  : Bias predictor 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
REAL(KIND=JPRB), ALLOCATABLE :: ZXPP(:,:,:),ZXPPB(:,:,:),ZXPRED(:,:),ZVPOBS(:,:),ZVPOBS_L(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZPAK(:,:,:),ZWAK(:,:,:),ZAPAK(:,:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZCOD5(:),ZTAUC(:,:),ZTAUC5(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZXPP5(:,:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZEM (:,:),ZPS (:),ZT2M (:),ZQ2M (:), ZCTOP(:), ZCAMT(:),&
 & ZTQOPP (:,:,:),ZPRES(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZEM5(:,:),ZPS5(:),ZT2M5(:),ZQ2M5(:), ZCTOP5(:), ZCAMT5(:),&
 & ZTQOPP5(:,:,:),ZTPP5_REF(:,:),ZTS5_REF(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZOMF(:,:), ZBIAS_WK(:,:)

!   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
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,INFO(1),IRET,&
 & ICOEF,IPOSM,IP,IDF,IDFS,ISENSOR,ITSLOT,ISENSOR_GETDB,JGEMS,&
 & IABNOB
INTEGER(KIND=JPIM) :: JOBS,JBODY,JVNM,JNLV,JLEV,J0,IHOR,JGRG, JGHG
INTEGER(KIND=JPIM) :: IJB, JB1, JB2, JB3
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG) :: ZGRAX1
REAL(KIND=JPRB) :: Z500HPA,ZLAYL(JPMXVAR,2),ZCMALT,ZDEP,ZOBERR,ZSPEED5,ZDPU,ZDPV,&
 & ZDEP1,ZDEP2,ZDEP3,ZDEP4,ZJ1,ZJ2,ZJ1P,ZJ2P,ZJ,ZDJ1U,ZDJ1V,ZDJ2U,ZDJ2V
REAL(KIND=JPRB) :: ZAZIM,Zsin_azim,Zcos_azim,zobstest
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_MOPITT
LOGICAL, DIMENSION(NGHG) :: LLGHG
LOGICAL, DIMENSION(NGRG) :: LLGRG
REAL(KIND=JPRB) :: ZINFO(1)
REAL(KIND=JPRB), DIMENSION(KDLEN)    :: ZLAT,ZLON

! 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
!  Model GEMS fields at observation points, model levels
TYPE (TYPE_GEMSPROF), DIMENSION(KDLEN,NGEMS) :: YLGEMSPROF5
TYPE (TYPE_GEMSPROF), DIMENSION(KDLEN,NGEMS) :: YLGEMSPROF
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 :: ZNO25(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZNO2(:,:)
INTEGER(KIND=JPIM) :: JLEN
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

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

#include "abor1.intfb.h"
!#include "aer_refl_ad.intfb.h"
#include "aod_ad.intfb.h"
#include "ch4_tcmr_ad.intfb.h"
#include "co2_tcmr_ad.intfb.h"
#include "cod_op.intfb.h"
#include "cod_opad.intfb.h"
#include "ghg_ak_ad.intfb.h"
#include "diurnal.intfb.h"
#include "gpsro_ad.intfb.h"
#include "grg_ak_ad.intfb.h"
#include "gpsro_2dad.intfb.h"
#include "hinth.intfb.h"
#include "hqscatt.intfb.h"
#include "hradp.intfb.h"
#include "hradp_ml.intfb.h"
#include "hradpad.intfb.h"
#include "hradp_ml_ad.intfb.h"
#include "hvnmtlt.intfb.h"
#include "meanuv_averagead.intfb.h"
#include "meanuv_weights.intfb.h"
#include "mopitt_ak_ad.intfb.h"
#include "meanuv_weightsad.intfb.h"
#include "nox2no2.intfb.h"
#include "nox2no2ad.intfb.h"
#include "ppobsa.intfb.h"
#include "ppobsaad.intfb.h"
#include "ppobsac.intfb.h"
#include "ppobsacad.intfb.h"
#include "ppobsas.intfb.h"
#include "ppobsasad.intfb.h"
#include "ppobsaza.intfb.h"
#include "pppmerad.intfb.h"
#include "gpszen_delayad.intfb.h"
#include "preint.intfb.h"
#include "preintad.intfb.h"
#include "preint2d.intfb.h"
#include "preint2dad.intfb.h"
#include "preintr.intfb.h"
#include "preintrad.intfb.h"
#include "preints.intfb.h"
#include "preintsad.intfb.h"
#include "qneglim.intfb.h"
#include "qneglimtl.intfb.h"
#include "radtrad.intfb.h"
#include "radtr_ml_ad.intfb.h"
#include "rtl_hop_1d_ad.intfb.h"
#include "rtl_hop_2d_ad.intfb.h"
#include "dopplsim_ad.intfb.h"
#include "ngedsta.intfb.h"
#include "fcobs.h"

#include "openmp_obs.h"
!*
!     ------------------------------------------------------------------
!*

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

!*          1.1   Set length (=number of observations)

IF (LHOOK) CALL DR_HOOK('HOPAD',0,ZHOOK_HANDLE)
!write(nulout,'('' ENTER HOPAD '')')
!CALL FLUSH(nulout)
ILEN   = MLNSET(KSET)
ITSLOT = MTSLSET(KSET)

DO JGEMS=1,NGEMS
  DO JLEN=1,KDLEN
    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.
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 HOPAD: ISENSOR=',ISENSOR,&
   & ' OUT OF RANGE FOR KSET,IOBSTYPE,IGRP,ITSLOT=',&
   & KSET,IOBSTYPE,IGRP,ITSLOT
  CALL ABORTDB('HOPAD', 'ISENSOR OUT OF RANGE', ISENSOR)
ENDIF

!*          1.3   Initialize ODB

CALL GETDB('HOPAD', 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('HOPAD', 'INCONSISTENCIES FROM GETDB', IRET)
ENDIF

!*          1.4   Other

Z500HPA=50000._JPRB
ZZ0SCAT(1:ILEN)=0.0_JPRB
ZQF5(:,:)=0.0_JPRB
ZTS5(:)=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 FJO-tables and PPOBSA-variable codes.

CALL HVNMTLT(JPMXVAR,CLV,IVARL,ZLAYL)

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

!*          2.1   Upper-air, always required

IF (KHORIZ > 1) THEN 

  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)  

ELSE

  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)  

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)

!*          2.3   Radiance, and make q positive.

IF(LL_RAD_OP) THEN
  CALL PREINTR(KDLEN,ILEN,KSET,ZLS5,ZCI5,ZAL5,ZTS5,ZWS5,ZSN5)
  ALLOCATE(ZQF5_REF(KDLEN,0:NFLEVG))
  ZQF5_REF(:,:) = ZQF5(:,:)
  CALL QNEGLIM(ZQF5(1,1),1,KDLEN,1,NFLEVG,1,ILEN,1,NFLEVG)
ENDIF

!*          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.

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.1.1  Retrieve and adjust emissivities and observations
!                  errors to avoid mismatch between preset emissivities 
!                  and land/sea flag (in coastal areas). 
IF(LLRAD1C)THEN
  ICOUNT(:)=0
  DO IBODY=1,MLNKH2B(ILEN+1)-1
    JOBS = MBODYJOBS(IBODY)
    JBODY = IBODY + 1 - MLNKH2B(JOBS)
    IF(ROBODY(IBODY,MDBVNM) == NVNUMB(50)) THEN
      ICOUNT(JOBS)=ICOUNT(JOBS)+1
      IPNLV(JOBS,ICOUNT(JOBS))=JBODY
    ENDIF
  ENDDO
  IMXCOUNT=MAXVAL(ICOUNT(1:ILEN))

  ALLOCATE(ZEM (KDLEN,IMXCOUNT))
  ZEM (1:ILEN,:)=0.0_JPRB
  ALLOCATE(ZEM5(KDLEN,IMXCOUNT))
  ZEM5(1:ILEN,:)=1.0_JPRB

  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_JPRB
          ROBODY(JB3,MDBFOE) = 999.0_JPRB
        ENDIF
      ENDIF
    ENDDO
  ENDDO
ENDIF

!*          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
ZHOFX(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)
  ZVERTP(JOBS,JBODY)  = ROBODY(IBODY,MDBPPP)
  ZVERTP_L(JOBS,JBODY)= ROBODY(IBODY,MDBPRL)


  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

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

  !*          3.2.1 ZHOFX to contain gradient with respect to H(x)

  ZDEP = ROBODY(IBODY,MDBIOM0(NUPTRA+1))
  ZOBERR=ROBODY(IBODY,MDBFOE)

  IF (ZDEP==RMDI.OR.ZOBERR==RMDI) THEN
    ZHOFX(JOBS,JBODY) = RMDI
  ELSE
    IF (LTESTADJM) THEN
      ZHOFX(JOBS,JBODY) = 0.0_JPRB
    ELSE
      ZHOFX(JOBS,JBODY) = -ZDEP/ZOBERR
    ENDIF
  ENDIF

  ! minus signs below because we want ZDEP/ZOBERR ie -ZHOFX
  IF (LADJOBS) THEN
    !   Save R^{-1}.H
    ROBODY(IBODY,MDB_OBS_DIAGS(MOBSENS,NUPTRA+1)) = -ZHOFX(JOBS,JBODY)

    !   Obs space scalar product for adjoint test
    IF (ZHOFX(JOBS,JBODY)/=RMDI) THEN
      IABNOB = ROBHDR(JOBS,MDB_ABNOB_AT_INDEX)
      ZOBSTEST = ROBODY(IBODY,MDBIFC1(NUPTRA+1))
      FJOADJ(IABNOB) = FJOADJ(IABNOB) - ZHOFX(JOBS,JBODY) * ZOBSTEST
      IF (MOBSENS>1) THEN
        ZOBSTEST = ROBODY(IBODY,MDB_OBS_DIAGS(1,NUPTRA+1))
        IF (ZOBSTEST/=RMDI) THEN
          FJOADJB(IABNOB) = FJOADJB(IABNOB) + ZHOFX(JOBS,JBODY) * ZOBSTEST
        ENDIF
      ENDIF
    ENDIF
  ENDIF

  !*          1.7   Add Jo to the actual JO-table

  !*          3.2.2 Reset the MDBIOM0-word to RMDI, as we only borrowed it

  ROBODY(IBODY,MDBIOM0(NUPTRA+1)) = RMDI

ENDDO NEW_BODY_LOOP

!*          3.2.3  Modify departure by mode 
IF ( LVARBC ) THEN
  ICOUNT(:)=0
  DO IBODY=1,MLNKH2B(ILEN+1)-1
    JOBS = MBODYJOBS(IBODY)
    JBODY = IBODY + 1 - MLNKH2B(JOBS)
    IF(IVNMRQ(JOBS,JBODY) == NVNUMB(50)) THEN 
      ICOUNT(JOBS)=ICOUNT(JOBS)+1
      IPNLV(JOBS,ICOUNT(JOBS))=JBODY
    ENDIF
  ENDDO
  IMXCOUNT=MAXVAL(ICOUNT(1:ILEN))

  ALLOCATE( ZOMF(KDLEN,IMXBDY),IXVARBC(KDLEN,IMXBDY))
  ALLOCATE( ZBIAS_WK(KDLEN,IMXBDY) )
  ZOMF(:,:)=RMDI
  ZBIAS_WK(:,:)=RMDI
  DO JNLV=1,IMXCOUNT
    DO JOBS = 1,ILEN
      IIVNM=IVNMRQ(JOBS,JNLV)
      IF( IIVNM /= NVNUMB(50) ) CYCLE
      IF( JNLV > ICOUNT(JOBS) ) CYCLE
      IBODY = MLNKH2B(JOBS) + (IPNLV(JOBS,JNLV)-1)
      ZOMF(JOBS,JNLV) = ROBODY(IBODY,MDBOMF)
      ZBIAS_WK(JOBS,JNLV)=ROBODY(IBODY,MDBTORB)
      IXVARBC(JOBS,JNLV) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
    ENDDO
  ENDDO
  ZWPD_MODE(:) = 0.0_JPRB
  DO JNLV=1,IMXCOUNT
    DO JOBS = 1,ILEN
      IIVNM=IVNMRQ(JOBS,JNLV)
      IF( IIVNM /= NVNUMB(50)) CYCLE
      IF( JNLV > ICOUNT(JOBS) ) CYCLE
      IF (ZHOFX(JOBS,JNLV) == RMDI .OR. ZOMF(JOBS,JNLV) == RMDI ) CYCLE 
      ix = IXVARBC(JOBS,JNLV)
      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,JNLV)) < YVARBC(ix)%DFGDEP) THEN
           ib = NINT(REAL(NHSTBINS)*(0.5 + ZOMF(JOBS,JNLV)/YVARBC(ix)%DFGDEP))
           ibd = NINT(REAL(NHSTBINS)*(ZBIAS_WK(JOBS,JNLV)/     &
           &                               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,JNLV) = ZHOFX(JOBS,JNLV) * zwpd
      ENDIF
    ENDDO
  ENDDO
  DEALLOCATE(ZOMF, ZBIAS_WK, IXVARBC)
ENDIF

!*          3.5   Surface wind data

IF(LL_SFC_OP) CALL HINTH(KDLEN,ILEN,KDBDY,IMXBDY,ICMBDY,IOBSTYPE,&
 & ZAPHI5(1,NFLEVG),ZINTHUV,IVNMRQ)

!*          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) THEN
  IF(LQSCATT) THEN
    CALL HQSCATT(KDLEN,ILEN,KDBDY,IMXBDY,ICMBDY,IOBSTYPE,IVNMRQ)
  ELSE
    IP=4
    !OCL NOVREC
    DO JOBS=1,ILEN
      IF(ICMBDY(JOBS) < 4) CYCLE
      IBODY = MLNKH2B(JOBS)

      ZDEP1=ROBODY(IBODY  ,MDBOMN)/ROBODY(IBODY  ,MDBFOE)
      ZDEP2=ROBODY(IBODY+1,MDBOMN)/ROBODY(IBODY+1,MDBFOE)
      ZDEP3=ROBODY(IBODY+2,MDBOMN)/ROBODY(IBODY+2,MDBFOE)
      ZDEP4=ROBODY(IBODY+3,MDBOMN)/ROBODY(IBODY+3,MDBFOE)
      ZJ1 = ZDEP1**2 + ZDEP2**2
      ZJ2 = ZDEP3**2 + ZDEP4**2
      ZJ1P= ZJ1**IP
      ZJ2P= ZJ2**IP
      ZJ=((ZJ1P*ZJ2P)/(ZJ1P+ZJ2P))

      ZDJ1U=ZJ1**(IP-1)*ZHOFX(JOBS,1)
      ZDJ1V=ZJ1**(IP-1)*ZHOFX(JOBS,2)
      ZDJ2U=ZJ2**(IP-1)*ZHOFX(JOBS,3)
      ZDJ2V=ZJ2**(IP-1)*ZHOFX(JOBS,4)

      ZDPU=( (ZDJ1U*ZJ2P+ZJ1P*ZDJ2U)*(ZJ1P+ZJ2P)-&
       & (ZDJ1U+ZDJ2U)*(ZJ1P*ZJ2P) )/((ZJ1P+ZJ2P)**2)
      ZDPV=( (ZDJ1V*ZJ2P+ZJ1P*ZDJ2V)*(ZJ1P+ZJ2P)-&
       & (ZDJ1V+ZDJ2V)*(ZJ1P*ZJ2P) )/((ZJ1P+ZJ2P)**2)
      ZHOFX(JOBS,1) = ZJ**((1.0_JPRB-IP)/IP) * ZDPU
      ZHOFX(JOBS,2) = ZJ**((1.0_JPRB-IP)/IP) * ZDPV
      ! -- These will not be used
      ZHOFX(JOBS,3) = 0.0_JPRB
      ZHOFX(JOBS,4) = 0.0_JPRB
      IVNMRQ(JOBS,3) = 0
      IVNMRQ(JOBS,4) = 0
    ENDDO
  ENDIF
ENDIF

!*
!     ------------------------------------------------------------------

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

!*          4.0   Preset gradients to zero

DO JOBS=1,ILEN
  ZPRESH(JOBS,0)=0.0_JPRB
  ZGEOPH(JOBS,0)=0.0_JPRB
  ZTSTAR(JOBS)=0.0_JPRB
  ZBN   (JOBS)=0.0_JPRB
  ZBH   (JOBS)=0.0_JPRB
  ZBM   (JOBS)=0.0_JPRB
  ZT0   (JOBS)=0.0_JPRB
  ZTS   (JOBS)=0.0_JPRB
  ZCPTGZ(JOBS)=0.0_JPRB
  ZCPTS (JOBS)=0.0_JPRB
  ZWS   (JOBS)=0.0_JPRB
  ZVEG  (JOBS)=0.0_JPRB
  ZWL   (JOBS)=0.0_JPRB
  ZSN   (JOBS)=0.0_JPRB
  ZZ0   (JOBS)=0.0_JPRB
  ZU10N (JOBS)=0.0_JPRB
  ZV10N (JOBS)=0.0_JPRB
ENDDO

DO IHOR=1,KHORIZ
  DO JOBS=1,ILEN
    ZPRESH_2D(JOBS,0,IHOR)=0.0_JPRB
    ZGEOPH_2D(JOBS,0,IHOR)=0.0_JPRB
    ZTSTAR_2D  (JOBS,IHOR)=0.0_JPRB
    ZT0_2D     (JOBS,IHOR)=0.0_JPRB
  ENDDO
ENDDO

DO JLEV=1,NFLEVG
  DO JOBS=1,ILEN
    ZUF     (JOBS,JLEV)=0.0_JPRB
    ZVF     (JOBS,JLEV)=0.0_JPRB
    ZTF     (JOBS,JLEV)=0.0_JPRB
    ZQF     (JOBS,JLEV)=0.0_JPRB
    ZQN     (JOBS,JLEV)=0.0_JPRB
    ZO3F    (JOBS,JLEV)=0.0_JPRB
    ZCLWF   (JOBS,JLEV)=0.0_JPRB
    ZCIWF   (JOBS,JLEV)=0.0_JPRB
    ZCCF    (JOBS,JLEV)=0.0_JPRB
    ZAPHI   (JOBS,JLEV)=0.0_JPRB
    ZPRESH  (JOBS,JLEV)=0.0_JPRB
    ZPRESF  (JOBS,JLEV)=0.0_JPRB
    ZGEOPH  (JOBS,JLEV)=0.0_JPRB
    ZGEOPF  (JOBS,JLEV)=0.0_JPRB
    ZALPH   (JOBS,JLEV)=0.0_JPRB
    ZLNPR   (JOBS,JLEV)=0.0_JPRB
    ZDELP   (JOBS,JLEV)=0.0_JPRB
    ZRDELP  (JOBS,JLEV)=0.0_JPRB
    ZRTGR   (JOBS,JLEV)=0.0_JPRB
    ZRPRE   (JOBS,JLEV)=0.0_JPRB
    ZRPP    (JOBS,JLEV)=0.0_JPRB
    ZCP     (JOBS,JLEV)=0.0_JPRB
    ZRF     (JOBS,JLEV)=0.0_JPRB
    ZKAP    (JOBS,JLEV)=0.0_JPRB
    DO JGEMS=1,NGEMS
      YLGEMSPROF(JOBS,JGEMS)%MODELPROF(JLEV)=0.0_JPRB
    ENDDO
  ENDDO
ENDDO

DO IHOR=1,KHORIZ
  DO JLEV=1,NFLEVG
    DO JOBS=1,ILEN
      ZUF_2D     (JOBS,JLEV,IHOR)=0.0_JPRB
      ZVF_2D     (JOBS,JLEV,IHOR)=0.0_JPRB
      ZTF_2D     (JOBS,JLEV,IHOR)=0.0_JPRB
      ZQF_2D     (JOBS,JLEV,IHOR)=0.0_JPRB
      ZQN_2D     (JOBS,JLEV,IHOR)=0.0_JPRB
      ZO3F_2D    (JOBS,JLEV,IHOR)=0.0_JPRB
      ZCLWF_2D   (JOBS,JLEV,IHOR)=0.0_JPRB
      ZCIWF_2D   (JOBS,JLEV,IHOR)=0.0_JPRB
      ZCCF_2D    (JOBS,JLEV,IHOR)=0.0_JPRB
      ZPRESH_2D  (JOBS,JLEV,IHOR)=0.0_JPRB
      ZPRESF_2D  (JOBS,JLEV,IHOR)=0.0_JPRB
      ZGEOPH_2D  (JOBS,JLEV,IHOR)=0.0_JPRB
      ZGEOPF_2D  (JOBS,JLEV,IHOR)=0.0_JPRB
      ZALPH_2D   (JOBS,JLEV,IHOR)=0.0_JPRB
      ZLNPR_2D   (JOBS,JLEV,IHOR)=0.0_JPRB
      ZDELP_2D   (JOBS,JLEV,IHOR)=0.0_JPRB
      ZRDELP_2D  (JOBS,JLEV,IHOR)=0.0_JPRB
      ZRTGR_2D   (JOBS,JLEV,IHOR)=0.0_JPRB
      ZRPRE_2D   (JOBS,JLEV,IHOR)=0.0_JPRB
      ZRPP_2D    (JOBS,JLEV,IHOR)=0.0_JPRB
      ZCP_2D     (JOBS,JLEV,IHOR)=0.0_JPRB
      ZRF_2D     (JOBS,JLEV,IHOR)=0.0_JPRB
      ZKAP_2D    (JOBS,JLEV,IHOR)=0.0_JPRB
    ENDDO
  ENDDO
ENDDO

DO J0=1,NPPM
  DO JLEV=0,NFLEVG
    DO JOBS=1,ILEN
      ZPXP (JOBS,JLEV,J0)=0.0_JPRB
      ZPXPD(JOBS,JLEV,J0)=0.0_JPRB
      ZPXZ (JOBS,JLEV,J0)=0.0_JPRB
      ZPXZD(JOBS,JLEV,J0)=0.0_JPRB
    ENDDO
  ENDDO
ENDDO

DO IHOR=1,KHORIZ
  DO J0=1,NPPM
    DO JLEV=0,NFLEVG
      DO JOBS=1,ILEN
        ZPXP_2D (JOBS,JLEV,J0,IHOR)=0.0_JPRB
        ZPXPD_2D(JOBS,JLEV,J0,IHOR)=0.0_JPRB
        ZPXZ_2D (JOBS,JLEV,J0,IHOR)=0.0_JPRB
        ZPXZD_2D(JOBS,JLEV,J0,IHOR)=0.0_JPRB
      ENDDO
    ENDDO
  ENDDO
ENDDO

!*          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) CYCLE VNM_LOOP
  ! 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 posotions in the volume JOBS*JBODY which
  !                 contain IIVNM, and count

  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
    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')

  !*          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)

  !*          4.5.1 Allocate with length IMXCOUNT

  IDF=2
  ALLOCATE(ZXPP(KDLEN,IMXCOUNT,IDF))
  ZXPP(:,:,:)=0.0_JPRB
  ALLOCATE(ZXPP5(KDLEN,IMXCOUNT,IDF))
  ALLOCATE(ZVPOBS(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))
  ALLOCATE(ZTAUC5(KDLEN,NFLEVG))
  ALLOCATE(ZTAUC(KDLEN,NFLEVG))
  ZTAUC(:,:)=0.0_JPRB
  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

  !*          4.5.2 Contract from 'bodies' to 'levels'. Set emissivity.

  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

  !*          4.5.3 Some non-linear operators require PP5

  IF(LL_NONLINEAR) THEN
    IF(LL_WIND .OR. LL_SPEED) THEN
      ZINTH(1:ILEN)=ZINTHUV(1:ILEN)
    ELSE
      ZINTH(1:ILEN)=2.0_JPRB*RG
    ENDIF
    !   ZXPP5 to contain ZRH2M5, needed as H2-operator is non-linear.
    IF(.NOT.LCACHMT) THEN
      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)
    ELSE
      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)  
    ENDIF
  ENDIF

  !*          4.6   Transfer PP-values to their location in ZHOFX-Adjoint

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

  !*          4.5   Call the appropriate PPOBSA routine

  !*          4.5.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

    !*          4.5.2 Bias correction - adjoint
    !*          4.5.2b 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

      ZXPPB(:,:,:) = 0.0_JPRB
      DO JNLV = 1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IF (ZXPP(JOBS,JNLV,1)/=RMDI ) &
           & ZXPPB(JOBS,JNLV,1) = ZXPPB(JOBS,JNLV,1) + ZXPP(JOBS,JNLV,1)
        ENDDO
      ENDDO
!
      CALL VARBC_PRED_AIREP (ILEN, IMXCOUNT, ICOUNT(1:ILEN), IXVARBC(1:ILEN,:), &
        &  JPMXNPRED, ZXPRED, LSTATS=.FALSE.)

      CALL VARBC_BIASAD (KSET, IXVARBC, IMXCOUNT, ICOUNT, KDLEN, ILEN, &
       & JPMXNPRED, ZXPRED, IVISNIR, ZLAT, ZLON, ZOMF, ZXPPB(:,:,1))
!
      DEALLOCATE(ZXPPB, ZXPRED, ZOMF, IXVARBC)
    ENDIF

    !*          4.5.2b 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

      ZXPPB(:,:,:) = 0.0_JPRB
      DO JNLV = 1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IF (ZXPP(JOBS,JNLV,2)/=RMDI ) &
           & ZXPPB(JOBS,JNLV,1) = ZXPPB(JOBS,JNLV,1) + ZXPP(JOBS,JNLV,2)
        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_BIASAD (KSET, IXVARBC, IMXCOUNT, ICOUNT, KDLEN, ILEN, &
       & JPMXNPRED, ZXPRED, IVISNIR, ZLAT, ZLON, ZOMF, ZXPPB(:,:,1))

      DEALLOCATE(ZXPPB, ZXPRED, ZOMF, IXVARBC)
    ENDIF

    !*          4.5.2c 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
      ZXPPB(:,:,:) = 0.0_JPRB
      DO JNLV = 1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IF (ZXPP(JOBS,JNLV,2)/=RMDI ) &
           & ZXPPB(JOBS,JNLV,1) = ZXPPB(JOBS,JNLV,1) + ZXPP(JOBS,JNLV,2)
        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_BIASAD (KSET, IXVARBC, IMXCOUNT, ICOUNT, KDLEN, ILEN, &
       & JPMXNPRED, ZXPRED, IVISNIR, ZLAT, ZLON, ZOMF, ZXPPB(:,:,1))

      DEALLOCATE(ZXPPB, ZXPRED, ZSOLAR, ZOMF, IXVARBC)
    ENDIF



    CALL PPOBSAAD(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),IOBSTYPE,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,&
     &  ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5)

    !*          4.5.1b Upper air operators, lower level

    IF(LL_LAYER) CALL PPOBSAAD(KDLEN,ILEN,&
     & IMXCOUNT,CLV(JVNM),IOBSTYPE,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,&
     & ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5)

    !*          4.5.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('HOPAD: PPOBSAS requires LL_SFC_OP=.T.')
    IF(.NOT.LCACHMT) THEN
      CALL PPOBSASAD(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,&
       & ZAPHI5,ZCPTGZ5,ZCPTS5,ZXPP5,ZES5,&
       & ZRI5,ZBN5,ZBM5,ZBH5)
    ELSE
      CALL PPOBSACAD(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.5.3 Surface pressure, with height as vertical coordinate
    !                 ZVPOBS is height

  ELSEIF(CLV(JVNM) == 'PS') THEN
    LLEXTLI=.FALSE.
    ISLCT=1
    CALL PPOBSAZA(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.5.5 Radiances

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

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

    IF(.NOT.LL_RAD_OP) CALL ABOR1('HOPAD: 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(ZTPP5_REF(KDLEN,NLSAT))
    ALLOCATE(ZTS5_REF(KDLEN))

    DO JGEMS=1,NGEMS
      DO JLEV=1,NLSAT
        DO JOBS=1,ILEN
          YLGEMSPROF (JOBS,JGEMS)%RTTOVPROF(JLEV)=0.0_JPRB
          YLGEMSPROF5(JOBS,JGEMS)%RTTOVPROF(JLEV)=0.0_JPRB
        ENDDO
      ENDDO
    ENDDO
    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
    ZPS(:) = 0.0_JPRB
    ZT2M(:)= 0.0_JPRB
    ZQ2M(:)= 0.0_JPRB
    ZCTOP(:)= 0.0_JPRB
    ZCAMT(:)= 0.0_JPRB
    ZTS5_REF(:)=ZTS5(:)

    IF( LRTTOV_INTERPOL )THEN

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

      CALL HRADP_ML(4,KDLEN,ILEN,KSET,ZNVANG,ZZEANG,ICOEF,&
       & ZPRESH5,ZTF5,ZQF5,&
       & ZLS5,ZCI5,ZPS5,ZTS5,ZT2M5,ZQ2M5,ZCTOP5,ZCAMT5)  

    ELSE

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

      ICOUNTX(1:ILEN)=NLSAT

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

      ZTQOPP(:,:,:) = 0.0_JPRB
      ZTQOPP5(:,:,:)= 0.0_JPRB

      !     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)

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

      ZTPP5_REF(:,:)=ZTQOPP5(:,:,1)
      CALL HRADP(4,KDLEN,ILEN,IDFS,KSET,ZOROG5,ZOROGOB,ZNVANG,ZZEANG,ICOEF,&
       & ZPRESH5,ZPRESF5,ZTF5,ZTSTAR5,ZT05,ZTQOPP5,&
       & ZLS5,ZCI5,ZPS5,ZTS5,ZT2M5,ZQ2M5,ZCTOP5,ZCAMT5)
    ENDIF

    !*          4.5.5d Bias correction - adjoint

    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)
        ENDDO
      ENDDO
      ZXPPB(:,:,:) = 0.0_JPRB
      DO JNLV = 1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IF (ZXPP(JOBS,JNLV,1)/=RMDI ) &
           & ZXPPB(JOBS,JNLV,1) = ZXPPB(JOBS,JNLV,1) + ZXPP(JOBS,JNLV,1)
        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_BIASAD (KSET, IXVARBC, IMXCOUNT, ICOUNT, KDLEN, ILEN, &
       & JPMXNPRED, ZXPRED, IVISNIR, ZLAT, ZLON, ZOMF, ZXPPB(:,:,1))

      DEALLOCATE(ZXPPB, ZXPRED, ZOMF, IXVARBC)
    ENDIF

    !*          4.5.5e Call radiative transfer model, RTTOV5-Adjoint

    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
            SATBODY(IBODY,MDB_TBVALUEAD)= ZXPP(JOBS,JNLV,1)
          ENDIF
        ENDDO
      ENDDO
    ELSE    
      ! Do not compute TL/AD of the radiative transfert for passive data !
      ICOUNTA(:) = 0                                                   !
      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                            !
          ! Overwrite arrays for non-passive channels only             !
          ZVPOBS(JOBS,ICOUNTA(JOBS)) = ZVPOBS(JOBS,JNLV)               !
          ZXPP(JOBS,ICOUNTA(JOBS),1) = ZXPP(JOBS,JNLV,1)               !
          ZEM(JOBS,ICOUNTA(JOBS))    = ZEM(JOBS,JNLV)                  !
          ZEM5(JOBS,ICOUNTA(JOBS))   = ZEM5(JOBS,JNLV)                 !
        ENDDO                                                          !
      ENDDO                                                            !
      !------------------------------------------------------------------!

      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( LRTTOV_INTERPOL )THEN
        CALL RADTR_ML_AD(ICOEF,ISENSOR,KDLEN,ILEN,IMXCOUNT,ICOUNTA,ZVPOBS,&
         & 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),ZEM,&
         & ZPRESF5,ZTF5,ZQF5,ZO3F5,ZCLWF5,ZCIWF5,ZCCF5,YLGEMSPROF5,&
         & ZPS5,ZTS5,ZLS5,ZT2M5,ZQ2M5,ZCTOP5,ZCAMT5,ZUF5(1,NFLEVG),ZVF5(1,NFLEVG),ZEM5,&
         & ZXPP)  
      ELSE
        CALL RADTRAD(ICOEF,ISENSOR,KDLEN,ILEN,IMXCOUNT,ICOUNTA,ZVPOBS,  &
         & ZZEANG,ZAZIANG,ZSOLZENANG,ZSOLAZIANG,ZLAT,ZOROG5,            &
         & ZTQOPP, YLGEMSPROF,ZPS, ZTS,ZT2M, ZQ2M,ZCTOP,ZCAMT,          &
         & ZUF (1,NFLEVG),ZVF(1,NFLEVG),ZEM,                            &
         & ZTQOPP5,YLGEMSPROF5,ZPS5,ZTS5,ZLS5,ZT2M5,                    &
         & ZQ2M5,ZCTOP5,ZCAMT5,ZUF5(1,NFLEVG),ZVF5(1,NFLEVG),ZEM5,ZXPP)
      ENDIF
    ENDIF

    IF( LRTTOV_INTERPOL )THEN

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

      CALL HRADP_ML_AD(KDLEN,ILEN,KSET,&
       & ZPRESH,ZTF,ZQF,&
       & ZPS,ZTS,ZT2M,ZQ2M,ZCTOP,ZCAMT,&
       & ZTS5,ZTS5_REF)  

    ELSE

      !*          4.5.5g Various radiance preparations - Adjoint

      CALL HRADPAD(KDLEN,ILEN,KSET,ZOROG5,ZOROGOB,&
       & ZPRESH ,ZTF ,ZTSTAR ,ZT0 ,ZTQOPP,&
       & ZPS ,ZTS ,ZT2M ,ZQ2M ,ZCTOP,ZCAMT,&
       & ZPRESH5,ZPRESF5,ZTSTAR5,ZT05,ZTQOPP5,&
       & ZPS5,ZTS5,ZT2M5,ZQ2M5,ZCTOP5,ZCAMT5,ZTPP5_REF,ZTS5_REF)

      !*          4.5.5h Interpolate T, q and O3 to fix pressure levels - Adjoint

      CALL PPOBSAAD(KDLEN,ILEN,NLSAT,'TV1',IOBSTYPE,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,&
       & ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
       & YDGEMSPROF=YLGEMSPROF,YDGEMSPROF5=YLGEMSPROF5)

      !*          4.5.5h Deallocate radiance arrays

      DEALLOCATE(ZPRES,ZTQOPP,ZTQOPP5)
    ENDIF

    DEALLOCATE(ZPS,ZT2M,ZQ2M,ZCTOP,ZCAMT,ZPS5,ZT2M5,ZQ2M5,ZCTOP5,ZCAMT5,ZTPP5_REF,ZTS5_REF)

    !*          4.5.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.5.6a Gaussian 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))
      ZUV = 0.0_JPRB
      ZW = 0.0_JPRB

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

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

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

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

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

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

      !*           4.5.6b Averaging using weighting function from radiative transfer

    CASE ('RT average')
      ! Allocations
      ALLOCATE(ZPRES(KDLEN,NLSAT))
      ALLOCATE(ZUV5(KDLEN,NLSAT,2))
      ALLOCATE(ZUV(KDLEN,NLSAT,2))
      ALLOCATE(ZW5(KDLEN,NLSAT))
      ALLOCATE(ZW(KDLEN,NLSAT))

      ZUV = 0.0_JPRB

      ! 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

      !       Adjoint of weighted average

      ZW = 0.0_JPRB
      ZUV5(1:ILEN,1:NFLEVG,1) = ZUF5(1:ILEN,1:NFLEVG)
      ZUV5(1:ILEN,1:NFLEVG,2) = ZVF5(1:ILEN,1:NFLEVG)
      CALL MEANUV_AVERAGEAD(KDLEN,ILEN,IMXCOUNT,NLSAT,ZUV5,ZUV,&
       & ZW5,ZW,ZXPP)
      !       Adjoint of interpolation U and V to fixed pressure levels
      CALL PPOBSAAD(KDLEN,ILEN,NLSAT,CLV(JVNM),IOBSTYPE,ICOUNTX,ZPRES,&
       & ZOROG5,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,&
       & ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5)
      DEALLOCATE(ZPRES,ZUV5,ZUV,ZW5,ZW)
    END SELECT

    !*           4.5.7  Call the GPSRO forward model

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

    IF (KHORIZ == 1) THEN 

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

    ELSE

      CALL GPSRO_2DAD(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  Aerosol optical depth at 0.55 microns (adjoint) 

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

! 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
      ZXPPB(:,:,:) = 0.0_JPRB
      DO JNLV = 1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IF (ZXPP(JOBS,JNLV,1)/=RMDI ) &
           & ZXPPB(JOBS,JNLV,1) = ZXPPB(JOBS,JNLV,1) + ZXPP(JOBS,JNLV,1)
        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

      ZSOLAR(:) = RMDI

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

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

      DEALLOCATE(ZXPPB, ZXPRED, ZSOLAR, ZOMF, IXVARBC)
    ENDIF

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

    !*           4.5.11 Cloud optical depth adjoint

  ELSEIF (CLV(JVNM) =='COD') THEN
    CALL COD_OPAD(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
!  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_AD( 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_AD(&
       & 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_AD(&
       & 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.5.10 Reactive gases
  ELSEIF(ANY(LLGRG)) THEN

    !*          4.5.2b 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
      ZXPPB(:,:,:) = 0.0_JPRB
      DO JNLV = 1,IMXCOUNT
        DO JOBS = 1,ILEN
          IF (JNLV>ICOUNT(JOBS)) CYCLE
          IF(LL_AK) THEN
            IF (ZXPP(JOBS,JNLV,1)/=RMDI ) &
             & ZXPPB(JOBS,JNLV,1) = ZXPPB(JOBS,JNLV,1) + ZXPP(JOBS,JNLV,1)
          ELSE
            IF (ZXPP(JOBS,JNLV,2)/=RMDI ) &
             & ZXPPB(JOBS,JNLV,1) = ZXPPB(JOBS,JNLV,1) + ZXPP(JOBS,JNLV,2)
          ENDIF
        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_BIASAD (KSET, IXVARBC, IMXCOUNT, ICOUNT, KDLEN, ILEN, &
       & JPMXNPRED, ZXPRED, IVISNIR, ZLAT, ZLON, ZOMF, ZXPPB(:,:,1))

      DEALLOCATE(ZXPPB, ZXPRED, ZSOLAR, ZOMF, IXVARBC)
    ENDIF

    !*          4.5.10a GRG operators using averaging kernels

    IF (LLNO2) THEN
      ! calc optical thickness of clouds
      CALL COD_OP(KDLEN,ILEN,1,ZQF5, ZTF5, ZPRESH5, ZPRESF5, ZLS5,ZCLWF5,ZCIWF5,ZCOD5,ZTAUC5)
      ! convert model NOX to NO2

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

    IF (LL_AK) THEN
      IF (LLNO2) THEN
        CALL GRG_AK_AD(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,&
         & IAK,ZWAK,ZPAK,ZPXP,ZPXPD,YLGEMSPROF,&
         & IDF,ZXPP,&
         & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,YLGEMSPROF5,PNO2=ZNO2,PNO25=ZNO25)
      ELSE
        IF(LL_MOPITT) THEN
          CALL MOPITT_AK_AD(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_AD(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,&
           & IAK,ZWAK,ZPAK,ZPXP,ZPXPD,YLGEMSPROF,&
           & IDF,ZXPP,&
           & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,YLGEMSPROF5)
        ENDIF
      ENDIF

      !*          4.5.10b GRG operators without averaging kernels
    ELSE
      IF (LLNO2) THEN
        CALL PPOBSAAD(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),IOBSTYPE,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,&
         & ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
         & YDGEMSPROF=YLGEMSPROF,YDGEMSPROF5=YLGEMSPROF5,PNO2=ZNO2,PNO25=ZNO25)

        !*          4.5.1b Upper air operators, lower level

        IF(LL_LAYER) CALL PPOBSAAD(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),&
         & IOBSTYPE,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,&
         & ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
         & YDGEMSPROF=YLGEMSPROF,YDGEMSPROF5=YLGEMSPROF5,PNO2=ZNO2,PNO25=ZNO25)
      ELSE
        CALL PPOBSAAD(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),IOBSTYPE,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,&
         & ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
         & YDGEMSPROF=YLGEMSPROF,YDGEMSPROF5=YLGEMSPROF5)

        !*          4.5.1b Upper air operators, lower level

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

    IF (LLNO2) THEN
      ZGRAX1(1:ILEN,0:NFLEVG)=0.0_JPRB
      CALL NOX2NO2AD(KDLEN,ILEN,IMXCOUNT,ICOUNT,ZVPOBS,&
       & ZPXP,ZPXPD,&
       & ZGRAX1,ZSOLEL,ZAL5,ZCOD5,ZTAUC5,ZCCF5,YLGEMSPROF,&
       & ZNO2,&
       & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZTF5,YLGEMSPROF5)
      ZTF(1:ILEN,1:NFLEVG) = ZTF(1:ILEN,1:NFLEVG) + ZGRAX1(1:ILEN,1:NFLEVG)
    ENDIF

    !*           4.5.10 Greenhouse gases
  ELSEIF(ANY(LLGHG)) THEN

    !*          4.5.10a GHG operators using averaging kernels

    IF (LL_AK) THEN
      CALL GHG_AK_AD(KDLEN,ILEN,IMXCOUNT,CLV(JVNM),ICOUNT,&
       & IAK,ZWAK,ZAPAK,ZPAK,ZPXP,ZPXPD,YLGEMSPROF,&
       & IDF,ZXPP,&
       & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,YLGEMSPROF5)

      !*          4.5.10b GHG operators without averaging kernels
    ELSE

      !*           CO2 mean column mixing ratio (adjoint)

      IF (CLV(JVNM) =='CO2') THEN

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

      ENDIF

      !*           CH4 mean column mixing ratio (adjoint)

      IF (CLV(JVNM) =='CH4') THEN

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

      ENDIF

    ENDIF

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

    ZVPOBS5(:,:)=0.0_JPRB
    CALL GPSZEN_DELAYAD(KDLEN,ILEN,IMXCOUNT,ICOUNT,&
     &                   ZPRESH,ZGEOPH,ZTF,ZQF,ZOROGOB,ZVPOBS5,&
     &                   IDF,ZXPP,&
     &                   ZPRESH5,ZGEOPH5,ZTF5,ZQF5,ZVPOBS)
    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 PPPMERAD(KDLEN,1,ILEN,ZPRESH(1,NFLEVG),ZORDIF,ZTSTAR,ZT0,ZVPOBS5,&
     &             ZPRESH5(1,NFLEVG),ZTSTAR5,ZT05)


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

  ENDIF

  !*          4.7   Deallocate

  DEALLOCATE(ZXPP,ZVPOBS,ZVPOBS_L,ZVPOBS5,ZORDIF,ZTAUC5,ZTAUC)
  DEALLOCATE(ZXPP5)
  IF(LLREO3) DEALLOCATE(IAK,ZPAK,ZWAK,ZAPAK)
  IF(ANY(LLGRG)) DEALLOCATE(ZCOD5)
  IF(LLNO2) DEALLOCATE(ZNO25,ZNO2)

ENDDO VNM_LOOP
IF(LLRAD1C) DEALLOCATE(ZEM,ZEM5)

IF(LLREO3) DEALLOCATE(ZSOLEL)
!*
!     ------------------------------------------------------------------

!        5.       Fill GOM-arrays with gradients. After first zeroing them.
!                 --------------------------------------------------------

!*          5.1   Zero GOM-arrays

DO JOBS=1,ILEN
  IPOSM  = ROBHDR(JOBS,MDB_MAPOMM_AT_INDEX)
  CALL SET_GOM(IOBSTYPE,IPOSM,0.0_JPRB)
ENDDO


!*          5.3   Fill the TOVSCVX array with the grad with respect to Ts

!Moved to HRADPAD.F90 where it belongs    RJE

!*          5.4   Fill GOM-arrays with gradients

!*          5.4.1 Radiance, and make q positive.

IF(LL_RAD_OP) THEN
  CALL QNEGLIMTL(ZQF(1,1),ZQF5_REF(1,1),1,KDLEN,1,NFLEVG,1,ILEN,1,NFLEVG)
  DEALLOCATE(ZQF5_REF)
  CALL PREINTRAD(KDLEN,ILEN,KSET,ZTS,ZWS,ZSN)
ENDIF

!*          5.4.2 Surface

IF(LL_SFC_OP) CALL PREINTSAD(KDLEN,ILEN,KSET,&
 & ZPRESH,&
 & ZUF,ZVF,ZTF,ZQF,ZQN,ZTS,&
 & ZU10N,ZV10N,ZRF,ZLNPR,ZALPH,&
 & ZCPTGZ,ZCPTS,ZBN,ZBH,ZBM,&
 & ZAPHI,ZZ0,ZWS,ZVEG,ZWL,ZSN,&
 & ZPRESH5,&
 & ZUF5,ZVF5,ZTF5,ZQF5,ZQN5,&
 & ZES5,ZQS5,&
 & ZZ05,ZWS5,ZVEG5,ZWL5,ZSN5,ZSLM5,ZTS5,&
 & ZU05,ZV05,ZU10N5,ZV10N5,ZCHN5,ZLNPR5,ZALPH5,&
 & ZAPHI5,ZWET5,ZRF5,ZRI5)

!*          5.4.3 Upper-air, always required


IF (KHORIZ > 1) THEN

  CALL PREINT2DAD(KDLEN,ILEN,KSET,KHORIZ,&
   & 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,ZPXZ5_2D,ZCP5_2D,ZRF5_2D,ZTF5_2D,&
   & ZDELP5_2D,ZRDELP5_2D,ZLNPR5_2D,ZALPH5_2D,ZRPRE5_2D,ZRPP5_2D)  

ELSE

  CALL PREINTAD(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


!       Modifications with TSCV

IF(LTSCV) THEN
  DO JOBS =1,ILEN
    IABNOB  = ROBHDR(JOBS,MDB_ABNOB_AT_INDEX)
    IPOSM   = ROBHDR(JOBS,MDB_MAPOMM_AT_INDEX)
    TSCVX(IPOSM)=YGOMS(IPOSM)%TS
    YGOMUA(IPOSM)%T(NFLEVG) = YGOMUA(IPOSM)%T(NFLEVG)+YGOMS(IPOSM)%TS
    ZTS(JOBS)=0.0_JPRB
  ENDDO
ENDIF


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

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

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