SUBROUTINE CALICO
!--------------------------------------------------------------------
!   CALICO : Initialisation des ecart-types d'erreur d'observation
!   ------   et des ecart-types d'erreur de representativite
!--------------------------------------------------------------------
!  But : initialisation  des ecart-types d'erreur d'observation et des
!  ---   ecart-types d'erreur de representativite pour tous les parametres;
!        mise a jour des pressions manquantes
!--------------------------------------------------------------------
!  Sequence d'appel     : CALL CALICO
!  ----------------
!  Sous-programme amont : CAMELO
!  --------------------
!  COMMON utilises      : YOMDIMO  - YOMOBA   - QAETEO  - QAKEKI
!  ---------------        YOMCMHDR - YOMCMBDY - YOMVNMB - YOMOCTP
!  Algorithme :
!  ----------
!    - initialisations
!    - pour chaque observation
!       - recherche du sous-type d'observations
!       - pour chaque parametre de l'observation
!          - recherche de l'indice du parametre concerne
!          - recherche des niveaux pression correspondants
!          - saisie de l'ecart-type d'erreur d'observation
!          - saisie de l'ecart-type d'erreur de representativite
!--------------------------------------------------------------------
!  auteur        :  Ph. Caille  04/90
!  modifications :  Ph. Caille  05/93  passage du FOC au CMAFOC
!                   Ph. Caille  03/96  passage du CMAFOC au CMAFOC
!                   JN  Thepaut 10/97  retrait du test NCONF.EQ.131 pour 
!                                      les SATEM
!                   LG          03/00  IOPARO for snow is initialized
!                   F.Taillefer 08/00  passage CMAFOC a ODB
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!--------------------------------------------------------------------

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

USE YOMCT0   , ONLY : LELAM
USE QAPASS   , ONLY : JPNVS
USE YOMDIMO  , ONLY : NOBTOT
USE YOMANCS  , ONLY : RMDI
USE QAETEO   , ONLY : ECTERO   ,ETEOST
USE QAREF    , ONLY : REF_STAT
USE YOMDB
USE YOMVNMB  , ONLY : NVNUMB
USE YOMCOCTP , ONLY : NSYNOP   ,NSRSCD   ,NATSCD   ,NSHSCD   ,NRADOH   ,&
 & NABSCD   ,NSHRED   ,NATSHS   ,NSYRCD   ,NAIREP   ,&
 & NSATOB   ,NTEMP    ,NPILOT   ,NSATEM   ,NSTMCD  
USE YOMLUN   , ONLY : NULOUT
USE QAKEKI   , ONLY : NDBCVF   ,NCQFCO   ,NCQFPC   ,NCQFPI   ,&
 & NCQFIN   ,NCQECO   ,NCQEPC   ,NCQEPI   ,NCQEIN   ,&
 & NCQKCO   ,NCQKPC   ,NCQKPI   ,NCQKIN   ,NCUPS    ,&
 & NCUUVT   ,NCUHU    ,NCUT2M   ,NCUH2M   ,NCUV10   ,&
 & NCURR    ,NCUSN    ,NCUSST  
USE QACTEX   , ONLY : LVERAL

IMPLICIT NONE

REAL(KIND=JPRB) :: ZOUAVE(JPNVS-1), ZLOGP(JPNVS)
LOGICAL :: LLSATEM

INTEGER(KIND=JPIM) :: ICDT, INBWAG, INDCOU, INIVO, INOVAR, IOBTYP, IOPARO, &
 & IOSTYP, ITPSB, J1, JA, JB, JH, JO, IRDFL, IFLG, IVAL, IWAG  

REAL(KIND=JPRB) :: Z_PRESB, Z_PRESH, ZECT, ZEPS, ZPRESS
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "qabitu.h"
#include "openmp_obs.h"

!--------------------------------------------------------------------
!  - 1 - Initialisations
!        ---------------

IF (LHOOK) CALL DR_HOOK('CALICO',0,ZHOOK_HANDLE)
DO JO = 1 , JPNVS
  ZLOGP(JO) = LOG( REF_STAT(JO,1) )
ENDDO
DO JO = 1 , JPNVS-1
  ZOUAVE(JO) =  1.0_JPRB / ( ZLOGP(JO) - ZLOGP(JO+1) )
ENDDO

LLSATEM=.FALSE.

