SUBROUTINE CAVIAR
!-----------------------------------------------------------------------
!   CAVIAR : Statistiques sur l'utilisation des observations
!   ------   dans l'analyse CANARI  (called by CANACO)

!   auteur : P.Moll 01/92
!-----------------------------------------------------------------------

!  Modifications :
!  ------------- 
!      P. Moll     01/93
!      V. Casse    10/93
!      Ph.Caille   04/96
!      F.Taillefer 06/00 : cas DM code
!      F.Taillefer 12/00 : CMAFOC --> ODB
!      O.Spaniel   04/03 : cleaning-a same named entity from modules
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!-----------------------------------------------------------------------

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

USE YOMDIMO  , ONLY : NOBTOTG
USE YOMLUN   , ONLY : NULOUT
USE YOMDB
USE YOMVNMB  , ONLY : NVNUMB
USE YOMCT0   , ONLY : LELAM
USE YOMANCS  , ONLY : RMDI     ,RDEGREES
USE QAKEKI   , ONLY : NCQFCO   ,NCUPS    ,NCUUVT   ,NCUHU    ,NCUSN    ,&
 & NCUT2M   ,NCUH2M   ,NCUV10   ,NCURR    ,NCUSST  

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IUTILT(9)
INTEGER(KIND=JPIM) :: IUTI(18,10,16,5),ITOT(18,10,16,5),IDIS(18,10,16,5)
INTEGER(KIND=JPIM) :: IUTIT(18,10,16),ITOTT(18,10,16),IDIST(18,10,16)
INTEGER(KIND=JPIM) :: IUTITT(18,10),ITOTTT(18,10),IDISTT(18,10)
INTEGER(KIND=JPIM) :: IUTITTT(10),ITOTTTT(10),IDISTTT(10)
REAL(KIND=JPRB) ::    ZPRESS(15)
CHARACTER :: CLNOM(18)*34,CLTYPO(10)*13,CLPRE(16)*34,CLZON(5)*34

INTEGER(KIND=JPIM) :: IADW, ICQFCO, ICQUTIL, IDISTTTT, IFLG, ILA,&
 & INLV, IPP, ITOTTTTT, ITYP, IUTITTTT, IVNM, IVVNM,&
 & JA, JIPP, JJ, JOBS, JT, JW, JZ  

REAL(KIND=JPRB) :: ZLAT, ZPCTD, ZPCTU, ZPIO
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

IF (LHOOK) CALL DR_HOOK('CAVIAR',0,ZHOOK_HANDLE)
CLNOM( 1) = ' vent zonal                     : '
CLNOM( 2) = ' vent meridien                  : '
CLNOM( 3) = ' geopotentiel                   : '
CLNOM( 4) = ' humidite relative (niveau)     : '
CLNOM( 5) = ' temperature                    : '
CLNOM( 6) = ' epaisseur                      : '
CLNOM( 7) = ' humidite relative a 2 metres   : '
CLNOM( 8) = ' temperature a 2 metres         : '
CLNOM( 9) = ' temperature de surface         : '
CLNOM(10) = ' taux de precipitations         : '
CLNOM(11) = ' quantite de neige              : '
CLNOM(12) = ' radiance brute                 : '
CLNOM(13) = ' fraction nuageuse              : '
CLNOM(14) = ' scatterometre                  : '
CLNOM(15) = ' vent zonal a 10 metres         : '
CLNOM(16) = ' vent meridien a 10 metres      : '
CLNOM(17) = ' humidite relative de couche    : '
CLNOM(18) = ' non repertorie                 : '

CLTYPO( 1) = 'SYNOP        '
CLTYPO( 2) = 'AIREP        '
CLTYPO( 3) = 'SATOB        '
CLTYPO( 4) = 'DRIBU        '
CLTYPO( 5) = 'TEMP         '
CLTYPO( 6) = 'PILOT        '
CLTYPO( 7) = 'SATEM        '
CLTYPO( 8) = 'PAOB         '
CLTYPO( 9) = 'SCATTEROMETRE'
CLTYPO(10) = 'RADIANCE     '

