C      ALGORITHM 761, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE,
C      VOL. 22, NO. 3, September, 1996, P.  362--371.
C

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	Doc
#	Drivers
#	Src
# This archive created: Wed Sep 25 11:42:20 1996
export PATH; PATH=/bin:$PATH
if test ! -d 'Doc'
then
	mkdir 'Doc'
fi
cd 'Doc'
cd ..
if test ! -d 'Drivers'
then
	mkdir 'Drivers'
fi
cd 'Drivers'
if test ! -d 'Sp'
then
	mkdir 'Sp'
fi
cd 'Sp'
if test -f 'RES'
then
	echo shar: will not over-write existing file "'RES'"
else
cat << \SHAR_EOF > 'RES'
TPSD3P



   Input data        NDP = 30

      I      XD     YD     ZD          I      XD     YD     ZD    
 
      1    11.16   1.24  22.15        16    14.59   8.71  14.81   
      2      .00    .00  58.20        17    10.28  15.16  21.59   
      3    24.20  16.23   2.83        18    15.20    .00  21.60   
      4     9.66  20.00   4.73        19     4.51  20.00  15.61   
      5    19.85  10.72   7.97        20     5.23  10.72  26.50   
 
      6     5.22  14.66  40.36        21      .00   4.48  61.77   
      7    10.35   4.11  22.33        22     2.14  15.03  53.10   
      8    11.77  10.47  13.62        23    16.70  19.65   6.31   
      9    19.72   1.39  16.83        24      .51   8.37  49.43   
     10    15.10  17.19  12.57        25     6.08   4.58  35.74   
 
     11      .00  20.00  34.60        26    25.00  20.00    .60   
     12    25.00   3.87   8.74        27    25.00  11.87   4.40   
     13    20.87  20.00   5.74        28    21.67  14.36   5.52   
     14    25.00    .00  12.00        29    14.90   3.12  21.70   
     15    19.99   4.62  14.72        30     3.31    .13  44.08   
TPSD3P              Part 1.  Program Check for SDBI3P
 



Calculation by points

                     ZI values                            Differences

                     ZI1(XI,YI)                           DZI1(XI,YI)
   XI    YI=                                  YI=
           .00   5.00  10.00  15.00  20.00      .00   5.00  10.00  15.00  20.00

 
  .00    58.20  60.75  49.32  71.20  34.60      .00    .00    .00    .00    .00
 
 5.00    37.45  39.37  27.61  41.39  14.82      .00    .00    .00    .00    .00
 
10.00    25.13  21.97  16.36  22.34   4.12      .00    .00    .00    .00    .00
 
15.00    21.69  20.17  12.98  12.24   3.73      .00    .00    .00    .00    .00
 
20.00    17.17  14.44   8.23   7.52   6.34      .00    .00    .00    .00    .00
 
25.00    12.00   8.00   5.27   2.97    .60      .00    .00    .00    .00    .00
 



Calculation by columns

                     ZI values                            Differences

                     ZI2(XI,YI)                           DZI2(XI,YI)
   XI    YI=                                  YI=
           .00   5.00  10.00  15.00  20.00      .00   5.00  10.00  15.00  20.00

 
  .00    58.20  60.75  49.32  71.20  34.60      .00    .00    .00    .00    .00
 
 5.00    37.45  39.37  27.61  41.39  14.82      .00    .00    .00    .00    .00
 
10.00    25.13  21.97  16.36  22.34   4.12      .00    .00    .00    .00    .00
 
15.00    21.69  20.17  12.98  12.24   3.73      .00    .00    .00    .00    .00
 
20.00    17.17  14.44   8.23   7.52   6.34      .00    .00    .00    .00    .00
 
25.00    12.00   8.00   5.27   2.97    .60      .00    .00    .00    .00    .00
TPSD3P              Part 2.  Program Check for SDSF3P
 



Calculation with MD=1

                     ZI values                            Differences

                     ZI3(XI,YI)                           DZI3(XI,YI)
   XI    YI=                                  YI=
           .00   5.00  10.00  15.00  20.00      .00   5.00  10.00  15.00  20.00

 
  .00    58.20  60.75  49.32  71.20  34.60      .00    .00    .00    .00    .00
 
 5.00    37.45  39.37  27.61  41.39  14.82      .00    .00    .00    .00    .00
 
10.00    25.13  21.97  16.36  22.34   4.12      .00    .00    .00    .00    .00
 
15.00    21.69  20.17  12.98  12.24   3.73      .00    .00    .00    .00    .00
 
20.00    17.17  14.44   8.23   7.52   6.34      .00    .00    .00    .00    .00
 
25.00    12.00   8.00   5.27   2.97    .60      .00    .00    .00    .00    .00
 



Calculation with MD=2

                     ZI values                            Differences

                     ZI4(XI,YI)                           DZI4(XI,YI)
   XI    YI=                                  YI=
           .00   5.00  10.00  15.00  20.00      .00   5.00  10.00  15.00  20.00

 
  .00    58.20  60.75  49.32  71.20  34.60      .00    .00    .00    .00    .00
 
 5.00    37.45  39.37  27.61  41.39  14.82      .00    .00    .00    .00    .00
 
10.00    25.13  21.97  16.36  22.34   4.12      .00    .00    .00    .00    .00
 
15.00    21.69  20.17  12.98  12.24   3.73      .00    .00    .00    .00    .00
 
20.00    17.17  14.44   8.23   7.52   6.34      .00    .00    .00    .00    .00
 
25.00    12.00   8.00   5.27   2.97    .60      .00    .00    .00    .00    .00
SHAR_EOF
fi # end of overwriting check
if test -f 'driver.f'
then
	echo shar: will not over-write existing file "'driver.f'"
else
cat << \SHAR_EOF > 'driver.f'
      PROGRAM TPSD3P
*
* Test Program for the SDBI3P/SDSF3P subroutine package
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This program calls the SDBI3P and SDSF3P subroutines.
*
* This program requires no input data files.
*
* This program creates the WFSD3P file.  All elements of the
* DZI1, DZI2, DZI3, and DZI4 arrays in this file are expected
* to be zero.
*
* Specification Statements
*     .. Parameters ..
      INTEGER          NEWPG
      PARAMETER        (NEWPG=210000000)
      INTEGER          NDP,NXI,NYI
      PARAMETER        (NDP=30,NXI=6,NYI=5)
*     ..
*     .. Local Scalars ..
      INTEGER          I,IDP,IER,IXI,IYI,L,MD,NDPO2
      CHARACTER*6      NMPR,NMWF
*     ..
*     .. Local Arrays ..
      REAL             DZI1(NXI,NYI),DZI2(NXI,NYI),DZI3(NXI,NYI),
     +                 DZI4(NXI,NYI),WK(30,17),XD(NDP),XI(NXI),YD(NDP),
     +                 YI(NYI),YIP(NXI),ZD(NDP),ZI1(NXI,NYI),
     +                 ZI2(NXI,NYI),ZI3(NXI,NYI),ZI4(NXI,NYI),
     +                 ZIE(NXI,NYI)
      INTEGER          IWK(30,25)
*     ..
*     .. External Subroutines ..
      EXTERNAL         SDBI3P,SDSF3P
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        ABS,MOD
*     ..
*     .. Equivalences ..
      EQUIVALENCE      (WK(1,1),IWK(1,20))
*     ..
* Data statements
      DATA             NMPR/'TPSD3P'/,NMWF/'WFSD3P'/
      DATA             (XD(I),YD(I),ZD(I),I=1,NDP)/11.16,1.24,22.15,
     +                 0.00,0.00,58.20,24.20,16.23,2.83,9.66,20.00,4.73,
     +                 19.85,10.72,7.97,5.22,14.66,40.36,10.35,4.11,
     +                 22.33,11.77,10.47,13.62,19.72,1.39,16.83,15.10,
     +                 17.19,12.57,0.00,20.00,34.60,25.00,3.87,8.74,
     +                 20.87,20.00,5.74,25.00,0.00,12.00,19.99,4.62,
     +                 14.72,14.59,8.71,14.81,10.28,15.16,21.59,15.20,
     +                 0.00,21.60,4.51,20.00,15.61,5.23,10.72,26.50,
     +                 0.00,4.48,61.77,2.14,15.03,53.10,16.70,19.65,
     +                 6.31,0.51,8.37,49.43,6.08,4.58,35.74,25.00,20.00,
     +                 0.60,25.00,11.87,4.40,21.67,14.36,5.52,14.90,
     +                 3.12,21.70,3.31,0.13,44.08/
      DATA             XI/0.00,5.00,10.00,15.00,20.00,25.00/
      DATA             YI/0.00,5.00,10.00,15.00,20.00/
      DATA             ((ZIE(IXI,IYI),IYI=1,NYI),IXI=1,NXI)/58.200,
     +                 60.751,49.315,71.203,34.600,37.450,39.375,27.607,
     +                 41.386,14.817,25.125,21.969,16.364,22.338,4.122,
     +                 21.687,20.165,12.983,12.236,3.726,17.171,14.442,
     +                 8.227,7.519,6.342,12.000,8.004,5.267,2.965,0.60/
*     ..
* Opens the output file.
      OPEN (6,FILE=NMWF)
* Writes the input data.
      WRITE (6,FMT=9000) NMPR,NDP
      NDPO2 = NDP/2
      DO 10 L = 1,NDPO2
          IF (MOD(L,5).EQ.1) WRITE (6,FMT=9010)
          WRITE (6,FMT=9020) (IDP,XD(IDP),YD(IDP),ZD(IDP),IDP=L,NDP,
     +      NDPO2)
   10 CONTINUE
* Calculates and writes the output results.
* Part 1.  Program check for SDBI3P
*   Subpart 1.1.  Calculation of each ZI value at a point
      DO 30 IYI = 1,NYI
          DO 20 IXI = 1,NXI
              IF (IXI.EQ.1 .AND. IYI.EQ.1) THEN
                  MD = 1
              ELSE
                  MD = 3
              END IF
              CALL SDBI3P(MD,NDP,XD,YD,ZD,1,XI(IXI),YI(IYI),
     +                    ZI1(IXI,IYI),IER, WK,IWK)
              IF (IER.GT.0) STOP
              DZI1(IXI,IYI) = ABS(ZI1(IXI,IYI)-ZIE(IXI,IYI))
   20     CONTINUE
   30 CONTINUE
      WRITE (6,FMT=9030) NEWPG,NMPR
      WRITE (6,FMT=9040)
      WRITE (6,FMT=9050) YI,YI
      WRITE (6,FMT=9060) (XI(IXI), (ZI1(IXI,IYI),IYI=1,NYI),
     +  (DZI1(IXI,IYI),IYI=1,NYI),IXI=1,NXI)
*   Subpart 1.2.  Calculation of ZI values for each YI value
      DO 60 IYI = 1,NYI
          IF (IYI.EQ.1) THEN
              MD = 1
          ELSE
              MD = 3
          END IF
          DO 40 IXI = 1,NXI
              YIP(IXI) = YI(IYI)
   40     CONTINUE
          CALL SDBI3P(MD,NDP,XD,YD,ZD,NXI,XI,YIP, ZI2(1,IYI),IER,
     +                WK,IWK)
          IF (IER.GT.0) STOP
          DO 50 IXI = 1,NXI
              DZI2(IXI,IYI) = ABS(ZI2(IXI,IYI)-ZIE(IXI,IYI))
   50     CONTINUE
   60 CONTINUE
      WRITE (6,FMT=9070)
      WRITE (6,FMT=9050) YI,YI
      WRITE (6,FMT=9060) (XI(IXI), (ZI2(IXI,IYI),IYI=1,NYI),
     +  (DZI2(IXI,IYI),IYI=1,NYI),IXI=1,NXI)
* Part 2.  Program check for SDSF3P
*   Subpart 2.1.  Calculation with MD=1
      CALL SDSF3P(1,NDP,XD,YD,ZD,NXI,XI,NYI,YI, ZI3,IER, WK,IWK)
      IF (IER.GT.0) STOP
      DO 80 IYI = 1,NYI
          DO 70 IXI = 1,NXI
              DZI3(IXI,IYI) = ABS(ZI3(IXI,IYI)-ZIE(IXI,IYI))
   70     CONTINUE
   80 CONTINUE
      WRITE (6,FMT=9080) NEWPG,NMPR
      WRITE (6,FMT=9090)
      WRITE (6,FMT=9050) YI,YI
      WRITE (6,FMT=9060) (XI(IXI), (ZI3(IXI,IYI),IYI=1,NYI),
     +  (DZI3(IXI,IYI),IYI=1,NYI),IXI=1,NXI)
*   Subpart 2.2.  Calculation with MD=2
      CALL SDSF3P(2,NDP,XD,YD,ZD,NXI,XI,NYI,YI, ZI4,IER, WK,IWK)
      IF (IER.GT.0) STOP
      DO 100 IYI = 1,NYI
          DO 90 IXI = 1,NXI
              DZI4(IXI,IYI) = ABS(ZI4(IXI,IYI)-ZIE(IXI,IYI))
   90     CONTINUE
  100 CONTINUE
      WRITE (6,FMT=9100)
      WRITE (6,FMT=9050) YI,YI
      WRITE (6,FMT=9060) (XI(IXI), (ZI4(IXI,IYI),IYI=1,NYI),
     +  (DZI4(IXI,IYI),IYI=1,NYI),IXI=1,NXI)
      STOP
* Format Statements
 9000 FORMAT (A6,/,/,/,/,'   Input data        NDP =',I3,/,/,
     +       2 ('      I      XD     YD     ZD    '))
 9010 FORMAT (1X)
 9020 FORMAT (2 (5X,I2,2X,3F7.2,3X))
 9030 FORMAT (A1,A6,14X,'Part 1.  Program Check for SDBI3P')
 9040 FORMAT (1X,/,/,/,/,'Calculation by points',/,/,21X,'ZI values',
     +       28X,'Differences',/,/,21X,'ZI1(XI,YI)',27X,'DZI1(XI,YI)')
 9050 FORMAT ('   XI    YI=',34X,'YI=',/,5X,2 (2X,5F7.2),/)
 9060 FORMAT (1X,/,F5.2,2X,5F7.2,2X,5F7.2)
 9070 FORMAT (1X,/,/,/,/,'Calculation by columns',/,/,21X,'ZI values',
     +       28X,'Differences',/,/,21X,'ZI2(XI,YI)',27X,'DZI2(XI,YI)')
 9080 FORMAT (A1,A6,14X,'Part 2.  Program Check for SDSF3P')
 9090 FORMAT (1X,/,/,/,/,'Calculation with MD=1',/,/,21X,'ZI values',
     +       28X,'Differences',/,/,21X,'ZI3(XI,YI)',27X,'DZI3(XI,YI)')
 9100 FORMAT (1X,/,/,/,/,'Calculation with MD=2',/,/,21X,'ZI values',
     +       28X,'Differences',/,/,21X,'ZI4(XI,YI)',27X,'DZI4(XI,YI)')
      END

SHAR_EOF
fi # end of overwriting check
cd ..
cd ..
if test ! -d 'Src'
then
	mkdir 'Src'
fi
cd 'Src'
if test ! -d 'Sp'
then
	mkdir 'Sp'
fi
cd 'Sp'
if test -f 'tripack.f'
then
	echo shar: will not over-write existing file "'tripack.f'"
else
cat << \SHAR_EOF > 'tripack.f'
      SUBROUTINE ADDNOD(K,XK,YK,IST,NCC,LCC,N,X,Y,LIST,LPTR,LEND,LNEW,
     +                  IER)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   08/25/91
*
*   Given a triangulation of N nodes in the plane created by
* subroutine TRMESH or TRMSHR, this subroutine updates the
* data structure with the addition of a new node in position
* K.  If node K is inserted into X and Y (K .LE. N) rather
* than appended (K = N+1), then a corresponding insertion
* must be performed in any additional arrays associated
* with the nodes.  For example, an array of data values Z
* must be shifted down to open up position K for the new
* value:  set Z(I+1) to Z(I) for I = N,N-1,...,K.  For
* optimal efficiency, new nodes should be appended whenever
* possible.  Insertion is necessary, however, to add a non-
* constraint node when constraints are present (refer to
* subroutine ADDCST).
*
*   Note that a constraint node cannot be added by this
* routine.  In order to insert a constraint node, it is
* necessary to add the node with no constraints present
* (call this routine with NCC = 0), update LCC by increment-
* ing the appropriate entries, and then create (or restore)
* the constraints by a call to ADDCST.
*
*   The algorithm consists of the following steps:  node K
* is located relative to the triangulation (TRFIND), its
* index is added to the data structure (INTADD or BDYADD),
* and a sequence of swaps (SWPTST and SWAP) are applied to
* the arcs opposite K so that all arcs incident on node K
* and opposite node K (excluding constraint arcs) are local-
* ly optimal (satisfy the circumcircle test).  Thus, if a
* (constrained) Delaunay triangulation is input, a (con-
* strained) Delaunay triangulation will result.  All indexes
* are incremented as necessary for an insertion.
*
*
* On input:
*
*       K = Nodal index (index for X, Y, and LEND) of the
*           new node to be added.  1 .LE. K .LE. LCC(1).
*           (K .LE. N+1 if NCC=0).
*
*       XK,YK = Cartesian coordinates of the new node (to be
*               stored in X(K) and Y(K)).  The node must not
*               lie in a constraint region.
*
*       IST = Index of a node at which TRFIND begins the
*             search.  Search time depends on the proximity
*             of this node to node K.  1 .LE. IST .LE. N.
*
*       NCC = Number of constraint curves.  NCC .GE. 0.
*
* The above parameters are not altered by this routine.
*
*       LCC = List of constraint curve starting indexes (or
*             dummy array of length 1 if NCC = 0).  Refer to
*             subroutine ADDCST.
*
*       N = Number of nodes in the triangulation before K is
*           added.  N .GE. 3.  Note that N will be incre-
*           mented following the addition of node K.
*
*       X,Y = Arrays of length at least N+1 containing the
*             Cartesian coordinates of the nodes in the
*             first N positions with non-constraint nodes
*             in the first LCC(1)-1 locations if NCC > 0.
*
*       LIST,LPTR,LEND,LNEW = Data structure associated with
*                             the triangulation of nodes 1
*                             to N.  The arrays must have
*                             sufficient length for N+1
*                             nodes.  Refer to TRMESH.
*
* On output:
*
*       LCC = List of constraint curve starting indexes in-
*             cremented by 1 to reflect the insertion of K
*             unless NCC = 0 or IER .NE. 0.
*
*       N = Number of nodes in the triangulation including K
*           unless IER .NE. 0.  Note that all comments refer
*           to the input value of N.
*
*       X,Y = Arrays updated with the insertion of XK and YK
*             in the K-th positions (node I+1 was node I be-
*             fore the insertion for I = K to N if K .LE. N)
*             unless IER .NE. 0.
*
*       LIST,LPTR,LEND,LNEW = Data structure updated with
*                             the addition of node K unless
*                             IER .NE. 0.
*
*       IER = Error indicator:
*             IER =  0 if no errors were encountered.
*             IER = -1 if K, IST, NCC, N, or an LCC entry is
*                      outside its valid range on input.
*             IER = -2 if all nodes (including K) are col-
*                      linear.
*             IER =  L if nodes L and K coincide for some L.
*             IER = -3 if K lies in a constraint region.
*
*             The errors conditions are tested in the order
*             specified.
*
* Modules required by ADDNOD:  BDYADD, CRTRI, INDXCC,
*                                INSERT, INTADD, LEFT,
*                                LSTPTR, SWAP, SWPTST,
*                                TRFIND
*
* Intrinsic function called by ADDNOD:  ABS
*
************************************************************
*
*     .. Scalar Arguments ..
      REAL             XK,YK
      INTEGER          IER,IST,K,LNEW,N,NCC
*     ..
*     .. Array Arguments ..
      REAL             X(*),Y(*)
      INTEGER          LCC(*),LEND(*),LIST(*),LPTR(*)
*     ..
*     .. Local Scalars ..
      INTEGER          I,I1,I2,I3,IBK,IN1,IO1,IO2,KK,L,LCCIP1,LP,LPF,
     +                 LPO1,NM1
*     ..
*     .. External Functions ..
      INTEGER          INDXCC,LSTPTR
      LOGICAL          CRTRI,SWPTST
      EXTERNAL         INDXCC,LSTPTR,CRTRI,SWPTST
*     ..
*     .. External Subroutines ..
      EXTERNAL         BDYADD,INTADD,SWAP,TRFIND
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        ABS
*     ..
      KK = K
