SUBROUTINE CANTIK
!-----------------------------------------------------------------------
!  CANTIK : Statistiques sommaires a l'issue du controle de qualite

!      called by CANARI
!-----------------------------------------------------------------------

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

USE PARDIMO  , ONLY : JPNOTP
USE QAPAVU   , ONLY : JPNVX
USE YOMDIMO  , ONLY : NOBTOT
USE YOMVNMB  , ONLY : NVNUMB
USE YOMOBA   , ONLY : MNBOTP
USE YOMLUN   , ONLY : NULOUT
USE YOMDB
USE QAKEKI   , ONLY : NDBPAF   ,NDBPACQ  ,NCQFCO   ,NCQFPC   ,&
 & NCQFPI   ,NCQFIN   ,NCQECO   ,NCQEPC   ,NCQEPI   ,&
 & NCQEIN   ,NCQKCO   ,NCQKPC   ,NCQKPI   ,NCQKIN   ,&
 & NCLNIN  
USE QAVARA   , ONLY : NVXINV
USE YOMCT0   , ONLY : LELAM
USE YOMANCS  , ONLY : RMDI
USE YOMMP    , ONLY : MYPROC

IMPLICIT NONE

CHARACTER :: CLONE(0:JPNVX)*8,CLLINO(JPNOTP,7)*8
INTEGER(KIND=JPIM) :: IWTOTL(JPNOTP,0:JPNVX),IWCORL(JPNOTP,0:JPNVX)
INTEGER(KIND=JPIM) :: IWCQ1L(JPNOTP,0:JPNVX),IWCQ2L(JPNOTP,0:JPNVX)
INTEGER(KIND=JPIM) :: IWCQ3L(JPNOTP,0:JPNVX),IWCQ4L(JPNOTP,0:JPNVX)
INTEGER(KIND=JPIM) :: IWCQ5L(JPNOTP,0:JPNVX)
INTEGER(KIND=JPIM) :: IWTOTG(JPNOTP,0:JPNVX),IWCORG(JPNOTP,0:JPNVX)
INTEGER(KIND=JPIM) :: IWCQ1G(JPNOTP,0:JPNVX),IWCQ2G(JPNOTP,0:JPNVX)
INTEGER(KIND=JPIM) :: IWCQ3G(JPNOTP,0:JPNVX),IWCQ4G(JPNOTP,0:JPNVX)
INTEGER(KIND=JPIM) :: IWCQ5G(JPNOTP,0:JPNVX)
INTEGER(KIND=JPIM) :: IOBSLNL(JPNOTP),IOBSLNG(JPNOTP)
INTEGER(KIND=JPIM) :: IOLINOL(JPNOTP,7),IOLINOG(JPNOTP,7)
INTEGER(KIND=JPIM) :: ITOTW(0:JPNVX),ICORW(0:JPNVX)
INTEGER(KIND=JPIM) :: IINCW1(0:JPNVX),IINCW2(0:JPNVX),IINCW3(0:JPNVX)
INTEGER(KIND=JPIM) :: IINCW4(0:JPNVX),IINCW5(0:JPNVX)
INTEGER(KIND=JPIM) :: IADWH(500),IADWQ(500),IADWT(500),IADWU(500),IADWV(500)
REAL(KIND=JPRB) :: ZPPPH(500),ZPPPQ(500),ZPPPT(500),ZPPPU(500),ZPPPV(500)
REAL(KIND=JPRB) :: ZWTOT(JPNOTP,0:JPNVX),ZWCOR(JPNOTP,0:JPNVX)
REAL(KIND=JPRB) :: ZWINC1(JPNOTP,0:JPNVX),ZWINC2(JPNOTP,0:JPNVX)
REAL(KIND=JPRB) :: ZWINC3(JPNOTP,0:JPNVX),ZWINC4(JPNOTP,0:JPNVX)
REAL(KIND=JPRB) :: ZWINC5(JPNOTP,0:JPNVX)
REAL(KIND=JPRB) :: ZTOTW(0:JPNVX),ZCORW(0:JPNVX)
REAL(KIND=JPRB) :: ZINCW1(0:JPNVX),ZINCW2(0:JPNVX),ZINCW3(0:JPNVX)
REAL(KIND=JPRB) :: ZINCW4(0:JPNVX),ZINCW5(0:JPNVX)
REAL(KIND=JPRB) :: ZINFO(1)

