!-------------------------------------- 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 gdtruncr(pgd,psp,cdtype,ktrunc,cdpart,ldspec,knk) 39,8
!
!s/r gdtruncr: Filter grid-point array using RPN 2D-FFT according to a given truncation type.
!
! AUTHOR: Luc Fillion - MSC/CAN - 20 Apr 2005.
! Revision: Luc Fillion - EC/CAN - 29 oct 2007. - Allow low or high wvnb filtering via cdpart.
! Revision: Luc Fillion - EC/CAN - 25 Feb 2009. - Allow low and high wvnb filtering at the same time.
! Revision: Luc Fillion - EC/CAN - 25 Feb 2009. - Add ldspec to directly filter input spectral array psp.
! IN/OUT:
!   psp:
! IN:
!   cdtype: Truncation type: 'T': triangular; 'E': Elliptic
!   cdpart: Truncation region: 'L': low; 'H': high; '2': Low&High wavenumber filtering.
!
      IMPLICIT  NONE
#include "taglam4d.cdk"
#include "comdim.cdk"
#include "comfftla.cdk"
#include "comsp.cdk"
#include "comgrd_param.cdk"
!
      logical ldspec
      integer knk,ktrunc
      character*1 cdtype
      character*1 cdpart
      real*8 pgd(nila,knk,njla)
      real*8 psp(nla,2,knk)
!
      integer ji,jj,jla,jk,jlon,jlat,itop
      integer itrunc(knk)
      real*8 zfmla(nila,njla)
      real*8 zgdxy(nila,njla)
      real*8 zsp(nla,2)
!
!!
      do jk = 1, knk
        itrunc(jk) = ktrunc
      enddo
!
      do jk = 1, knk
        if(ldspec) then
          do jla = 1,nla
            zsp(jla,1) = psp(jla,1,jk)
            zsp(jla,2) = psp(jla,2,jk)
          enddo
        else
          do jlat = 1, njla
            do jlon = 1, nila
              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,nila,njla,1)
          endif
        endif
!
        if(cdpart.eq.'2') then
          call sptruncr(zsp,cdtype,ktrunc,'H',1) ! high wvnb part
          call sptruncr(zsp,cdtype,5,'L',1) ! Low wvnb part
        else
          call sptruncr(zsp,cdtype,itrunc(jk),cdpart,1)
        endif
!
        if(ldspec) then
          do jla = 1,nla
            psp(jla,1,jk) = zsp(jla,1)
            psp(jla,2,jk) = zsp(jla,2)
          enddo
        else
          if(lrpnfft) then
            call zero(nila*njla,zgdxy)
            call idft2dr(zgdxy,zsp)
            do jj=1,njla
              do ji=1,nila
                pgd(ji,jk,jj) = zgdxy(ji,jj)
              enddo
            enddo
          else
            call idft2d(zfmla,zsp,sdft2d,nindxy,1,
     &                  mlen2d,nla,nila,njla,1)
            do jj=1,njla
              do ji=1,nila
                pgd(ji,jk,jj) = zfmla(ji,jj)
              enddo
            enddo
          endif
        endif
      enddo
!
      return
      end