SUBROUTINE HRADPAD(KDLEN,KLEN,KSET,POROG5,POROGOB,&
 & PPRESH ,PTF ,PTSTAR ,PT0 ,PTQOPP ,&
 & PPS ,PTS ,PT2M ,PQ2M ,PCTOP , PCAMT ,&
 & PPRESH5,PPRESF5,PTSTAR5,PT05,PTQOPP5,&
 & PPS5,PTS5,PT2M5,PQ2M5,PCTOP5 ,PCAMT5, PTPP5_REF,PTS5_REF)  

!****  HRADPAD  - PREPARATION FOR THE RADIANCE INTERPOLATION

!     ERIK ANDERSSON          01/04/99       ECMWF

!     PURPOSE
!     -------

!        HRADPAD PREPARES INTERPOLATION FOR ONE SET OF OBSERVATIONS.

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

!        CALL HRADPAD(KDLEN,KLEN,KSET,POROG5,POROGOB,&
!    &PPRESH ,PTF ,PTSTAR ,PT0 ,PTQOPP ,&
!    &PPS ,PTS ,PT2M ,PQ2M ,&
!    &PPRESH5,PPRESF5,PTSTAR5,PT05,PTQOPP5,&
!    &PPS5,PTS5,PT2M5,PQ2M5,PTPP5_REF,PTS5_REF)

!        Where KDLEN   = First dimension (Number of observations)
!              KLEN    = Actual number of observations
!              KSET    = Number (numero) of the obs set to be treated
!              POROG5  = Model's orography
!              POROGOB = Observation's orography
!              PPRESH5 = Half-level pressures
!              PPRESF5 = Full-level pressures
!              PTSTAR5 = Surface temperature (see CTSTAR)
!              PT05    = Surface temperature (see CTSTAR)
!              PTQOPP5 =Model T,Q and O3 on NLSAT pressure levels
!              PPS5    = Surface pressure at TOVS locations
!              PTS5    = Surface skin temperature
!              PT2M5   = Two-metre temperature, for rttov
!              PQ2M5   = Two-metre spec. humidity, for rttov
!              PTPP5_REF=Model T - reference value
!              PTS5_REF= Surface skin temperature-reference value

!        HRADPAD IS CALLED FROM HOPAD

!**   METHOD
!     ------

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