INTEGER(KIND=JPIM) :: IADH, IADQ, IADT, IADU, IADV, IADW,&
 & IBPF, ICCFCO, ICCK, ICCKCO, ICCKIN, ICCKPC, &
 & ICCKPI, ICFORC, ICLINO, ICPRET, &
 & ICRECO, ICREIN, ICREPC, ICREPI, IDIM, IFLAG, &
 & IFLG, IHFLG, IHQF, ILEBON, INBH, INBQ, &
 & INBT, INBU, INBV, INBWAG, INFO(1), IOLN, IPAR, IQFLG, &
 & IRDFL, IRET, ITFLG, ITQF, IUFLG, IUN, IUQF1, &
 & IUQF2, IUQF3, IUQF4, IUQFL, IVFLG, IVNM, &
 & IVQF1, IVQF2, IVQF3, IVQF4, IVQFL, IWH, IWT, &
 & IWU, IWV, IZERO, J1, J2, JO, JT, JW, JWH, &
 & JWT, JWU, JWV  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "qabitu.h"
INTERFACE
#include "getdb.h"
#include "putdb.h"
END INTERFACE

#include "casnd1.intfb.h"

#include "openmp_obs.h"

!-----------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('CANTIK',0,ZHOOK_HANDLE)
CLONE(0) = ' divers '
CLONE(1) = ' geopot.'
CLONE(2) = ' tempe. '
CLONE(3) = ' vent U '
CLONE(4) = ' vent V '
CLONE(5) = ' Epais. '
CLONE(6) = ' HU     '
CLONE(7) = ' SST    '
CLONE(8) = ' snow/RR'
CLONE(9) = ' QQ     '
CLONE(10)= ' T2m    '
CLONE(11)= ' Hu2m   '
CLONE(12)= ' u10m   '
CLONE(13)= ' v10m   '
IOBSLNL = 0
IWTOTL  = 0
IWCORL  = 0
IWCQ1L  = 0
IWCQ2L  = 0
IWCQ3L  = 0
IWCQ4L  = 0
IWCQ5L  = 0
ZWTOT   = 0.0_JPRB
ZWCOR   = 0.0_JPRB
ZWINC1  = 0.0_JPRB
ZWINC2  = 0.0_JPRB
ZWINC3  = 0.0_JPRB
ZWINC4  = 0.0_JPRB
ZWINC5  = 0.0_JPRB
IOLINOL = 0
CLLINO  = '        '
ITOTW   = 0
ICORW   = 0
IINCW1  = 0
IINCW2  = 0
IINCW3  = 0
IINCW4  = 0
IINCW5  = 0
ZTOTW   = 0.0_JPRB
ZCORW   = 0.0_JPRB
ZINCW1  = 0.0_JPRB
ZINCW2  = 0.0_JPRB
ZINCW3  = 0.0_JPRB
ZINCW4  = 0.0_JPRB
ZINCW5  = 0.0_JPRB
IZERO   = 0
IUN     = 1

CALL GETDB('CANTIK', 0, IRET, INFO, 0, ZINFO, 0, -1, -1, -1, -1, -1, -1)

!-----------------------------------------------------------------------
!  - 1 -  Ecriture du flag "code final" au niveau parametre
!         et calculs divers
!         -------------------------------------------------

DO JT = 1 , JPNOTP
  IF ( MNBOTP(JT) == 0 ) CYCLE
  DO JO = 1 , NOBTOT

    IF ( ROBHDR(JO,MDBOTP) /= JT ) CYCLE
    IF ( LELAM .AND. ROBHDR(JO,MDBTLA) == RMDI ) CYCLE

    IOLN   = 0

