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

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

!  modifications :
!  -------------
!       V. Casse       08/93
!       Ph. Caille     04/96
!       D. Paradis     03/98  ajout du cas LMESSP=.T.
!       F.Taillefer    12/00  CMAFOC --> ODB
!       M.Hamrud    01/10/03  CY28 Cleaning
!--------------------------------------------------------------------

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

USE YOMDIMO  , ONLY : NOBTOTG
USE YOMLUN   , ONLY : NULOUT
USE YOMOBA   , ONLY : MUTILW
USE YOMANCS  , ONLY : RMDI
USE YOMVNMB  , ONLY : NVNUMB
USE YOMCT0   , ONLY : LELAM
USE YOMDB
USE QAKEKI   , ONLY : NCQFCO

IMPLICIT NONE

INTEGER(KIND=JPIM) :: ITOT(18,10,16), IACU(18,10,16), IDIS(18,10,16)
INTEGER(KIND=JPIM) :: ITOTT(18,10),   IACUT(18,10),   IDIST(18,10)
INTEGER(KIND=JPIM) :: ITOTTT(10),     IACUTT(10),     IDISTT(10)
REAL(KIND=JPRB) ::    ZVARL(18,10,16), ZVARTL(18,10),   ZVARTTL(10)
REAL(KIND=JPRB) ::    ZPRESS(15)
CHARACTER :: CLNOM(18)*34, CLTYPO(10)*13, CLPRE(16)*34

INTEGER(KIND=JPIM) :: IACUTTT, IADW, ICQFCO, IDISTTT, IFLG, &
 & INLV, INOWU, INUT, IPP, ITOTTTT, ITYP, &
 & IVNM, IVVNM, JA, JIPP, JJ, JOBS, JT, JW  

REAL(KIND=JPRB) :: ZINU2, ZMOY, ZMOYT, ZMOYTT, ZMOYTTT, ZPIO, ZVAR, ZVARTTTL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

IF (LHOOK) CALL DR_HOOK('CAAPAR',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)

!  Initialisation tableaux locaux de calcul
IDISTT  = 0
ITOTTT  = 0
IACUTT  = 0
ZVARTTL = 0.0_JPRB
IDIST   = 0
ITOTT   = 0
IACUT   = 0
ZVARTL  = 0.0_JPRB
IDIS    = 0
ITOT    = 0
IACU    = 0
ZVARL   = 0.0_JPRB
IDISTTT = 0
ITOTTTT = 0
IACUTTT = 0
ZVARTTTL= 0.0_JPRB
IPP     = 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)

  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

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

    IPP = 16
    202 CONTINUE

    INOWU  = ROBODY(IADW,MDBESQN)
    INUT   = MUTILW(INOWU)
    IFLG   = ROBODY(IADW,MDBFLG)
    ICQFCO = KBITLU(IFLG,NCQFCO,1)

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

    IF ( ICQFCO == 1 ) THEN
      IACUTTT              = IACUTTT + INUT
      IACUTT(ITYP)         = IACUTT(ITYP) + INUT
      IACUT(IVVNM,ITYP)    = IACUT(IVVNM,ITYP) + INUT
      IACU(IVVNM,ITYP,IPP) = IACU(IVVNM,ITYP,IPP) + INUT
      IDIS(IVVNM,ITYP,IPP) = IDIS(IVVNM,ITYP,IPP) + 1
      IDIST(IVVNM,ITYP)    = IDIST(IVVNM,ITYP) + 1
      IDISTT(ITYP)         = IDISTT(ITYP) + 1
      IDISTTT              = IDISTTT + 1
      ZINU2                = REAL(INUT,JPRB)**2
      ZVARL(IVVNM,ITYP,IPP) = ZVARL(IVVNM,ITYP,IPP) + ZINU2
      ZVARTL(IVVNM,ITYP)    = ZVARTL(IVVNM,ITYP)    + ZINU2
      ZVARTTL(ITYP)         = ZVARTTL(ITYP)         + ZINU2
      ZVARTTTL              = ZVARTTTL              + ZINU2
    ENDIF

  ENDDO

ENDDO

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

WRITE (NULOUT,404)
IF ( IDISTTT == 0 ) THEN
  IF (LHOOK) CALL DR_HOOK('CAAPAR',1,ZHOOK_HANDLE)
  RETURN
ENDIF
ZMOYTTT = REAL(IACUTTT,JPRB)/REAL(IDISTTT,JPRB)
ZVAR = ZVARTTTL/REAL(IDISTTT,JPRB) - ZMOYTTT**2
WRITE (NULOUT,408) IACUTTT,IDISTTT,ITOTTTT,ZMOYTTT,SQRT(ZVAR)

DO JT = 1,10
  IF ( IDISTT(JT) == 0 ) CYCLE
  WRITE (NULOUT,401) CLTYPO(JT)
  ZMOYTT = REAL(IACUTT(JT),JPRB)/REAL(IDISTT(JT),JPRB)
  ZVAR = ZVARTTL(JT)/REAL(IDISTT(JT),JPRB) - ZMOYTT**2
  WRITE (NULOUT,402) IACUTT(JT),IDISTT(JT),ITOTTT(JT),ZMOYTT,SQRT(ZVAR)
  DO JJ = 1,18
    IF ( IDIST(JJ,JT) == 0 ) CYCLE
    ZMOYT = REAL(IACUT(JJ,JT),JPRB)/REAL(IDIST(JJ,JT),JPRB)
    ZVAR = ZVARTL(JJ,JT)/REAL(IDIST(JJ,JT),JPRB) - ZMOYT**2
       
    WRITE (NULOUT,403) CLNOM(JJ),IACUT(JJ,JT),IDIST(JJ,JT),ITOTT(JJ,JT),&
     & ZMOYT,SQRT(ZVAR)  

    DO JA = 1,16
      IF ( IDIS(JJ,JT,JA) == 0 ) CYCLE
      ZMOY = REAL(IACU(JJ,JT,JA),JPRB)/REAL(IDIS(JJ,JT,JA),JPRB)
      ZVAR = ZVARL(JJ,JT,JA)/REAL(IDIS(JJ,JT,JA),JPRB) - ZMOY**2
      WRITE (NULOUT,403) CLPRE(JA),IACU(JJ,JT,JA),IDIS(JJ,JT,JA),&
       & ITOT(JJ,JT,JA),ZMOY,SQRT(ZVAR)  
    ENDDO

  ENDDO

ENDDO

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

401 FORMAT(//,'    Type d''observations : ',A13,/,&
 & '    -------------------              ',&
 & '  util. total  autorises  total     moy.     ec.-type')  
402 FORMAT(' tous parametres confondus      :    ',&
 & I12,3X,I7,2X,I7,3X,F10.2,3X,F10.2)  
403 FORMAT(A34,3X,I12,3X,I7,2X,I7,3X,F10.2,3X,F14.2)
404 FORMAT(//,'     *********************************************',&
 & '***********************',/,'     *  Impression des di',&
 & 'agnostics d''utilisation numerique (s/p CAAPAR) *',/,&
 & '     ************************************************',&
 & '********************',//)  
408 FORMAT(' tous messages confondus        :    ',&
 & I12,3X,I7,2X,I7,3X,F10.2,3X,F10.2)  

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