CLPRE( 1) = '        superieure a 1000 hPa   : '
CLPRE( 2) = '       entre 1000 et  850 hPa   : '
CLPRE( 3) = '       entre  850 et  700 hPa   : '
CLPRE( 4) = '       entre  700 et  500 hPa   : '
CLPRE( 5) = '       entre  500 et  400 hPa   : '
CLPRE( 6) = '       entre  400 et  300 hPa   : '
CLPRE( 7) = '       entre  300 et  250 hPa   : '
CLPRE( 8) = '       entre  250 et  200 hPa   : '
CLPRE( 9) = '       entre  200 et  150 hPa   : '
CLPRE(10) = '       entre  150 et  100 hPa   : '
CLPRE(11) = '       entre  100 et   70 hPa   : '
CLPRE(12) = '       entre   70 et   50 hPa   : '
CLPRE(13) = '       entre   50 et   30 hPa   : '
CLPRE(14) = '       entre   30 et   20 hPa   : '
CLPRE(15) = '       entre   20 et   10 hPa   : '
CLPRE(16) = '        inferieure a   10 hPa   : '

ZPRESS( 1) = LOG(100000._JPRB)
ZPRESS( 2) = LOG( 85000._JPRB)
ZPRESS( 3) = LOG( 70000._JPRB)
ZPRESS( 4) = LOG( 50000._JPRB)
ZPRESS( 5) = LOG( 40000._JPRB)
ZPRESS( 6) = LOG( 30000._JPRB)
ZPRESS( 7) = LOG( 25000._JPRB)
ZPRESS( 8) = LOG( 20000._JPRB)
ZPRESS( 9) = LOG( 15000._JPRB)
ZPRESS(10) = LOG( 10000._JPRB)
ZPRESS(11) = LOG(  7000._JPRB)
ZPRESS(12) = LOG(  5000._JPRB)
ZPRESS(13) = LOG(  3000._JPRB)
ZPRESS(14) = LOG(  2000._JPRB)
ZPRESS(15) = LOG(  1000._JPRB)

CLZON( 1) = '            zone  60 / 90 dg    : '
CLZON( 2) = '            zone  20 / 60 dg    : '
CLZON( 3) = '            zone -20 / 20 dg    : '
CLZON( 4) = '            zone -60 / -20 dg   : '
CLZON( 5) = '            zone -90 / -60 dg   : '

IDISTTT  = 0
ITOTTTT  = 0
IUTITTT  = 0
IDISTT   = 0
ITOTTT   = 0
IUTITT   = 0
IDIST    = 0
ITOTT    = 0
IUTIT    = 0
IDIS     = 0
ITOT     = 0
IUTI     = 0
IDISTTTT = 0
ITOTTTTT = 0
IUTITTTT = 0

!-----------------------------------------------------------------------
!  - 2 -  Statistiques sur les observations
!         ---------------------------------

