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