SUBROUTINE CANARI
!****-----------------------------------------------------------------------
!****  CANARI : Controle de l'analyse par interpolation optimale
!****           (called by CAN1).
!****-----------------------------------------------------------------------
!  But : Controle de l'analyse par interpolation optimale
!  ---
!  Arguments de sortie  : fichiers ARPEGE contenant :
!  -------------------      1 : les champs analyses par I.O.
!                           2 : historique analyse (stat)
!  Algorithme :
!  ----------
!    - mise a jour si necessaire de l'ebauche (incremental)
!    - initialisation des statistiques liees a l'ebauche
!    - initialisation parametres relatifs aux observations
!    - calcul des residus observes ou initialises
!    - controle de la qualite des observations
!    - analyse Ps, UVT, Hu, T2m, H2m, V1m, Snow, SST
!    - smoothing of SWI changing of Wp, but only if enter in CAVEGI
!    - mise a jour des champs de surface Ts, Tp, Ws, Wp et Snow
!    - mise a jour des constantes de surface (pour ISBA)
!    - visualisation  des tableaux  d'observations et statistiques
!      sur l'utilisation des observations
!    - ecriture des champs analyses
!    - alimentation fichier historique analyse
!    - calcul des residus analyses
!  MODIFICATIONS :
!  -------------
!        M.Hamrud      01-Jul-2006 Revised surface fields
!---------------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE PARDIMO  , ONLY : JPNOTP
USE YOMDIM   , ONLY : NFLEVG   ,NPROMA
USE YOMCMA   , ONLY : LECFIO
USE YOMDB
USE YOMCT0   , ONLY : NTASKS   ,LCASIG   
USE YOMLUN   , ONLY : NULOUT   ,NULASS   ,NULERR
USE YOMMP    , ONLY : MYPROC   ,NSTROUT
USE YOMGEM   , ONLY : NGPTOT
USE YOMGC    , ONLY : GELAT    ,GELAM
USE YOMANCS  , ONLY : RDEGREES
USE SURFACE_FIELDS_MIX, ONLY : SP_CI, YSP_CI
USE QAPABL   , ONLY : JP3KSE
USE QANADA   , ONLY : NINSELG  ,NIASELG  ,RZDSELG
USE QADIAG   , ONLY : RCATSL   ,RCARES   ,RCASIG
USE QACTEX   , ONLY : LAEINC   ,LAEOMF   ,&
 & LAEOMN   ,LAECHK   ,LAEPDS   ,LAEUVT   ,LAEHUM   ,&
 & LAET2M   ,LAEH2M   ,LAEV1M   ,LAESNM   ,LAESST   ,&
 & LAEICS   ,LAECDS   ,LAESTA   ,LAEWIO   ,LAERFO   ,&
 & LVERAL   ,NAEINC  
USE QAIMPO   , ONLY : LAVISO   ,LAVOLO   ,LAVORO   ,LAVOCQ   ,LAVOAN   ,&
 & NBSYVO   ,NBAIVO   ,NBSBVO   ,NBDRVO   ,NBTPVO   ,&
 & NBPLVO   ,NBSTVO  
USE QALBAR   , ONLY : LRESCPL  ,NRESECR
USE QACVEG   , ONLY : LISSEW   ,L_SM_WP
USE QACTAN   , ONLY : LANMASK  ,ALATNB   ,ALATSB   ,ALONWB   ,ALONEB
USE YOMPHY   , ONLY : LSOLV

IMPLICIT NONE


REAL(KIND=JPRB),ALLOCATABLE :: ZLON(:),ZLAT(:)

REAL(KIND=JPRB) :: ZTLON, ZDLON
INTEGER(KIND=JPIM) :: IDLON, IREP, IREPN, IREPO
INTEGER(KIND=JPIM) :: IBLK, IEND, IOFF, IPCT, IST, JSTGLO, JL
LOGICAL :: LLANA
CHARACTER :: CLDAT*8, CLTIM*10, CLCONF*9
REAL(KIND=JPRB) :: ZHOOK_HANDLE