DO JOBS = 1 , NOBTOTG
  IF ( LELAM .AND. ROBHDR(JOBS,MDBTLA) == RMDI ) CYCLE
  INLV = MLNKH2B(JOBS+1)-MLNKH2B(JOBS)
  ITYP = ROBHDR(JOBS,MDBOTP)
  ZLAT = ROBHDR(JOBS,MDBLAT)*RDEGREES
  ILA  = 1
  IF ( ZLAT <=  60._JPRB .AND. ZLAT >  20._JPRB ) ILA = 2
  IF ( ZLAT <=  20._JPRB .AND. ZLAT > -20._JPRB ) ILA = 3
  IF ( ZLAT <= -20._JPRB .AND. ZLAT > -60._JPRB ) ILA = 4
  IF ( ZLAT <= -60._JPRB                        ) ILA = 5

  DO JW = 1 , INLV
    IADW  = MLNKH2B(JOBS)+JW-1
    IVNM  = ROBODY(IADW,MDBVNM)
    ZPIO  = ROBODY(IADW,MDBRBPIO)
    IVVNM = 18
    IF ( IVNM == NVNUMB( 1) ) IVVNM =  1
    IF ( IVNM == NVNUMB( 2) ) IVVNM =  2
    IF ( IVNM == NVNUMB( 3) ) IVVNM =  3
    IF ( IVNM == NVNUMB( 5) ) IVVNM =  4
    IF ( IVNM == NVNUMB( 8) ) IVVNM =  5
    IF ( IVNM == NVNUMB( 4) ) IVVNM =  6
    IF ( IVNM == NVNUMB( 7) ) IVVNM =  7
    IF ( IVNM == NVNUMB(10) ) IVVNM =  8
    IF ( IVNM == NVNUMB(12) ) IVVNM =  9
    IF ( IVNM == NVNUMB(34) ) IVVNM = 10
    IF ( IVNM == NVNUMB(46) ) IVVNM = 11
    IF ( IVNM == NVNUMB(51) ) IVVNM = 12
    IF ( IVNM == NVNUMB(52) ) IVVNM = 13
    IF ( IVNM == NVNUMB(53) ) IVVNM = 14
    IF ( IVNM == NVNUMB(56) ) IVVNM = 15
    IF ( IVNM == NVNUMB(57) ) IVVNM = 16
    IF ( IVNM == NVNUMB(58) ) IVVNM = 17
    IF ( IVNM == NVNUMB(61) ) IVVNM =  1
    IF ( IVNM == NVNUMB(62) ) IVVNM =  2

    IFLG      = ROBODY(IADW,MDBFLG)
    IUTILT(1) = KBITLU(IFLG,NCUPS,1)
    IUTILT(2) = KBITLU(IFLG,NCUUVT,1)
    IUTILT(3) = KBITLU(IFLG,NCUHU,1)
    IUTILT(4) = KBITLU(IFLG,NCUT2M,1)
    IUTILT(5) = KBITLU(IFLG,NCUH2M,1)
    IUTILT(6) = KBITLU(IFLG,NCUV10,1)
    IUTILT(7) = KBITLU(IFLG,NCUSST,1)
    IUTILT(8) = KBITLU(IFLG,NCURR,1)
    IUTILT(9) = KBITLU(IFLG,NCUSN,1)
    ICQUTIL   = MAX(IUTILT(1),IUTILT(2),IUTILT(3),IUTILT(4),&
     & IUTILT(5),IUTILT(6),IUTILT(7),IUTILT(8),IUTILT(9))  
    ICQFCO    = KBITLU(IFLG,NCQFCO,1)

    DO JIPP = 1 , 15
      IPP = JIPP
      IF ( ZPIO >= ZPRESS(JIPP) ) GOTO 202
    ENDDO
    IPP=16
    202 CONTINUE

    ITOTTTTT                 = ITOTTTTT + 1
    ITOTTTT(ITYP)            = ITOTTTT(ITYP)+ 1
    ITOTTT(IVVNM,ITYP)       = ITOTTT(IVVNM,ITYP) + 1
    ITOTT(IVVNM,ITYP,IPP)    = ITOTT(IVVNM,ITYP,IPP) + 1
    ITOT(IVVNM,ITYP,IPP,ILA) = ITOT(IVVNM,ITYP,IPP,ILA) + 1

    IF ( ICQFCO == 1 ) THEN
      IDIS(IVVNM,ITYP,IPP,ILA) = IDIS(IVVNM,ITYP,IPP,ILA)+1
      IDIST(IVVNM,ITYP,IPP)    = IDIST(IVVNM,ITYP,IPP) + 1
      IDISTT(IVVNM,ITYP)       = IDISTT(IVVNM,ITYP) + 1
      IDISTTT(ITYP)            = IDISTTT(ITYP) + 1
      IDISTTTT                 = IDISTTTT + 1
    ENDIF

    IF ( ICQUTIL == 1 ) THEN
      IUTI(IVVNM,ITYP,IPP,ILA) = IUTI(IVVNM,ITYP,IPP,ILA)+1
      IUTIT(IVVNM,ITYP,IPP)    = IUTIT(IVVNM,ITYP,IPP) + 1
      IUTITT(IVVNM,ITYP)       = IUTITT(IVVNM,ITYP) + 1
      IUTITTT(ITYP)            = IUTITTT(ITYP) + 1
      IUTITTTT                 = IUTITTTT + 1
    ENDIF

  ENDDO

ENDDO

!--------------------------------------------------------------------
!  - 2 -  Impressions des diagnostics
!         ---------------------------

WRITE (NULOUT,404)

IF ( IDISTTTT == 0 ) GOTO 500

ZPCTU = 100._JPRB * REAL(IUTITTTT,JPRB) / REAL(IDISTTTT,JPRB)
ZPCTD = 100._JPRB * REAL(IDISTTTT,JPRB) / REAL(ITOTTTTT,JPRB)
WRITE (NULOUT,405) IUTITTTT,ZPCTU,IDISTTTT,ZPCTD,ITOTTTTT