*
* Test for an invalid input parameter.
*
      IF (KK.LT.1 .OR. IST.LT.1 .OR. IST.GT.N .OR. NCC.LT.0 .OR.
     +    N.LT.3) GO TO 70
      LCCIP1 = N + 1
      DO 10 I = NCC,1,-1
          IF (LCCIP1-LCC(I).LT.3) GO TO 70
          LCCIP1 = LCC(I)
   10 CONTINUE
      IF (KK.GT.LCCIP1) GO TO 70
*
* Find a triangle (I1,I2,I3) containing K or the rightmost
*   (I1) and leftmost (I2) visible boundary nodes as viewed
*   from node K.
*
      CALL TRFIND(IST,XK,YK,X,Y,LIST,LPTR,LEND,I1,I2,I3)
*
* Test for collinear nodes, duplicate nodes, and K lying in
*   a constraint region.
*
      IF (I1.EQ.0) GO TO 80
      IF (I3.NE.0) THEN
          L = I1
          IF (XK.EQ.X(L) .AND. YK.EQ.Y(L)) GO TO 90
          L = I2
          IF (XK.EQ.X(L) .AND. YK.EQ.Y(L)) GO TO 90
          L = I3
          IF (XK.EQ.X(L) .AND. YK.EQ.Y(L)) GO TO 90
          IF (NCC.GT.0 .AND. CRTRI(NCC,LCC,I1,I2,I3)) GO TO 100

      ELSE
*
*   K is outside the convex hull of the nodes and lies in a
*     constraint region iff an exterior constraint curve is
*     present.
*
          IF (NCC.GT.0 .AND. INDXCC(NCC,LCC,N,LIST,LEND).NE.
     +        0) GO TO 100
      END IF
*
* No errors encountered.
*
      IER = 0
      NM1 = N
      N = N + 1
      IF (KK.LT.N) THEN
*
* Open a slot for K in X, Y, and LEND, and increment all
*   nodal indexes which are greater than or equal to K.
*   Note that LIST, LPTR, and LNEW are not yet updated with
*   either the neighbors of K or the edges terminating on K.
*
          DO 20 IBK = NM1,KK,-1
              X(IBK+1) = X(IBK)
              Y(IBK+1) = Y(IBK)
              LEND(IBK+1) = LEND(IBK)
   20     CONTINUE
          DO 30 I = 1,NCC
              LCC(I) = LCC(I) + 1
   30     CONTINUE
          L = LNEW - 1
          DO 40 I = 1,L
              IF (LIST(I).GE.KK) LIST(I) = LIST(I) + 1
              IF (LIST(I).LE.-KK) LIST(I) = LIST(I) - 1
   40     CONTINUE
          IF (I1.GE.KK) I1 = I1 + 1
          IF (I2.GE.KK) I2 = I2 + 1
          IF (I3.GE.KK) I3 = I3 + 1
      END IF
*
* Insert K into X and Y, and update LIST, LPTR, LEND, and
*   LNEW with the arcs containing node K.
*
      X(KK) = XK
      Y(KK) = YK
      IF (I3.EQ.0) THEN
          CALL BDYADD(KK,I1,I2,LIST,LPTR,LEND,LNEW)

      ELSE
          CALL INTADD(KK,I1,I2,I3,LIST,LPTR,LEND,LNEW)
      END IF
*
* Initialize variables for optimization of the triangula-
*   tion.
*
      LP = LEND(KK)
      LPF = LPTR(LP)
      IO2 = LIST(LPF)
      LPO1 = LPTR(LPF)
      IO1 = ABS(LIST(LPO1))
*
* Begin loop:  find the node opposite K.
*
   50 LP = LSTPTR(LEND(IO1),IO2,LIST,LPTR)
      IF (LIST(LP).LT.0) GO TO 60
      LP = LPTR(LP)
      IN1 = ABS(LIST(LP))
      IF (CRTRI(NCC,LCC,IO1,IO2,IN1)) GO TO 60
*
* Swap test:  if a swap occurs, two new arcs are
*             opposite K and must be tested.
*
      IF (.NOT.SWPTST(IN1,KK,IO1,IO2,X,Y)) GO TO 60
      CALL SWAP(IN1,KK,IO1,IO2,LIST,LPTR,LEND,LPO1)
      IO1 = IN1
      GO TO 50
*
* No swap occurred.  Test for termination and reset
*   IO2 and IO1.
*
   60 IF (LPO1.EQ.LPF .OR. LIST(LPO1).LT.0) RETURN
      IO2 = IO1
      LPO1 = LPTR(LPO1)
      IO1 = ABS(LIST(LPO1))
      GO TO 50
*
* A parameter is outside its valid range on input.
*
   70 IER = -1
      RETURN
*
* All nodes are collinear.
*
   80 IER = -2
      RETURN
*
* Nodes L and K coincide.
*
   90 IER = L
      RETURN
*
* Node K lies in a constraint region.
*
  100 IER = -3
      RETURN

      END


      SUBROUTINE BDYADD(KK,I1,I2,LIST,LPTR,LEND,LNEW)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   02/22/91
