!-------------------------------------- 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 PROJ
SUBROUTINE PROJ(LDAPPLY) 4,4
C
*S/P PROJ: CONTROLS THE APPLICATION OF THE PROJECTION OPERATOR
C DEFINING THE CONTROL VARIABLE.
C
C AUTHOR: LUC FILLION - SEP 94
C
C REVISION: L. FILLION - OCT 94 - FORCE ZERO MASS BIAS
C REVISION: L. FILLION - May 94 - Disactivate mean zero geopotential
C REVISION: c.cHARETTE - JAN 96 - Remove adjoint ageostrophic divergence
C REVISION: S. Pellerin- Sep 97 - Change from TT to GZ variable
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)
*
**
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 TRANSFORM FROM TEMPERATURE TO MASS VARIABLE
C -------------------------------------------
200 CONTINUE
CALL VTAP
C
C*3 COMPUTE GEOSTROPHIC DEPARTURE
C -----------------------------
300 CONTINUE
C
C KEEP ORIGINAL MASS FIELD
C
DO 320 JLEV = 1 , NFLEV
DO 310 JLA = 1 , NLA
ZTR(JLA,1,JLEV) = SPGZ(JLA,1,JLEV)
ZTR(JLA,2,JLEV) = SPGZ(JLA,2,JLEV)
310 CONTINUE
320 CONTINUE
C
C COMPUTE LINEARLY BALANCED MASS FIELD
C
CALL TRANSFER('SP01')
CALL LINBAL(+1,LLFPLAN)
C
C COMPUTE THE MASS DEPARTURE
C
DO 340 JLEV = 1 , NFLEV
DO 330 JLA = 1 , NLA
SPGZ(JLA,1,JLEV)=ZTR(JLA,1,JLEV)-SPGZ(JLA,1,JLEV)
SPGZ(JLA,2,JLEV)=ZTR(JLA,2,JLEV)-SPGZ(JLA,2,JLEV)
330 CONTINUE
340 CONTINUE
C
C SET MEAN GEOPOTENTIAL
C
C DO 350 JLEV = 1 , NFLEV
C SPTT(1,1,JLEV)= 0.0
C SPTT(1,2,JLEV)= 0.0
C 350 CONTINUE
C
C COMPUTE AGEOSTROPHIC DIVERGENCE
C
DO 370 JLEV = 1 , NFLEV
DO 360 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)
360 CONTINUE
370 CONTINUE
C
C*4 DEALLOCATE LOCAL ARRAY
C ----------------------
400 CONTINUE
C
CALL HPDEALLC(PXTR,IERR,1)
IF(IERR.NE.0) CALL ABORT3D(NULOUT,'PROJ Problem with ZTR')
C
C
RETURN
END