!  saisie d'informations utilisees lors du controle de coherence des codes
!  des humidites specifiques des SYNOPs et des TEMPs et des couples de
!  composantes du vent

    IADWH  = 0
    IADWQ  = 0
    IADWT  = 0
    IADWU  = 0
    IADWV  = 0
    ZPPPH  = 0.0_JPRB
    ZPPPQ  = 0.0_JPRB
    ZPPPT  = 0.0_JPRB
    ZPPPU  = 0.0_JPRB
    ZPPPV  = 0.0_JPRB
    INBH   = 0
    INBQ   = 0
    INBT   = 0
    INBU   = 0
    INBV   = 0

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

    DO JW = 1 , INBWAG
      IADW = MLNKH2B(JO)+JW-1
      IVNM = ROBODY(IADW,MDBVNM)
      IF ( IVNM == NVNUMB(5) .OR. IVNM == NVNUMB(7) ) THEN
        INBH        = INBH + 1
        IADWH(INBH) = JW
        ZPPPH(INBH) = ROBODY(IADW,MDBPPP)
      ELSEIF ( IVNM == NVNUMB(63) ) THEN
        INBQ        = INBQ + 1
        IADWQ(INBQ) = JW
        ZPPPQ(INBQ) = ROBODY(IADW,MDBPPP)
      ELSEIF ( IVNM == NVNUMB(8) .OR. IVNM == NVNUMB(10) ) THEN
        INBT        = INBT + 1
        IADWT(INBT) = JW
        ZPPPT(INBT) = ROBODY(IADW,MDBPPP)
      ELSEIF ( IVNM == NVNUMB(1) .OR. IVNM == NVNUMB(56) ) THEN
        INBU        = INBU + 1
        IADWU(INBU) = JW
        ZPPPU(INBU) = ROBODY(IADW,MDBPPP)
      ELSEIF ( IVNM == NVNUMB(2) .OR. IVNM == NVNUMB(57) ) THEN
        INBV        = INBV + 1
        IADWV(INBV) = JW
        ZPPPV(INBV) = ROBODY(IADW,MDBPPP)
      ELSE
        CYCLE
      ENDIF
    ENDDO

    DO JW = 1 , INBWAG
      ICFORC = 0
      ICPRET = 0
      ICRECO = 0
      ICREPC = 0
      ICREPI = 0
      ICREIN = 0
      ICCKCO = 0
      ICCKPC = 0
      ICCKPI = 0
      ICCKIN = 0
      ICLINO = 0
      IADW = MLNKH2B(JO)+JW-1
      IVNM = ROBODY(IADW,MDBVNM)
      IF ( IVNM == NVNUMB(63) ) CYCLE
      IPAR   = NVXINV( IVNM )
      IRDFL  = ROBODY(IADW,MDBRDFL)
      IFLG   = ROBODY(IADW,MDBFLG)
      ICFORC = KBITLU(IRDFL,NDBPAF,1)
      ICPRET = KBITLU(IRDFL,NDBPACQ,2)
      ICRECO = KBITLU(IFLG,NCQECO,1)
      ICREPC = KBITLU(IFLG,NCQEPC,1)
      ICREPI = KBITLU(IFLG,NCQEPI,1)
      ICREIN = KBITLU(IFLG,NCQEIN,1)
      ICCKCO = KBITLU(IFLG,NCQKCO,1)
      ICCKPC = KBITLU(IFLG,NCQKPC,1)
      ICCKPI = KBITLU(IFLG,NCQKPI,1)
      ICCKIN = KBITLU(IFLG,NCQKIN,1)
      ICLINO = KBITLU(IFLG,NCLNIN,1)
      ICCK   = ICCKCO + ICCKPC + ICCKPI + ICCKIN
      IF ( ICLINO == 1 ) IOLN = 1

!  ecriture du code final au niveau parametre
!  ------------------------------------------

      IFLAG = 0
      IFLG  = KBIT1OU0(IFLG,IFLAG,NCQFCO)
      IFLG  = KBIT1OU0(IFLG,IFLAG,NCQFPC)
      IFLG  = KBIT1OU0(IFLG,IFLAG,NCQFPI)
      IFLG  = KBIT1OU0(IFLG,IFLAG,NCQFIN)
      IFLAG = 1
      IBPF  = NCQFPI
      IF ( ICFORC == 1 ) THEN
        IBPF = NCQFCO
      ELSEIF ( ICLINO == 1 ) THEN
        IBPF = NCQFIN
      ELSEIF ( ICREIN == 1 ) THEN
        IBPF = NCQFIN
      ELSEIF ( ICCKCO == 1 ) THEN
        IBPF = NCQFCO
      ELSEIF ( ICCKPI == 1 ) THEN
        IBPF = NCQFPI
      ELSEIF ( ICCKIN == 1.OR. ICCKPC == 1.OR. ICCK == 0 ) THEN
        IF ( ICRECO == 1 ) THEN
          IBPF = NCQFCO
        ELSEIF ( ICREPI == 1 ) THEN
          IBPF = NCQFPI
        ELSEIF ( ICREPC == 1 ) THEN
          IF ( ICPRET <= 1 ) THEN
            IBPF = NCQFCO
          ELSE
            IBPF = NCQFPI
          ENDIF
        ELSE
          IBPF = NCQFPI
        ENDIF
      ENDIF
      IFLG = KBIT1OU0(IFLG,IFLAG,IBPF)
      ROBODY(IADW,MDBFLG) = IFLG
    ENDDO

