!-------------------------------------- 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 --------------------------------------
!
subroutine applyenergy(ldsqrt,ldinverse,ldareaweight,ldimages) 14,4
#if defined (DOC)
*
***s/r applyenergy - Apply the energy norm (or its sqrt and/or inverse) to
* field in gd and put result in gd1
*
*Author : M. Buehner June, 2002
*Revision:
*
* -------------------
** Purpose:
* .
*
*Arguments
* LDSQRT - use sqrt of energy norm
* LDINVERSE - use inverse of energy norm
* LDAREAWEIGHT - include dx*dy term in norm
* LDIMAGES - consider winds to be as images
#endif
c
IMPLICIT NONE
#include "pardim.cdk"
#include "comdim.cdk"
#include "comcst.cdk"
#include "comlun.cdk"
#include "comleg.cdk"
#include "comgd0.cdk"
#include "comgd1.cdk"
#include "comgem.cdk"
c
logical ldsqrt,ldinverse,ldareaweight,ldimages
c
integer jk,jlat,jlon,klat1,klat2,ISRCHILA
real*8 zfact,zfact2,ztop,zsfc
real*8 zweightq,zweightuv,zweightt,zweightps
logical Lonly_north,Lnopole,Lnotop
c
ztop=1000.0
zsfc=100000.0
c*****************
c TEMPORARY zero the values at the pole and above 200 hPa if this is initial time norm
c*****************
if(ldsqrt) then
do jk=1,NKGDIM
do jlon=1,NI
GD(jlon,jk,1)=0.0d0
GD(jlon,jk,NJ)=0.0d0
enddo
enddo
c do jk=1,9
c do jlon=1,NI
c do jlat=1,NJ
c UT0(jlon,jk,jlat)=0.0d0
c VT0(jlon,jk,jlat)=0.0d0
c TT0(jlon,jk,jlat)=0.0d0
c enddo
c enddo
c enddo
endif
c*****************
c
Lonly_north=.false.
Lnotop=.false.
Lnopole=.false.
c***************** ONLY INCLUDE NORTHERN EXTRA-TROPICS IF FINAL TIME NORM ******************
if(.not.ldsqrt) then
Lonly_north=.true.
Lnotop=.true.
c Lnopole=.true.
endif
c
c no humidity
zweightq=0.0
zweightps=1.0
zweightt=1.0
zweightuv=1.0
c
IF(Lonly_north) THEN
KLAT2=ISRCHILA(30.0*RPI/180.0)-1
ELSE
KLAT2=NJ
ENDIF
IF(Lnopole) THEN
KLAT1=ISRCHILA(80.0*RPI/180.0)-1
ELSE
KLAT1=1
ENDIF
write(nulout,*) 'ONLY_NORTH, NOPOLE=',Lonly_north,Lnopole,klat1,klat2
call vflush(nulout)
c
call transfer('ZGD1')
c
c UU,VV: convert winds to physical winds if LDIMAGES
c
DO JK = 2, NFLEV-1
ZFACT2=0.5*(VLEV(JK+1)-VLEV(JK-1))
DO JLAT = Klat1, Klat2
ZFACT = ZFACT2
IF(LDIMAGES) ZFACT=ZFACT*CONPHY(JLAT)*CONPHY(JLAT)
IF(LDAREAWEIGHT) ZFACT=ZFACT*RWT(JLAT)/NILON(JLAT)
ZFACT = ZFACT*zweightuv
IF(ZFACT.ne.0.0.and.LDSQRT) ZFACT=SQRT(ZFACT)
IF(ZFACT.ne.0.0.and.LDINVERSE) ZFACT=1.0/ZFACT
DO JLON = 1, NI
UT1(JLON,JK,JLAT)=UT0(JLON,JK,JLAT)*ZFACT
VT1(JLON,JK,JLAT)=VT0(JLON,JK,JLAT)*ZFACT
END DO
END DO
END DO
JK=1
ZFACT2=0.5*(VLEV(JK+1)-VLEV(JK))
c ZFACT2=(VLEV(JK+1)-VLEV(JK))
DO JLAT = Klat1, Klat2
ZFACT = ZFACT2
IF(LDIMAGES) ZFACT = ZFACT*CONPHY(JLAT)*CONPHY(JLAT)
IF(LDAREAWEIGHT) ZFACT=ZFACT*RWT(JLAT)/NILON(JLAT)
ZFACT = ZFACT*zweightuv
IF(ZFACT.ne.0.0.and.LDSQRT) ZFACT=SQRT(ZFACT)
IF(ZFACT.ne.0.0.and.LDINVERSE) ZFACT=1.0/ZFACT
DO JLON = 1, NI
UT1(JLON,JK,JLAT)=UT0(JLON,JK,JLAT)*ZFACT
VT1(JLON,JK,JLAT)=VT0(JLON,JK,JLAT)*ZFACT
END DO
END DO
JK=NFLEV
ZFACT2=0.5*(VLEV(JK)-VLEV(JK-1))
c ZFACT2=(VLEV(JK)-VLEV(JK-1))
DO JLAT = Klat1, Klat2
ZFACT = ZFACT2
IF(LDIMAGES) ZFACT = ZFACT*CONPHY(JLAT)*CONPHY(JLAT)
IF(LDAREAWEIGHT) ZFACT=ZFACT*RWT(JLAT)/NILON(JLAT)
ZFACT = ZFACT*zweightuv
IF(ZFACT.ne.0.0.and.LDSQRT) ZFACT=SQRT(ZFACT)
IF(ZFACT.ne.0.0.and.LDINVERSE) ZFACT=1.0/ZFACT
DO JLON = 1, NI
UT1(JLON,JK,JLAT)=UT0(JLON,JK,JLAT)*ZFACT
VT1(JLON,JK,JLAT)=VT0(JLON,JK,JLAT)*ZFACT
END DO
END DO
c
c TT: convert temperature to energy (cp/Tr)
c
DO JK = 2, NFLEV-1
ZFACT2=0.5*(VLEV(JK+1)-VLEV(JK-1))
DO JLAT = Klat1, Klat2
ZFACT = ZFACT2*(1005.0/300.0)
IF(LDAREAWEIGHT) ZFACT=ZFACT*RWT(JLAT)/NILON(JLAT)
ZFACT = ZFACT*zweightt
IF(ZFACT.ne.0.0.and.LDSQRT) ZFACT=SQRT(ZFACT)
IF(ZFACT.ne.0.0.and.LDINVERSE) ZFACT=1.0/ZFACT
DO JLON = 1, NI
TT1(JLON,JK,JLAT)=TT0(JLON,JK,JLAT)*ZFACT
END DO
END DO
END DO
JK=1
ZFACT2=0.5*(VLEV(JK+1)-VLEV(JK))
c ZFACT2=(VLEV(JK+1)-VLEV(JK))
DO JLAT = Klat1, Klat2
ZFACT = ZFACT2*(1005.0/300.0)
IF(LDAREAWEIGHT) ZFACT=ZFACT*RWT(JLAT)/NILON(JLAT)
ZFACT = ZFACT*zweightt
IF(ZFACT.ne.0.0.and.LDSQRT) ZFACT=SQRT(ZFACT)
IF(ZFACT.ne.0.0.and.LDINVERSE) ZFACT=1.0/ZFACT
DO JLON = 1, NI
TT1(JLON,JK,JLAT)=TT0(JLON,JK,JLAT)*ZFACT
END DO
END DO
JK=NFLEV
ZFACT2=0.5*(VLEV(JK)-VLEV(JK-1))
c ZFACT2=(VLEV(JK)-VLEV(JK-1))
DO JLAT = Klat1, Klat2
ZFACT = ZFACT2*(1005.0/300.0)
IF(LDAREAWEIGHT) ZFACT=ZFACT*RWT(JLAT)/NILON(JLAT)
ZFACT = ZFACT*zweightt
IF(ZFACT.ne.0.0.and.LDSQRT) ZFACT=SQRT(ZFACT)
IF(ZFACT.ne.0.0.and.LDINVERSE) ZFACT=1.0/ZFACT
DO JLON = 1, NI
TT1(JLON,JK,JLAT)=TT0(JLON,JK,JLAT)*ZFACT
END DO
END DO
c
c HU: convert humidity to energy
c
ZFACT = 2.5d6*2.5d6/(1005.0*300.0)*zweightq
DO JK = 2, NFLEV-1
DO JLAT = Klat1, Klat2
ZFACT2=ZFACT*0.5*(VLEV(JK+1)-VLEV(JK-1))
IF(LDAREAWEIGHT) ZFACT2=ZFACT2*RWT(JLAT)/NILON(JLAT)
IF(ZFACT2.ne.0.0.and.LDSQRT) ZFACT2=SQRT(ZFACT2)
IF(ZFACT2.ne.0.0.and.LDINVERSE) ZFACT2=1.0/ZFACT2
DO JLON = 1, NI
Q1(JLON,JK,JLAT) = Q0(JLON,JK,JLAT)*ZFACT2
END DO
END DO
END DO
JK=1
DO JLAT = Klat1, Klat2
ZFACT2=ZFACT*0.5*(VLEV(JK+1)-VLEV(JK))
c ZFACT2=ZFACT*(VLEV(JK+1)-VLEV(JK))
IF(LDAREAWEIGHT) ZFACT2=ZFACT2*RWT(JLAT)/NILON(JLAT)
IF(ZFACT2.ne.0.0.and.LDSQRT) ZFACT2=SQRT(ZFACT2)
IF(ZFACT2.ne.0.0.and.LDINVERSE) ZFACT2=1.0/ZFACT2
DO JLON = 1, NI
Q1(JLON,JK,JLAT) = Q0(JLON,JK,JLAT)*ZFACT2
END DO
END DO
JK=NFLEV
DO JLAT = Klat1, Klat2
ZFACT2=ZFACT*0.5*(VLEV(JK)-VLEV(JK-1))
c ZFACT2=ZFACT*(VLEV(JK)-VLEV(JK-1))
IF(LDAREAWEIGHT) ZFACT2=ZFACT2*RWT(JLAT)/NILON(JLAT)
IF(ZFACT2.ne.0.0.and.LDSQRT) ZFACT2=SQRT(ZFACT2)
IF(ZFACT2.ne.0.0.and.LDINVERSE) ZFACT2=1.0/ZFACT2
DO JLON = 1, NI
Q1(JLON,JK,JLAT) = Q0(JLON,JK,JLAT)*ZFACT2
END DO
END DO
c
c P0: convert surface pressure to energy (R*Tr/ps,r)*ps**2 or (R*Tr*ps,r)*log(ps)**2
c
DO JLAT = Klat1, Klat2
ZFACT2 =(287.04*300.0/(zsfc*zsfc))
IF(LDAREAWEIGHT) ZFACT2=ZFACT2*RWT(JLAT)/NILON(JLAT)
ZFACT2 = ZFACT2*zweightps
IF(ZFACT2.ne.0.0.and.LDSQRT) ZFACT2=SQRT(ZFACT2)
IF(ZFACT2.ne.0.0.and.LDINVERSE) ZFACT2=1.0/ZFACT2
DO JLON = 1, NI
GPS1(JLON,1,JLAT)=GPS0(JLON,1,JLAT)*ZFACT2
END DO
END DO
c
IF(Lnotop) THEN
DO JK = 1,5
DO JLAT = 1,NJ
DO JLON = 1, NI
UT1(JLON,JK,JLAT) = 0.0d0
VT1(JLON,JK,JLAT) = 0.0d0
TT1(JLON,JK,JLAT) = 0.0d0
Q1(JLON,JK,JLAT) = 0.0d0
END DO
END DO
END DO
ENDIF
end