SUBROUTINE CAISSEDM (KGUESS)
!****------------------------------------------------------------------------
!****   CAISSEDM : INITIALISATION ECART-TYPES PHI ET HU PAR DES
!****   --------   STATISTIQUES SAUVEGARDEES.
!****
!****    Auteurs :    P. MOLL  10/09/92     F. TAILLEFER  13/11/92
!****------------------------------------------------------------------------
!  BUT : INITIALISATION DES VARIANCES DE PHI ET HU DANS LE CAS D'UN
!  ---   DEMARRAGE A PARTIR D'UN GUESS PREVI (cas LMESSP=.T.).
!        ON LIT LES VALEURS DES ECART-TYPES D'ERREUR D'ANALYSE SUR LE
!        FICHIER "STATISTIQUES ASSIMILEES"; PUIS ON EN DEDUIT LA VALEUR
!        DES ECART-TYPES D'ERREUR DU GUESS.

!  ROUTINE APPELANTE :    *CALIFE*
!  -----------------

!  SOUS-PROGRAMME APPELE :  FACILE
!  ---------------------    CAPDGU CAINSU
!                           GPPRE  SPEREE REESPE
!                           ETIBIHIE EREESPE ESPEREE

!  ARGUMENT D'ENTREE :
!  -----------------
!     Explicite : - KGUESS : numero du guess choisi.
!     Implicite :  YOMDIM YOMCT0 YOMGEM
!                  QACOST QASSET QAGPSF

!  ARGUMENT DE SORTIE :
!  ------------------
!     Explicite : aucun
!     Implicite : - QASSET : tableau ESIG
!                 - QAGPSF : tableaux RSGPHI et RSGHUM.

!  MODIFICATIONS :
!  -------------
!     26/10/93  P. MOLL
!     12/10/95  F. TAILLEFER
!     95-12-22  M. Hamrud       Change of ZEPHI layout
!     96-12-20  M. Hamrud       Bug in Aladin call to EBECHFI
!     97-12-15  D. Giard        Call to esperee
!     98-02-13  R. El Khatib    SPREORD
!     98-08-10  K. YESSAD       removal of LRPOLE option
!        - removal of LRPOLE in YOMCT0.
!        - removal of code under LRPOLE.
!        - removal of 'LLP' or '.FALSE.' in 'CALL SPEREE'. 
!        - removal of the last argument (.FALSE.) in 'CALL DIWRGRID'.
!     01-03-20  S. Ivatek-Sahdan call DISSPEC -> call DISSPEC0
!     03-10-01  M. Hamrud       CY28 Cleaning
!     04-08-04  F. Taillefer    Back to gridpoint file
!        A. Stanesic   18-Apr-2008 Externalise biperiodicisation
!     Apr 2008  K. Yessad: use DISGRID instead of DISGRID_C + cleanings
!****------------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NDGENL   ,NDLON    ,NDLSM    ,NDLUNG   ,&
 & NDGUNG   ,NDLUXG   ,NDGUXG   ,NDGLG    ,NDGENG   ,&
 & NFLEVG   ,NFLSUR   ,NSMAX    ,NSPEC2   ,&
 & NUMP     ,NDGSAG   ,NMSMAX  
USE YOMLUN   , ONLY : NULOUT   ,NULASE
USE YOMCT0   , ONLY : LELAM
USE YOMGEM   , ONLY : NSTAGP   ,VBH      ,VAH      ,NGPTOT   ,&
 & NLOENG   ,NGPTOTG  
USE YOMGC    , ONLY : GELAT
USE YOMLAP   , ONLY : NASM0    ,MYMS
USE YEMLAP   , ONLY : NESM0    ,NCPLM
USE YOMMP    , ONLY : NSTA     ,NONL     ,MYPROC   ,NPTRFLOFF,MY_REGION_EW

USE YOMOP    , ONLY : NAGDIO   ,MAXFIELD
USE QALORI   , ONLY : RCAPRP   ,NCAMNS   ,NCAPLS
USE QACTAN   , ONLY : NCANLI   ,NCANLS
USE QACOST   , ONLY : QPOVZ
USE QASSET   , ONLY : ESIG
USE QAGPSF   , ONLY : RSGHUM   ,RSGPHI

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KGUESS 

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

