subroutine vec2gp (cdconf,knumb,kstglo,&
 & pu ,pv ,pt ,pq ,pvor ,po3 ,pgfl,psp,&
 & pu5,pv5,pt5,pq5,po35,pgfl5,psp5,&
 & porog,pgelat,ppertts)

!*** *VEC2GP*

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

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

!      CALL VEC2GP

!   Explicit Arguments:
!                     cdconf   - 'A' => add squares of gridpoint values
!                                'B' => subtract squares of point values
!                     knumb    - number of values in buffer
!                     kstglo   - indexing for buffer: global start
!                     pu       - gridpoint values of zonal wind
!                     pv       - gridpoint values of meridional wind
!                     pt       - gridpoint values of temperature
!                     pq       - gridpoint values of relative humidity
!                     pvor     - gridpoint values of vorticity
!                     po3      - gridpoint values of ozone
!                     pgfl     - gridpoint values of GFL variables
!                     psp      - gridpoint values of LNSP
!                     porog    - gridpoint values of orography
!                     ppertts  - gridpoint values of Ts perturpations
!                     pgelat   - gridpoint values of latitude
!                     pxx5     - gridpoint trajectory values

!   Implicit Arguments:
!                     anebuf   - gridpoint buffer for analysis errors

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

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

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

!   Modifications.
!   --------------
!      Original:     95/11/95
!      M. Fisher:    96/03/25 - Moved under STEPO
!      M. Fisher:    96/07/09 - Included vorticity
!      E. Andersson  98/06/04 - Radiance and tcw Bg Errors and BgQC
!      P.Viterbo     99/09/01 - Surface tiles
!      Y.Tremolet    00/08/15 - Module TRAJECTORY
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        G. Desroziers 16-Mar-2006 No computation for surface variables if LECMWF=.F.
!        A. Dethof     17-Nov-2008 LOGNOX JB

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVG   ,NPROMA
USE YOMCT0B  , ONLY : LECMWF
USE YOMVAR   , ONLY : NOANEF   ,&
 & LBGOBS  
USE YOMANEB  , ONLY : NANEBU   ,NANEBV   ,NANEBZ   ,NANEBR ,&
 & NANEBQ   ,NANEBT   ,NANEBVO  ,NANEBSP  ,ANEBUF   ,&
 & NANEBRAD ,NANEBTCW ,NANEBO3  ,NANEBTO3 ,&
 & NANEBRH2 ,NANEBU10 ,NANEBV10 ,NANEBT2  ,NANERADS ,&
 & NANERADL ,NANEBGHG ,NANEBGRG, NANEBAERO
USE SURFACE_FIELDS_MIX , ONLY :  &
 & YSP_SBD, YSP_SB, YSP_SGD, YSP_SG, &
 & YSP_RRD, YSP_RR, YSD_VFD, YSD_VF
USE YOEVDF   , ONLY : NVTYPES
USE YOMCT3   , ONLY : NSTEP

USE TRAJECTORY_MOD, ONLY: GET_TRAJ_SFC
USE YOMJG , ONLY : SPJB_VARS_INFO, NAEROCV, JPAEROCV
USE YOMGRB , ONLY : NGRBO3, NGRBGHG, NGRBGRG, NGRBAERLG, NGRBNOXLOG
USE YOM_YGFL , ONLY : YGFL, JPGHG, NGHG, JPGRG, NGRG, YGHG, NAERO

IMPLICIT NONE

