!-------------------------------------- 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 hspng_abc -- Prepares matrices aix,bix,cix,dix,aiy,biy,ciy * #include "model_macros_f.h"*
subroutine hspng_abc (F_aix_8, F_bix_8, F_cix_8, F_dix_8 , 17,2 $ F_aiy_8, F_biy_8, F_ciy_8, F_coef_8, $ F_cy2_8, F_xp0_8, F_xp2_8, F_yp0_8 , $ F_yp2_8, Gni, Gnj, PYDIST_DIM,F_gnjv, lnjv) * #include "impnone.cdk"
* integer Gni,Gnj,PYDIST_DIM,F_gnjv, lnjv real*8 F_aix_8(*), F_bix_8(*), F_cix_8(*), F_dix_8(*), $ F_aiy_8(*), F_biy_8(*), F_ciy_8(*), F_coef_8, $ F_cy2_8(PYDIST_SHAPE) , F_xp0_8(Gni,3), F_xp2_8(Gni,3), $ F_yp0_8(Gnj,3), F_yp2_8(Gnj,3) * *author * J.P. Toviessi (hzd_abc) * *revision * v3_01 - Lee V - for diffusion only on Hspng_nj points on the poles * *object * *arguments * Name I/O Description *---------------------------------------------------------------- * F_aix_8 *---------------------------------------------------------------- * *implicit #include "glb_ld.cdk"
#include "hspng.cdk"
#include "ldnh.cdk"
#include "grd.cdk"
#include "trp.cdk"
* integer i, j, k, kk, ii, jj real*8 $ ax_8(Ldnh_maxy,G_ni), bx_8(Ldnh_maxy,G_ni), cx_8(Ldnh_maxy,G_ni), $ ay_8(Trp_22max,G_nj), by_8(Trp_22max,G_nj), cy_8(Trp_22max,G_nj), $ mdifc(G_nj),diy_8 real*8 ZERO_8,ONE_8,HALF_8,pis2 parameter ( ZERO_8 = 0.0 , ONE_8 = 1.0 , HALF_8 = 0.5 ) ** * --------------------------------------------------------------- * do j = 1, l_nj mdifc(j) = ZERO_8 end do if (l_south) then do j = 1, Hspng_nj mdifc(j) = Hspng_mf*(Hspng_nj-j+1)/Hspng_nj end do endif if (l_north) then do j = lnjv-Hspng_nj+1, lnjv mdifc(j) = Hspng_mf*(j-lnjv+Hspng_nj)/Hspng_nj end do endif * * Calcul le long de X * do j = 1, lnjv do i = 1, G_ni ax_8(j,i) = F_xp0_8(i,1) - mdifc(j) * $ F_xp2_8(i,1)*F_coef_8/F_cy2_8(j) bx_8(j,i) = F_xp0_8(i,2) - mdifc(j) * $ F_xp2_8(i,2)*F_coef_8/F_cy2_8(j) cx_8(j,i) = F_xp0_8(i,3) - mdifc(j) * $ F_xp2_8(i,3)*F_coef_8/F_cy2_8(j) enddo enddo * do j = lnjv+1, Ldnh_maxy do i = 1, G_ni bx_8(j,i)= ONE_8 cx_8(j,i)= ZERO_8 ax_8(j,i)= ZERO_8 enddo enddo * call set_trig21
(F_aix_8,F_bix_8,F_cix_8,F_dix_8, ax_8,bx_8,cx_8, $ Ldnh_maxy, 1, G_ni, Ldnh_maxy, .true.) * * Calcul le long de Y * do j = 1, G_nj mdifc(j) = ZERO_8 end do do j = 1, Hspng_nj mdifc(j) = Hspng_mf*(Hspng_nj-j+1)/Hspng_nj end do do j = F_gnjv-Hspng_nj+1, F_gnjv mdifc(j) = Hspng_mf*(j-F_gnjv+Hspng_nj)/Hspng_nj end do * do i= 1, Trp_22n do j= 1, F_gnjv ay_8(i,j) = F_yp0_8(j,1) - mdifc(j) * % F_yp2_8(j,1) * F_coef_8 by_8(i,j) = F_yp0_8(j,2) - mdifc(j) * % F_yp2_8(j,2) * F_coef_8 cy_8(i,j) = F_yp0_8(j,3) - mdifc(j) * % F_yp2_8(j,3) * F_coef_8 enddo ay_8(i,1) = ZERO_8 enddo * do i = Trp_22n+1, Trp_22max do j = 1, F_gnjv by_8(i,j)= ONE_8 cy_8(i,j)= ZERO_8 ay_8(i,j)= ZERO_8 enddo enddo * call set_trig21
(F_aiy_8,F_biy_8,F_ciy_8,diy_8, ay_8,by_8,cy_8, $ Trp_22max, 1, F_gnjv, Trp_22max, .false.) * * --------------------------------------------------------------- * return end