!--------------------------------------------------------------------
!  - 2 -  Pour chaque observation traitee
!         -------------------------------

DO JO = 1 , NOBTOT
  IOBTYP = ROBHDR(JO,MDBOTP)
  ICDT   = ROBHDR(JO,MDB_CODETYPE_AT_HDR)

!--------------------------------------------------------------------
!  - 3 -  Recherche du sous-type d'observation
!         ------------------------------------

  IOSTYP = 1
  IF ( IOBTYP == NSYNOP ) THEN
    IF ( ICDT == NSRSCD .OR. ICDT == NATSCD .OR.&
       & ICDT == NSYRCD .OR. ICDT == NRADOH      ) THEN  
      IOSTYP = 1
    ELSEIF ( ICDT == NSHSCD .OR. ICDT == NABSCD .OR.&
       & ICDT == NSHRED .OR. ICDT == NATSHS      ) THEN  
      IOSTYP = 2
    ELSE
      IOSTYP = 2
    ENDIF
  ELSEIF ( IOBTYP == NSATOB ) THEN
    ITPSB = ROBHDR(JO,MDB_INSTTYPE_AT_HDR)
    IF ( ITPSB == 60 ) THEN
      IOSTYP = 2
    ELSEIF ( ITPSB == 62 ) THEN
      IOSTYP = 1
    ELSEIF ( ITPSB == 63 ) THEN
      IOSTYP = 4
    ELSEIF ( ITPSB == 68 ) THEN
      IOSTYP = 3
    ELSE
      IOSTYP = 5
    ENDIF
  ELSEIF ( IOBTYP == NSATEM ) THEN
    IF ( ICDT == NSTMCD ) THEN
      LLSATEM = .TRUE.
    ELSE
      LLSATEM = .FALSE.
    ENDIF
  ENDIF

!--------------------------------------------------------------------
!  - 4 -  Pour chaque parametre (wagon) de l'observation
!         ----------------------------------------------

  INBWAG = MLNKH2B(JO+1)-MLNKH2B(JO)

  DO J1 = 1 , INBWAG
    INIVO  = 0
    ZPRESS = 1.0_JPRB

!  - 4.1 -  recherche de l'indice correspondant au parametre traite

    IWAG = MLNKH2B(JO)+(J1-1)
    INOVAR = ROBODY(IWAG,MDBVNM)
    IF ( INOVAR == NVNUMB( 3) ) THEN
      IOPARO = 1
    ELSEIF ( INOVAR == NVNUMB( 8) .OR.INOVAR == NVNUMB(10)      ) THEN
      IOPARO = 2
    ELSEIF ( INOVAR == NVNUMB(12) ) THEN
      IOPARO = 5
    ELSEIF ( INOVAR == NVNUMB( 1) .OR.&
       & INOVAR == NVNUMB( 2) .OR.&
       & INOVAR == NVNUMB(56) .OR.&
       & INOVAR == NVNUMB(57)      ) THEN  
      IOPARO = 3
    ELSEIF ( INOVAR == NVNUMB( 5) .OR.&
       & INOVAR == NVNUMB( 7) .OR.&
       & INOVAR == NVNUMB(34) .OR.&
       !lg         &INOVAR == NVNUMB(46) .OR.&
       & INOVAR == NVNUMB(58) ) THEN  
      IOPARO = 4
    ELSEIF ( INOVAR == NVNUMB(4) ) THEN
      IOPARO = 5
    ELSEIF ( INOVAR == NVNUMB(46) ) THEN
      IOPARO = 6  
    ELSE
      GOTO 440
    ENDIF

!  - 4.2 -  recherche des indices niveaux pression idoines

    IF ( IOBTYP == NAIREP .OR. IOBTYP == NSATOB .OR.&
       & IOBTYP == NTEMP  .OR. IOBTYP == NPILOT      ) THEN  
      ZPRESS = ROBODY(IWAG,MDBPPP)
      INIVO  = 0

      DO JA = JPNVS-1 , 1 , -1
        IF ( ZPRESS > REF_STAT(JA+1,1) ) INIVO = JA
      ENDDO

    ENDIF