#include "ca0dgu.intfb.h"
#include "caclsst.intfb.h"
#include "cadavr.intfb.h"
#include "caeincw.intfb.h"
#include "caidgu.intfb.h"
#include "caifc1.intfb.h"
#include "calice.intfb.h"
#include "calife.intfb.h"
#include "calincw.intfb.h"
#include "camelo.intfb.h"
#include "canaco.intfb.h"
#include "cantik.intfb.h"
#include "caohis.intfb.h"
#include "carcfo.intfb.h"
#include "carcli.intfb.h"
#include "casino.intfb.h"
#include "casmswi.intfb.h"
#include "cavegi.intfb.h"
#include "caviso.intfb.h"
#include "cavodk.intfb.h"
#include "rdfpinc.intfb.h"
#include "spnorm.intfb.h"
#include "stepo.intfb.h"
#include "updtim.intfb.h"

#include "openmp_obs.h"

!---------------------------------------------------------------------------
!  - 1 -  Mise a jour de l'ebauche si mode incremental
!         --------------------------------------------

IF (LHOOK) CALL DR_HOOK('CANARI',0,ZHOOK_HANDLE)
IF ( LAEINC ) THEN

  CALL DATE_AND_TIME (CLDAT,CLTIM)
  WRITE(NULERR,'(A2,A1,A2,A1,A2,A27)') CLTIM(1:2),':',CLTIM(3:4), &
   & ':',CLTIM(5:6),'         Debut maj ebauche '  

  CALL RDFPINC

  CALL DATE_AND_TIME (CLDAT,CLTIM)
  WRITE(NULERR,'(A2,A1,A2,A1,A2,A17)') CLTIM(1:2),':', &
   & CLTIM(3:4),':',CLTIM(5:6),' Fin maj ebauche '  

  CALL FLUSH(NULOUT)
ENDIF

!---------------------------------------------------------------------------
!  - 2 -  Initialisation des statistiques liees a l'ebauche
!         -------------------------------------------------

CALL DATE_AND_TIME (CLDAT,CLTIM)
WRITE(NULERR,'(A2,A1,A2,A1,A2,A29)') CLTIM(1:2),':',CLTIM(3:4), &
 & ':',CLTIM(5:6),'         Debut stat. ebauche '  

IREPO=0
IREPN=0
CALL CALIFE(IREPO,IREPN)

CALL DATE_AND_TIME (CLDAT,CLTIM)
WRITE(NULERR,'(A2,A1,A2,A1,A2,A19)') CLTIM(1:2),':', &
 & CLTIM(3:4),':',CLTIM(5:6),' Fin stat. ebauche '  

CALL FLUSH(NULOUT)

!---------------------------------------------------------------------------
!  - 3 -  Initialisations supplementaires sur les observations
!         ----------------------------------------------------

CALL DATE_AND_TIME (CLDAT,CLTIM)
WRITE(NULERR,'(A2,A1,A2,A1,A2,A33)') CLTIM(1:2),':',CLTIM(3:4), &
 & ':',CLTIM(5:6),'         Initialisations sur obs.'  

CALL CASINO
CALL CAMELO

CALL DATE_AND_TIME (CLDAT,CLTIM)
WRITE(NULERR,'(A2,A1,A2,A1,A2,A29)') CLTIM(1:2),':', &
 & CLTIM(3:4),':',CLTIM(5:6), &
 & ' Fin initialisation sur obs. '  

IF ( LAVOLO ) THEN
  CALL CAVISO (NBSYVO,NBAIVO,NBSBVO,NBDRVO,NBTPVO,NBPLVO,NBSTVO)
ENDIF

CALL FLUSH(NULOUT)

!---------------------------------------------------------------------------
!  - 4 -  Initialisations necessaires aux differentes analyses
!         ----------------------------------------------------