*
*   This subroutine adds a boundary node to a triangulation
* of a set of points in the plane.  The data structure is
* updated with the insertion of node KK, but no optimization
* is performed.
*
*
* On input:
*
*       KK = Index of a node to be connected to the sequence
*            of all visible boundary nodes.  KK .GE. 1 and
*            KK must not be equal to I1 or I2.
*
*       I1 = First (rightmost as viewed from KK) boundary
*            node in the triangulation which is visible from
*            node KK (the line segment KK-I1 intersects no
*            arcs.
*
*       I2 = Last (leftmost) boundary node which is visible
*            from node KK.  I1 and I2 may be determined by
*            subroutine TRFIND.
*
* The above parameters are not altered by this routine.
*
*       LIST,LPTR,LEND,LNEW = Triangulation data structure
*                             created by TRMESH or TRMSHR.
*                             Nodes I1 and I2 must be in-
*                             cluded in the triangulation.
*
* On output:
*
*       LIST,LPTR,LEND,LNEW = Data structure updated with
*                             the addition of node KK.  Node
*                             KK is connected to I1, I2, and
*                             all boundary nodes in between.
*
* Module required by BDYADD:  INSERT
*
************************************************************
*
*     .. Scalar Arguments ..
      INTEGER          I1,I2,KK,LNEW
*     ..
*     .. Array Arguments ..
      INTEGER          LEND(*),LIST(*),LPTR(*)
*     ..
*     .. Local Scalars ..
      INTEGER          K,LP,LSAV,N1,N2,NEXT,NSAV
*     ..
*     .. External Subroutines ..
      EXTERNAL         INSERT
*     ..
      K = KK
      N1 = I1
      N2 = I2
*
* Add K as the last neighbor of N1.
*
      LP = LEND(N1)
      LSAV = LPTR(LP)
      LPTR(LP) = LNEW
      LIST(LNEW) = -K
      LPTR(LNEW) = LSAV
      LEND(N1) = LNEW
      LNEW = LNEW + 1
      NEXT = -LIST(LP)
      LIST(LP) = NEXT
      NSAV = NEXT
*
* Loop on the remaining boundary nodes between N1 and N2,
*   adding K as the first neighbor.
*
   10 LP = LEND(NEXT)
      CALL INSERT(K,LP,LIST,LPTR,LNEW)
      IF (NEXT.EQ.N2) GO TO 20
      NEXT = -LIST(LP)
      LIST(LP) = NEXT
      GO TO 10
*
* Add the boundary nodes between N1 and N2 as neighbors
*   of node K.
*
   20 LSAV = LNEW
      LIST(LNEW) = N1
      LPTR(LNEW) = LNEW + 1
      LNEW = LNEW + 1
      NEXT = NSAV
*
   30 IF (NEXT.EQ.N2) GO TO 40
      LIST(LNEW) = NEXT
      LPTR(LNEW) = LNEW + 1
      LNEW = LNEW + 1
      LP = LEND(NEXT)
      NEXT = LIST(LP)
      GO TO 30
*
   40 LIST(LNEW) = -N2
      LPTR(LNEW) = LSAV
      LEND(K) = LNEW
      LNEW = LNEW + 1
      RETURN

      END


      LOGICAL FUNCTION CRTRI(NCC,LCC,I1,I2,I3)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   08/14/91
*
*   This function returns TRUE if and only if triangle (I1,
* I2,I3) lies in a constraint region.
*
*
* On input:
*
*       NCC,LCC = Constraint data structure.  Refer to sub-
*                 routine ADDCST.
*
*       I1,I2,I3 = Nodal indexes of the counterclockwise-
*                  ordered vertices of a triangle.
*
* Input parameters are altered by this function.
*
*       CRTRI = TRUE iff (I1,I2,I3) is a constraint region
*               triangle.
*
* Note that input parameters are not tested for validity.
*
* Modules required by CRTRI:  None
*
* Intrinsic functions called by CRTRI:  MAX, MIN
*
************************************************************
*
*     .. Scalar Arguments ..
      INTEGER          I1,I2,I3,NCC
*     ..
*     .. Array Arguments ..
      INTEGER          LCC(*)
*     ..
*     .. Local Scalars ..
      INTEGER          I,IMAX,IMIN
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MAX,MIN
*     ..
      IMAX = MAX(I1,I2,I3)
*
*   Find the index I of the constraint containing IMAX.
*
      I = NCC + 1
   10 I = I - 1
      IF (I.LE.0) GO TO 20
      IF (IMAX.LT.LCC(I)) GO TO 10
      IMIN = MIN(I1,I2,I3)
*
* P lies in a constraint region iff I1, I2, and I3 are nodes
*   of the same constraint (IMIN >= LCC(I)), and (IMIN,IMAX)
*   is (I1,I3), (I2,I1), or (I3,I2).
*
      CRTRI = IMIN .GE. LCC(I) .AND. ((IMIN.EQ.I1.AND.IMAX.EQ.I3) .OR.
     +        (IMIN.EQ.I2.AND.IMAX.EQ.I1) .OR.
     +        (IMIN.EQ.I3.AND.IMAX.EQ.I2))
      RETURN
*
* NCC .LE. 0 or all vertices are non-constraint nodes.
*
   20 CRTRI = .FALSE.
      RETURN

      END


      INTEGER FUNCTION INDXCC(NCC,LCC,N,LIST,LEND)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   08/25/91
*
*   Given a constrained Delaunay triangulation, this func-
* tion returns the index, if any, of an exterior constraint
* curve (an unbounded constraint region).  An exterior con-
* straint curve is assumed to be present if and only if the
* clockwise-ordered sequence of boundary nodes is a subse-
* quence of a constraint node sequence.  The triangulation
* adjacencies corresponding to constraint edges may or may
* not have been forced by a call to ADDCST, and the con-
* straint region may or may not be valid (contain no nodes).
*
*
* On input:
*
*       NCC = Number of constraints.  NCC .GE. 0.
*
*       LCC = List of constraint curve starting indexes (or
*             dummy array of length 1 if NCC = 0).  Refer to
*             subroutine ADDCST.
*
*       N = Number of nodes in the triangulation.  N .GE. 3.
*
*       LIST,LEND = Data structure defining the triangula-
*                   tion.  Refer to subroutine TRMESH.
*
*   Input parameters are not altered by this function.  Note
* that the parameters are not tested for validity.
*
* On output:
*
*       INDXCC = Index of the exterior constraint curve, if
*                present, or 0 otherwise.
*
* Modules required by INDXCC:  None
*
************************************************************
*
*     .. Scalar Arguments ..
      INTEGER          N,NCC
*     ..
*     .. Array Arguments ..
      INTEGER          LCC(*),LEND(N),LIST(*)
*     ..
*     .. Local Scalars ..
      INTEGER          I,IFRST,ILAST,LP,N0,NST,NXT
*     ..
      INDXCC = 0
      IF (NCC.LT.1) RETURN
*
* Set N0 to the boundary node with smallest index.
*
      N0 = 0
   10 N0 = N0 + 1
      LP = LEND(N0)
      IF (LIST(LP).GT.0) GO TO 10
*
* Search in reverse order for the constraint I, if any, that
*   contains N0.  IFRST and ILAST index the first and last
*   nodes in constraint I.
*
      I = NCC
      ILAST = N
   20 IFRST = LCC(I)
      IF (N0.GE.IFRST) GO TO 30
      IF (I.EQ.1) RETURN
      I = I - 1
      ILAST = IFRST - 1
      GO TO 20
*
* N0 is in constraint I which indexes an exterior constraint
*   curve iff the clockwise-ordered sequence of boundary
*   node indexes beginning with N0 is increasing and bounded
*   above by ILAST.
*
   30 NST = N0
*
   40 NXT = -LIST(LP)
      IF (NXT.EQ.NST) GO TO 50
      IF (NXT.LE.N0 .OR. NXT.GT.ILAST) RETURN
      N0 = NXT
      LP = LEND(N0)
      GO TO 40
*
* Constraint I contains the boundary node sequence as a
*   subset.
*
   50 INDXCC = I
      RETURN

      END


      SUBROUTINE INSERT(K,LP,LIST,LPTR,LNEW)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   09/01/88
*
*   This subroutine inserts K as a neighbor of N1 following
* N2, where LP is the LIST pointer of N2 as a neighbor of
* N1.  Note that, if N2 is the last neighbor of N1, K will
* become the first neighbor (even if N1 is a boundary node).
*
*
* On input:
*
*       K = Index of the node to be inserted.
*
*       LP = LIST pointer of N2 as a neighbor of N1.
*
* The above parameters are not altered by this routine.
*
*       LIST,LPTR,LNEW = Data structure defining the trian-
*                        gulation.  Refer to subroutine
*                        TRMESH.
*
* On output:
*
*       LIST,LPTR,LNEW = Data structure updated with the
*                        addition of node K.
*
* Modules required by INSERT:  None
*
************************************************************
*
*
*     .. Scalar Arguments ..
      INTEGER          K,LNEW,LP
*     ..
*     .. Array Arguments ..
      INTEGER          LIST(*),LPTR(*)
*     ..
*     .. Local Scalars ..
      INTEGER          LSAV
*     ..
      LSAV = LPTR(LP)
      LPTR(LP) = LNEW
      LIST(LNEW) = K
      LPTR(LNEW) = LSAV
      LNEW = LNEW + 1
      RETURN

      END


      SUBROUTINE INTADD(KK,I1,I2,I3,LIST,LPTR,LEND,LNEW)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   02/22/91
*
*   This subroutine adds an interior node to a triangulation
* of a set of points in the plane.  The data structure is
* updated with the insertion of node KK into the triangle
* whose vertices are I1, I2, and I3.  No optimization of the
* triangulation is performed.
*
*
* On input:
*
*       KK = Index of the node to be inserted.  KK .GE. 1
*            and KK must not be equal to I1, I2, or I3.
*
*       I1,I2,I3 = Indexes of the counterclockwise-ordered
*                  sequence of vertices of a triangle which
*                  contains node KK.
*
* The above parameters are not altered by this routine.
*
*       LIST,LPTR,LEND,LNEW = Data structure defining the
*                             triangulation.  Refer to sub-
*                             routine TRMESH.  Triangle
*                             (I1,I2,I3) must be included
*                             in the triangulation.
*
* On output:
*
*       LIST,LPTR,LEND,LNEW = Data structure updated with
*                             the addition of node KK.  KK
*                             will be connected to nodes I1,
*                             I2, and I3.
*
* Modules required by INTADD:  INSERT, LSTPTR
*
************************************************************
*
*     .. Scalar Arguments ..
      INTEGER          I1,I2,I3,KK,LNEW
*     ..
*     .. Array Arguments ..
      INTEGER          LEND(*),LIST(*),LPTR(*)
*     ..
*     .. Local Scalars ..
      INTEGER          K,LP,N1,N2,N3
*     ..
*     .. External Functions ..
      INTEGER          LSTPTR
      EXTERNAL         LSTPTR
*     ..
*     .. External Subroutines ..
      EXTERNAL         INSERT
*     ..
      K = KK
*
* Initialization.
*
      N1 = I1
      N2 = I2
      N3 = I3
*
* Add K as a neighbor of I1, I2, and I3.
*
      LP = LSTPTR(LEND(N1),N2,LIST,LPTR)
      CALL INSERT(K,LP,LIST,LPTR,LNEW)
      LP = LSTPTR(LEND(N2),N3,LIST,LPTR)
      CALL INSERT(K,LP,LIST,LPTR,LNEW)
      LP = LSTPTR(LEND(N3),N1,LIST,LPTR)
      CALL INSERT(K,LP,LIST,LPTR,LNEW)
*
* Add I1, I2, and I3 as neighbors of K.
*
      LIST(LNEW) = N1
      LIST(LNEW+1) = N2
      LIST(LNEW+2) = N3
      LPTR(LNEW) = LNEW + 1
      LPTR(LNEW+1) = LNEW + 2
      LPTR(LNEW+2) = LNEW
      LEND(K) = LNEW + 2
      LNEW = LNEW + 3
      RETURN

      END


      LOGICAL FUNCTION LEFT(X1,Y1,X2,Y2,X0,Y0)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   09/01/88
*
*   This function determines whether node N0 is to the left
* or to the right of the line through N1-N2 as viewed by an
* observer at N1 facing N2.
*
*
* On input:
*
*       X1,Y1 = Coordinates of N1.
*
*       X2,Y2 = Coordinates of N2.
*
*       X0,Y0 = Coordinates of N0.
*
* Input parameters are not altered by this function.
*
* On output:
*
*       LEFT = .TRUE. if and only if (X0,Y0) is on or to the
*              left of the directed line N1->N2.
*
* Modules required by LEFT:  None
*
************************************************************
*
*
* Local parameters:
*
* DX1,DY1 = X,Y components of the vector N1->N2
* DX2,DY2 = X,Y components of the vector N1->N0
*
*     .. Scalar Arguments ..
      REAL             X0,X1,X2,Y0,Y1,Y2
*     ..
*     .. Local Scalars ..
      REAL             DX1,DX2,DY1,DY2
*     ..
      DX1 = X2 - X1
      DY1 = Y2 - Y1
      DX2 = X0 - X1
      DY2 = Y0 - Y1
*
* If the sign of the vector cross product of N1->N2 and
*   N1->N0 is positive, then sin(A) > 0, where A is the
*   angle between the vectors, and thus A is in the range
*   (0,180) degrees.
*
      LEFT = DX1*DY2 .GE. DX2*DY1
      RETURN

      END


      INTEGER FUNCTION LSTPTR(LPL,NB,LIST,LPTR)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   09/01/88
*
*   This function returns the index (LIST pointer) of NB in
* the adjacency list for N0, where LPL = LEND(N0).
*
*
* On input:
*
*       LPL = LEND(N0)
*
*       NB = Index of the node whose pointer is to be re-
*            turned.  NB must be connected to N0.
*
*       LIST,LPTR = Data structure defining the triangula-
*                   tion.  Refer to subroutine TRMESH.
*
* Input parameters are not altered by this function.
*
* On output:
*
*       LSTPTR = Pointer such that LIST(LSTPTR) = NB or
*                LIST(LSTPTR) = -NB, unless NB is not a
*                neighbor of N0, in which case LSTPTR = LPL.
*
* Modules required by LSTPTR:  None
*
************************************************************
*
*
*     .. Scalar Arguments ..
      INTEGER          LPL,NB
*     ..
*     .. Array Arguments ..
      INTEGER          LIST(*),LPTR(*)
*     ..
*     .. Local Scalars ..
      INTEGER          LP,ND
*     ..
      LP = LPTR(LPL)
   10 ND = LIST(LP)
      IF (ND.EQ.NB) GO TO 20
      LP = LPTR(LP)
      IF (LP.NE.LPL) GO TO 10
*
   20 LSTPTR = LP
      RETURN

      END


      REAL FUNCTION STORE(X)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   03/18/90
*
*   This function forces its argument X to be stored in a
* memory location, thus providing a means of determining
* floating point number characteristics (such as the machine
* precision) when it is necessary to avoid computation in
* high precision registers.
*
*
* On input:
*
*       X = Value to be stored.
*
* X is not altered by this function.
*
* On output:
*
*       STORE = Value of X after it has been stored and
*               possibly truncated or rounded to the single
*               precision word length.
*
* Modules required by STORE:  None
*
************************************************************
*
*
*     .. Scalar Arguments ..
      REAL             X
*     ..
*     .. Scalars in Common ..
      REAL             Y
*     ..
*     .. Common blocks ..
      COMMON           /STCOM/Y
*     ..
      Y = X
      STORE = Y
      RETURN

      END


      SUBROUTINE SWAP(IN1,IN2,IO1,IO2,LIST,LPTR,LEND,LP21)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   09/01/88
*
*   Given a triangulation of a set of points in the plane,
* this subroutine replaces a diagonal arc in a strictly
* convex quadrilateral (defined by a pair of adjacent tri-
* angles) with the other diagonal.
*
*
* On input:
*
*       IN1,IN2,IO1,IO2 = Nodal indexes of the vertices of
*                         the quadrilateral.  IO1-IO2 is re-
*                         placed by IN1-IN2.  (IO1,IO2,IN1)
*                         and (IO2,IO1,IN2) must be trian-
*                         gles on input.
*
* The above parameters are not altered by this routine.
*
*       LIST,LPTR,LEND = Data structure defining the trian-
*                        gulation.  Refer to subroutine
*                        TRMESH.
*
* On output:
*
*       LIST,LPTR,LEND = Data structure updated with the
*                        swap -- triangles (IO1,IO2,IN1) and
*                        (IO2,IO1,IN2) are replaced by
*                        (IN1,IN2,IO2) and (IN2,IN1,IO1).
*
*       LP21 = Index of IN1 as a neighbor of IN2 after the
*              swap is performed.
*
* Module required by SWAP:  LSTPTR
*
************************************************************
*
*
* Delete IO2 as a neighbor of IO1.
*
*     .. Scalar Arguments ..
      INTEGER          IN1,IN2,IO1,IO2,LP21
*     ..
*     .. Array Arguments ..
      INTEGER          LEND(*),LIST(*),LPTR(*)
*     ..
*     .. Local Scalars ..
      INTEGER          LP,LPH,LPSAV
*     ..
*     .. External Functions ..
      INTEGER          LSTPTR
      EXTERNAL         LSTPTR
*     ..
      LP = LSTPTR(LEND(IO1),IN2,LIST,LPTR)
      LPH = LPTR(LP)
      LPTR(LP) = LPTR(LPH)
*
* If IO2 is the last neighbor of IO1, make IN2 the
*   last neighbor.
*
      IF (LEND(IO1).EQ.LPH) LEND(IO1) = LP
*
* Insert IN2 as a neighbor of IN1 following IO1
*   using the hole created above.
*
      LP = LSTPTR(LEND(IN1),IO1,LIST,LPTR)
      LPSAV = LPTR(LP)
      LPTR(LP) = LPH
      LIST(LPH) = IN2
      LPTR(LPH) = LPSAV
*
* Delete IO1 as a neighbor of IO2.
*
      LP = LSTPTR(LEND(IO2),IN1,LIST,LPTR)
      LPH = LPTR(LP)
      LPTR(LP) = LPTR(LPH)
*
* If IO1 is the last neighbor of IO2, make IN1 the
*   last neighbor.
*
      IF (LEND(IO2).EQ.LPH) LEND(IO2) = LP
*
* Insert IN1 as a neighbor of IN2 following IO2.
*
      LP = LSTPTR(LEND(IN2),IO2,LIST,LPTR)
      LPSAV = LPTR(LP)
      LPTR(LP) = LPH
      LIST(LPH) = IN1
      LPTR(LPH) = LPSAV
      LP21 = LPH
      RETURN

      END


      LOGICAL FUNCTION SWPTST(IN1,IN2,IO1,IO2,X,Y)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   09/01/88
*
*   This function applies the circumcircle test to a quadri-
* lateral defined by a pair of adjacent triangles.  The
* diagonal arc (shared triangle side) should be swapped for
* the other diagonl if and only if the fourth vertex is
* strictly interior to the circumcircle of one of the
* triangles (the decision is independent of the choice of
* triangle).  Equivalently, the diagonal is chosen to maxi-
* mize the smallest of the six interior angles over the two
* pairs of possible triangles (the decision is for no swap
* if the quadrilateral is not strictly convex).
*
*   When the four vertices are nearly cocircular (the
* neutral case), the preferred decision is no swap -- in
* order to avoid unnecessary swaps and, more important, to
* avoid cycling in subroutine OPTIM which is called by
* DELNOD and EDGE.  Thus, a tolerance SWTOL (stored in
* SWPCOM by TRMESH or TRMSHR) is used to define 'nearness'
* to the neutral case.
*
*
* On input:
*
*       IN1,IN2,IO1,IO2 = Nodal indexes of the vertices of
*                         the quadrilateral.  IO1-IO2 is the
*                         triangulation arc (shared triangle
*                         side) to be replaced by IN1-IN2 if
*                         the decision is to swap.  The
*                         triples (IO1,IO2,IN1) and (IO2,
*                         IO1,IN2) must define triangles (be
*                         in counterclockwise order) on in-
*                         put.
*
*       X,Y = Arrays containing the nodal coordinates.
*
* Input parameters are not altered by this routine.
*
* On output:
*
*       SWPTST = .TRUE. if and only if the arc connecting
*                IO1 and IO2 is to be replaced.
*
* Modules required by SWPTST:  None
*
************************************************************
*
*
* Tolerance stored by TRMESH or TRMSHR.
*
*
* Local parameters:
*
* DX11,DY11 = X,Y components of the vector IN1->IO1
* DX12,DY12 = X,Y components of the vector IN1->IO2
* DX22,DY22 = X,Y components of the vector IN2->IO2
* DX21,DY21 = X,Y components of the vector IN2->IO1
* SIN1 =      Cross product of the vectors IN1->IO1 and
*               IN1->IO2 -- proportional to sin(T1), where
*               T1 is the angle at IN1 formed by the vectors
* COS1 =      Inner product of the vectors IN1->IO1 and
*               IN1->IO2 -- proportional to cos(T1)
* SIN2 =      Cross product of the vectors IN2->IO2 and
*               IN2->IO1 -- proportional to sin(T2), where
*               T2 is the angle at IN2 formed by the vectors
* COS2 =      Inner product of the vectors IN2->IO2 and
*               IN2->IO1 -- proportional to cos(T2)
* SIN12 =     SIN1*COS2 + COS1*SIN2 -- proportional to
*               sin(T1+T2)
*
*
* Compute the vectors containing the angles T1 and T2.
*
*     .. Scalar Arguments ..
      INTEGER          IN1,IN2,IO1,IO2
*     ..
*     .. Array Arguments ..
      REAL             X(*),Y(*)
*     ..
*     .. Scalars in Common ..
      REAL             SWTOL
*     ..
*     .. Local Scalars ..
      REAL             COS1,COS2,DX11,DX12,DX21,DX22,DY11,DY12,DY21,
     +                 DY22,SIN1,SIN12,SIN2
*     ..
*     .. Common blocks ..
      COMMON           /SWPCOM/SWTOL
*     ..
      DX11 = X(IO1) - X(IN1)
      DX12 = X(IO2) - X(IN1)
      DX22 = X(IO2) - X(IN2)
      DX21 = X(IO1) - X(IN2)
*
      DY11 = Y(IO1) - Y(IN1)
      DY12 = Y(IO2) - Y(IN1)
      DY22 = Y(IO2) - Y(IN2)
      DY21 = Y(IO1) - Y(IN2)
*
* Compute inner products.
*
      COS1 = DX11*DX12 + DY11*DY12
      COS2 = DX22*DX21 + DY22*DY21
*
* The diagonals should be swapped iff (T1+T2) > 180
*   degrees.  The following two tests ensure numerical
*   stability:  the decision must be FALSE when both
*   angles are close to 0, and TRUE when both angles
*   are close to 180 degrees.
*
      IF (COS1.GE.0. .AND. COS2.GE.0.) GO TO 20
      IF (COS1.LT.0. .AND. COS2.LT.0.) GO TO 10
*
* Compute vector cross products (Z-components).
*
      SIN1 = DX11*DY12 - DX12*DY11
      SIN2 = DX22*DY21 - DX21*DY22
      SIN12 = SIN1*COS2 + COS1*SIN2
      IF (SIN12.GE.-SWTOL) GO TO 20
*
* Swap.
*
   10 SWPTST = .TRUE.
      RETURN
*
* No swap.
*
   20 SWPTST = .FALSE.
      RETURN

      END


      SUBROUTINE TRFIND(NST,PX,PY,X,Y,LIST,LPTR,LEND,I1,I2,I3)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   06/14/90
*
*   This subroutine locates a point P relative to a triangu-
* lation created by subroutine TRMESH or TRMSHR.  If P is
* contained in a triangle, the three vertex indexes are
* returned.  Otherwise, the indexes of the rightmost and
* leftmost visible boundary nodes are returned.
*
*
* On input:
*
*       NST = Index of a node at which TRFIND begins the
*             search.  Search time depends on the proximity
*             of this node to P.
*
*       PX,PY = X and Y coordinates of the point P to be
*               located.
*
*       X,Y = Arrays containing the coordinates of the nodes
*             in the triangulation.
*
*       LIST,LPTR,LEND = Data structure defining the trian-
*                        gulation.  Refer to subroutine
*                        TRMESH.
*
* Input parameters are not altered by this routine.
*
* On output:
*
*       I1,I2,I3 = Nodal indexes, in counterclockwise order,
*                  of the vertices of a triangle containing
*                  P, or, if P is not contained in the con-
*                  vex hull of the nodes, I1 indexes the
*                  rightmost visible boundary node, I2 in-
*                  dexes the leftmost visible boundary node,
*                  and I3 = 0.  Rightmost and leftmost are
*                  defined from the perspective of P, and a
*                  pair of points are visible from each
*                  other if and only if the line segment
*                  joining them intersects no triangulation
*                  arc.  If P and all of the nodes lie on a
*                  common line, then I1 = I2 = I3 = 0 on
*                  output.
*
* Modules required by TRFIND:  LEFT, LSTPTR
*
* Intrinsic functions called by TRFIND:  ABS, MAX
*
************************************************************
*
*     .. Scalar Arguments ..
      REAL             PX,PY
      INTEGER          I1,I2,I3,NST
*     ..
*     .. Array Arguments ..
      REAL             X(*),Y(*)
      INTEGER          LEND(*),LIST(*),LPTR(*)
*     ..
*     .. Local Scalars ..
      REAL             XA,XB,XC,XP,YA,YB,YC,YP
      INTEGER          LP,N0,N1,N2,N3,N4,NB,NF,NL,NP,NPP
*     ..
*     .. External Functions ..
      INTEGER          LSTPTR
      LOGICAL          LEFT
      EXTERNAL         LSTPTR,LEFT
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        ABS,MAX
*     ..
*     .. Statement Functions ..
      LOGICAL          FRWRD
*     ..
*     .. Statement Function definitions ..
*
* FRWRD = TRUE iff C is forward of A->B
*              iff <A->B,A->C> .GE. 0.
*
      FRWRD(XA,YA,XB,YB,XC,YC) = (XB-XA)* (XC-XA) +
     +                           (YB-YA)* (YC-YA) .GE. 0.
*     ..
*
      N0 = MAX(NST,1)
      XP = PX
      YP = PY
*
* Set N1 = NF and NL to the first and last neighbors of N0.
*
   10 LP = LEND(N0)
      NL = LIST(LP)
      LP = LPTR(LP)
      NF = LIST(LP)
      N1 = NF
*
* Find a pair of adjacent neighbors N1,N2 of N0 which define
*   a wedge containing P:  P LEFT N0->N1 and P RIGHT N0->N2.
*
      IF (NL.GT.0) GO TO 20
*
*   N0 is a boundary node.  Test for P exterior.
*
      NL = -NL
      IF (.NOT.LEFT(X(N0),Y(N0),X(NF),Y(NF),XP,YP)) THEN
          NL = N0
          GO TO 90

      END IF

      IF (.NOT.LEFT(X(NL),Y(NL),X(N0),Y(N0),XP,YP)) THEN
          NB = NF
          NF = N0
          NP = NL
          NPP = N0
          GO TO 110

      END IF

      GO TO 30
*
*   N0 is an interior node.  Find N1.
*
   20 IF (LEFT(X(N0),Y(N0),X(N1),Y(N1),XP,YP)) GO TO 30
      LP = LPTR(LP)
      N1 = LIST(LP)
      IF (N1.EQ.NL) GO TO 60
      GO TO 20
*
*   P is to the left of edge N0->N1.  Initialize N2 to the
*     next neighbor of N0.
*
   30 LP = LPTR(LP)
      N2 = ABS(LIST(LP))
      IF (.NOT.LEFT(X(N0),Y(N0),X(N2),Y(N2),XP,YP)) GO TO 70
      N1 = N2
      IF (N1.NE.NL) GO TO 30
      IF (.NOT.LEFT(X(N0),Y(N0),X(NF),Y(NF),XP,YP)) GO TO 60
      IF (XP.EQ.X(N0) .AND. YP.EQ.Y(N0)) GO TO 50
*
*   P is left of or on edges N0->NB for all neighbors NB
*     of N0.
*   All points are collinear iff P is left of NB->N0 for
*     all neighbors NB of N0.  Search the neighbors of N0.
*     NOTE -- N1 = NL and LP points to NL.
*
   40 IF (.NOT.LEFT(X(N1),Y(N1),X(N0),Y(N0),XP,YP)) GO TO 50
      LP = LPTR(LP)
      N1 = ABS(LIST(LP))
      IF (N1.EQ.NL) GO TO 170
      GO TO 40
*
*   P is to the right of N1->N0, or P=N0.  Set N0 to N1 and
*     start over.
*
   50 N0 = N1
      GO TO 10
*
*   P is between edges N0->N1 and N0->NF.
*
   60 N2 = NF
*
* P is contained in the wedge defined by line segments
*   N0->N1 and N0->N2, where N1 is adjacent to N2.  Set
*   N3 to the node opposite N1->N2.
*
   70 N3 = N0
*
* Top of edge hopping loop.  Test for termination.
*
   80 IF (LEFT(X(N1),Y(N1),X(N2),Y(N2),XP,YP)) THEN
*
*   P LEFT N1->N2 and hence P is in (N1,N2,N3) unless an
*     error resulted from floating point inaccuracy and
*     collinearity.
*
          IF (LEFT(X(N2),Y(N2),X(N3),Y(N3),XP,YP) .AND.
     +        LEFT(X(N3),Y(N3),X(N1),Y(N1),XP,YP)) GO TO 160
      END IF
*
*   Set N4 to the neighbor of N2 which follows N1 (node
*     opposite N2->N1) unless N1->N2 is a boundary edge.
*
      LP = LSTPTR(LEND(N2),N1,LIST,LPTR)
      IF (LIST(LP).LT.0) THEN
          NF = N2
          NL = N1
          GO TO 90

      END IF

      LP = LPTR(LP)
      N4 = ABS(LIST(LP))
*
*   Select the new edge N1->N2 which intersects the line
*     segment N0-P, and set N3 to the node opposite N1->N2.
*
      IF (LEFT(X(N0),Y(N0),X(N4),Y(N4),XP,YP)) THEN
          N3 = N1
          N1 = N4

      ELSE
          N3 = N2
          N2 = N4
      END IF

      GO TO 80
*
* Boundary traversal loops.  NL->NF is a boundary edge and
*   P RIGHT NL->NF.  Save NL and NF.

   90 NP = NL
      NPP = NF
*
* Find the first (rightmost) visible boundary node NF.  NB
*   is set to the first neighbor of NF, and NP is the last
*   neighbor.
*
  100 LP = LEND(NF)
      LP = LPTR(LP)
      NB = LIST(LP)
      IF (.NOT.LEFT(X(NF),Y(NF),X(NB),Y(NB),XP,YP)) GO TO 120
*
*   P LEFT NF->NB and thus NB is not visible unless an error
*     resulted from floating point inaccuracy and collinear-
*     ity of the 4 points NP, NF, NB, and P.
*
  110 IF (FRWRD(X(NF),Y(NF),X(NP),Y(NP),XP,YP) .OR.
     +    FRWRD(X(NF),Y(NF),X(NP),Y(NP),X(NB),Y(NB))) THEN
          I1 = NF
          GO TO 130

      END IF
*
*   Bottom of loop.
*
  120 NP = NF
      NF = NB
      GO TO 100
*
* Find the last (leftmost) visible boundary node NL.  NB
*   is set to the last neighbor of NL, and NPP is the first
*   neighbor.
*
  130 LP = LEND(NL)
      NB = -LIST(LP)
      IF (.NOT.LEFT(X(NB),Y(NB),X(NL),Y(NL),XP,YP)) GO TO 140
*
*   P LEFT NB->NL and thus NB is not visible unless an error
*     resulted from floating point inaccuracy and collinear-
*     ity of the 4 points P, NB, NL, and NPP.
*
      IF (FRWRD(X(NL),Y(NL),X(NPP),Y(NPP),XP,YP) .OR.
     +    FRWRD(X(NL),Y(NL),X(NPP),Y(NPP),X(NB),Y(NB))) GO TO 150
*
*   Bottom of loop.
*
  140 NPP = NL
      NL = NB
      GO TO 130
*
* NL is the leftmost visible boundary node.
*
  150 I2 = NL
      I3 = 0
      RETURN
*
* P is in the triangle (N1,N2,N3).
*
  160 I1 = N1
      I2 = N2
      I3 = N3
      RETURN
*
* All points are collinear.
*
  170 I1 = 0
      I2 = 0
      I3 = 0
      RETURN

      END


      SUBROUTINE TRLIST(NCC,LCC,N,LIST,LPTR,LEND,NROW,NT,LTRI,LCT,IER)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   11/12/94
*
*   This subroutine converts a triangulation data structure
* from the linked list created by subroutine TRMESH or
* TRMSHR to a triangle list.
*
* On input:
*
*       NCC = Number of constraints.  NCC .GE. 0.
*
*       LCC = List of constraint curve starting indexes (or
*             dummy array of length 1 if NCC = 0).  Refer to
*             subroutine ADDCST.
*
*       N = Number of nodes in the triangulation.  N .GE. 3.
*
*       LIST,LPTR,LEND = Linked list data structure defin-
*                        ing the triangulation.  Refer to
*                        subroutine TRMESH.
*
*       NROW = Number of rows (entries per triangle) re-
*              served for the triangle list LTRI.  The value
*              must be 6 if only the vertex indexes and
*              neighboring triangle indexes are to be
*              stored, or 9 if arc indexes are also to be
*              assigned and stored.  Refer to LTRI.
*
* The above parameters are not altered by this routine.
*
*       LTRI = Integer array of length at least NROW*NT,
*              where NT is at most 2N-5.  (A sufficient
*              length is 12N if NROW=6 or 18N if NROW=9.)
*
*       LCT = Integer array of length NCC or dummy array of
*             length 1 if NCC = 0.
*
* On output:
*
*       NT = Number of triangles in the triangulation unless
*            IER .NE. 0, in which case NT = 0.  NT = 2N - NB
*            - 2, where NB is the number of boundary nodes.
*
*       LTRI = NROW by NT array whose J-th column contains
*              the vertex nodal indexes (first three rows),
*              neighboring triangle indexes (second three
*              rows), and, if NROW = 9, arc indexes (last
*              three rows) associated with triangle J for
*              J = 1,...,NT.  The vertices are ordered
*              counterclockwise with the first vertex taken
*              to be the one with smallest index.  Thus,
*              LTRI(2,J) and LTRI(3,J) are larger than
*              LTRI(1,J) and index adjacent neighbors of
*              node LTRI(1,J).  For I = 1,2,3, LTRI(I+3,J)
*              and LTRI(I+6,J) index the triangle and arc,
*              respectively, which are opposite (not shared
*              by) node LTRI(I,J), with LTRI(I+3,J) = 0 if
*              LTRI(I+6,J) indexes a boundary arc.  Vertex
*              indexes range from 1 to N, triangle indexes
*              from 0 to NT, and, if included, arc indexes
*              from 1 to NA = NT+N-1.  The triangles are or-
*              dered on first (smallest) vertex indexes,
*              except that the sets of constraint triangles
*              (triangles contained in the closure of a con-
*              straint region) follow the non-constraint
*              triangles.
*
*       LCT = Array of length NCC containing the triangle
*             index of the first triangle of constraint J in
*             LCT(J).  Thus, the number of non-constraint
*             triangles is LCT(1)-1, and constraint J con-
*             tains LCT(J+1)-LCT(J) triangles, where
*             LCT(NCC+1) = NT+1.
*
*       IER = Error indicator.
*             IER = 0 if no errors were encountered.
*             IER = 1 if NCC, N, NROW, or an LCC entry is
*                     outside its valid range on input.
*             IER = 2 if the triangulation data structure
*                     (LIST,LPTR,LEND) is invalid.  Note,
*                     however, that these arrays are not
*                     completely tested for validity.
*
* Modules required by TRLIST:  None
*
* Intrinsic function called by TRLIST:  ABS
*
************************************************************
*
*
* Test for invalid input parameters and store the index
*   LCC1 of the first constraint node (if any).
*
*     .. Scalar Arguments ..
      INTEGER          IER,N,NCC,NROW,NT
*     ..
*     .. Array Arguments ..
      INTEGER          LCC(*),LCT(NCC),LEND(N),LIST(*),LPTR(*),
     +                 LTRI(NROW,*)
*     ..
*     .. Local Scalars ..
      INTEGER          I,I1,I2,I3,ISV,J,JLAST,KA,KN,KT,L,LCC1,LP,LP2,
     +                 LPL,LPLN1,N1,N1ST,N2,N3,NM2,NN
      LOGICAL          ARCS,CSTRI,PASS2
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        ABS
*     ..
      NN = N
      IF (NCC.LT.0 .OR. (NROW.NE.6.AND.NROW.NE.9)) GO TO 120
      LCC1 = NN + 1
      IF (NCC.EQ.0) THEN
          IF (NN.LT.3) GO TO 120

      ELSE
          DO 10 I = NCC,1,-1
              IF (LCC1-LCC(I).LT.3) GO TO 120
              LCC1 = LCC(I)
   10     CONTINUE
          IF (LCC1.LT.1) GO TO 120
      END IF
*
* Initialize parameters for loop on triangles KT = (N1,N2,
*   N3), where N1 < N2 and N1 < N3.  This requires two
*   passes through the nodes with all non-constraint
*   triangles stored on the first pass, and the constraint
*   triangles stored on the second.
*
*   ARCS = TRUE iff arc indexes are to be stored.
*   KA,KT = Numbers of currently stored arcs and triangles.
*   N1ST = Starting index for the loop on nodes (N1ST = 1 on
*            pass 1, and N1ST = LCC1 on pass 2).
*   NM2 = Upper bound on candidates for N1.
*   PASS2 = TRUE iff constraint triangles are to be stored.
*
      ARCS = NROW .EQ. 9
      KA = 0
      KT = 0
      N1ST = 1
      NM2 = NN - 2
      PASS2 = .FALSE.
*
* Loop on nodes N1:  J = constraint containing N1,
*                    JLAST = last node in constraint J.
*
   20 J = 0
      JLAST = LCC1 - 1
      DO 110 N1 = N1ST,NM2
          IF (N1.GT.JLAST) THEN
*
* N1 is the first node in constraint J+1.  Update J and
*   JLAST, and store the first constraint triangle index
*   if in pass 2.
*
              J = J + 1
              IF (J.LT.NCC) THEN
                  JLAST = LCC(J+1) - 1

              ELSE
                  JLAST = NN
              END IF

              IF (PASS2) LCT(J) = KT + 1
          END IF
*
* Loop on pairs of adjacent neighbors (N2,N3).  LPLN1 points
*   to the last neighbor of N1, and LP2 points to N2.
*
          LPLN1 = LEND(N1)
          LP2 = LPLN1
   30     LP2 = LPTR(LP2)
          N2 = LIST(LP2)
          LP = LPTR(LP2)
          N3 = ABS(LIST(LP))
          IF (N2.LT.N1 .OR. N3.LT.N1) GO TO 100
*
* (N1,N2,N3) is a constraint triangle iff the three nodes
*   are in the same constraint and N2 < N3.  Bypass con-
*   straint triangles on pass 1 and non-constraint triangles
*   on pass 2.
*
          CSTRI = N1 .GE. LCC1 .AND. N2 .LT. N3 .AND. N3 .LE. JLAST
          IF ((CSTRI.AND..NOT.PASS2) .OR.
     +        (.NOT.CSTRI.AND.PASS2)) GO TO 100
*
* Add a new triangle KT = (N1,N2,N3).
*
          KT = KT + 1
          LTRI(1,KT) = N1
          LTRI(2,KT) = N2
          LTRI(3,KT) = N3
*
* Loop on triangle sides (I1,I2) with neighboring triangles
*   KN = (I1,I2,I3).
*
          DO 90 I = 1,3
              IF (I.EQ.1) THEN
                  I1 = N3
                  I2 = N2

              ELSE IF (I.EQ.2) THEN
                  I1 = N1
                  I2 = N3

              ELSE
                  I1 = N2
                  I2 = N1
              END IF
*
* Set I3 to the neighbor of I1 which follows I2 unless
*   I2->I1 is a boundary arc.
*
              LPL = LEND(I1)
              LP = LPTR(LPL)
   40         IF (LIST(LP).EQ.I2) GO TO 50
              LP = LPTR(LP)
              IF (LP.NE.LPL) GO TO 40
*
*   I2 is the last neighbor of I1 unless the data structure
*     is invalid.  Bypass the search for a neighboring
*     triangle if I2->I1 is a boundary arc.
*
              IF (ABS(LIST(LP)).NE.I2) GO TO 130
              KN = 0
              IF (LIST(LP).LT.0) GO TO 80
*
*   I2->I1 is not a boundary arc, and LP points to I2 as
*     a neighbor of I1.
*
   50         LP = LPTR(LP)
              I3 = ABS(LIST(LP))
*
* Find L such that LTRI(L,KN) = I3 (not used if KN > KT),
*   and permute the vertex indexes of KN so that I1 is
*   smallest.
*
              IF (I1.LT.I2 .AND. I1.LT.I3) THEN
                  L = 3

              ELSE IF (I2.LT.I3) THEN
                  L = 2
                  ISV = I1
                  I1 = I2
                  I2 = I3
                  I3 = ISV

              ELSE
                  L = 1
                  ISV = I1
                  I1 = I3
                  I3 = I2
                  I2 = ISV
              END IF
*
* Test for KN > KT (triangle index not yet assigned).
*
              IF (I1.GT.N1 .AND. .NOT.PASS2) GO TO 90
*
* Find KN, if it exists, by searching the triangle list in
*   reverse order.
*
              DO 60 KN = KT - 1,1,-1
                  IF (LTRI(1,KN).EQ.I1 .AND. LTRI(2,KN).EQ.I2 .AND.
     +                LTRI(3,KN).EQ.I3) GO TO 70
   60         CONTINUE
              GO TO 90
*
* Store KT as a neighbor of KN.
*
   70         LTRI(L+3,KN) = KT
*
* Store KN as a neighbor of KT, and add a new arc KA.
*
   80         LTRI(I+3,KT) = KN
              IF (ARCS) THEN
                  KA = KA + 1
                  LTRI(I+6,KT) = KA
                  IF (KN.NE.0) LTRI(L+6,KN) = KA
              END IF

   90     CONTINUE
*
* Bottom of loop on triangles.
*
  100     IF (LP2.NE.LPLN1) GO TO 30
  110 CONTINUE
*
* Bottom of loop on nodes.
*
      IF (.NOT.PASS2 .AND. NCC.GT.0) THEN
          PASS2 = .TRUE.
          N1ST = LCC1
          GO TO 20

      END IF
*
* No errors encountered.
*
      NT = KT
      IER = 0
      RETURN
*
* Invalid input parameter.
*
  120 NT = 0
      IER = 1
      RETURN
*
* Invalid triangulation data structure:  I1 is a neighbor of
*   I2, but I2 is not a neighbor of I1.
*
  130 NT = 0
      IER = 2
      RETURN

      END


      SUBROUTINE TRMESH(N,X,Y,LIST,LPTR,LEND,LNEW,IER)
*
************************************************************
*
*                                               From TRIPACK
*                                            Robert J. Renka
*                                  Dept. of Computer Science
*                                       Univ. of North Texas
*                                             (817) 565-2767
*                                                   08/25/91
*
*   This subroutine creates a Delaunay triangulation of a
* set of N arbitrarily distributed points in the plane re-
* ferred to as nodes.  The Delaunay triangulation is defined
* as a set of triangles with the following five properties:
*
*  1)  The triangle vertices are nodes.
*  2)  No triangle contains a node other than its vertices.
*  3)  The interiors of the triangles are pairwise disjoint.
*  4)  The union of triangles is the convex hull of the set
*        of nodes (the smallest convex set which contains
*        the nodes).
*  5)  The interior of the circumcircle of each triangle
*        contains no node.
*
* The first four properties define a triangulation, and the
* last property results in a triangulation which is as close
* as possible to equiangular in a certain sense and which is
* uniquely defined unless four or more nodes lie on a common
* circle.  This property makes the triangulation well-suited
* for solving closest point problems and for triangle-based
* interpolation.
*
*   The triangulation can be generalized to a constrained
* Delaunay triangulation by a call to subroutine ADDCST.
* This allows for user-specified boundaries defining a non-
* convex and/or multiply connected region.
*
*   The operation count for constructing the triangulation
* is close to O(N) if the nodes are presorted on X or Y com-
* ponents.  Also, since the algorithm proceeds by adding
* nodes incrementally, the triangulation may be updated with
* the addition (or deletion) of a node very efficiently.
* The adjacency information representing the triangulation
* is stored as a linked list requiring approximately 13N
* storage locations.
*
*
* On input:
*
*       N = Number of nodes in the triangulation.  N .GE. 3.
*
*       X,Y = Arrays of length N containing the Cartesian
*             coordinates of the nodes.  (X(K),Y(K)) is re-
*             ferred to as node K, and K is referred to as
*             a nodal index.  The first three nodes must not
*             be collinear.
*
* The above parameters are not altered by this routine.
*
*       LIST,LPTR = Arrays of length at least 6N-12.
*
*       LEND = Array of length at least N.
*
* On output:
*
*       LIST = Set of nodal indexes which, along with LPTR,
*              LEND, and LNEW, define the triangulation as a
*              set of N adjacency lists -- counterclockwise-
*              ordered sequences of neighboring nodes such
*              that the first and last neighbors of a bound-
*              ary node are boundary nodes (the first neigh-
*              bor of an interior node is arbitrary).  In
*              order to distinguish between interior and
*              boundary nodes, the last neighbor of each
*              boundary node is represented by the negative
*              of its index.
*
*       LPTR = Set of pointers (LIST indexes) in one-to-one
*              correspondence with the elements of LIST.
*              LIST(LPTR(I)) indexes the node which follows
*              LIST(I) in cyclical counterclockwise order
*              (the first neighbor follows the last neigh-
*              bor).
*
*       LEND = Set of pointers to adjacency lists.  LEND(K)
*              points to the last neighbor of node K for
*              K = 1,...,N.  Thus, LIST(LEND(K)) < 0 if and
*              only if K is a boundary node.
*
*       LNEW = Pointer to the first empty location in LIST
*              and LPTR (list length plus one).  LIST, LPTR,
*              LEND, and LNEW are not altered if IER < 0,
*              and are incomplete if IER > 0.
*
*       IER = Error indicator:
*             IER =  0 if no errors were encountered.
*             IER = -1 if N < 3 on input.
*             IER = -2 if the first three nodes are
*                      collinear.
*             IER =  L if nodes L and M coincide for some
*                      M > L.  The linked list represents
*                      a triangulation of nodes 1 to M-1
*                      in this case.
*
* Modules required by TRMESH:  ADDNOD, BDYADD, INSERT,
*                                INTADD, LEFT, LSTPTR,
*                                STORE, SWAP, SWPTST, TRFIND
*
************************************************************
*
*
*     .. Scalar Arguments ..
      INTEGER          IER,LNEW,N
