End of file
Contents
Index

      SUBROUTINE RENN3D (N,XN,YN,ZN,NK,BETA,B,C,D,T,HELP,IMARK,IERR)
C
C*****************************************************************
C                                                                *
C  The programm RENN3D computes the coefficient vectors B, C and *
C  D, as well as the lengths T(I) of the parameter intervals of  *
C  a closed or open parametric 3-dimensional Renner spline.      *
C  The subsplines are represented in vector form:                *
C                                                                *
C  [X(T)]=[PIX(T)]=[XN(I)+B(I,1)*T+C(I,1)*T**2+D(I,1)*T**3]      *
C  [Y(T)]=[PIY(T)]=[YN(I)+B(I,2)*T+C(I,2)*T**2+D(I,2)*T**3]      *
C  [Z(T)]=[PIZ(T)]=[ZN(I)+B(I,3)*T+C(I,3)*T**2+D(I,3)*T**3]      *
C                                                                *
C  for I=0, ..., N-1 and T a point in the interval [0, T(I)].    *
C                                                                *
C                                                                *
C  ASSUMPTIONS:                                                  *
C  ============    1. N >= 4 or NK >= 4                          *
C                  2. If 0.0 < BETA < 1.0: we must have          *
C                     NK >= N + INT((N+1)/2); otherwise NK = N   *
C                  2. The node (XN(I), YN(I), ZN(I)) cannot be   *
C                     equal to  (XN(I+1),YN(I+1), ZN(I+1))       *
C                     for any I = 0, ..., N-1                    *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  N       : Index of the last node                              *
C  XN      : DOUBLE PRECISION (NK+1)-vector XN(0:NK), containing *
C            the x-coordinates XN(I) of the nodes for I=0,..., N *
C  YN      : DOUBLE PRECISION (NK+1)-vector YN(0:NK), containing *
C            the y-coordinates YN(I) of the nodes for I=0,..., N *
C  ZN      : DOUBLE PRECISION (NK+1)-vector ZN(0:NK), containing *
C            the y-coordinates ZN(I) of the nodes for I=0,..., N *
C  NK      : NK = N + INT((N+1)/2), the maximal number of nodes  *
C            when using rounded corners,                         *
C            i.e. for 0.0 < BETA < 1.0.                          *
C            Without rounding of corners we must have: NK = N.   *
C  BETA    : for 0.0 < BETA < 1.0 corners are rounded; otherwise *
C            corners are kept as corners                         *
C                                                                *
C                                                                *
C  AUXILIARY PARAMETERS:                                         *
C  =====================                                         *
C  HELP    : DOUBLE PRECISION array HELP(-2:NK+1,1:14)           *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  N       : Index of the last node. If 0.0 < BETA < 1.0 , then  *
C            the output value for N can differ from its input.   *
C            When corners are rounded, the node list can be en-  *
C            larged by at most INT((N+1)/2) points.              *
C  T       : DOUBLE PRECISION NK-vector T(0:NK-1),] nodes        *
C            containing the parameter values      ] and          *
C  XN      : DOUBLE PRECISION vector XN(0:NK)     ] coefficients *
C  YN      : DOUBLE PRECISION vector YN(0:NK)     ] of           *
C  ZN      : DOUBLE PRECISION vector ZN(0:NK)     ] the          *
C  B       : DOUBLE PRECISION array B(0:NK-1,1:3) ] subsplines   *
C  C       : DOUBLE PRECISION array C(0:NK-1,1:3) ] for          *
C  D       : DOUBLE PRECISION array D(0:NK-1,1:3) ] I=0, ...,N-1.*
C            If 0.0 < BETA < 1.0, then the nodes XN(I) and FN(I) *
C            can be different from their input values for I=0,...*
C            ..., N                                              *
C                                                                *
C  IMARK   : Pointer                                             *
C            = 0, Subspline is not closed                        *
C            = 1, Subspline is closed                            *
C                                                                *
C  IERR    : Error parameter                                     *
C            =  0, all is ok                                     *
C            = -1, N < 4  or  NK < 4                             *
C            = -2, the assumption                                *
C                  (XN(I), YN(I), ZN(I)) not equal to            *
C                  (XN(I+1), YN(I+1), ZN(I+1)) is violated for   *
C                  some I=0, ..., N-1                            *
C            = -3, NK < N+INT((N+1)/2) while 0.0 < BETA < 1.0    *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: MACHPD                                  *
C                                                                *
C*****************************************************************
C                                                                *
C  Author     : Gisela Engeln-Muellges                           *
C  Date       : 4.7.1993                                         *
C  Source code: FORTRAN 77                                       *
C                                                                *
C*****************************************************************
C
C     Declarations
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION XN(0:NK), YN(0:NK), ZN(0:NK), B(0:NK-1, 1:3),
     +                 C(0:NK-1, 1:3), D(0:NK-1, 1:3), T(0:NK-1),
     +                 HELP(-2:NK+1, 1:14)
      double precision sklprd
