Logo Search packages:      
Sourcecode: fbasics version File versions  Download package

00A-funAkima.f

      SUBROUTINE SDBI3P(MD,NDP,XD,YD,ZD,NIP,XI,YI, ZI,IER, WK,IWK,
     +                  EXTRPI,NEAR,NEXT,DIST)
*
* 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.
*
* agebhard@uni-klu.ac.at: added from new TRIPACK:
*   NEAR, NEXT, DIST work arrays from TRMESH, size NDP
*
* 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,NEAR(NDP),NEXT(NDP)

*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION             WK(NDP,17),XD(NDP),XI(NIP),YD(NDP),
     +                 YI(NIP),ZD(NDP),ZI(NIP),DIST(NDP)
      INTEGER          IWK(NDP,25)
      LOGICAL          EXTRPI(NIP)
*     ..
*     .. 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),
     +                NEAR,NEXT,DIST)
*         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), EXTRPI(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,
     +                  EXTRPI,NEAR,NEXT,DIST)
*
* 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.
*
* agebhard@uni-klu.ac.at: added from new TRIPACK:
*   NEAR, NEXT, DIST work arrays from TRMESH, size NDP
*
* 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,NEAR(NDP),NEXT(NDP)
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION             WK(NDP,17),XD(NDP),XI(NXI),YD(NDP),
     +                 YI(NYI),ZD(NDP),ZI(NXI,NYI),DIST(NDP)
      INTEGER          IWK(NDP,25)
      LOGICAL          EXTRPI(NXI,NYI)
*     ..
*     .. Local Scalars ..
      INTEGER          IERT,IIP,IXI,IYI,NDPPV,NIPI,NL,NT
*     ..
*     .. Local Arrays ..
      DOUBLE PRECISION             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),
     +                NEAR,NEXT,DIST)
*         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),
     +                    EXTRPI(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,NEAR,NEXT,DIST)
*
* 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.
*
* agebhard@uni-klu.ac.at: added from new TRIPACK:
*   NEAR, NEXT, DIST work arrays from TRMESH, size NDP
*
*
* Specification statements
*     .. Scalar Arguments ..
      INTEGER          IERT,NDP,NL,NT,NEAR(NDP),NEXT(NDP)
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION             XD(NDP),YD(NDP),DIST(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,NEAR,NEXT,DIST)
      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,NEAR,NEXT,DIST)
*
* 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.
*
* agebhard@uni-klu.ac.at: added from new TRIPACK:
*   NEAR, NEXT, DIST work arrays from TRMESH, size NDP
*
* Specification statements
*     .. Parameters ..
      INTEGER          NCC,NROW
      PARAMETER        (NCC=0,NROW=6)
*     ..
*     .. Scalar Arguments ..
      INTEGER          IERTL,IERTM,NDP,NL,NT,NEAR(NDP),NEXT(NDP)
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION             XD(NDP),YD(NDP),DIST(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,NEAR,NEXT,DIST,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 ..
      DOUBLE PRECISION             HBRMN
      INTEGER          NRRTT
      PARAMETER        (HBRMN=0.10,NRRTT=5)
*     ..
*     .. Scalar Arguments ..
      INTEGER          NDP,NL,NT
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION             XD(NDP),YD(NDP)
      INTEGER          IPL(2,*),IPT(3,*),ITL(NDP)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION             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 ..
      DOUBLE PRECISION             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 ..
      DOUBLE PRECISION             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 ..
      DOUBLE PRECISION             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 ..
      DOUBLE PRECISION             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,DBLE
*     ..
* 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 = DBLE(NPE)
          ANPEM1 = DBLE(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 ..
      DOUBLE PRECISION             DSQ(NDP),XD(NDP),YD(NDP)
      INTEGER          IDSQ(NDP),IPC(9,NDP)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION             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 ..
      DOUBLE PRECISION             CNRMX
      PARAMETER        (CNRMX=1.5E+04)
      INTEGER          N1,N2,N3
      PARAMETER        (N1=3,N2=6,N3=10)
*     ..
*     .. Scalar Arguments ..
      INTEGER          NDP
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION             CF(9,NDP),XD(NDP),YD(NDP),ZD(NDP)
      INTEGER          IPC(9,NDP),NCP(NDP)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION             CN,DET,X,X1,X2,Y,Y1,Y2,Z1,Z2
      INTEGER          I,IDP,IDPI,J
*     ..
*     .. Local Arrays ..
      DOUBLE PRECISION             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        DBLE
*     ..
* 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*DBLE(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*DBLE(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*DBLE(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 ..
      DOUBLE PRECISION             CN,DET
      INTEGER          N
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION             AA(N,N),B(N),EE(N,N),X(N),ZZ(N,N)
      INTEGER          K(N)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION             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 ..
      DOUBLE PRECISION             CFL1(2,NDP),XD(NDP),YD(NDP),ZD(NDP)
      INTEGER          IPC(9,NDP),NCP(NDP)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION             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 ..
      DOUBLE PRECISION             XD(NDP),XI(NIP),YD(NDP),YI(NIP)
      INTEGER          IPL(2,NL),IPT(3,NT),ITLI(NIP),KTLI(NIP)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION             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 ..
      DOUBLE PRECISION             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, EXTRPI)
*
* 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.
*   EXTRPI = logical array of dimension NIP, indicating 
*            if a point resides outside the convex hull (and its Z value
*            has been extrapolated)
*
* Specification statements
*     .. Scalar Arguments ..
      INTEGER          NDP,NIP,NL,NT
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION             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)
      LOGICAL          EXTRPI(NIP)
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION             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 ..
      DOUBLE PRECISION             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))))
              EXTRPI(IIP) = .FALSE.
          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)
              EXTRPI(IIP) = .TRUE.
          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)
              EXTRPI(IIP) = .TRUE.
          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)
              EXTRPI(IIP) = .TRUE.
          END IF
  120 CONTINUE
      END


      SUBROUTINE  IDBVIP(MD,NCP,NDP,XD,YD,ZD,NIP,XI,YI,ZI,              ID001340
     1                   IWK,WK,MISSI)
C THIS SUBROUTINE PERFORMS BIVARIATE INTERPOLATION WHEN THE PRO-
C JECTIONS OF THE DATA POINTS IN THE X-Y PLANE ARE IRREGULARLY
C DISTRIBUTED IN THE PLANE.
C THE INPUT PARAMETERS ARE
C     MD  = MODE OF COMPUTATION (MUST BE 1, 2, OR 3),
C         = 1 FOR NEW NCP AND/OR NEW XD-YD,
C         = 2 FOR OLD NCP, OLD XD-YD, NEW XI-YI,
C         = 3 FOR OLD NCP, OLD XD-YD, OLD XI-YI,
C     NCP = NUMBER OF ADDITIONAL DATA POINTS USED FOR ESTI-
C           MATING PARTIAL DERIVATIVES AT EACH DATA POINT
C           (MUST BE 2 OR GREATER, BUT SMALLER THAN NDP),
C     NDP = NUMBER OF DATA POINTS (MUST BE 4 OR GREATER),
C     XD  = ARRAY OF DIMENSION NDP CONTAINING THE X
C           COORDINATES OF THE DATA POINTS,
C     YD  = ARRAY OF DIMENSION NDP CONTAINING THE Y
C           COORDINATES OF THE DATA POINTS,
C     ZD  = ARRAY OF DIMENSION NDP CONTAINING THE Z
C           COORDINATES OF THE DATA POINTS,
C     NIP = NUMBER OF OUTPUT POINTS AT WHICH INTERPOLATION
C           IS TO BE PERFORMED (MUST BE 1 OR GREATER),
C     XI  = ARRAY OF DIMENSION NIP CONTAINING THE X
C           COORDINATES OF THE OUTPUT POINTS,
C     YI  = ARRAY OF DIMENSION NIP CONTAINING THE Y
C           COORDINATES OF THE OUTPUT POINTS.
C THE OUTPUT PARAMETER IS
C     ZI  = ARRAY OF DIMENSION NIP WHERE INTERPOLATED Z
C           VALUES ARE TO BE STORED.
C     MISSI = LOCICAL ARRAY, INDICATING IF EXTRAPOLATION OR MISSING VALUES
C            OUTSIDE CONVEX HULL WANTED
C THE OTHER PARAMETERS ARE
C     IWK = INTEGER ARRAY OF DIMENSION
C              MAX0(31,27+NCP)*NDP+NIP
C           USED INTERNALLY AS A WORK AREA,
C     WK  = ARRAY OF DIMENSION 8*NDP USED INTERNALLY AS A
C           WORK AREA.
C THE VERY FIRST CALL TO THIS SUBROUTINE AND THE CALL WITH A NEW
C NCP VALUE, A NEW NDP VALUE, AND/OR NEW CONTENTS OF THE XD AND
C YD ARRAYS MUST BE MADE WITH MD=1.  THE CALL WITH MD=2 MUST BE
C PRECEDED BY ANOTHER CALL WITH THE SAME NCP AND NDP VALUES AND
C WITH THE SAME CONTENTS OF THE XD AND YD ARRAYS.  THE CALL WITH
C MD=3 MUST BE PRECEDED BY ANOTHER CALL WITH THE SAME NCP, NDP,
C AND NIP VALUES AND WITH THE SAME CONTENTS OF THE XD, YD, XI,
C AND YI ARRAYS.  BETWEEN THE CALL WITH MD=2 OR MD=3 AND ITS
C PRECEDING CALL, THE IWK AND WK ARRAYS MUST NOT BE DISTURBED.
C USE OF A VALUE BETWEEN 3 AND 5 (INCLUSIVE) FOR NCP IS RECOM-
C MENDED UNLESS THERE ARE EVIDENCES THAT DICTATE OTHERWISE.
C THE LUN CONSTANT IN THE DATA INITIALIZATION STATEMENT IS THE
C LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS,
C THEREFORE, SYSTEM DEPENDENT.
C THIS SUBROUTINE CALLS THE IDCLDP, IDLCTN, IDPDRV, IDPTIP, AND
C IDTANG SUBROUTINES.
C DECLARATION STATEMENTS
      IMPLICIT DOUBLE PRECISION (A-D,P-Z)
      LOGICAL MISSI, LINEAR
      DIMENSION   XD(NDP),YD(NDP),ZD(NDP),XI(NIP),YI(NIP),
     1            ZI(NIP),MISSI(NIP),IWK((31+NCP)*NDP+NIP),WK(8*NDP)
      COMMON/IDLC/NIT, idummy
      COMMON/IDPI/ITPV
      DATA  LUN/6/
C SETTING OF SOME INPUT PARAMETERS TO LOCAL VARIABLES.
C (FOR MD=1,2,3)
   10 MD0=MD
      NCP0=NCP
      NDP0=NDP
      NIP0=NIP
C ERROR CHECK.  (FOR MD=1,2,3)
   20 IF(MD0.LT.1.OR.MD0.GT.3)           GO TO 90
      IF(NCP0.EQ.0) THEN
         LINEAR=.TRUE.
         DO 21 I=1,NIP
            MISSI(I)=.TRUE.
   21    CONTINUE
      END IF
      IF(NCP0.EQ.1.OR.NCP0.GE.NDP0)      GO TO 90
      IF(NDP0.LT.4)                      GO TO 90
      IF(NIP0.LT.1)                      GO TO 90
      IF(MD0.GE.2)        GO TO 22
      IWK(1)=NCP0
      IWK(2)=NDP0
      GO TO 23
   22 NCPPV=IWK(1)
      NDPPV=IWK(2)
      IF(NCP0.NE.NCPPV)   GO TO 90
      IF(NDP0.NE.NDPPV)   GO TO 90
   23 IF(MD0.GE.3)        GO TO 24
      IWK(3)=NIP
      GO TO 30
   24 NIPPV=IWK(3)
      IF(NIP0.NE.NIPPV)   GO TO 90
C ALLOCATION OF STORAGE AREAS IN THE IWK ARRAY.  (FOR MD=1,2,3)
   30 JWIPT=16
      JWIWL=6*NDP0+1
      JWIWK=JWIWL
      JWIPL=24*NDP0+1
      JWIWP=30*NDP0+1
      JWIPC=27*NDP0+1
      JWIT0=MAX0(31,27+NCP0)*NDP0
C TRIANGULATES THE X-Y PLANE.  (FOR MD=1)
   40 IF(MD0.GT.1)   GO TO 50
      CALL IDTANG(NDP0,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),
     1            IWK(JWIWL),IWK(JWIWP),WK)
      IWK(5)=NT
      IWK(6)=NL
      IF(NT.EQ.0)    RETURN
C DETERMINES NCP POINTS CLOSEST TO EACH DATA POINT.  (FOR MD=1)
   50 IF(MD0.GT.1 .OR. LINEAR)   GO TO 60
      CALL IDCLDP(NDP0,XD,YD,NCP0,IWK(JWIPC))
      IF(IWK(JWIPC).EQ.0)      RETURN
C LOCATES ALL POINTS AT WHICH INTERPOLATION IS TO BE PERFORMED.
C (FOR MD=1,2)
   60 IF(MD0.EQ.3)   GO TO 70
      NIT=0
      JWIT=JWIT0
      DO 61  IIP=1,NIP0
         JWIT=JWIT+1
        CALL IDLCTN(NDP0,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),
     1            XI(IIP),YI(IIP),IWK(JWIT),IWK(JWIWK),WK)
   61 CONTINUE
C ESTIMATES PARTIAL DERIVATIVES AT ALL DATA POINTS.
C (FOR MD=1,2,3)
   70 IF (.NOT.LINEAR) CALL IDPDRV(NDP0,XD,YD,ZD,NCP0,IWK(JWIPC),WK)
C INTERPOLATES THE ZI VALUES.  (FOR MD=1,2,3)
   80 ITPV=0
      JWIT=JWIT0
      DO 81  IIP=1,NIP0
        JWIT=JWIT+1
        IF (LINEAR) THEN
           CALL IDPTLI(XD,YD,ZD,NDP,NT,IWK(JWIPT),NL,IWK(JWIPL),
     1                 IWK(JWIT),XI(IIP),YI(IIP),ZI(IIP),MISSI(IIP))
        ELSE
           CALL IDPTIP(XD,YD,ZD,NDP,NT,IWK(JWIPT),NL,IWK(JWIPL),WK,
     1                 IWK(JWIT),XI(IIP),YI(IIP),ZI(IIP),MISSI(IIP))
        END IF
   81 CONTINUE
      RETURN
C ERROR EXIT
   90 WRITE (LUN,2090) MD0,NCP0,NDP0,NIP0
      RETURN
C FORMAT STATEMENT FOR ERROR MESSAGE
 2090 FORMAT(1X/41H ***   IMPROPER INPUT PARAMETER VALUE(S)./
     1   7H   MD =,I4,10X,5HNCP =,I6,10X,5HNDP =,I6,
     2   10X,5HNIP =,I6/
     3   35H ERROR DETECTED IN ROUTINE   IDBVIP/)
      END

      SUBROUTINE  IDCLDP(NDP,XD,YD,NCP,IPC)                         
C THIS SUBROUTINE SELECTS SEVERAL DATA POINTS THAT ARE CLOSEST
C TO EACH OF THE DATA POINT.
C THE INPUT PARAMETERS ARE
C     NDP = NUMBER OF DATA POINTS,
C     XD,YD = ARRAYS OF DIMENSION NDP CONTAINING THE X AND Y
C           COORDINATES OF THE DATA POINTS,
C     NCP = NUMBER OF DATA POINTS CLOSEST TO EACH DATA
C           POINTS.
C THE OUTPUT PARAMETER IS
C     IPC = INTEGER ARRAY OF DIMENSION NCP*NDP, WHERE THE
C           POINT NUMBERS OF NCP DATA POINTS CLOSEST TO
C           EACH OF THE NDP DATA POINTS ARE TO BE STORED.
C THIS SUBROUTINE ARBITRARILY SETS A RESTRICTION THAT NCP MUST
C NOT EXCEED 25.
C THE LUN CONSTANT IN THE DATA INITIALIZATION STATEMENT IS THE
C LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS,
C THEREFORE, SYSTEM DEPENDENT.
C DECLARATION STATEMENTS
      IMPLICIT DOUBLE PRECISION (A-D,P-Z)
      DIMENSION   XD(NDP),YD(NDP),IPC(NCP*NDP)
      DIMENSION   DSQ0(25),IPC0(25)
      DATA  NCPMX/25/, LUN/6/
C STATEMENT FUNCTION
      DSQF(U1,V1,U2,V2)=(U2-U1)**2+(V2-V1)**2
C PRELIMINARY PROCESSING
   10 NDP0=NDP
      NCP0=NCP
      IF(NDP0.LT.2)  GO TO 90
      IF(NCP0.LT.1.OR.NCP0.GT.NCPMX.OR.NCP0.GE.NDP0)    GO TO 90
C CALCULATION
   20 DO 59  IP1=1,NDP0
C - SELECTS NCP POINTS.
        X1=XD(IP1)
        Y1=YD(IP1)
        J1=0
        DSQMX=0.0
        DO 22  IP2=1,NDP0
          IF(IP2.EQ.IP1)  GO TO 22
          DSQI=DSQF(X1,Y1,XD(IP2),YD(IP2))
          J1=J1+1
          DSQ0(J1)=DSQI
          IPC0(J1)=IP2
          IF(DSQI.LE.DSQMX)    GO TO 21
          DSQMX=DSQI
          JMX=J1
   21     IF(J1.GE.NCP0)  GO TO 23
   22   CONTINUE
   23   IP2MN=IP2+1
        IF(IP2MN.GT.NDP0)      GO TO 30
        DO 25  IP2=IP2MN,NDP0
          IF(IP2.EQ.IP1)  GO TO 25
          DSQI=DSQF(X1,Y1,XD(IP2),YD(IP2))
          IF(DSQI.GE.DSQMX)    GO TO 25
          DSQ0(JMX)=DSQI
          IPC0(JMX)=IP2
          DSQMX=0.0
          DO 24  J1=1,NCP0
            IF(DSQ0(J1).LE.DSQMX)   GO TO 24
            DSQMX=DSQ0(J1)
            JMX=J1
   24     CONTINUE
   25   CONTINUE
C - CHECKS IF ALL THE NCP+1 POINTS ARE COLLINEAR.
   30   IP2=IPC0(1)
        DX12=XD(IP2)-X1
        DY12=YD(IP2)-Y1
        DO 31  J3=2,NCP0
          IP3=IPC0(J3)
          DX13=XD(IP3)-X1
          DY13=YD(IP3)-Y1
          IF((DY13*DX12-DX13*DY12).NE.0.0)    GO TO 50
   31   CONTINUE
C - SEARCHES FOR THE CLOSEST NONCOLLINEAR POINT.
   40   NCLPT=0
        DO 43  IP3=1,NDP0
          IF(IP3.EQ.IP1)       GO TO 43
          DO 41  J4=1,NCP0
            IF(IP3.EQ.IPC0(J4))     GO TO 43
   41     CONTINUE
          DX13=XD(IP3)-X1
          DY13=YD(IP3)-Y1
          IF((DY13*DX12-DX13*DY12).EQ.0.0)    GO TO 43
          DSQI=DSQF(X1,Y1,XD(IP3),YD(IP3))
          IF(NCLPT.EQ.0)       GO TO 42
          IF(DSQI.GE.DSQMN)    GO TO 43
   42     NCLPT=1
          DSQMN=DSQI
          IP3MN=IP3
   43   CONTINUE
        IF(NCLPT.EQ.0)    GO TO 91
        DSQMX=DSQMN
        IPC0(JMX)=IP3MN
C - REPLACES THE LOCAL ARRAY FOR THE OUTPUT ARRAY.
   50   J1=(IP1-1)*NCP0
        DO 51  J2=1,NCP0
          J1=J1+1
          IPC(J1)=IPC0(J2)
   51   CONTINUE
   59 CONTINUE
      RETURN
C ERROR EXIT
   90 WRITE (LUN,2090)
      GO TO 92
   91 WRITE (LUN,2091)
   92 WRITE (LUN,2092)  NDP0,NCP0
      IPC(1)=0
      RETURN
C FORMAT STATEMENTS FOR ERROR MESSAGES
 2090 FORMAT(1X/41H ***   IMPROPER INPUT PARAMETER VALUE(S).)
 2091 FORMAT(1X/33H ***   ALL COLLINEAR DATA POINTS.)
 2092 FORMAT(8H   NDP =,I5,5X,5HNCP =,I5/
     1   35H ERROR DETECTED IN ROUTINE   IDCLDP/)
      END

      SUBROUTINE IDGRID(XD, YD, NDP, NT, IPT, NL, IPL, NXI, NYI, XI, YI,  IDG   10
     *  NGP, IGP)
C THIS SUBROUTINE ORGANIZES GRID POINTS FOR SURFACE FITTING BY
C SORTING THEM IN ASCENDING ORDER OF TRIANGLE NUMBERS AND OF THE
C BORDER LINE SEGMENT NUMBER.
C THE INPUT PARAMETERS ARE
C     XD,YD = ARRAYS OF DIMENSION NDP CONTAINING THE X AND Y
C           COORDINATES OF THE DATA POINTS, WHERE NDP IS THE
C           NUMBER OF THE DATA POINTS,
C     NT  = NUMBER OF TRIANGLES,
C     IPT = INTEGER ARRAY OF DIMENSION 3*NT CONTAINING THE
C           POINT NUMBERS OF THE VERTEXES OF THE TRIANGLES,
C     NL  = NUMBER OF BORDER LINE SEGMENTS,
C     IPL = INTEGER ARRAY OF DIMENSION 3*NL CONTAINING THE
C           POINT NUMBERS OF THE END POINTS OF THE BORDER
C           LINE SEGMENTS AND THEIR RESPECTIVE TRIANGLE
C           NUMBERS,
C     NXI = NUMBER OF GRID POINTS IN THE X COORDINATE,
C     NYI = NUMBER OF GRID POINTS IN THE Y COORDINATE,
C     XI,YI = ARRAYS OF DIMENSION NXI AND NYI CONTAINING
C           THE X AND Y COORDINATES OF THE GRID POINTS,
C           RESPECTIVELY.
C THE OUTPUT PARAMETERS ARE
C     NGP = INTEGER ARRAY OF DIMENSION 2*(NT+2*NL) WHERE THE
C           NUMBER OF GRID POINTS THAT BELONG TO EACH OF THE
C           TRIANGLES OR OF THE BORDER LINE SEGMENTS ARE TO
C           BE STORED,
C     IGP = INTEGER ARRAY OF DIMENSION NXI*NYI WHERE THE
C           GRID POINT NUMBERS ARE TO BE STORED IN ASCENDING
C           ORDER OF THE TRIANGLE NUMBER AND THE BORDER LINE
C           SEGMENT NUMBER.
C DECLARATION STATEMENTS
      IMPLICIT DOUBLE PRECISION (A-D,P-Z)
      DIMENSION XD(NDP), YD(NDP), IPT(3*NT), IPL(3*NL), XI(NXI),
     *  YI(NYI), NGP(2*(NT+2*NL)), IGP(NXI*NYI)
C STATEMENT FUNCTIONS
      SIDE(U1,V1,U2,V2,U3,V3) = (U1-U3)*(V2-V3) - (V1-V3)*(U2-U3)
      SPDT(U1,V1,U2,V2,U3,V3) = (U1-U2)*(U3-U2) + (V1-V2)*(V3-V2)
C PRELIMINARY PROCESSING
      NT0 = NT
      NL0 = NL
      NXI0 = NXI
      NYI0 = NYI
      NXINYI = NXI0*NYI0
      XIMN = DMIN1(XI(1),XI(NXI0))
      XIMX = DMAX1(XI(1),XI(NXI0))
      YIMN = DMIN1(YI(1),YI(NYI0))
      YIMX = DMAX1(YI(1),YI(NYI0))
C DETERMINES GRID POINTS INSIDE THE DATA AREA.
      JNGP0 = 0
      JNGP1 = 2*(NT0+2*NL0) + 1
      JIGP0 = 0
      JIGP1 = NXINYI + 1
      DO 160 IT0=1,NT0
        NGP0 = 0
        NGP1 = 0
        IT0T3 = IT0*3
        IP1 = IPT(IT0T3-2)
        IP2 = IPT(IT0T3-1)
        IP3 = IPT(IT0T3)
        X1 = XD(IP1)
        Y1 = YD(IP1)
        X2 = XD(IP2)
        Y2 = YD(IP2)
        X3 = XD(IP3)
        Y3 = YD(IP3)
        XMN = DMIN1(X1,X2,X3)
        XMX = DMAX1(X1,X2,X3)
        YMN = DMIN1(Y1,Y2,Y3)
        YMX = DMAX1(Y1,Y2,Y3)
        INSD = 0
        DO 20 IXI=1,NXI0
          IF (XI(IXI).GE.XMN .AND. XI(IXI).LE.XMX) GO TO 10
          IF (INSD.EQ.0) GO TO 20
          IXIMX = IXI - 1
          GO TO 30
   10     IF (INSD.EQ.1) GO TO 20
          INSD = 1
          IXIMN = IXI
   20   CONTINUE
        IF (INSD.EQ.0) GO TO 150
        IXIMX = NXI0
   30   DO 140 IYI=1,NYI0
          YII = YI(IYI)
          IF (YII.LT.YMN .OR. YII.GT.YMX) GO TO 140
          DO 130 IXI=IXIMN,IXIMX
            XII = XI(IXI)
            L = 0
            IF (SIDE(X1,Y1,X2,Y2,XII,YII)) 130, 40, 50
   40       L = 1
   50       IF (SIDE(X2,Y2,X3,Y3,XII,YII)) 130, 60, 70
   60       L = 1
   70       IF (SIDE(X3,Y3,X1,Y1,XII,YII)) 130, 80, 90
   80       L = 1
   90       IZI = NXI0*(IYI-1) + IXI
            IF (L.EQ.1) GO TO 100
            NGP0 = NGP0 + 1
            JIGP0 = JIGP0 + 1
            IGP(JIGP0) = IZI
            GO TO 130
  100       IF (JIGP1.GT.NXINYI) GO TO 120
            DO 110 JIGP1I=JIGP1,NXINYI
              IF (IZI.EQ.IGP(JIGP1I)) GO TO 130
  110       CONTINUE
  120       NGP1 = NGP1 + 1
            JIGP1 = JIGP1 - 1
            IGP(JIGP1) = IZI
  130     CONTINUE
  140   CONTINUE
  150   JNGP0 = JNGP0 + 1
        NGP(JNGP0) = NGP0
        JNGP1 = JNGP1 - 1
        NGP(JNGP1) = NGP1
  160 CONTINUE
C DETERMINES GRID POINTS OUTSIDE THE DATA AREA.
C - IN SEMI-INFINITE RECTANGULAR AREA.
      DO 450 IL0=1,NL0
        NGP0 = 0
        NGP1 = 0
        IL0T3 = IL0*3
        IP1 = IPL(IL0T3-2)
        IP2 = IPL(IL0T3-1)
        X1 = XD(IP1)
        Y1 = YD(IP1)
        X2 = XD(IP2)
        Y2 = YD(IP2)
        XMN = XIMN
        XMX = XIMX
        YMN = YIMN
        YMX = YIMX
        IF (Y2.GE.Y1) XMN = DMIN1(X1,X2)
        IF (Y2.LE.Y1) XMX = DMAX1(X1,X2)
        IF (X2.LE.X1) YMN = DMIN1(Y1,Y2)
        IF (X2.GE.X1) YMX = DMAX1(Y1,Y2)
        INSD = 0
        DO 180 IXI=1,NXI0
          IF (XI(IXI).GE.XMN .AND. XI(IXI).LE.XMX) GO TO 170
          IF (INSD.EQ.0) GO TO 180
          IXIMX = IXI - 1
          GO TO 190
  170     IF (INSD.EQ.1) GO TO 180
          INSD = 1
          IXIMN = IXI
  180   CONTINUE
        IF (INSD.EQ.0) GO TO 310
        IXIMX = NXI0
  190   DO 300 IYI=1,NYI0
          YII = YI(IYI)
          IF (YII.LT.YMN .OR. YII.GT.YMX) GO TO 300
          DO 290 IXI=IXIMN,IXIMX
            XII = XI(IXI)
            L = 0
            IF (SIDE(X1,Y1,X2,Y2,XII,YII)) 210, 200, 290
  200       L = 1
  210       IF (SPDT(X2,Y2,X1,Y1,XII,YII)) 290, 220, 230
  220       L = 1
  230       IF (SPDT(X1,Y1,X2,Y2,XII,YII)) 290, 240, 250
  240       L = 1
  250       IZI = NXI0*(IYI-1) + IXI
            IF (L.EQ.1) GO TO 260
            NGP0 = NGP0 + 1
            JIGP0 = JIGP0 + 1
            IGP(JIGP0) = IZI
            GO TO 290
  260       IF (JIGP1.GT.NXINYI) GO TO 280
            DO 270 JIGP1I=JIGP1,NXINYI
              IF (IZI.EQ.IGP(JIGP1I)) GO TO 290
  270       CONTINUE
  280       NGP1 = NGP1 + 1
            JIGP1 = JIGP1 - 1
            IGP(JIGP1) = IZI
  290     CONTINUE
  300   CONTINUE
  310   JNGP0 = JNGP0 + 1
        NGP(JNGP0) = NGP0
        JNGP1 = JNGP1 - 1
        NGP(JNGP1) = NGP1
C - IN SEMI-INFINITE TRIANGULAR AREA.
        NGP0 = 0
        NGP1 = 0
        ILP1 = MOD(IL0,NL0) + 1
        ILP1T3 = ILP1*3
        IP3 = IPL(ILP1T3-1)
        X3 = XD(IP3)
        Y3 = YD(IP3)
        XMN = XIMN
        XMX = XIMX
        YMN = YIMN
        YMX = YIMX
        IF (Y3.GE.Y2 .AND. Y2.GE.Y1) XMN = X2
        IF (Y3.LE.Y2 .AND. Y2.LE.Y1) XMX = X2
        IF (X3.LE.X2 .AND. X2.LE.X1) YMN = Y2
        IF (X3.GE.X2 .AND. X2.GE.X1) YMX = Y2
        INSD = 0
        DO 330 IXI=1,NXI0
          IF (XI(IXI).GE.XMN .AND. XI(IXI).LE.XMX) GO TO 320
          IF (INSD.EQ.0) GO TO 330
          IXIMX = IXI - 1
          GO TO 340
  320     IF (INSD.EQ.1) GO TO 330
          INSD = 1
          IXIMN = IXI
  330   CONTINUE
        IF (INSD.EQ.0) GO TO 440
        IXIMX = NXI0
  340   DO 430 IYI=1,NYI0
          YII = YI(IYI)
          IF (YII.LT.YMN .OR. YII.GT.YMX) GO TO 430
          DO 420 IXI=IXIMN,IXIMX
            XII = XI(IXI)
            L = 0
            IF (SPDT(X1,Y1,X2,Y2,XII,YII)) 360, 350, 420
  350       L = 1
  360       IF (SPDT(X3,Y3,X2,Y2,XII,YII)) 380, 370, 420
  370       L = 1
  380       IZI = NXI0*(IYI-1) + IXI
            IF (L.EQ.1) GO TO 390
            NGP0 = NGP0 + 1
            JIGP0 = JIGP0 + 1
            IGP(JIGP0) = IZI
            GO TO 420
  390       IF (JIGP1.GT.NXINYI) GO TO 410
            DO 400 JIGP1I=JIGP1,NXINYI
              IF (IZI.EQ.IGP(JIGP1I)) GO TO 420
  400       CONTINUE
  410       NGP1 = NGP1 + 1
            JIGP1 = JIGP1 - 1
            IGP(JIGP1) = IZI
  420     CONTINUE
  430   CONTINUE
  440   JNGP0 = JNGP0 + 1
        NGP(JNGP0) = NGP0
        JNGP1 = JNGP1 - 1
        NGP(JNGP1) = NGP1
  450 CONTINUE
      RETURN
      END

      SUBROUTINE IDLCTN(NDP, XD, YD, NT, IPT, NL, IPL, XII, YII, ITI,   IDL   10
     *  IWK, WK)
C THIS SUBROUTINE LOCATES A POINT, I.E., DETERMINES TO WHAT TRI-
C ANGLE A GIVEN POINT (XII,YII) BELONGS.  WHEN THE GIVEN POINT
C DOES NOT LIE INSIDE THE DATA AREA, THIS SUBROUTINE DETERMINES
C THE BORDER LINE SEGMENT WHEN THE POINT LIES IN AN OUTSIDE
C RECTANGULAR AREA, AND TWO BORDER LINE SEGMENTS WHEN THE POINT
C LIES IN AN OUTSIDE TRIANGULAR AREA.
C THE INPUT PARAMETERS ARE
C     NDP = NUMBER OF DATA POINTS,
C     XD,YD = ARRAYS OF DIMENSION NDP CONTAINING THE X AND Y
C           COORDINATES OF THE DATA POINTS,
C     NT  = NUMBER OF TRIANGLES,
C     IPT = INTEGER ARRAY OF DIMENSION 3*NT CONTAINING THE
C           POINT NUMBERS OF THE VERTEXES OF THE TRIANGLES,
C     NL  = NUMBER OF BORDER LINE SEGMENTS,
C     IPL = INTEGER ARRAY OF DIMENSION 3*NL CONTAINING THE
C           POINT NUMBERS OF THE END POINTS OF THE BORDER
C           LINE SEGMENTS AND THEIR RESPECTIVE TRIANGLE
C           NUMBERS,
C     XII,YII = X AND Y COORDINATES OF THE POINT TO BE
C           LOCATED.
C THE OUTPUT PARAMETER IS
C     ITI = TRIANGLE NUMBER, WHEN THE POINT IS INSIDE THE
C           DATA AREA, OR
C           TWO BORDER LINE SEGMENT NUMBERS, IL1 AND IL2,
C           CODED TO IL1*(NT+NL)+IL2, WHEN THE POINT IS
C           OUTSIDE THE DATA AREA.
C THE OTHER PARAMETERS ARE
C     IWK = INTEGER ARRAY OF DIMENSION 18*NDP USED INTER-
C           NALLY AS A WORK AREA,
C     WK  = ARRAY OF DIMENSION 8*NDP USED INTERNALLY AS A
C           WORK AREA.
C DECLARATION STATEMENTS
      IMPLICIT DOUBLE PRECISION (A-D,P-Z)
      DIMENSION XD(NDP), YD(NDP), IPT(3*NT), IPL(3*NL), IWK(18*NDP),
     *  WK(8*NDP)
      DIMENSION NTSC(9), IDSC(9)
      COMMON /IDLC/ NIT, ITIPV
C STATEMENT FUNCTIONS
      SIDE(U1,V1,U2,V2,U3,V3) = (U1-U3)*(V2-V3) - (V1-V3)*(U2-U3)
      SPDT(U1,V1,U2,V2,U3,V3) = (U1-U2)*(U3-U2) + (V1-V2)*(V3-V2)
C PRELIMINARY PROCESSING
      NDP0 = NDP
      NT0 = NT
      NL0 = NL
      NTL = NT0 + NL0
      X0 = XII
      Y0 = YII
C PROCESSING FOR A NEW SET OF DATA POINTS
      IF (NIT.NE.0) GO TO 80
      NIT = 1