!  controle coherence des codes qualite sur les composantes du vent
!  ----------------------------------------------------------------

    IF ( INBV > INBU ) THEN
      DO JW = 1,INBV
        IADV = MLNKH2B(JO)+IADWV(JW)-1
        IWU  = 0
        IF ( JW <= INBU .AND. &
           & NINT(ZPPPV(JW)*0.1_JPRB) == NINT(ZPPPU(JW)*0.1_JPRB) ) THEN  
          IWU = JW
        ELSE
          DO JWU = 1,INBU
            IF ( NINT(ZPPPV(JW)*0.1_JPRB) == NINT(ZPPPU(JWU)*0.1_JPRB) )&
             & IWU = JWU  
          ENDDO
        ENDIF
        IF ( IWU == 0 ) THEN
          IVFLG = ROBODY(IADV,MDBFLG)
          IVFLG = KBIT1OU0(IVFLG,0,NCQFCO)
          IVFLG = KBIT1OU0(IVFLG,0,NCQFPC)
          IVFLG = KBIT1OU0(IVFLG,0,NCQFPI)
          IVFLG = KBIT1OU0(IVFLG,1,NCQFIN)
          ROBODY(IADV,MDBFLG) = IVFLG
        ENDIF
      ENDDO
    ENDIF

    DO JW = 1,INBU
      IADU  = MLNKH2B(JO)+IADWU(JW)-1
      IUFLG = ROBODY(IADU,MDBFLG)
      IUQF1 = KBITLU(IUFLG,NCQFCO,1)
      IUQF2 = KBITLU(IUFLG,NCQFPC,1)
      IUQF3 = KBITLU(IUFLG,NCQFPI,1)
      IUQF4 = KBITLU(IUFLG,NCQFIN,1)
      IUQFL = IUQF1*1000 + IUQF2*100 + IUQF3*10 + IUQF4
      IWV   = 0
      IF ( JW <= INBV .AND. &
         & NINT(ZPPPU(JW)*0.1_JPRB) == NINT(ZPPPV(JW)*0.1_JPRB) ) THEN  
        IWV = JW
      ELSE
        DO JWV = 1,INBV
          IF ( NINT(ZPPPU(JW)*0.1_JPRB) == NINT(ZPPPV(JWV)*0.1_JPRB) )&
           & IWV = JWV  
        ENDDO
      ENDIF
      IF ( IWV /= 0 ) THEN
        IADV  = MLNKH2B(JO)+IADWV(IWV)-1
        IVFLG = ROBODY(IADV,MDBFLG)
        IVQF1 = KBITLU(IVFLG,NCQFCO,1)
        IVQF2 = KBITLU(IVFLG,NCQFPC,1)
        IVQF3 = KBITLU(IVFLG,NCQFPI,1)
        IVQF4 = KBITLU(IVFLG,NCQFIN,1)
        IVQFL = IVQF1*1000 + IVQF2*100 + IVQF3*10 + IVQF4
        IF ( IUQFL == IVQFL ) THEN
          CYCLE
        ELSEIF ( IUQFL > IVQFL ) THEN
          IUFLG = KBIT1OU0(IUFLG,IVQF1,NCQFCO)
          IUFLG = KBIT1OU0(IUFLG,IVQF2,NCQFPC)
          IUFLG = KBIT1OU0(IUFLG,IVQF3,NCQFPI)
          IUFLG = KBIT1OU0(IUFLG,IVQF4,NCQFIN)
          ROBODY(IADU,MDBFLG) = IUFLG
        ELSEIF ( IUQFL < IVQFL ) THEN
          IVFLG = KBIT1OU0(IVFLG,IUQF1,NCQFCO)
          IVFLG = KBIT1OU0(IVFLG,IUQF2,NCQFPC)
          IVFLG = KBIT1OU0(IVFLG,IUQF3,NCQFPI)
          IVFLG = KBIT1OU0(IVFLG,IUQF4,NCQFIN)
          ROBODY(IADV,MDBFLG) = IVFLG
        ENDIF
      ELSE
        IUFLG = KBIT1OU0(IUFLG,0,NCQFCO)
        IUFLG = KBIT1OU0(IUFLG,0,NCQFPC)
        IUFLG = KBIT1OU0(IUFLG,0,NCQFPI)
        IUFLG = KBIT1OU0(IUFLG,1,NCQFIN)
        ROBODY(IADU,MDBFLG) = IUFLG
      ENDIF
    ENDDO

