subroutine estsiga (cdtype)

!*** *ESTSIGA*

!   Purpose.
!   --------
!      To estimate the standard deviations of background or analysis
!      error for those variable which are not explicit in Jb.

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

!      CALL ESTSIGA (CDTYPE)
!      CHARACTER*2 CDTYPE

!          CDTYPE == 'an'   ==> calculate analysis errors
!          CDTYPE == 'bg'   ==> calculate background errors

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

!      MIO routines  SC2RDG SC2WRG

!   Reference.
!   ----------

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

!   Modifications.
!   --------------
!      Original   97-02-24
!     E. Andersson 98-06-22 : Radiance and tcw Bg errors.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVG   ,NPROMA
USE YOMGEM   , ONLY :    NGPTOT
USE YOMVAR   , ONLY : NOANEF   ,NFGFCLEN
USE YOMJG    , ONLY : FCEMN3D, FCEMN_DERIVED, NOFCEF, &
                    & N_SPJB_VARS, SPJB_VARS_INFO, JPAEROCV
USE YOMANEB  , ONLY : NANEBU   ,NANEBV   ,NANEBZ   ,&
 & NANEBQ   ,NANEBT   ,NANEBVO  ,NANEBO3  ,NANEBSP  ,ANEBUF  ,&
 & NANEBGHG ,NANEBGRG, NANEBAERO
USE YOMFCEB  , ONLY : FCEBUF
USE YOMGC    , ONLY : GEMU     ,GM
USE YOMGRB   , ONLY : NGRBVO
USE YOM_YGFL   , ONLY : JPGHG, JPGRG

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

IMPLICIT NONE

! * PARAMETER INTEGER SCALARS:
CHARACTER(LEN=2)  ,INTENT(IN)    :: CDTYPE 
INTEGER(KIND=JPIM), PARAMETER :: JPVARS=8+JPGHG+JPGRG+JPAEROCV

REAL(KIND=JPRB) :: zane(NPROMA,NOANEF),zfce(NPROMA,NOFCEF)

INTEGER(KIND=JPIM) :: ioff_l(JPVARS)

INTEGER(KIND=JPIM) :: istc,iendc,ioff,jkglo,jk,jvar,jlev, &
                    & JFIELD,IPTJBVO

REAL(KIND=JPRB) :: zgrow,zdt,zreduc
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "sc2rdg.intfb.h"
#include "sc2wrg.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('ESTSIGA',0,ZHOOK_HANDLE)
ioff_l=(/NANEBU,NANEBV,NANEBZ,NANEBSP,NANEBT,NANEBVO,NANEBQ,NANEBO3,NANEBGHG,NANEBGRG,NANEBAERO/)

!--- look up varaibles in SPJB_VARS_INFO

IPTJBVO = HUGE(IPTJBVO)
DO JFIELD=1,N_SPJB_VARS
  IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE_FCE==NGRBVO) THEN
    IPTJBVO=SPJB_VARS_INFO(JFIELD)%IPTJB
  ENDIF
ENDDO

!--- zgrow   = error growth rate time constant (per day) and
!--- zdt     = time between analysis cycles (days)

zgrow     =  0.4_JPRB
zdt       =  NFGFCLEN/24.0_JPRB

if (CDTYPE == 'an') then
  zreduc = exp(-zgrow*zdt)
else
  zreduc = 1.0_JPRB
endif

!--- calculate standard deviations of analysis error

MESSP_LOOP : do jkglo=1,NGPTOT,NPROMA
  istc=1
  iendc=min(NPROMA,NGPTOT-jkglo+1)
  call SC2RDG (ANEBUF,jkglo,istc,iendc,zane)
  istc=1
  iendc=min(NPROMA,NGPTOT-jkglo+1)
  call SC2RDG (FCEBUF,jkglo,istc,iendc,zfce)

  do jvar=1,JPVARS
    ioff=ioff_l(jvar)
    do jlev=1,NFLEVG
      do jk=istc,iendc
        if (ioff == NANEBU .or. ioff == NANEBV) then
          IF (IPTJBVO/=HUGE(IPTJBVO)) THEN
            zane(jk,jlev+ioff) = zane(jk,jlev+NANEBVO)&
             & *( GM(jkglo-1+jk)&
             & *FCEMN_DERIVED%U(jlev)&
             & /FCEMN3D(jlev,iptjbvo) )**2  
          ELSE
            CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR VORTICITY NOT IN JB: 1')
          ENDIF
        ELSEIF (ioff == NANEBZ) then
          IF (IPTJBVO/=HUGE(IPTJBVO)) THEN
            zane(jk,jlev+ioff) =&
             & 0.20_JPRB*(zreduc*FCEMN_DERIVED%Z(jlev))**2 &
             & +0.80_JPRB*2.0_JPRB*zane(jk,jlev+NANEBVO)&
             & *( GEMU(jkglo-1+jk)&
             & *FCEMN_DERIVED%Z(jlev)&
             & /FCEMN3D(jlev,iptjbvo) )**2  
          ELSE
            CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR VORTICITY NOT IN JB: 2')
          ENDIF
        ELSEIF (ioff == NANEBT) then
          IF (IPTJBVO/=HUGE(IPTJBVO)) THEN
            zane(jk,jlev+ioff) =&
             & 0.20_JPRB*(zreduc*FCEMN_DERIVED%T(jlev))**2 &
             & +0.80_JPRB*2.0_JPRB*zane(jk,jlev+NANEBVO)&
             & *( GEMU(jkglo-1+jk)&
             & *FCEMN_DERIVED%T(jlev)&
             & /FCEMN3D(jlev,iptjbvo) )**2  
          ELSE
            CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR VORTICITY NOT IN JB: 3')
          ENDIF
        ELSEIF (ioff == NANEBVO) then
          continue
        ELSEIF (ioff == NANEBQ) then
          continue
        ELSEIF (ioff == NANEBO3) then
! Something is needed here if we are going to cycle O3-errors sensibly
! in the case of NBGVECS=0. (=not randomization).
! The zane computed here should reflect total o3 (bal+unbal), to be inflated
! in estsig, and then used in BGQC-checks in subsequent screening.
          continue
        else
          continue
        endif
      enddo
    enddo
    if (ioff == NANEBSP) then
      do jk=istc,iendc
        zane(jk,1+ioff)=zane(jk,NFLEVG+NANEBZ)&
         & *(FCEMN_DERIVED%PS/FCEMN_DERIVED%Z(NFLEVG))**2  
      enddo
    endif
  enddo
  call SC2WRG (ANEBUF,jkglo,istc,iendc,zane)
enddo MESSP_LOOP

IF (LHOOK) CALL DR_HOOK('ESTSIGA',1,ZHOOK_HANDLE)
end subroutine estsiga
