End of file
Contents
Index
SUBROUTINE BICSP3(N,M,A,X,Y,FN,F,IERR)
C
C*****************************************************************
C *
C Determining bicubic splines for given functional values and *
C surface normals at all points. *
C *
C *
C INPUT PARAMETERS: *
C ================= *
C N : number of X-intervals *
C M : number of Y-intervals *
C A : 4-dimensional array A(0:N,0:M,0:KDIM,0:LDIM); contains *
C the spline coefficients. On call, A(I,J,0,0) must *
C contain the functional values U(I,J). *
C BICSP1 determines all other A(I,J,K,L) for I=0 to N-1 *
C and J=0 to M-1. Elements A(N,M,K,L), that are not *
C assigned a value on call, remain unassigned. *
C X : (N+1)-vector X(0:N) containing the endpoints of the *
C X-intervals *
C Y : (N+1)-vector Y(0:M) containing the endpoints of the *
C Y-intervals *
C FN : 3-dimensional array FN(0:N,0:M,1:3) containing the *
C normal vectors at all points. *
C F : auxiliary vector F(1:9*MAX(N,M)-8) *
C IERR : is initially set to 0. Will be set different from zero *
C if the algorithm detects an error. If errors occur *
C the program does not complete the calculations. *
C *
C----------------------------------------------------------------*
C *
C subroutines required: BIC3S1, BIC2S3, BIC1S3, BIC1S4, BIC1S5, *
C BIC1S6, BIC1S7, BIC1S8, BIC1S9, TRIDIG *
C *
C*****************************************************************
C *
C author : Eberhard Heyne *
C date : 02.15.1983 *
C source : FORTRAN 77 *
C *
C*****************************************************************
C
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
PARAMETER (KDIM=3,LDIM=3)
C
DIMENSION A(0:N,0:M,0:KDIM,0:LDIM),X(0:N),Y(0:M),F(*)
DIMENSION AA(0:3,0:3),FN(0:N,0:M,1:3)
C
C* steps 1 and 2
C
CALL BIC3S1(N,M,A,FN,JERR)
IF(JERR .NE. 0) RETURN
IERR=JERR
C
C* splitting of vector F for finding X values
C
IH=1
ISA=IH+N
ISB=ISA+N-1
ISC=ISB+N-1
ISD=ISC+N-1
ISX=ISD+N-1
ISGAMM=ISX+N-1
ISALPH=ISGAMM+N-1
ISG=ISALPH+N-1
C
C* splitting of the vector F for finding Y values
C
JH=1
JSA=JH+M
JSB=JSA+M-1
JSC=JSB+M-1
JSD=JSC+M-1
JSX=JSD+M-1
JSGAMM=JSX+M-1
JSALPH=JSGAMM+M-1
JSG=JSALPH+M-1
C
C* step 3
C
CALL BIC2S3(N,M,A,X,F(IH),JERR)
IERR=JERR+4
IF(JERR .NE. 0) RETURN
C
C* step 3 continued
C
CALL BIC1S3(N,M,A,X,
+ F(IH),F(ISA),F(ISB),F(ISC),F(ISD),F(ISX),
+ F(ISGAMM),F(ISALPH),F(ISG),JERR)
IERR=JERR+4
IF(JERR .NE. 0) RETURN
C
C* step 4
C
CALL BIC1S4(N,M,A,Y,
+ F(JH),F(JSA),F(JSB),F(JSC),F(JSD),F(JSX),
+ F(JSGAMM),F(JSALPH),F(JSG),JERR)
IERR=JERR+6
IF(JERR .NE. 0) RETURN
C
C* steps 5, 6, 7 are contained in step 8
C* loops over all X and Y values
C
DO 112 I=0,N-1
DO 111 J=0,M-1
CALL BIC1S8(N,M,A,X,Y,I,J,AA)
C
C* transfer AA to A
C
CALL BIC1S9(N,M,A,I,J,AA)
111 CONTINUE
112 CONTINUE
C
C* all spline-coefficients are determined now
C
IERR=0
RETURN
END
C
C
SUBROUTINE BIC3S1(N,M,A,FN,IERR)
C
C*****************************************************************
C *
C step 1 and step 2: *
C *
C----------------------------------------------------------------*
C *
C subroutines required: none *
C *
C*****************************************************************
C *
C author : Eberhard Heyne *
C date : 02.15.1983 *
C source : FORTRAN 77 *
C *
C*****************************************************************
C
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
PARAMETER (KDIM=3,LDIM=3)
C
DIMENSION A(0:N,0:M,0:KDIM,0:LDIM),FN(0:N,0:M,3)
C
C* The array FN contains of the normal vectors
C
DO 102 I=0,N
DO 101 J=0,M
IF(FN(I,J,3) .EQ. 0.0D0) GOTO 900
A(I,J,1,0)=-FN(I,J,1)/FN(I,J,3)
A(I,J,0,1)=-FN(I,J,2)/FN(I,J,3)
101 CONTINUE
102 CONTINUE
IERR=0
RETURN
C
C* error, third component of one normal vector is zero
C
900 IERR=1
RETURN
END
Begin of file
Contents
Index