SUBROUTINE PPOBSASTL(KDLEN,KLEN,KDCOUNT,CDPAR,PINTH,KOBSTYPE,KCOUNT,PZ0SC,&
 & PRESF,PUF,PVF,PTF,PQF,&
 & PCPTGZ,PCPTS,PAPHI,&
 & PBN,PBM,PBH,&
 & KDPP,PXPP,&
 & PRESF5,PUF5,PVF5,PTF5,PQF5,PU05,PV05,&
 & PCPTGZ5,PCPTS5,PAPHI5,PES5,&
 & PRI5,PBN5,PBM5,PBH5,PRH2M5)  

!**** PPOBSAS - POST-PROCESSING SURFACE VARIABLES

!     CARLA CARDINALI        ECMWF           92-18-03
!     (Tangent linear version: Mike Fisher *ECMWF*)

!     PURPOSE
!     -------

!        FIND OUT AN EQUIVALENT MODEL SURFACE PARAMETER FOR A GIVEN OBSERVED.

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

!     CALL PPOBSASTL(KDLEN,KLEN,KDCOUNT,CDPAR,PINTH,KOBSTYPE,KCOUNT,PZ0SC,
!    I               PRESF,PUF,PVF,PTF,PQF,
!    I               PCPTGZ,PCPTS,PAPHI,
!    I               PBN,PBM,PBH,
!    O               KDPP,PXPP,
!    R               PRESF5,PUF5,PVF5,PTF5,PQF5,PU05,PV05,
!    R               PCPTGZ5,PCPTS5,PAPHI5,PES5,
!    R               PRI5,PBN5,PBM5,PBH5,PRH2M5)

!     WHERE KDLEN   : FIRST DIMENSION (OBSERVATIONS)
!           KLEN    : ACTUAL NUMBER OF OBSERVATIONS
!           KDCOUNT : SECOND DIMENSION (Data)
!           CDPAR   : PARAMETER FOR POST-PROCESSING
!           PINTH   : INTERPOLATION HEIGHT
!           KOBSTYPE: OBS. TYPE
!           KCOUNT  : COUNTER OF DATA PER OBS
!           PZ0SC   : ROUGHNESS LENGHT COMPUTED FROM SCAT WIND SPEED
!           PRESH   : HALF LEVEL PRESSURES
!           PRESF   : FULL LEVEL PRESSURES
!           PUF     : U AT MODEL FULL LEVELS
!           PVF     : V AT MODEL FULL LEVELS
!           PTF     : T AT MODEL FULL LEVELS
!           PQF     : Q AT MODEL FULL LEVELS
!           KDPP    : Number of fields, dimension of PXPP.
!           PXPP    : POST-PROCESSED VALUES
!           PCPTGZ5 : STATIC ENERGY (LOWER LEVEL)
!           PCPTS5  : STATIC ENERGY AT THE SURFACE
!           PAPHI5  : GEOPOTENTIAL MODEL LEVELS
!           PRI5    : RICHARDSON NO.
!           PBN5    : STABILITY FUNCTION (NEUTRAL)
!           PBM5    : DRAG COEFFICIENT FOR MOMENTUM
!           PBH5    : DRAG COEFFICIENT FOR HEAT
!           PU05    : U-COMP OF OCEAN CURRENT
!           PV05    : V-COMP OF OCEAN CURRENT

!        PPOBSASTL IS CALLED FROM SURFACTL

!**   METHOD
!     ------

!**   EXTERNALS
!     ---------
!          PPRH2M  : COMPUTE THE POST-PROCESSED 2M RELATIVE HUMIDITY
!          PPUV10M : COMPUTE THE POST-PROCESSED 10M U-WIND COMPONENT
!          PPUV10M : COMPUTE THE POST-PROCESSED 10M V-WIND COMPONENT
!          PPT2M   : COMPUTE THE POST-PROCESSED 2M TEMPERATURE

!**   MODIFICATIONS
!     -------------
!     E.Andersson 960201 : Incorporating Scat in SURFACEO
!     E.Andersson 971117 : GOM-variables more flexible
!     E.Andersson 980611 : Pass dimension as argument
!     E.Gerard    990505 : If NSATEM U10 doesn't require LGSMU & LGSMV .T.
!     H.Hersbach  080416 : Introduce neutral-wind operator for Scat

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

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

