SUBROUTINE CAHUAX(KPROMA,KNBPT,KTASK,PTT,PQT,PSFL,PSFLN,POLDT,&
 & PGELAT,PGELAM,PCAGUE,PESIG,PSGHUM)  
!****-------------------------------------------------------------------
!****   CAHUAX : ROUTINE GERANT L'EXECUTION DE L'ANALYSE D'HUMIDITE
!****-------------------------------------------------------------------
!***  ROUTINES APPELANTES: - CAPOTX -
!***  -------------------
!***  ARGUMENTS:  IN       KPROMA : surdimensionnement horizontal
!***  ---------   IN       KNBPT  : nombre reel de points traites
!***              IN       KTASK  : numero de la tache (multitasking)
!***              IN       PTT    :
!***              IN/OUT   PQT    :
!***              IN       PSFL   : pressions aux niveaux pleins
!***              IN       PSFLN  : LOG (pressions aux niveaux pleins)
!***              IN       POLDT  :
!***              IN       PGELAT, PGELAM, PCAGUE, PESIG :
!***              OUT      PSGHUM : ecart-type d'erreur d'analyse

!     COMMONS: - QACTAN - DEFINITIONS RELATIVES AUX NIVEAUX D'ANALYSE.
!     -------  - QADOCK - CONTIENT LA TABLE DE CONTINGENCE
!                         PREDICTEURS/PREDICTANTS ET DES CONTRAINTES
!                         POUR LA SELECTION DES OBSERVATIONS.
!              - QAPAVU - DIMENSIONS ET INDICE RELATIFS A *QAVARA*.
!              - QADIAG - CHAMPS POINTS DE GRILLE SPECIAUX DE L'ANALYSE.
!              - YOMDIM - DIMENSION DES TABLEAUX DE TRAVAIL.
!              - PARDIMO- PARAMETERS POUR LES TABLEAUX D'OBSERVATIONS.

!     EXTERNES: - CANEVA - ROUTINE EFFECTUANT L'ANALYSE.
!     --------
!****--------------------------------------------------------------------

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

USE PARDIMO  , ONLY : JPNOTP
USE YOMDIM   , ONLY : NFLEVG
USE QAPAVU   , ONLY : JPPXHU
USE YOMPHY   , ONLY : LNEIGE
USE YOMGEM   , ONLY : VBH      ,VAH
USE YOMCST   , ONLY : RV       ,RCPV     ,RETV     ,RCW      ,&
 & RCS      ,RLVTT    ,RLSTT    ,RTT      ,RALPW    ,&
 & RBETW    ,RGAMW    ,RALPS    ,RBETS    ,RGAMS    ,&
 & RALPD    ,RBETD    ,RGAMD  
