!-------------------------------------- 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 --------------------------------------
!
!
! X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X
!
subroutine linbal_la(pgz,pgdpsi,ldfplane,ldcoriol_one,cdpsigrd) 11,13
!
!**s/r linbal_la - Solves the Linear Balance equation for Mass variable for the Limited Area domain.
! Lap(P) = Div * (f Grad(Psi) ). Input, Psi on 'P' grid, Output: P on 'S' grid.
!
!
!Author : Luc Fillion - MSC- 23 Sep 2005.
!Revision: L. Fillion - 2 Dec 2008 - Include cdpsigrd to allow alos using PSI coming from Global system on scalar grid.
!
! -------------------
!
!Arguments
!
IMPLICIT NONE
!
#include "taglam4d.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comcst.cdk"
#include "comgemla.cdk"
#include "comgrd.cdk"
#include "comgrd_param.cdk"
!
character*1 cdpsigrd ! input psi grid (can be P or S)
logical ldfplane,ldcoriol_one
real*8 pgz(ni,nflev,nj)
real*8 pgdpsi(ni,nflev,nj)
!
logical llprint
integer ji,jj,jk,nij,nijk
real*8 zmean,zcoriol
!
real*8 zwh(ni,nj)
real*8 zwh2(ni,nj)
!
real*8 zgradfx(ni,nj)
real*8 zgradfy(ni,nj)
real*8 zgrad2dx(ni,nj)
real*8 zgrad2dy(ni,nj)
real*8 zfld2d(ni,nj)
real*8 zscalx(ni,nj)
real*8 zscaly(ni,nj)
real*8 zvort(ni,nflev,nj)
real*8 zrhs(ni,nj)
real*8 zgdx(-1:ni+2,-1:nj+2)
real*8 zgdy(-1:ni+2,-1:nj+2)
!
!!
llprint = .false.
zcoriol=2.*romega
!
nij=ni*nj
nijk=ni*nj*nflev
call zero(nij,zwh)
call zero(nijk,pgz)
call zero(nijk,zvort)
call zero(nij,zrhs)
!
!
if(ldfplane) then
!
! f * PSI: Result on 'S' grid
! ---------------------------
!
if(ldcoriol_one) then
!
do jk=1,nflev
do ji=1,ni
do jj=1,nj
pgz(ji,jk,jj) = pgdpsi(ji,jk,jj)
enddo
enddo
enddo
!
else
!
do jk=1,nflev
!
do ji=1,ni
do jj=1,nj
zfld2d(ji,jj) = pgdpsi(ji,jk,jj)
enddo
enddo
!
if(cdpsigrd.eq.'P') then
call symmetrize(zgdx,zfld2d,ni,nj,1)
!
do jj=1,nj ! Interpolate from 'P' to 'S' grid
do ji=1,ni
zfld2d(ji,jj)=0.25*( zgdx(ji-1,jj-1)+zgdx(ji-1,jj)
& + zgdx(ji,jj)+zgdx(ji,jj-1) )
enddo
enddo
endif
!
do ji=1,ni
do jj=1,nj
pgz(ji,jk,jj) = coriol(ji,jj)*zfld2d(ji,jj)
enddo
enddo
enddo
endif
else
!
! f * Lap(Psi): Result on 'S' grid
! --------------------------------
!
call psi2vort(zvort,pgdpsi) ! all levels
!
do jk=1,nflev
do ji=1,ni
do jj=1,nj
zrhs(ji,jj) = coriol(ji,jj)*zvort(ji,jk,jj)
enddo
enddo
!
! Grad(f) * Grad(Psi): Result on 'S' grid
! ---------------------------------------
!
do ji=1,ni
do jj=1,nj
zfld2d(ji,jj)=coriol(ji,jj)
enddo
enddo
call gradfld(zgradfx,zgradfy,zfld2d)
!
do ji=1,ni
do jj=1,nj
zfld2d(ji,jj)=pgdpsi(ji,jk,jj)
enddo
enddo
!
call gradfld(zgrad2dx,zgrad2dy,zfld2d)
!
call symmetrize(zgdx,zgrad2dx,ni,nj,1)
call symmetrize(zgdy,zgrad2dy,ni,nj,1)
!
do jj=1,nj ! Interpolate 'x' 'y' components of Gradient to 'U' 'V' grid resp.
do ji=1,ni
zgrad2dx(ji,jj)=0.25*( zgdx(ji,jj-1)+zgdx(ji,jj)
& + zgdx(ji+1,jj)+zgdx(ji+1,jj-1) )
zgrad2dy(ji,jj)=0.25*( zgdy(ji-1,jj)+zgdy(ji-1,jj+1)
& + zgdy(ji,jj+1)+zgdy(ji,jj) )
enddo
enddo
!
do ji=1,ni
do jj=1,nj
zscalx(ji,jj) = zgradfx(ji,jj)*zgrad2dx(ji,jj)
enddo
enddo
call symmetrize(zgdx,zscalx,ni,nj,1)
!
do jj=1,nj ! x-interpolation
zgrad2dx(ji,jj)=0.50*( zgdx(ji-1,jj)+zgdx(ji,jj) )
enddo
!
do ji=1,ni
do jj=1,nj
zscaly(ji,jj) = zgradfy(ji,jj)*zgrad2dy(ji,jj)
enddo
enddo
call symmetrize(zgdy,zscaly,ni,nj,1)
!
do ji=1,ni ! y-interpolation
zgrad2dy(ji,jj)=0.50*( zgdy(ji,jj)+zgdy(ji,jj-1) )
enddo
!
! Results are all on 'S' grid: Add them all
!
do ji=1,ni
do jj=1,nj
zrhs(ji,jj)= zrhs(ji,jj)
& + zgrad2dx(ji,jj) + zgrad2dy(ji,jj)
enddo
enddo
!
! Solve Poisson problem: Result on 'S' grid
! -----------------------------------------
!
call invlap(zwh2,zrhs,'S')
!
! As in global linear balance solution, ensure zero-mean
!
zmean = 0.0
! call fldmean(zmean,zwh2,1,ni,nj,1)
!
do ji=1,ni
do jj=1,nj
pgz(ji,jk,jj)=zwh2(ji,jj)-zmean
enddo
enddo
enddo ! k-loop
endif ! f-plane option
!
return
end