!-------------------------------------- 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 setmean(pgd,kmean,knk) 1,5
!
!s/r setmean: Set horizontal mean of input field.
!
! Author: Luc Fillion - EC/CAN - 15 oct 2008
! IN/OUT:
!   psp:
! IN:
!   kmean: User defined mean to use.
!
      IMPLICIT  NONE
#include "taglam4d.cdk"
#include "comdim.cdk"
#include "comfftla.cdk"
#include "comsp.cdk"
      integer knk,kmean
      real*8 pgd(ni,knk,nj)
!
      integer ji,jj,jla,jk,jlon,jlat,itop,imax,ival
      integer jband,ila,jm
      real*8 zfmla(ni,nj)
      real*8 zgdxy(ni,nj)
      real*8 zsp(nla,2)
!
!!
      do jk = 1, knk
        do jlat = 1, nj
          do jlon = 1, ni
            zfmla(jlon,jlat) = pgd(jlon,jk,jlat)
            zgdxy(jlon,jlat) = pgd(jlon,jk,jlat)
          end do
        end do
        if(lrpnfft) then
          call dft2dr(zsp(1,1),zgdxy)
        else
          call dft2d(zsp,zfmla,sdft2d,nindxy,mlen2d,
     &               1,nla,ni,nj,1)
        endif
!
        do jband = 1, 1
          do jm = 1, mbandsp(jband)
            ila = mila(jm,jband)
            zsp(ila,1)=kmean
            zsp(ila,2)=0.0
          enddo
        enddo
!
        if(lrpnfft) then
          call zero(ni*nj,zgdxy)
          call idft2dr(zgdxy,zsp)
          do jj=1,nj
            do ji=1,ni
              pgd(ji,jk,jj) = zgdxy(ji,jj)
            enddo
          enddo
        else
          call idft2d(zfmla,zsp,sdft2d,nindxy,1,
     &                mlen2d,nla,ni,nj,1)
          do jj=1,nj
            do ji=1,ni
              pgd(ji,jk,jj) = zfmla(ji,jj)
            enddo
          enddo
        endif
      enddo
!
      return
      end