USE QACTAN   , ONLY : NCANLI   ,NCANLS
USE QAPREX   , ONLY : NPREA    ,NBPREA   ,NAHU
USE QADOCK   , ONLY : QDSTVA   ,MINMA    ,QCORMIN  ,QDELPI
USE QADIAG   , ONLY : RCATSL   ,RCARES   ,RCASIG

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNBPT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTASK 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTT(KPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQT(KPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSFL(KNBPT,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSFLN(KNBPT,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POLDT(KNBPT,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGELAT(KNBPT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGELAM(KNBPT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCAGUE(2,KNBPT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PESIG(2*NFLEVG+5,KNBPT) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSGHUM(NFLEVG,KNBPT) 
!     INM    : NOMBRE DE PREDICTEURS PAR TYPE DE PREDICTANT.
!     INBPR  : NOMBRE DE PREDICTEURS PAR VERTICALES D'ANALYSE.

REAL(KIND=JPRB) ::    ZDSTVA(JPNOTP)
INTEGER(KIND=JPIM) :: INM(1), INBPR(KNBPT*NFLEVG), INXI(1), INLXI

!     ZSIGPS : EN GENERAL, ECART TYPES D'ERREUR DE L'EBAUCHE
!     ZSIGA  : ECART TYPES D'ERREUR D'ANALYSE.
!     ZQGUESS: humidite specifique du guess au niveau *
!     ZESINVG: inverse de la pression de vapeur saturante au niveau *

REAL(KIND=JPRB) :: ZSIGPS(KNBPT*NFLEVG)
REAL(KIND=JPRB) :: ZRESIA(KNBPT*NFLEVG), ZSIGA(KNBPT*NFLEVG)
REAL(KIND=JPRB) :: ZPRESF(KNBPT*NFLEVG), ZQGUESS(KNBPT), ZESINVG(KNBPT)

INTEGER(KIND=JPIM) :: IANTY, ILEVI, INBPV, IQUOI, Ixx(JPNOTP), JLEV, JROF

REAL(KIND=JPRB) :: ZCORMIN, ZDELPI, ZDELTA, ZE2, ZES, ZESLEV,&
 & ZOLDT, ZPREF, ZPRESS, ZPTEST, ZQ, ZQSAT, &
 & ZQT, ZRH, ZT, Zxxx(JPNOTP)  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "caneva.intfb.h"

#include "fcttrm.h"

!**----------------------------------------------------------------------
!**       1. Initialisations.
!**          ---------------

IF (LHOOK) CALL DR_HOOK('CAHUAX',0,ZHOOK_HANDLE)
RCATSL(:,:,KTASK) = 0.0_JPRB
RCARES(:,:,KTASK) = 0.0_JPRB
RCASIG(:,:,KTASK) = 1.0_JPRB

ILEVI = NCANLI - 1
ZPTEST = 37500._JPRB
ZPREF = 100000._JPRB

!DIR$ SHORTLOOP
DO JLEV = NCANLI , NCANLS
  IF ( (VAH(JLEV)+VBH(JLEV)*ZPREF) <= ZPTEST ) THEN
    ILEVI = ILEVI + 1
  ENDIF
ENDDO
INBPV = NCANLS-ILEVI
IF ( INBPV <= 0  .AND. LHOOK) CALL DR_HOOK('CAHUAX',1,ZHOOK_HANDLE)
IF ( INBPV <= 0 ) RETURN

!**---------------------------------------------------------------------
!**       2. Initialisation des statistiques de l'ebauche.
!**          --------------------------------------------

DO JLEV = 1 , INBPV
  DO JROF = 1 , KNBPT
    ZPRESF(JROF+KNBPT*(JLEV-1)) = PSFLN(JROF,ILEVI+JLEV)
    ZSIGPS(JROF+KNBPT*(JLEV-1)) = PESIG(NFLEVG+ILEVI+JLEV,JROF)
  ENDDO
ENDDO

!**---------------------------------------------------------------------
!**       3. Initialisation des parametres.
!**          -----------------------------

IQUOI = -2
IANTY = 0

INLXI = 1
INXI(1) = JPPXHU

ZDELPI = QDELPI(NAHU)
ZCORMIN = QCORMIN(NAHU)

ZDSTVA = 0.0_JPRB

ZDSTVA(1) = QDSTVA(1)
ZDSTVA(5) = QDSTVA(5)
ZDSTVA(7) = QDSTVA(7)

INM(1) = MINMA(NAHU)

!**---------------------------------------------------------------------
!**       4. Lancement de l'analyse par interpolation optimale.
!**          -------------------------------------------------

CALL CANEVA(IQUOI, IANTY, KTASK,&
 & Zxxx, ZDSTVA(1), ZDELPI, Ixx, Ixx,&
 & ZCORMIN, PCAGUE, PGELAT, PGELAM,&
 & ZPRESF(1), KNBPT, INBPV,&
 & INXI(1), INLXI, NPREA(1,NAHU), NBPREA(NAHU), INM(1),&
 & ZSIGPS(1), ZRESIA(1), ZSIGA(1), INBPR(1))  

!**---------------------------------------------------------------------
!**       5. Calcul des champs analyses.
!**          --------------------------

DO JROF = 1 , KNBPT
  ZT = PTT(JROF,ILEVI+1)
  IF ( LNEIGE ) THEN
    ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZT))
  ELSE
    ZDELTA=0.0_JPRB
  ENDIF
  ZESINVG(JROF) = 1.0_JPRB / FOEW(ZT,ZDELTA)
  ZQGUESS(JROF) = PQT(JROF,ILEVI+1)
ENDDO

DO JLEV = 1 , INBPV
  DO JROF = 1 , KNBPT
    RCATSL(JROF,ILEVI+JLEV,KTASK) =REAL(INBPR(JROF+KNBPT*(JLEV-1)),JPRB)
    RCARES(JROF,ILEVI+JLEV,KTASK) =ZRESIA(JROF+KNBPT*(JLEV-1))
    RCASIG(JROF,ILEVI+JLEV,KTASK) =&
     & ZSIGA(JROF+KNBPT*(JLEV-1)) / ZSIGPS(JROF+KNBPT*(JLEV-1))  
    PSGHUM(ILEVI+JLEV,JROF)=ZSIGA(JROF+KNBPT*(JLEV-1))
! if there is a observation POLDT is consitent with the OMG computation
! but if there is no observation to keep Hu seem worse than to keep Q
! (work of Mehdi Elabed introduced like that by Vincent Casse)
    ZOLDT = POLDT(JROF,ILEVI+JLEV)
    ZT    = PTT(JROF,ILEVI+JLEV)
    ZQ    = PQT(JROF,ILEVI+JLEV)
    ZPRESS= PSFL(JROF,ILEVI+JLEV)

    IF ( LNEIGE ) THEN
      ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZOLDT))
    ELSE
      ZDELTA=0.0_JPRB
    ENDIF
    ZES = FOEW(ZOLDT,ZDELTA)
    ZRH = ( ZPRESS * ZQ * (RETV+1.0_JPRB) ) / ( (1.0_JPRB+RETV*ZQ) * ZES )&
     & + ZRESIA(JROF+KNBPT*(JLEV-1))  
    ZRH = MAX(0.0_JPRB,MIN(1.0_JPRB,ZRH))
    IF ( LNEIGE ) THEN
      ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZT))
    ELSE
      ZDELTA=0.0_JPRB
    ENDIF
    ZE2   = ZRH * FOEW(ZT,ZDELTA) / ZPRESS
    PQT(JROF,ILEVI+JLEV) = FOQS(ZE2)
  ENDDO
ENDDO

! entre NCANLI et ILEVI-1 on utilise une formule ad hoc (voir doc. !!!)
DO JLEV = NCANLI , ILEVI
  DO JROF = 1 , KNBPT
    ZT     = PTT(JROF,JLEV)
    ZPRESS = PSFL(JROF,JLEV)

    IF ( LNEIGE ) THEN
      ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZT))
    ELSE
      ZDELTA=0.0_JPRB
    ENDIF
    ZESLEV= FOEW(ZT,ZDELTA)
    ZQSAT = FOQS(ZESLEV/ZPRESS)
    ZQT   = PQT(JROF,JLEV) + ZESLEV * ZESINVG(JROF) *&
     & ( PQT(JROF,ILEVI+1) - ZQGUESS(JROF) )  
    PQT(JROF,JLEV) = MAX(0.0_JPRB,MIN(ZQT,ZQSAT))
  ENDDO
ENDDO

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