C
C     Check input
C
      IERR = 0
      IF (N .LT. 4 .OR. NK .LT. 4) THEN
         IERR = -1
         RETURN
      ENDIF
C
C     If  0.0 < BETA < 1.0  corners are rounded
C
      IF (BETA .GT. 0.0D0             .AND.
     F    BETA .LT. 1.0D0             .AND.
     F    NK   .LT. N+INT(0.5D0*(N+1))     ) THEN
            IERR = -3
            RETURN
      ENDIF
C
C     Compute the machine constant
C
      FMACHP = 1.0D0
    5 FMACHP = 0.5D0 * FMACHP
      IF (MACHPD(1.0D0+FMACHP) .EQ. 1) GOTO 5
      FMACHP = 2.0D0 * FMACHP
      EPS = 4.0D0 * FMACHP
C
C     Calculate the chordal vectors; store their three coordinates
C     in the first three columns of the auxiliary array HELP,
C     the fourth column of HELP contains the length of these chordal vectors.
C
      DO 10, I = 0, N-1
         HELP(I, 1) = XN(I+1) - XN(I)
         HELP(I, 2) = YN(I+1) - YN(I)
         HELP(I, 3) = ZN(I+1) - ZN(I)
         HELP(I, 4) = DSQRT(HELP(I, 1) * HELP(I, 1) +
     F                      HELP(I, 2) * HELP(I, 2) +
     F                      HELP(I, 3) * HELP(I, 3)   )
C
C     we check that all chordal vectors are nonzero, thus
C     verifying that consecutive nodes are distinct.
C
         IF(HELP(I,4) .LE. EPS) THEN
            IERR=-2
            RETURN
         ELSE
C
C    Columns 5 to 7 of HELP contain the three components
C    of the the chordal unit vectors
C
            HELP(I,5)=HELP(I,1)/HELP(I,4)
            HELP(I,6)=HELP(I,2)/HELP(I,4)
            HELP(I,7)=HELP(I,3)/HELP(I,4)
         ENDIF
   10 CONTINUE
C
C     We compute the area of the parallelograms generated by
C     two consecutive chordal vectors and store the results in
C     column 8 of the auxiliary array HELP
C
      DO 20, I = 0, N-2
         sklprd = HELP(I,5)*HELP(I+1,5) +
     F            HELP(I,6)*HELP(I+1,6) +
     F            HELP(I,7)*HELP(I+1,7)
         HELP(I,8)=DSQRT(1.0D0 - sklprd * sklprd)
   20 CONTINUE
C
C     Determine whether the curve is closed or not
C
      IMARK = 0
      IF (DABS(XN(0) - XN(N)) .LE. EPS .AND.
     F    DABS(YN(0) - YN(N)) .LE. EPS .AND.
     F    DABS(ZN(0) - ZN(N)) .LE. EPS      ) THEN
         IMARK = 1
      ENDIF
C
      IF(BETA.GT.0.0D0 .AND. BETA.LT.1.0D0 )THEN
C
C     If 0.0 < BETA < 1.0, round existing corners
C
         IF (IMARK .EQ. 1) THEN
C
C     Curve is closed
C
            XL=HELP(N-2,8)+HELP(0,8)
            sklprd = HELP(N-1,5)*HELP(0,5) +
     F               HELP(N-1,6)*HELP(0,6) +
     F               HELP(N-1,7)*HELP(0,7)
            XR=DSQRT(1.0D0 - sklprd * sklprd)
C
C     Condition for a corner
C
            IF(XL.LE.EPS .AND. XR.GT.EPS) THEN
C
C     Relabel points
C
               DO 30, I = 0, N-1
                  XN(I) = XN(I+1)
                  YN(I) = YN(I+1)
                  ZN(I) = ZN(I+1)
   30          CONTINUE
               XN(N) = XN(0)
               YN(N) = YN(0)
               ZN(N) = ZN(0)
C
C     Relabel chordal data
C
               DO 40 K = 1, 7
                  HELP(N,K) = HELP(0,K)
   40          CONTINUE
               DO 50, I = 0, N-1
                  DO 60, K = 1, 7
                     HELP(I,K) = HELP(I+1,K)
   60             CONTINUE
   50          CONTINUE
C
C     Relabel areas
C
               DO 70, I = 0, N-3
                  HELP(I,8) = HELP(I+1,8)
   70          CONTINUE
               sklprd = HELP(N-2,5)*HELP(N-1,5) +
     F                  HELP(N-2,6)*HELP(N-1,6) +
     F                  HELP(N-2,7)*HELP(N-1,7)
               HELP(N-2,8) = DSQRT(1.0D0 - sklprd * sklprd)
            ENDIF
