SUBROUTINE PPOBSACAD(KDLEN,KLEN,KDCOUNT,CDPAR,PINTH,KOBSTYPE,KCOUNT,&
 & PRESH,PRESF,PGEOPH,PGEOPF,&
 & PCP,PRF,PUF,PVF,PTF,PQF,&
 & PTS,PWS,PSN,PZ0,&
 & KDPP,PXPP,&
 & PRESH5,PRESF5,PGEOPH5,PGEOPF5,&
 & PCP5,PRF5,PUF5,PVF5,PTF5,PQF5,&
 & PTS5,PWS5,PVEG5,PSN5,PSLM5,PZ05,PRH2M5)  
!****-------------------------------------------------------------------
!****  PPOBSACAD : CANARI SURFACE POST-PROCESSING (AD)
!****  ---------
!****   AUTHOR :      P.MOLL 08-92, DG 05/94
!****                (Tangent linear version: F. Bouyssel 11-98)
!****-------------------------------------------------------------------
!***  PURPOSE : FIND OUT AN EQUIVALENT MODEL PARAMETER FOR A GIVEN OBSER
!***  -------
!**   INTERFACE
!**   ---------

!     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
!           PRESH5  : HALF LEVEL PRESS. AT OBS. POINTS
!           PRESF5  : FULL LEVEL PRESS. AT OBS. POINTS
!           PGEOPH5 : HALF LEVEL GEOP. AT OBS. POINTS
!           PGEOPF5 : FULL LEVEL GEOP. AT OBS. POINTS
!           PCP5    : Cp
!           PRF5    : R
!           PUF5    : U VALUES (MODEL) AT OB. POINS
!           PVF5    : V VALUES (MODEL) AT OB. POINS
!           PTF5    : T VALUES (MODEL) AT OB. POINS
!           PQF5    : Q VALUES (MODEL) AT OB. POINS
!           PTS5    : SURFACE TEMPERATURE
!           PWS5    : SOIL WETNESS
!           PVEG5   : VEGETATION
!           PSN5    : SNOW DEPTH
!           PSLM5   : SEE/LAND MASK
!           PZ05    : ROUGHNESS LENGTH
!           PUPP    : U (POST-PROCESSED)
!           PVPP    : V        "
!           PTPP    : T        "
!           PTSPP   : TS       "
!           PHPP    : RH       "  

!     PPOBSACTL CALLED FOR SYNOP AND DRIBU FROM SURFACEO

!**   METHOD : CALL TO AN APPROPRIATE POST-PROCESSING ROUTINE
!     ------
!**   EXTERNALS : ACHMTAD
!     ---------
!     MODIFIED
!     --------
!     F.Bouyssel  98-11-25 : Simplified ro run with PREINTS
!     P.Moll      99-08-03 : implementation in cy21t1  
!     P. Moll     99/10/15 : Put Apache and ACHMT in cy22 (for MF)
!     W.Sadiki    00/11/10 : modif pour appels odb
!     R. El Khatib : 01-08-07 Pruning options
!        M.Hamrud      01-Jul-2006 Revised surface fields
!     C. Payan  2008/11    : Neutral Wind
!****-------------------------------------------------------------------

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

USE YOMDB
USE YOMDIM   , ONLY : NFLEVG
USE YOMLUN   , ONLY : NULOUT
USE YOMCST   , ONLY : RG
USE YOMOBS   , ONLY : LSCATT_NEUTRAL
USE YOMPHY1  , ONLY : EWFC     ,GWFC
USE YOMPHY2  , ONLY : HTCLS    ,HVCLS
USE YOMPHY   , ONLY : LSOLV    ,LFGEL
USE SURFACE_FIELDS_MIX, ONLY : YSD_VVD
USE YOMCOCTP , ONLY : NSYNOP   ,NSCATT
USE GOMS_MIX , ONLY : YGOMEC

IMPLICIT NONE

