SUBROUTINE HRETR(KDLEN,KDBDY,KSET,KHORIZ,LDFLAG_DO_AEOLUS_L2BP)

!**** *HRETR* - Retrievals

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

!     PURPOSE
!     -------

!     Treats one set of observations and performs the following tasks:
!   1. Prepare for interpolation in vertical
!   2. Convert height vertical coordinates to pressure
!   4. Check contents of observation array, for consistency, or reject
!   5. TOVS/SSMI/METEOSAT retrievals
!      5.1 Radiance preparations
!      5.2 TOVS 1D-Var (removed)
!      5.3 SSMI 1D-Var (removed)
!      5.4 RAD-1C preparations
!   6. Surface emissivity / skin temp. computation
!   7. Computes cloudy radiances (Rad-1C only) 
!      For HIRS also retrieves effective cloud top 
!               and effective cloud effective emissivity with CO2 slicing method

!**   INTERFACE
!     ---------
!     *CALL* *HRETR(KDLEN,KDBDY,KSET,KHORIZ,LDFLAG_DO_AEOLUS_L2BP)*
!     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 = ???
!           LDFLAG_DO_AEOLUS_L2BP = Optional flag to trigger Aeolus Level-2B processing

!        HRETR is called from TASKOB

!**   METHOD
!     ------
!**   EXTERNALS
!     ---------
!        PREINT  - Prepare interpolation
!        PREINTS - Prepare interpolation, surface
!        PREINTR - Prepare interpolation, radiances
!        QNEGLIM - Remove negative specific humidity
!        EXHEIZ2P- Height to pressure conversion
!        PPOBSA  - Equivalents of observed values
!        HRADP   - Radiance preparation
!        HRADP_ML- Radiance preparation in case interpolation is performed in RTTOV
!        RAD1COBE- Observation errors for RAD-1C
!        RAD1CEMIS-Emissivity for RAD-1C
!        AMV_REASSIGN- Height reassignment for AMV/SATOBs
!        MEANUV_WEIGHTS- Weights for layer-mean winds
!        CLOUD_DETECT - Cloud detection for AIRS and IASI

!**   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
!     F. Chevallier   00/03/28 : Insertion of cloud processing
!     F. Chevallier   00/06/23 : Insertion of CO2 slicing
!     C. Kopken       00/10/17 : Pass ISATID to RAD1CEMIS for IR emissivity
!     E. Holm         00/10/24 : Surface pressure into REO3 if needed
!     N. Bormann      01/09/21 : AMV/SATOB height reassignment, preparations
!                                for layer-mean observation operator
!     A. Dethof       02/07/03 : Disable summing up of PWC layers for reo3 PWC
!     A. Dethof       03/04/25 : REO3 bias correction 
!     D. Salmond      03/06/16 : Fix for ICOUNT
!     D. Dee          04/03/11 : Support variational bias correction
!     E. Andersson    04/11/02 : Introduce ground-based GPS. Remove 1D-Var
!     S. Healy        04/10/27 : Set the GPSRO oberrors. 
!     F. Taillefer    04/08/12 : Update code for CANARI
!     P. Burton       14/10/04 : Added kset arg to radtrb
!     A. Benedetti    05/04/01 : Surface pressure into REO3 if needed (for AER) 
!     N. Bormann      04/12/23 : Obs-errors for limb radiances; cloud screening
!                                for limb rad.; RARAD -> LIMB + new codetypes
!     S. Healy        05/04/21 : Changes for 2d operators
!     N. Bormann      06/02/17 : METOP
!     P Bauer, G Kelly, N Bormann 06/02/03 : Add AMSRE, SSMIS, TMI
!     S.Saarinen      16/08/06 : More vectorization by use of MBODYJOBS
!     N. Bormann      06/07/14 : Move HIRS cloud dection from thinning to here
!     N. Bormann      06/08/15 : Move varbc to before rad1cemis
!     T. Auligne      10/01/07 : old scan correction no longer added to VarBC
!     D. Tan          07/03/02 : Intercept Aeolus DWL within PILOT
!     S. Kobayashi    06/11/16 : Store surface emissivity in ODB
!     D. Tan          07/07/04 : More arguments for aeolus_getamd
!     E. Wattrelot    07/07/16 : Add inversion of radar reflectivities
!     F. Karbou, N. Bormann 09/05/2007 : Add and optimize mw emissivity calculations over land
!     A.Bogatchev : 26-Oct-2007 removing of severe breaks of coding rules
!     N. Bormann      07/11/15 : RTTOV-9
!     P. Bauer        08/01/03 : Add Envisat MERIS TCWV
!     D. Tan        05-Mar-2008 : Logical flag for Aeolus Level-2B Processor
!     S. Saarinen  20-Jan-2008 : Fixed array bound violation in radar reflectivities, removed
!                                double-loop by use of MBODYJOBS, added reference to NRADAR & 
!                                NVNUMB(74) (used to be hardcoded 192). Deallocated ZXPP*-arrays, too.
!     F. Karbou   : 26-Feb-2008 reject bad AMSU-A AQUA zenithal angles
!     V. Guidard  : 24-Feb-2009 CO2-slicing for AIRS
!     N. Bormann  :  1-Sep-2008 : Fix bug affecting bias corrections for sensors with missing
!                                 data in some channels
!     A. Geer       03-Oct-2008 pass solar zenith angle to VarBC
!     D. Dee        10-Oct-2008 generalise VarBC
!     P. Bauer        23/01/09 : Add VarBC for TCWV
!     A. Geer       03-Dec-2008 Solar hour VarBC predictor for TMI
!     B. Krzeminski 29-Jan-2009 revised AMSU-A/B mw emissivity calculations and
!                               quality control over land and land/sea mixture
!     A. Inness     19-Aug-2009 Add Varbc for GRG
!     Q. Lu         11-Mar-2009 add fy3a IRAS, MWTS, MWHS and MWRI
!     A. Geer       10-Jun-2009 VarBC statistics per channel
!     A. Geer       18-Aug-2009 Stop use of an ODB variable which had been hijacked here
!     H. Hersbach   04-Dec-2009 10-m neutral wind
!     N. Bormann    09-Oct-2009 Call to amv_get_preds
!     A. Fouilloux   31/03/10: use new codetype for MERIS data
!     R. Eresmaa    27-Apr-2010 Save aerosol flags of AIRS and IASI
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVG   ,NPPM
USE YOMDIMO  , ONLY : NLSAT    ,NMXTCHU, NPNAV
USE GOMS_MIX     , ONLY : YGOMS
USE YOMCT0   , ONLY : LCANARI, L_SCREEN_CALL
USE YOMCST   , ONLY : RV       ,RCPV     ,RETV     ,RCW      ,&
 & RCS      ,RLVTT    ,RLSTT    ,RTT      ,RALPW    ,RBETW    ,&
 & RGAMW    ,RALPS    ,RBETS    ,RGAMS    ,RALPD    ,RBETD    ,&
 & RGAMD    ,RG       ,RA
USE YOMVAR   , ONLY : NUPTRA   ,LVARBC, LAEOLUSAMD ,LTOVSCV  ,LCLDSINK 
USE VARBC_EVAL, ONLY : VARBC_BIAS
USE VARBC_PRED, ONLY : JPMXNPRED, VARBC_PRED_RAD, VARBC_PRED_TO3, VARBC_PRED_AIREP
USE VARBC_AIREP, ONLY : LBC_AIREP
USE YOMOBS   , ONLY : LMFSCREEN, LCACHMT
USE YOMVNMB  , ONLY : NVNUMB
USE YOMOBSET , ONLY : MTYPOB   ,MLNSET   ,MTSLSET
USE YOMCOCTP , ONLY : NAIREP   ,NTEMP    ,NPILOT   ,NSSMI    ,NGTHRB   ,&
                    & NSTRO3   ,NSCATT   ,NSYNOP   ,NDRIBU   ,&
                    & NPAOB    ,NSATEM   ,NSATOB   ,NPGPS    ,&
                    & NLIMB    ,NGPSRO   ,NLRAD    ,NDWLPCD  ,&
                    & NRADAR   ,NTCWC
USE YOMLUN   , ONLY : NULERR   ,NULOUT
USE YOMANCS  , ONLY : RMDI     ,RDEGREES ,RADIANS
USE YOMCT0B  , ONLY : LECMWF
USE YOMTVRAD , ONLY : RADPRE   ,&
 & SATGRP_TABLE        ,SATOBGRP_TABLE    ,LRTCALC_HRETR        ,&
 & MSENSOR_HIRS        ,MSENSOR_MSG       ,MSENSOR_MSG_HR    , &
 & MSENSOR_IRAS        , &
 & MSENSOR_AMSUA       ,MSENSOR_SSMI      ,MSENSOR_SSMIS ,MSENSOR_AMSRE,&
 & MSENSOR_TMI         ,MSENSOR_AIRS      ,MSENSOR_IASI  ,NSENSOR_MERIS,&
 & MMETHOD_WVMW        ,MSENSOR_AMSUB     ,MSENSOR_MHS   ,MXSENSOR     ,&
 & LRTTOV_INTERPOL     ,LCO2_DIAG_AIRS
USE YOMLIMB , ONLY : Y_LIMBGRP_TABLE
USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
 & R4IES    ,R5LES    ,R5IES    ,R5ALVCP  ,R5ALSCP  ,RALVDCP  ,&
 & RALSDCP  ,RTWAT    ,RTICE    ,RTICECU  ,RTWAT_RTICE_R      ,&
 & RTWAT_RTICECU_R
USE YOMNMEV  , ONLY : ND1EVENT ,NR1EVENT
USE YOMDB
USE YOMNNE   , ONLY : LNNBC 
USE TYPE_GEMS_PROFILES
USE YOMEMIS , ONLY : LATLAS_EMIS, LDYN_EMIS, LDYN_TSKIN, &
 & MEMIS_CHAN, MTSKIN_CHAN
USE AEOLUS_PROCESSING_MOD, only: aeolus_getamd, aeolus_l2bp_wrapper

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
LOGICAL, OPTIONAL, INTENT(IN)    :: LDFLAG_DO_AEOLUS_L2BP
 
!   ZPRESH5 :   Half level pressure values at obs points of set KSET
!   ZPRESF5 :   Full level pressure values at obs points of set KSET
!   ZGEOPH5 :   Half level geopotential values at obs points of set KSET
!   ZGEOPF5 :   Full level geopotential values at obs points of set KSET
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) :: 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) ::ZPXP5,ZPXPD5,ZPXZ5,ZPXZD5

!   ZPXP5_2D,ZPXPD5_2D :   Intermediate variables (see PPINIT)
!   ZPXZ5_2D,ZPXZD5_2D :   Intermediate variables (see PPINITZ)
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) ::&
 & 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) ::&
 & 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
!   ZU05    :   U-COMP OCEAN CURRENT
!   ZV05    :   V-COMP OCEAN CURRENT
!   ZU10N5  :   U-COMP 10M NEUTRAL WIND
!   ZV10N5  :   V-COMP 10M NEUTRAL WIND 
!   ZCHN5   :   WAVE CHARNOCK
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) :: &
& ZT05_2D,ZTSTAR5_2D,ZOROG5_2D

!   Model surface fields, at observation points
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZSLM5,ZWS5,ZVEG5,ZWL5,ZSN5,ZZ05

!   Effective cloud top and effective cloud effective emissivity
REAL(KIND=JPRB), DIMENSION(KDLEN,3) :: ZEFF_PTOP,ZEFF_NE

!   ZOROGOB :   Elevation*RG of observation
!   ZORDIF  :   Model minus Observation orography (ZOROG5-ZOROGOB)
!   ZP_AT_OBALT: Model pressure at Observation orography
!   ZNVANG,ZZEANG,ZAZIANG :   Nadir viewing, zenith and azimuth angle
!   ZSOLZENANG,ZSOLAZIANG : Solar zenith and azimuth angle
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZLAT,ZLON,ZOROGOB,ZORDIF,ZP_AT_OBALT
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZNVANG,ZZEANG, ZAZIANG
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZSOLZENANG,ZSOLAZIANG,ZSOLHOUR
REAL(KIND=JPRB) :: ZTCWV(KDLEN,1,1)

!   Variables for the surface layer observation operators
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZCPTGZ5,ZWET5,ZQS5,ZCPTS5,ZRI5,ZBN5,ZBM5,ZBH5
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZT2M_TOVS5,ZQ2M_TOVS5,ZCTOP_TOVS5,ZCAMT_TOVS5
REAL(KIND=JPRB), DIMENSION(KDLEN,2) :: ZES5
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG) :: ZAPHI5

!   Model U/V/T/Q/O3/CLW/CIW/CC/CSW/CRW/CGW at observation points, model levels
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG) ::&
 & ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,ZCLWF5,ZCIWF5,ZCCF5,ZQN5, &
 & ZCSWF5,ZCRWF5,ZCGWF5

!   Model U/V/T/Q/O3/CLW/CIW/CC at observation points, model levels
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

!   Model RH at observation points
!   Via post-processed interpolation at full-model level pressures
REAL(KIND=JPRB), DIMENSION(KDLEN,NFLEVG) :: ZRHF5

!   ZINTHUV :   Interpolation height, for surface wind data
!   ZUV10M5 :   10-m wind
!   ZZ0SCAT : A model surface field, at observation points
INTEGER(KIND=JPIM), PARAMETER :: IDBDY2=2
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZINTHUV
REAL(KIND=JPRB), DIMENSION(KDLEN,IDBDY2) :: ZUV10M5
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZZ0SCAT

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

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

!   IDATOB,ITIMOB: Date and time of observation
!   ICMBDY  :  Number of data entries in each report in this KSET
!   IFOVOB  :  Field of view
!   ZBOAOB  :  bearing_azimuth .. amsu sensor 3 asc/dec node 1 or 2 o unknown
INTEGER(KIND=JPIM), DIMENSION(KDLEN) :: ICOUNT,IDATOB,ITIMOB,IFOVOB,ICMBDY,ICOUNTX
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZBOAOB
REAL(KIND=JPRB), DIMENSION(KDLEN,KDBDY) :: ZPPP,ZPPO

!   ZP:         AMV/SATOB pressure
!   ZU:         AMV/SATOB U
!   ZV:         AMV/SATOB V
REAL(KIND=JPRB), DIMENSION(KDLEN)  :: ZP,ZU,ZV
REAL(KIND=JPRB)   :: ZCMOER,ZCMPER,ZCMFOE

REAL(KIND=JPRB), ALLOCATABLE :: ZPS5(:),ZTQOPP5(:,:,:),ZPRES(:,:)

!   Parameters/arrays of the interface to ADVAR:
!   JP1DIN/OUT: LENGTH OF THE INPUT/OUTPUT ARRAY OF ADVAR

REAL(KIND=JPRB), DIMENSION(NLSAT)  :: ZPIN,ZTIN,ZQIN
REAL(KIND=JPRB) :: ZU10IN,ZV10IN,ZORIN,ZSNIN,ZWSIN  

