End of file
Contents
Index



F 12.2 Two-Dimensional Interpolating Surface Splines


      SUBROUTINE PROB2 (NX,X,Y,F,M,MARK,C,A,IWORK,WK)
C
C*****************************************************************
C                                                                *
C PROB2 determines 2-dimensional surface splines for a given set *
C of triples (X(I),Y(I), F(X(I),Y(I)), I=1, ..., NX. The points  *
C (X(I),Y(I)) must be distinct. For each pair (X,Y) there must   *
C be precisely one value F=F(X,Y), i.e., F has to be a function. *
C The nodes do not have to lie on a rectangular grid and may be  *
C ordered in any way. It is advisable to transform the nodes     *
C (X(I),Y(I)) to the unit circle. A program for this is included.*
C The derivative order should not be chosen too high, since the  *
C condition of the system of linear equations that must be       *
C solved worsens with increasing derivative order. Tests have    *
C shown that derivative orders between 3 and 5 are preferred.    *
C Only in a few of our tests have higher derivative orders       *
C resulted in marked improvements. The condition of the system   *
C matrix will also deteriorate with an increasing number of      *
C nodes or a decreasing distance between the nodes.              *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C NX   : number of nodes                                         *
C X,Y  : vectors X(1:NX), Y(1:NX); the nodes for which the       *
C        function values are known                               *
C F    : vector F(1:NX); the function values at the given nodes  *
C M    : derivative order for which the coefficients are to be   *
C        determined                                              *
C                                                                *
C                                                                *
C OUTPUT PARAMETERS:                                             *
C ==================                                             *
C C    : vector C(1:(NX + M*(M+1)/2)); the coefficients of the   *
C        spline function                                         *
C MARK : indicates whether the system of equations is solvable   *
C        MARK = 1:  everything o.k.                              *
C        MARK = 0:  system matrix is numerically singular        *
C                                                                *
C                                                                *
C AUXILIARY VARIABLES:                                           *
C ====================                                           *
C A    : vector (1:(NX + M*(M+1)/2)*(3 + NX + M*(M+1)/2)/2)      *
C IWORK: INTEGER vector IWORK(1:(NX + M*(M+1)/2))                *
C WK   : vector WK(1:(NX+M*(M+1)/2)*((NX+M*(M+1)/2)+1)/2)        *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C subroutines required: ALPHA2, GAMMA2, NEXT2, E2, CEPSPM,       *
C                       SESSPM                                   *
C                                                                *
C*****************************************************************
C                                                                *
C author   : Richard Reuter, 1983                                *
C editor   : Hartmut Turowski                                    *
C date     : 06.10.1988                                          *
C source   : FORTRAN 77                                          *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C..
C..   declarations
C..
      DIMENSION  X(NX),Y(NX),F(NX),C(NX+M*(M+1)/2),
     F           A((NX+M*(M+1)/2)*(3+NX+M*(M+1)/2)/2),
     F           WK((NX+M*(M+1)/2)*((NX+M*(M+1)/2)+1)/2)
      INTEGER IWORK(NX+M*(M+1)/2)
C..
C..   order of the matrix
C..
      NM = NX + M*(M+1)/2
C..
C..   indicator for the polynomial components of the matrix
C..
      NXX = 1 + NX*(NX+1)/2
C..
C..   initializing the error parameter
C..
      MARK = 1
C..
C..   forming the matrix:
C..   polynomial components P: top right, in condensed form
C..
      CALL ALPHA2(NX,X,Y,M,A(NXX),IWORK(1),IWORK(1+(M+1)*M/2))
C..
C..   kernel component G of the matrix:
C..   top left, upper triangle in condensed form
C..
      CALL GAMMA2(NX,X,Y,M,A)
C..
C..   preparation of the right-hand side
C..
      DO 20 I = 1,NX
            C(I) = F(I)
   20 CONTINUE
      DO 30 I = NX+1, NM
            C(I) = 0.0D0
   30 CONTINUE
C..
C..   decomposition the system matrix of the linear equations
C..
      CALL CEPSPM(A,NM,C,IWORK,RCOND,A(NM*(NM+1)/2+1),WK)
C..
C..   if the matrix is numerically singular: stop
C..
      IF (1.0D0 .EQ. 1.0D0+RCOND) THEN
         MARK = 0
         RETURN
      ENDIF
C..
C..   solving the system of equations
C..
      CALL SESSPM(WK,NM,IWORK,C)
      RETURN
      END
C
C

      SUBROUTINE ALPHA2 (NX,X,Y,M,A,IDX,IDY)
C
C*****************************************************************
C                                                                *
C Determine the polynomial components P of the syatem matrix.    *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C NX   : number of nodes                                         *
C X,Y  : vectors X(1:NX), Y(1:NX); the nodes for which the       *
C        function values are known                               *
C M    : derivative order for which the coefficients are to      *
C        be determined                                           *
C                                                                *
C                                                                *
C OUTPUT PARAMETERS:                                             *
C ==================                                             *
C A    : vector                                                  *
C        A(1:(NX * (M*(M+1)/2) + (M*(M+1)/2 * (1+M*(M+1)/2)/2)));*
C        the polynomial components of the matrix in condensed    *
C        form                                                    *
C                                                                *
C                                                                *
C AUXILIARY VARIABLES:                                           *
C ====================                                           *
C IDX  : INTEGER vector IDX(1:((M+1)*(M+2)/2))                   *
C IDY  : INTEGER vector IDY(1:((M+1)*(M+2)/2))                   *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C subroutines required: NEXT2                                    *
C                                                                *
C*****************************************************************
C                                                                *
C author   : Richard Reuter, 1983                                *
C editor   : Hartmut Turowski                                    *
C date     : 06.10.1988                                          *
C source   : FORTRAN 77                                          *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C..
C..   declarations
C..
      DIMENSION X(NX),Y(NX),
     F          A(NX*M*(M+1)/2+(M*(M+1)/2*(1+M*(M+1)/2)/2))
      INTEGER IDX((M+1)*(M+2)/2),IDY((M+1)*(M+2)/2)
C..
C..   the first monomial is 1.0
C..
      DO 10 I = 1, NX
         A(I) = 1.0D0
   10 CONTINUE
      A(NX+1) = 0.0D0
      IDX(1) = 0
      IDY(1) = 0
      DO 50 I = 2, M*(M+1)/2
C..
C..   determine the index of the monomial that is to be
C..   multiplied by X or Y
C..
         CALL NEXT2(I-1,IDX,IDY,IXY,K01)
         KL = IXY*(IXY-1)/2 + NX*(IXY-1)
         KLI= I  *(I  -1)/2 + NX*(I  -1)
         IF (K01 .EQ. 1) THEN
            DO 20 J = 1, NX
               A(KLI+J) = A(KL+J)*X(J)
   20       CONTINUE
         ELSE
            DO 30 J = 1, NX
               A(KLI+J) = A(KL+J)*Y(J)
   30       CONTINUE
         ENDIF
C..
C..    assign zero to the remaining matrix elements
C..
         DO 40 J = KLI+NX+1, KLI+NX+I
            A(J) = 0.0D0
   40    CONTINUE
   50 CONTINUE
      RETURN
      END
C
C

      SUBROUTINE NEXT2 (I,IDX,IDY,IXY,K)
C
C*****************************************************************
C                                                                *
C Auxiliary routine for efficiently determining all 2-dimensional*
C monomials up to degree M; see SUBROUTINE ALPHA2.               *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C I   : index of the 2-dimensional monomial determined previously*
C IDX : vector IDX(1:(I+1)); powers of X of the monomials with   *
C       index 1 to I                                             *
C IDY : vector IDY(1:(I+1)); powers of Y of the monomials with   *
C       index 1 to I                                             *
C                                                                *
C                                                                *
C OUTPUT PARAMETERS:                                             *
C ==================                                             *
C IDX : vector IDX(1:(I+1)); IDX(I+1) is the power of X of the   *
C       monomial with index I+1                                  *
C IDY : vector IDY(1:(I+1)); IDY(I+1) is the power of Y of the   *
C       monomial with index I+1                                  *
C IXY : index of the monomial, that is to be multiplied by X or  *
C       Y in order to obtain the (I+1)-st monomial.              *
C K   : switching variable, multiplication by X or by Y          *
C       K=1 :  monom(I+1) = monom(IXY)*X                         *
C       K=0 :  monom(I+1) = monom(IXY)*Y                         *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C subroutines required: none                                     *
C                                                                *
C*****************************************************************
C                                                                *
C author   : Richard Reuter, 1983                                *
C editor   : Hartmut Turowski                                    *
C date     : 06.10.1988                                          *
C source   : FORTRAN 77                                          *
C                                                                *
C*****************************************************************
C
C..
C..   declarations
C..
      INTEGER IDX(I+1),IDY(I+1)
C..
      N = IDX(I) + IDY(I)
      IF (IDX(I) .EQ. 0) THEN
         IDX(I+1) = N + 1
         IDY(I+1) = 0
         DO 10 J = 1, I
            IF (IDX(J) .EQ. N) GOTO 20
   10    CONTINUE
   20    CONTINUE
         IXY = J
         K   = 1
      ELSE
         IDX(I+1) = IDX(I) - 1
         IDY(I+1) = IDY(I) + 1
         DO 30 J = 1, I
            IF ((IDX(J) .EQ. IDX(I)-1) .AND.
     F          (IDY(J) .EQ. IDY(I))) GOTO 40
   30    CONTINUE
   40    CONTINUE
         IXY = J
         K   = 0
      ENDIF
      RETURN
      END
C
C

      SUBROUTINE GAMMA2 (NX,X,Y,M,A)
C
C*****************************************************************
C                                                                *
C Initializing the kernel function components G of the matrix.   *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C NX   : number of nodes                                         *
C X,Y  : vectors X(1:NX), Y(1:NX); the nodes for which the       *
C        coefficients are being determined                       *
C M    : derivative order for which the coefficients are         *
C        determined                                              *
C                                                                *
C                                                                *
C OUTPUT PARAMETERS:                                             *
C ==================                                             *
C A    : vector A(1:(NX*(NX+1)/2)); kernel function components   *
C        of the system matrix in condensed form                  *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C subroutines required: E2                                       *
C                                                                *
C*****************************************************************
C                                                                *
C author   : Richard Reuter, 1983                                *
C editor   : Hartmut Turowski                                    *
C date     : 06.10.1988                                          *
C source   : FORTRAN 77                                          *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C..
C..   declarations
C..
      DIMENSION X(NX),Y(NX),A(NX*(NX+1)/2)
C..
C..   determine the kernel function components G
C..
      L = 0
      DO 20 I = 1, NX
         DO 10 K = 1, I - 1
            L = L + 1
            A(L) = E2(X(K)-X(I),Y(K)-Y(I),M)
   10    CONTINUE
         L = L + 1
C..
C..   set the main diagonal of G equal to zero;
C..   (we are dealing with interpolating splines)
C..
         A(L) = 0.0D0
   20 CONTINUE
      RETURN
      END
C
C

      DOUBLE PRECISION FUNCTION E2 (X,Y,M)
C
C*****************************************************************
C                                                                *
C Evaluation of E at (X,Y). (See formula (12.19))                *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C X,Y : point where evaluation is to be performed                *
C M   : derivative order                                         *
C                                                                *
C                                                                *
C OUTPUT PARAMETER:                                              *
C =================                                              *
C E2  : functional value in DOUBLE PRECISION                     *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C subroutines required: none                                     *
C                                                                *
C*****************************************************************
C                                                                *
C author   : Richard Reuter                                      *
C editor   : Hartmut Turowski                                    *
C date     : 06.10.1988                                          *
C source   : FORTRAN 77                                          *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C..
C..   determine the kernel function
C..
      R2 = X*X + Y*Y
      IF (R2 .EQ. 0.0D0) THEN
         E2 = 0.0D0
      ELSE
         E2 = DLOG(R2) * R2**(M-1)
      ENDIF
      RETURN
      END
C
C

      SUBROUTINE APPRX2 (X0,Y0,NX,M,X,Y,C,AP)
C
C*****************************************************************
C                                                                *
C Evaluation function for the interpolation.                     *
C                                                                *
C                                                                *
C INPUT PARAMETER:                                               *
C ================                                               *
C X0,Y0: point where the function is to be evaluated             *
C NX   : number of nodes                                         *
C M    : derivative order for which the coefficients were        *
C        determined                                              *
C X,Y  : vectors X(1:NX), Y(1:NX); the nodes for which the       *
C        coefficients were determined                            *
C C    : vector C(1:(NX + M*(M+1)/2)); coefficient vector        *
C                                                                *
C                                                                *
C OUTPUT PARAMETER:                                              *
C =================                                              *
C AP   : approximate value for E at (X0,Y0)                      *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C subroutines required: none                                     *
C                                                                *
C*****************************************************************
C                                                                *
C author   : Richard Reuter, 1983                                *
C editor   : Hartmut Turowski                                    *
C date     : 06.10.1988                                          *
C source   : FORTRAN 77                                          *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C..
C..   declarations
C..
      DIMENSION X(NX),Y(NX),C(NX+M*(M+1)/2)
C..
C..   for differing M the evaluations are performed differently:
C..   1. M = 1, 2, 3 ; specially coded, hence fast
C..   2. M > 3 ; each monomial is represented in the form
C..              (X**IX)*(Y**IY). The evaluation is slow and prone
C..              to rounding errors.
C..
C..   the first polynomial is always taken equal to 1
C..
      AP = C(NX+1)
      IF (M .EQ. 1) GOTO 20
      IF (M .EQ. 2) THEN
         AP = AP + C(NX+2)*X0 + C(NX+3)*Y0
      ELSE IF (M .EQ. 3) THEN
         AP = AP + (C(NX+2) + C(NX+4)*X0 + C(NX+5)*Y0)*X0
     F           + (C(NX+3) + C(NX+6)*Y0)*Y0
      ELSE
         IX = 0
         IY = 0
         DO 10 I = 2, M*(M+1)/2
            IF (IX .EQ. 0) THEN
               IX = IY + 1
               IY = 0
                  AP = AP + C(NX+I)*(X0**IX)
            ELSE
               IX = IX - 1
               IY = IY + 1
               IF (IX .EQ. 0) THEN
                     AP = AP + C(NX+I)*(Y0**IY)
               ELSE
                     AP = AP + C(NX+I)*(X0**IX)*(Y0**IY)
               ENDIF
            ENDIF
   10    CONTINUE
      ENDIF
   20 CONTINUE
C..
C..   component of the kernel function E
C..
C..   The function E2(X,Y,M) could be called at this point.
C..   However, this would slow down the evaluation considerably.
C..   Thus, a direct code is performed.
C..
      DO 30 I = 1, NX
            R2 = (X(I) - X0)**2 + (Y(I) - Y0)**2
            IF (R2 .EQ. 0.0D0) R2 = 1.0D0
            AP = AP + C(I)*DLOG(R2)*R2**(M-1)
   30 CONTINUE
      RETURN
      END


Begin of file
Contents
Index