SUBROUTINE ESTSIG

!*** *ESTSIG*

!   Purpose.
!   --------
!      To estimate the standard deviations of forecast error from
!      the standard deviations of analysis error. The error growth
!      model is that recommended by Savijarvi, 1995. Specifically,
!      de/dt = (a*e+s)(1-e/emax), where e is standard deviation.

!   Interface.
!   ----------

!      CALL ESTSIG

!   Externals.
!   ----------

!      INQGRIB   READGRIB   COMMFCE1    COMMFCE2
!      SUHIFCE       SPEREE  SC2RDG     SC2WRG      GPPRE
!      SUVIFCE

!   Reference.
!   ----------
!      RD Tech Memo 220.
!      Savijarvi, Monthly Weather Review, Dec 1995, pp212...

!   Author.
!   -------
!      Mike Fisher *ECMWF*

!   Modifications.
!   --------------
!      Original   95-11-21
!      L. Isaksen 96-05-05 Adapted for Message Passing
!      M. Fisher  96-07-11 Modified error growth model for Q
!      M. Fisher  96-10-08 Spatially varying asymptotic std deviations
!      E. Holm    98-01-12 Included ozone
!      E.Andersson98-06-18 Bg errors for radiances and tcw.
!      E.Andersson98-08-10 Correct SQRT(2.0) factor on Ps, MESSP-loop
!      Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!          - removal of argument .FALSE. in 'CALL SPEREE'.
!        R. El Khatib : 01-08-07 Pruning options
!      E. Holm    03-04-23 New humidity control variable std estimate
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!      E. Holm    03-12-10 Correction for old humidity analysis
!      E. Holm    04-01-23 New ozone control variable std estimate
!        M.Hamrud      01-Dec-2005 Generalized IO scheme
!-----------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMCT0   , ONLY : NPROC
USE YOMDIM   , ONLY :     NFLEVG   ,NPROMA
USE YOMSPJB  , ONLY : SP7SP
USE YOMGC    , ONLY : GELAM    ,GELAT
USE YOMGEM   , ONLY :    VBH      ,VAH      ,NGPTOT
USE YOMVAR   , ONLY : NOANEF   ,NFGFCLEN ,LBGM
USE YOMJG    , ONLY : LFACHRO  ,LCLMSFCE ,FCEMN3D, FCEMN_DERIVED, &
                    & NOFCEF, LJB_NONLINEAR_CVHUM, LJB_NONLINEAR_CVO3, &
                    & N_SPJB_VARS, SPJB_VARS_INFO, NAEROCV, JPAEROCV
USE YOMANEB  , ONLY : NANEBU   ,NANEBV   ,NANEBZ   ,NANEBR ,&
 & NANEBQ   ,NANEBT   ,NANEBVO  ,NANEBO3  ,NANEBSP  ,&
 & NANEBRAD ,NANEBTCW ,ANEBUF   ,&
 & NANEBRH2 ,NANEBU10 ,NANEBV10 ,NANEBT2  ,NANEBTO3 ,&
 & NANERADS   ,NANEBGHG ,NANEBGRG, NANEBAERO
USE YOMFCEB  , ONLY : FCEBUF
USE YOMLUN   , ONLY : NULERR
USE YOMCST   , ONLY : RPI      ,RG
USE IOSTREAM_MIX , ONLY : SETUP_IOSTREAM, SETUP_IOREQUEST, IO_GET, &
 & CLOSE_IOSTREAM, TYPE_IOSTREAM , TYPE_IOREQUEST, IO_INQUIRE, &
 & CLOSE_IOREQUEST
USE YOMGRB   , ONLY : NGRBLNSP ,NGRBSP   ,NGRBT    ,NGRBU    ,&
 & NGRBVO   ,NGRBGH   ,NGRBQ    ,NGRBBTMP  ,NGRBO3   ,&
 & NGRBTCWV ,NGRBR    ,NGRB10U  ,NGRBTCO3 ,&
 & NGRB2T   ,NGRBGHG  ,NGRBGRG, &
 & NGRBAERLG
USE YOM_YGFL, ONLY : JPGHG, JPGRG, NGHG, NGRG

IMPLICIT NONE

INTEGER(KIND=JPIM), PARAMETER :: JPMAXLAT=500,JPMAXLEV=100,&
 & JPMAXVAR=20+JPGRG+JPGHG+JPAEROCV