!  - 4.3 -  saisie de l'ecart-type d'erreur d'observation

    IF ( LLSATEM ) THEN
      Z_PRESB  = ROBODY(IWAG,MDBPRL)
      Z_PRESH  = ROBODY(IWAG,MDBPPP)
      INDCOU = 0
      ZEPS   = 1.E-5_JPRB

      DO JB = 1 , JPNVS-1
        DO JH = JB+1 , JPNVS
          INDCOU = INDCOU + 1
          ZECT = REF_STAT(JB,1) - REF_STAT(JB+1,1) - ZEPS

          IF ( ABS(Z_PRESB-REF_STAT(JB,1)) < ZECT .AND.&
             & ABS(Z_PRESH-REF_STAT(JH,1)) < ZEPS       ) THEN  
            ROBODY(IWAG,MDBOER) = ETEOST(INDCOU)
            GOTO 433
          ENDIF

        ENDDO
      ENDDO

! Pb sur les bornes de la couche
      ROBODY(IWAG,MDBOER) = 9999.99_JPRB
      WRITE (NULOUT,*) ' SATEM bizarre  P bas ',Z_PRESB,'   P haut ',Z_PRESH

      433 CONTINUE

      Z_PRESH  = ROBODY(IWAG,MDBPPP)
      IF ( ABS(Z_PRESH-70000._JPRB)  <  1.E-5_JPRB ) THEN
        ROBODY(IWAG,MDBOER) = ETEOST(7)
      ELSEIF ( ABS(Z_PRESH-50000._JPRB)  <  1.E-5_JPRB ) THEN
        ROBODY(IWAG,MDBOER) = ETEOST(6)
      ELSEIF ( ABS(Z_PRESH-30000._JPRB)  <  1.E-5_JPRB ) THEN
        ROBODY(IWAG,MDBOER) = ETEOST(5)
      ELSEIF ( ABS(Z_PRESH-10000._JPRB)  <  1.E-5_JPRB ) THEN
        ROBODY(IWAG,MDBOER) = ETEOST(4)
      ELSEIF ( ABS(Z_PRESH- 5000._JPRB)  <  1.E-5_JPRB ) THEN
        ROBODY(IWAG,MDBOER) = ETEOST(3)
      ELSEIF ( ABS(Z_PRESH- 3000._JPRB)  <  1.E-5_JPRB ) THEN
        ROBODY(IWAG,MDBOER) = ETEOST(2)
      ELSEIF ( ABS(Z_PRESH- 1000._JPRB)  <  1.E-5_JPRB ) THEN
        ROBODY(IWAG,MDBOER) = ETEOST(1)
      ELSE
        WRITE (NULOUT,*) ' SATEM bizarre  P bas ',&
         & ROBODY(IWAG,MDBPRL),' P haut ', Z_PRESH  
      ENDIF

    ELSEIF ( IOBTYP == NAIREP .OR. IOBTYP == NSATOB .OR.&
       & IOBTYP == NTEMP  .OR. IOBTYP == NPILOT      ) THEN  

      IF ( INIVO == 0 ) THEN
        ROBODY(IWAG,MDBOER)=ECTERO(IOBTYP,IOSTYP,IOPARO,JPNVS)
      ELSE
        ROBODY(IWAG,MDBOER)=ZOUAVE(INIVO) *&
         & ( (ZLOGP(INIVO)-LOG(ZPRESS))&
         & * ECTERO(IOBTYP,IOSTYP,IOPARO,INIVO+1)&
         & + (LOG(ZPRESS)-ZLOGP(INIVO+1))&
         & * ECTERO(IOBTYP,IOSTYP,IOPARO,INIVO) )  
      ENDIF

    ELSE
      ROBODY(IWAG,MDBOER)=ECTERO(IOBTYP,IOSTYP,IOPARO,1)
    ENDIF

!  - 4.4 -  saisie des ecarts-type d'erreur de representativite
!           et de persistance

    440 CONTINUE

    ROBODY(IWAG,MDBRER) = 0.0_JPRB
    ROBODY(IWAG,MDBPER) = 0.0_JPRB

!  - 4.5 -  saisie de l'ecart-type d'erreur d'obs. finale

    ROBODY(IWAG,MDBFOE) = ROBODY(IWAG,MDBOER)