!  - 4.1 -  Initialisation des tableaux de calculs des statistiques imprimees

CALL CA0DGU

!  - 4.2 -  Lecture increments pour lissage champs de surface

IF ( LAEICS ) THEN
  CALL CAVEGI
  CALL UPDTIM (0,0.0_JPRB,0.0_JPRB,.FALSE.)
  IF ( LISSEW ) CALL CALINCW
ENDIF

!  - 4.3 -  Fabrication du champ de rappel climatologique de SST

CALL CACLSST

!  - 4.4 -  Mise a jour du masque d'analyse

IF (LANMASK) THEN

  IPCT=SIZE(GELAM)
  ALLOCATE(ZLON(IPCT))
  ALLOCATE(ZLAT(IPCT))
  ZLON(:)=GELAM(:) * RDEGREES
  ZLAT(:)=GELAT(:) * RDEGREES

  ZDLON=ALONEB-ALONWB

  IST=1
  DO JSTGLO = 1 , NGPTOT , NPROMA
    IEND=MIN(NPROMA,NGPTOT-JSTGLO+1)
    IBLK=(JSTGLO-1)/NPROMA+1
    IOFF=JSTGLO-1
    DO JL = IST , IEND
      IOFF=IOFF+1
      ZTLON=(ZLON(IOFF)-ALONWB)*(ZLON(IOFF)-ALONEB)*ZDLON
      IF (ZTLON > 0.0_JPRB .OR. ZLAT(IOFF) > ALATNB .OR. ZLAT(IOFF) < ALATSB) &
       & SP_CI(JL,YSP_CI%YCI(3)%MP0,IBLK)=0.0_JPRB  
    ENDDO
  ENDDO
  IF (ALLOCATED(ZLON)) DEALLOCATE(ZLON)
  IF (ALLOCATED(ZLAT)) DEALLOCATE(ZLAT)

ENDIF

!---------------------------------------------------------------------------
!  - 5 -  Premier calcul des residus (avec toutes les interpolations)
!         -----------------------------------------------------------

IF ( LAEOMF ) THEN
  CALL DATE_AND_TIME (CLDAT,CLTIM)
  WRITE(NULERR,'(A2,A1,A2,A1,A2,A32)') CLTIM(1:2),':',CLTIM(3:4), &
   & ':',CLTIM(5:6),'         1er calcul des residus '  

  NRESECR = 1
  IF ( NAEINC == 2 ) NRESECR = 2
  
  LRESCPL = .TRUE.
  LCASIG  = .TRUE.

  CALL CADAVR

  IF ( NAEINC == 1 ) CALL CAIFC1

  CALL DATE_AND_TIME (CLDAT,CLTIM)
  WRITE(NULERR,'(A2,A1,A2,A1,A2,A24)') CLTIM(1:2),':', &
   & CLTIM(3:4),':',CLTIM(5:6),' Fin 1er calcul residus '  

  IF ( LAVORO ) THEN
    CALL CAVISO (NBSYVO,NBAIVO,NBSBVO,NBDRVO,NBTPVO,NBPLVO,NBSTVO)
  ENDIF

  CALL FLUSH(NULOUT)
ENDIF

!---------------------------------------------------------------------------
!  - 6 -  Allocation tableaux de travail pour checking et analyse.
!         -------------------------------------------------------

LLANA = LAEPDS .OR. LAEUVT .OR. LAEHUM .OR. LAET2M .OR. &
 & LAEH2M .OR. LAEV1M .OR. LAESNM .OR. LAESST .OR. &
 & LAEICS .OR. LAECDS  
IF ( LLANA ) THEN
  IDLON = NPROMA
ELSE
  IDLON = 1
ENDIF