!  saisie des codes qualite pour les humidites specifiques
!  -------------------------------------------------------
!   si NCQFCO vaut 1 pour T et Hu, NCQFCO est mis a 1 pour q
!   sinon NCQFPI vaut 1 pour q

    DO JW = 1,INBQ
      IADQ   = MLNKH2B(JO)+IADWQ(JW)-1
      IWH    = 0
      IWT    = 0
      ILEBON = 0
      IF ( JW <= INBH .AND. &
         & NINT(ZPPPQ(JW)*0.1_JPRB) == NINT(ZPPPH(JW)*0.1_JPRB) ) THEN  
        IWH = JW
      ELSE
        DO JWH = 1,INBH
          IF ( NINT(ZPPPQ(JW)*0.1_JPRB) == NINT(ZPPPH(JWH)*0.1_JPRB) )&
           & IWH = JWH  
        ENDDO
      ENDIF
      IF ( JW <= INBT .AND. &
         & NINT(ZPPPQ(JW)*0.1_JPRB) == NINT(ZPPPT(JW)*0.1_JPRB) ) THEN  
        IWT = JW
      ELSE
        DO JWT = 1,INBT
          IF ( NINT(ZPPPQ(JW)*0.1_JPRB) == NINT(ZPPPT(JWT)*0.1_JPRB) )&
           & IWT = JWT  
        ENDDO
      ENDIF
      IF ( IWH /= 0.AND. IWT /= 0 ) THEN
        IADH  = MLNKH2B(JO)+IADWH(IWH)-1
        IHFLG = ROBODY(IADH,MDBFLG)
        IHQF  = KBITLU(IHFLG,NCQFCO,1)
        IADT  = MLNKH2B(JO)+IADWT(IWT)-1
        ITFLG = ROBODY(IADT,MDBFLG)
        ITQF  = KBITLU(ITFLG,NCQFCO,1)
        IF ( IHQF+ITQF == 2 ) ILEBON = 1
      ENDIF
      IQFLG = ROBODY(IADQ,MDBFLG)
      IF ( ILEBON == 1 ) THEN
        IQFLG = KBIT1OU0(IQFLG,IUN  ,NCQFCO)
        IQFLG = KBIT1OU0(IQFLG,IZERO,NCQFPC)
        IQFLG = KBIT1OU0(IQFLG,IZERO,NCQFPI)
        IQFLG = KBIT1OU0(IQFLG,IZERO,NCQFIN)
      ELSE
        IQFLG = KBIT1OU0(IQFLG,IZERO,NCQFCO)
        IQFLG = KBIT1OU0(IQFLG,IZERO,NCQFPC)
        IQFLG = KBIT1OU0(IQFLG,IUN  ,NCQFPI)
        IQFLG = KBIT1OU0(IQFLG,IZERO,NCQFIN)
      ENDIF
      ROBODY(IADQ,MDBFLG) = IQFLG
    ENDDO

