!-------------------------------------- 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 PROJIA
SUBROUTINE PROJIA(LDAPPLY) 3,4
C
*S/P PROJIA: CONTROLS THE APPLICATION OF THE ADJOINT-INVERSE-PROJECTION
C OPERATOR APPEARING IN THE Jo TERM.
C
C AUTHOR: LUC FILLION - OCT 94
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 VPATA
EXTERNAL HPALLOC, HPDEALLC, ABORT3D
C
POINTER (PXTR,ZTR)
*
**
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*3 ADJOINT OF P TO T
C -----------------
300 CONTINUE
C
CALL VPATA
C
C ADJOINT LINEAR BALANCE
C
CALL TRANSFER('SP01')
CALL LINBAL(-1,LLFPLAN)
C
C ADD CONTRIBUTIONS
C
DO 320 JLEV = 1 , NFLEV
DO 310 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)
310 CONTINUE
320 CONTINUE
C
C*4 INVERSE AGEOSTROPHIC DIVERGENCE OPERATOR
C ----------------------------------------
400 CONTINUE
DO 420 JLEV = 1 , NFLEV
DO 410 JLA = 1 , NLA
CCC SPDIV(JLA,1,JLEV)= (1./0.1)*SPDIV(JLA,1,JLEV)
CCC SPDIV(JLA,2,JLEV)= (1./0.1)*SPDIV(JLA,2,JLEV)
410 CONTINUE
420 CONTINUE
C
C*5 DEALLOCATE LOCAL ARRAY
C ----------------------
500 CONTINUE
CALL HPDEALLC(PXTR,IERR,1)
IF(IERR.NE.0) CALL ABORT3D(NULOUT,'PROJIAD Problem with ZTR')
C
C
RETURN
END