SUBROUTINE CALICE
!****--------------------------------------------------------------------------
!****   CALICE : CALCUL DES ECART-TYPES D'ERREUR D'ANALYSE ET ALIMENTATION
!****   --------   DU FICHIER POUR L'ASSIMILATION DES STATISTIQUES.
!****
!****    Auteurs :      P. MOLL et F. TAILLEFER    16/11/92
!****--------------------------------------------------------------------------

!* BUT : CALCUL DES ECART-TYPES D'ERREUR D'ANALYSE POUR PHI ET HU (SI ELLES
!* ---   ONT ETE ANALYSEES BIEN SUR !!!) SUR LES NFLEVG NIVEAUX DU MODELE.
!*       OUVERTURE ET ALIMENTATION DU FICHIER STATISTIQUE PAR CES DEUX CHAMPS
!*       (POUR INTEGRATION DANS LE CALCUL DES ECART-TYPES D'ERREUR DE
!*       PREVISION DANS LA FUTURE ANALYSE QUI UTILISERA UN GUESS FABRIQUE A
!*       PARTIR DE L'ANALYSE ACTUELLE).

!* ROUTINE APPELANTE :    *CANARI*
!* -----------------

!* SOUS-PROGRAMME APPELE :  REESPE - EREESPE - DIWRGRID
!* ---------------------

!* ARGUMENT D'ENTREE :
!* -----------------
!*    Explicite : aucun
!*    Implicite : QASSET QAGPSF

!* ARGUMENT DE SORTIE :
!* ------------------
!*    Explicite : aucun
!*    Implicite : aucun

!* MODIFICATIONS :
!* -------------
!*     95-10-12 F. TAILLEFER : le fichier des statistiques assimilees est
!*                             desormais en coordonnees spectrales (et non plus
!*                             en points de grille).
!*     95-12-25 Y. Bouteloup : Recuperation d'ecarts types utiles en previsibilite
!*     97-12-15 D. Giard     : call to EREESPE
!*     98-02-13 R. El Khatib : DIWRSPE -> DIWRSPE+SPREORD
!*     01-03-20 S. Ivatek-Sahdan : call DIWRSPE -> call DIWRSPE0
!*     01-08-07 R. El Khatib : Pruning options
!*     04-08-04 F. Taillefer : on repasse en fichier points de grille
!****--------------------------------------------------------------------------


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

USE YOMDIM   , ONLY : NFLEVG
USE YOMGEM   , ONLY : NGPTOT   ,NGPTOTG
USE YOMLUN   , ONLY : NULOUT   ,NULASS
USE YOMMP    , ONLY : MYPROC
USE YOMOP    , ONLY : NAGDIO
USE QACTEX   , ONLY : LAEUVT   
USE QASSET   , ONLY : ESIG
USE QAGPSF   , ONLY : RSGHUM   ,RSGPHI

IMPLICIT NONE

CHARACTER (LEN = 8) :: CLTYP(2*NFLEVG)
INTEGER(KIND=JPIM) :: ILEV(2*NFLEVG)
REAL(KIND=JPRB) :: ZCH1(NGPTOT,2*NFLEVG), ZCH2(NGPTOTG,2*NFLEVG)

INTEGER(KIND=JPIM) :: IND, IOPROC, IREP, JN, JPG
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "diwrgrid.intfb.h"
#include "suarpio.intfb.h"

!**----------------------------------------------------------------------------
!**   1.    Calcul de sigma PHI.
!**         -------------------

IF (LHOOK) CALL DR_HOOK('CALICE',0,ZHOOK_HANDLE)

IF ( .NOT. LAEUVT ) THEN
  RSGPHI(:,:)=ESIG(1:NFLEVG,:)
ENDIF

!**----------------------------------------------------------------------------
!**   2.    Calcul de sigma Humidite.
!**         ------------------------

!     IF ( .NOT. LAEHUM ) THEN
RSGHUM(:,:)=ESIG(NFLEVG+1:2*NFLEVG,:)
!     ENDIF

!**----------------------------------------------------------------------------
!**   3.    Preparation des champs globaux.
!**         ------------------------------

DO JN = 1,NFLEVG
  DO JPG = 1,NGPTOT
    ZCH1(JPG,JN)=RSGPHI(JN,JPG)
    ZCH1(JPG,JN+NFLEVG)=RSGHUM(JN,JPG)
  ENDDO
  CLTYP(JN)='ETAPHI'
  CLTYP(JN+NFLEVG)='ETAHU'
  ILEV(JN)=JN
  ILEV(JN+NFLEVG)=JN
ENDDO

IND=2*NFLEVG

CALL SUARPIO(2)

DO JN = 1,IND
  IF (NAGDIO(1,JN) /= MYPROC) THEN
    IOPROC=NAGDIO(1,JN)
    CALL DIWRGRID(IOPROC,JN,0,NGPTOT,ZCH1(1,JN))
  ELSE
    ZCH2(1:NGPTOT,JN)=ZCH1(1:NGPTOT,JN)
  ENDIF
ENDDO

!**----------------------------------------------------------------------------
!**   4.    Alimentation fichier apres reception des champs.
!**         -----------------------------------------------

WRITE(NULOUT,'(/,'' --> alimentation par ecart-types''&
 & ,'' d erreur d analyse'')')  

DO JN = 1,IND
  IF (NAGDIO(1,JN) == MYPROC) THEN
    IOPROC=NAGDIO(1,JN)
    CALL DIWRGRID(IOPROC,JN,1,NGPTOTG,ZCH2(1,JN))
    CALL FAIENC(IREP,NULASS,'S',ILEV(JN),CLTYP(JN),ZCH2(1,JN),.FALSE.)
  ENDIF
ENDDO

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