!  statistiques sommaires sur les parametres hors liste noire
!  ----------------------------------------------------------
!  ...1 : parametres declares inutilisables (pb relief, etc ...)
!  ...2 : parametres incorrects sur le test spatial
!  ...3 : parametres incorrects vis-a-vis de l'ebauche mais rachetes par
!         le test spatial
!  ...4 : parametres incorrects vis-a-vis de l'ebauche
!  ...5 : parametres non controles spatialement

    DO JW = 1 , INBWAG
      ICFORC = 0
      ICPRET = 0
      ICRECO = 0
      ICREPC = 0
      ICREPI = 0
      ICREIN = 0
      ICCKCO = 0
      ICCKPC = 0
      ICCKPI = 0
      ICCKIN = 0
      ICLINO = 0
      IADW   = MLNKH2B(JO)+JW-1
      IVNM   = ROBODY(IADW,MDBVNM)
      IPAR   = NVXINV( IVNM )
      IRDFL  = ROBODY(IADW,MDBRDFL)
      IFLG   = ROBODY(IADW,MDBFLG)
      ICFORC = KBITLU(IRDFL,NDBPAF,1)
      ICPRET = KBITLU(IRDFL,NDBPACQ,2)
      ICRECO = KBITLU(IFLG,NCQECO,1)
      ICREPC = KBITLU(IFLG,NCQEPC,1)
      ICREPI = KBITLU(IFLG,NCQEPI,1)
      ICREIN = KBITLU(IFLG,NCQEIN,1)
      ICCKCO = KBITLU(IFLG,NCQKCO,1)
      ICCKPC = KBITLU(IFLG,NCQKPC,1)
      ICCKPI = KBITLU(IFLG,NCQKPI,1)
      ICCKIN = KBITLU(IFLG,NCQKIN,1)
      ICLINO = KBITLU(IFLG,NCLNIN,1)
      ICCFCO = KBITLU(IFLG,NCQFCO,1)
      ICCK   = ICCKCO + ICCKPC + ICCKPI + ICCKIN
      IF ( ICLINO == 1 ) IOLN = 1
      IF ( ICLINO /= 1 ) THEN
        IF ( ICCK == 0 ) IWCQ5L(JT,IPAR) = IWCQ5L(JT,IPAR)+1
        IF ( ICCFCO == 1 ) THEN
          IWCORL(JT,IPAR) = IWCORL(JT,IPAR) + 1
          IF ( ICREPI == 1 )IWCQ3L(JT,IPAR) = IWCQ3L(JT,IPAR) + 1
        ELSE
          IF ( ICREIN == 1 ) THEN
            IWCQ1L(JT,IPAR) =  IWCQ1L(JT,IPAR) + 1
          ELSEIF ( ICREPI == 1 ) THEN
            IWCQ4L(JT,IPAR) =  IWCQ4L(JT,IPAR) + 1
          ELSE
            IWCQ2L(JT,IPAR) =  IWCQ2L(JT,IPAR) + 1
          ENDIF
        ENDIF
        IWTOTL(JT,IPAR) = IWTOTL(JT,IPAR)+1

      ELSE
!  saisie des nombres de parametres a ne pas utiliser (liste noire)
        IF ( IPAR == 1 ) THEN
          IOLINOL(JT,1) = IOLINOL(JT,1) + 1
        ELSEIF ( IPAR == 3.OR. IPAR == 4 ) THEN
          IOLINOL(JT,2) = IOLINOL(JT,2) + 1
        ELSEIF ( IPAR == 2 ) THEN
          IOLINOL(JT,3) = IOLINOL(JT,3) + 1
        ELSEIF ( IPAR == 6 ) THEN
          IOLINOL(JT,4) = IOLINOL(JT,4) + 1
        ELSEIF ( IPAR == 5 ) THEN
          IOLINOL(JT,5) = IOLINOL(JT,5) + 1
        ELSEIF ( IPAR == 7 ) THEN
          IOLINOL(JT,6) = IOLINOL(JT,6) + 1
        ELSE
          IOLINOL(JT,7) = IOLINOL(JT,7) + 1
        ENDIF
      ENDIF
    ENDDO
    IOBSLNL(JT) = IOBSLNL(JT) + IOLN
  ENDDO
ENDDO

CALL PUTDB('CANTIK', 0, IRET, INFO, 0, ZINFO, 0)

