***s/r xyfilt - Horizontal filtering (LAM grid) *subroutine xyfilt ( frout, frin, coef, ni, nj, nk, nis, njs, nks ) 1 #include "impnone.cdk"
* integer nis, njs, nks, ni, nj, nk real frout(nis,njs,nks), frin(nis,njs,nks), coef * *arguments *______________________________________________________________________ * | | * NAME | DESCRIPTION | *--------------------|-------------------------------------------------| * frout | output field | * frin | input field | * coef | filtering coeficient ( 0.0 <= coef <= 0.5) | * --------------------------------------------------------------------- * ** integer i, j, k real wk1(nis,njs,nks) real*8 con1 * * --------------------------------------------------------------------- * con1 = 1. - coef * * INTERPOLATION ALONG X * do k=1,nk do j=1,nj do i=2,ni-1 wk1(i,j,k) = % coef * ( frin(i-1,j,k) + frin(i+1,j,k) ) / 2. % + con1 * frin (i,j,k) enddo wk1(1,j,k) = % coef * ( frin(1,j,k) + frin(2,j,k) ) / 2. % + con1 * frin (1,j,k) wk1(ni,j,k) = % coef * (frin(ni-1,j,k)+frin(ni,j,k)) / 2. $ + con1 * frin (ni,j,k) enddo enddo * * INTERPOLATION ALONG Y * do k=1,nk do i=1,ni do j=2,nj-1 frout (i,j,k) = % coef * (wk1(i,j-1,k)+wk1(i,j+1,k)) / 2. % + con1 * wk1(i,j,k) enddo frout (i,1,k) = % coef * (wk1(i,1,k)+wk1(i,2,k)) / 2. % + con1 * wk1(i,1,k) frout (i,nj,k) = % coef * (wk1(i,nj-1,k)+wk1(i,nj,k)) / 2. $ + con1 * wk1(i,nj,k) enddo enddo * * --------------------------------------------------------------------- * return end