!-------------------------------------- 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 PROJI
SUBROUTINE PROJI(LDAPPLY) 4,5
C
*S/P PROJI: CONTROLS THE APPLICATION OF THE INVERSE PROJECTION
C OPERATOR APPEARING IN THE Jo TERM.
C
C AUTHOR: LUC FILLION - OCT 94
C
C Revision: S. Pellerin *ARMA/AES Sept 97.
C Change from TT to GZ states 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 VPAT, 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 MASS VARIABLE TO TEMPERATURE
C -------------------------------------------
200 CONTINUE
CALL VPAT
C
C*3 ADD GEOSTROPHIC CONTRIBUTION
C ----------------------------
300 CONTINUE
C
C KEEP ORIGINAL TEMPERATURE 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 TEMPERATURE FIELD
C
CALL TRANSFER('SP01')
CALL LINBAL(+1,LLFPLAN)
CALL VPAT
C
C ADD SLOW AND FAST CONTRIBUTIONS
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*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.01)*SPDIV(JLA,1,JLEV)
CCC SPDIV(JLA,2,JLEV)= (1./0.01)*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,'PROJI Problem with ZTR')
C
C
RETURN
END