REAL(KIND=JPRB) :: ZEPHI(NGPTOT,NFLEVG), ZEHU(NGPTOT,NFLEVG)
REAL(KIND=JPRB) :: ZIPHI(NFLSUR,NSPEC2), ZIHU(NFLSUR,NSPEC2)
REAL(KIND=JPRB) :: ZGESIG(NGPTOTG,NFLEVG), ZZEPHI(0:NDLSM,NFLEVG,NDGSAG:NDGENG)
REAL(KIND=JPRB) :: ZAEPHI(NGPTOT),ZDATA(NGPTOTG),ZFIELD(NGPTOT,2*NFLEVG)
REAL(KIND=JPRB) :: ZBID(NDLON,NDGENL,NFLEVG)
REAL(KIND=JPRB) :: ZPRESH(0:NFLEVG),ZPRESF(NFLEVG),ZPOIDS(NFLEVG),ZSTR(2)

INTEGER(KIND=JPIM) :: ITOT(12,NFLEVG),ITOTL(12),ITOTV(NFLEVG)
INTEGER(KIND=JPIM) :: ICPH(12,NFLEVG),ICPHL(12),ICPHV(NFLEVG)
INTEGER(KIND=JPIM) :: ICPB(12,NFLEVG),ICPBL(12),ICPBV(NFLEVG)
INTEGER(KIND=JPIM) , ALLOCATABLE :: ISTAGP(:)
CHARACTER (LEN = 1) ::  CLVAR(10)

INTEGER(KIND=JPIM) :: ICAGLN, ICAGLS, ICALOE, ICALOW, ICPBT,&
 & ICPHT, IEND, IGPTSK, IILA, ILEVHU, ILVMNS, &
 & ILVPLS, IM, IND, INUM, IPROC, IREP, IROF, &
 & ISTART, ITOTT, J, JGL, JIND, JJL, JLA, JLEV, &
 & JLON, JM, JMLOC, JN, JPG, I_NFLEV2  

LOGICAL :: LL

REAL(KIND=JPRB) :: Z1MALP, ZALPHA, ZARG, ZB, ZCST, ZFONC, ZKZ,&
 & ZKZ1, ZLAT, ZPOTOT, ZRBELL, ZTLUM  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

INTERFACE
#include "etibihie.h"
END INTERFACE

#include "abor1.intfb.h"
#include "cainsu.intfb.h"
#include "capdgu.intfb.h"
#include "disgrid.intfb.h"
#include "diwrgrid.intfb.h"
#include "ereespe.intfb.h"
#include "esperee.intfb.h"
#include "gppre.intfb.h"
#include "reespe.intfb.h"
#include "speree.intfb.h"
#include "suarpio.intfb.h"

#include "qastat.h"

!****------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CAISSEDM',0,ZHOOK_HANDLE)
!****------------------------------------------------------------------------

