SUBROUTINE SUSEPFCE (KNUMB,KSTGLO,PGM,PFGMWNE)

!      SUSEPFCE - Modifies the background errors to have a prescribed
!                 global mean profile and (optionally) to be seperable.

!     Arguments :
!     -----------
!     Input:
!       KNUMB - number of elements for which computations
!               are performed (used in message passing version)
!       KSTGLO - global offset
!       PGM    - map factor
!       PFGMWNE - horizontal pattern of background error

!     Implicit output:
!       Background errors

!     Author:  M.Fisher  *ECMWF*
!     -------

!     Modifications:
!     --------------
!       E. Holm   : 97-11-28 Included ozone
!        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 YOMJG    , ONLY : L3DBGERR ,FCEMN3D  ,FCEMN2D, FCEIMN   ,NOFCEF   ,&
                    & LRDQERR, SPJB_VARS_INFO, N_SPJB_VARS
USE YOMFCEB  , ONLY : FCEBUF
USE YOMGRB   , ONLY : NGRBVO, NGRBD, NGRBQ

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KNUMB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFGMWNE(NPROMA) 
REAL(KIND=JPRB) :: ZFCE   (NPROMA,NOFCEF)

INTEGER(KIND=JPIM) :: IEND, IENDC, IST, ISTC, JLEV, JFIELD, IOFF, IPTJB
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

IF (LHOOK) CALL DR_HOOK('SUSEPFCE',0,ZHOOK_HANDLE)
IST   = 1
IEND  = KNUMB
ISTC  = 1
IENDC = KNUMB

CALL SC2RDG(FCEBUF,KSTGLO,ISTC,IENDC,ZFCE)

!     *    1.    Separation of Background Errors
!                (NB: Humidity errors are never separated)

DO JFIELD=1,N_SPJB_VARS
  IOFF  = SPJB_VARS_INFO(JFIELD)%IPTFCE-1
  IPTJB = SPJB_VARS_INFO(JFIELD)%IPTJB

  IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE == NGRBQ) THEN
    IF (LRDQERR) THEN
      DO JLEV=1,NFLEVG
        ZFCE(IST:IEND,JLEV+IOFF) = ZFCE(IST:IEND,JLEV+IOFF)&
         & *FCEMN3D(JLEV,IPTJB)/FCEIMN(JLEV+IOFF)  
      ENDDO
    ENDIF
  ELSEIF (L3DBGERR) THEN
    IF (SPJB_VARS_INFO(JFIELD)%L_IN_SPA2) THEN
      ZFCE(IST:IEND,1+IOFF) = &
             & ZFCE(IST:IEND,1+IOFF)*FCEMN2D(IPTJB)/FCEIMN(1+IOFF)
    ELSE
      DO JLEV=1,NFLEVG
        ZFCE(IST:IEND,JLEV+IOFF) = ZFCE(IST:IEND,JLEV+IOFF)&
         & *FCEMN3D(JLEV,IPTJB)/FCEIMN(JLEV+IOFF)  
      ENDDO
    ENDIF
  ELSE
    IF (SPJB_VARS_INFO(JFIELD)%L_IN_SPA2) THEN
      ZFCE(IST:IEND,1+IOFF) = PFGMWNE(IST:IEND)*FCEMN2D(IPTJB)
    ELSE
      DO JLEV=1,NFLEVG
        ZFCE(IST:IEND,JLEV+IOFF) = PFGMWNE(IST:IEND)*FCEMN3D(JLEV,IPTJB)
      ENDDO
    ENDIF
  ENDIF

!*    2.    Map Factor

  IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE == NGRBVO .OR. &
    & SPJB_VARS_INFO(JFIELD)%IGRIBCODE == NGRBD ) THEN
    DO JLEV=1,NFLEVG
      ZFCE(IST:IEND,JLEV+IOFF) = ZFCE(IST:IEND,JLEV+IOFF)/PGM(IST:IEND)**2
    ENDDO
  ENDIF
ENDDO

CALL SC2WRG(FCEBUF,KSTGLO,ISTC,IENDC,ZFCE)

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

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