C - DIVIDES THE X-Y PLANE INTO NINE RECTANGULAR SECTIONS.
      XMN = XD(1)
      XMX = XMN
      YMN = YD(1)
      YMX = YMN
      DO 10 IDP=2,NDP0
        XI = XD(IDP)
        YI = YD(IDP)
        XMN = DMIN1(XI,XMN)
        XMX = DMAX1(XI,XMX)
        YMN = DMIN1(YI,YMN)
        YMX = DMAX1(YI,YMX)
   10 CONTINUE
      XS1 = (XMN+XMN+XMX)/3.0
      XS2 = (XMN+XMX+XMX)/3.0
      YS1 = (YMN+YMN+YMX)/3.0
      YS2 = (YMN+YMX+YMX)/3.0
C - DETERMINES AND STORES IN THE IWK ARRAY TRIANGLE NUMBERS OF
C - THE TRIANGLES ASSOCIATED WITH EACH OF THE NINE SECTIONS.
      DO 20 ISC=1,9
        NTSC(ISC) = 0
        IDSC(ISC) = 0
   20 CONTINUE
      IT0T3 = 0
      JWK = 0
      DO 70 IT0=1,NT0
        IT0T3 = IT0T3 + 3
        I1 = IPT(IT0T3-2)
        I2 = IPT(IT0T3-1)
        I3 = IPT(IT0T3)
        XMN = DMIN1(XD(I1),XD(I2),XD(I3))
        XMX = DMAX1(XD(I1),XD(I2),XD(I3))
        YMN = DMIN1(YD(I1),YD(I2),YD(I3))
        YMX = DMAX1(YD(I1),YD(I2),YD(I3))
        IF (YMN.GT.YS1) GO TO 30
        IF (XMN.LE.XS1) IDSC(1) = 1
        IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(2) = 1
        IF (XMX.GE.XS2) IDSC(3) = 1
   30   IF (YMX.LT.YS1 .OR. YMN.GT.YS2) GO TO 40
        IF (XMN.LE.XS1) IDSC(4) = 1
        IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(5) = 1
        IF (XMX.GE.XS2) IDSC(6) = 1
   40   IF (YMX.LT.YS2) GO TO 50
        IF (XMN.LE.XS1) IDSC(7) = 1
        IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(8) = 1
        IF (XMX.GE.XS2) IDSC(9) = 1
   50   DO 60 ISC=1,9
          IF (IDSC(ISC).EQ.0) GO TO 60
          JIWK = 9*NTSC(ISC) + ISC
          IWK(JIWK) = IT0
          NTSC(ISC) = NTSC(ISC) + 1
          IDSC(ISC) = 0
   60   CONTINUE
C - STORES IN THE WK ARRAY THE MINIMUM AND MAXIMUM OF THE X AND
C - Y COORDINATE VALUES FOR EACH OF THE TRIANGLE.
        JWK = JWK + 4
        WK(JWK-3) = XMN
        WK(JWK-2) = XMX
        WK(JWK-1) = YMN
        WK(JWK) = YMX
   70 CONTINUE
      GO TO 110
C CHECKS IF IN THE SAME TRIANGLE AS PREVIOUS.
   80 IT0 = ITIPV
      IF (IT0.GT.NT0) GO TO 90
      IT0T3 = IT0*3
      IP1 = IPT(IT0T3-2)
      X1 = XD(IP1)
      Y1 = YD(IP1)
      IP2 = IPT(IT0T3-1)
      X2 = XD(IP2)
      Y2 = YD(IP2)
      IF (SIDE(X1,Y1,X2,Y2,X0,Y0).LT.0.0) GO TO 110
      IP3 = IPT(IT0T3)
      X3 = XD(IP3)
      Y3 = YD(IP3)
      IF (SIDE(X2,Y2,X3,Y3,X0,Y0).LT.0.0) GO TO 110
      IF (SIDE(X3,Y3,X1,Y1,X0,Y0).LT.0.0) GO TO 110
      GO TO 170
C CHECKS IF ON THE SAME BORDER LINE SEGMENT.
   90 IL1 = IT0/NTL
      IL2 = IT0 - IL1*NTL
      IL1T3 = IL1*3
      IP1 = IPL(IL1T3-2)
      X1 = XD(IP1)
      Y1 = YD(IP1)
      IP2 = IPL(IL1T3-1)
      X2 = XD(IP2)
      Y2 = YD(IP2)
      IF (IL2.NE.IL1) GO TO 100
      IF (SPDT(X1,Y1,X2,Y2,X0,Y0).LT.0.0) GO TO 110
      IF (SPDT(X2,Y2,X1,Y1,X0,Y0).LT.0.0) GO TO 110
      IF (SIDE(X1,Y1,X2,Y2,X0,Y0).GT.0.0) GO TO 110
      GO TO 170
C CHECKS IF BETWEEN THE SAME TWO BORDER LINE SEGMENTS.
  100 IF (SPDT(X1,Y1,X2,Y2,X0,Y0).GT.0.0) GO TO 110
      IP3 = IPL(3*IL2-1)
      X3 = XD(IP3)
      Y3 = YD(IP3)
      IF (SPDT(X3,Y3,X2,Y2,X0,Y0).LE.0.0) GO TO 170
C LOCATES INSIDE THE DATA AREA.
C - DETERMINES THE SECTION IN WHICH THE POINT IN QUESTION LIES.
 110  ISC = 1
      IF (X0.GE.XS1) ISC = ISC + 1
      IF (X0.GE.XS2) ISC = ISC + 1
      IF (Y0.GE.YS1) ISC = ISC + 3
      IF (Y0.GE.YS2) ISC = ISC + 3
C - SEARCHES THROUGH THE TRIANGLES ASSOCIATED WITH THE SECTION.
      NTSCI = NTSC(ISC)
      IF (NTSCI.LE.0) GO TO 130
      JIWK = -9 + ISC
      DO 120 ITSC=1,NTSCI
        JIWK = JIWK + 9
        IT0 = IWK(JIWK)
        JWK = IT0*4
        IF (X0.LT.WK(JWK-3)) GO TO 120
        IF (X0.GT.WK(JWK-2)) GO TO 120
        IF (Y0.LT.WK(JWK-1)) GO TO 120
        IF (Y0.GT.WK(JWK)) GO TO 120
        IT0T3 = IT0*3
        IP1 = IPT(IT0T3-2)
        X1 = XD(IP1)
        Y1 = YD(IP1)
        IP2 = IPT(IT0T3-1)
        X2 = XD(IP2)
        Y2 = YD(IP2)
        IF (SIDE(X1,Y1,X2,Y2,X0,Y0).LT.0.0) GO TO 120
        IP3 = IPT(IT0T3)
        X3 = XD(IP3)
        Y3 = YD(IP3)
        IF (SIDE(X2,Y2,X3,Y3,X0,Y0).LT.0.0) GO TO 120
        IF (SIDE(X3,Y3,X1,Y1,X0,Y0).LT.0.0) GO TO 120
        GO TO 170
  120 CONTINUE
C LOCATES OUTSIDE THE DATA AREA.
  130 DO 150 IL1=1,NL0
        IL1T3 = IL1*3
        IP1 = IPL(IL1T3-2)
        X1 = XD(IP1)
        Y1 = YD(IP1)
        IP2 = IPL(IL1T3-1)
        X2 = XD(IP2)
        Y2 = YD(IP2)
        IF (SPDT(X2,Y2,X1,Y1,X0,Y0).LT.0.0) GO TO 150
        IF (SPDT(X1,Y1,X2,Y2,X0,Y0).LT.0.0) GO TO 140
        IF (SIDE(X1,Y1,X2,Y2,X0,Y0).GT.0.0) GO TO 150
        IL2 = IL1
        GO TO 160
  140   IL2 = MOD(IL1,NL0) + 1
        IP3 = IPL(3*IL2-1)
        X3 = XD(IP3)
        Y3 = YD(IP3)
        IF (SPDT(X3,Y3,X2,Y2,X0,Y0).LE.0.0) GO TO 160
  150 CONTINUE
      IT0 = 1
      GO TO 170
  160 IT0 = IL1*NTL + IL2
C NORMAL EXIT
  170 ITI = IT0
      ITIPV = IT0
      RETURN
      END

      SUBROUTINE  IDPDRV(NDP,XD,YD,ZD,NCP,IPC,PD)                       ID008940
C THIS SUBROUTINE ESTIMATES PARTIAL DERIVATIVES OF THE FIRST AND
C SECOND ORDER AT THE DATA POINTS.
C THE INPUT PARAMETERS ARE
C     NDP = NUMBER OF DATA POINTS,
C     XD,YD,ZD = ARRAYS OF DIMENSION NDP CONTAINING THE X,
C           Y, AND Z COORDINATES OF THE DATA POINTS,
C     NCP = NUMBER OF ADDITIONAL DATA POINTS USED FOR ESTI-
C           MATING PARTIAL DERIVATIVES AT EACH DATA POINT,
C     IPC = INTEGER ARRAY OF DIMENSION NCP*NDP CONTAINING
C           THE POINT NUMBERS OF NCP DATA POINTS CLOSEST TO
C           EACH OF THE NDP DATA POINTS.
C THE OUTPUT PARAMETER IS
C     PD  = ARRAY OF DIMENSION 5*NDP, WHERE THE ESTIMATED
C           ZX, ZY, ZXX, ZXY, AND ZYY VALUES AT THE DATA
C           POINTS ARE TO BE STORED.
C DECLARATION STATEMENTS
      IMPLICIT DOUBLE PRECISION (A-D,P-Z)
      DIMENSION   XD(NDP),YD(NDP),ZD(NDP),IPC(NCP*NDP),PD(5*NDP)
      DOUBLE PRECISION        NMX,NMY,NMZ,NMXX,NMXY,NMYX,NMYY
C PRELIMINARY PROCESSING
   10 NDP0=NDP
      NCP0=NCP
      NCPM1=NCP0-1
C ESTIMATION OF ZX AND ZY
  20  DO 24  IP0=1,NDP0
        X0=XD(IP0)
        Y0=YD(IP0)
        Z0=ZD(IP0)
        NMX=0.0
        NMY=0.0
        NMZ=0.0
        JIPC0=NCP0*(IP0-1)
        DO 23  IC1=1,NCPM1
          JIPC=JIPC0+IC1
          IPI=IPC(JIPC)
          DX1=XD(IPI)-X0
          DY1=YD(IPI)-Y0
          DZ1=ZD(IPI)-Z0
          IC2MN=IC1+1
          DO 22  IC2=IC2MN,NCP0
            JIPC=JIPC0+IC2
            IPI=IPC(JIPC)
            DX2=XD(IPI)-X0
            DY2=YD(IPI)-Y0
            DNMZ=DX1*DY2-DY1*DX2
            IF(DNMZ.EQ.0.0)    GO TO 22
            DZ2=ZD(IPI)-Z0
            DNMX=DY1*DZ2-DZ1*DY2
            DNMY=DZ1*DX2-DX1*DZ2
            IF(DNMZ.GE.0.0)    GO TO 21
            DNMX=-DNMX
            DNMY=-DNMY
            DNMZ=-DNMZ
   21       NMX=NMX+DNMX
            NMY=NMY+DNMY
            NMZ=NMZ+DNMZ
   22     CONTINUE
   23   CONTINUE
        JPD0=5*IP0
        PD(JPD0-4)=-NMX/NMZ
        PD(JPD0-3)=-NMY/NMZ
   24 CONTINUE
C ESTIMATION OF ZXX, ZXY, AND ZYY
   30 DO 34  IP0=1,NDP0
        JPD0=JPD0+5
        X0=XD(IP0)
        JPD0=5*IP0
        Y0=YD(IP0)
        ZX0=PD(JPD0-4)
        ZY0=PD(JPD0-3)
        NMXX=0.0
        NMXY=0.0
        NMYX=0.0
        NMYY=0.0
        NMZ =0.0
        JIPC0=NCP0*(IP0-1)
        DO 33  IC1=1,NCPM1
          JIPC=JIPC0+IC1
          IPI=IPC(JIPC)
          DX1=XD(IPI)-X0
          DY1=YD(IPI)-Y0
          JPD=5*IPI
          DZX1=PD(JPD-4)-ZX0
          DZY1=PD(JPD-3)-ZY0
          IC2MN=IC1+1
          DO 32  IC2=IC2MN,NCP0
            JIPC=JIPC0+IC2
            IPI=IPC(JIPC)
            DX2=XD(IPI)-X0
            DY2=YD(IPI)-Y0
            DNMZ =DX1*DY2 -DY1*DX2
            IF(DNMZ.EQ.0.0)    GO TO 32
            JPD=5*IPI
            DZX2=PD(JPD-4)-ZX0
            DZY2=PD(JPD-3)-ZY0
            DNMXX=DY1*DZX2-DZX1*DY2
            DNMXY=DZX1*DX2-DX1*DZX2
            DNMYX=DY1*DZY2-DZY1*DY2
            DNMYY=DZY1*DX2-DX1*DZY2
            IF(DNMZ.GE.0.0)    GO TO 31
            DNMXX=-DNMXX
            DNMXY=-DNMXY
            DNMYX=-DNMYX
            DNMYY=-DNMYY
            DNMZ =-DNMZ
   31       NMXX=NMXX+DNMXX
            NMXY=NMXY+DNMXY
            NMYX=NMYX+DNMYX
            NMYY=NMYY+DNMYY
            NMZ =NMZ +DNMZ
   32     CONTINUE
   33   CONTINUE
        PD(JPD0-2)=-NMXX/NMZ
        PD(JPD0-1)=-(NMXY+NMYX)/(2.0*NMZ)
        PD(JPD0)  =-NMYY/NMZ
   34 CONTINUE
      RETURN
      END

      SUBROUTINE  IDPTIP(XD,YD,ZD,NDP,NT,IPT,NL,IPL,PDD,ITI,XII,YII,        ID010190
     1                   ZII,MISSII)
C THIS SUBROUTINE PERFORMS PUNCTUAL INTERPOLATION OR EXTRAPOLA-
C TION, I.E., DETERMINES THE Z VALUE AT A POINT.
C THE INPUT PARAMETERS ARE
C     XD,YD,ZD = ARRAYS OF DIMENSION NDP CONTAINING THE X,
C           Y, AND Z COORDINATES OF THE DATA POINTS, WHERE
C           NDP IS THE NUMBER OF THE DATA POINTS,
C     NT  = NUMBER OF TRIANGLES,
C     IPT = INTEGER ARRAY OF DIMENSION 3*NT CONTAINING THE
C           POINT NUMBERS OF THE VERTEXES OF THE TRIANGLES,
C     NL  = NUMBER OF BORDER LINE SEGMENTS,
C     IPL = INTEGER ARRAY OF DIMENSION 3*NL CONTAINING THE
C           POINT NUMBERS OF THE END POINTS OF THE BORDER
C           LINE SEGMENTS AND THEIR RESPECTIVE TRIANGLE
C           NUMBERS,
C     PDD = ARRAY OF DIMENSION 5*NDP CONTAINING THE PARTIAL
C           DERIVATIVES AT THE DATA POINTS,
C     ITI = TRIANGLE NUMBER OF THE TRIANGLE IN WHICH LIES
C           THE POINT FOR WHICH INTERPOLATION IS TO BE
C           PERFORMED,
C     XII,YII = X AND Y COORDINATES OF THE POINT FOR WHICH
C           INTERPOLATION IS TO BE PERFORMED.
C THE OUTPUT PARAMETER IS
C     ZII = INTERPOLATED Z VALUE.
C     MISSII = LOCIGAL INDICATING MISSING VALUE
C DECLARATION STATEMENTS
      IMPLICIT DOUBLE PRECISION (A-D,P-Z)
      LOGICAL MISSII
      DIMENSION   XD(NDP),YD(NDP),ZD(NDP),IPT(3*NT),IPL(3*NL),
     1            PDD(5*NDP)
      COMMON/IDPI/ITPV
      DIMENSION   X(3),Y(3),Z(3),PD(15),
     1            ZU(3),ZV(3),ZUU(3),ZUV(3),ZVV(3)
      DOUBLE PRECISION        LU,LV
      EQUIVALENCE (P5,P50)
C PRELIMINARY PROCESSING
   10 IT0=ITI
      NTL=NT+NL
      IF(IT0.LE.NTL)      GO TO 20
C EXTRAPOLATION OR MISSING VALUE WANTED?
      IF (MISSII) THEN
         ZII=0
         RETURN
      END IF
      IL1=IT0/NTL
      IL2=IT0-IL1*NTL
      IF(IL1.EQ.IL2)      GO TO 40
      GO TO 60
C CALCULATION OF ZII BY INTERPOLATION.
C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED.
   20 IF(IT0.EQ.ITPV)     GO TO 30
C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE
C VERTEXES.
   21 JIPT=3*(IT0-1)
      JPD=0
      DO 23  I=1,3
        JIPT=JIPT+1
        IDP=IPT(JIPT)
        X(I)=XD(IDP)
        Y(I)=YD(IDP)
        Z(I)=ZD(IDP)
        JPDD=5*(IDP-1)
        DO 22  KPD=1,5
          JPD=JPD+1
          JPDD=JPDD+1
          PD(JPD)=PDD(JPDD)
   22   CONTINUE
   23 CONTINUE
C DETERMINES THE COEFFICIENTS FOR THE COORDINATE SYSTEM
C TRANSFORMATION FROM THE X-Y SYSTEM TO THE U-V SYSTEM
C AND VICE VERSA.
   24 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
C CONVERTS THE PARTIAL DERIVATIVES AT THE VERTEXES OF THE
C TRIANGLE FOR THE U-V COORDINATE SYSTEM.
   25 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 26  I=1,3
        JPD=5*I
        ZU(I)=A*PD(JPD-4)+C*PD(JPD-3)
        ZV(I)=B*PD(JPD-4)+D*PD(JPD-3)
        ZUU(I)=AA*PD(JPD-2)+ACT2*PD(JPD-1)+CC*PD(JPD)
        ZUV(I)=AB*PD(JPD-2)+ADBC*PD(JPD-1)+CD*PD(JPD)
        ZVV(I)=BB*PD(JPD-2)+BDT2*PD(JPD-1)+DD*PD(JPD)
   26 CONTINUE
C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL.
   27 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
      LU=SQRT(AA+CC)
      LV=SQRT(BB+DD)
      THXU=ATAN2(C,A)
      THUV=ATAN2(D,B)-THXU
      CSUV=COS(THUV)
      P41=5.0*LV*CSUV/LU*P50
      P14=5.0*LU*CSUV/LV*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
      THUS=ATAN2(D-C,B-A)-THXU
      THSV=THUV-THUS
      AA= SIN(THSV)/LU
      BB=-COS(THSV)/LU
      CC= SIN(THUS)/LV
      DD= COS(THUS)/LV
      AC=AA*CC
      AD=AA*DD
      BC=BB*CC
      G1=AA*AC*(3.0*BC+2.0*AD)
      G2=CC*AC*(3.0*AD+2.0*BC)
      H1=-AA*AA*AA*(5.0*AA*BB*P50+(4.0*BC+AD)*P41)
     1   -CC*CC*CC*(5.0*CC*DD*P05+(4.0*AD+BC)*P14)
      H2=0.5*ZVV(2)-P02-P12
      H3=0.5*ZUU(3)-P20-P21
      P22=(G1*H2+G2*H3-H1)/(G1+G2)
      P32=H2-P22
      P23=H3-P22
      ITPV=IT0
C CONVERTS XII AND YII TO U-V SYSTEM.
   30 DX=XII-X0
      DY=YII-Y0
      U=AP*DX+BP*DY
      V=CP*DX+DP*DY
C EVALUATES THE POLYNOMIAL.
   31 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
      ZII=P0+U*(P1+U*(P2+U*(P3+U*(P4+U*P5))))
      MISSII=.FALSE.
      RETURN
C CALCULATION OF ZII BY EXTRAPOLATION IN THE RECTANGLE.
C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED.
   40 IF(IT0.EQ.ITPV)     GO TO 50
C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE END
C POINTS OF THE BORDER LINE SEGMENT.
   41 JIPL=3*(IL1-1)
      JPD=0
      DO 43  I=1,2
        JIPL=JIPL+1
        IDP=IPL(JIPL)
        X(I)=XD(IDP)
        Y(I)=YD(IDP)
        Z(I)=ZD(IDP)
        JPDD=5*(IDP-1)
        DO 42  KPD=1,5
          JPD=JPD+1
          JPDD=JPDD+1
          PD(JPD)=PDD(JPDD)
   42   CONTINUE
   43 CONTINUE
C DETERMINES THE COEFFICIENTS FOR THE COORDINATE SYSTEM
C TRANSFORMATION FROM THE X-Y SYSTEM TO THE U-V SYSTEM
C AND VICE VERSA.
   44 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
C CONVERTS THE PARTIAL DERIVATIVES AT THE END POINTS OF THE
C BORDER LINE SEGMENT FOR THE U-V COORDINATE SYSTEM.
   45 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 46  I=1,2
        JPD=5*I
        ZU(I)=A*PD(JPD-4)+C*PD(JPD-3)
        ZV(I)=B*PD(JPD-4)+D*PD(JPD-3)
        ZUU(I)=AA*PD(JPD-2)+ACT2*PD(JPD-1)+CC*PD(JPD)
        ZUV(I)=AB*PD(JPD-2)+ADBC*PD(JPD-1)+CD*PD(JPD)
        ZVV(I)=BB*PD(JPD-2)+BDT2*PD(JPD-1)+DD*PD(JPD)
   46 CONTINUE
C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL.
   47 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.0
      P23=-ZUU(2)+ZUU(1)
      P22=-1.5*P23
      ITPV=IT0
C CONVERTS XII AND YII TO U-V SYSTEM.
   50 DX=XII-X0
      DY=YII-Y0
      U=AP*DX+BP*DY
      V=CP*DX+DP*DY
C EVALUATES THE POLYNOMIAL.
   51 P0=P00+V*(P01+V*(P02+V*(P03+V*(P04+V*P05))))
      P1=P10+V*(P11+V*(P12+V*P13))
      P2=P20+V*(P21+V*(P22+V*P23))
      ZII=P0+U*(P1+U*P2)
      RETURN
C CALCULATION OF ZII BY EXTRAPOLATION IN THE TRIANGLE.
C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED.
   60 IF(IT0.EQ.ITPV)     GO TO 70
C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE VERTEX
C OF THE TRIANGLE.
   61 JIPL=3*IL2-2
      IDP=IPL(JIPL)
      X(1)=XD(IDP)
      Y(1)=YD(IDP)
      Z(1)=ZD(IDP)
      JPDD=5*(IDP-1)
      DO 62  KPD=1,5
        JPDD=JPDD+1
        PD(KPD)=PDD(JPDD)
   62 CONTINUE
C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL.
   67 P00=Z(1)
      P10=PD(1)
      P01=PD(2)
      P20=0.5*PD(3)
      P11=PD(4)
      P02=0.5*PD(5)
      ITPV=IT0
C CONVERTS XII AND YII TO U-V SYSTEM.
   70 U=XII-X(1)
      V=YII-Y(1)
C EVALUATES THE POLYNOMIAL.
   71 P0=P00+V*(P01+V*P02)
      P1=P10+V*P11
      ZII=P0+U*(P1+U*P20)
      RETURN
      END

      SUBROUTINE  IDPTLI(XD,YD,ZD,NDP,NT,IPT,NL,IPL,ITI,XII,YII,ZII,
     1                   MISSII)                                        ID010191
C THIS SUBROUTINE PERFORMS LINEAR PUNCTUAL INTERPOLATION,
C I.E., DETERMINES THE Z VALUE AT A POINT.
C THE INPUT PARAMETERS ARE
C     XD,YD,ZD = ARRAYS OF DIMENSION NDP CONTAINING THE X,
C           Y, AND Z COORDINATES OF THE DATA POINTS, WHERE
C           NDP IS THE NUMBER OF THE DATA POINTS,
C     NT  = NUMBER OF TRIANGLES,
C     IPT = INTEGER ARRAY OF DIMENSION 3*NT CONTAINING THE
C           POINT NUMBERS OF THE VERTEXES OF THE TRIANGLES,
C     NL  = NUMBER OF BORDER LINE SEGMENTS,
C     IPL = INTEGER ARRAY OF DIMENSION 3*NL CONTAINING THE
C           POINT NUMBERS OF THE END POINTS OF THE BORDER
C           LINE SEGMENTS AND THEIR RESPECTIVE TRIANGLE
C           NUMBERS,
C     ITI = TRIANGLE NUMBER OF THE TRIANGLE IN WHICH LIES
C           THE POINT FOR WHICH INTERPOLATION IS TO BE
C           PERFORMED,
C     XII,YII = X AND Y COORDINATES OF THE POINT FOR WHICH
C           INTERPOLATION IS TO BE PERFORMED.
C THE OUTPUT PARAMETERS ARE
C     ZII = INTERPOLATED Z VALUE.
C     MISSII = LOCIGAL INDICATING MISSING VALUE
C DECLARATION STATEMENTS
      IMPLICIT DOUBLE PRECISION (A-D,P-Z)
      LOGICAL MISSII
      DIMENSION   XD(NDP),YD(NDP),ZD(NDP),IPT(3*NT),IPL(3*NL)
      COMMON/IDPI/ITPV
      DIMENSION   X(3),Y(3),Z(3)
      EQUIVALENCE (P5,P50)
C PRELIMINARY PROCESSING
   10 IT0=ITI
      NTL=NT+NL
      IF(IT0.LE.NTL)      GO TO 20
      GO TO 40
C CALCULATION OF ZII BY INTERPOLATION.
C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED.
   20 IF(IT0.EQ.ITPV)     GO TO 30
C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE
C VERTEXES.
   21 JIPT=3*(IT0-1)
      JPD=0
      DO 23  I=1,3
        JIPT=JIPT+1
        IDP=IPT(JIPT)
        X(I)=XD(IDP)
        Y(I)=YD(IDP)
        Z(I)=ZD(IDP)
   23 CONTINUE
C DETERMINES THE COEFFICIENTS FOR THE COORDINATE SYSTEM
C TRANSFORMATION FROM THE X-Y SYSTEM TO THE U-V SYSTEM
C AND VICE VERSA.
   24 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
C CONVERTS XII AND YII TO U-V SYSTEM.
   30 DX=XII-X0
      DY=YII-Y0
      U=AP*DX+BP*DY
      V=CP*DX+DP*DY
C EVALUATES THE INTERPOLATED PLANE
C ACCORDING TO
C |  U   V  ZII-Z1 |
C |  1   0   Z2-Z1 | = 0
C |  0   1   Z3-Z1 |
C
      ZII=Z(1)+U*(Z(2)-Z(1))+V*(Z(3)-Z(1))
      MISSII=.FALSE.
      RETURN
C NO EXTRAPOLATION! 
 40   ZII=0
      MISSII=.TRUE.
      RETURN
      END

      SUBROUTINE  IDSFFT(MD,NCP,NDP,XD,YD,ZD,NXI,NYI,XI,YI,ZI,          ID013070
     1                   IWK,WK,MISSI)
C THIS SUBROUTINE PERFORMS SMOOTH SURFACE FITTING WHEN THE PRO-
C JECTIONS OF THE DATA POINTS IN THE X-Y PLANE ARE IRREGULARLY
C DISTRIBUTED IN THE PLANE.
C THE INPUT PARAMETERS ARE
C     MD  = MODE OF COMPUTATION (MUST BE 1, 2, OR 3),
C         = 1 FOR NEW NCP AND/OR NEW XD-YD,
C         = 2 FOR OLD NCP, OLD XD-YD, NEW XI-YI,
C         = 3 FOR OLD NCP, OLD XD-YD, OLD XI-YI,
C     NCP = NUMBER OF ADDITIONAL DATA POINTS USED FOR ESTI-
C           MATING PARTIAL DERIVATIVES AT EACH DATA POINT
C           (MUST BE 2 OR GREATER, BUT SMALLER THAN NDP),
C     NDP = NUMBER OF DATA POINTS (MUST BE 4 OR GREATER),
C     XD  = ARRAY OF DIMENSION NDP CONTAINING THE X
C           COORDINATES OF THE DATA POINTS,
C     YD  = ARRAY OF DIMENSION NDP CONTAINING THE Y
C           COORDINATES OF THE DATA POINTS,
C     ZD  = ARRAY OF DIMENSION NDP CONTAINING THE Z
C           COORDINATES OF THE DATA POINTS,
C     NXI = NUMBER OF OUTPUT GRID POINTS IN THE X COORDINATE
C           (MUST BE 1 OR GREATER),
C     NYI = NUMBER OF OUTPUT GRID POINTS IN THE Y COORDINATE
C           (MUST BE 1 OR GREATER),
C     XI  = ARRAY OF DIMENSION NXI CONTAINING THE X
C           COORDINATES OF THE OUTPUT GRID POINTS,
C     YI  = ARRAY OF DIMENSION NYI CONTAINING THE Y
C           COORDINATES OF THE OUTPUT GRID POINTS.
C THE OUTPUT PARAMETER IS
C     ZI  = DOUBLY-DIMENSIONED ARRAY OF DIMENSION (NXI,NYI),
C           WHERE THE INTERPOLATED Z VALUES AT THE OUTPUT
C           GRID POINTS ARE TO BE STORED.
C THE OTHER PARAMETERS ARE
C     IWK = INTEGER ARRAY OF DIMENSION
C              MAX0(31,27+NCP)*NDP+NXI*NYI
C           USED INTERNALLY AS A WORK AREA,
C     WK  = ARRAY OF DIMENSION 5*NDP USED INTERNALLY AS A
C           WORK AREA.
C     MISSI = LOCICAL ARRAY, INDICATING IF EXTRAPOLATION OR MISSING VALUES
C            OUTSIDE CONVEX HULL WANTED
C THE VERY FIRST CALL TO THIS SUBROUTINE AND THE CALL WITH A NEW
C NCP VALUE, A NEW NDP VALUE, AND/OR NEW CONTENTS OF THE XD AND
C YD ARRAYS MUST BE MADE WITH MD=1.  THE CALL WITH MD=2 MUST BE
C PRECEDED BY ANOTHER CALL WITH THE SAME NCP AND NDP VALUES AND
C WITH THE SAME CONTENTS OF THE XD AND YD ARRAYS.  THE CALL WITH
C MD=3 MUST BE PRECEDED BY ANOTHER CALL WITH THE SAME NCP, NDP,
C NXI, AND NYI VALUES AND WITH THE SAME CONTENTS OF THE XD, YD,
C XI, AND YI ARRAYS.  BETWEEN THE CALL WITH MD=2 OR MD=3 AND ITS
C PRECEDING CALL, THE IWK AND WK ARRAYS MUST NOT BE DISTURBED.
C USE OF A VALUE BETWEEN 3 AND 5 (INCLUSIVE) FOR NCP IS RECOM-
C MENDED UNLESS THERE ARE EVIDENCES THAT DICTATE OTHERWISE.
C THE LUN CONSTANT IN THE DATA INITIALIZATION STATEMENT IS THE
C LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS,
C THEREFORE, SYSTEM DEPENDENT.
C THIS SUBROUTINE CALLS THE IDCLDP, IDGRID, IDPDRV, IDPTIP, AND
C IDTANG SUBROUTINES.
C DECLARATION STATEMENTS
      IMPLICIT DOUBLE PRECISION (A-D,P-Z)
      LOGICAL MISSI, LINEAR
      DIMENSION   XD(NDP),YD(NDP),ZD(NDP),XI(NXI),YI(NYI),
     1            ZI(NXI*NYI),MISSI(NXI*NYI),IWK((31+NCP)*NDP+NXI*NYI),
     2            WK(5*NDP)
      COMMON/IDPI/ITPV
      DATA  LUN/6/
      LINEAR=.FALSE.
C SETTING OF SOME INPUT PARAMETERS TO LOCAL VARIABLES.
C (FOR MD=1,2,3)
   10 MD0=MD
      NCP0=NCP
      NDP0=NDP
      NXI0=NXI
      NYI0=NYI
C ERROR CHECK.  (FOR MD=1,2,3)
   20 IF(MD0.LT.1.OR.MD0.GT.3)           GO TO 90
      IF(NCP0.EQ.0) THEN
         LINEAR=.TRUE.
         DO 21 I=1,NXI*NYI
            MISSI(I)=.TRUE.
   21    CONTINUE
      END IF
      IF(NCP0.EQ.1.OR.NCP0.GE.NDP0)      GO TO 90
      IF(NDP0.LT.4)                      GO TO 90
      IF(NXI0.LT.1.OR.NYI0.LT.1)         GO TO 90
      IF(MD0.GE.2)        GO TO 23
      IWK(1)=NCP0
      IWK(2)=NDP0
      GO TO 24
   23 NCPPV=IWK(1)
      NDPPV=IWK(2)
      IF(NCP0.NE.NCPPV)   GO TO 90
      IF(NDP0.NE.NDPPV)   GO TO 90
   24 IF(MD0.GE.3)        GO TO 25
      IWK(3)=NXI0
      IWK(4)=NYI0
      GO TO 30
   25 NXIPV=IWK(3)
      NYIPV=IWK(4)
      IF(NXI0.NE.NXIPV)   GO TO 90
      IF(NYI0.NE.NYIPV)   GO TO 90
C ALLOCATION OF STORAGE AREAS IN THE IWK ARRAY.  (FOR MD=1,2,3)
   30 JWIPT=16
      JWIWL=6*NDP0+1
      JWNGP0=JWIWL-1
      JWIPL=24*NDP0+1
      JWIWP=30*NDP0+1
      JWIPC=27*NDP0+1
      JWIGP0=MAX0(31,27+NCP0)*NDP0
C TRIANGULATES THE X-Y PLANE.  (FOR MD=1)
   40 IF(MD0.GT.1)   GO TO 50
      CALL IDTANG(NDP0,XD,YD,NT,IWK(JWIPT),NL,IWK(JWIPL),
     1            IWK(JWIWL),IWK(JWIWP),WK)
      IWK(5)=NT
      IWK(6)=NL
      IF(NT.EQ.0)    RETURN
C DETERMINES NCP POINTS CLOSEST TO EACH DATA POINT.  (FOR MD=1)
   50 IF(MD0.GT.1 .OR. LINEAR)   GO TO 60
      CALL IDCLDP(NDP0,XD,YD,NCP0,IWK(JWIPC))
      IF(IWK(JWIPC).EQ.0)      RETURN
C SORTS OUTPUT GRID POINTS IN ASCENDING ORDER OF THE TRIANGLE
C NUMBER AND THE BORDER LINE SEGMENT NUMBER.  (FOR MD=1,2)
   60 IF(MD0.EQ.3)   GO TO 70
      CALL IDGRID(XD,YD,NDP,NT,IWK(JWIPT),NL,IWK(JWIPL),NXI0,NYI0,
     1            XI,YI,IWK(JWNGP0+1),IWK(JWIGP0+1))
C ESTIMATES PARTIAL DERIVATIVES AT ALL DATA POINTS.
C (FOR MD=1,2,3)
   70 IF (.NOT.LINEAR) CALL IDPDRV(NDP0,XD,YD,ZD,NCP0,IWK(JWIPC),WK)