! For TOVS radiances
REAL(KIND=JPRB), ALLOCATABLE :: ZEM5(:,:), ZVPOBS(:,:), ZOBSC(:,:) 
REAL(KIND=JPRB), ALLOCATABLE :: ZTBCLR(:,:)  ! Model clear brightness temps
REAL(KIND=JPRB), ALLOCATABLE :: ZTBTOT(:,:)  ! Model total brightness temps
REAL(KIND=JPRB), ALLOCATABLE :: ZCLDLEV(:,:) ! Cloud level (AIRS&IASI)
REAL(KIND=JPRB), ALLOCATABLE :: ZTAUSFC(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZVARBC(:,:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IXVARBC(:,:)
INTEGER(KIND=JPIM), ALLOCATABLE :: ICLDFLG(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZOMF(:,:), ZXPRED(:,:)

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

!   Effective skin temperature and surface emissivities (for dynam emis)
REAL(KIND=JPRB)  :: ZEMIS_NEW, ZSKIN_NEW


! For AIRS and IASI cloud detection
INTEGER(KIND=JPIM) :: IMINLEV(1), IMAXLEV(1)

! For AIRS neural network bias correction
REAL(KIND=JPRB), ALLOCATABLE :: ZOBS(:,:), ZNNBIAS(:,:)

! For statistic inversion of radar reflectivities
REAL(KIND=JPRB), ALLOCATABLE :: ZXPP(:,:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZXPP_2D(:,:,:,:)

!   ZW   : Weights used for mean layer winds
!   ZTAU : Transmittances on RTTOV pressure levels
!   ZRADCLDLEV overcast radiances at every level        
!   ZCHAN: Channel for RT mean layer SATOBS
!   ZXDUM: Dummy argument
REAL(KIND=JPRB), ALLOCATABLE :: ZW(:,:), ZTAU(:,:,:), ZRADCLDLEV(:,:,:), ZCHAN(:,:), ZXDUM(:,:),  &
 & ZT2M5(:),ZQ2M5(:),ZCTOP5(:),ZCAMT5(:)  

! Other local variables

INTEGER(KIND=JPIM) :: ILEN,IOBSTYPE,ICDTYP,ICDTYP_TOVS,ICDTYP_LIMB,IGRP,IMXBDY,&
 & ISELE,IVNM,IVNM2,IBODY,&
 & ISERIES,ISATID,ICOEF,&
 & IDFS,ISENSOR,IS,INFO(1),IRET,ISUR_M,ICHAN,&
 & IMXCOUNT,ITSLOT,ISENSOR_GETDB,IDF,JPROF
INTEGER(KIND=JPIM)  :: ISONDE_TYPE ! Passed to getdb for Aeolus
CHARACTER (LEN = 6) ::  CLGET(2),CLPUT(2)
CHARACTER (LEN = 3) ::  CLPP
INTEGER(KIND=JPIM) :: JOBS,JLEV,JCASE,JBODY,IPOSM
! add ipnlv integer array , zrhmin, zrhmax, ZPRH,ZPES for inversion of radar reflectivities
INTEGER(KIND=JPIM), DIMENSION(KDLEN,KDBDY) :: IVAR,IPNLV
REAL(KIND=JPRB) :: Z500HPA,ZOBALT,ZPRED(8,1),ZPSOL,ZPSOLPPP, ZRHMIN, ZRHMAX
REAL(KIND=JPRB), DIMENSION(KDLEN,0:NFLEVG,KHORIZ) :: ZPRH,ZPES
! end of adding variables for reflectivities
REAL(KIND=JPRB) :: ZBIAS,ZOBSV,ZINFO(1),ZSOLEL,ZCLEAR
REAL(KIND=JPRB) :: ZBATS_VEG
REAL(KIND=JPRB) :: ZTFG, ZMPS, ZSZA
LOGICAL :: LLRAD1C,LL_TCWV,LL_AIREP,&
 & LLEXTLI,LL_SFC_OP,LL_RAD_OP,LLREO3, LL_WVMW, LL_MF
LOGICAL :: LL_TCWV_OK, LL_MERIS_OK
LOGICAL :: LLCHANMISS
LOGICAL :: LL_AEOLUS_SET, LL_DO_AEOLUS_L2BP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER(KIND=JPIM) :: ICLDTYPE,ICLDTYPEQF
INTEGER(KIND=JPIM) :: IEMIS_CHAN, ITSKIN_CHAN, IQC_CHAN

TYPE (TYPE_GEMSPROF), DIMENSION(KDLEN,NGEMS) :: YLGEMSPROF5
REAL(KIND=JPRB), TARGET :: Z_MODELPROF(KDLEN,NGEMS,NFLEVG)
REAL(KIND=JPRB), TARGET :: Z_RTTOVPROF(KDLEN,NGEMS,NLSAT)
INTEGER(KIND=JPIM) :: JLEN,IGEMS
REAL(KIND=JPRB) :: ZSWATH_WIDTH_AMSUA, ZFOV_SPACING_AMSUA, ZANG_SCAN_AMSUA,ZANG_ZENI_AMSUA
REAL(KIND=JPRB), PARAMETER :: ZHSAT_AQUA=705000.0_JPRB  ! Nominal satellite altitude aqua


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

#include "abor1.intfb.h"
!#include "aeolus_processing_mod.intfb.h"
#include "aeolus_l2b_to_body.intfb.h"
#include "amv_get_preds.intfb.h"
#include "amv_reassign.intfb.h"
#include "ch4bcor.intfb.h"
#include "diurnal.intfb.h"
#include "exheiz2p.intfb.h"
#include "hirs_cld.intfb.h"
#include "iras_cld.intfb.h"
#include "hradp.intfb.h"
#include "hradp_ml.intfb.h"
#include "gpsro_oberror.intfb.h"
#include "meanuv_weights.intfb.h"
#include "ppobsa.intfb.h"
#include "ppobsas.intfb.h"
#include "ppobsaz.intfb.h"
#include "preint.intfb.h"
#include "preint2d.intfb.h"
#include "preintr.intfb.h"
#include "preints.intfb.h"
#include "qneglim.intfb.h"
#include "rad1cemis.intfb.h"
#include "rad1cnne.intfb.h"
#include "rad1cobe.intfb.h"
#include "radtr.intfb.h"
#include "radtr_ml.intfb.h"
#include "reo3bcor.intfb.h"
#include "pppmer.intfb.h"
#include "rtl_oberror.intfb.h"
#include "rtl_screen.intfb.h"
#include "fcobs.h"
#include "fcttrm.h"
#include "fcttre.h"
#include "addoer.intfb.h"
#include "cloud_detect.intfb.h"
#include "cloud_estimate.intfb.h"
#include "gprh.intfb.h"
#include "inv_refl1dstat.intfb.h"
#include "reflsim_2dop.intfb.h"
#include "reflsim.intfb.h"

#include "openmp_obs.h"

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

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

!*          1.0   Parameters of this set
ILEN     = MLNSET(KSET)
IOBSTYPE = MOD(MTYPOB(KSET),100)
IGRP     = MOD(MTYPOB(KSET)/100,100)
ITSLOT   = MTSLSET(KSET)

ZPRED=0.0_JPRB

DO JLEN=1,KDLEN
  DO IGEMS=1,NGEMS
    YLGEMSPROF5(JLEN,IGEMS)%MODELPROF => Z_MODELPROF(JLEN,IGEMS,:)
    YLGEMSPROF5(JLEN,IGEMS)%RTTOVPROF => Z_RTTOVPROF(JLEN,IGEMS,:)
  ENDDO
ENDDO

!           1.0.1 Get actual series and satid number

LL_AEOLUS_SET = ( IOBSTYPE == NPILOT ) .AND. ( IGRP == 2 )
LL_DO_AEOLUS_L2BP = .FALSE.
IF ( PRESENT(LDFLAG_DO_AEOLUS_L2BP) ) &
   & LL_DO_AEOLUS_L2BP = LDFLAG_DO_AEOLUS_L2BP .AND. LL_AEOLUS_SET
IF ( LL_DO_AEOLUS_L2BP ) THEN
   ISONDE_TYPE =  1 ! Aeolus ODB tables for "L1B-master" HLOS observations only
ELSE
   ISONDE_TYPE = -1 ! Aeolus ODB tables for "all L1B/L2B" HLOS observations
ENDIF

ISENSOR_GETDB = -1
LL_WVMW     = .FALSE.
IF(IOBSTYPE == NSATEM) THEN
  ICDTYP_TOVS      = SATGRP_TABLE(IGRP)%codetype
  ICOEF            = SATGRP_TABLE(IGRP)%rtcoef_pos
  ISERIES          = SATGRP_TABLE(IGRP)%rtseries
  ISATID           = SATGRP_TABLE(IGRP)%rtid
  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_WVMW     = TRIM(SATOBGRP_TABLE(IGRP)%obs_oper) == 'RT average' &
      & .OR. TRIM(SATOBGRP_TABLE(IGRP)%obs_oper) == 'RT median'  &
      & .OR. TRIM(SATOBGRP_TABLE(IGRP)%obs_oper) == 'RT max'  &
      & .OR. TRIM(SATOBGRP_TABLE(IGRP)%obs_oper) == 'RT median Gauss average' &
      & .OR. TRIM(SATOBGRP_TABLE(IGRP)%obs_oper) == 'RT median RT average' &
      & .OR. TRIM(SATOBGRP_TABLE(IGRP)%obs_oper) == 'RT max Gauss average' &
      & .OR. TRIM(SATOBGRP_TABLE(IGRP)%obs_oper) == 'RT max RT average'
  ICDTYP_TOVS = SATOBGRP_TABLE(IGRP)%codetype
  ISENSOR     = 1
ELSEIF(IOBSTYPE == NLIMB)THEN
  ICDTYP_LIMB = Y_LIMBGRP_TABLE(IGRP)%codetype
  ICDTYP_TOVS = Y_LIMBGRP_TABLE(IGRP)%codetype  ! For ODB
  ISENSOR     = 1                             ! Not used
ELSEIF(LL_AEOLUS_SET)THEN ! Aeolus DWL
  ICDTYP_TOVS = NDWLPCD  ! For ODB
  ISENSOR     = 1                             ! Not used
ELSE
  ICDTYP_TOVS=-1
  ISENSOR=1
ENDIF

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

!*          1.0.2 Initialize ODB

IF (LCANARI) THEN
  CALL GETDB('HRETR_CA',0,IRET, INFO, 0, ZINFO, 0, &
   & KSET, -1, -1, -1, -1, -1)
ELSE
  CALL GETDB('HRETR', NUPTRA, IRET, INFO, 0, ZINFO,0, &
   & KSET, ITSLOT, -1, IOBSTYPE, ICDTYP_TOVS, ISENSOR_GETDB, &
   & KSONDE_TYPE = ISONDE_TYPE )  
ENDIF

IF (IRET /= ILEN) THEN
  WRITE(NULERR,'('' ** INCONSISTENT NO. OF OBSERVATIONS FROM GETDB'')')
  WRITE(NULERR,*)' Expecting ',ILEN,', but got =',IRET
  CALL ABORTDB('HRETR', 'INCONSISTENCIES FROM GETDB', IRET)
ENDIF

!*          1.0.3 Set 500 hPa

Z500HPA=50000._JPRB

!*          1.1   Switches

!*          1.1.1 Types of TOVS/RAD1C/SSMI/REO3 processing
!                 LLRAD1C=Calibrated 'raw' radiances, no 1D-Var
!                 LLREO3 =Retrieved ozone layers
!                 METEOSAT and SSMI radiances are LLRAD1C
!                 LL_TCWV SSM/I processing has been done in grid-point space, elsewhere
LLRAD1C = ICDTYP_TOVS == NGTHRB
LL_TCWV = ICDTYP_TOVS == NTCWC   ! Do nothing in HRETR except setting of top/bottom pressure in ODB
LL_AIREP= IOBSTYPE    == NAIREP
LLREO3  = ICDTYP_TOVS == NSTRO3

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

LL_SFC_OP=.FALSE.
LL_RAD_OP=LLRAD1C

!*          1.1.2.1 Aeolus AMD requires 10-m wind
!                   Current obstype for Aeolus is PILOT

LL_SFC_OP = ( LAEOLUSAMD ) .AND. ANY(IOBSTYPE == (/NPILOT/))

!*          1.1.3 Meteo-France case

LL_MF=LMFSCREEN .OR. LCANARI

!*          1.2   Interpolation preparation

!*          1.2.1 Upper-air


IF (KHORIZ > 1) THEN 

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

   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

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

ENDIF

!*          1.2.2 Surface (normally not required)

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)  

!*          1.2.3 Radiance

IF(LL_RAD_OP .OR. LL_WVMW) THEN
  CALL PREINTR(KDLEN,ILEN,KSET,ZLS5,ZCI5,ZAL5,ZTS5,ZWS5,ZSN5)
  CALL QNEGLIM(ZQF5(1,1),1,KDLEN,1,NFLEVG,1,ILEN,1,NFLEVG)
ENDIF
ZEFF_PTOP(:,:)=RMDI        
ZEFF_NE(:,:)=RMDI                                       


!*          1.2.4 Aeolus Level-2B processing
IF(IOBSTYPE == NPILOT)THEN
  JOBS = 1
  ICDTYP=ROBHDR(JOBS,MDB_CODETYPE_AT_HDR)
  IF(ICDTYP == NDWLPCD)THEN

    ! Compute RH and 10-m wind etc

!   Compute relative humidity
    ICOUNT(1:ILEN)=NFLEVG
    CALL PPOBSA(KDLEN,ILEN,NFLEVG,'H',IOBSTYPE,ICOUNT,ZPRESF5,ZOROG5,&
 & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,&
 & ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
 & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
 & 1,ZRHF5)  
! Argument 7 is pressure of requested output - here full model level pressures.
! Argument 3 is second dimension of Argument 7.

!   Compute 10-m wind

!           Compute interpolation heights
!*          Adapt from From HOP3.5   Surface wind data
    ZUV10M5(1:ILEN,1) = RMDI 
    ZUV10M5(1:ILEN,2) = RMDI 
    ZINTHUV(1:ILEN) = 10._JPRB*RG

!*          From HOP4.5.2 Surface operators

    IF(.NOT.LL_SFC_OP) CALL ABOR1('HRETR: Aeolus requires LL_SFC_OP=.T.')
    IF(.NOT.LCACHMT) THEN
      ICOUNT(1:ILEN)=1
      CALL PPOBSAS(KDLEN,ILEN,1,'U10',ZINTHUV,IOBSTYPE,ICOUNT,ZZ0SCAT,&
       & ZPRESF5,ZUF5,ZVF5,ZTF5,ZQN5,ZU05,ZV05,&
       & ZCPTGZ5,ZCPTS5,ZAPHI5,ZES5,ZRI5,ZBN5,ZBM5,ZBH5,2,ZUV10M5)
    ELSE
!      CALL PPOBSAC(KDLEN,ILEN,1,'U10',ZINTH,KSET,IOBSTYPE,ICOUNT,ZZ0SCAT,&
!       & ZOROGOB,ZOROG5,ZPRESH5,ZPRESF5,ZGEOPH5,ZGEOPF5,&
!       & ZCP5,ZRF5,ZUF5,ZVF5,ZTF5,ZQF5,&
!       & ZTS5,ZSST5,ZWS5,ZVEG5,ZSN5,ZSLM5,ZZ05,2,ZUV10M5)
       CALL ABOR1('HRETR: CANARI sfc op not enabled for Aeolus')
    ENDIF

    ! Load arrays into odb
    IF (LL_AEOLUS_SET) THEN ! Aeolus DWL
      IF (LL_DO_AEOLUS_L2BP) THEN
    CALL aeolus_getamd(ZTF5, &
&                        ZPRESH5, ZGEOPH5, &
&                        ZPRESF5, ZGEOPF5, &
&                        ZUF5,    ZVF5   , &
&                        ZQF5,    ZCLWF5 , ZCIWF5, ZCCF5, &
&                        ZRHF5,   ZUV10M5,                &
&                        ILEN,    KDLEN                   &
&                         )
        CALL aeolus_l2bp_wrapper(ILEN)
      ELSE
        CALL aeolus_l2b_to_body(ILEN)
  ENDIF
    ENDIF ! LL_AEOLUS_SET
  ENDIF
ENDIF

!*          1.2.5 Envisat MERIS TCWV
IF(LL_TCWV) THEN
  CALL PREINTR(KDLEN,ILEN,KSET,ZLS5,ZCI5,ZAL5,ZTS5,ZWS5,ZSN5)
ENDIF

!*          1.3   Loop observation array

!*          1.3.1 Find out number of bodies (ICMBDY)
!                 latitude and longitude (ZLAT, ZLON),
!                 date and time (IDATOB, ITIMOB) and obs orography (ZOROGOB)
!                 from observation array.

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

  ZLAT(JOBS)   = ROBHDR(JOBS,MDBLAT)*RDEGREES ! latitude in degrees
  ZLON(JOBS)   = ROBHDR(JOBS,MDBLON)*RDEGREES ! longitude in degrees

  IDATOB(JOBS) = ROBHDR(JOBS,MDBDAT)
  ITIMOB(JOBS) = ROBHDR(JOBS,MDBETM)

  ZOBALT=ROBHDR(JOBS,MDBALT)
  IF(ZOBALT == RMDI .AND. (IOBSTYPE == NTEMP .OR. IOBSTYPE == NPILOT)) THEN
    ROBHDR(JOBS,MDBALT) = ZOROG5(JOBS)/RG
    ZOROGOB(JOBS) = ZOROG5(JOBS)
    ZORDIF(JOBS)  = 0.0_JPRB
  ELSEIF(ZOBALT == RMDI .OR. ABS(ZOBALT) >  10000._JPRB) THEN
    ZOROGOB(JOBS) = RMDI
    ZORDIF(JOBS)  = 0.0_JPRB
  ELSE
    ZOROGOB(JOBS) = ZOBALT*RG
    ZORDIF(JOBS)  = ZOROG5(JOBS)-ZOROGOB(JOBS)
  ENDIF

  IF(LLRAD1C) THEN
    IFOVOB(JOBS) = NINT(SATHDR(JOBS,MDB_SCANPOS_AT_RADIANCE))
    ZBOAOB(JOBS) =      SATHDR(JOBS,MDB_AZIMUTH_AT_SAT)
  ENDIF
ENDDO
IMXBDY=MAXVAL(ICMBDY(1:ILEN))

!*
!     ------------------------------------------------------------------
!*
!        2.       Height to pressure
!                 ------------------

!*          2.0   Model's pressure at station height

IF(IOBSTYPE == NSYNOP) THEN

!           2.0.1   Compute model's pressure at station height
!                (currently used only for PPP of ground-based GPS data)

  CALL PPPMER(KDLEN,1,ILEN,ZPRESH5(1,NFLEVG),ZORDIF,ZTSTAR5,ZT05,ZP_AT_OBALT)

!           2.0.2   Total Column Water Vapour (For reference, for GPS)
 
  ICOUNT(1:ILEN)=1
  CALL PPOBSA(KDLEN,ILEN,1,'PWC',IOBSTYPE,ICOUNT,ZP_AT_OBALT,ZOROG5,&
   & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,&
   & ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,ZCLWF5,ZCIWF5,ZCCF5,&
   & ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
   & 1,ZTCWV)

!           2.0.3   Write PPP and TCWV into ODB, for ground-based GPS data

!OCL NOVREC
  DO IBODY=1,MLNKH2B(ILEN+1)-1
    JOBS = MBODYJOBS(IBODY)
    ICDTYP=ROBHDR(JOBS,MDB_CODETYPE_AT_HDR)
    IVNM  =ROBODY(IBODY,MDBVNM)
    IF(ICDTYP == NPGPS .AND. IVNM == NVNUMB(75)) THEN
      IF(ROBHDR(JOBS,MDBALT) /= RMDI) ROBODY(IBODY,MDBPPP)=ZP_AT_OBALT(JOBS)
      ROBODY(IBODY,MDBPER)=ZTCWV(JOBS,1,1)
      ROBODY(IBODY,MDBRER)=ZTF5(JOBS,NFLEVG)
    ENDIF
  ENDDO
ENDIF

!*          2.1   Assign first guess pressure to SYNOP/DRIBU/PAOB
!                 and TEMP/PILOT

IF(ANY(IOBSTYPE == (/NSYNOP,NDRIBU,NPAOB,NTEMP,NPILOT/))) THEN

!           2.1.1   Loop twice (1. Standard case
!                               2. Near surface parmeters case)
  CLGET=(/'GETHVC','GETNSU'/)
  CLPUT=(/'PUTHVC','PUTNSU'/)

  CASE_LOOP: DO JCASE = 1,2
    IF(JCASE == 1 .AND. IOBSTYPE == NTEMP) CYCLE CASE_LOOP

!*          2.1.3   Loop over the set and extract the height of observation

    ICOUNT(1:ILEN) = 0
    ZPPO(1:ILEN,:) = Z500HPA
    DO JOBS = 1, ILEN
      CALL EXHEIZ2P(CLGET(JCASE),KDLEN,KDBDY,JOBS,KSET,ICOUNT,ZPPO,LL_MF)
    ENDDO

!*          2.1.4   Post-process the heights to pressures

    ISELE   = 1
    LLEXTLI = .FALSE.
    CALL PPOBSAZ(KDLEN,ILEN,KDBDY,'PS ',IOBSTYPE,ICOUNT,ZPPO,&
     & ZOROG5,ISELE,LLEXTLI,&
     & ZPXZ5,ZPXZD5,ZGEOPH5,ZGEOPF5,ZPRESH5,ZPRESF5,ZTSTAR5,&
     & 1,ZPPP)  

!*          2.1.5   Loop over the set and insert the pressure of observation

    ICOUNT(1:ILEN) = 0
    DO JOBS = 1, ILEN
      CALL EXHEIZ2P(CLPUT(JCASE),KDLEN,KDBDY,JOBS,KSET,ICOUNT,ZPPP,LL_MF)
    ENDDO
  ENDDO CASE_LOOP

ENDIF

!*
!     ------------------------------------------------------------------
!*
!        3.       Thicknesses and PWC
!                 -------------------

!*          3.1   Sum-up HAS been removed.

!     ------------------------------------------------------------------
!*
!        4.       Modify contents of observation array, if necessary
!                 --------------------------------------------------

!*          4.1   Thicknesses

IF(LECMWF .AND. (LLREO3 .OR. LL_TCWV) ) THEN

!*          4.1.1 Loop bodies of observation array

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

    IVNM=ROBODY(IBODY,MDBVNM)

!*          4.1.2 Missing observed value

    IF(ROBODY(IBODY,MDBVAR) == RMDI) THEN
!          Do nothing

!*          4.1.4 Replace lower pressure of retrieved ozone layers
!                 by surface pressure if below surface. This is
!                 because the lowest retrieved layer (or total ozone)
!                 most of the time has a dummy lower pressure of 1013 hPa.

    ELSEIF(IVNM == NVNUMB(68) .OR. IVNM == NVNUMB(80) .OR. &
     &     IVNM == NVNUMB(81) .OR. IVNM == NVNUMB(82) .OR. &
     &     IVNM == NVNUMB(83) .OR. IVNM == NVNUMB(84) ) THEN
      ROBODY(IBODY,MDBPRL) = MIN(ROBODY(IBODY,MDBPRL),ZPRESH5(JOBS,NFLEVG))


!*          4.1.5 Replace lower pressure of retrieved pwc layers
!                 by surface pressure if below surface. This is
!                 because the lowest retrieved layer (or total PWC) 
!                 most of the time has a dummy lower pressure of 1013 hPa.

    ELSEIF(IVNM == NVNUMB(6)) THEN
      IF(LL_TCWV) THEN
        ROBODY(IBODY,MDBPPP) = ZPRESF5(JOBS,1)
        ROBODY(IBODY,MDBPRL) = ZPRESH5(JOBS,NFLEVG)
      ELSE
        ROBODY(IBODY,MDBPRL) = MIN(ROBODY(IBODY,MDBPRL),ZPRESH5(JOBS,NFLEVG))
      ENDIF
            
! BEN - Commented out as BUFR files do not contain this information
!!*          4.1.6 Replace lower pressure of retrieved aerosol optical depth 
!!                 by surface pressure if below surface. This is
!!                 because the lowest retrieved layer most of the time 
!!                 has a dummy lower pressure of 1013 hPa.

!    ELSEIF(IVNM == NVNUMB(78)) THEN
!      ROBODY(IBODY,MDBPRL) = MIN(ROBODY(IBODY,MDBPRL),ZPRESH5(JOBS,NFLEVG))
    ENDIF
  ENDDO NEW_BODY_LOOP

ENDIF

!*          4.2   Winds and pressures

IF(IOBSTYPE /= NSATEM) THEN

  DO JOBS = 1,ILEN

   IF(KHORIZ==1) THEN
    ZPSOL    = LOG(ZPRESH5(JOBS,NFLEVG))
    ZPSOLPPP = ZPRESH5(JOBS,NFLEVG)
   ELSE
     ZPSOL    = LOG(ZPRESH5_2D(JOBS,NFLEVG,1))
     ZPSOLPPP  = ZPRESH5_2D(JOBS,NFLEVG,1)
   ENDIF

!*         4.2.1 Use model pressure when pressure at observation point
!                is missing, for some of the observations only (MF)

    IF(LL_MF)THEN
      BODY_LOOPMF: DO JBODY=1,ICMBDY(JOBS)
        IBODY=MLNKH2B(JOBS)+(JBODY-1)
        IVNM=ROBODY(IBODY,MDBVNM)
        IF ( ( IOBSTYPE /= NTEMP .AND. IOBSTYPE /= NPILOT ) .OR.&
           & ( IVNM == NVNUMB( 7) .OR. IVNM == NVNUMB(10) .OR.&
           & IVNM == NVNUMB(61) .OR. IVNM == NVNUMB(62) .OR.&
           & IVNM == NVNUMB(56) .OR. IVNM == NVNUMB(57) )   ) THEN
          IF(ROBODY(IBODY,MDBPPP) <= 1.0_JPRB) ROBODY(IBODY,MDBPPP)=ZPSOLPPP
        ENDIF
      ENDDO BODY_LOOPMF
    ENDIF

!*          4.2.2 Loop bodies of observation array

    BODY_LOOP2: DO JBODY=1,ICMBDY(JOBS)
      IBODY=MLNKH2B(JOBS)+(JBODY-1)
      IVNM=ROBODY(IBODY,MDBVNM)

!*          4.2.3 Check that V/V10 comes after U/U10, and pressures agree.

      IF(IVNM == NVNUMB( 1) .OR. IVNM == NVNUMB(56) .OR. IVNM == NVNUMB(62)) THEN
        IVNM2=IVNM+1
        IF(IVNM == NVNUMB(62)) IVNM2=NVNUMB(61)
        IF(ROBODY(IBODY+1,MDBVNM) /= IVNM2) THEN
          CALL ABOR1(' ERROR IN HRETR: V DOES NOT FOLLOW U')
        ENDIF
        IF((ROBODY(IBODY,MDBPPP) /= ROBODY(IBODY+1,MDBPPP)) .AND. &
           & (ROBODY(IBODY,MDBPPP) > 1.0_JPRB)) THEN  
          CALL ABOR1(' ERROR IN HRETR: U P-LEVEL DIFFERENT FROM V'')')
        ENDIF
      ENDIF

!*          4.2.4 Check that U/U10 comes before V/V10, and pressures agree.

      IF(IVNM == NVNUMB( 2) .OR. IVNM == NVNUMB(57) .OR. IVNM == NVNUMB(61) ) THEN
        IVNM2=IVNM-1
        IF(IVNM == NVNUMB(61)) IVNM2=NVNUMB(62)
        IF(ROBODY(IBODY-1,MDBVNM) /= IVNM2) &
         & CALL ABOR1(' ERROR IN HRETR: U DOES NOT PRECEED V')  
        IF ((ROBODY(IBODY,MDBPPP) /= ROBODY(IBODY-1,MDBPPP)) .AND.&
         & (ROBODY(IBODY,MDBPPP) > 1.0_JPRB)) &
         & CALL ABOR1(' ERROR IN HRETR: V P-LEVEL DIFFERENT FROM U'')')  
      ENDIF

!*         4.2.5 Put psol guess in NCMRBPIO for CANARI

      IF(LCANARI .AND. ( &
       & IVNM == NVNUMB( 7) .OR. IVNM == NVNUMB(10) .OR. &
       & IVNM == NVNUMB(56) .OR. IVNM == NVNUMB(57) .OR. &
       & IVNM == NVNUMB(61) .OR. IVNM == NVNUMB(62) .OR. &
       & IVNM == NVNUMB(46) )) THEN
        ROBODY(IBODY,MDBRBPIO) = ZPSOL
      ENDIF

!*          4.2.6 Check that pressure is set, otherwise reject

      IF(.NOT.LCANARI .AND. ROBODY(IBODY,MDBPPP) <= 0 .AND. &
         & (ROBODY(IBODY,MDBVCO)) == 1) THEN  
        ROBODY(IBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(IBODY,MDBDSTA))
        ROBODY(IBODY,MDBDEV1) = ZCHEV1( ROBODY(IBODY,MDBDEV1),ND1EVENT(1))
      ENDIF
     
    ENDDO BODY_LOOP2

    IF(.NOT.LCANARI .AND. IOBSTYPE == NSCATT) THEN
      IF(ICMBDY(JOBS) < 4) THEN
        ROBHDR(JOBS,MDBRST) =ZCHSTAT_REJECT(ROBHDR(JOBS,MDBRST))
        ROBHDR(JOBS,MDBREV1)=ZCHEV1(ROBHDR(JOBS,MDBREV1),NR1EVENT( 3))
      ENDIF
    ENDIF

  ENDDO
ENDIF

!*          4.3   End for CANARI

IF(LCANARI) THEN
  CALL PUTDB('HRETR_CA', 0, IRET, INFO, 0, ZINFO, 0)
  IF (LHOOK) CALL DR_HOOK('HRETR',1,ZHOOK_HANDLE)
  RETURN
ENDIF

!****************************************
! Add loop for inversion of reflectivities


IF (IOBSTYPE == NRADAR) THEN ! do this only when radar obstype

  ICOUNT(:)=0
  DO IBODY=1,MLNKH2B(ILEN+1)-1
    IVNM = ROBODY(IBODY,MDBVNM)
    IF(IVNM == NVNUMB( 74)) THEN ! not the hardcoced 192, but NVNUMB !!
      JOBS = MBODYJOBS(IBODY)
      JBODY = IBODY + 1 - MLNKH2B(JOBS)
      ICOUNT(JOBS)=ICOUNT(JOBS)+1
      IPNLV(JOBS,ICOUNT(JOBS))=JBODY
    ENDIF
  ENDDO

  IMXCOUNT = MAXVAL(ICOUNT(1:ILEN))

  IF (IMXCOUNT > 0) THEN
! Add allocation for statistic inversion of radar reflectivities
    IDF = 2

    ALLOCATE(ZXPP(KDLEN,IMXCOUNT,IDF))

    IF (KHORIZ == 1) THEN

      CALL REFLSIM(KDLEN,KDBDY,ILEN,IMXCOUNT,ICOUNT,IPNLV,ZTF5,ZQF5,ZCLWF5,&
           & ZCIWF5,ZCSWF5,ZCRWF5,ZCGWF5,ZGEOPF5,IDF,ZXPP)

    ELSE

! call to the 2d_operator in order to inverse reflectivities

      ALLOCATE(ZXPP_2D(KDLEN,IMXCOUNT,IDF,KHORIZ))

      ZXPP(:,:,:)=0.0_JPRB
      CALL REFLSIM_2DOP(KDLEN,KDBDY,ILEN,KHORIZ,IMXCOUNT,ICOUNT,&
           &  IPNLV,ZTF5_2D,ZQF5_2D,&
           &  ZCLWF5_2D, ZCIWF5_2D,ZCSWF5_2D,ZCRWF5_2D,ZCGWF5_2D,&
           &  ZGEOPF5_2D,IDF,ZXPP_2D)

      ZRHMIN=-0.2_JPRB
      ZRHMAX=1.2_JPRB
      DO JPROF = 1, KHORIZ
        CALL GPRH(.TRUE.,KDLEN,1,ILEN,NFLEVG,ZRHMAX,ZRHMIN,&
             &  ZQF5_2D(1,1,JPROF),ZTF5_2D(1,1,JPROF),ZPXP5_2D(1,1,2,JPROF),ZPES(1,1,JPROF),ZPRH(1,1,JPROF))
      ENDDO

      CALL INV_REFL1DSTAT(KDLEN,KDBDY,ILEN,KHORIZ,IMXCOUNT,ICOUNT,&
           & IPNLV,ZTF5_2D,ZPRH(1,1,1),ZXPP_2D,ZGEOPF5_2D,ZPRESF5_2D,IDF)

      DEALLOCATE(ZXPP_2D)

    ENDIF ! condition on khoriz

    DEALLOCATE(ZXPP)
  ENDIF ! condition on imxcount
ENDIF
!*
!     ------------------------------------------------------------------
!*
!        5.       Preparation for radiances
!                 -------------------------

!*          5.1   Prepare model fields

IF(LL_RAD_OP) THEN
  ALLOCATE(ZPS5(KDLEN))
  IF( LRTTOV_INTERPOL )THEN
    CALL HRADP_ML(1,KDLEN,ILEN,KSET,ZNVANG,ZZEANG,ICOEF,&
     & ZPRESH5,ZTF5,ZQF5,&
     & ZLS5,ZCI5,ZPS5,ZTS5,ZT2M_TOVS5,ZQ2M_TOVS5,ZCTOP_TOVS5,ZCAMT_TOVS5) 
    ALLOCATE(ZTAU(KDLEN,IMXBDY,NFLEVG+1))
    ALLOCATE(ZRADCLDLEV(KDLEN,IMXBDY,NFLEVG+1))
  ELSE
    IF(SATGRP_TABLE(IGRP)%cld_rtcalc_screen)THEN
      CLPP='TVC'
      IDFS=NPNAV+2
    ELSE
      CLPP='TV1'
      IDFS=NPNAV-1
    ENDIF
    ALLOCATE(ZTQOPP5(KDLEN,NLSAT,IDFS))
    ALLOCATE(ZPRES(KDLEN,NLSAT))
    ALLOCATE(ZTAU(KDLEN,IMXBDY,NLSAT))
    ALLOCATE(ZRADCLDLEV(KDLEN,IMXBDY,NLSAT))

!*          5.1.1 Postprocess T, q and O3 to fix pressure levels

    ICOUNT(:)=NLSAT
    DO JLEV=1,NLSAT
      ZPRES(:,JLEV) = RADPRE(JLEV)
    ENDDO

    CALL PPOBSA(KDLEN,ILEN,NLSAT,CLPP,IOBSTYPE,ICOUNT,ZPRES,ZOROG5,&
     & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,&
     & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
     & IDFS,ZTQOPP5,YDGEMSPROF5=YLGEMSPROF5)

!*          5.1.2 Various other preparations


    CALL HRADP(1,KDLEN,ILEN,IDFS,KSET,ZOROG5,ZOROGOB,ZNVANG,ZZEANG,ICOEF,&
     & ZPRESH5,ZPRESF5,ZTF5,ZTSTAR5,ZT05,ZTQOPP5,&
     & ZLS5,ZCI5,ZPS5,ZTS5,ZT2M_TOVS5,ZQ2M_TOVS5,ZCTOP_TOVS5,ZCAMT_TOVS5)  

  ENDIF
ENDIF

!*          5.2   1D-Var for TOVS (obsolete)

!*          5.3    SSMI 1DVAR (obsolete)

!*          5.4    Rad-1C preparations
!*          5.4.1 Fill the input arrays with model values
!*          5.4.2 Estimate (and load into obs. array) bias/sdev 

IF(LLRAD1C) THEN

  OBS_LOOP_1C_A: DO JOBS= 1, ILEN

    IF( LRTTOV_INTERPOL )THEN
      IF( LVARBC )THEN
        CALL RAD1COBE(JOBS,IGRP,&
         & IDATOB(JOBS),ZLAT(JOBS),ISENSOR,IFOVOB(JOBS),ZBOAOB(JOBS),ZZEANG(JOBS),&
         & ZPIN, ZTIN, ZQIN, ZTS5(JOBS), ZU10IN, ZV10IN, ZPRED)  
      ELSE
        CALL ABOR1('HRETR: H&K-bias with interpolation in RTTOV not implemented') 
      ENDIF
    ELSE

      ZU10IN = ZUF5(JOBS,NFLEVG)              ! 10m u-component
      ZV10IN = ZVF5(JOBS,NFLEVG)              ! 10m v-component
      ZPIN(1:NLSAT) = ZPRES  (JOBS,1:NLSAT)   ! pressure prof
      ZTIN(1:NLSAT) = ZTQOPP5(JOBS,1:NLSAT,1) ! temperature prof
      ZQIN(1:NLSAT) = ZTQOPP5(JOBS,1:NLSAT,2) ! spec.hum. prof

      CALL RAD1COBE(JOBS,IGRP,&
       & IDATOB(JOBS),ZLAT(JOBS),ISENSOR,IFOVOB(JOBS),ZBOAOB(JOBS),ZZEANG(JOBS),&
       & ZPIN, ZTIN, ZQIN, ZTS5(JOBS), ZU10IN, ZV10IN, ZPRED)  

      SATPRED(JOBS,MDB1BCP9A) = ZPRED(1,1)
      SATPRED(JOBS,MDB1BCP10A)= ZPRED(2,1)
      SATPRED(JOBS,MDB1BCP11A)= ZPRED(3,1)
      SATPRED(JOBS,MDB1BCP12A)= ZPRED(4,1)
      SATPRED(JOBS,MDB1BCP15A)= ZPRED(5,1)
      SATPRED(JOBS,MDB1BCP16A)= ZPRED(6,1)

    ENDIF

    ZAZIANG(JOBS)    = SATHDR(JOBS,MDB_AZIMUTH_AT_SAT)! Satellite azimuth angle, for some
    ZSOLZENANG(JOBS) = SATHDR(JOBS,MDB_SOLAR_ZENITH_AT_SAT)! Solar zenith angle, always filled
    ZSOLAZIANG(JOBS) = SATHDR(JOBS,MDB_SOLAR_AZIMUTH_AT_SAT)! Solar azimuth angle, always filled
    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 OBS_LOOP_1C_A

!*          5.4.3 Variational bias correction

  ALLOCATE(ZVPOBS(KDLEN,IMXBDY))
  ZVPOBS(:,:)=RMDI
  ICOUNT(1:ILEN) = 0
  DO IBODY=1,MLNKH2B(ILEN+1)-1
    JOBS = MBODYJOBS(IBODY)
    JBODY = IBODY + 1 - MLNKH2B(JOBS)
    IF(ROBODY(IBODY,MDBPPP)  ==  20 .AND. ISENSOR == MSENSOR_HIRS ) CYCLE      ! Radiance datum not hirs 20
    IF(ROBODY(IBODY,MDBVNM) == NVNUMB(50) .AND. ROBODY(IBODY,MDBVAR) /= RMDI) THEN ! Radiance datum
      ICOUNT(JOBS)=ICOUNT(JOBS)+1        
      ZVPOBS(JOBS,ICOUNT(JOBS))=ROBODY(IBODY,MDBPPP)
    ENDIF
  ENDDO

  IF (lvarbc) THEN
    ALLOCATE(ZVARBC(KDLEN,IMXBDY),ZXPRED(0:JPMXNPRED,ILEN), &
             & ZOMF(KDLEN,IMXBDY),IXVARBC(KDLEN,IMXBDY))
    ZOMF(:,:)=RMDI
    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)
      JBODY = IBODY + 1 - MLNKH2B(JOBS)
      IXVARBC(JOBS,JBODY) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
    ENDDO

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

    CALL VARBC_BIAS (IXVARBC, IMXBDY, ICOUNT, KDLEN, ILEN, &
     & JPMXNPRED, ZXPRED, ZOMF, ZVARBC)

    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)
      JBODY = IBODY + 1 - MLNKH2B(JOBS)
      IF(ROBODY(IBODY,MDBPPP)  ==  20 .AND. ISENSOR == MSENSOR_HIRS ) CYCLE      ! Radiance datum not hirs 20
      IF(ROBODY(IBODY,MDBVNM) == NVNUMB(50) .AND. ROBODY(IBODY,MDBVAR) /= RMDI) THEN ! Radiance datum
        ROBODY(IBODY,MDB_BIASCTRL_AT_BODY) = ZVARBC(JOBS,JBODY)
        ROBODY(IBODY,MDBTORB)              = ZVARBC(JOBS,JBODY)
      ENDIF
    ENDDO
    DEALLOCATE(ZVARBC,ZXPRED,ZOMF,IXVARBC)
  ENDIF


!*          5.4.3 Estimate (and load into obs. array) surface emissivity values

  OBS_LOOP_1C_B: DO JOBS= 1, ILEN
    ZU10IN = ZUF5(JOBS,NFLEVG)              ! 10m u-component
    ZV10IN = ZVF5(JOBS,NFLEVG)              ! 10m v-component
    ZORIN  = ZOROG5(JOBS)/RG                ! orography (in metres)
    ZWSIN  = ZWS5(JOBS)*1000._JPRB          ! soil wetness
    ZSNIN  = ZSN5(JOBS)*1000._JPRB          ! snow depth

    ISUR_M=0
    ZBATS_VEG=0

    IF (L_SCREEN_CALL) THEN

     CALL RAD1CEMIS(JOBS,ISENSOR,ZNVANG(JOBS),ZZEANG(JOBS),&
                   & ZLS5(JOBS),ZTS5(JOBS),ZCI5(JOBS),&
                   & ZSNIN,ZWSIN,ZLAT(JOBS),ZLON(JOBS),IFOVOB(JOBS),&
                   & .FALSE.,ISUR_M,ZBATS_VEG)
    ENDIF
!*          5.4.4 Load into obs. array other variables for feedback

    SATPRED(JOBS,MDB_LSM) = ZLS5(JOBS)
    IF(ZORIN < 10000._JPRB) &
     & SATPRED(JOBS,MDB_OROGRAPHY) = MAX(ZORIN,0.0_JPRB)  
    SATPRED(JOBS,MDB1BCP3A) = ZTS5(JOBS)
    SATPRED(JOBS,MDB_SNOW_DEPTH) = MIN(ZSNIN,10._JPRB)
    SATPRED(JOBS,MDB1BCP5A) = ISUR_M/100. 
    SATPRED(JOBS,MDB_T2M) = ZT2M_TOVS5(JOBS)
    SATPRED(JOBS,MDB_ALBEDO) = ZAL5(JOBS)
    SATPRED(JOBS,MDB_WINDSPEED10M) = SQRT(ZU10IN**2 + ZV10IN**2)         

!*          6.4.2 REJECT FOR RAIN FLAG  AMSU CHAN 4 ,5

    IF (ISUR_M >= 11 .AND. ISUR_M <= 12 .AND. ISENSOR == MSENSOR_AMSUA) THEN  !reject coast, rain

      DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
        IF(ROBODY(JBODY,MDBVNM) /= NVNUMB(50)) CYCLE
        ICHAN=NINT(ROBODY(JBODY,MDBPPP))
        IF(ICHAN >  4 .AND. ICHAN < 7 )  THEN
          ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(JBODY,MDBDSTA))
          ROBODY(JBODY,MDBDEV1) = ZCHEV1( ROBODY(JBODY,MDBDEV1),ND1EVENT(13))
        ENDIF
      ENDDO
    ENDIF

