!-------------------------------------- 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 adw_polw - calculate pole values for wind components *subroutine adw_polw (F_u, F_v, F_cx, F_sx, F_wx, F_sy, F_j, 8 % F_nic, F_halox, F_njc, F_haloy, F_nk ) * #include "impnone.cdk"
* integer F_j, F_nic, F_halox, F_njc, F_haloy, F_nk * real F_u (-F_halox+1:F_nic+F_halox,-F_haloy+1:F_njc+F_haloy,F_nk), % F_v (-F_halox+1:F_nic+F_halox,-F_haloy+1:F_njc+F_haloy,F_nk) * real*8 F_cx (F_nic), F_sx (F_nic), F_wx (F_nic), F_sy (F_njc) * *author * alain patoine * *revision * v3_21 - Desgagne M. - Revision Openmp * *language * fortran 77 * *object * see id section * *arguments *______________________________________________________________________ * | | | * NAME | DESCRIPTION | I/O | *--------------|-------------------------------------------------|-----| * | | | * F_u | \ components of the wind to treat | io | * F_v | / | io | * | | | * F_cx | cos of longitudes | i | * F_sx | sin of longitudes | i | * F_wx | weights (proportional to x grid distances) | i | * F_sy | sin of latitudes | i | * F_j | j position to fill | i | * | | | * F_nic | number of points in x direction (advection grid)| i | * F_njc | number of points in y direction (advection grid)| i | * | | | * F_halox | size of halo in x direction (advection grid) | i | * F_haloy | size of halo in y direction (advection grid) | i | * | | | * F_nk | number of levels | i | *______________|_________________________________________________|_____| * *implicits * none * *modules * none ************************************************************************ integer i,j,k * real*8 vx, vy, coef1, coef2 * if ( F_j .eq. 0 ) then j = 1 coef1 = -1.0 coef2 = 1.0 else j = F_njc coef1 = 1.0 coef2 = -1.0 endif * !$omp do do k = 1,F_nk * vx = 0.0 vy = 0.0 do i=1,F_nic vx = vx + F_wx(i) * (F_sx(i) * dble(F_u(i,j,k)) % + F_cx(i) * F_sy(j) * dble(F_v(i,j,k))) * vy = vy + F_wx(i) * (F_cx(i) * dble(F_u(i,j,k)) % - F_sx(i) * F_sy(j) * dble(F_v(i,j,k))) enddo * do i=1,F_nic F_u(i,F_j,k) = vx * F_sx(i) + vy * F_cx(i) F_v(i,F_j,k) = coef1 * vx * F_cx(i) + coef2 * vy * F_sx(i) enddo * do i = 1, F_halox F_u(F_nic+i,F_j,k) = F_u(i ,F_j,k) F_v(F_nic+i,F_j,k) = F_v(i ,F_j,k) F_u(1-i ,F_j,k) = F_u(F_nic+1-i,F_j,k) F_v(1-i ,F_j,k) = F_v(F_nic+1-i,F_j,k) enddo * enddo !$omp enddo * return end