!-------------------------------------- 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 settrila(cdgrid) 2 ! !**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 real*8 palpha,pbeta ! 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) ! !! ! 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 zdenomc=zra2*rdmu(jj)*rdmuh(jj-1) ctris(jj)=r1mmu2h(jj)/zdenomc zdenom2=zra2*r1mmu2(jj) do jfi=1,nfi btris(jj,jfi)=-(atris(jj)+ctris(jj))+zpm(jfi)/zdenom2 enddo else zdenoma=zra2*rdmu(jj)*rdmuh(jj-1) atrip(jj)=r1mmu2(jj)/zdenoma zdenomc=zra2*rdmu(jj)*rdmuh(jj) ctrip(jj)=r1mmu2(jj+1)/zdenomc zdenom2=zra2*r1mmu2h(jj) do jfi=1,nfi btrip(jj,jfi)=-(atrip(jj)+ctrip(jj))+zpm(jfi)/zdenom2 enddo endif enddo ! return end