IDIM=JPNOTP*(JPNVX+1)
CALL CASND1(IWCORL,IWCORG,IDIM,1)
CALL CASND1(IWTOTL,IWTOTG,IDIM,2)
CALL CASND1(IWCQ1L,IWCQ1G,IDIM,3)
CALL CASND1(IWCQ2L,IWCQ2G,IDIM,4)
CALL CASND1(IWCQ3L,IWCQ3G,IDIM,5)
CALL CASND1(IWCQ4L,IWCQ4G,IDIM,6)
CALL CASND1(IWCQ5L,IWCQ5G,IDIM,7)
CALL CASND1(IOBSLNL,IOBSLNG,JPNOTP,8)
IDIM=JPNOTP*7
CALL CASND1(IOLINOL,IOLINOG,IDIM,9)

IF (MYPROC == 1) THEN

  DO JT = 1 , JPNOTP

    DO J1 = 0 , JPNVX
      IF ( IWTOTG(JT,J1) /= 0 ) THEN
        ZWTOT(JT,J1)  = 100.0_JPRB
        ZWCOR(JT,J1)  = 100.0_JPRB * REAL( IWCORG(JT,J1) ,JPRB) /&
         & REAL( IWTOTG(JT,J1) ,JPRB)  
        ZWINC1(JT,J1) = 100.0_JPRB * REAL( IWCQ1G(JT,J1) ,JPRB) /&
         & REAL( IWTOTG(JT,J1) ,JPRB)  
        ZWINC2(JT,J1) = 100.0_JPRB * REAL( IWCQ2G(JT,J1) ,JPRB) /&
         & REAL( IWTOTG(JT,J1) ,JPRB)  
        ZWINC4(JT,J1) = 100.0_JPRB * REAL( IWCQ4G(JT,J1) ,JPRB) /&
         & REAL( IWTOTG(JT,J1) ,JPRB)  
        ZWINC5(JT,J1) = 100.0_JPRB * REAL( IWCQ5G(JT,J1) ,JPRB) /&
         & REAL( IWTOTG(JT,J1) ,JPRB)  
        IF ( IWCQ3G(JT,J1)+IWCQ4G(JT,J1) > 0 )&
         & ZWINC3(JT,J1) = 100.0_JPRB * REAL( IWCQ3G(JT,J1) ,JPRB) /&
         & REAL( IWCQ3G(JT,J1)+IWCQ4G(JT,J1) ,JPRB)  
      ENDIF
    ENDDO

    DO J1 = 0 , JPNVX
      ITOTW(J1)  = ITOTW(J1) + IWTOTG(JT,J1)
      ICORW(J1)  = ICORW(J1) + IWCORG(JT,J1)
      IINCW1(J1) = IINCW1(J1) + IWCQ1G(JT,J1)
      IINCW2(J1) = IINCW2(J1) + IWCQ2G(JT,J1)
      IINCW3(J1) = IINCW3(J1) + IWCQ3G(JT,J1)
      IINCW4(J1) = IINCW4(J1) + IWCQ4G(JT,J1)
      IINCW5(J1) = IINCW5(J1) + IWCQ5G(JT,J1)
    ENDDO
  ENDDO
  DO J1 = 0 , JPNVX
    IF ( ITOTW(J1) /= 0 ) THEN
      ZTOTW(J1)  = 100.0_JPRB
      ZCORW(J1)  = 100.0_JPRB * REAL(ICORW(J1),JPRB) / REAL(ITOTW(J1),JPRB)
      ZINCW1(J1) = 100.0_JPRB * REAL(IINCW1(J1),JPRB) / REAL(ITOTW(J1),JPRB)
      ZINCW2(J1) = 100.0_JPRB * REAL(IINCW2(J1),JPRB) / REAL(ITOTW(J1),JPRB)
      IF ( IINCW3(J1)+IINCW4(J1) > 0 )&
       & ZINCW3(J1) = 100.0_JPRB * REAL(IINCW3(J1),JPRB) /&
       & REAL( IINCW3(J1) + IINCW4(J1) ,JPRB)  
      ZINCW4(J1) = 100.0_JPRB * REAL(IINCW4(J1),JPRB) / REAL(ITOTW(J1),JPRB)
      ZINCW5(J1) = 100.0_JPRB * REAL(IINCW5(J1),JPRB) / REAL(ITOTW(J1),JPRB)
    ENDIF
  ENDDO
  DO J1=1,JPNOTP
    DO J2 = 1 , 7
      IF (IOLINOG(J1,J2) /= 0)WRITE (CLLINO(J1,J2),'(I8)') IOLINOG(J1,J2)
    ENDDO
  ENDDO