*     ..
*     .. Array Arguments ..
      REAL             X(N),Y(N)
      INTEGER          LEND(N),LIST(*),LPTR(*)
*     ..
*     .. Scalars in Common ..
      REAL             SWTOL
*     ..
*     .. Local Scalars ..
      REAL             EPS
      INTEGER          K,KM1,NCC,NN
*     ..
*     .. Local Arrays ..
      INTEGER          LCC(1)
*     ..
*     .. External Functions ..
      REAL             STORE
      LOGICAL          LEFT
      EXTERNAL         STORE,LEFT
*     ..
*     .. External Subroutines ..
      EXTERNAL         ADDNOD
*     ..
*     .. Common blocks ..
      COMMON           /SWPCOM/SWTOL
*     ..
      NN = N
      IF (NN.LT.3) THEN
          IER = -1
          RETURN

      END IF
*
* Compute a tolerance for function SWPTST:  SWTOL = 10*
*   (machine precision)
*
      EPS = 1.
   10 EPS = EPS/2.
      SWTOL = STORE(EPS+1.)
      IF (SWTOL.GT.1.) GO TO 10
      SWTOL = EPS*20.
*
* Store the first triangle in the linked list.
*
      IF (.NOT.LEFT(X(1),Y(1),X(2),Y(2),X(3),Y(3))) THEN
*
*   The initial triangle is (1,3,2).
*
          LIST(1) = 3
          LPTR(1) = 2
          LIST(2) = -2
          LPTR(2) = 1
          LEND(1) = 2
*
          LIST(3) = 1
          LPTR(3) = 4
          LIST(4) = -3
          LPTR(4) = 3
          LEND(2) = 4
*
          LIST(5) = 2
          LPTR(5) = 6
          LIST(6) = -1
          LPTR(6) = 5
          LEND(3) = 6
*
      ELSE IF (.NOT.LEFT(X(2),Y(2),X(1),Y(1),X(3),Y(3))) THEN
*
*   The initial triangle is (1,2,3).
*
          LIST(1) = 2
          LPTR(1) = 2
          LIST(2) = -3
          LPTR(2) = 1
          LEND(1) = 2
*
          LIST(3) = 3
          LPTR(3) = 4
          LIST(4) = -1
          LPTR(4) = 3
          LEND(2) = 4
*
          LIST(5) = 1
          LPTR(5) = 6
          LIST(6) = -2
          LPTR(6) = 5
          LEND(3) = 6
*
      ELSE
*
*   The first three nodes are collinear.
*
          IER = -2
          RETURN

      END IF
*
* Initialize LNEW and add the remaining nodes.  Parameters
*   for ADDNOD are as follows:
*
*   K = Index of the node to be added.
*   KM1 = Index of the starting node for the search in
*         TRFIND and number of nodes in the triangulation
*         on input.
*   NCC = Number of constraint curves.
*   LCC = Dummy array (since NCC = 0).
*
      LNEW = 7
      IF (NN.EQ.3) THEN
          IER = 0
          RETURN

      END IF

      NCC = 0
      DO 20 K = 4,NN
          KM1 = K - 1
          CALL ADDNOD(K,X(K),Y(K),KM1,NCC,LCC,KM1,X,Y,LIST,LPTR,LEND,
     +                LNEW,IER)
          IF (IER.NE.0) RETURN
   20 CONTINUE
      IER = 0
      RETURN

      END

SHAR_EOF
fi # end of overwriting check
if test -f 'src.f'
then
	echo shar: will not over-write existing file "'src.f'"
else
cat << \SHAR_EOF > 'src.f'
      SUBROUTINE SDBI3P(MD,NDP,XD,YD,ZD,NIP,XI,YI, ZI,IER, WK,IWK)
