SUBROUTINE INTERAD (mode,ndp ,xin,yin,datain, a nxpts,nypts,imx,xg,yg,value,wno,idn,ncount,DIST) c USE setparms c PARAMETER (NOBMX=5) DIMENSION wno(NOBMX,IMX,nypts) DIMENSION IDN(NOBMX,IMX,nypts) DIMENSION NCOUNT(IMX,nypts) DIMENSION xin(NDP),yin(NDP),xg(IMX),yg(nypts) DIMENSION datain(NDP),value(IMX,nypts),DIST(NDP) integer(kind = int_single) :: ISMIN,IDMIN C RINF=1.5 RINFSQ=RINF*RINF A=1. B=5./(RINF*RINF) c print*,'ndp,nxpts,nypts,NOBMX',ndp,nxpts,nypts,NOBMX IF (MODE.GT.1) goto 210 DO 200 JN=1,nypts DO 200 IN=1,nxpts c calculate distance from old to new DO 100 ND=1,NDP DIST(ND)=(xin(ND)-xg(IN))**2 + (yin(ND)-yg(JN))**2 100 continue NCT=0 DO 150 NC=1,NOBMX c IMIN=MINVAL(DIST,NDP)+1 if (kind(dist) == real_single) then IMIN=ISMIN (NDP,DIST,1) else if (kind(dist) == real_double) then IMIN=IDMIN (NDP,DIST,1) endif IF (DIST(IMIN).GT.RINFSQ) GOTO 175 NCT=NCT+1 NCOUNT(IN,JN)=NCT WNO(NC,IN,JN)=(A*EXP(- B *DIST(IMIN))) IDN(NC,IN,JN)=IMIN DIST(IMIN)=999. 150 CONTINUE 175 CONTINUE 200 CONTINUE C C FOR MODE > 1 START INTERPOLATION HERE...WTS ALREADY CALCULATED C NOW DO INTERPOLATION ........... 210 DO 300 JN=1,nypts DO 300 IN=1,nxpts VSUM=0 SUM=0 DO 250 IC=1,NCOUNT(IN,JN) VSUM=VSUM+DATAIN(IDN(IC,IN,JN))*WNO(IC,IN,JN) SUM=SUM+WNO(IC,IN,JN) c print*,'sum=',sum,' vsum=',vsum 250 CONTINUE VALUE(IN,JN)=VSUM/SUM c print*,'value',value(IN,JN) 300 CONTINUE return end