C INTERPOLATES THE ZI VALUES.  (FOR MD=1,2,3)
   80 ITPV=0
      JIG0MX=0
      JIG1MN=NXI0*NYI0+1
      NNGP=NT+2*NL
      DO 89  JNGP=1,NNGP
        ITI=JNGP
        IF(JNGP.LE.NT)    GO TO 81
        IL1=(JNGP-NT+1)/2
        IL2=(JNGP-NT+2)/2
        IF(IL2.GT.NL)     IL2=1
        ITI=IL1*(NT+NL)+IL2
   81   JWNGP=JWNGP0+JNGP
        NGP0=IWK(JWNGP)
        IF(NGP0.EQ.0)     GO TO 86
        JIG0MN=JIG0MX+1
        JIG0MX=JIG0MX+NGP0
        DO 82  JIGP=JIG0MN,JIG0MX
          JWIGP=JWIGP0+JIGP
          IZI=IWK(JWIGP)
          IYI=(IZI-1)/NXI0+1
          IXI=IZI-NXI0*(IYI-1)
          IF (LINEAR) THEN
          CALL IDPTLI(XD,YD,ZD,NDP,NT,IWK(JWIPT),NL,IWK(JWIPL),
     1                ITI,XI(IXI),YI(IYI),ZI(IZI),MISSI(IZI))
          ELSE
          CALL IDPTIP(XD,YD,ZD,NDP,NT,IWK(JWIPT),NL,IWK(JWIPL),WK,
     1                ITI,XI(IXI),YI(IYI),ZI(IZI),MISSI(IZI))
          END IF          
   82   CONTINUE
   86   JWNGP=JWNGP0+2*NNGP+1-JNGP
        NGP1=IWK(JWNGP)
        IF(NGP1.EQ.0)     GO TO 89
        JIG1MX=JIG1MN-1
        JIG1MN=JIG1MN-NGP1
        DO 87  JIGP=JIG1MN,JIG1MX
          JWIGP=JWIGP0+JIGP
          IZI=IWK(JWIGP)
          IYI=(IZI-1)/NXI0+1
          IXI=IZI-NXI0*(IYI-1)
          IF (LINEAR) THEN
          CALL IDPTLI(XD,YD,ZD,NDP,NT,IWK(JWIPT),NL,IWK(JWIPL),
     1                ITI,XI(IXI),YI(IYI),ZI(IZI),MISSI(IZI))
          ELSE
          CALL IDPTIP(XD,YD,ZD,NDP,NT,IWK(JWIPT),NL,IWK(JWIPL),WK,
     1                ITI,XI(IXI),YI(IYI),ZI(IZI),MISSI(IZI))
          END IF
   87   CONTINUE
   89 CONTINUE
      RETURN
C ERROR EXIT
   90 WRITE (LUN,2090) MD0,NCP0,NDP0,NXI0,NYI0
      RETURN
C FORMAT STATEMENT FOR ERROR MESSAGE
 2090 FORMAT(1X/41H ***   IMPROPER INPUT PARAMETER VALUE(S)./
     1   7H   MD =,I4,10X,5HNCP =,I6,10X,5HNDP =,I6,
     2   10X,5HNXI =,I6,10X,5HNYI =,I6/
     3   35H ERROR DETECTED IN ROUTINE   IDSFFT/)
      END

      SUBROUTINE  IDTANG(NDP,XD,YD,NT,IPT,NL,IPL,IWL,IWP,WK)            ID014770
C THIS SUBROUTINE PERFORMS TRIANGULATION.  IT DIVIDES THE X-Y
C PLANE INTO A NUMBER OF TRIANGLES ACCORDING TO GIVEN DATA
C POINTS IN THE PLANE, DETERMINES LINE SEGMENTS THAT FORM THE
C BORDER OF DATA AREA, AND DETERMINES THE TRIANGLE NUMBERS
C CORRESPONDING TO THE BORDER LINE SEGMENTS.
C AT COMPLETION, POINT NUMBERS OF THE VERTEXES OF EACH TRIANGLE
C ARE LISTED COUNTER-CLOCKWISE.  POINT NUMBERS OF THE END POINTS
C OF EACH BORDER LINE SEGMENT ARE LISTED COUNTER-CLOCKWISE,
C LISTING ORDER OF THE LINE SEGMENTS BEING COUNTER-CLOCKWISE.
C THE LUN CONSTANT IN THE DATA INITIALIZATION STATEMENT IS THE
C LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS,
C THEREFORE, SYSTEM DEPENDENT.
C THIS SUBROUTINE CALLS THE IDXCHG FUNCTION.
C THE INPUT PARAMETERS ARE
C     NDP = NUMBER OF DATA POINTS,
C     XD  = ARRAY OF DIMENSION NDP CONTAINING THE
C           X COORDINATES OF THE DATA POINTS,
C     YD  = ARRAY OF DIMENSION NDP CONTAINING THE
C           Y COORDINATES OF THE DATA POINTS.
C THE OUTPUT PARAMETERS ARE
C     NT  = NUMBER OF TRIANGLES,
C     IPT = INTEGER ARRAY OF DIMENSION 6*NDP-15, WHERE THE
C           POINT NUMBERS OF THE VERTEXES OF THE (IT)TH
C           TRIANGLE ARE TO BE STORED AS THE (3*IT-2)ND,
C           (3*IT-1)ST, AND (3*IT)TH ELEMENTS,
C           IT=1,2,...,NT,
C     NL  = NUMBER OF BORDER LINE SEGMENTS,
C     IPL = INTEGER ARRAY OF DIMENSION 6*NDP, WHERE THE
C           POINT NUMBERS OF THE END POINTS OF THE (IL)TH
C           BORDER LINE SEGMENT AND ITS RESPECTIVE TRIANGLE
C           NUMBER ARE TO BE STORED AS THE (3*IL-2)ND,
C           (3*IL-1)ST, AND (3*IL)TH ELEMENTS,
C           IL=1,2,..., NL.
C THE OTHER PARAMETERS ARE
C     IWL = INTEGER ARRAY OF DIMENSION 18*NDP USED
C           INTERNALLY AS A WORK AREA,
C     IWP = INTEGER ARRAY OF DIMENSION NDP USED
C           INTERNALLY AS A WORK AREA,
C     WK  = ARRAY OF DIMENSION NDP USED INTERNALLY AS A
C           WORK AREA.
C DECLARATION STATEMENTS
      IMPLICIT DOUBLE PRECISION (A-D,P-Z)
      DIMENSION   XD(NDP),YD(NDP),IPT(6*NDP-15),IPL(6*NDP),
     1            IWL(18*NDP),IWP(NDP),WK(NDP)
      DIMENSION   ITF(2)
      DATA  RATIO/1.0E-6/, NREP/100/, LUN/6/
C STATEMENT FUNCTIONS
      DSQF(U1,V1,U2,V2)=(U2-U1)**2+(V2-V1)**2
      SIDE(U1,V1,U2,V2,U3,V3)=(V3-V1)*(U2-U1)-(U3-U1)*(V2-V1)
C PRELIMINARY PROCESSING
   10 NDP0=NDP
      NDPM1=NDP0-1
      IF(NDP0.LT.4)       GO TO 90
C DETERMINES THE CLOSEST PAIR OF DATA POINTS AND THEIR MIDPOINT.
   20 DSQMN=DSQF(XD(1),YD(1),XD(2),YD(2))
      IPMN1=1
      IPMN2=2
      DO 22  IP1=1,NDPM1
        X1=XD(IP1)
        Y1=YD(IP1)
        IP1P1=IP1+1
        DO 21  IP2=IP1P1,NDP0
          DSQI=DSQF(X1,Y1,XD(IP2),YD(IP2))
          IF(DSQI.EQ.0.0)      GO TO 91
          IF(DSQI.GE.DSQMN)    GO TO 21
          DSQMN=DSQI
          IPMN1=IP1
          IPMN2=IP2
   21   CONTINUE
   22 CONTINUE
      DSQ12=DSQMN
      XDMP=(XD(IPMN1)+XD(IPMN2))/2.0
      YDMP=(YD(IPMN1)+YD(IPMN2))/2.0
C SORTS THE OTHER (NDP-2) DATA POINTS IN ASCENDING ORDER OF
C DISTANCE FROM THE MIDPOINT AND STORES THE SORTED DATA POINT
C NUMBERS IN THE IWP ARRAY.
   30 JP1=2
      DO 31  IP1=1,NDP0
        IF(IP1.EQ.IPMN1.OR.IP1.EQ.IPMN2)      GO TO 31
        JP1=JP1+1
        IWP(JP1)=IP1
        WK(JP1)=DSQF(XDMP,YDMP,XD(IP1),YD(IP1))
   31 CONTINUE
      DO 33  JP1=3,NDPM1
        DSQMN=WK(JP1)
        JPMN=JP1
        DO 32  JP2=JP1,NDP0
          IF(WK(JP2).GE.DSQMN)      GO TO 32
          DSQMN=WK(JP2)
          JPMN=JP2
   32   CONTINUE
        ITS=IWP(JP1)
        IWP(JP1)=IWP(JPMN)
        IWP(JPMN)=ITS
        WK(JPMN)=WK(JP1)
   33 CONTINUE
C IF NECESSARY, MODIFIES THE ORDERING IN SUCH A WAY THAT THE
C FIRST THREE DATA POINTS ARE NOT COLLINEAR.
   35 AR=DSQ12*RATIO
      X1=XD(IPMN1)
      Y1=YD(IPMN1)
      DX21=XD(IPMN2)-X1
      DY21=YD(IPMN2)-Y1
      DO 36  JP=3,NDP0
        IP=IWP(JP)
        IF(ABS((YD(IP)-Y1)*DX21-(XD(IP)-X1)*DY21).GT.AR)
     1               GO TO 37
   36 CONTINUE
      GO TO 92
   37 IF(JP.EQ.3)    GO TO 40
      JPMX=JP
      JP=JPMX+1
      DO 38  JPC=4,JPMX
        JP=JP-1
        IWP(JP)=IWP(JP-1)
   38 CONTINUE
      IWP(3)=IP
C FORMS THE FIRST TRIANGLE.  STORES POINT NUMBERS OF THE VER-
C TEXES OF THE TRIANGLE IN THE IPT ARRAY, AND STORES POINT NUM-
C BERS OF THE BORDER LINE SEGMENTS AND THE TRIANGLE NUMBER IN
C THE IPL ARRAY.
   40 IP1=IPMN1
      IP2=IPMN2
      IP3=IWP(3)
      IF(SIDE(XD(IP1),YD(IP1),XD(IP2),YD(IP2),XD(IP3),YD(IP3))
     1     .GE.0.0)       GO TO 41
      IP1=IPMN2
      IP2=IPMN1
   41 NT0=1
      NTT3=3
      IPT(1)=IP1
      IPT(2)=IP2
      IPT(3)=IP3
      NL0=3
      NLT3=9
      IPL(1)=IP1
      IPL(2)=IP2
      IPL(3)=1
      IPL(4)=IP2
      IPL(5)=IP3
      IPL(6)=1
      IPL(7)=IP3
      IPL(8)=IP1
      IPL(9)=1
C ADDS THE REMAINING (NDP-3) DATA POINTS, ONE BY ONE.
   50 DO 79  JP1=4,NDP0
        IP1=IWP(JP1)
        X1=XD(IP1)
        Y1=YD(IP1)
C - DETERMINES THE VISIBLE BORDER LINE SEGMENTS.
        IP2=IPL(1)
        JPMN=1
        DXMN=XD(IP2)-X1
        DYMN=YD(IP2)-Y1
        DSQMN=DXMN**2+DYMN**2
        ARMN=DSQMN*RATIO
        JPMX=1
        DXMX=DXMN
        DYMX=DYMN
        DSQMX=DSQMN
        ARMX=ARMN
        DO 52  JP2=2,NL0
          IP2=IPL(3*JP2-2)
          DX=XD(IP2)-X1
          DY=YD(IP2)-Y1
          AR=DY*DXMN-DX*DYMN
          IF(AR.GT.ARMN)       GO TO 51
          DSQI=DX**2+DY**2
          IF(AR.GE.(-ARMN).AND.DSQI.GE.DSQMN)      GO TO 51
          JPMN=JP2
          DXMN=DX
          DYMN=DY
          DSQMN=DSQI
          ARMN=DSQMN*RATIO
   51     AR=DY*DXMX-DX*DYMX
          IF(AR.LT.(-ARMX))    GO TO 52
          DSQI=DX**2+DY**2
          IF(AR.LE.ARMX.AND.DSQI.GE.DSQMX)    GO TO 52
          JPMX=JP2
          DXMX=DX
          DYMX=DY
          DSQMX=DSQI
          ARMX=DSQMX*RATIO
   52   CONTINUE
        IF(JPMX.LT.JPMN)  JPMX=JPMX+NL0
        NSH=JPMN-1
        IF(NSH.LE.0)      GO TO 60
C - SHIFTS (ROTATES) THE IPL ARRAY TO HAVE THE INVISIBLE BORDER
C - LINE SEGMENTS CONTAINED IN THE FIRST PART OF THE IPL ARRAY.
        NSHT3=NSH*3
        DO 53  JP2T3=3,NSHT3,3
          JP3T3=JP2T3+NLT3
          IPL(JP3T3-2)=IPL(JP2T3-2)
          IPL(JP3T3-1)=IPL(JP2T3-1)
          IPL(JP3T3)  =IPL(JP2T3)
   53   CONTINUE
        DO 54  JP2T3=3,NLT3,3
          JP3T3=JP2T3+NSHT3
          IPL(JP2T3-2)=IPL(JP3T3-2)
          IPL(JP2T3-1)=IPL(JP3T3-1)
          IPL(JP2T3)  =IPL(JP3T3)
   54   CONTINUE
        JPMX=JPMX-NSH
C - ADDS TRIANGLES TO THE IPT ARRAY, UPDATES BORDER LINE
C - SEGMENTS IN THE IPL ARRAY, AND SETS FLAGS FOR THE BORDER
C - LINE SEGMENTS TO BE REEXAMINED IN THE IWL ARRAY.
   60   JWL=0
        DO 64  JP2=JPMX,NL0
          JP2T3=JP2*3
          IPL1=IPL(JP2T3-2)
          IPL2=IPL(JP2T3-1)
          IT  =IPL(JP2T3)
C - - ADDS A TRIANGLE TO THE IPT ARRAY.
          NT0=NT0+1
          NTT3=NTT3+3
          IPT(NTT3-2)=IPL2
          IPT(NTT3-1)=IPL1
          IPT(NTT3)  =IP1
C - - UPDATES BORDER LINE SEGMENTS IN THE IPL ARRAY.
          IF(JP2.NE.JPMX)      GO TO 61
          IPL(JP2T3-1)=IP1
          IPL(JP2T3)  =NT0
   61     IF(JP2.NE.NL0)       GO TO 62
          NLN=JPMX+1
          NLNT3=NLN*3
          IPL(NLNT3-2)=IP1
          IPL(NLNT3-1)=IPL(1)
          IPL(NLNT3)  =NT0
C - - DETERMINES THE VERTEX THAT DOES NOT LIE ON THE BORDER
C - - LINE SEGMENTS.
   62     ITT3=IT*3
          IPTI=IPT(ITT3-2)
          IF(IPTI.NE.IPL1.AND.IPTI.NE.IPL2)   GO TO 63
          IPTI=IPT(ITT3-1)
          IF(IPTI.NE.IPL1.AND.IPTI.NE.IPL2)   GO TO 63
          IPTI=IPT(ITT3)
C - - CHECKS IF THE EXCHANGE IS NECESSARY.
   63     IF(IDXCHG(XD,YD,NDP,IP1,IPTI,IPL1,IPL2).EQ.0)     GO TO 64
C - - MODIFIES THE IPT ARRAY WHEN NECESSARY.
          IPT(ITT3-2)=IPTI
          IPT(ITT3-1)=IPL1
          IPT(ITT3)  =IP1
          IPT(NTT3-1)=IPTI
          IF(JP2.EQ.JPMX)      IPL(JP2T3)=IT
          IF(JP2.EQ.NL0.AND.IPL(3).EQ.IT)     IPL(3)=NT0
C - - SETS FLAGS IN THE IWL ARRAY.
          JWL=JWL+4
          IWL(JWL-3)=IPL1
          IWL(JWL-2)=IPTI
          IWL(JWL-1)=IPTI
          IWL(JWL)  =IPL2
   64   CONTINUE
        NL0=NLN
        NLT3=NLNT3
        NLF=JWL/2
        IF(NLF.EQ.0)      GO TO 79
C - IMPROVES TRIANGULATION.
   70   NTT3P3=NTT3+3
        DO 78  IREP=1,NREP
          DO 76  ILF=1,NLF
            ILFT2=ILF*2
            IPL1=IWL(ILFT2-1)
            IPL2=IWL(ILFT2)
C - - LOCATES IN THE IPT ARRAY TWO TRIANGLES ON BOTH SIDES OF
C - - THE FLAGGED LINE SEGMENT.
            NTF=0
            DO 71  ITT3R=3,NTT3,3
              ITT3=NTT3P3-ITT3R
              IPT1=IPT(ITT3-2)
              IPT2=IPT(ITT3-1)
              IPT3=IPT(ITT3)
              IF(IPL1.NE.IPT1.AND.IPL1.NE.IPT2.AND.
     1           IPL1.NE.IPT3)      GO TO 71
              IF(IPL2.NE.IPT1.AND.IPL2.NE.IPT2.AND.
     1           IPL2.NE.IPT3)      GO TO 71
              NTF=NTF+1
              ITF(NTF)=ITT3/3
              IF(NTF.EQ.2)     GO TO 72
   71       CONTINUE
            IF(NTF.LT.2)       GO TO 76
C - - DETERMINES THE VERTEXES OF THE TRIANGLES THAT DO NOT LIE
C - - ON THE LINE SEGMENT.
   72       IT1T3=ITF(1)*3
            IPTI1=IPT(IT1T3-2)
            IF(IPTI1.NE.IPL1.AND.IPTI1.NE.IPL2)    GO TO 73
            IPTI1=IPT(IT1T3-1)
            IF(IPTI1.NE.IPL1.AND.IPTI1.NE.IPL2)    GO TO 73
            IPTI1=IPT(IT1T3)
   73       IT2T3=ITF(2)*3
            IPTI2=IPT(IT2T3-2)
            IF(IPTI2.NE.IPL1.AND.IPTI2.NE.IPL2)    GO TO 74
            IPTI2=IPT(IT2T3-1)
            IF(IPTI2.NE.IPL1.AND.IPTI2.NE.IPL2)    GO TO 74
            IPTI2=IPT(IT2T3)
C - - CHECKS IF THE EXCHANGE IS NECESSARY.
   74       IF(IDXCHG(XD,YD,NDP,IPTI1,IPTI2,IPL1,IPL2).EQ.0)
     1         GO TO 76
C - - MODIFIES THE IPT ARRAY WHEN NECESSARY.
            IPT(IT1T3-2)=IPTI1
            IPT(IT1T3-1)=IPTI2
            IPT(IT1T3)  =IPL1
            IPT(IT2T3-2)=IPTI2
            IPT(IT2T3-1)=IPTI1
            IPT(IT2T3)  =IPL2
C - - SETS NEW FLAGS.
            JWL=JWL+8
            IWL(JWL-7)=IPL1
            IWL(JWL-6)=IPTI1
            IWL(JWL-5)=IPTI1
            IWL(JWL-4)=IPL2
            IWL(JWL-3)=IPL2
            IWL(JWL-2)=IPTI2
            IWL(JWL-1)=IPTI2
            IWL(JWL)  =IPL1
            DO 75  JLT3=3,NLT3,3
              IPLJ1=IPL(JLT3-2)
              IPLJ2=IPL(JLT3-1)
              IF((IPLJ1.EQ.IPL1.AND.IPLJ2.EQ.IPTI2).OR.
     1           (IPLJ2.EQ.IPL1.AND.IPLJ1.EQ.IPTI2))
     2                         IPL(JLT3)=ITF(1)
              IF((IPLJ1.EQ.IPL2.AND.IPLJ2.EQ.IPTI1).OR.
     1           (IPLJ2.EQ.IPL2.AND.IPLJ1.EQ.IPTI1))
     2                         IPL(JLT3)=ITF(2)
   75       CONTINUE
   76     CONTINUE
          NLFC=NLF
          NLF=JWL/2
          IF(NLF.EQ.NLFC)      GO TO 79
C - - RESETS THE IWL ARRAY FOR THE NEXT ROUND.
          JWL=0
          JWL1MN=(NLFC+1)*2
          NLFT2=NLF*2
          DO 77  JWL1=JWL1MN,NLFT2,2
            JWL=JWL+2
            IWL(JWL-1)=IWL(JWL1-1)
            IWL(JWL)  =IWL(JWL1)
   77     CONTINUE
          NLF=JWL/2
   78   CONTINUE
   79 CONTINUE
C REARRANGES THE IPT ARRAY SO THAT THE VERTEXES OF EACH TRIANGLE
C ARE LISTED COUNTER-CLOCKWISE.
   80 DO 81  ITT3=3,NTT3,3
        IP1=IPT(ITT3-2)
        IP2=IPT(ITT3-1)
        IP3=IPT(ITT3)
        IF(SIDE(XD(IP1),YD(IP1),XD(IP2),YD(IP2),XD(IP3),YD(IP3))
     1       .GE.0.0)     GO TO 81
        IPT(ITT3-2)=IP2
        IPT(ITT3-1)=IP1
   81 CONTINUE
      NT=NT0
      NL=NL0
      RETURN
C ERROR EXIT
   90 WRITE (LUN,2090)  NDP0
      GO TO 93
   91 WRITE (LUN,2091)  NDP0,IP1,IP2,X1,Y1
      GO TO 93
   92 WRITE (LUN,2092)  NDP0
   93 WRITE (LUN,2093)
      NT=0
      RETURN
C FORMAT STATEMENTS
 2090 FORMAT(1X/23H ***   NDP LESS THAN 4./8H   NDP =,I5)
 2091 FORMAT(1X/29H ***   IDENTICAL DATA POINTS./
     1   8H   NDP =,I5,5X,5HIP1 =,I5,5X,5HIP2 =,I5,
     2   5X,4HXD =,E12.4,5X,4HYD =,E12.4)
 2092 FORMAT(1X/33H ***   ALL COLLINEAR DATA POINTS./
     1   8H   NDP =,I5)
 2093 FORMAT(35H ERROR DETECTED IN ROUTINE   IDTANG/)
      END

      FUNCTION  IDXCHG(X,Y,NDP,I1,I2,I3,I4)                                 ID018560
C THIS FUNCTION DETERMINES WHETHER OR NOT THE EXCHANGE OF TWO
C TRIANGLES IS NECESSARY ON THE BASIS OF MAX-MIN-ANGLE CRITERION
C BY C. L. LAWSON.
C THE INPUT PARAMETERS ARE
C     X,Y = ARRAYS CONTAINING THE COORDINATES OF THE DATA
C           POINTS,
C     I1,I2,I3,I4 = POINT NUMBERS OF FOUR POINTS P1, P2,
C           P3, AND P4 THAT FORM A QUADRILATERAL WITH P3
C           AND P4 CONNECTED DIAGONALLY.
C THIS FUNCTION RETURNS AN INTEGER VALUE 1 (ONE) WHEN AN EX-
C CHANGE IS NECESSARY, AND 0 (ZERO) OTHERWISE.
C DECLARATION STATEMENTS
      IMPLICIT DOUBLE PRECISION (A-D,P-Z)
      DIMENSION   X(NDP),Y(NDP)
      EQUIVALENCE (C2SQ,C1SQ),(A3SQ,B2SQ),(B3SQ,A1SQ),
     1            (A4SQ,B1SQ),(B4SQ,A2SQ),(C4SQ,C3SQ)
C PRELIMINARY PROCESSING
   10 X1=X(I1)
      Y1=Y(I1)
      X2=X(I2)
      Y2=Y(I2)
      X3=X(I3)
      Y3=Y(I3)
      X4=X(I4)
      Y4=Y(I4)
C CALCULATION
   20 IDX=0
      U3=(Y2-Y3)*(X1-X3)-(X2-X3)*(Y1-Y3)
      U4=(Y1-Y4)*(X2-X4)-(X1-X4)*(Y2-Y4)
      IF(U3*U4.LE.0.0)    GO TO 30
      U1=(Y3-Y1)*(X4-X1)-(X3-X1)*(Y4-Y1)
      U2=(Y4-Y2)*(X3-X2)-(X4-X2)*(Y3-Y2)
      A1SQ=(X1-X3)**2+(Y1-Y3)**2
      B1SQ=(X4-X1)**2+(Y4-Y1)**2
      C1SQ=(X3-X4)**2+(Y3-Y4)**2
      A2SQ=(X2-X4)**2+(Y2-Y4)**2
      B2SQ=(X3-X2)**2+(Y3-Y2)**2
      C3SQ=(X2-X1)**2+(Y2-Y1)**2
      S1SQ=U1*U1/(C1SQ*DMAX1(A1SQ,B1SQ))
      S2SQ=U2*U2/(C2SQ*DMAX1(A2SQ,B2SQ))
      S3SQ=U3*U3/(C3SQ*DMAX1(A3SQ,B3SQ))
      S4SQ=U4*U4/(C4SQ*DMAX1(A4SQ,B4SQ))
      IF(DMIN1(S1SQ,S2SQ).LT.DMIN1(S3SQ,S4SQ))     IDX=1
   30 IDXCHG=IDX
      RETURN
      END
C      ALGORITHM 751, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE,
C      VOL. 22, NO. 1, March, 1996, P.  1--8.
C      ####### With remark from renka (to appear) 4/dec/1998
C
C      modifications for R:
C        REAL -> DOUBLE PRECISION  albrecht.gebhardt@uni-klu.ac.at
C
      SUBROUTINE ADDCST (NCC,LCC,N,X,Y, LWK,IWK,LIST,LPTR,
     .                   LEND, IER)
      INTEGER NCC, LCC(*), N, LWK, IWK(LWK), LIST(*),
     .        LPTR(*), LEND(N), IER
      DOUBLE PRECISION X(N), Y(N)
C
C***********************************************************
C
C                                               From TRIPACK
C                                            Robert J. Renka
C                                  Dept. of Computer Science
C                                       Univ. of North Texas
C                                           renka@cs.unt.edu
C                                                   11/12/94
C
C   This subroutine provides for creation of a constrained
C Delaunay triangulation which, in some sense, covers an
C arbitrary connected region R rather than the convex hull
C of the nodes.  This is achieved simply by forcing the
C presence of certain adjacencies (triangulation arcs) cor-
C responding to constraint curves.  The union of triangles
C coincides with the convex hull of the nodes, but triangles
C in R can be distinguished from those outside of R.  The
C only modification required to generalize the definition of
C the Delaunay triangulation is replacement of property 5
C (refer to TRMESH) by the following:
C
C  5









































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































