End of file
Contents
Index

      SUBROUTINE PR2TRA (NX,X,Y,F,M,MARK,C,A,IWORK,WK,
     F                   XQUER,YQUER,R)
C
C*****************************************************************
C                                                                *
C  PR2TRA determines a 2-dimensional surface spline for any set  *
C  of triples (X(I),Y(I),F(X(I),Y(I))), I=1, ..., NX. The pairs  *
C  (X(I),Y(I)) must be distinct, i.e., for each value (X,Y) there*
C  must be exactly one value F=F(X,Y), or F must represent a     *
C  functional relation.                                          *
C  The nodes (X(I),Y(I)) do not have to lie on a rectangular     *
C  grid. In fact they can be given in any order. The nodes       *
C  (X(I),Y(I)) are transformed onto the unit circle.             *
C  The degree of smoothness required, i.e., the order of differ- *
C  entiability should not be chosen too high, since the condition*
C  of the linear system of equations that will have to be solved *
C  deteriorates with increasing derivative order. Tests have     *
C  shown that derivative orders between 3 and 5 are advisable.   *
C  Only in some rare cases have higher derivative orders resulted*
C  in noticable improvements. The condition of the system of     *
C  equations also worsens if the number of nodes increases or if *
C  their distance decreases.                                     *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C NX   :  number of nodes                                        *
C X,Y  :  vectors X(1:NX), Y(1:NX); the nodes at which the       *
C         functional values are known                            *
C F    :  vector F(1:NX); containing the functional values at    *
C         the nodes (X(I), Y(I))                                 *
C M    :  derivative order with which the spline coefficients    *
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 X,Y  :  vectors X(1:NX), Y(1:NX); the nodes transformed to the *
C         the unit circle                                        *
C XQUER:  mean of the X(I) values                                *
C YQUER:  mean of the Y(I) values                                *
C R    :  maximal distance of a node (X(I),Y(I)) from their      *
C         center of gravity (XQUER,YQUER)                        *
C                                                                *
C                                                                *
C AUXILIARY PARAMETERS:                                          *
C =====================                                          *
C A    : Vector A(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, CEPSPM, SESSPM, TRCIRC   *
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..   size of the system 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..   transformation of the nodes X(I), Y(I)
C..   to the unit circle
C..
      CALL TRCIRC (X,Y,NX,XQUER,YQUER,R)
C..
C..   formimg 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..   core components G of the matrix:
C..   top left, upper triangle, in condensed form
C..
      CALL GAMMA2 (NX,X,Y,M,A)
C..
C..   initializing 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..   decomposing the system matrix
C..
      CALL CEPSPM (A,NM,C,IWORK,RCOND,A(NM*(NM+1)/2+1),WK)
C..
C..   if the system matrix numerically is singular: stop
C..
      IF (1.0D0 .EQ. 1.0D0+RCOND) THEN
         MARK = 0
         RETURN
      ENDIF
C..
C..   solve the system of equations
C..
      CALL SESSPM (WK,NM,IWORK,C)
      RETURN
      END
C
C

      SUBROUTINE APPRT2 (X0,Y0,NX,M,X,Y,C,AP,XQUER,YQUER,R)
C
C*****************************************************************
C                                                                *
C Evaluation function used for interpolation of the surface      *
C spline.                                                        *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C X0,Y0:  location where the surface spline is to be evaluated   *
C NX   :  number of nodes                                        *
C M    :  derivative order for which the spline coefficients are *
C         determined                                             *
C X,Y  :  vectors X(1:NX), Y(1:NX); the transformed nodes on the *
C         unit circle for which the coefficients were determined *
C C    :  vector C(1:(NX + M*(M+1)/2)); coefficient vector       *
C XQUER:  arithmetic mean of the X(I)                            *
C YQUER:  arithmetic mean of the Y(I)                            *
C R    :  largest distance of a node (X(I),Y(I)) from the center *
C         (XQUER,YQUER)                                          *
C                                                                *
C                                                                *
C OUTPUT PARAMETER:                                              *
C =================                                              *
C AP   :  approximation value of the spline 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..   transformation of the point (X0,Y0), where the evaluation is
C..   to be performed, to the unit circle
C..
      X0 = R * (X0 - XQUER)
      Y0 = R * (Y0 - YQUER)
C..
C..   for different M various cases are considered separately:
C..   1. M = 1, 2, 3 ; special coding, very fast
C..   2. M > 3 ; each monomial is represented in the form (X**IX)*(Y**IY).
C..              A functional evaluation is slow and prone to rounding
C..              errors
C..
C..   the starting polynomial always is 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 core function E
C..
C..   The function E2(X,Y,M) could be called at this point.
C..   However, this would slow down the evaluation con-
C..   siderably. 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
C
C

      SUBROUTINE TRCIRC (X,Y,NX,XQUER,YQUER,R)
C
C*****************************************************************
C                                                                *
C Transformation of the nodes (X(I),Y(I)) to the unit circle.    *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C NX   : number of nodes                                         *
C X,Y  : vectors X(1:NX), X(1:NX); the nodes where the spline    *
C        function is known                                       *
C                                                                *
C                                                                *
C OUTPUT PARAMETERS:                                             *
C ==================                                             *
C X,Y  :  vectors X(1:NX), Y(1:NX); nodes that have been trans-  *
C         formed to the unit circle                              *
C XQUER:  arithmetic mean of the X(I)                            *
C YQUER:  arithmetic mean of the Y(I)                            *
C R    :  largest distance of a node (X(I),Y(I)) from the center *
C         (XQUER,YQUER)                                          *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C subroutines required: none                                     *
C                                                                *
C*****************************************************************
C                                                                *
C author   : Hartmut Turowski                                    *
C date     : 07.23.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..
C..   determine the arithmetic means for
C..   the X(I) and Y(I)
C..
      XQUER = 0.0D0
      YQUER = 0.0D0
      DO   10   I = 1, NX
           XQUER = XQUER + X (I)
           YQUER = YQUER + Y (I)
10    CONTINUE
      XQUER = XQUER / FLOAT (NX)
      YQUER = YQUER / FLOAT (NX)
C..
C..   determine the maximal distance of the nodes
C..   (X(I),Y(I)) from their center of gravity (XQUER,YQUER)
C..
      R = 0.0D0
      DO   20   I = 1, NX
           R = DMAX1 (DSQRT((X(I)-XQUER)**2 + (Y(I)-YQUER)**2),R)
20    CONTINUE
      R = 1.0D0 / R
C..
C..   transformation to the unit circle
C..
      DO   30   I = 1, NX
           X (I) = R * (X (I) - XQUER)
           Y (I) = R * (Y (I) - YQUER)
30    CONTINUE
      RETURN
      END


Begin of file
Contents
Index