!*          6.4.2 REJECT BAD AQUA OBSERVATIONS: IF BAD ZENITH ANGLE REJECT ALL AMSUA CHANNELS

    IF((ISENSOR == MSENSOR_AMSUA) .AND. (ISATID==20)) THEN

      ZSWATH_WIDTH_AMSUA=48.333333_JPRB*RADIANS
      ZFOV_SPACING_AMSUA=3.333333_JPRB*RADIANS
      ZANG_SCAN_AMSUA=-ZSWATH_WIDTH_AMSUA+(IFOVOB(JOBS)-1)*ZFOV_SPACING_AMSUA

      ZANG_ZENI_AMSUA = ABS(ASIN( SIN(ZANG_SCAN_AMSUA) *(RA+ZHSAT_AQUA)/RA))*RDEGREES
 
      IF(ABS(ZZEANG(JOBS)-ZANG_ZENI_AMSUA) > 5) THEN  
        DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
          IF(ROBODY(JBODY,MDBVNM) /= NVNUMB(50)) CYCLE
          ROBODY(JBODY,MDBVAR)=RMDI 
          ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(JBODY,MDBDSTA))
          ROBODY(JBODY,MDBDEV1) = ZCHEV1( ROBODY(JBODY,MDBDEV1),ND1EVENT(13))
        ENDDO
      ENDIF
    ENDIF