')  If a node is contained in the interior of the cir-C       cumcircle of a triangle, then every interior pointC       of the triangle is separated from the node by aC       constraint arc.CC   In order to be explicit, we make the following defini-C tions.  A constraint region is the open interior of aC simple closed positively oriented polygonal curve definedC by an ordered sequence of three or more distinct nodesC (constraint nodes) P(1),P(2),...,P(K), such that P(I) isC adjacent to P(I+1) for I = 1,...,K with P(K+1) = P(1).C Thus, the constraint region is on the left (and may haveC nonfinite area) as the sequence of constraint nodes isC traversed in the specified order.  The constraint regionsC must not contain nodes and must not overlap.  The regionC R is the convex hull of the nodes with constraint regionsC excluded.CC   Note that the terms boundary node and boundary arc areC reserved for nodes and arcs on the boundary of the convexC hull of the nodes.CC   The algorithm is as follows:  given a triangulationC which includes one or more sets of constraint nodes, theC corresponding adjacencies (constraint arcs) are forced toC be present (Subroutine EDGE).  Any additional new arcsC required are chosen to be locally optimal (satisfy theC modified circumcircle property).CCC On input:CC       NCC = Number of constraint curves (constraint re-C             gions).  NCC .GE. 0.CC       LCC = Array of length NCC (or dummy array of lengthC             1 if NCC = 0) containing the index (for X, Y,C             and LEND) of the first node of constraint I inC             LCC(I) for I = 1 to NCC.  Thus, constraint IC             contains K = LCC(I+1) - LCC(I) nodes, K .GE.C             3, stored in (X,Y) locations LCC(I), ...,C             LCC(I+1)-1, where LCC(NCC+1) = N+1.CC       N = Number of nodes in the triangulation, includingC           constraint nodes.  N .GE. 3.CC       X,Y = Arrays of length N containing the coordinatesC             of the nodes with non-constraint nodes in theC             first LCC(1)-1 locations, followed by NCC se-C             quences of constraint nodes.  Only one ofC             these sequences may be specified in clockwiseC             order to represent an exterior constraintC             curve (a constraint region with nonfiniteC             area).CC The above parameters are not altered by this routine.CC       LWK = Length of IWK.  This must be at least 2*NIC             where NI is the maximum number of arcs whichC             intersect a constraint arc to be added.  NIC             is bounded by N-3.CC       IWK = Integer work array of length LWK (used byC             Subroutine EDGE to add constraint arcs).CC       LIST,LPTR,LEND = Data structure defining the trian-C                        gulation.  Refer to SubroutineC                        TRMESH.CC On output:CC       LWK = Required length of IWK unless IER = 1 or IER =C             3.  In the case of IER = 1, LWK is not alteredC             from its input value.CC       IWK = Array containing the endpoint indexes of theC             new arcs which were swapped in by the lastC             call to Subroutine EDGE.CC       LIST,LPTR,LEND = Triangulation data structure withC                        all constraint arcs present unlessC                        IER .NE. 0.  These arrays are notC                        altered if IER = 1.CC       IER = Error indicator:C             IER = 0 if no errors were encountered.C             IER = 1 if NCC, N, or an LCC entry is outsideC                     its valid range, or LWK .LT. 0 onC                     input.C             IER = 2 if more space is required in IWK.C             IER = 3 if the triangulation data structure isC                     invalid, or failure (in EDGE or OPTIM)C                     was caused by collinear nodes on theC                     convex hull boundary.  An error mes-C                     sage is written to logical unit 6 inC                     this case.C             IER = 4 if intersecting constraint arcs wereC                     encountered.C             IER = 5 if a constraint region contains aC                     node.CC Modules required by ADDCST:  EDGE, LEFT, LSTPTR, OPTIM,C                                SWAP, SWPTSTCC Intrinsic functions called by ADDCST:  ABS, MAXCC***********************************************************C      INTEGER I, IFRST, ILAST, K, KBAK, KFOR, KN, LCCIP1,     .        LP, LPB, LPF, LPL, LW, LWD2, N1, N2      LWD2 = LWK/2CC Test for errors in input parameters.C      IER = 1      IF (NCC .LT. 0  .OR.  LWK .LT. 0) RETURN      IF (NCC .EQ. 0) THEN        IF (N .LT. 3) RETURN        LWK = 0        GO TO 9      ELSE        LCCIP1 = N+1        DO 1 I = NCC,1,-1          IF (LCCIP1 - LCC(I) .LT. 3) RETURN          LCCIP1 = LCC(I)    1     CONTINUE        IF (LCCIP1 .LT. 1) RETURN      ENDIFCC Force the presence of constraint arcs.  The outer loop isC   on constraints in reverse order.  IFRST and ILAST areC   the first and last nodes of constraint I.C      LWK = 0      IFRST = N+1      DO 3 I = NCC,1,-1        ILAST = IFRST - 1        IFRST = LCC(I)CC   Inner loop on constraint arcs N1-N2 in constraint I.C        N1 = ILAST        DO 2 N2 = IFRST,ILAST          LW = LWD2          CALL EDGE (N1,N2,X,Y, LW,IWK,LIST,LPTR,LEND, IER)          LWK = MAX(LWK,2*LW)          IF (IER .EQ. 4) IER = 3          IF (IER .NE. 0) RETURN          N1 = N2    2     CONTINUE    3   CONTINUECC Test for errors.  The outer loop is on constraint I withC   first and last nodes IFRST and ILAST, and the inner loopC   is on constraint nodes K with (KBAK,K,KFOR) a subse-C   quence of constraint I.C      IER = 4      IFRST = N+1      DO 8 I = NCC,1,-1        ILAST = IFRST - 1        IFRST = LCC(I)        KBAK = ILAST        DO 7 K = IFRST,ILAST          KFOR = K + 1          IF (K .EQ. ILAST) KFOR = IFRSTCC   Find the LIST pointers LPF and LPB of KFOR and KBAK asC     neighbors of K.C          LPF = 0          LPB = 0          LPL = LEND(K)          LP = LPLC    4     LP = LPTR(LP)            KN = ABS(LIST(LP))            IF (KN .EQ. KFOR) LPF = LP            IF (KN .EQ. KBAK) LPB = LP            IF (LP .NE. LPL) GO TO 4CC   A pair of intersecting constraint arcs was encounteredC     if and only if a constraint arc is missing (introduc-C     tion of the second caused the first to be swapped out).C          IF (LPF .EQ. 0  .OR.  LPB .EQ. 0) RETURNCC   Loop on neighbors KN of node K which follow KFOR andC     precede KBAK.  The constraint region contains no nodesC     if and only if all such nodes KN are in constraint I.C          LP = LPF    5     LP = LPTR(LP)            IF (LP .EQ. LPB) GO TO 6            KN = ABS(LIST(LP))            IF (KN .LT. IFRST  .OR.  KN .GT. ILAST) GO TO 10            GO TO 5CC   Bottom of loop.C    6     KBAK = K    7     CONTINUE    8   CONTINUECC No errors encountered.C    9 IER = 0      RETURNCC A constraint region contains a node.C   10 IER = 5      RETURN      END      SUBROUTINE ADDNOD (K,XK,YK,IST,NCC, LCC,N,X,Y,LIST,     .                   LPTR,LEND,LNEW, IER)      INTEGER K, IST, NCC, LCC(*), N, LIST(*), LPTR(*),     .        LEND(*), LNEW, IER      DOUBLE PRECISION XK, YK, X(*), Y(*)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   06/27/98CC   Given a triangulation of N nodes in the plane created byC Subroutine TRMESH or TRMSHR, this subroutine updates theC data structure with the addition of a new node in positionC K.  If node K is inserted into X and Y (K .LE. N) ratherC than appended (K = N+1), then a corresponding insertionC must be performed in any additional arrays associatedC with the nodes.  For example, an array of data values ZC must be shifted down to open up position K for the newC value:  set Z(I+1) to Z(I) for I = N,N-1,...,K.  ForC optimal efficiency, new nodes should be appended wheneverC possible.  Insertion is necessary, however, to add a non-C constraint node when constraints are present (refer toC Subroutine ADDCST).CC   Note that a constraint node cannot be added by thisC routine.  In order to insert a constraint node, it isC necessary to add the node with no constraints presentC (call this routine with NCC = 0), update LCC by increment-C ing the appropriate entries, and then create (or restore)C the constraints by a call to ADDCST.CC   The algorithm consists of the following steps:  node KC is located relative to the triangulation (TRFIND), itsC index is added to the data structure (INTADD or BDYADD),C and a sequence of swaps (SWPTST and SWAP) are applied toC the arcs opposite K so that all arcs incident on node KC and opposite node K (excluding constraint arcs) are local-C ly optimal (satisfy the circumcircle test).  Thus, if aC (constrained) Delaunay triangulation is input, a (con-C strained) Delaunay triangulation will result.  All indexesC are incremented as necessary for an insertion.CCC On input:CC       K = Nodal index (index for X, Y, and LEND) of theC           new node to be added.  1 .LE. K .LE. LCC(1).C           (K .LE. N+1 if NCC=0).CC       XK,YK = Cartesian coordinates of the new node (to beC               stored in X(K) and Y(K)).  The node must notC               lie in a constraint region.CC       IST = Index of a node at which TRFIND begins theC             search.  Search time depends on the proximityC             of this node to node K.  1 .LE. IST .LE. N.CC       NCC = Number of constraint curves.  NCC .GE. 0.CC The above parameters are not altered by this routine.CC       LCC = List of constraint curve starting indexes (orC             dummy array of length 1 if NCC = 0).  Refer toC             Subroutine ADDCST.CC       N = Number of nodes in the triangulation before K isC           added.  N .GE. 3.  Note that N will be incre-C           mented following the addition of node K.CC       X,Y = Arrays of length at least N+1 containing theC             Cartesian coordinates of the nodes in theC             first N positions with non-constraint nodesC             in the first LCC(1)-1 locations if NCC > 0.CC       LIST,LPTR,LEND,LNEW = Data structure associated withC                             the triangulation of nodes 1C                             to N.  The arrays must haveC                             sufficient length for N+1C                             nodes.  Refer to TRMESH.CC On output:CC       LCC = List of constraint curve starting indexes in-C             cremented by 1 to reflect the insertion of KC             unless NCC = 0 or (IER .NE. 0 and IER .NE.C             -4).CC       N = Number of nodes in the triangulation including KC           unless IER .NE. 0 and IER .NE. -4.  Note thatC           all comments refer to the input value of N.CC       X,Y = Arrays updated with the insertion of XK and YKC             in the K-th positions (node I+1 was node I be-C             fore the insertion for I = K to N if K .LE. N)C             unless IER .NE. 0 and IER .NE. -4.CC       LIST,LPTR,LEND,LNEW = Data structure updated withC                             the addition of node K unlessC                             IER .NE. 0 and IER .NE. -4.CC       IER = Error indicator:C             IER =  0 if no errors were encountered.C             IER = -1 if K, IST, NCC, N, or an LCC entry isC                      outside its valid range on input.C             IER = -2 if all nodes (including K) are col-C                      linear.C             IER =  L if nodes L and K coincide for some L.C             IER = -3 if K lies in a constraint region.C             IER = -4 if an error flag is returned by SWAPC                      implying that the triangulationC                      (geometry) was bad on input.CC             The errors conditions are tested in the orderC             specified.CC Modules required by ADDNOD:  BDYADD, CRTRI, INDXCC,C                                INSERT, INTADD, JRAND,C                                LEFT, LSTPTR, SWAP,C                                SWPTST, TRFINDCC Intrinsic function called by ADDNOD:  ABSCC***********************************************************C      INTEGER INDXCC, LSTPTR      INTEGER I, I1, I2, I3, IBK, IO1, IO2, IN1, KK, L,     .        LCCIP1, LP, LPF, LPO1, NM1      LOGICAL CRTRI, SWPTST      KK = KCC Test for an invalid input parameter.C      IF (KK .LT. 1  .OR.  IST .LT. 1  .OR.  IST .GT. N     .    .OR.  NCC .LT. 0  .OR.  N .LT. 3) GO TO 7      LCCIP1 = N+1      DO 1 I = NCC,1,-1        IF (LCCIP1-LCC(I) .LT. 3) GO TO 7        LCCIP1 = LCC(I)    1   CONTINUE      IF (KK .GT. LCCIP1) GO TO 7CC Find a triangle (I1,I2,I3) containing K or the rightmostC   (I1) and leftmost (I2) visible boundary nodes as viewedC   from node K.C      CALL TRFIND (IST,XK,YK,N,X,Y,LIST,LPTR,LEND, I1,I2,I3)CC Test for collinear nodes, duplicate nodes, and K lying inC   a constraint region.C      IF (I1 .EQ. 0) GO TO 8      IF (I3 .NE. 0) THEN        L = I1        IF (XK .EQ. X(L)  .AND.  YK .EQ. Y(L)) GO TO 9        L = I2        IF (XK .EQ. X(L)  .AND.  YK .EQ. Y(L)) GO TO 9        L = I3        IF (XK .EQ. X(L)  .AND.  YK .EQ. Y(L)) GO TO 9        IF (NCC .GT. 0  .AND.  CRTRI(NCC,LCC,I1,I2,I3) )     .    GO TO 10      ELSECC   K is outside the convex hull of the nodes and lies in aC     constraint region iff an exterior constraint curve isC     present.C        IF (NCC .GT. 0  .AND.  INDXCC(NCC,LCC,N,LIST,LEND)     .      .NE. 0) GO TO 10      ENDIFCC No errors encountered.C      IER = 0      NM1 = N      N = N + 1      IF (KK .LT. N) THENCC Open a slot for K in X, Y, and LEND, and increment allC   nodal indexes which are greater than or equal to K.C   Note that LIST, LPTR, and LNEW are not yet updated withC   either the neighbors of K or the edges terminating on K.C        DO 2 IBK = NM1,KK,-1          X(IBK+1) = X(IBK)          Y(IBK+1) = Y(IBK)          LEND(IBK+1) = LEND(IBK)    2     CONTINUE        DO 3 I = 1,NCC          LCC(I) = LCC(I) + 1    3     CONTINUE        L = LNEW - 1        DO 4 I = 1,L          IF (LIST(I) .GE. KK) LIST(I) = LIST(I) + 1          IF (LIST(I) .LE. -KK) LIST(I) = LIST(I) - 1    4     CONTINUE        IF (I1 .GE. KK) I1 = I1 + 1        IF (I2 .GE. KK) I2 = I2 + 1        IF (I3 .GE. KK) I3 = I3 + 1      ENDIFCC Insert K into X and Y, and update LIST, LPTR, LEND, andC   LNEW with the arcs containing node K.C      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 )      ENDIFCC Initialize variables for optimization of the triangula-C   tion.C      LP = LEND(KK)      LPF = LPTR(LP)      IO2 = LIST(LPF)      LPO1 = LPTR(LPF)      IO1 = ABS(LIST(LPO1))CC Begin loop:  find the node opposite K.C    5 LP = LSTPTR(LEND(IO1),IO2,LIST,LPTR)        IF (LIST(LP) .LT. 0) GO TO 6        LP = LPTR(LP)        IN1 = ABS(LIST(LP))        IF ( CRTRI(NCC,LCC,IO1,IO2,IN1) ) GO TO 6CC Swap test:  if a swap occurs, two new arcs areC             opposite K and must be tested.C        IF ( .NOT. SWPTST(IN1,KK,IO1,IO2,X,Y) ) GO TO 6        CALL SWAP (IN1,KK,IO1,IO2, LIST,LPTR,LEND, LPO1)        IF (LPO1 .EQ. 0) GO TO 11        IO1 = IN1        GO TO 5CC No swap occurred.  Test for termination and resetC   IO2 and IO1.C    6   IF (LPO1 .EQ. LPF  .OR.  LIST(LPO1) .LT. 0) RETURN        IO2 = IO1        LPO1 = LPTR(LPO1)        IO1 = ABS(LIST(LPO1))        GO TO 5CC A parameter is outside its valid range on input.C    7 IER = -1      RETURNCC All nodes are collinear.C    8 IER = -2      RETURNCC Nodes L and K coincide.C    9 IER = L      RETURNCC Node K lies in a constraint region.C   10 IER = -3      RETURNCC Zero pointer returned by SWAP.C   11 IER = -4      RETURN      END      DOUBLE PRECISION FUNCTION AREAP (X,Y,NB,NODES)      INTEGER NB, NODES(NB)      DOUBLE PRECISION X(*), Y(*)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   09/21/90CC   Given a sequence of NB points in the plane, this func-C tion computes the signed area bounded by the closed poly-C gonal curve which passes through the points in theC specified order.  Each simple closed curve is positivelyC oriented (bounds positive area) if and only if the pointsC are specified in counterclockwise order.  The last pointC of the curve is taken to be the first point specified, andC this point should therefore not be specified twice.CC   The area of a triangulation may be computed by callingC AREAP with values of NB and NODES determined by SubroutineC BNODES.CCC On input:CC       X,Y = Arrays of length N containing the CartesianC             coordinates of a set of points in the planeC             for some N .GE. NB.CC       NB = Length of NODES.CC       NODES = Array of length NB containing the orderedC               sequence of nodal indexes (in the rangeC               1 to N) which define the polygonal curve.CC Input parameters are not altered by this function.CC On output:CC       AREAP = Signed area bounded by the polygonal curve,C              or zero if NB < 3.CC Modules required by AREAP:  NoneCC***********************************************************C      INTEGER I, ND1, ND2, NNB      DOUBLE PRECISION ACC Local parameters:CC A =       Partial sum of signed (and doubled) trapezoidC             areasC I =       DO-loop and NODES indexC ND1,ND2 = Elements of NODESC NNB =     Local copy of NBC      NNB = NB      A = 0.      IF (NNB .LT. 3) GO TO 2      ND2 = NODES(NNB)CC Loop on line segments NODES(I-1) -> NODES(I), whereC   NODES(0) = NODES(NB), adding twice the signed trapezoidC   areas (integrals of the linear interpolants) to A.C      DO 1 I = 1,NNB        ND1 = ND2        ND2 = NODES(I)        A = A + (X(ND2)-X(ND1))*(Y(ND1)+Y(ND2))    1   CONTINUECC A contains twice the negative signed area of the region.C    2 AREAP = -A/2.      RETURN      END      SUBROUTINE BDYADD (KK,I1,I2, LIST,LPTR,LEND,LNEW )      INTEGER KK, I1, I2, LIST(*), LPTR(*), LEND(*), LNEWCC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   02/22/91CC   This subroutine adds a boundary node to a triangulationC of a set of points in the plane.  The data structure isC updated with the insertion of node KK, but no optimizationC is performed.CCC On input:CC       KK = Index of a node to be connected to the sequenceC            of all visible boundary nodes.  KK .GE. 1 andC            KK must not be equal to I1 or I2.CC       I1 = First (rightmost as viewed from KK) boundaryC            node in the triangulation which is visible fromC            node KK (the line segment KK-I1 intersects noC            arcs.CC       I2 = Last (leftmost) boundary node which is visibleC            from node KK.  I1 and I2 may be determined byC            Subroutine TRFIND.CC The above parameters are not altered by this routine.CC       LIST,LPTR,LEND,LNEW = Triangulation data structureC                             created by TRMESH or TRMSHR.C                             Nodes I1 and I2 must be in-C                             cluded in the triangulation.CC On output:CC       LIST,LPTR,LEND,LNEW = Data structure updated withC                             the addition of node KK.  NodeC                             KK is connected to I1, I2, andC                             all boundary nodes in between.CC Module required by BDYADD:  INSERTCC***********************************************************C      INTEGER K, LP, LSAV, N1, N2, NEXT, NSAV      K = KK      N1 = I1      N2 = I2CC Add K as the last neighbor of N1.C      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 = NEXTCC Loop on the remaining boundary nodes between N1 and N2,C   adding K as the first neighbor.C    1 LP = LEND(NEXT)        CALL INSERT (K,LP,LIST,LPTR,LNEW)        IF (NEXT .EQ. N2) GO TO 2        NEXT = -LIST(LP)        LIST(LP) = NEXT        GO TO 1CC Add the boundary nodes between N1 and N2 as neighborsC   of node K.C    2 LSAV = LNEW      LIST(LNEW) = N1      LPTR(LNEW) = LNEW + 1      LNEW = LNEW + 1      NEXT = NSAVC    3 IF (NEXT .EQ. N2) GO TO 4        LIST(LNEW) = NEXT        LPTR(LNEW) = LNEW + 1        LNEW = LNEW + 1        LP = LEND(NEXT)        NEXT = LIST(LP)        GO TO 3C    4 LIST(LNEW) = -N2      LPTR(LNEW) = LSAV      LEND(K) = LNEW      LNEW = LNEW + 1      RETURN      END      SUBROUTINE BNODES (N,LIST,LPTR,LEND, NODES,NB,NA,NT)      INTEGER N, LIST(*), LPTR(*), LEND(N), NODES(*), NB,     .        NA, NTCC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   09/01/88CC   Given a triangulation of N points in the plane, thisC subroutine returns an array containing the indexes, inC counterclockwise order, of the nodes on the boundary ofC the convex hull of the set of points.CCC On input:CC       N = Number of nodes in the triangulation.  N .GE. 3.CC       LIST,LPTR,LEND = Data structure defining the trian-C                        gulation.  Refer to SubroutineC                        TRMESH.CC The above parameters are not altered by this routine.CC       NODES = Integer array of length at least NBC               (NB .LE. N).CC On output:CC       NODES = Ordered sequence of boundary node indexesC               in the range 1 to N.CC       NB = Number of boundary nodes.CC       NA,NT = Number of arcs and triangles, respectively,C               in the triangulation.CC Modules required by BNODES:  NoneCC***********************************************************C      INTEGER K, LP, N0, NSTCC Set NST to the first boundary node encountered.C      NST = 1    1 LP = LEND(NST)        IF (LIST(LP) .LT. 0) GO TO 2        NST = NST + 1        GO TO 1CC Initialization.C    2 NODES(1) = NST      K = 1      N0 = NSTCC Traverse the boundary in counterclockwise order.C    3 LP = LEND(N0)        LP = LPTR(LP)        N0 = LIST(LP)        IF (N0 .EQ. NST) GO TO 4        K = K + 1        NODES(K) = N0        GO TO 3CC Termination.C    4 NB = K      NT = 2*N - NB - 2      NA = NT + N - 1      RETURN      END      SUBROUTINE CIRCUM (X1,Y1,X2,Y2,X3,Y3,RATIO, XC,YC,CR,     .                   SA,AR)      LOGICAL RATIO      DOUBLE PRECISION X1, Y1, X2, Y2, X3, Y3, XC, YC, CR,      .           SA, ARCC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   12/10/96CC   Given three vertices defining a triangle, this subrou-C tine returns the circumcenter, circumradius, signedC triangle area, and, optionally, the aspect ratio of theC triangle.CCC On input:CC       X1,...,Y3 = Cartesian coordinates of the vertices.CC       RATIO = Logical variable with value TRUE if and onlyC               if the aspect ratio is to be computed.CC Input parameters are not altered by this routine.CC On output:CC       XC,YC = Cartesian coordinates of the circumcenterC               (center of the circle defined by the threeC               points) unless SA = 0, in which XC and YCC               are not altered.CC       CR = Circumradius (radius of the circle defined byC            the three points) unless SA = 0 (infiniteC            radius), in which case CR is not altered.CC       SA = Signed triangle area with positive value ifC            and only if the vertices are specified inC            counterclockwise order:  (X3,Y3) is strictlyC            to the left of the directed line from (X1,Y1)C            toward (X2,Y2).CC       AR = Aspect ratio r/CR, where r is the radius of theC            inscribed circle, unless RATIO = FALSE, inC            which case AR is not altered.  AR is in theC            range 0 to .5, with value 0 iff SA = 0 andC            value .5 iff the vertices define an equilateralC            triangle.CC Modules required by CIRCUM:  NoneCC Intrinsic functions called by CIRCUM:  ABS, SQRTCC***********************************************************C      INTEGER I      DOUBLE PRECISION DS(3), FX, FY, U(3), V(3)CC Set U(K) and V(K) to the x and y components, respectively,C   of the directed edge opposite vertex K.C      U(1) = X3 - X2      U(2) = X1 - X3      U(3) = X2 - X1      V(1) = Y3 - Y2      V(2) = Y1 - Y3      V(3) = Y2 - Y1CC Set SA to the signed triangle area.C      SA = (U(1)*V(2) - U(2)*V(1))/2.      IF (SA .EQ. 0.) THEN        IF (RATIO) AR = 0.        RETURN      ENDIFCC Set DS(K) to the squared distance from the origin toC   vertex K.C      DS(1) = X1*X1 + Y1*Y1      DS(2) = X2*X2 + Y2*Y2      DS(3) = X3*X3 + Y3*Y3CC Compute factors of XC and YC.C      FX = 0.      FY = 0.      DO 1 I = 1,3        FX = FX - DS(I)*V(I)        FY = FY + DS(I)*U(I)    1   CONTINUE      XC = FX/(4.*SA)      YC = FY/(4.*SA)      CR = SQRT( (XC-X1)**2 + (YC-Y1)**2 )      IF (.NOT. RATIO) RETURNCC Compute the squared edge lengths and aspect ratio.C      DO 2 I = 1,3        DS(I) = U(I)*U(I) + V(I)*V(I)    2   CONTINUE      AR = 2.*ABS(SA)/     .     ( (SQRT(DS(1)) + SQRT(DS(2)) + SQRT(DS(3)))*CR )      RETURN      END      LOGICAL FUNCTION CRTRI (NCC,LCC,I1,I2,I3)      INTEGER NCC, LCC(*), I1, I2, I3CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   08/14/91CC   This function returns TRUE if and only if triangle (I1,C I2,I3) lies in a constraint region.CCC On input:CC       NCC,LCC = Constraint data structure.  Refer to Sub-C                 routine ADDCST.CC       I1,I2,I3 = Nodal indexes of the counterclockwise-C                  ordered vertices of a triangle.CC Input parameters are altered by this function.CC       CRTRI = TRUE iff (I1,I2,I3) is a constraint regionC               triangle.CC Note that input parameters are not tested for validity.CC Modules required by CRTRI:  NoneCC Intrinsic functions called by CRTRI:  MAX, MINCC***********************************************************C      INTEGER I, IMAX, IMIN      IMAX = MAX(I1,I2,I3)CC   Find the index I of the constraint containing IMAX.C      I = NCC + 1    1 I = I - 1        IF (I .LE. 0) GO TO 2        IF (IMAX .LT. LCC(I)) GO TO 1      IMIN = MIN(I1,I2,I3)CC P lies in a constraint region iff I1, I2, and I3 are nodesC   of the same constraint (IMIN >= LCC(I)), and (IMIN,IMAX)C   is (I1,I3), (I2,I1), or (I3,I2).C      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))      RETURNCC NCC .LE. 0 or all vertices are non-constraint nodes.C    2 CRTRI = .FALSE.      RETURN      END      SUBROUTINE DELARC (N,IO1,IO2, LIST,LPTR,LEND,     .                   LNEW, IER)      INTEGER N, IO1, IO2, LIST(*), LPTR(*), LEND(N), LNEW,     .        IERCC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   11/12/94CC   This subroutine deletes a boundary arc from a triangula-C tion.  It may be used to remove a null triangle from theC convex hull boundary.  Note, however, that if the union ofC triangles is rendered nonconvex, Subroutines DELNOD, EDGE,C and TRFIND may fail.  Thus, Subroutines ADDCST, ADDNOD,C DELNOD, EDGE, and NEARND should not be called followingC an arc deletion.CCC On input:CC       N = Number of nodes in the triangulation.  N .GE. 4.CC       IO1,IO2 = Indexes (in the range 1 to N) of a pair ofC                 adjacent boundary nodes defining the arcC                 to be removed.CC The above parameters are not altered by this routine.CC       LIST,LPTR,LEND,LNEW = Triangulation data structureC                             created by TRMESH or TRMSHR.CC On output:CC       LIST,LPTR,LEND,LNEW = Data structure updated withC                             the removal of arc IO1-IO2C                             unless IER > 0.CC       IER = Error indicator:C             IER = 0 if no errors were encountered.C             IER = 1 if N, IO1, or IO2 is outside its validC                     range, or IO1 = IO2.C             IER = 2 if IO1-IO2 is not a boundary arc.C             IER = 3 if the node opposite IO1-IO2 is al-C                     ready a boundary node, and thus IO1C                     or IO2 has only two neighbors or aC                     deletion would result in two triangu-C                     lations sharing a single node.C             IER = 4 if one of the nodes is a neighbor ofC                     the other, but not vice versa, imply-C                     ing an invalid triangulation dataC                     structure.CC Modules required by DELARC:  DELNB, LSTPTRCC Intrinsic function called by DELARC:  ABSCC***********************************************************C      INTEGER LSTPTR      INTEGER LP, LPH, LPL, N1, N2, N3      N1 = IO1      N2 = IO2CC Test for errors, and set N1->N2 to the directed boundaryC   edge associated with IO1-IO2:  (N1,N2,N3) is a triangleC   for some N3.C      IF (N .LT. 4  .OR.  N1 .LT. 1  .OR.  N1 .GT. N  .OR.     .    N2 .LT. 1  .OR.  N2 .GT. N  .OR.  N1 .EQ. N2) THEN        IER = 1        RETURN      ENDIFC      LPL = LEND(N2)      IF (-LIST(LPL) .NE. N1) THEN        N1 = N2        N2 = IO1        LPL = LEND(N2)        IF (-LIST(LPL) .NE. N1) THEN          IER = 2          RETURN        ENDIF      ENDIFCC Set N3 to the node opposite N1->N2 (the second neighborC   of N1), and test for error 3 (N3 already a boundaryC   node).C      LPL = LEND(N1)      LP = LPTR(LPL)      LP = LPTR(LP)      N3 = ABS(LIST(LP))      LPL = LEND(N3)      IF (LIST(LPL) .LE. 0) THEN        IER = 3        RETURN      ENDIFCC Delete N2 as a neighbor of N1, making N3 the firstC   neighbor, and test for error 4 (N2 not a neighborC   of N1).  Note that previously computed pointers mayC   no longer be valid following the call to DELNB.C      CALL DELNB (N1,N2,N, LIST,LPTR,LEND,LNEW, LPH)      IF (LPH .LT. 0) THEN        IER = 4        RETURN      ENDIFCC Delete N1 as a neighbor of N2, making N3 the new lastC   neighbor.C      CALL DELNB (N2,N1,N, LIST,LPTR,LEND,LNEW, LPH)CC Make N3 a boundary node with first neighbor N2 and lastC   neighbor N1.C      LP = LSTPTR(LEND(N3),N1,LIST,LPTR)      LEND(N3) = LP      LIST(LP) = -N1CC No errors encountered.C      IER = 0      RETURN      END      SUBROUTINE DELNB (N0,NB,N, LIST,LPTR,LEND,LNEW, LPH)      INTEGER N0, NB, N, LIST(*), LPTR(*), LEND(N), LNEW,     .        LPHCC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   07/30/98CC   This subroutine deletes a neighbor NB from the adjacencyC list of node N0 (but N0 is not deleted from the adjacencyC list of NB) and, if NB is a boundary node, makes N0 aC boundary node.  For pointer (LIST index) LPH to NB as aC neighbor of N0, the empty LIST,LPTR location LPH is filledC in with the values at LNEW-1, pointer LNEW-1 (in LPTR andC possibly in LEND) is changed to LPH, and LNEW is decremen-C ted.  This requires a search of LEND and LPTR entailing anC expected operation count of O(N).CCC On input:CC       N0,NB = Indexes, in the range 1 to N, of a pair ofC               nodes such that NB is a neighbor of N0.C               (N0 need not be a neighbor of NB.)CC       N = Number of nodes in the triangulation.  N .GE. 3.CC The above parameters are not altered by this routine.CC       LIST,LPTR,LEND,LNEW = Data structure defining theC                             triangulation.CC On output:CC       LIST,LPTR,LEND,LNEW = Data structure updated withC                             the removal of NB from the ad-C                             jacency list of N0 unlessC                             LPH < 0.CC       LPH = List pointer to the hole (NB as a neighbor ofC             N0) filled in by the values at LNEW-1 or errorC             indicator:C             LPH > 0 if no errors were encountered.C             LPH = -1 if N0, NB, or N is outside its validC                      range.C             LPH = -2 if NB is not a neighbor of N0.CC Modules required by DELNB:  NoneCC Intrinsic function called by DELNB:  ABSCC***********************************************************C      INTEGER I, LNW, LP, LPB, LPL, LPP, NNCC Local parameters:CC I =   DO-loop indexC LNW = LNEW-1 (output value of LNEW)C LP =  LIST pointer of the last neighbor of NBC LPB = Pointer to NB as a neighbor of N0C LPL = Pointer to the last neighbor of N0C LPP = Pointer to the neighbor of N0 that precedes NBC NN =  Local copy of NC      NN = NCC Test for error 1.C      IF (N0 .LT. 1  .OR.  N0 .GT. NN  .OR.  NB .LT. 1  .OR.     .    NB .GT. NN  .OR.  NN .LT. 3) THEN        LPH = -1        RETURN      ENDIFCC   Find pointers to neighbors of N0:CC     LPL points to the last neighbor,C     LPP points to the neighbor NP preceding NB, andC     LPB points to NB.C      LPL = LEND(N0)      LPP = LPL      LPB = LPTR(LPP)    1 IF (LIST(LPB) .EQ. NB) GO TO 2        LPP = LPB        LPB = LPTR(LPP)        IF (LPB .NE. LPL) GO TO 1CC   Test for error 2 (NB not found).C      IF (ABS(LIST(LPB)) .NE. NB) THEN        LPH = -2        RETURN      ENDIFCC   NB is the last neighbor of N0.  Make NP the new lastC     neighbor and, if NB is a boundary node, then make N0C     a boundary node.C      LEND(N0) = LPP      LP = LEND(NB)      IF (LIST(LP) .LT. 0) LIST(LPP) = -LIST(LPP)      GO TO 3CC   NB is not the last neighbor of N0.  If NB is a boundaryC     node and N0 is not, then make N0 a boundary node withC     last neighbor NP.C    2 LP = LEND(NB)      IF (LIST(LP) .LT. 0  .AND.  LIST(LPL) .GT. 0) THEN        LEND(N0) = LPP        LIST(LPP) = -LIST(LPP)      ENDIFCC   Update LPTR so that the neighbor following NB now fol-C     lows NP, and fill in the hole at location LPB.C    3 LPTR(LPP) = LPTR(LPB)      LNW = LNEW-1      LIST(LPB) = LIST(LNW)      LPTR(LPB) = LPTR(LNW)      DO 4 I = NN,1,-1        IF (LEND(I) .EQ. LNW) THEN          LEND(I) = LPB          GO TO 5        ENDIF    4   CONTINUEC    5 DO 6 I = 1,LNW-1        IF (LPTR(I) .EQ. LNW) THEN          LPTR(I) = LPB        ENDIF    6   CONTINUECC No errors encountered.C      LNEW = LNW      LPH = LPB      RETURN      END      SUBROUTINE DELNOD (K,NCC, LCC,N,X,Y,LIST,LPTR,LEND,     .                   LNEW,LWK,IWK, IER)      INTEGER K, NCC, LCC(*), N, LIST(*), LPTR(*),     .        LEND(*), LNEW, LWK, IWK(2,*), IER      DOUBLE PRECISION X(*), Y(*)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   06/28/98CC   This subroutine deletes node K (along with all arcsC incident on node K) from a triangulation of N nodes in theC plane, and inserts arcs as necessary to produce a triangu-C lation of the remaining N-1 nodes.  If a Delaunay triangu-C lation is input, a Delaunay triangulation will result, andC thus, DELNOD reverses the effect of a call to SubroutineC ADDNOD.CC   Note that a constraint node cannot be deleted by thisC routine.  In order to delete a constraint node, it isC necessary to call this routine with NCC = 0, decrement theC appropriate LCC entries (LCC(I) such that LCC(I) > K), andC then create (or restore) the constraints by a call to Sub-C routine ADDCST.CCC On input:CC       K = Index (for X and Y) of the node to be deleted.C           1 .LE. K .LT. LCC(1).  (K .LE. N if NCC=0).CC       NCC = Number of constraint curves.  NCC .GE. 0.CC The above parameters are not altered by this routine.CC       LCC = List of constraint curve starting indexes (orC             dummy array of length 1 if NCC = 0).  Refer toC             Subroutine ADDCST.CC       N = Number of nodes in the triangulation on input.C           N .GE. 4.  Note that N will be decrementedC           following the deletion.CC       X,Y = Arrays of length N containing the coordinatesC             of the nodes with non-constraint nodes in theC             first LCC(1)-1 locations if NCC > 0.CC       LIST,LPTR,LEND,LNEW = Data structure defining theC                             triangulation.  Refer to Sub-C                             routine TRMESH.CC       LWK = Number of columns reserved for IWK.  LWK mustC             be at least NNB-3, where NNB is the number ofC             neighbors of node K, including an extraC             pseudo-node if K is a boundary node.CC       IWK = Integer work array dimensioned 2 by LWK (orC             array of length .GE. 2*LWK).CC On output:CC       LCC = List of constraint curve starting indexes de-C             cremented by 1 to reflect the deletion of KC             unless NCC = 0 or 1 .LE. IER .LE. 4.CC       N = New number of nodes (input value minus one) un-C           less 1 .LE. IER .LE. 4.CC       X,Y = Updated arrays of length N-1 containing nodalC             coordinates (with elements K+1,...,N shiftedC             up a position and thus overwriting element K)C             unless 1 .LE. IER .LE. 4.  (N here denotes theC             input value.)CC       LIST,LPTR,LEND,LNEW = Updated triangulation dataC                             structure reflecting the dele-C                             tion unless IER .NE. 0.  NoteC                             that the data structure mayC                             have been altered if IER .GE.C                             3.CC       LWK = Number of IWK columns required unless IER = 1C             or IER = 3.CC       IWK = Indexes of the endpoints of the new arcs addedC             unless LWK = 0 or 1 .LE. IER .LE. 4.  (ArcsC             are associated with columns, or pairs ofC             adjacent elements if IWK is declared as aC             singly-subscripted array.)CC       IER = Error indicator:C             IER = 0 if no errors were encountered.C             IER = 1 if K, NCC, N, or an LCC entry is out-C                     side its valid range or LWK < 0 onC                     input.C             IER = 2 if more space is required in IWK.C                     Refer to LWK.C             IER = 3 if the triangulation data structure isC                     invalid on input.C             IER = 4 if K is an interior node with 4 orC                     more neighbors, and the number ofC                     neighbors could not be reduced to 3C                     by swaps.  This could be caused byC                     floating point errors with collinearC                     nodes or by an invalid data structure.C             IER = 5 if an error flag was returned byC                     OPTIM.  An error message is writtenC                     to the standard output unit in thisC                     event.CC   Note that the deletion may result in all remaining nodesC being collinear.  This situation is not flagged.CC Modules required by DELNOD:  DELNB, LEFT, LSTPTR, NBCNT,C                                OPTIM, SWAP, SWPTSTCC Intrinsic function called by DELNOD:  ABSCC***********************************************************C      INTEGER LSTPTR, NBCNT      LOGICAL LEFT      INTEGER I, IERR, IWL, J, LCCIP1, LNW, LP, LP21, LPF,     .        LPH, LPL, LPL2, LPN, LWKL, N1, N2, NFRST, NIT,     .        NL, NN, NNB, NR      LOGICAL BDRY      DOUBLE PRECISION X1, X2, XL, XR, Y1, Y2, YL, YRCC Set N1 to K and NNB to the number of neighbors of N1 (plusC   one if N1 is a boundary node), and test for errors.  LPFC   and LPL are LIST indexes of the first and last neighborsC   of N1, IWL is the number of IWK columns containing arcs,C   and BDRY is TRUE iff N1 is a boundary node.C      N1 = K      NN = N      IF (NCC .LT. 0  .OR.  N1 .LT. 1  .OR.  NN .LT. 4  .OR.     .    LWK .LT. 0) GO TO 21      LCCIP1 = NN+1      DO 1 I = NCC,1,-1        IF (LCCIP1-LCC(I) .LT. 3) GO TO 21        LCCIP1 = LCC(I)    1   CONTINUE      IF (N1 .GE. LCCIP1) GO TO 21      LPL = LEND(N1)      LPF = LPTR(LPL)      NNB = NBCNT(LPL,LPTR)      BDRY = LIST(LPL) .LT. 0      IF (BDRY) NNB = NNB + 1      IF (NNB .LT. 3) GO TO 23      LWKL = LWK      LWK = NNB - 3      IF (LWKL .LT. LWK) GO TO 22      IWL = 0      IF (NNB .EQ. 3) GO TO 5CC Initialize for loop on arcs N1-N2 for neighbors N2 of N1,C   beginning with the second neighbor.  NR and NL are theC   neighbors preceding and following N2, respectively, andC   LP indexes NL.  The loop is exited when all possibleC   swaps have been applied to arcs incident on N1.  If N1C   is interior, the number of neighbors will be reducedC   to 3.C      X1 = X(N1)      Y1 = Y(N1)      NFRST = LIST(LPF)      NR = NFRST      XR = X(NR)      YR = Y(NR)      LP = LPTR(LPF)      N2 = LIST(LP)      X2 = X(N2)      Y2 = Y(N2)      LP = LPTR(LP)CC Top of loop:  set NL to the neighbor following N2.C    2 NL = ABS(LIST(LP))      IF (NL .EQ. NFRST  .AND.  BDRY) GO TO 5      XL = X(NL)      YL = Y(NL)CC   Test for a convex quadrilateral.  To avoid an incorrectC     test caused by collinearity, use the fact that if N1C     is a boundary node, then N1 LEFT NR->NL and if N2 isC     a boundary node, then N2 LEFT NL->NR.C      LPL2 = LEND(N2)      IF ( (BDRY  .OR.  LEFT(XR,YR,XL,YL,X1,Y1))  .AND.     .     (LIST(LPL2) .LT. 0  .OR.     .      LEFT(XL,YL,XR,YR,X2,Y2)) ) GO TO 3CC   Nonconvex quadrilateral -- no swap is possible.C      NR = N2      XR = X2      YR = Y2      GO TO 4CC   The quadrilateral defined by adjacent trianglesC     (N1,N2,NL) and (N2,N1,NR) is convex.  Swap inC     NL-NR and store it in IWK.  Indexes larger than N1C     must be decremented since N1 will be deleted fromC     X and Y.C    3 CALL SWAP (NL,NR,N1,N2, LIST,LPTR,LEND, LP21)      IWL = IWL + 1      IF (NL .LE. N1) THEN        IWK(1,IWL) = NL      ELSE        IWK(1,IWL) = NL - 1      ENDIF      IF (NR .LE. N1) THEN        IWK(2,IWL) = NR      ELSE        IWK(2,IWL) = NR - 1      ENDIFCC   Recompute the LIST indexes LPL,LP and decrement NNB.C      LPL = LEND(N1)      NNB = NNB - 1      IF (NNB .EQ. 3) GO TO 5      LP = LSTPTR(LPL,NL,LIST,LPTR)      IF (NR .EQ. NFRST) GO TO 4CC   NR is not the first neighbor of N1.C     Back up and test N1-NR for a swap again:  Set N2 toC     NR and NR to the previous neighbor of N1 -- theC     neighbor of NR which follows N1.  LP21 points to NLC     as a neighbor of NR.C      N2 = NR      X2 = XR      Y2 = YR      LP21 = LPTR(LP21)      LP21 = LPTR(LP21)      NR = ABS(LIST(LP21))      XR = X(NR)      YR = Y(NR)      GO TO 2CC   Bottom of loop -- test for invalid termination.C    4 IF (N2 .EQ. NFRST) GO TO 24      N2 = NL      X2 = XL      Y2 = YL      LP = LPTR(LP)      GO TO 2CC Delete N1 from the adjacency list of N2 for all neighborsC   N2 of N1.  LPL points to the last neighbor of N1.C   LNEW is stored in local variable LNW.C    5 LP = LPL      LNW = LNEWCC Loop on neighbors N2 of N1, beginning with the first.C    6 LP = LPTR(LP)        N2 = ABS(LIST(LP))        CALL DELNB (N2,N1,N, LIST,LPTR,LEND,LNW, LPH)        IF (LPH .LT. 0) GO TO 23CC   LP and LPL may require alteration.C        IF (LPL .EQ. LNW) LPL = LPH        IF (LP .EQ. LNW) LP = LPH        IF (LP .NE. LPL) GO TO 6CC Delete N1 from X, Y, and LEND, and remove its adjacencyC   list from LIST and LPTR.  LIST entries (nodal indexes)C   which are larger than N1 must be decremented.C      NN = NN - 1      IF (N1 .GT. NN) GO TO 9      DO 7 I = N1,NN        X(I) = X(I+1)        Y(I) = Y(I+1)        LEND(I) = LEND(I+1)    7   CONTINUEC      DO 8 I = 1,LNW-1        IF (LIST(I) .GT. N1) LIST(I) = LIST(I) - 1        IF (LIST(I) .LT. -N1) LIST(I) = LIST(I) + 1    8   CONTINUECC   For LPN = first to last neighbors of N1, delete theC     preceding neighbor (indexed by LP).CC   Each empty LIST,LPTR location LP is filled in with theC     values at LNW-1, and LNW is decremented.  All pointersC     (including those in LPTR and LEND) with value LNW-1C     must be changed to LP.CC  LPL points to the last neighbor of N1.C    9 IF (BDRY) NNB = NNB - 1      LPN = LPL      DO 13 J = 1,NNB        LNW = LNW - 1        LP = LPN        LPN = LPTR(LP)        LIST(LP) = LIST(LNW)        LPTR(LP) = LPTR(LNW)        IF (LPTR(LPN) .EQ. LNW) LPTR(LPN) = LP        IF (LPN .EQ. LNW) LPN = LP        DO 10 I = NN,1,-1          IF (LEND(I) .EQ. LNW) THEN            LEND(I) = LP            GO TO 11          ENDIF   10     CONTINUEC   11   DO 12 I = LNW-1,1,-1          IF (LPTR(I) .EQ. LNW) LPTR(I) = LP   12     CONTINUE   13   CONTINUECC Decrement LCC entries.C      DO 14 I = 1,NCC        LCC(I) = LCC(I) - 1   14   CONTINUECC Update N and LNEW, and optimize the patch of trianglesC   containing K (on input) by applying swaps to the arcsC   in IWK.C      N = NN      LNEW = LNW      IF (IWL .GT. 0) THEN        NIT = 4*IWL        CALL OPTIM (X,Y,IWL, LIST,LPTR,LEND,NIT,IWK, IERR)        IF (IERR .NE. 0) GO TO 25      ENDIFCC Successful termination.C      IER = 0      RETURNCC Invalid input parameter.C   21 IER = 1      RETURNCC Insufficient space reserved for IWK.C   22 IER = 2      RETURNCC Invalid triangulation data structure.  NNB < 3 on input orC   N2 is a neighbor of N1 but N1 is not a neighbor of N2.C   23 IER = 3      RETURNCC K is an interior node with 4 or more neighbors, but theC   number of neighbors could not be reduced.C   24 IER = 4      RETURNCC Error flag returned by OPTIM.C   25 IER = 5      WRITE (*,100) NIT, IERR      RETURN  100 FORMAT (//5X,'*** Error in OPTIM:  NIT = 
',I4,     .        ', IER = ',I1,' ***













































































































































































































































































































































































































































































































