SUBROUTINE SUMDFCE

!**** *SUMDFCE*  - CALCULATE HORIZONTAL PATTERN OF BACKGROUND ERROR

!     PURPOSE.
!     --------

!        CALCULATE THE HORIZONTAL PATTERN OF BACKGROUND ERROR, FGMWNE.
!        THE STANDARD DEVIATION OF BACKGROUND ERROR IS: FGMWNE*FCEMN

!**   INTERFACE.
!     ----------

!        *CALL* *SUMDFCE()*

!     METHOD.
!     -------

!     The pressure weighted vertical integral of the background errors is
!     calculated and then normalized so that its area weighted average is
!     one.

!     EXTERNALS.
!     ----------

!     REFERENCE.
!     ----------

!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------

!        W. HECKLEY    *ECMWF*

!     MODIFICATIONS.
!     --------------

!        Bill Heckley  15:10:91 - Use of MIOLIB for IO on fc error files
!        and Mats Hamrud
!        Bill Heckley  20:11:91 - largely re-written for efficiency
!        Bill Heckley  04:02:92 - Change record order on MIOfile and add
!                             provision for both height and temperature
!                             (both filled with height for the moment).
!        Bill Heckley  19:05:93 - Consistency between P and u,v cov.
!        Erik Andersson 15:06:94- Use the pattern of the level 18 height
!              sigma-b, normalize it, assign the magnitude at each
!              level as given from the covariance statistics, 
!        Mike Fisher 26:10:95 Use mass-weighted vertically averaged
!              variances instead of level 18 to specify the horizontal
!              pattern of sigma-b.
!        Lars Isaksen  05:05:96 - Adapted for Message Passing
!        Mike Fisher 01-08-96 - Weight vertical integral using FCEMN
!                               rather than pressure
!        Mike Fisher 19-12-96 - ZFACHR restricted to tropics
!        Mike Fisher 19-12-96 - Use GAW for grid box area
!        Mike Fisher 19-12-96 - Set FGMWNE constant if LCFCE==.t.
!        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 YOMCT0   , ONLY : NPROC
USE YOMDIM   , ONLY : NFLEVG   ,NPROMA
USE YOMGEM   , ONLY :    NGPTOT   ,NGPTOTG
USE YOMLUN   , ONLY : NULOUT
USE YOMJG    , ONLY : LCFCE    ,FCEMN3D    ,FGMWNE  ,NOFCEF, &
                    & SPJB_VARS_INFO, N_SPJB_VARS
USE YOMFCEB  , ONLY : FCEBUF
USE YOMGC    , ONLY : GAW
USE YOMGRB   , ONLY : NGRBVO
USE MPL_MODULE

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

IMPLICIT NONE

REAL(KIND=JPRB),TARGET  :: ZFCE   (NPROMA,NOFCEF)
REAL(KIND=JPRB),POINTER :: ZFCEVO (:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZFGMWNE(:)

INTEGER(KIND=JPIM) :: IENDC, IN, ISTC, IVAR, JK, JKGLO, JKT, JLEV, &
                    & IOFF, JFIELD, IPTJBVO

REAL(KIND=JPRB) :: ZDA, ZSUMA, ZSUMP, ZVAR
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

!*    0.2   Vertically integrate height or vorticity, and normalize it.
!           -----------------------------------------------------------

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

NULLIFY(ZFCEVO)

DO JFIELD=1,N_SPJB_VARS
  IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE_FCE == NGRBVO) THEN
    IOFF=SPJB_VARS_INFO(JFIELD)%IPTFCE-1
    ZFCEVO  => ZFCE(:,IOFF+1:IOFF+NFLEVG)
    EXIT
  ENDIF
ENDDO

IF (.NOT.ASSOCIATED(ZFCEVO)) THEN
  CALL ABOR1 ('FAILED TO ASSOCIATE POINTER ZFCEVO')
ENDIF

IVAR=3
ZSUMP=0.0_JPRB
ZSUMA=0.0_JPRB
IN=0

IF (LCFCE) THEN
  DO JKT=1,NGPTOT
    FGMWNE(JKT)=1.0_JPRB
  ENDDO
ELSE

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

  IF (IPTJBVO==HUGE(IPTJBVO)) THEN
    CALL ABOR1 ('BEHAVIOUR NOT DEFINED FOR VORTICITY NOT IN JB')
  ENDIF

!--- LOOP OVER LATITUDES

  MESSP_LOOP : DO JKGLO=1,NGPTOT,NPROMA
    ISTC=1
    IENDC=MIN(NPROMA,NGPTOT-JKGLO+1)
    CALL SC2RDG(FCEBUF,JKGLO,ISTC,IENDC,ZFCE)

!--- LOOP OVER NPROMA PACKAGE (Message Passing version)

    DO JK=ISTC,IENDC

!--- WEIGHTED SUM OVER LEVELS (Message Passing version)

      FGMWNE(JKGLO-1+JK) = 0.0_JPRB
      
      DO JLEV=1,NFLEVG
        ZVAR = (ZFCEVO(JK,JLEV)/FCEMN3D(JLEV,IPTJBVO))**2
        FGMWNE(JKGLO-1+JK) = FGMWNE(JKGLO-1+JK) + ZVAR
      ENDDO

!--- WEIGHT WITH GRIDBOX AREA

      ZDA   = GAW(JKGLO-1+JK)
      FGMWNE(JKGLO-1+JK) = FGMWNE(JKGLO-1+JK)*ZDA
      ZSUMA = ZSUMA + ZDA
    ENDDO
  ENDDO  MESSP_LOOP

!--- GATHER THE GLOBAL SUM OF AREA OVER ALL GRIDBOXES (SAFETY CHECK)

  IF (NPROC > 1) THEN
    CALL MPL_ALLREDUCE(ZSUMA,'SUM',LDREPROD=.FALSE.,CDSTRING='SUMDFCE:')
  ENDIF

  IF (ABS(ZSUMA-1.0_JPRB) > 1e-5_JPRB) THEN
    WRITE (NULOUT,*) 'ERROR IN SUMDFCE: GLOBAL SUM OF GAW<>1'
    CALL ABOR1 ('ERROR IN SUMDFCE: GLOBAL SUM OF GAW<>1')
  ENDIF

! NORMALIZE SO THAT FGMWNE BECOMES A HORIZONTAL INDEX OF FC ERROR
! THIS IS ONLY DONE FOR THIS PE'S GRID POINTS BASED ON THE GLOBAL ZSUM.

  IF (NPROC > 1) THEN
    ALLOCATE(ZFGMWNE(NGPTOTG))
    CALL GATHERBDY(FGMWNE,ZFGMWNE)
    ZSUMP = SUM (ZFGMWNE(1:NGPTOTG))
    DEALLOCATE(ZFGMWNE)
  ELSE
    ZSUMP = SUM (FGMWNE(1:NGPTOTG))
  ENDIF

  FGMWNE(:)=SQRT(FGMWNE(:)/GAW(:)/ZSUMP)
ENDIF

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

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