!*          5.4.3 REJECT FOR CLOUDS/RAIN AND LAND/SEAICE SSMI,AMSRE,TMI

    IF((ISUR_M >= 10 .AND. ISUR_M <= 12) &
     &   .AND. (     ISENSOR == MSENSOR_SSMI  &
     &          .OR. ISENSOR == MSENSOR_AMSRE &
     &          .OR. ISENSOR == MSENSOR_TMI )     ) THEN

      DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
        IF(ROBODY(JBODY,MDBVNM) /= NVNUMB(50)) CYCLE
        ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(JBODY,MDBDSTA))
        ROBODY(JBODY,MDBDEV1) = ZCHEV1( ROBODY(JBODY,MDBDEV1),ND1EVENT(13))
      ENDDO
    ENDIF                                                                          
!*          5.4.4 REJECT FOR CLOUDS/RAIN AND LAND/SEAICE SSMIS

    IF((ISUR_M >= 10 .AND. ISUR_M <= 13) .AND. ISENSOR == MSENSOR_SSMIS ) THEN

      DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
        IF(ROBODY(JBODY,MDBVNM) /= NVNUMB(50)) CYCLE
        ICHAN=NINT(ROBODY(JBODY,MDBPPP))
        IF(      ( ICHAN <= 4 .AND. ISUR_M >= 11 ) &     ! AMSUA-like channels
          & .OR. ( ICHAN >= 8 .AND. ICHAN <= 18 ) )  THEN! SSMI-like channels
          ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(JBODY,MDBDSTA))
          ROBODY(JBODY,MDBDEV1) = ZCHEV1( ROBODY(JBODY,MDBDEV1),ND1EVENT(13))
        ENDIF
      ENDDO
    ENDIF                                                                                                             
