!-------------------------------------- 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 --------------------------------------
!
*DECK PROJA

      SUBROUTINE PROJA(LDAPPLY)  1,4
C
*S/P PROJA: CONTROLS THE APPLICATION OF THE ADJOINT-PROJECTION OPERATOR
C           APPEARING IN THE BACKGROUND TERM.
C
C AUTHOR: LUC FILLION - SEP 94 
C REVISION: c.cHARETTE - JAN 96 - Remove ageostrophic divergence
C
C ARGUMENTS:
C     LDAPPLY: .TRUE. appply the projection operator.
C            : .FALSE. subroutine is bypassed.
C
C#endif
      IMPLICIT NONE
C
*implicits
#include "comdim.cdk"
#include "comsp.cdk"
#include "comlun.cdk"
C
      LOGICAL  LDAPPLY
C
      LOGICAL  LLFPLAN
      INTEGER  ILEN, IERR, JLA, JLEV
      REAL*8     ZTR(NLA,2,NFLEV)
C
*modules
      EXTERNAL VTAP, TRANSFER, LINBAL 
      EXTERNAL HPALLOC, HPDEALLC, ABORT3D
C
      POINTER  (PXTR,ZTR)
C
*
**
      IF(.NOT.LDAPPLY) RETURN
      LLFPLAN = .FALSE.
CCC      LLFPLAN = .TRUE.
C
C*1   ALLOCATE SPACE
C     --------------
 100  CONTINUE
      ILEN = NLA*2*NFLEV
      CALL HPALLOC ( PXTR, MAX(ILEN,1), IERR, 8 )
C
C*2   COMPUTE ADJOINT GEOSTROPHIC DEPARTURE 
C     -------------------------------------
 200  CONTINUE
C
C     KEEP ORIGINAL VORTICITY FIELD
C
      DO  220  JLEV = 1 , NFLEV
        DO  210  JLA = 1 , NLA
          ZTR(JLA,1,JLEV) =  SPVOR(JLA,1,JLEV)
          ZTR(JLA,2,JLEV) =  SPVOR(JLA,2,JLEV)
 210    CONTINUE
 220  CONTINUE
C
C     ADJOINT LINEAR BALANCE  
C
      CALL TRANSFER('SP01')
      CALL LINBAL(-1,LLFPLAN)
C
C     COMPUTE THE VORTICITY DEPARTURE
C
      DO  240  JLEV = 1 , NFLEV
        DO  230  JLA = 1 , NLA
          SPVOR(JLA,1,JLEV)=ZTR(JLA,1,JLEV)-SPVOR(JLA,1,JLEV)
          SPVOR(JLA,2,JLEV)=ZTR(JLA,2,JLEV)-SPVOR(JLA,2,JLEV)
 230    CONTINUE
 240  CONTINUE
C
C*3   ADJOINT TRANSFORM FROM P TO TEMPERATURE VARIABLE
C     ------------------------------------------------
 300  CONTINUE
      CALL VPATA 
C
C*4   ADJOINT AGEOSTROPHIC DIVERGENCE OPERATOR
C     ----------------------------------------
 400  CONTINUE
      DO  420  JLEV = 1 , NFLEV
        DO  410  JLA = 1 , NLA
CCC   No longer needed. Ageo divergence now controlled by RNU2
CCC          SPDIV(JLA,1,JLEV)= 0.1*SPDIV(JLA,1,JLEV)
CCC          SPDIV(JLA,2,JLEV)= 0.1*SPDIV(JLA,2,JLEV)
 410    CONTINUE
 420  CONTINUE
C
C*5   DEALLOCATE LOCAL ARRAY
C     ----------------------
 500  CONTINUE
C
      CALL HPDEALLC(PXTR,IERR,1)
      IF(IERR.NE.0) CALL ABORT3D(NULOUT,'PROJA Problem with ZTR')
C
C
      RETURN
      END