C
C     Prepare loop
C
            I = 1
            IMAX = N-1
            sklprd = HELP(N-1,5)*HELP(0,5) +
     F               HELP(N-1,6)*HELP(0,6) +
     F               HELP(N-1,7)*HELP(0,7)
            HELP(-1,8) = DSQRT( 1.0D0 - sklprd * sklprd)
            HELP(N-1,8) = HELP(-1,8)
         ELSE
C
C     Curve not closed
C
C     Prepare loop
C
            I = 2
            IMAX = N-2
         ENDIF
\hbox{\JDhspace\verb`
   75    XL = HELP(I-2,8)+HELP(I,8)
         XR = HELP(I-1,8)
C
C     Round existing corners
C
         IF(XL.LE.EPS .AND. XR.GT.EPS)THEN
C
C     Relabel points  I to N
C
            DO 80, J = N, I, -1
               XN(J+1) = XN(J)
               YN(J+1) = YN(J)
               ZN(J+1) = ZN(J)
   80       CONTINUE
C
C    Relabel chordal data for I to N-1
C
            DO 90, J = N-1, I, -1
               DO 100, K = 1, 7
                  HELP(J+1,K) = HELP(J,K)
  100          CONTINUE
   90       CONTINUE
C
C     Relabel areas I to IMAX
C
            DO 110, J = IMAX, I, -1
               HELP(J+1,8) = HELP(J,8)
  110       CONTINUE
C
C     Create two new nodes  I and I+1
C
            XL = HELP(I-1,4)
            XR = HELP(I+1,4)
            XB = BETA*DMIN1(XL,XR)
            XLAMDA = XB/XL
            XMUE   = XB/XR
\hbox{\JDhspace\verb`
            XN(I) = XN(I)-XLAMDA*HELP(I-1,1)
            YN(I) = YN(I)-XLAMDA*HELP(I-1,2)
            ZN(I) = ZN(I)-XLAMDA*HELP(I-1,3)
            XN(I+1) = XN(I+1)+XMUE*HELP(I+1,1)
            YN(I+1) = YN(I+1)+XMUE*HELP(I+1,2)
            ZN(I+1) = ZN(I+1)+XMUE*HELP(I+1,3)
C
C     Compute new chordal data at I-1, I und I+1 and store
C
            DO 120, J = I-1, I+1
               HELP(J, 1) = XN(J+1) - XN(J)
               HELP(J, 2) = YN(J+1) - YN(J)
               HELP(J, 3) = ZN(J+1) - ZN(J)
               HELP(J, 4) = DSQRT(HELP(J, 1) * HELP(J, 1) +
     F                            HELP(J, 2) * HELP(J, 2) +
     F                            HELP(J, 3) * HELP(J, 3)   )
               HELP(J, 5) = HELP(J,1)/HELP(J,4)
               HELP(J, 6) = HELP(J,2)/HELP(J,4)
               HELP(J, 7) = HELP(J,3)/HELP(J,4)
  120       CONTINUE
C
C     Compute new areas at  I-2, I-1, I and I+1, and store
C
            DO 130, J = I-2, I+1
               sklprd = HELP(J,5)*HELP(J+1,5) +
     F                  HELP(J,6)*HELP(J+1,6) +
     F                  HELP(J,7)*HELP(J+1,7)
               HELP(J,8) = DSQRT(1.0D0 - sklprd * sklprd)
  130       CONTINUE
C
C     Increase point count
C
            N = N + 1
            IMAX = IMAX + 1
         ENDIF
C
C     Set index for next point
C
         I = I + 1
         IF(I.LE.IMAX) GOTO 75
C
      ENDIF
C
      IF(IMARK.EQ.1)THEN
C
C     Curve is closed
C
C     Compute additional chordal data and store
C
         DO 140, I = N-2, N-1
            DO 150, K = 1, 7
               HELP(I-N,K) = HELP(I,K)
  150       CONTINUE
  140    CONTINUE
         DO 160, I = 0, 1
            DO 170, K = 1, 7
               HELP(I+N,K) = HELP(I,K)
  170       CONTINUE
  160    CONTINUE
      ELSE
C
C     Curve not closed
C
         DO 180, K = 1, 3
            HELP(-2,K) = 3.D0*HELP(0,K)-2.D0*HELP(1,K)
            HELP(-1,K) = 2.D0*HELP(0,K)-HELP(1,K)
  180    CONTINUE
C
C     Compute additional chordal data at -2, -1, N and N+1
C
         DO 190, I = -2, -1
            HELP(I,4) = DSQRT( HELP(I,1)*HELP(I,1)
     F                        +HELP(I,2)*HELP(I,2)
     F                        +HELP(I,3)*HELP(I,3))
            IF(HELP(I,4).GT.EPS)THEN
               HELP(I, 5) = HELP(I,1)/HELP(I,4)
               HELP(I, 6) = HELP(I,2)/HELP(I,4)
               HELP(I, 7) = HELP(I,3)/HELP(I,4)
            ELSE
               HELP(I, 5) = 0.0D0
               HELP(I, 6) = 0.0D0
               HELP(I, 7) = 0.0D0
            ENDIF
  190    CONTINUE
         DO 200, K = 1, 3
            HELP(N,K)   = 2.D0*HELP(N-1,K)-HELP(N-2,K)
            HELP(N+1,K) = 3.D0*HELP(N-1,K)-2.D0*HELP(N-2,K)
  200    CONTINUE
         DO 210, I = N, N+1
            HELP(I,4) = DSQRT( HELP(I,1)*HELP(I,1)
     F                        +HELP(I,2)*HELP(I,2)
     F                        +HELP(I,3)*HELP(I,3))
            IF(HELP(I,4).GT.EPS)THEN
               HELP(I, 5) = HELP(I,1)/HELP(I,4)
               HELP(I, 6) = HELP(I,2)/HELP(I,4)
               HELP(I, 7) = HELP(I,3)/HELP(I,4)
            ELSE
               HELP(I, 5) = 0.0D0
               HELP(I, 6) = 0.0D0
               HELP(I, 7) = 0.0D0
            ENDIF
  210    CONTINUE
      ENDIF
C
C     Compute new areas for  -2, -1, N-1 and N
C
      DO 220, I = -2, -1
         sklprd = HELP(I,5)*HELP(I+1,5) +
     F            HELP(I,6)*HELP(I+1,6) +
     F            HELP(I,7)*HELP(I+1,7)
         HELP(I,8) = DSQRT(1.0D0 - sklprd * sklprd)
  220 CONTINUE
      DO 230, I = N-1, N
         sklprd = HELP(I,5)*HELP(I+1,5) +
     F            HELP(I,6)*HELP(I+1,6) +
     F            HELP(I,7)*HELP(I+1,7)
         HELP(I,8) = DSQRT(1.0D0 - sklprd * sklprd)
  230 CONTINUE
C
C     Compute the left and right hand unit tangent vectors and store in
C     columns 9 to 11 and 12 to 14 of HELP, respectively
C
      DO 240, I = 0, N
         XL = HELP(I-2,8)
         XR = HELP(I,8)
         IF(XL+XR.GT.EPS)THEN
            ALPHA = XL/(XL+XR)
            DO 250, K = 1,3
               HELP(I,K+8) = HELP(I-1,K)+ALPHA*(HELP(I,K)-HELP(I-1,K))
  250       CONTINUE
            HELPT = DSQRT(  HELP(I,9)*HELP(I,9)
     F                    + HELP(I,10)*HELP(I,10)
     F                    + HELP(I,11)*HELP(I,11) )
            HELP(I,9) = HELP(I,9)/HELPT
            HELP(I,10) = HELP(I,10)/HELPT
            HELP(I,11) = HELP(I,11)/HELPT
            HELP(I,12) = HELP(I,9)
            HELP(I,13) = HELP(I,10)
            HELP(I,14) = HELP(I,11)
         ELSE
            DO 260, K = 5, 7
               HELP(I,K+4) = HELP(I-1,K)
               HELP(I,K+7) = HELP(I,K)
  260       CONTINUE
         ENDIF
  240 CONTINUE
C
C     Compute the lengths of the parameter intervals
C
      DO 270, I = 0, N-1
         TS1 = HELP(I,12)+HELP(I+1,9)
         TS2 = HELP(I,13)+HELP(I+1,10)
         TS3 = HELP(I,14)+HELP(I+1,11)
         A1 = 16.0D0-(TS1*TS1+TS2*TS2+TS3*TS3)
         B1 = 6.0D0*(HELP(I,1)*TS1+HELP(I,2)*TS2+HELP(I,3)*TS3)
         C1 = 36.0D0*HELP(I,4)*HELP(I,4)
         T(I) = (-B1+DSQRT(B1*B1+A1*C1))/A1
         HELPT = 1.0D0/T(I)
C
C     Compute the spline coefficient vectors
C
         DO 280, K = 1, 3
            B(I,K) = HELP(I,K+11)
            C(I,K) = (3.0D0*HELPT*HELP(I,K)-2.0D0*B(I,K)
     F                                     -HELP(I+1,K+8))*HELPT
            D(I,K) = (B(I,K)+HELP(I+1,K+8)-2.0D0*HELPT*HELP(I,K))
     F                                              *HELPT*HELPT
  280    CONTINUE
  270 CONTINUE
C
      RETURN
      END


Begin of file
Contents
Index