!**--------------------------------------------------------------------------
!**   0.    Initialisation provisoire pour le domaine d'impression
!**         (en attendant la refonte de CAPDGU selon le masque d'analyse).
!**         -------------------------------------------------------------

ICALOW = NDLUNG
ICALOE = NDLUXG
ICAGLN = 1
ICAGLS = NDGENL

!  Le tableau ISTAGP est introduit au lieu de NSTAGP parce que pour
!  Canari/Aladin (existence de la zone E) NSTAGP est mal initialise dans
!  SUGEM1B pour LMESSP=.T.
!  De meme, ce tableau ISTAGP a ete introduit dans CABANE.

IF (LELAM) THEN
  ALLOCATE(ISTAGP(1:NDGLG))
  IROF = 1
  DO JGL = 1,NDGLG
    ISTAGP(JGL)=IROF
    IROF=IROF+NLOENG(JGL)
  ENDDO
ENDIF

!**--------------------------------------------------------------------------
!**   1.    Initialisation des champs d'ecart-types d'erreur d'analyse.
!**         ----------------------------------------------------------

!*    1.1.  Lecture du fichier des ecart-types

WRITE(NULOUT,'(/,'' --> lecture ecart-types d erreur d '',&
 & ''analyse du reseau precedent '')')  

!  Initialisation des differents tableaux
ZEPHI(:,:) = 0.0_JPRB
ZEHU (:,:) = 0.0_JPRB
ZIPHI(:,:) = 0.0_JPRB
ZIHU (:,:) = 0.0_JPRB

!  Lecture par les processeurs concernes
CALL SUARPIO(1)
INUM=0
DO JLEV = 1,NFLEVG
!   Traitement du champ concernant PHI: lecture puis envoi
  INUM=INUM+1
  IF (INUM <= MAXFIELD) THEN
    IF (NAGDIO(1,INUM) == MYPROC) THEN
      CALL FACILE(IREP,NULASE,'S',JLEV,'ETAPHI',ZDATA,.FALSE.)
      CALL DISGRID(INUM,0,NGPTOTG,ZDATA)
      ZFIELD(1:NGPTOT,JLEV)=ZDATA(1:NGPTOT)
    ENDIF
  ELSE
    WRITE(NULOUT,*) ' MAXFIELD TOO SMALL !'
    CALL ABOR1('CAISSEDM : ABOR1 CALLED')
  ENDIF
!   Traitement du champ concernant HU: lecture puis envoi
  INUM=INUM+1
  IF (INUM <= MAXFIELD) THEN
    IF (NAGDIO(1,INUM) == MYPROC) THEN
      CALL FACILE(IREP,NULASE,'S',JLEV,'ETAHU',ZDATA,.FALSE.)
      CALL DISGRID(INUM,0,NGPTOTG,ZDATA)
      ZFIELD(1:NGPTOT,JLEV+NFLEVG)=ZDATA(1:NGPTOT)
    ENDIF
  ELSE
    WRITE(NULOUT,*) ' MAXFIELD TOO SMALL !'
    CALL ABOR1('CAISSEDM : ABOR1 CALLED')
  ENDIF
ENDDO

!  Reception par les processeurs qui ne lisent pas
DO JJL = 1,2*NFLEVG
  IF (NAGDIO(1,JJL) /= MYPROC) THEN
    CALL DISGRID(JJL,1,NGPTOT,ZFIELD(1,JJL))
  ENDIF
ENDDO

!*    1.2.  Recuperation dans tableaux pdg locaux

ZEPHI(:,:)=ZFIELD(:,1:NFLEVG)
ZEHU(:,:)=ZFIELD(:,NFLEVG+1:NFLEVG+NFLEVG)

!**--------------------------------------------------------------------------
!**   2.    Calcul des champs d'ecart-types d'erreur du guess.
!**         -------------------------------------------------

WRITE(NULOUT,'(/,'' --> calcul ecart-types d erreur du guess'')')

I_NFLEV2=2*NFLEVG
ESIG(1:NFLEVG,:)=ESIG(1:NFLEVG,:)*3._JPRB
ESIG(NFLEVG+1:I_NFLEV2,:)=ESIG(NFLEVG+1:I_NFLEV2,:)*1.2_JPRB

DO JN = 1 , NFLEVG
  DO JLA = 1 , NDGENL
    IROF=NSTAGP(JLA)-1
    IF (LELAM) IROF=ISTAGP(JLA)-1
    DO JLON = NSTA(NPTRFLOFF+JLA,MY_REGION_EW) ,&
       & NSTA(NPTRFLOFF+JLA,MY_REGION_EW)+NONL(NPTRFLOFF+JLA,MY_REGION_EW)-1  
      IROF=IROF+1
      ZBID(JLON,JLA,JN)=ZEPHI(IROF,JN)
    ENDDO
  ENDDO
ENDDO

CLVAR(1)='S'
CLVAR(2)='I'
CLVAR(3)='G'
CLVAR(4)='M'
CLVAR(5)='A'
CLVAR(6)=' '
CLVAR(7)='A'
CLVAR(8)='N'
CLVAR(9)='A'
CLVAR(10)='L'

LL=.FALSE.
CALL CAPDGU(NDLON,NDGENL,NFLEVG,&
 & ICALOW,ICAGLN,NCANLI,&
 & ICALOE,ICAGLS,NCANLS,&
 & NULOUT,CLVAR,ZBID,LL)  

DO JN = 1 , NFLEVG
  DO JLA = 1 , NDGENL
    IROF=NSTAGP(JLA)-1
    IF (LELAM) IROF=ISTAGP(JLA)-1
    DO JLON = NSTA(NPTRFLOFF+JLA,MY_REGION_EW) ,&
       & NSTA(NPTRFLOFF+JLA,MY_REGION_EW)+NONL(NPTRFLOFF+JLA,MY_REGION_EW)-1  
      IROF=IROF+1
      ZBID(JLON,JLA,JN)=ESIG(JN,IROF)
    ENDDO
  ENDDO
ENDDO

CLVAR(1)='S'
CLVAR(2)='I'
CLVAR(3)='G'
CLVAR(4)='M'
CLVAR(5)='A'
CLVAR(6)=' '
CLVAR(7)='C'
CLVAR(8)='L'
CLVAR(9)='I'
CLVAR(10)='M'

LL=.FALSE.
CALL CAPDGU(NDLON,NDGENL,NFLEVG,&
 & ICALOW,ICAGLN,NCANLI,&
 & ICALOE,ICAGLS,NCANLS,&
 & NULOUT,CLVAR,ZBID,LL)  

ZALPHA=1.0_JPRB-REAL(KGUESS,KIND(ZALPHA))*.05_JPRB
Z1MALP=1.0_JPRB-ZALPHA
DO JN = 1 , NFLEVG
  ILEVHU=NFLEVG+JN
  DO JPG = 1 , NGPTOT
    RSGPHI(JN,JPG)=ESIG(JN,JPG)
    RSGHUM(JN,JPG)=ESIG(ILEVHU,JPG)
    ZEPHI(JPG,JN)=MIN(ZEPHI(JPG,JN),ESIG(JN,JPG))
    ESIG(JN,JPG)=&
     & SQRT ( MAX ( Z1MALP*ESIG(JN,JPG)**2+ZALPHA*&
     & ZEPHI(JPG,JN)**2 , 0.09_JPRB*ESIG(JN,JPG)**2 ) )  
!         ESIG(ILEVHU,JPG)=
!    s        SQRT ( MAX ( Z1MALP*ESIG(ILEVHU,JPG)**2+ZALPHA*
!    s        ZEHU(JPG,JN)**2 , 0.01*ESIG(ILEVHU,JPG)**2 ) )
    ESIG(ILEVHU,JPG)=MAX ( Z1MALP*ESIG(ILEVHU,JPG)+&
     & ZALPHA*ZEHU(JPG,JN) , ESIG(ILEVHU,JPG)*0.2_JPRB )  
    RSGPHI(JN,JPG)=ESIG(JN,JPG)/RSGPHI(JN,JPG)
!         RSGHUM(JN,JPG)=ESIG(ILEVHU,JPG)/RSGHUM(JN,JPG)
  ENDDO
ENDDO

DO JN = 1 , NFLEVG
  DO JLA = 1 , NDGENL
    IROF=NSTAGP(JLA)-1
    IF (LELAM) IROF=ISTAGP(JLA)-1
    DO JLON = NSTA(NPTRFLOFF+JLA,MY_REGION_EW) ,&
       & NSTA(NPTRFLOFF+JLA,MY_REGION_EW)+NONL(NPTRFLOFF+JLA,MY_REGION_EW)-1  
      IROF=IROF+1
      ZBID(JLON,JLA,JN)=ESIG(JN,IROF)
    ENDDO
  ENDDO
ENDDO

CLVAR(1)='S'
CLVAR(2)='I'
CLVAR(3)='G'
CLVAR(4)='M'
CLVAR(5)='A'
CLVAR(6)=' '
CLVAR(7)='G'
CLVAR(8)='U'
CLVAR(9)='E'
CLVAR(10)='S'

LL=.FALSE.
CALL CAPDGU(NDLON,NDGENL,NFLEVG,&
 & ICALOW,ICAGLN,NCANLI,&
 & ICALOE,ICAGLS,NCANLS,&
 & NULOUT,CLVAR,ZBID,LL)  

DO JN = 1 , NFLEVG
  DO JLA = 1 , NDGENL
    IROF=NSTAGP(JLA)-1
    IF (LELAM) IROF=ISTAGP(JLA)-1
    DO JLON = NSTA(NPTRFLOFF+JLA,MY_REGION_EW) ,&
       & NSTA(NPTRFLOFF+JLA,MY_REGION_EW)+NONL(NPTRFLOFF+JLA,MY_REGION_EW)-1  
      IROF=IROF+1
      ZBID(JLON,JLA,JN)=RSGPHI(JN,IROF)
    ENDDO
  ENDDO
ENDDO

CLVAR(1)='S'
CLVAR(2)='I'
CLVAR(3)='G'
CLVAR(4)='M'
CLVAR(5)='A'
CLVAR(6)=' '
CLVAR(7)='G'
CLVAR(8)='U'
CLVAR(9)='E'
CLVAR(10)='S'

LL=.FALSE.
CALL CAPDGU(NDLON,NDGENL,NFLEVG,&
 & ICALOW,ICAGLN,NCANLI,&
 & ICALOE,ICAGLS,NCANLS,&
 & NULOUT,CLVAR,ZBID,LL)  

DO JN = 1 , NFLEVG
  DO JLA = 1 , NDGENL
    IROF=NSTAGP(JLA)-1
    IF (LELAM) IROF=ISTAGP(JLA)-1
    DO JLON = NSTA(NPTRFLOFF+JLA,MY_REGION_EW) ,&
       & NSTA(NPTRFLOFF+JLA,MY_REGION_EW)+NONL(NPTRFLOFF+JLA,MY_REGION_EW)-1  
      IROF=IROF+1
      ZBID(JLON,JLA,JN)=RSGHUM(JN,IROF)
    ENDDO
  ENDDO
ENDDO

CLVAR(1)='S'
CLVAR(2)='I'
CLVAR(3)='G'
CLVAR(4)='M'
CLVAR(5)='A'
CLVAR(6)='G'
CLVAR(7)=' '
CLVAR(8)='H'
CLVAR(9)='U'
CLVAR(10)='M'

LL=.FALSE.
CALL CAPDGU(NDLON,NDGENL,NFLEVG,&
 & ICALOW,ICAGLN,NCANLI,&
 & ICALOE,ICAGLS,NCANLS,&
 & NULOUT,CLVAR,ZBID,LL)  

!**--------------------------------------------------------------------------
!**   3.    Quelques petits diagnostics sur SIGMA P.
!**         ---------------------------------------

ITOTT      = 0
ICPHT      = 0
ICPBT      = 0
ITOT (:,:) = 0
ITOTL(:)   = 0
ITOTV(:)   = 0
ICPH (:,:) = 0
ICPHL(:)   = 0
ICPHV(:)   = 0
ICPB (:,:) = 0
ICPBL(:)   = 0
ICPBV(:)   = 0

DO JN = 1 , NFLEVG
  DO JLA = 1 , NDGENL
    IROF=NSTAGP(JLA)-1
    IF (LELAM) IROF=ISTAGP(JLA)-1
    IILA=(12*(JLA-1))/NDGENL+1
    DO JLON = NSTA(NPTRFLOFF+JLA,MY_REGION_EW) ,&
       & NSTA(NPTRFLOFF+JLA,MY_REGION_EW)+NONL(NPTRFLOFF+JLA,MY_REGION_EW)-1  
      IROF=IROF+1
      ITOT(IILA,JN)=ITOT(IILA,JN)+1
      IF (RSGPHI(JN,IROF) > 0.40_JPRB) ICPH(IILA,JN)=ICPH(IILA,JN)+1
      IF (RSGPHI(JN,IROF) < 0.25_JPRB) ICPB(IILA,JN)=ICPB(IILA,JN)+1
    ENDDO
  ENDDO
ENDDO

DO JN = 1 , NFLEVG
  DO JLA = 1 , 12
    ITOTL(JLA)=ITOTL(JLA)+ITOT(JLA,JN)
    ITOTV(JN)=ITOTV(JN)+ITOT(JLA,JN)
    ITOTT=ITOTT+ITOT(JLA,JN)
    ICPHL(JLA)=ICPHL(JLA)+ICPH(JLA,JN)
    ICPHV(JN)=ICPHV(JN)+ICPH(JLA,JN)
    ICPHT=ICPHT+ICPH(JLA,JN)
    ICPBL(JLA)=ICPBL(JLA)+ICPB(JLA,JN)
    ICPBV(JN)=ICPBV(JN)+ICPB(JLA,JN)
    ICPBT=ICPBT+ICPB(JLA,JN)
  ENDDO
ENDDO

WRITE(NULOUT,*) ' '
WRITE(NULOUT,*) '    TOTAL  TOTAL '
WRITE(NULOUT,*) ' '
WRITE(NULOUT,3001) (JLA,JLA=1,12)
DO JN = 1 , NFLEVG
  WRITE(NULOUT,3004) JN,(ITOT(JLA,JN),JLA=1,12),ITOTV(JN)
ENDDO
WRITE(NULOUT,3005) 'TOT',(ITOTL(JLA),JLA=1,12),ITOTT
WRITE(NULOUT,*) ' '
WRITE(NULOUT,*) ' TOTAUX HAUTS POUR SIGMA P '
WRITE(NULOUT,*) ' '
WRITE(NULOUT,3001) (JLA,JLA=1,12)
DO JN = 1 , NFLEVG
  WRITE(NULOUT,3004) JN,(ICPH(JLA,JN),JLA=1,12),ICPHV(JN)
ENDDO
WRITE(NULOUT,3005) 'TOT',(ICPHL(JLA),JLA=1,12),ICPHT
WRITE(NULOUT,*) ' '
WRITE(NULOUT,*) ' POURCENTAGES HAUTS POUR SIGMA P '
WRITE(NULOUT,*) ' '
WRITE(NULOUT,3001) (JLA,JLA=1,12)
DO JN = 1 , NFLEVG
  WRITE(NULOUT,3002) JN,(100._JPRB*REAL(ICPH(JLA,JN),JPRB)/&
   & REAL(ITOT(JLA,JN),JPRB),JLA=1,12),&
   & 100._JPRB*REAL(ICPHV(JN),JPRB)/REAL(ITOTV(JN),JPRB)  
ENDDO
WRITE(NULOUT,3003) 'TOT',(100._JPRB*REAL(ICPHL(JLA),JPRB)/&
 & REAL(ITOTL(JLA),JPRB),JLA=1,12),&
 & 100._JPRB*REAL(ICPHT,JPRB)/REAL(ITOTT,JPRB)  

WRITE(NULOUT,*) ' '
WRITE(NULOUT,*) ' TOTAUX BAS POUR SIGMA P '
WRITE(NULOUT,*) ' '
WRITE(NULOUT,3001) (JLA,JLA=1,12)
DO JN = 1 , NFLEVG
  WRITE(NULOUT,3004) JN,(ICPB(JLA,JN),JLA=1,12),ICPBV(JN)
ENDDO
WRITE(NULOUT,3005) 'TOT',(ICPBL(JLA),JLA=1,12),ICPBT
WRITE(NULOUT,*) ' '
WRITE(NULOUT,*) ' POURCENTAGES BAS POUR SIGMA P '
WRITE(NULOUT,*) ' '
WRITE(NULOUT,3001) (JLA,JLA=1,12)
DO JN = 1 , NFLEVG
  WRITE(NULOUT,3002) JN,(100._JPRB*REAL(ICPB(JLA,JN),JPRB)/&
   & REAL(ITOT(JLA,JN),JPRB),JLA=1,12),&
   & 100._JPRB*REAL(ICPBV(JN),JPRB)/REAL(ITOTV(JN),JPRB)  
ENDDO
WRITE(NULOUT,3003) 'TOT',(100._JPRB*REAL(ICPBL(JLA),JPRB)/&
 & REAL(ITOTL(JLA),JPRB),JLA=1,12),&
 & 100._JPRB*REAL(ICPBT,JPRB)/REAL(ITOTT,JPRB)  
WRITE(NULOUT,*) ' '

3001 FORMAT(7X,12(I2,3X))
3002 FORMAT(1X,I2,2X,12(F4.1,1X),F4.1)
3003 FORMAT(1X,A3,1X,12(F4.1,1X),F4.1)
3004 FORMAT(1X,I2,2X,12(I4,1X),I4)
3005 FORMAT(1X,A3,1X,12(I4,1X),I4)

IF ( LELAM ) THEN
!****** doubly-periodicisation of sigma phi file
!****** Passage a un tableau global pour effectuer la biperiodicisation
!****** puis distribution du nouveau tableau sur les proc

  IPROC = 1
  ZZEPHI(:,:,:)=0.0_JPRB
  ZGESIG(:,:)=0.0_JPRB
  DO JLEV = 1 , NFLEVG
    IF (MYPROC /= IPROC) THEN
      ZAEPHI(:)=ESIG(JLEV,:)
      CALL DIWRGRID(IPROC,JLEV,0,NGPTOT,ZAEPHI)
    ELSE
      DO J = 1 , NGPTOT
        ZGESIG(J,JLEV)=ESIG(JLEV,J)
      ENDDO
    ENDIF
  ENDDO
  IF (MYPROC == IPROC) THEN
    DO JLEV = 1 , NFLEVG
      CALL DIWRGRID(IPROC,JLEV,1,NGPTOTG,ZGESIG(1,JLEV))
      DO JLA = NDGUNG , NDGUXG
        DO JLON = NDLUNG , NDLUXG
          ZZEPHI(JLON,JLEV,JLA)=ZGESIG(JLON+ISTAGP(JLA)-1,JLEV)
        ENDDO
      ENDDO
    ENDDO
    CALL ETIBIHIE(NDLON,NDGLG,NFLEVG,NDLUXG,NDGUXG,0,&
     & NDLSM,ZZEPHI,.TRUE.,.TRUE.,0)  
    DO JLEV = 1 , NFLEVG
      DO JLA = 1 , NDGLG
        DO JLON = 1 , NLOENG(JLA)
          ZGESIG(JLON+ISTAGP(JLA)-1,JLEV) = ZZEPHI(JLON,JLEV,JLA)
        ENDDO
      ENDDO
      DO J = 1 , NGPTOT
        ESIG(JLEV,J)=ZGESIG(J,JLEV)
      ENDDO
      CALL DISGRID(JLEV,0,NGPTOTG,ZGESIG(1,JLEV),LDC=.TRUE.,KIOPROC=IPROC)
    ENDDO
  ENDIF
  DO JLEV = 1 , NFLEVG
    IF (MYPROC /= IPROC) THEN
      CALL DISGRID(JLEV,1,NGPTOT,ZAEPHI,LDC=.TRUE.,KIOPROC=IPROC)
      ESIG(JLEV,:)=ZAEPHI(:)
    ENDIF
  ENDDO
ENDIF

RSGPHI(:,:)=ESIG(1:NFLEVG,:)

!**--------------------------------------------------------------------------
!**   4.    Quelques petits lissages sur SIGMA P.
!**         ------------------------------------

!**** LISSAGE SUR L'HORIZONTALE
!        - passage espace points de grille --> espace spectral
!        - application fonction filtre pour tronquer le spectre
!        - passage espace spectral --> espace points de grille

DO JN = 1 , NFLEVG
  DO JPG = 1 , NGPTOT
    ZEPHI(JPG,JN)=RSGPHI(JN,JPG)
  ENDDO
ENDDO

IF ( .NOT.LELAM ) THEN

  CALL REESPE(NFLSUR,NFLEVG,ZIPHI,ZEPHI)

  ZCST = -8._JPRB*LOG(0.1_JPRB)
  ZB   = -0.5_JPRB*ZCST/(NSMAX*NSMAX)
  DO JMLOC = 1 , NUMP
    IM=MYMS(JMLOC)
    DO JN = IM , NSMAX
      IND = NASM0(IM)+(JN-IM)*2
      ZFONC = EXP(ZB*JN*JN)
      DO JLEV = 1 , NFLEVG
        ZIPHI(JLEV,IND) = ZIPHI(JLEV,IND)*ZFONC
        ZIPHI(JLEV,IND+1) = ZIPHI(JLEV,IND+1)*ZFONC
      ENDDO
    ENDDO
  ENDDO

  CALL SPEREE(NFLSUR,NFLEVG,ZIPHI,ZEPHI)

ELSE

  CALL EREESPE(NFLSUR,NFLEVG,ZIPHI,ZEPHI)

  ZRBELL = -2.0_JPRB*LOG(0.1_JPRB)
  DO JM = 1 , NUMP
    IM = MYMS(JM)
    DO JN = 0 , NCPLM(IM)-1
      ZARG = (REAL(JN,JPRB)/REAL(NSMAX,JPRB))**2 +&
       & (REAL(IM,JPRB)/REAL(NMSMAX,JPRB))**2  
      ZTLUM = EXP(-ZRBELL*ZARG)
      ISTART = NESM0(IM)+4*JN
      IEND   = ISTART + 3
      DO JIND = ISTART , IEND
        DO JLEV = 1 , NFLEVG
          ZIPHI(JLEV,JIND) = ZIPHI(JLEV,JIND)*ZTLUM
        ENDDO
      ENDDO
    ENDDO
  ENDDO

  CALL ESPEREE(NFLSUR,NFLEVG,ZIPHI,ZEPHI)

ENDIF

DO JN = 1 , NFLEVG
  DO JPG = 1 , NGPTOT
    ESIG(JN,JPG)=ZEPHI(JPG,JN)
  ENDDO
ENDDO

DO JN = 1 , NFLEVG
  DO JLA = 1 , NDGENL
    IROF=NSTAGP(JLA)-1
    IF (LELAM) IROF=ISTAGP(JLA)-1
    DO JLON = NSTA(NPTRFLOFF+JLA,MY_REGION_EW) ,&
       & NSTA(NPTRFLOFF+JLA,MY_REGION_EW)+NONL(NPTRFLOFF+JLA,MY_REGION_EW)-1  
      IROF=IROF+1
      ZBID(JLON,JLA,JN)=ESIG(JN,IROF)
    ENDDO
  ENDDO
ENDDO

CLVAR(1)='S'
CLVAR(2)='I'
CLVAR(3)='G'
CLVAR(4)='M'
CLVAR(5)='A'
CLVAR(6)=' '
CLVAR(7)='G'
CLVAR(8)='U'
CLVAR(9)='E'
CLVAR(10)='2'

LL=.FALSE.
CALL CAPDGU(NDLON,NDGENL,NFLEVG,&
 & ICALOW,ICAGLN,NCANLI,&
 & ICALOE,ICAGLS,NCANLS,&
 & NULOUT,CLVAR,ZBID,LL)  

!**** LISSAGE SUR LA VERTICALE

ZSTR(:)=1.0_JPRB
DO JLA = 1 , NDGENL
  IROF=NSTAGP(JLA)-1
  IF (LELAM) IROF=ISTAGP(JLA)-1
  DO JLON = NSTA(NPTRFLOFF+JLA,MY_REGION_EW) ,&
     & NSTA(NPTRFLOFF+JLA,MY_REGION_EW)+NONL(NPTRFLOFF+JLA,MY_REGION_EW)-1  

    IROF=IROF+1
    ZLAT=GELAT(IROF)
    ZPRESH(NFLEVG)=101325._JPRB
    CALL GPPRE(1,1,1,NFLEVG,VAH,VBH,ZPRESH,ZPRESF)

    DO JLEV=1,NFLEVG
      ZPRESF(JLEV) = LOG( ZPRESF(JLEV) )
    ENDDO
    IGPTSK = 1
    CALL CAINSU(ZLAT,ZPRESF,ZSTR,NFLEVG,IGPTSK)

    DO JLEV = 1 , NFLEVG

      ILVMNS=MAX(1,JLEV-NCAMNS)
      ILVPLS=MIN(NFLEVG,JLEV+NCAPLS)

      ZPOIDS(:)=0.0_JPRB

      ZKZ1=QPOVZ(JLEV,IGPTSK)
      DO JJL = ILVMNS , ILVPLS
        IF (JJL == JLEV) CYCLE
        ZKZ=(QPOVZ(JJL,IGPTSK)+ZKZ1)*0.5_JPRB
        ZPOIDS(JJL)=RCAPRP*FV(ZPRESF(JLEV),ZPRESF(JJL),ZKZ)
      ENDDO
      ZPOIDS(JLEV)=1.0_JPRB

      ZPOTOT=0.0_JPRB
      DO JJL = ILVMNS , ILVPLS
        ZPOTOT=ZPOTOT+ZPOIDS(JJL)
      ENDDO

      ESIG(JLEV,IROF)=0.0_JPRB
      DO JJL = ILVMNS , ILVPLS
        ESIG(JLEV,IROF)=ESIG(JLEV,IROF)+ZEPHI(IROF,JJL)*ZPOIDS(JJL)/ZPOTOT
      ENDDO

    ENDDO

  ENDDO
ENDDO

DO JN = 1 , NFLEVG
  DO JLA = 1 , NDGENL
    IROF=NSTAGP(JLA)-1
    IF (LELAM) IROF=ISTAGP(JLA)-1
    DO JLON = NSTA(NPTRFLOFF+JLA,MY_REGION_EW) ,&
       & NSTA(NPTRFLOFF+JLA,MY_REGION_EW)+NONL(NPTRFLOFF+JLA,MY_REGION_EW)-1  
      IROF=IROF+1
      ZBID(JLON,JLA,JN)=ESIG(JN,IROF)
    ENDDO
  ENDDO
ENDDO

CLVAR(1)='S'
CLVAR(2)='I'
CLVAR(3)='G'
CLVAR(4)='M'
CLVAR(5)='A'
CLVAR(6)=' '
CLVAR(7)='G'
CLVAR(8)='U'
CLVAR(9)='E'
CLVAR(10)='F'

LL=.FALSE.
CALL CAPDGU(NDLON,NDGENL,NFLEVG,&
 & ICALOW,ICAGLN,NCANLI,&
 & ICALOE,ICAGLS,NCANLS,&
 & NULOUT,CLVAR,ZBID,LL)  

IF (ALLOCATED(ISTAGP)) DEALLOCATE(ISTAGP)

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