!-------------------------------------- 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 nesajr -- Horizontal blending of field "fn" with field "fd". * #include "model_macros_f.h"*
subroutine nesajr (F_fn, F_fd, DIST_DIM, Nk, F_is, F_js, 77,4 $ F_ndavx, F_ndavy) implicit none * integer DIST_DIM, NK, F_is, F_js, F_ndavx, F_ndavy real F_fn(DIST_SHAPE,Nk), F_fd(DIST_SHAPE,Nk) * *author * Desgagne - spring 2002 (after MC2 v_4.9.3) * *revision * v3_00 - Desgagne - initial version * *object * This subroutine blends the field "fn", updated by a dynamic * timestep, with the nesting field "fd". Nesting is performed * on ndavx+1 points along the x-axis and on ndavy+1 points along * the y-axis. * *arguments * Name I/O Description *---------------------------------------------------------------- * F_fn O field to be blended * F_fd I blending field * F_is I staggering parameter along x * F_js I staggering parameter along y * F_ndavx I thichness of sponge layer along x * F_ndavy I thichness of sponge layer along y *---------------------------------------------------------------- * *implicit #include "glb_ld.cdk"
#include "hblen.cdk"
integer i,j,k * ** *---------------------------------------------------------------------- if ((F_ndavx.eq.0).and.(F_ndavy.eq.0)) return if (Hblen_wfct_S .eq. "CONST") then !$omp parallel shared (F_fn,F_fd) !$omp do do k= 1, G_nk do j= 1, l_nj do i= 1, l_ni F_fn(i,j,k) = F_fd(i,j,k) enddo enddo enddo !$omp enddo !$omp end parallel else if (north+south+east+west.eq.4) $ call nes4s
(F_fn,F_fd,DIST_DIM,Nk,F_is,F_js,F_ndavx,F_ndavy) if (north+south+east+west.eq.3) $ call nes3s
(F_fn,F_fd,DIST_DIM,Nk,F_is,F_js,F_ndavx,F_ndavy) if (north+south+east+west.eq.2) $ call nes2s
(F_fn,F_fd,DIST_DIM,Nk,F_is,F_js,F_ndavx,F_ndavy) if (north+south+east+west.eq.1) $ call nes1s
(F_fn,F_fd,DIST_DIM,Nk,F_is,F_js,F_ndavx,F_ndavy) endif *---------------------------------------------------------------------- return end