IF ( LAECHK .OR. LLANA ) THEN
  WRITE (NULOUT,*) '  '
  ALLOCATE(NINSELG(JPNOTP,IDLON,NTASKS))
  WRITE(NULOUT,9990) 'NINSELG   ', SIZE(NINSELG), SHAPE(NINSELG)
  ALLOCATE(NIASELG(JP3KSE,IDLON,NTASKS))
  WRITE(NULOUT,9990) 'NIASELG   ', SIZE(NIASELG), SHAPE(NIASELG)
  ALLOCATE(RZDSELG(JP3KSE,IDLON,NTASKS))
  WRITE(NULOUT,9990) 'RZDSELG   ', SIZE(RZDSELG), SHAPE(RZDSELG)
ENDIF

!---------------------------------------------------------------------------
!  - 6 -  Controle de la qualite des observations
!         ---------------------------------------

!  - 6.1 -  Controle de coherence spatiale

IF ( LAECHK ) THEN
  CALL DATE_AND_TIME (CLDAT,CLTIM)
  WRITE(NULERR,'(A2,A1,A2,A1,A2,A32)') CLTIM(1:2),':',CLTIM(3:4), &
   & ':',CLTIM(5:6),'         Debut controle qualite '  

  WRITE (NULOUT,602)
  CALL CAVODK
  WRITE (NULOUT,603)

  CALL DATE_AND_TIME (CLDAT,CLTIM)
  WRITE(NULERR,'(A2,A1,A2,A1,A2,A22)') CLTIM(1:2),':', &
   & CLTIM(3:4),':',CLTIM(5:6),&
   & ' Fin controle qualite '  

ELSE
  WRITE (NULOUT,601)
ENDIF

!  - 6.2 -  Synthese des codes qualite

IF (.NOT.LVERAL) CALL CANTIK

!  - 6.3 -  Impressions

IF ( LAVOCQ ) THEN
  CALL CAVISO (NBSYVO,NBAIVO,NBSBVO,NBDRVO,NBTPVO,NBPLVO,NBSTVO)
ENDIF

CALL FLUSH(NULOUT)

601 FORMAT(/,/,3X,'**********************************',/, &
 & 3X,'*   pas de controle de qualite   *',/, &
 & 3X,'**********************************')  

602 FORMAT(/,/,3X,'************************************',/, &
 & 3X,'*   debut du controle de qualite   *',/, &
 & 3X,'************************************',/)  

603 FORMAT(/,3X,'**********************************',/, &
 & 3X,'*   fin du controle de qualite   *',/, &
 & 3X,'**********************************')  

!---------------------------------------------------------------------------
!  - 7 -  Analyses
!         --------

IF ( LLANA ) THEN
  CALL DATE_AND_TIME (CLDAT,CLTIM)
  WRITE(NULERR,'(A2,A1,A2,A1,A2,A24)') CLTIM(1:2),':',CLTIM(3:4), &
   & ':',CLTIM(5:6),'         Debut analyses '  

  WRITE (NULOUT,701)
  ALLOCATE(RCATSL(NPROMA,NFLEVG,NTASKS))
  WRITE(NULOUT,9990) 'RCATSL    ', SIZE(RCATSL ), SHAPE(RCATSL )
  ALLOCATE(RCARES(NPROMA,NFLEVG,NTASKS))
  WRITE(NULOUT,9990) 'RCARES    ', SIZE(RCARES ), SHAPE(RCARES )
  ALLOCATE(RCASIG(NPROMA,NFLEVG,NTASKS))
  WRITE(NULOUT,9990) 'RCASIG    ', SIZE(RCASIG ), SHAPE(RCASIG )
  WRITE(NULOUT,*) '   '

  CALL CANACO(1)

  CALL STEPO('0M1101AA0')

  WRITE(NULOUT,*) '     '
  CALL CAIDGU

  CALL CANACO(2)

  CALL DATE_AND_TIME (CLDAT,CLTIM)
  WRITE(NULERR,'(A2,A1,A2,A1,A2,A18)') CLTIM(1:2),':', &
   & CLTIM(3:4),':',CLTIM(5:6),' Fin analyses ! '  

  IF ( LAVOAN ) THEN
    CALL CAVISO (NBSYVO,NBAIVO,NBSBVO,NBDRVO,NBTPVO,NBPLVO,NBSTVO)
  ENDIF

  CALL FLUSH(NULOUT)

  WRITE (NULOUT,702)
  DEALLOCATE(RCATSL)
  DEALLOCATE(RCARES)
  DEALLOCATE(RCASIG)
