End of file
Contents
Index



F 13.2 Renner Subsplines


      SUBROUTINE RENN2D (N,XN,YN,NK,BETA,B,C,D,T,HELP,IMARK,IERR)
C
C*****************************************************************
C                                                                *
C  The programm RENN2D 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 2-dimensional parametric 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                                                                *
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), FN(I)) cannot be equal to *
C                     (XN(I+1),FN(I+1)) for all 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  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:10)           *
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 the       *
C  B       : DOUBLE PRECISION array B(0:NK-1,1:2) ] subsplines   *
C  C       : DOUBLE PRECISION array C(0:NK-1,1:2) ] for          *
C  D       : DOUBLE PRECISION array D(0:NK-1,1:2) ] 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), FN(I)) not equal to (XN(I+1), FN(I+1)) *
C                 is violated for 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       : 3.29.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), B(0:NK-1, 1:2),
     +                 C(0:NK-1, 1:2), D(0:NK-1, 1:2), T(0:NK-1),
     +                 HELP(-2:NK+1, 1:10)
C
C     Check input parameters
C
      IERR = 0
      IF (N .LT. 4 .OR. NK .LT. 4) THEN
         IERR = -1
         RETURN
      ENDIF
      IF (BETA .GT. 0.0D0 .AND. 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 first and second coordinates
C     in the first and second column of the auxiliary array HELP,
C     the third 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) = DSQRT(HELP(I, 1) * HELP(I, 1) +
     F                         HELP(I, 2) * HELP(I, 2))
C
C     We check that all chordal vectors are nonzero, thus
C     verifying that consecutive nodes are distinct.
C
         IF (HELP(I, 3) .LE. EPS) THEN
            IERR = -2
            RETURN
         ELSE
C
C    Columns 4 and 5 of HELP contain the first two components
C    of the chordal unit vectors
C
            HELP(I,4) = HELP(I,1)/HELP(I,3)
            HELP(I,5) = HELP(I,2)/HELP(I,3)
         ENDIF
   10 CONTINUE
C
C     We compute the area of the parellelograms generated by two
C     consecutive chordal vectors (magnitude of their determinant)
C     and store the results in column 6 of the auxiliary array HELP
C
      DO 20, I = 0, N-2
         HELP(I, 6) = DABS(HELP(I, 4) * HELP(I+1, 5) -
     F                     HELP(I, 5) * HELP(I+1, 4))
   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) THEN
         IMARK = 1
      ENDIF
C
C     If 0.0 < BETA < 1.0, we round corners if such exist
C
      IF (BETA .GT. 0.0D0 .AND. BETA .LT. 1.0D0 ) THEN
         IF(IMARK .EQ. 1) THEN
C
C     Curve closed
C
           XL = HELP(N-2,6) + HELP(0,6)
           XR = DABS(HELP(N-1,4)*HELP(0,5) - HELP(0,4)*HELP(N-1,5))
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)
   30        CONTINUE
             XN(N) = XN(0)
             YN(N) = YN(0)
C
C     Relabel chordal vectors, their lengths, and the unit chordal vectors
C
             DO 40, K = 1,5
                HELP(N,K) = HELP(0,K)
   40        CONTINUE
             DO 50, I = 0, N-1
                DO 60, K = 1,5
                   HELP(I,K) = HELP(I+1,K)
   60           CONTINUE
   50       CONTINUE
C
C      Relabel areas
C
            DO 70, I = 0,N-3
               HELP(I,6) = HELP(I+1,6)
   70       CONTINUE
            HELP(N-2,6) = DABS(HELP(N-2,4)
     F      *HELP(N-1,5) - HELP(N-1,4) * HELP(N-2,5))
          ENDIF
C
C     Prepare loop
C
          I = 1
          IMAX = N - 1
          HELP(-1,6) = DABS(HELP(N-1,4)*
     F    HELP(0,5) - HELP(0,4) * HELP(N-1,5))
          HELP(N-1,6) = HELP(-1,6)
      ELSE
C
C     Curve is not closed
C
C
C     Prepare loop
C
          I = 2
          IMAX = N-2
      ENDIF
\hbox{\JDhspace\verb`
   75 XL = HELP(I-2,6) + HELP(I,6)
      XR = HELP(I-1,6)
C
C    Round existing corners
C
      IF(XL .LE. EPS .AND. XR .GT. EPS) THEN
C
C    Shift index for points  I to N
C
         DO 80, J = N,I,-1
            XN(J+1) = XN(J)
            YN(J+1) = YN(J)
   80    CONTINUE
\hbox{\JDhspace\verb`
C
C    Relabel chordal vectors, their length, and chordal unit vectors
C    for I to N-1
C
         DO 90, J = N-1,I,-1
            DO 100, K = 1,5
               HELP(J+1,K) = HELP(J,K)
  100       CONTINUE
   90    CONTINUE
C
C    Relabel areas indexed I to IMAX
C
         DO 110, J = IMAX,I,-1
            HELP(J+1,6) = HELP(J,6)
  110    CONTINUE
C
C    Create two new points I and I+1
C
         XL = HELP(I-1,3)
         XR = HELP(I+1,3)
         XB = BETA * DMIN1(XL,XR)
         XLAMDA = XB/XL
         XMUE = XB/XR
         XN(I) = XN(I) - XLAMDA*HELP(I-1,1)
         YN(I) = YN(I) - XLAMDA*HELP(I-1,2)
         XN(I+1) = XN(I+1) + XMUE*HELP(I+1,1)
         YN(I+1) = YN(I+1) + XMUE*HELP(I+1,2)
C
C      Recompute the new chordal vectors, their length, and the corresponding
C      unit vectors for the three points  I-1, I, 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) = DSQRT(HELP(J,1) *
     F        HELP(J,1) + HELP(J,2) * HELP(J,2))
            HELP(J,4) = HELP(J,1)/HELP(J,3)
            HELP(J,5) = HELP(J,2)/HELP(J,3)
  120    CONTINUE