! * DUMMY:
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(INOUT) :: PRESH(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRESF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGEOPH(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGEOPF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCP(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRF(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) :: PTS(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWS(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSN(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PZ0(KDLEN) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDPP
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PXPP(KDLEN,KDCOUNT,KDPP) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESH5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESF5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOPH5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOPF5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCP5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRF5(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)    :: PTS5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWS5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVEG5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSN5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLM5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZ05(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRH2M5(KDLEN,KDCOUNT) 
REAL(KIND=JPRB) :: ZDPHIT(KDLEN),                ZDPHIV(KDLEN)
REAL(KIND=JPRB) :: ZARG(KDLEN),                  ZHV5(KDLEN)
REAL(KIND=JPRB) :: ZZ0H(KDLEN),                  ZWFC(KDLEN)
REAL(KIND=JPRB) :: ZGZ0R(KDLEN),                 ZNEIJG5(KDLEN)
REAL(KIND=JPRB) :: ZNEIJV5(KDLEN)       
REAL(KIND=JPRB) :: ZWSI5(KDLEN)
REAL(KIND=JPRB) :: ZHV(KDLEN)
REAL(KIND=JPRB) :: ZNEIJG(KDLEN),                ZNEIJV(KDLEN)       
REAL(KIND=JPRB) :: ZNBVNO(KDLEN,0:NFLEVG)       
REAL(KIND=JPRB) :: ZCD(KDLEN),                   ZCDN(KDLEN)
REAL(KIND=JPRB) :: ZCDROV(KDLEN),                ZCH(KDLEN)
REAL(KIND=JPRB) :: ZCHROV(KDLEN),                ZCPS(KDLEN)
REAL(KIND=JPRB) :: ZDQSTS(KDLEN),                ZGWDCS(KDLEN)
REAL(KIND=JPRB) :: ZGZ0(KDLEN),                  ZHQ(KDLEN)
REAL(KIND=JPRB) :: ZHU(KDLEN),                   ZNEIJ(KDLEN)
REAL(KIND=JPRB) :: ZQCLS(KDLEN),                 ZQS(KDLEN)
REAL(KIND=JPRB) :: ZQSATS(KDLEN),                ZRHCLS(KDLEN)
REAL(KIND=JPRB) :: ZRS(KDLEN),                   ZSTAB(KDLEN)
REAL(KIND=JPRB) :: ZTCLS(KDLEN),                 ZUCLS(KDLEN)
REAL(KIND=JPRB) :: ZVCLS(KDLEN),                 ZVEG(KDLEN)
REAL(KIND=JPRB) :: ZXDROV(KDLEN),                ZXHROV(KDLEN)
REAL(KIND=JPRB) :: ZPCLS(KDLEN),                 ZWSI(KDLEN)
REAL(KIND=JPRB) :: ZUCLN(KDLEN),                 ZVCLN(KDLEN)

REAL(KIND=JPRB) :: ZZARG,ZEPS

INTEGER(KIND=JPIM) :: ILEN,JROF,IPOSM,IMXCNT

LOGICAL :: LLDCLS,LLDHMT,LLDZ0H
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "achmtad.intfb.h"

#include "openmp_obs.h"

!**---------------------------------------------------------------------
!**  1.  PREPARATION DU CALCUL DES PARAMETRES AUX HAUTEURS METEOS.
!**      --------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('PPOBSACAD',0,ZHOOK_HANDLE)
ILEN=KLEN
IMXCNT = MAXVAL(KCOUNT(1:ILEN))
IF(IMXCNT == 0 .AND. LHOOK) CALL DR_HOOK('PPOBSACAD',1,ZHOOK_HANDLE)
IF(IMXCNT == 0) RETURN

!  REMPLISSAGE DES TABLEAUX LOCAUX.

ZDPHIT(1:ILEN) = RG*HTCLS
ZDPHIV(1:ILEN) = RG*HVCLS

IF(KOBSTYPE == NSYNOP)THEN
  DO JROF = 1 , ILEN
    ZDPHIV(JROF)=PINTH(JROF)
  ENDDO
ENDIF

LLDCLS=.FALSE.
LLDHMT=.TRUE.
LLDZ0H= LSOLV .AND. YSD_VVD%NUMFLDS >= 8

! Calculs preliminaires pour le schema sol-vegetation (WFC,HV)
IF ( LSOLV ) THEN
  DO JROF = 1 , ILEN
    IPOSM = ROBHDR(JROF,MDB_MAPOMM_AT_INDEX)
    ZARG(JROF) = YGOMEC(IPOSM)%ECARG
    ZHV5(JROF)  = YGOMEC(IPOSM)%ECHV
    IF (LLDZ0H) ZZ0H(JROF) = YGOMEC(IPOSM)%ECZ0H
    IF (LFGEL) ZWSI5(JROF) = YGOMEC(IPOSM)%ECSAB
    IF ( PSLM5(JROF) <= 0.5_JPRB ) THEN
      ZWFC(JROF) = 1.0_JPRB
    ELSE
      ZEPS=1.E-1_JPRB
      ZZARG = MAX(ZEPS,ZARG(JROF))
      ZWFC(JROF) = GWFC*(ZZARG**EWFC)
    ENDIF
  ENDDO
ENDIF

ZNBVNO(1:ILEN,0:NFLEVG)=0.0_JPRB

ZHV   (1:ILEN) = 0.0_JPRB
ZNEIJG(1:ILEN) = 0.0_JPRB
ZNEIJV(1:ILEN) = 0.0_JPRB
ZCD   (1:ILEN) = 0.0_JPRB
ZCDN  (1:ILEN) = 0.0_JPRB
ZCDROV(1:ILEN) = 0.0_JPRB
ZCH   (1:ILEN) = 0.0_JPRB
ZCHROV(1:ILEN) = 0.0_JPRB
ZCPS  (1:ILEN) = 0.0_JPRB
ZDQSTS(1:ILEN) = 0.0_JPRB
ZGWDCS(1:ILEN) = 0.0_JPRB
ZGZ0  (1:ILEN) = 0.0_JPRB
ZHQ   (1:ILEN) = 0.0_JPRB
ZHU   (1:ILEN) = 0.0_JPRB
ZNEIJ (1:ILEN) = 0.0_JPRB
ZQCLS (1:ILEN) = 0.0_JPRB
ZQS   (1:ILEN) = 0.0_JPRB
ZQSATS(1:ILEN) = 0.0_JPRB
ZRHCLS(1:ILEN) = 0.0_JPRB
ZRS   (1:ILEN) = 0.0_JPRB
ZTCLS (1:ILEN) = 0.0_JPRB
ZUCLS (1:ILEN) = 0.0_JPRB
ZVCLS (1:ILEN) = 0.0_JPRB
ZUCLN (1:ILEN) = 0.0_JPRB
ZVCLN (1:ILEN) = 0.0_JPRB
ZPCLS (1:ILEN) = 0.0_JPRB
ZVEG  (1:ILEN) = 0.0_JPRB
ZWSI  (1:ILEN) = 0.0_JPRB
ZXDROV(1:ILEN) = 0.0_JPRB
ZXHROV(1:ILEN) = 0.0_JPRB

DO JROF = 1 , ILEN

  IF (CDPAR == 'H2') THEN
    IF ((PRH2M5(JROF,1) <= 0.0_JPRB).OR.(PRH2M5(JROF,1) >= 1.0_JPRB)) THEN
      PXPP(JROF,1,1) = 0.0_JPRB
    ELSE
      ZRHCLS(JROF) = ZRHCLS(JROF) + PXPP(JROF,1,1)
      PXPP(JROF,1,1) = 0.0_JPRB
    ENDIF
  ELSEIF (CDPAR == 'U10')     THEN
    IF(KOBSTYPE == NSCATT .AND. LSCATT_NEUTRAL) THEN
      ZUCLN(JROF) = ZUCLN(JROF) + PXPP(JROF,1,1)
      PXPP(JROF,1,1) = 0.0_JPRB
      ZVCLN(JROF) = ZVCLN(JROF) + PXPP(JROF,1,2)
      PXPP(JROF,1,2) = 0.0_JPRB
    ELSE
      ZUCLS(JROF) = ZUCLS(JROF) + PXPP(JROF,1,1)
      PXPP(JROF,1,1) = 0.0_JPRB
      ZVCLS(JROF) = ZVCLS(JROF) + PXPP(JROF,1,2)
      PXPP(JROF,1,2) = 0.0_JPRB
    ENDIF
  ELSEIF (CDPAR == 'T2') THEN
    ZTCLS(JROF) = ZTCLS(JROF) + PXPP(JROF,1,1)
    PXPP(JROF,1,1) = 0.0_JPRB
  ELSEIF (CDPAR == 'TS') THEN
    PTS(JROF) = PTS(JROF) + PXPP(JROF,1,1)
    PXPP(JROF,1,1) = 0.0_JPRB
  ELSE
    WRITE(NULOUT,'('' *** ERROR IN PPOBSACTL'')')
    WRITE(NULOUT,'('' *** REQUESTED PARAMETER='',A)') CDPAR
  ENDIF

ENDDO

CALL ACHMTAD(1,ILEN,KDLEN,0,NFLEVG,&
 & PGEOPH5,PGEOPF5,PRESH5,PRESF5,PCP5,PQF5(1,1),PRF5,PTF5(1,1),&
 & PUF5(1,1),PVF5(1,1),PZ05,ZHV5,&
 & ZNEIJG5,ZNEIJV5,PSN5,PTS5,PWS5,ZWSI5,&
 & PGEOPH,PGEOPF,PRESH,PRESF,PCP,PQF(1,1),PRF,PTF(1,1),&
 & PUF(1,1),PVF(1,1),ZDPHIT,ZDPHIV,PZ0,ZZ0H,ZGZ0R,&
 & ZHV,PSLM5,ZNEIJG,ZNEIJV,PSN,PTS,PVEG5,ZWFC,PWS,ZWSI,&
 & LLDCLS,LLDHMT,LLDZ0H,&
 & ZNBVNO,ZCD,ZCDN,ZCDROV,ZCH,ZCHROV,ZCPS,ZDQSTS,ZGWDCS,&
 & ZGZ0,ZHQ,ZHU,ZNEIJ,ZQCLS,ZQS,ZQSATS,ZRHCLS,ZRS,&
 & ZSTAB,ZTCLS,ZUCLS,ZVCLS,ZUCLN,ZVCLN,ZPCLS,ZVEG,ZXDROV,ZXHROV,&
 & 'ACHMTAD')  

!**---------------------------------------------------------------------
!**  - 3 - Stockage/initialisation des champs diagnostics
!**        necessaires a l'analyse.
!**        ----------------------------------------------

!**---------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('PPOBSACAD',1,ZHOOK_HANDLE)
END SUBROUTINE PPOBSACAD