!*          5.4.7 REJECT SEVIRI DATA CONSIDERING CLOUD PRODUCTS FROM CMS
                                                                                                              
    IF( ISENSOR == MSENSOR_MSG_HR ) THEN
                                                                                                              
      ICLDTYPE   = INT(SATHDR(JOBS,MDB_CLDNE1_AT_ATOVS))   ! Cld type as computed by CMS
      ICLDTYPEQF = INT(SATHDR(JOBS,MDB_CLDNE2_AT_ATOVS))
      ICLDTYPEQF = IBITS(ICLDTYPEQF,7,2)                   ! Quality of the processing
                                                                                                              
      DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
        IF(ROBODY(JBODY,MDBVNM) /= NVNUMB(50)) CYCLE
        ICHAN=NINT(ROBODY(JBODY,MDBPPP))                ! Channel number
                                                                                                              
        IF( ICLDTYPEQF /= 1 .OR. &
           & ((ICHAN == 2 .OR. ICHAN == 3) .AND. (ICLDTYPE == 0 .OR. ICLDTYPE == 3 .OR. ICLDTYPE == 4 .OR. &
           &                    ICLDTYPE >= 9)) .OR. &
           & ((ICHAN == 1 .OR. ICHAN == 4 .OR. ICHAN == 5 .OR. ICHAN == 6 .OR. ICHAN == 7 .OR. ICHAN == 8).AND. &
           &  (ICLDTYPE /= 1 .AND. ICLDTYPE /= 2))) THEN
                                                                                                              
           ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(JBODY,MDBDSTA))
           ROBODY(JBODY,MDBDEV1) = ZCHEV1( ROBODY(JBODY,MDBDEV1),ND1EVENT(13))
        ENDIF
                                                                                                              
      ENDDO
    ENDIF

!*          5.4.8 REJECT SEVIRI CSR DATA CONSIDERING PERCENTAGE OF CLEAR AIR

    IF( LMFSCREEN .AND. (ISENSOR == MSENSOR_MSG) ) THEN

       DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
          IF(ROBODY(JBODY,MDBVNM) /= NVNUMB(50)) CYCLE
          ZCLEAR   = ROBODY(JBODY,MDBPRL)
          IF (ZCLEAR < 70.) THEN
             ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(JBODY,MDBDSTA))
             ROBODY(JBODY,MDBDEV1) = ZCHEV1( ROBODY(JBODY,MDBDEV1),ND1EVENT(13))
          ENDIF
       ENDDO
    ENDIF

  ENDDO OBS_LOOP_1C_B

!*          6.   Surface emissivity/skin temp. computation 

  IF (      LDYN_EMIS(ISENSOR) .OR. LDYN_TSKIN(ISENSOR) &
   &   .OR. LATLAS_EMIS(ISENSOR).OR.&
   & ((ISENSOR==MSENSOR_AIRS).AND.LCO2_DIAG_AIRS) ) THEN

    ALLOCATE(ZTBCLR(KDLEN,IMXBDY))
    ALLOCATE(ZTBTOT(KDLEN,IMXBDY))
    ALLOCATE(ZEM5(KDLEN,IMXBDY))
    ALLOCATE(ZOBS(KDLEN,IMXBDY))
    ALLOCATE(ZVAROUT(KDLEN,IMXBDY,4))
    ALLOCATE(IC2I(KDLEN,SATGRP_TABLE(IGRP)%nrtchannels)) 
    ALLOCATE(LLQCATLAS(KDLEN))

    ZEM5(1:ILEN,:)=1.0_JPRB
    ZVPOBS = RMDI
    IC2I   = RMDI
    ZOBS   = RMDI

    ICOUNT(1:ILEN) = 0
    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)

      IF(ROBODY(IBODY,MDBVNM) == NVNUMB(50)) THEN       ! Radiance datum
        ZOBSV=ROBODY(IBODY,MDBVAR)
        ZBIAS = ROBODY(IBODY, MDBTORB)
        IF(ZOBSV /= RMDI) THEN
          ICOUNT(JOBS)=ICOUNT(JOBS)+1                   ! Count rad. data
          ZVPOBS(JOBS,ICOUNT(JOBS))=ROBODY(IBODY,MDBPPP)
          ZOBS (JOBS,ICOUNT(JOBS)) = ZOBSV
          SATBODY(IBODY,MDB_MWEMIS_SAT1)=ROBODY(IBODY,MDBPER) !* old emis 
          !emissivity atlas is passed for Tskin retrievals to RADTR()
          !through ZEM5. It was filled in RAD1CEMIS() subroutine.
          IF (ZLS5(JOBS) >= 0.01_JPRB) THEN
            !over land and land-sea mixture, initialize ZEM5 with
            !"dummy" emissivity. It will substitute missing atlas cases
            !for Tskin retrievals, but will be later replaced with
            !dynamic emissivies.
            ZEM5(JOBS,ICOUNT(JOBS)) = &
                   & 0.55_JPRB * (1.0_JPRB-ZLS5(JOBS)) + &
                   & 0.95_JPRB * ZLS5(JOBS)
          ELSE
            !over sea, set to "old" emissivity (i.e 2.0)
            ZEM5(JOBS,ICOUNT(JOBS))=ROBODY(IBODY,MDBPER)
          ENDIF
          IF( ZLS5(JOBS) > 0.8_JPRB) THEN
            ZATLAS_EMIS = SATBODY(IBODY,MDB_MWEMIS_ATLAS1)
            IF (ZATLAS_EMIS>0.1_JPRB .AND. ZATLAS_EMIS<=1.0_JPRB) THEN
              !use sensible atlas values for Tskin retrievals,
              ZEM5(JOBS,ICOUNT(JOBS)) = ZATLAS_EMIS
            ENDIF
          ENDIF
        ENDIF
      ENDIF
    ENDDO

    !At this point, ZEM5 contains:
    !  * 2.0 for land<0.01
    !  * "dummy" emissivity for 0.01<=land<0.8
    !  * atlas (if available) for land<=0.8, dummy emis. otherwise


!*          6.2   Interface to the actual radiation code : RTTOV-9
!*                + CO2 slicing

    !store integrated cloud liquid/ice water in ODB;
    !clw and ciw are used for AMSU cloud screening

    DO JOBS = 1, ILEN
      SATHDR(JOBS,MDB_CLW_AT_ATOVS) = 0.0_JPRB
      SATHDR(JOBS,MDB_CIW_AT_ATOVS) = 0.0_JPRB
      DO JLEV = 1, NFLEVG
        SATHDR(JOBS,MDB_CLW_AT_ATOVS) = SATHDR(JOBS,MDB_CLW_AT_ATOVS) + &
           & (ZPRESH5(JOBS,JLEV) - ZPRESH5(JOBS,JLEV-1))* ZCLWF5(JOBS,JLEV)
        SATHDR(JOBS,MDB_CIW_AT_ATOVS) = SATHDR(JOBS,MDB_CIW_AT_ATOVS) + &
           & (ZPRESH5(JOBS,JLEV) - ZPRESH5(JOBS,JLEV-1))* ZCIWF5(JOBS,JLEV)
      ENDDO
      SATHDR(JOBS,MDB_CLW_AT_ATOVS) = SATHDR(JOBS,MDB_CLW_AT_ATOVS) / RG
      SATHDR(JOBS,MDB_CIW_AT_ATOVS) = SATHDR(JOBS,MDB_CIW_AT_ATOVS) / RG
    ENDDO


    IF (.NOT.LECMWF) THEN
      ZCCF5  = 0.0_JPRB
      ZCLWF5 = 0.0_JPRB
      ZCIWF5 = 0.0_JPRB
    ENDIF

    IF( LRTTOV_INTERPOL )THEN

      CALL RADTR_ML(ICOEF,ISENSOR,KDLEN,ILEN,IMXBDY,ICOUNT,ZVPOBS,&
       & SATGRP_TABLE(IGRP)%cld_rtcalc_screen,&
       & ZZEANG,ZAZIANG,ZSOLZENANG,ZSOLAZIANG,ZLAT,ZOROG5,&
       & ZPRESF5,ZTF5,ZQF5,ZO3F5,ZCLWF5,ZCIWF5,ZCCF5,YLGEMSPROF5,&
       & ZPS5,ZTS5,ZLS5,ZT2M_TOVS5,ZQ2M_TOVS5,&
       & ZCTOP_TOVS5,ZCAMT_TOVS5,ZUF5(1,NFLEVG),ZVF5(1,NFLEVG),ZEM5,&
       & ZTBCLR, ZTBTOT, ZTAU, ZRADCLDLEV, POBS = ZOBS, PVAROUT = ZVAROUT)

    ELSE

      CALL RADTR(ICOEF,ISENSOR,KDLEN,ILEN,IDFS,IMXBDY,ICOUNT,ZVPOBS,&
       & SATGRP_TABLE(IGRP)%cld_rtcalc_screen,&
       & ZZEANG,ZAZIANG,ZSOLZENANG,ZSOLAZIANG,ZLAT,ZOROG5,&
       & ZTQOPP5,YLGEMSPROF5,ZPS5,ZTS5,ZLS5,ZT2M_TOVS5,ZQ2M_TOVS5,&
       & ZCTOP_TOVS5,ZCAMT_TOVS5,ZUF5(1,NFLEVG),ZVF5(1,NFLEVG),ZEM5,&
       & ZTBCLR, ZTBTOT, ZTAU, ZRADCLDLEV, POBS = ZOBS, PVAROUT = ZVAROUT)

       ZEFF_PTOP(:,3)=ZCTOP_TOVS5
       ZEFF_NE(:,3)=  ZCAMT_TOVS5

    ENDIF

   IF (      LDYN_EMIS(ISENSOR) .OR. LDYN_TSKIN(ISENSOR) &
   &   .OR. LATLAS_EMIS(ISENSOR)) THEN

    ! Available emissivities at this point:
    !   * FASTEM for land<0.01 and seaice<0.5 in ZVAROUT(3,:)
    !   * Kelly&Bauer emissivity over seaice>0.5 (in pers_error@errstat)
    !   * dynamic emissivity (or RMDI in some cases!) everywhere - ZVAROUT(2,:)
    !   * atlas in SATBODY(:,MDB_MWEMIS_ATLAS1) for land > 0.8, RMDI otherwise

!*          6.3   Update emissivities

    IQC_CHAN = -1
    IF (ISENSOR==MSENSOR_AMSUA) THEN
      IQC_CHAN = 3
    ELSEIF (ISENSOR==MSENSOR_AMSUB .OR. ISENSOR==MSENSOR_MHS) THEN
      IQC_CHAN = 2
    ENDIF

    ! First pass through data:
    !  * map channel numbers (ICHAN) to the ZVAROUT array indexes (IC2I)
    !    (ZVAROUT array contains retrieved emissivities but only for non-missing
    !    channels, therefore channel number cannot be used as an index)
    !  * check if atlas emissivity is available for QC channel.

    IC2I(:,:) = -1
    LLQCATLAS (1:ILEN) = .FALSE.

    ICOUNT(1:ILEN) = 0
    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)
      IF (ROBODY(IBODY,MDBVNM)==NVNUMB(50)) THEN             ! Radiance datum
        ICHAN = NINT(ROBODY(IBODY,MDBPPP))
        ZOBSV = ROBODY(IBODY,MDBVAR)
        IF (ZOBSV /= RMDI) THEN
          ICOUNT(JOBS) = ICOUNT(JOBS)+1                      ! Count rad. data
          IC2I(JOBS,ICHAN) = ICOUNT(JOBS)
        ENDIF
        IF (ICHAN==IQC_CHAN) THEN
          ZATLAS_EMIS = SATBODY(IBODY,MDB_MWEMIS_ATLAS1)
          IF (ZATLAS_EMIS > 0.01_JPRB .AND. ZATLAS_EMIS <= 1.00_JPRB) THEN
            LLQCATLAS(JOBS) = .TRUE.
          ENDIF
        ENDIF
      ENDIF
    ENDDO

    ! second pass: assign emissivity for each radiance datum

    ICOUNT(1:ILEN) = 0
    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)

      IF(ROBODY(IBODY,MDBVNM) == NVNUMB(50)) THEN            ! Radiance datum
        ICHAN = NINT(ROBODY(IBODY,MDBPPP))                   ! Chan number from body
        ZOBSV = ROBODY(IBODY,MDBVAR)

        IF(ZOBSV /= RMDI) THEN
          ICOUNT(JOBS) = ICOUNT(JOBS)+1                      ! Count rad. data

          IF (ZLS5(JOBS) >= 0.01_JPRB) THEN

            ! get dummy emissivity
            ZDUMMY_EMIS = 0.55_JPRB * (1.0_JPRB-ZLS5(JOBS)) + 0.95_JPRB * ZLS5(JOBS)

            ! get atlas emissivity, but only for land fraction > 0.8
            ZATLAS_EMIS = RMDI
            IF (ZLS5(JOBS) > 0.8) THEN
              ZATLAS_EMIS = SATBODY(IBODY,MDB_MWEMIS_ATLAS1)   ! can be RMDI
            ENDIF

            ! get dynamic emissivity
            ZEMIS_NEW = RMDI
            IEMIS_CHAN = MEMIS_CHAN(ISENSOR,ICHAN)
            IF (IEMIS_CHAN >= 1 .AND. IEMIS_CHAN <= IMXBDY) THEN
              IF (IC2I(JOBS,IEMIS_CHAN) >= 1) THEN
                ZEMIS_NEW = ZVAROUT(JOBS,IC2I(JOBS,IEMIS_CHAN),2) !can be RMDI
              ENDIF
            ENDIF

            ! Dynamic emissivity option:
            ! pers_error@errstat (which is filled with K&B emissivities
            ! at this point) will be filled either with dynamic emissivity (if
            ! sensible), atlas (if sensible) or "dummy" emissivity as a last
            ! resort.

            IF (LDYN_EMIS(ISENSOR)) THEN

              IF (ZEMIS_NEW > 0.01_JPRB .AND. ZEMIS_NEW <= 1.0_JPRB &
                & .AND. ICHAN/=IEMIS_CHAN) THEN
                ROBODY(IBODY,MDBPER) = ZEMIS_NEW
                ! If atlas available - use it to check dynamic emissivity
                IF (ZATLAS_EMIS > 0.01_JPRB .AND. ZATLAS_EMIS <= 1.0_JPRB) THEN
                  IF (ABS(ZEMIS_NEW-ZATLAS_EMIS) > 0.2_JPRB) THEN
                    ROBODY(IBODY,MDBPER) = ZATLAS_EMIS
                  ENDIF
                ENDIF
              ELSEIF (ZATLAS_EMIS > 0.01_JPRB .AND. ZATLAS_EMIS <= 1.0_JPRB) THEN
                ROBODY(IBODY,MDBPER) = ZATLAS_EMIS
              ENDIF

            ENDIF

            ! Atlas or dynamic skin temperature option:
            ! pers_error@errstat (filled with K&B emissivities
            ! at this point) will be filled either with atlas emissivity (if
            ! sensible), dynamic emissivity (if sensible) or "dummy" emissivity
            ! as a last resort.

            IF (LATLAS_EMIS(ISENSOR) .OR. LDYN_TSKIN(ISENSOR)) THEN

              IF (ZATLAS_EMIS > 0.01_JPRB .AND. ZATLAS_EMIS <= 1.0_JPRB) THEN
                !use atlas where available (never available for 0.01<land<0.8)
                ROBODY(IBODY,MDBPER) = ZATLAS_EMIS


              ELSE
                IF (ZEMIS_NEW > 0.01_JPRB .AND. ZEMIS_NEW <= 1.0_JPRB ) THEN
                  !use dyn.emis. for missing atlas (in particular for 0.01<land<0.8)
                  ROBODY(IBODY,MDBPER) = ZEMIS_NEW
                ELSE
                  !both atlas and dyn. emissivity is missing -
                  !use "dummy" emissivity, reject surface sensitive channels.
                  IF ((ISENSOR==MSENSOR_AMSUA .AND. ICHAN<=7) &
                  & .OR. ISENSOR==MSENSOR_AMSUB &
                  & .OR. ISENSOR==MSENSOR_MHS) THEN
                    ROBODY(IBODY,MDBPER)  = ZDUMMY_EMIS
                    ROBODY(IBODY,MDBDEV1) = ZCHEV1(ROBODY(IBODY,MDBDEV1),ND1EVENT(3))
                    ROBODY(IBODY,MDBDSTA) = ZCHSTAT_REJECT(ROBODY(IBODY,MDBDSTA))
                  ENDIF
                ENDIF
              ENDIF
            ENDIF

          ENDIF !land/coast


          ! In any case, store results in the ODB

          SATBODY(IBODY,MDB_MWEMIS_SAT2)=ZVAROUT(JOBS,ICOUNT(JOBS),2) !* dynamic emis
          IF(   ROBODY(IBODY,MDBPER) > 1.5_JPRB &
           & .OR. ROBODY(IBODY,MDBPER) < 0.01_JPRB)THEN
            SATBODY(IBODY,MDB_MWEMIS_SAT1)=ZVAROUT(JOBS,ICOUNT(JOBS),3) !* include fastem emis
          ENDIF
          IF (SATBODY(IBODY,MDB_MWEMIS_ATLAS1) /= RMDI .OR. ROBODY(IBODY,MDBPER) > 1.5_JPRB) THEN
            !store retrieved skin temperature for non-missing atlas cases and over sea
            SATBODY(IBODY,MDB_MWSKIN2)=ZVAROUT(JOBS,ICOUNT(JOBS),1)
          ELSE
            !discard skin temperature retrieved with "dummy" emissivity
            SATBODY(IBODY,MDB_MWSKIN2)=RMDI
          ENDIF
          SATBODY(IBODY,MDB_MWSKIN1)=ZTS5(JOBS) !* Old Ts
          SATBODY(IBODY,MDB_MWATMO_TRANS)=ZVAROUT(JOBS,ICOUNT(JOBS),4) !* atmospheric transmissivity


          ! update skin temperature for the dynamic skin temperature
          ! option for non-missing atlas cases over land>0.8

          IF (LDYN_TSKIN(ISENSOR)) THEN
            ITSKIN_CHAN=MTSKIN_CHAN(ISENSOR)
            IF (ICHAN==ITSKIN_CHAN) THEN
              IF (ZLS5(JOBS)>0.8_JPRB) THEN
                IF (SATBODY(IBODY,MDB_MWEMIS_ATLAS1) > 0.01_JPRB &
                & .AND. SATBODY(IBODY,MDB_MWEMIS_ATLAS1) <= 1.0_JPRB) THEN
                  IPOSM = ROBHDR(JOBS,MDB_MAPOMM_AT_INDEX)
                  IF (IC2I(JOBS,ITSKIN_CHAN)<1 .OR. IC2I(JOBS,ITSKIN_CHAN)>IMXBDY) THEN
                    CALL ABOR1('HRETR: Invalid array index')
                  ENDIF
                  ZSKIN_NEW = ZVAROUT(JOBS,IC2I(JOBS,ITSKIN_CHAN),1)
                  IF ((ZSKIN_NEW > 90.0_JPRB).and.(ZSKIN_NEW < 360.0_JPRB)) THEN
                    SATPRED(JOBS,MDB1BCP11A)= ZSKIN_NEW
                    SATPRED(JOBS,MDB1BCP3A) = ZSKIN_NEW
                    YGOMS(IPOSM)%TS = ZSKIN_NEW
                  ENDIF
                ENDIF
              ENDIF
            ENDIF
          ENDIF


        ENDIF
      ENDIF
    ENDDO
    ENDIF   


    IF (ALLOCATED(ZEM5)) DEALLOCATE(ZEM5)
    IF (ALLOCATED(ZTBCLR)) DEALLOCATE(ZTBCLR)
    IF (ALLOCATED(ZTBTOT)) DEALLOCATE(ZTBTOT)
    IF (ALLOCATED(ZOBS)) DEALLOCATE(ZOBS)
    IF (ALLOCATED(ZVAROUT)) DEALLOCATE(ZVAROUT)
    IF (ALLOCATED(IC2I)) DEALLOCATE(IC2I)
    IF (ALLOCATED(LLQCATLAS)) DEALLOCATE(LLQCATLAS)

  ENDIF ! IF (amsua, amsub, mhs, ssmi, ...) THEN ...

