End of file
Contents
Index

      SUBROUTINE SHPFLG(X,Y,FX,FY,F,W,R,EPS,N,DMUE,RR,PHI,IERR)

C********************************************************************
C                                                                   *
C   Program name: SHPFLG                                            *
C                                                                   *
C********************************************************************
C                                                                   *
C   This subroutine computes one functional value at (X,Y) for given*
C   nodes using the local Shepard method and Franke-Little weights. *
C   The exponent dmue and the radius rr must be specified externally*
C   DMUE should be chosen to lie betwen 2 and 6.                    *
C   The radius RR should be so that the circle of radius RR around  *
C   (X,Y) contains some nodes.                                      *
C                                                                   *
C********************************************************************
C                                                                   *
C   Input parameters:                                               *
C   =================                                               *
C   X    :  X value for which we want to interpolate the Z value    *
C   Y    :  Y value for which we want to interpolate the Z value    *
C   FX, FY, F   :  vectors ..(0:N) with X and Y coordinates of nodes*
C                  (FX,FY) and corresponding functional value F.    *
C   N    :  Index of last node                                      *
C   DMUE :  Exponent, 0 < DMUE < infinity, reasonable results can   *
C           be achieved for 2 < DMUE < 6. If on input DMUE <= 0, we *
C           set DMUE = 2 internally.                                *
C   RR   :  Radius around (X,Y) inside which all nodes are used to  *
C           interpolate at (X,Y).                                   *
C                                                                   *
C                                                                   *
C   AUX VECTORS:                                                    *
C   ============                                                    *
C   W, R, EPS   : vectors ..(0:N)                                   *
C                                                                   *
C                                                                   *
C   Output parameters:                                              *
C   ==================                                              *
C   PHI  : Interpolated Z value at (X,Y)                            *
C   IERR : Error parameter:                                         *
C          = 0 : all correct                                        *
C          = 1 : Sum of Franke-Little weights is zero               *
C                                                                   *
C                                                                   *
C********************************************************************
C                                                                   *
C   Required subroutines: none                                      *
C                                                                   *
C********************************************************************
C                                                                   *
C   Author      : Bjoern Terwege                                    *
C   Date        : 6.12.1995                                         *
C   Source code : FORTRAN 77                                        *
C                                                                   *
C********************************************************************
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION R(0:N),W(0:N),FX(0:N),FY(0:N),F(0:N),EPS(0:N)
      IERR=0
C
C  Check that DMUE > 0, otherwise set DMUE = 2
C
      IF(DMUE.LE.0) DMUE=2
C
C  Check that  RR > 0, otherwise set RR = 0.1
C
      IF(RR.LE.0) RR=0.1
C
C  Compute the R(I)
C
      DO 20 I=0,N
           R(I)=DSQRT(((X-FX(I))*(X-FX(I)))+
     F          ((Y-FY(I))*(Y-FY(I))))
           IF (R(I).EQ.0) THEN
                PHI=F(I)
                GOTO 111
            ENDIF
20    CONTINUE
C
C  Compute the EPS(I)
C
      DO 40 I=0,N
          IF(R(I).GE.RR) THEN
              EPS(I)=0
          ELSE
              EPS(I)=1-(R(I)/RR)
          ENDIF
40    CONTINUE
C
C  Compute the numerators needed for the weights
C
      SUM=0
      DO 50 I=0,N
          SUM=SUM+EPS(I)**DMUE
50    CONTINUE
      IF(SUM.EQ.0) THEN
           IERR=1
           GOTO 111
      ENDIF
C
C  Compute the weights
C
      DO 60 J=0,N
          W(J)=(EPS(J)**DMUE)/SUM
60    CONTINUE
C
C  Compute the approximate function value at (X,Y)
C
      PHI=0
      DO 70 I=0,N
           PHI=PHI+W(I)*F(I)
70    CONTINUE
111   CONTINUE
      RETURN
      END


Begin of file
Contents
Index