'/)      END      SUBROUTINE EDGE (IN1,IN2,X,Y, LWK,IWK,LIST,LPTR,     .                 LEND, IER)      INTEGER IN1, IN2, LWK, IWK(2,*), LIST(*), LPTR(*),     .        LEND(*), IER      DOUBLE PRECISION X(*), Y(*)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   06/23/98CC   Given a triangulation of N nodes and a pair of nodalC indexes IN1 and IN2, this routine swaps arcs as necessaryC to force IN1 and IN2 to be adjacent.  Only arcs whichC intersect IN1-IN2 are swapped out.  If a Delaunay triangu-C lation is input, the resulting triangulation is as closeC as possible to a Delaunay triangulation in the sense thatC all arcs other than IN1-IN2 are locally optimal.CC   A sequence of calls to EDGE may be used to force theC presence of a set of edges defining the boundary of a non-C convex and/or multiply connected region (refer to Subrou-C tine ADDCST), or to introduce barriers into the triangula-C tion.  Note that Subroutine GETNP will not necessarilyC return closest nodes if the triangulation has been con-C strained by a call to EDGE.  However, this is appropriateC in some applications, such as triangle-based interpolationC on a nonconvex domain.CCC On input:CC       IN1,IN2 = Indexes (of X and Y) in the range 1 to NC                 defining a pair of nodes to be connectedC                 by an arc.CC       X,Y = Arrays of length N containing the CartesianC             coordinates of the nodes.CC The above parameters are not altered by this routine.CC       LWK = Number of columns reserved for IWK.  This mustC             be at least NI -- the number of arcs whichC             intersect IN1-IN2.  (NI is bounded by N-3.)CC       IWK = Integer work array of length at least 2*LWK.CC       LIST,LPTR,LEND = Data structure defining the trian-C                        gulation.  Refer to SubroutineC                        TRMESH.CC On output:CC       LWK = Number of arcs which intersect IN1-IN2 (butC             not more than the input value of LWK) unlessC             IER = 1 or IER = 3.  LWK = 0 if and only ifC             IN1 and IN2 were adjacent (or LWK=0) on input.CC       IWK = Array containing the indexes of the endpointsC             of the new arcs other than IN1-IN2 unless IERC             .GT. 0 or LWK = 0.  New arcs to the left ofC             IN2-IN1 are stored in the first K-1 columnsC             (left portion of IWK), column K containsC             zeros, and new arcs to the right of IN2-IN1C             occupy columns K+1,...,LWK.  (K can be deter-C             mined by searching IWK for the zeros.)CC       LIST,LPTR,LEND = Data structure updated if necessaryC                        to reflect the presence of an arcC                        connecting IN1 and IN2 unless IERC                        .NE. 0.  The data structure hasC                        been altered if IER = 4.CC       IER = Error indicator:C             IER = 0 if no errors were encountered.C             IER = 1 if IN1 .LT. 1, IN2 .LT. 1, IN1 = IN2,C                     or LWK .LT. 0 on input.C             IER = 2 if more space is required in IWK.C             IER = 3 if IN1 and IN2 could not be connectedC                     due to either an invalid data struc-C                     ture or collinear nodes (and floatingC                     point error).C             IER = 4 if an error flag was returned byC                     OPTIM.CC   An error message is written to the standard output unitC in the case of IER = 3 or IER = 4.CC Modules required by EDGE:  LEFT, LSTPTR, OPTIM, SWAP,C                              SWPTSTCC Intrinsic function called by EDGE:  ABSCC***********************************************************C      LOGICAL LEFT      INTEGER I, IERR, IWC, IWCP1, IWEND, IWF, IWL, LFT, LP,     .        LPL, LP21, NEXT, NIT, NL, NR, N0, N1, N2,     .        N1FRST, N1LST      DOUBLE PRECISION DX, DY, X0, Y0, X1, Y1, X2, Y2CC Local parameters:CC DX,DY =   Components of arc N1-N2C I =       DO-loop index and column index for IWKC IERR =    Error flag returned by Subroutine OPTIMC IWC =     IWK index between IWF and IWL -- NL->NR isC             stored in IWK(1,IWC)->IWK(2,IWC)C IWCP1 =   IWC + 1C IWEND =   Input or output value of LWKC IWF =     IWK (column) index of the first (leftmost) arcC             which intersects IN1->IN2C IWL =     IWK (column) index of the last (rightmost) areC             which intersects IN1->IN2C LFT =     Flag used to determine if a swap results in theC             new arc intersecting IN1-IN2 -- LFT = 0 iffC             N0 = IN1, LFT = -1 implies N0 LEFT IN1->IN2,C             and LFT = 1 implies N0 LEFT IN2->IN1C LP21 =    Unused parameter returned by SWAPC LP =      List pointer (index) for LIST and LPTRC LPL =     Pointer to the last neighbor of IN1 or NLC N0 =      Neighbor of N1 or node opposite NR->NLC N1,N2 =   Local copies of IN1 and IN2C N1FRST =  First neighbor of IN1C N1LST =   (Signed) last neighbor of IN1C NEXT =    Node opposite NL->NRC NIT =     Flag or number of iterations employed by OPTIMC NL,NR =   Endpoints of an arc which intersects IN1-IN2C             with NL LEFT IN1->IN2C X0,Y0 =   Coordinates of N0C X1,Y1 =   Coordinates of IN1C X2,Y2 =   Coordinates of IN2CCC Store IN1, IN2, and LWK in local variables and test forC   errors.C      N1 = IN1      N2 = IN2      IWEND = LWK      IF (N1 .LT. 1  .OR.  N2 .LT. 1  .OR.  N1 .EQ. N2  .OR.     .    IWEND .LT. 0) GO TO 31CC Test for N2 as a neighbor of N1.  LPL points to the lastC   neighbor of N1.C      LPL = LEND(N1)      N0 = ABS(LIST(LPL))      LP = LPL    1 IF (N0 .EQ. N2) GO TO 30        LP = LPTR(LP)        N0 = LIST(LP)        IF (LP .NE. LPL) GO TO 1CC Initialize parameters.C      IWL = 0      NIT = 0CC Store the coordinates of N1 and N2.C    2 X1 = X(N1)      Y1 = Y(N1)      X2 = X(N2)      Y2 = Y(N2)CC Set NR and NL to adjacent neighbors of N1 such thatC   NR LEFT N2->N1 and NL LEFT N1->N2,C   (NR Forward N1->N2 or NL Forward N1->N2), andC   (NR Forward N2->N1 or NL Forward N2->N1).CC   Initialization:  Set N1FRST and N1LST to the first andC     (signed) last neighbors of N1, respectively, andC     initialize NL to N1FRST.C      LPL = LEND(N1)      N1LST = LIST(LPL)      LP = LPTR(LPL)      N1FRST = LIST(LP)      NL = N1FRST      IF (N1LST .LT. 0) GO TO 4CC   N1 is an interior node.  Set NL to the first candidateC     for NR (NL LEFT N2->N1).C    3 IF ( LEFT(X2,Y2,X1,Y1,X(NL),Y(NL)) ) GO TO 4        LP = LPTR(LP)        NL = LIST(LP)        IF (NL .NE. N1FRST) GO TO 3CC   All neighbors of N1 are strictly left of N1->N2.C      GO TO 5CC   NL = LIST(LP) LEFT N2->N1.  Set NR to NL and NL to theC     following neighbor of N1.C    4 NR = NL        LP = LPTR(LP)        NL = ABS(LIST(LP))        IF ( LEFT(X1,Y1,X2,Y2,X(NL),Y(NL)) ) THENCC   NL LEFT N1->N2 and NR LEFT N2->N1.  The Forward testsC     are employed to avoid an error associated withC     collinear nodes.C          DX = X2-X1          DY = Y2-Y1          IF ((DX*(X(NL)-X1)+DY*(Y(NL)-Y1) .GE. 0.  .OR.     .         DX*(X(NR)-X1)+DY*(Y(NR)-Y1) .GE. 0.)  .AND.     .        (DX*(X(NL)-X2)+DY*(Y(NL)-Y2) .LE. 0.  .OR.     .         DX*(X(NR)-X2)+DY*(Y(NR)-Y2) .LE. 0.)) GO TO 6CC   NL-NR does not intersect N1-N2.  However, there isC     another candidate for the first arc if NL lies onC     the line N1-N2.C          IF ( .NOT. LEFT(X2,Y2,X1,Y1,X(NL),Y(NL)) ) GO TO 5        ENDIFCC   Bottom of loop.C        IF (NL .NE. N1FRST) GO TO 4CC Either the triangulation is invalid or N1-N2 lies on theC   convex hull boundary and an edge NR->NL (opposite N1 andC   intersecting N1-N2) was not found due to floating pointC   error.  Try interchanging N1 and N2 -- NIT > 0 iff thisC   has already been done.C    5 IF (NIT .GT. 0) GO TO 33      NIT = 1      N1 = N2      N2 = IN1      GO TO 2CC Store the ordered sequence of intersecting edges NL->NR inC   IWK(1,IWL)->IWK(2,IWL).C    6 IWL = IWL + 1      IF (IWL .GT. IWEND) GO TO 32      IWK(1,IWL) = NL      IWK(2,IWL) = NRCC   Set NEXT to the neighbor of NL which follows NR.C      LPL = LEND(NL)      LP = LPTR(LPL)CC   Find NR as a neighbor of NL.  The search begins withC     the first neighbor.C    7 IF (LIST(LP) .EQ. NR) GO TO 8        LP = LPTR(LP)        IF (LP .NE. LPL) GO TO 7CC   NR must be the last neighbor, and NL->NR cannot be aC     boundary edge.C      IF (LIST(LP) .NE. NR) GO TO 33CC   Set NEXT to the neighbor following NR, and test forC     termination of the store loop.C    8 LP = LPTR(LP)      NEXT = ABS(LIST(LP))      IF (NEXT .EQ. N2) GO TO 9CC   Set NL or NR to NEXT.C      IF ( LEFT(X1,Y1,X2,Y2,X(NEXT),Y(NEXT)) ) THEN        NL = NEXT      ELSE        NR = NEXT      ENDIF      GO TO 6CC IWL is the number of arcs which intersect N1-N2.C   Store LWK.C    9 LWK = IWL      IWEND = IWLCC Initialize for edge swapping loop -- all possible swapsC   are applied (even if the new arc again intersectsC   N1-N2), arcs to the left of N1->N2 are stored in theC   left portion of IWK, and arcs to the right are stored inC   the right portion.  IWF and IWL index the first and lastC   intersecting arcs.C      IWF = 1CC Top of loop -- set N0 to N1 and NL->NR to the first edge.C   IWC points to the arc currently being processed.  LFTC   .LE. 0 iff N0 LEFT N1->N2.C   10 LFT = 0      N0 = N1      X0 = X1      Y0 = Y1      NL = IWK(1,IWF)      NR = IWK(2,IWF)      IWC = IWFCC   Set NEXT to the node opposite NL->NR unless IWC is theC     last arc.C   11 IF (IWC .EQ. IWL) GO TO 21      IWCP1 = IWC + 1      NEXT = IWK(1,IWCP1)      IF (NEXT .NE. NL) GO TO 16      NEXT = IWK(2,IWCP1)CC   NEXT RIGHT N1->N2 and IWC .LT. IWL.  Test for a possibleC     swap.C      IF ( .NOT. LEFT(X0,Y0,X(NR),Y(NR),X(NEXT),Y(NEXT)) )     .   GO TO 14      IF (LFT .GE. 0) GO TO 12      IF ( .NOT. LEFT(X(NL),Y(NL),X0,Y0,X(NEXT),Y(NEXT)) )     .   GO TO 14CC   Replace NL->NR with N0->NEXT.C      CALL SWAP (NEXT,N0,NL,NR, LIST,LPTR,LEND, LP21)      IWK(1,IWC) = N0      IWK(2,IWC) = NEXT      GO TO 15CC   Swap NL-NR for N0-NEXT, shift columns IWC+1,...,IWL toC     the left, and store N0-NEXT in the right portion ofC     IWK.C   12 CALL SWAP (NEXT,N0,NL,NR, LIST,LPTR,LEND, LP21)      DO 13 I = IWCP1,IWL        IWK(1,I-1) = IWK(1,I)        IWK(2,I-1) = IWK(2,I)   13   CONTINUE      IWK(1,IWL) = N0      IWK(2,IWL) = NEXT      IWL = IWL - 1      NR = NEXT      GO TO 11CC   A swap is not possible.  Set N0 to NR.C   14 N0 = NR      X0 = X(N0)      Y0 = Y(N0)      LFT = 1CC   Advance to the next arc.C   15 NR = NEXT      IWC = IWC + 1      GO TO 11CC   NEXT LEFT N1->N2, NEXT .NE. N2, and IWC .LT. IWL.C     Test for a possible swap.C   16 IF ( .NOT. LEFT(X(NL),Y(NL),X0,Y0,X(NEXT),Y(NEXT)) )     .   GO TO 19      IF (LFT .LE. 0) GO TO 17      IF ( .NOT. LEFT(X0,Y0,X(NR),Y(NR),X(NEXT),Y(NEXT)) )     .   GO TO 19CC   Replace NL->NR with NEXT->N0.C      CALL SWAP (NEXT,N0,NL,NR, LIST,LPTR,LEND, LP21)      IWK(1,IWC) = NEXT      IWK(2,IWC) = N0      GO TO 20CC   Swap NL-NR for N0-NEXT, shift columns IWF,...,IWC-1 toC     the right, and store N0-NEXT in the left portion ofC     IWK.C   17 CALL SWAP (NEXT,N0,NL,NR, LIST,LPTR,LEND, LP21)      DO 18 I = IWC-1,IWF,-1        IWK(1,I+1) = IWK(1,I)        IWK(2,I+1) = IWK(2,I)   18   CONTINUE      IWK(1,IWF) = N0      IWK(2,IWF) = NEXT      IWF = IWF + 1      GO TO 20CC   A swap is not possible.  Set N0 to NL.C   19 N0 = NL      X0 = X(N0)      Y0 = Y(N0)      LFT = -1CC   Advance to the next arc.C   20 NL = NEXT      IWC = IWC + 1      GO TO 11CC   N2 is opposite NL->NR (IWC = IWL).C   21 IF (N0 .EQ. N1) GO TO 24      IF (LFT .LT. 0) GO TO 22CC   N0 RIGHT N1->N2.  Test for a possible swap.C      IF ( .NOT. LEFT(X0,Y0,X(NR),Y(NR),X2,Y2) ) GO TO 10CC   Swap NL-NR for N0-N2 and store N0-N2 in the rightC     portion of IWK.C      CALL SWAP (N2,N0,NL,NR, LIST,LPTR,LEND, LP21)      IWK(1,IWL) = N0      IWK(2,IWL) = N2      IWL = IWL - 1      GO TO 10CC   N0 LEFT N1->N2.  Test for a possible swap.C   22 IF ( .NOT. LEFT(X(NL),Y(NL),X0,Y0,X2,Y2) ) GO TO 10CC   Swap NL-NR for N0-N2, shift columns IWF,...,IWL-1 to theC     right, and store N0-N2 in the left portion of IWK.C      CALL SWAP (N2,N0,NL,NR, LIST,LPTR,LEND, LP21)      I = IWL   23 IWK(1,I) = IWK(1,I-1)      IWK(2,I) = IWK(2,I-1)      I = I - 1      IF (I .GT. IWF) GO TO 23      IWK(1,IWF) = N0      IWK(2,IWF) = N2      IWF = IWF + 1      GO TO 10CC IWF = IWC = IWL.  Swap out the last arc for N1-N2 andC   store zeros in IWK.C   24 CALL SWAP (N2,N1,NL,NR, LIST,LPTR,LEND, LP21)      IWK(1,IWC) = 0      IWK(2,IWC) = 0CC Optimization procedure --C      IF (IWC .GT. 1) THENCC   Optimize the set of new arcs to the left of IN1->IN2.C        NIT = 3*(IWC-1)        CALL OPTIM (X,Y,IWC-1, LIST,LPTR,LEND,NIT,IWK, IERR)        IF (IERR .NE. 0) GO TO 34      ENDIF      IF (IWC .LT. IWEND) THENCC   Optimize the set of new arcs to the right of IN1->IN2.C        NIT = 3*(IWEND-IWC)        CALL OPTIM (X,Y,IWEND-IWC, LIST,LPTR,LEND,NIT,     .              IWK(1,IWC+1), IERR)        IF (IERR .NE. 0) GO TO 34      ENDIFCC Successful termination.C      IER = 0      RETURNCC IN1 and IN2 were adjacent on input.C   30 IER = 0      RETURNCC Invalid input parameter.C   31 IER = 1      RETURNCC Insufficient space reserved for IWK.C   32 IER = 2      RETURNCC Invalid triangulation data structure or collinear nodesC   on convex hull boundary.C   33 IER = 3      WRITE (*,130) IN1, IN2  130 FORMAT (//5X,'*** Error in EDGE:  Invalid triangula
',     .        'tion or null triangles on boundary
'/     .        9X,'IN1 =',I4,', IN2=






',I4/)      RETURNCC Error flag returned by OPTIM.C   34 IER = 4      WRITE (*,140) NIT, IERR  140 FORMAT (//5X,'*** Error in OPTIM:  NIT = 
',I4,     .        ', IER = ',I1,' ***























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































'/)      RETURN      END      SUBROUTINE GETNP (NCC,LCC,N,X,Y,LIST,LPTR,LEND,     .                  L, NPTS,DS, IER)      INTEGER NCC, LCC(*), N, LIST(*), LPTR(*), LEND(N),     .        L, NPTS(L), IER      DOUBLE PRECISION X(N), Y(N), DS(L)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   11/12/94CC   Given a triangulation of N nodes and an array NPTS con-C taining the indexes of L-1 nodes ordered by distance fromC NPTS(1), this subroutine sets NPTS(L) to the index of theC next node in the sequence -- the node, other than NPTS(1),C ...,NPTS(L-1), which is closest to NPTS(1).  Thus, theC ordered sequence of K closest nodes to N1 (including N1)C may be determined by K-1 calls to GETNP with NPTS(1) = N1C and L = 2,3,...,K for K .GE. 2.  Note that NPTS must in-C clude constraint nodes as well as non-constraint nodes.C Thus, a sequence of K1 closest non-constraint nodes to N1C must be obtained as a subset of the closest K2 nodes to N1C for some K2 .GE. K1.CC   The terms closest and distance have special definitionsC when constraint nodes are present in the triangulation.C Nodes N1 and N2 are said to be visible from each other ifC and only if the line segment N1-N2 intersects no con-C straint arc (except possibly itself) and is not an interi-C or constraint arc (arc whose interior lies in a constraintC region).  A path from N1 to N2 is an ordered sequence ofC nodes, with N1 first and N2 last, such that adjacent pathC elements are visible from each other.  The path length isC the sum of the Euclidean distances between adjacent pathC nodes.  Finally, the distance from N1 to N2 is defined toC be the length of the shortest path from N1 to N2.CC   The algorithm uses the property of a Delaunay triangula-C tion that the K-th closest node to N1 is a neighbor of oneC of the K-1 closest nodes to N1.  With the definition ofC distance used here, this property holds when constraintsC are present as long as non-constraint arcs are locallyC optimal.CCC On input:CC       NCC = Number of constraints.  NCC .GE. 0.CC       LCC = List of constraint curve starting indexes (orC             dummy array of length 1 if NCC = 0).  Refer toC             Subroutine ADDCST.CC       N = Number of nodes in the triangulation.  N .GE. 3.CC       X,Y = Arrays of length N containing the coordinatesC             of the nodes with non-constraint nodes in theC             first LCC(1)-1 locations if NCC > 0.CC       LIST,LPTR,LEND = Triangulation data structure.  Re-C                        fer to Subroutine TRMESH.CC       L = Number of nodes in the sequence on output.  2C           .LE. L .LE. N.CC       NPTS = Array of length .GE. L containing the indexesC              of the L-1 closest nodes to NPTS(1) in theC              first L-1 locations.CC       DS = Array of length .GE. L containing the distanceC            (defined above) between NPTS(1) and NPTS(I) inC            the I-th position for I = 1,...,L-1.  Thus,C            DS(1) = 0.CC Input parameters other than NPTS(L) and DS(L) are notC   altered by this routine.CC On output:CC       NPTS = Array updated with the index of the L-thC              closest node to NPTS(1) in position L unlessC              IER .NE. 0.CC       DS = Array updated with the distance between NPTS(1)C            and NPTS(L) in position L unless IER .NE. 0.CC       IER = Error indicator:C             IER =  0 if no errors were encountered.C             IER = -1 if NCC, N, L, or an LCC entry isC                      outside its valid range on input.C             IER =  K if NPTS(K) is not a valid index inC                      the range 1 to N.CC Module required by GETNP:  INTSECCC Intrinsic functions called by GETNP:  ABS, MIN, SQRTCC***********************************************************C      LOGICAL INTSEC      INTEGER I, IFRST, ILAST, J, K, KM1, LCC1, LM1, LP,     .        LPCL, LPK, LPKL, N1, NC, NF1, NF2, NJ, NK,     .        NKBAK, NKFOR, NL, NN      LOGICAL ISW, VIS, NCF, NJF, SKIP, SKSAV, LFT1, LFT2,     .        LFT12      DOUBLE PRECISION DC, DL, X1, XC, XJ, XK, Y1, YC, YJ,      .        YKCC Store parameters in local variables and test for errors.C   LCC1 indexes the first constraint node.C      IER = -1      NN = N      LCC1 = NN+1      LM1 = L-1      IF (NCC .LT. 0  .OR.  LM1 .LT. 1  .OR.  LM1 .GE. NN)     .   RETURN      IF (NCC .EQ. 0) THEN        IF (NN .LT. 3) RETURN      ELSE        DO 1 I = NCC,1,-1          IF (LCC1 - LCC(I) .LT. 3) RETURN          LCC1 = LCC(I)    1     CONTINUE        IF (LCC1 .LT. 1) RETURN      ENDIFCC Test for an invalid index in NPTS.C      DO 2 K = 1,LM1        NK = NPTS(K)        IF (NK .LT. 1  .OR.  NK .GT. NN) THEN          IER = K          RETURN        ENDIF    2   CONTINUECC Store N1 = NPTS(1) and mark the elements of NPTS.C      N1 = NPTS(1)      X1 = X(N1)      Y1 = Y(N1)      DO 3 K = 1,LM1        NK = NPTS(K)        LEND(NK) = -LEND(NK)    3   CONTINUECC Candidates NC for NL = NPTS(L) are the unmarked visibleC   neighbors of nodes NK in NPTS.  ISW is an initializationC   switch set to .TRUE. when NL and its distance DL from N1C   have been initialized with the first candidate encount-C   ered.C      ISW = .FALSE.      DL = 0.CC Loop on marked nodes NK = NPTS(K).  LPKL indexes the lastC   neighbor of NK in LIST.C      DO 16 K = 1,LM1        KM1 = K - 1        NK = NPTS(K)        XK = X(NK)        YK = Y(NK)        LPKL = -LEND(NK)        NKFOR = 0        NKBAK = 0        VIS = .TRUE.        IF (NK .GE. LCC1) THENCC   NK is a constraint node.  Set NKFOR and NKBAK to theC     constraint nodes which follow and precede NK.  IFRSTC     and ILAST are set to the first and last nodes in theC     constraint containing NK.C          IFRST = NN + 1          DO 4 I = NCC,1,-1            ILAST = IFRST - 1            IFRST = LCC(I)            IF (NK .GE. IFRST) GO TO 5    4       CONTINUEC    5     IF (NK .LT. ILAST) THEN            NKFOR = NK + 1          ELSE            NKFOR = IFRST          ENDIF          IF (NK .GT. IFRST) THEN            NKBAK = NK - 1          ELSE            NKBAK = ILAST          ENDIFCC   Initialize VIS to TRUE iff NKFOR precedes NKBAK in theC     adjacency list for NK -- the first neighbor is visi-C     ble and is not NKBAK.C          LPK = LPKL    6     LPK = LPTR(LPK)            NC = ABS(LIST(LPK))            IF (NC .NE. NKFOR  .AND.  NC .NE. NKBAK) GO TO 6          VIS = NC .EQ. NKFOR        ENDIFCC Loop on neighbors NC of NK, bypassing marked and nonvis-C   ible neighbors.C        LPK = LPKL    7   LPK = LPTR(LPK)          NC = ABS(LIST(LPK))          IF (NC .EQ. NKBAK) VIS = .TRUE.CC   VIS = .FALSE. iff NK-NC is an interior constraint arcC     (NK is a constraint node and NC lies strictly betweenC     NKFOR and NKBAK).C          IF (.NOT. VIS) GO TO 15          IF (NC .EQ. NKFOR) VIS = .FALSE.          IF (LEND(NC) .LT. 0) GO TO 15CC Initialize distance DC between N1 and NC to EuclideanC   distance.C          XC = X(NC)          YC = Y(NC)          DC = SQRT((XC-X1)*(XC-X1) + (YC-Y1)*(YC-Y1))          IF (ISW  .AND.  DC .GE. DL) GO TO 15          IF (K .EQ. 1) GO TO 14CC K .GE. 2.  Store the pointer LPCL to the last neighborC   of NC.C          LPCL = LEND(NC)CC Set DC to the length of the shortest path from N1 to NCC   which has not previously been encountered and which isC   a viable candidate for the shortest path from N1 to NL.C   This is Euclidean distance iff NC is visible from N1.C   Since the shortest path from N1 to NL contains only ele-C   ments of NPTS which are constraint nodes (in addition toC   N1 and NL), only these need be considered for the pathC   from N1 to NC.  Thus, for distance function D(A,B) andC   J = 1,...,K, DC = min(D(N1,NJ) + D(NJ,NC)) over con-C   straint nodes NJ = NPTS(J) which are visible from NC.C          DO 13 J = 1,KM1            NJ = NPTS(J)            IF (J .GT. 1  .AND.  NJ .LT. LCC1) GO TO 13CC If NC is a visible neighbor of NJ, a path from N1 to NCC   containing NJ has already been considered.  Thus, NJ mayC   be bypassed if it is adjacent to NC.C            LP = LPCL    8       LP = LPTR(LP)              IF ( NJ .EQ. ABS(LIST(LP)) ) GO TO 12              IF (LP .NE. LPCL) GO TO 8CC NJ is a constraint node (unless J=1) not adjacent to NC,C   and is visible from NC iff NJ-NC is not intersected byC   a constraint arc.  Loop on constraints I in reverseC   order --C            XJ = X(NJ)            YJ = Y(NJ)            IFRST = NN+1            DO 11 I = NCC,1,-1              ILAST = IFRST - 1              IFRST = LCC(I)              NF1 = ILAST              NCF = NF1 .EQ. NC              NJF = NF1 .EQ. NJ              SKIP = NCF  .OR.  NJFCC Loop on boundary constraint arcs NF1-NF2 which containC   neither NC nor NJ.  NCF and NJF are TRUE iff NC (or NJ)C   has been encountered in the constraint, and SKIP =C   .TRUE. iff NF1 = NC or NF1 = NJ.C              DO 10 NF2 = IFRST,ILAST                IF (NF2 .EQ. NC) NCF = .TRUE.                IF (NF2 .EQ. NJ) NJF = .TRUE.                SKSAV = SKIP                SKIP = NF2 .EQ. NC  .OR.  NF2 .EQ. NJCC   The last constraint arc in the constraint need not beC     tested if none of the arcs have been skipped.C                IF ( SKSAV  .OR.  SKIP  .OR.     .               (NF2 .EQ. ILAST  .AND.     .               .NOT. NCF  .AND.  .NOT. NJF) ) GO TO 9                IF ( INTSEC(X(NF1),Y(NF1),X(NF2),Y(NF2),     .                      XC,YC,XJ,YJ) ) GO TO 12    9           NF1 = NF2   10           CONTINUE              IF (.NOT. NCF  .OR.  .NOT. NJF) GO TO 11CC NC and NJ are constraint nodes in the same constraint.C   NC-NJ is intersected by an interior constraint arc iffC   1)  NC LEFT NF2->NF1 and (NJ LEFT NF1->NC and NJ LEFTC         NC->NF2) orC   2)  NC .NOT. LEFT NF2->NF1 and (NJ LEFT NF1->NC orC         NJ LEFT NC->NF2),C   where NF1, NC, NF2 are consecutive constraint nodes.C              IF (NC .NE. IFRST) THEN                NF1 = NC - 1              ELSE                NF1 = ILAST              ENDIF              IF (NC .NE. ILAST) THEN                NF2 = NC + 1              ELSE                NF2 = IFRST              ENDIF              LFT1 = (XC-X(NF1))*(YJ-Y(NF1)) .GE.     .               (XJ-X(NF1))*(YC-Y(NF1))              LFT2 = (X(NF2)-XC)*(YJ-YC) .GE.     .               (XJ-XC)*(Y(NF2)-YC)              LFT12 = (X(NF1)-X(NF2))*(YC-Y(NF2)) .GE.     .                (XC-X(NF2))*(Y(NF1)-Y(NF2))              IF ( (LFT1  .AND.  LFT2)  .OR.  (.NOT. LFT12     .             .AND.  (LFT1  .OR.  LFT2)) ) GO TO 12   11         CONTINUECC NJ is visible from NC.  Exit the loop with DC = EuclideanC   distance if J = 1.C            IF (J .EQ. 1) GO TO 14            DC = MIN(DC,DS(J) + SQRT((XC-XJ)*(XC-XJ) +     .                  (YC-YJ)*(YC-YJ)))            GO TO 13CC NJ is not visible from NC or is adjacent to NC.  Initial-C   ize DC with D(N1,NK) + D(NK,NC) if J = 1.C   12       IF (J .EQ. 1) DC = DS(K) + SQRT((XC-XK)*(XC-XK)     .                         + (YC-YK)*(YC-YK))   13       CONTINUECC Compare DC with DL.C          IF (ISW  .AND.  DC .GE. DL) GO TO 15CC The first (or a closer) candidate for NL has beenC   encountered.C   14     NL = NC          DL = DC          ISW = .TRUE.   15     IF (LPK .NE. LPKL) GO TO 7   16   CONTINUECC Unmark the elements of NPTS and store NL and DL.C      DO 17 K = 1,LM1        NK = NPTS(K)        LEND(NK) = -LEND(NK)   17   CONTINUE      NPTS(L) = NL      DS(L) = DL      IER = 0      RETURN      END      INTEGER FUNCTION INDXCC (NCC,LCC,N,LIST,LEND)      INTEGER NCC, LCC(*), N, LIST(*), LEND(N)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   08/25/91CC   Given a constrained Delaunay triangulation, this func-C tion returns the index, if any, of an exterior constraintC curve (an unbounded constraint region).  An exterior con-C straint curve is assumed to be present if and only if theC clockwise-ordered sequence of boundary nodes is a subse-C quence of a constraint node sequence.  The triangulationC adjacencies corresponding to constraint edges may or mayC not have been forced by a call to ADDCST, and the con-C straint region may or may not be valid (contain no nodes).CCC On input:CC       NCC = Number of constraints.  NCC .GE. 0.CC       LCC = List of constraint curve starting indexes (orC             dummy array of length 1 if NCC = 0).  Refer toC             Subroutine ADDCST.CC       N = Number of nodes in the triangulation.  N .GE. 3.CC       LIST,LEND = Data structure defining the triangula-C                   tion.  Refer to Subroutine TRMESH.CC   Input parameters are not altered by this function.  NoteC that the parameters are not tested for validity.CC On output:CC       INDXCC = Index of the exterior constraint curve, ifC                present, or 0 otherwise.CC Modules required by INDXCC:  NoneCC***********************************************************C      INTEGER I, IFRST, ILAST, LP, N0, NST, NXT      INDXCC = 0      IF (NCC .LT. 1) RETURNCC Set N0 to the boundary node with smallest index.C      N0 = 0    1 N0 = N0 + 1        LP = LEND(N0)        IF (LIST(LP) .GT. 0) GO TO 1CC Search in reverse order for the constraint I, if any, thatC   contains N0.  IFRST and ILAST index the first and lastC   nodes in constraint I.C      I = NCC      ILAST = N    2 IFRST = LCC(I)        IF (N0 .GE. IFRST) GO TO 3        IF (I .EQ. 1) RETURN        I = I - 1        ILAST = IFRST - 1        GO TO 2CC N0 is in constraint I which indexes an exterior constraintC   curve iff the clockwise-ordered sequence of boundaryC   node indexes beginning with N0 is increasing and boundedC   above by ILAST.C    3 NST = N0C    4 NXT = -LIST(LP)        IF (NXT .EQ. NST) GO TO 5        IF (NXT .LE. N0  .OR.  NXT .GT. ILAST) RETURN        N0 = NXT        LP = LEND(N0)        GO TO 4CC Constraint I contains the boundary node sequence as aC   subset.C    5 INDXCC = I      RETURN      END      SUBROUTINE INSERT (K,LP, LIST,LPTR,LNEW )      INTEGER K, LP, LIST(*), LPTR(*), LNEWCC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   09/01/88CC   This subroutine inserts K as a neighbor of N1 followingC N2, where LP is the LIST pointer of N2 as a neighbor ofC N1.  Note that, if N2 is the last neighbor of N1, K willC become the first neighbor (even if N1 is a boundary node).CCC On input:CC       K = Index of the node to be inserted.CC       LP = LIST pointer of N2 as a neighbor of N1.CC The above parameters are not altered by this routine.CC       LIST,LPTR,LNEW = Data structure defining the trian-C                        gulation.  Refer to SubroutineC                        TRMESH.CC On output:CC       LIST,LPTR,LNEW = Data structure updated with theC                        addition of node K.CC Modules required by INSERT:  NoneCC***********************************************************C      INTEGER LSAVC      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 )      INTEGER KK, I1, I2, I3, LIST(*), LPTR(*), LEND(*),     .        LNEWCC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   02/22/91CC   This subroutine adds an interior node to a triangulationC of a set of points in the plane.  The data structure isC updated with the insertion of node KK into the triangleC whose vertices are I1, I2, and I3.  No optimization of theC triangulation is performed.CCC On input:CC       KK = Index of the node to be inserted.  KK .GE. 1C            and KK must not be equal to I1, I2, or I3.CC       I1,I2,I3 = Indexes of the counterclockwise-orderedC                  sequence of vertices of a triangle whichC                  contains node KK.CC The above parameters are not altered by this routine.CC       LIST,LPTR,LEND,LNEW = Data structure defining theC                             triangulation.  Refer to Sub-C                             routine TRMESH.  TriangleC                             (I1,I2,I3) must be includedC                             in the triangulation.CC On output:CC       LIST,LPTR,LEND,LNEW = Data structure updated withC                             the addition of node KK.  KKC                             will be connected to nodes I1,C                             I2, and I3.CC Modules required by INTADD:  INSERT, LSTPTRCC***********************************************************C      INTEGER LSTPTR      INTEGER K, LP, N1, N2, N3      K = KKCC Initialization.C      N1 = I1      N2 = I2      N3 = I3CC Add K as a neighbor of I1, I2, and I3.C      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)CC Add I1, I2, and I3 as neighbors of K.C      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 INTSEC (X1,Y1,X2,Y2,X3,Y3,X4,Y4)      DOUBLE PRECISION X1, Y1, X2, Y2, X3, Y3, X4, Y4CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   09/01/88CC   Given a pair of line segments P1-P2 and P3-P4, thisC function returns the value .TRUE. if and only if P1-P2C shares one or more points with P3-P4.  The line segmentsC include their endpoints, and the four points need not beC distinct.  Thus, either line segment may consist of aC single point, and the segments may meet in a V (which isC treated as an intersection).  Note that an incorrectC decision may result from floating point error if the fourC endpoints are nearly collinear.CCC On input:CC       X1,Y1 = Coordinates of P1.CC       X2,Y2 = Coordinates of P2.CC       X3,Y3 = Coordinates of P3.CC       X4,Y4 = Coordinates of P4.CC Input parameters are not altered by this function.CC On output:CC       INTSEC = Logical value defined above.CC Modules required by INTSEC:  NoneCC***********************************************************C      DOUBLE PRECISION A, B, D, DX12, DX31, DX34, DY12,     .        DY31, DY34CC Test for overlap between the smallest rectangles thatC   contain the line segments and have sides parallel toC   the axes.C      IF ((X1 .LT. X3  .AND.  X1 .LT. X4  .AND.  X2 .LT. X3     .     .AND.  X2 .LT. X4)  .OR.     .    (X1 .GT. X3  .AND.  X1 .GT. X4  .AND.  X2 .GT. X3     .     .AND.  X2 .GT. X4)  .OR.     .    (Y1 .LT. Y3  .AND.  Y1 .LT. Y4  .AND.  Y2 .LT. Y3     .     .AND.  Y2 .LT. Y4)  .OR.     .    (Y1 .GT. Y3  .AND.  Y1 .GT. Y4  .AND.  Y2 .GT. Y3     .     .AND.  Y2 .GT. Y4)) THEN        INTSEC = .FALSE.        RETURN      ENDIFCC Compute A = P4-P3 X P1-P3, B = P2-P1 X P1-P3, andC   D = P2-P1 X P4-P3 (Z components).C      DX12 = X2 - X1      DY12 = Y2 - Y1      DX34 = X4 - X3      DY34 = Y4 - Y3      DX31 = X1 - X3      DY31 = Y1 - Y3      A = DX34*DY31 - DX31*DY34      B = DX12*DY31 - DX31*DY12      D = DX12*DY34 - DX34*DY12      IF (D .EQ. 0.) GO TO 1CC D .NE. 0 and the point of intersection of the lines de-C   fined by the line segments is P = P1 + (A/D)*(P2-P1) =C   P3 + (B/D)*(P4-P3).C      INTSEC = A/D .GE. 0.  .AND.  A/D .LE. 1.  .AND.     .         B/D .GE. 0.  .AND.  B/D .LE. 1.      RETURNCC D .EQ. 0 and thus either the line segments are parallel,C   or one (or both) of them is a single point.C    1 INTSEC = A .EQ. 0.  .AND.  B .EQ. 0.      RETURN      END      INTEGER FUNCTION JRAND (N, IX,IY,IZ )      INTEGER N, IX, IY, IZCC***********************************************************CC                                              From STRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   07/28/98CC   This function returns a uniformly distributed pseudo-C random integer in the range 1 to N.CCC On input:CC       N = Maximum value to be returned.CC N is not altered by this function.CC       IX,IY,IZ = Integer seeds initialized to values inC                  the range 1 to 30,000 before the firstC                  call to JRAND, and not altered betweenC                  subsequent calls (unless a sequence ofC                  random numbers is to be repeated byC                  reinitializing the seeds).CC On output:CC       IX,IY,IZ = Updated integer seeds.CC       JRAND = Random integer in the range 1 to N.CC Reference:  B. A. Wichmann and I. D. Hill, "An EfficientC             and Portable Pseudo-random Number Generator",C             Applied Statistics, Vol. 31, No. 2, 1982,C             pp. 188-190.CC Modules required by JRAND:  NoneCC Intrinsic functions called by JRAND:  INT, MOD, DBLECC***********************************************************C      DOUBLE PRECISION U, XCC Local parameters:CC U = Pseudo-random number uniformly distributed in theC     interval (0,1).C X = Pseudo-random number in the range 0 to 3 whose frac-C       tional part is U.C      IX = MOD(171*IX,30269)      IY = MOD(172*IY,30307)      IZ = MOD(170*IZ,30323)      X = (DBLE(IX)/30269.) + (DBLE(IY)/30307.) +     .    (DBLE(IZ)/30323.)      U = X - INT(X)      JRAND = DBLE(N)*U + 1.      RETURN      END      LOGICAL FUNCTION LEFT (X1,Y1,X2,Y2,X0,Y0)      DOUBLE PRECISION X1, Y1, X2, Y2, X0, Y0CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   09/01/88CC   This function determines whether node N0 is to the leftC or to the right of the line through N1-N2 as viewed by anC observer at N1 facing N2.CCC On input:CC       X1,Y1 = Coordinates of N1.CC       X2,Y2 = Coordinates of N2.CC       X0,Y0 = Coordinates of N0.CC Input parameters are not altered by this function.CC On output:CC       LEFT = .TRUE. if and only if (X0,Y0) is on or to theC              left of the directed line N1->N2.CC Modules required by LEFT:  NoneCC***********************************************************C      DOUBLE PRECISION DX1, DY1, DX2, DY2CC Local parameters:CC DX1,DY1 = X,Y components of the vector N1->N2C DX2,DY2 = X,Y components of the vector N1->N0C      DX1 = X2-X1      DY1 = Y2-Y1      DX2 = X0-X1      DY2 = Y0-Y1CC If the sign of the vector cross product of N1->N2 andC   N1->N0 is positive, then sin(A) > 0, where A is theC   angle between the vectors, and thus A is in the rangeC   (0,180) degrees.C      LEFT = DX1*DY2 .GE. DX2*DY1      RETURN      END      INTEGER FUNCTION LSTPTR (LPL,NB,LIST,LPTR)      INTEGER LPL, NB, LIST(*), LPTR(*)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   09/01/88CC   This function returns the index (LIST pointer) of NB inC the adjacency list for N0, where LPL = LEND(N0).CCC On input:CC       LPL = LEND(N0)CC       NB = Index of the node whose pointer is to be re-C            turned.  NB must be connected to N0.CC       LIST,LPTR = Data structure defining the triangula-C                   tion.  Refer to Subroutine TRMESH.CC Input parameters are not altered by this function.CC On output:CC       LSTPTR = Pointer such that LIST(LSTPTR) = NB orC                LIST(LSTPTR) = -NB, unless NB is not aC                neighbor of N0, in which case LSTPTR = LPL.CC Modules required by LSTPTR:  NoneCC***********************************************************C      INTEGER LP, NDC      LP = LPTR(LPL)    1 ND = LIST(LP)        IF (ND .EQ. NB) GO TO 2        LP = LPTR(LP)        IF (LP .NE. LPL) GO TO 1C    2 LSTPTR = LP      RETURN      END      INTEGER FUNCTION NBCNT (LPL,LPTR)      INTEGER LPL, LPTR(*)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   09/01/88CC   This function returns the number of neighbors of a nodeC N0 in a triangulation created by Subroutine TRMESH (orC TRMSHR).CCC On input:CC       LPL = LIST pointer to the last neighbor of N0 --C             LPL = LEND(N0).CC       LPTR = Array of pointers associated with LIST.CC Input parameters are not altered by this function.CC On output:CC       NBCNT = Number of neighbors of N0.CC Modules required by NBCNT:  NoneCC***********************************************************C      INTEGER K, LPC      LP = LPL      K = 1C    1 LP = LPTR(LP)        IF (LP .EQ. LPL) GO TO 2        K = K + 1        GO TO 1C    2 NBCNT = K      RETURN      END      INTEGER FUNCTION NEARND (XP,YP,IST,N,X,Y,LIST,LPTR,     .                         LEND, DSQ)      INTEGER IST, N, LIST(*), LPTR(*), LEND(N)      DOUBLE PRECISION XP, YP, X(N), Y(N), DSQCC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   06/27/98CC   Given a point P in the plane and a Delaunay triangula-C tion created by Subroutine TRMESH or TRMSHR, this functionC returns the index of the nearest triangulation node to P.CC   The algorithm consists of implicitly adding P to theC triangulation, finding the nearest neighbor to P, andC implicitly deleting P from the triangulation.  Thus, itC is based on the fact that, if P is a node in a DelaunayC triangulation, the nearest node to P is a neighbor of P.CCC On input:CC       XP,YP = Cartesian coordinates of the point P to beC               located relative to the triangulation.CC       IST = Index of a node at which TRFIND begins theC             search.  Search time depends on the proximityC             of this node to P.CC       N = Number of nodes in the triangulation.  N .GE. 3.CC       X,Y = Arrays of length N containing the CartesianC             coordinates of the nodes.CC       LIST,LPTR,LEND = Data structure defining the trian-C                        gulation.  Refer to TRMESH.CC Input parameters are not altered by this function.CC On output:CC       NEARND = Nodal index of the nearest node to P, or 0C                if N < 3 or the triangulation data struc-C                ture is invalid.CC       DSQ = Squared distance between P and NEARND unlessC             NEARND = 0.CC       Note that the number of candidates for NEARNDC       (neighbors of P) is limited to LMAX defined inC       the PARAMETER statement below.CC Modules required by NEARND:  JRAND, LEFT, LSTPTR, TRFINDCC Intrinsic function called by NEARND:  ABSCC***********************************************************C      INTEGER   LSTPTR      INTEGER   LMAX      PARAMETER (LMAX=25)      INTEGER   I1, I2, I3, L, LISTP(LMAX), LP, LP1, LP2,     .          LPL, LPTRP(LMAX), N1, N2, N3, NR, NST      DOUBLE PRECISION   COS1, COS2, DS1, DSR, DX11, DX12,      .          DX21, DX22, DY11, DY12, DY21, DY22, SIN1,      .          SIN2CC Store local parameters and test for N invalid.C      IF (N .LT. 3) GO TO 7      NST = IST      IF (NST .LT. 1  .OR.  NST .GT. N) NST = 1CC Find a triangle (I1,I2,I3) containing P, or the rightmostC   (I1) and leftmost (I2) visible boundary nodes as viewedC   from P.C      CALL TRFIND (NST,XP,YP,N,X,Y,LIST,LPTR,LEND, I1,I2,I3)CC Test for collinear nodes.C      IF (I1 .EQ. 0) GO TO 7CC Store the linked list of 'neighbors




