CHARACTER (16) :: climfile='stdev_of_climate'
INTEGER(KIND=JPIM) :: INROWS, INVARS
INTEGER(KIND=JPIM) :: ILONE(JPMAXLAT)
INTEGER(KIND=JPIM) :: IFIELDS(JPMAXVAR), INLEVS(JPMAXVAR)
INTEGER(KIND=JPIM) :: ILEVS(JPMAXLEV,JPMAXVAR)
INTEGER(KIND=JPIM) :: IGRIB2D(JPMAXLEV*JPMAXVAR),ILEVS2D(JPMAXLEV*JPMAXVAR)
REAL(KIND=JPRB) :: ZLATE(JPMAXLAT), ZLON0E(JPMAXLAT), ZDLONE(JPMAXLAT), ZPFIELD(NGPTOT)
REAL(KIND=JPRB) :: ZA(JPMAXLEV,JPMAXVAR), ZB(JPMAXLEV,JPMAXVAR)
REAL(KIND=JPRB), ALLOCATABLE :: ZEGRID(:,:,:), ZIGRID(:,:), ZPRSFI(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZVALH(:,:), ZVALM(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZPRSHO(:,:), ZPRSFO(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZLATM(:), ZLONM(:)
REAL(KIND=JPRB) :: zane(NPROMA,NOANEF), zfce(NPROMA,NOFCEF)
REAL(KIND=JPRB) ,DIMENSION(10) ::ZXT=(/&
 & 0.667_JPRB,0.714_JPRB,0.833_JPRB,1.00_JPRB,1.00_JPRB,1.00_JPRB,1.00_JPRB,1.00_JPRB,1.00_JPRB,1.00_JPRB/)  
INTEGER(KIND=JPIM), PARAMETER :: JPVARS=16+JPGHG+JPGRG+JPAEROCV
INTEGER(KIND=JPIM), DIMENSION(JPVARS) :: ioff_l,icodes
INTEGER(KIND=JPIM) :: IOMASTER,INPTE,INFLDS,IOFF,I,ILAT,IX,INPTM &
 & ,istc,iendc,ilevx,IFLDOFF,IVAR &
 & ,JVAR,JLEV,JLAT,JLON,J,jkglo,JJ,JK, JFIELD, IFCEBQ, IPTJBVO, IPTJBQ &
 & ,IPTJBO3,IPTJBGHG(NGHG),IPTJBGRG(NGRG),IPTJBAERO(NAEROCV),II
REAL(KIND=JPRB) :: zgrow,zdt,zlimfac,zlimfac_ghg,zmodfac &
 & ,ZLAT,Z10DEG,ZDX,ZFACHR,zsigmod,zsigmodV,zsiglim,zsd
LOGICAL :: LLRAD,LLSLVAR,LLOBSV
TYPE(TYPE_IOSTREAM) :: YL_IOSTREAM
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER(KIND=JPIM) :: IGHG, JGHG, IGRG, JGRG, IAERO, JAERO

!--- zgrow   = error growth rate time constant (per day) and
!--- zdt     = time between analysis cycles (days)
!--- zlimfac : forecast error asymptotes to zlimfac*FCEMN(jlev,jvar)
!--- zmodfac : model error contributes zmodfac*FCEMN(jlev,jvar) per day

#include "abor1.intfb.h"
#include "commfce2.intfb.h"
#include "gppre.intfb.h"
#include "sc2rdg.intfb.h"
#include "sc2wrg.intfb.h"
#include "speree.intfb.h"
#include "suhifce.intfb.h"
#include "suvifce.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('ESTSIG',0,ZHOOK_HANDLE)
zgrow     =  0.4_JPRB
zdt       =  NFGFCLEN/24.0_JPRB
zlimfac   = 10.0_JPRB
zlimfac_ghg   = 3.0_JPRB
zmodfac   =  0.1_JPRB

ioff_l=(/NANEBSP,NANEBT,NANEBU,NANEBV,NANEBVO &
 & ,NANEBZ,NANEBQ,NANEBR,NANEBO3,NANEBTO3,NANEBRAD,NANEBTCW &
 & ,NANEBRH2,NANEBU10,NANEBV10,NANEBT2,NANEBGHG,NANEBGRG,NANEBAERO/)
icodes=(/NGRBSP,NGRBT,NGRBU,NGRBU,NGRBVO &
 & ,NGRBGH,NGRBQ,NGRBR,NGRBO3,NGRBTCO3,NGRBBTMP,NGRBTCWV &
 & ,NGRBR,NGRB10U,NGRB10U,NGRB2T,NGRBGHG,NGRBGRG & 
 & ,NGRBAERLG/)  
icodes(1)=NGRBLNSP

!--- look up varaibles in SPJB_VARS_INFO

IFCEBQ  = HUGE(IFCEBQ)
IPTJBVO = HUGE(IPTJBVO)
IPTJBQ  = HUGE(IPTJBQ)
IPTJBO3 = HUGE(IPTJBO3)
IF (NGHG > 0) IPTJBGHG(:) = HUGE(IPTJBGHG(:))
IF (NGRG > 0) IPTJBGRG(:) = HUGE(IPTJBGRG(:))
IF (NAEROCV> 0) IPTJBAERO(:) = HUGE(IPTJBAERO(:))
IGHG=0
IGRG=0
IAERO=0
DO JFIELD=1,N_SPJB_VARS
  IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE_FCE==NGRBVO) THEN
    IPTJBVO=SPJB_VARS_INFO(JFIELD)%IPTJB
  ELSEIF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE_FCE==NGRBQ) THEN
    IPTJBQ=SPJB_VARS_INFO(JFIELD)%IPTJB
    IFCEBQ=SPJB_VARS_INFO(JFIELD)%IPTFCE-1
  ELSEIF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE_FCE==NGRBO3) THEN
    IPTJBO3=SPJB_VARS_INFO(JFIELD)%IPTJB
  ELSEIF (ANY(SPJB_VARS_INFO(JFIELD)%IGRIBCODE_FCE==NGRBGHG)) THEN
    DO JGHG=1,JPGHG
      IF(SPJB_VARS_INFO(JFIELD)%IGRIBCODE_FCE==NGRBGHG(JGHG)) THEN
        IGHG=IGHG+1
        IPTJBGHG(IGHG)=SPJB_VARS_INFO(JFIELD)%IPTJB
      ENDIF
    ENDDO
  ELSEIF (ANY(SPJB_VARS_INFO(JFIELD)%IGRIBCODE_FCE==NGRBGRG)) THEN
    DO JGRG=1,JPGRG
      IF(SPJB_VARS_INFO(JFIELD)%IGRIBCODE_FCE==NGRBGRG(JGRG)) THEN
        IGRG=IGRG+1
        IPTJBGRG(IGRG)=SPJB_VARS_INFO(JFIELD)%IPTJB
      ENDIF
    ENDDO
  ELSEIF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE_FCE==NGRBAERLG) THEN
    DO JAERO=1,JPAEROCV
      IF(SPJB_VARS_INFO(JFIELD)%IGRIBCODE_FCE==NGRBAERLG) THEN
        IAERO=IAERO+1
        IPTJBAERO(IAERO)=SPJB_VARS_INFO(JFIELD)%IPTJB
      ENDIF
    ENDDO
  ENDIF
