!-------------------------------------- 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 v4d_irgdint_1_w - Linear interpolation with wrap around * based on EZ_IRGDINT_1_W (Y.Chartier EZSCINT 2001) *subroutine v4d_irgdint_1_w (zo,px,py,npts,ax,ay,zi,ni,j1,j2,nk) 7 * #include "impnone.cdk"
* integer npts,ni,j1,j2,nk real zo(nk,npts),zi(ni,j1:j2,nk), % px(npts),py(npts),ax(ni),ay(j1:j2) * *author Tanguay M. * *revision * v3_00 - Tanguay M. - initial MPI version * *object * see id section * *arguments * Name I/O Description *---------------------------------------------------------------- * zo O Interpolated field at positions px,py * px I Position x in INPUT grid * py I Position y in INPUT grid * npts I Number of positions in zo * zi I Field on INPUT grid * ax I X axe of INPUT grid * ay I Y axe of INPUT grid * ni I Dimension x in INPUT grid * j1-j2 I Dimension y in INPUT grid * nk I Dimension z in INPUT grid *---------------------------------------------------------------- * integer i,j,n,k,iplus1,tabplus1(ni) real*8 x_8,y_8,x1_8,x2_8,y1_8,y2_8,dx_8,dy_8 * real ax_ext(ni+1) * * Define tables to restaure vectorization * --------------------------------------- do i=1,ni ax_ext (i) = ax(i) enddo ax_ext(ni+1) = ax(1)+360.0 * do i=1,ni-1 tabplus1(i) = i+1 enddo tabplus1(ni) = 1 * * Interpolation * ------------- do n=1,npts do k=1,nk * i = min(ni, max(1, ifix(px(n)))) j = min(j2-1,max(j1,ifix(py(n)))) * if (j.le.0.and.py(n).lt.0.) then j = j-1 endif * iplus1 = tabplus1(i) * x1_8 = ax_ext(i ) x2_8 = ax_ext(i+1) * x_8 = x1_8 + (x2_8-x1_8)*(px(n)-i) y_8 = ay(j) + (ay(j+1)-ay(j))*(py(n)-j) * dx_8 = (x_8 - x1_8)/(x2_8-x1_8) dy_8 = (y_8 - ay(j))/(ay(j+1)-ay(j)) * y1_8 = dble(zi(i,j, k))+(dble(zi(iplus1,j, k))-dble(zi(i,j, k)))*dx_8 y2_8 = dble(zi(i,j+1,k))+(dble(zi(iplus1,j+1,k))-dble(zi(i,j+1,k)))*dx_8 zo(k,n) = y1_8 + (y2_8 - y1_8) * dy_8 * enddo enddo * return end