!*          7.     Cloudy radiance computation (1c TOVS and ATOVS only)



  IF (LRTCALC_HRETR(ISENSOR)) THEN

!*          7.1    Various preparations

    ALLOCATE(ZTBCLR(KDLEN,IMXBDY))
    ALLOCATE(ZTBTOT(KDLEN,IMXBDY))
    ALLOCATE(ZCLDLEV(KDLEN,IMXBDY))
    ALLOCATE(ZEM5(KDLEN,IMXBDY))
    ALLOCATE(ZOBSC(KDLEN,IMXBDY))

    ALLOCATE(ICLDFLG(KDLEN,IMXBDY))
    ALLOCATE(ZOBS(KDLEN,IMXBDY))
    ALLOCATE(ZTAUSFC(KDLEN,IMXBDY))

    ZEM5(1:ILEN,:)=1.0_JPRB
    ZVPOBS = RMDI
    ZOBS   = RMDI
    ZOBSC  = RMDI
    ZTBCLR = RMDI
    ZTBTOT = RMDI
    ZCLDLEV= RMDI
    ZTAUSFC  = RMDI
    ICLDFLG= 0

    ICOUNT(1:ILEN) = 0
    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)


      IF(ROBODY(IBODY,MDBVNM) == NVNUMB(50)) THEN       ! Radiance datum
        IF(ROBODY(IBODY,MDBPPP)  ==  20 .AND. ISENSOR == MSENSOR_HIRS ) CYCLE      ! Radiance datum not hirs 20
        ZOBSV=ROBODY(IBODY,MDBVAR)
        IF(ZOBSV /= RMDI) THEN
          ICOUNT(JOBS)=ICOUNT(JOBS)+1                     ! Count rad. data
          ZVPOBS(JOBS,ICOUNT(JOBS))=ROBODY(IBODY,MDBPPP)
          ZEM5  (JOBS,ICOUNT(JOBS))=ROBODY(IBODY,MDBPER)  ! Emissivity
          ZBIAS                    =ROBODY(IBODY,MDBTORB)
          ZOBS  (JOBS,ICOUNT(JOBS))=ZOBSV
          ZOBSC (JOBS,ICOUNT(JOBS))=ZOBSV-ZBIAS

!* to avoid mismatch between preset emissivities and land/sea flag b/w loops
          IF (ZEM5(JOBS,ICOUNT(JOBS)) > 1.0_JPRB .AND. ZLS5 (JOBS) >= 0.01_JPRB) THEN
            ZEM5(JOBS,ICOUNT(JOBS))=1.0_JPRB
            ROBODY(IBODY,MDBFOE)=999.0_JPRB
          ENDIF
        ENDIF
      ENDIF
    ENDDO


!*          7.2.1  Interface to the actual radiation code : RTTOV

    IF (.NOT.LECMWF) THEN
      ZCCF5  = 0.0_JPRB
      ZCLWF5 = 0.0_JPRB
      ZCIWF5 = 0.0_JPRB
    ENDIF


    IF( LRTTOV_INTERPOL )THEN

      CALL RADTR_ML(ICOEF,ISENSOR,KDLEN,ILEN,IMXBDY,ICOUNT,ZVPOBS,&
       & SATGRP_TABLE(IGRP)%cld_rtcalc_screen,&
       & ZZEANG,ZAZIANG,ZSOLZENANG,ZSOLAZIANG,ZLAT,ZOROG5,&
       & ZPRESF5,ZTF5,ZQF5,ZO3F5,ZCLWF5,ZCIWF5,ZCCF5,YLGEMSPROF5,&
       & ZPS5,ZTS5,ZLS5,ZT2M_TOVS5,ZQ2M_TOVS5,&
       & ZCTOP_TOVS5,ZCAMT_TOVS5,ZUF5(1,NFLEVG),ZVF5(1,NFLEVG),ZEM5,&
       & ZTBCLR, ZTBTOT, ZTAU, ZRADCLDLEV, ZCLDLEV, PTAUSFC = ZTAUSFC)

    ELSE

      CALL RADTR(ICOEF,ISENSOR,KDLEN,ILEN,IDFS,IMXBDY,ICOUNT,ZVPOBS,&
       & SATGRP_TABLE(IGRP)%cld_rtcalc_screen,&
       & ZZEANG,ZAZIANG,ZSOLZENANG,ZSOLAZIANG,ZLAT,ZOROG5,&
       & ZTQOPP5,YLGEMSPROF5,ZPS5,ZTS5,ZLS5,ZT2M_TOVS5,ZQ2M_TOVS5,&
       & ZCTOP_TOVS5,ZCAMT_TOVS5,ZUF5(1,NFLEVG),ZVF5(1,NFLEVG),ZEM5,&
       & ZTBCLR, ZTBTOT, ZTAU, ZRADCLDLEV, ZCLDLEV, PTAUSFC = ZTAUSFC)

    ENDIF

!*          7.2.2  Neural network bias correction for AIRS

    IF(LNNBC .AND. ISENSOR == MSENSOR_AIRS) THEN
      ALLOCATE(ZNNBIAS(ILEN,IMXBDY))
      CALL RAD1CNNE(ILEN,IMXBDY,ZVPOBS(1:ILEN,:),ZNNBIAS)
    ENDIF
    
!*          7.2.3 AIRS cloud detection using band-ranked channels 
 
    IF (ISENSOR == MSENSOR_AIRS  .OR. ISENSOR == MSENSOR_IASI) THEN 
      DO JOBS = 1,ILEN
        IF( LRTTOV_INTERPOL ) THEN
           IMINLEV(:) = MAXLOC( ZPRESF5(JOBS,:) , &
             & MASK =  (ZPRESF5(JOBS,:)/100.0_JPRB < 200._JPRB) )
           IF (ANY(ZPRESF5(JOBS,:)/100.0_JPRB > 900._JPRB)) THEN
              IMAXLEV(:) = MINLOC( ZPRESF5(JOBS,:) , &
             & MASK =  (ZPRESF5(JOBS,:)/100.0_JPRB > 900._JPRB) )
           ELSE
              IMAXLEV(1) = NFLEVG+1
           ENDIF
        ELSE
           IMINLEV(:) =  MAXLOC( RADPRE(:) , &
             & MASK = ( RADPRE(:)/100.0_JPRB < 200._JPRB ))
           IF (ANY(RADPRE(:)/100.0_JPRB > 900._JPRB)) THEN
              IMAXLEV(:) = &
             & MINLOC( RADPRE(:) , MASK =  (RADPRE(:)/100.0_JPRB > 900._JPRB ))
           ELSE
              IMAXLEV(1) = NLSAT+1
           ENDIF
        ENDIF

        CALL CLOUD_DETECT(ISENSOR, IMXBDY,&
             & NINT(ZVPOBS(JOBS,:)),                          &
             & ZTBCLR(JOBS,:),ZOBSC(JOBS,:),                  &
             & ZCLDLEV(JOBS,:),ICLDFLG(JOBS,:),IMINLEV(1), IMAXLEV(1))  
      ENDDO
    ENDIF

!*          7.2.5 HIRS cloud detection  

    IF (ISENSOR == MSENSOR_HIRS) THEN
      DO JOBS = 1,ILEN
        LLCHANMISS=.FALSE.
        DO ICHAN=1,15
          IF(NINT(ZVPOBS(JOBS,ICHAN))/=ICHAN) LLCHANMISS=.TRUE.
        ENDDO
        IF(.NOT.LLCHANMISS)THEN
          CALL HIRS_CLD(IMXBDY,ZOBSC(JOBS,:)-ZTBCLR(JOBS,:),  &
           &            ZT05(JOBS), ICLDFLG(JOBS,:))
        ELSE
          WRITE(NULERR,*)'HRETR-WARNING: Missing channels for HIRS cloud detect'
        ENDIF
      ENDDO
    ENDIF
!*          6.2.6 IRAS cloud detection

    IF (ISENSOR == MSENSOR_IRAS) THEN
      DO JOBS = 1,ILEN
        LLCHANMISS=.FALSE.
        DO ICHAN=1,15
          IF(NINT(ZVPOBS(JOBS,ICHAN))/=ICHAN) LLCHANMISS=.TRUE.
        ENDDO
        IF(.NOT.LLCHANMISS)THEN
          CALL IRAS_CLD(IMXBDY,ZOBSC(JOBS,:)-ZTBCLR(JOBS,:),  &
           &            ZT05(JOBS), ICLDFLG(JOBS,:))
        ELSE
          WRITE(NULERR,*)'HRETR-WARNING: Missing channels for IRAS cloud detect'
        ENDIF
      ENDDO
    ENDIF

!*          6.2.7 HIRS, AIRS and IASI cloud parameter estimation                        
    
    IF(LTOVSCV .AND. LCLDSINK) THEN
      IF (      ISENSOR == MSENSOR_AIRS  &
       &   .OR. ISENSOR == MSENSOR_IASI  &
       &   .OR. ISENSOR == MSENSOR_HIRS  &
       &   .OR. ISENSOR == MSENSOR_IRAS ) THEN
       DO JOBS = 1,ILEN
                  
         CALL CLOUD_ESTIMATE(ISENSOR, IMXBDY,&
             & NINT(ZVPOBS(JOBS,:)),NFLEVG+1,                        &
             & ZTBCLR(JOBS,:),ZOBSC(JOBS,:),ZRADCLDLEV(JOBS,:,:),    &
             & ZPRESF5(JOBS,:), ZEFF_PTOP(JOBS,2), ZEFF_NE(JOBS,2) )

!        reset dodgey cloud parameters to avoid their use in cloud analysis
         IF(ZTS5(JOBS) <= 275.0_JPRB .OR. ZLS5(JOBS) >= 0.01_JPRB .OR. &
             & ZEFF_PTOP(JOBS,2) > 900.0_JPRB .OR. ZEFF_PTOP(JOBS,2) < 100.0_JPRB &
             & .OR. ZEFF_NE(JOBS,2) > 1.0_JPRB .OR. ZEFF_NE(JOBS,2) < 0.0_JPRB) THEN 
            ZEFF_NE(JOBS,2) = MIN (ZEFF_NE(JOBS,2),0.98_JPRB) !thus can't be overcast and used
         ENDIF
       ENDDO
      ENDIF
    ENDIF

