!-------------------------------------- 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 settrilax(pa,pb,pc,palpha,pbeta,cdgrid,kfi) 1 ! !**s/r settrila - Prepares matrices a,b,c fro cyclic tridiagonal solver. ! ! !Author : Luc Fillion - MSC - 10 March 04. !Revision: 27 sept 2004. Mu version. !Revision: 18 Oct 2004. - Bi-periodic Arakawa-C: ! Scalar or PSI/ETA grid options. !Revision: 29 May 2007. - Introduce arrays atri,btri,ctri to be kept once and for all in comdeck. ! ------------------- ! !Arguments ! IMPLICIT NONE ! #include "taglam4d.cdk"
#include "comdim.cdk"
#include "comcst.cdk"
#include "comgrd_param.cdk"
#include "comgemla.cdk"
! character*1 cdgrid integer kfi real*8 palpha,pbeta real*8 pa(nj),pb(nj),pc(nj) ! logical lldirichlet integer ji,jj,jk,jfi real*8 zdlon,zdlat,zdlon2,zdlat2,zalpha,zbeta,za,zra2,zcon real*8 zdenom,zdenom2,zratio real*8 zdenoma,zdenomc real*8 zpm(nfi) ! !! ! lldirichlet=.false. zdlon=rdlon_an(1,1) zdlat=rdlat_an(1,1) zdlon2=zdlon*zdlon zdlat2=zdlat*zdlat zra2=ra**2 ! ! Build vectors a,b,c of tridiagonal matrix ! do jfi=1,nfi zratio=real(jfi-1)/real(ni) zpm(jfi)=2.0*(cos(2.*rpi*zratio)-1.)/(zdlon2) enddo ! do jj=1,nj if(cdgrid.eq.'S') then zdenoma=zra2*rdmu(jj-1)*rdmuh(jj-1) atris(jj)=r1mmu2h(jj-1)/zdenoma pa(jj) = atris(jj) zdenomc=zra2*rdmu(jj)*rdmuh(jj-1) ctris(jj)=r1mmu2h(jj)/zdenomc pc(jj) = ctris(jj) zdenom2=zra2*r1mmu2(jj) do jfi=1,nfi btris(jj,jfi)=-(atris(jj)+ctris(jj))+zpm(jfi)/zdenom2 enddo pb(jj) = btris(jj,kfi) else zdenoma=zra2*rdmu(jj)*rdmuh(jj-1) atrip(jj)=r1mmu2(jj)/zdenoma pa(jj) = atrip(jj) zdenomc=zra2*rdmu(jj)*rdmuh(jj) ctrip(jj)=r1mmu2(jj+1)/zdenomc pc(jj) = ctrip(jj) zdenom2=zra2*r1mmu2h(jj) do jfi=1,nfi btrip(jj,jfi)=-(atrip(jj)+ctrip(jj))+zpm(jfi)/zdenom2 enddo pb(jj) = btrip(jj,kfi) endif enddo ! if(lldirichlet) then palpha=0. pbeta=0. else pbeta=pa(1) palpha=pbeta ! palpha=pc(nj) ! print *,'settrila: palpha, pbeta =', palpha, pbeta endif ! return end