copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r nav_3df *integer function nav_3df (unf,halox,haloy,ext) 3 implicit none * integer unf,halox,haloy real ext * #include "lcldim.cdk"
#include "rec.cdk"
#include "partopo.cdk"
#include "ifd.cdk"
* logical needitx,needity,wb,eb,sb,nb,done integer i,j,nia,nja,i0,j0 real xi,xf,yi,yf,resa,xda,xfa,yda,yfa,xir,xfr,yir,yfr,epsilon parameter (epsilon = 1.0e-5) *----------------------------------------------------------------------- * * Compute xi,xf,yi,yf: lower-left/upper-right corners defining required * input data coverage for hor. interpolation * i = gc_ld(1,myproc) + halox*(1-west ) j = gc_ld(3,myproc) + haloy*(1-south) xir = xpx(i)+epsilon yir = ypx(j)+epsilon xi = xpx(i)+ext*(xpx(i)-xpx(i+1)) yi = ypx(j)+ext*(ypx(j)-ypx(j+1)) i = gc_ld(2,myproc) + halox + halox*east j = gc_ld(4,myproc) + haloy + haloy*north xfr = xpx(i)-epsilon yfr = ypx(j)-epsilon xf = xpx(i)+ext*(xpx(i)-xpx(i-1)) yf = ypx(j)+ext*(ypx(j)-ypx(j-1)) * * Considering data coverage of individual input files, determine * which files are needed for local target data coverage of myproc * and verify that input data coverage is sufficient. * ifd_nf = 1 ifd_niad = 200000 ifd_njad = 200000 ifd_niaf =-200000 ifd_njaf =-200000 wb = .false. eb = .false. sb = .false. nb = .false. * 1 read (unf,304,end=2) i0,j0, $ ifd_xia(ifd_nf),ifd_xfa(ifd_nf), $ ifd_yia(ifd_nf),ifd_yfa(ifd_nf), nia, nja write (ifd_fnext(ifd_nf),'((i7.7),a1,(i7.7))') i0,'-',j0 needitx = .false. needity = .false. resa = (ifd_xfa(ifd_nf)-ifd_xia(ifd_nf))/(nia-1)*1.5 xda = ifd_xia(ifd_nf)-resa xfa = ifd_xfa(ifd_nf)+resa resa = (ifd_yfa(ifd_nf)-ifd_yia(ifd_nf))/(nja-1)*1.5 yda = ifd_yia(ifd_nf)-resa yfa = ifd_yfa(ifd_nf)+resa * if (xda.lt.xi) then if (xfa.ge.xi) needitx=.true. else if (xda.le.xf) needitx=.true. endif if (yda.lt.yi) then if (yfa.ge.yi) needity=.true. else if (yda.le.yf) needity=.true. endif * ifd_needit(ifd_nf) = .false. if (needitx.and.needity) then read(ifd_fnext(ifd_nf)(1:7 ),'(i)') ifd_minx(ifd_nf) read(ifd_fnext(ifd_nf)(9:15),'(i)') ifd_miny(ifd_nf) ifd_maxx(ifd_nf) = ifd_minx(ifd_nf) + nia - 1 ifd_maxy(ifd_nf) = ifd_miny(ifd_nf) + nja - 1 ifd_niad = min(ifd_niad,ifd_minx(ifd_nf)) ifd_njad = min(ifd_njad,ifd_miny(ifd_nf)) ifd_niaf = max(ifd_niaf,ifd_maxx(ifd_nf)) ifd_njaf = max(ifd_njaf,ifd_maxy(ifd_nf)) ifd_needit(ifd_nf) = .true. wb = wb .or. (ifd_xia(ifd_nf).le.xir) eb = eb .or. (ifd_xfa(ifd_nf).ge.xfr) sb = sb .or. (ifd_yia(ifd_nf).le.yir) nb = nb .or. (ifd_yfa(ifd_nf).ge.yfr) endif ifd_nf = ifd_nf + 1 goto 1 2 ifd_nf = ifd_nf - 1 close (unf) * nav_3df = 0 if (.not.((wb).and.(eb).and.(sb).and.(nb))) then write (6,202) wb,eb,sb,nb,myproc nav_3df = -1 endif * 202 format (/' INSUFFICIENT INPUT DATA COVERAGE: ',4L, $ ', PROC#:',i4,' --ABORT--'/) 304 format (2i8,4e15.7,2i10) *----------------------------------------------------------------------- return end