!*          7.3.1   Save departures to ODB

    ICOUNT(1:ILEN) = 0
    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)
        IF(ROBODY(IBODY,MDBVNM) == NVNUMB(50)) THEN             ! Radiance datum
        IF(ROBODY(IBODY,MDBPPP)  ==  20 .AND. ISENSOR == MSENSOR_HIRS ) CYCLE      ! Radiance datum not hirs 20
        ICHAN = NINT(ROBODY(IBODY,MDBPPP))                    ! Chan number from body
        ZOBSV=ROBODY(IBODY,MDBVAR)
        IF(ZOBSV /= RMDI) THEN
          ICOUNT(JOBS)=ICOUNT(JOBS)+1                         ! Count rad. data
          IF (LNNBC .AND. ISENSOR == MSENSOR_AIRS) &
           & ROBODY(IBODY,MDBTORB)= ZNNBIAS(JOBS,ICOUNT(JOBS)) ! NN-estimated bias for AIRS
          ZBIAS=ROBODY(IBODY,MDBTORB)
          IF(ZBIAS /= RMDI) THEN
            IF (LECMWF) THEN
              IF(ZTBTOT(JOBS,ICOUNT(JOBS)) /= RMDI)THEN
                ROBODY(IBODY,MDB_CLD_FG_DEPAR_AT_BODY)=ZOBSV-ZTBTOT(JOBS,ICOUNT(JOBS))-ZBIAS
              ENDIF
            ELSE
              ROBODY(IBODY,MDB_CLD_FG_DEPAR_AT_BODY)=ZOBSV-ZTBCLR(JOBS,ICOUNT(JOBS))-ZBIAS
            ENDIF
            IF(ISENSOR == MSENSOR_AIRS .OR. ISENSOR == MSENSOR_IASI ) THEN
              ROBODY(IBODY,MDB_RANK_CLD_AT_BODY)=ZCLDLEV(JOBS,ICOUNT(JOBS))
            ENDIF

            IF(ISENSOR == MSENSOR_AIRS .OR. ISENSOR == MSENSOR_IASI .OR. &
                 &  ISENSOR == MSENSOR_HIRS .OR. ISENSOR == MSENSOR_IRAS) THEN

             IF(LTOVSCV .AND. LCLDSINK) THEN
               IF(ICLDFLG(JOBS,ICOUNT(JOBS)) == 1 .AND. (ZEFF_NE(JOBS,2) <= 0.99_JPRB &
                & .OR. (ISENSOR == MSENSOR_AIRS .AND. ICHAN > 1000)   &
                & .OR. (ISENSOR == MSENSOR_HIRS .AND. ICHAN > 8)      &
                & .OR. (ISENSOR == MSENSOR_IASI .AND. ICHAN > 1000)   &
                & .OR. (ISENSOR == MSENSOR_IRAS .AND. ( ICHAN > 9 .OR. ICHAN == 8 )) )) THEN
                 ROBODY(IBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(IBODY,MDBDSTA))
                 ROBODY(IBODY,MDBDEV1) = ZCHEV1( ROBODY(IBODY,MDBDEV1),ND1EVENT(13))
               ELSEIF(ICLDFLG(JOBS,ICOUNT(JOBS)) == -1 .AND. (ZEFF_NE(JOBS,2) <= 0.99_JPRB &
                & .OR. (ISENSOR == MSENSOR_AIRS .AND. ICHAN > 1000)   &
                & .OR. (ISENSOR == MSENSOR_IASI .AND. ICHAN > 1000)  )) THEN
                 ROBODY(IBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(IBODY,MDBDSTA))
                 ROBODY(IBODY,MDBDEV1) = ZCHEV1( ROBODY(IBODY,MDBDEV1),ND1EVENT(30))
               ENDIF
             ELSE
              IF(ICLDFLG(JOBS,ICOUNT(JOBS)) == 1 ) THEN
                ROBODY(IBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(IBODY,MDBDSTA))
                IF(LECMWF) THEN
                  ROBODY(IBODY,MDBDEV1) = ZCHEV1( ROBODY(IBODY,MDBDEV1),ND1EVENT(13))
                ELSE
                  ROBODY(IBODY,MDBDEV1) = ZCHEV1( ROBODY(IBODY,MDBDEV1),ND1EVENT(28))
                ENDIF
              ENDIF
              IF ((ISENSOR == MSENSOR_AIRS).AND.LCO2_DIAG_AIRS) THEN
                SATHDR(JOBS,MDB1BCP15A)=ZEFF_PTOP(JOBS,3)
                SATHDR(JOBS,MDB1BCP16A)=ZEFF_NE(JOBS,3)
                IF((ZEFF_NE(JOBS,3)==0._JPRB) .OR.&
                 & (ZEFF_PTOP(JOBS,3)<600_JPRB) .OR. (ZEFF_PTOP(JOBS,3)>950_JPRB)) THEN
                  ! Nothing, we are in the case we do not want to modify anything
                ELSE
                  IF(ICLDFLG(JOBS,ICOUNT(JOBS)) == 1) THEN
                    ! White-list activation of cloud-affected radiance
                    ROBODY(IBODY,MDBDEV1) = ZCHEV1(ROBODY(IBODY,MDBDEV1),ND1EVENT(6)) 
                    ROBODY(IBODY,MDBDSTA) = ZCHSTAT_UNREJECT(ROBODY(IBODY,MDBDSTA))
                  ENDIF 
                ENDIF
              ENDIF
             ENDIF     
             ROBODY(IBODY,MDB_TAUSFC_AT_BODY)= ZTAUSFC(JOBS,ICOUNT(JOBS))

            ENDIF
          ENDIF

          ROBODY(IBODY,MDB_SURFEMISS_AT_BODY)=ZEM5(JOBS,ICOUNT(JOBS))
        ENDIF
      ENDIF
    ENDDO

! 2: effective cloud parameters from the 2D-cost function (HIRS/AIRS/IASI)

    IF((LTOVSCV .AND. LCLDSINK).OR.&
     & ((ISENSOR == MSENSOR_AIRS).AND.(LCO2_DIAG_AIRS))) THEN
      IF(ISENSOR == MSENSOR_AIRS .OR. ISENSOR == MSENSOR_IASI .OR. &
       &  ISENSOR == MSENSOR_HIRS .OR. ISENSOR == MSENSOR_IRAS ) THEN
        DO JOBS = 1,ILEN
          IF (ZEFF_PTOP(JOBS,2) /= RMDI .OR. ZEFF_PTOP(JOBS,3) /= RMDI) THEN
            SATHDR(JOBS,MDB_CLDPTOP1_AT_ATOVS) = ZEFF_PTOP(JOBS,1)
            SATHDR(JOBS,MDB_CLDNE1_AT_ATOVS) = ZEFF_NE(JOBS,1)
            SATHDR(JOBS,MDB_CLDPTOP2_AT_ATOVS) = ZEFF_PTOP(JOBS,2)
            SATHDR(JOBS,MDB_CLDNE2_AT_ATOVS) = ZEFF_NE(JOBS,2)
            SATHDR(JOBS,MDB_CLDPTOP3_AT_ATOVS) = ZEFF_PTOP(JOBS,3)
            SATHDR(JOBS,MDB_CLDNE3_AT_ATOVS) = ZEFF_NE(JOBS,3)
          ENDIF
        ENDDO
      ENDIF
    ENDIF

    IF (ALLOCATED(ZEM5))    DEALLOCATE(ZEM5)
    IF (ALLOCATED(ZVPOBS))  DEALLOCATE(ZVPOBS)
    IF (ALLOCATED(ZOBSC))   DEALLOCATE(ZOBSC)
    IF (ALLOCATED(ZTBCLR))  DEALLOCATE(ZTBCLR)
    IF (ALLOCATED(ZTBTOT))  DEALLOCATE(ZTBTOT)
    IF (ALLOCATED(ZTAU))    DEALLOCATE(ZTAU)
    IF (ALLOCATED(ZRADCLDLEV))    DEALLOCATE(ZRADCLDLEV)
    IF (ALLOCATED(ZCLDLEV)) DEALLOCATE(ZCLDLEV)
    IF (ALLOCATED(ICLDFLG)) DEALLOCATE(ICLDFLG)
    IF (ALLOCATED(ZNNBIAS)) DEALLOCATE(ZNNBIAS)
    IF (ALLOCATED(ZTAUSFC)) DEALLOCATE(ZTAUSFC)

  ENDIF ! IF (LRTCALC_HRETR(ISENSOR)) THEN ...

  IF (ALLOCATED(ZVPOBS)) DEALLOCATE(ZVPOBS)
ENDIF ! IF(LLRAD1C) THEN ...

!*       8.       Bias correction/height reassignment/weights for AMV/SATOBs
!                 ----------------------------------------------------------

IF(IOBSTYPE == NSATOB) THEN

!*        8.1    Some preparations

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

      IF(ROBODY(IBODY,MDBVNM) == NVNUMB(1))THEN
        ZP(JOBS) = ROBODY(IBODY,MDBPPP)
        ZU(JOBS) = ROBODY(IBODY,MDBVAR) 
      ENDIF
      IF(ROBODY(IBODY,MDBVNM) == NVNUMB(2)) THEN
        ZV(JOBS)= ROBODY(IBODY,MDBVAR)
      ENDIF

    ENDDO
  ENDDO

  CALL AMV_GET_PREDS(KDLEN,ILEN,IOBSTYPE,ZOROG5,&
   & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5, &
   & ZCLWF5,ZCIWF5,ZCCF5,ZTSTAR5,ZT05,ZLNPR5,ZALPH5,ZLAT,ZLON,ZU,ZV,ZP)

  IF(SATOBGRP_TABLE(IGRP)%ipcor > 0)THEN

!*        8.2    Perform reassignment (also old p values are stored)
    CALL AMV_REASSIGN(KDLEN,ILEN,IGRP,ZLAT,ZLON,ZP)  

!*        8.3    Overwrite old pressure 
!OCL NOVREC
    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)
      IF(ZP(JOBS) /= RMDI)THEN
        IF(     ROBODY(IBODY,MDBVNM) == NVNUMB(1)            &! u
           & .OR. ROBODY(IBODY,MDBVNM) == NVNUMB(2))THEN        ! v  
          IF(      ZP(JOBS) - ROBODY(IBODY,MDBPPP) < 10000._JPRB       &
             & .AND. ZP(JOBS) - ROBODY(IBODY,MDBPPP) > -5000._JPRB       &
             & .AND. ZP(JOBS) >= 10000._JPRB) THEN  
            ! Reassign pressure if reassignment not too large
            ! ("not too large": approx. +- 3 sd around mean reassignment)
            ROBODY(IBODY,MDBPPP)     = ZP(JOBS)
            ! Adjust observation errors
            ZCMOER = ROBODY(IBODY,MDBOER)
            ZCMOER = ZCMOER * SATOBGRP_TABLE(IGRP)%oerr_factor
            ROBODY(IBODY,MDBOER) = ZCMOER

            ZCMPER = ROBODY(IBODY,MDBPER)
            IF(ZCMPER == RMDI) THEN
              ZCMFOE = ZCMOER
            ELSE
              ZCMFOE = SQRT(ZCMOER*ZCMOER + ZCMPER*ZCMPER)
            ENDIF
            ROBODY(IBODY,MDBFOE) = ZCMFOE
          ELSE
            ! Reject wind if reassignment too large
            ROBODY(IBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(IBODY,MDBDSTA))
            ROBODY(IBODY,MDBDEV1) = ZCHEV1( ROBODY(IBODY,MDBDEV1),ND1EVENT(21))   
          ENDIF
        ENDIF
      ENDIF
    ENDDO

!*        8.4    Weights for clear-sky WV wind
    IF(LL_WVMW)THEN
      ! Allocations
      IDFS=NPNAV-1
      IMXCOUNT=IMXBDY/5        ! Number of (u,v) pairs per obs
      ALLOCATE(ZPRES(KDLEN,NLSAT))
      ALLOCATE(ZTQOPP5(KDLEN,NLSAT,IDFS))
      ALLOCATE(ZPS5(KDLEN))
      ALLOCATE(ZT2M5(KDLEN))
      ALLOCATE(ZQ2M5(KDLEN))
      ALLOCATE(ZCTOP5(KDLEN))
      ALLOCATE(ZCAMT5(KDLEN))
      ALLOCATE(ZW(KDLEN,NLSAT)) 
      ALLOCATE(ZTAU(KDLEN,IMXCOUNT,NLSAT))
      ALLOCATE(ZRADCLDLEV(KDLEN,IMXCOUNT,NLSAT))
      ALLOCATE(ZEM5(KDLEN,IMXCOUNT))
      ALLOCATE(ZCHAN(KDLEN,IMXCOUNT))
      ALLOCATE(ZXDUM(KDLEN,IMXCOUNT))
      ALLOCATE(ZTBTOT(KDLEN,IMXCOUNT))
      ALLOCATE(ZVPOBS(KDLEN,IMXBDY))

      ! Interpolate T, q and O3 to fix pressure levels
      ICOUNTX(1:ILEN)=NLSAT
      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)  
      ! Various radiance preparations
      CALL HRADP(2,KDLEN,ILEN,IDFS,KSET,ZOROG5,ZOROGOB,ZNVANG,ZZEANG,ICOEF,&
       & ZPRESH5,ZPRESF5,ZTF5,ZTSTAR5,ZT05,ZTQOPP5,&
       & ZLS5,ZCI5,ZPS5,ZTS5,ZT2M5,ZQ2M5,ZCTOP5,ZCAMT5)  
      !  ZCHAN   : corresponding WV channel
      IF( SATOBGRP_TABLE(IGRP)%method == MMETHOD_WVMW ) THEN
        SELECT CASE (SATOBGRP_TABLE(IGRP)%rtseries)
        CASE(3)   ! Meteosat
          ZCHAN = 1.0_JPRB
          IF(SATOBGRP_TABLE(IGRP)%bufrid == 54 .OR. &
       &     SATOBGRP_TABLE(IGRP)%bufrid == 52) THEN
             ZCHAN = 1.0_JPRB
          ELSEIF(SATOBGRP_TABLE(IGRP)%bufrid == 55)THEN
      ! get the channel from the computational method for MET8
             IF(INT(SATOBGRP_TABLE(IGRP)%method/100) == 1)ZCHAN=2.0_JPRB ! 6.2micron
             IF(INT(SATOBGRP_TABLE(IGRP)%method/100) == 2)ZCHAN=3.0_JPRB ! 7.3micron
          ELSE
             CALL ABOR1('HRETR: Unimplemented satid for METEOSAT SATOB clear sky WV') 
          ENDIF
        CASE(4)   ! GOES
          ZCHAN = 2.0_JPRB
        CASE DEFAULT
          CALL ABOR1('HRETR: Unimplemented rtseries for SATOB clear sky WV') 
        END SELECT
      ELSE
        CALL ABOR1('HRETR: SATOB RT average requires computational method == 5')
      ENDIF
      ZEM5 = 1.0_JPRB ! Good guess for surface emis. 
      ZAZIANG(JOBS)  = 0.0_JPRB ! Not used for these data
      ZSOLZENANG(JOBS) = 0.0_JPRB ! Not used for these data
      ZSOLAZIANG(JOBS) = 0.0_JPRB ! Not used for these data
      ! Call radiative transfer model
      ICOUNT = IMXCOUNT
      CALL RADTR(ICOEF,ISENSOR,KDLEN,ILEN,IDFS,IMXCOUNT,ICOUNT,ZCHAN,&
       & .FALSE.,&
       & ZZEANG,ZAZIANG,ZSOLZENANG,ZSOLAZIANG,ZLAT,ZOROG5,&
       & ZTQOPP5,YLGEMSPROF5,ZPS5,ZTS5,ZLS5,ZT2M5,ZQ2M5,ZCTOP5,ZCAMT5,ZUF5(1,NFLEVG),&
       & ZVF5(1,NFLEVG),ZEM5,ZXDUM,ZTBTOT,ZTAU,ZRADCLDLEV)  
      ! Calculate weights from transmittances 
      CALL MEANUV_WEIGHTS(KDLEN,ILEN,IMXCOUNT,NLSAT,   &
       & SATOBGRP_TABLE(IGRP)%obs_oper,ZTAU,ZVPOBS,&
       & ZPRESF5,SATOBGRP_TABLE(IGRP)%SIGMA,ZW)  
      ! Store weights       
      DO JLEV=1,NLSAT
        SATHDR(1:ILEN,MDB_WEIGHT_AT_SATOB(JLEV)) = ZW(1:ILEN,JLEV)
      ENDDO

      IF (ALLOCATED(ZEM5)) DEALLOCATE(ZEM5)
      IF (ALLOCATED(ZVPOBS)) DEALLOCATE(ZVPOBS)
      IF (ALLOCATED(ZTQOPP5)) DEALLOCATE(ZTQOPP5)
      IF (ALLOCATED(ZPS5)) DEALLOCATE(ZPS5)
      IF (ALLOCATED(ZT2M5)) DEALLOCATE(ZT2M5)
      IF (ALLOCATED(ZQ2M5)) DEALLOCATE(ZQ2M5)
      IF (ALLOCATED(ZCTOP5)) DEALLOCATE(ZCTOP5)
      IF (ALLOCATED(ZCAMT5)) DEALLOCATE(ZCAMT5)
      IF (ALLOCATED(ZTAU)) DEALLOCATE(ZTAU)
      IF (ALLOCATED(ZRADCLDLEV)) DEALLOCATE(ZRADCLDLEV)
      IF (ALLOCATED(ZPRES)) DEALLOCATE(ZPRES)
      IF (ALLOCATED(ZW)) DEALLOCATE(ZW)
      IF (ALLOCATED(ZCHAN)) DEALLOCATE(ZCHAN)
      IF (ALLOCATED(ZXDUM)) DEALLOCATE(ZXDUM)
      IF (ALLOCATED(ZTBTOT)) DEALLOCATE(ZTBTOT)
    ENDIF
  ENDIF
