!-------------------------------------- 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 -------------------------------------- ! C C 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 Csubroutine lbalgl(pgdpsi,pgdchi) 3 * ***s/r lbalgl - In: (Psi,Chiu,Tu,q,psu); Out: (Psi,Chi,T,q,ps) * * *Author : Luc Fillion -ARMA/EC 10 Jul 2009. (Based on original lam code built in Feb. 2007) *Revision: * * ------------------- ** Purpose: Used for LA-XD-Var analysis using Spherical-Harmonics approach rather than Bi-Fourier. * *Arguments * none * implicit none #include "taglam4d.cdk"
#include "comdim.cdk"
#include "comcst.cdk"
#include "comlun.cdk"
#include "comcva.cdk"
#include "comgd0.cdk"
! logical ldhelm real*8 pgdpsi(ni,nflev,nj) real*8 pgdchi(ni,nflev,nj) ! real*8 zpnl(ni,nflev,nj) real*8 zchib(ni,nflev,nj) ! ! logical llchib,lldiab integer ji,jj,jk,jband,jm,nip1,njp1,jk1,jk2,ilev,ila integer idum1,idum2,idum3,idum4 real*8 zmin,zmax * ** zpnl(:,:,:) = 0.0 zchib(:,:,:) = 0.0 ! !*1. Save Unbalanced part ! -------------------- ! ! !*2. Build Balanced part ! ------------------- ! !*2.1 1st Order Baer-Tribbia ! lldiab = .false. write(nulout,*) 'lbalgl: linmi = ',linmi !cluc if(linmi) call inmi_P(zpnl,pgdpsi,lldiab) ! !*2.2 Compute Balanced Chi: Result in pgdchi ! if(linmi) then lldiab = ldiabatic !cluc call inmi_Chi(zchib,pgdpsi,lldiab) endif ! !*3 Add Balanced and Unbalanced components ! -------------------------------------- ! do jj=1,nj do ji=1,ni do jk=1,nflev !cluc pgdchi(ji,jk,jj)=zchib(ji,jk,jj)+pgdchi(ji,jk,jj) enddo enddo enddo ! return end