' of P in LISTP andC   LPTRP.  I1 is the first neighbor, and 0 is stored asC   the last neighbor if P is not contained in a triangle.C   L is the length of LISTP and LPTRP, and is limited toC   LMAX.C      IF (I3 .NE. 0) THEN        LISTP(1) = I1        LPTRP(1) = 2        LISTP(2) = I2        LPTRP(2) = 3        LISTP(3) = I3        LPTRP(3) = 1        L = 3      ELSE        N1 = I1        L = 1        LP1 = 2        LISTP(L) = N1        LPTRP(L) = LP1CC   Loop on the ordered sequence of visible boundary nodesC     N1 from I1 to I2.C    1   LPL = LEND(N1)          N1 = -LIST(LPL)          L = LP1          LP1 = L+1          LISTP(L) = N1          LPTRP(L) = LP1          IF (N1 .NE. I2  .AND.  LP1 .LT. LMAX) GO TO 1        L = LP1        LISTP(L) = 0        LPTRP(L) = 1      ENDIFCC Initialize variables for a loop on arcs N1-N2 opposite PC   in which new 'neighbors' are 'swapped











































































































































































































































































































































































































































































' in.  N1 followsC   N2 as a neighbor of P, and LP1 and LP2 are the LISTPC   indexes of N1 and N2.C      LP2 = 1      N2 = I1      LP1 = LPTRP(1)      N1 = LISTP(LP1)CC Begin loop:  find the node N3 opposite N1->N2.C    2 LP = LSTPTR(LEND(N1),N2,LIST,LPTR)        IF (LIST(LP) .LT. 0) GO TO 4        LP = LPTR(LP)        N3 = ABS(LIST(LP))CC Swap test:  Exit the loop if L = LMAX.C        IF (L .EQ. LMAX) GO TO 5        DX11 = X(N1) - X(N3)        DX12 = X(N2) - X(N3)        DX22 = X(N2) - XP        DX21 = X(N1) - XPC        DY11 = Y(N1) - Y(N3)        DY12 = Y(N2) - Y(N3)        DY22 = Y(N2) - YP        DY21 = Y(N1) - YPC        COS1 = DX11*DX12 + DY11*DY12        COS2 = DX22*DX21 + DY22*DY21        IF (COS1 .GE. 0.  .AND.  COS2 .GE. 0.) GO TO 4        IF (COS1 .LT. 0.  .AND.  COS2 .LT. 0.) GO TO 3C        SIN1 = DX11*DY12 - DX12*DY11        SIN2 = DX22*DY21 - DX21*DY22        IF (SIN1*COS2 + COS1*SIN2 .GE. 0.) GO TO 4CC Swap:  Insert N3 following N2 in the adjacency list for P.C        The two new arcs opposite P must be tested.C    3   L = L+1        LPTRP(LP2) = L        LISTP(L) = N3        LPTRP(L) = LP1        LP1 = L        N1 = N3        GO TO 2CC No swap:  Advance to the next arc and test for terminationC           on N1 = I1 (LP1 = 1) or N1 followed by 0.C    4   IF (LP1 .EQ. 1) GO TO 5        LP2 = LP1        N2 = N1        LP1 = LPTRP(LP1)        N1 = LISTP(LP1)        IF (N1 .EQ. 0) GO TO 5        GO TO 2CC Set NR and DSR to the index of the nearest node to P andC   its squared distance from P, respectively.C    5 NR = I1      DSR = (X(NR)-XP)**2 + (Y(NR)-YP)**2      DO 6 LP = 2,L        N1 = LISTP(LP)        IF (N1 .EQ. 0) GO TO 6        DS1 = (X(N1)-XP)**2 + (Y(N1)-YP)**2        IF (DS1 .LT. DSR) THEN          NR = N1          DSR = DS1        ENDIF    6   CONTINUE      DSQ = DSR      NEARND = NR      RETURNCC Invalid input.C    7 NEARND = 0      RETURN      END      SUBROUTINE OPTIM (X,Y,NA, LIST,LPTR,LEND,NIT,IWK, IER)      INTEGER NA, LIST(*), LPTR(*), LEND(*), NIT, IWK(2,NA),     .        IER      DOUBLE PRECISION X(*), Y(*)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   06/27/98CC   Given a set of NA triangulation arcs, this subroutineC optimizes the portion of the triangulation consisting ofC the quadrilaterals (pairs of adjacent triangles) whichC have the arcs as diagonals by applying the circumcircleC test and appropriate swaps to the arcs.CC   An iteration consists of applying the swap test andC swaps to all NA arcs in the order in which they areC stored.  The iteration is repeated until no swap occursC or NIT iterations have been performed.  The bound on theC number of iterations may be necessary to prevent anC infinite loop caused by cycling (reversing the effect of aC previous swap) due to floating point inaccuracy when fourC or more nodes are nearly cocircular.CCC On input:CC       X,Y = Arrays containing the nodal coordinates.CC       NA = Number of arcs in the set.  NA .GE. 0.CC The above parameters are not altered by this routine.CC       LIST,LPTR,LEND = Data structure defining the trian-C                        gulation.  Refer to SubroutineC                        TRMESH.CC       NIT = Maximum number of iterations to be performed.C             A reasonable value is 3*NA.  NIT .GE. 1.CC       IWK = Integer array dimensioned 2 by NA containingC             the nodal indexes of the arc endpoints (pairsC             of endpoints are stored in columns).CC On output:CC       LIST,LPTR,LEND = Updated triangulation data struc-C                        ture reflecting the swaps.CC       NIT = Number of iterations performed.CC       IWK = Endpoint indexes of the new set of arcsC             reflecting the swaps.CC       IER = Error indicator:C             IER = 0 if no errors were encountered.C             IER = 1 if a swap occurred on the last ofC                     MAXIT iterations, where MAXIT is theC                     value of NIT on input.  The new setC                     of arcs in not necessarily optimalC                     in this case.C             IER = 2 if NA < 0 or NIT < 1 on input.C             IER = 3 if IWK(2,I) is not a neighbor ofC                     IWK(1,I) for some I in the range 1C                     to NA.  A swap may have occurred inC                     this case.C             IER = 4 if a zero pointer was returned byC                     Subroutine SWAP.CC Modules required by OPTIM:  LSTPTR, SWAP, SWPTSTCC Intrinsic function called by OPTIM:  ABSCC***********************************************************C      LOGICAL SWPTST      INTEGER I, IO1, IO2, ITER, LP, LP21, LPL, LPP, MAXIT,     .        N1, N2, NNA      LOGICAL SWPCC Local parameters:CC I =       Column index for IWKC IO1,IO2 = Nodal indexes of the endpoints of an arc in IWKC ITER =    Iteration countC LP =      LIST pointerC LP21 =    Parameter returned by SWAP (not used)C LPL =     Pointer to the last neighbor of IO1C LPP =     Pointer to the node preceding IO2 as a neighborC             of IO1C MAXIT =   Input value of NITC N1,N2 =   Nodes opposite IO1->IO2 and IO2->IO1,C             respectivelyC NNA =     Local copy of NAC SWP =     Flag set to TRUE iff a swap occurs in theC             optimization loopC      NNA = NA      MAXIT = NIT      IF (NNA .LT. 0  .OR.  MAXIT .LT. 1) GO TO 7CC Initialize iteration count ITER and test for NA = 0.C      ITER = 0      IF (NNA .EQ. 0) GO TO 5CC Top of loop --C   SWP = TRUE iff a swap occurred in the current iteration.C    1 IF (ITER .EQ. MAXIT) GO TO 6      ITER = ITER + 1      SWP = .FALSE.CC   Inner loop on arcs IO1-IO2 --C      DO 4 I = 1,NNA        IO1 = IWK(1,I)        IO2 = IWK(2,I)CC   Set N1 and N2 to the nodes opposite IO1->IO2 andC     IO2->IO1, respectively.  Determine the following:CC     LPL = pointer to the last neighbor of IO1,C     LP = pointer to IO2 as a neighbor of IO1, andC     LPP = pointer to the node N2 preceding IO2.C        LPL = LEND(IO1)        LPP = LPL        LP = LPTR(LPP)    2   IF (LIST(LP) .EQ. IO2) GO TO 3          LPP = LP          LP = LPTR(LPP)          IF (LP .NE. LPL) GO TO 2CC   IO2 should be the last neighbor of IO1.  Test for noC     arc and bypass the swap test if IO1 is a boundaryC     node.C        IF (ABS(LIST(LP)) .NE. IO2) GO TO 8        IF (LIST(LP) .LT. 0) GO TO 4CC   Store N1 and N2, or bypass the swap test if IO1 is aC     boundary node and IO2 is its first neighbor.C    3   N2 = LIST(LPP)        IF (N2 .LT. 0) GO TO 4        LP = LPTR(LP)        N1 = ABS(LIST(LP))CC   Test IO1-IO2 for a swap, and update IWK if necessary.C        IF ( .NOT. SWPTST(N1,N2,IO1,IO2,X,Y) ) GO TO 4        CALL SWAP (N1,N2,IO1,IO2, LIST,LPTR,LEND, LP21)        IF (LP21 .EQ. 0) GO TO 9        SWP = .TRUE.        IWK(1,I) = N1        IWK(2,I) = N2    4   CONTINUE      IF (SWP) GO TO 1CC Successful termination.C    5 NIT = ITER      IER = 0      RETURNCC MAXIT iterations performed without convergence.C    6 NIT = MAXIT      IER = 1      RETURNCC Invalid input parameter.C    7 NIT = 0      IER = 2      RETURNCC IO2 is not a neighbor of IO1.C    8 NIT = ITER      IER = 3      RETURNCC Zero pointer returned by SWAP.C    9 NIT = ITER      IER = 4      RETURN      END      DOUBLE PRECISION FUNCTION STORE (X)      DOUBLE PRECISION XCC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   03/18/90CC   This function forces its argument X to be stored in aC memory location, thus providing a means of determiningC floating point number characteristics (such as the machineC precision) when it is necessary to avoid computation inC high precision registers.CCC On input:CC       X = Value to be stored.CC X is not altered by this function.CC On output:CC       STORE = Value of X after it has been stored andC               possibly truncated or rounded to the singleC               precision word length.CC Modules required by STORE:  NoneCC***********************************************************C      DOUBLE PRECISION Y      COMMON/STCOM/YC      Y = X      STORE = Y      RETURN      END      SUBROUTINE SWAP (IN1,IN2,IO1,IO2, LIST,LPTR,     .                 LEND, LP21)      INTEGER IN1, IN2, IO1, IO2, LIST(*), LPTR(*), LEND(*),     .        LP21CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   06/22/98CC   Given a triangulation of a set of points on the unitC sphere, this subroutine replaces a diagonal arc in aC strictly convex quadrilateral (defined by a pair of adja-C cent triangles) with the other diagonal.  Equivalently, aC pair of adjacent triangles is replaced by another pairC having the same union.CCC On input:CC       IN1,IN2,IO1,IO2 = Nodal indexes of the vertices ofC                         the quadrilateral.  IO1-IO2 is re-C                         placed by IN1-IN2.  (IO1,IO2,IN1)C                         and (IO2,IO1,IN2) must be trian-C                         gles on input.CC The above parameters are not altered by this routine.CC       LIST,LPTR,LEND = Data structure defining the trian-C                        gulation.  Refer to SubroutineC                        TRMESH.CC On output:CC       LIST,LPTR,LEND = Data structure updated with theC                        swap -- triangles (IO1,IO2,IN1) andC                        (IO2,IO1,IN2) are replaced byC                        (IN1,IN2,IO2) and (IN2,IN1,IO1)C                        unless LP21 = 0.CC       LP21 = Index of IN1 as a neighbor of IN2 after theC              swap is performed unless IN1 and IN2 areC              adjacent on input, in which case LP21 = 0.CC Module required by SWAP:  LSTPTRCC Intrinsic function called by SWAP:  ABSCC***********************************************************C      INTEGER LSTPTR      INTEGER LP, LPH, LPSAVCC Local parameters:CC LP,LPH,LPSAV = LIST pointersCCC Test for IN1 and IN2 adjacent.C      LP = LSTPTR(LEND(IN1),IN2,LIST,LPTR)      IF (ABS(LIST(LP)) .EQ. IN2) THEN        LP21 = 0        RETURN      ENDIFCC Delete IO2 as a neighbor of IO1.C      LP = LSTPTR(LEND(IO1),IN2,LIST,LPTR)      LPH = LPTR(LP)      LPTR(LP) = LPTR(LPH)CC If IO2 is the last neighbor of IO1, make IN2 theC   last neighbor.C      IF (LEND(IO1) .EQ. LPH) LEND(IO1) = LPCC Insert IN2 as a neighbor of IN1 following IO1C   using the hole created above.C      LP = LSTPTR(LEND(IN1),IO1,LIST,LPTR)      LPSAV = LPTR(LP)      LPTR(LP) = LPH      LIST(LPH) = IN2      LPTR(LPH) = LPSAVCC Delete IO1 as a neighbor of IO2.C      LP = LSTPTR(LEND(IO2),IN1,LIST,LPTR)      LPH = LPTR(LP)      LPTR(LP) = LPTR(LPH)CC If IO1 is the last neighbor of IO2, make IN1 theC   last neighbor.C      IF (LEND(IO2) .EQ. LPH) LEND(IO2) = LPCC Insert IN1 as a neighbor of IN2 following IO2.C      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)      INTEGER IN1, IN2, IO1, IO2      DOUBLE PRECISION X(*), Y(*)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   09/01/88CC   This function applies the circumcircle test to a quadri-C lateral defined by a pair of adjacent triangles.  TheC diagonal arc (shared triangle side) should be swapped forC the other diagonl if and only if the fourth vertex isC strictly interior to the circumcircle of one of theC triangles (the decision is independent of the choice ofC triangle).  Equivalently, the diagonal is chosen to maxi-C mize the smallest of the six interior angles over the twoC pairs of possible triangles (the decision is for no swapC if the quadrilateral is not strictly convex).CC   When the four vertices are nearly cocircular (theC neutral case), the preferred decision is no swap -- inC order to avoid unnecessary swaps and, more important, toC avoid cycling in Subroutine OPTIM which is called byC DELNOD and EDGE.  Thus, a tolerance SWTOL (stored inC SWPCOM by TRMESH or TRMSHR) is used to define 'nearness

























































































































































































































































































































































































































































































































































































































































































































































































































































































