ENDIF

!*       9.       Bias correction for REO3 (based on solar elevation)
!                 ---------------------------------------------------

IF(LLREO3) THEN

  ISATID=SATGRP_TABLE(IGRP)%bufrid
  ISENSOR=SATGRP_TABLE(IGRP)%sensor
  OBS_LOOP_O3: DO JOBS= 1, ILEN
    ZSOLEL  = SATHDR(JOBS,MDBRO3SOE)
    CALL REO3BCOR(JOBS,ISATID,ISENSOR,ZSOLEL)
  ENDDO OBS_LOOP_O3

  IF (lvarbc) THEN
    ALLOCATE(ZVARBC(KDLEN,IMXBDY),ZXPRED(0:JPMXNPRED,ILEN), &
             & ZSOLAR(ILEN), &
             & ZOMF(KDLEN,IMXBDY),IXVARBC(KDLEN,IMXBDY))
    ZOMF(:,:)=RMDI
    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)
      JBODY = IBODY + 1 - MLNKH2B(JOBS)
      IXVARBC(JOBS,JBODY) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
    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_BIAS (IXVARBC, IMXBDY, ICMBDY, KDLEN, ILEN, &
     & JPMXNPRED, ZXPRED, ZOMF, ZVARBC)
     
    DO IBODY=1,MLNKH2B(ILEN+1)-1
      JOBS = MBODYJOBS(IBODY)
      JBODY = IBODY + 1 - MLNKH2B(JOBS)
      IF (ROBODY(IBODY,MDBVNM) == NVNUMB(68).OR. &  ! Ozone datum
       &  ROBODY(IBODY,MDBVNM) == NVNUMB(80).OR. &  ! NO2 datum
       &  ROBODY(IBODY,MDBVNM) == NVNUMB(81).OR. &  ! SO2 datum
       &  ROBODY(IBODY,MDBVNM) == NVNUMB(82).OR. &  ! CO datum
       &  ROBODY(IBODY,MDBVNM) == NVNUMB(83).OR. &  ! For datum
       &  ROBODY(IBODY,MDBVNM) == NVNUMB(84).OR. &  ! GO3 datum
       &  ROBODY(IBODY,MDBVNM) == NVNUMB(78)) THEN  ! Aerosol optical depth datum
        ROBODY(IBODY,MDB_BIASCTRL_AT_BODY) = ZVARBC(JOBS,JBODY)
        ROBODY(IBODY,MDBTORB)              = ZVARBC(JOBS,JBODY)
      ENDIF
    ENDDO
    DEALLOCATE(ZVARBC,ZXPRED,ZSOLAR,ZOMF,IXVARBC)
  ENDIF

ENDIF

!*       9.1       Bias correction for SCIAMACHY CH4
!                  ---------------------------------

IF(LLREO3) THEN
  ISATID=SATGRP_TABLE(IGRP)%bufrid
  ISENSOR=SATGRP_TABLE(IGRP)%sensor
  OBS_LOOP_CH4: DO JOBS= 1, ILEN
    ZSOLEL  = SATHDR(JOBS,MDBRO3SOE)
    CALL CH4BCOR (JOBS,ISATID,ISENSOR,ZSOLEL)
  ENDDO OBS_LOOP_CH4
ENDIF

!*       10. Observation errors, screening and VarBC for TCWV observations 
      
IF (LL_TCWV .AND. ISENSOR_GETDB == NSENSOR_MERIS) THEN

!* Apply operator for FG TCWV
    CALL PPPMER(KDLEN,1,ILEN,ZPRESH5(1,NFLEVG),ZORDIF,ZTSTAR5,ZT05,ZP_AT_OBALT)
 
    ICOUNT(1:ILEN)=1
    CALL PPOBSA(KDLEN,ILEN,1,'PWC',IOBSTYPE,ICOUNT,ZP_AT_OBALT,ZOROG5,&
     & ZPRESH5,ZPRESF5,ZPXP5,ZPXPD5,&
     & ZUF5,ZVF5,ZTF5,ZQF5,ZO3F5,ZCLWF5,ZCIWF5,ZCCF5,&
     & ZTSTAR5,ZT05,ZLNPR5,ZALPH5,&
     & 1,ZTCWV)
     
!* Screening and observation errors
    DO IBODY = 1, MLNKH2B (ILEN+1) - 1

       IVNM  = ROBODY    (IBODY,MDBVNM)
       JOBS  = MBODYJOBS (IBODY)

       ZOBSV = ROBODY (IBODY,MDBVAR)
!*AF       ZSZA  = ROBHDR (JOBS,MDB_SAT_ZENITH_AT_HDR)
       ZSZA  = ROBHDR (JOBS,MDB_ZENITH_AT_SAT)
       
       LL_TCWV_OK  = IVNM == NVNUMB (6) .AND. ZOBSV /= RMDI .AND. &
        & ZTCWV (JOBS,1,1) /= RMDI

       LL_MERIS_OK = ZLS5 (JOBS) > 0.99_JPRB .AND. &
        & ALL (ZCCF5 (JOBS,1:NFLEVG) < 0.1_JPRB) .AND. & 
        & ABS (ZSZA) < 35.0 .AND. ABS (ZOBSV - ZTCWV (JOBS,1,1)) < 8.0_JPRB

       IF(LL_TCWV_OK) THEN 
          IF (LL_MERIS_OK) THEN
              ROBODY (IBODY,MDBOER)   = ZOBSV * 0.15_JPRB
              ROBODY (IBODY,MDBFOE)   = ZOBSV * 0.15_JPRB
          ENDIF
       ELSE
          ROBODY(IBODY,MDBDSTA) = ZCHSTAT_REJECT(ROBODY(IBODY,MDBDSTA))
          ROBODY(IBODY,MDBDEV1) = ZCHEV1(ROBODY(IBODY,MDBDEV1),ND1EVENT(11))
       ENDIF
    ENDDO
    
!* VarBC (uses general radiance predictor table)
    IF (lvarbc) THEN
        DO JOBS = 1,ILEN
          ZNVANG     (JOBS) = RMDI
          ZSOLZENANG (JOBS) = RMDI
          ZSOLHOUR   (JOBS) = 0.0_JPRB !check if solar hour is required
        ENDDO  

        ALLOCATE(ZVARBC(KDLEN,IMXBDY),ZXPRED(0:JPMXNPRED,ILEN), &
               & ZOMF(KDLEN,IMXBDY),IXVARBC(KDLEN,IMXBDY))
        ZOMF(:,:)=RMDI

        DO IBODY=1,MLNKH2B(ILEN+1)-1
           JOBS  = MBODYJOBS(IBODY)
           JBODY = IBODY + 1 - MLNKH2B(JOBS)
           IXVARBC(JOBS,JBODY) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
        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_BIAS (IXVARBC, IMXBDY, ICOUNT, KDLEN, ILEN, &
                       & JPMXNPRED, ZXPRED, ZOMF, ZVARBC)

        ICOUNT(1:ILEN) = 0
        DO IBODY=1,MLNKH2B(ILEN+1)-1
           JOBS = MBODYJOBS(IBODY)
   
           IF(ROBODY(IBODY,MDBVNM) == NVNUMB(6) .AND. ROBODY(IBODY,MDBVAR) /= RMDI) THEN ! TCWV datum
              ICOUNT(JOBS)=ICOUNT(JOBS)+1        
              ROBODY(IBODY,MDB_BIASCTRL_AT_BODY) = ZVARBC(JOBS,ICOUNT(JOBS))
              ROBODY(IBODY,MDBTORB)              = ZVARBC(JOBS,ICOUNT(JOBS))
           ENDIF
        ENDDO
        DEALLOCATE(ZVARBC,ZXPRED,ZOMF,IXVARBC)
    ENDIF
ENDIF

!*       11. VarBC for AIREP T observations 
      
IF (LVARBC .AND. LL_AIREP) THEN
  IF(LBC_AIREP)              THEN
!   write(NULOUT,'('' enter AIREP Varbc in hretr but no work at the moment'')')
!   call flush(nulout)
    
!   ALLOCATE(ZVARBC(KDLEN,IMXBDY),ZXPRED(0:JPMXNPRED,ILEN), &
!          & ZOMF(KDLEN,IMXBDY),IXVARBC(KDLEN,IMXBDY))
!   ZOMF(:,:)=RMDI

!   DO IBODY=1,MLNKH2B(ILEN+1)-1
!     JOBS  = MBODYJOBS(IBODY)
!     JBODY = IBODY + 1 - MLNKH2B(JOBS)
!     IXVARBC(JOBS,JBODY) = ROBODY(IBODY,MDB_VARBC_IX_AT_BODY)
!   ENDDO

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

!   CALL VARBC_BIAS (IXVARBC, IMXBDY, ICOUNT, KDLEN, ILEN, &
!                   & JPMXNPRED, ZXPRED, ZOMF, ZVARBC)

!   ICOUNT(1:ILEN) = 0
!   DO IBODY=1,MLNKH2B(ILEN+1)-1
!     JOBS = MBODYJOBS(IBODY)
!  
!     IF(ROBODY(IBODY,MDBVNM) == NVNUMB(8) .AND. ROBODY(IBODY,MDBVAR) /= RMDI) THEN ! T datum
!       ICOUNT(JOBS)=ICOUNT(JOBS)+1        
!       ROBODY(IBODY,MDB_BIASCTRL_AT_BODY) = ZVARBC(JOBS,ICOUNT(JOBS))
!       ROBODY(IBODY,MDBTORB)              = ZVARBC(JOBS,ICOUNT(JOBS))
!     ENDIF
!   ENDDO
!   DEALLOCATE(ZVARBC,ZXPRED,ZOMF,IXVARBC)
  ENDIF
ENDIF

!*       12. Observation errors and cloud screening for limb observations 
!           ------------------------------------------------------------
 
IF (IOBSTYPE == NLIMB) THEN
  IF (ICDTYP_LIMB == NGPSRO) THEN
    ! Set the GPSRO observation errors
    CALL gpsro_oberror(ILEN)             
  ELSEIF (ICDTYP_LIMB == NLRAD) THEN
    ! Set the observation errors for limb radiances
    CALL rtl_oberror(ILEN,Y_LIMBGRP_TABLE(IGRP)%sensor) 
    ! Cloud and height screening for limb radiances
    CALL rtl_screen(ILEN,Y_LIMBGRP_TABLE(IGRP)%sensor,&
     &                   Y_LIMBGRP_TABLE(IGRP)%rtcoef_pos) 
  ENDIF
ENDIF

!*       13.       INCREASE OBS.ERROR FOR SYNOP GEOPOTENTIALS
!                 ------------------------------------------
!*AF 15/05/2010 This option cannot work properly because ADDOER uses MDB_OROGRAPHY which is not
!*AF             set at this stage (set in prech.F90). Everything has to be done in prech.F90
!*AFIF(IOBSTYPE == NSYNOP)         THEN
 !*AF IF(L_OBS_ERR_INCREASE_Hretr)   THEN
!*AF    DO IBODY=1,MLNKH2B(ILEN+1)-1
!*AF      IVNM=ROBODY(IBODY,MDBVNM)
!*AF      IF(IVNM == NVNUMB( 3) .OR. IVNM == NVNUMB(47)) THEN 
!*AF        JOBS = MBODYJOBS(IBODY)
!*AF        ZTFG     = ZTF5   (JOBS,NFLEVG)
!*AF        ZMPS     = ZPRESH5(JOBS,NFLEVG)
!*AF        JBODY    = IBODY
!*AF        CALL ADDOER(JOBS,JBODY,ZTFG,ZMPS)
!*AF      ENDIF
!*AF    ENDDO
!*AF  ENDIF
!*AFENDIF

!     ------------------------------------------------------------------
!*
!       14.       Finish
!                 ------

!*         14.1    Deallocates

IF(ALLOCATED(ZPS5))DEALLOCATE(ZPS5)
IF(ALLOCATED(ZTAU))DEALLOCATE(ZTAU)
IF(ALLOCATED(ZRADCLDLEV))DEALLOCATE(ZRADCLDLEV)
IF(ALLOCATED(ZTQOPP5))DEALLOCATE(ZTQOPP5)
IF(ALLOCATED(ZPRES))DEALLOCATE(ZPRES)
IF(ALLOCATED(ZVPOBS))DEALLOCATE(ZVPOBS)
IF(ALLOCATED(ZVARBC))DEALLOCATE(ZVARBC)
IF(ALLOCATED(ZXPRED))DEALLOCATE(ZXPRED)
IF(ALLOCATED(ZOMF))DEALLOCATE(ZOMF)
IF(ALLOCATED(IXVARBC))DEALLOCATE(IXVARBC)
IF(ALLOCATED(ZTBCLR))DEALLOCATE(ZTBCLR)
IF(ALLOCATED(ZTBTOT))DEALLOCATE(ZTBTOT)
IF(ALLOCATED(ZEM5))DEALLOCATE(ZEM5)
IF(ALLOCATED(ZOBS))DEALLOCATE(ZOBS)
IF(ALLOCATED(ZVAROUT))DEALLOCATE(ZVAROUT)
IF(ALLOCATED(IC2I))DEALLOCATE(IC2I)
IF(ALLOCATED(LLQCATLAS))DEALLOCATE(LLQCATLAS)
IF(ALLOCATED(ZCLDLEV))DEALLOCATE(ZCLDLEV)
IF(ALLOCATED(ZOBSC))DEALLOCATE(ZOBSC)
IF(ALLOCATED(ICLDFLG))DEALLOCATE(ICLDFLG)
IF(ALLOCATED(ZTAUSFC))DEALLOCATE(ZTAUSFC)
IF(ALLOCATED(ZNNBIAS))DEALLOCATE(ZNNBIAS)
IF(ALLOCATED(ZT2M5))DEALLOCATE(ZT2M5)
IF(ALLOCATED(ZQ2M5))DEALLOCATE(ZQ2M5)
IF(ALLOCATED(ZCTOP5))DEALLOCATE(ZCTOP5)
IF(ALLOCATED(ZCAMT5))DEALLOCATE(ZCAMT5)
IF(ALLOCATED(ZW))DEALLOCATE(ZW)
IF(ALLOCATED(ZCHAN))DEALLOCATE(ZCHAN)
IF(ALLOCATED(ZXDUM))DEALLOCATE(ZXDUM)
IF(ALLOCATED(ZSOLAR))DEALLOCATE(ZSOLAR)


!*         14.2    Say good-bye to ODB

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

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