ENDDO

!--- read climatological variances

IF (.NOT.LCLMSFCE) THEN
  INVARS=0
ELSE
!         1.    Determine the forecast grid parameters
  IOMASTER=1
  CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLIMFILE),CDMODE='r',KIOMASTER=IOMASTER)
  CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
   & LDLATLONG=.TRUE.,KCHUNKSIZE=1)
  CALL IO_INQUIRE(YL_IOSTREAM,YL_IOREQUEST,&
   & KLATS=INROWS,KLONS=ILONE,PLATS=ZLATE,&
   & KNVARS=INVARS,KPARAMS=IFIELDS,KNLEVS=INLEVS,&
   & PA=ZA,PB=ZB,KLEVS=ILEVS)
  CALL CLOSE_IOREQUEST(YL_IOREQUEST)
  CALL CLOSE_IOSTREAM(YL_IOSTREAM)
  ZLON0E(:) = 0.0_JPRB

  ZDLONE(1:INROWS) = 2.0_JPRB * RPI / ILONE(1:INROWS)

  INPTE = SUM(ILONE(1:INROWS))
  INFLDS = SUM(INLEVS(1:INVARS))

  II=0
  DO JVAR=1,INVARS
    DO JLEV=1,INLEVS(JVAR)
      II=II+1
      IGRIB2D(II)=IFIELDS(JVAR)
      ILEVS2D (II)=ILEVS(JLEV,JVAR)
    ENDDO
  ENDDO

  ALLOCATE (ZEGRID(INPTE,INFLDS,1))

  CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLIMFILE),CDMODE='r',KIOMASTER=1)
  CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
   & KGRIB2D=IGRIB2D(1:INFLDS),KLEVS2D=ILEVS2D(1:INFLDS),&
   & KPROMA=INPTE,LDISTRIBUTE=.FALSE.,LDLATLONG=.TRUE.,KCHUNKSIZE=1)
  CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR3=ZEGRID)
  CALL CLOSE_IOREQUEST(YL_IOREQUEST)
  CALL CLOSE_IOSTREAM(YL_IOSTREAM)
  IF (NPROC>1) CALL COMMFCE2(ZEGRID,INPTE,INFLDS)

