!-------------------------------------- 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 -------------------------------------- ***s/r set_trig21 -- Preparation pour un eventuel solveur tridiagonal * Le solveur est soit parallel ou non * Periodicite est envisagee aussi. *subroutine set_trig21 ( F_ai_8, F_bi_8, F_ci_8, F_di_8, 13 $ F_a_8, F_b_8, F_c_8, % F_idel, F_jdel, fni, fnj, F_per_L ) * implicit none * logical F_per_L integer F_idel, F_jdel, fni, fnj real*8 F_ai_8(F_idel,fni),F_bi_8(F_idel,fni),F_ci_8(F_idel,fni), $ F_di_8(F_idel,fni), F_a_8(F_idel,fni), F_b_8(F_idel,fni), $ F_c_8 (F_idel,fni) * *author * Abdessamad Qaddouri * *revision * v2_00 - Qaddouri A. - initial MPI version * v3_11 - Gravel S. - modify for theoretical cases * *object * *arguments * Name I/O Description *---------------------------------------------------------------- * F_ai_8 *---------------------------------------------------------------- * integer i,l,m real*8 one parameter( one = 1.0 ) ** * --------------------------------------------------------------- * do l= 1,fnj*F_jdel,F_jdel F_bi_8(l,1) = one/F_b_8(l,1) F_ci_8(l,1) = F_c_8(l,1) * F_bi_8(l,1) enddo * if (F_per_L) then m =fni-1 else m=fni endif * if ( m .gt. 1) then ! to avoid calculation with theoretical cases do i=2, m-1 do l= 1,fnj*F_jdel,F_jdel F_bi_8(l,i) = one/( F_b_8(l,i) - F_a_8(l,i) * F_ci_8(l,i-1) ) F_ci_8(l,i) = F_bi_8(l,i) * F_c_8(l,i) F_ai_8(l,i) = F_bi_8(l,i) * F_a_8(l,i) enddo enddo do l= 1,fnj*F_jdel,F_jdel F_bi_8(l,m)=one/( F_b_8(l,m)-F_a_8(l,m) *F_ci_8(l,m-1) ) F_ai_8(l,m)=F_bi_8(l,m)*F_a_8(l,m) enddo endif ! end of exception for theoretical cases * if (F_per_L) then do l= 1,fnj*F_jdel,F_jdel F_di_8(l,1) = -F_bi_8(l,1) * F_a_8(l,1) enddo do i=2,m do l= 1,fnj*F_jdel,F_jdel F_di_8(l,i) = -F_ai_8(l,i) * F_di_8(l,i-1) enddo enddo do l= 1,fnj*F_jdel,F_jdel F_di_8(l,m)= F_di_8(l,m) - F_bi_8(l,m)*F_c_8(l,m) enddo * do i=m-1,1,-1 do l= 1,fnj*F_jdel,F_jdel F_di_8(l,i)= F_di_8(l,i) - F_ci_8(l,i)*F_di_8(l,i+1) enddo enddo * do l= 1,fnj*F_jdel,F_jdel F_bi_8(l,fni)= one/(F_b_8(l,fni)+F_c_8(l,fni)*F_di_8(l,1) % + F_a_8(l,fni)* F_di_8(l,m) ) F_ai_8(l,1) = - F_a_8(l,fni)*F_bi_8(l,fni) F_ci_8(l,fni)= - F_c_8(l,fni)* F_bi_8(l,fni) enddo * endif * * --------------------------------------------------------------- * return end