!-----------------------------------------------------------------------
!  - 2 -  Impressions
!         -----------

  WRITE (NULOUT,301)
  DO J1 = 0 , JPNVX
    WRITE (NULOUT,302) CLONE(J1),&
     & (IWTOTG(JT,J1),ZWTOT(JT,J1),JT = 1,7),&
     & IWTOTG(9,J1),ZWTOT(9,J1), ITOTW(J1),ZTOTW(J1)  
    WRITE (NULOUT,304) (IWCQ1G(JT,J1),ZWINC1(JT,J1),JT = 1,7),&
     & IWCQ1G(9,J1),ZWINC1(9,J1), IINCW1(J1),ZINCW1(J1)  
    WRITE (NULOUT,310) (IWCQ4G(JT,J1),ZWINC4(JT,J1),JT = 1,7),&
     & IWCQ4G(9,J1),ZWINC4(9,J1), IINCW4(J1),ZINCW4(J1)  
    WRITE (NULOUT,305) (IWCQ2G(JT,J1),ZWINC2(JT,J1),JT = 1,7),&
     & IWCQ2G(9,J1),ZWINC2(9,J1), IINCW2(J1),ZINCW2(J1)  
    WRITE (NULOUT,303) (IWCORG(JT,J1),ZWCOR(JT,J1),JT = 1,7),&
     & IWCORG(9,J1),ZWCOR(9,J1), ICORW(J1),ZCORW(J1)  
    WRITE (NULOUT,309) (IWCQ3G(JT,J1),ZWINC3(JT,J1),JT = 1,7),&
     & IWCQ3G(9,J1),ZWINC3(9,J1), IINCW3(J1),ZINCW3(J1)  
    WRITE (NULOUT,311) (IWCQ5G(JT,J1),ZWINC5(JT,J1),JT = 1,7),&
     & IWCQ5G(9,J1),ZWINC5(9,J1), IINCW5(J1),ZINCW5(J1)  
    IF ( J1 /= JPNVX ) WRITE (NULOUT,306)
  ENDDO

  WRITE (NULOUT,307) ((CLLINO(JT,JW),JT = 1,7),CLLINO(9,JW),JW = 1,7)
  WRITE (NULOUT,308) (IOBSLNG(JT),JT = 1,7),IOBSLNG(9)

ENDIF

!--------------------------------------------------------------------
!  - 3 -  Formats
!         -------

301 FORMAT(/,'  **********************************************',&
 & '******************',/,'  *  Statistiques sur les ob',&
 & 'servations rejetees  ( s/p CANTIK )  *',/,'  ******',&
 & '***************************************************',&
 & '*******',/,'              SYNOP        AIREP',&
 & '        SATOB        DRIBU        TEMP         PILO',&
 & 'T        SATEM        SCATT         total ',/)  
302 FORMAT(A8,8(I7,F6.1),I8,F6.1,'  total')
303 FORMAT(8X,8(I7,F6.1),I8,F6.1,'  good')
304 FORMAT(8X,8(I7,F6.1),I8,F6.1,'  no use')
305 FORMAT(8X,8(I7,F6.1),I8,F6.1,'  rejet loc')
309 FORMAT(8X,8(I7,F6.1),I8,F6.1,'  rachat')
310 FORMAT(8X,8(I7,F6.1),I8,F6.1,'  rejet FG')
311 FORMAT(8X,8(I7,F6.1),I8,F6.1,'  no control')
306 FORMAT(1X,130('-'))
307 FORMAT(//,' LISTE NOIRE       SYNOP        AIREP  ',&
 & '      SATOB        DRIBU         TEMP        PILOT ',&
 & '       SATEM        SCATT  ',/' geopotentiel ',8(A9,4X),/,&
 & ' vent         ',8(A9,4X),/,' temperature  ',8(A9,4X),/,&
 & ' humidite     ',8(A9,4X),/,' epaisseur    ',8(A9,4X),/,&
 & ' SST          ',8(A9,4X),/,' autres       ',8(A9,4X))  
308 FORMAT(/,' stations     ',8(I9,4X),//)

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