!---   Construct std of difference of two fields.
  CALL GSTATS(1871,0)
  DO JVAR=1,INFLDS
    DO JLEV=1,INPTE
      ZEGRID(JLEV,JVAR,1)=SQRT(2.0_JPRB)*ZEGRID(JLEV,JVAR,1)
    ENDDO
  ENDDO
  CALL GSTATS(1871,1)

!---   Increase climatological errors in the tropics

  IF (LFACHRO) THEN
    IOFF = 0
    CALL GSTATS(1887,0)
    DO JVAR=1,INVARS
      DO JLEV=1,INLEVS(JVAR)
        IOFF = IOFF+1
        IF (IFIELDS(JVAR) /= NGRBQ) THEN
          I = 0
          DO JLAT=1,INROWS
            ZLAT=ABS(ZLATE(JLAT))
            Z10DEG=RPI/18._JPRB
            ILAT=MIN(INT(ZLAT/Z10DEG),8)
            IX=ILAT+1
            ZDX=ZLAT/Z10DEG-ILAT
            ZFACHR=ZXT(6)/( ZXT(IX)+ZDX*(ZXT(IX+1)-ZXT(IX)) )

            DO JLON=1,ILONE(JLAT)
              I = I+1
              ZEGRID(I,IOFF,1) = ZEGRID(I,IOFF,1)*ZFACHR
            ENDDO
          ENDDO
        ENDIF
      ENDDO
    ENDDO
    CALL GSTATS(1887,1)
  ENDIF

!--- interpolate in the horizontal

  INPTM = NGPTOT

  ALLOCATE (ZLATM(INPTM),ZLONM(INPTM),ZIGRID(INPTM,INFLDS))

  DO J=1,NGPTOT
    ZLONM(J)=GELAM(J)
    ZLATM(J)=GELAT(J)
  ENDDO

  CALL SUHIFCE(ZLON0E,ZDLONE,ZLATE,INROWS,ILONE,ZLONM,ZLATM,INPTM,&
   & INPTE,INFLDS,ZEGRID(:,:,1),ZIGRID)  

  DEALLOCATE (ZEGRID,ZLONM,ZLATM)

!--- transform background surface pressure to gridpoint space

  CALL SPEREE(1,1,SP7SP,ZPFIELD)
ENDIF

!--- apply error growth model to standard deviations of analysis error

ALLOCATE (ZPRSFO(NPROMA,NFLEVG))
ALLOCATE (ZPRSHO(NPROMA,0:NFLEVG))

CALL GSTATS(1995,0)
MESSP_LOOP : DO jkglo=1,NGPTOT,NPROMA
  istc=1
  iendc=min(NPROMA,NGPTOT-jkglo+1)
  CALL SC2RDG(ANEBUF,jkglo,istc,iendc,zane)

! zfce needed only for the 'old' humidity analysis (q control variable).
  IF(.NOT. LJB_NONLINEAR_CVHUM) THEN
    istc=1
    iendc=min(NPROMA,NGPTOT-jkglo+1)
    CALL SC2RDG(FCEBUF,jkglo,istc,iendc,zfce)
  ENDIF

  MESSP_VAR_LOOP : DO jvar=1,JPVARS
    ioff = ioff_l(jvar)
!--- Not allocated variables are characterized by negative offset.
    IF (ioff < 0) CYCLE MESSP_VAR_LOOP
!--- If dynamic error growth, just VO needs adjusting.
    IF (LBGM .and. ioff /= NANEBVO) CYCLE MESSP_VAR_LOOP