*
* Scattered-data bivariate interpolation
* (a master subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine performs bivariate interpolation when the data
* points are scattered in the x-y plane.  It is based on the
* revised Akima method that has the accuracy of a cubic (third-
* degree) polynomial.
*
* The input arguments are
*   MD  = mode of computation
*       = 1 for new XD-YD (default)
*       = 2 for old XD-YD, new ZD
*       = 3 for old XD-YD, old ZD,
*   NDP = number of data points (must be 10 or greater),
*   XD  = array of dimension NDP containing the x coordinates
*         of the data points,
*   YD  = array of dimension NDP containing the y coordinates
*         of the data points,
*   ZD  = array of dimension NDP containing the z values at
*         the data points,
*   NIP = number of output points at which interpolation is
*         to be performed (must be 1 or greater),
*   XI  = array of dimension NIP containing the x coordinates
*         of the output points,
*   YI  = array of dimension NIP containing the y coordinates
*         of the output points.
*
* The output arguments are
*   ZI  = array of dimension NIP, where interpolated z values
*         are to be stored,
*   IER = error flag
*       = 0 for no errors
*       = 1 for NDP = 9 or less
*       = 2 for NDP not equal to NDPPV
*       = 3 for NIP = 0 or less
*       = 9 for errors in SDTRAN called by this subroutine.
*
* The other arguments are
*   WK  = two-dimensional array of dimension NDP*17 used
*         internally as a work area,
*   IWK = two-dimensional integer array of dimension NDP*25
*         used internally as a work area.
*
* The very first call to this subroutine and the call with a new
* NDP value or new XD and YD arrays must be made with MD=1.  The
* call with MD=2 must be preceded by another call with the same
* NDP value and same XD and YD arrays.  The call with MD=3 must
* be preceded by another call with the same NDP value and same
* XD, YD, and ZD arrays.  Between the call with MD=2 and its
* preceding call, the IWK array must not be disturbed.  Between
* the call with MD=3 and its preceding call, the WK and IWK
* arrays must not be disturbed.
*
* The user of this subroutine can save the storage, by NDP*6
* numerical storage units, by placing the statement
*     EQUIVALENCE (WK(1,1),IWK(1,20))
* in the program that calls this subroutine.
*
* The constant in the PARAMETER statement below is
*   NIPIMX = maximum number of output points to be processed
*            at a time.
* The constant value has been selected empirically.
*
* This subroutine calls the SDTRAN, SDPD3P, SDLCTN, and SDPLNL
* subroutines.
*
*
* Specification statements
*     .. Parameters ..
      INTEGER          NIPIMX
      PARAMETER        (NIPIMX=51)
*     ..
*     .. Scalar Arguments ..
      INTEGER          IER,MD,NDP,NIP
*     ..
*     .. Array Arguments ..
      REAL             WK(NDP,17),XD(NDP),XI(NIP),YD(NDP),YI(NIP),
     +                 ZD(NDP),ZI(NIP)
      INTEGER          IWK(NDP,25)
*     ..
*     .. Local Scalars ..
      INTEGER          IERT,IIP,NDPPV,NIPI,NL,NT
*     ..
*     .. Local Arrays ..
      INTEGER          ITLI(NIPIMX),KTLI(NIPIMX)
*     ..
*     .. External Subroutines ..
      EXTERNAL         SDLCTN,SDPD3P,SDPLNL,SDTRAN
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MIN
*     ..
*     .. Save statement ..
      SAVE             NDPPV,NT,NL
*     ..
* Error check
      IF (NDP.LE.9) GO TO 20
      IF (MD.NE.2 .AND. MD.NE.3) THEN
          NDPPV = NDP
      ELSE
          IF (NDP.NE.NDPPV) GO TO 30
      END IF
      IF (NIP.LE.0) GO TO 40
* Triangulates the x-y plane.  (for MD=1)
      IF (MD.NE.2 .AND. MD.NE.3) THEN
          CALL SDTRAN(NDP,XD,YD, NT,IWK(1,1),NL,IWK(1,7),IERT,
     +                IWK(1,1),IWK(1,7),IWK(1,13),IWK(1,14),IWK(1,9))
*         CALL SDTRAN(NDP,XD,YD, NT,IPT,NL,IPL,IERT,
*    +                LIST,LPTR,LEND,LTRI,ITL)
          IF (IERT.GT.0) GO TO 50
      END IF
* Estimates partial derivatives at all data points.  (for MD=1,2)
      IF (MD.NE.3) THEN
          CALL SDPD3P(NDP,XD,YD,ZD, WK(1,1), WK(1,6),WK(1,15),WK(1,17),
     +                IWK(1,9),IWK(1,10),IWK(1,19))
*         CALL SDPD3P(NDP,XD,YD,ZD, PDD, CF3,CFL1,DSQ,IDSQ,IPC,NCP)
      END IF
* Locates all points at which interpolation is to be performed
* and interpolates the ZI values.  (for MD=1,2,3)
      DO 10 IIP = 1,NIP,NIPIMX
          NIPI = MIN(NIP-IIP+1,NIPIMX)
          CALL SDLCTN(NDP,XD,YD,NT,IWK(1,1),NL,IWK(1,7),NIPI,XI(IIP),
     +                YI(IIP), KTLI,ITLI)
*         CALL SDLCTN(NDP,XD,YD,NT,IPT,NL,IPL,NIP,XI,YI, KTLI,ITLI)
          CALL SDPLNL(NDP,XD,YD,ZD,NT,IWK(1,1),NL,IWK(1,7),WK(1,1),NIPI,
     +                XI(IIP),YI(IIP),KTLI,ITLI, ZI(IIP))
*         CALL SDPLNL(NDP,XD,YD,ZD,NT,IPT,NL,IPL,PDD,
*    +                NIP,XI,YI,KTLI,ITLI, ZI)
   10 CONTINUE
* Normal return
      IER = 0
      RETURN
* Error exit
   20 WRITE (*,FMT=9000) MD,NDP
      IER = 1
      RETURN
   30 WRITE (*,FMT=9010) MD,NDP,NDPPV
      IER = 2
      RETURN
   40 WRITE (*,FMT=9020) MD,NDP,NIP
      IER = 3
      RETURN
   50 WRITE (*,FMT=9030)
      IER = 9
      RETURN
* Format statement for error message
 9000 FORMAT (' ',/,'*** SDBI3P Error 1: NDP = 9 or less',/,'    MD =',
     +       I5,',  NDP =',I5,/)
 9010 FORMAT (' ',/,'*** SDBI3P Error 2: NDP not equal to NDPPV',/,
     +       '    MD =',I5,',  NDP =',I5,',  NDPPV =',I5,/)
 9020 FORMAT (' ',/,'*** SDBI3P Error 3: NIP = 0 or less',/,'    MD =',
     +       I5,',  NDP =',I5,',  NIP =',I5,/)
 9030 FORMAT ('    Error detected in SDTRAN called by SDBI3P',/)
      END


      SUBROUTINE SDSF3P(MD,NDP,XD,YD,ZD,NXI,XI,NYI,YI, ZI,IER, WK,IWK)
*
* Scattered-data smooth surface fitting
* (a master subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine performs smooth surface fitting when the data
* points are scattered in the x-y plane.  It is based on the
* revised Akima method that has the accuracy of a cubic (third-
* degree) polynomial.
*
* The input arguments are
*   MD  = mode of computation
*       = 1 for new XD-YD (default)
*       = 2 for old XD-YD, new ZD
*       = 3 for old XD-YD, old ZD,
*   NDP = number of data points (must be 10 or greater),
*   XD  = array of dimension NDP containing the x coordinates
*         of the data points,
*   YD  = array of dimension NDP containing the y coordinates
*         of the data points,
*   ZD  = array of dimension NDP containing the z values at
*         the data points,
*   NXI = number of output grid points in the x coordinate
*         (must be 1 or greater),
*   XI  = array of dimension NXI containing the x coordinates
*         of the output grid points,
*   NYI = number of output grid points in the y coordinate
*         (must be 1 or greater),
*   YI  = array of dimension NYI containing the y coordinates
*         of the output grid points.
*
* The output arguments are
*   ZI  = two-dimensional array of dimension NXI*NYI, where
*         the interpolated z values at the output grid points
*         are to be stored,
*   IER = error flag
*       = 0 for no errors
*       = 1 for NDP = 9 or less
*       = 2 for NDP not equal to NDPPV
*       = 3 for NXI = 0 or less
*       = 4 for NYI = 0 or less
*       = 9 for errors in SDTRAN called by this subroutine.
*
* The other arguments are
*   WK  = two-dimensional array of dimension NDP*36 used
*         internally as a work area,
*   IWK = two-dimensional integer array of dimension NDP*25
*         used internally as a work area.
*
* The very first call to this subroutine and the call with a new
* NDP value or new XD and YD arrays must be made with MD=1.  The
* call with MD=2 must be preceded by another call with the same
* NDP value and same XD and YD arrays.  The call with MD=3 must
* be preceded by another call with the same NDP value and same
* XD, YD, and ZD arrays.  Between the call with MD=2 and its
* preceding call, the IWK array must not be disturbed.  Between
* the call with MD=3 and its preceding call, the WK and IWK
* arrays must not be disturbed.
*
* The user of this subroutine can save the storage, by NDP*6
* numeric storage units, by placing the statement
*     EQUIVALENCE (WK(1,1),IWK(1,20))
* in the program that calls this subroutine.
*
* The constant in the PARAMETER statement below is
*   NIPIMX = maximum number of output points to be processed
*            at a time.
* The constant value has been selected empirically.
*
* This subroutine calls the SDTRAN, SDPD3P, SDLCTN, and SDPLNL
* subroutines.
*
*
* Specification statements
*     .. Parameters ..
      INTEGER          NIPIMX
      PARAMETER        (NIPIMX=51)
*     ..
*     .. Scalar Arguments ..
      INTEGER          IER,MD,NDP,NXI,NYI
*     ..
*     .. Array Arguments ..
      REAL             WK(NDP,17),XD(NDP),XI(NXI),YD(NDP),YI(NYI),
     +                 ZD(NDP),ZI(NXI,NYI)
      INTEGER          IWK(NDP,25)
*     ..
*     .. Local Scalars ..
      INTEGER          IERT,IIP,IXI,IYI,NDPPV,NIPI,NL,NT
*     ..
*     .. Local Arrays ..
      REAL             YII(NIPIMX)
      INTEGER          ITLI(NIPIMX),KTLI(NIPIMX)
*     ..
*     .. External Subroutines ..
      EXTERNAL         SDLCTN,SDPD3P,SDPLNL,SDTRAN
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MIN
*     ..
*     .. Save statement ..
      SAVE             NDPPV,NT,NL
*     ..
* Error check
      IF (NDP.LE.9) GO TO 40
      IF (MD.NE.2 .AND. MD.NE.3) THEN
          NDPPV = NDP
      ELSE
          IF (NDP.NE.NDPPV) GO TO 50
      END IF
      IF (NXI.LE.0) GO TO 60
      IF (NYI.LE.0) GO TO 70
* Triangulates the x-y plane.  (for MD=1)
      IF (MD.NE.2 .AND. MD.NE.3) THEN
          CALL SDTRAN(NDP,XD,YD, NT,IWK(1,1),NL,IWK(1,7),IERT,
     +                IWK(1,1),IWK(1,7),IWK(1,13),IWK(1,14),IWK(1,9))
*         CALL SDTRAN(NDP,XD,YD, NT,IPT,NL,IPL,IERT,
*    +                LIST,LPTR,LEND,LTRI,ITL)
          IF (IERT.GT.0) GO TO 80
      END IF
* Estimates partial derivatives at all data points.  (for MD=1,2)
      IF (MD.NE.3) THEN
          CALL SDPD3P(NDP,XD,YD,ZD, WK(1,1), WK(1,6),WK(1,15),WK(1,17),
     +                IWK(1,9),IWK(1,10),IWK(1,19))
*         CALL SDPD3P(NDP,XD,YD,ZD, PDD, CF3,CFL1,DSQ,IDSQ,IPC,NCP)
      END IF
* Locates all grid points at which interpolation is to be
* performed and interpolates the ZI values.  (for MD=1,2,3)
      DO 30 IYI = 1,NYI
          DO 10 IIP = 1,NIPIMX
              YII(IIP) = YI(IYI)
   10     CONTINUE
          DO 20 IXI = 1,NXI,NIPIMX
              NIPI = MIN(NXI-IXI+1,NIPIMX)
              CALL SDLCTN(NDP,XD,YD,NT,IWK(1,1),NL,IWK(1,7),NIPI,
     +                    XI(IXI),YII, KTLI,ITLI)
*             CALL SDLCTN(NDP,XD,YD,NT,IPT,NL,IPL,NIP,XI,YI, KTLI,ITLI)
              CALL SDPLNL(NDP,XD,YD,ZD,NT,IWK(1,1),NL,IWK(1,7),WK(1,1),
     +                    NIPI,XI(IXI),YII,KTLI,ITLI, ZI(IXI,IYI))
*             CALL SDPLNL(NDP,XD,YD,ZD,NT,ITP,NL,IPL,PDD,
*    +                    NIP,XI,YI,KTLI,ITLI, ZI)
   20     CONTINUE
   30 CONTINUE
* Normal return
      IER = 0
      RETURN
* Error exit
   40 WRITE (*,FMT=9000) MD,NDP
      IER = 1
      RETURN
   50 WRITE (*,FMT=9010) MD,NDP,NDPPV
      IER = 2
      RETURN
   60 WRITE (*,FMT=9020) MD,NDP,NXI,NYI
      IER = 3
      RETURN
   70 WRITE (*,FMT=9030) MD,NDP,NXI,NYI
      IER = 4
      RETURN
   80 WRITE (*,FMT=9040)
      IER = 9
      RETURN
* Format statement for error message
 9000 FORMAT (' ',/,'*** SDSF3P Error 1: NDP = 9 or less',/,'    MD =',
     +       I5,',  NDP =',I5,/)
 9010 FORMAT (' ',/,'*** SDSF3P Error 2: NDP not equal to NDPPV',/,
     +       '    MD =',I5,',  NDP =',I5,'  NDPPV =',I5,/)
 9020 FORMAT (' ',/,'*** SDSF3P Error 3: NXI = 0 or less',/,'    MD =',
     +       I5,',  NDP =',I5,'  NXI =',I5,',  NYI =',I5,/)
 9030 FORMAT (' ',/,'*** SDSF3P Error 4: NYI = 0 or less',/,'    MD =',
     +       I5,',  NDP =',I5,'  NXI =',I5,',  NYI =',I5,/)
 9040 FORMAT ('    Error detected in SDTRAN called by SDSF3P',/)
      END


      SUBROUTINE SDTRAN(NDP,XD,YD, NT,IPT,NL,IPL,IERT, LIST,LPTR,LEND,
     +                  LTRI,ITL)
*
* Triangulation of the data area in a plane with a scattered data
* point set
* (a supporting subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine triangulates the data area in the x-y plane with
* a scattered data point set.  It divides the data area into a
* number of triangles and determines line segments that form the
* border of the data area.
*
* This subroutine consists of the following two steps, i.e.,
* (1) basic triangulation in the convex hull of the data points,
* and (2) removal of thin triangles along the border line of the
* data area.  It calls the SDTRCH and SDTRTT subroutines, that
* correspond to Steps (1) and (2), respectively.
*
* The input arguments are
*   NDP  = number of data points (must be greater than 3),
*   XD   = array of dimension NDP containing the x
*          coordinates of the data points,
*   YD   = array of dimension NDP containing the y
*          coordinates of the data points.
*
* The output arguments are
*   NT   = number of triangles (its maximum is 2*NDP-5),
*   IPT  = two-dimensional integer array of dimension
*          (3,NT), where the point numbers of the vertexes
*          of the ITth triangle are to be stored counter-
*          clockwise in the ITth column, where IT = 1, 2,
*          ..., NT,
*   NL   = number of border line segments (its maximum is
*          NDP),
*   IPL  = two-dimensional integer array of dimension
*          (2,NL), where the point numbers of the end
*          points of the (IL)th border line segment are to
*          be stored counterclockwise in the ILth column,
*          where IL = 1, 2, ..., NL, with the line segments
*          stored counterclockwise,
*   IERT = error flag
*        = 0 for no errors
*        = 1 for NDP = 3 or less
*        = 2 for identical data points
*        = 3 for all collinear data points.
*
* The other arguments are
*   LIST = integer array of dimension 6*NDP USED internally
*          as a work area,
*   LPTR = integer array of dimension 6*NDP USED internally
*          as a work area,
*   LEND = integer array of dimension NDP USED internally as
*          a work area,
*   LTRI = two-dimensional integer array of dimension 12*NDP
*          used internally as a work area.
*   ITL  = integer array of dimension NDP used internally as
*          a work area.
*
*
* Specification statements
*     .. Scalar Arguments ..
      INTEGER          IERT,NDP,NL,NT
*     ..
*     .. Array Arguments ..
      REAL             XD(NDP),YD(NDP)
      INTEGER          IPL(2,*),IPT(3,*),ITL(NDP),LEND(NDP),LIST(6,NDP),
     +                 LPTR(6,NDP),LTRI(12,NDP)
*     ..
*     .. Local Scalars ..
      INTEGER          IERTL,IERTM,IP1
*     ..
*     .. External Subroutines ..
      EXTERNAL         SDTRCH,SDTRTT
*     ..
* Basic triangulation
      CALL SDTRCH(NDP,XD,YD, NT,IPT,NL,IPL,IERTM,IERTL, LIST,LPTR,LEND,
     +            LTRI)
      IF (IERTM.NE.0) GO TO 10
      IF (IERTL.NE.0) GO TO 20
      IERT = 0
* Removal of thin triangles that share border line segments
      CALL SDTRTT(NDP,XD,YD, NT,IPT,NL,IPL, ITL)
      RETURN
* Error exit
   10 IF (IERTM.EQ.-1) THEN
          IERT = 1
          WRITE (*,FMT=9000) NDP
      ELSE IF (IERTM.EQ.-2) THEN
          IERT = 2
          WRITE (*,FMT=9010)
      ELSE
          IERT = 3
          IP1 = IERTM
          WRITE (*,FMT=9020) NDP,IP1,XD(IP1),YD(IP1)
      END IF
      RETURN
   20 IF (IERTL.EQ.1) THEN
          IERT = 4
          WRITE (*,FMT=9030) NDP
      ELSE IF (IERTL.EQ.2) THEN
          IERT = 5
          WRITE (*,FMT=9040)
      END IF
      RETURN
* Format statements
 9000 FORMAT (' ',/,'*** SDTRAN Error 1: NDP = 3 or less',/,'    NDP =',
     +       I5)
 9010 FORMAT (' ',/,'*** SDTRAN Error 2: ',
     +       'The first three data points are collinear.',/)
 9020 FORMAT (' ',/,'*** SDTRAN Error 3: Identical data points',/,
     +       '    NDP =',I5,',  IP1 =',I5,',  XD =',E11.3,',  YD =',
     +       E11.3)
 9030 FORMAT (' ',/,'*** SDTRAN Error 4: NDP outside its valid',
     +       ' range',/,'    NDP =',I5)
 9040 FORMAT (' ',/,'*** SDTRAN Error 5: ',
     +       'Invalid data structure (LIST,LPTR,LEND)',/)
      END


      SUBROUTINE SDTRCH(NDP,XD,YD, NT,IPT,NL,IPL,IERTM,IERTL,
     +                  LIST,LPTR,LEND,LTRI)
*
* Basic triangulation in the convex hull of a scattered data point
* set in a plane
* (a supporting subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine triangulates the data area that is a convex hull
* of the scattered data points in the x-y plane.  It divides the
* data area into a number of triangles and determines line segments
* that form the border of the data area.
*
* This subroutine depends on the TRIPACK package of ACM Algorithm
* 751 by R. J. Renka.  It calls the TRMESH and TRLIST subroutines
* included in the package.  The TRMESH subroutine in turn calls
* either directly or indirectly 12 other subprograms included in
* the package.
*
* The input arguments are
*   NDP   = number of data points (must be greater than 3),
*   XD    = array of dimension NDP containing the x
*           coordinates of the data points,
*   YD    = array of dimension NDP containing the y
*           coordinates of the data points.
*
* The output arguments are
*   NT    = number of triangles (its maximum is 2*NDP-5),
*   IPT   = two-dimensional integer array of dimension
*           (3,NT), where the point numbers of the vertexes
*           of the ITth triangle are to be stored counter-
*           clockwise in the ITth column, where IT = 1, 2,
*           ..., NT,
*   NL    = number of border line segments (its maximum is
*           NDP),
*   IPL   = two-dimensional integer array of dimension
*           (2,NL), where the point numbers of the end
*           points of the (IL)th border line segment are to
*           be stored counterclockwise in the ILth column,
*           where IL = 1, 2, ..., NL, with the line segments
*           stored counterclockwise,
*   IERTM = error flag from the TRMESH subroutine,
*         =  0 for no errors
*         = -1 for NDP = 3 or less
*         = -2 for the first three collinear data points,
*         =  L for the Lth data point identical to some
*            Mth data point, M > L.
*   IERTL = error flag from the TRLIST subroutine,
*         = 0 for no errors
*         = 1 for invalid NCC, NDP, or NROW value.
*         = 2 for invalid data structure (LIST,LPTR,LEND).
*
* The other arguments are
*   LIST  = integer array of dimension 6*NDP USED internally
*           as a work area,
*   LPTR  = integer array of dimension 6*NDP USED internally
*           as a work area,
*   LEND  = integer array of dimension NDP USED internally as
*           a work area,
*   LTRI  = two-dimensional integer array of dimension 12*NDP
*           used internally as a work area.
*
*
* Specification statements
*     .. Parameters ..
      INTEGER          NCC,NROW
      PARAMETER        (NCC=0,NROW=6)
*     ..
*     .. Scalar Arguments ..
      INTEGER          IERTL,IERTM,NDP,NL,NT
*     ..
*     .. Array Arguments ..
      REAL             XD(NDP),YD(NDP)
      INTEGER          IPL(2,*),IPT(3,*),LEND(NDP),LIST(*),LPTR(*),
     +                 LTRI(NROW,*)
*     ..
*     .. Local Scalars ..
      INTEGER          I,I1,I2,IL,IL1,IL2,IPL11,IPL21,J,LNEW
*     ..
*     .. Local Arrays ..
      INTEGER          LCC(1),LCT(1)
*     ..
*     .. External Subroutines ..
      EXTERNAL         TRLIST,TRMESH
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MOD
*     ..
* Performs basic triangulation.
      CALL TRMESH(NDP,XD,YD, LIST,LPTR,LEND,LNEW,IERTM)
      IF (IERTM.NE.0) RETURN
      CALL TRLIST(NCC,LCC,NDP,LIST,LPTR,LEND,NROW, NT,LTRI,LCT,IERTL)
      IF (IERTL.NE.0) RETURN
* Extracts the triangle data from the LTRI array and set the IPT
* array.
      DO 20 J = 1,NT
          DO 10 I = 1,3
              IPT(I,J) = LTRI(I,J)
   10     CONTINUE
   20 CONTINUE
* Extracts the border-line-segment data from the LTRI array and
* set the IPL array.
      IL = 0
      DO 50 J = 1,NT
          DO 30 I = 1,3
              IF (LTRI(I+3,J).LE.0) GO TO 40
   30     CONTINUE
          GO TO 50
   40     IL = IL + 1
          I1 = MOD(I,3) + 1
          I2 = MOD(I+1,3) + 1
          IPL(1,IL) = LTRI(I1,J)
          IPL(2,IL) = LTRI(I2,J)
   50 CONTINUE
      NL = IL
* Sorts the IPL array.
      DO 80 IL1 = 1,NL - 1
          DO 60 IL2 = IL1 + 1,NL
              IF (IPL(1,IL2).EQ.IPL(2,IL1)) GO TO 70
   60     CONTINUE
   70     IPL11 = IPL(1,IL1+1)
          IPL21 = IPL(2,IL1+1)
          IPL(1,IL1+1) = IPL(1,IL2)
          IPL(2,IL1+1) = IPL(2,IL2)
          IPL(1,IL2) = IPL11
          IPL(2,IL2) = IPL21
   80 CONTINUE
      RETURN
      END


      SUBROUTINE SDTRTT(NDP,XD,YD, NT,IPT,NL,IPL, ITL)
*
* Removal of thin triangles along the border line of triangulation
* (a supporting subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine removes thin triangles along the border line of
* triangulation.
*
* The input arguments are
*   NDP = number of data points (must be greater than 3),
*   XD  = array of dimension NDP containing the x
*         coordinates of the data points,
*   YD  = array of dimension NDP containing the y
*         coordinates of the data points.
*
* The input and output arguments are
*   NT  = number of triangles (its maximum is 2*NDP-5),
*   IPT = two-dimensional integer array of dimension
*         (3,NT), where the point numbers of the vertexes
*         of the ITth triangle are to be stored counter-
*         clockwise in the ITth column, where IT = 1, 2,
*         ..., NT,
*   NL  = number of border line segments (its maximum is
*         NDP),
*   IPL = two-dimensional integer array of dimension
*         (2,NL), where the point numbers of the end
*         points of the (IL)th border line segment are to
*         be stored counterclockwise in the ILth column,
*         where IL = 1, 2, ..., NL, with the line segments
*         stored counterclockwise.
*
* The other argument is
*   ITL = integer array of dimension NDP used internally as
*         a work area.
*
* The constants in the PARAMETER statement below are
*   HBRMN = minimum value of the height-to-bottom ratio of a
*           triangle along the border line of the data area,
*   NRRTT = number of repetitions in thin triangle removal.
* The constant values have been selected empirically.
*
* Specification statements
*     .. Parameters ..
      REAL             HBRMN
      INTEGER          NRRTT
      PARAMETER        (HBRMN=0.10,NRRTT=5)
*     ..
*     .. Scalar Arguments ..
      INTEGER          NDP,NL,NT
*     ..
*     .. Array Arguments ..
      REAL             XD(NDP),YD(NDP)
      INTEGER          IPL(2,*),IPT(3,*),ITL(NDP)
*     ..
*     .. Local Scalars ..
      REAL             HBR,U1,U2,U3,V1,V2,V3
      INTEGER          IL,IL0,IL00,IL1,ILP1,ILR1,IP1,IP2,IP3,IPL1,IPL2,
     +                 IREP,IT,IT0,ITP1,IV,IVP1,MODIF,NL0
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MOD
*     ..
*     .. Statement Functions ..
      REAL             DSQF,VPDT
*     ..
* Statement Function definitions 
      DSQF(U1,V1,U2,V2) = (U2-U1)**2 + (V2-V1)**2
      VPDT(U1,V1,U2,V2,U3,V3) = (V3-V1)* (U2-U1) - (U3-U1)* (V2-V1)
*     ..
* Triangle numbers of triangles that share line segments with the
* border line.
      DO 20 IL = 1,NL
          IPL1 = IPL(1,IL)
          IPL2 = IPL(2,IL)
          DO 10 IT = 1,NT
              IF (IPL1.EQ.IPT(1,IT) .OR. IPL1.EQ.IPT(2,IT) .OR.
     +            IPL1.EQ.IPT(3,IT)) THEN
                  IF (IPL2.EQ.IPT(1,IT) .OR. IPL2.EQ.IPT(2,IT) .OR.
     +                IPL2.EQ.IPT(3,IT)) THEN
                      ITL(IL) = IT
                      GO TO 20
                  END IF
              END IF
   10     CONTINUE
   20 CONTINUE
* Removes thin triangles that share line segments with the border
* line.
      DO 130 IREP = 1,NRRTT
          MODIF = 0
          NL0 = NL
          IL = 0
          DO 120 IL0 = 1,NL0
              IL = IL + 1
              IP1 = IPL(1,IL)
              IP2 = IPL(2,IL)
              IT = ITL(IL)
* Calculates the height-to-bottom ratio of the triangle.
              IF (IPT(1,IT).NE.IP1 .AND. IPT(1,IT).NE.IP2) THEN
                  IP3 = IPT(1,IT)
              ELSE IF (IPT(2,IT).NE.IP1 .AND. IPT(2,IT).NE.IP2) THEN
                  IP3 = IPT(2,IT)
              ELSE
                  IP3 = IPT(3,IT)
              END IF
              HBR = VPDT(XD(IP1),YD(IP1),XD(IP2),YD(IP2),XD(IP3),
     +              YD(IP3))/DSQF(XD(IP1),YD(IP1),XD(IP2),YD(IP2))
              IF (HBR.LT.HBRMN) THEN
                  MODIF = 1
* Removes this triangle when applicable.
                  ITP1 = IT + 1
                  DO 30 IT0 = ITP1,NT
                      IPT(1,IT0-1) = IPT(1,IT0)
                      IPT(2,IT0-1) = IPT(2,IT0)
                      IPT(3,IT0-1) = IPT(3,IT0)
   30             CONTINUE
                  NT = NT - 1
                  DO 40 IL00 = 1,NL
                      IF (ITL(IL00).GT.IT) ITL(IL00) = ITL(IL00) - 1
   40             CONTINUE
* Replaces the border line segment with two new line segments.
                  IF (IL.LT.NL) THEN
                      ILP1 = IL + 1
                      DO 50 ILR1 = ILP1,NL
                          IL1 = NL + ILP1 - ILR1
                          IPL(1,IL1+1) = IPL(1,IL1)
                          IPL(2,IL1+1) = IPL(2,IL1)
                          ITL(IL1+1) = ITL(IL1)
   50                 CONTINUE
                  END IF
* - Adds the first new line segment.
                  IPL(1,IL) = IP1
                  IPL(2,IL) = IP3
                  DO 70 IT0 = 1,NT
                      DO 60 IV = 1,3
                          IF (IPT(IV,IT0).EQ.IP1 .OR.
     +                        IPT(IV,IT0).EQ.IP3) THEN
                              IVP1 = MOD(IV,3) + 1
                              IF (IPT(IVP1,IT0).EQ.IP1 .OR.
     +                            IPT(IVP1,IT0).EQ.IP3) GO TO 80
                          END IF
   60                 CONTINUE
   70             CONTINUE
   80             ITL(IL) = IT0
* - Adds the second new line segment.
                  IL = IL + 1
                  IPL(1,IL) = IP3
                  IPL(2,IL) = IP2
                  DO 100 IT0 = 1,NT
                      DO 90 IV = 1,3
                          IF (IPT(IV,IT0).EQ.IP3 .OR.
     +                        IPT(IV,IT0).EQ.IP2) THEN
                              IVP1 = MOD(IV,3) + 1
                              IF (IPT(IVP1,IT0).EQ.IP3 .OR.
     +                            IPT(IVP1,IT0).EQ.IP2) GO TO 110
                          END IF
   90                 CONTINUE
  100             CONTINUE
  110             ITL(IL) = IT0
                  NL = NL + 1
              END IF
  120     CONTINUE
          IF (MODIF.EQ.0) RETURN
  130 CONTINUE
      RETURN
      END


      SUBROUTINE SDPD3P(NDP,XD,YD,ZD, PDD, CF3,CFL1,DSQ,IDSQ,IPC,NCP)
*
* Partial derivatives for bivariate interpolation and surface
* fitting for scattered data
* (a supporting subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine estimates partial derivatives of the first and
* second orders at the data points for bivariate interpolation
* and surface fitting for scattered data.  In most cases, this
* subroutine has the accuracy of a cubic (third-degree)
* polynomial.
*
* The input arguments are
*   NDP  = number of data points,
*   XD   = array of dimension NDP containing the x
*          coordinates of the data points,
*   YD   = array of dimension NDP containing the y
*          coordinates of the data points,
*   ZD   = array of dimension NDP containing the z values
*          at the data points.
*
* The output argument is
*   PDD  = two-dimensional array of dimension 5*NDP, where
*          the estimated zx, zy, zxx, zxy, and zyy values
*          at the IDPth data point are to be stored in the
*          IDPth row, where IDP = 1, 2, ..., NDP.
*
* The other arguments are
*   CF3  = two-dimensional array of dimension 9*NDP used
*          internally as a work area,
*   CFL1 = two-dimensional array of dimension 2*NDP used
*          internally as a work area,
*   DSQ  = array of dimension NDP used internally as a work
*          area,
*   IDSQ = integer array of dimension NDP used internally
*          as a work area,
*   IPC  = two-dimensional integer array of dimension 9*NDP
*          used internally as a work area,
*   NCP  = integer array of dimension NDP used internally
*          as a work area.
*
* The constant in the first PARAMETER statement below is
*   NPEMX = maximum number of primary estimates.
* The constant value has been selected empirically.
*
* The constants in the second PARAMETER statement below are
*   NPEAMN = minimum number of primary estimates,
*   NPEAMX = maximum number of primary estimates when
*            additional primary estimates are added.
* The constant values have been selected empirically.
*
* This subroutine calls the SDCLDP, SDCF3P, and SDLS1P
* subroutines.
*
*
* Specification statements
*     .. Parameters ..
      INTEGER          NPEMX
      PARAMETER        (NPEMX=25)
      INTEGER          NPEAMN,NPEAMX
      PARAMETER        (NPEAMN=3,NPEAMX=6)
*     ..
*     .. Scalar Arguments ..
      INTEGER          NDP
*     ..
*     .. Array Arguments ..
      REAL             CF3(9,NDP),CFL1(2,NDP),DSQ(NDP),PDD(5,NDP),
     +                 XD(NDP),YD(NDP),ZD(NDP)
      INTEGER          IDSQ(NDP),IPC(9,NDP),NCP(NDP)
*     ..
*     .. Local Scalars ..
      REAL             A01,A02,A03,A10,A11,A12,A20,A21,A30,ALPWT,ANPE,
     +                 ANPEM1,SMWTF,SMWTI,WTF,WTI,X,Y,ZX,ZY
      INTEGER          IDP1,IDP2,IDPI,IDPPE1,IMN,IPE,IPE1,J,J1,J2,JJ,
     +                 JMN,K,NCP2,NCP2P1,NPE
*     ..
*     .. Local Arrays ..
      REAL             AMPDPE(5),PDDIF(5),PDDII(5),PDPE(5,NPEMX),
     +                 PWT(NPEMX),RVWT(NPEMX),SSPDPE(5)
      INTEGER          IDPPE(NPEMX),IPCPE(10,NPEMX)
*     ..
*     .. External Subroutines ..
      EXTERNAL         SDCF3P,SDCLDP,SDLS1P
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        EXP,REAL
*     ..
* Calculation
* Selects, at each of the data points, nine data points closest
* to the data point in question.
      CALL SDCLDP(NDP,XD,YD, IPC, DSQ,IDSQ)
* Fits, at each of the data points, a cubic (third-degree)
* polynomial to z values at the 10 data points that consist of
* the data point in question and 9 data points closest to it.
      CALL SDCF3P(NDP,XD,YD,ZD,IPC, CF3,NCP)
* Performs, at each of the data points, the least-squares fit of
* a plane to z values at the 10 data points.
      CALL SDLS1P(NDP,XD,YD,ZD,IPC,NCP, CFL1)
* Outermost DO-loop with respect to the data point
      DO 310 IDP1 = 1,NDP
* Selects data point sets for sets of primary estimates of partial
* derivatives.
* - Selects a candidate.
          NPE = 0
          DO 80 IDP2 = 1,NDP
              NCP2 = NCP(IDP2)
              NCP2P1 = NCP2 + 1
              IF (IDP2.EQ.IDP1) GO TO 20
              DO 10 J = 1,NCP2
                  IF (IPC(J,IDP2).EQ.IDP1) GO TO 20
   10         CONTINUE
              GO TO 80
   20         IPCPE(1,NPE+1) = IDP2
              DO 30 J = 1,NCP2
                  IPCPE(J+1,NPE+1) = IPC(J,IDP2)
   30         CONTINUE
              DO 50 J1 = 1,NCP2
                  JMN = J1
                  IMN = IPCPE(JMN,NPE+1)
                  DO 40 J2 = J1,NCP2P1
                      IF (IPCPE(J2,NPE+1).LT.IMN) THEN
                          JMN = J2
                          IMN = IPCPE(JMN,NPE+1)
                      END IF
   40             CONTINUE
                  IPCPE(JMN,NPE+1) = IPCPE(J1,NPE+1)
                  IPCPE(J1,NPE+1) = IMN
   50         CONTINUE
* - Checks whether or not the candidate has already been included.
              IF (NPE.GT.0) THEN
                  DO 70 IPE1 = 1,NPE
                      IDPPE1 = IDPPE(IPE1)
                      IF (NCP2.NE.NCP(IDPPE1)) GO TO 70
                      DO 60 J = 1,NCP2P1
                          IF (IPCPE(J,NPE+1).NE.
     +                        IPCPE(J,IPE1)) GO TO 70
   60                 CONTINUE
                      GO TO 80
   70             CONTINUE
              END IF
              NPE = NPE + 1
              IDPPE(NPE) = IDP2
              IF (NPE.GE.NPEMX) GO TO 90
   80     CONTINUE
   90     CONTINUE
* Adds additional closest data points when necessary.
          IF (NPE.LT.NPEAMN) THEN
              DO 150 JJ = 1,9
                  IDP2 = IPC(JJ,IDP1)
                  NCP2 = NCP(IDP2)
                  NCP2P1 = NCP2 + 1
                  IPCPE(1,NPE+1) = IDP2
                  DO 100 J = 1,NCP2
                      IPCPE(J+1,NPE+1) = IPC(J,IDP2)
  100             CONTINUE
                  DO 120 J1 = 1,NCP2
                      JMN = J1
                      IMN = IPCPE(JMN,NPE+1)
                      DO 110 J2 = J1,NCP2P1
                          IF (IPCPE(J2,NPE+1).LT.IMN) THEN
                              JMN = J2
                              IMN = IPCPE(JMN,NPE+1)
                          END IF
  110                 CONTINUE
                      IPCPE(JMN,NPE+1) = IPCPE(J1,NPE+1)
                      IPCPE(J1,NPE+1) = IMN
  120             CONTINUE
                  IF (NPE.GT.0) THEN
                      DO 140 IPE1 = 1,NPE
                          IDPPE1 = IDPPE(IPE1)
                          IF (NCP2.NE.NCP(IDPPE1)) GO TO 140
                          DO 130 J = 1,NCP2P1
                              IF (IPCPE(J,NPE+1).NE.
     +                            IPCPE(J,IPE1)) GO TO 140
  130                     CONTINUE
                          GO TO 150
  140                 CONTINUE
                  END IF
                  NPE = NPE + 1
                  IDPPE(NPE) = IDP2
                  IF (NPE.GE.NPEAMX) GO TO 160
  150         CONTINUE
          END IF
  160     CONTINUE
* Calculates the primary estimates of partial derivatives.
          X = XD(IDP1)
          Y = YD(IDP1)
          DO 170 IPE = 1,NPE
              IDPI = IDPPE(IPE)
              A10 = CF3(1,IDPI)
              A20 = CF3(2,IDPI)
              A30 = CF3(3,IDPI)
              A01 = CF3(4,IDPI)
              A11 = CF3(5,IDPI)
              A21 = CF3(6,IDPI)
              A02 = CF3(7,IDPI)
              A12 = CF3(8,IDPI)
              A03 = CF3(9,IDPI)
              PDPE(1,IPE) = A10 + X* (2.0*A20+X*3.0*A30) +
     +                      Y* (A11+2.0*A21*X+A12*Y)
              PDPE(2,IPE) = A01 + Y* (2.0*A02+Y*3.0*A03) +
     +                      X* (A11+2.0*A12*Y+A21*X)
              PDPE(3,IPE) = 2.0*A20 + 6.0*A30*X + 2.0*A21*Y
              PDPE(4,IPE) = A11 + 2.0*A21*X + 2.0*A12*Y
              PDPE(5,IPE) = 2.0*A02 + 6.0*A03*Y + 2.0*A12*X
  170     CONTINUE
          IF (NPE.EQ.1) GO TO 290
* Weighted values of partial derivatives (through the statement
* labeled 280 + 1)
* Calculates the probability weight.
          ANPE = REAL(NPE)
          ANPEM1 = REAL(NPE-1)
          DO 190 K = 1,5
              AMPDPE(K) = 0.0
              SSPDPE(K) = 0.0
              DO 180 IPE = 1,NPE
                  AMPDPE(K) = AMPDPE(K) + PDPE(K,IPE)
                  SSPDPE(K) = SSPDPE(K) + PDPE(K,IPE)**2
  180         CONTINUE
              AMPDPE(K) = AMPDPE(K)/ANPE
              SSPDPE(K) = (SSPDPE(K)-ANPE*AMPDPE(K)**2)/ANPEM1
  190     CONTINUE
          DO 210 IPE = 1,NPE
              ALPWT = 0.0
              DO 200 K = 1,5
                  IF (SSPDPE(K).NE.0.0) ALPWT = ALPWT +
     +                ((PDPE(K,IPE)-AMPDPE(K))**2)/SSPDPE(K)
  200         CONTINUE
              PWT(IPE) = EXP(-ALPWT/2.0)
  210     CONTINUE
* Calculates the reciprocal of the volatility weight.
          DO 220 IPE = 1,NPE
              IDPI = IDPPE(IPE)
              ZX = CFL1(1,IDPI)
              ZY = CFL1(2,IDPI)
              RVWT(IPE) = ((PDPE(1,IPE)-ZX)**2+ (PDPE(2,IPE)-ZY)**2)*
     +                    (PDPE(3,IPE)**2+2.0*PDPE(4,IPE)**2+
     +                    PDPE(5,IPE)**2)
*             ZXX=0.0
*             ZXY=0.0
*             ZYY=0.0
*             RVWT(IPE)=((PDPE(1,IPE)-ZX)**2+(PDPE(2,IPE)-ZY)**2)
*    +                 *((PDPE(3,IPE)-ZXX)**2+2.0*(PDPE(4,IPE)-ZXY)**2
*    +                  +(PDPE(5,IPE)-ZYY)**2)
  220     CONTINUE
* Calculates the weighted values of partial derivatives.
          DO 230 K = 1,5
              PDDIF(K) = 0.0
              PDDII(K) = 0.0
  230     CONTINUE
          SMWTF = 0.0
          SMWTI = 0.0
          DO 260 IPE = 1,NPE
              IF (RVWT(IPE).GT.0.0) THEN
                  WTF = PWT(IPE)/RVWT(IPE)
                  DO 240 K = 1,5
                      PDDIF(K) = PDDIF(K) + PDPE(K,IPE)*WTF
  240             CONTINUE
                  SMWTF = SMWTF + WTF
              ELSE
                  WTI = PWT(IPE)
                  DO 250 K = 1,5
                      PDDII(K) = PDDII(K) + PDPE(K,IPE)*WTI
  250             CONTINUE
                  SMWTI = SMWTI + WTI
              END IF
  260     CONTINUE
          IF (SMWTI.LE.0.0) THEN
              DO 270 K = 1,5
                  PDD(K,IDP1) = PDDIF(K)/SMWTF
  270         CONTINUE
          ELSE
              DO 280 K = 1,5
                  PDD(K,IDP1) = PDDII(K)/SMWTI
  280         CONTINUE
          END IF
          GO TO 310
* Only one qualified point set
  290     DO 300 K = 1,5
              PDD(K,IDP1) = PDPE(K,1)
  300     CONTINUE
  310 CONTINUE
      RETURN
      END


      SUBROUTINE SDCLDP(NDP,XD,YD, IPC, DSQ,IDSQ)
*
* Closest data points
* (a supporting subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine selects, at each of the data points, nine data
* points closest to it.
*
* The input arguments are
*   NDP  = number of data points,
*   XD   = array of dimension NDP containing the x
*          coordinates of the data points,
*   YD   = array of dimension NDP containing the y
*          coordinates of the data points.
*
* The output argument is
*   IPC  = two-dimensional integer array of dimension 9*NDP,
*          where the point numbers of nine data points closest
*          to the IDPth data point, in an ascending order of
*          the distance from the IDPth point, are to be
*          stored in the IDPth column, where IDP = 1, 2,
*          ..., NDP.
*
* The other arguments are
*   DSQ  = array of dimension NDP used as a work area,
*   IDSQ = integer array of dimension NDP used as a work
*          area.
*
*
* Specification statements
*     .. Scalar Arguments ..
      INTEGER          NDP
*     ..
*     .. Array Arguments ..
      REAL             DSQ(NDP),XD(NDP),YD(NDP)
      INTEGER          IDSQ(NDP),IPC(9,NDP)
*     ..
*     .. Local Scalars ..
      REAL             DSQMN
      INTEGER          IDP,IDSQMN,JDP,JDPMN,JDSQMN,JIPC,JIPCMX
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MIN
*     ..
* DO-loop with respect to the data point number
      DO 50 IDP = 1,NDP
* Calculates the distance squared for all data points from the
* IDPth data point and stores the data point number and the
* calculated results in the IDSQ and DSQ arrays, respectively.
          DO 10 JDP = 1,NDP
              IDSQ(JDP) = JDP
              DSQ(JDP) = (XD(JDP)-XD(IDP))**2 + (YD(JDP)-YD(IDP))**2
   10     CONTINUE
* Sorts the IDSQ and DSQ arrays in such a way that the IDPth
* point is in the first element in each array.
          IDSQ(IDP) = 1
          DSQ(IDP) = DSQ(1)
          IDSQ(1) = IDP
          DSQ(1) = 0.0
* Selects nine data points closest to the IDPth data point and
* stores the data point numbers in the IPC array.
          JIPCMX = MIN(NDP-1,10)
          DO 30 JIPC = 2,JIPCMX
              JDSQMN = JIPC
              DSQMN = DSQ(JIPC)
              JDPMN = JIPC + 1
              DO 20 JDP = JDPMN,NDP
                  IF (DSQ(JDP).LT.DSQMN) THEN
                      JDSQMN = JDP
                      DSQMN = DSQ(JDP)
                  END IF
   20         CONTINUE
              IDSQMN = IDSQ(JDSQMN)
              IDSQ(JDSQMN) = IDSQ(JIPC)
              DSQ(JDSQMN) = DSQ(JIPC)
              IDSQ(JIPC) = IDSQMN
   30     CONTINUE
          DO 40 JIPC = 1,9
              IPC(JIPC,IDP) = IDSQ(JIPC+1)
   40     CONTINUE
   50 CONTINUE
      RETURN
      END


      SUBROUTINE SDCF3P(NDP,XD,YD,ZD,IPC, CF,NCP)
*
* Coefficients of the third-degree polynomial for z(x,y)
* (a supporting subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine calculates, for each data point, coefficients
* of the third-degree polynomial for z(x,y) fitted to the set of
* 10 data points consisting of the data point in question and
* nine data points closest to it.  When the condition number of
* the matrix associated with the 10 data point set is too large,
* this subroutine calculates coefficients of the second-degree
* polynomial fitted to the set of six data points consisting of
* the data point in question and five data points closest to it.
* When the condition number of the matrix associated with the six
* data point set is too large, this subroutine calculates
* coefficients of the first-degree polynomial fitted to the set of
* three data points closest to the data point in question.  When
* the condition number of the matrix associated with the three data
* point set is too large, this subroutine calculates coefficients
* of the first-degree polynomial fitted to the set of two data
* points consisting of the data point in question and one data
* point closest to it, assuming that the plane represented by the
* polynomial is horizontal in the direction which is at right
* angles to the line connecting the two data points.
*
* The input arguments are
*   NDP = number of data points,
*   XD  = array of dimension NDP containing the x
*         coordinates of the data points,
*   YD  = array of dimension NDP containing the y
*         coordinates of the data points,
*   ZD  = array of dimension NDP containing the z values
*         at the data points,
*   IPC = two-dimensional integer array of dimension
*         9*NDP containing the point numbers of 9 data
*         points closest to the IDPth data point in the
*         IDPth column, where IDP = 1, 2, ..., NDP.
*
* The output arguments are
*   CF  = two-dimensional array of dimension 9*NDP,
*         where the coefficients of the polynomial
*         (a10, a20, a30, a01, a11, a21, a02, a12, a03)
*         calculated at the IDPth data point are to be
*         stored in the IDPth column, where IDP = 1, 2,
*         ..., NDP,
*   NCP = integer array of dimension NDP, where the numbers
*         of the closest points used are to be stored.
*
* The constant in the first PARAMETER statement below is
*   CNRMX = maximum value of the ratio of the condition
*           number of the matrix associated with the point
*           set to the number of points.
* The constant value has been selected empirically.
*
* The N1, N2, and N3 constants in the second PARAMETER statement
* are the numbers of the data points used to determine the first-,
* second-, and third-degree polynomials, respectively.
*
* This subroutine calls the SDLEQN subroutine.
*
*
* Specification statements
*     .. Parameters ..
      REAL             CNRMX
      PARAMETER        (CNRMX=1.5E+04)
      INTEGER          N1,N2,N3
      PARAMETER        (N1=3,N2=6,N3=10)
*     ..
*     .. Scalar Arguments ..
      INTEGER          NDP
*     ..
*     .. Array Arguments ..
      REAL             CF(9,NDP),XD(NDP),YD(NDP),ZD(NDP)
      INTEGER          IPC(9,NDP),NCP(NDP)
*     ..
*     .. Local Scalars ..
      REAL             CN,DET,X,X1,X2,Y,Y1,Y2,Z1,Z2
      INTEGER          I,IDP,IDPI,J
*     ..
*     .. Local Arrays ..
      REAL             AA1(N1,N1),AA2(N2,N2),AA3(N3,N3),B(N3),CFI(N3),
     +                 EE(N3,N3),ZZ(N3,N3)
      INTEGER          K(N3)
*     ..
*     .. External Subroutines ..
      EXTERNAL         SDLEQN
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        REAL
*     ..
* Main DO-loop with respect to the data point
      DO 60 IDP = 1,NDP
          DO 10 J = 1,9
              CF(J,IDP) = 0.0
   10     CONTINUE
* Calculates the coefficients of the set of linear equations
* with the 10-point data point set.
          DO 20 I = 1,N3
              IF (I.EQ.1) THEN
                  IDPI = IDP
              ELSE
                  IDPI = IPC(I-1,IDP)
              END IF
              X = XD(IDPI)
              Y = YD(IDPI)
              AA3(I,1) = 1.0
              AA3(I,2) = X
              AA3(I,3) = X*X
              AA3(I,4) = X*X*X
              AA3(I,5) = Y
              AA3(I,6) = X*Y
              AA3(I,7) = X*X*Y
              AA3(I,8) = Y*Y
              AA3(I,9) = X*Y*Y
              AA3(I,10) = Y*Y*Y
              B(I) = ZD(IDPI)
   20     CONTINUE
* Solves the set of linear equations.
          CALL SDLEQN(N3,AA3,B, CFI,DET,CN, K,EE,ZZ)
* Stores the calculated results as the coefficients of the
* third-degree polynomial when applicable.
          IF (DET.NE.0.0) THEN
              IF (CN.LE.CNRMX*REAL(N3)) THEN
                  DO 30 J = 2,N3
                      CF(J-1,IDP) = CFI(J)
   30             CONTINUE
                  NCP(IDP) = N3 - 1
                  GO TO 60
              END IF
          END IF
* Calculates the coefficients of the set of linear equations
* with the 6-point data point set.
          DO 40 I = 1,N2
              IF (I.EQ.1) THEN
                  IDPI = IDP
              ELSE
                  IDPI = IPC(I-1,IDP)
              END IF
              X = XD(IDPI)
              Y = YD(IDPI)
              AA2(I,1) = 1.0
              AA2(I,2) = X
              AA2(I,3) = X*X
              AA2(I,4) = Y
              AA2(I,5) = X*Y
              AA2(I,6) = Y*Y
              B(I) = ZD(IDPI)
   40     CONTINUE
* Solves the set of linear equations.
          CALL SDLEQN(N2,AA2,B, CFI,DET,CN, K,EE,ZZ)
* Stores the calculated results as the coefficients of the
* second-degree polynomial when applicable.
          IF (DET.NE.0.0) THEN
              IF (CN.LE.CNRMX*REAL(N2)) THEN
                  CF(1,IDP) = CFI(2)
                  CF(2,IDP) = CFI(3)
                  CF(4,IDP) = CFI(4)
                  CF(5,IDP) = CFI(5)
                  CF(7,IDP) = CFI(6)
                  NCP(IDP) = N2 - 1
                  GO TO 60
              END IF
          END IF
* Calculates the coefficients of the set of linear equations
* with the 3-point data point set.
          DO 50 I = 1,N1
              IDPI = IPC(I,IDP)
              X = XD(IDPI)
              Y = YD(IDPI)
              AA1(I,1) = 1.0
              AA1(I,2) = X
              AA1(I,3) = Y
              B(I) = ZD(IDPI)
   50     CONTINUE
* Solves the set of linear equations.
          CALL SDLEQN(N1,AA1,B, CFI,DET,CN, K,EE,ZZ)
* Stores the calculated results as the coefficients of the
* first-degree polynomial when applicable.
          IF (DET.NE.0.0) THEN
              IF (CN.LE.CNRMX*REAL(N1)) THEN
                  CF(1,IDP) = CFI(2)
                  CF(4,IDP) = CFI(3)
                  NCP(IDP) = N1
                  GO TO 60
              END IF
          END IF
* Calculates the coefficients of the set of linear equations
* with the 2-point data point set when applicable.
          IDPI = IDP
          X1 = XD(IDPI)
          Y1 = YD(IDPI)
          Z1 = ZD(IDPI)
          IDPI = IPC(1,IDP)
          X2 = XD(IDPI)
          Y2 = YD(IDPI)
          Z2 = ZD(IDPI)
          CF(1,IDP) = (X2-X1)* (Z2-Z1)/ ((X2-X1)**2+ (Y2-Y1)**2)
          CF(4,IDP) = (Y2-Y1)* (Z2-Z1)/ ((X2-X1)**2+ (Y2-Y1)**2)
          NCP(IDP) = 1
   60 CONTINUE
      RETURN
      END


      SUBROUTINE SDLEQN(N,AA,B, X,DET,CN, K,EE,ZZ)
*
* Solution of a set of linear equations
* (a supporting subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine solves a set of linear equations.
*
* The input arguments are
*   N   = number of linear equations,
*   AA  = two-dimensional array of dimension N*N
*         containing the coefficients of the equations,
*   B   = array of dimension N containing the constant
*         values in the right-hand side of the equations.
*
* The output arguments are
*   X   = array of dimension N, where the solution is
*         to be stored,
*   DET = determinant of the AA array,
*   CN  = condition number of the AA matrix.
*
* The other arguments are
*   K   = integer array of dimension N used internally
*         as the work area,
*   EE  = two-dimensional array of dimension N*N used
*         internally as the work area,
*   ZZ  = two-dimensional array of dimension N*N used
*         internally as the work area.
*
*
* Specification statements
*     .. Scalar Arguments ..
      REAL             CN,DET
      INTEGER          N
*     ..
*     .. Array Arguments ..
      REAL             AA(N,N),B(N),EE(N,N),X(N),ZZ(N,N)
      INTEGER          K(N)
*     ..
*     .. Local Scalars ..
      REAL             AAIIJ,AAIJIJ,AAIJMX,AAMX,SA,SZ
      INTEGER          I,IJ,IJP1,IJR,J,JJ,JMX,KJMX
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        ABS,SQRT
*     ..
* Calculation
* Initial setting
      DO 10 J = 1,N
          K(J) = J
   10 CONTINUE
      DO 30 I = 1,N
          DO 20 J = 1,N
              EE(I,J) = 0.0
   20     CONTINUE
          EE(I,I) = 1.0
   30 CONTINUE
* Calculation of inverse matrix of AA
      DO 110 IJ = 1,N
* Finds out the element having the maximum absolute value in the
* IJ th row.
          AAMX = ABS(AA(IJ,IJ))
          JMX = IJ
          DO 40 J = IJ,N
              IF (ABS(AA(IJ,J)).GT.AAMX) THEN
                  AAMX = ABS(AA(IJ,J))
                  JMX = J
              END IF
   40     CONTINUE
* Switches two columns in such a way that the element with the
* maximum value is on the diagonal.
          DO 50 I = 1,N
              AAIJMX = AA(I,IJ)
              AA(I,IJ) = AA(I,JMX)
              AA(I,JMX) = AAIJMX
   50     CONTINUE
          KJMX = K(IJ)
          K(IJ) = K(JMX)
          K(JMX) = KJMX
* Makes the diagonal element to be unity.
          AAIJIJ = AA(IJ,IJ)
          IF (AAIJIJ.EQ.0.0) GO TO 210
          DO 60 J = IJ,N
              AA(IJ,J) = AA(IJ,J)/AAIJIJ
   60     CONTINUE
          DO 70 JJ = 1,N
              EE(IJ,JJ) = EE(IJ,JJ)/AAIJIJ
   70     CONTINUE
* Eliminates the lower left elements.
          IF (IJ.LT.N) THEN
              IJP1 = IJ + 1
              DO 100 I = IJP1,N
                  AAIIJ = AA(I,IJ)
                  DO 80 J = IJP1,N
                      AA(I,J) = AA(I,J) - AA(IJ,J)*AAIIJ
   80             CONTINUE
                  DO 90 JJ = 1,N
                      EE(I,JJ) = EE(I,JJ) - EE(IJ,JJ)*AAIIJ
   90             CONTINUE
  100         CONTINUE
          END IF
* Calculates the determinant.
          IF (IJ.EQ.1) THEN
              DET = 1.0
          END IF
          DET = DET*AAIJIJ* ((-1)** (IJ+JMX))
  110 CONTINUE
* Calculates the elements of the inverse matrix.
      DO 140 IJR = 1,N
          IJ = N + 1 - IJR
          IF (IJ.LT.N) THEN
              IJP1 = IJ + 1
              DO 130 J = IJP1,N
                  DO 120 JJ = 1,N
                      EE(IJ,JJ) = EE(IJ,JJ) - AA(IJ,J)*EE(J,JJ)
  120             CONTINUE
  130         CONTINUE
          END IF
  140 CONTINUE
      DO 160 J = 1,N
          I = K(J)
          DO 150 JJ = 1,N
              ZZ(I,JJ) = EE(J,JJ)
  150     CONTINUE
  160 CONTINUE
* Calculation of the condition number of AA
      SA = 0.0
      SZ = 0.0
      DO 180 I = 1,N
          DO 170 J = 1,N
              SA = SA + AA(I,J)*AA(J,I)
              SZ = SZ + ZZ(I,J)*ZZ(J,I)
  170     CONTINUE
  180 CONTINUE
      CN = SQRT(ABS(SA*SZ))
* Calculation of X vector
      DO 200 I = 1,N
          X(I) = 0.0
          DO 190 J = 1,N
              X(I) = X(I) + ZZ(I,J)*B(J)
  190     CONTINUE
  200 CONTINUE
      RETURN
* Special case where the determinant is zero
  210 DO 220 I = 1,N
          X(I) = 0.0
  220 CONTINUE
      DET = 0.0
      RETURN
      END


      SUBROUTINE SDLS1P(NDP,XD,YD,ZD,IPC,NCP, CFL1)
*
* Least squares fit of a linear surface (plane) to z(x,y) values
* (a supporting subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine performs the least squares fit of a linear
* surface (plane) to a data point set consisting of the data
* point in question and several data points closest to it used
* in the SDCF3P subroutine.
*
* The input arguments are
*   NDP  = number of data points,
*   XD   = array of dimension NDP containing the x coordinates
*          of the data points,
*   YD   = array of dimension NDP containing the y coordinates
*          of the data points,
*   ZD   = array of dimension NDP containing the z values at
*          the data points,
*   IPC  = two-dimensional integer array of dimension 9*NDP
*          containing, in the IDPth column, point numbers of
*          nine data points closest to the IDPth data point,
*          where IDP = 1, 2, ..., NDP,
*   NCP  = integer array of dimension NDP containing the
*          numbers of the closest points used in the SDCF3P
*          subroutine.
*
* The output argument is
*   CFL1 = two-dimensional array of dimension 2*NDP, where
*          the coefficients (a10, a01) of the least squares
*          fit, first-degree polynomial calculated at the
*          IDPth data point are to be stored in the IDPth
*          column, where IDP = 1, 2, ..., NDP.
*
* Before this subroutine is called, the SDCF3P subroutine must
* have been called.
*
*
* Specification statements
*     .. Scalar Arguments ..
      INTEGER          NDP
*     ..
*     .. Array Arguments ..
      REAL             CFL1(2,NDP),XD(NDP),YD(NDP),ZD(NDP)
      INTEGER          IPC(9,NDP),NCP(NDP)
*     ..
*     .. Local Scalars ..
      REAL             A11,A12,A22,AN,B1,B2,DLT,SX,SXX,SXY,SXZ,SY,SYY,
     +                 SYZ,SZ,X,X1,X2,Y,Y1,Y2,Z,Z1,Z2
      INTEGER          I,IDP,IDPI,NPLS
*     ..
* DO-loop with respect to the data point
      DO 30 IDP = 1,NDP
          NPLS = NCP(IDP) + 1
          IF (NPLS.EQ.2) GO TO 20
* Performs the least squares fit of a plane.
          SX = 0.0
          SY = 0.0
          SXX = 0.0
          SXY = 0.0
          SYY = 0.0
          SZ = 0.0
          SXZ = 0.0
          SYZ = 0.0
          DO 10 I = 1,NPLS
              IF (I.EQ.1) THEN
                  IDPI = IDP
              ELSE
                  IDPI = IPC(I-1,IDP)
              END IF
              X = XD(IDPI)
              Y = YD(IDPI)
              Z = ZD(IDPI)
              SX = SX + X
              SY = SY + Y
              SXX = SXX + X*X
              SXY = SXY + X*Y
              SYY = SYY + Y*Y
              SZ = SZ + Z
              SXZ = SXZ + X*Z
              SYZ = SYZ + Y*Z
   10     CONTINUE
          AN = NPLS
          A11 = AN*SXX - SX*SX
          A12 = AN*SXY - SX*SY
          A22 = AN*SYY - SY*SY
          B1 = AN*SXZ - SX*SZ
          B2 = AN*SYZ - SY*SZ
          DLT = A11*A22 - A12*A12
          CFL1(1,IDP) = (B1*A22-B2*A12)/DLT
          CFL1(2,IDP) = (B2*A11-B1*A12)/DLT
          GO TO 30
   20     IDPI = IDP
          X1 = XD(IDPI)
          Y1 = YD(IDPI)
          Z1 = ZD(IDPI)
          IDPI = IPC(1,IDP)
          X2 = XD(IDPI)
          Y2 = YD(IDPI)
          Z2 = ZD(IDPI)
          CFL1(1,IDP) = (X2-X1)* (Z2-Z1)/ ((X2-X1)**2+ (Y2-Y1)**2)
          CFL1(2,IDP) = (Y2-Y1)* (Z2-Z1)/ ((X2-X1)**2+ (Y2-Y1)**2)
   30 CONTINUE
      RETURN
      END


      SUBROUTINE SDLCTN(NDP,XD,YD,NT,IPT,NL,IPL,NIP,XI,YI, KTLI,ITLI)
*
* Locating points in a scattered data point set
* (a supporting subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine locates points in a scattered data point set in
* the x-y plane, i.e., determines to which triangle each of the
* points to be located belongs.  When a point to be located does
* not lie inside the data area, this subroutine determines the
* border line segment when the point lies in an outside rectangle,
* in an outside triangle, or in the overlap of two outside
* rectangles.
*
* The input arguments are
*   NDP  = number of data points,
*   XD   = array of dimension NDP containing the x
*          coordinates of the data points,
*   YD   = array of dimension NDP containing the y
*          coordinates of the data points,
*   NT   = number of triangles,
*   IPT  = two-dimensional integer array of dimension 3*NT
*          containing the point numbers of the vertexes of
*          the triangles,
*   NL   = number of border line segments,
*   IPL  = two-dimensional integer array of dimension 2*NL
*          containing the point numbers of the end points of
*          the border line segments,
*   NIP  = number of points to be located,
*   XI   = array of dimension NIP containing the x
*          coordinates of the points to be located,
*   YI   = array of dimension NIP containing the y
*          coordinates of the points to be located.
*
* The output arguments are
*   KTLI = integer array of dimension NIP, where the code
*          for the type of the piece of plane in which each
*          interpolated point lies is to be stored
*        = 1 for a triangle inside the data area
*        = 2 for a rectangle on the right-hand side of a
*            border line segment
*        = 3 for a triangle between two rectangles on the
*            right-hand side of two consecutive border line
*            segments
*        = 4 for a triangle which is an overlap of two
*            rectangles on the right-hand side of two
*            consecutive border line segments,
*   ITLI = integer array of dimension NIP, where the
*          triangle numbers or the (second) border line
*          segment numbers corresponding to the points to
*          be located are to be stored.
*
*
* Specification statements
*     .. Scalar Arguments ..
      INTEGER          NDP,NIP,NL,NT
*     ..
*     .. Array Arguments ..
      REAL             XD(NDP),XI(NIP),YD(NDP),YI(NIP)
      INTEGER          IPL(2,NL),IPT(3,NT),ITLI(NIP),KTLI(NIP)
*     ..
*     .. Local Scalars ..
      REAL             U1,U2,U3,V1,V2,V3,X0,X1,X2,X3,Y0,Y1,Y2,Y3
      INTEGER          IIP,IL1,IL2,ILII,IP1,IP2,IP3,ITII,ITLIPV,KTLIPV
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MOD
*     ..
*     .. Statement Functions ..
      REAL             SPDT,VPDT
*     ..
* Statement Function definitions 
      SPDT(U1,V1,U2,V2,U3,V3) = (U1-U3)* (U2-U3) + (V1-V3)* (V2-V3)
      VPDT(U1,V1,U2,V2,U3,V3) = (U1-U3)* (V2-V3) - (V1-V3)* (U2-U3)
*     ..
* Outermost DO-loop with respect to the points to be located
      DO 40 IIP = 1,NIP
          X0 = XI(IIP)
          Y0 = YI(IIP)
          IF (IIP.EQ.1) THEN
              KTLIPV = 0
              ITLIPV = 0
          ELSE
              KTLIPV = KTLI(IIP-1)
              ITLIPV = ITLI(IIP-1)
          END IF
* Checks if in the same inside triangle as previous.
          IF (KTLIPV.EQ.1) THEN
              ITII = ITLIPV
              IP1 = IPT(1,ITII)
              IP2 = IPT(2,ITII)
              IP3 = IPT(3,ITII)
              X1 = XD(IP1)
              Y1 = YD(IP1)
              X2 = XD(IP2)
              Y2 = YD(IP2)
              X3 = XD(IP3)
              Y3 = YD(IP3)
              IF ((VPDT(X1,Y1,X2,Y2,X0,Y0).GE.0.0) .AND.
     +            (VPDT(X2,Y2,X3,Y3,X0,Y0).GE.0.0) .AND.
     +            (VPDT(X3,Y3,X1,Y1,X0,Y0).GE.0.0)) THEN
                  KTLI(IIP) = 1
                  ITLI(IIP) = ITII
                  GO TO 40
              END IF
          END IF
* Locates inside the data area.
          DO 10 ITII = 1,NT
              IP1 = IPT(1,ITII)
              IP2 = IPT(2,ITII)
              IP3 = IPT(3,ITII)
              X1 = XD(IP1)
              Y1 = YD(IP1)
              X2 = XD(IP2)
              Y2 = YD(IP2)
              X3 = XD(IP3)
              Y3 = YD(IP3)
              IF ((VPDT(X1,Y1,X2,Y2,X0,Y0).GE.0.0) .AND.
     +            (VPDT(X2,Y2,X3,Y3,X0,Y0).GE.0.0) .AND.
     +            (VPDT(X3,Y3,X1,Y1,X0,Y0).GE.0.0)) THEN
                  KTLI(IIP) = 1
                  ITLI(IIP) = ITII
                  GO TO 40
              END IF
   10     CONTINUE
* Locates outside the data area.
          DO 20 ILII = 1,NL
              IL1 = ILII
              IL2 = MOD(IL1,NL) + 1
              IP1 = IPL(1,IL1)
              IP2 = IPL(1,IL2)
              IP3 = IPL(2,IL2)
              X1 = XD(IP1)
              Y1 = YD(IP1)
              X2 = XD(IP2)
              Y2 = YD(IP2)
              X3 = XD(IP3)
              Y3 = YD(IP3)
              IF (VPDT(X1,Y1,X3,Y3,X0,Y0).LE.0.0) THEN
                  IF (VPDT(X1,Y1,X3,Y3,X2,Y2).LE.0.0) THEN
                      IF ((SPDT(X1,Y1,X0,Y0,X2,Y2).LE.0.0) .AND.
     +                    (SPDT(X3,Y3,X0,Y0,X2,Y2).LE.0.0)) THEN
                          KTLI(IIP) = 3
                          ITLI(IIP) = IL2
                          GO TO 40
                      END IF
                  END IF
                  IF (VPDT(X1,Y1,X3,Y3,X2,Y2).GE.0.0) THEN
                      IF ((SPDT(X1,Y1,X0,Y0,X2,Y2).GE.0.0) .AND.
     +                    (SPDT(X3,Y3,X0,Y0,X2,Y2).GE.0.0)) THEN
                          KTLI(IIP) = 4
                          ITLI(IIP) = IL2
                          GO TO 40
                      END IF
                  END IF
              END IF
   20     CONTINUE
          DO 30 ILII = 1,NL
              IL2 = ILII
              IP2 = IPL(1,IL2)
              IP3 = IPL(2,IL2)
              X2 = XD(IP2)
              Y2 = YD(IP2)
              X3 = XD(IP3)
              Y3 = YD(IP3)
              IF (VPDT(X2,Y2,X3,Y3,X0,Y0).LE.0.0) THEN
                  IF ((SPDT(X3,Y3,X0,Y0,X2,Y2).GE.0.0) .AND.
     +                (SPDT(X2,Y2,X0,Y0,X3,Y3).GE.0.0)) THEN
                      KTLI(IIP) = 2
                      ITLI(IIP) = IL2
                      GO TO 40
                  END IF
              END IF
   30     CONTINUE
   40 CONTINUE
      END


      SUBROUTINE SDPLNL(NDP,XD,YD,ZD,NT,IPT,NL,IPL,PDD,NIP,XI,YI,KTLI,
     +                  ITLI, ZI)
*
* Polynomials
* (a supporting subroutine of the SDBI3P/SDSF3P subroutine package)
*
* Hiroshi Akima
* U.S. Department of Commerce, NTIA/ITS
* Version of 1995/05
*
* This subroutine determines a polynomial in x and y for each
* triangle or rectangle in the x-y plane and calculates the z
* value by evaluating the polynomial for the desired points,
* for bivariate interpolation and surface fitting for scattered
* data.
*
* The input arguments are
*   NDP  = number of data points,
*   XD   = array of dimension NDP containing the x
*          coordinates of the data points,
*   YD   = array of dimension NDP containing the y
*          coordinates of the data points,
*   ZD   = array of dimension NDP containing the z
*          values at the data points,
*   NT   = number of triangles,
*   IPT  = two-dimensional integer array of dimension 3*NT
*          containing the point numbers of the vertexes of
*          the triangles,
*   NL   = number of border line segments,
*   IPL  = two-dimensional integer array of dimension 2*NL
*          containing the point numbers of the end points of
*          the border line segments,
*   PDD  = two-dimensional array of dimension 5*NDP
*          containing the partial derivatives at the data
*          points,
*   NIP  = number of output points at which interpolation is
*          to be performed,
*   XI   = array of dimension NIP containing the x
*          coordinates of the output points,
*   YI   = array of dimension NIP containing the y
*          coordinates of the output points,
*   KTLI = integer array of dimension NIP, each element
*          containing the code for the type of the piece of
*          the plane in which each output point lies
*        = 1 for a triangle inside the data area
*        = 2 for a rectangle on the right-hand side of a
*            border line segment
*        = 3 for a triangle between two rectangles on the
*            right-hand side of two consecutive border
*            line segments
*        = 4 for the triangle which is an overlap of two
*            rectangles on the right-hand side of two
*            consecutive border line segments,
*   ITLI = integer array of dimension NIP containing the
*          triangle numbers or the (second) border line
*          segment numbers corresponding to the output
*          points.
*
* The output argument is
*   ZI   = array of dimension NIP, where the calculated z
*          values are to be stored.
*
*
* Specification statements
*     .. Scalar Arguments ..
      INTEGER          NDP,NIP,NL,NT
*     ..
*     .. Array Arguments ..
      REAL             PDD(5,NDP),XD(NDP),XI(NIP),YD(NDP),YI(NIP),
     +                 ZD(NDP),ZI(NIP)
      INTEGER          IPL(2,NL),IPT(3,NT),ITLI(NIP),KTLI(NIP)
*     ..
*     .. Local Scalars ..
      REAL             A,AA,AB,ACT2,AD,ADBC,AP,B,BB,BC,BDT2,BP,C,CC,CD,
     +                 CP,D,DD,DLT,DP,DX,DY,E1,E2,G1,G2,H1,H2,H3,LUSQ,
     +                 LVSQ,P0,P00,P01,P02,P03,P04,P05,P1,P10,P11,P12,
     +                 P13,P14,P2,P20,P21,P22,P23,P3,P30,P31,P32,P4,P40,
     +                 P41,P5,P50,SPUV,U,V,WT1,WT2,X0,XII,Y0,YII,Z0,ZII,
     +                 ZII1,ZII2
      INTEGER          I,IDP,IIP,ILI,IR,ITLII,ITLIPV,K,KTLII,KTLIPV
*     ..
*     .. Local Arrays ..
      REAL             PD(5,3),X(3),Y(3),Z(3),ZU(3),ZUU(3),ZUV(3),ZV(3),
     +                 ZVV(3)
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC        MOD
*     ..
* Outermost DO-loop with respect to the output point
      DO 120 IIP = 1,NIP
          XII = XI(IIP)
          YII = YI(IIP)
          KTLII = KTLI(IIP)
          ITLII = ITLI(IIP)
          IF (IIP.EQ.1) THEN
              KTLIPV = 0
              ITLIPV = 0
          ELSE
              KTLIPV = KTLI(IIP-1)
              ITLIPV = ITLI(IIP-1)
          END IF
* Part 1.  Calculation of ZII by interpolation
          IF (KTLII.EQ.1) THEN
* Calculates the coefficients when necessary.
              IF (KTLII.NE.KTLIPV .OR. ITLII.NE.ITLIPV) THEN
* Loads coordinate and partial derivative values at the
* vertexes.
                  DO 20 I = 1,3
                      IDP = IPT(I,ITLII)
                      X(I) = XD(IDP)
                      Y(I) = YD(IDP)
                      Z(I) = ZD(IDP)
                      DO 10 K = 1,5
                          PD(K,I) = PDD(K,IDP)
   10                 CONTINUE
   20             CONTINUE
* Determines the coefficients for the coordinate system
* transformation from the x-y system to the u-v system
* and vice versa.
                  X0 = X(1)
                  Y0 = Y(1)
                  A = X(2) - X0
                  B = X(3) - X0
                  C = Y(2) - Y0
                  D = Y(3) - Y0
                  AD = A*D
                  BC = B*C
                  DLT = AD - BC
                  AP = D/DLT
                  BP = -B/DLT
                  CP = -C/DLT
                  DP = A/DLT
* Converts the partial derivatives at the vertexes of the
* triangle for the u-v coordinate system.
                  AA = A*A
                  ACT2 = 2.0*A*C
                  CC = C*C
                  AB = A*B
                  ADBC = AD + BC
                  CD = C*D
                  BB = B*B
                  BDT2 = 2.0*B*D
                  DD = D*D
                  DO 30 I = 1,3
                      ZU(I) = A*PD(1,I) + C*PD(2,I)
                      ZV(I) = B*PD(1,I) + D*PD(2,I)
                      ZUU(I) = AA*PD(3,I) + ACT2*PD(4,I) + CC*PD(5,I)
                      ZUV(I) = AB*PD(3,I) + ADBC*PD(4,I) + CD*PD(5,I)
                      ZVV(I) = BB*PD(3,I) + BDT2*PD(4,I) + DD*PD(5,I)
   30             CONTINUE
* Calculates the coefficients of the polynomial.
                  P00 = Z(1)
                  P10 = ZU(1)
                  P01 = ZV(1)
                  P20 = 0.5*ZUU(1)
                  P11 = ZUV(1)
                  P02 = 0.5*ZVV(1)
                  H1 = Z(2) - P00 - P10 - P20
                  H2 = ZU(2) - P10 - ZUU(1)
                  H3 = ZUU(2) - ZUU(1)
                  P30 = 10.0*H1 - 4.0*H2 + 0.5*H3
                  P40 = -15.0*H1 + 7.0*H2 - H3
                  P50 = 6.0*H1 - 3.0*H2 + 0.5*H3
                  H1 = Z(3) - P00 - P01 - P02
                  H2 = ZV(3) - P01 - ZVV(1)
                  H3 = ZVV(3) - ZVV(1)
                  P03 = 10.0*H1 - 4.0*H2 + 0.5*H3
                  P04 = -15.0*H1 + 7.0*H2 - H3
                  P05 = 6.0*H1 - 3.0*H2 + 0.5*H3
                  LUSQ = AA + CC
                  LVSQ = BB + DD
                  SPUV = AB + CD
                  P41 = 5.0*SPUV/LUSQ*P50
                  P14 = 5.0*SPUV/LVSQ*P05
                  H1 = ZV(2) - P01 - P11 - P41
                  H2 = ZUV(2) - P11 - 4.0*P41
                  P21 = 3.0*H1 - H2
                  P31 = -2.0*H1 + H2
                  H1 = ZU(3) - P10 - P11 - P14
                  H2 = ZUV(3) - P11 - 4.0*P14
                  P12 = 3.0*H1 - H2
                  P13 = -2.0*H1 + H2
                  E1 = (LVSQ-SPUV)/ ((LVSQ-SPUV)+ (LUSQ-SPUV))
                  E2 = 1.0 - E1
                  G1 = 5.0*E1 - 2.0
                  G2 = 1.0 - G1
                  H1 = 5.0* (E1* (P50-P41)+E2* (P05-P14)) + (P41+P14)
                  H2 = 0.5*ZVV(2) - P02 - P12
                  H3 = 0.5*ZUU(3) - P20 - P21
                  P22 = H1 + G1*H2 + G2*H3
                  P32 = H2 - P22
                  P23 = H3 - P22
              END IF
* Converts XII and YII to u-v system.
              DX = XII - X0
              DY = YII - Y0
              U = AP*DX + BP*DY
              V = CP*DX + DP*DY
* Evaluates the polynomial.
              P0 = P00 + V* (P01+V* (P02+V* (P03+V* (P04+V*P05))))
              P1 = P10 + V* (P11+V* (P12+V* (P13+V*P14)))
              P2 = P20 + V* (P21+V* (P22+V*P23))
              P3 = P30 + V* (P31+V*P32)
              P4 = P40 + V*P41
              P5 = P50
              ZI(IIP) = P0 + U* (P1+U* (P2+U* (P3+U* (P4+U*P5))))
          END IF
* Part 2.  Calculation of ZII by extrapolation in the rectangle
          IF (KTLII.EQ.2) THEN
* Calculates the coefficients when necessary.
              IF (KTLII.NE.KTLIPV .OR. ITLII.NE.ITLIPV) THEN
* Loads coordinate and partial derivative values at the end
* points of the border line segment.
                  DO 50 I = 1,2
                      IDP = IPL(I,ITLII)
                      X(I) = XD(IDP)
                      Y(I) = YD(IDP)
                      Z(I) = ZD(IDP)
                      DO 40 K = 1,5
                          PD(K,I) = PDD(K,IDP)
   40                 CONTINUE
   50             CONTINUE
* Determines the coefficients for the coordinate system
* transformation from the x-y system to the u-v system
* and vice versa.
                  X0 = X(1)
                  Y0 = Y(1)
                  A = Y(2) - Y(1)
                  B = X(2) - X(1)
                  C = -B
                  D = A
                  AD = A*D
                  BC = B*C
                  DLT = AD - BC
                  AP = D/DLT
                  BP = -B/DLT
                  CP = -BP
                  DP = AP
* Converts the partial derivatives at the end points of the
* border line segment for the u-v coordinate system.
                  AA = A*A
                  ACT2 = 2.0*A*C
                  CC = C*C
                  AB = A*B
                  ADBC = AD + BC
                  CD = C*D
                  BB = B*B
                  BDT2 = 2.0*B*D
                  DD = D*D
                  DO 60 I = 1,2
                      ZU(I) = A*PD(1,I) + C*PD(2,I)
                      ZV(I) = B*PD(1,I) + D*PD(2,I)
                      ZUU(I) = AA*PD(3,I) + ACT2*PD(4,I) + CC*PD(5,I)
                      ZUV(I) = AB*PD(3,I) + ADBC*PD(4,I) + CD*PD(5,I)
                      ZVV(I) = BB*PD(3,I) + BDT2*PD(4,I) + DD*PD(5,I)
   60             CONTINUE
* Calculates the coefficients of the polynomial.
                  P00 = Z(1)
                  P10 = ZU(1)
                  P01 = ZV(1)
                  P20 = 0.5*ZUU(1)
                  P11 = ZUV(1)
                  P02 = 0.5*ZVV(1)
                  H1 = Z(2) - P00 - P01 - P02
                  H2 = ZV(2) - P01 - ZVV(1)
                  H3 = ZVV(2) - ZVV(1)
                  P03 = 10.0*H1 - 4.0*H2 + 0.5*H3
                  P04 = -15.0*H1 + 7.0*H2 - H3
                  P05 = 6.0*H1 - 3.0*H2 + 0.5*H3
                  H1 = ZU(2) - P10 - P11
                  H2 = ZUV(2) - P11
                  P12 = 3.0*H1 - H2
                  P13 = -2.0*H1 + H2
                  P21 = 0.5* (ZUU(2)-ZUU(1))
              END IF
* Converts XII and YII to u-v system.
              DX = XII - X0
              DY = YII - Y0
              U = AP*DX + BP*DY
              V = CP*DX + DP*DY
* Evaluates the polynomial.
              P0 = P00 + V* (P01+V* (P02+V* (P03+V* (P04+V*P05))))
              P1 = P10 + V* (P11+V* (P12+V*P13))
              P2 = P20 + V*P21
              ZI(IIP) = P0 + U* (P1+U*P2)
          END IF
* Part 3.  Calculation of ZII by extrapolation in the triangle
          IF (KTLII.EQ.3) THEN
* Calculates the coefficients when necessary.
              IF (KTLII.NE.KTLIPV .OR. ITLII.NE.ITLIPV) THEN
* Loads coordinate and partial derivative values at the vertex
* of the triangle.
                  IDP = IPL(1,ITLII)
                  X0 = XD(IDP)
                  Y0 = YD(IDP)
                  Z0 = ZD(IDP)
                  DO 70 K = 1,5
                      PD(K,1) = PDD(K,IDP)
   70             CONTINUE
* Calculates the coefficients of the polynomial.
                  P00 = Z0
                  P10 = PD(1,1)
                  P01 = PD(2,1)
                  P20 = 0.5*PD(3,1)
                  P11 = PD(4,1)
                  P02 = 0.5*PD(5,1)
              END IF
* Converts XII and YII to U-V system.
              U = XII - X0
              V = YII - Y0
* Evaluates the polynomial.
              P0 = P00 + V* (P01+V*P02)
              P1 = P10 + V*P11
              ZI(IIP) = P0 + U* (P1+U*P20)
          END IF
* Part 4.  Calculation of ZII by extrapolation in the triangle
*          which is an overlap of two rectangles.
          IF (KTLII.EQ.4) THEN
* Calculates the coefficients.
              DO 110 IR = 1,2
                  IF (IR.EQ.1) THEN
                      ILI = MOD(ITLII+NL-2,NL) + 1
                  ELSE
                      ILI = ITLII
                  END IF
* Loads coordinate and partial derivative values at the end
* points of the border line segment.
                  DO 90 I = 1,2
                      IDP = IPL(I,ILI)
                      X(I) = XD(IDP)
                      Y(I) = YD(IDP)
                      Z(I) = ZD(IDP)
                      DO 80 K = 1,5
                          PD(K,I) = PDD(K,IDP)
   80                 CONTINUE
   90             CONTINUE
* Determines the coefficients for the coordinate system
* transformation from the x-y system to the u-v system
* and vice versa.
                  X0 = X(1)
                  Y0 = Y(1)
                  A = Y(2) - Y(1)
                  B = X(2) - X(1)
                  C = -B
                  D = A
                  AD = A*D
                  BC = B*C
                  DLT = AD - BC
                  AP = D/DLT
                  BP = -B/DLT
                  CP = -BP
                  DP = AP
* Converts the partial derivatives at the end points of the
* border line segment for the u-v coordinate system.
                  AA = A*A
                  ACT2 = 2.0*A*C
                  CC = C*C
                  AB = A*B
                  ADBC = AD + BC
                  CD = C*D
                  BB = B*B
                  BDT2 = 2.0*B*D
                  DD = D*D
                  DO 100 I = 1,2
                      ZU(I) = A*PD(1,I) + C*PD(2,I)
                      ZV(I) = B*PD(1,I) + D*PD(2,I)
                      ZUU(I) = AA*PD(3,I) + ACT2*PD(4,I) + CC*PD(5,I)
                      ZUV(I) = AB*PD(3,I) + ADBC*PD(4,I) + CD*PD(5,I)
                      ZVV(I) = BB*PD(3,I) + BDT2*PD(4,I) + DD*PD(5,I)
  100             CONTINUE
* Calculates the coefficients of the polynomial.
                  P00 = Z(1)
                  P10 = ZU(1)
                  P01 = ZV(1)
                  P20 = 0.5*ZUU(1)
                  P11 = ZUV(1)
                  P02 = 0.5*ZVV(1)
                  H1 = Z(2) - P00 - P01 - P02
                  H2 = ZV(2) - P01 - ZVV(1)
                  H3 = ZVV(2) - ZVV(1)
                  P03 = 10.0*H1 - 4.0*H2 + 0.5*H3
                  P04 = -15.0*H1 + 7.0*H2 - H3
                  P05 = 6.0*H1 - 3.0*H2 + 0.5*H3
                  H1 = ZU(2) - P10 - P11
                  H2 = ZUV(2) - P11
                  P12 = 3.0*H1 - H2
                  P13 = -2.0*H1 + H2
                  P21 = 0.5* (ZUU(2)-ZUU(1))
* Converts XII and YII to u-v system.
                  DX = XII - X0
                  DY = YII - Y0
                  U = AP*DX + BP*DY
                  V = CP*DX + DP*DY
* Evaluates the polynomial.
                  P0 = P00 + V* (P01+V* (P02+V* (P03+V* (P04+V*P05))))
                  P1 = P10 + V* (P11+V* (P12+V*P13))
                  P2 = P20 + V*P21
                  ZII = P0 + U* (P1+U*P2)
                  IF (IR.EQ.1) THEN
                      ZII1 = ZII
                      WT2 = ((X(1)-X(2))* (XII-X(2))+
     +                      (Y(1)-Y(2))* (YII-Y(2)))**2
                  ELSE
                      ZII2 = ZII
                      WT1 = ((X(2)-X(1))* (XII-X(1))+
     +                      (Y(2)-Y(1))* (YII-Y(1)))**2
                  END IF
  110         CONTINUE
              ZI(IIP) = (WT1*ZII1+WT2*ZII2)/ (WT1+WT2)
          END IF
  120 CONTINUE
      END

SHAR_EOF
fi # end of overwriting check
cd ..
cd ..
#	End of shell archive
exit 0
