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