!  - 4.6 -  reinitialisation des codes qualite pour CANARI/ALADIN (via LELAM)

    IF ( LELAM .AND. .NOT. LVERAL ) THEN
      IFLG = ROBODY(IWAG,MDBFLG)
      IVAL = 0
      IFLG = KBIT1OU0(IFLG,IVAL,NCQFCO)
      IFLG = KBIT1OU0(IFLG,IVAL,NCQFPC)
      IFLG = KBIT1OU0(IFLG,IVAL,NCQFPI)
      IFLG = KBIT1OU0(IFLG,IVAL,NCQFIN)
      IFLG = KBIT1OU0(IFLG,IVAL,NCQECO)
      IFLG = KBIT1OU0(IFLG,IVAL,NCQEPC)
      IFLG = KBIT1OU0(IFLG,IVAL,NCQEPI)
      IFLG = KBIT1OU0(IFLG,IVAL,NCQEIN)
      IFLG = KBIT1OU0(IFLG,IVAL,NCQKCO)
      IFLG = KBIT1OU0(IFLG,IVAL,NCQKPC)
      IFLG = KBIT1OU0(IFLG,IVAL,NCQKPI)
      IFLG = KBIT1OU0(IFLG,IVAL,NCQKIN)
      IFLG = KBIT1OU0(IFLG,IVAL,NCUPS)
      IFLG = KBIT1OU0(IFLG,IVAL,NCUUVT)
      IFLG = KBIT1OU0(IFLG,IVAL,NCUHU)
      IFLG = KBIT1OU0(IFLG,IVAL,NCUT2M)
      IFLG = KBIT1OU0(IFLG,IVAL,NCUH2M)
      IFLG = KBIT1OU0(IFLG,IVAL,NCUV10)
      IFLG = KBIT1OU0(IFLG,IVAL,NCURR)
      IFLG = KBIT1OU0(IFLG,IVAL,NCUSN)
      IFLG = KBIT1OU0(IFLG,IVAL,NCUSST)
      ROBODY(IWAG,MDBFLG) = IFLG
    ENDIF

!  - 4.7 -  modification PPP pour eviter explosion (valeur manquante --> 1.)

    IF ( ROBODY(IWAG,MDBPPP) > 110000._JPRB .OR.&
       & ROBODY(IWAG,MDBPPP) <= 0.0_JPRB      .OR.&
       & ROBODY(IWAG,MDBPPP) == RMDI       ) THEN  
      ROBODY(IWAG,MDBPPP) = 1.0_JPRB
      IRDFL = ROBODY(IWAG,MDBRDFL)
      IFLG = 1
      IRDFL = KBIT1OU0(IRDFL,IFLG,NDBCVF)
      ROBODY(IWAG,MDBRDFL) = IRDFL
    ENDIF

! id pour PRL pour les donnees de couches

    IF ( INOVAR == NVNUMB(4) .OR. INOVAR == NVNUMB(58) .OR. &
       & INOVAR == NVNUMB(6)                                 ) THEN  
      IF ( ROBODY(IWAG,MDBPRL) > 110000._JPRB .OR.&
         & ROBODY(IWAG,MDBPRL) <= 0.0_JPRB      .OR.&
         & ROBODY(IWAG,MDBPRL) == RMDI       ) THEN  
        ROBODY(IWAG,MDBPRL) = 1.0_JPRB
        IRDFL = ROBODY(IWAG,MDBRDFL)
        IFLG = 1
        IRDFL = KBIT1OU0(IRDFL,IFLG,NDBCVF)
        ROBODY(IWAG,MDBRDFL) = IRDFL
      ENDIF
    ENDIF

!  - 4.8 -  initialisation MDBRBPIO (modifie ulterieurement par HRETR en surface)

    IF ( INOVAR == NVNUMB(58) ) THEN
      ROBODY(IWAG,MDBRBPIO) = &
       & LOG( (ROBODY(IWAG,MDBPPP)+ROBODY(IWAG,MDBPRL) * 0.5_JPRB ) )  
    ELSEIF ( INOVAR == NVNUMB(50)) THEN
      ROBODY(IWAG,MDBRBPIO) = RMDI
    ELSE
      ROBODY(IWAG,MDBRBPIO) = LOG(ROBODY(IWAG,MDBPPP))
    ENDIF

!  - 4.9 -  passage de PRL en Log P pour les SATEM

    IF ( INOVAR == NVNUMB(4) .OR. INOVAR ==NVNUMB(6) ) THEN
      ROBODY(IWAG,MDBPRL) = LOG(ROBODY(IWAG,MDBPRL))
    ENDIF

!  - 4.10 - fin de la boucle sur les wagons, puis sur les obs.

  ENDDO

ENDDO

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