USE YOMDIM   , ONLY : NFLEVG
USE YOMOBS   , ONLY : LSCATT_NEUTRAL
USE YOMLUN   , ONLY : NULERR
USE YOMSTA   , ONLY : STZ
USE YOMCOCTP , ONLY : NSCATT

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDCOUNT
CHARACTER(LEN=3)  ,INTENT(IN)    :: CDPAR 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PINTH(KDLEN) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBSTYPE 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCOUNT(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZ0SC(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPTGZ(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPTS(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHI(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBN(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBM(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBH(KDLEN) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDPP 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PXPP(KDLEN,KDCOUNT,KDPP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESF5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUF5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVF5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQF5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPTGZ5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPTS5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHI5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PES5(KDLEN,2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRI5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBN5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBM5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBH5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PU05(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PV05(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRH2M5(KDLEN,KDCOUNT) 
INTEGER(KIND=JPIM) :: ILEN,IMXCNT,INPP
INTEGER(KIND=JPIM) :: J
REAL(KIND=JPRB) :: ZRHMAX,ZRHMIN,Z10,ZLLH,ZLOGC
LOGICAL :: LLH2,LLU10,LLT2,LLAUV,LLNEUTRAL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "pprh2mtl.intfb.h"
#include "ppt2mtl.intfb.h"
#include "ppuv10mtl.intfb.h"
!     ------------------------------------------------------------------
!*    1.  PREPARATION
!*    1.1 MAX. NO. OF DATA

IF (LHOOK) CALL DR_HOOK('PPOBSASTL',0,ZHOOK_HANDLE)
ILEN=KLEN
IMXCNT = MAXVAL(KCOUNT(1:ILEN))
IF(IMXCNT == 0) GOTO 9
INPP=0

LLH2= CDPAR == 'H2'  .OR. CDPAR == 'BG1'
LLU10=CDPAR == 'U10' .OR. CDPAR == 'FFS'  .OR. CDPAR == 'BG1'
LLT2= CDPAR == 'T2'  .OR. CDPAR == 'BG1'
LLAUV=CDPAR == 'AUV'
LLNEUTRAL=(KOBSTYPE == NSCATT.AND.LSCATT_NEUTRAL)


IF(.NOT.ANY((/LLH2,LLU10,LLT2,LLAUV/))) THEN
  WRITE(NULERR,'('' *** REQUESTED PARAMETER='',A)') CDPAR
  CALL ABOR1('ERROR PPOBSASTL: WRONG REQUESTED PARAMETER')
ENDIF

!*    2.  10M U-V COMPONENTS

IF(LLU10) THEN
  IF(INPP+2 > KDPP) CALL ABOR1('PPOBSASTL: KDPP EXCEEDED, H2')
  INPP=INPP+2

  CALL PPUV10MTL(KDLEN,1,ILEN,LLNEUTRAL,PINTH,&
   & PUF5(1,NFLEVG),PVF5(1,NFLEVG),PAPHI5(1,NFLEVG),&
   & PUF(1,NFLEVG),PVF(1,NFLEVG),PAPHI(1,NFLEVG),&
   & PRI5,PBN5,PBM5,&
   & PBN,PBM,PU05,PV05,&
   & PXPP(1,1,INPP-1),PXPP(1,1,INPP))  
ENDIF

!*    3.  2M TEMPERATURE

IF(LLT2) THEN
  IF(INPP+1 > KDPP) CALL ABOR1('PPOBSASTL: KDPP EXCEEDED, H2')
  INPP=INPP+1

  CALL PPT2MTL(KDLEN,1,ILEN,PINTH,&
   & PQF5(1,NFLEVG),PAPHI5(1,NFLEVG),&
   & PQF(1,NFLEVG),PAPHI(1,NFLEVG),&
   & PCPTGZ5,PCPTS5,&
   & PCPTGZ,PCPTS,&
   & PRI5,PBN5,PBH5,&
   & PBN,PBH,&
   & PXPP(1,1,INPP))  
ENDIF

!*    4.  2M RELATIVE HUMIDITY

IF(LLH2) THEN
  IF(INPP+1 > KDPP) CALL ABOR1('PPOBSASTL: KDPP EXCEEDED, T2')
  INPP=INPP+1

  ZRHMAX=1.2_JPRB
  ZRHMIN=-0.2_JPRB
  CALL PPRH2MTL(KDLEN,1,ILEN,ZRHMAX,ZRHMIN,&
   & PRESF5(1,NFLEVG),PQF5(1,NFLEVG),PTF5(1,NFLEVG),&
   & PRESF(1,NFLEVG),PQF(1,NFLEVG),PTF(1,NFLEVG),&
   & PRH2M5,PES5(1,2),&
   & PXPP(1,1,INPP))  
ENDIF

!*    5.  AMBIGUOUS SCAT WINDS - TL LOGARITMIC CORRECTION
!*        ZLLH=ICAO height of lowest model level. Truncated
!         in order to have agreement with earlier code (=32m)

IF(LLAUV) THEN
  IF(KOBSTYPE /= NSCATT) CALL ABOR1('PPOBSASTL: AUV REQUIRES NSCATT')
  IF(INPP+2 > KDPP) CALL ABOR1('PPOBSASTL: KDPP EXCEEDED, AUV')
  INPP=INPP+2

  Z10=10._JPRB
  ZLLH=REAL(INT(STZ(NFLEVG)),JPRB)
  DO J=1,ILEN
    ZLOGC=LOG(Z10/PZ0SC(J)) / LOG(ZLLH/PZ0SC(J))
    PXPP(J,1,INPP-1)=ZLOGC*PUF(J,NFLEVG)
    PXPP(J,1,INPP)=ZLOGC*PVF(J,NFLEVG)
  ENDDO
ENDIF

!     9.  RETURN

9 CONTINUE
IF (LHOOK) CALL DR_HOOK('PPOBSASTL',1,ZHOOK_HANDLE)
END SUBROUTINE PPOBSASTL
