SUBROUTINE PPOBSASAD(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,&
 & PAPHI5,PCPTGZ5,PCPTS5,PRH2M5,PES5,&
 & PRI5,PBN5,PBM5,PBH5)  

!**** PPOBSASAD - ADJOINT OF POST-PROCESSING

!     CARLA CARDINALI          ECMWF           92-18-03

!     PURPOSE
!     -------

!        FIND OUT A GRADIENT WITH RESPECT TO POST-PROCESSED VALUES.

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

!     CALL PPOBSASAD(KDLEN,KLEN,KDCOUNT,CDPAR,PINTH,KOBSTYPE,KCOUNT,PZ0SC,
!    O               PRESF,PUF,PVF,PTF,PQF,
!    O               PCPTGZ,PCPTS,PAPHI,PBN,PBM,PBH,
!    I               KDPP,PXPP,
!    R               PRESF5,PUF5,PVF5,PTF5,PQF5,PU05,PV05,
!    R               PAPHI5,PCPTGZ5,PCPTS5,PRH2M5,PES5,
!    R               PRI5,PBN5,PBM5,PBH5)
!     WHERE KDLEN   : FIRST DIMENSION (OBSERVATIONS)
!           KLEN    : ACTUAL NUMBER OF OBSERVATIONS
!           KDCOUNT : SECOND DIMENSION (Data)
!           CDPAR   : POST-PROCESSING PARAMETER
!           PINTH   : INTERPOLATION HEIGHT
!           KOBSTYPE: OBS. TYPE
!           KCOUNT  : COUNTER OF DATA PER OBS
!           PZ0SC   : ROUGHNESS LENGHT COMPUTED FROM SCAT WIND SPEED
!           PRESH   : GRAD. WITH RESPECT TO HALF LEVELS
!           PRESF   : GRAD. WITH RESPECT TO FULL LEVELS
!           PUF     : GRAD. WITH RESPECT TO U (MODEL VALUES)
!           PVF     :            "          V       "
!           PTF     :            "          T       "
!           PQF     :            "          Q       "
!           KDPP    : Number of fields, dimension of PXPP.
!           PXPP    : POST-PROCESSED VALUES
!           PRESH5  : HALF LEVEL PRESSURES
!           PRESF5  : FULL LEVEL PRESSURES
!           PUF5    : U AT MODEL FULL LEVELS
!           PVF5    : V AT MODEL FULL LEVELS
!           PTF5    : T AT MODEL FULL LEVELS
!           PQF5    : Q AT MODEL FULL LEVELS
!           PAPHI5  : GEOPOTENTIAL MODEL LEVELS
!           PCPTGZ5 : STATIC ENERGY (LOWER LEVEL)
!           PCPTS5  : STATIC ENERGY AT THE SURFACE
!           PRI5    : RICHARDSON NO.
!           PBN5    : STABILITY FUNCTION (NEUTRAL CASE)
!           PBM5    : DRAG COEFFICIENT FOR MOMENTUM
!           PBH5    : DRAG COEFFICIENT FOR HEAT
!           PU05    : U-COMP OF OCEAN CURRENT
!           PV05    : V-COMP OF OCEAN CURRENT

!        PPOBSASAD IS CALLED FROM SURFACAD

!**   METHOD
!     ------

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

!        PPT2MAD    -      "     PPT2M
!        PPUV10MAD  - ADJOINT OF PPUV10M
!        PPRH2MAD   -      "     PPRH2M

!**   MODIFICATIONS
!     -------------
!     L. Isaksen      96-02-20 : NFLEV --> NFLEVG
!     Erik Andersson  97-11-17 : GOM-variables more flexible
!     Erik Andersson  98-06-11 : Pass dimension as argument
!     E.Gerard        99-05-05 : If NSATEM U10 doesn't require LGSMU & LGSMV .T.
!     H.Hersbach  041201 : Introduce neutral-wind operator for Scat, include ocean current

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

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

USE YOMDIM   , ONLY : NFLEVG
USE YOMLUN   , ONLY : NULERR
USE YOMOBS   , ONLY : LSCATT_NEUTRAL
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(INOUT) :: PRESF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTGZ(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTS(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAPHI(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBN(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBM(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: 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)    :: PAPHI5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPTGZ5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPTS5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRH2M5(KDLEN,KDCOUNT) 
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) 
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 "pprh2mad.intfb.h"
#include "ppt2mad.intfb.h"
#include "ppuv10mad.intfb.h"
!     ------------------------------------------------------------------
!*    1.  PREPARATION
!*    1.1 MAX. NO. OF DATA

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

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 PPOBSASAD: WRONG REQUESTED PARAMETER')
ENDIF

!*    2.  ADJOINT OF 10 METER U-V COMPONENTS

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

  CALL PPUV10MAD(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.  ADJOINT OF 2 METER TEMPERATURE

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

  CALL PPT2MAD(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.  ADJOINT OF 2 METER RELATIVITY HUMIDITY

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

  ZRHMAX=1.2_JPRB
  ZRHMIN=-0.2_JPRB
  CALL PPRH2MAD(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 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('PPOBSASAD: AUV REQUIRES NSCATT')
  IF(INPP+2 > KDPP) CALL ABOR1('PPOBSASAD: 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))
    PUF(J,NFLEVG)=PUF(J,NFLEVG)+ZLOGC*PXPP(J,1,INPP-1)
    PVF(J,NFLEVG)=PVF(J,NFLEVG)+ZLOGC*PXPP(J,1,INPP)
  ENDDO
ENDIF

!     9.  RETURN

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