!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!

      SUBROUTINE sumvogz 1,3
#if defined (DOC)
*
***s/r sumvogz  - Get zonal means on latitudes of analysis grid and store in
*                 in GOMOBSG for ONEOBS and effective variances experiments
*
*Author  : C. Charette  *ARMA/AES - 20 nov 98
*Revision:
*          S. Pellerin *ARMA/SMC May 2000
*                   . Logical unit cleanup
*          JM Belanger CMDA/SMC  Jul 2000 
*                   . 32 bits conversion
*
*    -------------------
**    Purpose: Setup for Project Background statistics into observation space
*     .        using zonal means for background fields
*Arguments
*
#endif
      IMPLICIT NONE
*implicits
c------------------------------------------------------------------------
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comphy.cdk"
#include "commvog.cdk"
#include "com1obs.cdk"
#include "rpnstd.cdk"
#include "comlun.cdk"
c
      integer jk,IDATA,JDATA,ilen,ILAT,jlat,jlon,ikey
      REAL*8 ZBUFFER(NJ,NFLEV)
      POINTER (PXZBUFFER,ZBUFFER)

      integer vfstlir
      external vfstlir
*------------------------------------------------------------------
c
c READ IN ZONALLY AVERAGED MONTHLY MEAN FIELDS
c
      ILEN = NJ*NFLEV
      CALL HPALLOC(PXZBUFFER,MAX(1,ILEN),IERR,8)
*
*     2. Reading the data
*
      CLETIKET = 'MEAN'
      IDATE(1) = -1
      IP1      = -1
      IP2      = -1
      IP3      = -1
      CLTYPVAR =' '
c
      write(NULOUT,*)'reading TT'
      CLNOMVAR = 'TT'
      IKEY = VFSTLIR(ZBUFFER,NULSTAT,INI,INJ,INK,IDATE(1)
     S     ,CLETIKET,IP1,IP2,IP3,CLTYPVAR,CLNOMVAR)
c
c Fill in only latitudinally varying gomobsg for HBHT calculation
      if(NOBTOT.eq.NJ) then
        do jk=1,NFLEV
          IDATA=0
          DO jlat = 1, NJ
            IDATA=IDATA+1
            gomtg(jk,IDATA) = ZBUFFER(NJ-JLAT+1,NFLEV-JK+1) + TCDK
          END DO
        ENDDO
c Fill in 2D grid for ONEOBS stuff
      elseif(NOBTOT.eq.(NI*NJ)) then
        do jk=1,NFLEV
          IDATA=0
          do jlon=1,NI
            do jlat = 1, NJ
              IDATA=IDATA+1
              gomtg(jk,IDATA) = ZBUFFER(NJ-JLAT+1,NFLEV-JK+1) + TCDK
            enddo
          enddo
        ENDDO
c ELSE fill in entire gomobsg with profile at NI1OBSLA
      else
        do JK  =1,NFLEV
          ILAT=NI1OBSLA
          DO JDATA=1,NOBTOT
            gomtg(jk,jdata) = ZBUFFER(NJ-ILAT+1,NFLEV-JK+1) + TCDK
          enddo
        enddo
      endif
c
      write(NULOUT,*)'reading HU'
      CLNOMVAR = 'HU'
      IKEY = VFSTLIR(ZBUFFER,NULSTAT,INI,INJ,INK,IDATE(1)
     S     ,CLETIKET,IP1,IP2,IP3,CLTYPVAR,CLNOMVAR)
c
      if(NOBTOT.eq.NJ) then
        do jk=1,NFLEV
          IDATA=0
          DO jlat = 1, NJ
            IDATA=IDATA+1
            gomqg(jk,IDATA) = log(ZBUFFER(NJ-JLAT+1,NFLEV-JK+1))
          END DO
        ENDDO
      elseif(NOBTOT.eq.(NI*NJ)) then
        do jk=1,NFLEV
          IDATA=0
          do jlon=1,NI
            do jlat = 1, NJ
              IDATA=IDATA+1
              gomqg(jk,IDATA) = log(ZBUFFER(NJ-JLAT+1,NFLEV-JK+1))
            enddo
          enddo
        enddo
      else
        do jk=1,NFLEV
          ILAT=NI1OBSLA
          do jdata=1,NOBTOT
            gomqg(jk,jdata) = log(ZBUFFER(NJ-ILAT+1,NFLEV-JK+1))
          enddo
        enddo
      endif
c
      write(NULOUT,*)'reading P0'
      CLNOMVAR = 'P0'
      IKEY = VFSTLIR(ZBUFFER,NULSTAT,INI,INJ,INK,IDATE(1)
     S     ,CLETIKET,IP1,IP2,IP3,CLTYPVAR,CLNOMVAR)
c
      if(NOBTOT.eq.NJ) then
        IDATA=0
        DO jlat = 1, NJ
          IDATA=IDATA+1
          gompsg(1,IDATA) = ZBUFFER(NJ-JLAT+1,1)*100.0
        ENDDO
      elseif(NOBTOT.eq.(NI*NJ)) then
        IDATA=0
        do jlon=1,NI
          do jlat = 1, NJ
            IDATA=IDATA+1
            gompsg(1,IDATA) = ZBUFFER(NJ-JLAT+1,1)*100.0
          enddo
        enddo
      else
        ILAT=NI1OBSLA
        DO JDATA=1,NOBTOT
          gompsg(1,JDATA) = ZBUFFER(NJ-ILAT+1,1)*100.0
        enddo
      endif
c
      DO JDATA=1,NOBTOT
        do jk=1,NFLEV
          gomug(jk,jdata)=0.0
          gomvg(jk,jdata)=0.0
        enddo
      enddo
c
      return
      end