'C to the neutral case.CCC On input:CC       IN1,IN2,IO1,IO2 = Nodal indexes of the vertices ofC                         the quadrilateral.  IO1-IO2 is theC                         triangulation arc (shared triangleC                         side) to be replaced by IN1-IN2 ifC                         the decision is to swap.  TheC                         triples (IO1,IO2,IN1) and (IO2,C                         IO1,IN2) must define triangles (beC                         in counterclockwise order) on in-C                         put.CC       X,Y = Arrays containing the nodal coordinates.CC Input parameters are not altered by this routine.CC On output:CC       SWPTST = .TRUE. if and only if the arc connectingC                IO1 and IO2 is to be replaced.CC Modules required by SWPTST:  NoneCC***********************************************************C      DOUBLE PRECISION DX11, DX12, DX22, DX21, DY11, DY12, DY22, DY21,     .     SIN1, SIN2, COS1, COS2, SIN12, SWTOLCC Tolerance stored by TRMESH or TRMSHR.C      COMMON/SWPCOM/SWTOLCC Local parameters:CC DX11,DY11 = X,Y components of the vector IN1->IO1C DX12,DY12 = X,Y components of the vector IN1->IO2C DX22,DY22 = X,Y components of the vector IN2->IO2C DX21,DY21 = X,Y components of the vector IN2->IO1C SIN1 =      Cross product of the vectors IN1->IO1 andC               IN1->IO2 -- proportional to sin(T1), whereC               T1 is the angle at IN1 formed by the vectorsC COS1 =      Inner product of the vectors IN1->IO1 andC               IN1->IO2 -- proportional to cos(T1)C SIN2 =      Cross product of the vectors IN2->IO2 andC               IN2->IO1 -- proportional to sin(T2), whereC               T2 is the angle at IN2 formed by the vectorsC COS2 =      Inner product of the vectors IN2->IO2 andC               IN2->IO1 -- proportional to cos(T2)C SIN12 =     SIN1*COS2 + COS1*SIN2 -- proportional toC               sin(T1+T2)CCC Compute the vectors containing the angles T1 and T2.C      DX11 = X(IO1) - X(IN1)      DX12 = X(IO2) - X(IN1)      DX22 = X(IO2) - X(IN2)      DX21 = X(IO1) - X(IN2)C      DY11 = Y(IO1) - Y(IN1)      DY12 = Y(IO2) - Y(IN1)      DY22 = Y(IO2) - Y(IN2)      DY21 = Y(IO1) - Y(IN2)CC Compute inner products.C      COS1 = DX11*DX12 + DY11*DY12      COS2 = DX22*DX21 + DY22*DY21CC The diagonals should be swapped iff (T1+T2) > 180C   degrees.  The following two tests ensure numericalC   stability:  the decision must be FALSE when bothC   angles are close to 0, and TRUE when both anglesC   are close to 180 degrees.C      IF (COS1 .GE. 0.  .AND.  COS2 .GE. 0.) GO TO 2      IF (COS1 .LT. 0.  .AND.  COS2 .LT. 0.) GO TO 1CC Compute vector cross products (Z-components).C      SIN1 = DX11*DY12 - DX12*DY11      SIN2 = DX22*DY21 - DX21*DY22      SIN12 = SIN1*COS2 + COS1*SIN2      IF (SIN12 .GE. -SWTOL) GO TO 2CC Swap.C    1 SWPTST = .TRUE.      RETURNCC No swap.C    2 SWPTST = .FALSE.      RETURN      END      SUBROUTINE TRFIND (NST,PX,PY,N,X,Y,LIST,LPTR,LEND, I1,     .                   I2,I3)      INTEGER NST, N, LIST(*), LPTR(*), LEND(N), I1, I2, I3      DOUBLE PRECISION PX, PY, X(N), Y(N)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   07/28/98CC   This subroutine locates a point P relative to a triangu-C lation created by Subroutine TRMESH or TRMSHR.  If P isC contained in a triangle, the three vertex indexes areC returned.  Otherwise, the indexes of the rightmost andC leftmost visible boundary nodes are returned.CCC On input:CC       NST = Index of a node at which TRFIND begins theC             search.  Search time depends on the proximityC             of this node to P.CC       PX,PY = X and y coordinates of the point P to beC               located.CC       N = Number of nodes in the triangulation.  N .GE. 3.CC       X,Y = Arrays of length N containing the coordinatesC             of the nodes in the triangulation.CC       LIST,LPTR,LEND = Data structure defining the trian-C                        gulation.  Refer to SubroutineC                        TRMESH.CC Input parameters are not altered by this routine.CC On output:CC       I1,I2,I3 = Nodal indexes, in counterclockwise order,C                  of the vertices of a triangle containingC                  P if P is contained in a triangle.  If PC                  is not in the convex hull of the nodes,C                  I1 indexes the rightmost visible boundaryC                  node, I2 indexes the leftmost visibleC                  boundary node, and I3 = 0.  Rightmost andC                  leftmost are defined from the perspectiveC                  of P, and a pair of points are visibleC                  from each other if and only if the lineC                  segment joining them intersects no trian-C                  gulation arc.  If P and all of the nodesC                  lie on a common line, then I1 = I2 = I3 =C                  0 on output.CC Modules required by TRFIND:  JRAND, LEFT, LSTPTR, STORECC Intrinsic function called by TRFIND:  ABSCC***********************************************************C      INTEGER JRAND, LSTPTR      LOGICAL LEFT      DOUBLE PRECISION STORE      INTEGER IX, IY, IZ, LP, N0, N1, N1S, N2, N2S, N3, N4,     .        NB, NF, NL, NP, NPP      LOGICAL FRWRD      DOUBLE PRECISION B1, B2, XA, XB, XC, XP, YA, YB, YC,      .        YPC      SAVE    IX, IY, IZ      DATA    IX/1/, IY/2/, IZ/3/CC Local parameters:CC B1,B2 =    Unnormalized barycentric coordinates of P withC              respect to (N1,N2,N3)C IX,IY,IZ = Integer seeds for JRANDC LP =       LIST pointerC N0,N1,N2 = Nodes in counterclockwise order defining aC              cone (with vertex N0) containing PC N1S,N2S =  Saved values of N1 and N2C N3,N4 =    Nodes opposite N1->N2 and N2->N1, respectivelyC NB =       Index of a boundary node -- first neighbor ofC              NF or last neighbor of NL in the boundaryC              traversal loopsC NF,NL =    First and last neighbors of N0, or firstC              (rightmost) and last (leftmost) nodesC              visible from P when P is exterior to theC              triangulationC NP,NPP =   Indexes of boundary nodes used in the boundaryC              traversal loopsC XA,XB,XC = Dummy arguments for FRWRDC YA,YB,YC = Dummy arguments for FRWRDC XP,YP =    Local variables containing the components of PCC Statement function:CC FRWRD = TRUE iff C is forward of A->BC              iff <A->B,A->C> .GE. 0.C      FRWRD(XA,YA,XB,YB,XC,YC) = (XB-XA)*(XC-XA) +     .                           (YB-YA)*(YC-YA) .GE. 0.CC Initialize variables.C      XP = PX      YP = PY      N0 = NST      IF (N0 .LT. 1  .OR.  N0 .GT. N)     .  N0 = JRAND(N, IX,IY,IZ )CC Set NF and NL to the first and last neighbors of N0, andC   initialize N1 = NF.C    1 LP = LEND(N0)      NL = LIST(LP)      LP = LPTR(LP)      NF = LIST(LP)      N1 = NFCC Find a pair of adjacent neighbors N1,N2 of N0 that defineC   a wedge containing P:  P LEFT N0->N1 and P RIGHT N0->N2.C      IF (NL .GT. 0) GO TO 2CC   N0 is a boundary node.  Test for P exterior.C      NL = -NL      IF ( .NOT. LEFT(X(N0),Y(N0),X(NF),Y(NF),XP,YP) ) THEN        NL = N0        GO TO 9      ENDIF      IF ( .NOT. LEFT(X(NL),Y(NL),X(N0),Y(N0),XP,YP) ) THEN        NB = NF        NF = N0        NP = NL        NPP = N0        GO TO 11      ENDIF      GO TO 3CC   N0 is an interior node.  Find N1.C    2 IF ( LEFT(X(N0),Y(N0),X(N1),Y(N1),XP,YP) ) GO TO 3        LP = LPTR(LP)        N1 = LIST(LP)        IF (N1 .EQ. NL) GO TO 6        GO TO 2CC   P is to the left of edge N0->N1.  Initialize N2 to theC     next neighbor of N0.C    3 LP = LPTR(LP)        N2 = ABS(LIST(LP))        IF ( .NOT. LEFT(X(N0),Y(N0),X(N2),Y(N2),XP,YP) )     .    GO TO 7        N1 = N2        IF (N1 .NE. NL) GO TO 3      IF ( .NOT. LEFT(X(N0),Y(N0),X(NF),Y(NF),XP,YP) )     .  GO TO 6      IF (XP .EQ. X(N0) .AND. YP .EQ. Y(N0)) GO TO 5CC   P is left of or on edges N0->NB for all neighbors NBC     of N0.C   All points are collinear iff P is left of NB->N0 forC     all neighbors NB of N0.  Search the neighbors of N0.C     NOTE -- N1 = NL and LP points to NL.C    4 IF ( .NOT. LEFT(X(N1),Y(N1),X(N0),Y(N0),XP,YP) )     .  GO TO 5        LP = LPTR(LP)        N1 = ABS(LIST(LP))        IF (N1 .EQ. NL) GO TO 17        GO TO 4CC   P is to the right of N1->N0, or P=N0.  Set N0 to N1 andC     start over.C    5 N0 = N1      GO TO 1CC   P is between edges N0->N1 and N0->NF.C    6 N2 = NFCC P is contained in the wedge defined by line segmentsC   N0->N1 and N0->N2, where N1 is adjacent to N2.  SetC   N3 to the node opposite N1->N2, and save N1 and N2 toC   test for cycling.C    7 N3 = N0      N1S = N1      N2S = N2CC Top of edge hopping loop.  Test for termination.C    8 IF ( LEFT(X(N1),Y(N1),X(N2),Y(N2),XP,YP) ) THENCC   P LEFT N1->N2 and hence P is in (N1,N2,N3) unless anC     error resulted from floating point inaccuracy andC     collinearity.  Compute the unnormalized barycentricC     coordinates of P with respect to (N1,N2,N3).C        B1 = (X(N3)-X(N2))*(YP-Y(N2)) -     .       (XP-X(N2))*(Y(N3)-Y(N2))        B2 = (X(N1)-X(N3))*(YP-Y(N3)) -     .       (XP-X(N3))*(Y(N1)-Y(N3))        IF (STORE(B1+1.) .GE. 1.  .AND.     .      STORE(B2+1.) .GE. 1.) GO TO 16CC   Restart with N0 randomly selected.C        N0 = JRAND(N, IX,IY,IZ )        GO TO 1      ENDIFCC   Set N4 to the neighbor of N2 which follows N1 (nodeC     opposite N2->N1) unless N1->N2 is a boundary edge.C      LP = LSTPTR(LEND(N2),N1,LIST,LPTR)      IF (LIST(LP) .LT. 0) THEN        NF = N2        NL = N1        GO TO 9      ENDIF      LP = LPTR(LP)      N4 = ABS(LIST(LP))CC   Select the new edge N1->N2 which intersects the lineC     segment N0-P, and set N3 to the node opposite N1->N2.C      IF ( LEFT(X(N0),Y(N0),X(N4),Y(N4),XP,YP) ) THEN        N3 = N1        N1 = N4        N2S = N2        IF (N1 .NE. N1S  .AND.  N1 .NE. N0) GO TO 8      ELSE        N3 = N2        N2 = N4        N1S = N1        IF (N2 .NE. N2S  .AND.  N2 .NE. N0) GO TO 8      ENDIFCC   The starting node N0 or edge N1-N2 was encounteredC     again, implying a cycle (infinite loop).  RestartC     with N0 randomly selected.C      N0 = JRAND(N, IX,IY,IZ )      GO TO 1CC Boundary traversal loops.  NL->NF is a boundary edge andC   P RIGHT NL->NF.  Save NL and NF.    9 NP = NL      NPP = NFCC Find the first (rightmost) visible boundary node NF.  NBC   is set to the first neighbor of NF, and NP is the lastC   neighbor.C   10 LP = LEND(NF)      LP = LPTR(LP)      NB = LIST(LP)      IF ( .NOT. LEFT(X(NF),Y(NF),X(NB),Y(NB),XP,YP) )     .  GO TO 12CC   P LEFT NF->NB and thus NB is not visible unless an errorC     resulted from floating point inaccuracy and collinear-C     ity of the 4 points NP, NF, NB, and P.C   11 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 13      ENDIFCC   Bottom of loop.C   12 NP = NF      NF = NB      GO TO 10CC Find the last (leftmost) visible boundary node NL.  NBC   is set to the last neighbor of NL, and NPP is the firstC   neighbor.C   13 LP = LEND(NL)      NB = -LIST(LP)      IF ( .NOT. LEFT(X(NB),Y(NB),X(NL),Y(NL),XP,YP) )     .  GO TO 14CC   P LEFT NB->NL and thus NB is not visible unless an errorC     resulted from floating point inaccuracy and collinear-C     ity of the 4 points P, NB, NL, and NPP.C      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 15CC   Bottom of loop.C   14 NPP = NL      NL = NB      GO TO 13CC NL is the leftmost visible boundary node.C   15 I2 = NL      I3 = 0      RETURNCC P is in the triangle (N1,N2,N3).C   16 I1 = N1      I2 = N2      I3 = N3      RETURNCC All points are collinear.C   17 I1 = 0      I2 = 0      I3 = 0      RETURN      END      SUBROUTINE TRLIST (NCC,LCC,N,LIST,LPTR,LEND,NROW, NT,     .                   LTRI,LCT,IER)      INTEGER NCC, LCC(*), N, LIST(*), LPTR(*), LEND(N),     .        NROW, NT, LTRI(NROW,*), LCT(*), IERCC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   03/22/97CC   This subroutine converts a triangulation data structureC from the linked list created by Subroutine TRMESH orC TRMSHR to a triangle list.CC On input:CC       NCC = Number of constraints.  NCC .GE. 0.CC       LCC = List of constraint curve starting indexes (orC             dummy array of length 1 if NCC = 0).  Refer toC             Subroutine ADDCST.CC       N = Number of nodes in the triangulation.  N .GE. 3.CC       LIST,LPTR,LEND = Linked list data structure defin-C                        ing the triangulation.  Refer toC                        Subroutine TRMESH.CC       NROW = Number of rows (entries per triangle) re-C              served for the triangle list LTRI.  The valueC              must be 6 if only the vertex indexes andC              neighboring triangle indexes are to beC              stored, or 9 if arc indexes are also to beC              assigned and stored.  Refer to LTRI.CC The above parameters are not altered by this routine.CC       LTRI = Integer array of length at least NROW*NT,C              where NT is at most 2N-5.  (A sufficientC              length is 12N if NROW=6 or 18N if NROW=9.)CC       LCT = Integer array of length NCC or dummy array ofC             length 1 if NCC = 0.CC On output:CC       NT = Number of triangles in the triangulation unlessC            IER .NE. 0, in which case NT = 0.  NT = 2N - NBC            - 2, where NB is the number of boundary nodes.CC       LTRI = NROW by NT array whose J-th column containsC              the vertex nodal indexes (first three rows),C              neighboring triangle indexes (second threeC              rows), and, if NROW = 9, arc indexes (lastC              three rows) associated with triangle J forC              J = 1,...,NT.  The vertices are orderedC              counterclockwise with the first vertex takenC              to be the one with smallest index.  Thus,C              LTRI(2,J) and LTRI(3,J) are larger thanC              LTRI(1,J) and index adjacent neighbors ofC              node LTRI(1,J).  For I = 1,2,3, LTRI(I+3,J)C              and LTRI(I+6,J) index the triangle and arc,C              respectively, which are opposite (not sharedC              by) node LTRI(I,J), with LTRI(I+3,J) = 0 ifC              LTRI(I+6,J) indexes a boundary arc.  VertexC              indexes range from 1 to N, triangle indexesC              from 0 to NT, and, if included, arc indexesC              from 1 to NA = NT+N-1.  The triangles are or-C              dered on first (smallest) vertex indexes,C              except that the sets of constraint trianglesC              (triangles contained in the closure of a con-C              straint region) follow the non-constraintC              triangles.CC       LCT = Array of length NCC containing the triangleC             index of the first triangle of constraint J inC             LCT(J).  Thus, the number of non-constraintC             triangles is LCT(1)-1, and constraint J con-C             tains LCT(J+1)-LCT(J) triangles, whereC             LCT(NCC+1) = NT+1.CC       IER = Error indicator.C             IER = 0 if no errors were encountered.C             IER = 1 if NCC, N, NROW, or an LCC entry isC                     outside its valid range on input.C             IER = 2 if the triangulation data structureC                     (LIST,LPTR,LEND) is invalid.  Note,C                     however, that these arrays are notC                     completely tested for validity.CC Modules required by TRLIST:  NoneCC Intrinsic function called by TRLIST:  ABSCC***********************************************************C      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, PASS2CC Test for invalid input parameters and store the indexC   LCC1 of the first constraint node (if any).C      NN = N      IF (NCC .LT. 0  .OR.  (NROW .NE. 6  .AND.     .    NROW .NE. 9)) GO TO 12      LCC1 = NN+1      IF (NCC .EQ. 0) THEN        IF (NN .LT. 3) GO TO 12      ELSE        DO 1 I = NCC,1,-1          IF (LCC1-LCC(I) .LT. 3) GO TO 12          LCC1 = LCC(I)    1     CONTINUE        IF (LCC1 .LT. 1) GO TO 12      ENDIFCC Initialize parameters for loop on triangles KT = (N1,N2,C   N3), where N1 < N2 and N1 < N3.  This requires twoC   passes through the nodes with all non-constraintC   triangles stored on the first pass, and the constraintC   triangles stored on the second.CC   ARCS = TRUE iff arc indexes are to be stored.C   KA,KT = Numbers of currently stored arcs and triangles.C   N1ST = Starting index for the loop on nodes (N1ST = 1 onC            pass 1, and N1ST = LCC1 on pass 2).C   NM2 = Upper bound on candidates for N1.C   PASS2 = TRUE iff constraint triangles are to be stored.C      ARCS = NROW .EQ. 9      KA = 0      KT = 0      N1ST = 1      NM2 = NN-2      PASS2 = .FALSE.CC Loop on nodes N1:  J = constraint containing N1,C                    JLAST = last node in constraint J.C    2 J = 0      JLAST = LCC1 - 1      DO 11 N1 = N1ST,NM2        IF (N1 .GT. JLAST) THENCC N1 is the first node in constraint J+1.  Update J andC   JLAST, and store the first constraint triangle indexC   if in pass 2.C          J = J + 1          IF (J .LT. NCC) THEN            JLAST = LCC(J+1) - 1          ELSE            JLAST = NN          ENDIF          IF (PASS2) LCT(J) = KT + 1        ENDIFCC Loop on pairs of adjacent neighbors (N2,N3).  LPLN1 pointsC   to the last neighbor of N1, and LP2 points to N2.C        LPLN1 = LEND(N1)        LP2 = LPLN1    3     LP2 = LPTR(LP2)          N2 = LIST(LP2)          LP = LPTR(LP2)          N3 = ABS(LIST(LP))          IF (N2 .LT. N1  .OR.  N3 .LT. N1) GO TO 10CC (N1,N2,N3) is a constraint triangle iff the three nodesC   are in the same constraint and N2 < N3.  Bypass con-C   straint triangles on pass 1 and non-constraint trianglesC   on pass 2.C          CSTRI = N1 .GE. LCC1  .AND.  N2 .LT. N3  .AND.     .            N3 .LE. JLAST          IF ((CSTRI  .AND.  .NOT. PASS2)  .OR.     .        (.NOT. CSTRI  .AND.  PASS2)) GO TO 10CC Add a new triangle KT = (N1,N2,N3).C          KT = KT + 1          LTRI(1,KT) = N1          LTRI(2,KT) = N2          LTRI(3,KT) = N3CC Loop on triangle sides (I1,I2) with neighboring trianglesC   KN = (I1,I2,I3).C          DO 9 I = 1,3            IF (I .EQ. 1) THEN              I1 = N3              I2 = N2            ELSEIF (I .EQ. 2) THEN              I1 = N1              I2 = N3            ELSE              I1 = N2              I2 = N1            ENDIFCC Set I3 to the neighbor of I1 which follows I2 unlessC   I2->I1 is a boundary arc.C            LPL = LEND(I1)            LP = LPTR(LPL)    4       IF (LIST(LP) .EQ. I2) GO TO 5              LP = LPTR(LP)              IF (LP .NE. LPL) GO TO 4CC   I2 is the last neighbor of I1 unless the data structureC     is invalid.  Bypass the search for a neighboringC     triangle if I2->I1 is a boundary arc.C            IF (ABS(LIST(LP)) .NE. I2) GO TO 13            KN = 0            IF (LIST(LP) .LT. 0) GO TO 8CC   I2->I1 is not a boundary arc, and LP points to I2 asC     a neighbor of I1.C    5       LP = LPTR(LP)            I3 = ABS(LIST(LP))CC Find L such that LTRI(L,KN) = I3 (not used if KN > KT),C   and permute the vertex indexes of KN so that I1 isC   smallest.C            IF (I1 .LT. I2  .AND.  I1 .LT. I3) THEN              L = 3            ELSEIF (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            ENDIFCC Test for KN > KT (triangle index not yet assigned).C            IF (I1 .GT. N1  .AND.  .NOT. PASS2) GO TO 9CC Find KN, if it exists, by searching the triangle list inC   reverse order.C            DO 6 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 7    6         CONTINUE            GO TO 9CC Store KT as a neighbor of KN.C    7       LTRI(L+3,KN) = KTCC Store KN as a neighbor of KT, and add a new arc KA.C    8       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            ENDIF    9       CONTINUECC Bottom of loop on triangles.C   10     IF (LP2 .NE. LPLN1) GO TO 3   11     CONTINUECC Bottom of loop on nodes.C      IF (.NOT. PASS2  .AND.  NCC .GT. 0) THEN        PASS2 = .TRUE.        N1ST = LCC1        GO TO 2      ENDIFCC No errors encountered.C      NT = KT      IER = 0      RETURNCC Invalid input parameter.C   12 NT = 0      IER = 1      RETURNCC Invalid triangulation data structure:  I1 is a neighbor ofC   I2, but I2 is not a neighbor of I1.C   13 NT = 0      IER = 2      RETURN      END      SUBROUTINE TRLPRT (NCC,LCT,N,X,Y,NROW,NT,LTRI,LOUT,     .                   PRNTX)      INTEGER NCC, LCT(*), N, NROW, NT, LTRI(NROW,NT),     .        LOUT      LOGICAL PRNTX      DOUBLE PRECISION X(N), Y(N)CC***********************************************************CC                                               From TRLPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   07/02/98CC   Given a triangulation of a set of points in the plane,C this subroutine prints the triangle list created byC Subroutine TRLIST and, optionally, the nodal coordinatesC on logical unit LOUT.  The numbers of boundary nodes,C triangles, and arcs, and the constraint region triangleC indexes, if any, are also printed.CC   All parameters other than LOUT and PRNTX should beC unaltered from their values on output from TRLIST.CCC On input:CC       NCC = Number of constraints.CC       LCT = List of constraint triangle starting indexesC             (or dummy array of length 1 if NCC = 0).CC       N = Number of nodes in the triangulation.C           3 .LE. N .LE. 9999.CC       X,Y = Arrays of length N containing the coordinatesC             of the nodes in the triangulation -- not usedC             unless PRNTX = TRUE.CC       NROW = Number of rows (entries per triangle) re-C              served for the triangle list LTRI.  The valueC              must be 6 if only the vertex indexes andC              neighboring triangle indexes are stored, or 9C              if arc indexes are also stored.CC       NT = Number of triangles in the triangulation.C            1 .LE. NT .LE. 9999.CC       LTRI = NROW by NT array whose J-th column containsC              the vertex nodal indexes (first three rows),C              neighboring triangle indexes (second threeC              rows), and, if NROW = 9, arc indexes (lastC              three rows) associated with triangle J forC              J = 1,...,NT.CC       LOUT = Logical unit number for output.  0 .LE. LOUTC              .LE. 99.  Output is printed on unit 6 if LOUTC              is outside its valid range on input.CC       PRNTX = Logical variable with value TRUE if and onlyC               if X and Y are to be printed (to 6 decimalC               places).CC None of the parameters are altered by this routine.CC Modules required by TRLPRT:  NoneCC***********************************************************C      INTEGER I, K, LUN, NA, NB, NL, NLMAX, NMAX      DATA    NMAX/9999/,  NLMAX/60/CC Local parameters:CC   I = DO-loop, nodal index, and row index for LTRIC   K = DO-loop and triangle indexC   LUN = Logical unit number for outputC   NA = Number of triangulation arcsC   NB = Number of boundary nodesC   NL = Number of lines printed on the current pageC   NLMAX = Maximum number of print lines per pageC   NMAX = Maximum value of N and NT (4-digit format)C      LUN = LOUT      IF (LUN .LT. 0  .OR.  LUN .GT. 99) LUN = 6CC Print a heading and test for invalid input.C      WRITE (LUN,100)      NL = 1      IF (N .LT. 3  .OR.  N .GT. NMAX  .OR.     .    (NROW .NE. 6  .AND.  NROW .NE. 9)  .OR.     .    NT .LT. 1  .OR.  NT .GT. NMAX) THENCC Print an error message and bypass the loops.C        WRITE (LUN,110) N, NROW, NT        GO TO 3      ENDIF      IF (PRNTX) THENCC Print X and Y.C        WRITE (LUN,101)        NL = 6        DO 1 I = 1,N          IF (NL .GE. NLMAX) THEN            WRITE (LUN,106)            NL = 0          ENDIF          WRITE (LUN,102) I, X(I), Y(I)          NL = NL + 1    1     CONTINUE      ENDIFCC Print the triangulation LTRI.C      IF (NL .GT. NLMAX/2) THEN        WRITE (LUN,106)        NL = 0      ENDIF      IF (NROW .EQ. 6) THEN        WRITE (LUN,103)      ELSE        WRITE (LUN,104)      ENDIF      NL = NL + 5      DO 2 K = 1,NT        IF (NL .GE. NLMAX) THEN          WRITE (LUN,106)          NL = 0        ENDIF        WRITE (LUN,105) K, (LTRI(I,K), I = 1,NROW)        NL = NL + 1    2   CONTINUECC Print NB, NA, and NT (boundary nodes, arcs, andC   triangles).C      NB = 2*N - NT - 2      NA = NT + N - 1      IF (NL .GT. NLMAX-6) WRITE (LUN,106)      WRITE (LUN,107) NB, NA, NTCC Print NCC and LCT.C    3 WRITE (LUN,108) NCC      IF (NCC .GT. 0) WRITE (LUN,109) (LCT(I), I = 1,NCC)      RETURNCC Print formats:C  100 FORMAT (///,24X,'TRIPACK (TRLIST) Output
')  101 FORMAT (//16X,'Node',7X,'X(Node)',10X,'Y(Node)

'//)  102 FORMAT (16X,I4,2E17.6)  103 FORMAT (//1X,'Triangle',8X,'Vertices',12X,'Neighbors
'/     .        4X,'KT',7X,'N1',5X,'N2',5X,'N3',4X,'KT1
',4X,     .        'KT2',4X,'KT3
'/)  104 FORMAT (//1X,'Triangle',8X,'Vertices',12X,'Neighbors
',     .        14X,'Arcs
'/     .        4X,'KT',7X,'N1',5X,'N2',5X,'N3',4X,'KT1
',4X,     .        'KT2',4X,'KT3',4X,'KA1',4X,'KA2',4X,'KA3


'/)  105 FORMAT (2X,I4,2X,6(3X,I4),3(2X,I5))  106 FORMAT (///)  107 FORMAT (/1X,'NB = ',I4,' Boundary Nodes
',5X,     .        'NA = ',I5,' Arcs',5X,'NT = 
',I5,     .        ' Triangles
')  108 FORMAT (/1X,'NCC =',I3,' Constraint Curves

')  109 FORMAT (1X,9X,14I5)  110 FORMAT (//1X,10X,'*** Invalid Parameter:  N =
',I5,     .        ', NROW =',I5,', NT =',I5,' ***








































































































































































































































































































































')      END      SUBROUTINE TRMESH (N,X,Y, LIST,LPTR,LEND,LNEW,NEAR,     .                   NEXT,DIST,IER)      INTEGER N, LIST(*), LPTR(*), LEND(N), LNEW, NEAR(N),     .        NEXT(N), IER      DOUBLE PRECISION X(N), Y(N), DIST(N)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   06/28/98CC   This subroutine creates a Delaunay triangulation of aC set of N arbitrarily distributed points in the plane re-C ferred to as nodes.  The Delaunay triangulation is definedC as a set of triangles with the following five properties:CC  1)  The triangle vertices are nodes.C  2)  No triangle contains a node other than its vertices.C  3)  The interiors of the triangles are pairwise disjoint.C  4)  The union of triangles is the convex hull of the setC        of nodes (the smallest convex set which containsC        the nodes).C  5)  The interior of the circumcircle of each triangleC        contains no node.CC The first four properties define a triangulation, and theC last property results in a triangulation which is as closeC as possible to equiangular in a certain sense and which isC uniquely defined unless four or more nodes lie on a commonC circle.  This property makes the triangulation well-suitedC for solving closest point problems and for triangle-basedC interpolation.CC   The triangulation can be generalized to a constrainedC Delaunay triangulation by a call to Subroutine ADDCST.C This allows for user-specified boundaries defining a non-C convex and/or multiply connected region.CC   The algorithm for constructing the triangulation hasC expected time complexity O(N*log(N)) for most nodal dis-C tributions.  Also, since the algorithm proceeds by addingC nodes incrementally, the triangulation may be updated withC the addition (or deletion) of a node very efficiently.C The adjacency information representing the triangulationC is stored as a linked list requiring approximately 13NC storage locations.CCC   The following is a list of the software package modulesC which a user may wish to call directly:CC  ADDCST - Generalizes the Delaunay triangulation to allowC             for user-specified constraints.CC  ADDNOD - Updates the triangulation by appending orC             inserting a new node.CC  AREAP  - Computes the area bounded by a closed polygonalC             curve such as the boundary of the triangula-C             tion or of a constraint region.CC  BNODES - Returns an array containing the indexes of theC             boundary nodes in counterclockwise order.C             Counts of boundary nodes, triangles, and arcsC             are also returned.CC  CIRCUM - Computes the area, circumcenter, circumradius,C             and, optionally, the aspect ratio of a trian-C             gle defined by user-specified vertices.CC  DELARC - Deletes a boundary arc from the triangulation.CC  DELNOD - Updates the triangulation with the deletion of aC             node.CC  EDGE   - Forces a pair of nodes to be connected by an arcC             in the triangulation.CC  GETNP  - Determines the ordered sequence of L closestC             nodes to a given node, along with the associ-C             ated distances.  The distance between nodes isC             taken to be the length of the shortest connec-C             ting path which intersects no constraintC             region.CC  INTSEC - Determines whether or not an arbitrary pair ofC             line segments share a common point.CC  JRAND  - Generates a uniformly distributed pseudo-randomC             integer.CC  LEFT   - Locates a point relative to a line.CC  NEARND - Returns the index of the nearest node to anC             arbitrary point, along with its squaredC             distance.CC  STORE  - Forces a value to be stored in main memory soC             that the precision of floating point numbersC             in memory locations rather than registers isC             computed.CC  TRLIST - Converts the triangulation data structure to aC             triangle list more suitable for use in a fin-C             ite element code.CC  TRLPRT - Prints the triangle list created by SubroutineC             TRLIST.CC  TRMESH - Creates a Delaunay triangulation of a set ofC             nodes.CC  TRMSHR - Creates a Delaunay triangulation (more effici-C             ently than TRMESH) of a set of nodes lying atC             the vertices of a (possibly skewed) rectangu-C             lar grid.CC  TRPLOT - Creates a level-2 Encapsulated Postscript (EPS)C             file containing a triangulation plot.CC  TRPRNT - Prints the triangulation data structure and,C             optionally, the nodal coordinates.CCC On input:CC       N = Number of nodes in the triangulation.  N .GE. 3.CC       X,Y = Arrays of length N containing the CartesianC             coordinates of the nodes.  (X(K),Y(K)) is re-C             ferred to as node K, and K is referred to asC             a nodal index.  The first three nodes must notC             be collinear.CC The above parameters are not altered by this routine.CC       LIST,LPTR = Arrays of length at least 6N-12.CC       LEND = Array of length at least N.CC       NEAR,NEXT,DIST = Work space arrays of length atC                        least N.  The space is used toC                        efficiently determine the nearestC                        triangulation node to each un-C                        processed node for use by ADDNOD.CC On output:CC       LIST = Set of nodal indexes which, along with LPTR,C              LEND, and LNEW, define the triangulation as aC              set of N adjacency lists -- counterclockwise-C              ordered sequences of neighboring nodes suchC              that the first and last neighbors of a bound-C              ary node are boundary nodes (the first neigh-C              bor of an interior node is arbitrary).  InC              order to distinguish between interior andC              boundary nodes, the last neighbor of eachC              boundary node is represented by the negativeC              of its index.CC       LPTR = Set of pointers (LIST indexes) in one-to-oneC              correspondence with the elements of LIST.C              LIST(LPTR(I)) indexes the node which followsC              LIST(I) in cyclical counterclockwise orderC              (the first neighbor follows the last neigh-C              bor).CC       LEND = Set of pointers to adjacency lists.  LEND(K)C              points to the last neighbor of node K forC              K = 1,...,N.  Thus, LIST(LEND(K)) < 0 if andC              only if K is a boundary node.CC       LNEW = Pointer to the first empty location in LISTC              and LPTR (list length plus one).  LIST, LPTR,C              LEND, and LNEW are not altered if IER < 0,C              and are incomplete if IER > 0.CC       NEAR,NEXT,DIST = Garbage.CC       IER = Error indicator:C             IER =  0 if no errors were encountered.C             IER = -1 if N < 3 on input.C             IER = -2 if the first three nodes areC                      collinear.C             IER = -4 if an error flag was returned by aC                      call to SWAP in ADDNOD.  This is anC                      internal error and should be reportedC                      to the programmer.C             IER =  L if nodes L and M coincide for someC                      M > L.  The linked list representsC                      a triangulation of nodes 1 to M-1C                      in this case.CC Modules required by TRMESH:  ADDNOD, BDYADD, INSERT,C                                INTADD, JRAND, LEFT,C                                LSTPTR, STORE, SWAP,C                                SWPTST, TRFINDCC Intrinsic function called by TRMESH:  ABSCC***********************************************************C      LOGICAL LEFT      DOUBLE PRECISION STORE      INTEGER I, I0, J, K, KM1, LCC(1), LP, LPL, NCC, NEXTI,     .        NN      DOUBLE PRECISION D, D1, D2, D3, EPS, SWTOL      COMMON/SWPCOM/SWTOLCC Local parameters:CC D =        Squared distance from node K to node IC D1,D2,D3 = Squared distances from node K to nodes 1, 2,C              and 3, respectivelyC EPS =      Half the machine precisionC I,J =      Nodal indexesC I0 =       Index of the node preceding I in a sequence ofC              unprocessed nodes:  I = NEXT(I0)C K =        Index of node to be added and DO-loop index:C              K > 3C KM1 =      K-1C LCC(1) =   Dummy arrayC LP =       LIST index (pointer) of a neighbor of KC LPL =      Pointer to the last neighbor of KC NCC =      Number of constraint curvesC NEXTI =    NEXT(I)C NN =       Local copy of NC SWTOL =    Tolerance for function SWPTSTC      NN = N      IF (NN .LT. 3) THEN        IER = -1        RETURN      ENDIFCC Compute a tolerance for function SWPTST:  SWTOL = 10*C   (machine precision)C      EPS = 1.    1 EPS = EPS/2.        SWTOL = STORE(EPS + 1.)        IF (SWTOL .GT. 1.) GO TO 1      SWTOL = EPS*20.CC Store the first triangle in the linked list.C      IF ( .NOT. LEFT(X(1),Y(1),X(2),Y(2),X(3),Y(3)) ) THENCC   The initial triangle is (3,2,1) = (2,1,3) = (1,3,2).C        LIST(1) = 3        LPTR(1) = 2        LIST(2) = -2        LPTR(2) = 1        LEND(1) = 2C        LIST(3) = 1        LPTR(3) = 4        LIST(4) = -3        LPTR(4) = 3        LEND(2) = 4C        LIST(5) = 2        LPTR(5) = 6        LIST(6) = -1        LPTR(6) = 5        LEND(3) = 6C      ELSEIF ( .NOT. LEFT(X(2),Y(2),X(1),Y(1),X(3),Y(3)) )     .       THENCC   The initial triangle is (1,2,3).C        LIST(1) = 2        LPTR(1) = 2        LIST(2) = -3        LPTR(2) = 1        LEND(1) = 2C        LIST(3) = 3        LPTR(3) = 4        LIST(4) = -1        LPTR(4) = 3        LEND(2) = 4C        LIST(5) = 1        LPTR(5) = 6        LIST(6) = -2        LPTR(6) = 5        LEND(3) = 6C      ELSECC   The first three nodes are collinear.C        IER = -2        RETURN      ENDIFCC Initialize LNEW and test for N = 3.C      LNEW = 7      IF (NN .EQ. 3) THEN        IER = 0        RETURN      ENDIFCC A nearest-node data structure (NEAR, NEXT, and DIST) isC   used to obtain an expected-time (N*log(N)) incrementalC   algorithm by enabling constant search time for locatingC   each new node in the triangulation.CC For each unprocessed node K, NEAR(K) is the index of theC   triangulation node closest to K (used as the startingC   point for the search in Subroutine TRFIND) and DIST(K)C   is an increasing function of the distance between nodesC   K and NEAR(K).CC Since it is necessary to efficiently find the subset ofC   unprocessed nodes associated with each triangulationC   node J (those that have J as their NEAR entries), theC   subsets are stored in NEAR and NEXT as follows:  forC   each node J in the triangulation, I = NEAR(J) is theC   first unprocessed node in J's set (with I = 0 if the
C   set is empty), L = NEXT(I) (if I > 0) is the second,
C   NEXT(L) (if L > 0) is the third, etc.  The nodes in each
C   set are initially ordered by increasing indexes (which
C   maximizes efficiency) but that ordering is not main-
C   tained as the data structure is updated.
C
C Initialize the data structure for the single triangle.
C
      NEAR(1) = 0
      NEAR(2) = 0
      NEAR(3) = 0
      DO 2 K = NN,4,-1
        D1 = (X(K)-X(1))**2 + (Y(K)-Y(1))**2
        D2 = (X(K)-X(2))**2 + (Y(K)-Y(2))**2
        D3 = (X(K)-X(3))**2 + (Y(K)-Y(3))**2
        IF (D1 .LE. D2  .AND.  D1 .LE. D3) THEN
          NEAR(K) = 1
          DIST(K) = D1
          NEXT(K) = NEAR(1)
          NEAR(1) = K
        ELSEIF (D2 .LE. D1  .AND.  D2 .LE. D3) THEN
          NEAR(K) = 2
          DIST(K) = D2
          NEXT(K) = NEAR(2)
          NEAR(2) = K
        ELSE
          NEAR(K) = 3
          DIST(K) = D3
          NEXT(K) = NEAR(3)
          NEAR(3) = K
        ENDIF
    2   CONTINUE
C
C Add the remaining nodes.  Parameters for ADDNOD are as
C   follows:
C
C   K = Index of the node to be added.
C   NEAR(K) = Index of the starting node for the search in
C             TRFIND.
C   NCC = Number of constraint curves.
C   LCC = Dummy array (since NCC = 0).
C   KM1 = Number of nodes in the triangulation.
C
      NCC = 0
      DO 7 K = 4,NN
        KM1 = K-1
        CALL ADDNOD (K,X(K),Y(K),NEAR(K),NCC, LCC,KM1,X,Y,
     .               LIST,LPTR,LEND,LNEW, IER)
        IF (IER .NE. 0) RETURN
C
C Remove K from the set of unprocessed nodes associated
C   with NEAR(K).
C
        I = NEAR(K)
        IF (NEAR(I) .EQ. K) THEN
          NEAR(I) = NEXT(K)
        ELSE
          I = NEAR(I)
    3     I0 = I
            I = NEXT(I0)
            IF (I .NE. K) GO TO 3
          NEXT(I0) = NEXT(K)
        ENDIF
        NEAR(K) = 0
C
C Loop on neighbors J of node K.
C
        LPL = LEND(K)
        LP = LPL
    4   LP = LPTR(LP)
          J = ABS(LIST(LP))
C
C Loop on elements I in the sequence of unprocessed nodes
C   associated with J:  K is a candidate for replacing J
C   as the nearest triangulation node to I.  The next value
C   of I in the sequence, NEXT(I), must be saved before I
C   is moved because it is altered by adding I to K












's set.C          I = NEAR(J)    5     IF (I .EQ. 0) GO TO 6          NEXTI = NEXT(I)CC Test for the distance from I to K less than the distanceC   from I to J.C          D = (X(K)-X(I))**2 + (Y(K)-Y(I))**2          IF (D .LT. DIST(I)) THENCC Replace J by K as the nearest triangulation node to I:C   update NEAR(I) and DIST(I), and remove I from J's set
C   of unprocessed nodes and add it to K






























































































































































































































































































































































































































































































