!--- Single level variables, ps, integrated columns, radiances
!--- Add ozone and/or humidity for new control variable
    LLSLVAR=ANY(ioff == (/NANEBSP,NANEBTCW,NANEBTO3 &
     & ,NANEBRH2,NANEBU10,NANEBV10,NANEBT2/))  
    LLRAD=ioff == NANEBRAD

    IF(LJB_NONLINEAR_CVHUM .AND. LJB_NONLINEAR_CVO3) THEN
      LLOBSV=ANY(ioff == (/NANEBRAD,NANEBTCW,NANEBTO3 &
       & ,NANEBRH2,NANEBU10,NANEBV10,NANEBT2,NANEBR,NANEBQ,NANEBO3/))  
    ELSEIF(LJB_NONLINEAR_CVHUM .AND. .NOT. LJB_NONLINEAR_CVO3) THEN
      LLOBSV=ANY(ioff == (/NANEBRAD,NANEBTCW,NANEBTO3 &
       & ,NANEBRH2,NANEBU10,NANEBV10,NANEBT2,NANEBR,NANEBQ/))  
    ELSEIF(.NOT. LJB_NONLINEAR_CVHUM .AND. LJB_NONLINEAR_CVO3) THEN
      LLOBSV=ANY(ioff == (/NANEBRAD,NANEBTCW,NANEBTO3 &
       & ,NANEBRH2,NANEBU10,NANEBV10,NANEBT2,NANEBR,NANEBO3/))  
    ELSE
      LLOBSV=ANY(ioff == (/NANEBRAD,NANEBTCW,NANEBTO3 &
       & ,NANEBRH2,NANEBU10,NANEBV10,NANEBT2,NANEBR/))  
    ENDIF

!--- Set number of levels/channels.
    IF (LLRAD) THEN
      ilevx=NANERADS
    ELSEIF(LLSLVAR) THEN
      ilevx=1
    ELSE
      ilevx=NFLEVG
    ENDIF

    IFLDOFF = -1
    DO JJ=1,INVARS
      IF (IFIELDS(JJ) == icodes(jvar)) THEN
        IFLDOFF = SUM(INLEVS(1:JJ-1))
        IVAR    = JJ
        EXIT
      ENDIF
    ENDDO

    ALLOCATE (ZVALM (NPROMA,ilevx))
    ZVALM(:,:)=0.0_JPRB

!--- if the field has been provided, interpolate it in the vertical
!--- Radiances and single level fields can just be copied.

    IF (IFLDOFF >= 0) THEN

!--- Radiances and single lev fields without vertical interpolation.
      IF(LLRAD .OR. LLSLVAR) THEN
        IF(INLEVS(ivar) /= ilevx) THEN
          WRITE(NULERR,*) ' ESTSIG: ioff,jvar,icodes(jvar)'&
           & ,ioff,jvar,icodes(jvar),INLEVS(ivar),ilevx  
          CALL ABOR1('ESTSIG: INLEVS(IVAR) /= ilevx')
        ENDIF
        DO JLEV=1,ilevx
          DO JK=istc,iendc
            zvalm(JK,JLEV) = ZIGRID(JKGLO-1+JK,JLEV+IFLDOFF)
          ENDDO
        ENDDO
      ELSE
        DO JK=istc,iendc
          ZPRSHO(JK,NFLEVG)= EXP(ZPFIELD(JKGLO-1+JK))
        ENDDO

        CALL GPPRE(NPROMA,istc,iendc,NFLEVG,VAH,VBH,ZPRSHO,ZPRSFO)

        ALLOCATE (ZPRSFI(NPROMA,  INLEVS(IVAR)))
        ALLOCATE (ZVALH (NPROMA,0:INLEVS(IVAR)))

        DO JLEV=1,INLEVS(IVAR)
          DO JK=istc,iendc
            ZPRSFI(JK,JLEV) =  ZA(JLEV,IVAR)&
             & + ZPRSHO(JK,NFLEVG)*ZB(JLEV,IVAR)  
            ZVALH (JK,JLEV) = ZIGRID(JKGLO-1+JK,JLEV+IFLDOFF)
          ENDDO
        ENDDO

        ZVALH(istc:iendc,0) = ZVALH(istc:iendc,1)

        IF (istc /= 1) THEN
          WRITE (NULERR,*) 'ESTSIG calls SUVIFCE with istc<>1'
          CALL ABOR1 ('ESTSIG calls SUVIFCE with istc /= 1')
        ENDIF

        CALL SUVIFCE (ZVALH,ZPRSFI,NPROMA,iendc-istc+1,&
         & INLEVS(IVAR),ZVALM,ZPRSFO,NFLEVG)  

        IF (icodes(jvar) == NGRBGH) THEN
          zvalm(istc:iendc,:) = RG*zvalm(istc:iendc,:)
        ENDIF

        DEALLOCATE (ZPRSFI)
        DEALLOCATE (ZVALH)
      ENDIF