!--- arguments

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNUMB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PU(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PV(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVOR(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PO3(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGFL(NPROMA,NFLEVG,YGFL%NDIM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSP(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PU5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PV5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PO35(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGFL5(NPROMA,NFLEVG,YGFL%NDIM5) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSP5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGELAT(NPROMA)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PPERTTS(NPROMA) 
!--- locals

REAL(KIND=JPRB), DIMENSION(NPROMA,NFLEVG)  ::ZUPP,ZVPP,ZTPP,ZRPP,ZQPP,ZZPP,ZO3PP
REAL(KIND=JPRB), DIMENSION(NPROMA,NFLEVG,MAX(1,NGHG))  ::ZGHGPP
REAL(KIND=JPRB), DIMENSION(NPROMA,NFLEVG,MAX(1,NGRG))  ::ZGRGPP
REAL(KIND=JPRB), DIMENSION(NPROMA,NFLEVG,MAX(1,NAEROCV)) ::ZAEROPP
REAL(KIND=JPRB), DIMENSION(NPROMA)         ::ZTCW,ZRH2M,ZU10M,ZV10M,ZT2M,ZTO3,ZCI,ZVEG
REAL(KIND=JPRB), DIMENSION(NPROMA,NANERADS) :: ZRADM
INTEGER(KIND=JPIM) :: ICH(NANERADS)
REAL(KIND=JPRB),TARGET  :: zane   (NPROMA,NOANEF)
REAL(KIND=JPRB),POINTER :: zaneu  (:,:)
REAL(KIND=JPRB),POINTER :: zanev  (:,:)
REAL(KIND=JPRB),POINTER :: zanez  (:,:)
REAL(KIND=JPRB),POINTER :: zaner  (:,:)
REAL(KIND=JPRB),POINTER :: zaneq  (:,:)
REAL(KIND=JPRB),POINTER :: zanet  (:,:)
REAL(KIND=JPRB),POINTER :: zanevor(:,:)
REAL(KIND=JPRB),POINTER :: zaneo3 (:,:)
REAL(KIND=JPRB),POINTER :: zanerad(:,:)
REAL(KIND=JPRB),POINTER :: zanetcw(:)
REAL(KIND=JPRB),POINTER :: zaneto3(:)
REAL(KIND=JPRB),POINTER :: zanerh2(:)
REAL(KIND=JPRB),POINTER :: zaneu10(:)
REAL(KIND=JPRB),POINTER :: zanev10(:)
REAL(KIND=JPRB),POINTER :: zanet2 (:)
REAL(KIND=JPRB),POINTER :: zanesp (:)
REAL(KIND=JPRB) :: ZSP_SB5(NPROMA,YSP_SBD%NLEVS,YSP_SBD%NDIM5)
REAL(KIND=JPRB) :: ZSP_SG5(NPROMA,YSP_SGD%NDIM5)
REAL(KIND=JPRB) :: ZSP_RR5(NPROMA,YSP_RRD%NDIM5)
REAL(KIND=JPRB) :: ZSD_VF5(NPROMA,YSD_VFD%NDIM5)

TYPE TYPE_ZANEGEMS
  REAL(KIND=JPRB), POINTER :: ZANE(:,:) 
END TYPE TYPE_ZANEGEMS
TYPE(TYPE_ZANEGEMS) :: ylaneghg(nghg)
TYPE(TYPE_ZANEGEMS) :: ylanegrg(ngrg)
TYPE(TYPE_ZANEGEMS) :: ylaneaero(naerocv)

INTEGER(KIND=JPIM) :: ist,iend,istc,iendc,ILEN,IAREA,ISOBT,INRCH &
 & ,jlev,jrof,jch,iblk  
REAL(KIND=JPRB) :: zsign,ZRTFREEZSICE,ZRVCOV(0:NVTYPES)
LOGICAL :: LLO3JB
INTEGER(KIND=JPIM) :: JGHG, IGHG, JGRG, IGRG, JAERO, IAERO
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE
#include "surf_inq.h"
END INTERFACE
#include "bgobs.intfb.h"
#include "sc2rdg.intfb.h"
#include "sc2wrg.intfb.h"
#include "sigam.intfb.h"

!--- point pointers at zane

IF (LHOOK) CALL DR_HOOK('VEC2GP',0,ZHOOK_HANDLE)
LLO3JB=ANY(SPJB_VARS_INFO(:)%IGRIBCODE==NGRBO3)

CALL SURF_INQ(PRTFREEZSICE=ZRTFREEZSICE,PRVCOV=ZRVCOV)

zaneu  => zane(:,NANEBU +1 : NANEBU +NFLEVG)
zanev  => zane(:,NANEBV +1 : NANEBV +NFLEVG)
zanez  => zane(:,NANEBZ +1 : NANEBZ +NFLEVG)
zaneq  => zane(:,NANEBQ +1 : NANEBQ +NFLEVG)
zanet  => zane(:,NANEBT +1 : NANEBT +NFLEVG)
zanevor=> zane(:,NANEBVO+1 : NANEBVO+NFLEVG)
zanesp => zane(:,NANEBSP+1)
IF(LBGOBS) THEN
  zanerad=> zane(:,NANEBRAD+1: NANEBRAD+NANERADS)
  zaner  => zane(:,NANEBR +1 : NANEBR +NFLEVG)
  zanetcw=> zane(:,NANEBTCW+1)
  zanerh2=> zane(:,NANEBRH2+1)
  zaneu10=> zane(:,NANEBU10+1)
  zanev10=> zane(:,NANEBV10+1)
  zanet2 => zane(:,NANEBT2 +1)
ENDIF
IF(LLO3JB) zaneo3 => zane(:,NANEBO3+1 : NANEBO3+NFLEVG)
IF(LLO3JB.AND. LBGOBS)  zaneto3=> zane(:,NANEBTO3+1)
IF(NGHG > 0) THEN
  IGHG=0
  DO JGHG=1,JPGHG
    IF(ANY(SPJB_VARS_INFO(:)%IGRIBCODE==NGRBGHG(JGHG))) THEN
      IGHG=IGHG+1
      ylaneghg(IGHG)%zane => zane(:,NANEBGHG(IGHG)+1 : NANEBGHG(IGHG)+NFLEVG)
    ENDIF
  ENDDO
ENDIF
IF(NGRG > 0) THEN
  IGRG=0
  DO JGRG=1,JPGRG
    IF(ANY(SPJB_VARS_INFO(:)%IGRIBCODE==NGRBGRG(JGRG))) THEN
      IGRG=IGRG+1
      ylanegrg(IGRG)%zane => zane(:,NANEBGRG(IGRG)+1 : NANEBGRG(IGRG)+NFLEVG)
    ENDIF
  ENDDO
ENDIF

IF(NAEROCV > 0) THEN
  IAERO=0
  DO JAERO=1,JPAEROCV
    IF(ANY(SPJB_VARS_INFO(:)%IGRIBCODE== NGRBAERLG )) THEN
      IAERO=IAERO+1
      ylaneaero(IAERO)%zane => zane(:,NANEBAERO(IAERO)+1 : NANEBAERO(IAERO)+NFLEVG)
    ENDIF
  ENDDO
ENDIF

!--- decide whether to add or subtract squares

if (cdconf == 'A') then
  zsign =  1.0_JPRB
else
  zsign = -1.0_JPRB
endif

!--- read analysis error buffer

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

call SC2RDG (ANEBUF,kstglo,istc,iendc,zane)

!--- read surface fields

iblk=(kstglo-1)/NPROMA+1
CALL GET_TRAJ_SFC(NSTEP,IBLK,IST,IEND,&
 & PSP_SB=ZSP_SB5,PSP_SG=ZSP_SG5,PSP_RR=ZSP_RR5,PSD_VF=ZSD_VF5)

!--- calculate observed quantites, at g.p.
!--- prepare request of a number of tovs channels and channel numbers

ILEN=1+iend-ist
IF(LBGOBS) THEN
  IAREA=1
  ISOBT=1
  INRCH =NANERADS
  ICH(:)=NANERADL(:)
  DO JROF=IST,IEND
    IF (LECMWF) THEN
      ZCI(JROF)=ZSD_VF5(1,YSD_VF%YCI%MP5)
      ZVEG(JROF)=&
       & ZSD_VF5(JROF,YSD_VF%YCVH%MP5)*ZRVCOV(NINT(ZSD_VF5(JROF,YSD_VF%YTVH%MP5)))+&
       & ZSD_VF5(JROF,YSD_VF%YCVL%MP5)*ZRVCOV(NINT(ZSD_VF5(JROF,YSD_VF%YTVL%MP5)))  
    ELSE
      ZVEG(JROF)=ZSD_VF5(1,YSD_VF%YVEG%MP5)
      IF (ZSP_RR5(JROF,YSP_RR%YT%MP5) < ZRTFREEZSICE) THEN
        ZCI(JROF)=1.
      ELSE
        ZCI(JROF)=0.
      ENDIF
    ENDIF
  ENDDO
  ZRADM(:,:)=0.0_JPRB              ! BGOBS might not perform Radiance calc.
  call BGOBS(cdconf,ILEN,ICH,INRCH,POROG,PGELAT,&
   & ZSD_VF5(ist,YSD_VF%YLSM%MP5),ZSP_RR5(ist,YSP_RR%YT%MP5),ZSP_SB5(ist,1,YSP_SB%YQ%MP5),&
   & ZSP_SG5(1,YSP_SG%YF%MP5),ZSD_VF5(ist,YSD_VF%YZ0F%MP5),ZVEG ,ZCI,&
   & PU(ist,1),PV(ist,1),PT(ist,1),&
   & PQ(ist,1) ,PO3(ist,1),PGFL(ist,1,1),PSP(ist),PPERTTS(ist),&
   & PU5(ist,1),PV5(ist,1),PT5(ist,1),&
   & PQ5(ist,1),PO35(ist,1),PGFL5(ist,1,1),PSP5(ist),&
   & ZUPP(ist,1),ZVPP(ist,1),ZTPP(ist,1),&
   & ZRPP(ist,1),ZQPP(ist,1),ZO3PP(ist,1),ZGHGPP(ist,1,1),ZGRGPP(ist,1,1),ZAEROPP(ist,1,1),&
   & ZRADM(ist,1),ZZPP(ist,1),ZTCW(ist),ZTO3(ist),&
   & ZRH2M(ist),ZU10M(ist),ZV10M(ist),ZT2M(ist))  
ELSE
!--- calculate linearized geopotential
  call SIGAM(NPROMA,1,ZZPP(ist,1),pt(ist,1),psp(ist),ILEN)
  do jlev=1,NFLEVG
    do jrof=ist,iend
      ZUPP(jrof,jlev)=pu(jrof,jlev)
      ZVPP(jrof,jlev)=pv(jrof,jlev)
      ZTPP(jrof,jlev)=pt(jrof,jlev)
      ZQPP(jrof,jlev)=pq(jrof,jlev)
      IF(LLO3JB) ZO3PP(jrof,jlev)=po3(jrof,jlev)
      DO IGHG=1,NGHG
        ZGHGPP(jrof,jlev,IGHG)=0.0 !stj  NEEDS PROPER VALUES
      ENDDO
      DO IAERO=1,NAEROCV
        ZAEROPP(jrof,jlev,IAERO)=0.0 !stj  NEEDS PROPER VALUES
      ENDDO
      DO IGRG=1,NGRG
        ZGRGPP(jrof,jlev,IGRG)=0.0 !std  NEEDS PROPER VALUES
      ENDDO
    enddo
  enddo
ENDIF

!--- accumulate model upper air variances

do jlev=1,NFLEVG
!OCL NOALIAS
  do jrof=ist,iend
    zaneu  (jrof,jlev) = zaneu(jrof,jlev)+zsign*ZUPP(jrof,jlev)**2
    zanev  (jrof,jlev) = zanev(jrof,jlev)+zsign*ZVPP(jrof,jlev)**2
    zanet  (jrof,jlev) = zanet(jrof,jlev)+zsign*ZTPP(jrof,jlev)**2
    zanez  (jrof,jlev) = zanez(jrof,jlev)+zsign*ZZPP(jrof,jlev)**2
    IF(LBGOBS) zaner  (jrof,jlev) = zaner(jrof,jlev)+zsign*ZRPP(jrof,jlev)**2
    zaneq  (jrof,jlev) = zaneq(jrof,jlev)+zsign*ZQPP(jrof,jlev)**2
    zanevor(jrof,jlev) = zanevor(jrof,jlev)+zsign*pvor(jrof,jlev)**2
    IF(LECMWF.AND.LLO3JB) zaneo3(jrof,jlev) = zaneo3(jrof,jlev)+zsign*ZO3PP(jrof,jlev)**2
    DO IGHG=1,NGHG
      ylaneghg(ighg)%zane(jrof,jlev) = ylaneghg(ighg)%zane(jrof,jlev)+zsign*ZGHGPP(jrof,jlev,IGHG)**2
    ENDDO
    DO IGRG=1,NGRG
      IF(NGRBGRG(IGRG) == NGRBNOXLOG) THEN
        ylanegrg(igrg)%zane(jrof,jlev) = ylanegrg(igrg)%zane(jrof,jlev)+zsign*ZGRGPP(jrof,jlev,IGRG)
      ELSE 
        ylanegrg(igrg)%zane(jrof,jlev) = ylanegrg(igrg)%zane(jrof,jlev)+zsign*ZGRGPP(jrof,jlev,IGRG)**2
      ENDIF
    ENDDO
    DO IAERO=1,NAEROCV
      ylaneaero(iaero)%zane(jrof,jlev) = ylaneaero(iaero)%zane(jrof,jlev)+zsign*ZAEROPP(jrof,jlev,IAERO)**2
    ENDDO
  enddo
enddo

!--- accumulate tovs radiance variances

IF(LBGOBS) THEN
  do jch=1,NANERADS
!OCL NOALIAS
    do jrof=ist,iend
      zanerad(jrof,jch) = zanerad(jrof,jch)+zsign*ZRADM(jrof,jch)**2
    enddo
  enddo
ENDIF

!--- accumulate model surface variances

!OCL NOALIAS
do jrof=ist,iend
  zanesp(jrof)  = zanesp(jrof)  + zsign*psp(jrof)**2
  IF(LBGOBS.AND.LECMWF) THEN
    zanetcw(jrof) = zanetcw(jrof) + zsign*ZTCW(jrof)**2
    zanerh2(jrof) = zanerh2(jrof) + zsign*ZRH2M(jrof)**2
    zaneu10(jrof) = zaneu10(jrof) + zsign*ZU10M(jrof)**2
    zanev10(jrof) = zanev10(jrof) + zsign*ZV10M(jrof)**2
    zanet2 (jrof) = zanet2 (jrof) + zsign*ZT2M(jrof)**2
    IF(LLO3JB) zaneto3(jrof) = zaneto3(jrof) + zsign*ZTO3(jrof)**2
  ENDIF
enddo

!--- write buffer

call SC2WRG (ANEBUF,kstglo,istc,iendc,zane)

IF (LHOOK) CALL DR_HOOK('VEC2GP',1,ZHOOK_HANDLE)
end subroutine vec2gp
