SUBROUTINE CANACO ( KOPT )

!****-----------------------------------------------------------------------
!****   CANACO : Chargement des observations pour le coeur de l'analyse
!****   ------   (called by CANARI) ou relachement de ces obs.
!****
!****   auteur : F. Taillefer  12/00
!****-----------------------------------------------------------------------

!   ABS(KOPT) = 1   - chargement global des observations pour l'analyse
!                       . KOPT > 0 : analyse elle-meme
!                       . KOPT < 0 : controle de qualite
!                   - mise a jour des differents tableaux d'adresses necessaires

!   ABS(KOPT) = 2   - visualisation observations avec statistiques d'utilisation
!                   - mise a jour base de donnees
!                       . KOPT > 0 : analyse elle-meme
!                       . KOPT < 0 : controle de qualite

!****-----------------------------------------------------------------------

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

USE YOMDIMO  , ONLY : NOBTOTG
USE YOMOBA   , ONLY : MUTILW
USE YOMDB
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMCT0   , ONLY : NPROC    ,NPRINTLEV
USE YOMMP    , ONLY : MYPROC
USE QABOIT   , ONLY : MNBOBO   ,MPROBO
USE QACTEX   , ONLY : LAECHK   ,LAEUPFLG

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KOPT 
INTEGER(KIND=JPIM), ALLOCATABLE :: IBUFR(:)

INTEGER(KIND=JPIM) :: IBOX, IND, ITYPO, IRET, INFO(1), IVERS, JOBS, JWAG

REAL(KIND=JPRB) :: ZINFO(1)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "caapar.intfb.h"
#include "casnd1.intfb.h"
#include "caupflg.intfb.h"
#include "caviar.intfb.h"

#include "openmp_obs.h"

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

IF (LHOOK) CALL DR_HOOK('CANACO',0,ZHOOK_HANDLE)
IF (KOPT > 0) THEN
!  cas de l'analyse en point de grille
  IVERS=1
ELSE
!  cas du controle de qualite
  IVERS=0
ENDIF

!---------------------------------------------------------------------------
!  - 1 -  Avant les differentes analyses
!         ------------------------------

IF (ABS(KOPT) == 1) THEN

!  - 1.1 -  chargement en memoire des observations

  WRITE(NULOUT,'(/,'' CANACO --> chargement global des observations '',/)')

  CALL GETDB('CANACO', IVERS, IRET, INFO, 0, ZINFO, 0, -1, -1, -1, -1, -1, -1)
  
  IF (IRET /= NOBTOTG) THEN
    WRITE(NULERR,'('' ** INCONSISTENT NO. OF OBSERVATIONS FROM GETDB'')')
    WRITE(NULERR,*)' Expecting ',NOBTOTG,', but got =',IRET
    CALL ABORTDB('CANACO', 'INCONSISTENCIES FROM GETDB', IRET)
  ENDIF

!  - 1.2 -  mise a jour des tableaux d'adresses necessaires

!  - 1.2.1 -  MNBOBO et MPROBO

  IF (.NOT.LAECHK .OR. (LAECHK.AND.KOPT<0)) THEN
    DO JOBS = 1,NOBTOTG
      IBOX=ROBHDR(JOBS,MDBBOX)
      ITYPO=ROBHDR(JOBS,MDBOTP)
      IF (MNBOBO(IBOX,ITYPO) == 0) MPROBO(IBOX,ITYPO)=JOBS
      MNBOBO(IBOX,ITYPO)=MNBOBO(IBOX,ITYPO)+1
    ENDDO
    IBOX=MAXVAL(MNBOBO)
    IF (IBOX > 4000 .AND. MYPROC==1) THEN
      WRITE(NULERR,*) ' ** WARNING : CANACO --> TOO MUCH OBSERVATIONS BY BOX ** '
      WRITE(NULERR,*) ' **    SOME PROBLEMS MIGHT OCCUR IN CASGRA ! ** '
    ENDIF
  ENDIF

  IF (KOPT > 0) THEN

!  - 1.2.2 -  MUTILW

    IRET=SIZE(ROBODY,1)
    ALLOCATE(MUTILW(IRET))
    MUTILW(:)=0

!  - 1.2.3 -  MDBESQN

    IND=0
    DO JWAG = 1,IRET
      IND=IND+1
      ROBODY(JWAG,MDBESQN)=IND
    ENDDO

  ENDIF

!---------------------------------------------------------------------------
!  - 2 -  Apres ces analyses
!         ------------------

ELSEIF ( ABS(KOPT) == 2 ) THEN

  IF (KOPT > 0) THEN

!  - 2.1 -  mise a jour valeurs globales

    IRET=SIZE(ROBODY,1)
    ALLOCATE(IBUFR(IRET))

!  - 2.1.1 -  MUTILW

    CALL CASND1(MUTILW,IBUFR,IRET,15)
    IF (MYPROC == 1) MUTILW(:)=IBUFR(:)

!  - 2.1.2 -  flag d'utilsation des observations MDBFLG

    IF (LAEUPFLG) THEN
      WRITE(NULOUT,'(/,'' CANACO --> pas de mise a jour du flag utilisation'')')
    ELSE
      IF (NPROC > 1) THEN
        DO JWAG = 1,IRET
          IBUFR(JWAG)=ROBODY(JWAG,MDBFLG)
        ENDDO
        CALL CAUPFLG(IBUFR,IRET)
        DO JWAG = 1,IRET
          ROBODY(JWAG,MDBFLG)=IBUFR(JWAG)
        ENDDO
      ENDIF
    ENDIF

    DEALLOCATE(IBUFR)

!  - 2.2 -  impressions de controle des analyses

    IF (MYPROC == 1) THEN

!  - 2.2.1 -  visualisation tableaux d'observations

      CALL CAVIAR

!  - 2.2.2 -  statistiques d'utilisation des observations

      IF (NPRINTLEV >= 1) CALL CAAPAR

    ENDIF

  ENDIF

!  - 2.3 -  mise a jour base de donnees

  CALL PUTDB('CANACO', IVERS, IRET, INFO, 0, ZINFO, 0)

  IF (IVERS == 1) THEN
    WRITE(NULOUT,'(/,'' CANACO --> mise a jour base des observations '')')
  ELSE
    WRITE(NULOUT,'(/,'' CANACO --> relachement base des observations '')')
  ENDIF
  CALL FLUSH(NULOUT)

ENDIF

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