!**   MODIFICATIONS
!     -------------
!     E.Andersson 990104 : Original
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMCT0B  , ONLY : LECMWF
USE GOMS_MIX     , ONLY : LGOMUA,YGOMV
USE YOMDIMO  , ONLY : NLSAT, NPNAV
USE YOMDIM   , ONLY : NFLEVG
USE YOMTVRAD , ONLY : RADPRE, SATGRP_TABLE, TOVSCVX
USE YOMCST   , ONLY : RPI
USE YOMANCS  , ONLY : RMDI
USE YOMVAR   , ONLY : LTOVSCV, LCO2, LCLDSINK
USE YOMCOCTP , ONLY : NGTHRB   
USE YOMOBSET , ONLY : MTYPOB
USE YOMDB

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSET 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROGOB(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PPRESH(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTSTAR(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PT0(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTQOPP(KDLEN,NLSAT,NPNAV-1)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PPS(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTS(KDLEN),PCTOP(KDLEN),PCAMT(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PT2M(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQ2M(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPRESH5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPRESF5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSTAR5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT05(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTQOPP5(KDLEN,NLSAT,NPNAV-1)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPS5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTS5(KDLEN),PCTOP5(KDLEN),PCAMT5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT2M5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ2M5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTPP5_REF(KDLEN,NLSAT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS5_REF(KDLEN)
INTEGER(KIND=JPIM), PARAMETER :: IT=1, IQ=2, IO3=3, ICO2=4
INTEGER(KIND=JPIM), DIMENSION(KDLEN) :: ILTROP

INTEGER(KIND=JPIM) :: ICDTYP_TOVS,IGRP,IOBSTYPE
INTEGER(KIND=JPIM) :: INLAMTOP,IOBS,IPMOTOV
INTEGER(KIND=JPIM) :: JOBS,JLEV
INTEGER(KIND=JPIM) :: IPOSM
REAL(KIND=JPRB), DIMENSION(KDLEN) :: ZORDIF
REAL(KIND=JPRB) :: ZPSINFL,ZDP5,ZA5,ZA,Z1MA5
REAL(KIND=JPRB), ALLOCATABLE :: Z_PTFOUTGR(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: Z_PTFINPGR(:,:)
LOGICAL :: LLFAIL,LLRAD1C
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "extrapad.intfb.h"
#include "pppmerad.intfb.h"
#include "tropopause.intfb.h"

#include "fcobs.h"

#include "openmp_obs.h"

! ---------------------------------------------------------------------
!*          1.1   Initiate, set switches

IF (LHOOK) CALL DR_HOOK('HRADPAD',0,ZHOOK_HANDLE)
IOBSTYPE = MOD(MTYPOB(KSET),100)
IGRP =MOD(MTYPOB(KSET)/100,100)
ICDTYP_TOVS=SATGRP_TABLE(IGRP)%codetype

LLRAD1C= ICDTYP_TOVS == NGTHRB
LLFAIL=.FALSE.

!*          1.4   Find fix pressure level corresponding to model's top
!                 (Assumes top model level is a pressure surface)
!                 Check is performed in terms of integer-Pascals.

IOBS=1
INLAMTOP=0
DO JLEV = 1,NLSAT
  IF(NINT(RADPRE(JLEV)) < NINT(PPRESF5(IOBS,1))) INLAMTOP=JLEV
ENDDO
!*          1.8   If any of the 43 levels are within 20 mbar of the
!                 surface, add a correction to the temperature at that
!                 level.

ZPSINFL=2000._JPRB
DO JLEV = 1,NLSAT
  DO JOBS = 1,KLEN
    ZDP5=PPS5(JOBS)-RADPRE(JLEV)
    IF( ABS(ZDP5) < ZPSINFL) THEN
!  Linear weight (ZA5) is a function of Ps (ZPS5(JOBS))
      ZA5=0.5_JPRB*(1.0_JPRB+SIN(RPI/ZPSINFL*(ZDP5-ZPSINFL*0.5_JPRB)))
      ZA5=MAX(ZA5,0.0001_JPRB)
      Z1MA5=1.0_JPRB-ZA5
!  Un-do the corrections to the trajectory, temp and hum.
      PTQOPP5(JOBS,JLEV,IT)=(PTQOPP5(JOBS,JLEV,IT)-Z1MA5*PT2M5(JOBS))/ZA5
      PTQOPP5(JOBS,JLEV,IQ)=(PTQOPP5(JOBS,JLEV,IQ)-Z1MA5*PQ2M5(JOBS))/ZA5
!  Zero gradient with respect to linear weight
      ZA=0.0_JPRB

!  Gradient with respect to temperature
      ZA= ZA + PTQOPP(JOBS,JLEV,IT)*(PTQOPP5(JOBS,JLEV,IT)-PT2M5(JOBS))
      PT2M(JOBS)=PT2M(JOBS)+Z1MA5*PTQOPP(JOBS,JLEV,IT)
      PTQOPP(JOBS,JLEV,IT)=ZA5*PTQOPP(JOBS,JLEV,IT)

!  Gradient with respect to humidity
      ZA= ZA + PTQOPP(JOBS,JLEV,IQ)*(PTQOPP5(JOBS,JLEV,IQ)-PQ2M5(JOBS))
      PQ2M(JOBS)=PQ2M(JOBS)+Z1MA5*PTQOPP(JOBS,JLEV,IQ)
      PTQOPP(JOBS,JLEV,IQ)=ZA5*PTQOPP(JOBS,JLEV,IQ)

!  Gradient with respect to surface pressure
      IF(ZA5 > 0.0001_JPRB) THEN
        PPS(JOBS) = PPS(JOBS) +&
         & 0.5_JPRB*COS(RPI/ZPSINFL*(ZDP5-ZPSINFL*0.5_JPRB))*RPI/ZPSINFL*ZA  
      ENDIF
    ENDIF
  ENDDO
ENDDO

!*          1.7   Find out pressure at the 'station height' of each
!                 TOVS location. The post processing routine for Mean
!                 Sea Level Pressure is used.

WHERE(POROGOB(1:KLEN) == RMDI)
  ZORDIF(1:KLEN) = 0.0_JPRB
ELSEWHERE
  ZORDIF(1:KLEN) = POROG5(1:KLEN)-POROGOB(1:KLEN)
ENDWHERE
CALL PPPMERAD(KDLEN,1,KLEN,PPRESH(1,NFLEVG),&
 & ZORDIF,PTSTAR,PT0,PPS,&
 & PPRESH5(1,NFLEVG),PTSTAR5,PT05)  

!*          1.6   Perform the post-processing of 2M temperature and humidity.

PTF(1:KLEN,NFLEVG) = PTF(1:KLEN,NFLEVG) + PT2M(1:KLEN)
PTQOPP(1:KLEN,NLSAT,IQ) = PTQOPP(1:KLEN,NLSAT,IQ) + PQ2M(1:KLEN)

!*          1.5   Replace temperature above model's top

IF (LECMWF) THEN
  DO JLEV = 1,INLAMTOP
    PTQOPP5(1:KLEN,JLEV,IT)=PTPP5_REF(1:KLEN,JLEV)
    PTQOPP (1:KLEN,JLEV,IT)=0.0_JPRB
  ENDDO
ELSE
  IPMOTOV = NLSAT-INLAMTOP-1
  ALLOCATE(Z_PTFOUTGR(KLEN, NLSAT))
  ALLOCATE(Z_PTFINPGR(KLEN, IPMOTOV))
  Z_PTFOUTGR=0.0_JPRB
  Z_PTFINPGR=0.0_JPRB
  DO JLEV = 1,INLAMTOP
    Z_PTFOUTGR(1:KLEN,JLEV) = Z_PTFOUTGR(1:KLEN,JLEV) + PTQOPP(1:KLEN,JLEV,IT)
    PTQOPP(1:KLEN,JLEV,IT) = 0.0_JPRB
  ENDDO
  CALL EXTRAPAD(Z_PTFINPGR, Z_PTFOUTGR, KLEN)
  PTQOPP(1:KLEN,INLAMTOP+2:NLSAT,IT) = PTQOPP(1:KLEN,INLAMTOP+2:NLSAT,IT) +&
   & Z_PTFINPGR(1:KLEN,1:IPMOTOV)  
  DEALLOCATE(Z_PTFOUTGR, Z_PTFINPGR)
ENDIF

IF(.NOT.(LTOVSCV.AND.LLRAD1C)) THEN
  PTS5(1:KLEN)=PTS5_REF(1:KLEN)
  PTS (1:KLEN)=0.0_JPRB
ENDIF

!*          1.3   Replace ozone with climatology, if not avalable as
!                 model field.

IF(.NOT.LGOMUA(IOBSTYPE,YGOMV%MO3)) PTQOPP(1:KLEN,1:NLSAT,IO3)=0.0_JPRB

IF(KSET < 0 .AND. LCO2) THEN
    PTQOPP (1:KLEN,1:NLSAT,ICO2)=0.0_JPRB
ENDIF

IF(KSET < 0) GOTO 4

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

IF(LTOVSCV .AND. LLRAD1C) THEN
  DO JOBS =1,KLEN
    IPOSM  = ROBHDR(JOBS,MDB_MAPOMM_AT_INDEX)
    TOVSCVX(IPOSM,1)=PTS(JOBS)
    PTS(JOBS)=0.0_JPRB
  ENDDO
ENDIF

!*          1.2a   Fill the TOVSCVX array with the grad with respect to cloud sink

IF(LTOVSCV .AND. LLRAD1C .AND. LCLDSINK) THEN

  DO JOBS =1,KLEN
    IPOSM  = ROBHDR(JOBS,MDB_MAPOMM_AT_INDEX)
      TOVSCVX(IPOSM,2)=PCTOP(JOBS)
      TOVSCVX(IPOSM,3)=PCAMT(JOBS)
      PCTOP(JOBS)=0.0_JPRB
      PCAMT(JOBS)=0.0_JPRB
  ENDDO
ENDIF


!*          1.2a   Fill the TOVSCVX array with the grad with respect to CO2

IF(LTOVSCV .AND. LLRAD1C .AND. LCO2) THEN
!* Calculate tropopause level at observation location (taken from SUSHFCE.F90)

  CALL TROPOPAUSE(KDLEN,KLEN,PTQOPP5,ILTROP)

  DO JOBS =1,KLEN
    IPOSM  = ROBHDR(JOBS,MDB_MAPOMM_AT_INDEX)
    TOVSCVX(IPOSM,2)=0.0_JPRB
    TOVSCVX(IPOSM,3)=0.0_JPRB
    DO JLEV =1,NLSAT
      IF(JLEV < ILTROP(JOBS)) TOVSCVX(IPOSM,2)=TOVSCVX(IPOSM,2)!+PTQOPP(JOBS,JLEV,ICO2)
      IF(JLEV >= ILTROP(JOBS)) TOVSCVX(IPOSM,3)=TOVSCVX(IPOSM,3)+PTQOPP(JOBS,JLEV,ICO2)
      PTQOPP(JOBS,JLEV,ICO2)=0.0_JPRB
    ENDDO
  ENDDO
ENDIF

4 CONTINUE


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