subroutine vec2gpfe (knumb,kstglo,pgp3jb,pgp2jb)

!*** *VEC2GPFE*

!   Purpose.
!   --------
!      To transform a control vector to grid point space and accumulate
!      sums of squares of gridpoint values

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

!      CALL VEC2GPFE

!   Explicit Arguments:
!                     knumb    - number of values in buffer
!                     kstglo   - indexing for buffer: global start
!                     pgp3jb   - gridpoint values of 3d fields
!                     pgp2jb   - gridpoint values of 2d fields

!   Implicit Arguments:
!                     fcebuf   - gridpoint buffer for background errors

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

!   Reference.
!   ----------
!      RD Tech Memo 220.

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

!   Modifications.
!   --------------
!      Original:     98/06/23 (Based on VEC2GP)
!        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 : NOFCEF, N_SPJB_VARS, SPJB_VARS_INFO
USE YOMFCEB  , ONLY : FCEBUF
USE YOMCVA   , ONLY : NVA3D, NVA2D

IMPLICIT NONE

!--- arguments

INTEGER(KIND=JPIM),INTENT(IN)    :: KNUMB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGP3JB(NPROMA,NFLEVG,NVA3D) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGP2JB(NPROMA,NVA2D) 
!--- locals

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

INTEGER(KIND=JPIM) :: ist, iend, istc, iendc, jlev, jrof, &
                    & IPTJB, JFIELD, IOFF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

!--- read buffer

ist   = 1
iend  = knumb
istc  = 1
iendc = knumb

call SC2RDG (FCEBUF,kstglo,istc,iendc,zfce)

!--- accumulate

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

  IF (SPJB_VARS_INFO(JFIELD)%L_IN_SPA2) THEN
!OCL NOVREC
    do jrof=ist,iend
      zfce(jrof,1+IOFF) = zfce(jrof,1+IOFF) + PGP2JB(jrof,IPTJB)**2
    enddo
  ELSE
    do jlev=1,NFLEVG
!OCL NOVREC
      do jrof=ist,iend
        zfce(jrof,jlev+IOFF) = &
             & zfce(jrof,jlev+IOFF) + PGP3JB(jrof,jlev,IPTJB)**2
      enddo
    enddo
  ENDIF
ENDDO


!--- write buffer

call SC2WRG (FCEBUF,kstglo,istc,iendc,zfce)

IF (LHOOK) CALL DR_HOOK('VEC2GPFE',1,ZHOOK_HANDLE)
end subroutine vec2gpfe
