1 subroutine evintrp2d(xget,yget,x,nx,y,ny,jspline,
2 > f,icoeff,ixdim,iydim,ict,fval,ier)
27 integer :: ixdim,iydim
31 real f(icoeff,ixdim,iydim)
122 call vecin2d_argchk(
'evintrp2d',jspline,
123 > icoeff,nx,ny,ixdim,iydim,ier)
126 call herm2xy(xget,yget,x,nx,y,ny,0,0,
127 > i,j,xparam,yparam,hx,hxi,hy,hyi,ier)
130 call fvintrp2d(ict,1,1,
131 > fval,i,j,xparam,yparam,hx,hxi,hy,hyi,
132 > jspline,f,icoeff,ixdim,iydim)
140 subroutine fvintrp2d(ict,ivec,ivecd,
141 > fval,ii,jj,xparam,yparam,hx,hxi,hy,hyi,
142 > jspline,fin,icoeff,ixdim,iydim)
150 integer ii(ivec),jj(ivec)
151 real xparam(ivec),yparam(ivec)
154 real hx(ivec),hy(ivec)
155 real hxi(ivec),hyi(ivec)
158 integer :: jspline(2)
160 integer :: ixdim,iydim
161 real fin(icoeff,ixdim,iydim)
179 integer :: i,j,i1,i2,zonrank,linrank,cubrank
180 integer :: imaxx,imaxy,imaxdlin,imaxdcub
181 logical :: splin_flag
184 integer :: iderivs(2,6),ict4(4),maxd_lin(4),maxd_cub(4)
186 integer :: idcub,idlin
187 real :: xp,dxlin,dxlini,h,hi,ans1,ans2
190 real,
parameter :: ONE = 1.0d0
198 if(jspline(i).eq.-1)
then
199 zonrank = zonrank + 1
201 else if(jspline(i).eq.0)
then
202 linrank = linrank + 1
205 splin_flag = jspline(i).eq.2
206 cubrank = cubrank + 1
210 if(cubrank.eq.2)
then
213 call fvbicub(ict,ivec,ivecd,
214 > fval,ii,jj,xparam,yparam,hx,hxi,hy,hyi,
221 if(maxval(iderivs(1:2,i)).le.1)
then
223 indx=2*iderivs(2,i) + iderivs(1,i) + 1
225 call herm2fcn(ict4,ivec,ivecd,
226 > fval(1,i),ii,jj,xparam,yparam,hx,hxi,hy,hyi,
240 if(cubrank.eq.0)
then
241 if(jspline(1).eq.0)
then
247 if(jspline(2).eq.0)
then
254 if((iderivs(1,i).le.imaxx).and.(iderivs(2,i).le.imaxy))
then
255 if(linrank.eq.2)
then
258 indx=2*iderivs(2,i) + iderivs(1,i) + 1
260 call pc2fcn(ict4,ivec,ivecd,
261 > fval(1,i),ii,jj,xparam,yparam,hx,hxi,hy,hyi,
263 else if(zonrank.eq.2)
then
266 fval(j,i)=fin(1,ii(j),jj(j))
270 if(jspline(1).eq.0)
then
273 if(iderivs(1,i).eq.0)
then
274 fval(j,i)=(one-xparam(j))*fin(1,ii(j),jj(j))
275 > +xparam(j)*fin(1,ii(j)+1,jj(j))
277 fval(j,i)=(fin(1,ii(j)+1,jj(j)) -
278 > fin(1,ii(j),jj(j)))*hxi(j)
284 if(iderivs(2,i).eq.0)
then
285 fval(j,i)=(one-yparam(j))*fin(1,ii(j),jj(j))
286 > +yparam(j)*fin(1,ii(j),jj(j)+1)
288 fval(j,i)=(fin(1,ii(j),jj(j)+1) -
289 > fin(1,ii(j),jj(j)))*hyi(j)
311 if(linrank.eq.1)
then
318 if(jspline(1).ge.1)
then
326 if((maxd_lin(i).le.imaxdlin).and.
327 > (maxd_cub(i).le.imaxdcub))
then
328 if(linrank.eq.1)
then
330 if(jspline(1).ge.1)
then
339 f22(1:2,1)=fin(1:2,i1,i2)
340 f22(1:2,2)=fin(1:2,i1+1,i2)
346 f22(1:2,1)=fin(1:2,i1,i2+1)
347 f22(1:2,2)=fin(1:2,i1+1,i2+1)
354 fval(j,i)=(ans2-ans1)*hyi(j)
356 fval(j,i)=ans2*dxlin + ans1*dxlini
369 f22(1:2,1)=fin(1:2,i1,i2)
370 f22(1:2,2)=fin(1:2,i1,i2+1)
376 f22(1:2,1)=fin(1:2,i1+1,i2)
377 f22(1:2,2)=fin(1:2,i1+1,i2+1)
384 fval(j,i)=(ans2-ans1)*hxi(j)
386 fval(j,i)=ans2*dxlin + ans1*dxlini
393 if(jspline(1).ge.1)
then
400 f22(1:2,1)=fin(1:2,i1,i2)
401 f22(1:2,2)=fin(1:2,i1+1,i2)
416 f22(1:2,1)=fin(1:2,i1,i2)
417 f22(1:2,2)=fin(1:2,i1,i2+1)
448 if(ict(1).le.(2))
then
468 else if(ict(1).eq.3)
then
482 else if(ict(1).eq.4)
then
493 else if(ict(1).eq.5)
then
501 else if(ict(1).eq.6)
then
507 end subroutine dtrans
509 subroutine add1(idx,idy)
512 integer,
intent(in) :: idx,idy
517 if(jspline(1).le.0)
then
526 if(jspline(2).le.0)
then
527 maxd_lin(inum)=max(maxd_lin(inum),idy)
529 maxd_cub(inum)=max(maxd_cub(inum),idy)
536 real,
intent(out) :: ans
542 real :: xpi,xp2,xpi2,cx,cxi,hx2,cxd,cxdi
545 data sixth/0.166666666666666667/
559 ans=xpi*f22(1,1) +xp*f22(1,2)
560 ans=ans+sixth*hx2*(cxi*f22(2,1) +cx*f22(2,2))
562 else if(idcub.eq.1)
then
572 ans=hi*(f22(1,2)-f22(1,1))
573 ans=ans+sixth*h*(cxdi*f22(2,1) +cxd*f22(2,2))
575 else if(idcub.eq.2)
then
579 ans=xpi*f22(2,1) + xp*f22(2,2)
584 ans = hi*(f22(2,2)-f22(2,1))
592 real,
intent(out) :: ans
598 real :: xpi,xp2,xpi2,ax,axbar,bx,bxbar
599 real :: axp,axbarp,bxp,bxbarp
613 ans=axbar*f22(1,1) + ax*f22(1,2)
614 ans=ans + h*(bxbar*f22(2,1) + bx*f22(2,2))
622 bxbarp=xpi*(3.0*xpi-2.0)
624 ans=hi*(axbarp*f22(1,1) +axp*f22(1,2))
625 ans=ans + bxbarp*f22(2,1) + bxp*f22(2,2)