!--- if the field was not provided, use the default

    ELSE
      DO jlev=1,ilevx
        IF(LLOBSV) THEN
!         The climate variance is not known for some fields.
!         We then simply set it large compared to zane, i.e. no assymtote.
          WHERE(zane(istc:iendc,jlev+ioff) <= 0.0_JPRB)
            zvalm(istc:iendc,jlev)=100._JPRB
          ELSEWHERE
            zvalm(istc:iendc,jlev)=&
             & 100._JPRB*sqrt(zane(istc:iendc,jlev+ioff))  
          ENDWHERE
        ELSEIF(ioff == NANEBU .or. ioff == NANEBV) THEN
          zvalm(istc:iendc,jlev) = zlimfac*FCEMN_DERIVED%U(jlev)
        ELSEIF(ioff == NANEBZ) THEN
          zvalm(istc:iendc,jlev) = zlimfac*FCEMN_DERIVED%Z(jlev)
        ELSEIF(ioff == NANEBQ) THEN
!         If LJB_NONLINEAR_CVHUM, Q is done within LLOBSV, above
          IF (IFCEBQ/=HUGE(IFCEBQ)) THEN
             zvalm(istc:iendc,jlev) = zlimfac*zfce(istc:iendc,jlev+IFCEBQ)
          ELSE
            CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR Q NOT IN JB: 1')
          ENDIF
        ELSEIF(ioff == NANEBT) THEN
          zvalm(istc:iendc,jlev) = zlimfac*FCEMN_DERIVED%T(jlev)
        ELSEIF(ioff == NANEBVO) THEN
          IF (IPTJBVO/=HUGE(IPTJBVO)) THEN
            zvalm(istc:iendc,jlev) = zlimfac*FCEMN3D(jlev,iptjbvo)
           ELSE
            CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR VORTICITY NOT IN JB: 1')
          ENDIF
        ELSEIF(ioff == NANEBO3) THEN
!         If LJB_NONLINEAR_CVO3, O3 is done within LLOBSV, above
          IF (IPTJBO3/=HUGE(IPTJBO3)) THEN
            zvalm(istc:iendc,jlev) = zlimfac*FCEMN3D(jlev,iptjbo3)
           ELSE
            CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR O3 NOT IN JB: 1')
          ENDIF
!stj
        ELSEIF(ANY(ioff == NANEBGHG)) THEN
           DO IGHG=1,NGHG
            IF (ioff == NANEBGHG(IGHG)) THEN
              IF (IPTJBGHG(IGHG)/=HUGE(IPTJBGHG(IGHG))) THEN
                zvalm(istc:iendc,jlev) = zlimfac_ghg*FCEMN3D(jlev,iptjbghg(ighg))
               ELSE
                CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR GHG NOT IN JB: 1')
              ENDIF
            ENDIF
          ENDDO
        ELSEIF(ANY(ioff == NANEBGRG)) THEN
          DO IGRG=1,NGRG
            IF (IPTJBGRG(IGRG)/=HUGE(IPTJBGRG(IGRG))) THEN
              zvalm(istc:iendc,jlev) = zlimfac*FCEMN3D(jlev,iptjbgrg(igrg))
             ELSE
              CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR GRG NOT IN JB: 1')
            ENDIF
          ENDDO
        ELSEIF(ANY(ioff == NANEBAERO)) THEN
          DO IAERO=1,NAEROCV
            IF (IPTJBAERO(IAERO)/=HUGE(IPTJBAERO(IAERO))) THEN
              zvalm(istc:iendc,jlev) = zlimfac*FCEMN3D(jlev,iptjbaero(iaero))
             ELSE
              CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR AEROSOL NOT IN JB: 1')
            ENDIF
          ENDDO