DO JT = 1 , 10
  IF ( IDISTTT(JT) == 0 ) CYCLE
  ZPCTU = 100._JPRB * REAL(IUTITTT(JT),JPRB) / REAL(IDISTTT(JT),JPRB)
  ZPCTD = 100._JPRB * REAL(IDISTTT(JT),JPRB) / REAL(ITOTTTT(JT),JPRB)
  WRITE (NULOUT,401) CLTYPO(JT)
  WRITE (NULOUT,402) IUTITTT(JT),ZPCTU,IDISTTT(JT),ZPCTD,ITOTTTT(JT)

  DO JJ = 1 , 18
    IF ( IDISTT(JJ,JT) == 0 ) CYCLE
    ZPCTU = 100._JPRB * REAL(IUTITT(JJ,JT),JPRB) / REAL(IDISTT(JJ,JT),JPRB)
    ZPCTD = 100._JPRB * REAL(IDISTT(JJ,JT),JPRB) / REAL(ITOTTT(JJ,JT),JPRB)
    WRITE (NULOUT,403) CLNOM(JJ),IUTITT(JJ,JT),ZPCTU,&
     & IDISTT(JJ,JT),ZPCTD,ITOTTT(JJ,JT)  

    DO JA = 1 , 16
      IF ( IDIST(JJ,JT,JA) == 0 ) CYCLE
      ZPCTU = 100._JPRB * REAL(IUTIT(JJ,JT,JA),JPRB) /&
       & REAL(IDIST(JJ,JT,JA),JPRB)  
      ZPCTD = 100._JPRB * REAL(IDIST(JJ,JT,JA),JPRB) /&
       & REAL(ITOTT(JJ,JT,JA),JPRB)  
      WRITE (NULOUT,403) CLPRE(JA),IUTIT(JJ,JT,JA),ZPCTU,&
       & IDIST(JJ,JT,JA),ZPCTD,ITOTT(JJ,JT,JA)  

      DO JZ = 1 , 5
        IF ( IDIS(JJ,JT,JA,JZ) == 0 ) CYCLE
        ZPCTU = 100._JPRB * REAL(IUTI(JJ,JT,JA,JZ),JPRB) /&
         & REAL(IDIS(JJ,JT,JA,JZ),JPRB)  
        ZPCTD = 100._JPRB * REAL(IDIS(JJ,JT,JA,JZ),JPRB) /&
         & REAL(ITOT(JJ,JT,JA,JZ),JPRB)  
        WRITE (NULOUT,403) CLZON(JZ),IUTI(JJ,JT,JA,JZ),ZPCTU,&
         & IDIS(JJ,JT,JA,JZ),ZPCTD,&
         & ITOT(JJ,JT,JA,JZ)  
      ENDDO

    ENDDO

  ENDDO

ENDDO

!--------------------------------------------------------------------
!  - 4 -  Formats
!         -------

401 FORMAT(//,'    Type d''observations : ',A13,'          nombre',&
 & ' de parametres',/,'    -------------------           ',&
 & '    utilises    controles corrects  presents',/)  
402 FORMAT(' tous parametres confondus      : ',I5,' (',F5.1,' %)',&
 & 3X,I5,' (',F5.1,' %)',4X,I5,/)  
403 FORMAT(A34,I5,' (',F5.1,' %)',3X,I5,' (',F5.1,' %)',4X,I5)
404 FORMAT(//,'     *********************************************',&
 & '***************************',/,'     *  Impression de',&
 & 's diagnostics d''utilisation pour CANARI  (s/p CAVIAR',&
 & ')  *',/,'     ***************************************',&
 & '*********************************',///,&
 & '     Analyse complete                            no',&
 & 'mbre de parametres',/,'    ==================        ',&
 & '        utilises    controles corrects  presents',/)  
405 FORMAT(' tous messages confondus        :',I6,' (',F5.1,' %)',&
 & 2X,I6,' (',F5.1,' %)',3X,I6)  

!--------------------------------------------------------------------
500 CONTINUE
IF (LHOOK) CALL DR_HOOK('CAVIAR',1,ZHOOK_HANDLE)
END SUBROUTINE CAVIAR