's set.C            NEAR(I) = K            DIST(I) = D            IF (I .EQ. NEAR(J)) THEN              NEAR(J) = NEXTI            ELSE              NEXT(I0) = NEXTI            ENDIF            NEXT(I) = NEAR(K)            NEAR(K) = I          ELSE            I0 = I          ENDIFCC Bottom of loop on I.C          I = NEXTI          GO TO 5CC Bottom of loop on neighbors J.C    6     IF (LP .NE. LPL) GO TO 4    7   CONTINUE      RETURN      END      SUBROUTINE TRMSHR (N,NX,X,Y, NIT, LIST,LPTR,LEND,LNEW,     .                   IER)      INTEGER  N, NX, NIT, LIST(*), LPTR(*), LEND(N), LNEW,     .         IER      DOUBLE PRECISION  X(N), Y(N)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   06/27/98CC   This subroutine creates a Delaunay triangulation of aC set of N nodes in the plane, where the nodes are the vert-C ices of an NX by NY skewed rectangular grid with theC natural ordering.  Thus, N = NX*NY, and the nodes areC ordered from left to right beginning at the top row soC that adjacent nodes have indexes which differ by 1 in theC x-direction and by NX in the y-direction.  A skewed rec-C tangular grid is defined as one in which each grid cell isC a strictly convex quadrilateral (and is thus the convexC hull of its four vertices).  Equivalently, any transfor-C mation from a rectangle to a grid cell which is bilinearC in both components has an invertible Jacobian.CC   If the nodes are not distributed and ordered as definedC above, Subroutine TRMESH must be called in place of thisC routine.  Refer to Subroutine ADDCST for the treatment ofC constraints.CC   The first phase of the algorithm consists of construc-C ting a triangulation by choosing a diagonal arc in eachC grid cell.  If NIT = 0, all diagonals connect lower leftC to upper right corners and no error checking or additionalC computation is performed.  Otherwise, each diagonal arc isC chosen to be locally optimal, and boundary arcs are addedC where necessary in order to cover the convex hull of theC nodes.  (This is the first iteration.)  If NIT > 1 and noC error was detected, the triangulation is then optimized byC a sequence of up to NIT-1 iterations in which interiorC arcs of the triangulation are tested and swapped if appro-C priate.  The algorithm terminates when an iterationC results in no swaps and/or when the allowable number ofC iterations has been performed.  NIT = 0 is sufficient toC produce a Delaunay triangulation if the original grid isC actually rectangular, and NIT = 1 is sufficient if it isC close to rectangular.  Note, however, that the orderingC and distribution of nodes is not checked for validity inC the case NIT = 0, and the triangulation will not be validC unless the rectangular grid covers the convex hull of theC nodes.CCC On input:CC       N = Number of nodes in the grid.  N = NX*NY for someC           NY .GE. 2.CC       NX = Number of grid points in the x-direction.  NXC            .GE. 2.CC       X,Y = Arrays of length N containing coordinates ofC             the nodes with the ordering and distributionC             defined in the header comments above.C             (X(K),Y(K)) is referred to as node K.CC The above parameters are not altered by this routine.CC       NIT = Nonnegative integer specifying the maximumC             number of iterations to be employed.  ReferC             to the header comments above.CC       LIST,LPTR = Arrays of length at least 6N-12.CC       LEND = Array of length at least N.CC On output:CC       NIT = Number of iterations employed.CC       LIST,LPTR,LEND,LNEW = Data structure defining theC                             triangulation.  Refer to Sub-C                             routine TRMESH.CC       IER = Error indicator:C             IER = 0 if no errors were encountered.C             IER = K if the grid element with upper leftC                     corner at node K is not a strictlyC                     convex quadrilateral.  The algorithmC                     is terminated when the first suchC                     occurrence is detected.  Note thatC                     this test is not performed if NIT = 0C                     on input.C             IER = -1 if N, NX, or NIT is outside its validC                      range on input.C             IER = -2 if NIT > 1 on input, and the optimi-C                      zation loop failed to converge withinC                      the allowable number of iterations.C                      The triangulation is valid but notC                      optimal in this case.CC Modules required by TRMSHR:  INSERT, LEFT, LSTPTR, NBCNT,C                                STORE, SWAP, SWPTSTCC Intrinsic function called by TRMSHR:  ABSCC***********************************************************C      INTEGER LSTPTR, NBCNT      LOGICAL LEFT, SWPTST      DOUBLE PRECISION STORE      INTEGER I, ITER, J, K, KP1, LP, LPF, LPK, LPL, LPP,     .        M1, M2, M3, M4, MAXIT, N0, N1, N2, N3, N4, NI,     .        NJ, NM1, NN, NNB      LOGICAL TST      DOUBLE PRECISION EPS, SWTOL      COMMON/SWPCOM/SWTOLCC Store local variables and test for errors in inputC   parameters.C      NI = NX      NJ = N/NI      NN = NI*NJ      MAXIT = NIT      NIT = 0      IF (N .NE. NN  .OR.  NJ .LT. 2  .OR.  NI .LT. 2  .OR.     .    MAXIT .LT. 0) THEN        IER = -1        RETURN      ENDIF      IER = 0CC Compute a tolerance for function SWPTST:  SWTOL = 10*C   (machine precision)C      EPS = 1.    1 EPS = EPS/2.        SWTOL = STORE(EPS + 1.)        IF (SWTOL .GT. 1.) GO TO 1      SWTOL = EPS*20.CC Loop on grid points (I,J) corresponding to nodes K =C   (J-1)*NI + I.  TST = TRUE iff diagonals are to beC   chosen by the swap test.  M1, M2, M3, and M4 are theC   slopes (-1, 0, or 1) of the diagonals in quadrants 1C   to 4 (counterclockwise beginning with the upper right)C   for a coordinate system with origin at node K.C      TST = MAXIT .GT. 0      M1 = 0      M4 = 0      LP = 0      KP1 = 1      DO 6 J = 1,NJ        DO 5 I = 1,NI          M2 = M1          M3 = M4          K = KP1          KP1 = K + 1          LPF = LP + 1          IF (J .EQ. NJ  .AND.  I .NE. NI) GO TO 2          IF (I .NE. 1) THEN            IF (J .NE. 1) THENCC   K is not in the top row, leftmost column, or bottom rowC     (unless K is the lower right corner).  Take the firstC     neighbor to be the node above K.C              LP = LP + 1              LIST(LP) = K - NI              LPTR(LP) = LP + 1              IF (M2 .LE. 0) THEN                LP = LP + 1                LIST(LP) = K - 1 - NI                LPTR(LP) = LP + 1              ENDIF            ENDIFCC   K is not in the leftmost column.  The next (or first)C     neighbor is to the left of K.C            LP = LP + 1            LIST(LP) = K - 1            LPTR(LP) = LP + 1            IF (J .EQ. NJ) GO TO 3            IF (M3 .GE. 0) THEN              LP = LP + 1              LIST(LP) = K - 1 + NI              LPTR(LP) = LP + 1            ENDIF          ENDIFCC   K is not in the bottom row.  The next (or first)C     neighbor is below K.C          LP = LP + 1          LIST(LP) = K + NI          LPTR(LP) = LP + 1CC   Test for a negative diagonal in quadrant 4 unless K isC     in the rightmost column.  The quadrilateral associatedC     with the quadrant is tested for strict convexity un-C     less NIT = 0 on input.C          IF (I .EQ. NI) GO TO 3          M4 = 1          IF (.NOT. TST) GO TO 2          IF ( LEFT(X(KP1),Y(KP1),X(K+NI),Y(K+NI),X(K),Y(K))     .         .OR.  LEFT(X(K),Y(K),X(KP1+NI),Y(KP1+NI),     .                    X(K+NI),Y(K+NI))     .         .OR.  LEFT(X(K+NI),Y(K+NI),X(KP1),Y(KP1),     .                    X(KP1+NI),Y(KP1+NI))     .         .OR.  LEFT(X(KP1+NI),Y(KP1+NI),X(K),Y(K),     .                    X(KP1),Y(KP1)) )          GO TO 12          IF ( SWPTST(KP1,K+NI,K,KP1+NI,X,Y) ) GO TO 2          M4 = -1          LP = LP + 1          LIST(LP) = KP1 + NI          LPTR(LP) = LP + 1CC   The next (or first) neighbor is to the right of K.C    2     LP = LP + 1          LIST(LP) = KP1          LPTR(LP) = LP + 1CC   Test for a positive diagonal in quadrant 1 (the neighborC     of K-NI which follows K is not K+1) unless K is in theC     top row.C          IF (J .EQ. 1) GO TO 3          IF (TST) THEN            M1 = -1            LPK = LSTPTR(LEND(K-NI),K,LIST,LPTR)            LPK = LPTR(LPK)            IF (LIST(LPK) .NE. KP1) THEN              M1 = 1              LP = LP + 1              LIST(LP) = KP1 - NI              LPTR(LP) = LP + 1            ENDIF          ENDIFCC   If K is in the leftmost column (and not the top row) orC     in the bottom row (and not the rightmost column), thenC     the next neighbor is the node above K.C          IF (I .NE. 1  .AND.  J .NE. NJ) GO TO 4          LP = LP + 1          LIST(LP) = K - NI          LPTR(LP) = LP + 1          IF (I .EQ. 1) GO TO 3CC   K is on the bottom row (and not the leftmost or right-C     most column).C          IF (M2 .LE. 0) THEN            LP = LP + 1            LIST(LP) = K - 1 - NI            LPTR(LP) = LP + 1          ENDIF          LP = LP + 1          LIST(LP) = K - 1          LPTR(LP) = LP + 1CC   K is a boundary node.C    3     LIST(LP) = -LIST(LP)CC   Bottom of loop.  Store LEND and correct LPTR(LP).C     LPF and LP point to the first and last neighborsC     of K.C    4     LEND(K) = LP          LPTR(LP) = LPF    5     CONTINUE    6   CONTINUECC Store LNEW, and terminate the algorithm if NIT = 0 onC   input.C      LNEW = LP + 1      IF (MAXIT .EQ. 0) RETURNCC Add boundary arcs where necessary in order to cover theC   convex hull of the nodes.  N1, N2, and N3 are consecu-C   tive boundary nodes in counterclockwise order, and N0C   is the starting point for each loop around the boundary.C      N0 = 1      N1 = N0      N2 = NI + 1CC   TST is set to TRUE if an arc is added.  The boundaryC     loop is repeated until a traversal results in noC     added arcs.C    7 TST = .FALSE.CC   Top of boundary loop.  Set N3 to the first neighbor ofC     N2, and test for N3 LEFT N1 -> N2.C    8   LPL = LEND(N2)          LP = LPTR(LPL)          N3 = LIST(LP)          IF ( LEFT(X(N1),Y(N1),X(N2),Y(N2),X(N3),Y(N3)) )     .       N1 = N2          IF (N1 .NE. N2) THENCC   Add the boundary arc N1-N3.  If N0 = N2, the startingC     point is changed to N3, since N2 will be removed fromC     the boundary.  N3 is inserted as the first neighbor ofC     N1, N2 is changed to an interior node, and N1 isC     inserted as the last neighbor of N3.C            TST = .TRUE.            IF (N2 .EQ. N0) N0 = N3            LP = LEND(N1)            CALL INSERT (N3,LP, LIST,LPTR,LNEW )            LIST(LPL) = -LIST(LPL)            LP = LEND(N3)            LIST(LP) = N2            CALL INSERT (-N1,LP, LIST,LPTR,LNEW )            LEND(N3) = LNEW - 1          ENDIFCC   Bottom of loops.  Test for termination.C          N2 = N3          IF (N1 .NE. N0) GO TO 8        IF (TST) GO TO 7CC Terminate the algorithm if NIT = 1 on input.C      NIT = 1      IF (MAXIT .EQ. 1) RETURNCC Optimize the triangulation by applying the swap test andC   appropriate swaps to the interior arcs.  The loop isC   repeated until no swaps are performed or MAXIT itera-C   tions have been applied.  ITER is the current iteration,C   and TST is set to TRUE if a swap occurs.C      ITER = 1      NM1 = NN - 1    9 ITER = ITER + 1        TST = .FALSE.CC   Loop on interior arcs N1-N2, where N2 > N1 andC     (N1,N2,N3) and (N2,N1,N4) are adjacent triangles.CC   Top of loop on nodes N1.C        DO 11 N1 = 1,NM1          LPL = LEND(N1)          N4 = LIST(LPL)          LPF = LPTR(LPL)          N2 = LIST(LPF)          LP = LPTR(LPF)          N3 = LIST(LP)          NNB = NBCNT(LPL,LPTR)CC   Top of loop on neighbors N2 of N1.  NNB is the number ofC                                       neighbors of N1.C          DO 10 I = 1,NNBCC   Bypass the swap test if N1 is a boundary node and N2 isC     the first neighbor (N4 < 0), N2 < N1, or N1-N2 is aC     diagonal arc (already locally optimal) when ITER = 2.C            IF ( N4 .GT. 0  .AND.  N2 .GT. N1  .AND.     .          (ITER .NE. 2  .OR.  ABS(N1+NI-N2) .NE. 1) )     .          THEN              IF (SWPTST(N3,N4,N1,N2,X,Y) ) THENCC   Swap diagonal N1-N2 for N3-N4, set TST to TRUE, and setC     N2 to N4 (the neighbor preceding N3).C                CALL SWAP (N3,N4,N1,N2, LIST,LPTR,LEND, LPP)                IF (LPP .NE. 0) THEN                  TST = .TRUE.                  N2 = N4                ENDIF              ENDIF            ENDIFCC   Bottom of neighbor loop.C            IF (LIST(LPL) .EQ. -N3) GO TO 11            N4 = N2            N2 = N3            LP = LSTPTR(LPL,N2,LIST,LPTR)            LP = LPTR(LP)            N3 = ABS(LIST(LP))   10       CONTINUE   11     CONTINUECC   Test for termination.C        IF (TST  .AND.  ITER .LT. MAXIT) GO TO 9      NIT = ITER      IF (TST) IER = -2      RETURNCC Invalid grid cell encountered.C   12 IER = K      RETURN      END      SUBROUTINE TRPLOT (LUN,PLTSIZ,WX1,WX2,WY1,WY2,NCC,LCC,     .                   N,X,Y,LIST,LPTR,LEND,TITLE,     .                   NUMBR, IER)      CHARACTER*(*) TITLE      INTEGER LUN, NCC, LCC(*), N, LIST(*), LPTR(*),     .        LEND(N), IER      LOGICAL NUMBR      DOUBLE PRECISION PLTSIZ, WX1, WX2, WY1, WY2, X(N),      .        Y(N)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   07/15/98CC   This subroutine creates a level-2 Encapsulated Post-C script (EPS) file containing a triangulation plot.CCC On input:CC       LUN = Logical unit number in the range 0 to 99.C             The unit should be opened with an appropriateC             file name before the call to this routine.CC       PLTSIZ = Plot size in inches.  The window is mapped,C                with aspect ratio preserved, to a rectangu-C                lar viewport with maximum side-length equalC                to .88*PLTSIZ (leaving room for labels out-C                side the viewport).  The viewport isC                centered on the 8.5 by 11 inch page, andC                its boundary is drawn.  1.0 .LE. PLTSIZC                .LE. 8.5.CC       WX1,WX2,WY1,WY2 = Parameters defining a rectangularC                         window against which the triangu-C                         lation is clipped.  (Only theC                         portion of the triangulation thatC                         lies in the window is drawn.)C                         (WX1,WY1) and (WX2,WY2) are theC                         lower left and upper right cor-C                         ners, respectively.  WX1 < WX2 andC                         WY1 < WY2.CC       NCC = Number of constraint curves.  Refer to Subrou-C             tine ADDCST.  NCC .GE. 0.CC       LCC = Array of length NCC (or dummy parameter ifC             NCC = 0) containing the index of the firstC             node of constraint I in LCC(I).  For I = 1 toC             NCC, LCC(I+1)-LCC(I) .GE. 3, where LCC(NCC+1)C             = N+1.CC       N = Number of nodes in the triangulation.  N .GE. 3.CC       X,Y = Arrays of length N containing the coordinatesC             of the nodes with non-constraint nodes in theC             first LCC(1)-1 locations.CC       LIST,LPTR,LEND = Data structure defining the trian-C                        gulation.  Refer to SubroutineC                        TRMESH.CC       TITLE = Type CHARACTER variable or constant contain-C               ing a string to be centered above the plot.C               The string must be enclosed in parentheses;C               i.e., the first and last characters must beC               '(' and ')





























































































































', respectively, but these are notC               displayed.  TITLE may have at most 80 char-C               acters including the parentheses.CC       NUMBR = Option indicator:  If NUMBR = TRUE, theC               nodal indexes are plotted next to the nodes.CC Input parameters are not altered by this routine.CC On output:CC       IER = Error indicator:C             IER = 0 if no errors were encountered.C             IER = 1 if LUN, PLTSIZ, NCC, or N is outsideC                     its valid range.  LCC is not testedC                     for validity.C             IER = 2 if WX1 >= WX2 or WY1 >= WY2.C             IER = 3 if an error was encountered in writingC                     to unit LUN.CC   Various plotting options can be controlled by alteringC the data statement below.CC Modules required by TRPLOT:  NoneCC Intrinsic functions called by TRPLOT:  ABS, CHAR, NINT,C                                          DBLECC***********************************************************C      INTEGER I, IFRST, IH, ILAST, IPX1, IPX2, IPY1, IPY2,     .        IW, LP, LPL, N0, N0BAK, N0FOR, N1, NLS      LOGICAL ANNOT, CNSTR, PASS1      DOUBLE PRECISION DASHL, DX, DY, FSIZN, FSIZT, R, SFX,      .        SFY, T, TX, TY, X0, Y0C      DATA    ANNOT/.TRUE./,  DASHL/4.0/,  FSIZN/10.0/,     .        FSIZT/16.0/CC Local parameters:CC ANNOT =     Logical variable with value TRUE iff the plotC               is to be annotated with the values of WX1,C               WX2, WY1, and WY2C CNSTR       Logical variable used to flag constraint arcs:C               TRUE iff N0-N1 lies in a constraint regionC DASHL =     Length (in points, at 72 points per inch) ofC               dashes and spaces in a dashed line patternC               used for drawing constraint arcsC DX =        Window width WX2-WX1C DY =        Window height WY2-WY1C FSIZN =     Font size in points for labeling nodes withC               their indexes if NUMBR = TRUEC FSIZT =     Font size in points for the title (andC               annotation if ANNOT = TRUE)C I =         Constraint index (1 to NCC)C IFRST =     Index of the first node in constraint IC IH =        Height of the viewport in pointsC ILAST =     Index of the last node in constraint IC IPX1,IPY1 = X and y coordinates (in points) of the lowerC               left corner of the bounding box or viewportC IPX2,IPY2 = X and y coordinates (in points) of the upperC               right corner of the bounding box or viewportC IW =        Width of the viewport in pointsC LP =        LIST index (pointer)C LPL =       Pointer to the last neighbor of N0C N0 =        Nodal index and DO-loop indexC N0BAK =     Predecessor of N0 in a constraint curveC               (sequence of adjacent constraint nodes)C N0FOR =     Successor to N0 in a constraint curveC N1 =        Index of a neighbor of N0C NLS =       Index of the last non-constraint nodeC PASS1 =     Logical variable used to flag the first passC               through the constraint nodesC R =         Aspect ratio DX/DYC SFX,SFY =   Scale factors for mapping world coordinatesC               (window coordinates in [WX1,WX2] X [WY1,WY2])C               to viewport coordinates in [IPX1,IPX2] XC               [IPY1,IPY2]C T =         Temporary variableC TX,TY =     Translation vector for mapping world coordi-C               nates to viewport coordinatesC X0,Y0 =     X(N0),Y(N0) or label locationCCC Test for error 1, and set NLS to the last non-constraintC   node.C      IF (LUN .LT. 0  .OR.  LUN .GT. 99  .OR.     .    PLTSIZ .LT. 1.0  .OR.  PLTSIZ .GT. 8.5  .OR.     .    NCC .LT. 0  .OR.  N .LT. 3) GO TO 11      NLS = N      IF (NCC .GT. 0) NLS = LCC(1)-1CC Compute the aspect ratio of the window.C      DX = WX2 - WX1      DY = WY2 - WY1      IF (DX .LE. 0.0  .OR.  DY .LE. 0.0) GO TO 12      R = DX/DYCC Compute the lower left (IPX1,IPY1) and upper rightC   (IPX2,IPY2) corner coordinates of the bounding box.C   The coordinates, specified in default user space unitsC   (points, at 72 points/inch with origin at the lowerC   left corner of the page), are chosen to preserve theC   aspect ratio R, and to center the plot on the 8.5 by 11C   inch page.  The center of the page is (306,396), andC   T = PLTSIZ/2 in points.C      T = 36.0*PLTSIZ      IF (R .GE. 1.0) THEN        IPX1 = 306 - NINT(T)        IPX2 = 306 + NINT(T)        IPY1 = 396 - NINT(T/R)        IPY2 = 396 + NINT(T/R)      ELSE        IPX1 = 306 - NINT(T*R)        IPX2 = 306 + NINT(T*R)        IPY1 = 396 - NINT(T)        IPY2 = 396 + NINT(T)      ENDIFCC Output header comments.C      WRITE (LUN,100,ERR=13) IPX1, IPY1, IPX2, IPY2  100 FORMAT ('%!PS-Adobe-3.0 EPSF-3.0'/
     .        '%%BoundingBox:',4I4/
     .        '%%Title:  Triangulation'/
     .        '%%Creator:  TRIPACK'/
     .        '%%EndComments')
C
C Set (IPX1,IPY1) and (IPX2,IPY2) to the corner coordinates
C   of a viewport obtained by shrinking the bounding box by
C   12% in each dimension.
C
      IW = NINT(0.88*DBLE(IPX2-IPX1))
      IH = NINT(0.88*DBLE(IPY2-IPY1))
      IPX1 = 306 - IW/2
      IPX2 = 306 + IW/2
      IPY1 = 396 - IH/2
      IPY2 = 396 + IH/2
C
C Set the line thickness to 2 points, and draw the
C   viewport boundary.
C
      T = 2.0
      WRITE (LUN,110,ERR=13) T
      WRITE (LUN,120,ERR=13) IPX1, IPY1
      WRITE (LUN,130,ERR=13) IPX1, IPY2
      WRITE (LUN,130,ERR=13) IPX2, IPY2
      WRITE (LUN,130,ERR=13) IPX2, IPY1
      WRITE (LUN,140,ERR=13)
      WRITE (LUN,150,ERR=13)
  110 FORMAT (F12.6,' setlinewidth')
  120 FORMAT (2I4,' moveto')
  130 FORMAT (2I4,' lineto')
  140 FORMAT ('closepath')
  150 FORMAT ('stroke')
C
C Set up a mapping from the window to the viewport.
C
      SFX = DBLE(IW)/DX
      SFY = DBLE(IH)/DY
      TX = IPX1 - SFX*WX1
      TY = IPY1 - SFY*WY1
      WRITE (LUN,160,ERR=13) TX, TY, SFX, SFY
  160 FORMAT (2F12.6,' translate'/
     .        2F12.6,' scale')
C
C The line thickness (believe it or fucking not) must be
C   changed to reflect the new scaling which is applied to
C   all subsequent output.  Set it to 1.0 point.
C
      T = 2.0/(SFX+SFY)
      WRITE (LUN,110,ERR=13) T
C
C Save the current graphics state, and set the clip path to
C   the boundary of the window.
C
      WRITE (LUN,170,ERR=13)
      WRITE (LUN,180,ERR=13) WX1, WY1
      WRITE (LUN,190,ERR=13) WX2, WY1
      WRITE (LUN,190,ERR=13) WX2, WY2
      WRITE (LUN,190,ERR=13) WX1, WY2
      WRITE (LUN,200,ERR=13)
  170 FORMAT ('gsave')
  180 FORMAT (2F12.6,' moveto')
  190 FORMAT (2F12.6,' lineto')
  200 FORMAT ('closepath clip newpath')
C
C Draw the edges N0->N1, where N1 > N0, beginning with a
C   loop on non-constraint nodes N0.  LPL points to the
C   last neighbor of N0.
C
      DO 3 N0 = 1,NLS
        X0 = X(N0)
        Y0 = Y(N0)
        LPL = LEND(N0)
        LP = LPL
C
C   Loop on neighbors N1 of N0.
C
    2   LP = LPTR(LP)
          N1 = ABS(LIST(LP))
          IF (N1 .GT. N0) THEN
C
C   Add the edge to the path.
C
            WRITE (LUN,210,ERR=13) X0, Y0, X(N1), Y(N1)
  210       FORMAT (2F12.6,' moveto',2F12.6,' lineto')
          ENDIF
          IF (LP .NE. LPL) GO TO 2
    3   CONTINUE
C
C Loop through the constraint nodes twice.  The non-
C   constraint arcs incident on constraint nodes are
C   drawn (with solid lines) on the first pass, and the
C   constraint arcs (both boundary and interior, if any)
C   are drawn (with dashed lines) on the second pass.
C
      PASS1 = .TRUE.
C
C Loop on constraint nodes N0 with (N0BAK,N0,N0FOR) a sub-
C   sequence of constraint I.  The outer loop is on
C   constraints I with first and last nodes IFRST and ILAST.
C
    4 IFRST = N+1
      DO 8 I = NCC,1,-1
        ILAST = IFRST - 1
        IFRST = LCC(I)
        N0BAK = ILAST
        DO 7 N0 = IFRST,ILAST
          N0FOR = N0 + 1
          IF (N0 .EQ. ILAST) N0FOR = IFRST
          LPL = LEND(N0)
          X0 = X(N0)
          Y0 = Y(N0)
          LP = LPL
C
C   Loop on neighbors N1 of N0.  CNSTR = TRUE iff N0-N1 is a
C     constraint arc.
C
C   Initialize CNSTR to TRUE iff the first neighbor of N0
C     strictly follows N0FOR and precedes or coincides with
C     N0BAK (in counterclockwise order).
C
    5     LP = LPTR(LP)
            N1 = ABS(LIST(LP))
            IF (N1 .NE. N0FOR  .AND.  N1 .NE. N0BAK) GO TO 5
          CNSTR = N1 .EQ. N0BAK
          LP = LPL
C
C   Loop on neighbors N1 of N0.  Update CNSTR and test for
C     N1 > N0.
C
    6     LP = LPTR(LP)
            N1 = ABS(LIST(LP))
            IF (N1 .EQ. N0FOR) CNSTR = .TRUE.
            IF (N1 .GT. N0) THEN
C
C   Draw the edge iff (PASS1=TRUE and CNSTR=FALSE) or
C     (PASS1=FALSE and CNSTR=TRUE); i.e., CNSTR and PASS1
C     have opposite values.
C
              IF (CNSTR .NEQV. PASS1)
     .          WRITE (LUN,210,ERR=13) X0, Y0, X(N1), Y(N1)
            ENDIF
            IF (N1 .EQ. N0BAK) CNSTR = .FALSE.
C
C   Bottom of loops.
C
            IF (LP .NE. LPL) GO TO 6
          N0BAK = N0
    7     CONTINUE
    8   CONTINUE
      IF (PASS1) THEN
C
C End of first pass:  paint the path and change to dashed
C   lines for subsequent drawing.  Since the scale factors
C   are applied to everything, the dash length must be
C   specified in world coordinates.
C
        PASS1 = .FALSE.
        WRITE (LUN,150,ERR=13)
        T = DASHL*2.0/(SFX+SFY)
        WRITE (LUN,220,ERR=13) T
  220   FORMAT ('[',F12.6,'] 0 setdash')
        GO TO 4
      ENDIF
C
C Paint the path and restore the saved graphics state (with
C   no clip path).
C
      WRITE (LUN,150,ERR=13)
      WRITE (LUN,230,ERR=13)
  230 FORMAT ('grestore')
      IF (NUMBR) THEN
C
C Nodes in the window are to be labeled with their indexes.
C   Convert FSIZN from points to world coordinates, and
C   output the commands to select a font and scale it.
C
        T = FSIZN*2.0/(SFX+SFY)
        WRITE (LUN,240,ERR=13) T
  240   FORMAT ('/Helvetica findfont'/
     .          F12.6,' scalefont setfont')
C
C   Loop on nodes N0 with coordinates (X0,Y0).
C
        DO 9 N0 = 1,N
          X0 = X(N0)
          Y0 = Y(N0)
          IF (X0 .LT. WX1  .OR.  X0 .GT. WX2  .OR.
     .        Y0 .LT. WY1  .OR.  Y0 .GT. WY2) GO TO 9
C
C   Move to (X0,Y0), and draw the label N0.  The first char-
C     acter will have its lower left corner about one
C     character width to the right of the nodal position.
C
          WRITE (LUN,180,ERR=13) X0, Y0
          WRITE (LUN,250,ERR=13) N0
  250     FORMAT ('(',I3,') show')
    9     CONTINUE
      ENDIF
C
C Convert FSIZT from points to world coordinates, and output
C   the commands to select a font and scale it.
C
      T = FSIZT*2.0/(SFX+SFY)
      WRITE (LUN,240,ERR=13) T
C
C Display TITLE centered above the plot:
C
      Y0 = WY2 + 3.0*T
      WRITE (LUN,260,ERR=13) TITLE, (WX1+WX2)/2.0, Y0
  260 FORMAT (A80/'  stringwidth pop 2 div neg ',F12.6,
     .        ' add ',F12.6,' moveto')
      WRITE (LUN,270,ERR=13) TITLE
  270 FORMAT (A80/'  show')
      IF (ANNOT) THEN
C
C Display the window extrema below the plot.
C
        X0 = WX1
        Y0 = WY1 - 100.0/(SFX+SFY)
        WRITE (LUN,180,ERR=13) X0, Y0
        WRITE (LUN,280,ERR=13) WX1, WX2
        Y0 = Y0 - 2.0*T
        WRITE (LUN,290,ERR=13) X0, Y0, WY1, WY2
  280   FORMAT ('(Window:   WX1 = ',E9.3,',   WX2 = ',E9.3,
     .          ') show')
  290   FORMAT ('(Window:  ) stringwidth pop ',F12.6,' add',
     .          F12.6,' moveto'/
     .          '( WY1 = ',E9.3,',   WY2 = ',E9.3,') show')
      ENDIF
C
C Paint the path and output the showpage command and
C   end-of-file indicator.
C
      WRITE (LUN,300,ERR=13)
  300 FORMAT ('stroke'/
     .        'showpage'/
     .        '%%EOF')
C
C HP








































































































































































































's interpreters require a one-byte End-of-PostScript-JobC   indicator (to eliminate a timeout error message):C   ASCII 4.C      WRITE (LUN,310,ERR=13) CHAR(4)  310 FORMAT (A1)CC No error encountered.C      IER = 0      RETURNCC Invalid input parameter.C   11 IER = 1      RETURNCC DX or DY is not positive.C   12 IER = 2      RETURNCC Error writing to unit LUN.C   13 IER = 3      RETURN      END      SUBROUTINE TRPRNT (NCC,LCC,N,X,Y,LIST,LPTR,LEND,LOUT,     .                   PRNTX)      INTEGER NCC, LCC(*), N, LIST(*), LPTR(*), LEND(N),     .        LOUT      LOGICAL PRNTX      DOUBLE PRECISION X(N), Y(N)CC***********************************************************CC                                               From TRIPACKC                                            Robert J. RenkaC                                  Dept. of Computer ScienceC                                       Univ. of North TexasC                                           renka@cs.unt.eduC                                                   07/30/98CC   Given a triangulation of a set of points in the plane,C this subroutine prints the adjacency lists and, option-C ally, the nodal coordinates on logical unit LOUT.  TheC list of neighbors of a boundary node is followed by indexC 0.  The numbers of boundary nodes, triangles, and arcs,C and the constraint curve starting indexes, if any, areC also printed.CCC On input:CC       NCC = Number of constraints.CC       LCC = List of constraint curve starting indexes (orC             dummy array of length 1 if NCC = 0).CC       N = Number of nodes in the triangulation.C           3 .LE. N .LE. 9999.CC       X,Y = Arrays of length N containing the coordinatesC             of the nodes in the triangulation -- not usedC             unless PRNTX = TRUE.CC       LIST,LPTR,LEND = Data structure defining the trian-C                        gulation.  Refer to SubroutineC                        TRMESH.CC       LOUT = Logical unit number for output.  0 .LE. LOUTC              .LE. 99.  Output is printed on unit 6 if LOUTC              is outside its valid range on input.CC       PRNTX = Logical variable with value TRUE if and onlyC               if X and Y are to be printed (to 6 decimalC               places).CC None of the parameters are altered by this routine.CC Modules required by TRPRNT:  NoneCC***********************************************************C      INTEGER I, INC, K, LP, LPL, LUN, NA, NABOR(100), NB,     .        ND, NL, NLMAX, NMAX, NODE, NN, NT      DATA  NMAX/9999/,  NLMAX/60/C      NN = N      LUN = LOUT      IF (LUN .LT. 0  .OR.  LUN .GT. 99) LUN = 6CC Print a heading and test the range of N.C      WRITE (LUN,100) NN      IF (NN .LT. 3  .OR.  NN .GT. NMAX) THENCC N is outside its valid range.C        WRITE (LUN,110)        GO TO 5      ENDIFCC Initialize NL (the number of lines printed on the currentC   page) and NB (the number of boundary nodes encountered).C      NL = 6      NB = 0      IF (.NOT. PRNTX) THENCC Print LIST only.  K is the number of neighbors of NODEC   which are stored in NABOR.C        WRITE (LUN,101)        DO 2 NODE = 1,NN          LPL = LEND(NODE)          LP = LPL          K = 0C    1     K = K + 1            LP = LPTR(LP)            ND = LIST(LP)            NABOR(K) = ND            IF (LP .NE. LPL) GO TO 1          IF (ND .LE. 0) THENCC   NODE is a boundary node.  Correct the sign of the lastC     neighbor, add 0 to the end of the list, and incrementC     NB.C            NABOR(K) = -ND            K = K + 1            NABOR(K) = 0            NB = NB + 1          ENDIFCC   Increment NL and print the list of neighbors.C          INC = (K-1)/14 + 2          NL = NL + INC          IF (NL .GT. NLMAX) THEN            WRITE (LUN,106)            NL = INC          ENDIF          WRITE (LUN,103) NODE, (NABOR(I), I = 1,K)          IF (K .NE. 14) WRITE (LUN,105)    2     CONTINUE      ELSECC Print X, Y, and LIST.C        WRITE (LUN,102)        DO 4 NODE = 1,NN          LPL = LEND(NODE)          LP = LPL          K = 0    3     K = K + 1            LP = LPTR(LP)            ND = LIST(LP)            NABOR(K) = ND            IF (LP .NE. LPL) GO TO 3          IF (ND .LE. 0) THENCC   NODE is a boundary node.C            NABOR(K) = -ND            K = K + 1            NABOR(K) = 0            NB = NB + 1          ENDIFCC   Increment NL and print X, Y, and NABOR.C          INC = (K-1)/8 + 2          NL = NL + INC          IF (NL .GT. NLMAX) THEN            WRITE (LUN,106)            NL = INC          ENDIF          WRITE (LUN,104) NODE, X(NODE), Y(NODE),     .                    (NABOR(I), I = 1,K)          IF (K .NE. 8) WRITE (LUN,105)    4     CONTINUE      ENDIFCC Print NB, NA, and NT (boundary nodes, arcs, andC   triangles).C      NT = 2*NN - NB - 2      NA = NT + NN - 1      IF (NL .GT. NLMAX-6) WRITE (LUN,106)      WRITE (LUN,107) NB, NA, NTCC Print NCC and LCC.C    5 WRITE (LUN,108) NCC      IF (NCC .GT. 0) WRITE (LUN,109) (LCC(I), I = 1,NCC)      RETURNCC Print formats:C  100 FORMAT (///,26X,'Adjacency Sets,    N = 
',I5//)  101 FORMAT (1X,'Node',32X,'Neighbors of Node
'//)  102 FORMAT (1X,'Node',5X,'X(Node)',8X,'Y(Node)
',     .        20X,'Neighbors of Node




'//)  103 FORMAT (1X,I4,5X,14I5/(1X,9X,14I5))  104 FORMAT (1X,I4,2E15.6,5X,8I5/(1X,39X,8I5))  105 FORMAT (1X)  106 FORMAT (///)  107 FORMAT (/1X,'NB = ',I4,' Boundary Nodes
',5X,     .        'NA = ',I5,' Arcs',5X,'NT = 
',I5,     .        ' Triangles
')  108 FORMAT (/1X,'NCC =',I3,' Constraint Curves

')  109 FORMAT (1X,9X,14I5)  110 FORMAT (1X,10X,'*** N is outside its valid
',     .        ' range ***






























































































































Generated by  Doxygen 1.6.0   Back to index