C
C     Recompute the areas for I-2, I-1, I, I+1
C
         DO 130, J = I-2, I+1
            HELP(J,6) = DABS(HELP(J,4) *
     F        HELP(J+1,5) - HELP(J+1,4) * HELP(J,5))
  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
      ENDIF
\hbox{\JDhspace\verb`
      IF( IMARK .EQ. 1) THEN
C
C     Curve is closed
C
C
C     Prepare additional chordal vectors, lengths, unit chordal vectors
C     for the four points  -2, -1, N, N+1 and store
C
         DO 140, I = N-2, N-1
            DO 150 K = 1,5
               HELP(I-N,K) = HELP(I,K)
  150       CONTINUE
  140    CONTINUE
         DO 160, I = 0,1
            DO 170 K = 1,5
               HELP(I+N,K) = HELP(I,K)
  170       CONTINUE
  160    CONTINUE
      ELSE
C
C     Curve is not closed
C
         DO 180, K = 1,2
            HELP(-2,K) = 3.0D0 * HELP(0,K) -2.0D0 * HELP(1,K)
            HELP(-1,K) = 2.0D0 * HELP(0,K) - HELP(1,K)
  180    CONTINUE
C
C     Compute additional chordal vectors, length, and unit chordal vectors
C     for the 4 points  -2, -1, N, N+1 and store
C
         DO 190, I = -2,-1
            HELP(I,3) = DSQRT(HELP(I,1) * HELP(I,1) +
     F                  HELP(I,2) * HELP(I,2))
            IF(HELP(I,3) .GT. EPS) THEN
               HELP(I,4) = HELP(I,1)/HELP(I,3)
               HELP(I,5) = HELP(I,2)/HELP(I,3)
            ELSE
               HELP(I,4) = 0.0D0
               HELP(I,5) = 0.0D0
            ENDIF
  190    CONTINUE
         DO 200, K = 1,2
            HELP(N,K)   = 2.0D0 * HELP(N-1,K) - HELP(N-2,K)
            HELP(N+1,K) = 3.0D0 * HELP(N-1,K) - 2.0D0 * HELP(N-2,K)
  200    CONTINUE
         DO 210, I = N,N+1
            HELP(I,3) = DSQRT(HELP(I,1) * HELP(I,1) +
     F                 HELP(I,2) * HELP(I,2))
            IF(HELP(I,3) .GT. EPS) THEN
               HELP(I,4) = HELP(I,1)/HELP(I,3)
               HELP(I,5) = HELP(I,2)/HELP(I,3)
            ELSE
               HELP(I,4) = 0.0D0
               HELP(I,5) = 0.0D0
            ENDIF
  210    CONTINUE
      ENDIF
C
C     Compute additional areas at  -2, -1, N-1, N
C
      DO 220, I = -2, -1
            HELP(I,6) = DABS(HELP(I,4) * HELP(I+1,5)
     F                  - HELP(I+1,4) * HELP(I,5))
  220 CONTINUE
      DO 230, I = N-1, N
            HELP(I,6) = DABS(HELP(I,4) * HELP(I+1,5)
     F                  - HELP(I+1,4) * HELP(I,5))
  230 CONTINUE
C
C     Compute the left and right hand unit tangent vectors and
C     store in columns 7, 8, and 9, 10 of HELP, respectively
C
      DO 240, I = 0,N
         XL = HELP(I-2,6)
         XR = HELP(I,6)
         IF(XL + XR .GT. EPS) THEN
            ALPHA = XL/(XL + XR)
            DO 250 K = 1,2
               HELP(I,K+6) = HELP(I-1,K) +
     F           ALPHA * (HELP(I,K) - HELP(I-1,K))
  250       CONTINUE
            HELPT = DSQRT(HELP(I,7) * HELP(I,7) + HELP(I,8) * HELP(I,8))
            HELP(I,7) = HELP(I,7)/HELPT
            HELP(I,8) = HELP(I,8)/HELPT
            HELP(I,9) = HELP(I,7)
            HELP(I,10) = HELP(I,8)
         ELSE
            DO 260, K =4,5
               HELP(I,K+3) = HELP(I-1,K)
               HELP(I,K+5) = HELP(I,K)
  260       CONTINUE
         ENDIF
  240 CONTINUE
      DO 270, I = 0,N-1
C
C    Compute the parameter interval lengths
C
         TS1 = HELP(I,9) + HELP(I+1,7)
         TS2 = HELP(I,10) + HELP(I+1,8)
         A1 = 16.0D0 - (TS1*TS1 + TS2*TS2)
         B1 = 6.0D0 * (HELP(I,1)*TS1 + HELP(I,2)*TS2)
         C1 = 36.0D0 * HELP(I,3) * HELP(I,3)
         T(I) = (-B1+DSQRT(B1*B1 + A1*C1))/A1
         HELPT = 1.0D0/T(I)
C
C     Compute spline coefficient vectors
C
         DO 280, K = 1,2
            B(I,K) = HELP(I,K+8)
            C(I,K) = (3.0D0 * HELPT * HELP(I,K) -
     F        2.0D0 * B(I,K) - HELP(I+1,K+6)) * HELPT
            D(I,K) = ( B(I,K) + HELP(I+1,K+6) -
     F        2.0D0 * HELPT *HELP(I,K)) * HELPT * HELPT
  280    CONTINUE
  270 CONTINUE
      RETURN
      END


Begin of file
Contents
Index