!-------------------------------------- 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 --------------------------------------
!
!
!  X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X
!

      subroutine gdmaskh(pgd,knk) 5,1
!
!**s/r gdmaskh  - Multiplies a mask function to input field to bring field to zero close the walls.
!
!
!Author  : Luc Fillion  - EC - ARMA - 23 Mar 2006.
!Revision: Luc Fillion  - EC - ARMA - 11 Apr 2007 - Improve to apply to st-dev.
!
!     -------------------
!
!Arguments
!
      implicit none
!
#include "taglam4d.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcst.cdk"
#include "comgrd_param.cdk"
!
      integer knk
      real*8 pgd(ni,knk,nj)

      integer ji,jj,jk,ifois
      integer ibeg,iend,iin,iexp
      real*8 zbeg,zend,zrange,zvar,zpio2,zcscl,ztol
      real*8 zmask(ni,nj)
      data ifois/0/
      save ifois
!
!!
      zpio2 = rpi/2.
      ztol = 1.e-5
      iexp = 4
      iin = 10
!
      do jj=1,nj
        do ji=1,ni
          zmask(ji,jj) = 1.0
        enddo
      enddo
!
! West
      ibeg = 1
      zbeg = real(ibeg)
      iend = Glb_pil_o + iin
      zend = real(iend)
      zrange = abs(zend-zbeg)
!
      do jj=1,nj
        do ji=ibeg,iend
          zvar = real(ji)
          zmask(ji,jj)= zmask(ji,jj)
     &         * ( sin((zvar-zbeg)/zrange*zpio2)**iexp )
          if(zmask(ji,jj).le.ztol) zmask(ji,jj)=ztol
        enddo
      enddo
!
! East
      Ibeg = mni_in-Glb_pil_e-iin
      zbeg = real(ibeg)
      iend = ni
      zend = real(iend)
      zrange = abs(zend-zbeg)
!
      do jj=1,nj
        do ji=ibeg,iend
          zvar = real(ji)
          zmask(ji,jj)= zmask(ji,jj)
     &         * ( cos((zvar-zbeg)/zrange*zpio2)**iexp )
          if(zmask(ji,jj).le.ztol) zmask(ji,jj)=ztol
        enddo
      enddo
!
! South
      ibeg = 1
      zbeg = real(ibeg)
      iend = Glb_pil_s + iin
      zend = real(iend)
      zrange = abs(zend-zbeg)
!
      do ji=1,ni
        do jj=ibeg,iend
          zvar = real(jj)
          zmask(ji,jj)= zmask(ji,jj)
     &         * ( sin((zvar-zbeg)/zrange*zpio2)**iexp )
          if(zmask(ji,jj).le.ztol) zmask(ji,jj)=ztol
        enddo
      enddo
!
! North
      ibeg = mnj_in-Glb_pil_n-iin
      zbeg = real(ibeg)
      iend = nj
      zend = real(iend)
      zrange = abs(zend-zbeg)
!
      do ji=1,ni
        do jj=ibeg,iend
          zvar = real(jj)
          zmask(ji,jj)= zmask(ji,jj)
     &         * ( cos((zvar-zbeg)/zrange*zpio2)**iexp )
          if(zmask(ji,jj).le.ztol) zmask(ji,jj)=ztol
        enddo
      enddo
!
      if(ifois.eq.0) then
        call outhoriz2d(zmask,'mask.od     ','WG',1,
     &                  1,ni,1,nj,ni,nj,1)
      endif
!
! Apply mask
      do jk=1,knk
        do jj=1,nj
          do ji=1,ni
            pgd(ji,jk,jj) = zmask(ji,jj)*pgd(ji,jk,jj)
          enddo
        enddo
      enddo
!
      ifois = 1
!
      return
      end