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

      subroutine mach2(pgd,kni,knj,knip,knjp) 10,2
*
*Author: Luc Fillion - 29 Nov 2004.
!
!revision: Luc Fillion/Jean-Francois Caron - 20 Feb 2008 - Correct a bug ii point where derivatives are taken
!         (idem for J-direction). These points are now constrained to be the non-extended dimensions of the analysis grid.
! Luc Fillion ARMA/EC - May 2010 - More printout in case of problems.
! Arguments:
!      kni   ! Maximum I-dimension where the input array is assumed to carry information.
!              Will be used as I-limit where backward derivatives will be evaluated
!      knj   ! Maximum J-dimension where the input array is assumed to carry information.
!              Will be used as J-limit where backward derivatives will be evaluated
!      knip  ! Number of points where periodicity is desired in I-direction.
!      knjp  ! Number of points where periodicity is desired in J-direction.
*           
*
      IMPLICIT NONE
*implicits
#include "taglam4d.cdk"
#include "comct0.cdk"
#include "comlun.cdk"
#include "comdim.cdk"
#include "comcst.cdk"
#include "comgrd_param.cdk"
#include "comgrd.cdk"
*
      integer kni,knj,knip,knjp
      real*8 pgd(kni,knj)
!
      integer ji,jj,ii,ij,inip,injp
      real*8 zcon,zxp,za0,za1,zb1,zb2
      real*8 zderiv_ii, zderiv_ij, zderiv_0, zdel
!
!!
! x-direction
      ii=mni_mach   ! I-limit where backward derivatives will be evaluated
      if(knip.lt.kni) then
         write(nulout,*) 'mach2: mni_mach, mnj_mach =',mni_mach, mnj_mach
         write(nulout,*) 'mach2: kni,knip = ',kni,knip  
        call abort3d(nulout,'MACH2: knip LT kni !!!!!')
      endif
      zcon=1./(grd_dx*111.e3)
!
      if(kni.gt.1) then
        do jj=1,knj
          za0=0.5*(pgd(ii,jj)+pgd(1,jj))
          za1=0.5*(pgd(ii,jj)-pgd(1,jj))
          zderiv_ii = zcon*(pgd(ii,jj)-pgd(ii-1,jj))
          zderiv_0 = zcon*(pgd(2,jj)-pgd(1,jj))
          zb1 = 0.5 * ( zderiv_ii - zderiv_0 )
          zb2 = 0.25 * (  zderiv_ii + zderiv_0 )
!
          zdel= real(knip-ii)
          do ji=ii,kni
            zxp=rpi*real(ji-ii)/zdel
            pgd(ji,jj)=za0+za1*cos(zxp)+zb1*sin(zxp)+zb2*sin(2.*zxp)
          enddo
        enddo
      endif
!
! y-direction
!
      ij=mnj_mach
      if(knjp.lt.knj) then
        call abort3d(nulout,'MACH2: knjp LT knj !!!!!')
      endif
      zcon=1./(grd_dy*111.e3)
!
      if(knj.gt.1) then
        do ji=1,kni
          za0=0.5*(pgd(ji,ij)+pgd(ji,1))
          za1=0.5*(pgd(ji,ij)-pgd(ji,1))
          zderiv_ij = zcon*(pgd(ji,ij)-pgd(ji,ij-1))
          zderiv_0 = zcon*(pgd(ji,2)-pgd(ji,1))
          zb1 = 0.5 * ( zderiv_ij - zderiv_0 )
          zb2 = 0.25 * (  zderiv_ij + zderiv_0 )
!
          zdel= real(knjp-ij)
          do jj=ij,knj
            zxp=rpi*real(jj-ij)/zdel
            pgd(ji,jj)=za0+za1*cos(zxp)+zb1*sin(zxp)+zb2*sin(2.*zxp)
          enddo
        enddo
      endif
!
      return
      end