ENDIF

IF (ALLOCATED(NINSELG)) DEALLOCATE(NINSELG)
IF (ALLOCATED(NIASELG)) DEALLOCATE(NIASELG)
IF (ALLOCATED(RZDSELG)) DEALLOCATE(RZDSELG)

701 FORMAT(/,3X,'**********************',/, &
 & 3X,'*   debut analyses   *',/, &
 & 3X,'**********************',/)  

702 FORMAT(/,3X,'********************',/, &
 & 3X,'*   fin analyses   *',/, &
 & 3X,'********************',/)  

!---------------------------------------------------------------------------
!  - 8 -  Smoothing of SWI changing of Wp
!      -------------------------------

IF (L_SM_WP) CALL CASMSWI

!---------------------------------------------------------------------------
!  - 9 -  Ecriture du fichier analyse
!         ---------------------------

IF ( LAEWIO ) THEN
  IF (LSOLV) CALL CARCLI
  CLCONF(1:9) = 'A00000000'
  CALL STEPO(CLCONF)
ELSE
  CALL SPNORM(0)
ENDIF

!---------------------------------------------------------------------------
!  - 10 -  Gestion des ecart-types d'erreur d'analyse
!         ------------------------------------------

IF ( LAESTA ) THEN
  IF (IREPN /= 1) CALL CAOHIS(.TRUE.,IREPN)
  WRITE(NULOUT,'(//,''REMPLISSAGE FICHIER STATISTIQUE ANALYSE'')')
  CALL CALICE
  IF (MYPROC <= NSTROUT) CALL FAIRME(IREP,NULASS,'KEEP')
ENDIF

!---------------------------------------------------------------------------
!  - 11 -  Gestion des increments de lissage des champs de surface
!          -------------------------------------------------------

IF ( LAEICS .AND. LISSEW ) CALL CAEINCW

!---------------------------------------------------------------------------
!  - 12 -  Second calcul des residus 
!          -------------------------

IF ( LAEOMN ) THEN
  CALL DATE_AND_TIME (CLDAT,CLTIM)
  WRITE(NULERR,'(A2,A1,A2,A1,A2,A32)') CLTIM(1:2),':',CLTIM(3:4), &
   & ':',CLTIM(5:6),'         Debut residus analyses '  

  NRESECR = 2
  LRESCPL = .NOT.LAEOMF
  LCASIG  = .NOT.LAEOMF
  CALL CADAVR

  CALL DATE_AND_TIME (CLDAT,CLTIM)
  WRITE(NULERR,'(A2,A1,A2,A1,A2,A22)') CLTIM(1:2),':', &
   & CLTIM(3:4),':',CLTIM(5:6),' Fin residus analyses '  

  CALL FLUSH(NULOUT)
ENDIF

!---------------------------------------------------------------------------
!  - 13 -  Visualisation des obs. en fin d'analyse
!          ---------------------------------------

IF ( LAVISO ) THEN
  CALL CAVISO (NBSYVO,NBAIVO,NBSBVO,NBDRVO,NBTPVO,NBPLVO,NBSTVO)
  CALL FLUSH(NULOUT)
ENDIF

!---------------------------------------------------------------------------
!  - 14 -  Mise a jour finale des observations
!          -----------------------------------

IF ( LAERFO .AND. LECFIO ) CALL CARCFO
CALL FLUSH(NULOUT)

!---------------------------------------------------------------------------
9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)

IF (LHOOK) CALL DR_HOOK('CANARI',1,ZHOOK_HANDLE)
END SUBROUTINE CANARI
