!-------------------------------------- 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 alinbal_la(pgdpsi,pgz,ldfplane,ldcoriol_one,cdpsigrd) 4,3
!
!**s/r alinbal_la  - Adjoint of linbal_la.ftn.
!
!Author  : Luc Fillion  - MSC- 20 Jan 2006.
!Revision: Luc Fillion - ARMA/EC - 2 Dec 2008 - Add cdpsigrd.
!Revision: Luc Fillion - ARMA/EC - 5 Mar 2009 - Add ldcoriol_one.
!
!     -------------------
!
!Arguments
!
      IMPLICIT NONE
!
#include "taglam4d.cdk"
#include "pardim.cdk"
#include "comgrd_param.cdk"
#include "comdim.cdk"
#include "comcst.cdk"
#include "comgemla.cdk"
#include "comgrd.cdk"
!
      character*1 cdpsigrd
      logical ldfplane,ldcoriol_one
      real*8 pgdpsi(ni,nflev,nj)
      real*8 pgz(ni,nflev,nj)
!
      logical llprint
      integer ji,jj,jk,nij,nijk
      real*8 zmean,zcoriol
!
      real*8 z2d(ni,nj)
      real*8 zdx(-1:ni+2,-1:nj+2)
      real*8 zdy(-1:ni+2,-1:nj+2)
!
!!
      llprint = .false.
      zcoriol=2.*romega
!
      nij=ni*nj
      nijk=ni*nj*nflev
!
!
      if(ldfplane) then
!
! adjoint of: f * Lap(PSI): Result on 'S' grid
!             --------------------------------
!
        do jk=1,nflev
!
          call zero(ni*nj,z2d)
          if(ldcoriol_one) then
            do ji=1,ni
            do jj=1,nj
              z2d(ji,jj) = pgz(ji,jk,jj)
            enddo
            enddo
          else
            do ji=1,ni
            do jj=1,nj
!              z2d(ji,jj) = zcoriol*pgz(ji,jk,jj)
              z2d(ji,jj) = coriol(ji,jj)*pgz(ji,jk,jj)
            enddo
            enddo
         endif
!
          call zero((ni+4)*(nj+4),zdx)
!
! Adjoint of: Interpolate from 'P' to 'S' grid
!
          if(cdpsigrd.eq.'P') then
            do jj = nj, 1, -1
            do ji = ni, 1, -1
              zdx(ji-1,jj-1) = zdx(ji-1,jj-1)+z2d(ji,jj)*0.25
              zdx(ji-1,jj) = zdx(ji-1,jj)+z2d(ji,jj)*0.25
              zdx(ji,jj) = zdx(ji,jj)+z2d(ji,jj)*0.25
              zdx(ji,jj-1) = zdx(ji,jj-1)+z2d(ji,jj)*0.25
              z2d(ji,jj) = 0.0
            enddo
            enddo
!
!           Adjoint of symmetrize
!
            call asymmetrize(z2d,zdx,ni,nj,1)
          endif
!
          do ji=1,ni
          do jj=1,nj
            pgdpsi(ji,jk,jj)=pgdpsi(ji,jk,jj)+z2d(ji,jj)
          enddo
          enddo
        enddo
!
      else
! not yet implemented
      endif ! f-plane option
!
      return
      end