!stj
        ELSEIF(ioff == NANEBSP) THEN
          zvalm(istc:iendc,jlev) = zlimfac*FCEMN_DERIVED%PS
        ENDIF
      ENDDO
    ENDIF

    DO jlev=1,ilevx
      IF (ioff == NANEBU .or. ioff == NANEBV) THEN
        zsigmodV = zmodfac * FCEMN_DERIVED%U(jlev)
      ELSEIF(ioff == NANEBZ) THEN
        zsigmodV = zmodfac * FCEMN_DERIVED%Z(jlev)
      ELSEIF(ioff == NANEBQ) THEN
        IF (IPTJBQ/=HUGE(IPTJBQ)) THEN
          zsigmodV = zmodfac * FCEMN3D(jlev,iptjbq)
        ELSE
          CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR Q NOT IN JB: 2')
        ENDIF
      ELSEIF(ioff == NANEBT) THEN
        zsigmodV = zmodfac * FCEMN_DERIVED%T(jlev)
      ELSEIF(ioff == NANEBVO) THEN
        IF (IPTJBVO/=HUGE(IPTJBVO)) THEN
          zsigmodV = zmodfac * FCEMN3D(jlev,iptjbvo)
        ELSE
          CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR VORTICITY NOT IN JB: 2')
        ENDIF
      ELSEIF(ioff == NANEBO3) THEN
        IF (IPTJBO3/=HUGE(IPTJBO3)) THEN
          zsigmodV = zmodfac * FCEMN3D(jlev,iptjbo3)
        ELSE
          CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR O3 NOT IN JB: 2')
        ENDIF


!stj
      ELSEIF(ANY(ioff == NANEBGHG)) THEN
        DO IGHG=1,NGHG
          IF (ioff == NANEBGHG(IGHG)) THEN
            IF (IPTJBGHG(IGHG)/=HUGE(IPTJBGHG(IGHG))) THEN
              zsigmodV = zmodfac * FCEMN3D(jlev,iptjbghg(ighg))
            ELSE
              CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR GHG NOT IN JB: 2')
            ENDIF
          ENDIF
        ENDDO
      ELSEIF(ANY(ioff == NANEBGRG)) THEN
        DO IGRG=1,NGRG
          IF (IPTJBGRG(IGRG)/=HUGE(IPTJBGRG(IGRG))) THEN
            zsigmodV = zmodfac * FCEMN3D(jlev,iptjbgrg(igrg))
          ELSE
            CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR GRG NOT IN JB: 2')
          ENDIF
        ENDDO
! BEN
      ELSEIF(ANY(ioff == NANEBAERO)) THEN
        DO IAERO=1,NAEROCV
          IF (IPTJBAERO(IAERO)/=HUGE(IPTJBAERO(IAERO))) THEN
            zsigmodV = zmodfac * FCEMN3D(jlev,iptjbaero(iaero))
          ELSE
            CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR AERO NOT IN JB: 2')
          ENDIF
        ENDDO
!stj


      ELSEIF(LLOBSV) THEN
        zsigmodV = 0.0_JPRB
      ELSEIF(ioff == NANEBSP) THEN
        zsigmodV = zmodfac * FCEMN_DERIVED%PS
      ELSE
        zsigmodV = 0.0_JPRB
      ENDIF

      DO jk=istc,iendc
        zsiglim = zvalm(jk,jlev)
        zsigmod = MIN (zsiglim/zdt,zsigmodV)
        zsd = sqrt(max(0.0_JPRB,zane(jk,jlev+ioff)))
        
        IF(LBGM) THEN
          zsd=min(max(zsd,zsiglim*0.1_JPRB),zsiglim*0.9_JPRB)
        ELSE
          zsd =  zsiglim &
           & - MAX(0.0_JPRB , (zsiglim  + zsigmod/zgrow)&
           & /( 1.0_JPRB - (zsd + zsigmod/zgrow)&
           & *exp((zgrow+zsigmod/zsiglim)*zdt)&
           & /(zsd - zsiglim) ) )  
        ENDIF

        zane(jk,jlev+ioff) = zsd*zsd
      ENDDO
    ENDDO
    DEALLOCATE (ZVALM)
  ENDDO MESSP_VAR_LOOP

  CALL SC2WRG (ANEBUF,jkglo,istc,iendc,zane)
ENDDO MESSP_LOOP
CALL GSTATS(1995,1)

DEALLOCATE (ZPRSFO)
DEALLOCATE (ZPRSHO)

IF (LCLMSFCE) DEALLOCATE (ZIGRID)

IF (LHOOK) CALL DR_HOOK('ESTSIG',1,ZHOOK_HANDLE)
end subroutine estsig
