//===========================================================================
// Copyright (C) 1998, 2000-2007, 2010, 2011, 2012 SINTEF ICT, Applied
// Mathematics, Norway.
//
// This file is part of GoTools
//
// This program is free software; you can redistribute it and/or          
// modify it under the terms of the GNU General Public License            
// as published by the Free Software Foundation version 2 of the License. 
//
// This program is distributed in the hope that it will be useful,        
// but WITHOUT ANY WARRANTY; without even the implied warranty of         
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          
// GNU General Public License for more details.                           
//
// You should have received a copy of the GNU General Public License      
// along with this program; if not, see <http://www.gnu.org/licenses>
//
// Contact information: E-mail: tor.dokken@sintef.no                      
// SINTEF ICT, Department of Applied Mathematics,                         
// P.O. Box 124 Blindern,                                                 
// 0314 Oslo, Norway.                                                     
//
// Other licenses are also available for this software, notably licenses
// for:
// - Building commercial software.                                        
// - Building software whose source code you wish to keep private.        
//===========================================================================

#include "GoTools/geometry/SISL_code.h"
///\cond SISL
//===========================================================================
// MORE SISL DEFINEs
//===========================================================================

/* Get standard library definitions (includes malloc defs) */
#include <stdlib.h>
#include <sys/types.h> // get size_t
#include <math.h> // get fabs, etc.
#include <stdio.h> // get stderr, etc.
/* Get  string library definitions (includes memcpy defs) */
#include <string.h>

#define SISL_CRV_PERIODIC -1
#define SISL_CRV_OPEN 1
#define SISL_CRV_CLOSED 0

#define SISL_SURF_PERIODIC -1
#define SISL_SURF_OPEN 1
#define SISL_SURF_CLOSED 0

#  define M_SQRT1_2   0.70710678118654752440
                      
#ifndef M_PI
#define M_PI 3.1415926535897932384626433
#endif
#ifndef M_PI_2
#define M_PI_2 1.57079632679489661923132
#endif
#ifndef DZERO
#define DZERO (double)0.0
#endif
#ifndef PIHALF
#define PIHALF       (double)M_PI_2
#endif
#ifndef PI
#define PI           (double)M_PI
#endif
#ifndef TRUE
#define TRUE 1
#endif
#ifndef FALSE
#define FALSE 0
#endif
#ifndef SIMPLECASE
#define SIMPLECASE   (double)0.75
#endif
#ifndef ROTM
#define ROTM         (double)M_SQRT1_2
#endif

#define SISL_NULL 0
#define  DOUBLE  double
#define  INT     int

#define VOIDP      (void *)
#define CONSTVOIDP (const void *)

#define MAXIMAL_RADIUS_OF_CURVATURE    (double)10000.0
#define ANGULAR_TOLERANCE              (double)0.01  /* IN RADIANS */
#define REL_PAR_RES                    (double)0.000000000001
#define REL_COMP_RES                   (double)0.000000000000001
#define ONE_THIRD  (double)0.333333333333333333333333
#define ONE_FOURTH (double)0.25

#define newarray(a,b) \
  ((a)>(SISL_NULL)?((b*)malloc((size_t)((a)*sizeof(b)))):(SISL_NULL))
#define new0array(a,b) \
  ((a)>(SISL_NULL)?((b*)calloc((size_t)(a),(size_t)(sizeof(b)))):(SISL_NULL))
#define increasearray(a,b,c) (c*)realloc(VOIDP(a),(size_t)((b)*sizeof(c)))
#define freearray(a) { (void)free(VOIDP a); a = SISL_NULL; }
#define free0array(a) { (void)free(VOIDP a); a = SISL_NULL; }
#define memcopy(a,b,c,d) \
  VOIDP memcpy(VOIDP (a),CONSTVOIDP(b),(size_t)((c)*sizeof(d)))

/* Functions taking max/min of two arguments. */

#ifndef max
#define max(a,b) ((a) > (b) ? (a) : (b))
#endif

#ifndef min
#define min(a,b) ((a) < (b) ? (a) : (b))
#endif

#ifndef MAX
#define MAX max
#endif
#ifndef MIN
#define MIN min
#endif

/* Macros checking for equality/non-equality  between two double numbers */

#define DEQUAL(a,b) \
  ( (fabs((a) - (b)) <= (REL_PAR_RES * MAX(MAX(fabs(a),fabs(b)),(double)1.0))) ? (1) : (0) )

#define DNEQUAL(a,b) \
  ( (fabs((a) - (b)) >  (REL_PAR_RES * MAX(MAX(fabs(a),fabs(b)),(double)1.0))) ? (1) : (0) )

#define ZEROLEN(a) \
  ( (fabs(a) <= AEPSGE) ? (1) : (0) )

// used by s1772
#define SINGULAR 1.0e-16
#define s1772_copy2(a,b,c) for (ki=0;ki<(c);ki++) (a)[ki]=(b)[ki]
#define s1772_copy3(a,b,c,d) for (ki=0;ki<(d);ki++) (a)[ki]=(b)[ki]=(c)[ki]
#define s1772_incr2(a,b,c) for (ki=0;ki<(c);ki++) (a)[ki]+=(b)[ki]
#define s1772_decr2(a,b,c) for (ki=0;ki<(c);ki++) (a)[ki]-=(b)[ki]
#define s1772_set_order(a) if((a)==1) {s_v=s_uu;order=0;} else {s_v=s_v1;order=1;}

// spesific defines for s1770_2D:
#define SINGULAR 1.0e-16
#define s1770_2D_copy2(a,b,c) for (ki=0;ki<(c);ki++) (a)[ki]=(b)[ki]
#define s1770_2D_copy3(a,b,c,d) for (ki=0;ki<(d);ki++) (a)[ki]=(b)[ki]=(c)[ki]
#define s1770_2D_incr2(a,b,c) for (ki=0;ki<(c);ki++) (a)[ki]+=(b)[ki]
#define s1770_2D_decr2(a,b,c) for (ki=0;ki<(c);ki++) (a)[ki]-=(b)[ki]
#define s1770_2D_set_order(a)  {if((a)==1) order=0; else order=1;}

#define s1891_MAX_SIZE  50
#define s1925_MAX_ARRAY_SIZE 50
#define s1897_MAX_IK    50

#ifdef __BORLANDC__
#  include <Values.h>
#  ifndef HUGE
#    define HUGE MAXDOUBLE
#  endif
#endif


enum {  SI_ORD = 1, SI_SING, SI_TRIM, SI_TOUCH };
enum {  SI_UNDEF, SI_IN, SI_OUT, SI_ON, SI_AT };
enum {  SI_RIGHT=1, SI_LEFT=2 };


static int sh1762_xc = 0;
static int sh1762_xmax = 0;
typedef void (*sh1783_fevalProc)(SISLCurve *,int,double,int *,double[],int *);
typedef void (*sh1784_fevalcProc)(SISLCurve *, int, double, int *, double [], int *);
typedef void (*s1786_fevalcProc)(SISLCurve *,int,double,int *,double [],int *);

//===========================================================================
// SISL functions indirectly used by 'sisl_dependent'
//===========================================================================
void sh6setcnsdir(SISLIntpt *pt1,SISLIntpt *pt2,int ipar,int *jstat);
void s6degnorm(SISLSurf *ps1,int ider,double epar[],double eder[],
	       double utang[],double vtang[],double enorm[],int *jstat);
void sh6idrmcross(SISLObject *po1, SISLObject *po2, SISLIntdat **pintdat,
		  SISLIntpt *vcross[], int incross, SISLIntpt *vpt[],
		  int inpt, int *jstat);
void sh6idfcross(SISLIntdat *pintdat, SISLIntpt *vcross[], int *jncross,
		 int ipar1, int ipar2, int *jstat);
void sh6idput (SISLObject * po1, SISLObject * po2, SISLIntdat ** rintdat, 
	       SISLIntdat * pintdat, int inr, double apar, 
	       SISLIntpt *** outintpt, int *npoint, int *jstat);
void sh1992(SISLObject *po,int itype,double aepsge,int *jstat);
void s9boundimp(double epnt1[],double epar1[],SISLSurf *psurf1,double eimpli[],
		int ideg,double apar,int idir,double aepsge,
		double gpnt1[],double gpar1[],int *jstat);
void s1308(double ep[],int idim,double eimpli[],int ideg,double enorm[],int *jstat);
void s1001 (SISLSurf * ps, double min1, double min2,
	    double max1, double max2,
	    SISLSurf ** rsnew, int *jstat);
void s6crvcheck(SISLCurve *pc,int *jstat);
void s1379(double ep[],double ev[],double epar[],int im,int idim,
	   SISLCurve **rcurve,int *jstat);
void s6twonorm(double evec[],double enorm1[],double enorm2[],int *jstat);
void s9boundit(double epnt1[],double epnt2[],double epar1[],double epar2[],
	       SISLSurf *psurf1,SISLSurf *psurf2,double apar,int idir,double aepsge,
	       double gpnt1[],double gpnt2[],double gpar1[],double gpar2[],int *jstat);
void s1602(double estapt[],double endpt[],int ik,int idim,double astpar,
	   double *cendpar,SISLCurve **rc,int *jstat);
void s1755 (double orknt[], int in, int ik, double extknt[], int *inh, int *jstat);
void s1753 (double et[], double ecf[], int in, int ik, int idim, double etr[],
	    double ecfr[], int inr, double ecc[], double ecw[], int *jstat);
void s1754 (double *et, int in, int ik, int ikh, double **iknt, int *inh, int *jstat);
void s1750(SISLCurve *pc,int ikh,SISLCurve **rc,int *jstat);
void s1715(SISLCurve *pc1,SISLCurve *pc2,int iend1,int iend2,SISLCurve **rcnew,int *jstat);
void s1710 (SISLCurve * pc1, double apar, SISLCurve ** rcnew1, 
	    SISLCurve ** rcnew2, int *jstat);
void s1714 (SISLCurve * pc, double apar1, double apar2, SISLCurve ** rcnew1, 
	    SISLCurve ** rcnew2, int *jstat);
void s1713(SISLCurve *pc,double abeg,double aend,SISLCurve **rcnew,int *jstat);
void  s1706(SISLCurve *pc);
void pick_crv_sf(SISLObject *po1, SISLObject *po2,int ipar,
		 SISLIntpt *pt1,SISLIntpt *pt2,SISLCurve **rcrv, int *jstat);
SISLIntsurf *newIntsurf (SISLIntlist * pintlist);
void s1425(SISLSurf *ps1,int ider1,int ider2,int iside1,int iside2,double epar[],
	   int *ileft1,int *ileft2,double eder[],int *jstat);
void s1422(SISLSurf *ps1,int ider,int iside1,int iside2,double epar[],int *ilfs,
	   int *ilft,double eder[],double enorm[],int *jstat);
void sh6evalint (SISLObject * ob1, SISLObject * ob2, double eimpli[], int ideg,
		 SISLIntpt * pt, double aepsge, double *curve_3d[], 
		 double *curve_2d_1[], double *curve_2d_2[], int *jstat);
void sh6idsplit (SISLIntdat ** pintdat, SISLIntpt * psource, int *jstat);
void sh6gettophlp (SISLIntpt * pt, int pretop[4], int case_2d, int *jstat);
void sh1779_at (SISLObject * po1, SISLObject * po2, SISLIntpt * pintpt, int *jstat);
void sh1780_at (SISLObject * po1, SISLObject * po2, SISLIntpt * pintpt, int *jstat);
void sh1781_at (SISLObject * po1, SISLObject * po2, SISLIntpt * pintpt, int *jstat);
void sh_set_at (SISLObject * po1, SISLObject * po2, SISLIntdat * pintdat, int *jstat);
void sh6idlis (SISLObject * po1, SISLObject * po2, SISLIntdat ** pintdat,
	       double aepsge, int *jstat);
void sh6idunite (SISLIntdat ** intdat, SISLIntpt ** pt1, SISLIntpt ** pt2,
		 double weight, int *jstat);
void sh6edgred (SISLObject * po1, SISLObject * po2,
		SISLIntdat * pintdat, int *jstat);
void s9conmarch(SISLSurf *ps,double alevel,double epar[],int ndir[],int ipoint,
		double *gpar[],int *mpar[],int *jpoint,int *jstat);
void s9surmarch(SISLSurf *ps1,SISLSurf *ps2,double epar[],int ndir[],int ipoint,
		double *gpar[],int *mpar[],int *jpoint,int *jstat);
void shsing_s9dir(double cdiff[],double evals[],double evalq[]);
void shsing_s9corr(double gd[], double coef[],double limit[]);
void shsing(SISLSurf *psurf1,SISLSurf *psurf2,double limit[],
	    double enext[], double gpos[],int *jstat);
void s6findfac(double evecu[],double evecv[],double evecw[],double etang[],
               int idim,int isign,double *coef1,double *coef2,double *coef3,int *jstat);
int s1789_s9knot(double et[], int ik, int in, double ax1, double ax2,
		 int *jmy, int *jstat);
void s1789_s9eval(double eders[],double enorms[],double etanc[],
		  double ederc[],int idim, int *jstat);
void s1789(SISLPoint *ppoint,SISLSurf *psurf,double aepsge,
	   double epar1[],double epar2[],int *jstat);
void s1786_s9relax(s1786_fevalcProc fevalc1,s1786_fevalcProc fevalc2,
		   SISLCurve *pc1,SISLCurve *pc2,
		   int ider,double aepsge,double ax1,int *jleft1,double eder1[],
		   double anext,double *cx2,int *jleft2,double eder2[],int *jstat);
void s1786(SISLCurve *pc1,SISLCurve *pc2,double aepsge,double epar1[],
	   double epar2[],int *jstat);
void s1785(SISLCurve *pcurve,SISLSurf *psurf,double aepsge,
	   double epar1[],double epar2[],int icur,int *jstat);
void s1880(int ipar1,int ipar2,int *jpt,SISLIntpt **vpoint,int *jlist,
	   SISLIntlist **vlist,int *jpar,double **gpar1,double **gpar2,
	   int *jcrv,SISLIntcurve ***wcrv,int *jstat);
SISLIntlist *newIntlist (SISLIntpt * pfirst, SISLIntpt * plast, int itype);
void s6decomp(double ea[],double gx[],double eb1[],double eb2[],
	      double eb3[],int *jstat);
void s1788(SISLSurf *ps1,SISLSurf *ps2,double aepsge,double epar[],
	   double gpar1[],double gpar2[],int *jstat);
void freeIntlist(SISLIntlist *plist);
void s6idklist(SISLIntdat **pintdat,SISLIntlist *pintlist,int *jstat);
SISLIntcurve *newIntcurve (int ipoint, int ipar1, int ipar2,
			   double *epar1, double *epar2, int itype);
void s1787(SISLSurf *ps,double alevel,double aepsge,double epar[],
	   double gpar1[],double gpar2[],int *jstat);
void s6idkpt(SISLIntdat **pintdat,SISLIntpt **pintpt,SISLIntpt **rtpt,SISLIntpt **rfpt,
	     int *jstat);
void s6idlis_s9psexamin(SISLSurf *ps1,double alevel, SISLIntdat **rintdat,int *jstat);
void s6idlis_s9ssexamin(SISLSurf *ps1,SISLSurf *ps2, SISLIntdat **rintdat,int *jstat);
void s6idlis(SISLObject *po1,SISLObject *po2,SISLIntdat **pintdat,int *jstat);
void s1252_s6dir(double *cdiff,double acoef,double eval[],double astart, double aend);
void s1252_s6corr(double *gdn,double acoef,double et[], int in,int ik,int *ileft,int *jdir);
void s1252(SISLCurve *pcurve,double aepsge,double astart,double *cpos,int *jstat);
void s1119(double *ecoef,double *et1,double *et2,int ik1,int in1,int ik2,
	   int in2,int *jsimple,int *jind1,int *jind2,int *jstat);
void s1162_s9mic(SISLObject *,SISLObject *,SISLIntdat **, SISLEdge *[],int *);
void s1162_s9num(SISLObject *,int *,int *);
void s1162_s9edge(SISLObject *[],SISLObject *[],int,int, SISLIntdat *,
		  SISLEdge *[],int *);
void s1162_s9con(SISLObject *,double *,double,SISLIntdat **,SISLEdge *[],int *,
		 int *,int *);
void s1162_s9update(SISLObject *,double *,double,SISLIntdat **, SISLEdge *[2],
		    int *);
void s1162_s9div(SISLObject *,double *,double,int,int,int, SISLObject *[],
		 SISLIntdat **,SISLEdge *[2],int,int *);
SISLIntpt *hp_copyIntpt (SISLIntpt * ppt);
SISLIntpt *copyIntpt (SISLIntpt * ppt);
void s6idcon_s9endturn(SISLIntdat *pintdat,SISLIntpt *pt);
void s6idcon_s9turn(SISLIntpt *pt);
void s6idcon(SISLIntdat **pintdat,SISLIntpt **pintpt1,SISLIntpt **pintpt2,int *jstat);
void s6idput(SISLIntdat **rintdat,SISLIntdat *pintdat,int inr,double apar,int *jstat);
void s1192_s9mbox(double ecoef[], int in1,int in2,double aepsge,
		  double *cmax, double *cmin,int *jmax,int *jmin);
void s1192(SISLObject *po,double aepsge,int *jstat);
void s1190(SISLObject *po1, double *cmax, double aepsge,int *jstat);
void s6idnpt(SISLIntdat **pintdat,SISLIntpt **pintpt,int itest,int *jstat);
SISLIntpt *newIntpt (int ipar, double *epar, double adist);
void s1161(SISLObject *po1,double *cmax,double aepsge,SISLIntdat **pintdat,int *jstat);
void s1921(SISLSurf *ps1,double edir[],int idim,double aepsco,double aepsge,
	   int *jpt,double **gpar,int *jcrv,SISLIntcurve ***wcurve,int *jstat);
void s1954(SISLSurf *psurf,double epoint[],int idim,double aepsco,double aepsge,
	   int *jpt,double **gpar,int *jcrv,SISLIntcurve ***wcurve,int *jstat);
void s1893 (SISLCurve * orig, double earray[], int dimp1, int narr, int der1,
	    int der2, SISLCurve ** ncurve, int *jstat);
void s1370 (SISLCurve * pcurv, double earray[], int idim, int inarr,
	    int ratflag, SISLCurve ** rcurv, int *jstat);
void sh6sepcrv_s9circle(double apt1[], double apt2[], double apt3[],
			double aepsge, double ecentre[], double eaxis[],
			double *crad, int *jstat);
void sh6sepcrv (SISLCurve *pc1, SISLCurve *pc2, double aepsge, double ecentre[],
		double *crad, int *jstat);
void sh1831(SISLCurve *pc1, SISLCurve *pc2, int isign, double epoint[], 
	    double enorm[], double aepsge, int *jstat);
void sh1830(SISLObject *po1,SISLObject *po2,double aepsge,int *jstat);
void 
sh1871(SISLCurve *pc1, double *pt1, int idim, double aepsco, double aepsge,
	int trackflag, int *jtrack, SISLTrack *** wtrack,
       int *jpt,double **gpar1,int **pretop,int *jcrv,
       SISLIntcurve ***wcurve,int *jstat);
void s1376(double et[],int in,int ik,double **gt,int *jkn,int *jkk,int *jstat);
void s1378 (SISLSurf * psurf, double econic[], int ideg, int idim,
	    SISLSurf ** rsurf, int *jstat);
void s1927 (double *w1, int nur, int ik, int *ed, double *w2, int nrc,
	    double *w3, int nlr, double *ex[], double *ey, int *jstat);
void s1926 (double *w1, int nur, int ik, int *ed, double *w2, int nrc,
	    double *w3, int nlr, int *jstat);
void s1897 (double et[], int ik, double ax, int left, int deriv,
	    double ebiatx[], int *jstat);
void s1925 (double etau[], double epoint[], int inbpnt, int eder[],
	    double et[], double ebcoef[], int in, int ik, int iright, int dim,
	    double ew1[], int nur, int ed[], double ew2[], int inrc, double ew3[],
	    int inlr, int *jstat);
void s1891 (double etau[], double epoint[], int idim, int inbpnt, int iright,
	    int eder[], int iopen, double et[], double *ebcoef[], int *in,
	    int ik, int inlr, int inrc, int *jstat);
void s1890 (double oknots[], int oik, int oin, double *par[], int *der[], int *jstat);
void s1894 (double oknots[], int oik, int oin, int der1, int der2, double earray[],
	    int dimp1, int narr, double *nknots[], int *nik, int *nin, int *jstat);
void s1896 (SISLSurf * osurf, double earray[], int dimp1, int narr, int ders1[],
	    int dert1[], int ders2[], int dert2[], SISLSurf ** nsurf, int *jstat);
void s1320 (SISLSurf * psurf, double earray[], int inarr,
	    int ratflag, SISLSurf ** rsurf, int *jstat);
void s1322(double epoint[],double edirec[],double aradiu,int idim,
	   int inumb,double carray[],int *jstat);
void s1321(double ecentr[],double aradiu,int idim,int inumb, double carray[],int *jstat);

void sh6splitgeom_s9circle(double apt1[], double apt2[], double apt3[],
			   double aepsge, double ecentre[], double eaxis[],
			   double *crad, int *jstat);
void sh6splitgeom (SISLSurf *ps1, SISLSurf *ps2, double aepsge, double ecentre[],
		   double eaxis[], double *cdist, double *crad, int *jstat);
void sh6findsplit (SISLSurf *ps1, SISLSurf *ps2, double aepsge, int *jstat);
void sh1834_s9mat3d(double emat[],double edir1[],double edir2[]);
void sh1834_s9mat2d(double emat[],double edir[]);
void sh1834(SISLObject *po1,SISLObject *po2,double aepsge,int idim,
	    double edir1[],double edir2[],int *jstat);
void sh1839(SISLObject *po1,SISLObject *po2,double aepsge,int *jstat);
int sh6isconnect(SISLIntpt *pt0, SISLIntpt *pt1, SISLIntpt *pt2);
void sh6floop(SISLIntpt *vedgept[],int inum,int *jpt,int *jstat);
void sh6closevert(SISLCurve *pcurve,SISLSurf *psurf,double *cpar1, double epar2[]);
void sh6cvvert(SISLCurve *pc1, SISLCurve *pc2, double *cpar1, double *cpar2);
void s1711(SISLSurf *ps,int ipar,double apar,SISLSurf **rsnew1,
	   SISLSurf **rsnew2,int *jstat);
void s6idcpt(SISLIntdat *pintdat,SISLIntpt *pintpt,SISLIntpt **rintpt);
void sh6insert(SISLIntdat **pintdat,SISLIntpt *pt1,SISLIntpt *pt2,
	       SISLIntpt **ptnew,int *jstat);
void sh6idget (SISLObject * po1, SISLObject * po2, int ipar, double apar, 
	       SISLIntdat * pintdat, SISLIntdat ** rintdat, double aepsge, 
	       int *jstat);
void s1700(int imy,int ik,int in,int iv,
	   int *jpl,int *jfi,int *jla,double *et,double apar,
	   double *galfa,int *jstat);
void s1231(SISLCurve *pc1,double apar,
	   SISLCurve **rcnew1,SISLCurve **rcnew2,int *jstat);
void s1174_s9dir(double *cdiff1, double *cdiff2,double evals[]);
void s1174_s9corr(double gd[], double acoef1,double acoef2,double astart1,
		  double aend1,double astart2, double aend2);
void s1174(SISLSurf *psurf,double estart[], double eend[], double enext[], 
	   double gpos[],int *jstat);
void s9simple_knot(SISLSurf* surf, int idiv, double epar[], 
		   int *fixflag, int *jstat);
double s1792(double et[],int ik,int in);
int s1772_s6local_pretop(double dist,double diff[],double normal[],
			 double f[],double f_t[],double f_tt[],
			 double s[],double s_u[],double s_v[],
			 double s_uu[],double s_uv[],double s_vv[],
			 int dim, int*jstat);
void s1772_s6sekant1(SISLCurve *pcurve,SISLSurf *psurf,
		     double  par_val[], double delta, double *dist, double aepsge,
		     double astart1,double estart2[],double aend1,double eend2[],
		     double c0[], double s0[], double norm[], int *jstat);
void s1772_s9dir(double *dist,double diff[],double delta[],
		 double f[],double f_t[],double f_tt[],
		 double g[],double g_u[],double g_v[],
		 double g_uu[],double g_uv[],double g_vv[],
		 int dim,int second,int* jstat);
void s1772_s9corr(double gd[],double acoef[],double astart1,double aend1,
		  double astart2[],double aend2[],int *corr);
void s1772(SISLCurve *pcurve,SISLSurf *psurf,double aepsge,
	   double astart1,double estart2[],double aend1,double eend2[],
	   double anext1,double enext2[],double *cpos1,double gpos2[], int *jstat);
void s1172_s9dir(double *cdiff,double evals[]);
void s1172_s9corr(double *cd, double acoef,double astart,double aend);
void s1172(SISLCurve *pcurve,double astart,
	   double aend, double anext, double *cpos,int *jstat);
int sh6nmbhelp(SISLIntpt *pt,int *jstat);
int s1791(double et[],int ik,int in);
void sh6setdir(SISLIntpt *pt1,SISLIntpt *pt2,int *jstat);
void sh1784 (SISLCurve * pcurve, SISLSurf * psurf, double aepsge,
	     double epar[], int icur, int idirc, double elast[],
	     double enext[], int *jstat);
void sh1779 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** rintdat, SISLIntpt * pintpt, int *jnewpt, int *jstat);
void sh1787 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** rintdat, SISLIntpt * pintpt, int *jnewpt,
	     int *jstat);
void sh1786 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** rintdat, SISLIntpt * pintpt, int *jnewpt, int *jstat);
void s1307(double ep[],int idim,double egeo[],int *jstat);
void sh1992_s9mbox(double ecoef[],int icoef1,int icoef2,int idim,
		   double aeps1,double aeps2,double e2max[],
		   double e2min[],int *jstat);
void sh1992_s9mbox2(double ecoef[],int icoef1,int icoef2,double aeps1,
		    double aeps2,double e2max[],double e2min[]);
void sh1992_s9mbox3(double ecoef[],int icoef1,int icoef2,double aeps1,
		    double aeps2,double e2max[],double e2min[]);
void s6newbox(SISLbox *pbox,int inum,int itype,  double aepsge,int *jstat);
int s6existbox(SISLbox *pbox,int itype,double aepsge);
SISLbox * newbox (int idim);
void sh1992cu(SISLCurve *pc,int itype,double aepsge,int *jstat);
void sh1783_s9relax(sh1783_fevalProc fevalc1,sh1783_fevalProc fevalc2,
		    SISLCurve * pc1, SISLCurve * pc2,int ider, double aepsge, 
		    double ax1, int *jleft1, double eder1[],double anext,
		    double *cx2, int *jleft2, double eder2[], int *jstat);
void sh1783 (SISLCurve * pc1, SISLCurve * pc2, double aepsge, double epar[],
	     int idir1, int idir2, double elast[], double enext[], int *jstat);
void sh1780 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** rintdat, SISLIntpt * pintpt, int *jnewpt, 
	     int *jstat);
void sh6settop(SISLIntpt *pt,int ilist,int left1,int right1,int left2,
	       int right2,int *jstat);
void shevalc(SISLCurve *pc1,int ider,double ax,double aepsge,int *ileft,
	     double eder[],int *jstat);
void sh6getgeom(SISLObject *ob, int obnr, SISLIntpt *pt,
		double **geom, double **norm, double aepsge, int *jstat);
void sh6gettop(SISLIntpt *pt,int ilist,int *left1,int *right1,
	       int *left2,int *right2,int *jstat);
void sh1781 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** rintdat, SISLIntpt * pintpt, int *jnewpt,
	     int *jstat);
void s6idint(SISLObject *po1,SISLObject *po2,SISLIntdat *pintdat,SISLIntpt **rpt,
	     int iob);
void shmkhlppts (SISLObject * po1, SISLObject * po2, double aepsge,
		 SISLIntdat ** rintdat, SISLEdge * vedge[], int *jnewpt, 
		 int *jstat);
void sh6tohelp(SISLIntpt *pt,int *jstat);
double s1173_s9del(double *eco, double *eco1, double *eco2, int idim);
void s1173_s9dir(double *cdist, double *cdiff1, double *cdiff2,
		 double gdiff[], double evalp[], double evals[], double aepsge);
void s1173_s9corr(double gd[], double acoef1,double acoef2,double astart1,
		  double aend1,double astart2, double aend2);
void  s1173(SISLPoint *ppoint, SISLSurf *psurf, double aepsge,double estart[],
	    double eend[], double enext[], double gpos[],int *jstat);
void s1773_s9dir(double *cdist,double *cdiff1,double *cdiff2,
		 double PS[],double eval1[],double eval2[],
		 double aepsge, int idim,int *jstat);
void s1773_s9corr(double gd[],double acoef1,double acoef2,
		  double astart1,double aend1,double astart2,double aend2);
void s1773(SISLPoint *ppoint,SISLSurf *psurf,double aepsge,
	   double estart[],double eend[],double enext[],double gpos[],int *jstat);
void sh6ptobj(double *point, SISLObject *obj, double aepsge,
	      double start[], double result[], int *jstat);
void sh6idnewunite (SISLObject *po1, SISLObject *po2, SISLIntdat ** intdat, 
		    SISLIntpt ** pt1, SISLIntpt ** pt2, double weight, 
		    double aepsge, int *jstat);
void sh6trimlist (SISLIntpt * pt, SISLIntpt *** ptlist, int *no_of_points,
		  int *no_alloc);
void sh6red (SISLObject * po1, SISLObject * po2,
	     SISLIntdat * pintdat, int *jstat);
void sh6idcon (SISLIntdat ** pintdat, SISLIntpt ** pintpt1, 
	       SISLIntpt ** pintpt2, int *jstat);
void sh6insertpt (SISLIntpt * pt1, SISLIntpt * pt2, SISLIntpt * ptnew, int *jstat);
int sh6nmbmain(SISLIntpt *pt,int *jstat);
void sh6connect (SISLIntpt * pt1, SISLIntpt * pt2, int *jstat);
void sh6disconnect(SISLIntpt *pt1,SISLIntpt *pt2,int *jstat);
void sh6idkpt (SISLIntdat ** pintdat, SISLIntpt ** pintpt, int join, int *jstat);
void sh_div_crv (SISLCurve * pc, int which_end, double aepsge, 
		 SISLCurve ** rcnew, int *jstat);
void sh_div_surf (SISLSurf * ps, int which_end_1, int which_end_2,
		  double aepsge, SISLSurf ** rsnew, int *jstat);
void sh6comedg (SISLObject * po1, SISLObject * po2, SISLIntpt *pt1, 
		SISLIntpt *pt2, int *jstat);
void sh6isinside (SISLObject * po1, SISLObject * po2, SISLIntpt *intpt, int *jstat);
void freeTrimpar(SISLTrimpar *trimpar);
void freeIntpt(SISLIntpt *ppt);
void s6deCasteljau(double C[], double a, double b, double t, int k, double D[], int* jstat);
void s6sratder(double eder[],int idim,int ider1,int ider2,double gder[],int *jstat);
void s1424(SISLSurf *ps1,int ider1,int ider2,double epar[],
	   int *ileft1,int *ileft2,double eder[],int *jstat);
void s6hermite_bezier(SISLSurf* s,double a[],double b[],int idim, double c[],int* jstat);
void s6identify(SISLSurf* s,double a[], double b[], double level_val,
		double eps1,double eps2,int* jstat);
SISLIntdat *newIntdat (void);
void sh_1d_div_sh9idnpt(SISLSurf* surf, SISLPoint* point, SISLIntdat **pintdat,
			SISLIntpt **pintpt, int itest, double aepsge, int *jstat);
void  sh_1d_div (SISLObject *po1, SISLObject *po2, double aepsge,
		 SISLIntdat **pintdat,  SISLEdge * vedge[], int *jstat);
void s1797(SISLSurf *ps1,SISLCurve *pc1,double aepsge,double aang,int *jstat);
void s1795(SISLSurf *ps1,SISLSurf *ps2,double aepsge,double aang,int *jstat);
void s1796(SISLCurve *pc1,SISLCurve *pc2,double aepsge,double aang,int *jstat);
double s6dplane(double eq1[],double eq2[],double eq3[],double epoint[],
		int idim,int *jstat);
double s6dline(double estart[],double eend[],double epoint[],
	       int idim,int *jstat);
void s1990_s9smooth(double ecoef1[],int in1,int in2,int idim,
		    double aepsge,double ecoef2[],int *jstat);
void s1990_s9edg(double et[],double etan[],double esen[],double aepsge,
		 double *cang,int idim,int *jstat);
void s1990(SISLSurf *ps,double aepsge,int *jstat);
void sh1994(SISLSurf *s1,double aepsge,int *jstat);
SISLdir *newdir(int);
void s1991(SISLCurve *pc,double aepsge,int *jstat);
void sh1993(SISLCurve *c1,double aepsge,int *jstat);
void s1741(SISLObject *po1,SISLObject *po2,double aepsge,int *jstat);
void sh6edgpoint (SISLEdge * vedge[], SISLIntpt *** wintpt, int *jnum,int *jstat);
void sh1762_s9mic (SISLObject *, SISLObject *, SISLIntdat **, SISLEdge **[], int *);
void sh1762_s9num (SISLObject *, SISLObject *, int *, int *);
void sh1762_s9div (SISLObject *, SISLObject *, double, int, int, SISLObject *[], SISLEdge *[], SISLIntdat **, int *);
void sh1762_s9subdivpt (SISLObject *, SISLObject *, double, int, int, SISLEdge *[], SISLIntdat **, int *, SISLIntpt **, double[], int *);
void sh1762_s9update (SISLObject *, SISLObject *, double, SISLIntdat **, SISLEdge **[], int *);
void sh1762_s9con (SISLObject *, SISLObject *, double, SISLIntdat **, SISLEdge *[], int *);
void sh1762_s9intercept (SISLObject *, SISLObject *, double, int, SISLIntpt *[], int *);
void sh1762_s9coincide (SISLObject *, SISLObject *, double, int, SISLIntpt *[], int *);
void sh1762_s9toucharea (SISLObject *, SISLObject *, double, int, SISLIntpt *[], int *);
void sh1762_s9edgsscon (SISLEdge *[], SISLSurf *, SISLSurf *, SISLIntdat *, int, double, int *);
void sh1762_s9edgpscon (SISLEdge *, double, SISLSurf *, int, SISLIntdat *, double, int *);
void sh1762_s9simple (SISLObject *, SISLObject *, SISLEdge *[], int *);
void sh1762_s9ptiter (SISLObject *, SISLObject *, double, SISLIntdat **, SISLEdge *[], int *);
int sh1762_is_taboo(SISLSurf *, SISLSurf *, SISLIntpt *, int, int *);
void sh1762 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** pintdat, SISLEdge * vedge[], int *jstat);
double sh1762_sflength(SISLSurf *, int, int *);
void sh6tomain(SISLIntpt *pt,int *jstat);
void s6fndintvl(double *et,int ik,int in,int *ileft,
		double ax1,double ax2,int mu_max,int *jstat);
int sh6getprev(SISLIntpt *pt1,SISLIntpt *pt2);
void sh6getlist(SISLIntpt *pt1,SISLIntpt *pt2,int *index1,int *index2,int *jstat);
void sh6getother(SISLIntpt *pt,SISLIntpt *pt1,SISLIntpt **pt2,int *jstat);
void sh6getnhbrs(SISLIntpt *pt,SISLIntpt **pt1,SISLIntpt **pt2,int *jstat);
int sh6ismain(SISLIntpt *pt);
SISLIntpt* sh6getnext(SISLIntpt *pt,int index);
int sh6ishelp(SISLIntpt *pt);
SISLIntpt * sh6getmain (SISLIntpt * pt);
void sh6idalledg (SISLObject * pob1, SISLObject * pob2, SISLIntdat * pintdat,
		  SISLEdge * wedge[], int *jstat);
void freePtedge(SISLPtedge *p1);
void freeEdge(SISLEdge *pedge);
void s1435(SISLSurf *ps1,int iedge,SISLCurve **rcedge,double *cpar,int *jstat);
SISLPtedge *newPtedge (SISLIntpt * ppt);
void s6idedg(SISLObject *po1,SISLObject *po2,int iobj,int ipar,double apar,
	     SISLIntdat *pintdat,SISLPtedge **rptedge,int *jnum,int *jstat);
int s6knotmult(double et[],int ik,int in,int *ileft,double ax,int *jstat);
void test_cyclic_knots(double et[],int in,int ik,int *jstat);
double s1325(double aradiu,double angle);
void sh1782 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat * pintdat, int ipar, double apar,
	     SISLIntdat ** rintdat, int *jnewpt, int *jstat);
void sh1782_s9sf_pt (SISLObject *, SISLObject *, double, SISLIntdat **,
		     SISLIntpt **, int, int, int *);
void sh1782_s9sf_cu (SISLObject *, SISLObject *, double, SISLIntdat **,
		     SISLIntpt **, int, int, int *);
void sh1782_s9sf_sf (SISLObject *, SISLObject *, double, SISLIntdat **,
		     SISLIntpt **, int, int, int *);
void s1438(SISLCurve  *pc,int iedge,SISLPoint **rpedge,double *cpar,int *jstat);
SISLEdge *newEdge (int iedge);
void sh1790(SISLObject *po1,SISLObject *po2,int itype, double aepsge,int *jstat);
void sh6idnpt(SISLIntdat **pintdat,SISLIntpt **pintpt,int itest,int *jstat);
SISLIntpt * hp_newIntpt (int ipar, double *epar, double adist, int itype,
			 int ileft1, int iright1, int ileft2, int iright2,
			 int size_1, int size_2, double egeom1[], double egeom2[]);
void make_cv_kreg (SISLCurve * pc, SISLCurve ** rcnew, int *jstat);
void s1605(SISLCurve *pc,double aepsge,double **gpoint,int *jnbpnt,int *jstat);
double s1309(double epnt[],double edir[],double eimpli[],int ideg,int *jstat);
void s1436(SISLSurf *ps1,double apar,SISLCurve **rcurve,int *jstat);
void s1712 (SISLCurve * pc, double abeg, double aend, SISLCurve ** rcnew, int *jstat);
void s1437(SISLSurf *ps1,double apar,SISLCurve **rcurve,int *jstat);
void s9clipimp(double epar1[],double epar2[],SISLSurf *psurf1,double eimpli[],
	       int ideg,double euval[],double evval[],double aepsge,
	       double gpnt1[],double gpar1[],int *jstat);
void s1305(double epar1[],double epar2[],double eval1[],double eval2[],
	   int *jbound,double gpar[],int *jstat);
void s1331(double ep[],double eimpli[],int ideg,int ider,
	   double gder[],double gnorm[],int *jstat);
double s9adsimp(double epnt1[],double epar1[],double eimpli[],int ideg,double egd1[],
		double epgd1[],double etang[],double eptan[],double astep,int *jstat);
void s9iterimp(double epoint[],double epnt1[],double epar1[],SISLSurf *psurf1,
	       double eimpli[],int ideg,double astep,double aepsge,
	       double gpnt1[],double gpar1[],int *jstat);
void s1313(SISLSurf *ps1,double eimpli[],int ideg,double aepsco,double aepsge,
	   double amax,SISLIntcurve *pintcr,int icur,int igraph,int *jstat);
void s1313_s9constline(SISLSurf *,double [],int,double,
		       SISLIntcurve *,int,int,int *);
void s1306(double ep[],double eparp[],double eimpli[],int ideg,
	   double egeo3d[],double egeop[],int *jstat);
void s1771(SISLPoint *ppoint,SISLCurve *pcurve,double aepsge,
	   double astart,double aend,double anext,double *cpos,int *jstat);
void s6ratder(double eder[],int idim,int ider,double gder[],int *jstat);
double s1771_s9del(double *,double *,double *,int);
void s1771_s9point(SISLCurve *,double [],double [],double [],double,double,
		   int,double *,double *,double,double *,double,int,int *);
void s6lusolp(double ea[],double eb[],int nl[],int im,int *jstat);
void s6lufacp(double ea[],int nl[],int im,int *jstat);
void s1227(SISLCurve *pc1,int ider,double ax,int *ileft,double eder[],int *jstat);
void refine_all (SISLIntdat ** pintdat, SISLObject * po1, SISLObject * po2,
		 double eimpli[], int ideg, double aepsge, int *jstat);
void sh6degen(SISLObject * po1, SISLObject * po2, SISLIntdat ** pintdat,
	      double aepsge, int *jstat);
void sh6degen_geom(SISLObject *,SISLObject *,double [],double [], int *);
void freePoint(SISLPoint *ppoint);
// SISLPoint *newPoint (double *ecoef, int idim, int icopy);
void s1329(SISLSurf *psold,double epoint[],double enorm[],int idim,
	   SISLSurf **rsnew,int *jstat);
void make_sf_kreg (SISLSurf * ps, SISLSurf ** rsnew, int *jstat);
void s6err(const char *rut,int jstat,int ipos);
void s1310_s9constline(SISLSurf *ps1,SISLSurf *ps2,SISLIntcurve *pintcr,
		       double aepsge,int icur,int igraph,int *jstat);
void s1359(double egeo[],double aepsge,int idim,int inbinf,
	   int ipar,double epar[],SISLCurve **rcurve,int *jstat);
void s6line(double epoint[]);
void s6move(double epoint[]);
void s9clipit(double epar11[],double epar12[],double epar21[],double epar22[],
	      SISLSurf *psurf1,SISLSurf *psurf2,double euval[],double evval[],
	      double esval[], double etval[],double aepsge,double gpnt1[],
	      double gpnt2[], double gpar1[],double gpar2[],int *jstat);
void s1330(double epar11[],double epar12[],double epar21[],double epar22[],
	   double eval11[],double eval12[],double eval21[],double eval22[],
	   int *jbound,double gpar1[],double gpar2[],int *jstat);
double s6ang(double evec1[],double evec2[],int idim);
void s1361(double epnt1[],double epnt2[],int idim,
	   double gmidd[],double gmtang[],int *jstat);
double s9adstep(double epnt1[],double epar1[],double epnt2[],double epar2[],
		double egd1[],double epgd1[],double egd2[],double epgd2[],
		double etang[],double eptan1[],double eptan2[],double astep,int *jstat);
double s1311(double arad,double aepsge,double amax,int *jstat);
double s6dist(double [],double [],int);
void s9iterate(double epoint[],double epnt1[],double epnt2[],double epar1[],
	       double epar2[],SISLSurf *psurf1,SISLSurf *psurf2,double astep,
	       double aepsge,double gpnt1[],double gpnt2[],double gpar1[],
	       double gpar2[],int *jstat);

void s1304(double ep[],double eq[],double eparp[],double eparq[],double egeo3d[],
	   double egeop[],double egeoq[],int *jstat);
// void freeIntdat(SISLIntdat *pintdat);
// void freeObject(SISLObject *);
void hp_s1880(SISLObject *,SISLObject *,int,int,int,SISLIntdat *,int *,
	      double **,double **,int **,int *,SISLIntcurve ***,
	      int *,SISLIntsurf ***,int *);
void make_tracks(SISLObject *,SISLObject *,int,double [],int,SISLIntlist **,
		 int *,SISLTrack ***,double,int *);
void int_join_per(SISLIntdat **,SISLObject *,SISLObject *,double [],
		  int,double,int *);
// void sh1761 (SISLObject * po1, SISLObject * po2, double aepsge, 
// 	     SISLIntdat ** pintdat, int *jstat);
double s6norm(double e1[],int idim,double e2[],int *jstat);
void s6diff(double e1[],double e2[],int idim,double e3[]);
void s1219(double *et,int ik,int in,int *ileft,double ax,int *jstat);
void s6strider(double [],int,int,double [],int *);
void s6crss(double e1[],double e2[],double e3[])
{
  e3[0] = e1[1]*e2[2] - e1[2]*e2[1];
  e3[1] = e1[2]*e2[0] - e1[0]*e2[2];
  e3[2] = e1[0]*e2[1] - e1[1]*e2[0];
}
double s6length(double e1[],int idim,int *jstat);
void s6chpar(double ecoef1[],int in1,int in2,int idim,double ecoef2[]);

void s1770_s9corr(double [],double,double,double,double,double,double);
void s1770_s9dir(double *,double *,double *,double [],double [],double [],int);
void sh1851(SISLSurf * ps1, double epoint[], double enorm[], int idim, 
	    double aepsco, double aepsge,int trackflag, int *jtrack, 
	    SISLTrack *** wtrack,int *jpt, double **gpar, int **pretop, 
	    int *jcrv, SISLIntcurve *** wcurve, int *jsurf, 
	    SISLIntsurf ***wsurf, int *jstat);
void sh1853(SISLSurf *ps1,double epoint[],double edirec[],double aradius,
	    int idim, double aepsco,double aepsge,
	    int trackflag, int *jtrack, SISLTrack *** wtrack,
	    int *jpt,double **gpar,int **pretop,int *jcrv,
	    SISLIntcurve ***wcurve,int *jsurf, 
	    SISLIntsurf *** wsurf, int *jstat);
void sh1859 (SISLSurf * ps1, SISLSurf * ps2, double aepsco, double aepsge,
	     int trackflag, int *jtrack, SISLTrack *** wtrack,
	     int *jpt, double **gpar1, double **gpar2, int **pretop, 
	     int *jcrv, SISLIntcurve *** wcurve, int *jsurf, 
	     SISLIntsurf *** wsurf, int *jstat);

void freeIntsurf(SISLIntsurf *);

void s1770_2D_s9corr(double [],double[],double,double,double,double,int*);
void s1770_2D_s9dir(double *dist,double diff[],double delta[],
			   double c1[],double c1_t[],double c1_tt[],
			   double c2[],double c2_t[],double c2_tt[],
			   int dim, int second, double* det, int* jstat);
void s1770_2D_s6sekant1(SISLCurve *pcurve1,SISLCurve *pcurve2,
			double  par_val[], double delta, double *dist, double aepsge,
			double astart1,double astart2,double aend1,double aend2,
			double c1[], double c2[], double norm[],
			int *jstat);
int s1770_2D_s6local_pretop(double dist,double diff[],double normal[],
			    double c1[],double c1_t[],double c1_tt[],
			    double c2[],double c2_t[],double c2_tt[],
			    int dim, int*jstat);

void s1770_2D(SISLCurve *pcurve1,SISLCurve *pcurve2,double aepsge,
	      double astart1,double astart2,double aend1,double aend2,
	      double anext1,double anext2,double *cpos1,double *cpos2,int *jstat);

void s1221(SISLCurve *pc1,int ider,double ax,int *ileft,double eder[],int *jstat);
void sh1992su(SISLSurf *ps,int itype,double aepsge,int *jstat);


//===========================================================================
//                IMPLEMENTATIONS COMMENCE HERE
//===========================================================================

//===========================================================================
void sh6setcnsdir(SISLIntpt *pt1,SISLIntpt *pt2,int ipar,int *jstat)
//===========================================================================
{
   int kstat;         /* error flag. */
   int index1,index2; /* dummy indices.           */
   
   *jstat = 0;
   /* Legal value on ipar ? */
   if (ipar < 0 || ipar > 3) goto err0;
			     
   /* Check if pt1 and pt2 are already connected. */

   sh6getlist(pt1,pt2,&index1,&index2,&kstat);
   if(kstat < 0) goto err2;
   if(kstat > 1) goto err1; /* Not connected. */
		 /*
		 if(pt1->iinter == SI_ORD)       pt1->iinter =  SI_SING;
		 else if(pt1->iinter == -SI_ORD) pt1->iinter = -SI_SING;
		 
		 if(pt2->iinter == SI_ORD)       pt2->iinter =  SI_SING;
		 else if(pt2->iinter == -SI_ORD) pt2->iinter = -SI_SING;
		 */
 /* Set constant direction between pt1 and pt2. */
   pt1->curve_dir[index1] |= (1<<(ipar+1));
   pt2->curve_dir[index2] |= (1<<(ipar+1));

   goto out;

   /* Wrong value on ipar. */
err0:

   *jstat = -3;
   s6err("sh6setcnsdir",*jstat,0);
   goto out;

   /* Points are not connected. */
err1:

   *jstat = -1;
   s6err("sh6setcnsdir",*jstat,0);
   goto out;

   /* Error in subfuction. */
err2:

   *jstat = -2;
   s6err("sh6setcnsdir",*jstat,0);
   goto out;

   out :
      return;
}


//===========================================================================
void s6degnorm(SISLSurf *ps1,int ider,double epar[],double eder[],
	       double utang[],double vtang[],double enorm[],int *jstat)
//===========================================================================
{
  int kstat=0;        /* Local status variable.                          */
  int kpos=0;         /* Position of error.                              */
  int kdim;           /* Dimension of the space in which the surface lies. */
  int ki;             /* Control variables in for loop                   */
  double *et1,*et2;   /* Local pointer to knot vectors. */
  int in1,in2;        /* Number of points in ps1 in the 2 direcs. */
  int ik1,ik2;        /* Degree of ps1 in the 2 direcs. */
  double upar,vpar;   /* Parameter values. */
  double *xu,*xv;         /* Pointers to first derivatives. */
  double *xuu,*xuv,*xvv;  /* Pointers to second derivatives. */
  double len;        /* Vector length. */
  int ius,ivs,is;    /* Flags. u=min => ius = 1, u=max => ius = -1. */
  int endu,endv;     /* Flags for whether u or v are extreme. */
  int iu,iv;         /* Which first derivs are zero? */
  int iuu,iuv,ivv;   /* Which second derivs are zero? */
  double vec[3];     /* Temporary vector. */
  double vec1[3],vec2[3];  /* Temporary vectors. */
  double normal[3];  /* Temporary normal. */
  int usuccess;      /* Flag if u tangent found. */
  int vsuccess;      /* Flag if v tangent found. */
  
  
  /* Set up local variables. */

  kdim = ps1 -> idim;
  et1 = ps1 -> et1;
  et2 = ps1 -> et2;
  in1 = ps1 -> in1;
  in2 = ps1 -> in2;
  ik1 = ps1 -> ik1;
  ik2 = ps1 -> ik2;

  /* Check input. */

  if(kdim != 3) goto err101;
  if(ider < 2) goto err101;
  

  upar = epar[0];
  vpar = epar[1];

  xu  = eder + kdim;
  xuu = xu   + kdim;
  xv  = xuu  + kdim;
  xuv = xv   + kdim;
  xvv = xuv  + kdim + kdim;

  /* Find out whether (u,v) is at a corner, edge or in the
     middle of the surface ps1. */

  ius = 0;
  ivs = 0;
  is = 0;

  if(upar == et1[ik1-1])
  {
      endu = TRUE;
      ius = 1;
  }
  else if(upar == et1[in1])
  {
      endu = TRUE;
      ius = -1;
  }
  else
  {
      endu = FALSE;
  }

  if(vpar == et2[ik2-1])
  {
      endv = TRUE;
      ivs = 1;
  }
  else if(vpar == et2[in2])
  {
      endv = TRUE;
      ivs = -1;
  }
  else
  {
      endv = FALSE;
  }

  if(endu && endv) is = ius * ivs;

  if(!endu && !endv) goto err101;

  /* For each derivative, set flag to 0 or 1 according to
     whether the length is 0 or non-zero. */

  len = s6length(xu,kdim,&iu);
  len = s6length(xv,kdim,&iv);
  len = s6length(xuu,kdim,&iuu);
  len = s6length(xuv,kdim,&iuv);
  len = s6length(xvv,kdim,&ivv);


  /* Calculate tangent in u using higher derivatives. */

  usuccess = FALSE;

  if(iu == 0)
  {
      if(endu && iuu == 1)
      {
          len = s6norm(xuu,kdim,vec,&kstat);
          for(ki=0; ki<kdim; ki++) vec[ki]*=ius;
          usuccess = TRUE;
      }
      else if(endv && iuv == 1)
      {
          len = s6norm(xuv,kdim,vec,&kstat);
          for(ki=0; ki<kdim; ki++) vec[ki]*=ivs;
          usuccess = TRUE;
      }
  }
  else
  {
      len = s6norm(xu,kdim,vec,&kstat);
      usuccess = TRUE;
  }


  if(usuccess)
  {
      /* u tangent found. Return result. */

      for(ki=0; ki<kdim; ki++) utang[ki] = vec[ki];
  }
  else
  {
      /* No u tangent found. Return zero and flag. */

      for(ki=0; ki<kdim; ki++) utang[ki] = (double)0.0;
  }

  /* Calculate tangent in v using higher derivatives. */

  vsuccess = FALSE;

  if(iv == 0)
  {
      if(endu && iuv == 1)
      {
          len = s6norm(xuv,kdim,vec,&kstat);
          for(ki=0; ki<kdim; ki++) vec[ki]*=ius;
          vsuccess = TRUE;
      }
      else if(endv && ivv == 1)
      {
          len = s6norm(xvv,kdim,vec,&kstat);
          for(ki=0; ki<kdim; ki++) vec[ki]*=ivs;
          vsuccess = TRUE;
      }
  }
  else
  {
      len = s6norm(xv,kdim,vec,&kstat);
      vsuccess = TRUE;
  }


  if(vsuccess)
  {
      /* v tangent found. Return result. */

      for(ki=0; ki<kdim; ki++) vtang[ki] = vec[ki];
  }
  else
  {
      /* No v tangent found. Return zero and flag. */

      for(ki=0; ki<kdim; ki++) vtang[ki] = (double)0.0;
  }


  /* Calculate normal using higher derivatives. */

  if(iu == 0)
  {
      if(iv == 0)
      {
	  if(endu && iuu == 1 && iuv == 1)
	  {
	      s6crss(xuu,xuv,vec);
	      len = s6norm(vec,kdim,normal,&kstat);
	      if(kstat == 1) goto normfound;
	  }
	  if(endv && iuv == 1 && ivv == 1)
	  {
	      s6crss(xuv,xvv,vec);
	      len = s6norm(vec,kdim,normal,&kstat);
	      if(kstat == 1) goto normfound;
	  }
	  if(endu && endv && iuu == 1 && ivv == 1)
	  {
	      s6crss(xuu,xvv,vec);
	      for(ki=0; ki<kdim; ki++) vec[ki]*=is;
	      len = s6norm(vec,kdim,normal,&kstat);
	      if(kstat == 1) goto normfound;
	  }
      }
      else
      {
	  if(endu && iuu == 1)
	  {
	      s6crss(xuu,xv,vec);
	      for(ki=0; ki<kdim; ki++) vec[ki]*=ius;
	      len = s6norm(vec,kdim,normal,&kstat);
	      if(kstat == 1) goto normfound;
	  }
	  if(endv && iuv == 1)
	  {
	      s6crss(xuv,xv,vec);
	      for(ki=0; ki<kdim; ki++) vec[ki]*=ivs;
	      len = s6norm(vec,kdim,normal,&kstat);
	      if(kstat == 1) goto normfound;
	  }
      }
  }
  else
  {
      if(iv == 0)
      {
	  if(endu && iuv == 1)
	  {
	      s6crss(xu,xuv,vec);
	      for(ki=0; ki<kdim; ki++) vec[ki]*=ius;
	      len = s6norm(vec,kdim,normal,&kstat);
	      if(kstat == 1) goto normfound;
	  }
	  if(endv && iuv == 1)
	  {
	      s6crss(xuv,xv,vec);
	      for(ki=0; ki<kdim; ki++) vec[ki]*=ivs;
	      len = s6norm(vec,kdim,normal,&kstat);
	      if(kstat == 1) goto normfound;
	  }
      }
      else
      {
	  if(endu && (iuu == 1 || iuv == 1))
	  {
	      s6crss(xuu,xv,vec1);
	      s6crss(xu,xuv,vec2);
	      for(ki=0; ki<kdim; ki++) vec[ki]=vec1[ki]+vec2[ki];
	      for(ki=0; ki<kdim; ki++) vec[ki]*=ius;
	      len = s6norm(vec,kdim,normal,&kstat);
	      if(kstat == 1) goto normfound;
	  }
	  if(endv && (iuv == 1 || ivv == 1))
	  {
	      s6crss(xuv,xv,vec1);
	      s6crss(xu,xvv,vec2);
	      for(ki=0; ki<kdim; ki++) vec[ki]=vec1[ki]+vec2[ki];
	      for(ki=0; ki<kdim; ki++) vec[ki]*=ivs;
	      len = s6norm(vec,kdim,normal,&kstat);
	      if(kstat == 1) goto normfound;
	  }
      }
  }

  /* No normal found. Return zero and flag. */

  for(ki=0; ki<kdim; ki++) enorm[ki] = (double)0.0;

  /* Set diagnostics flag. */
  if(usuccess)
  {
      if(vsuccess) *jstat = 1;
      else *jstat = 2;
  }
  else
  {
      if(vsuccess) *jstat = 3;
      else *jstat = 4;
  }
  goto out;

   /* Normal found and hence tangents found. Return result. */

normfound:

  for(ki=0; ki<kdim; ki++) enorm[ki] = normal[ki];
  *jstat = 0;
  goto out;


  /* Error in input. */

err101: *jstat = -101;
  s6err("s6degnorm",*jstat,kpos);
  goto out;
  
  
 out:
  
  return;
}



//===========================================================================
void sh6idrmcross(SISLObject *po1, SISLObject *po2, SISLIntdat **pintdat,
		  SISLIntpt *vcross[], int incross, SISLIntpt *vpt[],
		  int inpt, int *jstat)
//===========================================================================
{
   int kstat;          /* Status variable.                          */
   int ki,kj,kl;       /* Counters.                                 */
   int kdim;           /* Dimension of geometry space.              */
   int kleft1 = 0;     /* Parameters used in evaluator.             */
   int kleft2 = 0;
   int kdir1,kdir2;    /* Parameter directions.                     */
   int kpar;           /* Number of parameter directions.           */
   int k1par = po1->iobj; /* Number of par. dir. in first object.   */
   int kmin;           /* Number of minimum parameter point.        */
   double tmin;        /* Length of minimum parameter point as vector. */
   double thelp;       /* Help parameter. Length of vector.         */
   double sder1[27];   /* Position, derivative etc. of object 1.    */
   double sder2[27];   /* Position, derivative etc. of object 2.    */
   double stang1[3];   /* Tangent in first parameter dir., deg. surf. */
   double stang2[3];   /* Tangent in second parameter dir., deg. surf. */
   double snorm[3];    /* Normal of degenerated surface.            */

   *jstat = 0;

   /* Test input.  */

   if (incross != 4) goto err138;

   if (po1->iobj == SISLPOINT || po2->iobj == SISLPOINT)
   {
      *jstat = 0;
      goto out;
   }

   if (po1->iobj == SISLSURFACE)
   {
      /* Check if the intersection points have got one parameter in
	 common.      */

      for (kj=0; kj<2; kj++)
      {
	 for (ki=1; ki<incross; ki++)
	    if (DNEQUAL(vcross[ki]->epar[kj],vcross[0]->epar[kj])) break;
	 if (ki == incross) break;  /* Common parameter direction.  */
      }

      if (kj == 2)
      {
	 /* No common parameter direction, i.e. no cross intersection
	    to remove.  */

	 *jstat = 0;
	 goto out;
      }

      /* Set the parameter direction that is not constant.  */

      kdir1 = 1 - kj;
   }

   if (po2->iobj == SISLSURFACE)
   {
      /* Check if the intersection points have got one parameter in
	 common.      */

      for (kj=po1->iobj, kpar=vcross[0]->ipar; kj<kpar; kj++)
      {
	 for (ki=1; ki<incross; ki++)
	    if (DNEQUAL(vcross[ki]->epar[kj],vcross[0]->epar[kj])) break;
	 if (ki == incross) break;  /* Common parameter direction.  */
      }

      if (kj == kpar)
      {
	 /* No common parameter direction, i.e. no cross intersection
	    to remove.  */

	 *jstat = 0;
	 goto out;
      }

      /* Set the parameter direction that is not constant.  */

      kdir2 = kpar - 1 - kj;
   }

   /* Find the minimum parameter point in which to evaluate. */

   kmin = 0;
   tmin = s6length(vcross[0]->epar,vcross[0]->ipar,&kstat);

   for (kj=1; kj<incross; kj++)
   {
      thelp = s6length(vcross[kj]->epar,vcross[kj]->ipar,&kstat);
      if (thelp < tmin)
      {
	 tmin = thelp;
	 kmin = kj;
      }
   }

   /* Compute derivatives.  */

   if (po1->iobj == SISLCURVE)
   {
      kdir1 = 0;
      kdim = po1->c1->idim;
      s1221(po1->c1,1,vcross[kmin]->epar[kdir1],&kleft1,sder1,&kstat);
      if (kstat < 0) goto error;
   }
   else if (po1->iobj == SISLSURFACE)
   {
      kdim = po1->s1->idim;
      s1424(po1->s1,2,2,vcross[kmin]->epar,&kleft1,&kleft2,sder1,
	    &kstat);
      if (kstat < 0) goto error;
      s6crss(sder1+kdim, sder1+2*kdim, snorm);

      /* Check if the surface is degenerated in the wanted parameter
	 direction.   */

      if (s6length(sder1+(1+kdir1)*kdim,kdim,&kstat) <= REL_COMP_RES)
      {
	 /* Compute partial derivatives as a limit.  */

	 s6degnorm(po1->s1,2,vcross[kmin]->epar,sder1,stang1,stang2,
		   snorm,&kstat);
	 if (kstat < 0) goto error;

	 memcopy(sder1+kdim,stang1,kdim,DOUBLE);
	 memcopy(sder1+2*kdim,stang2,kdim,DOUBLE);
      }
   }

   /* Compute derivatives.  */

   if (po2->iobj == SISLCURVE)
   {
      kdir2 = 0;
      s1221(po2->c1,1,vcross[kmin]->epar[k1par+kdir2],&kleft1,sder2,&kstat);
      if (kstat < 0) goto error;
   }
   else if (po2->iobj == SISLSURFACE)
   {
      s1424(po2->s1,2,2,vcross[kmin]->epar+k1par,&kleft1,&kleft2,sder2,
	    &kstat);
      if (kstat < 0) goto error;
      s6crss(sder2+kdim, sder2+2*kdim, snorm);

      /* Check if the surface is degenerated in the wanted parameter
	 direction.   */

      if (s6length(sder2+(1+kdir2)*kdim,kdim,&kstat) <= REL_COMP_RES)
      {
	 /* Compute partial derivatives as a limit.  */

	 s6degnorm(po2->s1,2,vcross[kmin]->epar+k1par,sder2,stang1,stang2,
		   snorm,&kstat);
	 if (kstat < 0) goto error;

	 memcopy(sder2+kdim,stang1,kdim,DOUBLE);
	 memcopy(sder2+2*kdim,stang2,kdim,DOUBLE);
      }
   }

   if (s6ang(sder1+(kdir1+1)*kdim,sder2+(kdir2+1)*kdim,kdim) > ANGULAR_TOLERANCE
       && !(s6length(sder1+(kdir1+1)*kdim,kdim,&kstat) < REL_COMP_RES &&
	    s6length(sder2+(kdir2+1)*kdim,kdim,&kstat) < REL_COMP_RES))
   {
      *jstat = 0;
      goto out;
   }

   /* Check if the parameter directions of the objects are the same.  */

   if (s6scpr(sder1+(kdir1+1)*kdim,sder2+(kdir2+1)*kdim,kdim) >= 0)
   {
      /* Remove the pair of intersection point that do not have the
	 same "parameter direction" in both objects.  */

      for (ki=0; ki<incross; ki++)
	{
	  for (kj=1; kj<incross; kj++)
	    {
	      if (DNEQUAL(vcross[ki]->epar[kdir1],vcross[kj]->epar[kdir1]) &&
		  DNEQUAL(vcross[ki]->epar[k1par+kdir2],
			  vcross[kj]->epar[k1par+kdir2]))
		{
		  /* A pair is found. Check if the pair should be removed. */

		  if ((vcross[ki]->epar[kdir1] - vcross[kj]->epar[kdir1]) *
		      (vcross[ki]->epar[k1par+kdir2] -
		       vcross[kj]->epar[k1par+kdir2]) < 0)
		    {
		      /* Remove the points. First make sure that vpt will
			 not point to killed points.  */

		      for (kl=0; kl<inpt; kl++)
			if (vpt[kl] == vcross[ki] || vpt[kl] == vcross[kj])
			  vpt[kl] = SISL_NULL;

		      sh6idkpt(pintdat,&vcross[ki],1,&kstat);
		      if (kstat < 0) goto error;

		      sh6idkpt(pintdat,&vcross[kj],1,&kstat);
		      if (kstat < 0) goto error;

		      *jstat = 1;
		      break;
		    }
		}
	    }
	  if (kj < incross)
	    break;           /* The cross intersection is removed */
	}

      if (*jstat == 1) goto out;  /* Points removed.  */
   }
   else
   {
      /* Remove the pair of intersection point that have the
	 same "parameter direction" in both objects.  */

      for (ki=0; ki<incross; ki++)
	{
	  for (kj=1; kj<incross; kj++)
	    {
	      if (DNEQUAL(vcross[ki]->epar[kdir1],vcross[kj]->epar[kdir1]) &&
		  DNEQUAL(vcross[ki]->epar[k1par+kdir2],
			  vcross[kj]->epar[k1par+kdir2]))
		{
		  /* A pair is found. Check if the pair should be removed. */

		  if ((vcross[ki]->epar[kdir1] - vcross[kj]->epar[kdir1]) *
		      (vcross[ki]->epar[k1par+kdir2] -
		       vcross[kj]->epar[k1par+kdir2]) > 0)
		    {
		      /* Remove the points. First make sure that vpt will
			 not point to killed points. */

		      for (kl=0; kl<inpt; kl++)
			if (vpt[kl] == vcross[ki] || vpt[kl] == vcross[kj])
			  vpt[kl] = SISL_NULL;

		      sh6idkpt(pintdat,&vcross[ki],1,&kstat);
		      if (kstat < 0) goto error;

		      sh6idkpt(pintdat,&vcross[kj],1,&kstat);
		      if (kstat < 0) goto error;

		      *jstat = 1;
		      break;
		    }
		}
	    }
	  if (kj < incross)
	    break;           /* The cross intersection is removed */
	 }

      if (*jstat == 1) goto out;  /* Points removed.  */
   }

      /* No points are removed. Set status.  */

      *jstat = 0;
      goto out;


   /* Wrong number of intersection points.  */

   err138 : *jstat = -138;
   goto out;

   /* Error in lower level routine.  */

   error : *jstat = kstat;
   goto out;

   out :
      return;
}


//===========================================================================
void sh6idfcross(SISLIntdat *pintdat, SISLIntpt *vcross[], int *jncross,
		 int ipar1, int ipar2, int *jstat)
//===========================================================================
{ 
   int ki,kj;       /* Counters.                               */
   int kpt;         /* Index of last intersection point found. */
   int kpar1;       /* Start index of current parameter set.   */
   int kpar2;       /* Number of parameter in current set.     */
   double tdist;    /* Distance between parameter points.      */
   SISLIntpt *pt;   /* Current intersection point.             */
   SISLIntpt *qnext; /* Next point to find.                    */
   
 
   /* Test if there is 4 points in pintdat.  */
   
   if (pintdat->ipoint < 4)
   {
      /* No possibility of cross intersections. */
      
      *jstat = 0;
      return;
   }
   
   /* Test if a set of cross intersections is found. */
   
   if (*jncross == 4)
   {
      /* Test if the second parameter set of the last intersection point
	 found is equal to that of the first point.         */
      
      tdist = s6dist(vcross[0]->epar+ipar1,vcross[3]->epar+ipar1,ipar2);
      if (DEQUAL(tdist+(double)1.0,(double)1.0))
	 /* The set of points is found.  */
	 
	 *jstat = 1;
      else
	 *jstat = 0;
      
      return;
   }
   
   /* Prepare for a search for the next point in the set.  */
   
   kpt = (*jncross) - 1;
   pt = vcross[kpt];
   kpar1 = (kpt % 2 == 0) ? 0 : ipar1;
   kpar2 = (kpt % 2 == 0) ? ipar1 : ipar2;
   
   /* Traverse the intersection points to find a point that has got
      one parameter set equal to the current one.  */
   
   for (ki=0; ki<pintdat->ipoint; ki++)
   {
      qnext = pintdat->vpoint[ki];
      
      /* Check if the point is found already.  */
      
      for (kj=0; kj<=kpt; kj++)
	 if (qnext == vcross[kj]) break;
      if (kj <= kpt) continue;
      
      /* Check if the next point belongs to the wanted set. */
      
      tdist = s6dist(qnext->epar+kpar1,pt->epar+kpar1,kpar2);
      if (DEQUAL(tdist+(double)1.0,(double)1.0))
      {
	 /* A point is found.  */
	 
	 kpt++;
	 vcross[kpt] = qnext;
	 (*jncross)++;
	 
	 /* Find next point.  */
	 
	 sh6idfcross(pintdat,vcross,jncross,ipar1,ipar2,jstat);
	 if (*jstat == 1) return;  /* The entire set is found.  */
	 
	 (*jncross)--;
	 kpt--;
      }
   }
   
   /* No set of cross intersections exist.  */
   
   *jstat = 0;
   return;
}


//===========================================================================
void sh6idput (SISLObject * po1, SISLObject * po2, SISLIntdat ** rintdat, 
	       SISLIntdat * pintdat, int inr, double apar, 
	       SISLIntpt *** outintpt, int *npoint, int *jstat)
//===========================================================================
{
  int kstat;			/* Local status variable.               */
  int kpos = 0;			/* Position of error.                   */
  int ki, kj;			/* Counters                             */
  int keep_first;		/* Flag, which object is not enhanced   */
  int kant;			/* Number of parameters in new points.  */
  int ind1, ind2;		/* Indexes (not used)                   */
  int no;			/* No. of doubles to copy into geo_aux  */
  double *scoef = SISL_NULL;		/* Pointer to array copying into geo_aux*/
  double *spar = SISL_NULL;		/* Storing uppdated parametervalues.    */
  SISLIntpt **uintpt = SISL_NULL;	/* Help array while getting connections */
  int iinter;
  double *nullp = SISL_NULL;
  /* VSK. Remove cross intersections. ----------------------------  */
  int kcross = 1;     /* Indicates existence of cross intersections. */
  int kncross = 0;    /* Number of cross intersections.              */
  int kpt;            /* Index in uintpt.                            */
  SISLIntpt *ucross[4];  /* Cross intersections.                     */

  *npoint = 0;

  /* Find out which object the parameter belongs to */
  if (inr < po1->iobj)
    keep_first = 0;
  else
    keep_first = 1;

  /* Do we have an intdat structure? */
  if (pintdat == SISL_NULL)
    {
      *jstat = 0;
      goto out;
    }

  /* Computing number of new parameter direction. */
  kant = pintdat->vpoint[0]->ipar + 1;


  if (inr < 0 || inr >= kant)
    goto err191;

  *npoint = pintdat->ipoint;

  /* Allocate an array for intersection points. */
  if ((uintpt = newarray (pintdat->ipoint, SISLIntpt *)) == SISL_NULL)
    goto err101;

  /* Allocate an array for parametervalues. */
  if ((spar = newarray (kant, double)) == SISL_NULL)
    goto err101;


  /* Enhance all intersection points. */
  for (ki = 0; ki < pintdat->ipoint; ki++)
    {
      /* Insert the missing parameter value. */

      for (kj = 0; kj < inr; kj++)
	spar[kj] = pintdat->vpoint[ki]->epar[kj];
      spar[kj] = apar;
      for (kj++; kj < kant; kj++)
	spar[kj] = pintdat->vpoint[ki]->epar[kj - 1];

      iinter = pintdat->vpoint[ki]->iinter;

      uintpt[ki] = hp_newIntpt (kant, spar, pintdat->vpoint[ki]->adist,
				iinter,
				pintdat->vpoint[ki]->left_obj_1[0],
				pintdat->vpoint[ki]->right_obj_1[0],
				pintdat->vpoint[ki]->left_obj_2[0],
				pintdat->vpoint[ki]->right_obj_2[0],
			     (keep_first ? pintdat->vpoint[ki]->size_1 : 0),
			     (keep_first ? 0 : pintdat->vpoint[ki]->size_2),
		     (keep_first ? pintdat->vpoint[ki]->geo_data_1 : nullp),
		    (keep_first ? nullp : pintdat->vpoint[ki]->geo_data_2));

      if (uintpt[ki] == SISL_NULL)
	goto err101;

      /* Store info from lower level object */
      if (keep_first)
	{
	  /* Store second object geometry in geo_aux */
	  no = pintdat->vpoint[ki]->size_2;
	  scoef = pintdat->vpoint[ki]->geo_data_2;
	}
      else
	{
	  /* Store first object geometry in geo_aux */
	  no = pintdat->vpoint[ki]->size_1;
	  scoef = pintdat->vpoint[ki]->geo_data_1;
	}
      /*      if (no > 0)
        	memcopy (uintpt[ki]->geo_aux, scoef, (no < 6) ? no : 6, DOUBLE); */



    }



  /* Insert all new intersection points in rintdat. */
  for (ki = 0; ki < pintdat->ipoint; ki++)
    {
      sh6idnpt (rintdat, &uintpt[ki], 1, &kstat);
      if (kstat < 0)
	goto error;
    }

  /* Transform the connections. */
  for (ki = 0; ki < pintdat->ipoint; ki++)
    {
      for (kj = ki + 1; kj < pintdat->ipoint; kj++)
	{
	  sh6getlist (pintdat->vpoint[ki], pintdat->vpoint[kj],
		      &ind1, &ind2, &kstat);
	  if (kstat < 0)
	    goto error;
	  if (kstat == 0)
	    {
	      sh6idcon (rintdat, &uintpt[ki], &uintpt[kj], &kstat);
	      if (kstat < 0)
		goto error;
	    }
	}

      if (sh6ismain (pintdat->vpoint[ki]) &&
	  sh6nmbmain (pintdat->vpoint[ki], &kstat))
	{
	  sh6tomain (uintpt[ki], &kstat);
	  if (kstat < 0)
	    goto error;
	}
    }
  
  if (po1->iobj > SISLPOINT && po2->iobj > SISLPOINT)
  {
     /* There is a possibility for cross intersections. Check the
	intersection data.  */
     
     kpt = 0;
     while (kpt < (*npoint))
     {
	kncross = 0;
	ucross[kncross] = uintpt[kpt];
	kncross = 1;
	
	/* Fetch cross intersections.  */
	
	sh6idfcross(*rintdat,ucross,&kncross,po1->iobj,po2->iobj,&kstat);
	kcross = kstat;
	
	if (kcross)
	{
	   /* Remove cross intersections. */
	   
	   sh6idrmcross(po1, po2, rintdat, ucross, kncross, uintpt, 
			*npoint, &kstat);
	   if (kstat < 0) goto error;
	   
	   if (kstat)
	   {
	      /* Points have been removed. Update uintpt.  */
	      
	      for (kj=0; kj<*npoint; kj++)
		 if (uintpt[kj] == SISL_NULL)
		 {
		    uintpt[kj] = uintpt[(*npoint)-1];
		    kj--;
		    (*npoint)--;
		 }
	   }
	   else kpt++;
	}
	else kpt++;
     }
  }
     
  *jstat = 0;
  goto out;


/* Error in inserted parameter number.  */

err191:*jstat = -191;
  s6err ("sh6idput", *jstat, kpos);
  goto out;


/* Error in space allocation.  */

err101:*jstat = -101;
  s6err ("sh6idput", *jstat, kpos);
  goto out;

/* Error in sub function.  */

error:*jstat = kstat;
  s6err ("sh6idput", *jstat, kpos);
  goto out;

out:*outintpt = uintpt;
  if (spar != SISL_NULL)
    freearray (spar);
}


//===========================================================================
void sh1992(SISLObject *po,int itype,double aepsge,int *jstat)
//===========================================================================
{
   int kstat = 0;                       /* Status variable.        */
   int kdim;                       /* Dimension of geometry space. */
   int ktype = itype % 10;              /* Kind of box.            */
   int knum;                            /* Number of sides of box. */
   int k2;                              /* Other box type.         */
   int kbez = 0;                        /* Indicates if Bezier case. */
   double teps_inner;     /* Tolerance with which to expand in the inner. */
   double teps_edge;      /* Tolerance with which to expand at the edge.  */

   /* Set correct tolerances.  */
   
   teps_inner = (ktype == 0) ? DZERO : (double)0.5*aepsge;
   teps_edge = (ktype == 2) ? -teps_inner : teps_inner;
   
   if (po -> iobj == SISLPOINT)
   {
      if (po->p1->pbox == SISL_NULL)
	 if ((po->p1->pbox = newbox(po->p1->idim)) == SISL_NULL) goto err101;
      
      if (s6existbox(po->p1->pbox,ktype,aepsge) < 1)
      {
     	 kdim = po->p1->idim;
	 if (itype < 10 && kdim == 3) knum = 9;
	 else if (itype < 10 && kdim == 2) knum = 4;
	 else knum = kdim;
	   
	 /* The box do not exist already. For a point we always 
	    use non-expanded boxes.  */

	 /* Create the box.  */
	 
	 s6newbox(po->p1->pbox,knum,ktype,aepsge,&kstat);
	 if (kstat < 0) goto error;
	 
	 teps_inner = teps_edge = DZERO;
	 
	 k2 = (ktype == 0) ? 0 : ((ktype == 1) ? 2 : 1);
	 if (ktype > 0 && s6existbox(po->p1->pbox,k2,aepsge))
	    {
	       memcopy(po->p1->pbox->e2min[ktype],po->p1->pbox->e2min[k2],
		       (1+(kdim!=1))*knum,double);
	       memcopy(po->p1->pbox->e2max[ktype],po->p1->pbox->e2max[k2],
		       (1+(kdim!=1))*knum,double);
	    }
	    else
	    {
	       /* Make the requested box. */
	       
	       if (knum == 9) 
		  sh1992_s9mbox3(po->p1->ecoef,1,1,teps_inner,teps_edge,
			  po->p1->pbox->e2max[ktype],po->p1->pbox->e2min[ktype]);
	       else if (knum == 4)
		  sh1992_s9mbox2(po->p1->ecoef,1,1,teps_inner,teps_edge,
			  po->p1->pbox->e2max[ktype],po->p1->pbox->e2min[ktype]);
	       else
	       {
		  sh1992_s9mbox(po->p1->ecoef,1,1,kdim,teps_inner,teps_edge,
			 po->p1->pbox->e2max[ktype],po->p1->pbox->e2min[ktype],
			 &kstat);
		  if (kstat < 0) goto error;
	       }
	    }
      }
   }
   else if (po -> iobj == SISLCURVE)
   {
      if (po->c1->pbox == SISL_NULL)
	 if ((po->c1->pbox = newbox(po->c1->idim)) == SISL_NULL) goto err101;
      
      if (s6existbox(po->c1->pbox,ktype,aepsge) < 1)
      {
     	 kdim = po->c1->idim;
	 if (itype < 10 && kdim == 3) knum = 9;
	 else if (itype < 10 && kdim == 2) knum = 4;
	 else knum = kdim;
	 
	 /* The box do not exist already. In the Bezier case,
	    it is not necessary to expand in the inner of the curve.  */
	 
	 /* Create the box.  */
	 
	 s6newbox(po->c1->pbox,knum,ktype,aepsge,&kstat);
	 if (kstat < 0) goto error;
	 
	 if (po->c1->ik == po->c1->in) 
         {
            teps_inner = DZERO;
            kbez = 1;
         }
	 
	 /* Make the requested box. First allocate scratch for
	    box arrays.  */
	 
	 if (knum == 9) 
	    sh1992_s9mbox3(po->c1->ecoef,po->c1->in,1,teps_inner,teps_edge,
		    po->c1->pbox->e2max[ktype],po->c1->pbox->e2min[ktype]);
	 else if (knum == 4)
	    sh1992_s9mbox2(po->c1->ecoef,po->c1->in,1,teps_inner,teps_edge,
		    po->c1->pbox->e2max[ktype],po->c1->pbox->e2min[ktype]);
	 else
	 {
	    sh1992_s9mbox(po->c1->ecoef,po->c1->in,1,kdim,teps_inner,
		   teps_edge,po->c1->pbox->e2max[ktype],
		   po->c1->pbox->e2min[ktype],&kstat);
	    if (kstat < 0) goto error;
         }
      }
   } 
   else if (po -> iobj == SISLSURFACE)
   {
      if (po->s1->pbox == SISL_NULL)
	 if ((po->s1->pbox = newbox(po->s1->idim)) == SISL_NULL) goto err101;
      
      if (s6existbox(po->s1->pbox,ktype,aepsge) < 1)
      {
     	 kdim = po->s1->idim;
	 if (itype < 10 && kdim == 3) knum = 9;
	 else if (itype < 10 && kdim == 2) knum = 4;
	 else knum = kdim;
	 
	 /* The box do not exist already. In the Bezier case, it
	    is not necessary to expand in the inner of the surface.  */
	 
	 /* Create the box.  */
	 
	 s6newbox(po->s1->pbox,knum,ktype,aepsge,&kstat);
	 if (kstat < 0) goto error;
	 
	 if (po->s1->ik1 == po->s1->in1 && po->s1->ik2 == po->s1->in2) 
         {
	    teps_inner = DZERO;
            kbez = 1;
         }
	 
	 /* Make the requested box. First allocate scratch for
	    box arrays.  */
	 
	 if (knum == 9) 
	    sh1992_s9mbox3(po->s1->ecoef,po->s1->in1,po->s1->in2,teps_inner,
		    teps_edge,po->s1->pbox->e2max[ktype],
		    po->s1->pbox->e2min[ktype]);
	 else if (knum == 4)
	    sh1992_s9mbox2(po->s1->ecoef,po->s1->in1,po->s1->in2,teps_inner,
		    teps_edge,po->s1->pbox->e2max[ktype],
		    po->s1->pbox->e2min[ktype]);
	 else
	 {
	    sh1992_s9mbox(po->s1->ecoef,po->s1->in1,po->s1->in2,kdim,
		   teps_inner,teps_edge,po->s1->pbox->e2max[ktype],
		   po->s1->pbox->e2min[ktype],&kstat);
	    if (kstat < 0) goto error;
	 }
      }
   }  
  
  *jstat = kbez;
  goto out;

  /* Error in space allocation.  */
  
  err101 : *jstat = -101;
  goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  goto out;
     
 out:
    return;
}


//===========================================================================
void s9boundimp(double epnt1[],double epar1[],SISLSurf *psurf1,double eimpli[],
		int ideg,double apar,int idir,double aepsge,
		double gpnt1[],double gpar1[],int *jstat)
//===========================================================================
{
  int kcont;              /* Indicator telling if iteration is not finished */
  int kder = 2;           /* Derivative indicator                           */
  int klfu=0;             /* Pointer into knot vector                       */
  int klfv=0;             /* Pointer into knot vector                       */
  int kstat;              /* Status variable                                */
  int knbit=0;            /* Counter for number of iterations               */
  int kmaxit = 100;       /* Maximal number of iterations allowed           */
  int kpos=0;             /* Position indicator ofr errors                  */
  int ksize;              /* Number of doubles for storage of derivateves
			     and normal vector */
  int ksizem3;            /* ksize - 3                                      */
  double *sp,*spu,*spv,*spn; /* Pointers into gpnt1                         */
  double ta11,ta12,tb1;   /* Variables used in equation systems             */
  double tdu,tdv;         /* Increments of u and v parameter directions     */
  double tdist;           /* Distance between two points in iteration        */
  double tcurdst;         /* Distance between points in both surfaces       */
  double sder[3];         /* Derivatives of comb. of impl. surf and par.surf*/
  double sproj[3];        /* Projection direction                           */
  
  
  /* If ideg=1,2 or 1001 then only derivatives up to second order
     are calculated, then 18 doubles for derivatives and 3 for the
     normal vector are to be used for calculation of points in the
     spline surface. For ideg=1003,1004,1005 we have a silhouette curve and
     derivatives up to the third are to be calculated,
     thus 30 +3 a total of 33 doubles are to be calculated */
  
  if (ideg==1003 || ideg==1004 || ideg==1005)
    {
      kder = 3;
      ksize = 33;
    }
  else
    {
      ksize = 21;
      kder =2;
    }
  ksizem3 = ksize -3;
  
  /* Copy input variables to output variables */
  
  memcopy(gpnt1,epnt1,21,DOUBLE); 
  memcopy(gpar1,epar1,2,DOUBLE); 
  
  /* At the start of the iteration the point gpnt1 is put into both implicit
     equations */
  
  /* Set a number of local pointers that are used often */
  sp  = gpnt1;
  spu = gpnt1 + 3;
  spv = gpnt1 + 6; 
  spn = gpnt1 + 18;
  
  kcont = 1;
  
  while (kcont)
    
    {
      /*  Independent of which parameter direction is constant we want to
       *   make an equation:
       *           du*ta11 + dv*ta12 = tb1
       *   describing the connection between du and dv. Afterwards du or dv can
       *   be fixed and dv or du calculated
       */
      
      /* Calculate value and derivatives of the parametric surface put into
	 the equation of the implicit surface */
      
      s1331(gpnt1,eimpli,ideg,1,sder,sproj,&kstat);
      
      ta11 = sder[1];
      ta12 = sder[2];
      tb1  = -sder[0];
      
      
      /*  Now we can branch on the constant parameter dircection */
      
      if (idir == 1)
        {
	  /* First parameter is constant  */
	  
	  tdu = apar - gpar1[0];
	  if (DNEQUAL(ta12,DZERO) )
	    {
	      tdv = (tb1-tdu*ta11)/ta12;
	    }
	  else
	    {
	      /* spv is normal to normalvector */
	      goto war02;
	    }
	  
	  gpar1[0]  = apar;
	  gpar1[1] += tdv;
        }
      else
        {
	  /* Second parameter direction constant */
	  tdv = apar - gpar1[1];
	  if (DNEQUAL(ta11,DZERO))
	    {
	      tdu = (tb1-tdv*ta12)/ta11;
	    }
	  else
	    {
	      /* spv is normal to normalvector */
	      goto war02;
	    }
	  gpar1[0] += tdu;
	  gpar1[1]  = apar;
        }
      
      
      /*  Calculate value of new point */
      
      s1421(psurf1,kder,gpar1,&klfu,&klfv,gpnt1,gpnt1+18,&kstat); 
      if (kstat<0) goto error;
      
      /*  Stop iteration if degenerate point */
      if (kstat == 2) goto war02;
      
      /*  Find distance between point and point on implicit surface along sproj
       */
      tcurdst = s1309(gpnt1,sproj,eimpli,ideg,&kstat);
      if (kstat < 0) goto error;
      
      tcurdst = fabs(tcurdst);
      
      /*  tcurdst now contains the distance between the point in the parametric
	  surface and the projection along sproj of this point onto the implicit
	  surface if ideg== 1,2 or 1001. In the case ideg==1003,1004,1005 we have a
	  silhouette line and tcurdst contains the angle PI minus the angle 
	  between the view direction and the normal of the surface */
      
      
      /*  We continue iteration so long as the error tcurdst is not decreasing */
      
      knbit = knbit + 1;
      
      if (DEQUAL(tcurdst,DZERO))
        {
	  /* Length is zero iteration has converged   */
	  kcont = 0;
	  goto war00;
        }
      
      if (knbit<=1)
        {
	  /* First iteration intitate distance variable, if the equation
	     systems were not singular */
	  tdist = tcurdst;
        }
      else
        {
	  /*  More than one iteration done, stop if distance or angle is not
	      decreasing. */
	  if (tcurdst>=tdist)
            {
	      /*  Distance or angle is not decreasing */
	      if (  (ideg < 1003 && tdist <= aepsge) ||
                    (  (ideg==1003 || ideg==1004 || ideg==1005) &&
                       tdist <= ANGULAR_TOLERANCE))
                {               
		  /*  Distance within tolerance */
		  goto war00; 
		  
                }
	      else
                {
		  /* Distance is not within tolerance, divergence */
		  goto war02;
                }
            }
	  /* Distance still decreasing */
	  
	  tdist = tcurdst;
        }
      
      /*  Make sure that not to many iteration are being done */
      if (knbit > kmaxit) goto war02;
    }
  
  
  /* Iteration converged */
 war00:
  
  *jstat = 0;
  goto out;
  
  /* To many iterations or iteration diverging */
 war02: *jstat = 2;
  goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("s9boundimp",*jstat,kpos);
  goto out;
  
 out:
  return;
}


//===========================================================================
void s1308(double ep[],int idim,double eimpli[],int ideg,double enorm[],int *jstat)
//===========================================================================
{            
  int ki,kj,kl;       /* Variables in loop                           */
  int kdimp1=idim+1;  /* Dimension + 1                               */
  int kpos=0;         /* Position of error                           */
  int kstat=0;        /* Local error                                 */
  double tsum;        /* Dummy variable                              */
  
  if (ideg != 1 && ideg !=2 && ideg != 1001) goto err175; 
  
  if (ideg == 1)
    {
      /*  First degree implicit surface normal vector is eimpli[0:idim-1] */
      memcopy(enorm,eimpli,idim,DOUBLE);
    }
  else if (ideg==2)
    {
      
      /* Calculate the matrix product */
      
      for (ki=0;ki<idim;ki++)
        {
	  tsum = eimpli[idim*kdimp1+ki];
	  for (kj=0,kl=ki ; kj<idim ; kj++,kl+=kdimp1)
            {
	      tsum +=(eimpli[kl]*ep[kj]);
            }
	  enorm[ki] = tsum;
        }
    }
  else if (ideg==1001)
    {  
      /*  Torus surface */
      
      double *scentr;  /* The center of the torus */
      double *snorm;   /* The normal of the torus symmetry plane */
      double tbigr;    /* The big radius of the torus */ 
      double tsmalr;   /* The small radius of the torus */
      double sdum1[3]; /* Temporary storage for point */
      double sdum2[3]; /* Temporary storage for point */
      double tproj;    /* Projection of vector onto snorm */
      
      
      scentr = eimpli;
      snorm  = eimpli+3;
      tbigr  = *(eimpli+6);
      tsmalr = *(eimpli+7);
      
      /*  Find projection of vector from torus center on to torus axis */
      s6diff(ep,scentr,3,sdum1);
      tproj = s6scpr(sdum1,snorm,3);
      
      /*  Project vector from torus center to ep onto torus plane */
      for (ki=0;ki<3;ki++)
        sdum2[ki] = sdum1[ki] - tproj*snorm[ki];
      (void)s6norm(sdum2,3,sdum2,&kstat);
      if (kstat<0) goto error;
      
      /*  Find vector from torus circle to ep */
      for (ki=0;ki<3;ki++)
        sdum1[ki] = sdum1[ki] - tbigr*sdum2[ki];
      
      /*  Normalize this vector */
      (void)s6norm(sdum1,3,enorm,&kstat);
      if (kstat<0) goto error;
    }
  
  *jstat = 0;
  goto out;
  
  /* IDEG NOT 1 OR 2 */
 err175:
  *jstat = -175;
  s6err("s1308",*jstat,kpos);
  goto out;
  
  
  /* Error in lower leve function */
 error:
  *jstat = kstat;
  s6err("s1308",*jstat,kpos);
  goto out;
  
 out:
  return;
}
                                                                              


//===========================================================================
void s1001 (SISLSurf * ps, double min1, double min2,
	    double max1, double max2,
	    SISLSurf ** rsnew, int *jstat)
//===========================================================================
{
  int kstat;			/* Local status variable.	       */
  int kpos = 0;			/* Position of error.		       */
  int kleft1 = 0;		/* Knot navigator.		       */
  int kleft2 = 0;		/* Knot navigator.		       */
  int kleft3 = 0;		/* Knot navigator.		       */
  int kleft4 = 0;		/* Knot navigator.		       */
  int kdim = ps->idim;		/* Dimension of geometry space.        */
  int kkind = ps->ikind;	/* Kind of surface.                    */
  int kn1;			/* Number of vertices in 1. par. dir.  */
  int kn2;			/* Number of vertices in 2. par. dir.  */
  int cuopen_1, cuopen_2;	/* Open flags for the new surface.     */
  int change_1,change_2;	/* Flag, need to change surf in dir ?  */
  int wholeperi1 = FALSE;       /* Flag, pick whole peri. param. range */
  int wholeperi2 = FALSE;       /* Flag, pick whole peri. param. range */
  double *st1=SISL_NULL;		/* Knot vector in 1. par. dir.         */
  double *st2=SISL_NULL;		/* Knot vector in 2. par. dir.         */
  double *scoef1 = SISL_NULL;	/* Coefficients of input curve to
			           refinement in 1. par. dir.          */
  double *scoef2 = SISL_NULL;	/* Coefficients of refined surface.    */
  double *scoef  = SISL_NULL;	/* Coefficients of refined surface.    */
  SISLCurve *qc1 = SISL_NULL;	/* Input curve to pick curve.          */
  SISLCurve *qc2 = SISL_NULL;	/* Output curve from pick curve.       */
  SISLCurve *qc3 = SISL_NULL;	/* Output curve from pick curve.       */
  double *oldcoef;           	/* Pointer to vertices of old surf.    */
  /* ----------------------------------------------------------------- */

  if(kkind == 2 || kkind == 4)
  {
     oldcoef = ps->rcoef;
     kdim++;
  }
  else
  {
     oldcoef = ps->ecoef;
  }

  kleft1=ps->ik1-1;
  kleft2=ps->in1;
  kleft3=ps->ik2-1;
  kleft4=ps->in2;
  change_1 = change_2 = TRUE;

  if ( min1 == ps->et1[ps->ik1 -1]  &&  max1 == ps->et1[ps->in1] )
  {
    if ( s6knotmult(ps->et1,ps->ik1,ps->in1,
		    &kleft1,ps->et1[ps->ik1-1],&kstat) == ps->ik1 &&
	 s6knotmult(ps->et1,ps->ik1,ps->in1,
		    &kleft2,ps->et1[ps->in1],&kstat) == ps->ik1 )
      change_1 = FALSE;
    else
      wholeperi1 = ( ps->cuopen_1 == SISL_SURF_PERIODIC );
  }

  if ( min2 == ps->et2[ps->ik2 -1]  &&  max2 == ps->et2[ps->in2] )
  {
    if ( s6knotmult(ps->et2,ps->ik2,ps->in2,
		    &kleft3,ps->et2[ps->ik2-1],&kstat) == ps->ik2 &&
	 s6knotmult(ps->et2,ps->ik2,ps->in2,
		    &kleft4,ps->et2[ps->in2],&kstat) == ps->ik2 )
      change_2 = FALSE;
    else
      wholeperi2 = ( ps->cuopen_2 == SISL_SURF_PERIODIC );
  }

  if (change_1)
    {
       /* Treat the first parameter direction of the
	  surface. First express the surface as a curve.  */
       if ((scoef1 = newarray (kdim * ps->in1 * ps->in2, double)) == SISL_NULL)
	 goto err101;

       /* Change parameter directions of surface.  */
       s6chpar (oldcoef, ps->in1, ps->in2, kdim, scoef1);

       /* Create curve.  */
       qc1 = newCurve (ps->in1, ps->ik1, ps->et1, scoef1, 1, kdim * ps->in2, 0);
       if (qc1 == SISL_NULL)
	 goto err101;
       qc1->cuopen = ps->cuopen_1;

       /* Pick part of curve */
       s1713 (qc1, min1, max1, &qc2, &kstat);
       if (kstat < 0)
	 goto error;

       /* Change parameter directions of the coefficient array of
	  the refined curve.     */

       if ((scoef2 = newarray (qc2->in *ps->in2 * kdim, DOUBLE)) == SISL_NULL)
	 goto err101;
       s6chpar (qc2->ecoef, ps->in2, qc2->in, kdim, scoef2);

       /* Set local parameters of refined surface. */

       kn1 = qc2->in;
       kn2 = ps->in2;
       st1 = qc2->et;
       st2 = ps->et2;
       if ( wholeperi1 )
	 cuopen_1 = SISL_SURF_CLOSED;
       else
	 cuopen_1 = qc2->cuopen;

       /* Free curve used as input to s1713. */
       if (qc1)
	 freeCurve (qc1);
       qc1 = SISL_NULL;
    }

  else
    {
       /* Set local parameters of input surface. */

       kn1 = ps -> in1;
       kn2 = ps -> in2;
       st1 = ps -> et1;
       st2 = ps -> et2;
       scoef2   = oldcoef;
       cuopen_1 = ps->cuopen_1;
    }

  if (change_2)
    {
       /* Treat the first parameter direction of the
	  surface. First express the surface as a curve.  */

       if ((qc1 = newCurve (kn2, ps->ik2, st2, scoef2, 1, kn1 * kdim, 0))
	   == SISL_NULL)
	 goto err101;
       qc1->cuopen = ps->cuopen_2;

       /* Pick part of curve */
       s1713 (qc1, min2, max2, &qc3, &kstat);
       if (kstat < 0)
	 goto error;


       /*	Set local parameters of the refined surface. */
       kn2 = qc3->in;
       st2 = qc3->et;
       scoef = qc3->ecoef;
       if ( wholeperi2 )
	 cuopen_2 = SISL_SURF_CLOSED;
       else
	 cuopen_2 = qc3->cuopen;

       /* Free curve used as input to s1713. */
       if (qc1)
	 freeCurve (qc1);
       qc1 = SISL_NULL;
    }
  else
    {
       scoef = scoef2;
       cuopen_2 = ps->cuopen_2;
    }

  /* Express result as a surface.  */
  if ((*rsnew = newSurf (kn1, kn2, ps->ik1, ps->ik2, st1, st2,
			 scoef, kkind, ps->idim, 1)) == SISL_NULL)
    goto err101;


  (*rsnew)->cuopen_1 = cuopen_1;
  (*rsnew)->cuopen_2 = cuopen_2;

  /* Task done  */

  *jstat = 0;
  goto out;

  /* ---------------------- ERROR EXITS ------------------------------- */
  /* Error in scratch allocation.  */

err101:
  *jstat = -101;
  s6err ("s1001", *jstat, kpos);
  goto out;

  /* Error in lower level routine.  */

error:
  *jstat = kstat;
  s6err ("s1001", *jstat, kpos);
  goto out;

  out:
     /* Free scratch occupied by local arrays and objects.  */

     if (change_1)
       {
	  if (scoef1) freearray (scoef1);
	  if (scoef2) freearray (scoef2);
	  scoef1 = SISL_NULL;
	  scoef2 = SISL_NULL;
       }

     if (qc1) freeCurve (qc1);
     if (qc2) freeCurve (qc2);
     if (qc3) freeCurve (qc3);
}


//===========================================================================
void s6crvcheck(SISLCurve *pc,int *jstat)
//===========================================================================
{
  int kstat = 0;              /* Status variable.                 */
  int ki,kj;                  /* Counter.                         */
  int kdim;                   /* Dimension of space               */
  int rdim;                   /* Rational dimension.              */
  int kn;                     /* Number of knots                  */
  int kk;                     /* Number of vertices               */
  int kmark;                  /* Indicates if k-tupple knots      */
  int knnew;                  /* New number of vertices           */
  int kind;                   /* Type of curve, 2 and 4 rational. */
  double *snt=SISL_NULL;           /* Compressed knot vector           */
  double *sncoef=SISL_NULL;        /* Compressed vertex vector         */
  double *srcoef=SISL_NULL;        /* Compressed vertex vector         */
  double *st;                 /* Knots                            */
  double *scoef;              /* Vertices                         */
  double *rcoef;              /* Rational vertices.               */
  
  *jstat = 0;

  if (pc == SISL_NULL) goto out;
  
  kk    = pc -> ik;
  kn    = pc -> in;
  kdim  = pc -> idim;
  rdim  = kdim + 1;
  kind  = pc -> ikind;
  st    = pc -> et;
  scoef = pc -> ecoef;
  rcoef = pc -> rcoef;
  
  /* Run through all knots to detect if st[ki]=st[ki+kk-1] e.g. that we
     have at least kk-tupple internal knots */
  
  kmark = 0;
  for (ki=1 ; ki < kn-1 ; ki++)
    if (st[ki] == st[ki+kk-1] && 
	DEQUAL(s6dist(scoef+(ki-1)*kdim,scoef+ki*kdim,kdim),DZERO))
      {
        kmark = 1;
        break;
      }
  
  if (kmark == 0) goto out;
  
  /* We have at least kk-tupple knots, remove not necessary knots and vertices */
  
  if((snt = newarray(kn+kk,DOUBLE)) == SISL_NULL) goto err101;  
  if((sncoef = newarray(kn*kdim,DOUBLE)) == SISL_NULL) goto err101;

  if (kind == 2 || kind == 4)
    {
      srcoef = newarray(kn*rdim,DOUBLE);
      if (srcoef == SISL_NULL) goto err101;
      for (ki=0,kj=0 ; ki < kn ; ki ++)
        if (ki == 0 || ki == kn-1 || st[ki] < st[ki+kk-1] || 
	  DNEQUAL(s6dist(rcoef+(ki-1)*rdim,rcoef+ki*rdim,rdim),DZERO))
          {
            snt[kj] = st[ki];
            memcopy(sncoef+kdim*kj,scoef+kdim*ki,kdim,DOUBLE);
            memcopy(srcoef+rdim*kj,rcoef+rdim*ki,rdim,DOUBLE);
            kj++;
          }
    }
  else
    {
      for (ki=0,kj=0 ; ki < kn ; ki ++)
        if (ki == 0 || ki == kn-1 || st[ki] < st[ki+kk-1] || 
	  DNEQUAL(s6dist(scoef+(ki-1)*kdim,scoef+ki*kdim,kdim),DZERO))
          {
            snt[kj] = st[ki];
            memcopy(sncoef+kdim*kj,scoef+kdim*ki,kdim,DOUBLE);
            kj++;
          }
    }
  
  for (ki=kn ; ki<kn+kk ; ki++,kj++)
    snt[kj] = st[ki];
  
  knnew = kj - kk;
  
  /* An additional end knot might have been left */
  
  if (snt[knnew-1] == snt[knnew+kk-1]) knnew--;
  
  /* Put compressed description back to curve object */      
  
  if (pc->icopy > 0)
    {
      pc -> in = knnew;
      memcopy(pc->et,snt,knnew+kk,DOUBLE);
      memcopy(pc->ecoef,sncoef,knnew*kdim,DOUBLE);
      if (kind == 2 || kind == 4)
        memcopy(pc->rcoef,srcoef,knnew*rdim,DOUBLE);
      kstat = 1;
    }
  
  /* Task done. */
  
  *jstat = kstat;
  goto out;
  
  /* Error in space allocation. */
  
  err101: 
    *jstat = -101;
    goto out;
  
  out:
    if (snt != SISL_NULL) freearray(snt);
    if (sncoef != SISL_NULL) freearray(sncoef);
}


//===========================================================================
void s1379(double ep[],double ev[],double epar[],int im,int idim,
	   SISLCurve **rcurve,int *jstat)
//===========================================================================
{
  int ki,kj;          /* Loop variables                              */
  int kk;             /* Polynomial order                            */
  int kn;             /* Number of vertices                          */
  int kpoint;         /* Pointer into point and derivative array     */
  int kcoef;          /* Pointer into coefficient array              */
  int kpos=0;         /* Position of error                           */
  int kthis;          /* Current point                               */
  int kstat=0;        /* Status variable                             */
  int kcycpos = 1;    /* Flag telling if first and last points are equal */
  int kcycder = 1;    /* Flag telling if first and last derviatives are equal */
  double *st=SISL_NULL;    /* Knot vector                                 */
  double *scoef=SISL_NULL; /* B-spline vertices                           */
  double th1,th2;     /* Parameter intervals                         */



  /* Check input */

  if (im < 2)   goto err181;
  if (idim < 1) goto err102;

  /* Set the dimension and order of the spline space */

  kn = 2*im;
  kk = 4;

  /* Allocate arrays for temporary storage of knots and vertices */

  st    = newarray(kn+kk,DOUBLE);
  if (st == SISL_NULL) goto err101;
  scoef = newarray(idim*kn,DOUBLE);
  if (scoef == SISL_NULL) goto err101;

  /* Check if the curve is periodic, e.g. if first and last points are
     equal and/or that first and last derivates are equal */

  /*  for (kj=0, kcycpos=1 ; kj<idim && kcycpos == 1 ; kj++)
     if (ep[kj] != ep[idim*(im-1)+kj]) kcycpos =0; */
  for (kj=0, kcycpos=1 ; kj<idim && kcycpos == 1 ; kj++)
     if (DNEQUAL(ep[kj], ep[idim*(im-1)+kj])) kcycpos =0;

  /*  for (kj=0, kcycder=1 ; kj<idim && kcycder == 1 ; kj++)
    if (ev[kj] != ev[idim*(im-1)+kj]) kcycder= 0; */
  for (kj=0, kcycder=1 ; kj<idim && kcycder == 1 ; kj++)
    if (DNEQUAL(ev[kj], ev[idim*(im-1)+kj])) kcycder= 0;

  /* Make the knot vector, first all knots except the two first and the two last */

  for (ki=2,kj=0 ; ki<kn+2 ; ki+=2, kj++)
    st[ki] = st[ki+1] = epar[kj];



  /* Make the two first and two last knots */

  if (kcycder == 1 && kcycpos == 1)
    {
      /* Two first knots to be shifted */

      st[0]= st[1] = epar[0] - (epar[im-1]-epar[im-2]);
      st[kn+2]= st[kn+3] = epar[im-1] + epar[1] - epar[0];
    }
  else if (kcycder ==0 && kcycpos ==1)
    {
      /* First and last knot to be shifted */

      st[0] = epar[0] - (epar[im-1]-epar[im-2]);
      st[1] = st[2];
      st[kn+2] = st[kn];
      st[kn+3] = epar[im-1] + epar[1] - epar[0];
    }
  else
    {
      /* k-regular basis */

      st[0] = st[1] = st[2];
      st[kn+2] = st[kn+3] = st[kn];
    }

  /* Compute knot vector and coefficients as indicated above */

  for (kj=0, kcoef=0, kpoint = 0 ; kj < kn ; kj+=2)
    {
      th1 = st[kj+3] - st[kj+1];
      th2 = st[kj+4] - st[kj+2];

      /*  Compute coefficient no kj */

      kthis = kpoint;
      for (ki=0;ki<idim;ki++,kpoint++)
        {
	  scoef[kcoef++] = ep[kpoint] - th1*ONE_THIRD*ev[kpoint];
        }

      /*  Compute coefficient no kj+1 */

      kpoint = kthis;
      for (ki=0;ki<idim;ki++,kpoint++)
        {
	  scoef[kcoef++] = ep[kpoint] + th2*ONE_THIRD*ev[kpoint];
        }
    }

  /* Make new curve object */

  *rcurve = newCurve(kn,kk,st,scoef,1,idim,1);
  if (*rcurve == SISL_NULL) goto err101;

  /* Remove unneccesarry knots */

  s6crvcheck(*rcurve,&kstat);
  if (kstat<0) goto error;

  /* Periodicity flag */
  if (kcycpos)
    {
       test_cyclic_knots((*rcurve)->et,(*rcurve)->in,(*rcurve)->ik,&kstat);
       if (kstat<0) goto error;
       if (kstat == 2) (*rcurve)->cuopen = SISL_CRV_PERIODIC;
    }

  /* Calculation completed */

  *jstat = 0;
  goto out;


  /* Error in space allocation. Return zero. */


  /* Error in space allocation */
 err101: *jstat = -101;
  s6err("s1379",*jstat,kpos);
  goto out;


  /* Dimension less than 1*/
 err102: *jstat = -102;
  s6err("s1379",*jstat,kpos);
  goto out;

  /* Too few interpolation conditions */

 err181: *jstat = -181;
  s6err("s1379",*jstat,kpos);
  goto out;

 error:  *jstat =kstat;
  s6err("s1379",*jstat,kpos);
  goto out;

 out:
  if (st != SISL_NULL) freearray(st);
  if (scoef != SISL_NULL) freearray(scoef);

  return;
}


//===========================================================================
void s6twonorm(double evec[],double enorm1[],double enorm2[],int *jstat)
//===========================================================================
{
  int kstat;                 /* Local status variable                        */
  int kdim = 3;              /* We work in 3-D                               */
  int kpos=0;                /* Position of eror                             */
  double svec[3],sdum[3];    /* Local dummy arrays                           */
  double t1,t2,t3;           /* Absolute value of components of svec         */
  
  
  /* If the dimension is 1 the length of the vector is the same as the
     absolute value of the number */
  
  
  /* Normalize input vector */
  
  (void)s6norm(evec,kdim,svec,&kstat);
  
  if (kstat == 0) goto err174;
  
  t1 =fabs(svec[0]);
  t2 =fabs(svec[1]);
  t3 =fabs(svec[2]);
  
  /* Make along one of the main axis that has component 1 in the direction
     that svec has the smalles component */
  
  sdum[0] = (double)0.0;
  sdum[1] = (double)0.0;
  sdum[2] = (double)0.0;
  
  if (t1 < t2 && t1 < t3)
    {
      sdum[0] = (double)1.0;
    }
  else if (t2 < t3)
    {
      sdum[1] = (double)1.0;
    }
  else
    {
      sdum[2] = (double)1.0;
    }
  
  /* Make normal of sdum and svec */
  
  s6crss(svec,sdum,enorm1);
  
  /* Normalize enorm1 */
  
  (void)s6norm(enorm1,kdim,enorm1,&kstat);
  
  /* Make normal of enorm1 and svec */
  
  s6crss(svec,enorm1,enorm2);
  
  /* Normalize enorm2 */
  
  (void)s6norm(enorm2,kdim,enorm2,&kstat);
  
  *jstat = 0;
  goto out;

/* Direction vector of zero length */

err174: *jstat = -174;
        s6err("s6twonorm",*jstat,kpos);
goto out;
out:
return;
}


//===========================================================================
void s9boundit(double epnt1[],double epnt2[],double epar1[],double epar2[],
	       SISLSurf *psurf1,SISLSurf *psurf2,double apar,int idir,double aepsge,
	       double gpnt1[],double gpnt2[],double gpar1[],double gpar2[],int *jstat)
//===========================================================================
{
  int kcont;              /* Indicator telling if iteration is not finished */
  int kder = 2;           /* Derivative indicator                           */
  int klfu=0;             /* Pointer into knot vector                       */
  int klfv=0;             /* Pointer into knot vector                       */
  int klfs=0;             /* Pointer into knot vector                       */
  int klft=0;             /* Pointer into knot vector                       */
  int kstat;              /* Status variable                                */
  int knbit=0;            /* Counter for number of iterations               */
  int kdim = 3;           /* Set dimension to 3                             */
  int kmaxit = 100;       /* Maximal number of iterations allowed           */
  int kpos=1;             /* Position indicator ofr errors                  */
  double snorm1[3];       /* Normalvector to constant parameter line        */
  double snorm2[3];       /* Normalvector to constant parameter line        */
  double *sp,*spu,*spv,*spn; /* Pointers into gpnt1                         */
  double *sq,*sqs,*sqt,*sqn; /* Pointers into gpnt2                         */
  double ta11,ta12,ta21;  /* Variables used in equation systems             */
  double ta22,tb1,tb2;    /* Variables used in equation systems             */
  double sdiff[3];        /* Difference between two vectors                 */
  double tdum2;           /* Dummy variables                                */
  double tdum3;           /* Dummy variables                                */
  double tdist;           /* Distance betweentwo points in iteration        */
  double tdu,tdv,tds,tdt; /* Increments of parameter values                 */
  
  
  /* Copy input variables to output variables */
  
  memcopy(gpnt1,epnt1,21,DOUBLE); 
  memcopy(gpnt2,epnt2,21,DOUBLE);
  memcopy(gpar1,epar1,2,DOUBLE); 
  memcopy(gpar2,epar2,2,DOUBLE);
  
  /* At the start of the iteration the two point gpnt1 and gpnt2 might be
     very close since we in most cases start from a point on the intersection
     curve. */
  
  /* Set a number of local pointers that are used often */
  sp  = gpnt1;
  spu = gpnt1 + 3;
  spv = gpnt1 + 6;
  spn = gpnt1 + 18;
  sq  = gpnt2;
  sqs = gpnt2 + 3;
  sqt = gpnt2 + 6;
  sqn = gpnt2 + 18;
  
  kcont = 1;
  
  while (kcont)
    
    {
      if (idir==1 || idir==2)
        {
	  /* The constant parameter direction is in the first surface, intersect
	     with implicit representation of tangent plane of second surface.
	     Independent of which parameter direction is constant we want to
	     make an equation:
	     du*ta11 + dv*ta12 = tb1
	     describing the connection between du and dv. Afterwards du or dv can
	     be fixed and dv or du calculated
	   
	     Put a parametric representation of the tangent plane of surface 1 into
	     the implicit representation of the tangent plane of surface 2.
	   */ 
	  
	  ta11 = s6scpr(spu,sqn,kdim);
	  ta12 = s6scpr(spv,sqn,kdim);
	  s6diff(sq,sp,kdim,sdiff);
	  
	  tb1  = s6scpr(sdiff,sqn,kdim);
	  
	  /* Now we can branch on the constant parameter direction */
	  
	  if (idir == 1)
            {
	      /* First parameter is constant  */
	      
	      tdu = apar - gpar1[0];
	      if (DNEQUAL(ta12,DZERO))
		{
		  tdv = (tb1-tdu*ta11)/ta12;
		}
	      else
		{
		  /* spv is normal to normalvector */
		  goto war02;
		}
	      
	      gpar1[0]  = apar;
	      gpar1[1] += tdv;
            }
	  else
            {
	      /* Second parameter direction constant */
	      tdv = apar - gpar1[1];
	      if (DNEQUAL(ta11,DZERO))
		{
		  tdu = (tb1-tdv*ta12)/ta11;
		}
	      else
		{
		  /* spv is normal to normalvector */
		  goto war02;
		}
	      gpar1[0] += tdu;
	      gpar1[1]  = apar;
            }
	  
	  /* Calculate the point found in first surface */
	  
	  s1421(psurf1,kder,gpar1,&klfu,&klfv,gpnt1,gpnt1+18,&kstat); 
	  if (kstat<0) goto error;
	  
	  /* If the surface has normal of zero length leave the routine */
	  
	  if (kstat == 2) goto war02;
	  
	  /* Make the difference of the found point and sq */
	  
	  s6diff(gpnt1,sq,kdim,sdiff);
	  
	  
	  /* Project the point onto surface 2 along the normal sqn */
	  
	  
	  /* Make two normals to the normal of surface two in last point */
	  
	  s6twonorm(sqn,snorm1,snorm2,&kstat);
	  if (kstat<0) goto error;
	  
	  ta11 = s6scpr(sqs,snorm1,kdim);
	  ta12 = s6scpr(sqt,snorm1,kdim);
	  ta21 = s6scpr(sqs,snorm2,kdim);
	  ta22 = s6scpr(sqt,snorm2,kdim);
	  
	  tb1  = s6scpr(sdiff,snorm1,kdim);
	  
	  tb2  = s6scpr(sdiff,snorm2,kdim);
	  
	  /*      Calculate determinant of equation system */
	  tdum2 = ta11*ta22 - ta12*ta21;
	  
	  /* If tdum2 = 0.0, then the equation system is singular, iteration not
	     possible. */
	  if (DNEQUAL(tdum2,DZERO))
            {
	      gpar2[0] += (tb1*ta22-tb2*ta12)/tdum2;
	      gpar2[1] += (ta11*tb2-ta21*tb1)/tdum2;
            }
	  
	  /* Calculate point in second surface */
	  
	  s1421(psurf2,kder,gpar2,&klfs,&klft,gpnt2,gpnt2+18,&kstat); 
	  if (kstat<0) goto error;
	  
	  /* If the surface has normal of zero length leave the routine */
	  
	  if (kstat == 2) goto war02;
        }
      
      else
        {
	  /* idir==3 or idir==4 */
	  
	  /*  The constant parameter direction is in the second surface, intersect
	      with implicit representation of tangent plane of second surface.
	      Independent of which parameter direction is constant we want to
	      make an equation:
	      ds*ta11 + dt*ta12 = tb1
	      describing the connection between ds and dt. Afterwards ds or dt can
	      be fixed and dt or ds calculated
	   
	      Put a parametric representation of the tangent plane of surface 2 into
	      the implicit representation of the tangent plane of surface 1.
	   */ 
	  
	  ta11 = s6scpr(sqs,spn,kdim);
	  ta12 = s6scpr(sqt,spn,kdim);
	  s6diff(sp,sq,kdim,sdiff);
	  
	  tb1  = s6scpr(sdiff,spn,kdim);
	  
	  /* Now we can branch on the constant parameter direction */
	  
	  if (idir == 3)
            {
	      /* First parameter is constant  */
	      
	      tds = apar - gpar2[0];
	      if (DNEQUAL(ta12,DZERO))
		{
		  tdt = (tb1-tds*ta11)/ta12;
		}
	      else
		{
		  /* sqt is normal to normalvector */
		  goto war02;
		}
	      
	      gpar2[0]  = apar;
	      gpar2[1] += tdt;
            }     
	  else
            {
	      /* Second parameter direction constant */
	      tdt = apar - gpar2[1];
	      if (DNEQUAL(ta11,DZERO))
		{
		  tds = (tb1-tdt*ta12)/ta11;
		}
	      else
		{
		  /* spv is normal to normalvector */
		  goto war02;
		}
	      gpar2[0] += tds;
	      gpar2[1]  = apar;
	      
            }
	  
	  /* Calculate the point found in first surface */
	  
	  s1421(psurf2,kder,gpar2,&klfs,&klft,gpnt2,gpnt2+18,&kstat); 
	  if (kstat<0) goto error;
	  
	  /* If the surface has normal of zero length leave the routine */
	  
	  if (kstat == 2) goto war02;
	  
	  /* Make the difference of the found point and sq */
	  
	  s6diff(gpnt2,sp,kdim,sdiff);
	  
	  
	  /* Project the point onto surface 2 along the normal spn */
	  
	  
	  /* Make two normals to the normal of surface one in last point */
	  
	  s6twonorm(spn,snorm1,snorm2,&kstat);
	  if (kstat<0) goto error;
	  
	  
	  /* Put a parametric representation of the tangent plane of surface 1 into
	     the implicit representation of the tangent planes of the constant
	     parameter line of surface 2 */
	  
	  ta11 = s6scpr(spu,snorm1,kdim);
	  ta12 = s6scpr(spv,snorm1,kdim);
	  ta21 = s6scpr(spu,snorm2,kdim);
	  ta22 = s6scpr(spv,snorm2,kdim);
	  
	  tb1  = s6scpr(sdiff,snorm1,kdim);
	  
	  tb2  = s6scpr(sdiff,snorm2,kdim);
	  
	  /* Calculate determinant of equation system */

	  tdum2 = ta11*ta22 - ta12*ta21;
	  
	  /* If tdum2 = 0.0, then the equation system is singular, iteration not
	     possible. */

	  if (DNEQUAL(tdum2,DZERO))
            {
	      gpar1[0] += (tb1*ta22-tb2*ta12)/tdum2;
	      gpar1[1] += (ta11*tb2-ta21*tb1)/tdum2;
            }
	  
	  /* Calculate point in first surface */
	  
	  s1421(psurf1,kder,gpar1,&klfu,&klfv,gpnt1,gpnt1+18,&kstat); 
	  if (kstat<0) goto error;
	  
	  /* If the surface has normal of zero length leave the routine */
	  
	  if (kstat == 2) goto war02;
        }
      
      
      /* Make difference between the two points, 
	 and calculate length of difference */

      s6diff(gpnt1,gpnt2,kdim,sdiff);
      tdum3 = s6length(sdiff,kdim,&kstat);
      knbit = knbit + 1;
      
      if (kstat==0) 
        {
	  /* Length is zero iteration has converged   */
	  kcont = 0;
	  goto war00;
        }
      
      if (knbit<=1)
        {
	  /* First iteration intitate distance variable, if the equation
	     systems were not singular */

	  if (DEQUAL(tdum2,DZERO)) goto war02;
	  tdist = tdum3;
        }
      else
        {
	  /* More than one iteration done, stop if distance is not decreasing.
	     Then decide if we converge distance between the points is within
	     the tolerance and the last step had singular or none singular
	     equation systems. */

	  if (tdum3>=tdist)
            {
	      /* Distance is not decreasing */
	      if (tdist <= aepsge)
                {
		  /* Distance within tolerance */
		  if (DEQUAL(tdum2,DZERO))
                    {
		      /* Singular equation system */
		      goto war01;
                    }
		  else
                    {
		      /* Nonsingular equation system */
		      goto war00;
                    }
                }
	      else
                {
		  /* Distance is not within tolerance, divergence */
		  goto war02;
                }
            }
	  /* Distance still decreasing */
	  
	  tdist = tdum3;
        }
      
      /*  Make sure that not to many iteration are being done */
      if (knbit > kmaxit) goto war02;
    }
  
  
  /* Iteration converged */

  war00:
    *jstat = 0;
    goto out;
  
  /* Iteration converged, singular point found */

  war01: 
    *jstat = 1;
    goto out;
  
  /* To many iterations or iteration diverging */

  war02: 
    *jstat = 2;
    goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
    s6err("s9boundit",*jstat,kpos);
    goto out;
  
  out:
    return;
}


//===========================================================================
void s1602(double estapt[],double endpt[],int ik,int idim,double astpar,
	   double *cendpar,SISLCurve **rc,int *jstat)
//===========================================================================
{
  int kit;            /* Loop control                                    */
  int kit2;           /* Loop contero                                    */
  int kvert;          /* Counter for position in vertex array            */
  int kpos=0;         /* Position of error                               */
  
  double *st=SISL_NULL;    /* Pointer to the first element of the knot vector
			 of the curve.                                   */
  double *scoef=SISL_NULL; /* Pointer to the first element of the curve's
			 B-spline coefficients.                          */
  double tdist;       /* Distance                                        */
  double tdel;        /* Delta x, y , ....                               */
  
  /* Check input */          
  
  if (idim <  1) goto err102;
  if (ik   <  2) goto err109;
  
  /* Find distance between start nd end point */
  tdist = s6dist(estapt,endpt,idim);
  
  
  /* Make knots. First allocate space */
  
  st = newarray(ik*2,DOUBLE);
  if (st == SISL_NULL) goto err101;
  
  for (kit=0; kit<ik; kit++) 
    {
      st[kit]    = astpar;
      st[kit+ik] = astpar + tdist;
    }
  
  /* calculate the vertices. First allocate space */ 
  
  /* First allocate space for vertices */ 
  
  scoef = newarray(ik*idim,DOUBLE);
  if (scoef == SISL_NULL) goto err101;
  
  /* Find first and last vertex. */ 
  
  kvert = (ik-1) * idim;
  for (kit=0; kit<idim; kit++,kvert++) 
    {
      scoef[kit]   = estapt[kit];
      scoef[kvert] = endpt[kit];
    }
  
  /* Find other vertices */ 
  
  for (kit=0; kit<idim; kit++)
    {   
      tdel = (endpt[kit] - estapt[kit])/(ik - 1);
      for (kit2=2; kit2<ik; kit2++)
	scoef[(kit2-1)*idim + kit] = scoef[(kit2-2)*idim + kit] + tdel; 
    }
  
  /* Make the curve */
  
  *rc = SISL_NULL;              
  *rc = newCurve(ik,ik,st,scoef,1,idim,1);
  if (*rc == SISL_NULL) goto err101;                
  
  *cendpar = st[ik];
  *jstat = 0;
  goto out;
  
  /* Error in memory allocation */
  
 err101: 
  *jstat = -101;
  s6err("s1602",*jstat,kpos);
  goto out;
  
  /* Error in input. Dimension less than 1 */
  
 err102: 
  *jstat = -102;
  s6err("s1602",*jstat,kpos);
  goto out;                          
  /* Error in input. Order less than 2 */
  
 err109: 
  *jstat = -109;
  s6err("s1602",*jstat,kpos);
  goto out;                          
    
 out:
  if (st     != SISL_NULL) freearray(st);
  if (scoef  != SISL_NULL) freearray(scoef);
  return;
}          


//===========================================================================
void s1755 (double orknt[], int in, int ik, double extknt[], int *inh, int *jstat)
//===========================================================================
{
  int ki;			/* Loop control parameters 		*/
  int kstart, kstop;
  int numb;
  int kpos = 0;			/* Position indicator for errors	*/
  double prev, par;		/* Parameters used to find consecutive
				   distinct knotvector values		*/
  double tstart, tstop;		/* tstart=orknt[ik-1], tstop=orknt[in]	*/

  *jstat = 0;


  /* Test if legal input. */

  if ((ik < 1) || (in <ik))
    goto err112;


  /* Test if input knot vector degenerate. */

  if (orknt[ik - 1] >= orknt[in])
    goto err112;

  kstop = in +ik;


  /* PRODUCTION OF KNOTS: First we fill in extra knots at each
     distinct knot value, then we remove the superfluous knots.	*/

  numb = 0;
  prev = orknt[0] - 1;
  for (ki = 0; ki < kstop; ki++)
    {
      par = orknt[ki];
      if (par < prev)
	goto err112;

      if (par != prev)
	{
	  /* New distinct knot value, insert additional knot. */

	  extknt[numb] = par;
	  numb++;
	}
      extknt[numb] = par;
      prev = par;
      numb++;
    }

  /* Remove superfluous knots at start. Find greatest start knot. */

  kstart = 0;
  tstart = orknt[ik - 1];
  while (extknt[kstart] <= tstart)
    kstart++;
  kstart--;


  /* Find smallest end knot 		*/

  kstop = numb - 1;
  tstop = orknt[in];
  while (extknt[kstop] >= tstop)
    kstop--;
  kstop++;


  /* The knots from kstart-ik up to
   * kstop+ik are the knots to be kept	*/

  *inh = kstop - kstart + ik;


  /* Copy the knots to be kept to the start of the knot array */

  memcopy (extknt, &extknt[kstart - ik], *inh + ik + 1, DOUBLE);
  goto out;


  /* Error in description of B-spline */

err112:
  *jstat = -112;
  s6err ("s1755", *jstat, kpos);
  goto out;

out:
  return;
}


//===========================================================================
void s1753 (double et[], double ecf[], int in, int ik, int idim, double etr[],
	    double ecfr[], int inr, double ecc[], double ecw[], int *jstat)
//===========================================================================
{
  int ki, kj, kk, kl, kr, kstop;/* Loop control variables 		*/
  int kjmid, ikmid;		/* kjmid=(kj-1)*idim  ikmid=(ik-1)*idim */
  int kpos = 0;			/* Error position indicator		*/
  double ty1, ty2, tyi, tyik;	/* Parameters used in Main Loop		*/
  double dummy;
  double tden;

  *jstat = 0;


  /* Check input values. */

  if ((ik < 1) || (in <ik) ||(inr < (ik + 1)))
    goto err112;


  /* Initiate local variables. */

  kr = 1;
  for (kj = 1; kj <= inr; kj++)
    {

      /* Find kr, such that et[kr-1]<=etr[kj-1]<et[kr]	*/

      for (kr--; et[kr] <= etr[kj - 1]; kr++) ;


      /* Set ecc and ecw to zero. */

      for (ki = 0; ki < ik * idim; ki++)
	{
	  ecc[ki] = (double) 0.0;
	  ecw[ki] = (double) 0.0;
	}

      /* Initialize the remaining ecc and ecw entries. */

      kstop = MIN (ik, in +ik - kr);
      for (ki = MAX (0, ik - kr); ki < kstop; ki++)
	for (kl = 0; kl < idim; kl++)
	  {
	    dummy = ecf[(ki + kr - ik) * idim + kl];
	    ecc[ki * idim + kl] = dummy;
	    ecw[ki * idim + kl] = dummy;
	  }

      /* MAIN LOOP. */

      for (kk = ik - 1; kk > 0; kk--)
	{
	  ty1 = etr[kj + kk - 1];
	  ty2 = etr[kj + kk];
	  kstop = MAX (ik - kk, ik - kr);

	  for (ki = MIN (ik - 1, in +2 * ik - kk - kr - 1); ki >= kstop; ki--)
	    {
	      tyi = et[kr + ki - ik];
	      tyik = et[kr + ki + kk - ik];
	      tden = tyik - tyi;

	      for (kl = 0; kl < idim; kl++)
		{
		  ecc[ki * idim + kl] = ((ty2 - tyi) * ecc[ki * idim + kl] +
			   (tyik - ty2) * ecc[(ki - 1) * idim + kl]) / tden;
		  ecw[ki * idim + kl] = ((ty1 - tyi) * ecw[ki * idim + kl] +
			  (tyik - ty1) * ecw[(ki - 1) * idim + kl]) / tden +
		    ecc[ki * idim + kl];
		}
	    }
	}
      kjmid = (kj - 1) * idim;
      ikmid = (ik - 1) * idim;

      for (kl = 0; kl < idim; kl++)
	ecfr[kjmid + kl] = ecw[ikmid + kl] / ik;
    }

  goto out;


  /* Error in description of bases */

err112:
  *jstat = -112;
  s6err ("s1753", *jstat, kpos);
  goto out;

out:
  return;
}


//===========================================================================
void s1754 (double *et, int in, int ik, int ikh, double **iknt, int *inh, int *jstat)
//===========================================================================
{
  int ki, kj;			/* Loop control parameters 		*/
  int kstart, kstop;
  int numb;
  int kpos = 0;			/* Position indicator for errors	*/
  int kant;			/* Equals ikh-ik			*/
  double prev, par;		/* Parameters used to find consecutive
				   distinct knotvector values		*/
  double tstart, tstop;		/* tstart=et[ik-1], tstop=et[in]	*/

  *jstat = 0;


  /* Test if legal input. */

  if (ik < 1 || ikh < ik || in <ik)
    goto err112;


  /* Test if input knot vector degenerate. */

  if (et[ik - 1] >= et[in])
    goto err112;


  /* Allocate internal array arr. */

  *iknt = newarray ((in +ik) *(ikh - ik + 1), DOUBLE);
  if (*iknt == SISL_NULL)
    goto err101;


  /* If ik=ikh, just copy knots. */

  kstop = in +ik;
  if (ik == ikh)
    {
      *inh = in;
      memcopy (*iknt, et, kstop, DOUBLE);
      goto out;
    }

  /* PRODUCTION OF KNOTS: First we fill in extra knots at each
     distinct knot value, then we remove the superfluous knots. */

  numb = 0;
  kant = ikh - ik;
  prev = et[0] - 1;
  for (ki = 0; ki < kstop; ki++)
    {
      par = et[ki];
      if (par < prev)
	goto err112;

      if (par != prev)
	{
	  /* New distinct knot value, insert additional knots. */

	  for (kj = 0; kj < kant; kj++, numb++)
	    (*iknt)[numb] = par;
	}
      (*iknt)[numb] = par;
      prev = par;
      numb++;
    }

  /* Remove superfluous knots at start. Find greatest start knot. */

  kstart = 0;
  tstart = et[ik - 1];
  while ((*iknt)[kstart] <= tstart)
    kstart++;
  kstart--;


  /* Find smallest end knot. */

  kstop = numb - 1;
  tstop = et[in];
  while ((*iknt)[kstop] >= tstop)
    kstop--;
  kstop++;


  /* The knots from kstart-ikh+1 up to
   * kstop+ikh-1 are the knots to be kept. */

  *inh = kstop - kstart + ikh - 1;


  /* Copy the knots to be kept to the start of the knot array. */

  kstart -= ikh - 1;
  kstop = *inh + ikh;
  memcopy (*iknt, &(*iknt)[kstart], kstop, double);

  goto out;

  /* Memory error or error in allocation. */

err101:
  *jstat = -101;
  s6err ("s1754", *jstat, kpos);
  goto out;

  /* Error in description of B-spline. */

err112:
  *jstat = -112;
  s6err ("s1754", *jstat, kpos);
  goto out;

out:
  if (*iknt != SISL_NULL)
    {
      *iknt = increasearray (*iknt, *inh + ikh, DOUBLE);
      if (*iknt == SISL_NULL)
	goto err101;
    }
  return;
}

//===========================================================================
void s1750(SISLCurve *pc,int ikh,SISLCurve **rc,int *jstat)
//===========================================================================
{
  int ki, kn, kk;		/* Loop control parameters			*/
  int kordr;
  int inhrem;			/* Used to store inh, for later use in last
				 * call to s1753				*/
  int kpos = 0;			/* Error position indicator			*/
  int kstat = 0;		/* Status variable */
  double *kcc = SISL_NULL;
  double *kcw = SISL_NULL;		/* Arrays for internal use only			*/
  double *orknot = SISL_NULL;	/* Used to store 'original' knot vector		*/
  double *xtknot = SISL_NULL;	/* Used to store extended knot vector		*/
  double *pointer = SISL_NULL;
  double *orcoef = SISL_NULL;	/* Used to store 'original' coefficient matrix	*/
  double *et = SISL_NULL;		/* Original knot vector				*/
  double *ebcoef = SISL_NULL;	/* Vertices of original curve			*/
  int in;			/* Number of vertices of original curve		*/
  int ik;			/* Order of original curve			*/
  int idim;			/* Dimension of the space where the curve lie	*/
  int kdim;                     /* Potential rational dimension.                */
  int kind;                     /* Kind of curve, 2 and 4 are rationals.        */
  double *iknt = SISL_NULL;		/* New knot vector				*/
  double *icoef = SISL_NULL;		/* Coefficients of new curve			*/
  int inh;			/* Number of vertices produced			*/

  *jstat = 0;

  /* Initialization of variables. */

  kind = pc->ikind;
  idim = pc->idim;
  et = pc->et;
  if (kind == 2 || kind == 4)
    {
      ebcoef = pc->rcoef;
      kdim = idim + 1;
    }
  else
    {
      ebcoef = pc->ecoef;
      kdim = idim;
    }
  in = pc->in;
  ik = pc->ik;

  /* Test if legal input. */

  if ((ik < 1) || (ikh < ik) || (in <ik)) goto err112;

  /* If ikh=ik, copy input curve to output variables. */

  if (ikh == ik)
    {
      *rc = newCurve (in, ik, et, ebcoef, pc->ikind, idim, 1);
      if (*rc == SISL_NULL) goto err171;

      /* If the input curve is periodic, the output curve is periodic. */
      (*rc)->cuopen = pc->cuopen;
      goto out;
    }

  /* Find size of knot vector and vertex vector,
     and find knot vector expressed in order ikh. */

  s1754 (et, in, ik, ikh, &iknt, &inh, &kstat);
  if (kstat < 0) goto error;

  /* Allocate coefficients array for raised curve. */

  if((icoef = newarray (inh * kdim, DOUBLE)) == SISL_NULL) goto err101;

  /* Allocate arrays for internal use. */

  if((kcc = newarray (kdim * ikh, DOUBLE)) == SISL_NULL) goto err101;
  if((kcw = newarray (kdim * ikh, DOUBLE)) == SISL_NULL) goto err101;

  /* Find vertices if  ikh = ik+1 */

  if (ikh == ik + 1)
    {
      s1753 (et, ebcoef, in, ik, kdim, iknt, icoef, inh, kcc, kcw, &kstat);
      if (kstat < 0) goto error;

      *rc = newCurve (inh, ikh, iknt, icoef, pc->ikind, idim, 2);
      if (*rc == SISL_NULL) goto err171;

      /* If the input curve is periodic, the output curve is periodic. */
      (*rc)->cuopen = pc->cuopen;
 
      goto out;
    }

  /* Allocate arrays to store knot vector for use in s1755. */

  orknot = newarray ((in +ik) *(ikh - ik + 1), DOUBLE);
  if (orknot == SISL_NULL) goto err101;
  xtknot = newarray ((in +ik) *(ikh - ik + 1), DOUBLE);
  if (xtknot == SISL_NULL) goto err101;

  /* Allocate array to store vertices. */

  orcoef = newarray (inh * kdim, DOUBLE);
  if (orcoef == SISL_NULL) goto err101;

  /* Initialize orknot and orcoef. */

  for (ki = 0; ki < (in +ik); ki++)
    orknot[ki] = et[ki];

  for (ki = 0; ki < (kdim * in); ki++)
    orcoef[ki] = ebcoef[ki];


  /* MAIN LOOP. Do the order raisings. */

  inhrem = inh;
  kn = in;
  kk = ik;
  for (kordr = ik + 1; kordr < ikh; kordr++)
    {
      /* Produce raised knots. */

      s1755 (orknot, kn, kk, xtknot, &inh, &kstat);
      if (kstat < 0) goto error;

      /* Produce raised vertices. */

      s1753 (orknot, orcoef, kn, kk, kdim, xtknot, icoef,
	     inh, kcc, kcw, &kstat);
      if (kstat < 0) goto error;


      if ((kordr + 1) < ikh)
	{
	  pointer = orknot;
	  orknot = xtknot;
	  xtknot = pointer;
	}
      kk = kordr;
      kn = inh;
      pointer = orcoef;
      orcoef = icoef;
      icoef = pointer;
    }

  inh = inhrem;
  s1753 (xtknot, orcoef, kn, kk, kdim, iknt, icoef, inh, kcc, kcw, &kstat);
  if (kstat < 0) goto error;

  /* OK.
   * Create new curve */

  *rc = newCurve (inh, ikh, iknt, icoef, pc->ikind, idim, 2);
  if (*rc == SISL_NULL) goto err171;

  /* If the input curve is periodic, the output curve is periodic. */
  (*rc)->cuopen = pc->cuopen;

  goto out;


  /* Error in array allocation */

  err101:
    *jstat = -101;
    s6err ("s1750", *jstat, kpos);
    goto out;

  /* Could not create curve. */

  err171:
    *jstat = -171;
    s6err ("s1750", *jstat, kpos);
    goto out;

  /* Error in description of B-spline */

  err112:
    *jstat = -112;
    s6err ("s1750", *jstat, kpos);
    goto out;

  /* Error in lower level routine */

  error:
    *jstat = kstat;
    s6err ("s1750", *jstat, kpos);
    goto out;

  out:
    if (kcc != SISL_NULL)    freearray (kcc);
    if (kcw != SISL_NULL)    freearray (kcw);
    if (orknot != SISL_NULL) freearray (orknot);
    if (xtknot != SISL_NULL) freearray (xtknot);
    if (orcoef != SISL_NULL) freearray (orcoef);
    return;
}


//===========================================================================
void s1715(SISLCurve *pc1,SISLCurve *pc2,int iend1,int iend2,SISLCurve **rcnew,int *jstat)
//===========================================================================
{
  int kstat=0;            /* Local status variable.                     */
  int kpos=0;             /* Position of error.                         */
  int kcopy=0;            /* To mark if pc1 (1) or pc2 (2) is
			     changed to point at a local copy.          */
  int km1=0,km2=0;        /* Knot mutiplicety at the end to join.       */
  int km2end=0;           /* Knot mutiplicety at the end of the
			     second curve.                              */
  int kk;                 /* Order of the new curve.                    */
  int kn;                 /* Number of the vertices in the new curve.   */
  int kdim;               /* Dimensjon of the space in whice curve lies.*/
  int routdim;            /* Rational dimension of the output curve.    */
  int kn1=pc1->in;        /* Number of vertices in the old curves.      */
  int kn2=pc2->in;        /* Number of vertices in the old curves.      */
  int ki,kj;              /* Control variable in loop, and others.      */
  double tdel;            /* The translation of the knots to the
			     second curve.                              */
  double *s1,*s2,*s3; 	  /* Pointers used in loop.                     */
  double *stran=SISL_NULL;     /* The translation vector to vertices.        */
  double *st=SISL_NULL;        /* The new knot-vector.                       */
  double *scoef=SISL_NULL;     /* The new vertice.                           */
  SISLCurve *qc=SISL_NULL;     /* Pointer to the new curve-object.           */
  
  int ktype;              /* Type of curves:                            */
                          /* = 1 : Both are B-splines                   */
                          /* = 2 : pc1 is B-spline and pc2 is NURBS     */
                          /* = 3 : pc1 is NURBS and pc2 is B-spline     */
                          /* = 4 : Both are NURBS                       */
  int knumb;              /* Number of vertices.                        */
  double weight;          /* Rational weight.                           */
  double *u1,*u2;         /* Utility pointers into the vertices.        */

  /* Check that we have curves to join. */
  
  if (!pc1 || !pc2) goto err150;

  /* Check that The curves is in the same room, have the same kdim. */
  
  if (pc1->idim != pc2->idim) goto err106;
  else kdim = pc1->idim;

  /* Check the type of the curves. */

  if (pc1->ikind == 2 || pc1->ikind == 4)
    {
      if (pc2->ikind == 2 || pc2->ikind == 4)
        {
          ktype = 4;
          routdim = kdim + 1;
        }
      else
        {
          ktype = 3;
          routdim = kdim + 1;
        }
    }
  else
    {
      if (pc2->ikind == 2 || pc2->ikind == 4)
        {
          ktype = 2;
          routdim = kdim + 1;
        }
      else
        {
          ktype = 1;
          routdim = kdim;
        }
    }
  
  /* Allocate a kdim array to store the translation of the second curv.*/
  
  if ((stran=newarray(kdim,double)) == SISL_NULL) goto err153;
  
  /* Checking the order of the curves, and raise the order if nessesary.*/
  
  if (pc1->ik < pc2->ik)
    {
      kcopy=1;
      kk=pc2->ik;
      s1750(pc1,kk,&pc1,&kstat);
      if (kstat) goto err153;
    } 
  else
    if (pc2->ik < pc1->ik)
      {
	kcopy=2;
	kk=pc1->ik;
	s1750(pc2,kk,&pc2,&kstat);
	if (kstat) goto err153;
      } 
    else
      kk = pc1->ik;
  
  /* Finding the knot multiplicity at the juinction, km1 km2.
     At the end thats  going to be the end of the new curve
     we also need to know the knot mutiticeply, km2end. */
  
  /* Having raised the order of the curves if necessary,
     remember the number of vertices in the two curves. */

  kn1=pc1->in;
  kn2=pc2->in;

  if (iend1) 
    while (pc1->et[kn1+kk-1-km1] == pc1->et[kn1+kk-1]) km1++;
  else        
    while (pc1->et[km1] == *pc1->et) km1++;
  if (iend2)
    {
      while (pc2->et[kn2+kk-1-km2] == pc2->et[kn2+kk-1]) km2++;
      while (pc2->et[km2end] == *pc2->et) km2end++;
    } 
  else
    {
      while (pc2->et[km2] == *pc2->et) km2++;
      while (pc2->et[kn2+kk-1-km2end] == pc2->et[kn2+kk-1]) km2end++;
    }
  
  /* Find the number of vertices in the new curve. */
  
  kn = kn1 + kn2 + 3*kk - km1 - km2 - km2end -1;
  
  /* Allocating the new arrays to the new curve. */
  
  if ((st=newarray(kn+kk,double))==SISL_NULL) goto err101;
  if ((scoef=newarray(kn*routdim,double))==SISL_NULL) goto err101;
  
  /* Copying the knotvectors from the old curve to the new curves */
  /****************************************************************/
  
  /* The first curve. */
  
  if (iend1)     /* The junction is at the end of the first curve. */
    {
      /* Copying all knots from the first curve that is different
	 from the last knot. */
      
      memcopy(st,pc1->et,kn1+kk-km1,double);
      
      /* Making a kk-1 touple knot at the junction. */
      
      for (s1=st+kn1+kk-km1,s2=s1+kk-1; s1<s2; s1++)
	*s1=pc1->et[kn1+kk-1];
      
    } 
  else     /* The junction is at the beginning of the first curve. */
    {
      /* Computing the factor to turn the first knotvector. */
      
      tdel = *pc1->et + pc1->et[kn1+kk-1];
	
      /* Copying and turning the first knot vector except the
	 knots at the junction. */
      
      for (s1=st,s2=pc1->et+km1,s3=pc1->et+kn1+kk-1; s2<=s3; s1++,s3--)
	*s1 = tdel - *s3;
      
      /* Making a kk-1 touple knot at the junction. */
      
      for (s2--,s3=s1+kk-1; s1<s3; s1++) *s1= tdel - *s2;
    }
  
  /* The second curve. */
  
  s2 = st+kn+kk-max(0,kk-km2end); /* The border for the last exsisting knot 
				     in the new knot vector. */
  
  if (!iend2)  /* The junction is at the begining of the second curve. */
    {
      /* Computing what the second knot vector has to be translated
	 to get a kontinue total knotvector. */
      
      tdel = s1[-1] - *pc2->et;
      
      /* copying and translating all knots except the knots
	 at the junction. */
      
      for (s3=pc2->et+km2; s1<s2; s1++,s3++) *s1 = *s3 + tdel;
    } 
  else
    {
      /* Coputing a factor to both translate and turn the knots. */
      
      tdel = pc2->et[kn2+kk-1] + s1[-1];
      
      /* Turning and translating all knots exept the knots
	 at the junction. */
	
      for (s3=pc2->et+kn2+kk-km2-1; s1<s2; s1++,s3--) *s1 =tdel- *s3;
    }
  
  /* Inserting new knots such that we have a kk touple knot at the end.*/
  
  for (ki=0; ki<kk-km2end; ki++)  s1[ki] = s1[-1];
  
  /* Copying the coeffesientvectors to the new curves.*/
  /***************************************************/
  
  /* Copying the first coeffisientvector. */
  
  knumb = min(kn1,kn1+kk-km1);
  ki = routdim*knumb;
  if (iend1)                        /* Just copying. */
    {
      if (ktype == 1)
        memcopy(scoef,pc1->ecoef,ki,double);
      else if (ktype == 2)
        {
          for (kj=0; kj<knumb; kj++)
            {
              u1 = scoef + kj*routdim;
              u2 = pc1->ecoef + kj*kdim;
              memcopy(u1,u2,kdim,double);
              scoef[kj*routdim + kdim] = 1.;
            }
        }
      else if (ktype == 3 || ktype == 4) 
        memcopy(scoef,pc1->rcoef,ki,double);
      s1 = scoef +ki;
    }
  else                              /* Copying back to front. */
    {
      if (ktype == 2)
        {
          s2 = pc1->ecoef;
          s3 = s2 + kdim*(knumb - 1);
          for (s1=scoef; s2<=s3; s3-=2*kdim)
            {
              for (ki=0; ki<kdim; ki++,s1++,s3++)  *s1 = *s3;
              *s1 = 1.;
              s1++;
            } 
        }
      else
        {
          if (ktype == 1)
            s2 = pc1->ecoef;
          else
            s2 = pc1->rcoef; 
          for (s1=scoef,s3=s2+ki-routdim; s2<=s3; s3-=2*routdim)
            for (ki=0; ki<routdim; ki++,s1++,s3++)  *s1 = *s3;
        }
    }

  /* If there is less than a kk touple knot at the end of the first curve
     than we have to inserte zeroes. */
  
  for (s2=s1+routdim*max(0,kk-km1); s1<s2; s1+=routdim)
    {
      for (ki=0; ki<kdim; ki++)
        s1[ki] = DZERO;
      if (ktype != 1)
        s1[kdim] = 1.;
    }
  
  /* Compute the translation of the second curv. */
  
  for (ki=0; ki<kdim; ki++)
    {
      if (km2<kk) stran[ki] = DZERO;
      else
	stran[ki] = iend2? pc2->ecoef[kdim*(kn2-max(0,km2-kk)-1)+ki]:
	  pc2->ecoef[kdim*max(0,km2-kk)+ki];
      if (km1>=kk)
	stran[ki] -= iend1? pc1->ecoef[kdim*(kn1-max(0,km1-kk)-1)+ki]:
	  pc1->ecoef[kdim*max(0,km1-kk)+ki];
    }
  
  
  /* Copying the second coefficientvector. */
  
  /* Findig the startpoint for copying in the old coeffisient vector. */
  
  if (iend2)
    {
      if (ktype == 1 || ktype == 3)
        s3=pc2->ecoef+kdim*(kn2-max(0,km2-kk)-1);
      else
        s3=pc2->rcoef+routdim*(kn2-max(0,km2-kk)-1);
    }
  else
    {
      if (ktype == 1 || ktype == 3) 
        s3=pc2->ecoef+kdim*max(0,km2-kk);
      else
        s3=pc2->rcoef+routdim*max(0,km2-kk);
    }
  
  if (km2<kk)
    {
      /* If km2<kk-1 we have to insert zeroes and than transform. */
      
      for (kj=km2+1; kj<kk; kj++,s2+=routdim)
        {
	  for (ki=0; ki<kdim; ki++,s1++) *s1 = -stran[ki];
          if (ktype != 1)
            {
              *s1 = 1.;
              s1++;
            }
        }       

      /* Copying and transforming the first coeffisients. */
      
      if (ktype == 1) 
        for (ki=0; ki<kdim; ki++,s1++,s3++) *s1 = *s3 - stran[ki];
      else
        {
          if (ktype == 3)
            weight = 1.;
          else
            weight = s3[kdim];
          for (ki=0; ki<kdim; ki++,s1++,s3++) *s1 = *s3 - stran[ki]*weight;
          *s1 = weight;
          s1++;
          if (ktype != 3) s3++;
        } 
    } 
  else
    if (ktype == 1 || ktype == 3)
      s3+=kdim;     /* Skiping the first coeffisients. */
    else  
      s3+=routdim;     /* Skiping the first coeffisients. */

  /* Copying and transforming the coeffisient from the second curve. */
  
  for (s2=scoef+routdim*min(kn,kn-kk+km2end); s1<s2;)
    {
      if (iend2)
        {
          if (ktype == 1 || ktype == 3)
            s3-=2*kdim;
          else
            s3-=2*routdim;
        } 
      if (ktype == 1) 
        for (ki=0; ki<kdim; ki++,s1++,s3++) *s1 = *s3 - stran[ki];
      else
        {
          if (ktype == 3)
            weight = 1.;
          else
            weight = s3[kdim];
          for (ki=0; ki<kdim; ki++,s1++,s3++) *s1 = *s3 - stran[ki]*weight;
          *s1 = weight;
          s1++;
          if (ktype != 3) s3++;
        }
    }
  
  /* Insert and transform from zeroes if we do not have a kk touple
     knot at the end of the second curve. */
  
  for (kj=0; kj<kk-km2end; kj++)
    {
      for (ki=0; ki<kdim; ki++,s1++)  *s1 = -stran[ki];
      if (ktype != 1)
        {
          *s1 = 1.;
          s1++;
        }
    }
  
  /* Create the new curve. */
  
  if (ktype == 1)
    {
      if ((qc=newCurve(kn,kk,st,scoef,1,kdim,2)) == SISL_NULL) goto err101;
    }
  else
      if ((qc=newCurve(kn,kk,st,scoef,2,kdim,2)) == SISL_NULL) goto err101;
  
  /* Updating output. */
  
  *rcnew = qc;
  *jstat = 0;
  goto out;
  
  
  /* Error. Subrutine error. */
  
 err153:
  *jstat = kstat;
  goto outfree;
  
  
  /* Error. No curve to subdevice.  */
  
 err150:
  *jstat = -150;
  s6err("s1715",*jstat,kpos);
  goto out;
  
  
  /* Error. Different dimensjon of the room.  */
  
 err106:
  *jstat = -106;
  s6err("s1715",*jstat,kpos);
  goto out;
  
  
  /* Error. Allocation error, not enough memory.  */
  
 err101:
  *jstat = -101;
  s6err("s1715",*jstat,kpos);
  goto outfree;
  
  
 outfree:
  if(qc) 
    freeCurve(qc);
  else
    {
      if (st) freearray(st);
      if (scoef) freearray(scoef);
    }
  
  /* Free local used memory. */
  
 out: 
  if (stran) 
    freearray(stran);
  if (kcopy == 1) 
    freeCurve(pc1);
  else
    if (kcopy == 2) freeCurve(pc2);
  return;
}



//===========================================================================
void s1710 (SISLCurve * pc1, double apar, SISLCurve ** rcnew1, 
	    SISLCurve ** rcnew2, int *jstat)
//===========================================================================
{
  int kind = pc1->ikind;	/* Type of curve pc1 is.                   */
  int kstat;			/* Local status variable.                  */
  int kpos = 0;			/* Position of error.                      */
  int kmy;			/* An index to the knot-vector.            */
  int kv, kv1;			/* Number of knots we have to insert.      */
  int kpl, kfi, kla;		/* To posisjon elements in trans.-matrix.  */
  int kk = pc1->ik;		/* Order of the input curve.               */
  int kn = pc1->in;		/* Number of the vertices in input curves. */
  int kdim = pc1->idim;		/* Dimensjon of the space in whice
				 * the curve lies.                         */
  int kn1, kn2;			/* Number of vertices in the new curves.   */
  int knum;			/* Number of knots less and equal than
			           the intersection point.                 */
  int ki, ki1;			/* Control variable in loop.               */
  int kj, kj1, kj2;		/* Control variable in loop.               */
  int newkind = 1;		/* Type of curve the subcurves are         */
  double *s1, *s2, *s3, *s4;	/* Pointers used in loop.                  */
  double *st1 = SISL_NULL;		/* The first new knot-vector.              */
  double *st2 = SISL_NULL;		/* The second new knot-vector.             */
  double *salfa = SISL_NULL;		/* A line of the trans.-matrix.            */
  double *scoef;		/* Pointer to vertices.                    */
  double *scoef1 = SISL_NULL;	/* The first new vertice.                  */
  double *scoef2 = SISL_NULL;	/* The second new vertice.                 */
  SISLCurve *q1 = SISL_NULL;		/* Pointer to new curve-object.            */
  SISLCurve *q2 = SISL_NULL;		/* Pointer to new curve-object.            */
  int incr;			/* Number of extra knots copied
				 * during periodicity                      */
  int mu;			/* Multiplisity at the k'th knot           */
  int kleft = kk-1;		/* Knot navigator                          */
  double delta;                 /* Period size in knot array.              */
  double salfa_local[5];	/* Local help array.			   */

  *rcnew1 = SISL_NULL;
  *rcnew2 = SISL_NULL;

  /* if pc1 is rational, do subdivision in homogeneous coordinates */
  /* just need to set up correct dim and kind for the new curves at end of routine */
  if (kind == 2 || kind == 4)
    {
      scoef = pc1->rcoef;
      kdim++;
      newkind++;
    }
  else
    {
      scoef = pc1->ecoef;
    }

  /* Check that we have a curve to subdivide. */

  if (!pc1)
    goto err150;


  /* Periodic curve treatment, UJK jan 92--------------------------------- */
  if (pc1->cuopen == SISL_CRV_PERIODIC)
    {
      delta = (pc1->et[kn] - pc1->et[kk - 1]);

      /* Check that the intersection point is an interior point. */
      /*if (apar < *(pc1->et) || apar > *(pc1->et + kn + kk - 1))*/
      if ((apar < pc1->et[0] && DNEQUAL(apar, pc1->et[0])) ||
	  (apar > pc1->et[kn+kk-1] && DNEQUAL(apar, pc1->et[kn+kk-1])))
	 goto err158;

      /* If inside the knot vector, but outside well define
	 intervall, we shift the parameter value one period. */
      if (apar < pc1->et[kk - 1] && DNEQUAL(apar, pc1->et[kk - 1]))
	apar += delta;
      if (apar > pc1->et[kn] || DEQUAL(apar, pc1->et[kn]))
	apar -= delta;

      /* Now we create a new curve that is a copy of pc1,
	 but with the period repeated once,
	 this allows us to pick a whole period. */

      /* Get multiplisity at start of full basis interval */
      mu = s6knotmult(pc1->et, kk, kn, &kleft, pc1->et[kk-1], &kstat);
      if (kstat < 0) goto err153;
      if (mu >= kk) goto errinp;

      /* Copy ----------------------------------- */
      incr = kn - kk + mu;
      if ((scoef1 = newarray ((kn + incr) * kdim, double)) == SISL_NULL)
	goto err101;
      if ((st1 = newarray (kn + kk + incr, double)) == SISL_NULL)
	goto err101;

      memcopy (scoef1, scoef, kn * kdim, double);
      memcopy (st1, pc1->et, kn + kk, double);
      memcopy (scoef1 + kn * kdim, scoef + (kk - mu) * kdim,
	       incr * kdim, double);


      for (ki = 0; ki < incr; ki++)
	st1[kn + kk + ki] = st1[kn + kk + ki - 1] +
	  (st1[2*kk - mu + ki] - st1[2*kk - mu + ki - 1]);

      if ((q1 = newCurve (kn + incr, kk, st1, scoef1,
			  newkind, pc1->idim, 2)) == SISL_NULL)
	goto err101;
      q1->cuopen = SISL_CRV_OPEN;

      /* Pick part (one period)------------------ */
      s1712 (q1, apar, apar + delta,
	     rcnew1, &kstat);
      if (kstat < 0)
	goto err153;
      freeCurve (q1);
      if (*rcnew1)
	(*rcnew1)->cuopen = SISL_CRV_CLOSED;

      /* Finished, exit */
      *jstat = 2;
      goto out;

    }

  /* End of periodic curve treatment, UJK jan 92------------- */

    /* Check that the intersection point is an interior point. */
  /* Changed by UJK and later ALA*/
  /*if (apar < *(pc1->et) || apar > *(pc1->et+kn+kk-1)) goto err158; */

  if ((apar < pc1->et[kk - 1] && DNEQUAL(apar, pc1->et[kk - 1]))||
      (apar > pc1->et[kn] && DNEQUAL(apar, pc1->et[kn])))
    goto err158;

  /* Allocate space for the kk elements which may not be zero in eache
     line of the basic transformation matrix.*/

  if (kk > 5)
  {
     if ((salfa = newarray (kk, double)) == SISL_NULL)	goto err101;
  }
  else salfa = salfa_local;


  /* Find the number of the knots which is smaller or like
     the intersection point, and how many knots we have to insert.*/

  s1 = pc1->et;
  kv = kk;	/* The maximum number of knots we may have to insert. */

  if ((apar > s1[0] && DNEQUAL(apar, s1[0])) &&
      (apar < s1[kn+kk-1] && DNEQUAL(apar, s1[kn+kk-1])))
  {
     /* Using binear search*/
     kj1=0;
     kj2=kk+kn-1;
     knum = (kj1+kj2)/2;
     while (knum != kj1)
     {
	if ((s1[knum] < apar) && DNEQUAL (s1[knum], apar))
	   kj1=knum;
	else
	   kj2=knum;
	knum = (kj1+kj2)/2;
     }
     knum++;    /* The smaller knots. */

     while (DEQUAL (s1[knum], apar))
      	/* The knots thats like the intersection point. */
     {
	apar = s1[knum];
	knum++;
	kv--;
     }
  }
  else if (DEQUAL(apar,s1[0]))
  {
     apar = s1[0];
     knum = 0;
     while (s1[knum] == apar)
	/* The knots thats like the intersection point. */
	knum++;
  }
  else if (DEQUAL(apar,s1[kn+kk-1]))
  {
     apar = s1[kn+kk-1];
     knum = kn+kk-1;
     while (s1[knum-1] == apar)
	/* The knots thats like the intersection point. */
	knum--;
  }

  /* Find the number of vertices in the two new curves. */

  kn1 = knum + kv - kk;
  kn2 = kn + kk - knum;



  /* Allocating the new arrays to the two new curves. */

  if (kn1 > 0)
  {
     if ((scoef1 = newarray (kn1 * kdim, double)) == SISL_NULL)
	goto err101;
     if ((st1 = newarray (kn1 + kk, double)) == SISL_NULL)
	goto err101;
  }
  if (kn2 > 0)
  {
     if ((scoef2 = newarray (kn2 * kdim, double)) == SISL_NULL)
	goto err101;
     if ((st2 = newarray (kn2 + kk, double)) == SISL_NULL)
	goto err101;
  }


  /* Copying the knotvectors, all but the intersection point from
     the old curve to the new curves */

  memcopy (st1, pc1->et, kn1, double);
  memcopy (st2 + kk, pc1->et + knum, kn2, double);


  /* Updating the knotvectors by inserting a k-touple knot in
     the intersection point at each curve.*/

  for (s2 = st1 + kn1, s3 = st2, s4 = s3 + kk; s3 < s4; s2++, s3++)
    *s2 = *s3 = apar;


  /* Copying the coefisientvectors to the new curves.*/

  memcopy (scoef1, scoef, kdim * kn1, double);
  memcopy (scoef2, scoef + kdim * (knum - kk), kdim * kn2, double);


  /* Updating the coefisientvectors to the new curves.*/

  /* Updating the first curve. */
  knum -= kk - 1;
  for (ki=max(0, knum), kv1=max(0,-knum), s1=scoef1+ki*kdim; ki < kn1; ki++)
  {
     /* Initialising:
	knum = knum-kk+1, Index of the first vertice to change.
	ki = knum,        Index of the vertices we are going to
	change. Starting with knum, but if
	knum is negativ we start at zero.
	kv1 = 0,          Number if new knots between index ki
	and ki+kk. We are starting one below
	becase we are counting up before using
	it. If knum is negativ we are not
	starting at zero but at -knum.
	s1=scoef1+ki*kdim,SISLPointer at the first vertice to
	change. */


     /* Using the Oslo-algorithm to make a transformation-vector
	from the old vertices to one new vertice. */

     kmy = ki;
     s1700 (kmy, kk, kn, ++kv1, &kpl, &kfi, &kla, pc1->et, apar, salfa, &kstat);
     if (kstat)
	goto err153;


     /* Compute the kdim vertices with the same "index". */

     for (kj = 0; kj < kdim; kj++, s1++)
	for (*s1 = 0, kj1 = kfi, kj2 = kfi + kpl; kj1 <= kla; kj1++, kj2++)
	   *s1 += salfa[kj2] * scoef[kj1 * kdim + kj];
  }

  /* And the second curve. */

  for (ki1 = min (kn1 + kv - 1, kn + kv), s1 = scoef2; ki < ki1; ki++)
    {
      /* Initialising:
	 ki1 = kn1+kv-1,   the index of the vertice next to the
	 last vertice we have to change.
	 If we do not have so many vertices,
	 we have to use the index next to the
	 last vertice we have, kn+kv.
	 s1=scoef2         Pointer at the first vertice to
	 change. */


      /* Using the Oslo-algorithm to make a transformation-vector
	 from the old vertices to one new vertice. */

      s1700 (kmy, kk, kn, kv1--, &kpl, &kfi, &kla, pc1->et, apar, salfa, &kstat);
      if (kstat)
	goto err153;


      /* Compute the kdim vertices with the same "index". */

      for (kj = 0; kj < kdim; kj++, s1++)
	for (*s1 = 0, kj1 = kfi, kj2 = kfi + kpl; kj1 <= kla; kj1++, kj2++)
	  *s1 += salfa[kj2] * scoef[kj1 * kdim + kj];
    }


  /* Allocating new curve-objects.*/

  if (kn1 > 0)
    q1 = newCurve (kn1, kk, st1, scoef1, newkind, pc1->idim, 2);

  if (kn2 > 0)
    q2 = newCurve (kn2, kk, st2, scoef2, newkind, pc1->idim, 2);

  if (q1 == SISL_NULL && q2 == SISL_NULL)       goto err101;

  /* Updating output. */

  *rcnew1 = q1;
  *rcnew2 = q2;
  if (q1 == SISL_NULL || q2 == SISL_NULL)
     *jstat = 5;  /* The curve is subdivided in an endpoint. */
  else
     *jstat = 0;
  goto out;


  /* Error. Error in low level routine. */

err153:
  *jstat = kstat;
  s6err ("s1710", *jstat, kpos);
  goto outfree;

  /* Error. Error in input */
errinp:
  *jstat = -154;
  s6err ("s1710", *jstat, kpos);
  goto outfree;


  /* Error. No curve to subdivide.  */

err150:
  *jstat = -150;
  s6err ("s1710", *jstat, kpos);
  goto out;


  /* Error. The parameter value is outside the curve.  */

err158:
  *jstat = -158;
  s6err ("s1710", *jstat, kpos);
  goto out;


  /* Error. Allocation error, not enough memory.  */

err101:
  *jstat = -101;
  s6err ("s1710", *jstat, kpos);
  goto outfree;


outfree:
   if (q1)
      freeCurve (q1);

   if (q2)
      freeCurve (q2);


   /* Free local used memory. */

out:
   if (!q1)
   {
      if (st1)
	 freearray (st1);
      if (scoef1)
	 freearray (scoef1);
   }

   if (!q2)
   {
      if (st2)
	 freearray (st2);
      if (scoef2)
	 freearray (scoef2);
   }

   if (kk > 5 && salfa)
      freearray (salfa);
   return;
}


//===========================================================================
void s1714 (SISLCurve * pc, double apar1, double apar2, SISLCurve ** rcnew1, 
	    SISLCurve ** rcnew2, int *jstat)
//===========================================================================
{
  int kstat;			/* Local status variable.        */
  int kpos = 0;			/* Position of error.            */
  SISLCurve *q1 = SISL_NULL;		/* Pointer to new curve-object.  */
  SISLCurve *q2 = SISL_NULL;		/* Pointer to new curve-object.  */

  /* Check that we have a curve to devide. */

  if (!pc)
    goto err150;

  /* Check that apar1 is not equal apar2. */

  if (DEQUAL (apar1, apar2))
    goto err151;

  /* Treating periodicity UJK, jan.92 and later ALA, sep.92 ------- */
  if (pc->cuopen == SISL_CRV_PERIODIC)
    {
      double delta = pc->et[pc->in] - pc->et[pc->ik - 1];
      
      while(apar1 < pc->et[pc->ik - 1] && DNEQUAL(apar1, pc->et[pc->ik - 1]))
	 apar1 += delta;
      while(apar1 > pc->et[pc->in] || DEQUAL(apar1, pc->et[pc->in]))
	 apar1 -= delta;

      while (apar2 < apar1 || DEQUAL(apar2, apar1))
	apar2 += delta;
      
      while (apar2 > (apar1+delta) && DNEQUAL(apar2, (apar1+delta)))
	apar2 -= delta;

      /* Shift startpoint of curve (and make it ordinary closed )*/
      s1710 (pc, apar1, &q1, &q2, &kstat);
      if (kstat < 0)
	goto err153;

      if (q2)
	freeCurve (q2);
      q2 = SISL_NULL;

      /* Split into two */
      s1710 (q1, apar2, rcnew1, rcnew2, &kstat);
      if (kstat < 0)
	goto err153;

	if (q1)
	freeCurve (q1);
      q1 = SISL_NULL;


      *jstat = 0;
      goto out;
    }
  /* End of treating periodicity UJK, jan.92 ------- */


    /* Divide the curve into two at each point.
     Join the two end curves at each end.*/

if (apar1 < apar2)
  {
    s1712 (pc, apar1, apar2, &q1, &kstat);
    if (kstat)
      goto err153;

    s1713 (pc, apar2, apar1, &q2, &kstat);
    if (kstat)
      goto err153;
  }

else
  {
    s1712 (pc, apar2, apar1, &q2, &kstat);
    if (kstat)
      goto err153;

    s1713 (pc, apar1, apar2, &q1, &kstat);
    if (kstat)
      goto err153;
  }

 /* Updating output. */

*rcnew1 = q1;
*rcnew2 = q2;
*jstat = 0;
goto out;


 /* Error. Subrutine error. */

err153:
*jstat = kstat;
goto outfree;


 /* Error. No curve to pick a part of.  */

err150:
*jstat = -150;
s6err ("s1714", *jstat, kpos);
goto out;


 /* Error. No part, apar1 and apar2 has illegal values.  */

err151:
*jstat = -151;
s6err ("s1714", *jstat, kpos);
goto out;


 /* Error in output. */

outfree:
if (q1)
  freeCurve (q1);
if (q2)
  freeCurve (q2);

out:
return;
}


//===========================================================================
void s1713(SISLCurve *pc,double abeg,double aend,SISLCurve **rcnew,int *jstat)
//===========================================================================
{
  int kstat;          /* Local status variable.          */
  int kpos=0;         /* Position of error.              */
  double tbeg,tend;   /* The smaller and greater point.  */
  SISLCurve *q1=SISL_NULL; /* Pointer to new curve-object.    */
  SISLCurve *q2=SISL_NULL; /* Pointer to new curve-object.    */
  SISLCurve *q3=SISL_NULL; /* Pointer to new curve-object.    */
  SISLCurve *q4=SISL_NULL; /* Pointer to new curve-object.    */
  
  /* Check that we have a curve to pick a part of. */
  
  if (!pc) goto err150;
  
  /* Treating periodicity UJK, jan.92 ------- */
  if (pc->cuopen == SISL_CRV_PERIODIC)
  {
     s1714 (pc, abeg, aend, rcnew, &q1, jstat);
     if (q1) freeCurve(q1);q1=SISL_NULL;
     goto out;
  }

  /* Check that the intersection points is interior points. */
  
  if ((abeg < pc->et[0] && DNEQUAL(abeg,pc->et[0])) || 
      (abeg > pc->et[pc->in+pc->ik-1] && DNEQUAL(abeg,pc->et[pc->in+pc->ik-1])))
     goto err151;
  if ((aend < pc->et[0] && DNEQUAL(aend,pc->et[0])) || 
      (aend > pc->et[pc->in+pc->ik-1] && DNEQUAL(aend,pc->et[pc->in+pc->ik-1])))
    goto err151;
      
  /* Find the smaller and greater of the intersection points. */
  
  if (abeg<aend)
    {
      tbeg = abeg;
      tend = aend;
    } 
  else
    if (abeg>aend)
      {
	tbeg = aend;
	tend = abeg;
      }
  
  if (DEQUAL(abeg,aend))
  {
     /* In this case we have just one point to
	devide at. The result is two curves, q1 q1. */
     
     s1710(pc,abeg,&q1,&q3,&kstat);
     if (kstat<0 || kstat==2) goto err153;
  } 
  else
  {
     /* Devide into two at each point,
	we than have tree curves, q1 q2 q3.*/
     
     s1710(pc,tbeg,&q1,&q4,&kstat);
     if (kstat<0 || kstat==2) goto err153;
     
     s1710(q4,tend,&q2,&q3,&kstat);
     if (kstat<0 || kstat==2) goto err153;
     
     freeCurve(q4);  q4 = SISL_NULL;
  }
  
  /* If nessesary we have to join curve q3 and q1 to get the new curve.*/
  
  if (abeg > aend || DEQUAL(abeg,aend))
  {
     if (q2) 
     {
	freeCurve(q2);
	q2 = SISL_NULL;
     }
     if (!q1)
     {
	q2 = q3;
	q3 = SISL_NULL;
     }
     else if (!q3)
     {
	q2 = q1;
	q1 = SISL_NULL;
     }
     else
     {
	s1715(q3,q1,1,0,&q2,&kstat);
	if (kstat) goto err153;
     }
  }
  
  /* Updating output. */
  
  *rcnew = q2;
  *jstat = 0;
  goto out;
  
  /* Error. Subrutine error. */
  
 err153:
  *jstat = kstat;
  goto outfree;
  
  /* Error. No curve to pick a part of.  */
  
 err150:
  *jstat = -150;
  s6err("s1713",*jstat,kpos);
  goto out;
  
  /* Error. No part, abeg and aend has illegal values.  */
  
 err151:
  *jstat = -151;
  s6err("s1713",*jstat,kpos);
  goto out;
  
  /* Error in output. */
  
 outfree:
  if(q2) freeCurve(q2);
  
  /* Free local used memory. */
  
 out:
  if(q1) freeCurve(q1);
  if(q3) freeCurve(q3);
  if(q4) freeCurve(q4);
  return;
}


//===========================================================================
void  s1706(SISLCurve *pc)
//===========================================================================
{
  int  kk=pc->ik;             /* Order of the input curve.             */
  int  kn=pc->in;             /* Number of vertices in the input curve.*/
  int  kdim=pc->idim;         /* Dimensjon of the space in whice curve
				 lies.                                 */
  register double *s1,*s2;
  register double *s3; 	       /* Pointers used in loop.               */
  register double t1,t2;       /* Help variables.                      */
  
  /* Now curve to turn. */
  
  if (!pc) goto out;
  
  /* Here we are turning the knot vector such that the first
     element have the same value as the old first element. */
  
  for (s1=pc->et,s2=s1+kk+kn-1,t1=(*s1)+(*s2); s1<=s2; s1++,s2--)
    {
      t2 = *s1;
      *s1 = t1 - *s2;
      *s2 = t1 - t2;
    }
  
  /* Here we just turn the vertices. */
  
  for (s1=pc->ecoef,s2=s1+kdim*(kn-1); s1<s2; s2-=2*kdim)
    for (s3=s1+kdim; s1<s3; s1++,s2++)
      {
	t1 = *s1;
	*s1 = *s2;
	*s2 = t1;
      }

  /* If necessary turn rational vertices. */

  if (pc->ikind == 2 || pc->ikind == 4)
    {
      kdim++;
      for (s1=pc->rcoef,s2=s1+kdim*(kn-1); s1<s2; s2-=2*kdim)
        for (s3=s1+kdim; s1<s3; s1++,s2++)
          {
	    t1 = *s1;
            *s1 = *s2;
	    *s2 = t1;
          }
    }
  
 out:
  return;
}

//===========================================================================
void pick_crv_sf(SISLObject *po1, SISLObject *po2,int ipar,
		 SISLIntpt *pt1,SISLIntpt *pt2,SISLCurve **rcrv, int *jstat)
//===========================================================================
{
  int kstat = 0;        /* Local status parameter.                        */
  int kpos = 0;         /* Position of error.                             */
  int index=0;          /* Index of other par dir in surf.                */
  int first_const;      /* Flag, const first direction or not             */
  double tpar;          /* Parameter value of curve in constant parameter
			   direction.                                     */
  SISLSurf *ps1=SISL_NULL;   /* Pointer to surf to pick crv from               */
  SISLCurve *pick_crv=SISL_NULL;/* Picked curve before trimming.               */
  /* -------------------------------------------------------------------- */
  if (ipar < 0 || ipar >= po1->iobj + po2->iobj) goto errinp;

  if (ipar >= po1->iobj)
  {
     /* pick from second object (must be a sf) */
     if (po2->iobj != SISLSURFACE) goto errinp;
     ps1 = po2->s1;
     index = (ipar == po1->iobj) ? po1->iobj + 1 : po1->iobj;
  }
  else
  {
     /* pick from first object (must be a sf) */
     if (po1->iobj != SISLSURFACE) goto errinp;
     ps1 = po1->s1;
     index = (ipar == 0) ? 1 : 0;
  }
  
  if (ipar < index) first_const = TRUE;
  else first_const = FALSE;
  tpar = pt1->epar[ipar];
  
  
  if (first_const == FALSE)
    {
       /* Pick curve with constant second parameter.  */
       s1436(ps1,tpar,&pick_crv,&kstat);
       if (kstat < 0) goto error;
    }
  else 
    {
       /* Pick curve with constant first parameter.  */
       s1437(ps1,tpar,&pick_crv,&kstat);
       if (kstat < 0) goto error;
    }
  
  /* SISLCurve picked, now trim it.  */
  if (DEQUAL(pt1->epar[index], pick_crv->et[pick_crv->ik-1]) &&
      DEQUAL(pt2->epar[index], pick_crv->et[pick_crv->in]))
    {
       /* Return the whole curve */
       (*rcrv)  = pick_crv;
       pick_crv = SISL_NULL;
    }
  
  
  else if(DEQUAL(pt1->epar[index], pick_crv->et[pick_crv->in]) &&
	  DEQUAL(pt2->epar[index], pick_crv->et[pick_crv->ik-1]))
    {
       /* Return the whole curve, but turn it first */
       /* Return the whole curve */
       (*rcrv)  = pick_crv;
       pick_crv = SISL_NULL;
       s1706(*rcrv); 
    } 
  else
  {
     /* Return a part of the curve */ 
     double amin = min(pt1->epar[index], pt2->epar[index]);
     double amax = max(pt1->epar[index], pt2->epar[index]);
     
     if (pick_crv->cuopen == SISL_CRV_PERIODIC)
	s1713(pick_crv,amin,amax,rcrv,&kstat);
     else
	s1712(pick_crv,amin,amax,rcrv,&kstat);
     
     if (kstat < 0) goto error;
     
     if (pt1->epar[index] > pt2->epar[index]) s1706(*rcrv); 

    }
  
  *jstat = 0;
  goto out;
  
  /* Error in input.  */
  errinp : *jstat = -1;
  s6err("pick_crv_sf",*jstat,kpos);
  goto out;

  /* Error in lower level routine.  */
  error : *jstat = kstat;
  s6err("pick_crv_sf",*jstat,kpos);
  goto out;
  
 out: if (pick_crv) freeCurve(pick_crv);
}


//===========================================================================
SISLIntsurf *newIntsurf (SISLIntlist * pintlist)
//===========================================================================
{
  SISLIntsurf *pnew = SISL_NULL;	/* Local pointer to instance to create. */
  SISLIntpt *qpt = SISL_NULL;	/* Local help pointer                   */
  SISLIntpt *qpfirst = SISL_NULL;	/* Local help pointer                   */
  SISLIntpt *qplast = SISL_NULL;	/* Local help pointer                   */
  SISLIntpt *qprev = SISL_NULL;	/* Local help pointer                   */
  SISLIntpt *qnext = SISL_NULL;	/* Local help pointer                   */
  int index, ipar, ipoint;
  int ki, kk, kdir;		/* Counter.                             */
  int dummy,kstat;
  double *stpar1, *stpar2;
  /* ------------------------------------------------------------------ */

  if (pintlist == SISL_NULL)
    goto out;

  qpfirst = pintlist->pfirst;
  qplast  = pintlist->plast;
  ipoint  = pintlist->inumb - 1;
  ipar    = qpfirst->ipar;
  index   = pintlist->ind_first;


  if (ipar <= 0)
    goto out;
  if (ipoint <= 1)
    goto out;

  /* Allocate space for instance of Intsurf. */
  pnew = newarray (1, SISLIntsurf);
  if (pnew == SISL_NULL)
    goto err101;

  pnew->ipar = ipar;
  pnew->ipoint = ipoint;

  /* First allocate space for parameter array. */
  pnew->epar = stpar1 = newarray (ipar * ipoint, DOUBLE);
  if (pnew->epar == SISL_NULL)
    goto err101;

  /* Allocate space for constant direction array. */
  /* UJK, sept 92 */
  /* pnew->const_par = newarray (ipar, int); */
  pnew->const_par = newarray (ipoint, int);
  if (pnew->const_par == SISL_NULL)
    goto err101;

  /* Fill in arrays */

  qpt = qprev = qpfirst;
  qnext = qpt->pnext[index];

    for (ki = 0; ki < ipoint; ki++)
    {
      qpt->marker = -99;
      stpar2 = qpt->epar;
      for (kk = 0; kk < ipar; kk++)
	*(stpar1++) = *(stpar2++);

      for (kdir = 0; kdir < ipar; kdir++)
	if (qpt->curve_dir[index] &
	    (1 << (kdir + 1)))
	  break;

      pnew->const_par[ki] = kdir;

      /* Next point */
      qprev = qpt;
      qpt = qnext;
      sh6getother (qpt, qprev, &qnext, &kstat);

      sh6getlist (qpt, qnext, &index, &dummy, &kstat);
    }

  /* Task done.  */


  goto out;

  /* Error in space allocation. Return zero. */

err101:pnew = SISL_NULL;
  goto out;

out:return (pnew);
}

//===========================================================================
void s1425(SISLSurf *ps1,int ider1,int ider2,int iside1,int iside2,double epar[],
	   int *ileft1,int *ileft2,double eder[],int *jstat)
//===========================================================================
{
  int kstat=0;        /* Local status variable.                          */
  int kpos=0;         /* The position of error.                          */
  int kn1,kn2;        /* The number of B-splines accociated with the knot
			 vectors st1 and st2.                            */
  int kn;	      /* Variable used for storing shorter version of knot
			 vector used by left hand derivatives */
  int kmult;	      /* Multiplicity of knot */
  int kk1,kk2;        /* The polynomial order of the surface in the two
			 directions.                                     */
  int kdim;           /* The dimension of the space in which the surface
			 lies. Equivalently, the number of components
			 of each B-spline coefficient.                   */
  int kder1,kder2;    /* Local versions of ider1 and ider2. Since
			 derivatives of order higher than kk1-1 and kk2-1,
			 respectively, are all zero, we set
			 kder1=min(kk1-1,ider1) and kder2=(kk2-1,ider2). */
  int kleft2,kleft1;  /* Local versions of ileft1 and ileft2 which are
			 used in order to avoid the pointers.            */
  int ki,kj,kih,kjh;  /* Control variables in for loops and for stepping
			 through arrays.                                 */
  int kh,kl,kl1,kl2;  /* Control variables in for loops and for stepping
			 through arrays.                                 */
  double *st1,*st2;   /* The knot vectors of the surface. These have
			 length [kn1+kk1] and [kn2+kk2],
			 respectively.                                   */
  double *scoef;      /* The B-spline coefficients of the surface.
			 This is an array of dimension [kn2*kn1*kdim].   */
  double tt;          /* Dummy variable used for holding an array element
			 in a for loop.                                  */
  double *ebder=SISL_NULL; /* Pointer to an array of dimension
			 [max(kk1*(ider1+1),kk2*(ider2+1))] which will
			 contain the values and ider first derivatives of
			 the kk1 (kk2) nonzero B-splines at epar[0] (epar[1]).
			 These are stored in the following order:
			 First the value, 1. derivative etc. of the
			 first nonzero B-spline, then the same for the
			 second nonzero B-spline and so on.              */
  
  double *ew=SISL_NULL;    /* Pointer to an array of dimension [kk1*(ider1+1)*kdim]
			 which will be used to store the result of the first
			 matrix multiplication in (2) above. This array is
			 initialized to all zeros.                       */
  double *sder=SISL_NULL;  /* Pointer to array used for storage of points, if
			 non rational sder points to eder, if rational sder
			 has to be allocated to make room for the homogenous
			 coordinate */
  
  double sdum1[49];   /* Arraye used for ebder */
  double sdum2[147];  /* Array used for ew */
  int knumb1;         /* Necessary size of ebder */   
  int knumb2;         /* Necessary size of ew */   
  
  kleft2 = *ileft2;
  kleft1 = *ileft1;
  
  /* Copy surface to local parameters.  */
  
  kn1 = ps1 -> in1;
  kn2 = ps1 -> in2;                                         
  kk1 = ps1 -> ik1;
  kk2 = ps1 -> ik2;
  st1 = ps1 -> et1;
  st2 = ps1 -> et2;
  kdim = ps1 -> idim;
  if (ps1->ikind == 2 || ps1->ikind == 4)
    {
      scoef = ps1 -> rcoef;
      kdim +=1;
      if((sder=newarray(kdim*(ider1+1)*(ider2+1),DOUBLE)) == SISL_NULL)
	goto err101;
    }
  else
    {
      scoef = ps1 -> ecoef;
      sder = eder;  
    }
  
  /* Check the input. */
  
  if (kdim < 1) goto err102;
  
  if (kk1 < 1) goto err115;
  
  if (kn1 < kk1 || kn2 < kk2) goto err116;
  
  if (ider1 < 0 || ider2 < 0) goto err178;
  
  if (st1[kk1-1] == st1[kk1] || st1[kn1-1] == st1[kn1]) goto err117;
  
  if (st2[kk2-1] == st2[kk2] || st2[kn2-1] == st2[kn2]) goto err117;
  
  kder1 = min(kk1-1,ider1);
  kder2 = min(kk2-1,ider2);
  
  /* Allocate space for B-spline values and derivatives and one work array. */
  
  knumb1 = max(kk1*(kder1+1),kk2*(kder2+1));
  
  /* ONly allocate ebder if sdum1 too small */
  
  if (knumb1>49)
  {
    if((ebder=newarray(knumb1,double)) == SISL_NULL) goto err101;
  }
  else
    {
      ebder = &sdum1[0];
      for (ki=0;ki<knumb1;ki++)
	ebder[ki] = DZERO;
    }
  
  if (ebder == SISL_NULL) goto err101;
  
  /* Only allocate ew if sdum2 too small */
  
  knumb2 = (kk1*(kder2+1)*kdim);
  if (knumb2>147)
  {
    if((ew=new0array(knumb2,double)) == SISL_NULL) goto err101;
  }
  else	
    { 
      ew = &sdum2[0];
      for (ki=0;ki<knumb2;ki++)
	sdum2[ki] = DZERO;
    }
  
  if (ew == SISL_NULL) goto err101;
  
  /* Set all the elements of sder to 0. */
  
  for (ki=0; ki<(ider2+1)*(ider1+1)*kdim; ki++) sder[ki] = DZERO;
  
  /* If the left hand derivative at epar[1] is to be calculated, this can be
     done by forgetting all polynomial segments starting in epar[1] or
     right of epar[1], thus the position of epar[1] in the knot vector is to be
     calculated */
  
  if (iside2<0)
  {
     /* Calculate last knot equal to or left of epar[1] */
     
     s1219(st2,kk2,kn2,&kleft2,epar[1],&kstat);
     if (kstat < 0) goto error;
		    
    
     if (st2[kn2] == epar[1])
	kmult = 0;
     else
     {
        kmult = s6knotmult(st2,kk2,kn2,&kleft2,epar[1],&kstat);
        if (kstat < 0) goto error;
     }
     
     kleft2 = MAX(kk2-1,kleft2 - kmult);		    
     kn = kleft2+1;
  }
  else
     kn = kn2;
  
  /* Compute the values and derivatives of the nonzero B-splines in the
     second parameter direction.                                        */
  
  s1220(st2,kk2,kn,&kleft2,epar[1],kder2,ebder,&kstat);
  
  if (kstat < 0) goto error;
  
  /* Update ileft1 (ileft2 was updated above, in s1220). */
  
  s1219(st1,kk1,kn1,&kleft1,epar[0],&kstat);
  if (kstat < 0) goto error;
    
   /* If the left hand derivative at epar[0] is to be calculated, this can be
     done by forgetting all polynomial segments starting in epar[0] or
     right of epar[0], thus the position of epar[0] in the knot vector 
     is to be calculated */
  
  if (iside1<0)
  {
     /* ileft1 already calculated */
     if (epar[0] == st1[kn1])
	kmult = 0;
     else
     {
	 kmult = s6knotmult(st1,kk1,kn1,&kleft1,epar[0],&kstat);
         if (kstat < 0) goto error;
     }
     
     kleft1 = MAX(kk1-1,kleft1-kmult);
     kn = kleft1 + 1;
  }
  else
     kn = kn1;
  
  /* Compute the first matrix product in (2) above. */
  
  /* ki steps through the appropriate kk2 rows of B-spline coefficients
     while kih steps through the B-spline value and derivatives for the
     B-spline given by ki.                                              */
  
  kih = 0;
  for (ki=kleft2-kk2+1; ki<=kleft2; ki++)
    {
      
      /* kj counts through the kder2+1 derivatives to be computed.
	 kjh steps through ew once for each ki to accumulate the contribution
	 from the different B-splines.
	 kl1 points to the first component of the first B-spline coefficient
	 in row no. ki of the B-spline coefficient matrix that multiplies
	 a nonzero B-spline in the first parameter direction.
	 */
      
      kjh = 0; kl1 = ki*kdim*kn1 + kdim*(kleft1-kk1+1);
      for (kj=0; kj<=kder2; kj++)
	{
	  
	  /* The value of the B-spline derivative is stored in tt while
	     kl2 steps through the kdim components of all the B-spline
	     coefficients that multiplies nonzero B-splines along st1. 
	     */
	  
	  tt = ebder[kih++]; kl2 = kl1;
	  for (kl=0; kl<kdim*kk1; kl++,kjh++,kl2++)
	    {
	      ew[kjh] += scoef[kl2]*tt;
	    }
	}
    }

  
  /* Compute the values and derivatives of the nonzero B-splines in the
     first parameter direction.                                        */
  
  s1220(st1,kk1,kn,&kleft1,epar[0],kder1,ebder,&kstat);         
  
  if (kstat < 0) goto error;
  
  /* Compute the remaining matrix product. */
  
  /* kh steps through the kder2+1 derivatives in the first parameter direction
     (the rows of ew if we image it as a kk1x(ider1+1) matrix with each element
     a kdim dimensional vector) while kl1 steps through the elements of ew
     (again considering each element to have kdim components).                   
     */
  
  kl1 = 0;
  for (kh=0; kh<=kder2; kh++)
    {
      
      /* ki steps through the kk1 columns of ew (corresponding to the columns
	 of scoef that multiply nonzero B-splines along st1), while kih
	 steps through the B-spline values and derivatives for the nonzero
	 B-splines along st1 (stored in ebder).
	 */
      
      kih = 0;
      for (ki=0; ki<kk1; ki++)
	{
	  
	  /* kj counts through the kder1+1 derivatives in the first
	     parameter direction (corresponding to the columns of sder).
	     kjh points to the row of sder corresponding to derivatives of
	     order kh in the second parameter direction (if sder is
	     considered a matrix with elements consisting of vectors with
	     kdim components.
	     */
	  
	  kjh = kh*(kder1+1)*kdim;
	  for (kj=0; kj<=kder1; kj++)
	    {
	      /* Pick out the current element of ebder.
		 kl2 steps through the kdim components of the (kh,ki)
		 element of ew.
		 */
	      
	      tt = ebder[kih++];
	      kl2 = kl1;
	      for (kl=0; kl<kdim; kl++,kjh++,kl2++)
		{
		  sder[kjh] += ew[kl2]*tt;
		}
	    }
	  kl1 += kdim;
	}
    }
  
  if (kder1 < ider1 || kder2 < ider2)
    
    /* The derivatives are not positioned in the right way in sder, 
       shift values into the right position 
       */
    
    for (kj=ider2 ; 0<=kj ; kj--)
      {
	for (ki=ider1 ; 0<=ki ; ki--)
	  {
	    if ( ki <= kder1 && kj <= kder2)
	      memcopy(sder+kdim*(ki+kj*(ider1+1)),sder+kdim*(ki+kj*(kder1+1)),
		      kdim,DOUBLE);
	    else
	      for (kl=0;kl<kdim;kl++)     
		*(sder+kdim*(ki+kj*(ider1+1))+kl) = DZERO;
	  }
      }
  /* Free memory. */
  
  /* If rational surface calculate the derivatives based on derivatives in
     homogenous coordinates */
  
  if (ps1->ikind == 2 || ps1->ikind == 4)
    {
      s6sratder(sder,ps1->idim,ider1,ider2,eder,&kstat);
      if (kstat<0) goto error;
      if(sder != SISL_NULL) freearray(sder);
    }
  
  /* Only free ew and ebder if the were allocated by newarray */
  
  if (knumb1 > 49)
    {
      if(ebder != SISL_NULL) freearray(ebder);
    }
  if (knumb2 > 147)
    {
      if(ew != SISL_NULL) freearray(ew);
    }
  
  /* Successful computations.  */
  
  *jstat = 0;
  goto out;
  
  /* Not enough memory. */
 err101: *jstat = -101;
  s6err("s1425",*jstat,kpos);
  goto out;
  
  /* kdim less than 1. */
 err102: *jstat = -102;
  s6err("s1425",*jstat,kpos);
  goto out;
  
  /* Polynomial order less than 1. */
 err115: *jstat = -115;
  s6err("s1425",*jstat,kpos);
  goto out;
  
  /* Fewer B-splines than the order. */
 err116: *jstat = -116;
  s6err("s1425",*jstat,kpos);
  goto out;
  
  /* Error in knot vector.
     (The first or last interval of one of the knot vectors is empty.) */
 err117: *jstat = -117;
  s6err("s1425",*jstat,kpos);
  goto out;
  
  /* Illegal derivative requested. */
 err178: *jstat = -178;
  s6err("s1425",*jstat,kpos);
  goto out;
  
  /* Error in lower level routine.  */
  
 error:  *jstat = kstat;
  s6err("s1425",*jstat,kpos);
  goto out;
  
 out: 
   *ileft2 = kleft2;
   *ileft1 = kleft1;
   return;
}



//===========================================================================
void s1422(SISLSurf *ps1,int ider,int iside1,int iside2,double epar[],int *ilfs,
	   int *ilft,double eder[],double enorm[],int *jstat)
//===========================================================================
{
  int kstat=0;        /* Local status variable.                          */
  int kpos=0;         /* Position of error.                              */
  int kdim;           /* Dimension of the space in which the surface lies. */
  int keder;          /* Integer used in address calculations on eder    */
  int ksp;            /* Integer used in address calculations on sp      */
  int kincre;         /* Increment for address calculations              */
  int ki,kl;          /* Control variables in for loop                   */
  int knumb;          /* Number of elements used for storage of deriv.s  */
  double *sp;         /* Pointer to temporary array                      */
  double sdum[48];    /* Array used in stead of allocation               */
  
  
  /* Allocate array for storage of ider*ider derivatives */
  
  sp = SISL_NULL;
  kdim = ps1 -> idim;
  knumb = kdim*(ider+1)*(ider+1);
  
  /* Only allocate space if sdum is too smaall */
  
  if (knumb>48)
    sp = newarray(knumb,DOUBLE);
  else
    sp = &sdum[0];
  
  if (sp == SISL_NULL) goto err101;
  
  
  /* Evaluate s1422surface.  */
  
  s1425(ps1,ider,ider,iside1,iside2,epar,ilfs,ilft,sp,&kstat);
  
  if (kstat < 0) goto error;
  
  /* Copy required derivatives into eder */
  
  kincre = kdim*ider;
  
  /*  Copy all derivatives of order 0, then of order 1, up to order ider */
  
  for (kl=0,keder=0;kl<=ider;kl++)
    {
      for (ki=0,ksp=kl*kdim ; ki<=kl ; ki++,ksp+=kincre,keder+=kdim)
        {
	  memcopy(eder+keder,sp+ksp,kdim,DOUBLE);
        }
    }
  
  /* Make cross products of tangents, if idim==3 and derivative >0 */
  
  if (ider>0 && kdim ==3)
    {
      double tlen1,tlen2,tnorm,tang=(double)0.0;
      
      s6crss(eder+kdim,eder+2*kdim,enorm);
      
      /*  Make length of tangents and normal */
      
      tlen1 = s6length(eder+kdim,kdim,&kstat);
      tlen2 = s6length(eder+2*kdim,kdim,&kstat);
      tnorm = s6length(enorm,kdim,&kstat);
      
      /*  Calculate angle between tangents */
      
      if (tlen1 != DZERO && tlen2 != DZERO && tnorm != DZERO)
        tang = tnorm/(tlen1*tlen2);
      
      if (tang == DZERO) *jstat = 2;
      else if (tang <= ANGULAR_TOLERANCE) *jstat = 1;   
      else *jstat = 0;
      goto out;
      
    }
  
  *jstat = 0;
  goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("s1422",*jstat,kpos);
  goto out;
  
 err101: *jstat = -101;
  s6err("s1422",*jstat,kpos);
  
  
 out:
  
  /* Free allocated space (Space only allocated if sdum is too small) */
  
  if (knumb>48)
    if (sp != SISL_NULL) freearray(sp);
  
  return;
}


//===========================================================================
void sh6evalint (SISLObject * ob1, SISLObject * ob2, double eimpli[], int ideg,
		 SISLIntpt * pt, double aepsge, double *curve_3d[], 
		 double *curve_2d_1[], double *curve_2d_2[], int *jstat)
//===========================================================================
{
  int dim;			/* Geometric dimension. */
  int kstat;
  int kpos = 1;			/* Position indicator ofr errors          */
  int left1 = 0, left2 = 0;	/* Knot navigators in s1421               */
  int kder = 2;			/* Numb of derivatives                    */
  int silhouett;		/* Flag silhouett case                    */
  int ki;			/* Variable used in loop                  */
  int ksize;			/* Size of output from s1421 or getgeom   */
  double *geom1 = SISL_NULL;		/* Output values from s1421 or getgeom    */
  double con_tang[3];		/* Constant tangent.                      */
  double *norm1 = SISL_NULL;		/* Output values from s1421 or getgeom    */
  double *geom2 = SISL_NULL;		/* Output values from s1421 or getgeom    */
  double *norm2 = SISL_NULL;		/* Output values from s1421 or getgeom    */
  double normimpl[3];		/* Normal of impl surf                    */
  double right_dir[3];		/* Right direction of 3D intersect. curve */
  double dot;			/* Scalar product */
  double dummy[6];
  double ang;
  double min_hp_ang = 0.00000000001;
  *jstat = 0;
  con_tang[0] = (double) 1.0;
  con_tang[1] = DZERO;
  con_tang[2] = DZERO;


  if (ob1->iobj != SISLSURFACE && ob1->iobj != SISLCURVE)
    goto errinp;
  if (!pt)
    goto errinp;
  if (ideg < 0)
    goto errinp;

  if (ob1->iobj == SISLSURFACE )
    dim = ob1->s1->idim;
  else
    dim = ob1->c1->idim;

  if (dim > 3 || dim < 1)
    goto errinp;

  *curve_3d = pt->geo_track_3d;
  *curve_2d_1 = pt->geo_track_2d_1;
  *curve_2d_2 = pt->geo_track_2d_2;

  if (pt->evaluated)
    goto out;

  if (ideg == 0)
    {
       /* No implicit geometry involved */
       kpos = 1;
       if (ob2->iobj != SISLSURFACE && ob2->iobj != SISLCURVE)
	 goto errinp;

       if (ob2->iobj == SISLCURVE)
	 {
	    /* At least the second object is a spline curve,
	       use this one */
	    kpos = 2;
	    if (ob2->c1->idim > 3) goto errinp;

	    /* Get geometry of first surface */
	    sh6getgeom (ob1, 1, pt, &geom1, &norm1, aepsge, &kstat);
	    if (kstat < 0)
	      goto error;

	    /* Get geometry of objects */
	    sh6getgeom (ob2, 2, pt, &geom2, &norm2, aepsge, &kstat);
	    if (kstat < 0)
	      goto error;

	    /* The number of elements to copy is given by pt->size_<obnr>
	       and we have obnr=2  (PFU 05/09-94) */
	    memcopy(*curve_3d,geom2,pt->size_2,double);

	 }
       else
	 {


	    /* Two 3d surfaces */
	    kpos = 3;
	    if (ob2->iobj != SISLSURFACE)
	      goto errinp;
	    if ((dim = ob2->s1->idim) != 3)
	      goto errinp;

	    /* Get geometry of first surface */
	    sh6getgeom (ob1, 1, pt, &geom1, &norm1, aepsge, &kstat);
	    if (kstat < 0)
	      goto error;

	    /* Get geometry of second surface */
	    sh6getgeom (ob2, 2, pt, &geom2, &norm2, aepsge, &kstat);
	    if (kstat < 0)
	      goto error;

	    /* Get normal direction */
	    s6crss (norm1, norm2, right_dir);
	    if (kstat < 0)
	      goto error;

	    /* Compute angle. */
	    ang = s6ang(norm1, norm2,3);
	    if (ang < min_hp_ang)
	    {
	       /* The point is a singular meeting point.*/
	       if (pt->iinter == SI_ORD) pt->iinter = SI_SING;
	    }

	    /* Get tangent and curvature */
	    s1304 (geom1, geom2, pt->epar, pt->epar + 2,
		   *curve_3d, *curve_2d_1, *curve_2d_2, &kstat);
	    if (kstat < 0)
	      goto error;

	    if ((dot = s6scpr (right_dir, *curve_3d + 3, 3)) < DZERO)
	      {
		 /* Change direction for tangent */
		 for (ki = 0; ki < 3; ki++)
		   (*curve_3d)[ki + 3] *= -(double) 1;
		 for (ki = 0; ki < 2; ki++)
		   {
		      (*curve_2d_1)[ki + 2] *= -(double) 1;
		      (*curve_2d_2)[ki + 2] *= -(double) 1;
		   }
	      }
	 }

       pt->evaluated = TRUE;
    }
  else
    {
       /* Implicit cases */
       if (ideg == 2000)
	 {
	    /* Here we treat the cases
	       spline surf vs implicit analytic curve
	       spline curve vs implicit analytic curve
	       spline curve vs implicit analytic surf
	       in all these cases only 3D posisition is necessary */

	    /* Clean up from 1D or 2D result */
	    if (pt->geo_data_1)
	      freearray (pt->geo_data_1);
	    if (pt->geo_data_2)
	      freearray (pt->geo_data_2);
	    pt->geo_data_1 = SISL_NULL;
	    pt->size_1 = 0;
	    pt->geo_data_2 = SISL_NULL;
	    pt->size_2 = 0;

	    /* Get the right values are computed */
	    sh6getgeom (ob1, 1, pt, &geom1, &norm1, aepsge, &kstat);
	    if (kstat < 0)
	      goto error;

     	    memcopy(*curve_3d,geom1,dim,double);
     	    memcopy((*curve_3d)+dim,con_tang,dim,double);

	 }
       else
	 {
	    if (ideg == 1003 || ideg == 1004 || ideg == 1005)
	      {
		 /* Silhouette cases, B-spline surface */
		 kpos = 3;
		 ksize = 33;
		 silhouett = TRUE;
		 kder = 3;

	      }
	    else
	      {
		 /* Analytic surf vs B-spline surface */

		 kpos = 4;
		 ksize = 21;
		 silhouett = FALSE;
		 kder = 2;
	      }

	    if (pt->size_1 != ksize)
	      {
		 /* Clean up from 1D result */
		 if (pt->geo_data_1)
		   freearray (pt->geo_data_1);
		 if (pt->geo_data_2)
		   freearray (pt->geo_data_2);
		 pt->geo_data_1 = SISL_NULL;
		 pt->size_1 = 0;
		 pt->geo_data_2 = SISL_NULL;
		 pt->size_2 = 0;


		 if ((pt->geo_data_1 = newarray (ksize, DOUBLE))
		     == SISL_NULL)
		   goto err101;
		 pt->size_1 = ksize;
		 geom1 = pt->geo_data_1;
		 norm1 = pt->geo_data_1 + ksize - 3;

		 s1422 (ob1->s1, kder, pt->iside_1, pt->iside_2,
			pt->epar, &left1, &left2, geom1,
			norm1, &kstat);
		 if (kstat < 0)
		   goto error;
	      }
	    else
	      {
		 /* The right values are computed */
		 sh6getgeom (ob1, 1, pt, &geom1, &norm1, aepsge, &kstat);
		 if (kstat < 0)
		   goto error;

	      }


	    /* Get normal of implicit surface */
	    s1331 (geom1, eimpli, ideg, kder = -1, dummy, normimpl, &kstat);
	    if (kstat < 0)
	      goto error;

	    /* Get the right direction of the intersection curve */
	    if (silhouett)
	      {
		 ang = 1.5; /* Not used */
		 memcopy (right_dir, normimpl, 3, DOUBLE);
		 for (ki=0;ki<3;ki++) right_dir[ki] *= -(double)1.0;
	      }
	    else
	    {
	       /* Compute angle. */
	       ang = s6ang(norm1, normimpl,3);
	       s6crss (norm1, normimpl, right_dir);
	    }

	    /* Get tangent and curvature to the real intersection. */
	    s1306 (geom1, pt->epar,
		   eimpli, ideg, *curve_3d, *curve_2d_1, &kstat);
	    if (kstat < 0)
	      goto error;
	    if (kstat == 2)
	    {
	       /* The point is a singular meeting point.*/
	       if (pt->iinter == SI_ORD) pt->iinter = SI_SING;
	    }
	    else if (kstat == 10)
	    {
	       /* The point is a singular non-meeting point.
		  Tangent found, but sign might be wrong. */
	       if (pt->iinter == SI_ORD || pt->iinter == SI_SING )
		  pt->iinter = SI_TOUCH;
	    }
	    else if (ang < min_hp_ang)
	    {
	       /* The point is a singular meeting point.*/
	       if (pt->iinter == SI_ORD) pt->iinter = SI_SING;
	    }
	    else
	    if ((dot = s6scpr (right_dir, *curve_3d + 3, 3)) < DZERO)
	      {
		 /* Change direction for tangent */
		 for (ki = 0; ki < 3; ki++)
		   (*curve_3d)[ki + 3] *= -(double) 1;
		 for (ki = 0; ki < 2; ki++)
		   (*curve_2d_1)[ki + 2] *= -(double) 1;

	      }
	 }


       pt->evaluated = TRUE;

    }

  *jstat = 0;
  goto out;

  /* ---------- ERROR EXITS --------------------------- */
  /* Error in alloc  */
  err101:
     *jstat = -101;
  s6err ("shevalint", *jstat, kpos);
  goto out;

  /* Error in lower level */
  error:
     *jstat = kstat;
  s6err ("shevalint", *jstat, kpos);
  goto out;

  /* Error in input */
  errinp:
     *jstat = -200;
  s6err ("shevalint", *jstat, kpos);
  goto out;


  out:;
}


//===========================================================================
void sh6idsplit (SISLIntdat ** pintdat, SISLIntpt * psource, int *jstat)
//===========================================================================
{
  int ki;			/* Counters.                         */
  int no_main;			/* No of neighbours (main points)    */
  int test= FALSE;              /* No equality testing when inserted
				   in pintdat                        */
  int kstat = 0;                /* Local status.                     */
  SISLIntpt *pneighb = SISL_NULL;	/* Current neighbour                 */
  SISLIntpt *pshadow = SISL_NULL;	/* Current copy of source point      */
  /* ------------------------------------------------*/
  
  *jstat = 0;
  
  if (psource == SISL_NULL)
    {
       *jstat = 1;
       goto out;
    }
  
  /* Get number of neighbours */
  no_main = sh6nmbmain (psource, &kstat);
  if (kstat < 0)
    goto error;
  
  for (ki=psource->no_of_curves - 1; no_main > 1; ki--)
    {
       pneighb = sh6getnext(psource, ki);
       if (!pneighb) goto error;
       if (sh6ismain(pneighb))
	 {
	    pshadow = hp_copyIntpt(psource);
	    sh6idnpt(pintdat, &pshadow, test=FALSE, &kstat);
	    if (kstat < 0) goto error;
	    
	    sh6insertpt(psource, pneighb, pshadow, &kstat);
	    if (kstat < 0) goto error;
	    
	    sh6disconnect(psource, pshadow, &kstat);
	    if (kstat < 0) goto error;
	    no_main--;
	 }
    }
  goto out;
  
  
error:
  *jstat = kstat;
  goto out;

out:;
}


//===========================================================================
void sh6gettophlp (SISLIntpt * pt, int pretop[4], int case_2d, int *jstat)
//===========================================================================
{
  int loc_top[4];
  int ki;

  *jstat = 0;

/* Check pt. */

  if (pt == SISL_NULL)
    goto err2;
/* Only help points are treated */
  if (sh6ishelp (pt) && pt->marker == 0)
    {
      /* To avoid infinite loops : */
      pt->marker = -10;

      sh6gettop (pt, 0, loc_top, loc_top + 1, loc_top + 2, loc_top + 3, jstat);
      if (*jstat < 0)
	goto out;

      if (case_2d)
      {
	 /* Spesial treatment 2D surf point */
	 for (ki=0; ki<4; ki++)
	    if (loc_top[ki] == SI_IN) pretop[ki] = SI_IN;
	    else if (loc_top[ki] == SI_OUT && pretop[ki] != SI_IN)
	       pretop[ki] = SI_OUT;
      }
      else
      {
	 /* Overrule ? */
	 for (ki = 0; ki < 4; ki++)
	    if ((pretop[ki] == SI_UNDEF ||
		 pretop[ki] == SI_ON) &&
		loc_top[ki] != SI_UNDEF &&
		loc_top[ki] != SI_ON)
	       pretop[ki] = loc_top[ki];
      }
      
      for (ki = 0; ki < pt->no_of_curves; ki++)
	sh6gettophlp (pt->pnext[ki],  pretop, case_2d, jstat);

      /* Data is set. */

    }


  goto out;


err2:
  /* Error in input. pt is SISL_NULL. */

  *jstat = -2;
  s6err ("sh6gettophlp", *jstat, 0);
  goto out;


out:
  return;
}

//===========================================================================
void sh1779_at (SISLObject * po1, SISLObject * po2, SISLIntpt * pintpt, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int kpar1, kpar2;		/* Index of parameter value of object.     */
  int kn;			/* Number of vertices of curve.            */
  int kk;			/* Order of curve.                         */
  int lleft[2];			/* Array storing pre-topology information. */
  int lright[2];		/* Array storing pre-topology information. */
  int *ll1, *ll2, *lr1, *lr2;	/* Pointers into pre-topology arrays.   */
  double tref;			/* Referance value in equality test.       */
  double *st;			/* Knot vector of curve.                   */
  double *sptpar = pintpt->epar;/* Pointer to parameter values of int.pt.  */
  SISLCurve *qc;		/* Pointer to the curve.                   */
  SISLSurf *qs;			/* Pointer to the surface.                 */
  double sf_low_lim[2];
  double sf_high_lim[2];
  /* ---------------------------------------------------------------------- */
  /* Don't make pretop for help points ! */
  if (sh6ishelp (pintpt))
    {
      *jstat = 0;
      goto out;
    }

  /* Set pointers into the arrays storing pre-topology information. */
  if (po1->iobj == SISLCURVE)
    {
      qc = po1->c1;
      qs = po2->s1;
      kpar1 = 0;
      kpar2 = 1;
      ll1 = lleft;
      lr1 = lright;
      ll2 = lleft + 1;
      lr2 = lright + 1;
    }
  else
    {
      qc = po2->c1;
      qs = po1->s1;

      kpar1 = 2;
      kpar2 = 0;
      ll1 = lleft + 1;
      lr1 = lright + 1;
      ll2 = lleft;
      lr2 = lright;
    }

  kk = qc->ik;
  kn = qc->in;
  st = qc->et;
  tref = st[kn] - st[kk - 1];

  sf_low_lim[0] = qs->et1[qs->ik1 - 1] + REL_COMP_RES;
  sf_low_lim[1] = qs->et2[qs->ik2 - 1] + REL_COMP_RES;
  sf_high_lim[0] = qs->et1[qs->in1] - REL_COMP_RES;
  sf_high_lim[1] = qs->et2[qs->in2] - REL_COMP_RES;

  sh6gettop (pintpt, -1, lleft, lright, lleft + 1, lright + 1, &kstat);
  if (kstat < 0)
    goto error;
  /* Check endpoint of curve. */

  if (DEQUAL (sptpar[kpar1] + tref, st[kk - 1] + tref))
    *ll1 = SI_AT;
  if (DEQUAL (sptpar[kpar1] + tref, st[kn] + tref))
    *lr1 = SI_AT;

  /* Update pre-topology of intersection point.  */
  sh6settop (pintpt, -1, lleft[0], lright[0], lleft[1], lright[1], &kstat);
  if (kstat < 0)
    goto error;

  *jstat = 0;
  goto out;

  /* Error lower level routine.  */
error:*jstat = kstat;
  goto out;

out:
  return;
}

//===========================================================================
void sh1780_at (SISLObject * po1, SISLObject * po2, SISLIntpt * pintpt, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int kk1, kk2;			/* Orders of the two curves.               */
  int kn1, kn2;			/* Number of vertices in the curves.       */
  int lleft[2];			/* Array storing pre-topology information. */
  int lright[2];		/* Array storing pre-topology information. */
  double tref;			/* Reference value in equality test.       */
  double *st1, *st2;		/* Pointers to knot vectors of curves.     */
  double *sptpar = pintpt->epar;/* Parameter array of int.pt.              */
  /* --------------------------------------------------------------------- */

  /* Don't make pretop for help points ! */
  if (sh6ishelp (pintpt))
    {
      *jstat = 0;
      goto out;
    }


  /* Express the curve by local parameters.  */

  kn1 = po1->c1->in;
  kk1 = po1->c1->ik;
  st1 = po1->c1->et;
  kn2 = po2->c1->in;
  kk2 = po2->c1->ik;
  st2 = po2->c1->et;
  tref = MAX (st1[kn1] - st1[kk1 - 1], st2[kn2] - st2[kk2 - 1]);

  /* Update pre-topology of intersection point.  */
  sh6gettop (pintpt, -1, lleft, lright, lleft + 1, lright + 1, &kstat);

  /* Change the pre-topology information if the intersection point
	 lies at an endpoint of the curves.    */
  if (DEQUAL (sptpar[0] + tref, st1[kn1] + tref))
    {
      lright[0] = SI_AT;
    }
  if (DEQUAL (sptpar[0] + tref, st1[kk1 - 1] + tref))
    {
      lleft[0] = SI_AT;
    }
  if (DEQUAL (sptpar[1] + tref, st2[kn2] + tref))
    {
      lright[1] = SI_AT;
    }
  if (DEQUAL (sptpar[1] + tref, st2[kk2 - 1] + tref))
    {
      lleft[1] = SI_AT;
    }

  /* Update pre-topology of intersection point.  */
  sh6settop (pintpt, -1, lleft[0], lright[0], lleft[1], lright[1], &kstat);
  if (kstat < 0)
    goto error;


  *jstat = 0;
  goto out;


  /* Error lower level routine.  */
error:*jstat = kstat;
  goto out;

out:
  return;
}


//===========================================================================
void sh1781_at (SISLObject * po1, SISLObject * po2, SISLIntpt * pintpt, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int kn;			/* Number of vertices of curve.            */
  int kk;			/* Order of curve.                         */
  int lleft[2];			/* Array storing pre-topology information. */
  int lright[2];		/* Array storing pre-topology information. */
  int *ll1, *ll2, *lr1, *lr2;	/* Pointers into pre-topology arrays.      */
  double *st;			/* Pointer to knot vector of curve.        */
  double *sptpar = pintpt->epar;/* Pointer to parameter array of int.pt.   */
  double tref;			/* Referance value in equality test.       */
  SISLCurve *qc;		/* Pointer to current curve.               */
  /* --------------------------------------------------------------------- */


  /* Don't make pretop for help points ! */
  if (sh6ishelp (pintpt))
    {
      *jstat = 0;
      goto out;
    }

  /* Set pointers into the arrays storing pre-topology information. */

  if (po1->iobj == SISLCURVE)
    {
      ll1 = lleft;
      lr1 = lright;
      ll2 = lleft + 1;
      lr2 = lright + 1;
    }
  else
    {
      ll1 = lleft + 1;
      lr1 = lright + 1;
      ll2 = lleft;
      lr2 = lright;
    }

  /* Get pre-topology information. */
  sh6gettop (pintpt, -1, lleft, lright, lleft + 1, lright + 1, &kstat);
  if (kstat < 0)
    goto error;

  /* Test dimension of geometry space. */
  if (po1->iobj == SISLCURVE)
    qc = po1->c1;
  else
    qc = po2->c1;

  /* Store curve information in local parameters. */
  kn = qc->in;
  kk = qc->ik;
  st = qc->et;
  tref = st[kn] - st[kk - 1];

  /* Test if the intersection point lies at an endpoint of
     the curve. */

  if (DEQUAL (sptpar[0] + tref, st[kn] + tref))
    *lr1 = SI_AT;
  if (DEQUAL (sptpar[0] + tref, st[kk - 1] + tref))
    *ll1 = SI_AT;

  /* Update pretopology of intersection point.  */

  sh6settop (pintpt, -1, lleft[0], lright[0], lleft[1], lright[1], &kstat);
  if (kstat < 0)
    goto error;

  *jstat = 0;
  goto out;


  /* Error lower level routine.  */
error:*jstat = kstat;
  goto out;

out:
  return;
}


//===========================================================================
void sh_set_at (SISLObject * po1, SISLObject * po2, SISLIntdat * pintdat, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int ki;			/* Counter.                                */
  int kdim;			/* Dimension of geometry space.            */
  SISLIntpt *qpt = SISL_NULL;	/* Pointer to intersection point.          */
  /* --------------------------------------------------------------------- */

  /* Init */
  *jstat = 0;

  /* Test if an intersection data structure exist.  */
  if (pintdat == SISL_NULL)
    goto out;


  /* Fetch dimension of geometry space. */
  if (po1->iobj == SISLPOINT)

    kdim = po1->p1->idim;
  else if (po1->iobj == SISLCURVE)
    kdim = po1->c1->idim;
  else
    kdim = po1->s1->idim;

  /* Treat only cases:
     crv vs pt 1D
     crv vs crv
     crv vs sf
     (?sf vs pt 2D)
     */

  if (!(((po1->iobj == SISLCURVE && po2->iobj >= SISLCURVE) ||
	 (po2->iobj == SISLCURVE && po1->iobj >= SISLCURVE)) ||
	(kdim == 1 && (po1->iobj + po2->iobj) == (SISLPOINT + SISLCURVE)) ||
	(kdim == 2 && (po1->iobj + po2->iobj) == (SISLPOINT + SISLSURFACE))))
    goto out;


  for (ki = 0; ki < (pintdat)->ipoint; ki++)
  {
     qpt = (pintdat)->vpoint[ki];

      /* Browse on the dimension of geometry space and the type of
         the input objects.     */

      if (kdim == 1 && ((po1->iobj == SISLCURVE && po2->iobj == SISLPOINT)
		     || (po2->iobj == SISLCURVE && po1->iobj == SISLPOINT)))
	{
	  /* Compute pre-topology in one-dimensional curve-level value
             intersection.            */

	  sh1781_at (po1, po2,qpt, &kstat);
	  if (kstat < 0)
	    goto error;
	}
      else if (po1->iobj == SISLCURVE && po2->iobj == SISLCURVE)
	{
	  /* curve-curve intersection.  */
	  sh1780_at (po1, po2, qpt, &kstat);
	  if (kstat < 0)
	    goto error;
	}
      else if (kdim == 3 &&
	       ((po1->iobj == SISLCURVE && po2->iobj == SISLSURFACE) ||
		(po1->iobj == SISLSURFACE && po2->iobj == SISLCURVE)))
	{
	  /* Surface-curve intersection in 3-dimensional geometry space. */

	  sh1779_at (po1, po2, qpt, &kstat);
	  if (kstat < 0)
	    goto error;
	}
    }

  /* Task performed.  */

  *jstat = 0;
  goto out;

  /* Error in lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
   return;
}


//===========================================================================
void sh6idlis (SISLObject * po1, SISLObject * po2, SISLIntdat ** pintdat,
	       double aepsge, int *jstat)
//===========================================================================
{
  int kstat;			/* Local status variable.          */
  int kpos = 0;			/* Position of error.              */
  int list_index = 0;		/* Counter                         */
  int knum = 0;			/* Counter                         */
  int indstart;			/* Indexes used in lists           */
  int indlast;			/* Indexes used in lists           */
  int ind1, ind2;
  int inddum;			/* Indexes used in lists           */
  int no_main = 0;		/* Counter                         */
  int ki1, ki2, ki, kj;		/* Counters                        */
  int r1, r2, l1, l2;		/* Pretopology info.		   */
  int ktype = 0;		/* To indicate type of list.       */
  int direction;		/* Direction of curve              */
  double *geom, *norm1, *norm2;	/* help pointers.		   */
  SISLIntpt *prev, *pcurr;	/* to traverse list of points.     */
  SISLIntpt *pnext, *pstart;	/* to traverse list of points.     */
  SISLIntpt *plast, *pother;	/* to traverse list of points.     */
  int pretop[4];
  int case_2d = 0;		/* Case flag, 2d Sf vs Pnt.        */
  int const_dir;		/* Reduction of internal points
				   along a constant parameter.     */
  int log_1, log_2;
  /* ------------------------------------------------------------- */

  /* If we do not have any intersection data we just return. */

  if ((*pintdat) == SISL_NULL)
    goto out;
  if ((po1->iobj == SISLSURFACE && po1->s1->idim == 2) ||
      (po2->iobj == SISLSURFACE && po2->s1->idim == 2))
    case_2d = TRUE;
  else
    case_2d = FALSE;

  /* We first destroy existing intersection lists. */

  for (kj = 0; kj < (*pintdat)->ilist; kj++)
    freeIntlist ((*pintdat)->vlist[kj]);

  /* Set SI_AT info in topology part */
  sh_set_at (po1, po2, *pintdat, &kstat);
  if (kstat < 0)
    goto error;

  
  
  /* Traverse all intersection points to get pretopology from help
     points */
  
  for (ki1 = 0; *pintdat && ki1 < (*pintdat)->ipoint; ki1++)
  {
     pcurr = (*pintdat)->vpoint[ki1];
     if (sh6ismain (pcurr))
     {
	sh6gettop (pcurr, 0, pretop, pretop + 1, pretop + 2, pretop + 3, &kstat);
	if (kstat < 0)
	   goto error;
	
	for (ki2 = 0; ki2 < pcurr->no_of_curves; ki2++)
	{
	   sh6gettophlp (pcurr->pnext[ki2], pretop, case_2d, &kstat);
	   if (kstat < 0)
	      goto error;
	}
	
	sh6settop (pcurr, 0, pretop[0], pretop[1], pretop[2], pretop[3], &kstat);
	if (kstat < 0)
	   goto error;
	
     }
  }
  
  
  /* Remove all internal points in a list when along a
     constant parameter direction */
  /* Remove all singularpoints that has exactly two 
     singular neighbours. */
  
  if ((po1->iobj == SISLSURFACE && po2->iobj == SISLPOINT
       && po1->s1->idim == 1) ||
      (po2->iobj == SISLSURFACE && po1->iobj == SISLPOINT
       && po2->s1->idim == 1) ||
      (po1->iobj == SISLSURFACE && po2->iobj == SISLSURFACE
       && po1->s1->idim == 3))
     const_dir = 2;
  else if ((po1->iobj == SISLSURFACE && po2->iobj == SISLCURVE) ||
	   (po1->iobj == SISLCURVE && po2->iobj == SISLSURFACE))
     const_dir = 1;
  else
     const_dir = 0;
  
  for (kj = 0; kj < (*pintdat)->ipoint; kj++)
  {
     
     pcurr = (*pintdat)->vpoint[kj];
     
     sh6getnhbrs (pcurr, &pstart, &plast, &kstat);
     if (kstat < 0)
	goto error;
     
     if (kstat == 0)
     {
	/* Two neighbours, check */
	sh6getlist (pcurr, pstart, &indstart, &inddum, &kstat);
	if (kstat < 0)
	   goto error;		/* Error. */
	if (kstat == 1)
	   goto errinconsist;	/* pcurr and pstart are not linked. */
	
	sh6getlist (pcurr, plast, &indlast, &inddum, &kstat);
	if (kstat < 0)
	   goto error;		/* Error. */
	if (kstat == 1)
	   goto errinconsist;	/* pcurr and plast are not linked. */
	
	log_1 = pcurr->curve_dir[indstart];
	log_1 = log_1>>1;
	log_1 &= 15;
	log_2 = pcurr->curve_dir[indlast];
	log_2 = log_2>>1;
	log_2 &= 15;
	
	
	if (const_dir == 0 || 
	    (log_1 & log_2 ) ||
	    (pcurr->iinter == SI_SING &&
	     pstart->iinter == SI_SING && plast->iinter == SI_SING))
	{
	   sh6idkpt (pintdat, &pcurr, 1, &kstat);
	   if (kstat < 0)
	      goto error;
	   /* Recursive nature : */
	   kj = -1;
	}
	
	
     }
  }
  
  /* -------------------------------------------- */
  if (const_dir > 1)
  {
     /* Split curves at points when change in curve_dir */
     for (kj = 0; kj < (*pintdat)->ipoint; kj++)
     {
	
	pcurr = (*pintdat)->vpoint[kj];
	
	sh6getnhbrs (pcurr, &pstart, &plast, &kstat);
	if (kstat < 0)
	   goto error;
	
	if (pcurr->iinter == SI_ORD && kstat == 0)
	{
	   /* Two neighbours, check */
	   sh6getlist (pcurr, pstart, &indstart, &inddum, &kstat);
	   if (kstat < 0)
	      goto error;		/* Error. */
	   if (kstat == 1)
	      goto errinconsist;	/* pcurr and pstart are not linked. */
	   
	   sh6getlist (pcurr, plast, &indlast, &inddum, &kstat);
	   if (kstat < 0)
	      goto error;		/* Error. */
	   if (kstat == 1)
	      goto errinconsist;	/* pcurr and plast are not linked. */
	   
	   log_1 = pcurr->curve_dir[indstart];
	   log_1 = log_1>>1;
	   log_1 &= 15;
	   log_2 = pcurr->curve_dir[indlast];
	   log_2 = log_2>>1;
	   log_2 &= 15;
	   
	   /* If both curve_dir is set as constant, this must be a singular
	      point, (remember internal points on same edge has been
	      removed! )*/
	   if (log_1 && log_2 ) pcurr->iinter = SI_SING;
	}
	
	
     }
  }
  
  /* -------------------------------------------- */
  
  if (const_dir > 1)
  {
     
     /* Split curves at corner points. This is put in to avoid
	problems for the marching.   */
     
     for (kj = 0; kj < (*pintdat)->ipoint; kj++)
     {
	
	pcurr = (*pintdat)->vpoint[kj];
	
	pcurr->marker = FALSE;
	if (pcurr->iinter == SI_ORD && sh6nmbmain(pcurr,&kstat) == 2)
	   
	{
	   sh6isinside(po1,po2,pcurr,&kstat);
	   
	   /* UJK, February 1993, Sometimes an intersection point on an edge is not
	      identified as singular. Therefore we split the curve at edges, 
	      if this is no natural ending (ie parallel pnt), 
	      int_join_per will join them. */
	   /* if (kstat == 3 || kstat == 4) */
	   
	   if (kstat < 0) goto error;
	   
	   if (kstat > 1) 
	   {
	      /* The point lies on a boarder. Mark it
		 achieve a split.  */
	      
	      /* UJK, aug 93, always mark singular in corners */
	      if (kstat == 3 || kstat == 4) pcurr->iinter = SI_SING;
	      pcurr->marker = TRUE;
	   }
	}
     }
  }
  
  
  if (const_dir > 1)
  {
     /* All previous trim points in a corner, must split it's neighbour if
	this lies on a corner */
     for (kj = 0; kj < (*pintdat)->ipoint; kj++)
     {
	
	pcurr = (*pintdat)->vpoint[kj];
	
	if (pcurr->iinter == SI_TRIM &&
	    sh6nmbmain (pcurr, &kstat) == 1)
	{
	   sh6isinside (po1, po2, pcurr, &kstat);
	   if (kstat == 3 || kstat == 4)
	   {
	      sh6getnhbrs (pcurr, &pstart, &plast, &kstat);
	      if (kstat < 0)
		 goto error;
	      if (pstart->iinter == SI_TRIM)
	      {
		 sh6isinside (po1, po2, pstart, &kstat);
		 if (kstat == 3 || kstat == 4)
		 {
		    
		    pstart->iinter = SI_SING;
		    
		    /* Recursive nature : */
		    kj = -1;
		 }
	      }
	   }
	}
     }
  }
  
  /* April 92, we need one instanse of each end point. This
     because of the storing of geometric data in the points
     that is in some cases contex dependent (mirroring
     in singular situation or translation of parameter space 
     values in periodicity treatment).
     We identify junction points and make a copy
     for each branch. */
  for (ki1 = 0; *pintdat && ki1 < (*pintdat)->ipoint; ki1++)
  {
     pcurr = (*pintdat)->vpoint[ki1];
     if (sh6ismain (pcurr))
     {
	/* Get number of neighbours */
	no_main = sh6nmbmain (pcurr, &kstat);
	if (kstat < 0)
	   goto error;
	
	if (pcurr->marker ||
	    (no_main == 2 && pcurr->iinter == SI_SING) ||
	    no_main > 2)
	{
	   if (pcurr->iinter == SI_ORD && no_main > 2) 
	      pcurr->iinter = SI_SING;
	   sh6idsplit(pintdat, pcurr, &kstat);
	   if (kstat < 0) goto error;
	}
     }
  }
  /* End of split */
  
  /* Traverse all intersection points, mark all main points */
  for (ki1 = 0; *pintdat && ki1 < (*pintdat)->ipoint; ki1++)
     if (sh6ismain ((*pintdat)->vpoint[ki1]))
     {
	/* Get number of neighbours */
	(*pintdat)->vpoint[ki1]->marker =
	   sh6nmbmain ((*pintdat)->vpoint[ki1], &kstat);
	if (kstat < 0)
	   goto error;
     }
     else
	(*pintdat)->vpoint[ki1]->marker = 0;
     
     
     /* Traverse all intersection points to look for
	start points to lists. If a point has only one neighbour,
	or is SI_SING or has more than two neighbours,
	it is a start or end point. */
     
     for (ki1 = 0; *pintdat && ki1 < (*pintdat)->ipoint; ki1++)
	if ((*pintdat)->vpoint[ki1]->marker > 0)
	{
	   /* Get number of neighbours */
	   no_main = sh6nmbmain ((*pintdat)->vpoint[ki1], &kstat);
	   if (kstat < 0)
	      goto error;
	   
	   if (no_main == 1 ||
	       (no_main == 2 && (*pintdat)->vpoint[ki1]->iinter == SI_SING) ||
	       no_main > 2)
	   {
	      pstart = (*pintdat)->vpoint[ki1];
	      
	      for (ki2 = 0; ki2 < pstart->no_of_curves; ki2++)
		 if (sh6ismain (pstart->pnext[ki2]) &&
		     pstart->pnext[ki2]->marker)
		 {
		    pcurr = pstart->pnext[ki2];
		    prev = pstart;
		    knum = 1;
		    
		    /* Get first index */
		    sh6getlist (pstart, pcurr, &indstart, &inddum, &kstat);
		    
		    while (pcurr)
		    {
		       /* Remember index */
		       sh6getlist (prev, pcurr, &inddum, &indlast, &kstat);
		       
		       prev->marker--;
		       pcurr->marker--;
		       sh6getother (pcurr, prev, &pnext, &kstat);
		       if (kstat < 0)
			  goto error;
		       
		       prev = pcurr;
		       pcurr = pnext;
		       knum++;
		    }
		    
		    /* Create list */
		    /* To be sure that list array is big enough. */
		    
		    if (list_index == (*pintdat)->ilmax)
		    {
		       (*pintdat)->ilmax += 20;
		       
		       if (((*pintdat)->vlist =
			    increasearray ((*pintdat)->vlist, (*pintdat)->ilmax,
					   SISLIntlist *)) == SISL_NULL)
			  goto err101;
		    }
		    
		    /* Type setting may be done in s1880? */
		    ktype = 0;
		    
		    /* Making a new list structure. */
		    if (((*pintdat)->vlist[list_index] =
			 newIntlist (pstart, prev, ktype)) == SISL_NULL)
		       goto err101;
		    (*pintdat)->vlist[list_index]->inumb = knum;
		    (*pintdat)->vlist[list_index]->ind_first = indstart;
		    (*pintdat)->vlist[list_index]->ind_last = indlast;
		    list_index++;
		    
		    
		    
		 }
	   }
	}
     
     /* Only closed list left */
     for (ki1 = 0; *pintdat && ki1 < (*pintdat)->ipoint; ki1++)
	if ((*pintdat)->vpoint[ki1]->marker > 0)
	{
	   /* Get number of neighbours */
	   no_main = sh6nmbmain ((*pintdat)->vpoint[ki1], &kstat);
	   if (kstat < 0)
	      goto error;
	   
	   
	   if (no_main == 2)
	   {
	      pstart = prev = (*pintdat)->vpoint[ki1];
	      
	      sh6getnhbrs (prev, &pcurr, &pnext, &kstat);
	      if (kstat < 0 || pcurr == SISL_NULL)
		 goto error;
	      knum = 1;
	      
	      /* Get first index */
	      sh6getlist (prev, pcurr, &indstart, &inddum, &kstat);
	      
	      /* Get last index */
	      sh6getlist (prev, pnext, &indlast, &inddum, &kstat);
	      
	      
	      
	      while (pcurr && pcurr != pstart)
	      {
		 prev->marker = 0;
		 
		 sh6getother (pcurr, prev, &pnext, &kstat);
		 if (kstat < 0)
		    goto error;
		 
		 prev = pcurr;
		 pcurr = pnext;
		 knum++;
	      }
	      prev->marker = 0;
	      if (pcurr == pstart)
	      {
		 /* It really is a closed curve */
		 knum++;
		 prev = pstart;
	      }
	      else
		 goto errinconsist;
	      
	      /* Create list */
	      /* To be sure that list array is big enough. */
	      
	      if (list_index == (*pintdat)->ilmax)
	      {
		 (*pintdat)->ilmax += 20;
		 
		 if (((*pintdat)->vlist =
		      increasearray ((*pintdat)->vlist, (*pintdat)->ilmax,
				     SISLIntlist *)) == SISL_NULL)
		    goto err101;
	      }
	      
	      /* Type setting may be done in s1880? */
	      ktype = 0;
	      
	      /* Making a new list structure. */
	      if (((*pintdat)->vlist[list_index] =
		   newIntlist (pstart, prev, ktype)) == SISL_NULL)
		 goto err101;
	      (*pintdat)->vlist[list_index]->inumb = knum;
	      (*pintdat)->vlist[list_index]->ind_first = indstart;
	      (*pintdat)->vlist[list_index]->ind_last = indlast;
	      list_index++;
	      
	      
	   }
	}
     
     
     (*pintdat)->ilist = list_index;
     
     
     /* If direction of a list is wrong, turn it. */
     
     for (kj = 0; kj < (*pintdat)->ilist; kj++)
     {
	knum = (*pintdat)->vlist[kj]->inumb;
	indstart = (*pintdat)->vlist[kj]->ind_first;
	
	pcurr = (*pintdat)->vlist[kj]->pfirst;
	plast = (*pintdat)->vlist[kj]->plast;
	pnext = (*pintdat)->vlist[kj]->pfirst->pnext[indstart];
	direction = (*pintdat)->vlist[kj]->pfirst->curve_dir[indstart];
	
	(*pintdat)->vlist[kj]->pretop[0] = SI_UNDEF;
	(*pintdat)->vlist[kj]->pretop[1] = SI_UNDEF;
	(*pintdat)->vlist[kj]->pretop[2] = SI_UNDEF;
	(*pintdat)->vlist[kj]->pretop[3] = SI_UNDEF;
	
	
	while (pnext != plast)
	{
	   if (direction)
	      break;
	   
	   sh6getother (pnext, pcurr, &pother, &kstat);
	   if (kstat < 0)
	      goto error;
	   sh6getlist (pnext, pother, &ind1, &ind2, &kstat);
	   if (kstat < 0)
	      goto error;
	   direction = pnext->curve_dir[ind1];
	   pcurr = pnext;
	   pnext = pother;
	}
	
	if (direction < 0)
	{
	   pcurr = (*pintdat)->vlist[kj]->pfirst;
	   (*pintdat)->vlist[kj]->pfirst = (*pintdat)->vlist[kj]->plast;
	   (*pintdat)->vlist[kj]->plast = pcurr;
	   
	   inddum = (*pintdat)->vlist[kj]->ind_first;
	   (*pintdat)->vlist[kj]->ind_first = (*pintdat)->vlist[kj]->ind_last;
	   (*pintdat)->vlist[kj]->ind_last = inddum;
	   indstart = (*pintdat)->vlist[kj]->ind_first;
	}
	
	/* Set pretopology information. */
	/* Traverse the list */
	
	if ((po1->iobj == SISLSURFACE && po2->iobj == SISLPOINT
	     && po1->s1->idim == 1) ||
	    (po2->iobj == SISLSURFACE && po1->iobj == SISLPOINT
	     && po2->s1->idim == 1) ||
	    (po1->iobj == SISLSURFACE && po2->iobj == SISLSURFACE
	     && po1->s1->idim == 3))
	{
	   pstart = prev = (*pintdat)->vlist[kj]->pfirst;
	   plast = (*pintdat)->vlist[kj]->plast;
	   
	   if ((pstart->edge_1 && plast->edge_1) ||
	       (pstart->edge_2 && plast->edge_2))
	   {
	      l1 = SI_IN;
	      r1 = SI_OUT;
	      l2 = SI_OUT;
	      r2 = SI_IN;
	      
	      if (plast->edge_1 == SI_RIGHT)
		 r1 = SI_AT;
	      else if (plast->edge_1 == SI_LEFT)
		 l1 = SI_AT;
	      
	      if (plast->edge_2 == SI_RIGHT)
		 r2 = SI_AT;
	      else if (plast->edge_2 == SI_LEFT)
		 l2 = SI_AT;
	      
	      (*pintdat)->vlist[kj]->pretop[0] = l1;
	      (*pintdat)->vlist[kj]->pretop[1] = r1;
	      (*pintdat)->vlist[kj]->pretop[2] = l2;
	      (*pintdat)->vlist[kj]->pretop[3] = r2;
	      
	   }
	   
	   else
	   {
	      
	      r1 = r2 = l1 = l2 = 0;
	      pcurr = sh6getnext (prev, indstart);
	      
	      /* UJK,Does not work
		 while (pcurr != plast) */
	      while (0)
	      {
		 if (sh6nmbhelp (pcurr, &kstat))
		 {
		    if (pcurr->left_obj_1[0] == pcurr->right_obj_1[0] &&
			pcurr->left_obj_1[0] != 0 && r1 == 0)
		    {
		       l1 = r1 = pcurr->left_obj_1[0];
		       if (po1->iobj == 2 && po2->iobj == 2 && po1->s1->idim == 3)
		       {
			  sh6getgeom (po1, 1, pcurr, &geom, &norm1, aepsge, &kstat);
			  if (kstat < 0)
			     goto error;
			  sh6getgeom (po2, 2, pcurr, &geom, &norm2, aepsge, &kstat);
			  if (kstat < 0)
			     goto error;
			  
			  if (s6scpr (norm1, norm2, 3) < 0.0)
			     l2 = r2 = l1;
			  else
			     l2 = r2 = (l1 == SI_IN ? SI_OUT : SI_IN);
		       }
		       else
			  l2 = r2 = (l1 == SI_IN ? SI_OUT : SI_IN);
		       
		       break;
		    }
		    
		    if (pcurr->left_obj_2[0] == pcurr->right_obj_2[0] &&
			pcurr->left_obj_2[0] != 0 && r2 == 0)
		    {
		       l2 = r2 = pcurr->left_obj_2[0];
		       if (po1->iobj == 2 && po2->iobj == 2 && po1->s1->idim == 3)
		       {
			  sh6getgeom (po1, 1, pcurr, &geom, &norm1, aepsge, &kstat);
			  if (kstat < 0)
			     goto error;
			  sh6getgeom (po2, 2, pcurr, &geom, &norm2, aepsge, &kstat);
			  if (kstat < 0)
			     goto error;
			  
			  if (s6scpr (norm1, norm2, 3) < 0.0)
			     l1 = r1 = l2;
			  else
			     l1 = r1 = (l2 == SI_IN ? SI_OUT : SI_IN);
		       }
		       else
			  l1 = r1 = (l2 == SI_IN ? SI_OUT : SI_IN);
		       
		       break;
		    }
		 }
		 else if (kstat < 0)
		    goto error;
		 
		 
		 sh6getother (pcurr, prev, &pnext, &kstat);
		 if (kstat < 0)
		    goto error;
		 
		 prev = pcurr;
		 pcurr = pnext;
	      }
	      if (r1 == 0)
	      {
		 l1 = SI_IN;
		 r1 = SI_OUT;
		 l2 = SI_OUT;
		 r2 = SI_IN;
	      }
	      
	      
	      (*pintdat)->vlist[kj]->pretop[0] = l1;
	      (*pintdat)->vlist[kj]->pretop[1] = r1;
	      (*pintdat)->vlist[kj]->pretop[2] = l2;
	      (*pintdat)->vlist[kj]->pretop[3] = r2;
	      
	      prev = pstart;
	      pcurr = sh6getnext (prev, indstart);
	      sh6getlist (prev, pcurr, &ind1, &ind2, &kstat);
	      if (kstat < 0)
		 goto error;
	      
	      for (ki = 0; ki < knum; ki++)
	      {
		 sh6settop (prev, ind1, l1, r1, l2, r2, &kstat);
		 if (!pcurr)
		    break;
		 sh6settop (pcurr, ind2, l1, r1, l2, r2, &kstat);
		 sh6getother (pcurr, prev, &pnext, &kstat);
		 if (kstat < 0)
		    goto error;
		 prev = pcurr;
		 pcurr = pnext;
		 sh6getlist (prev, pcurr, &ind1, &ind2, &kstat);
		 if (kstat < 0)
		    goto error;
	      }
	   }
	}
	
	else if ((po1->iobj == SISLCURVE && po2->iobj == SISLPOINT) ||
		 (po2->iobj == SISLCURVE && po1->iobj == SISLPOINT))
	   
	{
	   /* Curve point cases */
	   
	   (*pintdat)->vlist[kj]->pretop[0] =
	      (*pintdat)->vlist[kj]->pfirst->left_obj_1[0];
	   (*pintdat)->vlist[kj]->pretop[1] =
	      (*pintdat)->vlist[kj]->plast->right_obj_1[0];
	   (*pintdat)->vlist[kj]->pretop[2] =
	      (*pintdat)->vlist[kj]->pfirst->left_obj_2[0];
	   (*pintdat)->vlist[kj]->pretop[3] =
	      (*pintdat)->vlist[kj]->plast->right_obj_2[0];
	}
	
	else if (po1->iobj == SISLCURVE && po2->iobj == SISLCURVE)
	{
	   
	   /* Curve curve cases */
	   if ((*pintdat)->vlist[kj]->pfirst->epar[0] <=
	       (*pintdat)->vlist[kj]->plast->epar[0])
	   {
	      (*pintdat)->vlist[kj]->pretop[0] =
		 (*pintdat)->vlist[kj]->pfirst->left_obj_1[0];
	      (*pintdat)->vlist[kj]->pretop[1] =
		 (*pintdat)->vlist[kj]->plast->right_obj_1[0];
	   }
	   else
	   {
	      (*pintdat)->vlist[kj]->pretop[0] =
		 (*pintdat)->vlist[kj]->plast->left_obj_1[0];
	      (*pintdat)->vlist[kj]->pretop[1] =
		 (*pintdat)->vlist[kj]->pfirst->right_obj_1[0];
	   }
	   
	   if ((*pintdat)->vlist[kj]->pfirst->epar[1] <=
	       (*pintdat)->vlist[kj]->plast->epar[1])
	   {
	      (*pintdat)->vlist[kj]->pretop[2] =
		 (*pintdat)->vlist[kj]->pfirst->left_obj_2[0];
	      (*pintdat)->vlist[kj]->pretop[3] =
		 (*pintdat)->vlist[kj]->plast->right_obj_2[0];
	   }
	   else
	   {
	      (*pintdat)->vlist[kj]->pretop[2] =
		 (*pintdat)->vlist[kj]->plast->left_obj_2[0];
	      (*pintdat)->vlist[kj]->pretop[3] =
		 (*pintdat)->vlist[kj]->pfirst->right_obj_2[0];
	   }
	}
	
	else if ((po1->iobj == SISLSURFACE && po2->iobj == SISLCURVE
		  && po1->s1->idim == 3))
	{
	   
	   /* Suface curve case */
	   
	   (*pintdat)->vlist[kj]->pretop[0] =
	      (*pintdat)->vlist[kj]->pfirst->left_obj_1[0];
	   (*pintdat)->vlist[kj]->pretop[1] =
	      (*pintdat)->vlist[kj]->plast->right_obj_1[0];
	   
	   if ((*pintdat)->vlist[kj]->pfirst->epar[2] <=
	       (*pintdat)->vlist[kj]->plast->epar[2])
	   {
	      (*pintdat)->vlist[kj]->pretop[2] =
		 (*pintdat)->vlist[kj]->pfirst->left_obj_2[0];
	      (*pintdat)->vlist[kj]->pretop[3] =
		 (*pintdat)->vlist[kj]->plast->right_obj_2[0];
	   }
	   else
	   {
	      (*pintdat)->vlist[kj]->pretop[2] =
		 (*pintdat)->vlist[kj]->plast->left_obj_2[0];
	      (*pintdat)->vlist[kj]->pretop[3] =
		 (*pintdat)->vlist[kj]->pfirst->right_obj_2[0];
	   }
	   
	}
	
	else if ((po1->iobj == SISLCURVE && po2->iobj == SISLSURFACE
		  && po1->c1->idim == 3))
	{
	   
	   /* Curve suface case */
	   
	   if ((*pintdat)->vlist[kj]->pfirst->epar[0] <=
	       (*pintdat)->vlist[kj]->plast->epar[0])
	   {
	      (*pintdat)->vlist[kj]->pretop[0] =
		 (*pintdat)->vlist[kj]->pfirst->left_obj_1[0];
	      (*pintdat)->vlist[kj]->pretop[1] =
		 (*pintdat)->vlist[kj]->plast->right_obj_1[0];
	   }
	   else
	   {
	      (*pintdat)->vlist[kj]->pretop[0] =
		 (*pintdat)->vlist[kj]->plast->left_obj_1[0];
	      (*pintdat)->vlist[kj]->pretop[1] =
		 (*pintdat)->vlist[kj]->pfirst->right_obj_1[0];
	   }
	   
	   (*pintdat)->vlist[kj]->pretop[2] =
	      (*pintdat)->vlist[kj]->pfirst->left_obj_2[0];
	   (*pintdat)->vlist[kj]->pretop[3] =
	      (*pintdat)->vlist[kj]->plast->right_obj_2[0];
	   
	}
     }
     
     
     
     
     *jstat = 0;
     goto out;
     
     /* ------------------------------------------------------ */
     errinconsist:
	*jstat = -500;
     s6err ("sh6idlis", *jstat, kpos);
     goto out;
     
     err101:
	*jstat = -101;
     s6err ("sh6idlis", *jstat, kpos);
     goto out;
     
     error:
	*jstat = kstat;
     s6err ("sh6idlis", *jstat, kpos);
     goto out;
     
     out:
	;
}


//===========================================================================
void sh6idunite (SISLIntdat ** intdat, SISLIntpt ** pt1, SISLIntpt ** pt2,
		 double weight, int *jstat)
//===========================================================================
{
  int ki, kstat;
  SISLIntpt *lpt;
  SISLIntpt *lpt1;
  SISLIntpt *lpt2;

  sh6idnpt (intdat, pt1, 0, &kstat);
  if (kstat < 0)
    goto error;
  sh6idnpt (intdat, pt2, 0, &kstat);
  if (kstat < 0)
    goto error;

  if (sh6ismain (*pt1))
    {
      lpt1 = (*pt1);
      lpt2 = (*pt2);
    }
  else
    {
      lpt1 = (*pt2);
      lpt2 = (*pt1);
      weight = 1.0 - weight;
    }

  sh6disconnect (lpt1, lpt2, &kstat);
  if (kstat < 0)
    goto error;

  /* UJK, Oct. 91 */
  /* for (ki=0;;ki++) */
  for (ki = 0;;)
    {
      if ((lpt = sh6getnext (lpt2, ki)) == SISL_NULL)
	break;

      sh6disconnect (lpt2, lpt, &kstat);
      if (kstat < 0)
	goto error;


      sh6connect (lpt1, lpt, &kstat);
      if (kstat < 0)
	goto error;
    }

  for (ki = 0; ki < lpt1->ipar; ki++)
    lpt1->epar[ki] = lpt1->epar[ki] * (1.0 - weight) + lpt2->epar[ki] * weight;

  sh6idkpt (intdat, &lpt2, 0, &kstat);
  if (kstat < 0)
    goto error;

  (*pt1) = lpt1;
  (*pt2) = lpt2;

  goto out;

error:
  *jstat = kstat;
  s6err ("sh6idunite", kstat, 0);
  goto out;
out:
  ;
}



//===========================================================================
void sh6edgred (SISLObject * po1, SISLObject * po2,
		SISLIntdat * pintdat, int *jstat)
//===========================================================================
{
  int kstat, gstat, i, ki;
  int change = FALSE;
  int change_2 = FALSE;
  int num = 0;
  SISLIntpt *pt1 = SISL_NULL;
  SISLIntpt *pt2 = SISL_NULL;
  SISLIntpt *pcurr = SISL_NULL;

  if (pintdat != SISL_NULL)
    {
      do
	{
	  change_2 = FALSE;
	  /* If trim point is internal and one neighbours, change to help
	     point, if two neighbours unite till one of them */
	  do
	    {
	      change = FALSE;
	      for (i = 0; i < pintdat->ipoint; i++)
		{
		  pcurr = pintdat->vpoint[i];
		  if (pcurr->iinter == SI_TRIM)
		    {
		      sh6isinside (po1, po2, pcurr, &kstat);
		      if (kstat < 0)
			goto error;
		      if (kstat == 1)
			{
			  num = sh6nmbmain (pcurr, &kstat);
			  if (kstat < 0)
			    goto error;
			  if (num == 1)
			    {
			      sh6tohelp (pcurr, &kstat);
			      change = TRUE;
			    }
			  else if (num == 2)
			    {
			      sh6getnhbrs (pcurr, &pt1, &pt2, &gstat);
			      if (kstat < 0)
				goto error;
			      if (pt1->iinter == SI_TRIM &&
				  pt2->iinter == SI_TRIM)
				{
				  sh6idunite (&pintdat, &pt1, &pcurr,
					      DZERO, &kstat);
				  if (kstat < 0)
				    goto error;
				  change = TRUE;
				}
			    }
			}
		    }
		}
	  } while (change);


	  /* For a trim point on the edge with only one trim
             neighbour on an edge, unit till the other edge
             neighbour and change status of neighbour*/
	  do
	    {
	      change = FALSE;
	      for (i = 0; i < pintdat->ipoint; i++)
		{
		  pt1 = pt2 = SISL_NULL;
		  pcurr = pintdat->vpoint[i];
		  if (pcurr->iinter == SI_TRIM)
		    {
		      sh6isinside (po1, po2, pcurr, &kstat);
		      if (kstat < 0)
			goto error;
		      if (kstat == 2)
			{
			  for (ki = 0; ki < pcurr->no_of_curves; ki++)
			    {
			      pt1 = pcurr->pnext[ki];
			      if (pt1->iinter == SI_TRIM)
				{
				  sh6comedg (po1, po2, pcurr, pt1, &kstat);
				  if (kstat < 0)
				    goto error;
				    if (kstat)
				    {
				       if (pt2)
					  {
					     pt2 = SISL_NULL;
					     break;
					  }
					  else
					  pt2 = pt1;
				    }
				}
			    }
			  if (pt2)
			    {
			       /* sh6idunite (&pintdat, &pt2, &pcurr,
				              DZERO, &kstat);  */
			       /* UJK, 12.08.93  */
			      /* sh6idkpt (&pintdat, &pcurr, 1, &kstat);
			     sh6disconnect(pcurr,pt2,&kstat); */
			     pcurr->iinter = SI_SING;

			      /*------------------- */
			      /* If no trim neighbours on common
			         edge, remove trim status. */
			      pcurr = pt2;
			      kstat = 0;

			      for (ki = 0; ki < pcurr->no_of_curves; ki++)
				{
				  pt1 = pcurr->pnext[ki];
				  if (pt1->iinter == SI_TRIM)
				    {
				      sh6comedg (po1, po2, pcurr, pt1, &kstat);
				      if (kstat < 0)
					goto error;
				      if (kstat)
					break;

				    }

				}
			      /* -------------------- */
			      if (!kstat)
				pcurr->iinter = SI_SING;
			      change = TRUE;
			      change_2 = TRUE;
			    }

			}

		    }
		}
	  } while (change);
      } while (change_2);


      /* Reduce internal stuff */
      sh6red (po1, po2, pintdat, &kstat);
      if (kstat < 0)
	goto error;


      /* General edge treatment */

      /* UJK, aug 93, spesial branch for crv/crv */
      if (po1->iobj == SISLCURVE &&
	  po2->iobj == SISLCURVE )
      {
	 do
	 {
	    change = 0;
	    for (i = 0; i < pintdat->ipoint; i++)
	    {
	       if (sh6ismain (pintdat->vpoint[i]))
	       {
		  sh6getnhbrs (pintdat->vpoint[i], &pt1, &pt2, &gstat);
		  if (gstat == 1)
		  {
		     double parval;
		     SISLCurve *pcu=SISL_NULL;
		     if (pintdat->vpoint[i]->epar[0] == pt1->epar[0])
		     {
			parval = pintdat->vpoint[i]->epar[1];
			pcu    = po2->c1;
		     }
		     else if (pintdat->vpoint[i]->epar[1] == pt1->epar[1])
		     {
			parval = pintdat->vpoint[i]->epar[0];
			pcu    = po1->c1;
		     }
		     
		     if (pcu &&
			 parval > pcu->et[pcu->ik-1] &&
			 parval < pcu->et[pcu->in] )
			
			
		     {
			sh6tohelp (pintdat->vpoint[i], &kstat);
			if (kstat < 0)
			   goto error;
			change = 1;
		     }
		  }
	       }
	    }
	 } while (change);
      }
      else 
      { 
	 do
	 {
	    change = 0;
	    for (i = 0; i < pintdat->ipoint; i++)
	    {
	       if (sh6ismain (pintdat->vpoint[i]))
	       {
		  sh6isinside (po1, po2, pintdat->vpoint[i], &kstat);
		  if (kstat < 0)
		     goto error;
		  
		  /* ALA and VSK. Test if the point lies on edge in 
		     one or two objects.         */
		  if (kstat == 2 || kstat == 5)
		  {
		     sh6getnhbrs (pintdat->vpoint[i], &pt1, &pt2, &gstat);
		     if (gstat == 1)
		     {
			sh6comedg (po1, po2, pintdat->vpoint[i], pt1, &gstat);
			
			/* ALA and VSK. Test if the points lie on the same
			   edge in both objects if it lies on an edge in
			   both objects.                  */
			if ((kstat == 2 && gstat > 0) ||
			    (kstat == 5 && gstat == 3))
			{
			   sh6tohelp (pintdat->vpoint[i], &kstat);
			   if (kstat < 0)
			      goto error;
			   change = 1;
			}
		     }
		  }
	       }
	    }
	 } while (change);
      }
    }



  *jstat = 0;
  goto out;

  /* Error lower level routine.  */

error:(*jstat) = kstat;
  s6err ("sh6edgred", *jstat, 0);
  goto out;

out:
  return;
}

//===========================================================================
void s9conmarch(SISLSurf *ps,double alevel,double epar[],int ndir[],int ipoint,
		double *gpar[],int *mpar[],int *jpoint,int *jstat)
//===========================================================================
{
  int kstat;            /* Status variable                             */
  int kpos=0;           /* Position of error                           */
  int *lpar = SISL_NULL;     /* Pointer to output integer array             */
  int ki,kj;
  int kn1,kn2,kk1,kk2;  /* Surface attributes.           */
  double tstart1,tstart2,tend1,tend2; /* Surface attributes.           */
  int ksucc;            /* Success indicator                           */
  double tepsge=1.0;    /* Not used                                    */
  double *spar=SISL_NULL;    /* Pointer to output real array                */
  double scand1[2];     /* Result of iteration process                 */
  double scand2[2];     /* Result of iteration process                 */
  double *sp,*sq;       /* Pointer used in loop                        */
  double tdum1;         /* Max knot value used in DEQUAL comparing.    */
  double tdum2;         /* Max knot value used in DEQUAL comparing.    */

  /* Init */
  kn1 = ps->in1;
  kn2 = ps->in2;
  kk1 = ps->ik1;
  kk2 = ps->ik2;

  tstart1 = ps->et1[kk1-1];
  tend1   = ps->et1[kn1];
  tstart2 = ps->et2[kk2-1];
  tend2   = ps->et2[kn2];

  tdum1 = (double)2.0*max(fabs(tstart1),fabs(tend1));
  tdum2 = (double)2.0*max(fabs(tstart2),fabs(tend2));

  /* Allocate output arrays */
  
  if ((*mpar=newarray(3*ipoint,INT     )) == SISL_NULL) goto err101;
  if ((*gpar=newarray(6*ipoint,DOUBLE)) == SISL_NULL) goto err101;
  
  lpar = *mpar;
  spar = *gpar;
  
  memcopy(spar,epar,2*ipoint,DOUBLE);
  *jpoint = ipoint;
  
  /* Initiate output integer array to point to no points */
  
  for (ki=0 ; ki< 3*ipoint ; ki++) *(lpar+ki) = 0;
  

  /* Loop for all input points. */      
  for (ki=0, sp=spar ; ki< ipoint-1 ; ki++, sp+=2)
    {
      /* Start marching from point ki */

      /* Exclude points already connected and parallell points. */
      if (lpar[ki] != 0 || ndir[ki] == 0) continue;
	  
      /* SISLPoint not marched to */
	  
      s1787(ps,alevel,tepsge,sp,scand1,scand2,&kstat);
      if (kstat<0) goto error;
      if (kstat==0) goto war00;
	  
      /* Run through remaining points to find if scand2 matches any
	 of them. If we've got only two points, we connect them.*/
	  
      ksucc = 0;
	  
      for (kj=ki+1,sq=spar+2*ki+2 ; kj<ipoint ; kj++,sq+=2)
	{
	      
	  /* SISLPoint found */
	      
	  if (DEQUAL(sq[0]+tdum1,scand2[0]+tdum1) && 
	      DEQUAL(sq[1]+tdum2,scand2[1]+tdum2))
	    {
	      /* Accepted end point found */
	      
	      lpar[ki] = kj+1;
	      lpar[kj] = ki+1;
	      ksucc = 1;
	      break;
	    }
	}
      /* If ksucc==0 then one of the searches was not successful */
	  
      if (ksucc==0) goto war00;   

    }
  
  goto success;

 success: 
  *jstat = 1;
  goto out;

  /* No success */
 war00: 
  *jstat=0;
  /* If we got only singular points, set status. */
  if (ndir[0] == 2) *jstat = 2;

  goto out;

  /* Error in space allocation */
 err101: 
  *jstat = -101;
  s6err("s9conmarch",*jstat,kpos);
  goto out;

  /* Error in lower level function */
 error:
  *jstat = kstat;
  s6err("s9conmarch",*jstat,kpos);
  goto out;

 out:;
}


//===========================================================================
void s9surmarch(SISLSurf *ps1,SISLSurf *ps2,double epar[],int ndir[],int ipoint,
		double *gpar[],int *mpar[],int *jpoint,int *jstat)
//===========================================================================
{
  int kstat;            /* Status variable                             */
  int kpos=0;           /* Position of error                           */
  int *lpar = SISL_NULL;     /* Pointer to output integer array             */
  int ki,kj;
  int kn1,kn2,kk1,kk2;  /* Surface attributes.           */
  double tstart1,tstart2,tend1,tend2; /* Surface attributes.           */
  int ksucc;            /* Success indicator                           */
  double tepsge=1.0;    /* Not used                                    */
  double *spar=SISL_NULL;    /* Pointer to output real array                */
  double scand1[4];     /* Result of iteration process                 */
  double scand2[4];     /* Result of iteration process                 */
  double *sp,*sq;       /* Pointer used in loop                        */
  double tdum1;         /* Max knot value used in DEQUAL comparing.    */
  double tdum2;         /* Max knot value used in DEQUAL comparing.    */
  double tdum3;         /* Max knot value used in DEQUAL comparing.    */
  double tdum4;         /* Max knot value used in DEQUAL comparing.    */

  /* Init */
  kn1 = ps1->in1;
  kn2 = ps1->in2;
  kk1 = ps1->ik1;
  kk2 = ps1->ik2;

  tstart1 = ps1->et1[kk1-1];
  tend1   = ps1->et1[kn1];
  tstart2 = ps1->et2[kk2-1];
  tend2   = ps1->et2[kn2];

  tdum1 = (double)2.0*max(fabs(tstart1),fabs(tend1));
  tdum2 = (double)2.0*max(fabs(tstart2),fabs(tend2));

  kn1 = ps2->in1;
  kn2 = ps2->in2;
  kk1 = ps2->ik1;
  kk2 = ps2->ik2;

  tstart1 = ps2->et1[kk1-1];
  tend1   = ps2->et1[kn1];
  tstart2 = ps2->et2[kk2-1];
  tend2   = ps2->et2[kn2];


  tdum3 = (double)2.0*max(fabs(tstart1),fabs(tend1));
  tdum4 = (double)2.0*max(fabs(tstart2),fabs(tend2));


  /* Allocate output arrays */
  
  if ((*mpar=newarray(2*ipoint,INT     )) == SISL_NULL) goto err101;
  if ((*gpar=newarray(8*ipoint,DOUBLE)) == SISL_NULL) goto err101;
  
  lpar = *mpar;
  spar = *gpar;
  
  memcopy(spar,epar,4*ipoint,DOUBLE);
  *jpoint = ipoint;
  
  /* Initiate output integer array to point to no points */
  
  for (ki=0 ; ki< 2*ipoint ; ki++) *(lpar+ki) = 0;
  

  /* Loop for all input points. */      
  for (ki=0, sp=spar ; ki< ipoint-1 ; ki++, sp+=4)
    {
      /* Start marching from point ki */

      /* Exclude points already connected and parallell points. */
      if (lpar[ki] != 0 || ndir[ki] == 0) continue;
	  
      /* SISLPoint not marched to */
	  
      s1788(ps1,ps2,tepsge,sp,scand1,scand2,&kstat);
      if (kstat<0) goto error;
      if (kstat==0) goto war00;;
	  
      /* Run through remaining points to find if scand2 matches any
	 of them. If we've got only two points, we connect them.*/
	  
      ksucc = 0;
	  
      for (kj=ki+1,sq=spar+4*ki+4 ; kj<ipoint ; kj++,sq+=4)
	{
	      
	  /* SISLPoint found */
	      
	  if (DEQUAL(sq[0]+tdum1,scand2[0]+tdum1) && 
	       DEQUAL(sq[1]+tdum2,scand2[1]+tdum2) &&
	       DEQUAL(sq[2]+tdum3,scand2[2]+tdum3) &&
	       DEQUAL(sq[3]+tdum4,scand2[3]+tdum4))

	    {
	      /* Accepted end point found */
	      
	      lpar[ki] = kj+1;
	      lpar[kj] = ki+1;
	      ksucc = 1;
	      break;
	    }
	}
      /* If ksucc==0 then one of the searches was not successful */
	  
      if (ksucc==0) goto war00;   

    }
  
  goto success;

 success: 
  *jstat = 1;
  goto out;

  /* No success */
 war00: 
  *jstat=0;
  /* If we got only singular points, set status.*/
  if (ndir[0] == 2) *jstat = 2;
  goto out;

  /* Error in space allocation */
 err101: 
  *jstat = -101;
  s6err("s9surmarch",*jstat,kpos);
  goto out;

  /* Error in lower level function */
 error:
  *jstat = kstat;
  s6err("s9surmarch",*jstat,kpos);
  goto out;

 out:;
}


//===========================================================================
void shsing_s9dir(double cdiff[],double evals[],double evalq[])
//===========================================================================
{                        


  int ki;                             /* Loop control.                               */
  int kdim = 3;                       /* Dim of object space.                        */
  double *sval;                       /* Pointer to first surface value              */
  double *s_u,*s_v,*s_uu,*s_uv,*s_vv; /* Pointers to first surface derivatives       */
  double *ns;                         /* Pointer to first surface normal             */
  double *qval;                       /* Pointer to second surface value             */
  double *q_t,*q_r,*q_tt,*q_tr,*q_rr; /* Pointer to second surface derivatives       */
  double *nq;                         /* Pointer to second surface normal            */
  double nq_u[3], nq_v[3];            /* Derivatives of second surface normal (with u and v !) */
  double help1[3], help2[3];          /* Help arrays                                 */
  double help3[3], help4[3];          /* Help arrays                                 */
  double matr[4];                     /* Matrix in linear equation to be solved      */
  int    piv[2];                      /* Pivotation array                            */
  double sq[3];                       /* The difference cevtor S-Q                   */
  double h_u[2];                      /* The partial derivative of h() by u          */
  double h_v[2];                      /* The partial derivative of h() by v          */
  int kstat;                          /* Local status                                */
  
  /* ------------------------------------------------------------------------------- */
  
  cdiff[0] = DZERO;
  cdiff[1] = DZERO;
  cdiff[2] = DZERO;
  cdiff[3] = DZERO;

  /* Init, Set pointers to input values */
  sval = evals;
  qval = evalq;
  
  s_u   = sval + kdim;
  s_v   = s_u   + kdim;
  s_uu  = s_v   + kdim;
  s_uv  = s_uu  + kdim;
  s_vv  = s_uv  + kdim;
  ns    = s_vv  + kdim;

  q_t   = qval + kdim;
  q_r   = q_t   + kdim;
  q_tt  = q_r   + kdim;
  q_tr  = q_tt  + kdim;
  q_rr  = q_tr  + kdim;
  nq    = q_rr  + kdim;

  /* Get the difference vector S-Q */
  s6diff(sval,qval,kdim,sq);
  
  /* Find the derivatives of the h() function by solving 2 2x2 systems (same matrix) */
  matr[0] = s6scpr(q_tt,sq,kdim) - s6scpr(q_t,q_t,kdim);
  matr[1] = s6scpr(q_tr,sq,kdim) - s6scpr(q_t,q_r,kdim);
  matr[2] = matr[1];
  matr[3] = s6scpr(q_rr,sq,kdim) - s6scpr(q_r,q_r,kdim);  

  h_u[0] = -s6scpr(s_u,q_t,kdim);
  h_u[1] = -s6scpr(s_u,q_r,kdim);

  h_v[0] = -s6scpr(s_v,q_t,kdim);
  h_v[1] = -s6scpr(s_v,q_r,kdim);
  

  /* Factorize matrix */
  s6lufacp(matr,piv,2,&kstat);
  if (kstat != 0) goto out;
  
  /* Solve */
  s6lusolp(matr,h_u,piv,2,&kstat);
  if (kstat != 0) goto out;

  /* Solve */
  s6lusolp(matr,h_v,piv,2,&kstat);
  if (kstat != 0) goto out;

  /* Construct matrix for finding du and dv */
  for (ki=0;ki<kdim;ki++) 
    {
      help1[ki] = q_tt[ki]*h_u[0] + q_tr[ki]*h_u[1];
      help2[ki] = q_tr[ki]*h_u[0] + q_rr[ki]*h_u[1];
    }
  s6crss(help1,q_r,help3);
  s6crss(q_t,help2,help4);
  
  for (ki=0;ki<3;ki++) nq_u[ki] = help3[ki] + help4[ki];

  for (ki=0;ki<kdim;ki++) 
    {
      help1[ki] = q_tt[ki]*h_v[0] + q_tr[ki]*h_v[1];
      help2[ki] = q_tr[ki]*h_v[0] + q_rr[ki]*h_v[1];
    }
  s6crss(help1,q_r,help3);
  s6crss(q_t,help2,help4);
  
  for (ki=0;ki<3;ki++) nq_v[ki] = help3[ki] + help4[ki];

  for (ki=0;ki<4;ki++) matr[ki] = DZERO;
  
  for (ki=0;ki<3;ki++) 
    {
      matr[0] += s_uu[ki]*nq[ki] + s_u[ki]*nq_u[ki];
      matr[1] += s_uv[ki]*nq[ki] + s_u[ki]*nq_v[ki];
      matr[2] += s_uv[ki]*nq[ki] + s_v[ki]*nq_u[ki];
      matr[3] += s_vv[ki]*nq[ki] + s_v[ki]*nq_v[ki];
    }
  
  /* solve the linear 2x2 system */

  s6lufacp(matr,piv,2,&kstat);
  if (kstat != 0) 
    {
      if( DNEQUAL(matr[0],DZERO)) cdiff[0] = - s6scpr(s_u,nq,kdim)/matr[0];
      else if( DNEQUAL(matr[1],DZERO)) cdiff[1] = - s6scpr(s_u,nq,kdim)/matr[1];
      else if( DNEQUAL(matr[2],DZERO)) cdiff[0] = - s6scpr(s_v,nq,kdim)/matr[2];
      else if( DNEQUAL(matr[3],DZERO)) cdiff[1] = - s6scpr(s_v,nq,kdim)/matr[3];

    }
  else 
    {
      cdiff[0] = - s6scpr(s_u,nq,kdim);
      cdiff[1] = - s6scpr(s_v,nq,kdim);
      s6lusolp(matr,cdiff,piv,2,&kstat);
    }
  out:;
  
}

//===========================================================================
void shsing_s9corr(double gd[], double coef[],double limit[])
//===========================================================================
{
  int ki;

  for (ki=0;ki<4;ki++)
    if (coef[ki] + gd[ki] < limit[2*ki])        gd[ki] = limit[2*ki]    - coef[ki];
    else if (coef[ki] + gd[ki] > limit[2*ki+1]) gd[ki] = limit[2*ki +1] - coef[ki];
  

}


//===========================================================================
void shsing(SISLSurf *psurf1,SISLSurf *psurf2,double limit[],
	    double enext[], double gpos[],int *jstat)
//===========================================================================
{                        
  int kstat = 0;            /* Local status variable.                      */
  int kpos = 0;             /* Position of error.                          */
  int ki;                   /* Loop control                                */
  int kleftt=0;             /* Variables used in the evaluator.            */
  int klefts=0;             /* Variables used in the evaluator.            */
  int kleftu=0;             /* Variables used in the evaluator.            */
  int kleftv=0;             /* Variables used in the evaluator.            */
  int kder=2;               /* Order of derivatives to be calulated        */
  int kdim=3;               /* Dimension of space the surface lies in      */
  int knbit;                /* Number of iterations                        */
  double tdelta[4];         /* Length of parameter intervals.              */
  double tdist;             /* The current norm of the cross product       */
                            /* between the two normals                     */
  double tprev;             /* The current norm of the cross product       */
                            /* between the two normals                     */
  double td[4],t1[4],tdn[4];/* Distances between old and new parameter     */
			    /* value in the four parameter directions.     */
  double sval1[21];         /* Value ,first and second derivatiev of surf. */ 
  double *snorm1=sval1+18;  /* Normal vector of the surface                */
  double sval2[21];         /* Value ,first and second derivatiev of surf. */ 
  double *snorm2=sval2+18;  /* Normal vector of the surface                */
  double snext[4];          /* Parameter values                            */
  double temp[3];           /* Temp vector storing cross products.         */
  double start[2];          /* Parameters limit of second surface, used in */
                            /* call to closest point                       */
  double end[2];            /* Parameters limit of second surface, used in */
                            /* call to closest point                       */
  double guess[2];          /* Start point for closest point iteration     */
  double tol = (double)10000.0*REL_COMP_RES; /* equality tol. in par.space */
  SISLPoint *ppoint=SISL_NULL;   /* Contains the current position in first      */ 
                            /* surface used in closest point iteration     */
  int max_iter=20;          /* Maximal number of iteration allowed         */

  /* --------------------------------------------------------------------- */
  
  /* Test input.  */
  if (psurf1->idim != kdim) goto err106;
  if (psurf2->idim != kdim) goto err106;
  
  /* Fetch referance numbers from the serach intervals for the surfaces.  */
  tdelta[0] = limit[1] - limit[0];
  tdelta[1] = limit[3] - limit[2];
  tdelta[2] = limit[5] - limit[4];
  tdelta[3] = limit[7] - limit[6];

  /* Set limit values, used in closest point iteration */
  start[0] = limit[4];
  start[1] = limit[6];
  end[0]   = limit[5];
  end[1]   = limit[7];
  
  /* Create point, used in closest point iteration */
  ppoint = newPoint(sval1,3,0);
  
  /* Collapsed ? */
  for (ki=0;ki<4;ki++) if (tdelta[ki] < tol) goto errsmall;  
  
  /* Initiate output variables.  */
  for (ki=0;ki<4;ki++)     gpos[ki] = enext[ki];

  /* Evaluate 0.-2. derivatives of first surface */
  s1421(psurf1,kder,gpos,&kleftt,&klefts,sval1,snorm1,&kstat);
  if (kstat < 0) goto error;

  /* Get closest point in second surface. */
  guess[0] = gpos[2];
  guess[1] = gpos[3];
  s1773(ppoint,psurf2,REL_COMP_RES,start,end,guess,gpos+2,&kstat);
  if (kstat < 0) goto error;
  
  /* Evaluate 0.-2. derivatives of second surface */
  s1421(psurf2,kder,gpos+2,&kleftu,&kleftv,sval2,snorm2,&kstat);
  if (kstat < 0) goto error;

  /* Get length of normal cross product */
  s6crss(snorm1,snorm2,temp);
  tprev = s6length(temp,kdim,&kstat);
  
  /* Compute the Newton stepdistance vector in first surface. */
  shsing_s9dir(td,sval1,sval2);
  
  /* Adjust if we are not inside the parameter intervall. */
  for (ki=0;ki<4;ki++)    t1[ki] = td[ki];

  shsing_s9corr(t1,gpos,limit);
  
  /* Iteratation loop.  */
  
  for (knbit = 0; knbit < max_iter; knbit++)
    {
      
      for (ki=0;ki<2;ki++)    snext[ki] = gpos[ki] + t1[ki];
   
      /* Evaluate 0.-2. derivatives of first surface */
      s1421(psurf1,kder,snext,&kleftt,&klefts,sval1,snorm1,&kstat);
      if (kstat < 0) goto error;
      
      /* Get closest point in second surface. */
      guess[0] = gpos[2];
      guess[1] = gpos[3];
      s1773(ppoint,psurf2,REL_COMP_RES,start,end,guess,snext+2,&kstat);
      if (kstat < 0) goto error;

      /* Evaluate 0.-2. derivatives of second surface */
      s1421(psurf2,kder,snext+2,&kleftu,&kleftv,sval2,snorm2,&kstat);
      if (kstat < 0) goto error;

      /* Get length of normal cross product */
      s6crss(snorm1,snorm2,temp);
      tdist = s6length(temp,kdim,&kstat);
  
      /* Compute the Newton stepdistance vector. */
      shsing_s9dir(tdn,sval1,sval2);
      
      if (tdist <= tprev)
	{
	  /* Ordinary converging. */
	  
	  for (ki=0;ki<4;ki++)
	    {
	      gpos[ki] = snext[ki];
	      td[ki] = t1[ki] = tdn[ki];
	    }
	  
	  /* Adjust if we are not inside the parameter intervall. */
	  shsing_s9corr(t1,gpos,limit);
		  
          if ((fabs(t1[0]/tdelta[0]) <= REL_COMP_RES) &&
	      (fabs(t1[1]/tdelta[1]) <= REL_COMP_RES) &&
	      (fabs(t1[2]/tdelta[2]) <= REL_COMP_RES) &&	   
	      (fabs(t1[3]/tdelta[3]) <= REL_COMP_RES))
	      {
		for (ki=0;ki<2;ki++) gpos[ki] += t1[ki];
		/* Evaluate 0.-2. derivatives of first surface */
		s1421(psurf1,kder,gpos,&kleftt,&klefts,sval1,snorm1,&kstat);
		if (kstat < 0) goto error;
		
		/* Get closest point in second surface. */
		guess[0] = gpos[2];
		guess[1] = gpos[3];
		s1773(ppoint,psurf2,REL_COMP_RES,start,end,guess,gpos+2,&kstat);
		if (kstat < 0) goto error;
		break;
	      }
	  tprev = tdist;
	}
      
      else
	{
	  /* Not converging, half step length try again. */
	  
	  for (ki=0;ki<4;ki++) t1[ki] /= (double)2;
	}
    }
  
  /* Iteration stopped, test if point is extremum */
  /* Unsure about what i right here , angle between normals and difference vector ?? */
  if (tdist <= tol)
    *jstat = 1;
  else
    *jstat = 0;

 
  /* Test if the iteration is close to a knot */
  if (fabs(gpos[0] - psurf1->et1[kleftt])/tdelta[0] < tol)
    gpos[0] = psurf1->et1[kleftt];
  else if (fabs(gpos[0] - psurf1->et1[kleftt+1])/tdelta[0] < tol)
    gpos[0] = psurf1->et1[kleftt+1];
  
  if (fabs(gpos[1] - psurf1->et2[klefts])/tdelta[1] < tol)
    gpos[1] = psurf1->et2[klefts];
  else if (fabs(gpos[1] - psurf1->et2[klefts+1])/tdelta[1] < tol)
    gpos[1] = psurf1->et2[klefts+1];

  if (fabs(gpos[2] - psurf2->et1[kleftu])/tdelta[2] < tol)
    gpos[2] = psurf2->et1[kleftu];
  else if (fabs(gpos[2] - psurf2->et1[kleftu+1])/tdelta[2] < tol)
    gpos[2] = psurf2->et1[kleftu+1];
  
  if (fabs(gpos[3] - psurf2->et2[kleftv])/tdelta[3] < tol)
    gpos[3] = psurf2->et2[kleftv];
  else if (fabs(gpos[3] - psurf2->et2[kleftv+1])/tdelta[3] < tol)
    gpos[3] = psurf2->et2[kleftv+1];
  
  /* Iteration completed.  */
  goto out;
  
  /* --------------------------------------------------------------------- */ 
  /* Error in input. Dimension not equal to 3 */
  err106: *jstat = -106;
  s6err("shsing",*jstat,kpos);
  goto out;                  

  /* Error in input. One parameter interval colapsed. */
  errsmall: *jstat = -200;
  s6err("shsing",*jstat,kpos);
  goto out;                  
  
  /* Error in lower level routine.  */
  error : *jstat = kstat;
  s6err("shsing",*jstat,kpos);
  goto out;                  
  
 out:if(ppoint) freePoint(ppoint);
}



//===========================================================================
void s6findfac(double evecu[],double evecv[],double evecw[],double etang[],
               int idim,int isign,double *coef1,double *coef2,double *coef3,int *jstat)
//===========================================================================
{

  int kstat = 0;           /* Status variable.                    */
  int ki;                  /* Counter.                            */
  double tdotuu;           /* Scalar product of evecu and evecu.  */
  double tdotuv;           /* Scalar product of evecu and evecv.  */
  double tdotutang;        /* Scalar product of evecu and etang.  */
  double tdotvv;           /* Scalar product of evecv and evecv.  */
  double tdotvtang;        /* Scalar product of evecv and etang.  */
  double tdiv;             /* Determinant of equation system.     */
  double sdum[3];          /* Help vector.     */

  *jstat = 0;
  
  /* Test input.  */

  /* if (idim != 3) goto err104; */
  
  /* Set output to zero. */

  *coef1 = (double)0.0;
  *coef2 = (double)0.0;
  
  /* Compute coefficients of equation system.  */

  tdotuu = s6scpr(evecu,evecu,idim);
  tdotuv = s6scpr(evecu,evecv,idim);
  tdotutang = (double)isign*s6scpr(evecu,etang,idim);
  tdotvv = s6scpr(evecv,evecv,idim);
  tdotvtang = (double)isign*s6scpr(evecv,etang,idim);

  tdiv = tdotuv*tdotuv - tdotuu*tdotvv;
  if (DEQUAL(tdiv,DZERO))
    {
      if (DEQUAL(tdotuu,DZERO) && DEQUAL(tdotvv,DZERO));
      else if (DEQUAL(tdotuu,DZERO))
	  *coef2 = s6length(etang,idim,&kstat)/sqrt(tdotvv);
      else
	*coef1 = s6length(etang,idim,&kstat)/sqrt(tdotuu);
      goto out;
    }
  
  /* Compute the first two output factors.  */

  *coef1 = (tdotvtang*tdotuv - tdotutang*tdotvv)/tdiv;
  *coef2 = (tdotutang*tdotuv - tdotvtang*tdotuu)/tdiv;

  /* Find third output factor.  */

  for (ki=0; ki<idim; ki++) 
    sdum[ki] = (double)isign*etang[ki] - *coef1*evecu[ki] - *coef2*evecv[ki];
  *coef3 = s6length(sdum,idim,&kstat)/s6length(evecw,idim,&kstat);
  
  if (s6scpr(sdum,evecw,idim) < DZERO) (*coef3) *= -(double)1.0;

  goto out;


  out :
    return;
}


//===========================================================================
int s1789_s9knot(double et[], int ik, int in, double ax1, double ax2,
		 int *jmy, int *jstat)
//===========================================================================
{
   int kstat = 0;         /* Status variable.  */
   int kleft1 = 0;
   int kleft2 = 0;
   int kknot;
   double tref = et[in] - et[ik-1];

   /* Initialize input. */

   *jmy = 0;

   /* Find position of the input parameter values in the given knot vector. */

   s1219(et, ik, in, &kleft1, ax1, &kstat);
   if (kstat < 0) goto error;

   s1219(et, ik, in, &kleft2, ax2, &kstat);
   if (kstat < 0) goto error;

   if (kleft1 != kleft2)
   {
      /* Not the same knot interval. */

      if (ax1 < ax2) (*jmy) = kleft1 + 1;
      else
      {
	 (*jmy) = kleft1 - 1;
	 while (DEQUAL(et[*jmy], et[kleft1])) (*jmy)--;
      }
   }

   if (kleft1 == kleft2 ||
       DEQUAL(et[*jmy]+tref, ax2+tref) ||
       (DEQUAL(et[kleft1]+tref, ax1+tref) && kleft2 == (*jmy) &&
	DEQUAL(et[kleft2]+tref, ax2+tref)))
      kknot = 0;     /* No knot found between the parameter values. */
   else kknot = 1;   /* Knot with index (*jmy) found.               */

   *jstat = 0;
   goto out;

   /* Error in lower level routine. */

   error : *jstat = kstat;
   goto out;

   out:
      return kknot;
}


//===========================================================================
void s1789_s9eval(double eders[],double enorms[],double etanc[],
		  double ederc[],int idim, int *jstat)
//===========================================================================
{
   int kstat = 0;         /* Status variable.  */
   int ki;                /* Counter.          */
   int ksign = 1;         /* Parameter used in s6findfac.     */
   double tfac1,tfac2,tfac3;  /* Factors found by s6findfac.  */

   /* Copy position of surface to output array.   */

   memcopy(ederc,eders,idim,DOUBLE);

   /* Compute the factors used to express etanc by the derivatives and normal
      of the surface.  */

   s6findfac(eders+idim,eders+2*idim,enorms,etanc,idim,ksign,&tfac1,&tfac2,
	     &tfac3,&kstat);
   if (kstat < 0) goto error;

   /* Compute first and second derivative of the curve in the surface.  */

   for (ki=0; ki<idim; ki++)
   {
      ederc[idim+ki] = tfac1*eders[idim+ki] + tfac2*eders[2*idim+ki];
      ederc[2*idim+ki] = tfac1*tfac1*eders[3*idim+ki]
	 + (double)2.0*tfac1*tfac2*eders[4*idim+ki] + tfac2*tfac2*eders[5*idim+ki];
   }

   *jstat = 0;
   goto out;

   /* Error in lower level routine.  */

   error:
      *jstat = kstat;
   goto out;

   out:
      return;
}


//===========================================================================
void s1789(SISLPoint *ppoint,SISLSurf *psurf,double aepsge,
	   double epar1[],double epar2[],int *jstat)
//===========================================================================
{
   int kstat;          /* Status variable                                 */
   int ki;             /* Counter.                                        */
   int kleft1=0;       /* Left indicator for point calculation in 1. par.
			  direction of surface.                           */
   int kleft2=0;       /* Left indicator for point calculation in 2. par dir.*/
   int kknot1, kknot2; /* Indicates whether there is a knot between the
			  input points in 1. and 2. parameter direction.  */
   int kmy1, kmy2;     /* Index of an eventual knot.                      */
   int kk1,kk2,kn1,kn2;/* Orders and nu,ber of vertices of surface        */
   int kdims;          /* Dimension of space where the surface lies       */
   int kpos=0;         /* Position of error                               */
   int kders=2;        /* Number of derivatives to be calculated on surface
			  If step lenght is to be generated from surface,
			  kders must be equal to 2.                       */
   int kpar;           /* Parameter value of constant parameter curve.    */
   double snorm[3];    /* Normal vector of surface                        */
   double *st1;        /* First knot direction of surface                 */
   double *st2;        /* Second knot direction of surface                */
   double sders[18];   /* Position, first and second derivatives of surface */
   double tstep;       /* Final step length     */
   double tlengthend;  /* Length of 1st derivative at end of segment */
   double tincre;      /* Parameter value increment */
   double tsmax;       /* Local maximal step length based of boxsizes of objects */
   double tdist;       /* Distance */
   double tref;        /* Referance value in equality test.               */
   double sstart[2];   /* Lower boundary of parameter intervals */
   double send[2];     /* Upper bounadry of parameter intervals */
   double spos[2];     /* New iteration  point on surface                 */
   double spos1[2];    /* New iteration  point on surface                 */
   double spos2[2];    /* New iteration  point on surface                 */
   double sint[2];     /* Interval between test points in par. space.     */
   double snext[2];    /* Save previous intersection point.               */
   double sdiff[2];    /* Difference vector between input int. pts.       */
   double spardir[2];  /* Direction of coincidence curve in parameter area. */
   double tbeta;       /* Scaling factor between partial derivatives of sf. */
   double stanc[2];    /* Direction of coincidence curve in surface.        */
   double sder2[10];   /* Information about curve in surface.               */
   double tdot;        /* Scalar product to test direction of vectors.      */
   double td;          /* Distance between current and last point.          */
   double s3dinf2[10]; /* Marching information to decide step length.       */
   SISLCurve *qc = SISL_NULL;   /* Constant parameter curve.                       */

   *jstat = 0;

   /* Make maximal step length based on box-size of surface */

   sh1992su(psurf,0,aepsge,&kstat);
   if (kstat < 0) goto error;

   tsmax = MAX(psurf->pbox->e2max[0][0] - psurf->pbox->e2min[0][0],
	       psurf->pbox->e2max[0][1] - psurf->pbox->e2min[0][1]);

   /* Copy surface attributes to local parameters.  */

   kdims = psurf -> idim;
   kk1   = psurf -> ik1;
   kk2   = psurf -> ik2;
   kn1   = psurf -> in1;
   kn2   = psurf -> in2;
   st1   = psurf -> et1;
   st2   = psurf -> et2;

   /* Set reference value.  */

   tref = MAX(st1[kn1]-st1[kk1-1],st2[kn2]-st2[kk2-1]);

   /* Check dimension  */

   if (ppoint->idim != kdims || (kdims != 2 && kdims != 3))
     goto err105;

   sstart[0] = st1[kk1-1];
   sstart[1] = st2[kk2-1];
   send[0] = st1[kn1];
   send[1] = st2[kn2];

   /* Set start point for marching on surface */

   spos1[0] = epar1[0];
   spos1[1] = epar1[1];

   /* Set difference vector between input points. */

   s6diff(epar2, epar1, 2, sdiff);

   /* Evaluate start point of surface.  */

   s1421(psurf,kders,spos1,&kleft1,&kleft2,sders,snorm,&kstat);
   if (kstat < 0) goto error;

   /* While end not reached */

   td = s6dist(spos1, epar2, 2);
   while (td > REL_PAR_RES)
   {
      /* Compute direction of marching. The partial derivatives of the
	 surface in this point must be almost parallel. Find the factor
	 that makes the partial derivatives sum up to zero (approximately). */

     if (kdims == 2)
       {
	 if (DEQUAL(sders[kdims]+tref,tref) && 
	     DEQUAL(sders[kdims+1]+tref,tref) &&
	     DEQUAL(sders[kdims+2]+tref,tref)) break;

	 if (sders[2] >= sders[3])
	   {
	     if (DEQUAL(sders[4]+tref,sders[2]+tref))
	       tbeta = (double)0.5;
	     else
	       tbeta = (double)1/((double)1 - (sders[4]/sders[2]));
	   }
	 else
	   {
	     if (DEQUAL(sders[5]+tref,sders[3]+tref))
	       tbeta = (double)0.5;
	     else
	       tbeta = (double)1/((double)1 - (sders[5]/sders[3]));
	   } 


	 spardir[0] = (double)1-tbeta;
	 spardir[1] = tbeta;
       }
     else
       {
	 spardir[0] = epar2[0]-epar1[0];
	 spardir[1] = epar2[1]-epar1[1];
       }

      tdot = s6norm(spardir, 2, spardir,&kstat);
      if (tdot < REL_PAR_RES)
      {
	 *jstat = 0;
	 goto out;
      }

      for (ki=0; ki<kdims; ki++)
	 stanc[ki] = spardir[0]*sders[kdims+ki] + spardir[1]*sders[2*kdims+ki];

      tdot = s6scpr(stanc, sdiff, kdims);
      if (tdot < DZERO)
      {
	 stanc[0] *= -(double)1;
	 stanc[1] *= -(double)1;
      }

      /* Compute position, first and second derivative of the curve in the
	 surface going through the evaluated point in this point. */

      s1789_s9eval(sders,snorm,stanc,sder2,kdims,&kstat);
      if (kstat < 0) goto error;

      /* Calculate unit tangent and radius of curvature of curve in surface.*/

      s1307(sder2,kdims,s3dinf2,&kstat);
      if (kstat<0) goto error;

      /* Calculate step length based on curvature */

      tstep = s1311(s3dinf2[3*kdims],aepsge,tsmax,&kstat);
      if (kstat<0) goto error;

      tlengthend = s6length(sder2+kdims,kdims,&kstat);
      if (kstat<0) goto error;

      /* Find candidate end point, make sure that no breaks in tangent or
	 curvature exists between start and endpoints of the segment      */

      /* Make step length equal to resolution if the length is zero */

      /* Find parameter value of candidate end point of segment */

      if (DEQUAL(tlengthend+tref,tref))
	 tincre = REL_PAR_RES;
      else
	 tincre = tstep/tlengthend;

      spos2[0] = spos1[0] + tincre*spardir[0];
      spos2[1] = spos1[1] + tincre*spardir[1];

     /* Make sure not to jump out of the surface */
     if ((epar2[0] > epar1[0] && spos2[0] >= epar2[0]) ||
	 (epar2[0] < epar1[0] && spos2[0] <= epar2[0]) ||
	 (epar2[1] > epar1[1] && spos2[1] >= epar2[1]) ||
	 (epar2[1] < epar1[1] && spos2[1] <= epar2[1]))
       {
	 spos2[0] = epar2[0];
	 spos2[1] = epar2[1];
       }

      if (s6dist(spos1, spos2, kdims) > s6dist(spos1, epar2, kdims))
	 memcopy(spos2, epar2, 2, DOUBLE);

      /* Check if any knot line exist within the step. */

      kknot1 = s1789_s9knot(st1, kk1, kn1, spos1[0], spos2[0], &kmy1, &kstat);
      if (kstat < 0) goto error;

      kknot2 = s1789_s9knot(st2, kk2, kn2, spos1[1], spos2[1], &kmy2, &kstat);
      if (kstat < 0) goto error;

      if ((kknot1 && !kknot2) ||
	  (kknot1 && kknot2 && spardir[1]*(st1[kmy1]-spos1[0]) <
	   spardir[0]*(st2[kmy2]-spos1[1])))
      {
	 /* Pull back to knotline in first parameter direction. */

	 spos2[0] = psurf->et1[kmy1];   /* Parameter value of knotline. */
	 spos2[1] = spos1[1] + (spos2[0]-spos1[0])*spardir[1]/spardir[0];
	 kpar = 1;
      }
      else if (kknot2)
      {
	 /* Pull back to knot line in second parameter direction. */

	 spos2[1] = psurf->et2[kmy2];
	 spos2[0] = spos1[0] + (spos2[1] - spos1[1])*spardir[0]/spardir[1];
	 kpar = 2;
      }
      else
      {
	 /* No knot line. Decide in which parameter direction to iterate. */

	 if (spardir[1]*fabs(st1[kmy1]-spos1[0]) <
	     spardir[0]*fabs(st2[kmy2]-spos1[1]))
	    kpar = 1;
	 else
	    kpar = 2;
      }

      sint[0] = (spos2[0]-spos1[0])/(double)3;
      sint[1] = (spos2[1]-spos1[1])/(double)3;

      for (ki=0, spos[0]=spos1[0]+sint[0], spos[1]=spos1[1]+sint[1];
       ki<3; ki++, spos[0]+=sint[0], spos[1]+=sint[1])
      {

	 if (kpar == 1)
	 {
	    /* Pick constant parameter curve in 1. par. dir. */

	    s1437(psurf, spos[0], &qc, &kstat);
	    if (kstat < 0) goto error;

	    /* Iterate down to the curve. */

	    s1771(ppoint, qc, aepsge, qc->et[qc->ik-1], qc->et[qc->in],
		  spos[1], &spos[1], &kstat);
	    if (kstat < 0) goto error;
	 }
	 else
	 {
	    /* Pick constant parameter curve in 2. par. dir. */

	    s1436(psurf, spos[1], &qc, &kstat);
	    if (kstat < 0) goto error;

	    /* Iterate down to the curve. */

	    s1771(ppoint, qc, aepsge, qc->et[qc->ik-1], qc->et[qc->in],
		  spos[0], &spos[0], &kstat);
	    if (kstat < 0) goto error;
	 }

	 memcopy(snext, spos, 2, DOUBLE);

	 /* Calculate point and derivatives in surface */

	 s1421(psurf,kders,spos,&kleft1,&kleft2,sders,snorm,&kstat);
	 if (kstat<0) goto error;

	 /* Check if the input point and surface point are within positional
	    tolerance. */

	 tdist = s6dist(ppoint->ecoef,sders,kdims);

	 if (tdist>aepsge)
	 {
	    /* Points not within tolerances, no coincide. */

	    goto war01;
	 }

	 /* Test whether the marching has advanced. */

	 if (s6dist(spos1, spos, 2) < REL_PAR_RES) goto war01;

         /* Free memory occupied by local curve. */

        if (qc != SISL_NULL) freeCurve(qc);
        qc = SISL_NULL;
      }

      /* Update start parameter of step. */

      spos1[kpar-1] = spos2[kpar-1];
      spos1[2-kpar] = snext[2-kpar];
      td = s6dist(spos1, epar2, 2);
   }

   if (td > REL_PAR_RES) *jstat = 0;
   else *jstat = 1;

   goto out;

   /* Point and surface not within tolerance */
   war01: *jstat = 0;
   goto out;

   /* Error in input, dimension not equal to 2 or 3 */

   err105: *jstat = -105;
   s6err("s1789",*jstat,kpos);
   goto out;

   /* Error in lower level function */

   error:  *jstat = kstat;
   s6err("s1789",*jstat,kpos);
   goto out;


   out:
      if (qc != SISL_NULL) freeCurve(qc);

      return;
}


//===========================================================================
void s1786_s9relax(s1786_fevalcProc fevalc1,s1786_fevalcProc fevalc2,
		   SISLCurve *pc1,SISLCurve *pc2,
		   int ider,double aepsge,double ax1,int *jleft1,double eder1[],
		   double anext,double *cx2,int *jleft2,double eder2[],int *jstat)
//===========================================================================
{
   int kstat = 0;         /* Status variable.  */
   double tstart;         /* Start parameter value of curve 2.  */
   double tend;           /* End parameter value of curve 2.    */
   SISLPoint *qpoint = SISL_NULL;  /* SISLPoint instance used to represent point on curve 1. */

   /* Find endpoints of the parameter interval of curve 2.  */

   tstart = *(pc2->et + pc2->ik - 1);
   tend = *(pc2->et + pc2->in);


   /*  Make point sderc at curve at ax1 */

   fevalc1(pc1,ider,ax1,jleft1,eder1,&kstat);

   if (kstat<0) goto error;

   /* Find closest point on curve 2 to eder1 */

   qpoint = newPoint(eder1,pc1->idim,0);
   if (qpoint==SISL_NULL) goto err101;

   s1771(qpoint,pc2,aepsge,tstart,tend,anext,cx2,&kstat);
   if(kstat<0) goto error;

   /* Calculate point and derivatives in second curve */

   fevalc2(pc2,ider,*cx2,jleft2,eder2,&kstat);

   if (kstat<0) goto error;

   *jstat = 0;
   goto out;

   /* Error in space allocation.  */

   err101 :
      *jstat = -101;
   goto out;

   /* Error in lower level routine.  */

   error :
      *jstat = kstat;
   goto out;

   out :
     if (qpoint != SISL_NULL) freePoint(qpoint);

      return;
}


//===========================================================================
void s1786(SISLCurve *pc1,SISLCurve *pc2,double aepsge,double epar1[],
	   double epar2[],int *jstat)
//===========================================================================
{
  int kstat;          /* Status variable                                 */
  int ki;             /* Counter.                                        */
  int kleftc1=0;      /* Left indicator for point calculation of curve 1.*/
  int kleftc2=0;      /* Left indicator for point calculation of curve 2.*/
  int kk1,kk2,kn1,kn2;/* Orders and number of vertices of curves         */
  int kdim;           /* The dimension of the space in which the curves lie. */
  int kpos=0;         /* Position of error                               */
  int kderc=2;        /* Number of derivatives to be claculated on the curves */
  int kdum;           /* Temporary variable                              */
  int kchange;        /* Indicates which curve that is marched along.
			 = 0 : First curve.
			 = 1 : Second curve.                             */
  int kknot;          /* Indicates if the next knot in the marching direction
			 is before or after the current knot.            */
  double s3dinf1[20]; /* Pointer to storage for point info of curve 1
			  (10 dobules pr point when idim=3, 7 when idim=3) */
  double s3dinf2[20]; /* Pointer to storage for point info of curve 2
			  (10 dobules pr point when idim=3, 7 when idim=3) */
  double *st1;        /* Knot vector of first curve                      */
  double *st2;        /* Knot vector of second curve                     */
  double tfirst1,tfirst2;/* First parameter value on curves              */
  double tend1,tend2; /* Last parameter on curves                        */
  double sderc1[20];  /* Position, first and second derivatives on curve 1 */
  double sderc2[20];  /* Position, first and second derivatives on curve 2 */
  double tx,tx1,tx2;  /* Parameter values of first curve.  */
  double ty,ty1,ty2;  /* Parameter value of second curve.  */
  double tminstep;    /* Referance value in parameter domain     */
  double tstep;       /* Final step length     */
  double txstep,tystep;  /* Step length     */
  double txmaxinc,tymaxinc;  /* Maximal increment in parameter value along curve*/
  double txlengthend,tylengthend;  /* Length of 1st derivative at start of segment */
  double txincre,tyincre;      /* Parameter value increment */
  double txmax,tymax;        /* Local maximal step length                       */
  double tdist;       /* Distance */
  double tpos;        /* New iteration  point on curve pc2     */

 /* Pointer to curve evaluator routine of 2. curve.  */

  s1786_fevalcProc fevalc;
/*
 #if defined(SISLNEEDPROTOTYPES)
   void (*fevalc)(SISLCurve *, int, double , int *, double [], int *);
 #else
      void (*fevalc)();
 #endif
 */
     /* UJK, aug 93, make min step in parameter domain based on the
	max parameter values */
     tminstep  = max(fabs(pc1->et[pc1->ik-1]),fabs(pc1->et[pc1->in]));
     tminstep += max(fabs(pc2->et[pc2->ik-1]),fabs(pc2->et[pc2->in]));
     tminstep *= REL_PAR_RES;


     /* Make maximal step length based on box-size of curve 1 */

  sh1992cu(pc1,0,aepsge,&kstat);
  if (kstat < 0) goto error;

  txmax = MAX(pc1->pbox->e2max[0][0] - pc1->pbox->e2min[0][0],
	     pc1->pbox->e2max[0][1] - pc1->pbox->e2min[0][1]);
  txmax = MAX(txmax,pc1->pbox->e2max[0][2] - pc1->pbox->e2min[0][2]);

  /* Make maximal step length based on box-size of curve 2 */

  sh1992cu(pc2,0,aepsge,&kstat);
  if (kstat < 0) goto error;

  tymax = MAX(pc2->pbox->e2max[0][0] - pc2->pbox->e2min[0][0],
	     pc2->pbox->e2max[0][1] - pc2->pbox->e2min[0][1]);
  tymax = MAX(tymax,pc2->pbox->e2max[0][2] - pc2->pbox->e2min[0][2]);

  /* Copy curve pc1 attributes to local parameters.  */

  kdim = pc1 -> idim;
  kk1    = pc1 -> ik;
  kn1    = pc1 -> in;
  st1    = pc1 -> et;

  /* Copy curve pc2 attributes to local parameters.  */

  kk2    = pc2 -> ik;
  kn2    = pc2 -> in;
  st2    = pc2 -> et;

  /* Check that dimensions are equal */

  if (kdim != pc2->idim || kdim > 3) goto err105;

  /* Copy interval description into local variables */

  if ( epar1[0]<epar2[0] )
    {
      tfirst1 = epar1[0];
      tfirst2 = epar1[1];
      tend1   = epar2[0];
      tend2   = epar2[1];
    }
  else
    {
      tfirst1 = epar2[0];
      tfirst2 = epar2[1];
      tend1   = epar1[0];
      tend2   = epar1[1];
    }

  /* To make sure we do not start outside or end outside the curve we
     truncate tstart1 and tend1 to the knot interval of the curve */

  tfirst1 = MAX(tfirst1,st1[kk1-1]);
  tend1   = MIN(tend1,st1[kn1]);

  /* To make sure we do not start outside or end outside the curve we
     truncate tstart2 and tend2 to the knot interval of the curve */

  if (tfirst2 <= tend2)
  {
     tfirst2 = MAX(tfirst2,st2[kk2-1]);
     tend2   = MIN(tend2,st2[kn2]);
     kknot = 1;
  }
  else
  {
     tfirst2 = MIN(tfirst2,st2[kn2]);
     tend2 = MAX(tend2,st2[kk2-1]);
     kknot = -1;
  }

  /* Set curve evaluator of 2. curve.  */

  fevalc = (kknot == 1) ? s1221 : s1227;

  /* Store knot values at start of curve */

  tx1 = tfirst1;
  kdum = MAX(kk1,kk2);
  txmaxinc = (tend1-tfirst1)/(kdum*kdum);
  txmaxinc = MAX(txmaxinc, REL_PAR_RES);

  /* Make start point and intital step length based on first curve  */

  s1221(pc1,kderc,tx1,&kleftc1,sderc1,&kstat);
  if (kstat<0) goto error;

  ty1 = tfirst2;
  tymaxinc = fabs(tend2-tfirst2)/(kdum*kdum);
  tymaxinc = MAX(tymaxinc, REL_PAR_RES);

  /* Make start point and intital step length based on second curve  */

fevalc(pc2,kderc,ty1,&kleftc2,sderc2,&kstat);
  if (kstat<0) goto error;

  /* While end not reached */


  while (tx1 < tend1 && kknot*ty1 < kknot*tend2)
    {

      /* Calculate unit tangent and radius of curvature of first curve. */

      s1307(sderc1,kdim,s3dinf1,&kstat);
      if (kstat<0) goto error;

      /* Calculate step length based on curvature of first curve. */

      txstep = s1311(s3dinf1[3*kdim],aepsge,tymax,&kstat);
      if (kstat<0) goto error;

      /* Remember length of start tangent, end of zero segment */

      txlengthend = s6length(sderc1+kdim,kdim,&kstat);
      if (kstat<0) goto error;

      /* Calculate unit tangent and radius of curvature of second curve. */

      s1307(sderc2,kdim,s3dinf2,&kstat);
      if (kstat<0) goto error;

      /* Calculate step length based on curvature */

      tystep = s1311(s3dinf2[3*kdim],aepsge,txmax,&kstat);
      if (kstat<0) goto error;

      /* Remember length of start tangent, end of zero segment */

      tylengthend = s6length(sderc2+kdim,kdim,&kstat);
      if (kstat<0) goto error;

      /*  Find minimum step length.  */

      tstep = MIN(txstep,tystep);
      kchange = (txstep <= tystep) ? 0 : 1;

      /*  Find candidate end point, make sure that no breaks in tangent or
	  curvature exists between start and endpoints of the segment      */
      /* Compute increment in the parameter values.  Use tminstep if the
         tangent has zero length.  */

      if (DEQUAL(txlengthend,DZERO))
	  txincre = tminstep;
      else
        txincre = MIN(tstep/txlengthend,txmaxinc);

      if (DEQUAL(tylengthend,DZERO))
	tyincre = tminstep;
      else
        tyincre = MIN(tstep/tylengthend,tymaxinc);

      /*  Make sure that we don't pass any knots of curve 1. */

      if (tx1 + txincre > st1[kleftc1+1] + tminstep &&
	  tx1 < st1[kleftc1+1] - tminstep)
	{
	  txincre = st1[kleftc1+1] - tx1;
	  tstep = txincre*txlengthend;
	  tyincre = (tylengthend > DZERO) ? tstep/tylengthend : tminstep;
	  kchange = 0;
	}

       /* Avoid passing second next knot of curve 2. */

      if (kknot*(ty1 + tyincre) > kknot*(st2[kleftc2+kknot]+tminstep) &&
	  kknot*ty1 > kknot*(st2[kleftc2+kknot]-tminstep))
	{
	  tyincre = kknot*(st2[kleftc2+kknot] - ty1);
	  tstep = tyincre*tylengthend;
	  txincre = (txlengthend > DZERO) ? tstep/txlengthend : tminstep;
	  kchange = 1;
	}

       /* Avoid passing next knot of curve 2. */

      if (kknot < 0 && (ty1 - tyincre < st2[kleftc2] - tminstep) &&
	  (ty1 < st2[kleftc2] + tminstep))
	{
	  tyincre = kknot*(st2[kleftc2+kknot] - ty1);
	  tstep = tyincre*tylengthend;
	  txincre = (txlengthend > DZERO) ? tstep/txlengthend : tminstep;
	  kchange = 1;
	}


      /* Set endpoints of step.  */

      tx2 = tx1 + txincre;
      ty2 = ty1 + kknot*tyincre;

      for (tx=(tx1+tx2)/(double)2.0, ty=(ty1+ty2)/(double)2.0, ki=0;
       ki<2; ki++, tx=tx2, ty=ty2)
      {
	 if (kchange == 0)
	 {
	    if (tx >= tend1) break;

	    /* March along first curve. Iterate down to the second.  */

	    s1786_s9relax(s1221,fevalc,pc1,pc2,kderc,aepsge,tx,&kleftc1,sderc1,ty,
			  &tpos,&kleftc2,sderc2,jstat);
	    if (kstat < 0) goto error;
	 }
	 else
	 {
	    /* UJK, 05.05.91     if (kknot*tx >= kknot*tend2) break; */
	    if (kknot*ty >= kknot*tend2) break;

	    /* March along second curve. Iterate down to the first.  */
	    s1786_s9relax(fevalc,s1221,pc2,pc1,kderc,aepsge,ty,&kleftc2,sderc2,tx,
			  &tpos,&kleftc1,sderc1,jstat);
	    if (kstat < 0) goto error;
	 }

	  /*  Check if point on curve and surface are within positional and
	      angular tolerances */

	  tdist = s6dist(sderc1,sderc2,kdim);

	  if (tdist>aepsge)
	    {
	      /*      Points not within tolerances, curve and surface do not
		      coincide */
	      goto war00;
	    }
	}

      /*   Update start parameter value of segment, and calculate right
	   hand derivative */

      if (kchange == 0)
      {
	 tx1 = tx2;
	 ty1 = tpos;
      }
      else
      {
	 tx1 = tpos;
	 ty1 = ty2;
      }
    }

  /*  Curves within tolerance */

  /*  Curves within tolerance. Test if the start- and endpoint of any
     of the curves are equal.   */

  *jstat = (DEQUAL(tfirst1,tend1) || DEQUAL(tfirst2,tend2)) ? 0 : 1;
  goto out;

/* Curve and surface not within tolerance */
war00: *jstat = 0;
goto out;

/* Error in input, dimension not equal to 2 or 3 */

err105: *jstat = -105;
        s6err("S1786",*jstat,kpos);
        goto out;

/* Error in lower level function */

error:  *jstat = kstat;
        s6err("S1786",*jstat,kpos);
        goto out;

out:
 return;
}


//===========================================================================
void s1785(SISLCurve *pcurve,SISLSurf *psurf,double aepsge,
	   double epar1[],double epar2[],int icur,int *jstat)
//===========================================================================
{
    int kstat;          /* Status variable                                 */
    int ki;             /* Counter.                                        */
    int kleftc=0;       /* Left indicator for point calculation            */
    int kleft1=0;       /* Left indicator for point calculation in 1. par.
			   direction of surface.                           */
    int kleft2=0;       /* Left indicator for point calculation in 2. par dir.*/
    int kleft1prev,kleft2prev;  /* Previous left indicators of surface.    */
    int khelp;          /* Help index of knot vector.                      */
    int kn;             /* The number of B-splines, i.e., the dimension of
			   the spline space associated with the knot
			   vector.                                         */
    int kk;             /* The polynomial order of the curve.              */
    int kk1,kk2,kn1,kn2;/* Orders and nu,ber of vertices of surface        */
    int kdimc;          /* The dimension of the space in which the curve
			   lies. Equivalently, the number of components
			   of each B-spline coefficient.                   */
    int kdims;          /* Dimension of space where the surface lies       */
    int kpos=0;         /* Position of error                               */
    int kderc=2;        /* Number of derivatives to be claculated on curve */
    int kders=1;        /* Number of derivatives to be calculated on surface
			   If step lenght is to be generated from surface,
			   kders must be equal to 2.                       */
    int kdum;           /* Temporary variable                              */
    int kpar;           /* Parameter value of constant parameter curve.    */
    double tclose1,tclose2;  /* Parameter values of closest point between curves. */
    double snorm[3];    /* Normal vector of surface                        */
    double s3dinf1[10]; /* Pointer to storage for point info of curve
			   (10 dobules prpoint when idim=3, 7 when idim=3) */
    double *st;         /* Pointer to the first element of the knot vector
			   of the curve. The knot vector has [kn+kk]
			   elements.                                       */
    double *st1;        /* First knot direction of surface                 */
    double *st2;        /* Second knot direction of surface                */
    double sfirst[2];   /* Start parameter par in surface                  */
    double slast[2];    /* End parameter par in surface                    */
    double tfirst;      /* Fist parameter on curve                         */
    double tend;        /* Last parameter on curve                         */
    double sderc[9];    /* Position, first and second derivative of curve  */
    double sders[18];   /* Position, first and second derivatives of surface */
    double tx,tx1,tx2;  /* Parameter value */
    double tcstep;      /* Step length based on curvature of objects.   */
    double tstep;       /* Final step length     */
    double tmaxinc;     /* Maximal increment in parameter value along curve*/
    double tlengthend;  /* Length of 1st derivative at end of segment */
    double tincre;      /* Parameter value increment */
    double tsmax,tcmax; /* Local maximal step length based of boxsizes of objects */
    double tdist;       /* Distance */
    double tref;        /* Referance value in equality test.               */
    double sstart[2];   /* Lower boundary of parameter intervals */
    double send[2];     /* Upper bounadry of parameter intervals */
    double snext[3];    /* Existing iteration point on  surface            */
    double spos[3];     /* New iteration  point on surface                 */
    double snext2[2];   /* Help parameter values.                          */
    SISLPoint *qpoint=SISL_NULL;
    SISLCurve *qc = SISL_NULL;   /* Constant parameter curve.                       */
      
    *jstat = 0;
      
    /* Make maximal step length based on box-size of surface */
      
    sh1992su(psurf,0,aepsge,&kstat);
    if (kstat < 0) goto error;
      
    tsmax = MAX(psurf->pbox->e2max[0][0] - psurf->pbox->e2min[0][0],
		psurf->pbox->e2max[0][1] - psurf->pbox->e2min[0][1]);
    tsmax = MAX(tsmax,psurf->pbox->e2max[0][2] - psurf->pbox->e2min[0][2]);
      
    /* Make maximal step length based on box-size of curve */
      
    sh1992cu(pcurve,0,aepsge,&kstat);
    if (kstat < 0) goto error;
      
    tcmax = MAX(pcurve->pbox->e2max[0][0] - pcurve->pbox->e2min[0][0],
		pcurve->pbox->e2max[0][1] - pcurve->pbox->e2min[0][1]);
    tcmax = MAX(tcmax,pcurve->pbox->e2max[0][2] - pcurve->pbox->e2min[0][2]);
      
    /* Copy curve attributes to local parameters.  */
      
    kdimc = pcurve -> idim;
    kk    = pcurve -> ik;
    kn    = pcurve -> in;
    st    = pcurve -> et;
      
    /* Copy surface attributes to local parameters.  */
      
    kdims = psurf -> idim;
    kk1   = psurf -> ik1;
    kk2   = psurf -> ik2;
    kn1   = psurf -> in1;
    kn2   = psurf -> in2;
    st1   = psurf -> et1;
    st2   = psurf -> et2;
      
    /* Set reference value.  */
      
    tref = MAX(st[kn]-st[kk-1],MAX(st1[kn1]-st1[kk1-1],st2[kn2]-st2[kk2-1]));

    /* Check that dimensions are 3 */
      
    if (kdimc != 3 || kdims != 3) goto err105;
      
    sstart[0] = st1[kk1-1];
    sstart[1] = st2[kk2-1];
    send[0] = st1[kn1];
    send[1] = st2[kn2];
      
    /* Copy interval description into local variables */
      
    if (icur ==1)
	if ( epar1[0]<epar2[0] )
	    {
		sfirst[0] = epar1[1];
		sfirst[1] = epar1[2];
		slast[0]  = epar2[1];
		slast[1]  = epar2[2];
		tfirst    = epar1[0];
		tend      = epar2[0];
	    }
	else
	    {
		sfirst[0] = epar2[1];
		sfirst[1] = epar2[2];
		slast[0]  = epar1[1];
		slast[1]  = epar1[2];
		tfirst    = epar2[0];
		tend      = epar1[0];
	    }
    else
	if ( epar1[2]<epar2[2] )
	    {
		sfirst[0] = epar1[0];
		sfirst[1] = epar1[1];
		slast[0]  = epar2[0];
		slast[1]  = epar2[1];
		tfirst    = epar1[2];
		tend      = epar2[2];
	    }
	else
	    {
		sfirst[0] = epar2[0];
		sfirst[1] = epar2[1];
		slast[0]  = epar1[0];
		slast[1]  = epar1[1];
		tfirst    = epar2[2];
		tend      = epar1[2];
	    }
      
    /* To make sure we do not start outside or end outside the curve we
       truncate tstart and tend to the knot interval of the curve */
      
    tfirst = MAX(tfirst,st[kk-1]);
    tend   = MIN(tend,st[kn]);
    if (DEQUAL(tfirst,tend)) goto out;
      
    /* Set start point of iteration on surface */
      
    spos[0] = sfirst[0];
    spos[1] = sfirst[1];
      
    /* Store knot values at start of curve */
      
    tx2 = tfirst;
    kdum = MAX(kk1,kk2);
    kdum = MAX(kdum,kk);
    tmaxinc = (tend-tfirst)/(kdum*kdum);      
      
    /* Make start point of curve  */
      
    s1221(pcurve,kderc,tx2,&kleftc,sderc,&kstat);
    if (kstat<0) goto error;
      
    /* Make start point of surface.  */
      
    s1421(psurf,kders,spos,&kleft1,&kleft2,sders,snorm,&kstat);
    if (kstat < 0) goto error;
      
    /* While end not reached */
      
    while (tx2 < tend)
	{
	    /* Save parameters of previous step.   */
	 
	    tx1 = tx2;
	    snext[0] = spos[0];
	    snext[1] = spos[1];
	    kleft1prev = kleft1;
	    kleft2prev = kleft2;
	 
	    /* Calculate unit tangent and radius of curvature of curve. */
	 
	    s1307(sderc,kdimc,s3dinf1,&kstat);
	    if (kstat<0) goto error;
	 
	    /* Calculate step length based on curvature */
	 
	    tcstep = s1311(s3dinf1[3*kdimc],aepsge,tsmax,&kstat);
	    if (kstat<0) goto error;
	 
	    /* Remember length of start tangent, end of zero segment */
	 
	    tlengthend = s6length(sderc+kdimc,kdimc,&kstat);
	    if (kstat<0) goto error;     
	 
	    /* Compute position, first and second derivative of the curve in the
	       surface going through the evaluated point in this point. 
	 
	       s1785_s9eval(sders,snorm,sderc+kdimc,sder2,kdims,&kstat);
	       if (kstat < 0) goto error;
	 
	       Calculate unit tangent and radius of curvature of curve in surface. 
	 
	       s1307(sder2,kdims,s3dinf2,&kstat);
	       if (kstat<0) goto error;
	 
	       Calculate step length based on curvature 
	 
	       tsstep = s1311(s3dinf2[3*kdims],aepsge,tcmax,&kstat);
	       if (kstat<0) goto error;
	 
	       Compute minimum step length.  
	 
	       tstep = MIN(tcstep,tsstep);  */

	    tstep = tcstep;
	 
	    /* Find candidate end point, make sure that no breaks in tangent or
	       curvature exists between start and endpoints of the segment      */
	 
	    /* Make step length equal to resolution if the length is zero */
	 
	    /* Find parameter value of candidate end point of segment */
	 
	    if (DEQUAL(tlengthend,DZERO))
		tincre = REL_PAR_RES;
	    else
		tincre = tstep/tlengthend;
	 
	    /* Make sure that we don't pass any knots of the curve. */
	 
	    tincre = MIN(tincre,tmaxinc);
	    tx2 = MIN(tx1 + tincre,st[kleftc+1]);
	 
	    for (ki=0, tx=(tx1+tx2)/(double)2.0; ki<2; ki++, tx=tx2)
		{
		    if (tx >= tend) break;
	    
		    /* Make point sderc at curve at tx */
	    
		    s1221(pcurve,kderc,tx,&kleftc,sderc,&kstat);
		    if (kstat<0) goto error;
	    
		    /* Find closest point on surface to sderc */
	    
		    qpoint = newPoint(sderc,kdimc,0);
		    if (qpoint==SISL_NULL) goto err101;
	    
		    snext2[0] = snext[0];
		    snext2[1] = snext[1];
		    s1773(qpoint,psurf,aepsge,sstart,send,snext2,spos,&kstat);
		    if(kstat<0) goto error;
	    
		    freePoint(qpoint);  qpoint = SISL_NULL;
	    
		    /* Calculate point and derivatives in surface */
	    
		    s1421(psurf,kders,spos,&kleft1,&kleft2,sders,snorm,&kstat);
		    if (kstat<0) goto error;
	    
		    /* Check if point on curve and surface are within positional and
		       angular tolerances */
	    
		    tdist = s6dist(sderc,sders,kdimc);
	    
		    if (tdist>aepsge)
			{
			    /* Points not within tolerances, curve and surface do not
			       coincide */
			    goto war01;
			}
	    
		    /* Check if any parameter lines of the surface is crossed in the 1. 
		       parameter direction.  */
	    
		    /* changed by Michael Metzger, Feb 1993 */
		    /* for (khelp=kleft1prev-1; DEQUAL(st1[khelp],st1[kleft1prev]); khelp--); */
		    for (khelp=kleft1prev-1; khelp >= 0 && DEQUAL(st1[khelp],st1[kleft1prev]); khelp--);
		    if (kleft1 != kleft1prev && 
			((DNEQUAL(spos[0]+tref,st1[kleft1]+tref) &&
			  DNEQUAL(snext[0]+tref,st1[kleft1]+tref)) || 
			 kleft1 != kleft1prev+1) &&
			((DNEQUAL(snext[0]+tref,st1[kleft1prev]+tref) &&
			  DNEQUAL(spos[0]+tref,st1[kleft1prev]+tref)) || kleft1 != khelp))
			{
			    /* At least one parameter line is crossed. Fetch the constant parameter
			       curve at the closest parameter line in the direction of the marching. */
	       
			    if (kleft1 > kleft1prev) kpar = kleft1prev + 1;
			    else if (snext[0] != st1[kleft1prev]) kpar = kleft1prev;
			    else kpar = khelp;
	       
			    /* Pick constant parameter curve.   */
	       
			    s1437(psurf,st1[kpar],&qc,&kstat);
			    if (kstat < 0) goto error;
	       
			    /* Find the closest point between the input curve and the constant
			       parameter curve.    */
	       
			    s1770(pcurve,qc,aepsge,tx1,st2[kk2-1],tx,st2[kn2],(tx1+tx)/(double)2.0,
				  st2[kleft2],&tclose1,&tclose2,&kstat);
			    if (kstat < 0) goto error;
	       
			    /* Set new parameter values to the iteration.  */
	       
			    spos[0] = st1[kpar];
			    spos[1] = tclose2;
			    tx2 = tclose1;
	       
			    /* Test midpoint of reduced step. First evaluate curve in midpoint. */
	       
			    tx = (tx1 + tx2)/(double)2.0;
			    s1221(pcurve,kderc,tx,&kleftc,sderc,&kstat);
			    if (kstat<0) goto error;
	       
			    /* Find closest point on surface to sderc */
	       
			    qpoint = newPoint(sderc,kdimc,0);
			    if (qpoint==SISL_NULL) goto err101;
	       
			    snext2[0] = snext[0];
			    snext2[1] = snext[1];
			    s1773(qpoint,psurf,aepsge,sstart,send,snext2,snext2,&kstat);
			    if(kstat<0) goto error;
	       
			    freePoint(qpoint);  qpoint = SISL_NULL;
	       
			    /* Calculate point and derivatives in surface */
	       
			    s1421(psurf,kders,snext2,&kleft1,&kleft2,sders,snorm,&kstat);
			    if (kstat<0) goto error;
	       
			    /* Check if point on curve and surface are within positional and
			       angular tolerances */
	       
			    tdist = s6dist(sderc,sders,kdimc);
	       
			    if (tdist>aepsge)
				{
				    /* Points not within tolerances, curve and surface do not
				       coincide */
				    goto war01;
				}

			    /* Calculate point and derivatives in the curve in the endpoint of the step. */
	       
			    s1221(pcurve,kderc,tx2,&kleftc,sderc,&kstat);
			    if (kstat<0) goto error;
	       
			    /* Calculate point and derivatives in the surface.  */
	       
			    s1421(psurf,kders,spos,&kleft1,&kleft2,sders,snorm,&kstat);
			    if (kstat<0) goto error;
	       
			    /* Check if point on curve and surface are within positional and
			       angular tolerances */
	       
			    tdist = s6dist(sderc,sders,kdimc);
	       
			    if (tdist>aepsge)
				{
				    /* Points not within tolerances, curve and surface do not
				       coincide */
				    goto war01;
				}
	       
			    /* Mark that a new step is to be initiated.  */
	       
			    ki = 2;
	       
			    /* Free constant parameter curve.  */
	       
			    if (qc != SISL_NULL) freeCurve(qc);  qc = SISL_NULL;
			}
	    
		    /* Check if any parameter lines of the surface is crossed in the 2. 
		       parameter direction.  */
	    
		    /* changed by Michael Metzger, Feb 1993 */
		    /* for (khelp=kleft2prev-1; DEQUAL(st2[khelp],st2[kleft2prev]); khelp--); */
		    for (khelp=kleft2prev-1; khelp >= 0 && DEQUAL(st2[khelp],st2[kleft2prev]); khelp--);
		    if (kleft2 != kleft2prev && 
			((DNEQUAL(spos[1]+tref,st2[kleft2]+tref) &&
			  DNEQUAL(snext[1]+tref,st2[kleft2]+tref)) || 
			 kleft2 != kleft2prev+1) &&
			((DNEQUAL(snext[1]+tref,st2[kleft2prev]+tref) &&
			  DNEQUAL(spos[1]+tref,st2[kleft2prev]+tref)) ||
			 kleft2 != khelp))
			{
			    /* At least one parameter line is crossed. Fetch the constant parameter
			       curve at the closest parameter line in the direction of the marching. */
	       
			    if (kleft2 > kleft2prev) kpar = kleft2prev + 1;
			    else if (snext[1] != st2[kleft2prev]) kpar = kleft2prev;
			    else kpar = khelp;
	       
			    /* Pick constant parameter curve.   */
	       
			    s1436(psurf,st2[kpar],&qc,&kstat);
			    if (kstat < 0) goto error;
	       
			    /* Find the closest point between the input curve and the constant
			       parameter curve.    */
	       
			    s1770(pcurve,qc,aepsge,tx1,st1[kk1-1],tx,st1[kn1],(tx1+tx)/(double)2.0,
				  st1[kleft1],&tclose1,&tclose2,&kstat);
			    if (kstat < 0) goto error;
	       
			    /* Set new parameter values to the iteration.  */
	       
			    spos[0] = tclose2;
			    spos[1] = st2[kpar];
			    tx2 = tclose1;
	       
			    /* Test midpoint of reduced step. First evaluate curve in midpoint. */
	       
			    tx = (tx1 + tx2)/(double)2.0;
			    s1221(pcurve,kderc,tx,&kleftc,sderc,&kstat);
			    if (kstat<0) goto error;
	       
			    /* Find closest point on surface to sderc */
	       
			    qpoint = newPoint(sderc,kdimc,0);
			    if (qpoint==SISL_NULL) goto err101;
	       
			    snext2[0] = snext[0];
			    snext2[1] = snext[1];
			    s1773(qpoint,psurf,aepsge,sstart,send,snext2,snext2,&kstat);
			    if(kstat<0) goto error;
	       
			    freePoint(qpoint);  qpoint = SISL_NULL;
	       
			    /* Calculate point and derivatives in surface */
	       
			    s1421(psurf,kders,snext2,&kleft1,&kleft2,sders,snorm,&kstat);
			    if (kstat<0) goto error;
	       
			    /* Check if point on curve and surface are within positional and
			       angular tolerances */
	       
			    tdist = s6dist(sderc,sders,kdimc);
	       
			    if (tdist>aepsge)
				{
				    /* Points not within tolerances, curve and surface do not
				       coincide */
				    goto war01;
				}

			    /* Calculate point and derivatives in the curve.    */
	       
			    s1221(pcurve,kderc,tx2,&kleftc,sderc,&kstat);
			    if (kstat<0) goto error;
	       
			    /* Calculate point and derivatives in the surface.  */
	       
			    s1421(psurf,kders,spos,&kleft1,&kleft2,sders,snorm,&kstat);
			    if (kstat<0) goto error;
	       
			    /* Check if point on curve and surface are within positional and
			       angular tolerances */
	       
			    tdist = s6dist(sderc,sders,kdimc);
	       
			    if (tdist>aepsge)
				{
				    /* Points not within tolerances, curve and surface do not
				       coincide */
				    goto war01;
				}
	       
			    /* Mark that a new step is to be initiated.  */
	       
			    ki = 2;
	       
			    /* Free constant parameter curve.  */
	       
			    if (qc != SISL_NULL) freeCurve(qc);  qc = SISL_NULL;
			}
		}
	}
      
    /* Curves within tolerance. Test on whether the start- and
       endpoint of the curve are identical.                      */
      
    *jstat = (DEQUAL(tfirst,tend)) ? 0 : 1;
    goto out;
      
    /* Curve and surface not within tolerance */
 war01: *jstat = 0;
    goto out;
      
    /* Error in memory allocation */
      
 err101: *jstat = -101;
    s6err("S1785",*jstat,kpos);
    goto out;
      
    /* Error in input, dimension not equal to 2 or 3 */
      
 err105: *jstat = -105;
    s6err("S1785",*jstat,kpos);
    goto out;
      
    /* Error in lower level function */
      
 error:  *jstat = kstat;
    s6err("S1785",*jstat,kpos);
    goto out;
      
      
 out:
	 
    return;
}          


//===========================================================================
void s1880(int ipar1,int ipar2,int *jpt,SISLIntpt **vpoint,int *jlist,
	   SISLIntlist **vlist,int *jpar,double **gpar1,double **gpar2,
	   int *jcrv,SISLIntcurve ***wcrv,int *jstat)
//===========================================================================
{
  int kpos = 0;         /* Position of error.                          */
  int ki,kj,kk;         /* Counters.                                   */
  int kpoint;           /* Number of points in an intersection list.   */
  int klst;             /* Kind of intersection list. (See SISLIntlist).   */
  int ktype;            /* Kind of intersection curve. (See SISLIntcurve). */
  int kpt;              /* Used to find number of single intersection points.*/
  double *spar1,*spar2; /* Values of points belonging to an intersection
			   curve in the parameter area of the objects
			   involved in the intersection.               */
  double *stpar1,*stpar2,*stpar3; /* Pointers used to travers arrays 
				     containing parameter values.      */ 
  SISLIntcurve **ucrv;      /* Pointer used to traverse *wcrv array.    */
  SISLIntlist **ulst;       /* Pointer used to traverse vlist array.     */
  SISLIntpt *qpt;           /* Pointer to an intersection point.         */
  SISLIntpt **upt;          /* Pointer used to travers vpoint array.     */
  
  /* Initiate output arrays.  */
  
  *gpar1 = *gpar2 = SISL_NULL;  *wcrv = SISL_NULL;
  
  /* Allocate space for intersection curve array.  */
  
  *jcrv = *jlist;
  *wcrv = newarray(*jlist,SISLIntcurve*);
  if ((*jcrv) > 0 && *wcrv == SISL_NULL) goto err101;
  
  /* Transfer curve-information from vlist array to wcrv array. */
  
  ucrv = *wcrv;
  ulst = vlist;
  kpt = 0;
  for (ki=0; ki<(*jlist); ki++)
    {
      qpt = (*ulst) -> pfirst;
      
      /* Allocate space for arrays containing parameter vlaues of points 
	 in intersection curves.                                          */
      
      kpoint = (*ulst) -> inumb;
      if (kpoint == 0) goto err137;
      spar1 = newarray(ipar1*kpoint,double);
      spar2 = newarray(ipar2*kpoint,double);
      if ((ipar1 > 0 && spar1 == SISL_NULL) ||
	  (ipar2 > 0 && spar2 == SISL_NULL)) goto err101;
      
      /* Collect parameter values of the points in this intersection list
	 and distribute values to the objects in the intersection.         */
      
      kj = 0;
      stpar1 = spar1;   
      stpar2 = spar2;
      while (qpt != SISL_NULL && qpt -> ipar != -1)
	{
	  stpar3 = qpt -> epar;
	  for (kk=0; kk<ipar1; kk++) *(stpar1++) = *(stpar3++);
	  for (kk=0; kk<ipar2; kk++) *(stpar2++) = *(stpar3++);
	  qpt -> ipar = -1;
	  qpt = qpt -> pcurve;
	  kj++;
	}
      
      /* Find kind of intersection curve.  */
      
      klst = (*ulst) -> itype;
      if (klst == 0) ktype = 4;
      else if (klst == 1) ktype = 2;
      else if (klst == 2) ktype = 5;
      else if (klst == 3) ktype = 6;
      else if (klst == 4) ktype = 7;
      else if (klst == 5) ktype = 8;
      else goto err146;             
      
      /* Create new intersection curve.  */
      
      *ucrv = newIntcurve(kj,ipar1,ipar2,spar1,spar2,ktype);
      if (*ucrv == SISL_NULL) goto err101;
      
      kpt += kj;
      ucrv++;
      ulst++;
    }                  
  
  /* Find number of single intersection points.  */
  
  kpt = *jpt - kpt;
  
  /* Create arrays to keep parameter values of intersection points.  */
  
  *gpar1 = newarray(ipar1*kpt,double);
  *gpar2 = newarray(ipar2*kpt,double);
  if ((ipar1*kpt > 0 && *gpar1 == SISL_NULL) 
      || (ipar2*kpt > 0 && *gpar2 == SISL_NULL)) goto err101;
  
  /* Copy parameters of single intersection points into output-arrays. */
  
  kj = 0;
  upt = vpoint; 
  stpar1 = *gpar1;
  stpar2 = *gpar2;
  for (ki=0; ki<(*jpt); ki++)
    {
      qpt = *upt;     
      if (qpt != SISL_NULL)
	{  
	  if (qpt -> ipar != -1)
	    {
	      kj++;
	      stpar3 = qpt -> epar;
	      for (kk=0; kk<ipar1; kk++) *(stpar1++) = *(stpar3++);
	      for (kk=0; kk<ipar2; kk++) *(stpar2++) = *(stpar3++);
	    }     
	  
	  /* Free space occupied by current intersection point.  */
	  
	  freeIntpt(qpt);
	}
      
      upt++;
    }
  
  *jpar = kj;
  
  /* Adjust output arrays to correct length.  */
  
  if (kj*ipar1 > 0)
    {
      if ((*gpar1 = increasearray(*gpar1,kj*ipar1,double)) == SISL_NULL) goto err101;
    }
  else 
    {
      if (*gpar1 != SISL_NULL) freearray(*gpar1);
      *gpar1 = SISL_NULL;
    }
  if (kj*ipar2 > 0)
    {
      if ((*gpar2 = increasearray(*gpar2,kj*ipar2,double)) == SISL_NULL) goto err101;
    }
  else 
    {
      if (*gpar2 != SISL_NULL) freearray(*gpar2);
      *gpar2 = SISL_NULL;
    }
  
  /* Intersections copied to output format.  */
  
  *jpt = 0;
  *jstat = 0;
  goto out;
  
  /* Error in space allocation.  */
  
 err101: *jstat = -101;
  s6err("s1880",*jstat,kpos);
  goto out;
  
  /* Error in data-strucuture. Expected intersection point not found. */
  
 err137: *jstat = -137;
  s6err("s1880",*jstat,kpos);
  goto out;
  
  /* Unknown kind of intersection type.  */
  
 err146: *jstat = -146;
  s6err("s1880",*jstat,kpos);
  goto out;
  
 out: return;
}                                   



//===========================================================================
SISLIntlist *newIntlist (SISLIntpt * pfirst, SISLIntpt * plast, int itype)
//===========================================================================
{
  SISLIntlist *pnew;		/* Local pointer to this instance. */

  /* Allocate space for the instance.  */

  pnew = newarray (1, SISLIntlist);
  if (pnew == SISL_NULL)
    goto err101;

  /* Initialize.  */

  pnew->pfirst = pfirst;
  pnew->plast = plast;
  pnew->itype = itype;
  pnew->inumb = 2;

  /* Tast done. */

  goto out;

  /* Error in space allocation. Return zero.  */

err101:pnew = SISL_NULL;
  goto out;

out:return (pnew);
}


//===========================================================================
void s6decomp(double ea[],double gx[],double eb1[],double eb2[],
	      double eb3[],int *jstat)
//===========================================================================
{
  int kstat =0;       /* Local status variable.    */
  int ki;             /* Counter.                  */
  int n1[3];          /* Array for use in lufac.   */
  double sc[9],se[3]; /* Matrix and help vector.   */
  
  
  /* Copy new bases into local matrix.  */
  
  memcopy(sc,eb1,3,double);
  memcopy(sc+3,eb2,3,double);
  memcopy(sc+6,eb3,3,double);
  
  
  s6lufacp(sc,n1,3,&kstat);
  if (kstat < 0) goto error;
  else if (kstat > 0) goto warn1;
  
  for (ki=0; ki<3; ki++)
    {                      
      se[0] = se[1] = se[2] = DZERO;
      se[ki] = (double)1;
      
      s6lusolp(sc,se,n1,3,&kstat);
      if (kstat < 0) goto error;
      else if (kstat > 0) goto warn1;
      
      gx[ki] = s6scpr(ea,se,3);
    }
  
  /* Change of bases performed.  */
  
  *jstat = 0;
  goto out;

/* Singular equation system.  */

warn1 : *jstat = 1;
        goto out;

/* Error in subrutines.  */

error: *jstat = kstat;
        s6err("s6decomp",*jstat,0);
        goto out;

 out: ;
}


//===========================================================================
void s1788(SISLSurf *ps1,SISLSurf *ps2,double aepsge,double epar[],
	   double gpar1[],double gpar2[],int *jstat)
//===========================================================================
{
  int kpos=0;           /* Position of error                           */
  int kk1,kk2,kn1,kn2;  /* Orders and numbers of vertices              */
  int kstat;            /* Status variable                             */
  int kmark1,kmark2,kclose,kmatch1,kmatch2; /* Flags                   */
  int kcur,kgraph;      /* Indicators telling to control type of output
			   from marching                               */
  double sval1[2];      /* Limits of parameter plane in first SISLdir      */
  double sval2[2];      /* Limits of parameter plane in second SISLdir     */
  double sval3[2];      /* Limits of parameter plane in third SISLdir      */
  double sval4[2];      /* Limits of parameter plane in fourth SISLdir     */
  double *st1,*st2;     /* Knots and vertices of input surface         */
  double tmax;          /* Box size                                    */
  double tepsge;   
  double *spar11,*spar12;/* Pointers to arrays                         */
  double *spar21,*spar22;/* Pointers to arrays                         */

  /* UJK, Nov 1990 */
  /*  double *spar=SISL_NULL; */
  double *spar1=SISL_NULL;     /* Pointer to allocated values for parameter values*/
  double *spar2=SISL_NULL;     /* Pointer to allocated values for parameter values*/

  SISLCurve *qcrv;           /* Curve in parameter plane                    */
  SISLIntcurve *qintcr=SISL_NULL; /* Intersection curve object            */
  
  /* Find limits of parameter plane */
  
  kk1   = ps1 -> ik1;
  kk2   = ps1 -> ik2;
  kn1   = ps1 -> in1;
  kn2   = ps1 -> in2;
  st1   = ps1 -> et1;
  st2   = ps1 -> et2;
  sval1[0] = st1[kk1-1];
  sval1[1] = st1[kn1];
  sval2[0] = st2[kk2-1];
  sval2[1] = st2[kn2];
  
  kk1   = ps2 -> ik1;
  kk2   = ps2 -> ik2;
  kn1   = ps2 -> in1;
  kn2   = ps2 -> in2;
  st1   = ps2 -> et1;
  st2   = ps2 -> et2;
  sval3[0] = st1[kk1-1];
  sval3[1] = st1[kn1];
  sval4[0] = st2[kk2-1];
  sval4[1] = st2[kn2];
  
  
  /* Make maximal step length based on box-size of surface */
  
  sh1992su(ps1,0,aepsge,&kstat);
  if (kstat < 0) goto error;
  
  tmax = MAX(ps1->pbox->e2max[0][0] - ps1->pbox->e2min[0][0],
	     ps1->pbox->e2max[0][1] - ps1->pbox->e2min[0][1]);
  tmax = MAX(tmax,ps1->pbox->e2max[0][2] - ps1->pbox->e2min[0][2]);
  
  sh1992su(ps2,0,aepsge,&kstat);
  if (kstat < 0) goto error;
  
  tmax = MAX(tmax,ps2->pbox->e2max[0][0] - ps2->pbox->e2min[0][0]);
  tmax = MAX(tmax,ps2->pbox->e2max[0][1] - ps2->pbox->e2min[0][1]);
  tmax = MAX(tmax,ps2->pbox->e2max[0][2] - ps2->pbox->e2min[0][2]);
  
  tepsge = tmax * (double)0.01;
  

  kgraph = 0;
  kcur   = 3;
  
  /* Make an intersection curve object with the parameter value */
  /* UJK, Nov 1990 */  
  /*  if ((spar=newarray(4,DOUBLE))==SISL_NULL) goto err101;
      memcopy(spar,epar,4,DOUBLE); */
  if ((spar1=newarray(2,DOUBLE))==SISL_NULL) goto err101;
  memcopy(spar1,epar,2,DOUBLE);
  if ((spar2=newarray(2,DOUBLE))==SISL_NULL) goto err101;
  memcopy(spar2,epar+2,2,DOUBLE);
  
  /* UJK, Nov 1990 */  
  /* if((qintcr = newIntcurve(1,2,2,epar,epar+2,0)) == SISL_NULL) goto err101; */
  if((qintcr = newIntcurve(1,2,2,spar1,spar2,0)) == SISL_NULL) goto err101;
  
  kcur = 2;
  kgraph = 0;
  tmax = (double)0.0;

  
  s1310(ps1,ps2,qintcr,tepsge,tmax,kcur,kgraph,&kstat);
  
  if (kstat==-185) goto war00;
  if (kstat<0) goto error;
  
  /* Identify first and last parameter pair in the intersection curve */
  
  qcrv = qintcr -> ppar1;
  if (qcrv == SISL_NULL) goto war00;
  
  spar11 = qcrv -> ecoef;
  spar21 = spar11 + 2*(qcrv->in)-2;
  
  
  qcrv = qintcr -> ppar2;
  if (qcrv == SISL_NULL) goto war00;
  
  spar12 = qcrv -> ecoef;
  spar22 = spar12 + 2*(qcrv->in)-2;
  
  /* Check if any of the points lie on the boundary */
  
  kmark1 = 0;
  if (spar11[0] == sval1[0] || spar11[0] == sval1[1] ||
      spar11[1] == sval2[0] || spar11[1] == sval2[1] ||
      spar12[0] == sval3[0] || spar12[0] == sval3[1] ||
      spar12[1] == sval4[0] || spar12[1] == sval4[1] ) kmark1 = 1;
  
  kmark2 = 0;
  if (spar21[0] == sval1[0] || spar21[0] == sval1[1] ||
      spar21[1] == sval2[0] || spar21[1] == sval2[1] ||
      spar22[0] == sval3[0] || spar22[0] == sval3[1] ||
      spar22[1] == sval4[0] || spar22[1] == sval4[1] ) kmark2 = 1;
  
  
  /* Check if closed */
  
  kclose = 0;
  if (spar11[0] == spar21[0] && spar11[1] == spar21[1]  &&
      spar12[0] == spar22[0] && spar12[1] == spar22[1]     ) kclose = 1;
  
  /* Check if first points matches start point */
  
  kmatch1 = 0;
  if (DEQUAL(epar[0],spar11[0]) && DEQUAL(epar[1],spar11[1]) &&
      DEQUAL(epar[2],spar12[0]) && DEQUAL(epar[3],spar12[1])   ) kmatch1 = 1;
  
  /* Check if second points matches start point */
  
  kmatch2 = 0;
  if (DEQUAL(epar[0],spar21[0]) && DEQUAL(epar[1],spar21[1]) &&
      DEQUAL(epar[2],spar22[0]) && DEQUAL(epar[3],spar22[1]) ) kmatch2 = 1;
  
  
  /* Check if any point matches start point */
  
  if (kmatch1 == 1 || kmatch2 == 1)
    {
      /* Start point matches one of the end points, status values in
	 the range 11-19*/
      
      if (kmark1 == 1 && kmark2 == 1 && kclose == 0)
        {
	  /* Open curve, status 11 */
	  *jstat = 11;
	  if(kmatch1==1)
            goto copy;
	  else
            goto invcopy;
        }
      else if (kmark1 ==1 || (kmark2 == 1 && kclose == 0))
	{
	  /* Open curve one point inside status 12 or 13 */
	  
	  if (kmark1 == 1 && kmatch1 == 1)
	    {
	      *jstat = 12;
	      goto copy;
	    }
	  else if (kmark2 == 1 && kmatch2 == 1)
	    {
	      *jstat = 12;
	      goto invcopy;
	    }
	  if (kmark1 == 1 && kmatch2 == 1)
	    {
	      *jstat = 13;
	      goto invcopy;
	    }
	  if (kmark2 == 1 && kmatch1 == 1)
	    {
	      *jstat = 13;
	      goto copy;
	    }
        }
      else if (kclose == 0)
	{
	  /* Both ends inside */
	  *jstat = 14;
	  if(kmatch1==1)
            goto copy;
	  else
            goto invcopy;
	}
      else if(kmatch1 == 1)
	{
	  /* Closed curve, no singularity */
	  *jstat = 16;
	  memcopy(gpar1,  spar11,2,DOUBLE);
	  memcopy(gpar1+2,spar12,2,DOUBLE);
	  memcopy(gpar2,  gpar1, 4,DOUBLE);
	  goto out;
	}
      else
	{
	  /* Closed curve, with singularity */
	  *jstat=17;
	  memcopy(gpar1,  epar,  4,DOUBLE);
	  memcopy(gpar2,  spar11,2,DOUBLE);
	  memcopy(gpar2+2,spar12,2,DOUBLE);
	  goto out;
	}
    }
  else
    {
      /* epar does not match produced end points, status messages in
	 21-29 the range  */
      
      if (kmark1 ==1 && kmark2 ==1 && kclose == 0)
        {
	  /* Open curve, status 11 */
	  *jstat = 21;
	  goto copy;
        }
      else if (kmark1 ==1 && kclose == 0)
	{
	  /* Open curve one point inside status 12 */
	  *jstat=22;
	  goto copy;
	}
      else if (kmark2 ==1 && kclose == 0)
	{
	  /* Open curve one point inside status 12 */
	  *jstat=22;
	  goto invcopy;
	}
      else if (kclose == 0)
	{
	  /* Both ends inside */
	  *jstat=24;
	  goto copy;
	}
      else if(kmatch1 == 1)
	{
	  /* Closed curve, no singularity */
	  *jstat=26;
	  memcopy(gpar1,  spar11,2,DOUBLE);
	  memcopy(gpar1+2,spar12,2,DOUBLE);
	  memcopy(gpar2,  gpar1, 4,DOUBLE);
	}
      else
	{
	  /* Closed curve, with singularity */
	  *jstat = 27;
	  memcopy(gpar1,  epar,  4,DOUBLE);
	  memcopy(gpar2  ,spar11,2,DOUBLE);
	  memcopy(gpar2+2,spar12,2,DOUBLE);
	  goto out;
	}
    }

  /* Marching produced no curve */

 war00: 
  *jstat = 0;
  memcopy(gpar1,epar,4,DOUBLE);
  memcopy(gpar2,epar,4,DOUBLE);
  goto out;

 copy:
  memcopy(gpar1,  spar11,2,DOUBLE);
  memcopy(gpar1+2,spar12,2,DOUBLE);
  memcopy(gpar2,  spar21,2,DOUBLE);
  memcopy(gpar2+2,spar22,2,DOUBLE);
  goto out;

 invcopy:
  memcopy(gpar1,  spar21,2,DOUBLE);
  memcopy(gpar1+2,spar22,2,DOUBLE);
  memcopy(gpar2,  spar11,2,DOUBLE);
  memcopy(gpar2+2,spar12,2,DOUBLE);
  goto out;

  /* Error in space allocation */
 err101: 
  *jstat = -101;
  s6err("s1788",*jstat,kpos);
  goto out;

  /* Error in lower level function */
 error:
  *jstat = kstat;
  s6err("s1788",*jstat,kpos);
  goto out;

 out:
  if (qintcr != SISL_NULL) freeIntcurve(qintcr);
}


//===========================================================================
void freeIntlist(SISLIntlist *plist)
//===========================================================================
{
  /* Free space. */

  freearray(plist);

  return;
}

//===========================================================================
void s6idklist(SISLIntdat **pintdat,SISLIntlist *pintlist,int *jstat)
//===========================================================================
{
  SISLIntpt *qkillpt,*qnext,*qdum1,*qdum2;
  
  int ki,knum,kstat;  
  
  *jstat = 0;
  
  /* We have to be sure that we have an intdat structure. */
  
  if ((*pintdat) == SISL_NULL)
    goto out;
  
  if (pintlist == SISL_NULL)
    {
      *jstat = 1;
      goto out;
    }
  
  /* Now we have to find the index in the vlist array in pintdat. */
  
  
  for (ki=0,knum = -1; ki < (*pintdat)->ilist; ki++)
    if ((*pintdat)->vlist[ki] == pintlist)
      {
	knum = ki;
	break;
      }
  
  if (knum == -1)
    /* Not in the pintdat list. */
    *jstat = 1;
  else
    {
      pintlist->plast->pcurve = SISL_NULL;
      
      /* Kill all points in the list. */
      for (ki=0,qkillpt=pintlist->pfirst,qnext=qkillpt->pcurve;
	   qnext!=SISL_NULL;
	   qkillpt=qnext,qnext=qnext->pcurve)
	{
	  s6idkpt(pintdat,&qkillpt,&qdum1,&qdum2,&kstat);
	  if (kstat < 0) goto error;
	}
      s6idkpt(pintdat,&qkillpt,&qdum1,&qdum2,&kstat);
      if (kstat < 0) goto error;
      
      /* Update pintdat. */
      if ((*pintdat) != SISL_NULL)
	{
	  (*pintdat)->vlist[knum] = (*pintdat)->vlist[(*pintdat)->ilist-1];
	  ((*pintdat)->ilist)--;
	  (*pintdat)->vlist[(*pintdat)->ilist] = SISL_NULL;
	}
      freeIntlist(pintlist);
    }
  
  goto out;  
  
  error : *jstat = kstat;
  s6err("s6idklist",*jstat,0);
  goto out;                       
  
  out: ;
}


//===========================================================================
SISLIntcurve *newIntcurve (int ipoint, int ipar1, int ipar2,
			   double *epar1, double *epar2, int itype)
//===========================================================================
{
  SISLIntcurve *qnew;

  /* Allocate space for the new Intcurve.  */

  qnew = newarray (1, SISLIntcurve);
  if (qnew == SISL_NULL)
    goto err101;

  /* Set variables of the intersection curve.  */

  qnew->ipoint = ipoint;
  qnew->ipar1 = ipar1;
  qnew->ipar2 = ipar2;
  qnew->epar1 = epar1;
  qnew->epar2 = epar2;
  qnew->pgeom = SISL_NULL;
  qnew->ppar1 = SISL_NULL;
  qnew->ppar2 = SISL_NULL;
  qnew->itype = itype;

  /* Task done.  */

  goto out;

  /* Error in space allocation. Return zero.  */

err101:qnew = SISL_NULL;
  goto out;

out:return (qnew);
}


//===========================================================================
void s1787(SISLSurf *ps,double alevel,double aepsge,double epar[],
	   double gpar1[],double gpar2[],int *jstat)
//===========================================================================
{
  int kdeg=1;           /* Indicate that a plane is used               */
  int kk1,kk2,kn1,kn2;  /* Orders and numbers of vertices              */
  int kstat;            /* Status variable                             */
  int kkm1,kkm2;        /* Orders minus 1                              */
  int kincre;           /* Number of doubles in first vertex direction */
  int kpos=0;           /* Position of error                           */
  int ki,kj,kl,kstop;
  int kcur,kgraph;      /* Indicators telling to control type of output
			   from marching                               */
  int kmark1,kmark2,kclose,kmatch1,kmatch2; /* Flags                   */
  double tmax;          /* Box size                                    */
  double tstart,tlength;/* Variables used in Marsdens identity         */
  double tfak;
  double tdum1;         /* Max knot value used in DEQUAL comparing.    */
  double tdum2;         /* Max knot value used in DEQUAL comparing.    */
  double tsum,*sp,*sq;
  double simpli[4];     /* Description of plane                        */
  double *st1,*st2,*scoef; /* Knots and vertices of input surface      */
  double *s3coef=SISL_NULL;  /* 3-D coeff                                   */
			   
  double tepsco = REL_COMP_RES;
  double tepsge;   
  double sval1[2];      /* Limits of parameter plane in first SISLdir      */
  double sval2[2];      /* Limits of parameter plane in second SISLdir     */
  double *spar1,*spar2; /* Pointers to arrays                          */
  double *spar=SISL_NULL;    /* Pointer to allocated values for parameter values*/
  SISLSurf *qs=SISL_NULL;    /* 3-D version of surface                     */
  SISLCurve *qcrv;          /* Curve in parameter plane                   */
  SISLIntcurve *qintcr=SISL_NULL;/* Intersection curve object            */
  kk1   = ps -> ik1;
  kk2   = ps -> ik2;
  kn1   = ps -> in1;
  kn2   = ps -> in2;
  st1   = ps -> et1;
  st2   = ps -> et2;
  scoef = ps -> ecoef;
  sval1[0] = st1[kk1-1];
  sval1[1] = st1[kn1];
  sval2[0] = st2[kk2-1];
  sval2[1] = st2[kn2];
  
  /* Allocate array for 3-D representation of surface */
  
  if((s3coef = newarray(kn1*kn2*3,DOUBLE)) == SISL_NULL) goto err101;
  
  sh1992su(ps,0,aepsge,&kstat);
  if (kstat < 0) goto error;
  
  tmax = ps->pbox->e2max[0][0] - ps->pbox->e2min[0][0];
  
  /* Make description of plane */
  
  simpli[0] = (double)0.0;
  simpli[1] = (double)0.0;
  simpli[2] = (double)1.0;
  simpli[3] = -alevel;
  
  /* Make 3-D description of the surface */
  
  
  /* Make representation of coefficients from Marsdens identity for the
   * function f(t) = t, with the knot vector in first parameter direction
   * scaled to [0,tmax]. This will be used as the x-coordinate in the 3-D
   * representation */
  
  tstart = st1[kk1-1];
  tlength = st1[kn1] - tstart;
  tfak = tmax/tlength;
  kkm1 = kk1 - 1;
  kincre = 3*kn1;
  
  for (ki=0,kl=0,sp=s3coef ; ki<kn1 ; ki++,kl+=3,sp+=3)
    {
      tsum = (double)0.0;
      kstop = ki+kk1;
      for (kj=ki+1;kj<kstop;kj++)
        tsum +=st1[kj];
      
      tsum = (tsum/kkm1-tstart)*tfak;
      
      
      /* Copy x-coordinate to the other vertex rows */
      /*UJK,changed from kj<kn to kj<kn2.*/      
      for (kj=0,sq=sp ; kj<kn2 ; kj++,sq+=kincre) *sq = tsum;
      
    }
  
  /* Make representation of coefficients from Marsdens identity for the
   * function f(t) = t, with the knot vector in second parameter direction
   * scaled to [0,tfak].  This will be used as the x-coordinate in the 3-D
   * representation */
  
  kkm2 = kk2 - 1;
  tstart = st2[kk2-1];
  tlength = st2[kn2] - tstart;
  tfak = tmax/tlength;
  for (ki=0,sp=s3coef+1 ; ki< kn2 ; ki++)
    {
      tsum = (double)0.0;
      kstop = ki+kk2;
      for (kj=ki+1;kj<kstop;kj++)
        tsum +=st2[kj];
      
      tsum  = (tsum/kkm2-tstart)*tfak;
      
      /*  Copy to remaining y-coordinates in first vertex row */
      
      for (kj=0 ; kj<kn1 ; kj++,sp+=3) *sp = tsum;
      
    }
  
  /* Copy z-coordinates */
  
  for (kj=0,sp=s3coef+2,sq=scoef ; kj < kn2 ; kj++)
    for (ki=0 ; ki<kn1 ; ki++,sp+=3,sq++)
      *sp = *sq;
  
  /* Make 3-D surface */
  
  if((qs = newSurf(kn1,kn2,kk1,kk2,st1,st2,s3coef,1,3,1)) == SISL_NULL) goto err101;
  
  kgraph = 0;
  kcur   = 3;

  /* Make an intersection curve object with the parameter value */
  
  if ((spar=newarray(2,DOUBLE))==SISL_NULL) goto err101;
  memcopy(spar,epar,2,DOUBLE);
  
  if((qintcr = newIntcurve(1,2,0,spar,SISL_NULL,0)) == SISL_NULL) goto err101;
  
  kcur = 2;
  kgraph = 0;
  tepsge = tmax*(double)0.01;
  s1313(qs,simpli,kdeg,tepsco,tepsge,tmax,qintcr,kcur,kgraph,&kstat);
  if (kstat==-185) goto war00;
  if (kstat<0) goto error;
  
  /* Identify first and last parameter pair in the intersection curve */
  
  qcrv = qintcr -> ppar1;
  if (qcrv == SISL_NULL) goto war00;
  
  spar1 = qcrv -> ecoef;
  spar2 = spar1 + 2*(qcrv->in)-2;
  /* Check if any of the points lie on the boundary */
  
  kmark1 = 0;
  tdum1 = (double)2.0*max(fabs(sval1[0]),fabs(sval1[1]));
  tdum2 = (double)2.0*max(fabs(sval2[0]),fabs(sval2[1]));

  if (DEQUAL(spar1[0]+tdum1,sval1[0]+tdum1) || DEQUAL(spar1[0]+tdum1,sval1[1]+tdum1) ||
      DEQUAL(spar1[1]+tdum2,sval2[0]+tdum2) || DEQUAL(spar1[1]+tdum2,sval2[1]+tdum2) )
    kmark1 = 1;
  
  kmark2 = 0;

  if (DEQUAL(spar2[0]+tdum1,sval1[0]+tdum1) || DEQUAL(spar2[0]+tdum1,sval1[1]+tdum1) ||
      DEQUAL(spar2[1]+tdum2,sval2[0]+tdum2) || DEQUAL(spar2[1]+tdum2,sval2[1]+tdum2) )
    kmark2 = 1;
  
  /* Check if closed */
  
  kclose = 0;
  if (spar1[0] == spar2[0] && spar1[1] == spar2[1]) kclose = 1;
  
  /* Check if first points matches start point */
  
  kmatch1 = 0;
  if (DEQUAL(epar[0]+tdum1,spar1[0]+tdum1) && DEQUAL(epar[1]+tdum2,spar1[1]+tdum2) ) 
    kmatch1 = 1;
  
  /* Check if second points matches start point */
  
  kmatch2 = 0;
  if (DEQUAL(epar[0]+tdum1,spar2[0]+tdum1) && DEQUAL(epar[1]+tdum2,spar2[1]+tdum2) ) 
    kmatch2 = 1;
  
  /* Check if any point matches start point */
  
  if (kmatch1 == 1 || kmatch2 == 1)
    {
      /*  Start point matches one of the end points, status values in
	  the range 11-19*/
      
      if (kmark1 == 1 && kmark2 == 1 && kclose == 0)
        {
	  /* Open curve, status 11 */
	  *jstat = 11;
	  if(kmatch1==1)
            goto copy;
	  else
            goto invcopy;
        }
      else if (kmark1 ==1 || (kmark2 == 1 && kclose == 0))
	{
	  /* Open curve one point inside status 12 or 13 */
	  
	  if (kmark1 == 1 && kmatch1 == 1)
	    {
	      *jstat = 12;
	      goto copy;
	    }
	  else if (kmark2 == 1 && kmatch2 == 1)
	    {
	      *jstat = 12;
	      goto invcopy;
	    }
	  if (kmark1 == 1 && kmatch2 == 1)
	    {
	      *jstat = 13;
	      goto invcopy;
	    }
	  if (kmark2 == 1 && kmatch1 == 1)
	    {
	      *jstat = 13;
	      goto copy;
	    }
        }
      else if (kclose == 0)
	{
	  /* Both ends inside */
	  *jstat = 14;
	  if(kmatch1==1)
            goto copy;
	  else
            goto invcopy;
	}
      else if(kmatch1 == 1)
	{
	  /* Closed curve, no singularity */
	  *jstat = 16;
	  memcopy(gpar1,spar1,2,DOUBLE);
	  memcopy(gpar2,spar1,2,DOUBLE);
	  goto out;
	}
      else
	{
	  /* Closed curve, with singularity */
	  *jstat=17;
	  memcopy(gpar1,epar ,2,DOUBLE);
	  memcopy(gpar2,spar1,2,DOUBLE);
	  goto out;
	}
    }
  else
    {
      /* epar does not match produced end points, status messages in
	 21-29 the range  */
      
      if (kmark1 ==1 && kmark2 ==1 && kclose == 0)
        {
	  /* Open curve, status 11 */
	  *jstat = 21;
	  memcopy(gpar1,spar1,2,DOUBLE);
	  memcopy(gpar2,spar2,2,DOUBLE);
	  goto out;
        }
      else if (kmark1 ==1 && kclose == 0)
	{
	  /* Open curve one point inside status 12 */
	  *jstat=22;
	  goto copy;
	}
      else if (kmark2 ==1 && kclose == 0)
	{
	  /* Open curve one point inside status 12 */
	  *jstat=22;
	  goto invcopy;
	}
      else if (kclose == 0)
	{
	  /* Both ends inside */
	  *jstat=24;
	  goto copy;
	}
      else if(kmatch1 == 1)
	{
	  /* Closed curve, no singularity */
	  *jstat=26;
	  memcopy(gpar1,spar1,2,DOUBLE);
	  memcopy(gpar2,spar1,2,DOUBLE);
	}
      else
	{
	  /* Closed curve, with singularity */
	  *jstat = 27;
	  memcopy(gpar1,epar ,2,DOUBLE);
	  memcopy(gpar2,spar1,2,DOUBLE);
	  goto out;
	}
    }
  /* Marching produced no curve */
  
 war00: *jstat = 0;
  memcopy(gpar1,epar,2,DOUBLE);
  memcopy(gpar2,epar,2,DOUBLE);
  goto out;
  
 copy:
  memcopy(gpar1,spar1,2,DOUBLE);
  memcopy(gpar2,spar2,2,DOUBLE);
  goto out;
  
 invcopy:
  memcopy(gpar1,spar2,2,DOUBLE);
  memcopy(gpar2,spar1,2,DOUBLE);
  goto out;
  
  /* Error in space allocation */
 err101: 
  *jstat = -101;
  s6err("s1787",*jstat,kpos);
  goto out;
  
  /* Error in lower level function */
 error:
  *jstat = kstat;
  s6err("s1787",*jstat,kpos);
  goto out;
  
 out:
  if (s3coef != SISL_NULL) freearray(s3coef);
  if (qs     != SISL_NULL) freeSurf (qs);
  if (qintcr != SISL_NULL) freeIntcurve(qintcr);
}


//===========================================================================
void s6idkpt(SISLIntdat **pintdat,SISLIntpt **pintpt,SISLIntpt **rtpt,SISLIntpt **rfpt,
	     int *jstat)
//===========================================================================
{
  int ki;              /* Counters.    */
  int knum;
  
  (*rtpt) = (*rfpt) = SISL_NULL;
  *jstat = 0;
  
  /* We have to be sure that we have an intdat structure. */
  
  if ((*pintdat) == SISL_NULL)
    goto out;
  
  if ((*pintpt) == SISL_NULL)
    {
      *jstat = 1;
      goto out;
    }
  
  
  /* Than we have to be sure that we do not have the intersection point
     before or an equal point. */
  
  for (knum = -1,ki=0; ki<(*pintdat)->ipoint; ki++)
    {
      if ((*pintdat)->vpoint[ki] == (*pintpt))
	knum = ki;
      
      if ((*pintdat)->vpoint[ki] == (*pintpt)->pcurve)
	(*rfpt) = (*pintdat)->vpoint[ki];
      
      if ((*pintdat)->vpoint[ki]->pcurve == (*pintpt))
	(*rtpt) = (*pintdat)->vpoint[ki];
    }
  
  
  if (knum == -1)
    *jstat = 1;
  else
    {
      (*pintdat)->vpoint[knum] = (*pintdat)->vpoint[(*pintdat)->ipoint-1];
      ((*pintdat)->ipoint)--;
      (*pintdat)->vpoint[(*pintdat)->ipoint] = SISL_NULL;
      
      if ((*rtpt) != SISL_NULL)
	(*rtpt) ->pcurve = SISL_NULL;
      
      if ((*pintdat)->ipoint == 0)
	{
	  freeIntdat(*pintdat);
	  (*pintdat) = SISL_NULL;
	}
    }
  
  freeIntpt(*pintpt);
  (*pintpt) = SISL_NULL;
  
 out: ;
}


//===========================================================================
void s6idlis_s9psexamin(SISLSurf *ps1,double alevel, SISLIntdat **rintdat,int *jstat)
//===========================================================================
{
  int kstat;
  int kdirstat;
  
  unsigned char edg=0;
  SISLIntpt **uipt=SISL_NULL;
  SISLIntlist **uilst=SISL_NULL;
  
  int ki,kj,kv,klnr,kpnr,klfs,klft,kdir,kpar;
  SISLIntpt *qpt1,*qpt2;
  SISLIntpt *qipt, *qp;
  
  double tepsge, tmax,sedg[4];
  double sval1[9],snorm1[3];
  double epar1[2],epar2[2];
/* ALA && UJK 19.09.90 */
  double ttol= 10000.0 * REL_COMP_RES;
  
  tepsge = (double)0.001;
  
  sedg[0] = ps1->et1[ps1->ik1-1];
  sedg[1] = ps1->et1[ps1->in1];
  sedg[2] = ps1->et2[ps1->ik2-1];
  sedg[3] = ps1->et2[ps1->in2];
  
  
  /* Init */ 
  if (!(*rintdat)) goto out;
  if (ps1->idim != 1) goto err200;
  *jstat = 0;
  
  
  /* SISLCurve analyse section --------------------------------------------------*/
  
  if ((*rintdat)->ilist != 0)
    {
      /* Allocate array of pointers to the lists. */
      klnr = (*rintdat)->ilist;
      if ((uilst = newarray(klnr,SISLIntlist *)) == SISL_NULL) goto err101;
      
      /* Update the list array. */
      
      /* Get all open curves into array. */
      for (kv=ki=0; ki<klnr; ki++)
        if ((*rintdat)->vlist[ki]->itype != 1)
	  uilst[kv++] = (*rintdat)->vlist[ki];
      
      /* Correct number of curves.*/
      klnr = kv;
      
      /* Remove all open curves with endpoints on edges or singular 
	 endpoints from array.(they are ok.) */
      for (ki=0; ki<klnr; ki++)
	{
	  for (kj=0; kj<4; kj++)
	    if (DEQUAL(uilst[ki]->pfirst->epar[(kj/2)],sedg[kj]))
	      break;
	  
	  
	  if (kj == 4)
	    {
	      /* Start point is NOT on edge, test if the point 
		 is a singular point. */
	      
	      klfs=klft=0;
	      s1421(ps1,1,uilst[ki]->pfirst->epar,&klfs,&klft,sval1,
		    snorm1,&kstat);
	      if (kstat < 0) goto error;
	      else if (kstat > 0 ) kj--;
	      
	      tmax = sqrt(sval1[1]*sval1[1] + sval1[2]*sval1[2]);
	      if ( tmax < ttol ) kj--;
	      
	    }	    
	  
	  
	  if (kj<4)
	    {
	      /* Start point is ok, test end point*/
	      for (kj=0; kj<4; kj++)
		if (DEQUAL(uilst[ki]->plast->epar[(kj/2)],sedg[kj]))
		  break;
	      
	      
	      if (kj == 4)
		{
		  /* End point is NOT on edge, test if the point 
		     is a singular point. */
		  klfs=klft=0;
		  s1421(ps1,1,uilst[ki]->plast->epar,&klfs,&klft,sval1,
			snorm1,&kstat);
		  if (kstat < 0) goto error;
		  else if (kstat > 0 ) kj--;
		  
		  tmax = sqrt(sval1[1]*sval1[1] + sval1[2]*sval1[2]);
		  if ( tmax < ttol ) kj--;
		  
		}	    
	      
	      
	      if (kj<4)
		{
		  /* Start point and end point is ok, remove it from the array*/
		  klnr--;
		  if (ki<klnr)
		    {
		      uilst[ki] = uilst[klnr];
		      ki--;
		    }
		  
		}
	    }
	}
      
      /* Now we only have curves with bad endpoints in the array. */
      
      for (ki=0; ki< klnr; ki++)
	{
	  /* Now we kill all the points in the list except the
	     end point that is an internal point . */
	  
	  for (kj=0; kj<4; kj++)
	    if (DEQUAL(uilst[ki]->pfirst->epar[(kj/2)],sedg[kj]))
	      break;
	  
	  if (kj<4)
	    {
	      
	      /* The first point is on the edge, keep the last. */
	      qipt = uilst[ki]->pfirst;
	      for (qp=qipt->pcurve; qipt != uilst[ki]->plast;qipt=qp,qp=qp->pcurve)
		{
		  s6idkpt(rintdat,&qipt,&qpt1,&qpt2,&kstat);
		  if (kstat < 0) goto error;
		}
	      
	      qipt = uilst[ki]->plast;
	      uilst[ki]->pfirst = uilst[ki]->plast =  qipt;
	      uilst[ki]->inumb = 1;
	    }
	  else
	    {
	      /* The first point is not on the edge, keep it. */
	      
	      for (qipt = uilst[ki]->pfirst->pcurve; qipt != SISL_NULL;qipt=qp)	      
		{
		  s6idkpt(rintdat,&qipt,&qpt1,&qp,&kstat);
		  if (kstat < 0) goto error;
		}
	      qipt = uilst[ki]->pfirst;
	      uilst[ki]->pfirst = uilst[ki]->plast =  qipt;
	      uilst[ki]->inumb = 1;
	    }
	  
	  /* March from point qipt */
	  s1787(ps1,alevel,tepsge,qipt->epar,epar1,epar2,&kstat);
          if (kstat<0) goto error;
	  
	  if (kstat == 0)
            {
	      /* No succes. */
	      /* Kill point and the list */
	      s6idklist(rintdat,uilst[ki],&kstat);
	      if (kstat<0) goto error;
	      
	      klnr--;
	      if (ki < klnr)
		{
		  uilst[ki] = uilst[klnr];
		  ki--;
		}
	      
	    }
	  else if (kstat == 11 || kstat == 12 || kstat == 13 ||
	           kstat == 14 || kstat == 21 || kstat == 22 || kstat == 24 )
	    {
	      /* Making a new open curve with endpoint in epar1 and epar2.*/
	      
	      uilst[ki]->pfirst = newIntpt(2,epar1,DZERO);
	      if (uilst[ki]->pfirst == SISL_NULL) goto err101;
	      
	      s6idnpt(rintdat,&uilst[ki]->pfirst,0,&kstat);
	      if (kstat < 0)goto error;
	      
	      uilst[ki]->plast = newIntpt(2,epar2,DZERO);
	      if (uilst[ki]->plast == SISL_NULL) goto err101;
	      
	      s6idnpt(rintdat,&uilst[ki]->plast,0,&kstat);
	      if (kstat < 0)goto error;
	      
	      uilst[ki]->pfirst->pcurve = qipt;
	      qipt->pcurve = uilst[ki]->plast;
	      uilst[ki]->inumb = 3;
              uilst[ki]->itype = 4;
	    }
	  
	  else if (kstat == 16 || kstat == 17 || kstat == 26 || kstat == 27)
	    {
	      /* Making a new closed curve with pfirst and plast
                 pointing on qipt.*/
	      
              uilst[ki]->pfirst = uilst[ki]->plast = qipt;
	      uilst[ki]->inumb = 1;
              uilst[ki]->itype = 1;
	      qipt->pcurve = qipt;
	    }
	}
      /* Now we check equality between the remaining curves in the array. */
      for (ki=0;ki<klnr-1;ki++)
	for (kj=ki+1;kj<klnr;kj++)
	  {
	    if ((s6dist(uilst[ki]->pfirst->epar,uilst[kj]->pfirst->epar,2)
		 < REL_COMP_RES &&
		 s6dist(uilst[ki]->plast->epar,uilst[kj]->plast->epar,2)
		 < REL_COMP_RES)  ||
		(s6dist(uilst[ki]->pfirst->epar,uilst[kj]->plast->epar,2)
		 < REL_COMP_RES &&
		 s6dist(uilst[ki]->plast->epar,uilst[kj]->pfirst->epar,2)
		 < REL_COMP_RES))
	      /* The two curves has common start+end, remove the last one of them. */
	      {
		
		s6idklist(rintdat,uilst[kj],&kstat);
		if (kstat<0) goto error;
		
		klnr--;
		if (kj < klnr)
		  {
		    uilst[kj] = uilst[klnr];
		    kj--;
		  }
		
	      }
	  }
      
    }
  
  
  /* End of curve analyse section -------------------------------------------*/
  
  /* SISLPoint analyse section --------------------------------------------------*/
  
  if ((*rintdat) && (*rintdat)->ipoint != 0)
    
    /* Update the point array. */
    {     
      kpnr = (*rintdat)->ipoint;
      if ((uipt = newarray(kpnr,SISLIntpt *)) == SISL_NULL) goto err101;
      
      
      for (kv=ki=0; ki<kpnr; ki++)
        if ((*rintdat)->vpoint[ki]->pcurve == SISL_NULL)
	  uipt[kv++] = (*rintdat)->vpoint[ki];
      
      for (ki=0; ki<kpnr; ki++)
        for (kj=0; kj<kv; kj++)
          if ((*rintdat)->vpoint[ki]->pcurve  == uipt[kj])
            {
	      kv--;
      	      uipt[kj] = uipt[kv];
              break;
            }
      
      /* All single points found. */
      kpnr = kv;
      
      
      /* Sorting out and killing all points but single touch points. */
      
      for (ki=0; ki<kpnr; ki++)
	{
	  klfs=klft=0;
	  s1421(ps1,1,uipt[ki]->epar,&klfs,&klft,sval1,snorm1,&kstat);
	  if (kstat < 0) goto error;
	  else if (kstat > 0 ) continue;
	  
	  tmax = sqrt(sval1[1]*sval1[1] + sval1[2]*sval1[2]);
	  if ( tmax < ttol ) continue;
	  
	  
	  /* All singular points or degenerated points is ok. We
	     then remove all other internal points. */
	  
	  for (kj=0,edg=0; kj<4; kj++)
	    if (DEQUAL(uipt[ki]->epar[(kj/2)],sedg[kj]))
		edg |= (unsigned char)(1<<kj);
	  
	  if (edg == 0)
	    {
	      /* The point is removed. */
	      
	      s6idkpt(rintdat,&uipt[ki],&qpt1,&qpt2,&kstat);
	      if (kstat < 0) goto error;
	      
	      kpnr--;
	      
	      if (ki < kpnr)
		{
		  uipt[ki] = uipt[kpnr];
		  ki--;
		}
	      
	      continue;
	    }
	  
	  /* Now we remove all edge points with in/out component. */
	  for (kpar=1,kj=0,kdir=kdirstat=0; kj<4; kj++)
	    if ((edg & 1<<kj) == 1<<kj)
	      {
		switch (kj) 
		  {
		  case 0:
		    if (fabs(sval1[1]/tmax) < ttol)
		      kdir = 0;
		    else
		      kdir = (sval1[1] > DZERO ?  1 : -1);
		    break;
		  case 1:
		    if (fabs(sval1[2]/tmax) < ttol)
		      kdir = 0;
		    else
		      kdir = (sval1[2] > DZERO ?  1 : -1);
		    break;
		  case 2:
		    if (fabs(sval1[1]/tmax) < ttol)
		      kdir = 0;
		    else
		      kdir = (sval1[1] > DZERO ?  -1 : 1);
		    break;
		  case 3:
		    if (fabs(sval1[2]/tmax) < ttol)
		      kdir = 0;
		    else
		      kdir = (sval1[2] > DZERO ?  -1 : 1);
		  }
		
		if (kdir == 0)
		  kpar = 0;
		else if (kdirstat != kdir)
		  {
		    if (kdirstat == 0)
		      kdirstat = kdir;
		    else
		      {
			kdirstat = 10;
			break;
		      }
		  }
	      }
	  
	  if (kpar == 0 && kdirstat != 10) kdirstat = 0;
	  
	  /* Test if the point is to be removed.*/
	  if (kdirstat == 1 || kdirstat == -1)
	    {
	      /* The point is removed. */
	      
	      s6idkpt(rintdat,&uipt[ki],&qpt1,&qpt2,&kstat);
	      if (kstat < 0) goto error;
	      
	      kpnr--;
	      
	      if (ki < kpnr)
		{
		  uipt[ki] = uipt[kpnr];
		  ki--;
		}
	      
	      continue;
	    }
	  
	} /* End of for ki= .... */
      
    }
  /* End of point analyse section ---------------------------------------------*/ 
    
  goto out;
  
  /* Error in sub rutines.      */
  
  error : 
    *jstat = kstat;
    s6err("s6idlis_s9psexamin",*jstat,0);
    goto out;                       
  
  /* Error in memory allocation.      */
  
  err101 : 
    *jstat = -101;
    s6err("s6idlis_s9psexamin",*jstat,0);
    goto out;                       
  
  /* Error dimention.      */
  
  err200 : 
    *jstat = -200;
    s6err("s6idlis_s9psexamin",*jstat,0);
    goto out;                       
  
  out:
    if (uipt != SISL_NULL)  freearray(uipt);
    if (uilst != SISL_NULL) freearray(uilst);
}


//===========================================================================
void s6idlis_s9ssexamin(SISLSurf *ps1,SISLSurf *ps2, SISLIntdat **rintdat,int *jstat)
//===========================================================================
{
  int kstat;
  int kdirstat;
  
  unsigned char edg=0;
  SISLIntpt **uipt=SISL_NULL;
  SISLIntlist **uilst=SISL_NULL;
  
  int ki,kj,kv,klnr,kpnr,klfs,klft,kdir,kpar;
  SISLIntpt  *qpt1,*qpt2;
  SISLIntpt  *qipt, *qp;
  
  double tepsge, tang,sedg[8];
  double sval1[9],sval2[9],snorm1[3],snorm2[3];
  double stang[3],sdec1[3],sdec2[3];
  double epar1[4],epar2[4];
  
  tepsge = (double)0.001;
  
  sedg[0] = ps1->et1[ps1->ik1-1];
  sedg[1] = ps1->et1[ps1->in1];
  sedg[2] = ps1->et2[ps1->ik2-1];
  sedg[3] = ps1->et2[ps1->in2];
  sedg[4] = ps2->et1[ps2->ik1-1];
  sedg[5] = ps2->et1[ps2->in1];
  sedg[6] = ps2->et2[ps2->ik2-1];
  sedg[7] = ps2->et2[ps2->in2];
  
  /* Init */  
  if (!(*rintdat)) goto out;
  if (ps1->idim != 3 || ps2->idim != 3) goto err200;
  *jstat = 0;
  
  
  /* SISLCurve analyse section --------------------------------------------------*/
  if ((*rintdat)->ilist != 0)
    {
      /* Allocate array of pointers to the lists. */
      klnr = (*rintdat)->ilist;
      if ((uilst = newarray(klnr,SISLIntlist *)) == SISL_NULL) goto err101;
      
      /* Update the list array. */
      
      /* Get all open curves into array. */
      for (kv=ki=0; ki<klnr; ki++)
        if ((*rintdat)->vlist[ki]->itype != 1)
	  uilst[kv++] = (*rintdat)->vlist[ki];
      
      /* Correct number of curves.*/
      klnr = kv;
      
      /* Remove all open curves with endpoints on edges or singular 
	 endpoints from array.(they are ok.) */
      for (ki=0; ki<klnr; ki++)
	{
	  for (kj=0; kj<8; kj++)
	    if (DEQUAL(uilst[ki]->pfirst->epar[(kj/2)],sedg[kj]))
	      break;
	  
	  
	  if (kj == 8)
	    {
	      /* Start point is NOT on edge, test if the point 
		 is a singular point. */
	      
	      klfs=klft=0;
	      s1421(ps1,1,uilst[ki]->pfirst->epar,&klfs,&klft,sval1,
		    snorm1,&kstat);
	      if (kstat < 0) goto error;
	      else if (kstat > 0 ) kj--;
	      
	      klfs=klft=0;
	      s1421(ps2,1,uilst[ki]->pfirst->epar+2,&klfs,&klft,sval2,
		    snorm2,&kstat);
	      if (kstat < 0) goto error;
	      else if (kstat > 0 ) kj--;
	      
	      tang = s6ang(snorm1,snorm2,3);
	      if (tang < ANGULAR_TOLERANCE) kj--;
	    }	    
	  
	  
	  if (kj<8)
	    {
	      /* Start point is ok, test end point*/
	      for (kj=0; kj<8; kj++)
		if (DEQUAL(uilst[ki]->plast->epar[(kj/2)],sedg[kj]))
		  break;
	      
	      
	      if (kj == 8)
		{
		  /* End point is NOT on edge, test if the point 
		     is a singular point. */
		  klfs=klft=0;
		  s1421(ps1,1,uilst[ki]->plast->epar,&klfs,&klft,sval1,
			snorm1,&kstat);
		  if (kstat < 0) goto error;
		  else if (kstat > 0 ) kj--;
		  
		  klfs=klft=0;
		  s1421(ps2,1,uilst[ki]->plast->epar+2,&klfs,&klft,sval2,
			snorm2,&kstat);
		  if (kstat < 0) goto error;
		  else if (kstat > 0 ) kj--;
		  
		  tang = s6ang(snorm1,snorm2,3);
		  if (tang < ANGULAR_TOLERANCE) kj--;
		}	    
	      
	      
	      if (kj<8)
		{
		  /* Start point and end point is ok, remove it from the array*/
		  klnr--;
		  if (ki<klnr)
		    {
		      uilst[ki] = uilst[klnr];
		      ki--;
		    }
		  
		}
	    }
	}
      
      /* Now we only have curves with bad endpoints in the array. */
      
      for (ki=0; ki< klnr; ki++)
	{
	  /* Now we kill all the points in the list except the
	     end point that is an internal point . */
	  
	  for (kj=0; kj<8; kj++)
	    if (DEQUAL(uilst[ki]->pfirst->epar[(kj/2)],sedg[kj]))
	      break;
	  
	  if (kj<8)
	    {
	      
	      /* The first point is on the edge, keep the last. */
	      qipt = uilst[ki]->pfirst;
	      for (qp=qipt->pcurve; qipt != uilst[ki]->plast;qipt=qp,qp=qp->pcurve)
		{
		  s6idkpt(rintdat,&qipt,&qpt1,&qpt2,&kstat);
		  if (kstat < 0) goto error;
		}
	      
	      qipt = uilst[ki]->plast;
	      uilst[ki]->pfirst = uilst[ki]->plast =  qipt;
	      uilst[ki]->inumb = 1;
	    }
	  else
	    {
	      /* The first point is not on the edge, keep it. */
	      
	      for (qipt = uilst[ki]->pfirst->pcurve; qipt != SISL_NULL;qipt=qp)	      
		{
		  s6idkpt(rintdat,&qipt,&qpt1,&qp,&kstat);
		  if (kstat < 0) goto error;
		}
	      
	      qipt = uilst[ki]->pfirst;
	      uilst[ki]->pfirst = uilst[ki]->plast =  qipt;
	      uilst[ki]->inumb = 1;
	      
	    }
	  
	  /* March from point qipt */
	  s1788(ps1,ps2,tepsge,qipt->epar,epar1,epar2,&kstat);
          if (kstat<0) goto error;
	  
	  if (kstat == 0)
            {
	      /* No succes. */
	      /* Kill point and the list */
	      s6idklist(rintdat,uilst[ki],&kstat);
	      if (kstat<0) goto error;
	      klnr--;
	      if (ki < klnr)
		{
		  uilst[ki] = uilst[klnr];
		  ki--;
		}
	      
	    }
	  else if (kstat == 11 || kstat == 12 || kstat == 13 ||
	           kstat == 14 || kstat == 21 || kstat == 22 || kstat == 24 )
	    {
	      /* Making a new open curve with endpoint in epar1 and epar2.*/
	      
	      uilst[ki]->pfirst = newIntpt(4,epar1,DZERO);
	      if (uilst[ki]->pfirst == SISL_NULL) goto err101;
	      
	      s6idnpt(rintdat,&uilst[ki]->pfirst,0,&kstat);
	      if (kstat < 0)goto error;
	      
	      uilst[ki]->plast = newIntpt(4,epar2,DZERO);
	      if (uilst[ki]->plast == SISL_NULL) goto err101;
	      
	      s6idnpt(rintdat,&uilst[ki]->plast,0,&kstat);
	      if (kstat < 0)goto error;
	      
	      uilst[ki]->pfirst->pcurve = qipt;
	      qipt->pcurve = uilst[ki]->plast;
	      uilst[ki]->inumb = 3;
              uilst[ki]->itype = 4;
	    }
	  
	  else if (kstat == 16 || kstat == 17 || kstat == 26 || kstat == 27)
	    {
	      /* Making a new closed curve with pfirst and plast
                 pointing on qipt.*/
	      
              uilst[ki]->pfirst = uilst[ki]->plast = qipt;
	      uilst[ki]->inumb = 1;
              uilst[ki]->itype = 1;
	      qipt->pcurve = qipt;
	      
	    }
	}
      /* Now we check equality between the remaining curves in the array. */
      for (ki=0;ki<klnr-1;ki++)
	for (kj=ki+1;kj<klnr;kj++)
	  {
	    if ((s6dist(uilst[ki]->pfirst->epar,uilst[kj]->pfirst->epar,4)
		 < REL_COMP_RES &&
		 s6dist(uilst[ki]->plast->epar,uilst[kj]->plast->epar,4)
		 < REL_COMP_RES)  ||
		(s6dist(uilst[ki]->pfirst->epar,uilst[kj]->plast->epar,4)
		 < REL_COMP_RES &&
		 s6dist(uilst[ki]->plast->epar,uilst[kj]->pfirst->epar,4)
		 < REL_COMP_RES))
	      /* The two curves has common start+end, remove the last one of them. */
	      {
		
		s6idklist(rintdat,uilst[kj],&kstat);
		if (kstat<0) goto error;
		
		klnr--;
		if (kj < klnr)
		  {
		    uilst[kj] = uilst[klnr];
		    kj--;
		  }
		
	      }
	  }
      
    }
  
  
  /* End of curve analyse section -------------------------------------------*/
  
  /* SISLPoint analyse section --------------------------------------------------*/
  
  if ((*rintdat) && (*rintdat)->ipoint != 0)
    /* Update the point array. */
    {     
      kpnr = (*rintdat)->ipoint;
      if ((uipt = newarray(kpnr,SISLIntpt *)) == SISL_NULL) goto err101;
      
      
      for (kv=ki=0; ki<kpnr; ki++)
        if ((*rintdat)->vpoint[ki]->pcurve == SISL_NULL)
	  uipt[kv++] = (*rintdat)->vpoint[ki];
      
      for (ki=0; ki<kpnr; ki++)
        for (kj=0; kj<kv; kj++)
          if ((*rintdat)->vpoint[ki]->pcurve == uipt[kj])
            {
	      kv--;
      	      uipt[kj] = uipt[kv];
              break;
            }
      
      /* All single points found. */
      kpnr = kv;
      
      
      /* Sorting out and killing all points but single touch points. */
      
      for (ki=0; ki<kpnr; ki++)
	{
	  klfs=klft=0;
	  s1421(ps1,1,uipt[ki]->epar,&klfs,&klft,sval1,snorm1,&kstat);
	  if (kstat < 0) goto error;
	  else if (kstat > 0 ) continue;
	  
	  if (s6length(snorm1,3,&kstat) <= REL_COMP_RES) continue;
	  
	  klfs=klft=0;
	  s1421(ps2,1,uipt[ki]->epar+2,&klfs,&klft,sval2,snorm2,&kstat);
	  if (kstat < 0) goto error;
	  else if (kstat > 0 ) continue;
	  
	  if (s6length(snorm2,3,&kstat) <= REL_COMP_RES) continue;
	  
	  tang = s6ang(snorm1,snorm2,3);
	  if (tang < ANGULAR_TOLERANCE) continue;	    
	  
	  
	  /* All singular points or degenerated points is ok. We
	     then remove all other internal points. */
	  
	  for (kj=0,edg=0; kj<8; kj++)
	    if (DEQUAL(uipt[ki]->epar[(kj/2)],sedg[kj]))
		edg |= (unsigned char)(1<<kj);
	  
	  if (edg == 0)
	    {
	      /* The point is removed. */
	      
	      s6idkpt(rintdat,&uipt[ki],&qpt1,&qpt2,&kstat);
	      if (kstat < 0) goto error;
	      
	      kpnr--;
	      
	      if (ki < kpnr)
		{
		  uipt[ki] = uipt[kpnr];
		  ki--;
		}
	      
	      continue;
	    }
	  
	  
	  s6crss(snorm1,snorm2,stang);
	  
	  s6decomp(stang,sdec1,sval1+3,sval1+6,snorm1,&kstat);
	  if (kstat < 0) goto error;
	  else if (kstat > 0 ) continue;
	  
	  s6decomp(stang,sdec2,sval2+3,sval2+6,snorm2,&kstat);
	  if (kstat < 0) goto error;
	  else if (kstat > 0 ) continue;
	  
	  for (kpar=1,kdir=kdirstat=0,kj=0; kj<8; kj++)
	    if ((edg & 1<<kj) == 1<<kj)
	      {
		switch (kj) 
		  {
		  case 0: tang = s6ang(stang,sval1+3,3);
		    kdir = (sdec1[1] > DZERO ?  1 : -1);
		    break;
		  case 4: tang = s6ang(stang,sval2+3,3);
		    kdir = (sdec2[1] > DZERO ?  1 : -1);
		    break;
		  case 1: tang = s6ang(stang,sval1+6,3);
		    kdir = (sdec1[0] > DZERO ?  -1 : 1);
		    break;
		  case 5: tang = s6ang(stang,sval2+6,3);
		    kdir = (sdec2[0] > DZERO ?  -1 : 1);
		    break;
		  case 2: tang = s6ang(stang,sval1+3,3);
		    kdir = (sdec1[1] > DZERO ?  -1 : 1);
		    break;
		  case 6: tang = s6ang(stang,sval2+3,3);
		    kdir = (sdec2[1] > DZERO ?  -1 : 1);
		    break;
		  case 3: tang = s6ang(stang,sval1+6,3);
		    kdir = (sdec1[0] > DZERO ?  1 : -1);
		    break;
		  case 7: tang = s6ang(stang,sval2+6,3);
		    kdir = (sdec2[0] > DZERO ?  1 : -1);
		  }
		
		if (tang < ANGULAR_TOLERANCE) kdir = 0;
		
		if (kdir == 0)
		  kpar = 0;
		else if (kdirstat != kdir)
		  {
		    if (kdirstat == 0)
		      kdirstat = kdir;
		    else
		      {
			kdirstat = 10;
			break;
		      }
		  }
	      }
	  
	  if (kpar == 0 && kdirstat != 10) kdirstat = 0;
	  
	  /* Test if the point is to be removed.*/
	  if (kdirstat == 1 || kdirstat == -1)
	    {
	      /* The point is removed. */
	      
	      s6idkpt(rintdat,&uipt[ki],&qpt1,&qpt2,&kstat);
	      if (kstat < 0) goto error;
	      
	      kpnr--;
	      
	      if (ki < kpnr)
		{
		  uipt[ki] = uipt[kpnr];
		  ki--;
		}
	      
	      continue;
	    }
	  
	} /* End of for ki= .... */
      
    }
  /* End of point analyse section ---------------------------------------------*/ 
  
  
  goto out;
  
  /* Error in sub rutines.      */
  
  error : *jstat = kstat;
  s6err("s6idlis_s9ssexamin",*jstat,0);
  goto out;                       
  
  /* Error in memory allocation.      */
  
  err101 : *jstat = -101;
  s6err("s6idlis_s9ssexamin",*jstat,0);
  goto out;                       
  
  /* Error dimention.      */
  
  err200 : *jstat = -200;
  s6err("s6idlis_s9ssexamin",*jstat,0);
  goto out;                       
  
  out:
  if (uipt != SISL_NULL)  freearray(uipt);
  if (uilst != SISL_NULL)   freearray(uilst);
}


//===========================================================================
void s6idlis(SISLObject *po1,SISLObject *po2,SISLIntdat **pintdat,int *jstat)
//===========================================================================
{
  int kstat;                /* Local status variable.          */
  int kpos=0;               /* Position of error.              */
  int kj,ki1,ki2;           /* Counters                        */
  int ktype;                /* To indicate type of list.       */
  SISLIntpt   *pt;       /* to traverse list of points.     */
  
  *jstat = 0;
  
  /* If we do not have any intersection data we just return. */
  
  if ((*pintdat) == SISL_NULL) goto out;
  
  /* We first destroy existing intersection lists. */
  
  for (kj=0; kj<(*pintdat)->ilist; kj++) freeIntlist((*pintdat)->vlist[kj]);
  
  
  /* Then we split lists with internal junction points. We have to
     be sure that all junction points are end points in the lists. */
  
  for (kj=0; kj<(*pintdat)->ipoint; kj++)
    if ((*pintdat)->vpoint[kj]->iinter == 2)
      {
	if ((*pintdat)->vpoint[kj]->pcurve != SISL_NULL)
	  {
	    for (ki1=0; ki1<(*pintdat)->ipoint; ki1++)
	      if ((*pintdat)->vpoint[ki1]->pcurve == (*pintdat)->vpoint[kj])
		break;
	    
	    if (ki1<(*pintdat)->ipoint)
	      {
		pt = copyIntpt((*pintdat)->vpoint[kj]);
		
		s6idnpt(pintdat,&pt,0,&kstat);
		if (kstat < 0) goto error;
		
		pt->pcurve = (*pintdat)->vpoint[kj]->pcurve;
		
		(*pintdat)->vpoint[kj]->pcurve = SISL_NULL;
	      }
	  }
      }
  
  
  /* At least we can traverse all intersection points to look for
     start points to lists. If a point have a next point
     and no other point pointing on itself. It is a start point. */
  
  for (ki1=0,ki2=0; ki1 < (*pintdat)->ipoint; ki1++)
    if ((*pintdat)->vpoint[ki1]->pcurve != SISL_NULL)
      {
	for (kj=0; kj<(*pintdat)->ipoint; kj++)
	  if ((*pintdat)->vpoint[kj]->pcurve == (*pintdat)->vpoint[ki1])
	    break;
	
	if (kj == (*pintdat)->ipoint)
	  {
	    /* To be sure that list array is big enough. */
	    
	    if (ki2 == (*pintdat)->ilmax)
	      {
		(*pintdat)->ilmax += 20;
		
		if (((*pintdat)->vlist = increasearray((*pintdat)->vlist,
						       (*pintdat)->ilmax,SISLIntlist *)) == SISL_NULL)
		  
		  goto err101;
	      }
	    
	    
	    /* Finding the last point in the list, and number of points. */
	    
	    kj = 0;
	    for (pt=(*pintdat)->vpoint[ki1];pt->pcurve!=SISL_NULL;
		 pt=pt->pcurve,kj++);
	    
	    
	    /* Computing type of point, junctions in the end points. */
	    
	    ktype = 0;
	    
	    if ((*pintdat)->vpoint[ki1]->iinter == 2)
	      ktype = 2;
	    
	    if (pt->iinter == 2)
	      ktype = (ktype == 2 ? 4 : 3);
	    
	    
	    /* Making a new list structure. */
	    
	    if (((*pintdat)->vlist[ki2] = newIntlist((*pintdat)->vpoint[ki1],
						     pt,ktype)) == SISL_NULL) goto err101;
	    
	    (*pintdat)->vlist[ki2]->inumb = kj + 1;
	    ki2++;
	    
	  }
      }
  
  /*------------------------------------------------------------------*/
  
  /* We also have to find closed lists.    */
  
  /* Mark found list elements: */
  for (ki1=0; ki1 < ki2; ki1++)
    for (pt=(*pintdat)->vlist[ki1]->pfirst;pt!=SISL_NULL;pt=pt->pcurve)
      pt->iinter += 10;
  
  /* Now travers the point array untill we find an unmarked point.
     This point has to be a single (unconnected) one or a member 
     of a closed connection. Mark points in the closed connection and 
     establish a new list. */
  
  for (ki1=0; ki1 < (*pintdat)->ipoint; ki1++)
    {
      if ((*pintdat)->vpoint[ki1]->iinter>=10)
	/* Unmark point. */
	(*pintdat)->vpoint[ki1]->iinter -= 10;
      
      else  if ((*pintdat)->vpoint[ki1]->pcurve != SISL_NULL)
	{
	  /* It has to be a closed connection, travers all elements. */
	  kj = 1;
	  for (pt=(*pintdat)->vpoint[ki1]->pcurve;pt!=(*pintdat)->vpoint[ki1];
	       pt=pt->pcurve)
	    {	
	      if (pt == SISL_NULL) goto err105;
	      /* Mark found list elements: */
	      pt->iinter += 10;
	      kj++;
	    }
	  
	  /*Create new list element. */
	  
	  /* To be sure that list array is big enough. */
	  if (ki2 == (*pintdat)->ilmax)
	    {
	      (*pintdat)->ilmax += 20;
	      
	      if (((*pintdat)->vlist = increasearray((*pintdat)->vlist,
						     (*pintdat)->ilmax,SISLIntlist *)) == SISL_NULL) 
		goto err101;
	    }
	  
	  /* Closed curves will have no singularities: */
	  ktype = 1;
	  
	  /* Making a new list structure. */
	  if (((*pintdat)->vlist[ki2] = 
	       newIntlist((*pintdat)->vpoint[ki1]->pcurve,
			  (*pintdat)->vpoint[ki1],ktype)) == SISL_NULL) 
	    goto err101;
	  (*pintdat)->vlist[ki2]->inumb = kj;
	  ki2++;
	  
	}
    }
  
  (*pintdat)->ilist = ki2;
  
  /*------------------------------------------------------------------*/
  
  /* A final check if the geometry found is ok. */
  
  if (po1->iobj == SISLSURFACE && po2->iobj == SISLSURFACE && po1->s1->idim == 3)
    {
       s6idlis_s9ssexamin(po1->s1,po2->s1,pintdat,&kstat);
      if (kstat < 0) goto error;
    }
  else if (po1->iobj == SISLPOINT && po2->iobj == SISLSURFACE && po1->p1->idim == 1)
    {
       s6idlis_s9psexamin(po2->s1,po1->p1->ecoef[0],pintdat,&kstat);
      if (kstat < 0) goto error;
    }
  else if (po1->iobj == SISLSURFACE && po2->iobj == SISLPOINT && po2->p1->idim == 1)
    {
       s6idlis_s9psexamin(po1->s1,po2->p1->ecoef[0],pintdat,&kstat);
      if (kstat < 0) goto error;
    }
  
  goto out;
  
  /* Error in space allocation.  */
  
  err101: *jstat = -101;
  s6err("s6idlis",*jstat,kpos);
  goto out;
  
  /* Error in vpoint array.  */
  
  err105: *jstat = -105;
  s6err("s6idlis",*jstat,kpos);
  goto out;
  
  /* Error in sub function.  */
  
  error:  *jstat = kstat;
  s6err("s6idlis",*jstat,kpos);
  goto out;
  
  out: ;
  
}

//===========================================================================
void s1252_s6dir(double *cdiff,double acoef,double eval[],double astart, double aend)
//===========================================================================
{
  double t1,t2,t3,t4,t5,t6;   /* Constants in equation.                    */
  double tmax;                /* Max values in equation.                   */
  double ttol=(double)1e-10;  /* Relative tolerance in equation.           */

  /* Dummy statements to avoid warning. */
  t1=acoef;
  t2=astart;
  t3=aend;


  t1 =  eval[1];
  t2 =  eval[2];
  t3 =  eval[3]/(double)2.0;

  tmax  = max(fabs(t1),fabs(t2));
  tmax  = max(fabs(t3),tmax);

  if (DEQUAL(tmax,DZERO))                    *cdiff = DZERO;
  else if (fabs(t3)/tmax < ttol) /* The second degree part is degenerated. */
	{
          if (fabs(t2) == DZERO )      *cdiff = DZERO;
	  else                        *cdiff = (-t1/t2);
	}
  else
	{
          /* An ordinary second degree equation.    */
	   t4 = t2*t2 - (double)4*t3*t1;
	   if (t4 < DZERO)
	    {
	      /* Use linear equation. */
	      if (fabs(t2) == DZERO )      *cdiff = DZERO;
              else                        *cdiff = (-t1/t2);
      	    }

           else
	    {
	       t6 = sqrt(t4);
	       t5 = (-t2 + t6)/((double)2*t3);
	       t6 = (-t2 - t6)/((double)2*t3);
	       t4 = min(fabs(t5),fabs(t6));

               /* We have two solutions and we want to use the one
	          with the one with smallest value. */

               if (t4 == DZERO)
                {
	          /* Use linear equation. */
	          if (fabs(t2) == DZERO )      *cdiff = DZERO;
                  else                        *cdiff = (-t1/t2);
	        }
               else if (fabs(t5) <= fabs(t6))  *cdiff = t5;
               else                            *cdiff = t6;
             }
	}
}


//===========================================================================
void s1252_s6corr(double *gdn,double acoef,double et[], int in,int ik,int *ileft,int *jdir)
//===========================================================================
{
  int kmult,kstat;

  /* Make sure the point is inside the interval */

  *gdn = MAX(et[ik-1]-acoef,*gdn);
  *gdn = MIN(et[in]  -acoef,*gdn);

  if (acoef+*gdn<et[*ileft] && acoef>et[*ileft])
    {
      *gdn = MAX(et[*ileft]-acoef,*gdn);
    }

  else if(acoef<et[*ileft+1] && acoef+*gdn>et[*ileft+1])
    {
      /*  We cross a knot value */

      *gdn = MIN(et[*ileft+1]-acoef,*gdn);
    }

  /* Make sure that we calculate the left or right handed derivatives */

  if (*gdn>=0)
    {
      *jdir = 1;
    }
  else
    {
      *jdir = -1;
    }

  kmult = s6knotmult(et,ik,in,ileft,acoef,&kstat);

  if (acoef==et[*ileft])
    {

      if(kmult>ik-2)
        {
	  if (*jdir == -1)
            {
	      *jdir = -2;
            }
	  else
            {
	      *jdir =  2;
            }
        }
    }
}


//===========================================================================
void s1252(SISLCurve *pcurve,double aepsge,double astart,double *cpos,int *jstat)
//===========================================================================
{
  int kstat = 0;        /* Local status variable.                          */
  int kpos = 0;         /* Position of error.                              */
  int kleft=0;          /* Variables used in the evaluator.                */
  int kder=3;           /* Order of derivatives to be calulated            */
  int kdim;             /* Dimension of space the curves lie in            */
  int knbit;            /* Number of iterations                            */
  int kn,kk;            /* Number of vertices and order                    */
  int kdir=1;           /* Direction of derivative to be calculated        */
  double tstart,tend;   /* Ends of parameter interval of first curve.      */
  double tdelta;        /* Parameter interval of the curves.               */
  double tdist=DZERO;   /* Distance between position and origo.            */
  double td;        	/* Distances between old and new parameter value   */
  double tnext;         /* Parameter-value of expression in first curve.   */
  double tprev;         /* Previous difference between the curves.         */
  double sval[4];       /* Value ,first and second derivative on function  */
  double *st;           /* Knot vector                                     */
  double ref;           /* Refferance value for equality test.             */

  /* Test input.  */

  if (pcurve->idim != 1) goto err106;

  kdim = pcurve -> idim;

  /* Fetch endpoints and the intervals of parameter interval of curves.  */

  st = pcurve->et;
  kn = pcurve->in;
  kk = pcurve->ik;

  tstart = *(pcurve->et + pcurve->ik - 1);
  tend   = *(pcurve->et + pcurve->in);
  tdelta = tend - tstart;
  if (tdelta == DZERO) tdelta = fabs(tend);
  if (tdelta == DZERO) tdelta = (double)1.0;

  /* Initiate variables.  */

  tnext = astart;

  /* Evaluate 0-1.st derivatives of function */

  s1221(pcurve,kder,tnext,&kleft,sval,&kstat);
  if (kstat < 0) goto error;

  tprev = sval[0];

  /* Evaluate step */

  s1252_s6dir(&td,tnext,sval,tstart,tend);

  /* Correct if we not are inside the parameter intervall. */

  s1252_s6corr(&td,tnext,st,kn,kk,&kleft,&kdir);

  /* Iterate to find the intersection point.  */

  for (knbit = 0; knbit < 20; knbit++)
    {

      /* If the tnext is a break point test if it is a local maximum */

      if (kdir == -2 || kdir == 2)
	{
	  double tder1,tder2;
	  /* Break point, test if local maximum */

	  s1221(pcurve,kder,tnext,&kleft,sval,&kstat);
	  if (kstat < 0) goto error;
	  tder2 = sval[1];

	  s1227(pcurve,kder,tnext,&kleft,sval,&kstat);
	  if (kstat < 0) goto error;
	  tder1 = sval[1];

	  /*    Test if top point */

	  if (tder1>=DZERO && tder2<=DZERO) break;

	  /*    Not a top point */
	}


      /* Evaluate 0-1.st derivatives of both curves, dependent of the
	 sign of td we calculate derivatives from the right or the left */

      if (kdir>=1)
	{
	  s1221(pcurve,kder,tnext+td,&kleft,sval,&kstat);
	  if (kstat < 0) goto error;
	}
      else
	{
	  s1227(pcurve,kder,tnext+td,&kleft,sval,&kstat);
	  if (kstat < 0) goto error;
	}

        tdist = sval[0];
        if (fabs(tdist) < (double)1.0) ref = (double)2.0;
	else                           ref = DZERO;

        if (tdist >= tprev || DEQUAL(ref+tdist,ref+tprev))
	{
	   tnext += td;

	   /* Evaluate step */
	   s1252_s6dir(&td,tnext,sval,tstart,tend);
	   s1252_s6corr(&td,tnext,st,kn,kk,&kleft,&kdir);

	   if (fabs(td/tdelta) <= REL_COMP_RES) break;

	   tprev = tdist;

	}

      /* Not converging, correct and try again. */

      else
	{

	  td /= (double)2;
	  if (fabs(td/tdelta) <= REL_COMP_RES) break;
	}


    }


  /* Iteration stopped, test if point founds found is within resolution */

  if (tdist <= aepsge)
    *jstat = 1;
  else
    *jstat = 2;

  /*ujk,july 89:*/
  /* Test if the iteration is close to a knot */
  if (DEQUAL(tnext,pcurve->et[kleft]))
    *cpos = pcurve->et[kleft];
  else if (DEQUAL(tnext,pcurve->et[kleft+1]))
    *cpos = pcurve->et[kleft+1];
  else
    *cpos = tnext;

  /* Iteration completed.  */

  goto out;


  /* Error in input. Conflicting dimensions.  */

 err106: *jstat = -106;
  s6err("S1252",*jstat,kpos);
  goto out;

  /* Error in lower level routine.  */

  error : *jstat = kstat;
  s6err("S1252",*jstat,kpos);
  goto out;

 out:;
}


//===========================================================================
void s1119(double *ecoef,double *et1,double *et2,int ik1,int in1,int ik2,
	   int in2,int *jsimple,int *jind1,int *jind2,int *jstat)
//===========================================================================
{
  int ki,kj;     /* Counters.                                          */
  int ksimple;   /* Indicates if simple case.                          */
  int ksimple1;  /* Indicates if simple case.                          */
  int ksimple2;  /* Indicates if simple case.                          */
  int ksign;     /* Number of direction changes in line/column.        */
  int kconvex1;  /* Flag, if true, we have no interior min 
		    in first direction.*/
  int kconcav1;  /* Flag, if true, we have no interior max 
		    in first direction.*/
  int kconvex2;  /* Flag, if true, we have no interior min 
		    in second direction.*/
  int kconcav2;  /* Flag, if true, we have no interior max 
		    in second direction.*/
  int kbez;      /* Flagging for bezier case.                          */
  double tfirst; /* First non-zero difference between two adjacent vertices. */
  double tprev;  /* Previous difference between two adjacent vertices. */
  double tdiff;  /* Current difference between two adjacent vertices.  */
  double *s1;    /* Pointer used to traverse array of vertices.        */
  
  /* First we search for interior knotmultiplicity in 
     both parameter directions*/
  *jind1    = 0;
  ksimple1 = 1;
  if (in1 > 1)
    for (ki=ik1+1; ki<in1 && ksimple1; ki++) 
      {  
	if (et1[ki] == et1[ki+ik1-1]) 
	  {
	    *jind1    = ki;
	    ksimple1  =  0;
	  }
      }
  
  *jind2   = 0;
  ksimple2 = 1;
  if (in2 > 1)
    for (ki=ik2+1; ki<in2 && ksimple2; ki++) 
      {  
	if (et2[ki] == et2[ki+ik2-1]) 
	  {
	    *jind2    = ki;
	    ksimple2  =  0;
	  }
      }
  
  
  ksimple = ksimple1 && ksimple2;
  kbez = (((ik1 == in1) && (ik2 == in2)) ? 1 : 0);
  
  /* Count number of direction changes in first parameter direction. */
  /* Notify that we cannot accept equal coeffisient neighbours when 
     we are in a none-bezier case.                                   */
  
  kconcav1 = kconvex1 = 1;
  
  if (in1 > 1)
    for (s1=ecoef,kj=0; kj<in2 && ksimple; kj++)
      {
	ksign = 0;
	tfirst = DZERO;
	
	for (ki=0; ki<in1-1 && ksimple; ki++,s1++)
	  {
	    tdiff = *(s1+1) - *s1;
	    if (DEQUAL(tdiff,DZERO) )
	      { 
		if (kbez == 0) ksimple = 0;
	      }
	    else if (DEQUAL(tfirst,DZERO) )
	      {
		/* First none-zero vector, save it. */
		tfirst = tdiff;
		tprev  = tdiff;
	      }
	    
	    else if (tprev*tdiff < DZERO)
	      {
		tprev = tdiff;
		ksign++;
		if (ksign > 1) ksimple = 0;
	      }
	  }
	
	
	if (kbez == 0)
	  {
	    /* We permit status simple case only in bezier case. 
	       However, if the surface is strictly concav in one 
	       parameter direction, we have found 
	       the max on the edges. */ 
	    kconvex1 = 0;
	    kconcav1 = ((tfirst < DZERO) && kconcav1); 
	  }
	else
	  {
	    
	    kconvex1 = (((ksign == 0) || 
			 (ksign == 1 && tfirst >= DZERO)) && kconvex1); 
	    kconcav1 = (((ksign == 0) || 
			 (ksign == 1 && tfirst <= DZERO)) && kconcav1); 
	  }
	
	ksimple  = ((kconvex1 || kconcav1) && ksimple);
	s1++;
	
      }
  
  /* Count number of direction changes in second parameter direction. */
  kconcav2 = kconvex2 = 1;    
  if (in2 > 1)
    for (kj=0; kj<in1 && ksimple; kj++)
      {
	ksign = 0;
	tfirst = DZERO;
	s1 = ecoef + kj;
	
	for (ki=0; ki<in2-1 && ksimple; ki++,s1+=in1)
	  {
	    tdiff = *(s1+in1) - *s1;
	    if (DEQUAL(tdiff,DZERO) )
	      { 
		if (kbez == 0) ksimple = 0;
	      }
	    else if (DEQUAL(tfirst,DZERO) )
	      {
		/* First none-zero vector, save it. */
		tfirst = tdiff;
		tprev  = tdiff;
	      }
	    
	    else if (tprev*tdiff < DZERO)
	      {
		tprev = tdiff;
		ksign++;
		if (ksign > 1) ksimple = 0;
	      }
	  }
	
	if (kbez == 0)
	  {
	    /* We permit status simple case only in bezier case. 
	       However, if the surface is strictly concav in one 
	       parameter direction, we have found 
	       the max on the edges. */ 
	    kconvex2 = 0;
	    kconcav2 = ((tfirst < DZERO) && kconcav2); 
	  }
	else
	  {
	    
	    kconvex2 = (((ksign == 0) || 
			 (ksign == 1 && tfirst >= DZERO)) && kconvex2); 
	    kconcav2 = (((ksign == 0) || 
			 (ksign == 1 && tfirst <= DZERO)) && kconcav2); 
	  }
	ksimple  = ((kconvex2 || kconcav2) && ksimple);
      }
  
  /* Simple case test performed.  */
  
  if (ksimple)
    {
      if (kconvex1 && kconvex2)
	*jsimple = 1;
      else
	*jsimple = 0;	
    }
  else
    *jsimple = 2;
  *jstat = 0;
  
  return;
}
                              
//===========================================================================
void s1162(SISLObject *po1,double *cmax,double aepsge, SISLIntdat **pintdat,
	   SISLEdge *vedge[2], int ilevel,int inum,int *jstat)
//===========================================================================
{
  int klevel;             /* Local - Debt in recursion with.    */
  int knumedge;           /* Local - Number of max. on the edges*/
  int kpos  = 0;          /* Position of error.                 */
  int kstat = 0;          /* Local error status.                */
  int ksimple = 0;        /* Local simple case status.          */
  int kdiv  = 0;          /* Parameter direction of subdivsion. */
  int knum;               /* Number of edges in subproblems.    */
  int ki;                 /* Counter.                           */
  int kind1,kind2;        /* Index two knots with multiplicity. */
  SISLObject *uob1[4];        /* Pointers to subdivided object.     */
  SISLObject *qdum;           /* Pointer to dummy object.           */
  SISLEdge **uedge=SISL_NULL;      /* Pointer to array (to be allocated)
				    of edges to use in subproblems.    */
  SISLIntpt *up[2];
  SISLPtedge *qpt0,*qpt1;

  /*Init*/
  knumedge   = inum;
  klevel     = ilevel;

  for (ki=0;ki<4;ki++)  uob1[ki] = SISL_NULL;
  if ((qdum = newObject(SISLPOINT)) == SISL_NULL) goto err101;

  /* Initiate no maximum.*/
  *jstat = 0;

  /* Test if maximum is possible (perform box-test).  */
  s1190(po1,cmax,aepsge,&kstat);
  if (kstat < 0) goto error;

  /* We may have four different values on kstat.
     kstat = 1 : The SISLbox is beyond level value.
     kstat = 2 : The object is of constant value.
     kstat = 3 : The object is beyond one of its corners.
     kstat = 0 : No conclusion.*/

  if (kstat == 1);

  /* No max is possible */

  else if (kstat == 2)
    {
      /* The geometry is of constant value. Since it is not taken by
	 the SISLbox test and the edges already are treated in s1161,
	 we just connect the point on the edges. */


      if (vedge[0] != SISL_NULL && vedge[0]->iedge == 2)
	{
	  /* Only curves has to do connect */

	  qpt0=vedge[0]->prpt[0];
	  qpt1=vedge[0]->prpt[1];
	  if (qpt0 != SISL_NULL && qpt1 != SISL_NULL)
	    {

	      up[0] = qpt0->ppt;
	      up[1] = qpt1->ppt;
	      s6idcon(pintdat,&up[0],&up[1],&kstat);
	      if (kstat<0) goto error;
	    }
	}
    }

  else if (kstat == 3);


  /* Maximum for the object is a corner value, it has been found
     while treating the edges. */


  else
    {
      /* Simple Case test (more than one maximum possible?)  */
      if(po1->iobj ==SISLCURVE)

	s1119(po1->c1->ecoef,po1->c1->et,po1->c1->et,
	      po1->c1->ik,po1->c1->in,
	      1,1,&ksimple,&kind1,&kind2,&kstat);

      else
	s1119(po1->s1->ecoef,po1->s1->et1,po1->s1->et2,
	      po1->s1->ik1,po1->s1->in1,
	      po1->s1->ik2,po1->s1->in2,&ksimple,&kind1,&kind2,&kstat);
      if (kstat < 0) goto error;

      /* We may have three different values on ksimple.
	 ksimple = 0 : Not possible with interior max.
	 ksimple = 1 : Simpel case
	 ksimple = 2 : Not simpel case.*/

      if (ksimple == 0)
	*jstat = 0;

      else if (ksimple == 1)
	{
	  /* Simple Case, uppdate maximum list. */

	  s1162_s9update(po1,cmax,aepsge,pintdat,vedge,&kstat);
	  if (kstat < 0) goto error;
	  *jstat = kstat;

	}
      else
	{
	  /* Check for interval maximum.*/

	  s1162_s9con(po1,cmax,aepsge,pintdat,vedge,&klevel,&knumedge,&kstat);
	  if (kstat < 0) goto error;

	  /* We may have two different values on kstat.
	     kstat = 0 : No intervall maximum.
	     kstat = 1 : More than 2 maximum found on the edges.
	                 (bezier case only).
	     kstat = 2 : Intervall maximum found.
	     kstat = 3 : Simple case  */

	  if (kstat == 3)
	    /* Simple Case, uppdate maximum list. */
	    {

	      s1162_s9update(po1,cmax,aepsge,pintdat,vedge,&kstat);
	      if (kstat < 0) goto error;
	      *jstat = kstat;
	    }

	  else if (kstat == 2)

	    *jstat = kstat;     /*Uppdating maximum found. */

	  else
	    {
	      /* Find number of possible subdivision directions.
		 kdiv may have 4 difference values :
		 kdiv = 0 : Subdivision not possible.
		 kdiv = 1 : Subdivision in first parameter direction.
		 kdiv = 2 : Subdivision in second parameter direction.
		 kdiv = 3 : Subdivision in both parameter directions. */

	      s1162_s9num(po1,&kdiv,&kstat);
	      if (kstat < 0) goto error;


	      if(kdiv == 0)
		{
		  /* Microcase in parameter plane.*/

		  s1162_s9mic(po1,qdum,pintdat,vedge,&kstat);
		  if (kstat < 0) goto error;
		  else *jstat = kstat;
		}
	      else
		{
		  /* We do not have simpel case and it is possible to
		     subdivide. We therfor subdivide and uppdate the
		     edge maximum and then do a recurcive call
		     to treat the sub problems. Curves are subdivided
		     into two, surfaces into four. We can therfor get
		     up to four recursive calls.*/

		  /* Computing total number of subobjects in sub problems. */
		  knum = (kdiv<3 ? 2:4);

		  /***** Treating objects on sub problems. *****/

		  if (kdiv > 0) /* New objects for subdivision of po1. */
		    {
		      for (ki=0;ki<knum;ki++)
			{
			  if ((uob1[ki] = newObject(po1->iobj)) == SISL_NULL)
			    goto err101;

			  /*Initiate o1 pointer to point to top level object.*/

			  uob1[ki]->o1 = po1->o1;
			}

		      /* Subdivide the po1 object. */

		      s1162_s9div(po1,cmax,aepsge,kdiv,kind1,kind2,
			    uob1,pintdat,vedge,klevel,&kstat);
		      if (kstat < 0) goto error;
		      *jstat = max(*jstat,kstat);

		    }

		  /***** Treating edges on sub problems. *****/


		  /* Making array of pointers to edge object
		     to the sub problems. */
		  if ((uedge = new0array(2*knum,SISLEdge *)) == SISL_NULL)
		    goto err101;

		  /* Making new edge object to sub problems. */
		  for (ki=0; ki<2*knum; ki+=2)
		    {

		      if ((uedge[ki]   = newEdge(vedge[0]->iedge)) == SISL_NULL)
			goto err101;
		      /* No edge for the dummy point: */
		      uedge[ki+1] = SISL_NULL;

		    }


		  /***** Recursion. *****/
		  for (ki=0;ki<knum;ki+=1)
		    {

		      /* Uppdate edge maximum on sub problems. */
		      s1162_s9edge(uob1+ki, &qdum, 1, 1, *pintdat,
			     uedge+2*ki, &kstat);
		      if (kstat < 0) goto error;

		      s1162(uob1[ki],cmax,aepsge,pintdat,
			    uedge+2*ki,klevel,knumedge,&kstat);
		      if (kstat < 0) goto error;
		      else *jstat = max(*jstat, kstat);
		    }
		}
	    }
	}
    }

  /* Intersections in the inner found.  */

  goto out;

  /* Error in space allocation.         */
 err101: *jstat = -101;
  s6err("s1162",*jstat,kpos);
  goto out;

  /* Error in lower level routine.      */
  error : *jstat = kstat;
  s6err("s1162",*jstat,kpos);
  goto out;

  /* Free the space that is  allocated. */

 out:
  if (qdum != SISL_NULL) freeObject(qdum);

  for (ki=0;ki<4;ki++)
    if (uob1[ki] != SISL_NULL) freeObject(uob1[ki]);

  if (uedge != SISL_NULL)
    {
       /* 26.10.92 UJK/ BEOrd13969 */
       /* for (ki=0;ki<knum;ki++) */
       for (ki=0;ki<2*knum;ki++)
	  if (uedge[ki] != SISL_NULL) freeEdge(uedge[ki]);

      freearray(uedge);
    }
}



//===========================================================================
void s1162_s9mic(SISLObject *po1,SISLObject *po2,SISLIntdat **rintdat,
		 SISLEdge *vedge[],int *jstat)
//===========================================================================
{
  int kpos = 0;                 /* Position of error.                      */
  int kstat=0;                  /* Local error status.                     */
  int kpoint;                   /* Number of intpt on edges.               */
  double *spar = SISL_NULL;          /* Array to store parameter values.        */
  SISLIntpt **up = SISL_NULL;     /* Array of poiners to intersection point. */


  /* Initiate to now new intersection point. */


  *jstat = 0;


  /* Compute number of intersection points on edges. */

  if (vedge[0] == SISL_NULL )
    kpoint = 0;
  else
    kpoint = vedge[0]->ipoint;

  if (vedge[1] != SISL_NULL )
    kpoint += vedge[1]->ipoint;


  if (kpoint == 0 )
    {
      int kpar = 0;
      SISLIntpt *qt;


      /* There is not any intersection points on the edges.
	 We therfor make one new intersection point with parameter
	 values in senter of each object. */


      /* Number of parameter values of object 1. */

      if (po1->iobj == SISLCURVE) kpar = 1;
      else if (po1->iobj == SISLSURFACE) kpar = 2;


      /* Number of parameter values of object 2. */

      if (po2->iobj == SISLCURVE) kpar++;
      else if (po2->iobj == SISLSURFACE) kpar += 2;


      /* Allocate array to store midpoint parameter values. */

      if ((spar = newarray(kpar,double)) == SISL_NULL)
	goto err101;


      /* Compute midpoint parameter values. */

      if (po1->iobj == SISLCURVE)
	{
	  spar[0] = (po1->c1->et[po1->c1->ik - 1] +
		     po1->c1->et[po1->c1->in])*(double)0.5;
	  kpar = 1;
	}
      else if (po1->iobj == SISLSURFACE)
	{
	  spar[0] = (po1->s1->et1[po1->s1->ik1 - 1] +
		     po1->s1->et1[po1->s1->in1])*(double)0.5;
	  spar[1] = (po1->s1->et2[po1->s1->ik2 - 1] +
		     po1->s1->et2[po1->s1->in2])*(double)0.5;
	  kpar = 2;
	}

      if (po2->iobj == SISLCURVE)
	{
	  spar[kpar] = (po2->c1->et[po2->c1->ik - 1] +
			po2->c1->et[po2->c1->in])*(double)0.5;
	  kpar++;
	}
      else if (po2->iobj == SISLSURFACE)
	{
	  spar[kpar] = (po2->s1->et1[po2->s1->ik1 - 1] +
			po2->s1->et1[po2->s1->in1])*(double)0.5;
	  spar[kpar+1] = (po2->s1->et2[po2->s1->ik2 - 1] +
			  po2->s1->et2[po2->s1->in2])*(double)0.5;
	  kpar += 2;
	}

      *jstat = 1;         /* Mark intersection found. */


      /* Makeing intersection point. */

      qt = newIntpt(kpar,spar,DZERO);
      if (qt == SISL_NULL) goto err101;

      /* Uppdating pintdat. */

      s6idnpt(rintdat,&qt,1,&kstat);
      if (kstat < 0) goto error;
    }
  else if (kpoint > 1)
    {
      int kn,kn1,ki,kj;
      SISLPtedge *qpt;


      /* We have more than one intersection point on the edges,
	 we therfor conect these points to each other. */

      /* Allacate array of pointers to these points. */

      if ((up = newarray(kpoint,SISLIntpt *)) == SISL_NULL) goto err101;


      /* Uppdate the array. */

      for (kn=0,kn1=0; kn<2; kn++)
	if (vedge[kn] != SISL_NULL && vedge[kn]->ipoint > 0)
	  for(kj=0; kj<vedge[kn]->iedge; kj++)
	    for(qpt=vedge[kn]->prpt[kj]; qpt != SISL_NULL; qpt=qpt->pnext,kn1++)
	      up[kn1] = qpt->ppt;


      /* Connect the points to each other. */

      for (ki=1; ki<kpoint; ki++)
	{
	  s6idcon(rintdat,&up[ki-1],&up[ki],&kstat);
	  if (kstat<0) goto error;
	}
    }

  goto out;

  /* Error in space allocation.         */

 err101: *jstat = -101;
  s6err("s1162_s9mic",*jstat,kpos);
  goto out;

  /* Error in lower level routine.      */

  error : *jstat = kstat;
  s6err("s1162_s9mic",*jstat,kpos);
  goto out;

 out: if (spar != SISL_NULL) freearray(spar);
  if (up != SISL_NULL)   freearray(up);
}

//===========================================================================
void s1162_s9num(SISLObject *po,int *jdiv,int *jstat)
//===========================================================================
{
  *jstat = 0;
  if (po->iobj == SISLPOINT)                             *jdiv = 0;
  else if (po->iobj == SISLCURVE)
    {
      if(s1791(po->c1->et,po->c1->ik,po->c1->in))    *jdiv = 1;
      else                                           *jdiv = 0;
    }
  else if (po->iobj == SISLSURFACE)
    {
      if(s1791(po->s1->et1,po->s1->ik1,po->s1->in1)) *jdiv = 1;
      else                                           *jdiv = 0;

      if(s1791(po->s1->et2,po->s1->ik2,po->s1->in2)) *jdiv += 2;
    }
  else
    {

      /* Error. Kind of object does not exist.  */

      *jstat = -121;
      s6err("s1162_s9num",*jstat,0);
    }
}

//===========================================================================
void s1162_s9edge(SISLObject *vob1[],SISLObject *vob2[], int iobj1,int iobj2,
		  SISLIntdat *pintdat,SISLEdge *wedge[],int *jstat)
//===========================================================================
{
  int kpos = 0;                 /* Position of error.       */
  int kstat=0;                  /* Local error status.      */
  int ki1,ki2,kj,kn;            /* Counters.                */
  int kedg;                     /* Number of edges.         */
  int kpar;                     /* Parameter number.        */
  double tpar;                  /* Parameter value at edge. */


  for (kn=0,ki1=0; ki1<iobj1; ki1++)
    for (ki2=0; ki2<iobj2; ki2++,kn+=2)
      {
        kedg = (vob1[ki1]->iobj == SISLPOINT ?0:(vob1[ki1]->iobj == SISLCURVE ?2:4));

	for (kj=0; kj<kedg; kj++)
	  {
	    if (vob1[ki1]->iobj == SISLCURVE)
	      {
		tpar = (kj == 0 ? vob1[ki1]->c1->et[vob1[ki1]->c1->ik-1] :
			vob1[ki1]->c1->et[vob1[ki1]->c1->in]);
		kpar = 1;
	      }
	    else if (kj == 0)
	      {
		tpar = vob1[ki1]->s1->et2[vob1[ki1]->s1->ik2-1];
		kpar = 2;
	      }
	    else if (kj == 1)
	      {
		tpar = vob1[ki1]->s1->et1[vob1[ki1]->s1->in1];
		kpar = 1;
	      }
	    else if (kj == 2)
	      {
		tpar = vob1[ki1]->s1->et2[vob1[ki1]->s1->in2];
		kpar = 2;
	      }
	    else
	      {
		tpar = vob1[ki1]->s1->et1[vob1[ki1]->s1->ik1-1];
		kpar = 1;
	      }


	    s6idedg(vob1[ki1],vob2[ki2],1,kpar,tpar,pintdat,
		    &(wedge[kn]->prpt[kj]),&(wedge[kn]->ipoint),&kstat);
	    if (kstat < 0) goto error;
	  }

        kedg = (vob2[ki2]->iobj == SISLPOINT ?0:(vob2[ki2]->iobj == SISLCURVE ?2:4));

	for (kj=0; kj<kedg; kj++)
	  {
	    if (vob2[ki2]->iobj == SISLCURVE)
	      {
		tpar = (kj == 0 ? vob2[ki2]->c1->et[vob2[ki2]->c1->ik-1] :
			vob2[ki2]->c1->et[vob2[ki2]->c1->in]);
		kpar = 1;
	      }
	    else if (kj == 0)
	      {
		tpar = vob2[ki2]->s1->et2[vob2[ki2]->s1->ik2-1];
		kpar = 2;
	      }
	    else if (kj == 1)
	      {
		tpar = vob2[ki2]->s1->et1[vob2[ki2]->s1->in1];
		kpar = 1;
	      }
	    else if (kj == 2)
	      {
		tpar = vob2[ki2]->s1->et2[vob2[ki2]->s1->in2];
		kpar = 2;
	      }
	    else
	      {
		tpar = vob2[ki2]->s1->et1[vob2[ki2]->s1->ik1-1];
		kpar = 1;
	      }


	    s6idedg(vob1[ki1],vob2[ki2],2,kpar,tpar,pintdat,
		    &(wedge[kn+1]->prpt[kj]),&(wedge[kn+1]->ipoint),&kstat);
	    if (kstat < 0) goto error;
	  }
      }

  *jstat = 0;

  goto out;

  /* Error in lower level routine.      */

  error : *jstat = kstat;
  s6err("s1162_s9edge",*jstat,kpos);
  goto out;

 out: ;
}

//===========================================================================
void s1162_s9con(SISLObject *po1,double *cmax,double aepsge,SISLIntdat **pintdat,
		 SISLEdge *vedge[],int *jlevel,int *jnum,int *jstat)
//===========================================================================
{
  SISLIntpt  *qintpt,*up[10];
  SISLPtedge *qpt;

  int kstat;      /* Local status.                */
/*guen  int kpos;   */   /* Local status counter.        */
/*guen changed into:*/
  int kpos = 0;   /* Local status counter.        */
  int kk1;        /* Local SURFACE attribute.     */
  int kk2;        /* Local SURFACE attribute.     */
  int kn1;        /* Local SURFACE attribute.     */
  int kn2;        /* Local SURFACE attribute.     */
  int ki,kj;      /* Local counter.               */
  int kfound;     /* Local flag in loop.          */
  int knum   = 0; /* Local number of max on edge. */
  int klevel = 0; /* Local level.                 */
  int kleft1 = 0; /* Local input parameter s1421  */
  int kleft2 = 0; /* Local input parameter s1421  */
  int kder   = 1; /* Local input parameter s1421  */

  double spar[2];  /* Parameter value              */
  double spar1[2]; /* Parameter value              */
  double smidle[2];/* middle parameter value       */
  double *sval=SISL_NULL;/*  Values from s1421.          */
  double *snorm=SISL_NULL;/* Values from s1421.         */


  kstat = 0;

  if (po1->iobj == SISLSURFACE)
    {
      if ((po1->s1->in1 == po1->s1->ik1) && (po1->s1->in2 == po1->s1->ik2))
	/* Bezier case for surface */
	{

	  /*-------------------------------------------------------*/
	  /* Count number of max on the edges. */
	  kk1 = po1->s1->ik1;
	  kk2 = po1->s1->ik2;
	  kn1 = po1->s1->in1;
	  kn2 = po1->s1->in2;

	  for (kj=0,knum=0;kj<vedge[0]->iedge;kj++)
	    {
	      qpt = vedge[0]->prpt[kj];
	      while(qpt != SISL_NULL)
		{
		  qintpt = qpt->ppt;
		  for (ki=0,kfound=0;ki<knum && kfound == 0;ki++)
		    if (qintpt == up[ki]) kfound = 1;

		  if (kfound == 0)
		    {
		      if (knum > 9) goto out;
		      up[knum]=qintpt;
		      knum++;
		    }

		  qpt = qpt->pnext;
		}

	    }

	  /*---------------------------------------------------------*/

	  if (knum > 0 )
	    /* Number of max on the edges more than 1. */
	    {
	      klevel = *jlevel;

	      if (klevel == 0 || knum !=*jnum)
		/* No continuation of suspected singulear point,
		   start a new one. */
		{
		  kstat = 1;
		  klevel = 1;
		}
	      else if (klevel < 2)
		/* Continuation of suspected singulear point. */
		{
		  kstat = 1;
		  klevel += 1;
		}
	      else if (knum < 2 )
		/* Simple Case */
		{
		  kstat = 3;
		  klevel += 1;
		}
	      else
		{

		  /*--------------------------------------------------*/
		  /* Connection case. */

		  /* Allocate local used memory */

		  sval = newarray(4,double);
		  if (sval == SISL_NULL) goto err101;
		  snorm = sval + 3;

		  for (kj=0;kj<knum-1;kj++)
		    {
		      spar[0] = up[kj]->epar[0];
		      spar[1] = up[kj]->epar[1];

		      for (ki=kj+1;ki<knum;ki++)
			{
			  /* First we linearize. */
			  spar1[0] = up[ki]->epar[0];
			  spar1[1] = up[ki]->epar[1];
			  smidle[0] = (spar[0] + spar1[0])/(double)2.0;
			  smidle[1] = (spar[1] + spar1[1])/(double)2.0;

			  /* Evaluate 0-1.st derivatives of surface */

			  s1421(po1->s1,kder,smidle,&kleft1,&kleft2,
				sval,snorm,&kstat);
			  if (kstat < 0) goto error;
			  if (fabs(sval[0]-*cmax) < aepsge)
			    {
			      /* Connect. */
			      s6idcon(pintdat,&up[kj],&up[ki],&kstat);
			      if (kstat<0) goto error;
			    }

			}
		    }


		  kstat = 2;
		  /*------------------------------------------*/


		}
	    }
	}
    }

  goto out;

  /* Error in allocation */
 err101: kstat = -101;
  s6err("s1162_s9con",kstat,kpos);
  goto out;

  /* Error in lower level routine.  */
  error : s6err("s1162_s9con",kstat,kpos);
  goto out;

 out:    if (sval != SISL_NULL) freearray(sval);
  *jlevel = klevel;
  *jnum   = knum;
  *jstat  = kstat;

}

//===========================================================================
void s1162_s9update(SISLObject *po1,double *cmax,double aepsge,
		    SISLIntdat **pintdat,SISLEdge *vedge[2],int *jstat)
//===========================================================================
{
  int i, kj, ki;      /* Counters.                          */
  int kpos = 0;       /* Position of error.                 */
  int kstat= 0;       /* Local status                       */
  int kk1, kk2, kn1, kn2; /* Local number of knots and vertices.     */
  int kmax, kind1, kind2; /* Indexes of the maximum vertice.         */
  int kleft = 0;          /* Used in s1221 .                         */
  int kleft2 = 0;         /* Used in s1424 .                         */
  int kconn  = 0;         /* Connection flag.                        */
  int knum  = 0;          /* Number of max on the edge.              */
  int kfound = 0;         /* Flag.                                   */

  double tstart, tend;       /* Start, end values for curve parameter.    */
  double sstart[2], send[2]; /* Start, end values for surface parameter.  */
  double tpar;               /* The parameter vallue for
				subdivision of a curve.    */
  double spar[2];            /* The parameter vallue for subdivision
				of a surface.  */
  double tmax, tmin;         /* Local max and min value for the
				vertices of object. */
  double tval;               /* The value of the geometry at the found point.*/


  SISLObject *qop=SISL_NULL,*qcuo = SISL_NULL;/* Help pointers        */
  SISLIntdat *qintdat=SISL_NULL;         /* Local max data.      */
  SISLIntdat *qintdat1=SISL_NULL;        /* Local for double upgrading. */
  SISLIntpt  *qintpt,*up[3];
  SISLPtedge *qpt;

  /* Init */
  *jstat = 0;
  if (po1 == SISL_NULL || po1->iobj == SISLPOINT) goto out;
  if ((qop = newObject(SISLPOINT)) == SISL_NULL) goto err101;

  if (po1->iobj == SISLCURVE)
    {
      kk1   = po1->c1->ik;
      kn1   = po1->c1->in;
      kmax  = po1->c1->pbox->imax;
      tmax  = po1->c1->pbox->emax[0];
      tmin  = po1->c1->pbox->emin[0];

      tstart = po1->c1->et[kk1-1];
      tend   = po1->c1->et[kn1];

      /* Try to find an inner ekstremal point by iteration. */


      /* First get a good starting point for the iteration. */
      tpar = 0;
      for (i=kmax+1;i<kmax+kk1;i++)
	tpar += po1->c1->et[i];

      tpar /= kk1 - 1;

      s1252(po1->c1,aepsge,tpar,&tpar,&kstat);
      if (kstat < 0) goto error;

      /* Test if the found point is at start or end. */
      if(DEQUAL(tpar,tstart)  || DEQUAL(tpar,tend)) goto out;


      /* Evaluate curve at parameter value. */
      kleft = 0;
      s1221(po1->o1->c1,0,tpar,&kleft,&tval,&kstat);
      if (kstat < 0) goto error;

      /* Here we are ready to examine if we really found a new max point.*/
      if ((qop->p1 = newPoint(&tval,1,1)) == SISL_NULL) goto err101;

      s1161(qop,cmax,aepsge,&qintdat,&kstat);
      if (kstat < 0) goto error;

      if (kstat == 2)
	/* New maximum found, delete old ones */
	if (*pintdat != SISL_NULL)
	  {
	    freeIntdat(*pintdat);
	    *pintdat = SISL_NULL;
	  }

      if ( kstat )
	{
	  /* Maximum found, add it to the list */
	  *jstat = max(*jstat,kstat);         /* Mark maximum found. */

	  /* Set parameter parameter value of curve. */
	  s6idput(pintdat,qintdat,0,tpar,&kstat);
	  if (kstat < 0) goto error;
	}

    }
  else if (po1->iobj == SISLSURFACE)
    {


      kk1   = po1->s1->ik1;
      kn1   = po1->s1->in1;
      kk2   = po1->s1->ik2;
      kn2   = po1->s1->in2;
      kmax = po1->s1->pbox->imax;
      tmax = po1->s1->pbox->emax[0];
      tmin = po1->s1->pbox->emin[0];

      sstart[0] = po1->s1->et1[kk1-1];
      sstart[1] = po1->s1->et2[kk2-1];

      send[0]   = po1->s1->et1[kn1];
      send[1]   = po1->s1->et2[kn2];


      /* Get the two dimensional index of the greatest vertice. */
      kind2 = kmax/kk1;
      kind1 = kmax - kind2*kk1;


      /*-----------------------------------------------------------*/
      /* Count number of max on the edges. */

      for (kj=0,knum=0;kj<vedge[0]->iedge&&knum<3;kj++)
	{
	  qpt = vedge[0]->prpt[kj];
	  while(qpt != SISL_NULL && knum<3)
	    {
	      qintpt = qpt->ppt;
	      for (ki=0,kfound=0;ki<knum && kfound == 0;ki++)
		if (qintpt == up[ki]) kfound = 1;

	      if (kfound == 0)
		{
		  up[knum]=qintpt;
		  knum++;
		}

	      qpt = qpt->pnext;
	    }

	}

      /* Try if connection is possible.*/
      if (knum == 2)
	{
	  /* if on same edge, they are be connected before
	     (when in simple case.)*/
	  if ((DEQUAL(up[0]->epar[0],sstart[0]) &&
	       DEQUAL(up[1]->epar[0],sstart[0]))||
	      (DEQUAL(up[0]->epar[0],send[0])   &&
	       DEQUAL(up[1]->epar[0],send[0]))  ||
	      (DEQUAL(up[0]->epar[1],sstart[1]) &&
	       DEQUAL(up[1]->epar[1],sstart[1]))||
	      (DEQUAL(up[0]->epar[1],send[1])   &&
	       DEQUAL(up[1]->epar[1],send[1])))
	    kconn = 0;

	  else
	    {
	      /* Pick out two curves between the parameter
		 value on the edges. */
	      kconn = 0;
	      ki = 0;
	      if (fabs(up[0]->epar[0]-up[1]->epar[0]) <
		  fabs(up[0]->epar[1]-up[1]->epar[1]))
		ki =1;

	      tpar = (double)0.25*up[0]->epar[ki] +
		     (double)0.75*up[1]->epar[ki];
	      if ((qcuo = newObject(SISLCURVE)) == SISL_NULL) goto err101;
	      if (ki==0)
		s1437(po1->s1,tpar,&(qcuo->c1),&kstat);
	      else
		s1436(po1->s1,tpar,&(qcuo->c1),&kstat);
	      if (kstat < 0) goto error;

	      s1161(qcuo,cmax,aepsge,&qintdat,&kstat);
	      if (kstat < 0) goto error;

	      if (kstat == 1)
		{
		  freeCurve(qcuo->c1);
		  qcuo->c1 = SISL_NULL;

		  tpar = (double)0.75*up[0]->epar[ki] +
		         (double)0.25*up[1]->epar[ki];
		  if (ki==0)
		    s1437(po1->s1,tpar,&(qcuo->c1),&kstat);
		  else
		    s1436(po1->s1,tpar,&(qcuo->c1),&kstat);
		  if (kstat < 0) goto error;

		  s1161(qcuo,cmax,aepsge,&qintdat,&kstat);
		  if (kstat < 0) goto error;

		  if (kstat == 1)
		    {
		      /* Connect. */
		      kconn = 1;
		      s6idcon(pintdat,&up[0],&up[1],&kstat);
		      if (kstat<0) goto error;
		    }
		}
	    }
	}


      if (kconn == 0)
	{
	  /* No connection is done. */

	  /* Try to find an inner ekstremal point by iteration. */

	  /* First get a good starting point for the iteration. */
	  spar[0] = 0;
	  for (i=kind1+1;i<kind1+kk1;i++)
	    spar[0] += po1->s1->et1[i];

	  spar[0] /= kk1 - 1;

	  spar[1] = 0;
	  for (i=kind2+1;i<kind2+kk2;i++)
	    spar[1] += po1->s1->et2[i];

	  spar[1] /= kk2 - 1;


	  /* Create a point greater than the surface */
	  if ((qop->p1 = newPoint(&tmax,1,1)) == SISL_NULL) goto err101;

	  /* Iterate using aepsge=tmax-tmin to ensure covergence. */
	  s1173(qop->p1,po1->o1->s1,aepsge,sstart,send,spar,spar,&kstat);
	  if (kstat < 0) goto error;

	  /* Test if the found point is at start or end. */
	  if(DEQUAL(spar[0],sstart[0])  ||
	     DEQUAL(spar[0],send[0])    ||
	     DEQUAL(spar[1],sstart[1])  ||
	     DEQUAL(spar[1],send[1])) goto out;

	  /* Evaluate surface at parameter value. */
	  kleft  = 0;
	  kleft2 = 0;
	  s1424(po1->o1->s1,0,0,spar,&kleft,&kleft2,&tval,&kstat);
	  if (kstat < 0) goto error;

	  /* Here we are ready to examine if we really found a max point.*/
	  freePoint(qop->p1);
	  qop->p1 = SISL_NULL;
	  if ((qop->p1 = newPoint(&tval,1,1)) == SISL_NULL) goto err101;

	  s1161(qop,cmax,aepsge,&qintdat,&kstat);
	  if (kstat < 0) goto error;

	  if (kstat == 2)
	    /* New maximum found, delete old ones */
	    if (*pintdat != SISL_NULL)
	      {
		freeIntdat(*pintdat);
		*pintdat = SISL_NULL;
	      }

	  if ( kstat )
	    {
	      /* Maximum found, add them to the list */

	      *jstat = max(*jstat,kstat);  /* Mark maximum found. */

	      /* Special treatment for putting two
		 new parameters into pintdat from qintdat. */
	      s6idput(&qintdat1,qintdat,0,spar[0],&kstat);
	      if (kstat < 0) goto error;
	      s6idput(pintdat,qintdat1,1,spar[1],&kstat);
	      if (kstat < 0) goto error;

	    }
	}
    }


  goto out;

  /* -------------------ERROR SECTION----------------------------*/

  /* Error in space allocation.  */
 err101: *jstat = -101;
  s6err("s1162_s9update",*jstat,kpos);
  goto out;

  /* Error in lower level routine.  */
  error : *jstat = kstat;

 out:
  if (qcuo != SISL_NULL)
    {
      if (qcuo->c1 != SISL_NULL)
	{
	  freeCurve(qcuo->c1);
	  qcuo->c1 = SISL_NULL;
	}
      freeObject(qcuo);
      qcuo = SISL_NULL;
    }

  if (qop != SISL_NULL)
    {
      if (qop->p1 != SISL_NULL)
	{
	  freePoint(qop->p1);
	  qop->p1 = SISL_NULL;
	}
      freeObject(qop);
      qop = SISL_NULL;
    }
  if (qintdat != SISL_NULL)
    {
      freeIntdat(qintdat);
      qintdat = SISL_NULL;
    }
  if (qintdat1 != SISL_NULL)
    {
      freeIntdat(qintdat1);
      qintdat1 = SISL_NULL;
    }
}

//===========================================================================
void s1162_s9div(SISLObject *po1,double *cmax,double aepsge,int idiv,int iind1,
		 int iind2,SISLObject *wob[],SISLIntdat **pintdat,SISLEdge *vedge[2],
		 int ilevel,int *jstat)
//===========================================================================
{

  SISLPtedge *qpt;

  int ki, kj,i; /* Counters.                                           */
  int kpos = 0; /* Position of error.                                  */
  int kstat= 0; /* Local status                                        */
  int kk1, kk2, kn1, kn2; /* Local number of knots and vertices.       */
  int kmax, kind1, kind2; /* Indexes of the maximum vertice.           */
  double tstart, tend;    /* Start,end and middle values for curve parameter.*/
  double sstart[2], send[2],tmidle;/* Start, end values for surface parameter*/
  double tpar, tparold;  /* The parameter vallue for subdivision curve.*/
  double spar[2],sparold[2]; /* The parameter vallue for subdivision
				of a surface.  */
  double *tmax, *tmin;/* Local max and min value for the vertices of object.*/
  double sdiff[2];    /* The length of parameter intervall for surface.      */
  double smin[2];     /* The lower allowed limit in the prameter intervall
			 for subdividing a surface.      */
  double smax[2];    /* The upper allowed limit in the prameter intervall
			for subdividing a surface.      */
  SISLSurf *qs1=SISL_NULL;  /* Help pointers while subdividing        */
  SISLSurf *qs2=SISL_NULL;  /* Help pointers while subdividing        */
  SISLObject *qop = SISL_NULL;/* Help pointers while subdividing      */
  SISLObject *qoc = SISL_NULL;/* Help pointers while subdividing      */
  SISLIntdat *qintdat=SISL_NULL;/* Local max data for the new edges.  */



  /* Init */
  *jstat = 0;
  if ((qop = newObject(SISLPOINT)) == SISL_NULL) goto err101;

  if (po1 == SISL_NULL || po1->iobj == SISLPOINT)
    /* Nothing to do. */
    ;
  else if (po1->iobj == SISLCURVE)
    {
      kk1   = po1->c1->ik;
      kn1   = po1->c1->in;
      kmax  = po1->c1->pbox->imax;
      tmax  = po1->c1->pbox->emax;
      tmin  = po1->c1->pbox->emin;

      tstart = po1->c1->et[kk1-1];
      tend   = po1->c1->et[kn1];

      /* If we got problems with subdiv in max points, remove as comment: */
      /*   kmax = 0;  */


      /* ------------------Determination of sudiv parameter value-----------*/
      if (iind1 != 0)
	/* We subdivide in an interior knot with multiplicity. */
	tpar = po1->c1->et[iind1];

      else if (kmax == 0 || kmax == kn1-1)
	/*The greatest coeff is the first or last, divide in middlepoint. */
	tpar = s1792(po1->c1->et,kk1, kn1);


      else
	/* Try to find an inner subdivision (ekstremal) point by iteration. */
	{

	  /* First get a good starting point for the iteration. */
	  tpar = 0;
	  for (i=kmax+1;i<kmax+kk1;i++)
	    tpar += po1->c1->et[i];

	  tpar /= kk1 - 1;
	  tparold = tpar;

	  /*Iterate using Newton. */
	  s1252(po1->c1,aepsge,tpar,&tpar,&kstat);
	  if (kstat < 0) goto error;

	  /* Test if the found point is at start or end. */
	  if(DEQUAL(tpar,tstart)  || DEQUAL(tpar,tend))
	    /*Try Schoenbergs approximation to max vertice. */
	    {
	      tpar = tparold;

	      if(DEQUAL(tpar,tstart)  || DEQUAL(tpar,tend))
		/*Divide in middlepoint. */
		tpar = s1792(po1->c1->et,kk1,kn1);
	    }
	}
      /* ------------------Subdivision -------------------------------- */

      /* Subdivide the curve at the given parameter value. */
      s1231(po1->c1,tpar,&(wob[0]->c1),&(wob[1]->c1),&kstat);
      if (kstat < 0) goto error;


      /* Pick out end point from a curve. */
      s1438(wob[0]->c1,1,&(qop->p1),&tpar,&kstat);
      if (kstat < 0) goto error;


      /* Examin if the subdividing point is a max. */
      s1161(qop,cmax,aepsge,&qintdat,&kstat);
      if (kstat < 0) goto error;

      if (kstat == 2)
	/* New maximum found, delete old ones */
	if (*pintdat != SISL_NULL)
	  {

	    freeIntdat(*pintdat);
	    *pintdat = SISL_NULL;
	  }

      if (kstat)
	{
	  /* Maximum found, add them to the list */

	  *jstat = max(*jstat,kstat);         /* Mark maximum found. */

	  /* Put maximum found on edges into pintdat. */

	  /* Set parameter border values of object. */
	  s6idput(pintdat,qintdat,0,tpar,&kstat);
	  if (kstat < 0) goto error;

	  if (qintdat != SISL_NULL)
	    {
	      freeIntdat(qintdat);
	      qintdat = SISL_NULL;
	    }
	}
    }
  else if (po1->iobj == SISLSURFACE)
    {
      kk1   = po1->s1->ik1;
      kn1   = po1->s1->in1;
      kk2   = po1->s1->ik2;
      kn2   = po1->s1->in2;
      kmax = po1->s1->pbox->imax;
      tmax = po1->s1->pbox->emax;
      tmin = po1->s1->pbox->emin;

      sstart[0] = po1->s1->et1[kk1-1];
      sstart[1] = po1->s1->et2[kk2-1];

      send[0]   = po1->s1->et1[kn1];
      send[1]   = po1->s1->et2[kn2];

      sdiff[0] = send[0] - sstart[0];
      sdiff[1] = send[1] - sstart[1];
      smin[0]  = sstart[0] + (double)0.01*sdiff[0];
      smin[1]  = sstart[1] + (double)0.01*sdiff[1];
      smax[0]  = send[0] - (double)0.01*sdiff[0];
      smax[1]  = send[1] - (double)0.01*sdiff[0];

      kind2 = kmax/kn1;
      kind1 = kmax - kind2*kn1;


      /* If we got problems with subdiv in max points, remove as comment: */
      /*  kind1 = 0; */

      /* ------------------Determination of sudiv parameter value-------*/
      if (iind1 != 0 || iind2 != 0 || ilevel > 0)
	{
	  if (ilevel > 0)
	    /* We are forced to subdivide in middlepoint. */
	    {
	      spar[0] = s1792(po1->s1->et1,kk1, kn1);
	      spar[1] = s1792(po1->s1->et2,kk2, kn2);
	    }

	  else
	    /*We have knot multiplicity at least in one parameter direction.
	      Subdivide in interior knot multiplicity. If the other parameter
	      direction is without multiplicities, subdivide in middlepoint.*/
	    {
	      if (iind1 != 0)
		spar[0] = po1->s1->et1[iind1];
	      else
		spar[0] = s1792(po1->s1->et1,kk1, kn1);

	      if (iind2 != 0 )
		spar[1] = po1->s1->et2[iind2];
	      else
		spar[1] = s1792(po1->s1->et2,kk2, kn2);
	    }
	}


      else if (kind1 == 0 || kind1 == kn1-1 || kind2 == 0 || kind2 == kn2-1)
	{

	  /*The greatest coeff is on the edge.
	    Examin the edge for max and divide
	    in these parameter values. If more than one max,
	    use the one closest to the middlepoint*/

	  tmidle = s1792(po1->s1->et1,kk1, kn1);
	  spar[0] = sstart[0];

	  for (kj=0;kj<3;kj+=2)
	    {
	      qpt = vedge[0]->prpt[kj];
	      while (qpt != SISL_NULL)
		{
		  if (fabs(qpt->ppt->epar[0] - tmidle) <
		      fabs(spar[0] - tmidle))
		    spar[0] = qpt->ppt->epar[0];
		  qpt = qpt->pnext;
		}
	    }
	  if (DEQUAL(spar[0],sstart[0])  || DEQUAL(spar[0],send[0]))
	    spar[0] = tmidle;

	  tmidle = s1792(po1->s1->et2,kk2, kn2);
	  spar[1] = sstart[1];

	  for (kj=1;kj<4;kj+=2)
	    {
	      qpt = vedge[0]->prpt[kj];
	      while (qpt != SISL_NULL)
		{
		  if (fabs(qpt->ppt->epar[0] - tmidle) <
		      fabs(spar[1] - tmidle))
		    spar[1] = qpt->ppt->epar[1];
		  qpt = qpt->pnext;
		}
	    }
	  if (DEQUAL(spar[1],sstart[1])  || DEQUAL(spar[1],send[1]))
	    spar[1] = tmidle;
	}


      else
	/* Try to find an inner subdivision (ekstremal) point by iteration. */
	{

	  /* First get a good starting point for the iteration. */
	  spar[0] = 0;
	  for (i=kind1+1;i<kind1+kk1;i++)
	    spar[0] += po1->s1->et1[i];

	  spar[0] /= kk1 - 1;
	  sparold[0] = spar[0];

	  spar[1] = 0;
	  for (i=kind2+1;i<kind2+kk2;i++)
	    spar[1] += po1->s1->et2[i];

	  spar[1] /= kk2 - 1;
	  sparold[1] = spar[1];


	  /* Create a point greater than the surface */
	  if ((qop->p1 = newPoint(tmax,1,1)) == SISL_NULL) goto err101;

	  /* Iterate using Newton. */
	  s1173(qop->p1,po1->o1->s1,aepsge,sstart,send,spar,spar,&kstat);
	  freePoint(qop->p1);
	  qop->p1 = SISL_NULL;
	  if (kstat < 0) goto error;

	  /* Test if the found point is near one edge. */
	  if(spar[0] < smin[0] ||spar[0] > smax[0]
	     || spar[1] < smin[1] ||spar[1] > smax[1])
	    {
	      /*Try Schoenberg. */
	      spar[0] = sparold[0];
	      spar[1] = sparold[1];

	      if(spar[0] < smin[0] ||spar[0] > smax[0]
		 || spar[1] < smin[1] ||spar[1] > smax[1])
		{
		  /*Divide in middlepoint. */
		  spar[0] = s1792(po1->s1->et1,kk1,kn1);
		  spar[1] = s1792(po1->s1->et2,kk2,kn2);
		}
	    }


	}


      /* ------------------Subdivision ------------------------------*/
      /* Now we have found the parameters for subdivision, divide! */

      if ((qoc = newObject(SISLCURVE)) == SISL_NULL)
	goto err101;

      for (ki=0; ki<(idiv<3 ? 1:3); ki++)
	{

	  if (idiv == 1)
	    {
	      s1711(po1->s1,1,spar[0],&(wob[0]->s1),&(wob[1]->s1),&kstat);
	      if (kstat < 0) goto error;

	      /* Pick out edge curve from a surface. */

	      s1435(wob[0]->s1,1,&(qoc->c1),spar,&kstat);
	      if (kstat < 0) goto error;
	    }
	  else if (idiv == 2)
	    {
	      s1711(po1->s1,2,spar[1],&(wob[0]->s1),&(wob[1]->s1),&kstat);
	      if (kstat < 0) goto error;

	      /* Pick out edge curve from a surface. */

	      s1435(wob[0]->s1,2,&(qoc->c1),spar+1,&kstat);
	      if (kstat < 0) goto error;
	    }
	  else if (ki == 0)
	    {
	      s1711(po1->s1,1,spar[0],&qs1,&qs2,&kstat);
	      if (kstat < 0) goto error;

	      /* Pick out edge curve from a surface. */

	      s1435(qs1,1,&(qoc->c1),spar,&kstat);
	      if (kstat < 0) goto error;
	    }
	  else if (ki == 1)
	    {
	      s1711(qs1,2,spar[1],&(wob[0]->s1),&(wob[1]->s1),&kstat);
	      if (kstat < 0) goto error;

	      /* Pick out edge curve from a surface. */

	      s1435(wob[0]->s1,2,&(qoc->c1),spar+1,&kstat);
	      if (kstat < 0) goto error;
	    }
	  else   /* if (ki == 2) */
	    {
	      s1711(qs2,2,spar[1],&(wob[2]->s1),&(wob[3]->s1),&kstat);
	      if (kstat < 0) goto error;

	      /* Pick out edge curve from a surface. */

	      s1435(wob[2]->s1,2,&(qoc->c1),spar+1,&kstat);
	      if (kstat < 0) goto error;
	    }


	  /* Examine the new edge for max. */

	  s1161(qoc, cmax, aepsge, &qintdat, &kstat);
	  if (kstat < 0) goto error;

	  freeCurve(qoc->c1);
	  qoc->c1 = SISL_NULL;


	  if (kstat == 2)
	    /* New maximum found, delete old ones */
	    if (*pintdat != SISL_NULL)
	      {
		freeIntdat(*pintdat);
		*pintdat = SISL_NULL;
	      }

	  if (kstat)
	    {
	      /* Maximum found, add them to the list */

	      *jstat = max(kstat,*jstat);         /* Mark maximum found. */

	      /* Put maximum found on edges into pintdat. */

	      /* Test if we can pick the second subdivision parameter
		 from a max on subdiv curve.*/
	      if(ki==0 && qintdat->vpoint[0]->epar[0] > smin[1]
		 && qintdat->vpoint[0]->epar[0] < smax[1] )
		spar[1]=qintdat->vpoint[0]->epar[0];


	      /* Set parameter border values of object. */
	      s6idput(pintdat,qintdat,(ki==0 ? 0:1),spar[(ki==0 ? 0:1)],&kstat);
	      if (kstat < 0) goto error;

	      if (qintdat != SISL_NULL)
		{
		  freeIntdat(qintdat);
		  qintdat = SISL_NULL;
		}

	    }

	  /* End of for (ki=/..............) */
	}

    }
  goto out;

  /* -------------------ERROR SECTION------------------------------------*/

  /* Error in space allocation.  */
 err101: *jstat = -101;
  s6err("s1162_s9div",*jstat,kpos);
  goto out;

  /* Error in lower level routine.  */
  error : *jstat = kstat;
  s6err("s1162_s9div",*jstat,kpos);
  goto out;
  /* -------------------END OF ERROR SECTION----------------------------*/

 out:
  if (qop != SISL_NULL) freeObject(qop);
  if (qoc != SISL_NULL) freeObject(qoc);
  if (qs1 != SISL_NULL) freeSurf(qs1);  /* PFU 15/07-94 */
  if (qs2 != SISL_NULL) freeSurf(qs2);  /* PFU 15/07-94 */
}



//===========================================================================
SISLIntpt *hp_copyIntpt (SISLIntpt * ppt)
//===========================================================================
{
  SISLIntpt *qcopy;		/* Local pointer to copied intersection point. */

  /* Create copy.  */

  qcopy = hp_newIntpt (ppt->ipar, ppt->epar, ppt->adist, ppt->iinter,
		       ppt->left_obj_1[0], ppt->right_obj_1[0],
		       ppt->left_obj_2[0], ppt->right_obj_2[0],
		       ppt->size_1, ppt->size_2, ppt->geo_data_1,
		       ppt->geo_data_2);
  if (qcopy == SISL_NULL)
    goto err101;

  /* Copy made.  */

  goto out;

  /* Error in space allocation. Return zero.  */

err101:goto out;

out:return (qcopy);
}


//===========================================================================
SISLIntpt *copyIntpt (SISLIntpt * ppt)
//===========================================================================
{
  SISLIntpt *qcopy;		/* Local pointer to copied intersection point. */

  /* Create copy.  */

  qcopy = newIntpt (ppt->ipar, ppt->epar, ppt->adist);
  if (qcopy == SISL_NULL)
    goto err101;

  /* Set remaining parameter.  */

  qcopy->iinter = ppt->iinter;

  /* Copy made.  */

  goto out;

  /* Error in space allocation. Return zero.  */

err101:goto out;

out:return (qcopy);
}


//===========================================================================
void s6idcon_s9endturn(SISLIntdat *pintdat,SISLIntpt *pt)
//===========================================================================
{
  register int ki;
  
  while(1)
    {
      for (ki=0; ki < pintdat->ipoint; ki++)
        if (pintdat->vpoint[ki]->pcurve == pt)
	  break;
      
      if (ki < pintdat->ipoint)
	pt = pintdat->vpoint[ki];
      else
	break;
    }
  
  s6idcon_s9turn(pt);
}


//===========================================================================
void s6idcon_s9turn(SISLIntpt *pt)
//===========================================================================
{
  register SISLIntpt *pt1,*pt2;/* Help pointer to traverse lists.*/
  
  pt1 = pt->pcurve;
  pt2 = pt1->pcurve;
  pt->pcurve = SISL_NULL;  
  pt1->pcurve = pt;
  
  while (pt2 != SISL_NULL)
    {
      pt  = pt1;
      pt1 = pt2;
      pt2 = pt2->pcurve;
      pt1->pcurve = pt;
    }
}


//===========================================================================
void s6idcon(SISLIntdat **pintdat,SISLIntpt **pintpt1,SISLIntpt **pintpt2,int *jstat)
//===========================================================================
{
  int kstat;                /* Local status variable.                     */
/*guen  int kpos;   */               /* Position of error.                         */
/*guen changed into:*/
  int kpos=0;                 /* Position of error.                         */

  int kfirst1,kfirst2;      /* To mark if the point is first in the list. */
  int ki1,ki2;              /* Counters                                   */
  SISLIntpt *qpt1,*qpt2;
  
  
  /* First we have to be sure that pintdat contain the two points. */
  
  s6idnpt(pintdat,pintpt1,1,&kstat);
  if (kstat < 0) goto error;
  
  s6idnpt(pintdat,pintpt2,1,&kstat);
  if (kstat < 0) goto error;
  
  
  qpt1 = *pintpt1;
  qpt2 = *pintpt2;
  
  
  /* Then we have to be sure that we do not have the same points as
     copies, junction points. */
  
  if (qpt1->iinter == 2 || qpt2->iinter == 2)
    {
      if (qpt1->iinter == 2 && qpt2->iinter == 2)
	{
	  for (ki1=0; ki1 < qpt1->ipar; ki1++)
	    if (qpt1->epar[ki1] != qpt2->epar[ki1]) break;
	  
	  if (ki1 == qpt1->ipar)
	    {
	      *jstat = 3;
	      goto out;
	    }
	}
      
      if (qpt1->iinter == 2)
	{
	  for (ki1=0; ki1 < (*pintdat)->ipoint; ki1++)
	    {
	      for (ki2=0; ki2 < qpt1->ipar; ki2++)
		if (qpt1->epar[ki2] != (*pintdat)->vpoint[ki1]->epar[ki2])
		  break;
	      
	      if (ki2 == qpt1->ipar)
		{
		  /* UJK && ALA 19.09.90 qpt1 changed to qpt2. */
		  
		  if (qpt2->pcurve == (*pintdat)->vpoint[ki1] || 
		      (*pintdat)->vpoint[ki1]->pcurve == qpt2)
		    {
		      /* The points are already connected. */
		      *jstat = 1;
		      goto out;
		    }
		}
	    }
	}
      
      if (qpt2->iinter == 2)
	{
	  for (ki1=0; ki1 < (*pintdat)->ipoint; ki1++)
	    {
	      for (ki2=0; ki2 < qpt2->ipar; ki2++)
		if (qpt2->epar[ki2] != (*pintdat)->vpoint[ki1]->epar[ki2])
		  break;
	      
	      if (ki2 == qpt2->ipar)
		{
		  /* UJK && ALA 19.09.90 qpt2 changed to qpt1. */
		  if (qpt1->pcurve == (*pintdat)->vpoint[ki1] || 
		      (*pintdat)->vpoint[ki1]->pcurve == qpt1)
		    {
		      /* The points are already connected. */
		      *jstat = 1;
		      goto out;
		    }
		}
	    }
	}
    }
  
  
  
  if (qpt1 == qpt2)
    /* There is only one point. */
    *jstat = 2;
  if (qpt1->pcurve == qpt2 || qpt2->pcurve == qpt1)
    /* The points are already connected. */
    *jstat = 1;
  else
    {
      /* We have to be sure that if one of the points is in the end of 
	 a list than this point is the first point. */
      
      if (qpt1->pcurve != SISL_NULL && qpt2->pcurve == SISL_NULL)
        {
	  SISLIntpt *pt;
	  
	  pt = qpt1;
	  qpt1 = qpt2;
	  qpt2 = pt;
        }
      
      /* Computing the index of the point pointing to the first point.    */
      
      for (ki1=0; ki1<(*pintdat)->ipoint; ki1++)
        if ((*pintdat)->vpoint[ki1]->pcurve == qpt1)
	  break;
      
      if ( ki1 < (*pintdat)->ipoint)
        kfirst1 = 0;
      else
        kfirst1 = 1;
      
      /* Computing the index of the point pointing to the sescond point.  */
      
      for (ki2=0; ki2<(*pintdat)->ipoint; ki2++)
        if ((*pintdat)->vpoint[ki2]->pcurve == qpt2)
	  break;
      
      if ( ki2 < (*pintdat)->ipoint)
        kfirst2 = 0;
      else
        kfirst2 = 1;
      
      /* If the first point is not at end, than we have to
	 reorganize the first list.  */
      
      if (qpt1->pcurve != SISL_NULL)
        {
	  if (kfirst1)
	    s6idcon_s9turn(qpt1);                  /* First point is at start. */
	  else                               /* First point is internal. */
	    {
	      /* We have a junction point. We therfor make a copy of
		 this point, and set this copy to the first point. */
	      
	      qpt1->iinter = 2;
	      
	      if((qpt1 = copyIntpt(qpt1)) == SISL_NULL) goto err101;
	      
	      s6idnpt(pintdat,&qpt1,0,&kstat);
	      if (kstat < 0) goto error;
	    }
        }
      
      
      if (kfirst2)                             /*Second point is at start.*/
        qpt1->pcurve = qpt2;
      else if (qpt2->pcurve == SISL_NULL)     /* Second point is at end. */
        {
	  s6idcon_s9endturn(*pintdat,qpt2);
	  qpt1->pcurve = qpt2;
        }
      else                          /* Second point is an internal point. */
        {
	  /* We have a junction point. We therfor make a copy of
	     this point, and set the first point  to point to this copy. */
	  
	  qpt2->iinter = 2;
	  
	  if((qpt2 = copyIntpt(qpt2)) == SISL_NULL) goto err101;
	  
	  s6idnpt(pintdat,&qpt2,0,&kstat);
	  if (kstat < 0) goto error;
	  
	  qpt1->pcurve = qpt2;
        }
      *jstat = 0;
    }
  
  goto out;
  

/* Error in space allocation.  */

err101: *jstat = -101;
        s6err("s6idcon",*jstat,kpos);
        goto out;

/* Error in sub function.  */

error:  *jstat = kstat;
        s6err("s6idcon",*jstat,kpos);
        goto out;

 out: ;
}


//===========================================================================
void s6idput(SISLIntdat **rintdat,SISLIntdat *pintdat,int inr,double apar,int *jstat)
//===========================================================================
{
  int kstat;                    /* Local status variable.               */
/*guen  int kpos;    */                 /* Position of error.                   */
/*guen changed into: */
  int kpos=0;                     /* Position of error.                   */
  int ki,kj;                    /* Counters                             */
  int kant;                     /* Number of parameters in new points.  */
  double *spar = SISL_NULL;          /* Storing uppdated parametervalues.    */
  SISLIntpt **uintpt = SISL_NULL; /* Pointers to new intersection points. */
  
  
  /* We have to be sure that we have an intdat structure. */
  
  if (pintdat == SISL_NULL)
    {
      *jstat = 0;
      goto out;
    }
  
  /* Computing number of new parameter direction. */
  
  kant = pintdat->vpoint[0]->ipar + 1;
  
  
  if (inr<0 || inr>=kant) goto err191;
  
  
  /* Allocating an array for intersection points. */
  
  if ((uintpt = newarray(pintdat->ipoint,SISLIntpt *)) == SISL_NULL)
    goto err101;
  
  /* Allocating an array for parametervalues. */
  
  if ((spar = newarray(kant,double)) == SISL_NULL)
    goto err101;
  
  
  /* Making copies of all intersection points. */
  
  for (ki=0; ki<pintdat->ipoint; ki++)
    {
      /* First we have to insert the missing parameter value. */
      
      for(kj=0; kj<inr; kj++) spar[kj] = pintdat->vpoint[ki]->epar[kj];
      spar[kj] = apar;
      for(kj++; kj<kant; kj++) spar[kj] = pintdat->vpoint[ki]->epar[kj-1];
      
      
      /* UJK,01-91 bringing over the adist value ! */
      uintpt[ki] = newIntpt(kant,spar,pintdat->vpoint[ki]->adist);
    }
  
  
  /* Than we can insert all new intersection points in rintdat. */
  
  for (ki=0; ki<pintdat->ipoint; ki++)
    {
      s6idnpt(rintdat,&uintpt[ki],1,&kstat);
      if (kstat < 0) goto error;
    }
  
  /* Than we can uppdate all pcurve pointers (lists). */
  
  for (ki=0; ki<pintdat->ipoint; ki++)
    if (pintdat->vpoint[ki]->pcurve != SISL_NULL)
      {
	for (kj=0;kj<pintdat->ipoint;kj++)
	  if (pintdat->vpoint[ki]->pcurve == pintdat->vpoint[kj])
	    break;
	
	if (kj == pintdat->ipoint) goto err190;
	
	s6idcon(rintdat,&uintpt[ki],&uintpt[kj],&kstat);
	if (kstat < 0) goto error;
      }
  
  
  *jstat = 0;
  goto out;
  

/* Error in inserted parameter number.  */

err191: *jstat = -191;
        s6err("s6idput",*jstat,kpos);
        goto out;
/* Error in intersection list.  */

err190: *jstat = -190;
        s6err("s6idput",*jstat,kpos);
        goto out;

/* Error in space allocation.  */

err101: *jstat = -101;
        s6err("s6idput",*jstat,kpos);
        goto out;

/* Error in sub function.  */

error: *jstat = kstat;
        s6err("s6idput",*jstat,kpos);
        goto out;

 out: if (uintpt != SISL_NULL) freearray(uintpt);
      if (spar   != SISL_NULL) freearray(spar);
}


//===========================================================================
void s1192_s9mbox(double ecoef[], int in1,int in2,double aepsge,
		  double *cmax, double *cmin,int *jmax,int *jmin)
//===========================================================================
{
  int ki,kj,li[4];         /* Counters.  */
  int icorn;               /* Number of corners in object.  */
  int kmin, kmax;          /* Index for max and min corner value.  */
  double tmin, tmax;       /* Max and min corner value.  */
  
  /* Compute the indexes of the (up to four) corners. */
  li[0] = 0;
  li[1] = in1 -1;
  li[2] = in1*(in2 - 1);
  li[3] = in1*in2 - 1;
  
  /* Set number of corners. 
     for point, curve, surface. */
  if(in1 == 1)
    {
      if(in2 == 1) 
	icorn = 0;
      else
	icorn = 2;
    }
  else
    icorn = 4;
  
  /* Now find the max and min corner. */
  tmax = tmin = ecoef[li[0]];
  kmin = kmax = 0;
  
  for (ki = 1; ki < icorn; ki++)
    {
      if (ecoef[li[ki]] > tmax)
	{
	  tmax = ecoef[li[ki]];
	  kmax = li[ki];
	}
      
      if (ecoef[li[ki]] < tmin)
	{
	  tmin = ecoef[li[ki]];
	  kmin = li[ki];
	}
    }
  
  /* Now find the max and min for the inner of the object. */
  *cmax = tmax - (double)1000.0;
  *jmax = -1;
  *cmin = tmin + (double)1000.0;
  *jmin = -1;
  
  for (ki = 0; ki < icorn - 1; ki++)
    for (kj = li[ki] + 1; kj < li[ki + 1]; kj++)
      {
	if (ecoef[kj] > *cmax)
	  {
	    *cmax = ecoef[kj];
	    *jmax = kj;
	  }
	
	if (ecoef[kj] < *cmin)
	  {
	    *cmin = ecoef[kj];
	    *jmin = kj;
	  }
      }
  
  
  /* At last compare the corner values against the interior ones */
  
  if (tmax > *cmax + aepsge)
    { 
      *cmax = tmax;
      *jmax = kmax;
    }
  
  if (tmin < *cmin - aepsge)
    { 
      *cmin = tmin;
      *jmin = kmin;
    }
}


//===========================================================================
void s1192(SISLObject *po,double aepsge,int *jstat)
//===========================================================================
{
  int kpos = 0;                        /* Position of error.   */
  
  
  if (po -> iobj == SISLPOINT)
    {
      if (po->p1->idim != 1) goto err105;
      
      if (po->p1->pbox == SISL_NULL)
	{
	  if ((po->p1->pbox = newbox(po->p1->idim))==SISL_NULL)
	    goto err101;
	  
	  s1192_s9mbox(po->p1->ecoef,1,1,aepsge,
		 po->p1->pbox->emax,po->p1->pbox->emin,
		 &po->p1->pbox->imax,&po->p1->pbox->imin);
	  
	  
	}
    }
  else
    if (po -> iobj == SISLCURVE)
      {
	if (po->c1->idim != 1) goto err105;
	if (po->c1->pbox == SISL_NULL)
	  {
	    if ((po->c1->pbox = newbox(po->c1->idim))==SISL_NULL)
	      goto err101;
	    
	    s1192_s9mbox(po->c1->ecoef,po->c1->in,1,aepsge,
		   po->c1->pbox->emax,po->c1->pbox->emin,
		   &po->c1->pbox->imax,&po->c1->pbox->imin);
	    
	  }
      }
    else
      if (po -> iobj == SISLSURFACE)
	{
	  if (po->s1->idim != 1) goto err105;
	  if (po->s1->pbox == SISL_NULL)
	    {
	      if ((po->s1->pbox = newbox(po->s1->idim))==SISL_NULL)
		goto err101;
	      
	      s1192_s9mbox(po->s1->ecoef,po->s1->in1,po->s1->in2,aepsge,
		     po->s1->pbox->emax,po->s1->pbox->emin,
		     &po->s1->pbox->imax,&po->s1->pbox->imin);
	    }
	}
  
  *jstat = 0;
  goto out;
  
  
  /* Error in space allocation.  */
  
 err101: *jstat = -101;
  s6err("s1192",*jstat,kpos);
  goto out;
  
  /* Dimension not equal one.  */
  
 err105: *jstat = -105;
  s6err("s1192",*jstat,kpos);
  goto out;
  
 out: ;
}


//===========================================================================
void s1190(SISLObject *po1, double *cmax, double aepsge,int *jstat)
//===========================================================================
{
  int kstat = 0;        /* Local status error.                        */
  int kpos = 0;         /* Position of error.                         */
  int kcorn = 0;        /* Number of corners in object.               */
  int li[4];	        /* Contains the indexes of the corners.       */
  int kbez = 0;         /* Flag to mark bezier curve or patch.        */
  int kdim;	        /* Dimension of space.			      */
  int in1,in2;	        /* Local number of vertices.     	      */
  int i1;	        /* Counter.                     	      */
  int kmax;             /* Index for the largest value of 
			   the vertices of the object*/
  double *tmin1,*tmax1; /* Smallest and largest value of 
			   the vertices of the object*/
  double scorn[4];      /* The corner values of the object*/
  
  
  *jstat = 0;  
  
  /* Check kind of first object. */
  
  if (po1->iobj == SISLPOINT)
    {
      kcorn = 0;
      /* Fetch dimention of the object. */
      
      if((kdim = po1->p1->idim) != 1) goto err105;;
      
      
      /* Check if the SISLbox have been computed. */
      
      if (po1->p1->pbox == SISL_NULL)
	{
	  /* If not compute a box. */
	  
	  s1192(po1,aepsge,&kstat);
	  if (kstat<0) goto error;
	}
      
      /* Fetch the SISLbox boarder. */
      
      kmax  = po1->p1->pbox->imax;      
      tmax1 = po1->p1->pbox->emax;
      tmin1 = po1->p1->pbox->emin;
    }
  else
    if (po1->iobj == SISLCURVE)
      {
	/* Fetch dimention of the object. */
	
	if((kdim = po1->c1->idim) != 1) goto err105;;
	
	/* Fetch corners. */
	
	kcorn = 2;
	li[0] = 0;
	li[1] = po1->c1->in - 1;
	scorn[0] = po1->c1->ecoef[li[0]];
	scorn[1] = po1->c1->ecoef[li[1]];
	
	/* Check if we have a bezier curve. */
	
	if (po1->c1->in == po1->c1->ik) kbez = 1;
	
	/* Check if the SISLbox have been computed. */
	
	if (po1->c1->pbox == SISL_NULL)
	  {
	    /* If not compute a box. */
	    
	    s1192(po1,aepsge,&kstat);
	    if (kstat<0) goto error;
	  }
	
	/* Fetch the SISLbox boarder. */
	kmax  = po1->c1->pbox->imax;      	
	tmax1 = po1->c1->pbox->emax;
	tmin1 = po1->c1->pbox->emin;
      }
    else
      if (po1->iobj == SISLSURFACE)
	{
	  /* Fetch dimention of the object. */
	  
	  if((kdim = po1->s1->idim) != 1) goto err105;;
	  
	  
	  kcorn = 4;
	  in1   = po1->s1->in1;
	  in2   = po1->s1->in2;
	  li[0] = 0;
	  li[1] = in1 - 1;
	  li[2] = in1*(in2 - 1);
	  li[3] = in1*in2-1;
	  scorn[0] = po1->s1->ecoef[li[0]];
	  scorn[1] = po1->s1->ecoef[li[1]];
	  scorn[2] = po1->s1->ecoef[li[2]];
	  scorn[3] = po1->s1->ecoef[li[3]];
	  
	  /* Check if we have a bezier patch. */
	  
	  if (po1->s1->in1 == po1->s1->ik1 &&
	      po1->s1->in2 == po1->s1->ik2)    kbez = 1;
	  
	  /* Check if the SISLbox have been computed. */
	  
	  if (po1->s1->pbox == SISL_NULL)
	    {
	      /* If not compute a box. */
	      
	      s1192(po1,aepsge,&kstat);
	      if (kstat<0) goto error;
	    }
	  
	  /* Fetch the SISLbox boarder. */
	  kmax  = po1->s1->pbox->imax;	  
	  tmax1 = po1->s1->pbox->emax;
	  tmin1 = po1->s1->pbox->emin;
	}
      else  goto err121;
  
  
  /* Now we've got the box, do the test: */
  
  if (*cmax - *tmax1 > aepsge)
    *jstat = 1;         /* The object is beyond level value. */
  
  else if (*tmax1 - *tmin1 < aepsge)
    *jstat = 2;         /* The object is of constant value. */ 
  
  else
    /* if (kbez)*/
    {
      /*check for corner max. */
      for (i1=0; i1<kcorn; i1++)
	if (fabs(scorn[i1] - *tmax1) < aepsge)
	  {
	    
	    *jstat = 3;         /* Only corner touching possible.*/
	    break;
	    
	  }
    }
  /*  
    else */
  /*check for absolute corner max. */
  /*    for (i1=0; i1<kcorn; i1++)
	if (kmax == li[i1])
	{
	
	*jstat = 3;    */     /* Only corner touching possible.*/
  /*	  break;
	  
	  }
	  
	  */  
  
  /* Box-test performed. */
  goto out;

  /* Dimensions not equal one. */
  
 err105: *jstat = -105;
  s6err("s1190",*jstat,kpos);
  goto out;
  
  /* Kind of object does not exist. */
  
 err121: *jstat = -121;
  s6err("s1190",*jstat,kpos);
  goto out;
  
  /* Error in lower level routine. */
  
 error:  *jstat = kstat;
  s6err("s1190",*jstat,kpos);
  goto out;
  
 out:	return;
}

//===========================================================================
void s6idnpt(SISLIntdat **pintdat,SISLIntpt **pintpt,int itest,int *jstat)
//===========================================================================
{
  register int ki,kj;              /* Counters.    */
  
  /* We have to be sure that we have an intdat structure. */
  
  if ((*pintdat) == SISL_NULL)
    {
      if (((*pintdat) = newIntdat()) == SISL_NULL) goto err101;
    }
  
  
  /* Than we have to be sure that we do not have the intersection point
     before or an equal point. */
  
  for (ki=0; ki<(*pintdat)->ipoint; ki++)
    if ((*pintdat)->vpoint[ki] == (*pintpt))
      {
	*jstat = 1;
	goto out;
      }
    else if (itest && (*pintpt)->iinter != 2)
      {
	for (kj=0; kj<(*pintpt)->ipar; kj++)
	  if (DNEQUAL((*pintpt)->epar[kj],(*pintdat)->vpoint[ki]->epar[kj]))
	    break;
	
	if (kj == (*pintpt)->ipar)
	  {
	    freeIntpt(*pintpt);
	    (*pintpt) = (*pintdat)->vpoint[ki];
	    *jstat = 2;
	    goto out;
	  }
      }
  
  
  /* Than we have to be sure that the array vpoint is great enought. */
  
  if (ki == (*pintdat)->ipmax)
    {
      (*pintdat)->ipmax += 20;
      
      if (((*pintdat)->vpoint = increasearray((*pintdat)->vpoint,
					      (*pintdat)->ipmax,SISLIntpt *)) == SISL_NULL) 
	goto err101;
    }
  
  
  /* Now we can insert the new point. */
  
  (*pintdat)->vpoint[ki] = (*pintpt);
  (*pintdat)->ipoint++;
  *jstat = 0;
  goto out;
  

/* Error in space allocation.  */

err101: *jstat = -101;
        s6err("s6idnpt",*jstat,0);
        goto out;

 out: ;
}

//===========================================================================
SISLIntpt *newIntpt (int ipar, double *epar, double adist)
//===========================================================================
{
  SISLIntpt *pnew;		/* Local pointer to instance to create. */
  int ki;			/* Counter.                             */

  /* Allocate space for instance of Intpt. */

  pnew = newarray (1, SISLIntpt);
  if (pnew == SISL_NULL)
    goto err101;

  /* Initialize instance. First allocate space for parameter array. */

  if (ipar > 0)
    {
      pnew->epar = newarray (ipar, DOUBLE);
      if (pnew->epar == SISL_NULL)
	goto err101;
    }


  /* Initialize the variables of the instance. */

  pnew->ipar = ipar;
  for (ki = 0; ki < ipar; ki++)
    pnew->epar[ki] = epar[ki];
  pnew->adist = adist;
  pnew->pcurve = SISL_NULL;
  pnew->iinter = 0;

  /* Set intersection atributes to SISL_NULL */
  pnew->no_of_curves_alloc = 0;
  pnew->no_of_curves = 0;

  pnew->pnext = SISL_NULL;
  pnew->curve_dir = SISL_NULL;
  pnew->left_obj_1 = SISL_NULL;
  pnew->left_obj_2 = SISL_NULL;
  pnew->right_obj_1 = SISL_NULL;
  pnew->right_obj_2 = SISL_NULL;
  pnew->geo_data_1 = SISL_NULL;
  pnew->size_1 = 0;
  pnew->geo_data_2 = SISL_NULL;
  pnew->size_2 = 0;

  pnew->trim[0] = SISL_NULL;
  pnew->trim[1] = SISL_NULL;

  /* Task done.  */


  goto out;

  /* Error in space allocation. Return zero. */

err101:pnew = SISL_NULL;
  goto out;

out:return (pnew);
}

//===========================================================================
void s1161(SISLObject *po1,double *cmax,double aepsge,SISLIntdat **pintdat,int *jstat)
//===========================================================================
{
  int    klevel=0;     /* Parameter into s1162                   */
  int    knum=0;       /* Parameter into s1162                   */
  int    kpar;         /* Fixed parameter direction.             */
  int    ki;           /* Counter.                               */    
  int    kedge;        /* Number of edges.                       */
  int idim  = 1;       /* Local dimension, always = 1            */
  int kstat = 0;       /* Local status variable.                 */
  int kpos  = 0;       /* Position of error.                     */
  double tpar;         /* Help variable used for parameter value
			  and geometric distance.                */
  SISLEdge   *qedge[2];        /* Edges for use in s1162().      */
  SISLObject *qdum = SISL_NULL;     /* Dummy  pointer.                */
  SISLObject *qob  = SISL_NULL;     /* Objects for use in recurson.   */
  SISLIntdat *qintdat = SISL_NULL;  /* Intdat for use in recurson.    */
  
  qedge[0] = SISL_NULL;
  qedge[1] = SISL_NULL;
  
  if (po1->iobj == SISLPOINT) 
    {
      /* It's a point, treat the case here and return. */
      
      /* Control the dimension. */
      if (po1->p1->idim != idim ) goto err106;
      
      /* Computing the distance beetween the point and level value. */
      tpar = po1->p1->ecoef[0] - *cmax;
      
      if (fabs(tpar) <= aepsge)
	
        /* The point is close enough to the level value to be a max. */
	*jstat = 1;         /* Mark maximum found. */
      
      else if (tpar > (double)0.0)
	{
	  
	  /* The point is greater than the level value . */
	  *jstat = 2;         /* Mark new maximum found. */
	  *cmax   = po1->p1->ecoef[0];
	}
      
      else 
	
	*jstat = 0;         /* Mark no maximum found. */
      
      
      if ( *jstat > 0 )
	{
	  SISLIntpt *qt;
	  
	  /* Add maximum  point. */
	  qt = newIntpt(0,cmax,DZERO);
	  if (qt == SISL_NULL) goto err101;
	  
	  /* Uppdate pintdat. */
	  s6idnpt(pintdat,&qt,1,&kstat);
	  if (kstat < 0) goto error;
	}
      
    }
  
  
  else if (po1->iobj > SISLPOINT)
    {
      /* It's a higher order geometry, treat the edges here and
	 use a recursiv function to treat the inner of the object       */
      
      
      *jstat = 0;
      /* Perform a boxtest */
      s1190(po1,cmax,aepsge,&kstat);
      if (kstat == 1) goto out;
      
      
      /*Create a dummy object, to be used when calling 
	the intersection routines
	treating two objects.*/
      if ((qdum = newObject(SISLPOINT)) == SISL_NULL) goto err101;
      
      
      
      kedge  = 2 * po1->iobj;
      kpar   = kedge/2;
      
      /* Create correct number of edges. */
      if ((qedge[0] = newEdge(kedge)) == SISL_NULL) goto err101;
      
      
      for (ki=0; ki<kedge; ki++)
	{
	  
	  /* Set  correct parameter direction to keep constant         */
	  kpar   = ((ki == kedge/2) ? kedge/2-1:kpar-1);
	  
	  /* Create one lower order helpobject */
	  if ((qob = newObject(po1->iobj - 1)) == SISL_NULL) goto err101;	
	  
	  
	  if (po1->iobj == SISLCURVE)
	    
	    /* Pick out end point from a curve. */
	    s1438(po1->c1,ki,&(qob->p1),&tpar,&kstat);
	  
	  else if (po1->iobj == SISLSURFACE)
	    
	    /* Pick out edge curve from a surface. */
	    s1435(po1->s1,ki,&(qob->c1),&tpar,&kstat);
	  
	  else
	    /* Unknown higher order object . */
	    goto err121;
	  
	  if (kstat < 0) goto error;
	  
	  /* Recursiv computing of end maximum. */
	  s1161(qob,cmax,aepsge,&qintdat,&kstat);
	  if (kstat < 0) goto error;
	  
	  if (kstat == 2)
	    {
	      
	      /* New maximum found, delete old ones */
	      if (*pintdat != SISL_NULL)
		{
		  freeIntdat(*pintdat);
		  *pintdat = SISL_NULL;
		}
	      
	      if (qedge[0] != SISL_NULL)
		{
		  /*  Empty the edges */
		  freeEdge(qedge[0]);
		  if ((qedge[0] = newEdge(kedge)) == SISL_NULL) goto err101;	      
		}
	      
	    }  
	  
	  
	  if (kstat)
	    {
	      /* Maximum found, add them to the list */
	      
	      *jstat = max(*jstat,kstat);         /* Mark maximum found. */
	      
	      /* Put maximum found on edges into pintdat. */
	      
	      /* Set parameter border values of object. */
	      s6idput(pintdat,qintdat,kpar,tpar,&kstat);
	      if (kstat < 0) goto error;
	      
	      /* Uppdate edge structure. */
	      s6idedg(po1,qdum,1,kpar+1,tpar,*pintdat,
		      &(qedge[0]->prpt[ki]),&(qedge[0]->ipoint),&kstat);
	      if (kstat < 0) goto error;
	    }
	  
	  if (qintdat != SISL_NULL) freeIntdat(qintdat);
	  qintdat = SISL_NULL;
	  freeObject(qob);
	}	  
      
      
      /* ---------------------------------------------------------------*/
      /* Treat the inner of higher order objects. */ 
      
      /* Before we enter internal maximum and subdivision we
	 initiate pointers to top level objects. */
      
      if (po1->o1 == SISL_NULL) po1->o1 = po1;
      
      /* Find the maximums in the inner of the object.  */
      s1162(po1,cmax,aepsge,pintdat,qedge,klevel,knum,&kstat);
      if (kstat < 0)  goto error;
      *jstat = max(*jstat,kstat);
      
      /* Organize the list in pintdat. */
      s6idlis(po1,po1,pintdat,&kstat);
      if (kstat < 0)  goto error;
    }
  
  else 
    /* Unknown  object . */
    goto err121;
  
  
  goto out; 
  
  
  
  /* -------------- ERROR HANDLING ----------------------------------------*/
  
  /* Error in space allocation.  */
 err101: *jstat = -101;
  s6err("s1161",*jstat,kpos);
  goto out;
  
  /* Error. Dimensions conflicting.  */
 err106: *jstat = -106;
  s6err("s1161",*jstat,kpos);
  goto out;
  
  /* Error. Kind of object does not exist.  */
 err121: *jstat = -121;
  s6err("s1161",*jstat,kpos);
  goto out;
  
  /* Error in lower order routine.  */
  error : *jstat = kstat;
  s6err("s1161",*jstat,kpos);
  goto out;
  
 out:
  /* Free the edges used in s1162. */
  if (qedge[0] != SISL_NULL) freeEdge(qedge[0]);
  
  /* Free the dummy object(point). */
  if (qdum != SISL_NULL) freeObject(qdum);
  
}

//===========================================================================
void s1921(SISLSurf *ps1,double edir[],int idim,double aepsco,double aepsge,
	   int *jpt,double **gpar,int *jcrv,SISLIntcurve ***wcurve,int *jstat)
//===========================================================================
{
  int ikind;               /* Type of surface ps1 is.                     */
  int kstat = 0;           /* Local status variable.                      */
  int kpos = 0;            /* Position of error.                          */
  int ki;                  /* Counter.                                    */
  int kn1,kn2;             /* Number of vertices of surface.              */
  int kk1,kk2;             /* Order of surface.                           */
  double tmax;             /* Estimate of maximal value of 1-dim. surface.*/
  double *st1,*st2;        /* Pointer to knotvectors of surface.          */
  double *scoef;           /* Pointer to vertices of surface.             */
  double *sc = SISL_NULL;       /* Pointer to vertices of surface in maxima
			      calculation.                                */
  double *spar = SISL_NULL;     /* Values of maxima in the parameter area of
			      the second object. Empty in this case.      */
  double *s1,*s2,*sstop;   /* Pointers used to traverse double-arrays.    */
  SISLIntdat *qintdat = SISL_NULL;  /* Pointer to max data structure.*/
  SISLSurf *qs = SISL_NULL;         /* Pointer to 1-dim. surface in maxima-calculation.*/
  SISLObject *qo1 = SISL_NULL;      /* Pointer to object in maxima-calculation.  */
  SISLSurf *qkreg = SISL_NULL;      /* Input surface with k-regularity ensured.  */


  /* Ensure k-regular input surface. */

  if ( ps1 -> cuopen_1 == SISL_SURF_PERIODIC ||
       ps1 -> cuopen_2 == SISL_SURF_PERIODIC )
  {
    /* Cyclic (periodic) surface */

    make_sf_kreg(ps1, &qkreg, &kstat);
    if ( kstat < 0 )  goto error;
  }
  else
    qkreg = ps1;


  /* Check dimension.  */

  if ( qkreg -> idim != idim )  goto err106;

  /* Describe surface with local variables.  */

  kn1 = qkreg -> in1;
  kn2 = qkreg -> in2;
  kk1 = qkreg -> ik1;
  kk2 = qkreg -> ik2;
  st1 = qkreg -> et1;
  st2 = qkreg -> et2;
  ikind = qkreg -> ikind;

  if ( ikind == 2 || ikind == 4 )
  {
    scoef = qkreg -> rcoef;
    /* Allocate space for coeffecients of new surface.  */

    if ( (sc = newarray(2*kn1*kn2, DOUBLE)) == SISL_NULL )  goto err101;

    /* Compute scalar-product of surface-vertices and direction vector. */
    /* Copy over weights. */

    for ( s1=scoef, s2=sc, sstop=s2+2*kn1*kn2;  s2 < sstop;  s1+=idim+1, s2+=2 )
    {
      *s2 = s6scpr(s1, edir, idim);
      *(s2+1) = *(s1+idim);
    }
  }
  else
  {
    scoef = qkreg -> ecoef;
    /* Allocate space for coeffecients of new surface.  */

    if ( (sc = newarray(kn1*kn2, DOUBLE)) == SISL_NULL )  goto err101;

    /* Compute scalar-product of surface-vertices and direction vector. */

    for ( s1=scoef, s2=sc, sstop=s2+kn1*kn2;  s2 < sstop;  s1+=idim, s2++ )
      *s2 = s6scpr(s1, edir, idim);
  }


  /* Create new surface.  */

  qs = newSurf(kn1, kn2, kk1, kk2, st1, st2, sc, qkreg->ikind, 1, 1);
  if ( qs == SISL_NULL )  goto err101;

  /* Create new object and connect surface to object.  */

  qo1 = newObject(SISLSURFACE);
  if ( qo1 == SISL_NULL )  goto err101;
  qo1 -> s1 = qs;

  /* Find maxima.  */

  /* Find maxima. */
  tmax = -(double)HUGE;

  s1161(qo1, &tmax, aepsge, &qintdat, &kstat);
  if ( kstat < 0 )  goto error;

  if (qintdat)
  {

    /* Express maximal points/intervals on output format.  */
    s1880(2, 0, &qintdat->ipoint, qintdat->vpoint,
	  &qintdat->ilist, qintdat->vlist,
	  jpt, gpar, &spar, jcrv, wcurve, &kstat);
    if ( kstat < 0 )  goto error;

    /* Handle periodicity (remove extraneous points) */

    if ( *jpt > 1  &&  idim > 1 && (ps1 -> cuopen_1 == SISL_SURF_PERIODIC ||
				    ps1 -> cuopen_2 == SISL_SURF_PERIODIC ) )
    {
      for ( ki=0; ki < (*jpt); ki++ )
      {
	if ( (ps1 -> cuopen_1 == SISL_SURF_PERIODIC &&
	      (*gpar)[2*ki]   == ps1 -> et1[ps1->in1]) ||
	     (ps1 -> cuopen_2 == SISL_SURF_PERIODIC &&
	      (*gpar)[2*ki+1] == ps1 -> et2[ps1->in2]) )
	{
	  (*jpt)--;
	  (*gpar)[2*ki]   = (*gpar)[2*(*jpt)];
	  (*gpar)[2*ki+1] = (*gpar)[2*(*jpt)+1];
	  ki--;
	}
      }
    }
  }

  /* Extremal points/intervals found.  */

  *jstat = 0;
  goto out;

  /* Error in space allocation.  */

 err101:
  *jstat = -101;
  s6err("s1921",*jstat,kpos);
  goto out;

  /* Dimensions conflicting.  */

 err106:
  *jstat = -106;
  s6err("s1921",*jstat,kpos);
  goto out;

  /* Error in lower level routine.  */

 error:
  *jstat = kstat;
  s6err("s1921",*jstat,kpos);
  goto out;

 out:

  /* Free allocated space.  */

  if ( qkreg && qkreg != ps1 )  freeSurf(qkreg);
  if (sc) freearray(sc);
  if (spar) freearray(spar);
  if (qo1) freeObject(qo1);
  if (qintdat) freeIntdat(qintdat);

  return;
}


//===========================================================================
void s1954(SISLSurf *psurf,double epoint[],int idim,double aepsco,double aepsge,
	   int *jpt,double **gpar,int *jcrv,SISLIntcurve ***wcurve,int *jstat)
//===========================================================================
{
  int kstat = 0;            /* Local status variable.                    */
  int kpos = 0;             /* Position of error.                        */
  int kdim = 1;             /* Dimension of curve in extremal problem.   */
  double tradius = 0;       /* Radius of hyper-sphere describing point.  */
  double tdir = -1;         /* Direction of extremal value.              */
  double *sarray = SISL_NULL;    /* Matrix describing hyper-sphere.           */
  SISLSurf *qs = SISL_NULL;      /* Surface of which to find extremal points. */
  SISLSurf *qkreg = SISL_NULL;   /* Input surface with k-regularity ensured.  */
  int ratflag = 0;          /* Flag to indicate if surface is rational.  */
  int ki;                   /* Counter.                                  */


  *jstat = 0;

  /* Ensure k-regular basis */

  if ( psurf -> cuopen_1 == SISL_SURF_PERIODIC ||
       psurf -> cuopen_2 == SISL_SURF_PERIODIC )
  {
    /* Cyclic (i.e. periodic) surface */

    make_sf_kreg(psurf, &qkreg, &kstat);
    if ( kstat < 0 )  goto error;
  }
  else
    qkreg = psurf;


  /* Test input.  */

  if ( qkreg -> idim != idim )  goto err106;

  if ( qkreg -> ikind == 2  ||  qkreg -> ikind == 4)  ratflag = 1;

  /* Allocate space for array describing a hyper-sphere.  */

  if ( (sarray = newarray((idim+1)*(idim+1), DOUBLE)) == SISL_NULL )  goto err101;

  /* Make a matrix of dimension (idim+1)*(idim+1) to describe
     the hyper-shpere.                                        */

  s1321(epoint, tradius, idim, kdim, sarray, &kstat);
  if ( kstat < 0 )  goto error;

  /* Put surface into equation of hyper-sphere.  */

  s1320(qkreg, sarray, kdim, ratflag, &qs, &kstat);
  if ( kstat < 0 )  goto error;

  /* Find minimum points of the new surface.  */

  s1921(qs, &tdir, kdim, aepsco, aepsge, jpt, gpar, jcrv, wcurve, &kstat);
  if ( kstat < 0 )  goto error;

  /* Handle periodicity (remove extraneous points) */
  if ( (*jpt) > 1  &&  idim > 1  && (psurf -> cuopen_1 == SISL_SURF_PERIODIC ||
				     psurf -> cuopen_2 == SISL_SURF_PERIODIC) )
  {
    for ( ki=0;  ki < (*jpt);  ki++ )
    {
      if ( (psurf -> cuopen_1 == SISL_SURF_PERIODIC &&
	    (*gpar)[2*ki]     == psurf -> et1[psurf->in1]) ||
	   (psurf -> cuopen_2 == SISL_SURF_PERIODIC &&
	    (*gpar)[2*ki+1]     == psurf -> et2[psurf->in2]) )
      {
	(*jpt)--;
	(*gpar)[2*ki]   = (*gpar)[2*(*jpt)];
	(*gpar)[2*ki+1] = (*gpar)[2*(*jpt)+1];
	ki--;
      }
    }
  }

  /* Closest points/intervals found.  */

  *jstat = 0;
  goto out;


  /* Error in space allocation.  */

 err101:
  *jstat = -101;
  s6err("s1954",*jstat,kpos);
  goto out;

  /* Dimensions conflicting.  */

 err106:
  *jstat = -106;
  s6err("s1954",*jstat,kpos);
  goto out;

  /* Error in lower level routine.  */

 error:
  *jstat = kstat;
  s6err("s1954",*jstat,kpos);
  goto out;

 out:

  /* Free allocated space.  */

  if ( qkreg  &&  qkreg != psurf )  freeSurf(qkreg);
  if (sarray)  freearray(sarray);
  if (qs)  freeSurf(qs);

  return;
}

//===========================================================================
void s1893 (SISLCurve * orig, double earray[], int dimp1, int narr, int der1,
	    int der2, SISLCurve ** ncurve, int *jstat)
//===========================================================================
{
  int nik;			/* The order of the new basis. */
  int nin;			/* The number of verices in the new basis. */
  int mder;			/* max(der1,der2) */
  int left;			/* Interval indicator. */
  int pos;			/* Used to index earray */
  int pos1;			/* Position of the first derivatives in the
				 * array deriv. (returned form s1221); */
  int pos2;			/* Position of the second derivatives in the
				 * array deriv. (returned form s1221); */
  int count1, count2;		/* Loop control variables. */
  int count3=0;
  int kr, kl, kp;
  int *der = SISL_NULL;		/* The derivative indicators. (0) */

  double *nknots = SISL_NULL;	/* The new knot vector. */
  double *coef = SISL_NULL;		/* Coefficients of the new B-spline curve. */
  double *par = SISL_NULL;		/* Parameter values used for interpolation. */
  double *deriv = SISL_NULL;		/* The derivates returned by s1221. */
  double *val1 = SISL_NULL;		/* Extracted values from deriv. */
  double *val2 = SISL_NULL;		/* Extracted values from deriv. */
  double *tau = SISL_NULL;		/* Interpolation points. */
  double sum;			/* Used for calculating F(t). */
  int kpos = 0;
  int kstat = 0;

  *jstat = 0;


  /* Test if legal input. */

  if (orig->ik <= 1 || orig->in <orig->ik)
    goto err112;
  if ( dimp1 < orig->idim || dimp1 > orig->idim +1 )
    goto err151;


  /* Produce a knot vector. */

  s1894 (orig->et, orig->ik, orig->in, der1, der2, earray, dimp1, narr,
	 &nknots, &nik, &nin, &kstat);
  if (kstat < 0)
    goto error;


  /* Produce parameter values and derivate indicators. */

  s1890 (nknots, nik, nin, &par, &der, &kstat);
  if (kstat < 0)
    goto error;


  /* Allocate arrays. */

  val1 = newarray (orig->idim + 1, DOUBLE);
  if (val1 == SISL_NULL)
    goto err101;
  val2 = newarray (orig->idim + 1, DOUBLE);
  if (val2 == SISL_NULL)
    goto err101;
  tau = new0array (nin * narr * narr, DOUBLE);
  /*  tau = newarray (nin * narr, DOUBLE);  (PFU 21/09-94) */
  if (tau == SISL_NULL)
    goto err101;

  mder = max (der1, der2);
  deriv = newarray ((mder + 1) * orig->idim, DOUBLE);
  if (deriv == SISL_NULL)
    goto err101;


  /* Calculate interpolation points. */

  left = 0;
  for (count1 = 0; count1 < nin; count1++)
    {
      s1221 (orig, mder, par[count1], &left, deriv, &kstat);
      if (kstat < 0)
	goto error;


      /* Extract the values/derivatives. */

      pos1 = der1 * orig->idim;
      pos2 = der2 * orig->idim;

      for (count2 = 0; count2 < orig->idim; count2++)
	{
	  val1[count2] = deriv[pos1++];
	  val2[count2] = deriv[pos2++];
	}

      if(orig->idim < dimp1)
      {
          if (der1 > 0)
            val1[orig->idim] = (double) 0.0;
          else
            val1[orig->idim] = (double) 1.0;

          if (der2 > 0)
            val2[orig->idim] = (double) 0.0;
          else
            val2[orig->idim] = (double) 1.0;
      }

      /* Calculate the functtion F(t). */

      pos = 0;
      for (kl = 0; kl < narr; kl++)
	{
	  sum = (double) 0.0;
	  for (kr = 0; kr < dimp1; kr++)
	    {
	      for (kp = 0; kp < dimp1; kp++)
		sum += earray[pos++] * val1[kr] * val2[kp];
	      /* sum += earray[pos++] * val1[kp] * val2[kr]; */
	    }
	  tau[count3++] = sum;
	}
    }

  /* Caculate new curve description */

  s1891 (par, tau, narr, nin, narr, der, TRUE, nknots, &coef, &nin,
	 nik, 0, 0, &kstat);
  if (kstat < 0)
    goto error;

  *ncurve = newCurve (nin, nik, nknots, coef, orig->ikind, narr, 2);
  if (*ncurve == SISL_NULL)
    goto err171;
  (*ncurve)->cuopen = orig->cuopen;

  /* OK */

  goto out;


  /* Memory error. */

err101:
  *jstat = -101;
  s6err ("s1893", *jstat, kpos);
  goto out;

  /* Could not create curve. */

err171:
  *jstat = -171;
  s6err ("s1893", *jstat, kpos);
  goto out;

  /* Error in description of B-spline. */

err112:
  *jstat = -112;
  s6err ("s1893", *jstat, kpos);
  goto out;

  /* dimp1 not equal to idim+1. */

err151:
  *jstat = -151;
  s6err ("s1893", *jstat, kpos);
  goto out;

  /* Error in lower level routine. */

error:
  *jstat = kstat;
  s6err ("s1893", *jstat, kpos);
  goto out;

  /* Free memory. */

out:
  if (val1 != SISL_NULL)
    freearray (val1);
  if (val2 != SISL_NULL)
    freearray (val2);
  if (der != SISL_NULL)
    freearray (der);
  if (par != SISL_NULL)
    freearray (par);
  if (deriv != SISL_NULL)
    freearray (deriv);
  if (tau != SISL_NULL)
    freearray (tau);
  return;
}


//===========================================================================
void s1370 (SISLCurve * pcurv, double earray[], int idim, int inarr,
	    int ratflag, SISLCurve ** rcurv, int *jstat)
//===========================================================================
{
  int kpos = 0;
  int kstat = 0;
  SISLCurve *icurve = SISL_NULL;	/* Temporary SISLCurve. */
  int kn;			/* Number of vertices of pcurv            */
  int kk;			/* Order in  pcurv                        */
  int kdim;			/* Number of dimesions in pcurv           */
  int kdimp1;			/* Dimension of  earray should be kdim+1  */
  double *st = SISL_NULL;		/* First knot vector is pcurv             */
  double *scoef = SISL_NULL;		/* Vertices of pcurv                      */
  int ikind;			/* kind of surface pcurv is               */
  double *rscoef = SISL_NULL;	/* Scaled coefficients if pcurv is rational       */
  double wmin, wmax;		/* min and max values of the weights if rational  */
  double scale;			/* factor for scaling weights if rational         */
  int i;			/* loop variable                          */
  double *sarray = SISL_NULL;	/* Array for calculating denominator if used      */
  int knarr;			/* Number of parallel arrays to use.              */
  int nkind;			/* Kind of output curve (rcurf).                  */

  *jstat = 0;

  /* Make local pointers. */

  kn = pcurv->in;
  kk = pcurv->ik;
  kdim = pcurv->idim;
  st = pcurv->et;
  ikind = pcurv->ikind;

  kdimp1 = kdim + 1;

  /* Test input. */

  if (kdim != idim || (kdim != 2 && kdim != 3))
    goto err104;
  if (inarr < 1 || 3 < inarr) goto err172;

  /* rational surfaces are a special case. */
  if (ikind == 2 || ikind == 4)
    {
      kdim++;

      /* scale the coeffs so that min. weight * max. weight = 1. */

      rscoef = pcurv->rcoef;
      wmin = rscoef[kdim-1];
      wmax = rscoef[kdim-1];

      for (i = 2*kdim-1; i < kn * kdim; i += kdim)
	{
	  if (rscoef[i] < wmin)
	    wmin = rscoef[i];
	  if (rscoef[i] > wmax)
	    wmax = rscoef[i];
	}
      scale = (double) 1.0 / sqrt (wmin * wmax);
      scoef = newarray (kn * kdim, DOUBLE);
      if (scoef == SISL_NULL)
	goto err101;

      for (i = 0; i < kn * kdim; i++)
        scoef[i] = rscoef[i] * scale;
    }
  else
    scoef = pcurv->ecoef;

  icurve = newCurve (kn, kk, st, scoef, 1, kdim, 1);
  if (icurve == SISL_NULL)
    goto err171;

  icurve->cuopen = pcurv->cuopen;

  if ((ikind == 2 || ikind == 4) && ratflag == 1)
    {
      /* Output curve will also be rational. */

      nkind = 2;

      /* Add an extra parallel array to pick up the weights
	 of the subsequent homogeneous vertices of rcurv. */

      knarr = inarr + 1;
      sarray = new0array (kdimp1 * kdimp1 * knarr, DOUBLE);
      if (sarray == SISL_NULL) goto err101;

      memcopy (sarray, earray, kdimp1 * kdimp1 * inarr, DOUBLE);
      sarray[kdimp1 * kdimp1 * knarr - 1] = (DOUBLE) 1.0;
    }
  else
    {
      nkind = 1;
      knarr = inarr;
      sarray = earray;
    }

  /* Put curve into implicit surface. */

  s1893 (icurve, sarray, kdimp1, knarr, 0, 0, rcurv, &kstat);
  if (kstat < 0) goto error;

  if (*rcurv == SISL_NULL) goto err171;

  if ( ikind == 2 || ikind == 4 )
  {
    /* Free arrays. */

    if (scoef) freearray (scoef);
    if (ratflag && sarray) freearray (sarray);

    if ( ratflag == 1 )
    {
      /* Output from s1893 is a dim+1 non-rational curve. */
      /* Convert homogeneous curve to rational form (rcoef is SISL_NULL here). */

      (*rcurv)->rcoef = newarray((*rcurv)->in * (*rcurv)->idim, DOUBLE);
      memcopy((*rcurv)->rcoef, (*rcurv)->ecoef,
	      (*rcurv)->in * (*rcurv)->idim, DOUBLE);

      (*rcurv)->idim --;    /* Adjust from the homogeneus coordinates. */
      (*rcurv)->ikind = 2;  /* i.e. rational */

    }
  }


  /* Ok ! */

  goto out;

  /* Error in lower level function. */

  error:
    *jstat = kstat;
    s6err ("s1370", *jstat, kpos);
    goto out;

  /* Allocation problems.    */

  err101:
    *jstat = -101;
    s6err ("s1370", *jstat, kpos);
    goto out;

  /* Dimension not equal to 3.    */

  err104:
    *jstat = -104;
    s6err ("s1370", *jstat, kpos);
    goto out;

  /* Could not create curve */

  err171:
    *jstat = -171;
    s6err ("s1370", *jstat, kpos);
    goto out;

  /* Dimension inarr not equal to 1,2 or 3. */

  err172:
    *jstat = -172;
    s6err ("s1370", *jstat, kpos);
    goto out;

  out:
  if (icurve != SISL_NULL) freeCurve (icurve);
  return;
}


//===========================================================================
void sh6sepcrv_s9circle(double apt1[], double apt2[], double apt3[],
			double aepsge, double ecentre[], double eaxis[],
			double *crad, int *jstat)
//===========================================================================
{
   int kstat = 0;
   int ki;
   int kdim = 3;
   int lpiv[3];
   double snorm[3];
   double smid1[3];
   double smid2[3];
   double sdiff1[3];
   double sdiff2[3];
   double smat[9];
   double sright[3];
   
   /* Compute difference vectors between the 1. and 2. and 2. and 3. point. */
   
   s6diff(apt1, apt2, kdim, sdiff1);
   s6diff(apt3, apt2, kdim, sdiff2);
   
   /* Compute the normal of the plane in which the circle lies. */
   
   s6crss(sdiff1, sdiff2, snorm);
   
   /* Compute the normals to the planes normal to the first plane and
      perpendicular to the difference vectors. */
   
   /* s6crss(sdiff1, snorm, snorm1);
   s6crss(sdiff2, snorm, snorm3); */
   
   /* Check normals.  */
   
   if (s6norm(sdiff1, kdim, sdiff1, &kstat) < aepsge) goto warn1;
   if (s6norm(snorm, kdim, snorm, &kstat) < aepsge) goto warn1;
   if (s6norm(sdiff2, kdim, sdiff2, &kstat) < aepsge) goto warn1; 
   
   /* Compute the midpoints of the difference vectors. */
   
   for (ki=0; ki<kdim; ki++)
   {
      smid1[ki] = (double)0.5*(apt1[ki] + apt2[ki]);
      smid2[ki] = (double)0.5*(apt2[ki] + apt3[ki]);
   }
   
   /* Set up equation system.  */

   memcopy(smat, snorm, kdim, DOUBLE);
   memcopy(smat+kdim, sdiff1, kdim, DOUBLE);
   memcopy(smat+2*kdim, sdiff2, kdim, DOUBLE);
   
   sright[0] = s6scpr(apt2, snorm, kdim);
   sright[1] = s6scpr(smid1, sdiff1, kdim);
   sright[2] = s6scpr(smid2, sdiff2, kdim);
   
   /* Solve equation system.  */
   
   s6lufacp(smat, lpiv, 3, &kstat);
   if (kstat < 0) goto error;
   
   s6lusolp(smat, sright, lpiv, 3, &kstat);
   if (kstat < 0) goto error;
   
   /* Prepare output.  */
   
   memcopy(eaxis, snorm, kdim, DOUBLE);
   memcopy(ecentre, sright, kdim, DOUBLE);
   *crad = s6dist(ecentre, apt2, kdim);
   
   *jstat = 0; 
   goto out;
   
   /* Almost singular equation system.  */
   
   warn1 :
      *jstat = 1;
   goto out;
   
   /* Error in lower level routine.  */
   
   error :
      *jstat = kstat;
   goto out;
   
   out :
      return;
}


//===========================================================================
void sh6sepcrv (SISLCurve *pc1, SISLCurve *pc2, double aepsge, double ecentre[],
		double *crad, int *jstat)
//===========================================================================
{
   int kstat = 0;         /* Status variable.       */
   int ki,kj;             /* Counters.              */
   int kleft1=0; /* Parameters to surface evaluator. */
   int kdim=pc1->idim;    /* Dimension of geometry space.      */
   double tpar;       /* Midpoint of surface.              */
   double sparc1[3];      /* Corner parameters of first surface. */
   double sparc2[3];      /* Parameters of closest points on second surface. */
   double scorn1[9];     /* Corners of first surface.           */
   double scorn2[9];     /* Closest points in the other surface. */
   SISLPoint *qp = SISL_NULL;  /* Representing a surface corner as a point. */
   double tstart;      /* Start parameters of second surface.       */
   double tend;       /* End parameters of second surface.       */
   double saxis[3];       /* Normal to circle between edges.         */
   double tdot;
   double tsign;
   double tang;
   double tpi4 = PI/(double)4.0;
   
   /* Test dimension.  */
   
   if (kdim != 3)
   {
      *jstat = 0;
      goto out;
   }
   
   /* Test if the cones of the surfaces is less than pi, otherwise
      no attempt to find splitting geometry is made.  */
   
   if (pc1->pdir->igtpi != 0 || pc2->pdir->igtpi != 0)
   {
      *jstat = 0;
      goto out;
   }
   
   
   /* Check that the objects are not too large, i.e. contain to many
      vertices to be put into a sphere equation effectively. */
   
   if (pc1->in > 4*pc1->ik || pc2->in > 4*pc2->ik)
   {
      *jstat = 0;
      goto out;
   }
   
   /* Make sure that the cones lies in the same area, otherwise
      return.   */

   tdot = s6scpr(pc1->pdir->ecoef,pc2->pdir->ecoef,kdim);
   tsign = (tdot >= DZERO) ? (double)1.0 : -(double)1.0;

   tang = s6ang(pc1->pdir->ecoef,pc2->pdir->ecoef,kdim);
   if (tang > tpi4)
   {
      *jstat = 0;
      goto out;
   }
 
   /* Try to find a circle splitting the edge curves of the surface and the
      cyrve, and extend this circle to a sphere.  */
   
   sparc1[0] = *(pc1->et+pc1->ik-1);
   sparc1[2] = *(pc1->et+pc1->in);
   sparc1[1] = (double)0.5*(sparc1[0] + sparc1[2]);
   
   tstart = *(pc2->et + pc2->ik - 1);
   tend = *(pc2->et + pc2->in);
   tpar= (double)0.5*(tstart + tend);
   
   for (ki=0; ki<3; ki++)
   {
      /* Evaluate curve.  */
      
      s1221(pc1, 0, sparc1[ki], &kleft1, scorn1+ki*kdim, &kstat);
      if (kstat < 0) goto error;
      
      /* Find the closest point in the other surface. First express
	 the corner as a SISLPoint. */
      
      if ((qp = newPoint(scorn1+ki*kdim, kdim, 1)) == SISL_NULL) goto err101;
      s1771(qp, pc2, aepsge, tstart, tend, tpar, sparc2+ki, &kstat);
      if (kstat < 0) goto error;
      
      /* Evaluate second curve. */
      
      s1221(pc2, 0, sparc2[ki], &kleft1, scorn2+ki*kdim, &kstat);
      if (kstat < 0) goto error;
      
      if (qp != SISL_NULL) freePoint(qp); qp = SISL_NULL;
   }
   
   
   /* Find middle points between the sets of closest points. */
   
   for (kj=0; kj<3; kj++)
      for (ki=0; ki<kdim; ki++)
	 scorn1[kj*kdim+ki] = (double)0.5*(scorn1[kj*kdim+ki] + 
					   scorn2[kj*kdim+ki]);
   
   /* Compute splitting cylinder. */
   
   sh6sepcrv_s9circle(scorn1, scorn1+kdim, scorn1+2*kdim,
		       aepsge, ecentre, saxis, crad, &kstat);
   if (kstat < 0) goto error;
   if (kstat > 0)
   {
      *jstat = 0;
      goto out;
   }
   
   /* Output sphere. */
   
   *jstat = 1;
   goto out;

   err101 : *jstat = -101;
   goto out;
   
   error : *jstat = kstat;
   goto out;
   
   out :
      return;
}



//===========================================================================
void sh1831(SISLCurve *pc1, SISLCurve *pc2, int isign, double epoint[], 
	    double enorm[], double aepsge, int *jstat)
//===========================================================================
{
  int kpos = 0;          /* Position of error.               */
  int ki;
  int kdim;              /* Dimension of space.              */
  int kbez1, kbez2;      /* Indicates if the curves are of type Bezier. */
  int ksignprev = 0;     /* Sign of distance between previous curve and plane.*/
  int ksign1 = 0;        /* Sign of distance between curve and plane.*/
  int ksign2 = 0;        /* Sign of distance between curve and plane.*/
  double tdist;          /* Distance between coefficient and plane.     */
  double *s1;            /* Pointer to coefficient of curve. */
  double sdiff[3];       /* Difference vector.               */
  
  /* Test dimension of geometry space. */
  
  kdim = pc1->idim;
  if (kdim != 2 && kdim != 3) goto err105;
  if (kdim != pc2->idim) goto err106;
  
  /* Test if the curves are Bezier curves. */
  
  kbez1 = (pc1->ik == pc1->in) ? 1 : 0;
  kbez2 = (pc2->ik == pc2->in) ? 1 : 0;
  
  /* For each curve, compute the distance between the coefficients of the
     curve and the given plane.    */
  
  for (s1=pc1->ecoef, ki=0; ki<pc1->in; ki++, s1+=kdim)
  {
     s6diff(epoint, s1, kdim, sdiff);
     tdist = s6scpr(sdiff, enorm, kdim);
     
     if (fabs(tdist) <= aepsge && !kbez1 && !(ki==0 || ki==pc1->in-1)) break;
     ksign2 = (DEQUAL(tdist,DZERO)) ? 0 : ((tdist > 0) ? 1 : -1);
     if (ksign1*ksign2 < 0) break;
     ksign1 = ksign2;
  }
  if (ki < pc1->in)
  {
     *jstat = 1;
     goto out;
  }

  ksignprev = isign*ksign1;
  ksign1 = 0;
  for (s1=pc2->ecoef, ki=0; ki<pc2->in; ki++, s1+=kdim)
  {
     s6diff(epoint, s1, kdim, sdiff);
     tdist = s6scpr(sdiff, enorm, kdim);
     
     if (fabs(tdist) <= aepsge && !kbez2 && !(ki==0 || ki==pc2->in-1)) break;
     ksign2 = (DEQUAL(tdist,DZERO)) ? 0 : ((tdist > 0) ? 1 : -1);
     if (ksign1*ksign2 < 0) break;
     if (ksignprev*ksign1 > 0) break;
     ksign1 = ksign2;
  }
  if (ki < pc2->in)
  {
     *jstat = 1;
     goto out;
  }
  
  goto out;
  
  /* Error in input. Dimension not equal to 2 or 3.  */
  
 err105: *jstat = -105;
  s6err("sh1831",*jstat,kpos);
  goto out;
  
  /* Error in input. Dimensions conflicting.  */
  
 err106: *jstat = -106;
  s6err("sh1831",*jstat,kpos);
  goto out;
  
 out:
  
  return;
}

//===========================================================================
void sh1830(SISLObject *po1,SISLObject *po2,double aepsge,int *jstat)
//===========================================================================
{
  int kstat = 0;         /* Local status variable.           */
  int kpos = 0;          /* Position of error.               */
  int kdim;              /* Dimension of space.              */
  int knc;               /* Number of vertices of curve.     */
  int kn1,kn2;           /* Number of vertices of surface.   */
  double *scurve;        /* Vertices of curve.               */
  double *ssurf;         /* Vertices of surface.             */
  double *stan = SISL_NULL;   /* Main tangent of curve.           */
  double *sdiag1 = SISL_NULL; /* First main diagonal of surface.  */
  double *sdiag2 = SISL_NULL; /* Second main diagonal of surface. */
  double *snorm = SISL_NULL;  /* Main normal of surface.          */
  SISLCurve *qcurve;     /* Pointer to curve.                */
  SISLSurf *qsurf;       /* Pointer to surface.              */
  
  /* Test input.  */
  
  if (!((po1->iobj == SISLSURFACE && po2->iobj == SISLCURVE) ||
	(po1->iobj == SISLCURVE && po2->iobj == SISLSURFACE))) 
     goto err121;
  
  /* Set pointers to objects.  */
  
  if (po1->iobj == SISLSURFACE)
  {
     qsurf = po1->s1;  qcurve = po2->c1;
  }
  else
  {
     qsurf = po2->s1;  qcurve = po1->c1;
  }
  
  /* Test dimension.  */
  
  kdim = qsurf -> idim;
  if (kdim != 3) goto err104;
  if (kdim != qcurve -> idim) goto err106;
  
  /* Allocate space for local arrays.  */
  
  if ((stan = newarray(kdim,double)) == SISL_NULL) goto err101;
  if ((sdiag1 = newarray(kdim,double)) == SISL_NULL) goto err101;
  if ((sdiag2 = newarray(kdim,double)) == SISL_NULL) goto err101;
  if ((snorm = newarray(kdim,double)) == SISL_NULL) goto err101;
  
  /* Describe curve with local parameters.  */
  
  knc = qcurve->in;
  scurve = qcurve->ecoef;
  
  /* Describe surface with local parameters.  */
  
  kn1 = qsurf->in1;
  kn2 = qsurf->in2;
  ssurf = qsurf->ecoef;
  
  /* Fetch main tangent of curve.  */
  
  s6diff(scurve+(knc-1)*kdim,scurve,kdim,stan);
  
  /* Fetch main diagonals of surface.  */
  
  s6diff(ssurf+(kn1*kn2-1)*kdim,ssurf,kdim,sdiag1);
  
  s6diff(ssurf+kn1*(kn2-1)*kdim,ssurf+(kn1-1)*kdim,kdim,sdiag2);
  
  /* Compute main normal of surface.  */
  
  s6crss(sdiag1,sdiag2,snorm);
  
  /* Perform rotated box-test.  */
  
  sh1834(po1,po2,aepsge,kdim,stan,snorm,&kstat);
  if (kstat < 0) goto error;
  
  if (kstat == 1)
    {
      kstat = 0;
      
      sh1834(po1,po2,aepsge,kdim,snorm,stan,&kstat);
      if (kstat < 0) goto error;
    }
  
  /* Improved box-test performed.  */
  
  *jstat = kstat;
  goto out;
  
  /* Error in space allocation.  */
  
 err101: *jstat = -101;
  s6err("sh1830",*jstat,kpos);
  goto out;
  
  /* Error in input. Dimension not equal to 3.  */
  
 err104: *jstat = -104;
  s6err("sh1830",*jstat,kpos);
  goto out;
  
  /* Error in input. Dimensions conflicting.  */
  
 err106: *jstat = -106;
  s6err("sh1830",*jstat,kpos);
  goto out;
  
  /* Error in kind of object.  */
  
  err121: *jstat = -121;
  s6err("s1930",*jstat,kpos);
  goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("sh1830",*jstat,kpos);
  goto out;
  
 out:
  
  /* Free space occupied by local arrays.  */
  
  if (stan != SISL_NULL) freearray(stan);
  if (sdiag1 != SISL_NULL) freearray(sdiag1);
  if (sdiag2 != SISL_NULL) freearray(sdiag2);
  if (snorm != SISL_NULL) freearray(snorm);
  
  return;
}


//===========================================================================
void s1376(double et[],int in,int ik,double **gt,int *jkn,int *jkk,int *jstat)
//===========================================================================
{                                                                     
  double tval;     /* Value of knot                                 */
  double *sdum;    /* Pointer to knot array                         */
  int ki,kl;       /* Variable in loop                              */
  int knumb;       /* Number of intervals                           */
  int kstop;       /* Loop stop variable                            */
  int kpos=0;      /* Position of error                             */
  
  /* Run through the knot vector to decide how many intervals exist */
  
  knumb = 0;       
  tval = et[ik-1];
  
  for (ki=ik ; ki<=in ; ki++)
    {
      if (tval < et[ki])
        {
	  /*      New knot value found */
	  knumb = knumb + 1;
	  tval = et[ki];
        }
    }
  
  *jkk = 4*(ik-1) + 1;
  *jkn = (*jkk-1)*(knumb-1) + *jkk;
  
  sdum = newarray(*jkn+*jkk,DOUBLE);
  if (sdum == SISL_NULL) goto err101;
  
  *gt  = sdum; 
  
  /* Make knot values */
  
  tval = et[ik-1];
  
  /* Make jkk first knot values */
  
  for (kl=0;kl<*jkk;kl++)
    {
      sdum[kl] = tval;
    }
  
  /* kl points to the array entry where the next knot value is to be stored
   */
  
  for (ki=ik ; ki<=in ; ki++)
    {
      if (tval < et[ki])
        {
	  /* New knot value, remember this and make knots */
	  tval = et[ki];
	  kstop = kl + *jkk-1;
	  for (;kl<kstop;kl++)
            sdum[kl] = tval;
        }   
    }
  
  /* Make last knot value */
  
  sdum[kl] = tval;
  
  *jstat = 0;
  goto out;
  
  /* Error in space allocation */
 err101: *jstat = -101;
  s6err("s1376",*jstat,kpos);
  goto out;
 out:
  
  return;
}                                               


//===========================================================================
void s1378 (SISLSurf * psurf, double econic[], int ideg, int idim,
	    SISLSurf ** rsurf, int *jstat)
//===========================================================================
{
  int ikind;			/* type of surface psurf is                         */
  int kn1;			/* Number of vertices of psurf in first par.dir     */
  int kk1;			/* Order in  psurf in first par.dir                 */
  int kn2;			/* Number of vertices of psurf in second par.dir    */
  int kk2;			/* Order in  psurf in second par.dir                */
  int kjkk1;			/* Order of interpolated basis in first par.dir     */
  int kjkn1;			/* Number of vertices in interpolated basis first.dr*/
  int kjkk2;			/* Order of interpolated basis in first par SISLdir     */
  int kjkn2;			/* Number of vertices in interpolated basis secnd.dr*/
  int kdim;			/* Number of dimesions in psurf                     */
  int kstat;			/* Local status variable                            */
  int kpos = 0;			/* Position indicator for errors                    */
  int kzero = 0;		/* Value 0 needed in call s1891		          */
  int kone = 1;			/* Value 1 needed in call s1891			  */
  int cuopen;			/* Open/Closed flag                                 */
  int ki, kj, kl;		/* Loop control variable                            */
  int kp;			/* Index of points put into conic equation          */
  int klfs = 0;			/* Pointer into knot vector                         */
  int klft = 0;			/* Pointer into knot vector                         */
  double *st1 = SISL_NULL;		/* First knot vector is psurf                       */
  double *st2 = SISL_NULL;		/* Second knot vector is psurf                      */
  double *scentr = econic;	/* Center of torus             */
  double *saxis = econic + 3;	/* Axis of torus               */
  double tbigr = *(econic + 6);	/* Big radius of torus         */
  double tsmalr = *(econic + 7);/* Small radius of torus       */
  double tbigr2 = tbigr * tbigr;/* Square of big radius        */
  double tdiffr2 = tbigr2 - tsmalr * tsmalr;	/* Difference of square of radia*/
  double *sval1 = SISL_NULL;		/* Array of values of surface put into torus eq.    */
  double *sval2 = SISL_NULL;
  double *sval3 = SISL_NULL;
  double *sgt1 = SISL_NULL;		/* Knot vector in first parameter direction of
				   surface put into torus equation                  */
  double *sgt2 = SISL_NULL;		/* Knot vector in second parameter direction of
				   surface put into torus equation                  */
  double sy[3];			/* Difference between point and torus center        */
  double tzn;			/* Projection of sy onto torus axis                 */
  double tyy;			/* Square of length of sy                           */
  double tzz;			/* Square of length of sz                           */
  double ty;			/* Component of sy                                  */
  double tz;			/* Component of sz                                  */
  double sder[4];		/* SISLPoint on the surface                         */
  double spar[2];		/* Current parameter pair                           */
  double ww;			/* the weight of sder squared if psurf is rational  */
  double *par1 = SISL_NULL;		/* Parameter vaues in direction 1. 		  */
  double *par2 = SISL_NULL;		/* Parameter vaues in direction 2. 		  */
  int *der1 = SISL_NULL;		/* Derivative indicators in direction 1.		  */
  int *der2 = SISL_NULL;		/* Derivative indicators in direction 2.		  */
  SISLSurf *tempsurf = SISL_NULL;	/* only used for rational surfaces             */

  *jstat = 0;


  /* Test if torus. */

  if (ideg != 1001)
    goto err180;

  if (idim != psurf->idim)
    goto err104;

  /* Make local pointers. */

  kn1 = psurf->in1;
  kk1 = psurf->ik1;
  kn2 = psurf->in2;
  kk2 = psurf->ik2;
  kdim = psurf->idim;
  st1 = psurf->et1;
  st2 = psurf->et2;
  ikind = psurf->ikind;

  if (ikind == 2 || ikind == 4)
    {
      tempsurf = newSurf (kn1, kn2, kk1, kk2, st1, st2,
			  psurf->rcoef, ikind - 1, kdim + 1, 0);
      if (tempsurf == SISL_NULL)
	goto err171;
      tempsurf->cuopen_1 = psurf->cuopen_1;
      tempsurf->cuopen_2 = psurf->cuopen_2;
    }
  else
    {
      tempsurf = psurf;
    }

  /* Test input. */

  if (kdim != 3)
    goto err104;


  /* Make description of knot array for interpolation in first parameter
     direction. */

  s1376 (st1, kn1, kk1, &sgt1, &kjkn1, &kjkk1, &kstat);
  if (kstat < 0)
    goto error;


  /* Make parameter values and derivative indicators. */

  s1890 (sgt1, kjkk1, kjkn1, &par1, &der1, &kstat);
  if (kstat < 0)
    goto error;


  /* Make description of knot array for interpolation in second parameter
     direction. */

  s1376 (st2, kn2, kk2, &sgt2, &kjkn2, &kjkk2, &kstat);
  if (kstat < 0)
    goto error;


  /* Make parameter values and derivative indicators. */

  s1890 (sgt2, kjkk2, kjkn2, &par2, &der2, &kstat);
  if (kstat < 0)
    goto error;


  /* Allocate array for values of surface put into torus equation. */

  sval1 = newarray (kjkn1 * kjkn2, DOUBLE);
  if (sval1 == SISL_NULL)
    goto err101;


  /* Calculate values to be interpolated. */

  /* Index of point to be stored. */

  kp = 0;

  for (kj = 0; kj < kjkn2; kj++)
    {

      spar[1] = par2[kj];

      for (ki = 0; ki < kjkn1; ki++)
	{
	  /*  Calculate values on 3-D surface */

	  spar[0] = par1[ki];

	  s1424 (tempsurf, 0, 0, spar, &klfs, &klft, sder, &kstat);
	  if (kstat < 0)
	    goto error;

	  /*
	   *       The calculation of a point on the torus surface
	   *		 can be done in the following way.
	   *
	   *          y = p - scentr
	   *          z = y - (y saxis) saxis
	   *
	   *       The equation of the torus can be written
	   *
	   *                              2    2
	   *          (y - R z/sqrt(z z) )  - r = 0
	   *
	   *
	   *       or by elliminating the square root:
           *
           *          f =
	   *
	   *              2           2  2      2       2  2 2
	   *          (yy)  + 2 (yy)(R -r ) - 4R zz + (R -r )  = 0
	   *
           *       or in 4-D homogeneous coordinates:
           *
           *                                               4
           *          f =
	   *
	   *              2      2      2  2      2 2      4  2  2 2
	   *          (yy)  + 2 w (yy)(R -r ) - 4w R zz + w (R -r )  = 0
	   *
	   *         where Y = T - w*scentr,  p+T/w
	   *
	   *       We thus need to calculate yy and zz:
	   */

	  if (ikind == 2 || ikind == 4)
	    {
	      for (kl = 0; kl < 3; kl++)
		sy[kl] = sder[kl] - sder[3] * scentr[kl];
	      ww = sder[3] * sder[3];
	    }
	  else
	    {
	      for (kl = 0; kl < 3; kl++)
		sy[kl] = sder[kl] - scentr[kl];
	      ww = (double) 1.0;
	    }

	  tzn = s6scpr (sy, saxis, 3);

	  tyy = (double) 0.0;
	  tzz = (double) 0.0;

	  /*      Make z and necessary derivatives of z */

	  for (kl = 0; kl < 3; kl++)
	    {
	      ty = sy[kl];
	      tz = ty - tzn * saxis[kl];
	      tyy += ty * ty;
	      tzz += tz * tz;
	    }

	  /*                                      2            2   2
	     Now tyy = yy and tzz = zz, tbigr2 = R ,tdiffr2 = R - r   */

	  sval1[kp++] = tyy * tyy + ((double) 2.0 * ww * tyy + ww * ww * tdiffr2) * tdiffr2
	    - (double) 4.0 *ww * tbigr2 * tzz;
	}
    }

  cuopen = TRUE;

  /* Interpolate in second parameter direction, the first parameter direction
     is treated as a point of dimension kjkn1 */

  s1891 (par2, sval1, kjkn1, kjkn2, kone, der2, cuopen, sgt2, &sval2,
	 &kjkn2, kjkk2, kzero, kzero, &kstat);
  if (kstat < 0)
    goto error;


  /* Interpolate in first parameter direction, perform kjkn2 interpolations
     of one dimensional data */

  s1891 (par1, sval2, kone, kjkn1, kjkn2, der1, cuopen, sgt1, &sval3,
	 &kjkn1, kjkk1, kzero, kzero, &kstat);
  if (kstat < 0)
    goto error;

  *rsurf = SISL_NULL;
  *rsurf = newSurf (kjkn1, kjkn2, kjkk1, kjkk2, sgt1, sgt2, sval3, 1, 1, 1);
  if (*rsurf == SISL_NULL)
    goto err171;
  (*rsurf)->cuopen_1 = psurf->cuopen_1;
  (*rsurf)->cuopen_2 = psurf->cuopen_2;

  /* Ok ! */

  goto out;


  /* Error in lower level function */

error:
  *jstat = kstat;
  s6err ("s1378", *jstat, kpos);
  goto out;

  /* Error in space allocation */

err101:
  *jstat = -101;
  s6err ("s1378", *jstat, kpos);
  goto out;

  /* Dimension not equal to 3  or confliciting dim  */

err104:
  *jstat = -104;
  s6err ("s1378", *jstat, kpos);
  goto out;

  /* Could not create surface. */

err171:
  *jstat = -171;
  s6err ("s1378", *jstat, kpos);
  goto out;

  /* Error in torus description */

err180:
  *jstat = -180;
  s6err ("s1378", *jstat, kpos);
  goto out;

out:

  /* Release allocated arrays */

  if (sgt1 != SISL_NULL)
    freearray (sgt1);
  if (sgt2 != SISL_NULL)
    freearray (sgt2);
  if (sval1 != SISL_NULL)
    freearray (sval1);
  if (sval2 != SISL_NULL)
    freearray (sval2);
  if (sval3 != SISL_NULL)
    freearray (sval3);
  if (par1 != SISL_NULL)
    freearray(par1);
  if (par2 != SISL_NULL)
    freearray(par2);
  if (der1 != SISL_NULL)
    freearray(der1);
  if (der2 != SISL_NULL)
    freearray(der2);
  if ((ikind == 2 || ikind == 4) && (tempsurf != SISL_NULL))
    freeSurf (tempsurf);


  return;
}

//===========================================================================
void s1927 (double *w1, int nur, int ik, int *ed, double *w2, int nrc,
	    double *w3, int nlr, double *ex[], double *ey, int *jstat)
//===========================================================================
{
  int kpos = 0;
  int ii, jj;			/* Loop control parameters 		*/
  int di;			/* Pointer to diagonal element of W 	*/
  int midi;			/* Parameter always equal: ii-di	*/
  int dim;			/* di minus 2:  di-2			*/
  int mur;			/* Used in calculation of index for w3  */
  int nn;			/* Number of rows/columns in w3		*/
  int nlc;			/* Number of left columns in W		*/
  double wii;			/* Used to store values from matrix W	*/
  double sum;			/* Stores values for calculation of ex 	*/

  *jstat = 0;


  /* Test if legal dimension of interpolatoin problem */

  if (nur < 1 || ik < 1 || nrc < 0 || nlr < 0)
    goto err160;
  nn = nur + nlr;
  nlc = nn - nrc;
  if (ik > nlc)
    goto err160;


  /* Allocate output array ex */

  *ex = new0array (nn, DOUBLE);
  if (*ex == SISL_NULL)
    goto err101;


  /* Solve L*z = ey */

  for (ii = 0; ii < nur; ii++)
    {
      di = ed[ii];
      wii = w1[(di - 1) * nur + ii];


      /* Test for errors */

      if (ii >= nlc)
	goto err163;
      if (di < 1 || ik < di || wii == (double) 0.0)
	goto err162;
      sum = ey[ii];
      if (di > 1)
	{
	  dim = di - 1;
	  midi = ii - di + 1;
	  for (jj = 0; jj < dim; jj++)
	    sum -= w1[jj * nur + ii] * ((*ex)[jj + midi]);
	}
      (*ex)[ii] = sum / wii;
    }

  /* Solve filled part of L*z = ey */

  for (; ii < nn; ii++)
    {
      mur = ii - nur;
      wii = w3[ii * nlr + mur];
      if (wii == (double) 0.0)
	goto err162;
      sum = ey[ii];
      if (ii >= 1)
	{
	  for (jj = 0; jj < ii; jj++)
	    sum -= w3[jj * nlr + mur] * ((*ex)[jj]);
	}
      (*ex)[ii] = sum / wii;
    }

  /* Solve U*ex = z   ; Jump if filled part of U is exhausted */

  for (ii = nn - 2; ii >= nur; ii--)
    {
      sum = (*ex)[ii];
      mur = ii - nur;
      for (jj = ii + 1; jj < nn; jj++)
	sum -= w3[jj * nlr + mur] * ((*ex)[jj]);
      (*ex)[ii] = sum;
    }

  /* Test if w2 contains diagonal elements */

  if (ii >= nlc)
    goto err163;
  if (nlc < nn)
    {
      for (; ii >= 0; ii--)
	{
	  sum = (*ex)[ii];
	  for (jj = nlc; jj < nn; jj++)
	    sum -= w2[(jj - nlc) * nur + ii] * ((*ex)[jj]);
	  (*ex)[ii] = sum;
	}
    }
  for (ii = nur - 1; ii >= 0; ii--)
    {
      di = ed[ii];
      if (di < ik)
	{
	  sum = (*ex)[ii];
	  midi = ii - di + 1;
	  for (jj = di; jj < ik; jj++)
	    sum -= w1[jj * nur + ii] * ((*ex)[jj + midi]);
	  (*ex)[ii] = sum;
	}
    }

  goto out;


  /* Memory error, array ex not allocated */

err101:
  *jstat = -101;
  s6err ("s1927", *jstat, kpos);
  goto out;

  /* error in dimension of interpolation problem */

err160:
  *jstat = -160;
  s6err ("s1927", *jstat, kpos);
  goto out;

  /* W is non-invertible */

err162:
  *jstat = -162;
  s6err ("s1927", *jstat, kpos);
  goto out;

  /* w2 contains diagonal element */

err163:
  *jstat = -163;
  s6err ("s1927", *jstat, kpos);
  goto out;

out:
  return;
}


//===========================================================================
void s1926 (double *w1, int nur, int ik, int *ed, double *w2, int nrc,
	    double *w3, int nlr, int *jstat)
//===========================================================================
{
  int kpos = 0;
  int ii, jj;			/* Loop control parameters 		*/
  int ll;
  int nn;			/* Number of rows/columns in W 		*/
  int nlc;			/* Number of left columns in W 		*/
  int di;			/* Pointer to diagonal element of W   	*/
  int midi;			/* Parameters used in elimination alg.  */
  int midl;
  int korr;			/* midl - midi 				*/
  int mur;			/* Used in calculation of index for w3  */
  double wii;			/* Used to store values from matrix W   */
  double wli;

  *jstat = 0;


  /* Test if legal dimension of interpolation problem */

  if (nur < 1 || (nur >= 1 && ik < 1) || nrc < 0 || nlr < 0)
    goto err160;

  nn = nur + nlr;
  nlc = nn - nrc;
  if (ik > nlc)
    goto err160;


  /* Elimination scheme, jump if band part of W is completed */

  for (ii = 0; ii < nur; ii++)
    {
      di = ed[ii];
      wii = w1[(di - 1) * nur + ii];


      /* Test for errors */

      if (ii >= nlc)
	goto err163;
      if ((di < 1) || (ik < di) || (wii == 0.0))
	goto err162;


      /* Jump if W(ii,jj) is trivially zero, jj = ii+1,ii+2,...,nlr */

      if (di < ik)
	{
	  for (jj = di; jj < ik; jj++)
	    w1[jj * nur + ii] /= wii;


	  /* Perform elimination row by row */

	  midi = ii - di;
	  for (ll = ii + 1;; ll++)
	    {
	      /* Jump if ii-th element of rows of band-part has been
               * eliminated */

	      if (ll >= nur)
		break;
	      midl = ll - ed[ll];


	      /* Jump if W(ii,jj) is trivially zero, jj = ll,ll+1,...,nur */

	      if (midl >= ii)
		break;
	      korr = midl - midi;
	      wli = w1[(di - korr - 1) * nur + ll];
	      for (jj = di; jj < ik; jj++)
		w1[(jj - korr) * nur + ll] += -w1[jj * nur + ii] * wli;
	    }

	  /*  Eliminate ii-th column of w3 using ii-th row from w1 */

	  if (nlr > 0)
	    for (ll = 0; ll < nlr; ll++)
	      {
		wli = w3[ii * nlr + ll];
		for (jj = di; jj < ik; jj++)
		  w3[(jj + midi + 1) * nlr + ll] -= w1[jj * nur + ii] * wli;
	      }
	}
    }

  /* Apply the above elimination scheme on w2 */

  if (nrc > 0)
    {
      /* Jump if band part of W is completed or if system error
       * occures, i.e. if w2 contains some diagonal elements of W) */

      for (ii = 0; ii < nur; ii++)
	{
	  /* Test for error */

	  if (ii > nlc)
	    goto err163;

	  di = ed[ii];
	  wii = w1[(di - 1) * nur + ii];
	  for (jj = 0; jj < nrc; jj++)
	    w2[jj * nur + ii] /= wii;


	  /* Perform elimination row by row */

	  midi = ii - di;
	  for (ll = ii + 1;; ll++)
	    {

	      /*  Jump if ii-th element of rows of band-part has been
	          eliminated                                          */

	      if (ll >= nur)
		break;
	      midl = ll - ed[ll];


	      /* Jump if W(ii,jj) is trivially zero, jj = ll,ll+1,...,nur */

	      if (midl >= ii)
		break;
	      korr = midl - midi;
	      wli = w1[(di - korr - 1) * nur + ll];
	      for (jj = 0; jj < nrc; jj++)
		w2[jj * nur + ll] -= w2[jj * nur + ii] * wli;
	    }

	  /*  Eliminate ii-th column of w3 using ii-th row from w2 */

	  for (ll = 0; ll < nlr; ll++)
	    {
	      wli = w3[ii * nlr + ll];
	      for (jj = nlc; jj < nn; jj++)
		w3[jj * nlr + ll] -= w2[(jj - nlc) * nur + ii] * wli;
	    }
	}
    }

  /* Eliminate w3-part of W */

  if (ii >= nn)
    goto out;
  for (; ii < nn; ii++)
    {

      /* 1 <= ii <= nn */

      mur = ii - nur;
      wii = w3[ii * nlr + mur];
      if (wii == (double) 0.0)
	goto err162;


      /*  1 <= ii < nn */

      for (jj = ii + 1; jj < nn; jj++)
	w3[jj * nlr + mur] /= wii;
      for (ll = mur + 1; ll < nlr; ll++)
	{
	  wli = w3[ii * nlr + ll];
	  for (jj = ii + 1; jj < nn; jj++)
	    w3[jj * nlr + ll] -= w3[jj * nlr + mur] * wli;
	}
    }

  goto out;


  /* W may be non-invertible */

err162:
  *jstat = -162;
  s6err ("s1926", *jstat, kpos);
  goto out;

  /* Error in dimension in interpolation problem */

err160:
  *jstat = -160;
  s6err ("s1926", *jstat, kpos);
  goto out;

  /* w2 contains diagonal elements */

err163:
  *jstat = -163;
  s6err ("s1926", *jstat, kpos);
  goto out;

out:
  return;
}

//===========================================================================
void s1897 (double et[], int ik, double ax, int left, int deriv,
	    double ebiatx[], int *jstat)
//===========================================================================
{
  int kpos = 0;
  int local_array_allocated = FALSE;
  int j;			         /* Loop control variables.    */
  int count;
  double dummy;			         /* Used for temporary calculations.*/
  double fak;
  double term;
  double saved;
  double stmp[2*s1897_MAX_IK + 1];             /* temporary storage              */
  double *sltmp = SISL_NULL;                  /* temp storage allocated only 
					    if ik > MAX_IK                 */
  double *edltr = SISL_NULL;                  /* pointer into temporary storage */
  double *edltl = SISL_NULL;                  /* pointer into temporary storage */
  
  /*
   * Initialize.
   * -----------
   */

  *jstat = 0;

  if (ik > s1897_MAX_IK)
    {
       /*
        * We need to allocate a larger local tmp array; Do so.
	* ----------------------------------------------------
	*/
       
       if ((sltmp = newarray(2 * ik + 1, DOUBLE)) == SISL_NULL)
	 goto err101;
       local_array_allocated = TRUE;
       
    }
  else
    sltmp = stmp;

  /*
   * Set pointer into local array.
   * -----------------------------
   */
         
  edltr = sltmp;
  edltl = sltmp + ik;

  ebiatx[0] = (double) 1.0;

  for (j = 1; j <= deriv; j++)
    {
      edltr[j - 1] = et[left + j] - ax;
      edltl[j - 1] = ax - et[left + 1 - j];
      fak = (double) j;

      saved = (double) 0.0;
      for (count = 1; count <= j; count++)
	{
	  dummy = edltr[count - 1] + edltl[j - count];
	  if (dummy <= (double) 0.0)
	    goto err112;

	  term = fak * ebiatx[count - 1] / dummy;
	  ebiatx[count - 1] = saved - term;
	  saved = term;
	}
      ebiatx[j] = saved;
    }

  for (; j < ik; j++)
    {
      edltr[j - 1] = et[left + j] - ax;
      edltl[j - 1] = ax - et[left + 1 - j];
      fak = ((double) j) / (double) (j - deriv);

      saved = (double) 0.0;
      for (count = 1; count <= j; count++)
	{
	  dummy = edltr[count - 1] + edltl[j - count];
	  if (dummy <= (double) 0.0)
	    goto err112;

	  term = fak * ebiatx[count - 1] / dummy;
	  ebiatx[count - 1] = saved + edltr[count - 1] * term;
	  saved = edltl[j - count] * term;
	}
      ebiatx[j] = saved;
    }

  /* OK */

  goto out;

  /* Error in scratch allocation. */

err101:
  *jstat = -101;
  s6err ("s1897", *jstat, kpos);
  goto out;

  /* Error in knot vector. */

err112:
  *jstat = -112;
  s6err ("s1897", *jstat, kpos);
  goto out;

out:
  if (local_array_allocated)
    freearray (sltmp);
  return;
}

//===========================================================================
void s1925 (double etau[], double epoint[], int inbpnt, int eder[],
	    double et[], double ebcoef[], int in, int ik, int iright, int dim,
	    double ew1[], int nur, int ed[], double ew2[], int inrc, double ew3[],
	    int inlr, int *jstat)
//===========================================================================
{
  int kstat = 0;
  int kpos = 0;			/* Position of error			*/
  int open;			/* Used as a boolean parameter to
				 * indicate open or closed curve:
				 * open=TRUE   ; Open curve
			  	 * open=FALSE  ; Closed curve  		*/
  int left;			/* An integer chosen (usually) so that
				 * et(left-1)<=point<et(left)		*/
  int leftmax;
  int leftmin;
  int leftdel;
  int kmod;			/* Used in calculation of ew3 index  	*/
  int isum;
  int ii, jj, kl, stop;		/* Loop control parameters		*/
  int dim1;			/* Loop control parameter,
				 * values: 0..dim-1 			*/
  int imnur;			/* Equals ii-nur			*/
  int nn;			/* Equals nur+inlr
				 * i.e. Number of rows/columns in W	*/
  int nlc;			/* Number of lower columns
				 * Equals inbpnt-inrc			*/
  int kk;			/* Minimum: ik or nlc			*/
  double tk;			/* ik-th element of knot vector 	*/
  double taudel;		/* to left and taui			*/
  int lfmkm;			/* Equals left-ik			*/
  int iadd;
  int iadd_save;
  int kmiadd;
  int isub;
  int kmisub;			/* Equals ik-isub			*/
  int ish;
  int ideri;			/* Derivative order indicator 		*/
  int store;

  double taui;			/* Parametrization value = etau[ii] 	*/
  double *mcoef = SISL_NULL;		/* Arrays for internal use in 		*/
  double *ebder = SISL_NULL;		/* this subroutine			*/
  double sarray[s1925_MAX_ARRAY_SIZE];
  int alloc_needed=FALSE;
  
  *jstat = 0;

  nn = nur + inlr;

  /* Test if legal input */

  if (ik < 1)
    goto err109;

  if ((nur < 0) || ((nur + inlr) != inbpnt) || (inrc < 0) || (inlr < 0))
    goto err160;

  nlc = inbpnt - inrc;
  kk = MIN (ik, nlc);
  tk = et[ik - 1];


  /* Test if open or closed curve */

  if (inbpnt == in)
    open = TRUE;
  else
    open = FALSE;

  if (open == TRUE)
    {
      /* Open curve */

      taudel = (double) 0.0;
      leftdel = 0;
      leftmin = ik - 1;
      leftmax = in -1;
      if ((inrc != 0) || (inlr != 0))
	goto err160;
    }
  else
    {
      /* Closed curve, note: we assume that et(in) < etau(inbpnt) */

      if ((inbpnt + ik - 1) != in)
	goto err160;
      leftdel = in +1 - ik;
      iadd = (ik - 1) / 2;
      leftmax = leftdel + iadd - 1;
      leftmin = ik - iadd - 1;
      taudel = et[in] -tk;

      if ((iadd != inrc) || ((inrc + inlr) != (ik - 1)))
	goto err160;

      if (inrc > 0)
	{
	  stop = nur * inrc;
	  for (ii = 0; ii < stop; ii++)
	    ew2[ii] = (double) 0.0;
	}
    }

  /* Band part of W */

  /* Allocate array ebder */

  left = leftmin;
  if (ik > s1925_MAX_ARRAY_SIZE)
    {
       if ((ebder = newarray (ik, DOUBLE)) == SISL_NULL)
	 goto err101;
	alloc_needed = TRUE;
    }
  else
    ebder = sarray;
  
  for (ii = 0; ii < nur; ii++)
    {
      taui = etau[ii];
      ideri = eder[ii];


      /* Locate left so that  et[left] <= taui < et[left+1] */

      while (left < leftmax && et[left + 1] <= taui)
	left++;


      /* et(left-1) <= taui < et(left)  */

      ed[ii] = ii - (left - ik);


      /* Test if error in interpolation problem */

      if ((ed[ii] < 1) || (ed[ii] > ik))
	goto err165;


      iadd = MAX (0, ik - left - 1);
      iadd_save = iadd;
      kmiadd = ik - iadd;


      /* Compute the value and ideri first derivative of the
      ik (possibly) nonzero B-spline associated with the knot
      vector et at a point 				    */

      if (iadd > 0)
	{
	  s1897 (et, ik, taui + taudel, left + leftdel, ideri, ebder, &kstat);
	  if (kstat < 0)
	    goto error;

	  ed[ii] -= iadd;
	  ish = inrc - iadd;
	  if ((ish < 0) || (kmiadd < 0))
	    goto err160;

	  for (jj = 0; jj < iadd; jj++)
	    {
	      ew1[(jj + kmiadd) * nur + ii] = (double) 0.0;
	      ew2[(jj + ish) * nur + ii] = ebder[jj];
	    }
	}
      else
	{
	  s1897 (et, ik, taui, left, ideri, ebder, &kstat);
	  if (kstat < 0)
	    goto error;
	}

      isub = MAX (0, ii - ed[ii] + kmiadd - nlc + 1);
      kmisub = ik - isub;
      if (isub > 0)
	{
	  ish = isub - (kmiadd - kk);
	  ed[ii] += ish;
	  iadd -= ish;
	  if (kmisub < 0)
	    goto err160;
	  stop = MIN (ik, kmisub + inrc);

	  for (jj = kmisub; jj < stop; jj++)
	    {
	      ew1[(jj - kmisub) * nur + ii] = (double) 0.0;
	      ew2[(jj - kmisub) * nur + ii] = ebder[jj];
	    }
	}
      for (jj = iadd_save; jj < kmisub; jj++)
	ew1[(jj - iadd) * nur + ii] = ebder[jj];


      /* Test if error in dimension of interpolation problem */

      if ((ideri < 0) || (ik <= ideri))
	goto err160;
    }

  /* Band part of W is now completed */

  if (ii < inbpnt)
    {
      /* Will compute lower, filled part of W for closed
	 curve interpolation */

      if ((inbpnt + ik - 1) != in)
	goto err160;
      store = inlr * inbpnt;
      for (jj = 0; jj < store; jj++)
	ew3[jj] = (double) 0.0;


      /* Repeat until filled part of W is completed */

      for (; ii < inbpnt; ii++)
	{
	  taui = etau[ii];


	  /* Locate left so that  et[left] <= taui < et[left+1] */

	  while (left < in -1 && et[left + 1] <= taui)
	    left++;


	  /* et(left-1) <= taui < et(left)  */

	  ideri = eder[ii];


	  /* Compute the value and the ideri first derivatives of the
	     ik (possibly) nonzero B-spline associated with the knot
	     vector et at the point (taui) */

	  s1897 (et, ik, taui, left, ideri, ebder, &kstat);
	  if (kstat < 0)
	    goto error;

	  imnur = ii - nur;
	  lfmkm = left - ik;
	  for (jj = 0; jj < ik; jj++)
	    {
	      isum = jj + lfmkm + 1;
	      if (isum >= 0)
		kmod = isum % inbpnt;
	      if (isum < 0)
		kmod = (isum + 1) % inbpnt + in -1;
	      ew3[kmod * inlr + imnur] = ebder[jj];
	    }
	  if ((ideri < 0) || (ik <= ideri))
	    goto err160;
	}
    }
  if (inlr != (inbpnt - nur))
    goto err160;


  /* W is now contained in ew1, ew2 and ew3 as required
     by the subroutine s1898  */

  s1926 (ew1, nur, kk, ed, ew2, inrc, ew3, inlr, &kstat);
  if (kstat < 0)
    goto error;

  store = iright * dim * inbpnt;
  for (jj = 0; jj < store; jj++)
    ebcoef[jj] = epoint[jj];


  /* epoint is now properly contained in ebcoef.
   * Solve interpolation equations 		 */

  if (nn > s1925_MAX_ARRAY_SIZE)
    {
       if (alloc_needed)
	 {
	    if ((ebder = increasearray(ebder,nn,DOUBLE)) == SISL_NULL)
	      goto err101;
	 }
       else
	 {
	    if ((ebder = newarray(nn,DOUBLE)) == SISL_NULL)
	      goto err101;
	    alloc_needed = TRUE;
	 }
    }

  for (kl = 0; kl < iright; kl++)
    for (dim1 = 0; dim1 < dim; dim1++)
      {
	store = inbpnt * dim * kl + dim1;
	for (jj = 0; jj < nn; jj++, store += dim)
	  ebder[jj] = ebcoef[store];

	s1927 (ew1, nur, kk, ed, ew2, inrc, ew3, inlr, &mcoef, ebder, &kstat);
	if (kstat < 0)
	  goto error;

	store = inbpnt * dim * kl + dim1;
	for (jj = 0; jj < nn; jj++, store += dim)
	  ebcoef[store] = mcoef[jj];

        if(mcoef != SISL_NULL)       /* KYS 200594: healed memory leak */
        {
          freearray(mcoef);
          mcoef = SISL_NULL;
        }
      }

  goto out;


  /* Error in array allocations */

err101:
  *jstat = -101;
  s6err ("s1925", *jstat, kpos);
  goto out;

  /* Order of B-spline zero or negative */

err109:
  *jstat = -109;
  s6err ("s1925", *jstat, kpos);
  goto out;

  /* Error in dimension of interpolation problem */

err160:
  *jstat = -160;
  s6err ("s1925", *jstat, kpos);
  goto out;

  /* Error in lower level routine */

error:
  *jstat = kstat;
  s6err ("s1925", *jstat, kpos);
  goto out;

  /* Error in interpolation problem */

err165:
  *jstat = -165;
  s6err ("s1925", *jstat, kpos);
  goto out;

out:
  if (alloc_needed)
    freearray (ebder);
  if (mcoef != SISL_NULL)
    freearray (mcoef);
  return;
}


//===========================================================================
void s1891 (double etau[], double epoint[], int idim, int inbpnt, int iright,
	    int eder[], int iopen, double et[], double *ebcoef[], int *in,
	    int ik, int inlr, int inrc, int *jstat)
//===========================================================================
{
  int kstat = 0;
  int kpos = 0;			/* Position of error			*/
  int ii;			/* Loop control parameter		*/
  int limit1, limit2;		/* Loop parameters			*/
  int kj, kl;
  int kdum, stop;
  int nur;			/* Number of upper rows in W		*/
  int inlx;			/* Equal to inlr if inlr>0, else=1 	*/
  int inrx;			/* Equal to inrc if inrc>0, else=1	*/
  int edarray[s1891_MAX_SIZE];        /* Array for ed below                   */
  int alloc_needed=FALSE;
  int *ed = SISL_NULL;		/* Arrays defining elements of W	*/
  double *ewarray=SISL_NULL;         /* Array for ew1, ew2 and ew3           */
  double *ew1 = SISL_NULL;		/* See subroutine s1926			*/
  double *ew2 = SISL_NULL;
  double *ew3 = SISL_NULL;

  *jstat = 0;


  /* Test if legal input. */

  if (ik < 1 || idim < 1) goto err112;

  /* Indicate dimension of B-spline. */

  *in = inbpnt;
  if (iopen != SISL_CRV_OPEN)    *in +=ik - 1;

  *ebcoef = new0array (*in *idim * iright, DOUBLE);
  if (*ebcoef == SISL_NULL) goto err101;

  if ((nur = inbpnt - inlr) > s1891_MAX_SIZE)
    alloc_needed = TRUE;

  /* Allocate arrays ew1, ew2, ew3, ed. */

  inlx = MAX (1, inlr);
  inrx = MAX (1, inrc);
  limit1 = (ik * nur) + (inrx * nur) + (inlx * inbpnt);
  
  if ((ewarray = new0array(limit1 + 1,DOUBLE)) == SISL_NULL) goto err101;
  
  ew1 = ewarray;
  ew2 = ew1 + (ik * nur);
  ew3 = ew2 + (inrx * nur);

  if (alloc_needed)
    {
       if ((ed = new0array(nur,INT)) == SISL_NULL)
	 goto err101;
    }
  else
    ed = edarray;
  
  s1925 (etau, epoint, inbpnt, eder, et, *ebcoef,*in, ik, iright, 
	 idim, ew1, nur, ed, ew2, inrc, ew3, inlr, &kstat);
  if (kstat < 0) goto error;

  /* For closed B-spline curves we have:
   * ebcoef(i) = ebcoef(i+inbpnt) ; i=1,...,ik-1. */

  if (iopen != SISL_CRV_OPEN)
    {
      stop = ik - 1;
      for (kl = 0; kl < iright; kl++)
	{
	  kdum = *in *kl;
	  for (kj = 0; kj < stop; kj++)
	    {
	      limit2 = (kj + kdum) * idim;
	      limit1 = inbpnt * idim + limit2;
	      for (ii = 0; ii < idim; ii++)
		(*ebcoef)[limit1 + ii] = (*ebcoef)[limit2 + ii];
	    }
	}
    }

  goto out;

  /* Error in lower level routine */

  error:
    *jstat = kstat;
    s6err ("s1891", *jstat, kpos);
    goto out;

  /* Error in array allocations */

  err101:
    *jstat = -101;
    s6err ("s1891", *jstat, kpos);
    goto out;

  /* Error in description of B-spline */

  err112:
    *jstat = -112;
    s6err ("s1891", *jstat, kpos);
    goto out;

  out:
    if (alloc_needed)    freearray (ed);
    if (ewarray)         freearray (ewarray);
    return;
}

//===========================================================================
void s1890 (double oknots[], int oik, int oin, double *par[], int *der[], int *jstat)
//===========================================================================
{
  int kpos = 0;
  int count1, count2;		/* Loop control variables     */
  int start, stop;
  int numb;			/* Number of wrong parameters */

  double sum;			/* Sum of knot values         */
  double pvl;			/* Single parameter value     */
  double delta;			/* Used for correcting wrong
				 * parameter values           */

  *jstat = 0;


  /* Test if legal input. */

  if (oik <= 1 || oin < oik)
    goto err112;


  /* Test if input knot vector degenerate. */

  if (oknots[oik - 1] >= oknots[oin])
    goto err112;


  /* Allocate arrays par and der. */

  *par = newarray (oin, DOUBLE);
  if (*par == SISL_NULL)
    goto err101;
  *der = new0array (oin, INT);
  if (*der == SISL_NULL)
    goto err101;


  /* P R O D U C E  P A R A M E T E R   V A L U E S.
   * First we produce parameter values by a simple algorithm.
   * The parameter values calculated in a wrong way are then corrected. */

  (*par)[0]       = oknots[oik - 1];
  (*par)[oin - 1] = oknots[oin];
  
  for (count1 = 2; count1 < oin; count1++)
    {
      stop = count1 + oik;
      sum = (double) 0.0;
      for (count2 = count1; count2 <= stop; count2++)
	sum += oknots[count2 - 1];
      (*par)[count1 - 1] = sum / (oik + 1);
    }

  /* Find second distinct knot value. */

  pvl = oknots[oik - 1];
  for (count1 = oik; oknots[count1] <= pvl; count1++) ;


  /* Find number of parameter values with wrong value at start of curve. */

  pvl = (oknots[oik - 1] + oknots[count1]) / (double)2.0;
  for (numb = 0, start = 1; (*par)[start] <= pvl; start++, numb++) ;

  if (numb > 0)
    {
      delta = (pvl - (*par)[0]) / (numb + 1);

      /* Fill inn missing parameter values. */

      pvl = (*par)[0] + delta;

      for (count1 = 1; count1 <= numb; count1++)
	{
	  (*par)[count1] = pvl;
	  pvl += delta;
	}
    }

  /* Find last but one distinct knot value. */

  pvl = oknots[oin];
  for (count1 = oin - 1; oknots[count1] >= pvl; count1--) ;


  /* Find end parameters in wrong interval. */

  pvl = (oknots[count1] + oknots[oin + 1]) / (double) 2.0;
  for (numb = 0, stop = oin - 2; (*par)[stop] >= pvl; stop--, numb++) ;

  if (numb > 0)
    {
      delta = ((*par)[oin - 1] - pvl) / (numb + 1);
      pvl = (*par)[oin - 1] - delta;
      for (count1 = 1; count1 <= numb; count1++)
	{
	  (*par)[oin - 1 - count1] = pvl;
	  pvl -= delta;
	}
    }

  /* Make derivative indicators */

  /* We used new0array which initializes all elements with zeroes 
   * and then this code is redundant.
   *
   * for (count1 = 0; count1 < oin; count1++)
   *  (*der)[count1] = 0;
   */
  /* Knots produced */

  goto out;


  /* Not enough memory. */

err101:
  *jstat = -101;
  s6err ("s1890", *jstat, kpos);
  goto out;

  /* Error in description of B-spline. */

err112:
  *jstat = -112;
  s6err ("s1890", *jstat, kpos);
  goto out;

out:
  return;
}


//===========================================================================
void s1894 (double oknots[], int oik, int oin, int der1, int der2, double earray[],
	    int dimp1, int narr, double *nknots[], int *nik, int *nin, int *jstat)
//===========================================================================
{
  int size;			/* The total size of earray. */
  int mult;			/* Multiplicity of knots */
  int numb;			/* Number of new knots. */
  int kdim;			/* dimp1 -1  (sub-matrix dimension) */
  int empty;			/* Used to check if sub-matrix of earray
				   is zero. */
  int kl;			/* Loop control varibles. */
  int count1;
  int count2;
  int count3;
  int start;
  int stop;

  double eps;			/* Resolution. */
  double maximum;		/* The maximum value in et. */
  double prev;			/* Knot value. (extracted from orig) */
  double curr;			/* Knot value. (extracted from orig) */
  int kpos = 0;
  int der = max(der1, der2);

  *jstat = 0;
  

  /* Test if legal input. */

  if (oik <= 1 || oin < oik)
    goto err112;


  /* Test if knot vector degenerate. */

  if (oknots[oik - 1] >= oknots[oin])
    goto err112;


  /* The maximal number of knots to be produced at a specified knot value
   * is the order of the B-spline basis produced. */

  /* Allocate space for new knot vector */

  (*nknots) = newarray ((oin + oik) * oik, DOUBLE);
  if (*nknots == SISL_NULL)
    goto err101;


  /* Check if sub-matrix is zero. */

  kdim = dimp1 - 1;
  size = dimp1 * dimp1;
  empty = TRUE;

  for (count1 = 0; count1 < narr && empty; count1++)
    for (count2 = 0; count2 < kdim && empty; count2++)
      for (count3 = 0; count3 < kdim && empty; count3++)
	if (earray[count1 * size + count2 * dimp1 + count3] != (double)0.)
	  empty = FALSE;


  /* Assign value to nk. */

  if (empty)
    (*nik) = oik - min (der1, der2);
  else
    (*nik) = 2 * oik - der1 - der2 - 1;
  if ((*nik) < 2)
    (*nik) = 2;
  *nin = 0;


  /* Make resolution to be used for testing of knot value equalness. */

  eps = fabs (oknots[oin] - oknots[oik - 1]) * 1.0e-11;


  /* Production of knots. Initiate for calculation of knots.
     Find first knot not equal to start of curve. */

  maximum = oknots[oin];
  prev = oknots[oik - 1];
  for (kl = oik; prev >= oknots[kl]; kl++) ;

  curr = oknots[kl];
  for (mult = oik; curr < maximum; mult++)
    {
      if (curr < prev)
	goto err112;

      if (prev > curr || curr > prev + eps)
	{

	  /* New knot value found. Fill in old value. */

	   /* numb = (*nik) - oik + mult; */
	  numb = (*nik) - oik + mult + der;
	  if (numb > (*nik))
	    numb = (*nik);


	  /* If numb >= nik, test if all the numb knots are equal
	     or if they only are equal within the resolution eps.
	     If not totally equal knumb=nik-1. */

	  if (numb == (*nik))
	    {
	       /* start = max (kl - oik, 1);
	      stop = kl - 2;
	      for (count1 = start; count1 <= stop; count1++)
		if (oknots[count1 - 1] != oknots[count1])
		  numb = (*nik) - 1; */

	      start = kl - oik + der;
	      stop = kl - 2;
	      for (count1 = start; count1 <= stop; count1++)
		if (oknots[count1] != oknots[count1 + 1])
		  numb = (*nik) - 1;
	    }

	  if (prev == oknots[oik - 1])
	    numb = (*nik);
	  for (count1 = 1; count1 <= numb; count1++)
	    (*nknots)[(*nin)++] = prev;


	  /* Initialize multiplicity. */

	  mult = 0;
	  prev = curr;
	}
      kl++;
      curr = oknots[kl];
    }

  /* Knot for the next last knot value not produced. */

  /* numb = min ((*nik) - oik + mult, (*nik)); */
  numb = min ((*nik) - oik + mult + der, (*nik));


  /* If numb >= nik, test if all the numb knots are equal or if they
   * only are equal within the resolution eps. */

  /* I not totally equal numb=nik-1. */

  if (numb >= (*nik))
    {
       /* start = max (kl - oik, 1);
      stop = kl - 2;
      for (count1 = start; count1 <= stop; count1++)
	if (oknots[count1 - 1] != oknots[count1])
	  numb = (*nik) - 1; */

      start = kl - oik + der;
      stop = kl - 2;
      for (count1 = start; count1 <= stop; count1++)
	if (oknots[count1] != oknots[count1 + 1])
	  numb = (*nik) - 1;
    }

  for (count1 = 1; count1 <= numb; count1++)
    (*nknots)[(*nin)++] = prev;


  /* Knot at et[oin+1] not produced. */

  for (count1 = 1; count1 <= (*nik); count1++)
    (*nknots)[(*nin)++] = maximum;


  /* Knots produced. Correct nin and length of nknots. */

  (*nin) -= (*nik);
  *nknots = increasearray (*nknots, (*nik) + (*nin), DOUBLE);
  if (*nknots == SISL_NULL)
    goto err101;

  goto out;

  /* Not enough memory. */

err101:
  *jstat = -101;
  s6err ("s1894", *jstat, kpos);
  goto out;

  /* Error in description of B-spline. */

err112:
  *jstat = -112;
  s6err ("s1894", *jstat, kpos);
  goto out;

out:
  return;
}

//===========================================================================
void s1896 (SISLSurf * osurf, double earray[], int dimp1, int narr, int ders1[],
	    int dert1[], int ders2[], int dert2[], SISLSurf ** nsurf, int *jstat)
//===========================================================================
{
  int nik1;			/* Order of new surface in
				   first parameter direction. */
  int nin1;			/* Order of new surface in
				   second parameter direction. */
  int nik2;			/* Number of vertices in first
				   parameter direction. */
  int nin2;			/* Number of vertices in second parameter direction. */
  int lfs;			/* Interval indicator. (left side) */
  int lft;			/* Interval indicator. (left side) */
  int tpos;			/* Used to index array tau. */
  int epos;			/* Used to index earray. */
  int pos1;			/* Position of values of first derivatives. */
  int pos2;			/* Position of values of second derivatives. */
  int ds1;			/* Order of derivatives. */
  int dt1;
  int ds2;
  int dt2;
  int mds1;			/* Maximum order of derivatives. */
  int mdt1;
  int mds2;
  int mdt2;
  int nder1;			/* Total order of derivatives.
				   (Both directions) */
  int nder2;
  int dim;			/* Dimension of tau. */
  int maxder;			/* Largest total order of derivatives.
				   (Both functions.) */
  int count1;			/* Loop control variables. */
  int kj, ki;
  int kl, kr, kp;
  double parval[2];
  double sum;			/* Used for calculation of P(s,t). */
  double *nknots1 = SISL_NULL;	/* New knots in first parameter direction. */
  double *nknots2 = SISL_NULL;	/* New knots in second parameter direction. */
  double *coef1 = SISL_NULL;		/* New coeficients */
  double *coef2 = SISL_NULL;		/* New coeficients */
  double *par1 = SISL_NULL;		/* Parameter values in first direction. */
  double *par2 = SISL_NULL;		/* Parameter values in second direction. */
  int *der1 = SISL_NULL;		/* Derivative indicators in first direction. */
  int *der2 = SISL_NULL;		/* Derivative indicators in second direction.*/
  double *deriv = SISL_NULL;		/* Derivatives returned by s1421. */
  double *normal = SISL_NULL;	/* Normal returned by s1421. (not used) */
  double *val1 = SISL_NULL;		/* Values extracted from deriv. */
  double *val2 = SISL_NULL;		/* Values extracted from deriv. */
  double *tau = SISL_NULL;		/* Interpolation points. */
  int kstat = 0;
  int kpos = 0;

  *jstat = 0;

  /* Test if legal input. */

  if (osurf->ik1 <= 1 || osurf->in1 < osurf->ik1)
    goto err112;
  if (osurf->ik2 <= 1 || osurf->in2 < osurf->ik2)
    goto err112;

  /* Find minimal and maximal order of derivatives */

  ds1 = mds1 = ders1[0];
  dt1 = mdt1 = dert1[0];
  ds2 = mds2 = ders2[0];
  dt2 = mdt2 = dert2[0];

  for (count1 = 1; count1 < narr; count1++)
    {
      if (ds1 > ders1[count1])	ds1 = ders1[count1];
      if (dt1 > dert1[count1])	dt1 = dert1[count1];
      if (ds2 > ders2[count1])	ds2 = ders2[count1];
      if (dt2 > dert2[count1])	dt2 = dert2[count1];

      if (mds1 < ders1[count1])	mds1 = ders1[count1];
      if (mdt1 < dert1[count1])	mdt1 = dert1[count1];
      if (mds2 < ders2[count1])	mds2 = ders2[count1];
      if (mdt2 < dert2[count1]) mdt2 = dert2[count1];
    }

  /* Produce a knot vector in the first parameter direction. */

  s1894 (osurf->et1, osurf->ik1, osurf->in1, ds1, ds2, earray, dimp1, narr,
	 &nknots1, &nik1, &nin1, &kstat);
  if (kstat < 0) goto error;

  /* Produce a knot vector in second parameter direction. */

  s1894 (osurf->et2, osurf->ik2, osurf->in2, dt1, dt2, earray, dimp1, narr,
	 &nknots2, &nik2, &nin2, &kstat);
  if (kstat < 0) goto error;

  /* Produce parameter values and derivative indicators in first
   * parameter direction. */

  s1890 (nknots1, nik1, nin1, &par1, &der1, &kstat);
  if (kstat < 0) goto error;

  /* Produce parameter values and derivative indicators in second
   * parameter direction. */

  s1890 (nknots2, nik2, nin2, &par2, &der2, &kstat);
  if (kstat < 0) goto error;

  /* Allocate memory for point calculation. */

  val1 = newarray (dimp1, DOUBLE);
  if (val1 == SISL_NULL) goto err101;
  val2 = newarray (dimp1, DOUBLE);
  if (val2 == SISL_NULL) goto err101;
  tau = newarray (narr * nin1 * nin2, DOUBLE);
  if (tau == SISL_NULL) goto err101;
  maxder = max (max (mds1, mds2), max (mdt1, mdt2));
  deriv = newarray (osurf->idim * (maxder + 1) * (maxder + 2) / 2, DOUBLE);
  if (deriv == SISL_NULL) goto err101;
  normal = newarray (osurf->idim * (maxder + 1) * (maxder + 2) / 2, DOUBLE);
  if (normal == SISL_NULL) goto err101;

  /* Calculate interpolation points. */

  lfs = 0;
  lft = 0;
  tpos = 0;
  for (kj = 0; kj < nin2; kj++)
    {
      parval[1] = par2[kj];
      for (ki = 0; ki < nin1; ki++)
	{
	  parval[0] = par1[ki];
	  epos = 0;
	  for (kl = 0; kl < narr; kl++)
	    {
	      ds1 = ders1[kl];
	      dt1 = dert1[kl];
	      ds2 = ders2[kl];
	      dt2 = dert2[kl];

	      /* ds2 = dert2[kl];
	      dt2 = ders2[kl]; */

	      maxder = max (max (ds1, ds2), max (dt1, dt2));

	      s1421 (osurf, maxder, parval, &lfs, &lft, deriv, normal, &kstat);
	      if (kstat < 0) goto error;

	      nder1 = ds1 + dt1;
	      nder2 = ds2 + dt2;
	      pos1 = osurf->idim * (nder1 * (nder1 + 1) / 2 + dt1);
	      pos2 = osurf->idim * (nder2 * (nder2 + 1) / 2 + dt2);

	      for (count1 = 0; count1 < osurf->idim; count1++)
		{
		  val1[count1] = deriv[pos1++];
		  val2[count1] = deriv[pos2++];
		}
	      if (osurf->idim < dimp1)
		{
		  val1[osurf->idim] = (double) 1.0;
		  val2[osurf->idim] = (double) 1.0;
		  if (ds1 > 0 || dt1 > 0)
		    val1[osurf->idim] = (double) 0.0;
		  if (ds2 > 0 || dt2 > 0)
		    val2[osurf->idim] = (double) 0.0;
		}

	      /* Can now calculate a interpolation point. */

	      sum = (double) 0.0;
	      for (kr = 0; kr < dimp1; kr++, epos += dimp1)
		{
		  for (kp = 0; kp < dimp1; kp++)
		    sum += earray[epos + kp] * val1[kr] * val2[kp];
		  /* sum += earray[epos + kp] * val1[kp] * val2[kr]; */
		}
	      tau[tpos++] = sum;
	    }
	}
    }

  /* Calculate new surface description. */

  /* Interpolate in second parameter direction. */

  dim = narr * nin1;

  s1891 (par2, tau, dim, nin2, 1, der2, TRUE, nknots2, &coef1, &nin2,
	 nik2, 0, 0, &kstat);
  if (kstat < 0) goto error;

  /* Interpolate in first parameter direction. */

  s1891 (par1, coef1, narr, nin1, nin2, der1, TRUE, nknots1, &coef2,
	 &nin1, nik1, 0, 0, &kstat);
  if (kstat < 0) goto error;

  /* OK */

  *nsurf = newSurf (nin1, nin2, nik1, nik2, nknots1, nknots2,
		    coef2, osurf->ikind, narr, 2);
  if (*nsurf == SISL_NULL) goto err171;

  goto out;

  /* Not enough memory. */

err101:
  *jstat = -101;
  s6err ("s1896", *jstat, kpos);
  goto out;

  /* Could not create surface, */

err171:
  *jstat = -171;
  s6err ("s1896", *jstat, kpos);
  goto out;

  /* Error in description of B-spline. */

err112:
  *jstat = -112;
  s6err ("s1896", *jstat, kpos);
  goto out;

  /* Error in lower level routine. */

error:
  *jstat = kstat;
  s6err ("s1896", *jstat, kpos);
  goto out;

  /* Free pointers. */

out:
  if (coef1 != SISL_NULL)    freearray (coef1);
  if (val1 != SISL_NULL)     freearray (val1);
  if (val2 != SISL_NULL)     freearray (val2);
  if (par1 != SISL_NULL)     freearray (par1);
  if (par2 != SISL_NULL)     freearray (par2);
  if (der1 != SISL_NULL)     freearray (der1);
  if (der2 != SISL_NULL)     freearray (der2);
  if (normal != SISL_NULL)   freearray (normal);
  if (deriv != SISL_NULL)    freearray (deriv);
  if (tau != SISL_NULL)      freearray (tau);

  return;
}

//===========================================================================
void s1320 (SISLSurf * psurf, double earray[], int inarr,
	    int ratflag, SISLSurf ** rsurf, int *jstat)
//===========================================================================
{
  int kpos = 0;
  int kstat = 0;
  SISLSurf *ssurf = SISL_NULL;	/* Temperary SISL-surface. */
  int kdim;			/* Number of dimesions in psurf                     */
  int kdimp1;			/* Dimension of  earray should be kdim+1            */
  int lder[3];			/* Derivative indicator array                       */
  double *scoef = SISL_NULL;		/* Vertices of psurf (scaled in the rational case)  */
  double *rscoef = SISL_NULL;	/* pointer to vertices in the rational case         */
  int ikind;			/* kind of surface                                  */
  double wmin, wmax;		/* min. and max. weight values for rational surface */
  double scale;			/* factor used for scaling rational weights         */
  int i;			/* loop variable                                    */
  double *sarray = SISL_NULL;	/* Array for calculating denominator if used      */
  int knarr;			/* Number of parallel arrays to use.   */
  int nkind;			/* Kind of output surface (rsurf).    */
  SISLSurf *jsurf = SISL_NULL;       /* Temporary SISLSurf. */

  *jstat = 0;


  /* Make local pointers. */

  kdim = psurf->idim;
  ikind = psurf->ikind;

  /* Set dimension of kdimp1.  */

  kdimp1 = kdim + 1;


  /* Test input. */

  if (kdim < 1)
    goto err102;
  if (inarr < 1 || 3 < inarr)
    goto err172;


  /* rational surfaces is a special case. */

  if (ikind == 2 || ikind == 4)
    {
      kdim++;
      /* scale the coeffs so that min. weight * max. weight = 1. */

      rscoef = psurf->rcoef;
      wmin = rscoef[kdim-1];
      wmax = rscoef[kdim-1];

      for (i = kdim-1; i < psurf->in1 * psurf->in2 * kdim; i += kdim)
	{
	  if (rscoef[i] < wmin)
	    wmin = rscoef[i];
	  if (rscoef[i] > wmax)
	    wmax = rscoef[i];
	}

      scale = (double) 1.0 / sqrt (wmin * wmax);
      scoef = newarray (psurf->in1 * psurf->in2 * kdim, DOUBLE);
      if (scoef == SISL_NULL)
	goto err101;

      for (i = 0; i < psurf->in1 * psurf->in2 * kdim; i++)
	{
	  scoef[i] = rscoef[i] * scale;
	}
    }
  else
    {
      scoef = psurf->ecoef;
    }

  ssurf = newSurf (psurf->in1, psurf->in2, psurf->ik1, psurf->ik2,
		   psurf->et1, psurf->et2, scoef, 1, kdim, 1);
  if (ssurf == SISL_NULL)
    goto err171;

  if ((ikind == 2 || ikind == 4) && ratflag == 1)
    {
      /* Output surface will also be rational. */

      nkind = 2;

      /* Add an extra parallel array to pick up the weights
	 of the subsequent homogeneous vertices of rsurf. */

      knarr = inarr + 1;

      sarray = new0array (kdimp1 * kdimp1 * knarr, DOUBLE);
      if (sarray == SISL_NULL)
	goto err101;

      memcopy (sarray, earray, kdimp1 * kdimp1 * inarr, double);

      sarray[kdimp1 * kdimp1 * knarr - 1] = (double) 1.0;
    }
  else
    {
      nkind = 1;
      knarr = inarr;
      sarray = earray;
    }

  lder[0] = 0;
  lder[1] = 0;
  lder[2] = 0;

  /* Put surface into implicit surface */

  s1896 (ssurf, sarray, kdimp1, knarr, lder, lder, lder, lder, &jsurf, &kstat);
  if (kstat < 0)
    goto error;

  if ((ikind == 2 || ikind == 4) && ratflag == 1)
    {
      /* Output from s1896 is a dim+1 non-rational surface jsurf. */
      /* Convert homogeneous jsurf to rational rsurf. */

      *rsurf = newSurf(jsurf->in1,jsurf->in2,
                        jsurf->ik1,jsurf->ik2,
                        jsurf->et1,jsurf->et2,
                        jsurf->ecoef,
                        2,jsurf->idim-1,1);
      freeSurf(jsurf);
    }
  else
    {
      *rsurf = jsurf;
    }

  if (ikind == 2 || ikind == 4)
    {
      if (scoef)
	freearray (scoef);
      if (ratflag)
	freearray (sarray);
    }

  /* Ok. */

  goto out;


  /* Error in lower level function */

error:
  *jstat = kstat;
  s6err ("s1320", *jstat, kpos);
  goto out;

  /* allocation problems. */
err101:
  *jstat = -101;
  s6err ("s1320", *jstat, kpos);
  goto out;

  /* Dimension less than 1    */

err102:
  *jstat = -102;
  s6err ("s1320", *jstat, kpos);
  goto out;

  /* Could not create surface. */

err171:
  *jstat = -171;
  s6err ("s1320", *jstat, kpos);
  goto out;

  /* Dimension inarr not equal to 1,2 or 3 */

err172:
  *jstat = -172;
  s6err ("s1320", *jstat, kpos);
  goto out;

out:
  if (ssurf)
    freeSurf (ssurf);
  return;
}


//===========================================================================
void s1322(double epoint[],double edirec[],double aradiu,int idim,
	   int inumb,double carray[],int *jstat)
//===========================================================================
{
  int kdimp1;         /* Dimension of matrix kdimp1 = idim + 1         */
  int kdimp2;         /* idim + 2                                      */
  int kstop;          /* Stop condition for for loop                   */
  int ki,kj,kl;       /* Running variables in loop                     */
  int kpos=0;         /* Position of error                             */
  double twx,twy,twz; /* Local version of normalized direction vector  */
  double tx0,ty0,tz0; /* Local version of point on axis                */
  double temp;        /* Temporary storage variable                    */
  double tsum;        /* Varaible used for summation                   */
  double sdirec[3];   /* Normalized direction vector                   */


  /* Test i legal input */
  if (inumb <1 ) inumb = 1;
  if (idim != 3 ) goto err104;

  kdimp1 = idim + 1;
  kdimp2 = idim + 2;
  kstop  = kdimp1*kdimp1;

  for (ki=0;ki<kstop;ki++)
    {
      carray[ki] = DZERO;
    }

  /* Normalize direction vector */

  tsum = DZERO;

  for (ki=0;ki<idim;ki++)
    {
      temp = edirec[ki];
      tsum += (temp*temp);
    }

  tsum = sqrt(tsum);
  if (DEQUAL(tsum,DZERO)) goto err173;

  for (ki=0;ki<idim;ki++)
    {
      sdirec[ki] = edirec[ki]/tsum;
    }

  /* Make diagonal elements */

  for (ki=0,kl=0 ; ki<kstop-1 ; kl++,ki+=kdimp2)   /* (PFU 14/11-1994) */
    {
      temp = sdirec[kl];
      carray[ki] = (double)1.0 - temp*temp;
    }
  carray[ki] = (double) 1.0;  /* (PFU 14/11-1994) */

  /* Make element 1,...,idim of last row and 1,...,idim of last column */

  tsum = DZERO;
  twx = sdirec[0];
  twy = sdirec[1];
  twz = sdirec[2];
  tx0 = epoint[0];
  ty0 = epoint[1];
  tz0 = epoint[2];

  /* Make element (1,4) and (4,1) */

  temp = tx0*(twx*twx-(double)1.0) + twx*(ty0*twy+tz0*twz);

  carray[3]  = temp;
  carray[12] = temp;

  /* Make element (2,4) and (4,2) */

  temp = ty0*(twy*twy-(double)1.0) + twy*(tz0*twz+tx0*twx);

  carray[7]  = temp;
  carray[13] = temp;

  /* Make element (3,4) amd (4,3) */

  temp = tz0*(twz*twz-(double)1.0) + twz*(tx0*twx+ty0*twy);

  carray[11] = temp;
  carray[14] = temp;

  /* Make element (4,4) */

  temp = tx0*tx0*((double)1.0-twx*twx) + ty0*ty0*((double)1.0-twy*twy)
         + tz0*tz0*((double)1.0-twz*twz) - (double)2.0*tx0*ty0*twx*twy
         - (double)2.0*ty0*tz0*twy*twz - (double)2.0*tz0*tx0*twz*twx
	 - aradiu*aradiu;

  carray[15] = temp;

  /* Make element (1,2) and (2,1) */

  temp = -twx*twy;
  carray[1] = temp;
  carray[4] = temp;

  /* Make element (1,3) and (3,1) */

  temp = -twx*twz;
  carray[2] = temp;
  carray[8] = temp;

  /* Make element (2,3) and (3,2) */
  temp = -twy*twz;
  carray[6] = temp;
  carray[9] = temp;

  /* Make extra copies of cylinder */

  kj = kstop;
  for (ki=1;ki<inumb;ki++)
    {
      for (kl=0;kl<kstop;kl++,kj++)
        {
	  carray[kj] = carray[kl];
        }
    }

  *jstat = 0;
  goto out;

  /* Dimension less than 1 */
 err104: *jstat = -104;
  s6err("s1322",*jstat,kpos);
  goto out;

  /* Direction vector of length 0 */
 err173: *jstat = -173;
  s6err("s1322",*jstat,kpos);
  goto out;
 out:
  return;
}


//===========================================================================
void s1321(double ecentr[],double aradiu,int idim,int inumb, double carray[],int *jstat)
//===========================================================================
{
  int kdimp1;         /* Dimension of matrix kdimp1 = idim + 1         */
  int kdimp2;         /* idim + 2                                      */
  int kstop;          /* Stop condition for for loop                   */
  int ki,kj,kl;       /* Running variables in loop                     */
  int kpos=0;         /* Position of error                             */
  double temp;        /* Temporary storage variable                    */
  double tsum;        /* Varaible used for summation                   */
  
  
  
  /* Test i legal input */
  if (inumb <1 ) inumb = 1;
  if (idim < 1 ) goto err102;
  
  kdimp1 = idim + 1;
  kdimp2 = idim + 2;
  kstop  = kdimp1*kdimp1;
  
  for (ki=0;ki<kstop;ki++)
    {
      carray[ki] = (double)0.0;
    }
  
  /* Make diagonal elements */
  
  for (ki=0;ki<kstop;ki+=kdimp2)
    {
      carray[ki] = (double)1.0;
    }
  
  /* Make element 1,...,idim of last column and element 1,...,idim of last
   *  row */
  
  tsum = (double)0.0;
  for (kl=0,ki=idim,kj=idim*kdimp1;kl<idim;kl++,kj++,ki+=kdimp1)
    {
      temp = -ecentr[kl];
      carray[ki] = temp;
      carray[kj] = temp;
      tsum +=(temp*temp);                                                
    }
  
  /* Make lower right corner element */
  
  carray[kstop-1] = tsum - aradiu*aradiu;
  
  /* Make extra copies of hyper sphere */
  
  kj = kstop;
  for (ki=1;ki<inumb;ki++)
    {
      for (kl=0;kl<kstop;kl++,kj++)
        {
	  carray[kj] = carray[kl];
        }
    }
  
  *jstat = 0;
  goto out;
  
  /* Dimension less than 1 */
 err102: *jstat = -102;
  s6err("s1321",*jstat,kpos);
  goto out;
 out:
  return;
}


//===========================================================================
void sh6splitgeom_s9circle(double apt1[], double apt2[], double apt3[],
			   double aepsge, double ecentre[], double eaxis[],
			   double *crad, int *jstat)
//===========================================================================
{
   int kstat = 0;
   int ki;
   int kdim = 3;
   int lpiv[3];
   double snorm2[3];
   double smid1[3];
   double smid2[3];
   double sdiff1[3];
   double sdiff2[3];
   double smat[9];
   double sright[3];
   
   /* Compute difference vectors between the 1. and 2. and 2. and 3. point. */
   
   s6diff(apt1, apt2, kdim, sdiff1);
   s6diff(apt3, apt2, kdim, sdiff2);
   
   /* Compute the normal of the plane in which the circle lies. */
   
   s6crss(sdiff1, sdiff2, snorm2);
   
   /* Compute the normals to the planes normal to the first plane and
      perpendicular to the difference vectors. */
   
   /* s6crss(sdiff1, snorm2, snorm1);
   s6crss(sdiff2, snorm2, snorm3); */
   
   /* Check normals.  */
   
   if (s6norm(snorm2, kdim, snorm2, &kstat) < aepsge) goto warn1;
   
   /* Compute the midpoints of the difference vectors. */
   
   for (ki=0; ki<kdim; ki++)
   {
      smid1[ki] = (double)0.5*(apt1[ki] + apt2[ki]);
      smid2[ki] = (double)0.5*(apt2[ki] + apt3[ki]);
   }
   
   /* Set up equation system.  */

   memcopy(smat, snorm2, kdim, DOUBLE);
   memcopy(smat+kdim, sdiff1, kdim, DOUBLE);
   memcopy(smat+2*kdim, sdiff2, kdim, DOUBLE);
   
   sright[0] = s6scpr(apt2, snorm2, kdim);
   sright[1] = s6scpr(smid1, sdiff1, kdim);
   sright[2] = s6scpr(smid2, sdiff2, kdim);
   
   /* Solve equation system.  */
   
   s6lufacp(smat, lpiv, 3, &kstat);
   if (kstat < 0) goto error;
   
   s6lusolp(smat, sright, lpiv, 3, &kstat);
   if (kstat < 0) goto error;
   
   /* Prepare output.  */
   
   memcopy(eaxis, snorm2, kdim, DOUBLE);
   memcopy(ecentre, sright, kdim, DOUBLE);
   *crad = s6dist(ecentre, apt2, kdim);
   
   *jstat = 0; 
   goto out;
   
   /* Almost singular equation system.  */
   
   warn1 :
      *jstat = 1;
   goto out;
   
   /* Error in lower level routine.  */
   
   error :
      *jstat = kstat;
   goto out;
   
   out :
      return;
}


//===========================================================================
void sh6splitgeom (SISLSurf *ps1, SISLSurf *ps2, double aepsge, double ecentre[],
		   double eaxis[], double *cdist, double *crad, int *jstat)
//===========================================================================
{
   int kstat = 0;         /* Status variable.       */
   int ki,kj,k1,k2;       /* Counters.              */
   int kleft1=0, kleft2=0; /* Parameters to surface evaluator. */
   int kder=0;            /* Evaluate only position.           */
   int kdim=ps1->idim;    /* Dimension of geometry space.      */
   double tpi6=PI/(double)6;
   double tsign;          /* Sign of vector.        */
   double tdot;           /* Scalar product.        */
   double tang;           /* Angle between vectors. */
   double trad1, trad2;   /* Curvature radius.          */
   double tmaxrad;        /* Maximum radius of sphere/torus/cylinder. */
   double tminfac = (double)0.9; /* Minimum factor between radiuses 
				    for a sphere. */
   double spar1[2],spar2[2]; /* Paramater value in which to evaluate
				surfaces.                         */
   double sder1[18];      /* Value of 1. surface. */
   double snorm1[3];      /* Normal of 1. surface.  */
   double sder2[18];      /* Value of 2. surface. */
   double snorm2[3];      /* Normal of 2. surface.  */
   double scentre1[3];    /* Centre of first circle. */
   double scentre2[3];    /* Centre of second circle. */
   double svec[3];        /* Vector used to find midpoint of 
			     splitting geometry.    */
   double sdiff[3];       /* Difference vector between midpoints. */
   double sparc1[10];      /* Corner parameters of first surface. */
   double sparc2[10];      /* Parameters of closest points on second surface. */
   double scorn1[15];     /* Corners of first surface.           */
   double scorn2[15];     /* Closest points in the other surface. */
   SISLPoint *qp = SISL_NULL;  /* Representing a surface corner as a point. */
   double start2[2];      /* Start parameters of second surface.       */
   double send2[2];       /* End parameters of second surface.       */
   double sdist[4];       /* Distance between closest points.        */
   
   /* Test if the cones of the surfaces is less than pi, otherwise
      no attempt to find splitting geometry is made.  */
   
   if (ps1->pdir->igtpi != 0 || ps2->pdir->igtpi != 0)
   {
      *jstat = 0;
      goto out; 
   }
   
   /*   if (ps1->pdir->aang > tpi4 || ps2->pdir->aang > tpi4)
   {
    *jstat = 0;
      goto out; 
   } */
   
   /* Make sure that the cones lies in the same area, otherwise
      return.   */
   
   tdot = s6scpr(ps1->pdir->ecoef,ps2->pdir->ecoef,kdim);
   tsign = (tdot >= DZERO) ? (double)1.0 : -(double)1.0;
   
   tang = s6ang(ps1->pdir->ecoef,ps2->pdir->ecoef,kdim);
   if (tang > tpi6)
   {
      *jstat = 0;
      goto out; 
   } 
   
   /* Check that the surfaces is not too large, i.e. contain to many
      vertices to be put into a sphere- or cylinder equation effectively. */
   
   if (ps1->in1 > 2*ps1->ik1 || ps1->in2 > 2*ps1->ik2 ||
       ps2->in1 > 2*ps2->ik1 || ps2->in2 > 2*ps2->ik2)
   {
      *jstat = 0;
      goto out; 
   } 
   
   /* Compute the midvector between the axises of the surface cones. */
   
   for (ki=0; ki<kdim; ki++)
      svec[ki] = (double)0.5*(tsign*ps1->pdir->ecoef[ki] + ps2->pdir->ecoef[ki]);
   (void)s6norm(svec,kdim,svec,&kstat);
   if (!kstat)
   {
      *jstat = 0;
      goto out; 
   }
   
   /* Set maximum radius. */
   
   tmaxrad = ps1->pbox->e2max[2][0] - ps1->pbox->e2min[2][0];
   tmaxrad = MAX(tmaxrad, ps1->pbox->e2max[2][1]-ps1->pbox->e2min[2][1]);
   tmaxrad = MAX(tmaxrad, ps1->pbox->e2max[2][2]-ps1->pbox->e2min[2][2]);
   tmaxrad *= (double)10.0;
   
   /* Set parameter bourders of second surface. */
   
   start2[0] = *(ps2->et1 + ps2->ik1 - 1);
   start2[1] = *(ps2->et2 + ps2->ik2 - 1);
   send2[0] = *(ps2->et1 + ps2->in1);
   send2[1] = *(ps2->et2 + ps2->in2);
   
   /* Evaluate the surfaces in their midpoints up to 2. order
      derivatives.                                             */
   
   spar1[0] = (double)0.5*(ps1->et1[ps1->ik1-1] + ps1->et1[ps1->in1]);
   spar1[1] = (double)0.5*(ps1->et2[ps1->ik2-1] + ps1->et2[ps1->in2]);
      
   s1421(ps1,kder,spar1,&kleft1,&kleft2,sder1,snorm1,&kstat);
   if (kstat < 0) goto error;
   
   spar2[0] = (double)0.5*(ps2->et1[ps2->ik1-1] + ps2->et1[ps2->in1]);
   spar2[1] = (double)0.5*(ps2->et2[ps2->ik2-1] + ps2->et2[ps2->in2]);
      
   s1421(ps2,kder,spar2,&kleft1,&kleft2,sder2,snorm2,&kstat);
   if (kstat < 0) goto error;
   
   /* Check if the difference vector between the midpoints point in 
      about the same direction as the vector svec.  */
   
   s6diff(sder1, sder2, kdim, sdiff);
   tang = s6ang(sdiff, svec, kdim);
   if (tang < tpi6 || tang > (double)5.0*tpi6)
   {
      /* Set up parameter values for evaluation of first surface in
	 the midpoint and in the midpoints of each edge curve.       */
      
      memcopy(sparc1, spar1, 2, DOUBLE);
      sparc1[3] = *(ps1->et2+ps1->ik2-1);
      sparc1[4] = *(ps1->et1+ps1->in1);
      sparc1[7] = *(ps1->et2+ps1->in2);
      sparc1[8] = *(ps1->et1+ps1->ik1-1);
      sparc1[2] = sparc1[6] = spar1[0];
      sparc1[5] = sparc1[9] = spar1[1];
      
      for (ki=0; ki<5; ki++)
      {
	 /* Evaluate point.  */
	 
	 if (ki == 0)
	    memcopy(scorn1, sder1, kdim, DOUBLE);
	 else
	 {
	    s1421(ps1, 0, sparc1+2*ki, &kleft1, &kleft2, scorn1+ki*kdim,
		  snorm1, &kstat);
	    if (kstat < 0) goto error;
	 }
	 
	 /* Find the closest point in the other surface. First express
	    the corner as a SISLPoint. */
	 
	 if ((qp = newPoint(scorn1+ki*kdim, kdim, 1)) == SISL_NULL) goto err101;
	 s1773(qp, ps2, aepsge, start2, send2, spar2, sparc2+2*ki, &kstat);
	 if (kstat < 0) goto error;
	 
	 /* Evaluate surface. */
	 
	 s1421(ps2, 0, sparc2+2*ki, &kleft1, &kleft2, scorn2+ki*kdim,
	       snorm2, &kstat);
	 if (kstat < 0) goto error;
	 
	 /* Compute midpoint. */

	 for (kj=0; kj<kdim; kj++)
	    scorn1[ki*kdim+kj] = (double)0.5*(scorn1[ki*kdim+kj] + scorn2[ki*kdim+kj]);
	    
	 if (qp != SISL_NULL) freePoint(qp); qp = SISL_NULL;
      }
      
      /* Estimate circles.  */
      
      sh6splitgeom_s9circle(scorn1+kdim, scorn1, scorn1+3*kdim,
			    aepsge, scentre1, snorm1, &trad1, &kstat);
      if (kstat < 0) goto error;
      if (kstat > 0)
	 *jstat = 1;  /* Find plane. */

      sh6splitgeom_s9circle(scorn1+4*kdim, scorn1, scorn1+2*kdim,
			    aepsge, scentre2, snorm2, &trad2, &kstat);
      if (kstat < 0) goto error;
      if (kstat > 0)
	 *jstat = 1;  /* Find plane. */
      
      /* Find kind of splitting geometry.  */
      
      if (*jstat == 1 || (trad1 > tmaxrad && trad2 > tmaxrad))
      {
	 /* Set plane geometry. */
	 
	 *jstat = 1;
	 memcopy(ecentre, scorn1, kdim, DOUBLE);
	 s6diff(scorn1+2*kdim, scorn1, kdim, scorn1+2*kdim);
	 s6diff(scorn1+3*kdim, scorn1, kdim, scorn1+3*kdim);
	 s6crss(scorn1+2*kdim, scorn1+3*kdim, eaxis);
      }
      else if (MAX(trad1,trad2) > tmaxrad)
      {
	 /* Set cylinder geometry.  */
	 
	 *jstat = 3;
	 *crad = MIN(trad1, trad2);
	 if (trad1 < trad2)
	 {
	    memcopy(ecentre, scentre1, kdim, DOUBLE);
	    memcopy(eaxis, snorm1, kdim, DOUBLE);
	 }
	 else
	 {
	    memcopy(ecentre, scentre2, kdim, DOUBLE);
	    memcopy(eaxis, snorm2, kdim, DOUBLE);
	 }
      }
      else if (MIN(trad1,trad2)/MAX(trad1,trad2) > tminfac)
      {
	 /* Set sphere geometry. */
	 
	 *jstat = 2;
	 *crad = (double)0.5*(trad1 + trad2);
	 for (kj=0; kj<kdim; kj++) 
	    ecentre[kj] = (double)0.5*(scentre1[kj] + scentre2[kj]);
      }
      else if (MAX(trad1,trad2)/MIN(trad1,trad2) > (double)25.0)
      {
	 /* Little chance of success in interception. */
	 
	 *jstat = 0;
	 goto out;
      }
      else
      {
	 /* Set torus geometry.  */
	 
	 *jstat = 4;
	 *crad = MIN(trad1, trad2);
	 *cdist = MAX(trad1, trad2) - (*crad);
	 *crad = MIN(trad1, trad2);
	 if (trad1 < trad2)
	 {
	    memcopy(ecentre, scentre2, kdim, DOUBLE);
	    memcopy(eaxis, snorm2, kdim, DOUBLE);
	 }
	 else
	 {
	    memcopy(ecentre, scentre1, kdim, DOUBLE);
	    memcopy(eaxis, snorm1, kdim, DOUBLE);
	 }
	     
      }
   }
   else if (tang > (double)2.0*tpi6 && tang < (double)4.0*tpi6)
   {
      /* Try to find a circle splitting the edge curves of the surfaces,
	 and extend this circle to a cylinder. First find closest edgecurves
	 by feching the corners of the first surface and finding the closest
	 points in the other surface. */
      
      sparc1[6] = sparc1[0] = *(ps1->et1+ps1->ik1-1);
      sparc1[2] = sparc1[4] = *(ps1->et1+ps1->in1);
      sparc1[1] = sparc1[3] = *(ps1->et2+ps1->ik2-1);
      sparc1[5] = sparc1[7] = *(ps1->et2+ps1->in2);
      
      for (ki=0; ki<4; ki++)
      {
	 /* Evaluate corner.  */
	 
	 s1421(ps1, 0, sparc1+2*ki, &kleft1, &kleft2, scorn1+ki*kdim,
	       snorm1, &kstat);
	 if (kstat < 0) goto error;
	 
	 /* Find the closest point in the other surface. First express
	    the corner as a SISLPoint. */
	 
	 if ((qp = newPoint(scorn1+ki*kdim, kdim, 1)) == SISL_NULL) goto err101;
	 s1773(qp, ps2, aepsge, start2, send2, spar2, sparc2+2*ki, &kstat);
	 if (kstat < 0) goto error;
	 
	 /* Evaluate surface. */
	 
	 s1421(ps2, 0, sparc2+2*ki, &kleft1, &kleft2, scorn2+ki*kdim,
	       snorm2, &kstat);
	 if (kstat < 0) goto error;
	 
	 /* Compute distance. */
	 
	 sdist[ki] = s6dist(scorn1+ki*kdim, scorn2+ki*kdim, kdim);
	 
	 if (qp != SISL_NULL) freePoint(qp); qp = SISL_NULL;
      }
      
      /* Check if the two closest points lies on a common edge. */
      
      if (sdist[0] < MIN(sdist[1],sdist[2]) && 
	  sdist[3] < MIN(sdist[1],sdist[2]))
      {
	 k1 = 0; k2 = 3;
      }
      else if (sdist[1] < MIN(sdist[0],sdist[3]) && 
	       sdist[2] < MIN(sdist[0],sdist[3]))
      {
	 k1 = 1; k2 = 2;
      }
      else if (sdist[0] < MIN(sdist[2],sdist[3]) && 
	       sdist[1] < MIN(sdist[2],sdist[3]))
      {
	 k1 = 0; k2 = 1;
      }
      else if (sdist[2] < MIN(sdist[0],sdist[1]) && 
	       sdist[3] < MIN(sdist[0],sdist[1]))
      {
	 k1 = 2; k2 = 3;
      }
      else
      {
	 *jstat = 0;
	 goto out;
      }
      
      /* Compute closest point to the midpoint between the two closest
	 corners.                                                       */
      
      sparc1[8] = (double)0.5*(sparc1[2*k1] + sparc1[2*k2]);
      sparc1[9] = (double)0.5*(sparc1[2*k1+1] + sparc1[2*k2+1]);
      
      /* Evaluate point.  */
      
      s1421(ps1, 0, sparc1+8, &kleft1, &kleft2, scorn1+4*kdim,
	    snorm1, &kstat);
      if (kstat < 0) goto error;
      
      /* Find the closest point in the other surface. First express
	 the corner as a SISLPoint. */
      
      if ((qp = newPoint(scorn1+4*kdim, kdim, 1)) == SISL_NULL) goto err101;
      s1773(qp, ps2, aepsge, start2, send2, spar2, sparc2+8, &kstat);
      if (kstat < 0) goto error;
      
      if (qp != SISL_NULL) freePoint(qp); qp = SISL_NULL;
      
      /* Evaluate surface. */
      
      s1421(ps2, 0, sparc2+8, &kleft1, &kleft2, scorn2+4*kdim,
	    snorm2, &kstat);
      if (kstat < 0) goto error;

      /* Find middle points between the sets of closest points. */
      
      for (ki=0; ki<kdim; ki++)
      {
	 scorn1[k1*kdim+ki] = (double)0.5*(scorn1[k1*kdim+ki] + scorn2[k1*kdim+ki]);
	 scorn1[k2*kdim+ki] = (double)0.5*(scorn1[k2*kdim+ki] + scorn2[k2*kdim+ki]);
	 scorn1[4*kdim+ki] = (double)0.5*(scorn1[4*kdim+ki] + scorn2[4*kdim+ki]);
      }
      
      /* Compute splitting cylinder. */
      
      sh6splitgeom_s9circle(scorn1+k1*kdim, scorn1+4*kdim, scorn1+k2*kdim,
			    aepsge, ecentre, eaxis, crad, &kstat);
      if (kstat < 0) goto error;
      if (kstat > 0 || *crad > tmaxrad)
      {
	 /* Make plane. */
	    
	 *jstat = 1;
	 memcopy(ecentre, scorn1+4*kdim, kdim, DOUBLE);
	 s6diff(scorn1+k1*kdim, scorn1+4*kdim, kdim, scorn1+k1*kdim);
	 s6diff(scorn1+k2*kdim, scorn1+4*kdim, kdim, scorn1+k2*kdim);
	 s6crss(scorn1+k1*kdim, scorn1+k2*kdim, eaxis);
      }
      else
	 
	 /* Output cylinder. */
	 
	 *jstat = 3;
   }
   else *jstat = 0;
   
   goto out;
   
   err101 : *jstat = -101;
   goto out;
   
   error : *jstat = kstat;
   goto out;
   
   out :
      return;
}

//===========================================================================
void sh6findsplit (SISLSurf *ps1, SISLSurf *ps2, double aepsge, int *jstat)
//===========================================================================
{
   int kstat = 0;   /* Local status variable.  */
   int kdim = ps1->idim;  /* Dimension of space. */
   int ratflag = 0; /* Indicates if surface is rational. */
   double tepsge;   /* Local tolerance.        */
   double tdist;    /* Large radius of torus.  */
   double trad;     /* Radius of sphere, cylinder or torus. */
   double scentre[3];  /* Centre of splitting geometry.     */
   double saxis[3];    /* Axis of splitting geometry.       */
   double simpli[16];   /* Array containing torus info.      */
   double splitgeom[16];         /* Matrix description of a sphere
				    or cylinder.                   */
   SISLSurf *qs1 = SISL_NULL; /* 1D surface.                     */
   SISLSurf *qs2 = SISL_NULL; /* 1D surface.                     */
      
   /* Still overlap. Try to find splitting geometry object. */
   
   sh6splitgeom(ps1, ps2, aepsge, scentre, saxis, &tdist,
		&trad, &kstat);
   if (kstat < 0) goto error;
   
   /* 
   if (kstat == 0) nmb0++;
   else if (kstat == 1) nmb1++;
   else if (kstat == 2) nmb2++; 
   else if (kstat == 3) nmb3++; 
   else if (kstat == 4) nmb4++; 
 */
   
   /* If kstat = 0 is returned, no splitting geometry is found,
      and no further interception is to be tried.  */
   
   if (kstat > 0)
   {
      if (kstat == 1)
      {
	 /* The splitting geometry is a plane. Set the two surfaces
	    into the plane equation.  */
	 
	 s1329 (ps1, scentre, saxis, kdim, &qs1, &kstat);
	 if (kstat < 0)
	    goto error;
	 s1329 (ps2, scentre, saxis, kdim, &qs2, &kstat);
	 if (kstat < 0)
	    goto error;
	 
	 
	 /* Set local tolerance.  */
	 
	 tepsge = aepsge;
      }
      else if (kstat == 2 || kstat == 3)
      {
	 if (kstat == 2)
	 {
	    /* The splitting geometry object is a sphere.  
	       Make a matrix of dimension (idim+1)x(idim+1) describing a hyper
	       sphere as an implicit function.      	      */
	    
	    s1321(scentre,trad,kdim,1,splitgeom,&kstat);
	    if (kstat < 0) goto error;
	    
	 }
	 else if (kstat == 3)
	 {
	    /* The splitting geometry object is a cylinder.
	       Make a matrix of dimension (idim+1)x(idim+1) describing a 
	       cylinder as an implicit function.           */
	    
	    s1322(scentre,saxis,trad,kdim,1,splitgeom,&kstat);
	    if (kstat < 0) goto error;
	 }
	 /* 
	 * Put the description of the surfaces into the implicit
	 * equation for the sphere or cylinder.
	 * ----------------------------------------------------------
	 */
	 
	 ratflag = (ps1->ikind == 2 || ps1->ikind == 4) ? 1 : 0;
	 s1320(ps1,splitgeom,1,ratflag,&qs1,&kstat);
	 if (kstat < 0) goto error;
	 
	 ratflag = (ps2->ikind == 2 || ps2->ikind == 4) ? 1 : 0;
	 s1320(ps2,splitgeom,1,ratflag,&qs2,&kstat);
	 if (kstat < 0) goto error;
	 
	 /* Set up local tolerance. */
	 
	 tepsge = (double)2.0*trad*aepsge;
      }
      else if (kstat == 4)
      {
	 /* Set surfaces into torus equation. */
	 
	 /* 
	 * Put the information concerning the torus in the following sequence
	 * into simpli: Center, normal, big radius, small radius 
	 * ------------------------------------------------------------------
	 */
	 
	 memcopy(simpli,scentre,3,DOUBLE);
	 memcopy(simpli+3,saxis,3,DOUBLE);
	 simpli[6] = tdist;
	 simpli[7] = trad;
	 
	 /* 
	 * Put surfaces into torus equation 
	 * -------------------------------
	 */ 
	 
	 s1378(ps1,simpli,1001,kdim,&qs1,&kstat);
	 if (kstat<0) goto error;
	 
	 s1378(ps2,simpli,1001,kdim,&qs2,&kstat);
	 if (kstat<0) goto error;
	 
	 /* Set up local tolerance. */
	 
	 tepsge = (double)8.0*aepsge*trad*tdist*tdist;
      }	 
	 
      
      /* Make box of first 1D surface. */
      
      sh1992su(qs1,2,tepsge,&kstat);
      if (kstat < 0) goto error;
      
      /* Make box of second 1D surface. */
      
      sh1992su(qs2,2,tepsge,&kstat);
      if (kstat < 0) goto error;
      
      /* Check if the boxes overlap.  */
      
      if (qs1->pbox->e2min[2][0] > qs2->pbox->e2max[2][0] ||
	  qs1->pbox->e2max[2][0] < qs2->pbox->e2min[2][0])
      {
	 /* 
	 nmbsuccess++; 
	 */
	 
	 /* No intersection is possible.  */
	 
	 *jstat = 0;
      }
      else *jstat = 1;  /* Mark possibility of intersection.  */
   }
   else *jstat = 1;  /* Mark possibility of intersection.  */

   goto out;
   
   error : *jstat = kstat;
   goto out;
   
   out:
      if (qs1) freeSurf(qs1);
      if (qs2) freeSurf(qs2);
      
      return;
}


//===========================================================================
void sh1834_s9mat3d(double emat[],double edir1[],double edir2[])
//===========================================================================
{
  int kstat = 0;    /* Local status variable.                         */
  double snorm[3];  /* Cross-product of edir1 and edir2.              */
  double sdir[3];   /* Normalized vertion of edir1.                   */
  double *s1;       /* Pointer into emat array.                       */
  double tleng1,tleng2; /* Length of snorm and edir1 respectively.    */
  double ta1,ta2,ta3,tb1,tb2,tb3,td1,td2,tl1,tl2,tl3; /* Help variables. */

  /* Calculate cross-product of edir1 and edir2.  */

  s6crss(edir1,edir2,snorm);

  /* Normalize snorm.  */

  tleng1 = s6norm(snorm,3,snorm,&kstat);

  /* Normalize edir1.  */

  tleng2 = s6norm(edir1,3,sdir,&kstat);

  /* Initialize help variables.  */

  ta1 = snorm[0];
  ta2 = snorm[1];
  ta3 = snorm[2];
  tl1 = sqrt(ta2*ta2+ta3*ta3);

  /* Set up rotation matrix.  */

  if ((DEQUAL(tleng1,DZERO) || DEQUAL(tl1,DZERO)) && DEQUAL(tleng2,DZERO))

    /* The rotation matrix is the identity matrix.  */

    emat[0] = emat[4] = emat[8] = (double)1.0;
  else if (DEQUAL(tleng1,DZERO) || DEQUAL(tl1,DZERO))
    {

      /* The rotation matrix is supposed to rotate edir1 to be parallell
	 to the x-axis.                                                   */

      tb1 = sdir[0];
      tb2 = sdir[1];
      tb3 = sdir[2];
      tl3 = sqrt(tb1*tb1+tb2*tb2);

      if (DEQUAL(tl3,DZERO)) emat[0] = emat[4] = emat[8] = (double)1.0;
      else
	{
	  s1      = emat;
	  *(s1++) = tb1;
	  *(s1++) = tb2;
	  *(s1++) = tb3;
	  *(s1++) = -tb2/tl3;
	  *(s1++) = tb1/tl3;
	  *(s1++) = DZERO;
	  *(s1++) = -tb1*tb3/tl3;
	  *(s1++) = -tb2*tb3/tl3;
	  *(s1++) = tl3;
	}
    }
  else
    {
      td1 = edir1[0]/tl1;
      td2 = (ta3*edir1[1] - ta2*edir1[2])/tl1;
      tl2 = sqrt(td1*td1+td2*td2);

      if (DEQUAL(tl2,DZERO))
	{

	  /* The normal snorm is rotated to be parallell to the z-axis. */

	  s1      = emat;
	  *(s1++) = tl1;
	  *(s1++) = -ta1*ta2/tl1;
	  *(s1++) = -ta1*ta3/tl1;
	  *(s1++) = DZERO;
	  *(s1++) = ta3/tl1;
	  *(s1++) = -ta2/tl1;
	  *(s1++) = ta1;
	  *(s1++) = ta2;
	  *(s1++) = ta3;
	}
      else
	{

	  /* The normal is rotated to be parallell to the z-axis and edir1
	     to be parallell to the x-axis.                                 */

	  s1      = emat;
	  *(s1++) = td1*tl1/tl2;
	  *(s1++) = (-ta1*ta2*td1 + ta3*td2)/(tl1*tl2);
	  *(s1++) = (-ta1*ta3*td1 - ta2*td2)/(tl1*tl2);
	  *(s1++) = -td2*tl1/tl2;
	  *(s1++) = (ta1*ta2*td2 + ta3*td1)/(tl1*tl2);
	  *(s1++) = (ta1*ta3*td2 - ta2*td1)/(tl1*tl2);
	  *(s1++) = ta1;
	  *(s1++) = ta2;
	  *(s1++) = ta3;
	}
    }
}


//===========================================================================
void sh1834_s9mat2d(double emat[],double edir[])
//===========================================================================
{
  int kstat = 0;   /* Local status variable.              */
  double tlength;  /* Length of vector edir.              */
  double sdir[2];  /* Normalized vertion of vector edir.  */

  tlength = s6norm(edir,2,sdir,&kstat);
  if (kstat == 0)

    /* Length of edir equal to zero. Let the rotation matrix be
       the identity matrix.                                      */

    emat[0] = emat[3] = (double)1.0;
  else
    {

      /* Make rotation matrix.  */

      emat[0] = sdir[0];
      emat[1] = sdir[1];
      emat[2] = sdir[1];
      emat[3] = -sdir[0];
    }
}

//===========================================================================
void sh1834(SISLObject *po1,SISLObject *po2,double aepsge,int idim,
	    double edir1[],double edir2[],int *jstat)
//===========================================================================
{
  int kstat = 0;   /* Local status variable.                     */
  int kpos = 0;    /* Position of error.                         */
  int kinnerexp = 12; /* Expand box in the inner. No rotation.   */
  int kn1=0,kn2=0;     /* Number of coefficients of objects.     */
  double *sc1,*sc2;/* Pointers to coefficients of objects.       */
  double *scoef1=SISL_NULL;  /* Rotated coefficients of first object. */
  double *scoef2=SISL_NULL;  /* Rotated coefficients of second object.*/
  double *smat=SISL_NULL;    /* Rotation matrix.                      */
  double *s1,*s2,*s3,*s4,*s5;  /* Pointers used to traverse arrays. */
  SISLObject *qo1=SISL_NULL; /* First object after rotation.          */
  SISLObject *qo2=SISL_NULL; /* Second object after rotation.         */
  /*  long time_before;
  long time_used=0; */

  double *rc1,*rc2;     /* Pointers to homogeneous coefficients. */
  double *rcoef1=SISL_NULL;  /* Possibly homogeneous coefficients.    */
  double *rcoef2=SISL_NULL;  /* Possibly homogeneous coefficients.    */
  int ikind1=0, ikind2=0;   /* Kinds of objects 1 and 2.         */
  int i,i1,i2,j,k;      /* Loop variables.                       */

  /* Test input.  */

  if (idim != 2 && idim != 3) goto err105;

  /* Fetch coefficients of the objects. */

  if (po1->iobj == SISLCURVE)
  {
     kn1 = po1->c1->in;
     sc1 = po1->c1->ecoef;
     rc1 = po1->c1->rcoef;
     ikind1 = po1->c1->ikind;
  }
  else if (po1->iobj == SISLSURFACE)
  {
     kn1 = po1->s1->in1*po1->s1->in2;
     sc1 = po1->s1->ecoef;
     rc1 = po1->s1->rcoef;
     ikind1 = po1->s1->ikind;
  }
  else
  {
     kn1 = 1;
     sc1 = po1->p1->ecoef;
     rc1 = SISL_NULL;
     ikind1 = 1;
  }

  if (po2->iobj == SISLCURVE)
  {
     kn2 = po2->c1->in;
     sc2 = po2->c1->ecoef;
     rc2 = po2->c1->rcoef;
     ikind2 = po2->c1->ikind;
  }
  else if (po2->iobj == SISLSURFACE)
  {
     kn2 = po2->s1->in1*po2->s1->in2;
     sc2 = po2->s1->ecoef;
     rc2 = po2->s1->rcoef;
     ikind2 = po2->s1->ikind;
  }
  else
  {
     kn2 = 1;
     sc2 = po2->p1->ecoef;
     rc2 = SISL_NULL;
     ikind2 = 1;
  }

  /* Allocate space for local parameters.  */

  if ((scoef1 = newarray(idim*kn1,DOUBLE)) == SISL_NULL) goto err101;
  if ((scoef2 = newarray(idim*kn2,DOUBLE)) == SISL_NULL) goto err101;
  if ((smat = new0array(idim*idim,DOUBLE)) == SISL_NULL) goto err101;

  /* Find the rotation matrix.  */

  if (idim == 2)

    /* After normalization edir1[0] will contain the cosine of the
       rotation angle and edir1[1] will contain the sine.           */

     sh1834_s9mat2d(smat,edir1);
  else

    /* Set up the rotation matrix when idim = 3. (edir1 x edir2) is
       rotated to be parallell to the z-axis and edir1 to be parallell
       to the x-axis.                                                   */

  sh1834_s9mat3d(smat,edir1,edir2);

  /* The objects is moved into the new coordinate system by rotating
     them using the rotation matrix.                                 */

  /* Rotate first object. */

    for (s2=sc1,s4=s2+idim*kn1,s5=scoef1; s2<s4; s2+=idim)
     for (s1=smat,s3=smat+idim*idim; s1<s3; s1+=idim,s5++)
	*s5 = s6scpr(s1,s2,idim);

  /* Rotate second object. */

  for (s2=sc2,s4=s2+idim*kn2,s5=scoef2; s2<s4; s2+=idim)
     for (s1=smat,s3=smat+idim*idim; s1<s3; s1+=idim,s5++)
	*s5 = s6scpr(s1,s2,idim);

  /* Make rotated objects.  */

  if ((qo1 = newObject(po1->iobj)) == SISL_NULL) goto err101;
  if ((qo2 = newObject(po2->iobj)) == SISL_NULL) goto err101;

  if(ikind1 == 2 || ikind1 == 4)
  {
      if ((rcoef1 = newarray((idim+1)*kn1,DOUBLE)) == SISL_NULL) goto err101;
      for(i=0,i1=0,i2=0; i<kn1; i++)
      {
	  k = i1 + idim;
	  for(j=0; j<idim; j++, i1++, i2++)
	  {
	      rcoef1[i1] = scoef1[i2] * rc1[k];
	  }
	  rcoef1[i1] = rc1[k];
	  i1++;
      }
  }
  else
  {
      rcoef1 = scoef1;
  }

  if(ikind2 == 2 || ikind2 == 4)
  {
      if ((rcoef2 = newarray((idim+1)*kn2,DOUBLE)) == SISL_NULL) goto err101;
      for(i=0,i1=0,i2=0; i<kn2; i++)
      {
	  k = i1 + idim;
	  for(j=0; j<idim; j++, i1++, i2++)
	  {
	      rcoef2[i1] = scoef2[i2] * rc2[k];
	  }
	  rcoef2[i1] = rc2[k];
	  i1++;
      }
  }
  else
  {
      rcoef2 = scoef2;
  }


  if (po1->iobj == SISLCURVE)
  {
     if ((qo1->c1 = newCurve(po1->c1->in,po1->c1->ik,po1->c1->et,
			     rcoef1,po1->c1->ikind,idim,0)) == SISL_NULL)
	goto err101;
     /* printf("Rotated box test. Curve - "); */
  }
  else if (po1->iobj == SISLSURFACE)
  {
     if ((qo1->s1 = newSurf(po1->s1->in1,po1->s1->in2,po1->s1->ik1,
			    po1->s1->ik2,po1->s1->et1,po1->s1->et2,
			     rcoef1,po1->s1->ikind,idim,0)) == SISL_NULL)
	goto err101;
     /* printf("Rotated box test. Surface - "); */

  }
  else 
  {
     if ((qo1->p1 = newPoint(rcoef1,idim,0)) == SISL_NULL) goto err101;
  }

  if (po2->iobj == SISLCURVE)
  {
     if ((qo2->c1 = newCurve(po2->c1->in,po2->c1->ik,po2->c1->et,
			     rcoef2,po2->c1->ikind,idim,0)) == SISL_NULL)
	goto err101;
     /* printf("curve. "); */
  }
  else if (po2->iobj == SISLSURFACE)
  {
     if ((qo2->s1 = newSurf(po2->s1->in1,po2->s1->in2,po2->s1->ik1,
			    po2->s1->ik2,po2->s1->et1,po2->s1->et2,
			     rcoef2,po2->s1->ikind,idim,0)) == SISL_NULL)
	goto err101;
     /* printf("surface. "); */
  }
  else 
  {
     if ((qo2->p1 = newPoint(rcoef2,idim,0)) == SISL_NULL) goto err101;
  }

  /* Make box test.  */

  /*  time_before = clock();
  boxrot_nmb++; */
  sh1790(qo1,qo2,kinnerexp,aepsge,&kstat);
  /*  time_used = clock() - time_before;
  boxrot_time += time_used; */
  if (kstat < 0) goto error;
		 /* printf("Status = %d \n",kstat); */

  /* Box-test permformed.  */

  *jstat = kstat;
  goto out;

  /* Error in space allocation.  */

 err101: *jstat = -101;
  s6err("sh1834",*jstat,kpos);
  goto out;

  /* Error in input. Dimension not equal to 2 or 3.  */

 err105: *jstat = -105;
  s6err("sh1834",*jstat,kpos);
  goto out;

  /* Error in lower level routine.  */

  error : *jstat = kstat;
  goto out;

 out:

  /* Free space occupied by local arrays and objects.  */

  if (qo1 != SISL_NULL) freeObject(qo1);
  if (qo2 != SISL_NULL) freeObject(qo2);
  if (rcoef1 != SISL_NULL && rcoef1 != scoef1) freearray(rcoef1);
  if (rcoef2 != SISL_NULL && rcoef2 != scoef2) freearray(rcoef2);
  if (scoef1 != SISL_NULL) freearray(scoef1);
  if (scoef2 != SISL_NULL) freearray(scoef2);
  if (smat != SISL_NULL) free0array(smat);

  return;
}



//===========================================================================
void sh1839(SISLObject *po1,SISLObject *po2,double aepsge,int *jstat)
//===========================================================================
{
  int kstat = 0;           /* Local status variable.                        */
  int kpos = 0;            /* Position of error.                            */
  int ki,kj;               /* Counter.                                      */
  int kdim;                /* Dimension of geometry space.                  */
  int kn1,kn2;             /* Number of vertices in each parameter
			      direction of surface.                         */
  int kk1,kk2;             /* Order in each parameter direction of surface. */
  int kvec;                /* Number of direction vectors to calculate.     */
  int klap;                /* Indcates whether SISLbox of surface overlap point.*/
  double tang1,tang2;      /* Angles between direction vectors.             */
  double *scoef;           /* Vertices of surface.                          */
  register double *s1,*s2,
  *s3,*s4;                 /* Pointers used to traverse arrays.             */
  double *sdir = SISL_NULL;     /* Array containing direction vectors.           */
  
  /* Test kind of first object.  */
  
  if (po1->iobj != SISLSURFACE) goto err122;
    
  /* Copy surface to local parameters.  */
  
  kdim = po1 -> s1 -> idim;
  kn1 = po1 -> s1 -> in1;
  kn2 = po1 -> s1 -> in2;
  kk1 = po1 -> s1 -> ik1;
  kk2 = po1 -> s1 -> ik2;
  scoef = po1 -> s1 -> ecoef;
  
  /* Find number of rotations to make.  */
  
  if (kk1 > 2 || kk2 > 2) kvec = 10; else kvec = 2;
  
  /* Allocate space for vectors with which the x-axis is to be parallell. */
  
  sdir = newarray(kvec*kdim,double);
  if (sdir == SISL_NULL) goto err101;
  
   if (kvec == 2)
   {
  /* Make diagonal from lower left to upper right corner of patch.  
     s1 points to the array which contains the results, s3 points to the
     lower left corner and s4 to the upper right corner.                 */
  
  for (s1=sdir,s2=s1+kdim,s3=scoef,s4=scoef+kdim*(kn1*kn2-1); s1<s2;
       s1++,s3++,s4++)
    *s1 = *s4 - *s3;
  
  /* Make diagonal from upper left to lower right corner of patch. s1
     points to the array which contains the results, s3 points to the
     upper left and s4 to the lower right corner.                       */
  
  for (s1=sdir+kdim,s2=s1+kdim,s3=scoef+kdim*kn1*(kn2-1),
       s4=scoef+kdim*(kn1-1); s1<s2; s1++,s3++,s4++)
    *s1 = *s4 - *s3;
   }
   
  if (kvec > 2)
    {
      
      /* The surface is not linear in both parameter directions. Make
	 horizontal and vertical tangent in lower left corner. s1 points
	 to the array which contain the results and s3 to the corner.    */
      
      for (s1=sdir+2*kdim,s2=s1+kdim,s3=scoef; s1<s2; s1++,s3++)
	{       
	  *s1 = *(s3+kdim) - *s3;
	  *(s1+kdim) = *(s3+kdim*kn1) - *s3;
	}
      
      /* Make the horizontal and vertical tangent in lower right corner. s1
	 points to the array which contain the results and s3 to the corner.*/
      
      for (s1=sdir+4*kdim,s2=s1+kdim,s3=scoef+kdim*(kn1-1); s1<s2; s1++,s3++)
	{
	  *s1 = *(s3-kdim) - *s3;
	  *(s1+kdim) = *(s3+kdim*kn1) - *s3;
	}
      
      /* Make the horizontal and vertical tangent in upper left corner. s1
	 points to the result array and s3 to the corner.                  */
      
      for (s1=sdir+6*kdim,s2=s1+kdim,s3=scoef+kdim*kn1*(kn2-1);s1<s2;s1++,s3++)
	{
	  *s1 = *(s3+kdim) - *s3;
	  *(s1+kdim) = *(s3-kdim*kn1) - *s3;
	}
      
      /* Make the horizontal and vertical tangent in upper right corner. 
	 s1 points to the result array and s3 to the corner.             */
      
      for (s1=sdir+8*kdim,s2=s1+kdim,s3=scoef+kdim*(kn1*kn2-1);s1<s2;s1++,s3++)
	{
	  *s1 = *(s3-kdim) - *s3;
	  *(s1+kdim) = *(s3-kn1*kdim) - *s3;
	}
    }
  
  /* Rotate coordinate system according to the vectors found and perform
     box-test. First use the diagonal vectors.                           */
  
  klap = 1;
  if (kvec == 2)
  {
  sh1834(po1,po2,aepsge,kdim,sdir,sdir+kdim,&kstat);
  if (kstat < 0) goto error;
  klap = kstat;
  
  if (klap == 1)
    {
       sh1834(po1,po2,aepsge,kdim,sdir+kdim,sdir,&kstat);
      if (kstat < 0) goto error;
      klap = kstat;
    }
  }
  
  /* If the box-tests performed till now show overlap and the surface
     is non-linear in at least one direction rotate the geometry according
     to the tangent information gathered.                                 */
  /* First remove superfluous rotation directions.                        */
  
  for (ki=4; ki<kvec; )
  {
     for (kj=2; kj<4; kj+=2)
     {
	/* Test if the found vectors are aproximately equal.  */
	
	tang1 = s6ang(sdir+ki*kdim,sdir+kj*kdim,kdim);
	tang2 = s6ang(sdir+(ki+1)*kdim,sdir+(kj+1)*kdim,kdim);
	
	if (tang1 < ANGULAR_TOLERANCE && tang2 < ANGULAR_TOLERANCE) break;
     }
     
     if (kj < 4)
     {
	/* Remove set of rotation vectors.  */
	
	if (ki+2 < kvec)
	   memcopy(sdir+ki*kdim, sdir+(ki+2)*kdim, (kvec-ki-2)*kdim, DOUBLE);
	kvec -= 2;
     }
     else ki+=2;
  }
  
  ki = 2;
  while (ki<kvec && klap == 1)
    {
       sh1834(po1,po2,aepsge,kdim,sdir+ki*kdim,sdir+(ki+1)*kdim,&kstat);
      if (kstat < 0) goto error;
      klap = kstat;
      
      if (klap && 
	  fabs(s6ang(sdir+ki*kdim,sdir+(ki+1)*kdim,kdim)-PIHALF) 
	  > ANGULAR_TOLERANCE)
      {
	 /* VSK, 01/93. Use the other partial derivative as x-axis in 
	    the rotation. */
	 
	 sh1834(po1,po2,aepsge,kdim,sdir+(ki+1)*kdim,sdir+ki*kdim,&kstat);
	 if (kstat < 0) goto error;
	 klap = kstat;
      }
      ki += 2;
    }
  
  /* Improved boxtest performed.  */
  
  *jstat = klap;
  goto out;
  
  /* Error in space allocation.  */
  
 err101: *jstat = -101;
  s6err("sh1839",*jstat,kpos);
  goto out;
  
  /* Error in input. Unexpected object found.  */
  
 err122: *jstat = -122;
  s6err("sh1839",*jstat,kpos);
  goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("sh1839",*jstat,kpos);
  goto out;
  
 out: 
  
  /* Free allocated space.  */
  
  if (sdir != SISL_NULL) freearray(sdir);
  
  return;
}


//===========================================================================
int sh6isconnect(SISLIntpt *pt0, SISLIntpt *pt1, SISLIntpt *pt2)
//===========================================================================
{
   int kstat = 0;   /* Status on wether a connection is found.  */
   int ki;          /* Counter.                                 */
   SISLIntpt *qt;   /* Intersection point.                      */
   int been_here = -199;

   /* Test if the points are equal.  */

   if (pt1 == pt2) return 1;
   
   /* UJK, aug 93, oo-loop in sh6isconn. */
   if (pt1->marker == been_here) return 0;
   pt1->marker = been_here;

   /* Traverse the intersection points connected to pt1.  */
   
   for (ki=0; ki<pt1->no_of_curves; ki++)
   {
      qt = sh6getnext(pt1,ki);
      if (qt == pt0) continue;
      
      kstat = sh6isconnect(pt1,qt,pt2);
      
      if (kstat) return 1;
   }
   
   /* No connection is found.  */
   
   return 0;
}


//===========================================================================
void sh6floop(SISLIntpt *vedgept[],int inum,int *jpt,int *jstat)
//===========================================================================
{
   int kstat2 = -1;   /* Status of traversing the first list.           */
   int kpt = 0;       /* Current number of intersections in first loop. */
   int ki,kj;         /* Counters.                                      */
   SISLIntpt *qstart; /* First intersection point around the edges.     */
   SISLIntpt *qprev;  /* Previous intersection point found.             */
   SISLIntpt *qt;     /* Current intersection point in list.            */
   SISLIntpt *qnext = SISL_NULL;  /* The next point to enter the list.              */
   SISLIntpt *qhelp;  /* Help point used in sorting vedgept.            */

   /* Check if there is a list.  */

   *jpt = 0;
   if (inum == 0) goto out;

   /* Set start point. */

   qstart = vedgept[0];

   /* Traverse the edge intersections to fetch a list starting in qstart.
      The elements in the list must lie on the edges of the objects.    */

   for (qprev=SISL_NULL, qt=qstart; ; qt=vedgept[kpt])
   {
      if (kstat2 == 0)
      {
	 /* Open list. Travers in the opposite direction.  */

	 qt = qstart;
	 qprev = (kpt > 0) ? vedgept[1] : SISL_NULL;
      }

      for (ki=0; ki<qt->no_of_curves; ki++)
      {
	 /* Search all curves in this points to find the list.  */

	 qnext = sh6getnext(qt,ki);

	 if (qnext == SISL_NULL)
	 {
	    kstat2 = 0; break;  /* No point.  */
	 }
	 if (qnext == qprev) continue;  /* Traversing of list have turned.
				 	   Try next curve.                 */
	 if (qnext == qstart)
	 {
	    kstat2 = 1; break;  /* A closed loop is found.  */
	 }

	 /* An intersection is found. Check if it lies on the current
	    edges.               */

	 for (kj=kpt+1; kj<inum; kj++)
	    if (qnext == vedgept[kj]) break;

	 if (kj == inum) continue;  /* The point lies not at an edge. */

	 /* Change position in the array in such a way that the members
	    of the list are placed first.  */

	 kpt++;
	 qhelp = vedgept[kj];
	 vedgept[kj] = vedgept[kpt];
	 vedgept[kpt] = qhelp;

	 /* Set previous pointer.  */

	 qprev = qt;

	 /* Check if we are finished or may continue with the next point. */

	 if (qnext == SISL_NULL || (qnext == qstart && qnext != qprev) ||
	     qprev == qt) break;
      }

      /* Check if we have found the entire list.  */

      if (qnext == qstart || kpt >= inum) break;
      else if (ki == qt->no_of_curves)
      {
	 if (kstat2 < 0) kstat2 = 0;
	 else break;
      }
   }

   /* Set number of points in list and output status.  */

   *jpt = kpt + 1;
   if (kpt == 0) *jstat = 2;
   else if (kstat2 == 1) *jstat = 1;
   else *jstat = 0;

   out :
      return;
}

//===========================================================================
void sh6closevert(SISLCurve *pcurve,SISLSurf *psurf,double *cpar1, double epar2[])
//===========================================================================
{
  int ki,kj,kl;           /* Counters.   */
  int kdim = pcurve->idim; /* Dimension of geometry space.      */
  int kminc;              /* Number of closest vertex of curve. */
  int kmins1,kmins2;      /* Numbers of closest vertex of surface. */
  int kn = pcurve->in;    /* Number of coefficients of curve. */
  int kn1 = psurf->in1;   /* Number of coefficients of surface, 1. par. dir. */
  int kn2 = psurf->in2;   /* Number of coefficients of surface, 2. par. dir. */
  int kk = pcurve->ik;    /* Order of curve. */
  int kk1 = psurf->ik1;   /* Order of surface, 1. par. dir. */
  int kk2 = psurf->ik2;   /* Order of surface, 2. par. dir. */
  double tdist;           /* Distance.   */
  double tmin = HUGE;     /* Minimum distance.  */
  double tpar;            /* Used to compute parameter values.   */
  double *s1,*s2;         /* Pointers into arrays.   */

  /* Find position of closest vertices. */

  for (s1=pcurve->ecoef, ki=0; ki<kn; s1+=kdim, ki++)
    for (s2=psurf->ecoef, kj=0; kj<kn1; kj++)
      for (kl=0; kl<kn2; s2+=kdim, kl++)
	{
	   tdist = s6dist(s1,s2,kdim);
	   if (tdist < tmin)
	   {
	      tmin = tdist;
	      kminc = ki;
	      kmins1 = kj;
	      kmins2 = kl;
	   }
	}

  /* Estimate parameter values of vertices.  */

  for (ki=kminc+1, s1=pcurve->et+ki, tpar=DZERO;
   ki<kminc+kk; tpar+=(*s1), s1++, ki++);
  *cpar1 = tpar/(double)(kk-1);

  for (ki=kmins1+1, s1=psurf->et1+ki, tpar=DZERO;
   ki<kmins1+kk1; tpar+=(*s1), s1++, ki++);
  epar2[0] = tpar/(double)(kk1-1);

  for (ki=kmins2+1, s1=psurf->et2+ki, tpar=DZERO;
   ki<kmins2+kk2; tpar+=(*s1), s1++, ki++);
  epar2[1] = tpar/(double)(kk2-1);


  goto out;

 out:
  return;
}

//===========================================================================
void sh6cvvert(SISLCurve *pc1, SISLCurve *pc2, double *cpar1, double *cpar2)
//===========================================================================
{
  int ki,kj, kh;           /* Counters.   */
  int kdim = pc1->idim; /* Dimension of geometry space.      */
  int kminc1;           /* Number of closest vertex of 1. curve. */
  int kminc2;           /* Number of closest vertex of 2. curve. */
  int kn1 = pc1->in;    /* Number of coefficients of 1. curve. */
  int kn2 = pc2->in;    /* Number of coefficients of 2. curve. */
  int kk1 = pc1->ik;    /* Order of 1. curve. */
  int kk2 = pc2->ik;   /* Order of 2. curve. */
  double tdist;           /* Distance.   */
  double tmin = HUGE;     /* Minimum distance.  */
  double tpar;            /* Used to compute parameter values.   */
  double *s1,*s2;         /* Pointers into arrays.   */
  
  /* Find position of closest vertices. */
  
  for (s1=pc1->ecoef, ki=0; ki<kn1; s1+=kdim, ki++)
    for (s2=pc2->ecoef, kj=0; kj<kn2; s2+=kdim, kj++)
      {
	for (tdist=0.0, kh=kdim-1; kh>=0; kh--)
	  tdist += (s2[kh]-s1[kh])*(s2[kh]-s1[kh]);
	//	tdist = s6dist(s1,s2,kdim);
	if (tdist < tmin)
	  {
	    tmin = tdist;
	    kminc1 = ki;
	    kminc2 = kj;
	   }
	}
  
  /* Estimate parameter values of vertices.  */
  
  for (ki=kminc1+1, s1=pc1->et+ki, tpar=0.0; 
   ki<kminc1+kk1; tpar+=(*s1), s1++, ki++);
  *cpar1 = tpar/(double)(kk1-1);
  
  for (ki=kminc2+1, s1=pc2->et+ki, tpar=0.0; 
   ki<kminc2+kk2; tpar+=(*s1), s1++, ki++);
  *cpar2 = tpar/(double)(kk2-1);

  return;
}

//===========================================================================
void s1711(SISLSurf *ps,int ipar,double apar,SISLSurf **rsnew1,
	   SISLSurf **rsnew2,int *jstat)
//===========================================================================
{
  int kstat;		/* Local status variable.		*/
  int kpos=0;		/* Position of error.			*/
  int kmy;		/* An index to the knot-vector.		*/
  int kv,kv1;		/* Number of knots we have to insert.	*/
  int kpl,kfi,kla;	/* To posisjon elements in trans.-matrix.*/
  int kk,kksec;		/* Order of the input surface.		*/
  int kn,knsec;		/* Number of the vertices in input curves.*/
  int kdim=ps->idim;	/* Dimensjon of the space in whice surface
			   lies.				*/
  int kind=ps->ikind;	/* Type of surface ps is.               */
  int kn1,kn2;		/* Number of vertices in the new surfaces.*/
  int knum;		/* Number of knots less and equal than
			   the intersection point.		*/
  int ki,ki1,ki2;	/* Control variable in loop.		*/
  int kj,kj1,kj2;	/* Control variable in loop.		*/
  int k1m,k2m,k3m,k4m;	/* Variables to mark directons in array.*/
  int newkind=1;	/* Type of surface subsurfaces are.     */
  double *s1,*s2,*s3,*s4;/* Pointers used in loop.		*/
  double *st,*stsec;	/* The old knot-vectors.		*/
  double *st1=SISL_NULL;	/* The first first new knot-vector.	*/
  double *st1sec=SISL_NULL;	/* The first second new knot-vector.	*/
  double *st2=SISL_NULL;	/* The second first new knot-vector.	*/
  double *st2sec=SISL_NULL;	/* The second second new knot-vector.	*/
  double *salfa=SISL_NULL;	/* A line of the trans.-matrix.		*/
  double *scoef;	/* Pointer to vertices.   		*/
  double *scoef1=SISL_NULL;	/* The first new vertice.		*/
  double *scoef2=SISL_NULL;	/* The second new vertice.		*/
  SISLSurf *q1=SISL_NULL;	/* Pointer to new surface-object.	*/
  SISLSurf *q2=SISL_NULL;	/* Pointer to new surface-object.	*/
  double salfa_local[5];/* Local help array.			*/

 /* if ps is rational, do subdivision in homogeneous coordinates */
 /* just need to set up correct dim and kind for the new surfaces at end of routine */
  if(kind == 2 || kind == 4)
  {
       scoef = ps->rcoef;
       kdim++;
       newkind++;
  }
  else
  {
       scoef = ps->ecoef;
  }

  /* Check that we have a surface to subdivide. */

  if (!ps) goto err150;

  /* Making constants and ponters to mark direction.  */

  if (ipar==1)
    {
      /* If ipar is 1 we have to split the "three" dimentional
	 coeffisient matrix along a column. In this case k4m is
	 the distance beetween each element in the clumn.
	 For each element in the column we have to treat a part
	 of a line, to march along the line we use k1m.*/

      st = ps->et1;
      stsec = ps->et2;
      kn = ps->in1;
      knsec = ps->in2;
      kk = ps->ik1;
      kksec = ps->ik2;
      k1m = kdim;
      k4m = kdim*kn;
    }
  else
    {
      /* If ipar is 2 we have to split the "three" dimentional
	 coeffisient matrix along a line. In this case k4m is
	 the distance beetween each element in the line.
	 For each element in the line we have to treat a part
	 of a column, to march along the column we use k1m.*/

      st = ps->et2;
      stsec = ps->et1;
      kn = ps->in2;
      knsec = ps->in1;
      kk = ps->ik2;
      kksec = ps->ik1;
      k1m = kdim*knsec;
      k4m = kdim;
    }

  /* Check that the intersection point is an interior point. */

  if ((apar < *st  && DNEQUAL(apar, *st)) ||
      (apar > st[kn+kk-1] && DNEQUAL(apar, st[kn+kk-1])))
	  						goto err158;

  /* Allocate space for the kk elements which may not be zero in eache
     line of the basic transformation matrix.*/

  if (kk > 5)
  {
     if ((salfa = newarray (kk, double)) == SISL_NULL)	goto err101;
  }
  else salfa = salfa_local;

  /* Find the number of the knots which is smaller or like
     the intersection point, and how many knots we have to insert.*/

  s1 = st;
  kv = kk;	/* The maximum number of knots we have to insert. */

  if ((apar > s1[0] && DNEQUAL(apar, s1[0])) &&
      (apar < s1[kn+kk-1] && DNEQUAL(apar, s1[kn+kk-1])))
  {
     /* Using binear search*/
     kj1=0;
     kj2=kk+kn-1;
     knum = (kj1+kj2)/2;
     while (knum != kj1)
     {
	if ((s1[knum] < apar ) && DNEQUAL(s1[knum], apar))
	   kj1=knum; else kj2=knum;
	knum = (kj1+kj2)/2;
     }
     knum++;           /* The smaller knots.*/

     while (DEQUAL(s1[knum], apar))
     {
	apar = s1[knum];
	knum++;
	kv--;
     }
     /* The knots thats like the */
     /*     intersection point.  */
  }
  else if (DEQUAL(apar,s1[0]))
  {
     apar = s1[0];
     knum = 0;
     while (s1[knum] == apar)
	/* The knots thats like the intersection point. */
	knum++;
  }
  else if (DEQUAL(apar,s1[kn+kk-1]))
  {
     apar = s1[kn+kk-1];
     knum = kn+kk-1;
     while (s1[knum-1] == apar)
	/* The knots thats like the intersection point. */
	knum--;
  }
  /* Find the number of vertices in the two new curves. */

  kn1 = knum + kv - kk;
  kn2 = kn + kk - knum;

  /* Allocating the new arrays to the two new curves. */

  if ((st1=newarray(kn1+kk,double))==SISL_NULL) goto err101;
  if ((st1sec=newarray(knsec+kksec,double))==SISL_NULL) goto err101;
  if ((st2=newarray(kn2+kk,double))==SISL_NULL) goto err101;
  if ((st2sec=newarray(knsec+kksec,double))==SISL_NULL) goto err101;
  if ((scoef1=newarray(kn1*kdim*knsec,double))==SISL_NULL) goto err101;
  if ((scoef2=newarray(kn2*kdim*knsec,double))==SISL_NULL) goto err101;

  /* Copying the knotvectors from the old curve to the new curves */

  memcopy(st1,st,kn1,double);
  memcopy(st2+kk,st+knum,kn2,double);
  memcopy(st1sec,stsec,knsec+kksec,double);
  memcopy(st2sec,stsec,knsec+kksec,double);

  /* Updating the knotvectors by inserting the new k-touple knot */

  for(s2=st1+kn1,s3=st2,s4=s3+kk;s3<s4;s2++,s3++) *s2 = *s3 = apar;

  /* Copying the coefisientvectors to the new curves.*/

  if (ipar == 1)
    for (ki=0; ki<knsec; ki++)
      {
	memcopy(scoef1+ki*kdim*kn1,scoef+ki*kdim*kn,
		kdim*kn1,double);
	memcopy(scoef2+ki*kdim*kn2,scoef+kdim*(ki*kn+knum-kk),
		kdim*kn2,double);
      }
  else
    {
      memcopy(scoef1,scoef,kdim*kn1*knsec,double);
      memcopy(scoef2,scoef+kdim*(knum-kk)*knsec,
	      kdim*kn2*knsec,double);
    }

  /* Updating the coefisientvectors to the new surfaces.*/

  /* Updating the first surface. */

  /* If we imagine that the matrix is turned in such a way that we are
     splitting it along a column, then for each element in the column
     we have to treat a par of a line, to march along the line
     in the first new matrix we use k1m, And we use k3m as a mark
     at the end of the column in this new matrix.*/

  if(ipar==1)
    {
      k2m=kdim*kn1;
      k3m=kdim*kn1*knsec;
    }
  else
    {
      k2m=kdim;
      k3m=kdim*knsec;
    }
  knum -= kk - 1;
  for (ki=max(0,knum),kv1=max(0,-knum),s1=scoef1+ki*k1m;ki<kn1;ki++,s1+=k1m)
    {
      /* Initialising:
	 knum = knum-kk+1, Index of the first vertice to change.
	 ki = knum, 	  Index of the vertices we are going to
	 change. Starting with knum, but if
	 knum is negativ we start at zero.
	 kv1 = 0,	  Number if new knots between index ki
	 and ki+kk. We are starting one below
	 becase we are counting up before using
	 it. If knum is negativ we are not
	 starting at zero but at -knum.
	 s1=scoef1+ki*k1m  Pointer at the first vertice to
	 change. */

      /* Using the Oslo-algorithm to make a transformation-vector
	 from the old vertices to one new vertice. */

      kmy=ki;
      s1700(kmy,kk,kn,++kv1,&kpl,&kfi,&kla,st,apar,salfa,&kstat);
      if (kstat) goto err153;

      /* Compute the knsec*kdim vertices with the "same index". */

      for (s2=s1,s3=s2+k3m,ki2=0; s2<s3; s2+=k2m,ki2+=k4m)
	for (kj=0,s4=s2; kj<kdim; kj++,s4++)
	  for (*s4=0,kj1=kfi,kj2=kfi+kpl; kj1<=kla;kj1++,kj2++)
	    *s4 += salfa[kj2] * scoef[k1m*kj1+ki2+kj];
    }

  /* And the second surface. */

  /* If we imagine that the matrix is turned in such a way that we are
     splitting it along a column, then for each element in the column
     we have to treat a par of a line, to march along the line
     in the second new matrix we use k1m, And we use k3m as a mark
     at the end of the column in this new matrix.*/

  if(ipar==1)
    {
      k2m=kdim*kn2;
      k3m=kdim*kn2*knsec;
    }
  else
    {
      k2m=kdim;
      k3m=kdim*knsec;
    }

  for (ki1=min(kn1+kv-1,kn+kv),s1=scoef2; ki<ki1; ki++,s1+=k1m)
    {
      /* Initialising:
	 ki1 = kn1+kv-1,	  the index of the vertice next to the
	 last vertice we have to change.
	 If we do not have so many vertices,
	 we have to use the index next to the
	 last vertice we have, kn+kv.
	 s1=scoef2	  Pointer at the first vertice to
	 change. */


      /* Using the Oslo-algorithm to make a transformation-vector
	 from the old vertices to one new vertice. */

      s1700(kmy,kk,kn,kv1--,&kpl,&kfi,&kla,st,apar,salfa,&kstat);
      if (kstat) goto err153;


      /* Compute the knsec*kdim vertices with the "same index". */

      for (s2=s1,s3=s2+k3m,ki2=0; s2<s3; s2+=k2m,ki2+=k4m)
	for (kj=0,s4=s2; kj<kdim; kj++,s4++)
	  for (*s4=0,kj1=kfi,kj2=kfi+kpl; kj1<=kla;kj1++,kj2++)
	    *s4 += salfa[kj2] * scoef[k1m*kj1+ki2+kj];
    }


  /* Allocating new surface-objects.*/
 /* use ps->idim rather than kdim in case ps is rational  */


  if (ipar==1)
  {
    if ((q1=newSurf(kn1,knsec,kk,kksec,st1,st1sec,     /* PFU 15/07-94 */
                    scoef1,newkind,ps->idim,2)) == SISL_NULL) goto err101;
    if ((q2=newSurf(kn2,knsec,kk,kksec,st2,st2sec,     /* PFU 15/07-94 */
                    scoef2,newkind,ps->idim,2)) == SISL_NULL) goto err101;
  }
  else
  {
    if ((q1=newSurf(knsec,kn1,kksec,kk,st1sec,st1,     /* PFU 15/07-94 */
                    scoef1,newkind,ps->idim,2)) == SISL_NULL) goto err101;
    if ((q2=newSurf(knsec,kn2,kksec,kk,st2sec,st2,     /* PFU 15/07-94 */
                    scoef2,newkind,ps->idim,2)) == SISL_NULL) goto err101;
  }


  /* Updating output. */

  *rsnew1 = q1;
  *rsnew2 = q2;
  *jstat = 0;
  goto out;


  /* Error. Error in lower level function. */

 err153: *jstat = kstat;
  goto outfree;


  /* Error. No surface to subdevice.  */

 err150: *jstat = -150;
  s6err("s1711",*jstat,kpos);
  goto out;


  /* Error. The intersection-point is outside the surface.  */

 err158: *jstat = -158;
  s6err("s1711",*jstat,kpos);
  goto out;


  /* Error. Allocation error, not enough memory.  */

 err101: *jstat = -101;
  s6err("s1711",*jstat,kpos);
  goto outfree;


outfree:
   if(q1) freeSurf(q1);
   if(q2) freeSurf(q2);

   /* Free local used memory. */

out:
   if(!q1)
   {
      if (st1) freearray(st1);
      if (st1sec) freearray(st1sec);
      if (scoef1) freearray(scoef1);
   }

   if(!q2)
   {
      if (st2) freearray(st2);
      if (st2sec) freearray(st2sec);
      if (scoef2) freearray(scoef2);
   }

   if (kk > 5 && salfa)
      freearray (salfa);
   return;
}


//===========================================================================
void s6idcpt(SISLIntdat *pintdat,SISLIntpt *pintpt,SISLIntpt **rintpt)
//===========================================================================
{
  if (pintdat == SISL_NULL)
    *rintpt = SISL_NULL;
  else
    {
      int ki,knr;                /* Counters.          */
      double tdist,td;           /* To store distanse. */
      
      if (pintpt == pintdat->vpoint[0])
        tdist = HUGE;
      else
        tdist = s6dist(pintdat->vpoint[0]->epar,pintpt->epar,pintpt->ipar);
      
      for (knr=0,ki=1; ki<pintdat->ipoint; ki++)
        {
	  if (pintpt == pintdat->vpoint[ki])
	    td = HUGE;
	  else
	    td = s6dist(pintdat->vpoint[ki]->epar,pintpt->epar,pintpt->ipar);
	  
	  if (td < tdist)
	    {
	      knr = ki;
	      tdist = td;
	    }
        }
      
      if (tdist == HUGE)
        *rintpt = SISL_NULL;
      else
        *rintpt = pintdat->vpoint[knr];
    }
}

//===========================================================================
void sh6insert(SISLIntdat **pintdat,SISLIntpt *pt1,SISLIntpt *pt2,
	       SISLIntpt **ptnew,int *jstat)
//===========================================================================
{
  int kstat;                /* Local status variable.                     */
  
   *jstat = 0;
  
  /* First we have to be sure that pintdat contains ptnew. */
  
  sh6idnpt(pintdat,ptnew,1,&kstat);
  if (kstat < 0) goto error;
  if (kstat > 0) 
    { 
       /* Point already existing in data structure, point killed, 
	  no insertion */
       *jstat = 1;
       goto out;
    }
  
  /* UJK, aug. 92 insert always mainpts if one of the neighbour is a main */
  /* if (sh6ismain(pt1) && sh6ismain(pt2)) */
   if (sh6ismain(pt1) || sh6ismain(pt2))
     sh6tomain(*ptnew,&kstat);
  else
     sh6tohelp(*ptnew,&kstat);
  if (kstat < 0) goto error;

  /* Then insert the point. */
  sh6insertpt(pt1,pt2,*ptnew,&kstat);
  if (kstat < 0) goto error;
  
  
  goto out;
  

/* Error. pt1 and pt2 are not properly connected.  */


/* Error in sub function.  */

error:  *jstat = kstat;
        s6err("sh6insert",*jstat,0);
        goto out;

   out:
      return;
}

//===========================================================================
void sh6idget (SISLObject * po1, SISLObject * po2, int ipar, double apar, 
	       SISLIntdat * pintdat, SISLIntdat ** rintdat, double aepsge, 
	       int *jstat)
//===========================================================================
{
  int kstat;			/* Local status variable.                 */
  int kpos = 0;			/* Position of error.                     */
  int ki, kj, kn, kl;
  int keep_first;		/* Flag, which object is not reduced      */
  double tstart[4];
  double tend[4];
  double spar[4];		/* Storing uppdated parametervalues.      */
  double tlow, thigh;
  double help_arr[4];
  double thelp;
  SISLIntpt *qpt = SISL_NULL, *pinter=SISL_NULL;
  double *nullp = SISL_NULL;
  int found = FALSE;
  int ind_div, ind_other;
  SISLObject *qo_div = SISL_NULL, *qo_other = SISL_NULL;
  int kleftt = 0, klefts = 0;
  double point[3];
  int log_ind;

  /* Find out which object the parameter belongs to */
 if (ipar < po1->iobj)
 {
   if(ipar == 1)	log_ind = 0;
   else 		log_ind=1;
   qo_div = po1;
   qo_other = po2;
   ind_div = 0;
   ind_other = po1->iobj;
      keep_first = 0;
 }
 else
 {
   if(ipar == po1->iobj)	log_ind = ipar +1;
   else 			log_ind=ipar-1;
   qo_div = po2;
   qo_other = po1;
   ind_div = po1->iobj;
   ind_other = 0;
   keep_first = 1;
    }

  if (pintdat == SISL_NULL)
    goto out;

  /* ----------------------------------------- */

  for (ki = 0; ki < pintdat->ipoint; ki++)
  {
    sh6isinside (po1, po2, pintdat->vpoint[ki], &kstat);
    if (kstat < 0)
      goto error;

    if (kstat)
    {
      for (kj = 0; kj < (pintdat->vpoint[ki])->no_of_curves;kj++)
      {
	qpt = sh6getnext (pintdat->vpoint[ki], kj);
	sh6isinside (po1, po2, qpt, &kstat);
	if (kstat < 0)
	  goto error;

	/* For surface, check on curve_dir */
	if (kstat &&
	    (qo_div->iobj == SISLCURVE ||
	     (qo_div->iobj == SISLSURFACE &&
	      (pintdat->vpoint[ki]->curve_dir[kj] & (1 << (log_ind + 1))))))
	{
	  /* curve: */
	  tlow = pintdat->vpoint[ki]->epar[ipar];
	  thigh = qpt->epar[ipar];
	  if (thigh < tlow)
	  {
	    thelp = thigh;
	    thigh = tlow;
	    tlow = thelp;
	  }

	  if (apar > tlow && apar < thigh)
	  {
	    found = TRUE;
	    break;
	  }
	}
      }
    }
    if (found)
    {

      for (kl=0; kl<qpt->ipar; kl++)
	help_arr[kl] = (double)0.5*(pintdat->vpoint[ki]->epar[kl]
				    + qpt->epar[kl]);
      help_arr[ipar] = apar;

      /* Prepare for iteration. */
      if (qo_div->iobj == SISLCURVE)
      {
	kleftt=0;
	s1221 (qo_div->c1, 0, apar, &kleftt, point, &kstat);
	if (kstat < 0)
	  goto error;
      }
      else
      {
	kleftt=0;
	klefts=0;
	s1421 (qo_div->s1, 0, help_arr + ind_div,
	       &kleftt, &klefts, point, nullp, &kstat);
	if (kstat < 0)
	  goto error;
      }


      sh6ptobj (point, qo_other, aepsge, help_arr + ind_other,
		    help_arr + ind_other, &kstat);
      if (kstat == 1)
      {
	/* Point found, insert */

	pinter = hp_newIntpt (qpt->ipar, help_arr, DZERO, qpt->iinter,
			      SI_UNDEF, SI_UNDEF, SI_UNDEF, SI_UNDEF,
			      0, 0, nullp, nullp);
	if (pinter == SISL_NULL)
	  goto err101;

	sh6insert (&pintdat, pintdat->vpoint[ki], qpt, &pinter, &kstat);
	if (kstat < 0)
	  goto error;
      }
    }
    if (qo_div->iobj == SISLCURVE)
      break;
    else
      found = FALSE;
  }



  /* ----------------------------------------- */



  if (po1->iobj == SISLCURVE)
  {
    tstart[0] = po1->c1->et[po1->c1->ik - 1];
    tend[0] = po1->c1->et[po1->c1->in];
  }
  else if (po1->iobj == SISLSURFACE)
  {
    tstart[0] = po1->s1->et1[po1->s1->ik1 - 1];
    tend[0] = po1->s1->et1[po1->s1->in1];
    tstart[1] = po1->s1->et2[po1->s1->ik2 - 1];
    tend[1] = po1->s1->et2[po1->s1->in2];
  }

  if (po2->iobj == SISLCURVE)
  {
    tstart[po1->iobj] = po2->c1->et[po2->c1->ik - 1];
    tend[po1->iobj] = po2->c1->et[po2->c1->in];
  }
  else if (po2->iobj == SISLSURFACE)
  {
    tstart[po1->iobj] = po2->s1->et1[po2->s1->ik1 - 1];
    tend[po1->iobj] = po2->s1->et1[po2->s1->in1];
    tstart[po1->iobj + 1] = po2->s1->et2[po2->s1->ik2 - 1];
    tend[po1->iobj + 1] = po2->s1->et2[po2->s1->in2];
  }

  /* Fix pick values for reduced paramater. */
  tstart[ipar] = tend[ipar] = apar;


  /* Uppdate the array. */

  for (ki = 0; ki < pintdat->ipoint; ki++)
  {
    for (kj = 0; kj < pintdat->vpoint[ki]->ipar; kj++)
      if ((DNEQUAL (pintdat->vpoint[ki]->epar[kj], tstart[kj]) &&
	   pintdat->vpoint[ki]->epar[kj] < tstart[kj]) ||
	  (DNEQUAL (pintdat->vpoint[ki]->epar[kj], tend[kj]) &&
	   pintdat->vpoint[ki]->epar[kj] > tend[kj]))
	break;

    if (kj == pintdat->vpoint[ki]->ipar)
    {
      for (kn = 0; kn < ipar; kn++)
	spar[kn] = pintdat->vpoint[ki]->epar[kn];
      for (; kn < pintdat->vpoint[ki]->ipar - 1; kn++)
	spar[kn] = pintdat->vpoint[ki]->epar[kn + 1];

      /* Point accepted, insert into rintdat. */
      /* VSK. Let the point be a normal main point.  */

      qpt = hp_newIntpt (pintdat->vpoint[ki]->ipar - 1, spar,
			 pintdat->vpoint[ki]->adist,1,
			 pintdat->vpoint[ki]->left_obj_1[0],
			 pintdat->vpoint[ki]->right_obj_1[0],
			 pintdat->vpoint[ki]->left_obj_2[0],
			 pintdat->vpoint[ki]->right_obj_2[0],
			 (keep_first ? pintdat->vpoint[ki]->size_1 : 0),
			 (keep_first ? 0 : pintdat->vpoint[ki]->size_2),
			 (keep_first ? pintdat->vpoint[ki]->geo_data_1 : nullp),
			 (keep_first ? nullp : pintdat->vpoint[ki]->geo_data_2));

      if (qpt == SISL_NULL)
	goto err101;

      sh6idnpt (rintdat, &qpt, 1, &kstat);
      if (kstat < 0)
	goto error;
    }
  }

  *jstat = 0;
  goto out;


/* Error in space allocation.  */

err101:*jstat = -101;
  s6err ("sh6idget", *jstat, kpos);
  goto out;

/* Error in sub function.  */

error:*jstat = kstat;
  s6err ("sh6idget", *jstat, kpos);
  goto out;

out:;
}


//===========================================================================
void s1700(int imy,int ik,int in,int iv,
	   int *jpl,int *jfi,int *jla,double *et,double apar,
	   double *galfa,int *jstat)
//===========================================================================
{
  int kpos=0;              /* Posisjon of error.           */
  int kj,kv;               /* Help variable                */
  int kp;                  /* Control variable in loop.    */
  double *salfa;           /* Help pointer to galfa.       */
  double tbeta,tbeta1;     /* Help variabels               */
  double td1,td2;          /* Help variabels               */
  double *t1,*t2;          /* Pointers to the knot vector. */
  
  
  /* Check that the number of knots we insert is not to large */
  
  if (iv >= ik) goto err152;
  
  
  /* Compute the negativ difference between the index in galfa and
     the real knot inserten matrix. */
  
  *jpl=ik-imy-1;
  
  
  /* Changing the galfa so we may use the index in the real matrix. */
  
  galfa += *jpl;
  
  
  /* Initialise the last element. */
  
  galfa[imy] = 1;
  
  
  /* Here we go one time for each new knot we insert. */
  
  for (kj=in+iv-2,in+=ik-1,kv=ik-iv,kp=0; kp<iv; kp++,kv++)
    {
      /* The initialising:  The two first are not changing.
	 kj = in+iv-2, minus the maximum of kp it
	 gives the index of the last
	 orginal vertices.
	 in = in+ik-1, the index of the last element in et.
	 kv = ik-iv ,  the nuber of old knots in the field.
	 This variabel is counting up to ik
	 (the order) during the loops. */
      
      
      /* Here we note the special case where we are at the
	 start of the matrix and we does not have a k-touple
	 knot at this end. */
      
      if (kp>=imy) tbeta1=(apar - *et)* *galfa/(et[kv] - *et);
      else         tbeta1=(double)0.0;
      
      
      *jfi=max(1,imy-kp); *jla=min(imy,kj-kp);
      
      
      /* For details about this loop look in the reference. */
      
      for (salfa=galfa+*jfi,t1=et+*jfi,t2=et+*jla; t1<=t2; t1++,salfa++)
	{
	  td1 = apar - *t1;
	  td2 = t1[kv] - apar;
	  tbeta = *salfa/(td1 + td2);
	  salfa[-1] = td2*tbeta + tbeta1;
	  tbeta1 = td1*tbeta;
	}
      
      
      /* Here we note the special case where we are at the
	 end of the matrix and we does not have a k-touple
	 knot at this end. */
      
      if (*jla<imy)
	{
	  t1 = et + in;
	  *(salfa-1) = tbeta1+(*t1-apar)* *salfa/(*t1 - *(t2+1));
	} else  *(salfa-1) = tbeta1;
    }
  
  
  /* Adjusting the index of first and last in galfa. */
  
  if (iv) (*jfi)--;
  else   *jfi = *jla = imy;
  
  
  /* Updating output. */
  
  *jstat = 0;
  goto out;
  
  
  /* Error, to many insertions knots. */
  
 err152:
  *jstat = -152;
  s6err("s1700",*jstat,kpos);
  goto out;
  
 out: 
  return;
}


//===========================================================================
void s1231(SISLCurve *pc1,double apar,
	   SISLCurve **rcnew1,SISLCurve **rcnew2,int *jstat)
//===========================================================================
{
  int kstat;              /* Local status variable.                     */
  int kpos=0;             /* Position of error.                         */
  int kmy;                /* An index to the knot-vector.               */
  int kv,kv1;             /* Number of knots we have to insert.         */
  int kpl,kfi,kla;        /* To posisjon elements in trans.-matrix.     */
  int kk=pc1->ik;         /* Order of the input curve.                  */
  int kn=pc1->in;         /* Number of the vertices in input curves.    */
  int kdim=pc1->idim;     /* Dimensjon of the space in whice curve lies.*/
  int kind=pc1->ikind;    /* Type of curve pc1 is.                      */
  int kn1,kn2;            /* Number of vertices in the new curves.      */
  int knum;               /* Number of knots less and equal than
			     the intersection point.                    */
  int ki,ki1;             /* Control variable in loop.                  */
  int kj,kj1,kj2;         /* Control variable in loop.                  */
  int newkind=1;          /* Type of curve the subcurves are            */
  double *s1,*s2,*s3,*s4; /* Pointers used in loop.                     */
  double *st1=SISL_NULL;       /* The first new knot-vector.                 */
  double *st2=SISL_NULL;       /* The second new knot-vector.                */
  double *salfa=SISL_NULL;     /* A line of the trans.-matrix.               */
  double *scoef;          /* Pointer to vertices.                       */
  double *scoef1=SISL_NULL;    /* The first new vertice.                     */
  double *scoef2=SISL_NULL;    /* The second new vertice.                    */
  SISLCurve *q1=SISL_NULL;     /* Pointer to new curve-object.               */
  SISLCurve *q2=SISL_NULL;     /* Pointer to new curve-object.               */
  int incr;		  /* No of extra knots copied during periodicity*/
  int mu;		  /* Multiplisity at the k'th knot              */
  int kleft = kk-1;	  /* Knot navigator                             */
  double delta;           /* Period size in knot array.                 */
  double salfa_local[5];  /* Local help array.			        */
  
  *rcnew1 = SISL_NULL;
  *rcnew2 = SISL_NULL;
  
  
 /* if pc1 is rational, do subdivision in homogeneous coordinates */
 /* just need to set up correct dim and kind for the new curves at end of routine */
  if(kind == 2 || kind == 4)
  {
     scoef = pc1->rcoef;
     kdim++;
     newkind++;
  }
  else
  {
     scoef = pc1->ecoef;
  }
  
  /* Check that we have a curve to subdivide. */
  
  if (!pc1) goto err150;
  
  /* Periodic curve treatment, UJK jan 92--------------------------------- */
  if (pc1->cuopen == SISL_CRV_PERIODIC)
  {
     delta = (pc1->et[kn] - pc1->et[kk - 1]);
     
     /* Check that the intersection point is an interior point. */
     if (apar < *(pc1->et) || apar > *(pc1->et + kn + kk - 1))
	goto err158;
     
     /* If inside the knot vector, but outside well define
	intervall, we shift the parameter value one period. */
     if (apar < *(pc1->et + kk - 1))
	apar += delta;
     if (apar > *(pc1->et + kn))
	apar -= delta;
     
     /* Now we create a new curve that is a copy of pc1,
	but with the period repeated once,
	this allows us to pick a whole period. */
     
     /* Get multiplisity at start of full basis interval */
     mu = s6knotmult(pc1->et, kk, kn, &kleft, pc1->et[kk-1], &kstat);
     if (kstat < 0) goto err153;
     if (mu >= kk) goto errinp;
     
     /* Copy ----------------------------------- */
     incr = kn - kk + mu;
     if ((scoef1 = newarray ((kn + incr) * kdim, double)) == SISL_NULL)
	goto err101;
     if ((st1 = newarray (kn + kk + incr, double)) == SISL_NULL)
	goto err101;
     
     memcopy (scoef1, pc1->ecoef, kn * kdim, double);
     memcopy (st1, pc1->et, kn + kk, double);
     memcopy (scoef1 + kn * kdim, pc1->ecoef + (kk - mu) * kdim, 
	      incr * kdim, double);
     
     
     for (ki = 0; ki < incr; ki++)
	st1[kn + kk + ki] = st1[kn + kk + ki - 1] +
	   (st1[2*kk - mu + ki] - st1[2*kk - mu + ki - 1]);
     if ((q1 = newCurve (kn + incr, kk, st1, scoef1,
			 newkind, pc1->idim, 2)) == SISL_NULL)
	goto err101;
     q1->cuopen = SISL_CRV_OPEN;
     
     /* Pick part (one period)------------------ */
     s1712 (q1, apar, apar + delta,
	    rcnew1, &kstat);
     if (kstat < 0)
	goto err153;
     freeCurve (q1);
     if (*rcnew1)
	(*rcnew1)->cuopen = SISL_CRV_CLOSED;
     
     /* Finished, exit */
     *jstat = 2;
     goto out;
     
  }
  
  /* End of periodic curve treatment, UJK jan 92------------- */

	    
  /* Check that the intersection point is an interior point. */
  /* Changed by UJK */
  /*if (apar <= *(pc1->et) || apar >= *(pc1->et+kn+kk-1)) goto err158; */
  if ((apar < pc1->et[kk - 1] || DEQUAL(apar, pc1->et[kk - 1]))||
      (apar > pc1->et[kn] || DEQUAL(apar, pc1->et[kn])))
    goto err158;
  
  
  /* Allocate space for the kk elements which may not be zero in eache
     line of the basic transformation matrix.*/
  
  if (kk > 5)
  {
     if ((salfa = newarray (kk, double)) == SISL_NULL)	goto err101;
  }
  else salfa = salfa_local;
  
  
  /* Find the number of the knots which is smaller or like
     the intersection point, and how many knots we have to insert.*/
  
  s1 = pc1->et;
  kv = kk;     /* The maximum number of knots we may have to insert. */
  
  /* Using binear search*/
  kj1=0;
  kj2=kk+kn-1;
  knum = (kj1+kj2)/2;
  while (knum != kj1)
  {
     if ((s1[knum] < apar) && DNEQUAL (s1[knum], apar))
	kj1=knum; else kj2=knum;
     knum = (kj1+kj2)/2;
  }
  knum++;           /* The smaller knots. */
  
  while (DEQUAL (s1[knum], apar))
     /* The knots thats like the intersection point. */
  { 
     apar = s1[knum];
     knum++; 
     kv--;
  }
  
  
  /* Find the number of vertices in the two new curves. */
  
  kn1 = knum + kv - kk;
  kn2 = kn + kk - knum;
  
  
  
  /* Allocating the new arrays to the two new curves. */
  
  if (kn1>0)
  {
     if ((scoef1=newarray(kn1*kdim,double))==SISL_NULL) goto err101;
     if ((st1=newarray(kn1+kk,double))==SISL_NULL) goto err101;
  }
  if (kn2>0)
  {
     if ((scoef2=newarray(kn2*kdim,double))==SISL_NULL) goto err101;
     if ((st2=newarray(kn2+kk,double))==SISL_NULL) goto err101;
  }
  
  
  /* Copying the knotvectors, all but the intersection point from
     the old curve to the new curves */
  
  memcopy(st1,pc1->et,kn1,double);
  memcopy(st2+kk,pc1->et+knum,kn2,double);
  
  
  /* Updating the knotvectors by inserting a k-touple knot in
     the intersection point at each curve.*/
  
  for(s2=st1+kn1,s3=st2,s4=s3+kk; s3<s4; s2++,s3++) *s2 = *s3 = apar;
  
  
  /* Copying the coefisientvectors to the new curves.*/
  
  memcopy(scoef1,scoef,kdim*kn1,double);
  memcopy(scoef2,scoef+kdim*(knum-kk),kdim*kn2,double);
  
  
  /* Updating the coefisientvectors to the new curves.*/
  
  /* Updating the first curve. */
  knum -= kk - 1;
  for (ki=max(0,knum),kv1=max(0,-knum),s1=scoef1+ki*kdim; ki<kn1; ki++)
  {
     /* Initialising:
	knum = knum-kk+1, Index of the first vertice to change.
	ki = knum,        Index of the vertices we are going to
	change. Starting with knum, but if
	knum is negativ we start at zero.
	kv1 = 0,          Number if new knots between index ki
	and ki+kk. We are starting one below
	becase we are counting up before using
	it. If knum is negativ we are not
	starting at zero but at -knum.
	s1=scoef1+ki*kdim,SISLPointer at the first vertice to
	change. */
     
     
     /* Using the Oslo-algorithm to make a transformation-vector
	from the old vertices to one new vertice. */
     
     kmy=ki;
     s1700(kmy,kk,kn,++kv1,&kpl,&kfi,&kla,pc1->et,apar,salfa,&kstat);
     if (kstat) goto err153;
     
     
     /* Compute the kdim vertices with the same "index". */
     
     for (kj=0; kj<kdim; kj++,s1++)
	for (*s1=0,kj1=kfi,kj2=kfi+kpl; kj1<=kla; kj1++,kj2++)
	   *s1 += salfa[kj2] * scoef[kj1*kdim+kj];
  }
  
  /* And the second curve. */
  
  for (ki1=min(kn1+kv-1,kn+kv),s1=scoef2; ki<ki1; ki++)
  {
     /* Initialising:
	ki1 = kn1+kv-1,   the index of the vertice next to the
	last vertice we have to change.
	If we do not have so many vertices,
	we have to use the index next to the
	last vertice we have, kn+kv.
	s1=scoef2         Pointer at the first vertice to
	change. */
     
     
     /* Using the Oslo-algorithm to make a transformation-vector
	from the old vertices to one new vertice. */
     
     s1700(kmy,kk,kn,kv1--,&kpl,&kfi,&kla,pc1->et,apar,salfa,&kstat);
     if (kstat) goto err153;
     
     
     /* Compute the kdim vertices with the same "index". */
     
     for (kj=0; kj<kdim; kj++,s1++)
	for (*s1=0,kj1=kfi,kj2=kfi+kpl; kj1<=kla; kj1++,kj2++)
	   *s1 += salfa[kj2] * scoef[kj1*kdim+kj];
  }
  
  
  /* Allocating new curve-objects.*/
  /* use pc1->idim rather than kdim in case pc1 is rational  */
  
  if (kn1>0)
     if ((q1=newCurve(kn1,kk,st1,scoef1,newkind,pc1->idim,2)) == SISL_NULL)
								goto err101;
  if (kn2>0)
     if ((q2=newCurve(kn2,kk,st2,scoef2,newkind,pc1->idim,2)) == SISL_NULL)
								goto err101;
  
  
  /* Updating output. */
  
  *rcnew1 = q1;
  *rcnew2 = q2;
  *jstat = 0;
  goto out;
  
  
  /* Error. Error in low level routine. */
  
err153:
     *jstat = kstat;
  goto outfree;
  
  
  /* Error. Error in input */
errinp:
     *jstat = -154;
  goto outfree;
  
  /* Error. No curve to subdivide.  */
err150:
     *jstat = -150;
  s6err("s1231",*jstat,kpos);
  goto out;
  
  
  /* Error. The parameter value is outside the curve.  */
  
err158:
     *jstat = -158;
  s6err("s1231",*jstat,kpos);
  goto out;
  
  
  /* Error. Allocation error, not enough memory.  */
  
err101:
     *jstat = -101;
  s6err("s1231",*jstat,kpos);
  goto outfree;
  
  
outfree:
   if(q1) freeCurve(q1);
   if(q2) freeCurve(q2);   
   
   /* Free local used memory. */
   
out:
   if(!q1)
   {
      if (st1) freearray(st1);
      if (scoef1) freearray(scoef1);
   }
   
   if(!q2)
   {
      if (st2) freearray(st2);
      if (scoef2) freearray(scoef2);
   }
   
   if (kk > 5 && salfa)
      freearray (salfa);
   return;
}


//===========================================================================
void s1174_s9dir(double *cdiff1, double *cdiff2,double evals[])
//===========================================================================
{
  double tdiv;		      /* Determinant                               */
  double ta11,ta12,ta21,ta22; /* The matrix                  		   */
  double tmax;                /* The largest value in matrix               */
  double tb1,tb2;             /* The right hand side.                      */
  double tderx,tderxx;        /* Derivatives                               */
  double tdery,tderyy;
  double tderxy;
  double tdeltax,tdeltay;   /* Locals for the step value to be determined. */
  /* --------------------------------------------------------------------- */

  /* Init */
  tderx  = evals[1];
  tdery  = evals[2];
  tderxx = evals[3];
  tderxy = evals[4];
  tderyy = evals[5];
  tdeltax = DZERO;
  tdeltay = DZERO;
  *cdiff1  = DZERO;
  *cdiff2  = DZERO;


  /* Building the matrix. */

  ta11 = tderxx;
  ta12 = tderxy;
  ta21 = tderxy;
  ta22 = tderyy;
  tb1  = -tderx;
  tb2  = -tdery;

  tmax = max(fabs(ta11),max(fabs(ta12),max(fabs(ta21),fabs(ta22))));

  if (DEQUAL(tb1+tmax,tmax) && DEQUAL(tb2+tmax,tmax))
    {
      /* Finished, we have found a max. */
    }
  else
    {
      tdiv    = ta11*ta22 - ta21*ta12;
      if (fabs(tdiv) > MAX(tmax*REL_COMP_RES,REL_COMP_RES))
	{
	  /* The matrix is ok, solve the system using Cramers rule. */
	  tdeltax = tb1*ta22 - tb2*ta12;
	  tdeltay = ta11*tb2 - ta21*tb1;
	  tdeltax /= tdiv;
	  tdeltay /= tdiv;
	}
      else if (max (fabs(ta11),fabs(ta22)) > REL_COMP_RES)
	{
	   if (fabs(ta11) > fabs(ta22))
	     tdeltax = tb1/ta11;
	   else
	     tdeltay = tb2/ta22;
	}

    }

  *cdiff1  = tdeltax;
  *cdiff2  = tdeltay;

}

//===========================================================================
void s1174_s9corr(double gd[], double acoef1,double acoef2,double astart1,
		  double aend1,double astart2, double aend2)
//===========================================================================
{
  if (acoef1 + gd[0] < astart1)  gd[0] = astart1 - acoef1;
  else if (acoef1 + gd[0] > aend1) gd[0] = aend1 - acoef1;

  if (acoef2 + gd[1] < astart2)  gd[1] = astart2 - acoef2;
  else if (acoef2 + gd[1] > aend2) gd[1] = aend2 - acoef2;
}


//===========================================================================
void s1174(SISLSurf *psurf,double estart[], double eend[], double enext[], 
	   double gpos[],int *jstat)
//===========================================================================
{
  int kstat = 0;            /* Local status variable.                      */
  int kpos = 0;             /* Position of error.                          */
  int kleft1=0;             /* Variables used in the evaluator.            */
  int kleft2=0;             /* Variables used in the evaluator.            */
  int kder=2;               /* Order of derivatives to be calulated        */
  int knbit;                /* Number of iterations                        */
  int kdir;                 /* Changing direction.                         */
  double tdelta[2];         /* Parameter intervals of the surface.         */
  double tdist = 0.0;       /* Euclidian norm of derivative vector         */
  double tprev;             /* Previous Euclidian norm of derivative vector*/
  double td[2],t1[2],tdn[2];/* Distances between old and new parameter
			       value in the two parameter directions.      */
  double sval[7];           /* Value ,first and second derivatiev of surf. */
  double *snorm=sval+7;     /* Normal vector of the surface, dummy.        */
  double snext[2];          /* Parameter values                            */
  double tol = (double)10000.0*REL_COMP_RES; /* Singularity tolerance        */
  /* --------------------------------------------------------------------- */

  /* Test input.  */
  if (psurf->idim != 1) goto err106;

  /* Fetch endpoints and the intervals of parameter interval of curves.  */

  tdelta[0] = psurf->et1[psurf->in1] - psurf->et1[psurf->ik1 - 1];
  tdelta[1] = psurf->et2[psurf->in2] - psurf->et2[psurf->ik2 - 1];


  /* Initiate variables.  */
  gpos[0] = enext[0];
  gpos[1] = enext[1];

  /* Evaluate 0-2.st derivatives of surface */
  s1421(psurf,kder,gpos,&kleft1,&kleft2,sval,snorm,&kstat);
  if (kstat < 0) goto error;

  /* Get Euclidian norm of derivative vector */
  tprev = sqrt(sval[1]*sval[1] + sval[2]*sval[2]);

  /* Compute the Newton stepdistanse vector. */
  s1174_s9dir(td,td+1,sval);

  if ( (fabs(td[0]/tdelta[0]) <= REL_COMP_RES) &&
      (fabs(td[1]/tdelta[1]) <= REL_COMP_RES))
     goto stop_it;

  /* Adjust if we are not inside the parameter intervall. */
  t1[0] = td[0];
  t1[1] = td[1];
  s1174_s9corr(t1,gpos[0],gpos[1],estart[0],eend[0],estart[1],eend[1]);

  /* Iterate to find the intersection point.  */

  for (knbit = 0; knbit < 50; knbit++)
    {
      /* Evaluate 0-2.st derivatives of surface */

      snext[0] = gpos[0] + t1[0];
      snext[1] = gpos[1] + t1[1];

      s1421(psurf,kder,snext,&kleft1,&kleft2,sval,snorm,&kstat);
      if (kstat < 0) goto error;

      /* Get Euclidian norm of derivative vector */
      tdist = sqrt(sval[1]*sval[1] + sval[2]*sval[2]);

      /* Compute the Newton stepdistanse vector. */
      s1174_s9dir(tdn,tdn+1,sval);

      /* Check if the direction of the step have change. */

      kdir = (s6scpr(td,tdn,2) >= DZERO);     /* 0 if changed. */

      if (tdist <= tprev || kdir)
	{
	  /* Ordinary converging. */

          gpos[0] += t1[0];
          gpos[1] += t1[1];

          td[0] = t1[0] = tdn[0];
          td[1] = t1[1] = tdn[1];

	  /* Adjust if we are not inside the parameter intervall. */
	  s1174_s9corr(t1,gpos[0],gpos[1],estart[0],eend[0],estart[1],eend[1]);


          if ( (fabs(t1[0]/tdelta[0]) <= REL_COMP_RES) &&
	      (fabs(t1[1]/tdelta[1]) <= REL_COMP_RES))
	    {
	      gpos[0] += t1[0];
	      gpos[1] += t1[1];

	      break;
	    }

          tprev = tdist;
	}

      else
	{
	  /* Not converging, half step length try again. */

          t1[0] /= (double)2;
          t1[1] /= (double)2;
	  /*         knbit--;  */
	}
    }

  /* Iteration stopped, test if point is extremum */

  stop_it:

  if (tdist <= tol)
    *jstat = 1;
  else
    *jstat = 0;


  /* Test if the iteration is close to a knot */
  if (fabs(gpos[0] - psurf->et1[kleft1])/tdelta[0] < tol)
    gpos[0] = psurf->et1[kleft1];
  else if (fabs(gpos[0] - psurf->et1[kleft1+1])/tdelta[0] < tol)
    gpos[0] = psurf->et1[kleft1+1];

  if (fabs(gpos[1] - psurf->et2[kleft2])/tdelta[1] < tol)
    gpos[1] = psurf->et2[kleft2];
  else if (fabs(gpos[1] - psurf->et2[kleft2+1])/tdelta[1] < tol)
    gpos[1] = psurf->et2[kleft2+1];

  /* Iteration completed.  */
  goto out;

 /* --------------------------------------------------------------------- */
  /* Error in input. Dimension not equal to 1 */
 err106: *jstat = -106;
  s6err("s1174",*jstat,kpos);
  goto out;

  /* Error in lower level routine.  */
  error : *jstat = kstat;
  s6err("s1174",*jstat,kpos);
  goto out;

 out:;
}


//===========================================================================
void s9simple_knot(SISLSurf* surf, int idiv, double epar[], 
		   int *fixflag, int *jstat)
//===========================================================================
{
  int k1,k2,kstat,mult;

  k1 = k2 = *fixflag = 0;

  if ( idiv < 1 || idiv > 3 ) goto err202;
  if (idiv == 1 || idiv == 3) /* Check in first parameter direction */
    {
      if ( surf->in1 == surf->ik1 )
	{
	  epar[0] = (surf->et1[0] + surf->et1[surf->in1+surf->ik1-1])/2.0;
	  k1 = 1;
	}
      else 
	{
	  int left = surf->ik1;
	  mult = s6knotmult(surf->et1,surf->ik1,surf->in1, &left,
			    surf->et1[surf->ik1],&kstat);
	  if (kstat < 0 ) goto error;
	  if ( surf->ik1+mult == surf->in1 )
	    {
	      epar[0] = surf->et1[surf->ik1];
	      k1 = 1;
	      *fixflag += 1;
	    }
	}
    }

  if (idiv == 2 || idiv == 3)
    {
      if ( surf->in2 == surf->ik2 )
	{
	  epar[1] = (surf->et2[0] + surf->et2[surf->in2+surf->ik2-1])/2.0;
	  k1 += 2;
	}
      else 
	{
	  int left = surf->ik2;
	  mult = s6knotmult(surf->et2,surf->ik2,surf->in2, &left,
			    surf->et2[surf->ik2],&kstat);
	  if (kstat < 0 ) goto error;
	  if ( surf->ik2+mult == surf->in2 )
	    {
	      epar[1] = surf->et2[surf->ik2];
	      k1 += 2;
	      *fixflag += 2 ;
	    }
	}
    }
  
  *jstat = ((idiv == k1 && (*fixflag)) ? 1 : 0);
  goto out;

 error : *jstat = kstat;
         s6err("s9simple_knot",*jstat,0);
  	 goto out;

 err202 : *jstat = -202;
         s6err("s9simple_knot",*jstat,0);

 out:  return;         
}


//===========================================================================
double s1792(double et[],int ik,int in)
//===========================================================================
{
  if (in > ik)
    {
      int kpar = (in + ik)/2;
      
      if (DNEQUAL(et[ik-1],et[kpar]) || DNEQUAL(et[in],et[kpar]))
        return  et[kpar];
    }
  
  return (et[ik-1]+et[in])*(double)0.5;
}

//===========================================================================
int s1772_s6local_pretop(double dist,double diff[],double normal[],
			 double f[],double f_t[],double f_tt[],
			 double s[],double s_u[],double s_v[],
			 double s_uu[],double s_uv[],double s_vv[],
			 int dim, int*jstat)
//===========================================================================
{
  int kstat = 0;	/* Status variable.				*/
  int ki;		/* Counter.					*/
  int return_val;	/* For return value.				*/
  double a1,a2,a3,a4;   /* Matrix.					*/
  double *S_u = SISL_NULL;	/* Normalized s_u.				*/
  double *S_v;		/* Normalized s_v.				*/
  double *S_uxS_v;	/* Cross between S_u and S_v.			*/
  double *s_d;		/* Second derevative in diriction f_t.		*/
  double *N;		/* Normalized normal.				*/
  double *d_uv;		/* Normalized direction vector in par-plane.	*/
  double local[17];	/* Local array for allocations.			*/
  
  *jstat = 0;
  
  if (s6ang(diff,normal,dim) > ANGULAR_TOLERANCE) goto warn1;
  
  /* Allocate local used memory and set value pointers.*/

  if (dim > 3)
  {
     S_u = newarray(5*dim+2,double);
     if (S_u == SISL_NULL) goto err101;
  }
  else
     S_u  = local;
  
  S_v     = S_u+dim;
  S_uxS_v = S_v+dim;
  s_d     = S_uxS_v+dim;
  N       = s_d+dim;
  d_uv    = N+dim;
  
  s6norm(s_u,dim,S_u,&kstat);
  if (kstat == 0)  goto warn1;
  s6norm(s_v,dim,S_v,&kstat);
  if (kstat == 0)  goto warn1;
  s6crss(S_u,S_v,S_uxS_v);
  a1 = s6scpr(S_u,S_v,dim);
  a2 = s6scpr(f_t,S_u,dim);
  a3 = s6scpr(f_t,S_v,dim);
  if ((a4 = s6scpr(S_uxS_v,S_uxS_v,dim)) < SINGULAR) goto warn1;
  
  d_uv[0] = (a2 - a1*a3)/a4;
  d_uv[1] = (a3 - a1*a2)/a4;
  s6norm(d_uv,2,d_uv,&kstat);
  if (kstat == 0)  goto warn1;
  
  a1 = d_uv[0]*d_uv[0];
  a2 = d_uv[1]*d_uv[1];
  a3 = 2*d_uv[0]*d_uv[1];
  
  for (ki=0; ki<dim; ki++)
     s_d[ki] = a1*s_uu[ki] + a3*s_uv[ki] + a2*s_vv[ki];
  
  for (ki=0; ki<dim; ki++)
     N[ki] = diff[ki]/dist;  
  
  a1 = s6scpr(N,f_tt,dim) - s6scpr(N,s_d,dim);

  return_val = a1 > 1.0e-10;
  goto out;

  /* Error in allocation */

  err101: 
    *jstat = -101;
    s6err("s1772_s6local_pretop",*jstat,0);
    return_val = 0;                 
    goto out;
  
  /* Degenerated system.  */

  warn1: 
    return_val = -1;
    goto out;

  out:
    if (S_u != local && S_u != SISL_NULL) freearray(S_u);
    return return_val;
}

//===========================================================================
void s1772_s6sekant1(SISLCurve *pcurve,SISLSurf *psurf,
		     double  par_val[], double delta, double *dist, double aepsge,
		     double astart1,double estart2[],double aend1,double eend2[],
		     double c0[], double s0[], double norm[], int *jstat)
//===========================================================================
{
  int ki,kj;		    /* Counter.					   */
  int kstat = 0;            /* Local status variable.                      */
  int kpos = 0;             /* Position of error.                          */
  int dim;                  /* Dimension of space the curves lie in        */
  int knbit;                /* Number of iterations                        */
  double cu_val[2];	    /* Parameter values on curve.		   */
  double new_cu_val = par_val[2];    /* New parameter value on curve.	   */
  double *diff;		    /* Difference vector between curve surface.    */
  double y[2],new_y,delta_y;/* Signed distance.				   */
  SISLPoint *pt=SISL_NULL;	    /* Point for use in closest point point/surface*/
  int cu_left = 0;	    /* Keep left knot information for evaluator.   */
  int s_left1 = 0;	    /* Keep left knot information for evaluator.   */
  int s_left2 = 0;	    /* Keep left knot information for evaluator.   */
  int shift = 0;	    /* Mark that the diriction have been changed.  */

  *jstat = 0;
  
  /* Test input.  */
  
  if (pcurve->idim != psurf->idim) goto err106;  
  dim = pcurve->idim;
  diff = c0 + dim;
   
  if ((pt = newPoint(c0,dim,0)) == SISL_NULL) goto err101;

  if (delta == 0.0) delta =1e-15;
  
  if ((par_val[2] == astart1 && delta < 0.0) ||
      (par_val[2] == aend1   && delta > 0.0))
  {
     delta = -delta;
     shift++;
  }
  
  if (fabs(delta) < (aend1 -astart1)/100.0)
  {
     if (delta < 0.0)
	delta = (astart1 - aend1)/100.0;
     else
	delta = (aend1 - astart1)/100.0;
  }
  else if (fabs(delta) > (aend1 -astart1)/10.0)
  {
     if (delta < 0.0)
	delta = (astart1 - aend1)/10.0;
     else
	delta = (aend1 - astart1)/10.0;
  }


  cu_val[0] = par_val[2];
  s1221(pcurve,0,cu_val[0],&cu_left,pt->ecoef,&kstat);
  if (kstat < 0) goto error;      
  s1773(pt,psurf,aepsge,estart2,eend2,par_val,par_val,&kstat);
  if (kstat < 0) goto error;      
  s1421(psurf,1,par_val,&s_left1,&s_left2,s0,norm,&kstat);
  if (kstat < 0) goto error;
  for(kj=0; kj<dim; kj++) diff[kj] = s0[kj] - pt->ecoef[kj];
  new_y = s6norm(norm,dim,norm,&kstat);
  if (kstat == 0)
  {
     (*dist)=s6length(diff,dim,&kstat);
     new_cu_val = cu_val[0];
     goto out;
  }
  if (((*dist)=s6length(diff,dim,&kstat)) < aepsge)
  {
     new_cu_val = cu_val[0];
     goto out;
  }
  y[0] = s6scpr(norm,diff,dim);
  cu_val[1] = cu_val[0] + delta;
  
  for (ki=0; ki<20; ki++)
  {
     s1221(pcurve,0,cu_val[1],&cu_left,pt->ecoef,&kstat);
     if (kstat < 0) goto error;      
     s1773(pt,psurf,aepsge,estart2,eend2,par_val,par_val,&kstat);
     if (kstat < 0) goto error;      
     s1421(psurf,1,par_val,&s_left1,&s_left2,s0,norm,&kstat);
     if (kstat < 0) goto error;
     for(kj=0; kj<dim; kj++) diff[kj] = s0[kj] - pt->ecoef[kj];
     new_y = s6norm(norm,dim,norm,&kstat);
     if (kstat == 0)
     {
	(*dist)=s6length(diff,dim,&kstat);
	new_cu_val = cu_val[1];
	goto out;
     }
     if (((*dist)=s6length(diff,dim,&kstat)) < aepsge)
     {
	new_cu_val = cu_val[1];
	goto out;
     }
     y[1] = s6scpr(norm,diff,dim);
     new_y = y[1]/y[0];
     if (new_y > 1.0000000000001)
     {
	if (shift)
	{
	   new_cu_val = cu_val[1];
	   goto out;
	}
	delta = -delta;
	/* ALA, UJK, sept 93, update cu_val[1]*/
	cu_val[1] = cu_val[0] + delta;
	shift++;	
     }
     else if (y[0]*y[1] <= 0.0 || fabs(new_y) < 0.5) break;
     else
     {
	if (cu_val[1]+delta <= aend1 && 
	    cu_val[1]+delta >= astart1) cu_val[1] += delta;
	else if (cu_val[1] < aend1)  	cu_val[1] = aend1;
	else if (cu_val[1] > astart1)   cu_val[1] = astart1;
	else 
	{
	   new_cu_val = cu_val[1];
	   goto out;
	}
     }
  }
  
  if (ki == 20)
  {
     *jstat = 2;
     goto out;
  }

  for (knbit=0; knbit < 50; knbit++)
  {
     delta_y = y[0]-y[1];
     if (fabs(delta_y) < REL_COMP_RES) break;
     
     new_cu_val = cu_val[1] + y[1]*(cu_val[1]-cu_val[0])/delta_y;
     if (new_cu_val >= aend1)
     {
	new_cu_val = aend1;
	if (cu_val[0] == aend1 || cu_val[1] == aend1) goto out;
     }
     else if (new_cu_val <= astart1)
     {
	new_cu_val = astart1;
	if (cu_val[0] == astart1 || cu_val[1] == astart1) goto out;
     }

     s1221(pcurve,0,new_cu_val,&cu_left,pt->ecoef,&kstat);
     if (kstat < 0) goto error;      
     s1773(pt,psurf,aepsge,estart2,eend2,par_val,par_val,&kstat);
     if (kstat < 0) goto error;      
     s1421(psurf,1,par_val,&s_left1,&s_left2,s0,norm,&kstat);
     if (kstat < 0) goto error;
     for(kj=0; kj<dim; kj++) diff[kj] = s0[kj] - pt->ecoef[kj];
     new_y = s6norm(norm,dim,norm,&kstat);
     if (kstat == 0)
     {
	(*dist) = s6length(diff,dim,&kstat);
	goto out;
     }
     if (((*dist)=s6length(diff,dim,&kstat)) < aepsge) goto out;
     new_y = s6scpr(norm,diff,dim);
     
     if ((y[0] < 0.0 && y[1] > 0.0) ||
	 (y[0] > 0.0 && y[1] < 0.0))
     {
	if ((new_y > 0.0 && y[0] > 0.0) ||
	    (new_y < 0.0 && y[0] < 0.0))
	{
	   cu_val[0] = new_cu_val;
	   y[0] = new_y;
	}
	else
	{
	   cu_val[1] = new_cu_val;
	   y[1] = new_y;
	}
     }
     else
     {
	if ( y[0] < 0.0 && new_y > 0.0)
	{
	   if (y[0] < y[1])
	   {
	      cu_val[0] = new_cu_val;
	      y[0] = new_y;
	   }
	   else
	   {
	      cu_val[1] = new_cu_val;
	      y[1] = new_y;
	   }
	}
	else if ( y[0] > 0.0 && new_y < 0.0)
	{
	   if (y[0] > y[1])
	   {
	      cu_val[0] = new_cu_val;
	      y[0] = new_y;
	   }
	   else
	   {
	      cu_val[1] = new_cu_val;
	      y[1] = new_y;
	   }
	}
	else if (y[0] > 0.0)
	{
	   if (y[0] > y[1])
	   {
	      if (new_y >=  y[0]) break;
	      cu_val[0] = new_cu_val;
	      y[0] = new_y;
	   }
	   else 
	   {
	      if (new_y >=  y[1]) break;
	      cu_val[1] = new_cu_val;
	      y[1] = new_y;
	   }
	     
	}
	else if (y[0] < 0.0)
	{
	   if (y[0] < y[1])
	   {
	      if (new_y <=  y[0]) break;
	      cu_val[0] = new_cu_val;
	      y[0] = new_y;
	   }
	   else 
	   {
	      if (new_y <=  y[1]) break;
	      cu_val[1] = new_cu_val;
	      y[1] = new_y;
	   }   
	}	   
     }
  }
  
  /* Iteration completed.  */
  
  goto out;
  
  /* Error in allocation */
  
  err101:
    *jstat = -101;
    s6err("s1772_s6sekant1",*jstat,kpos);
    goto out;                  
    
  /* Error in input. Conflicting dimensions.  */
  
  err106: 
    *jstat = -106;
    s6err("s1772_s6sekant1",*jstat,kpos);
    goto out;                  
  
  /* Error in lower level routine.  */
  
  error : 
    *jstat = kstat;
    s6err("s1772_s6sekant1",*jstat,kpos);
    goto out;                  
  
  out:
    par_val[2] = new_cu_val;
    if(pt) freePoint(pt);
}


//===========================================================================
void s1772_s9dir(double *dist,double diff[],double delta[],
		 double f[],double f_t[],double f_tt[],
		 double g[],double g_u[],double g_v[],
		 double g_uu[],double g_uv[],double g_vv[],
		 int dim,int second,int* jstat)
//===========================================================================
{                        
  int kstat;			/* Local status variable. 		  */
  double a1,a2,a3,a4,a5,a6;	/* The A matrix, diagonal and A12 A13 A23.*/
  double b1,b2,b3,b4;		/* The B matrix, diagonal and B23.	  */
  double A[9],mat[9];		/* Matrix in linear equation to be solved */
  double h[3];			/* Left side in the equation.		  */
  double x[3];			/* Left side in the equation.		  */
  double r[3];			/* Left side in the equation.		  */
  double det;			/* Determinant for matrix.		  */
  long double ss,aa,xx,bb;	/* For use in iterative improvement.      */
  int    piv[3];		/* Pivotation array                       */
  int k,k3,j;			/* Counters.				  */
  
  
  /* Computing the different vector */
  
  s6diff(f,g,dim,diff);
  
  /* Computing the length of the different vector. */
  
  *dist = s6length(diff,dim,&kstat);
  if (kstat<0) goto error;
  
  if (second || dim != 3)
  {
     a1 = s6scpr(f_t,f_t,dim);
     a2 = s6scpr(g_u,g_u,dim);
     a3 = s6scpr(g_v,g_v,dim);
     a4 = s6scpr(f_t,g_u,dim);
     a5 = s6scpr(f_t,g_v,dim);
     a6 = s6scpr(g_u,g_v,dim);
  }
  
  if (second)
  {
     b1 = s6scpr(diff,f_tt,dim);
     b2 = s6scpr(diff,g_uu,dim);
     b3 = s6scpr(diff,g_vv,dim);
     b4 = s6scpr(diff,g_uv,dim);
  }
  else b1=b2=b3=b4=0;

  if (second || dim != 3)
  {  
     mat[0] = a2-b2;	mat[1] = a6-b4;		mat[2] = -a4;
     mat[3] = a6-b4;	mat[4] = a3-b3;		mat[5] = -a5;
     mat[6] = -a4;	mat[7] = -a5;		mat[8] = a1+b1;
     
     h[0] =  s6scpr(diff,g_u,dim);
     h[1] =  s6scpr(diff,g_v,dim);
     h[2] = -s6scpr(diff,f_t,dim);
  }
  else
  {
     mat[0] = g_u[0];	mat[1] = g_v[0];	mat[2] = -f_t[0];
     mat[3] = g_u[1];	mat[4] = g_v[1];	mat[5] = -f_t[1];
     mat[6] = g_u[2]; 	mat[7] = g_v[2];	mat[8] = -f_t[2];
     
     h[0] =  diff[0];
     h[1] =  diff[1];
     h[2] =  diff[2];
  }
  
  for (k=0;k<9;k++) A[k]=mat[k];
  for (k=0;k<3;k++) x[k]=h[k];
  
  det = A[0]*(A[4]*A[8]-A[5]*A[7])
      - A[1]*(A[3]*A[8]-A[5]*A[6])
      + A[2]*(A[3]*A[7]-A[4]*A[6]);
  if (fabs(det) < 1.0e-16)
  {
     *jstat = 1;
     goto out;
  }  
     
  /* solve the linear 3x3 system */

  /*  s1772_s6lufacp(mat,piv,&kstat); */
  s6lufacp(mat,piv,3,&kstat);
  if (kstat<0) goto error;
  if (kstat == 1)
  {
     *jstat = 1;
     goto out;
  }  
  
  s6lusolp(mat,x,piv,3,&kstat);
  if (kstat<0) goto error;
  if (kstat == 1)
  {
     *jstat = 1;
     goto out;
  }
  
  for (k=0;k<3;k++) delta[k] = x[k];

  for (k=k3=0; k<3; k++,k3+=3)
  {
     for (ss=0.0,j=0; j<3; j++)
     {
	aa = A[j+k3];
	xx = x[j];
	ss += aa*xx;
     }
     bb = h[k];
     ss = bb-ss;
     r[k] = (double)ss;
  }
  s6lusolp(mat,r,piv,3,&kstat);
  if (kstat<0) goto error;
  if (kstat == 1)
  {
     *jstat = 1;
     goto out;
  }

  for (k=0;k<3;k++) delta[k] = x[k] + r[k];
  
  /* if (debug_flag) printf("\nITERATIV IMPROVES: r = (%g %g %g) ",
			 delta[0]-x[0],delta[1]-x[1],delta[2]-x[2]); */

  *jstat = 0;
  goto out;

  error : 
    *jstat = kstat;
    s6err("s1772_s9dir",*jstat,0);
    goto out;                  
	       
  out: 
    return;
}


//===========================================================================
void s1772_s9corr(double gd[],double acoef[],double astart1,double aend1,
		  double astart2[],double aend2[],int *corr)
//===========================================================================
{
  int lcorr = 0;
  if (acoef[0] + gd[0] < astart2[0])  
    {
       gd[0] = astart2[0] - acoef[0]; 
       lcorr=1;
    }
  else if (acoef[0] + gd[0] > aend2[0]) 
    {
       gd[0] = aend2[0] - acoef[0]; 
       lcorr=1;
    }
  
  if (acoef[1] + gd[1] < astart2[1])  
    {
       gd[1] = astart2[1] - acoef[1]; 
       lcorr=1;
    }
  else if (acoef[1] + gd[1] > aend2[1]) 
    {
       gd[1] = aend2[1] - acoef[1]; 
       lcorr=1;
    }
  
  if (acoef[2] + gd[2] < astart1)  
    {
       gd[2] = astart1 - acoef[2]; 
       lcorr=1;
    }
  else if (acoef[2] + gd[2] > aend1) 
    {
       gd[2] = aend1 - acoef[2]; 
       lcorr=1;
    }
  
  if (lcorr) 
    (*corr)++;
  else 
    (*corr) = 0;
}


//===========================================================================
void s1772(SISLCurve *pcurve,SISLSurf *psurf,double aepsge,
	   double astart1,double estart2[],double aend1,double eend2[],
	   double anext1,double enext2[],double *cpos1,double gpos2[], int *jstat)
//===========================================================================
{
  int ki;		    /* Counter.					   */
  int kstat = 0;            /* Local status variable.                      */
  int kpos = 0;             /* Position of error.                          */
  int left[3];              /* Variables used in the evaluator.            */
  int dim;                  /* Dimension of space the curves lie in        */
  int knbit;                /* Number of iterations                        */
  int p_dir;                /* Changing direction in par-space.            */
  int g_up,ng_up,g_dir;     /* Changing direction in geometric space.      */
  int order;		    /* Order of methode.			   */
  int sing = 0;		    /* Mark that singularity has ocured.	   */	
  double *c0=SISL_NULL;          /* Value  of curve.				   */ 
  double *c_t;		    /* First derivatiev of curve.		   */ 
  double *c_tt;		    /* Second derivatiev of curve.		   */ 
  double *s0;               /* Value of surf. 				   */
  double *s_u;		    /* First derivatiev in first dir of surf. 	   */
  double *s_v;		    /* First derivatiev in second dir of surf.	   */
  double *s_uu;		    /* Second derivatiev in first dir of surf. 	   */
  double *s_vv;		    /* Second derivatiev in second dir of surf.	   */
  double *s_uv;		    /* Cross derivatiev of surf.	   	   */
  double *s_v1;		    /* First derivatiev in second dir of surf.	   */
  double *norm;		    /* Normal to the surface.			   */
  double *diff;             /* Difference between the curve and the surf.  */
  double *prev_diff;        /* Previous difference.			   */
  double delta[3];          /* Parameter interval of the curve and surface.*/
  double d[3];		    /* Clipped distances between old and new par.
			       value in the tree parameter directions.     */
  double c_d[3];	    /* Computed distances ....			   */
  double nc_d[3];	    /* New computed distances ....		   */
  double dist;              /* Distance between position and origo.        */
  double prev_dist;         /* Previous difference between the curves.     */
  double par_val[3];        /* Parameter values                            */
  double local[45];
  int corr = 0, div2 = 0;


  
  
  /* Test input.  */
  
  if (pcurve->idim != psurf->idim) goto err106;  
  dim = pcurve->idim;
  
  /* Fetch endpoints and the intervals of parameter interval of curves.  */
  
  delta[0] = psurf->et1[psurf->in1] - psurf->et1[psurf->ik1 - 1];
  delta[1] = psurf->et2[psurf->in2] - psurf->et2[psurf->ik2 - 1];
  delta[2] = pcurve->et[pcurve->in] - pcurve->et[pcurve->ik - 1];
  
  /* Allocate local used memory and set value pointers.*/

  if (dim > 3)
  {
     c0 = newarray((15)*dim,double);
     if (c0 == SISL_NULL) goto err101;
  }
  else
     c0 = local;
  
  s0 = c0 + 3*dim;
  diff = s0 + 10*dim;
  prev_diff = diff+dim;
  c_t = c0+dim;
  c_tt = c_t+dim;
  s_u = s0+dim;
  s_uu = s_u+dim;
  s_v1 = s_uu+dim;
  s_uv  = s_v1+dim;
  s_vv = s_uv+dim+dim;
  norm = s_vv+dim;
    
  /* Initiate variables.  */

  s1772_copy2(par_val,enext2,2);
  par_val[2] = anext1;
  left[0]=left[1]=left[2]=0;  
  
  for (ki=1; ki<3; ki++)
  {
      s1772_set_order(ki);
     
     /* Evaluate 0-2.st derivatives of curve */
     
     if (par_val[2] == aend1)
	s1227(pcurve,1+order,par_val[2],left+2,c0,&kstat);
     else
	s1221(pcurve,1+order,par_val[2],left+2,c0,&kstat);
     if (kstat < 0) goto error;
     
     /* Evaluate 0-2.st derivatives of surface */
     
     s1424(psurf,1+order,1+order,par_val,left,left+1,s0,&kstat);
     if (kstat < 0) goto error;
     
     /* Compute the distanse vector and value and the new step. */
     
     s1772_s9dir(&dist,diff,c_d, c0,c_t,c_tt,
		 s0,s_u,s_v,s_uu,s_uv,s_vv, dim,order,&kstat);
     if (kstat < 0) goto error;
     if (kstat == 1) 		/* Singular matrix. */
     {
	if (order == 1) goto singular;
     }
     else break;
  }
  
  /* Correct if we are not inside the parameter intervall. */
  
  s6crss(s_u,s_v,norm);
  g_up = ((s6scpr(diff,norm,dim) >= DZERO) ? 1 : -1);
  s1772_copy2(d,c_d,3);
  s1772_s9corr(d,par_val, astart1,aend1,estart2,eend2,&corr);
  prev_dist = dist;
  s1772_copy2(prev_diff,diff,dim);      
  
  /* Iterate to find the intersection point.  */
  
  for (knbit = 0; knbit < 30; knbit++)
  {
     s1772_incr2(par_val,d,3);
     
     while (1)
     {
	/* Evaluate 0-2.st derivatives of curve */
	
	if (par_val[2] == aend1)
	   s1227(pcurve,1+order,par_val[2],left+2,c0,&kstat);
	else
	   s1221(pcurve,1+order,par_val[2],left+2,c0,&kstat);
	if (kstat < 0) goto error;
	
	/* Evaluate 0-2.st derivatives of surface */
	
	s1424(psurf,1+order,1+order,par_val,left,left+1,s0,&kstat);
	if (kstat < 0) goto error;
	
	/* Compute the distanse vector and value and the new step. */
	
	
	s1772_s9dir(&dist,diff,nc_d, c0,c_t,c_tt,
		    s0,s_u,s_v,s_uu,s_uv,s_vv, dim,order,&kstat);
	if (kstat < 0) goto error;      
	if (kstat == 1) 		/* Singular matrix. */
	{
	   sing++;
	   if (order == 1) goto singular;
	   else	 s1772_set_order(2);		/* Change to order 2. */
	}
	else
	{
	   s6crss(s_u,s_v,norm);
	   ng_up = ((s6scpr(diff,norm,dim) >= DZERO) ? 1 : -1);
	   
	   g_dir = (ng_up+g_up != 0);			/* 0 if changed. */
	   p_dir = (s6scpr(c_d,nc_d,3) >= DZERO);	/* 0 if changed. */
	   
	   if (!order && g_dir && (!p_dir || dist > 0.3*prev_dist))
	   {
	      if (div2) div2 = 0;
	      s1772_set_order(2);
	      /*  if (debug_flag) printf("\n order-2 ");*/
	   }
	   else if (order && !g_dir)
	   {
	      if (sing) goto singular;
	      if (div2) div2 = 0;
	      s1772_set_order(1);
	      /*  if (debug_flag) printf("\n  order-1 "); */
	   }
	   else
	   {
	      if (sing) sing = 0;
	      break;
	   }
	}
     }
     
     if (corr)
	if (!(p_dir && g_dir)) corr = 0;

     if (dist < prev_dist)
     {
	if (div2) div2 = 0;
	
	/* Corrigate if we are not inside the parameter intervall. */
	
	g_up = ng_up;
	s1772_copy3(d,c_d,nc_d,3);
	s1772_s9corr(d,par_val, astart1,aend1,estart2,eend2,&corr);
	prev_dist = dist;
	s1772_copy2(prev_diff,diff,dim);
	
	/* Testing */
	/*	if (quick && corr > 3) break; */
	if (corr > 3) break;
     }    
     else if ( corr > 3 ||
	     ((fabs(d[0]/delta[0]) <= REL_COMP_RES) &&
	      (fabs(d[1]/delta[1]) <= REL_COMP_RES) &&
	      (fabs(d[2]/delta[2]) <= REL_COMP_RES)))     break;
     else
     {
	/* Not converging, corrigate and try again. */
	/*  if (debug_flag) printf(" *h*:%d ",knbit);*/

	if (corr) corr++;
	if (dist > prev_dist && div2) break;
	div2++;
        s1772_decr2(par_val,d,3);
	d[0] /= 2; d[1] /= 2; d[2] /= 2;
     }
  }
	
	/* Iteration stopped, test if point found is within resolution */
  
  goto not_singular;
  
singular:
   
   /*  if (!quick && dist > aepsge) */
     if (dist > aepsge)
     {
	ki = s1772_s6local_pretop(dist,diff,norm,c0,c_t,c_tt,
			    s0,s_u,s_v,s_uu,s_uv,s_vv,dim,&kstat);
	if (kstat < 0) goto error;
	if (ki == 0)
	{
	   s1772_s6sekant1(pcurve,psurf,par_val,c_d[2],&dist,aepsge,
			   astart1,estart2,aend1,eend2,c0,s0,norm,&kstat);  
	   if (kstat < 0) goto error;
	}
     }
     
not_singular:	
  if (dist <= aepsge)
  {
     /* if (debug_flag) printf("\n FOUND: %d dist = %g",knbit,dist); */

    *jstat = 1;
  }
  else
  {
     /*if (debug_flag) printf("\n no: %d dist = %g",knbit,dist);*/

     s6crss(s_u,s_v,norm);
     if ((PIHALF-s6ang(c_t,norm,dim)) < ANGULAR_TOLERANCE)
	*jstat = 3;
     else
	*jstat = 2;
  }
  
  /* if (knbit > 25)
     if (debug_flag) printf("\n *****status: %d dist: %f \tknbit: %d",
			    *jstat,dist,knbit); */

  *cpos1 = par_val[2];
  gpos2[0] = par_val[0];
  gpos2[1] = par_val[1];
  
  /* Iteration completed.  */
  
  goto out;
  
  /* Error in allocation */
  
  err101: 
    *jstat = -101;
    s6err("s1772",*jstat,kpos);
    goto out;                  
  
  /* Error in input. Conflicting dimensions.  */
  
  err106: 
    *jstat = -106;
    s6err("s1772",*jstat,kpos);
    goto out;                  
  
  /* Error in lower level routine.  */
  
  error : 
    *jstat = kstat;
    s6err("s1772",*jstat,kpos);
    goto out;                  
  
  out:
    if (c0 != local && c0 != SISL_NULL) freearray(c0);
}


//===========================================================================
void s1172_s9dir(double *cdiff,double evals[])
//===========================================================================
{                        
   double a,b,c,d,d1,d2;

   a = evals[3];
   b = evals[2];
   c = b*b - 2.0*a*evals[1];
   
   if (fabs(b) > DZERO)  d = -evals[1]/b;
   else                  d = 0.0;
   
   
   if (c < DZERO)                    *cdiff = d;
   else if (fabs(a) > DZERO)
   {
      c = sqrt(c);
      d1 = (-b + c)/a;
      d2 = (-b - c)/a;
      if (DEQUAL(b,c))               *cdiff = d;
      else
	if (fabs(d1-d) < fabs(d2-d)) *cdiff = d1;
      else                           *cdiff = d2;
   }
   else                              *cdiff = d;
}

//===========================================================================
void s1172_s9corr(double *cd, double acoef,double astart,double aend)
//===========================================================================
{
  if (acoef + *cd < astart)  *cd = astart - acoef;
  else if (acoef + *cd > aend) *cd = aend - acoef;  
}


//===========================================================================
void s1172(SISLCurve *pcurve,double astart,
	   double aend, double anext, double *cpos,int *jstat)
//===========================================================================
{                        
  int kstat = 0;            /* Local status variable.                      */
  int kpos = 0;             /* Position of error.                          */
  int kleft=0;              /* Variables used in the evaluator.            */
  int kder=3;               /* Order of derivatives to be calulated        */
  int knbit;                /* Number of iterations                        */
  int kdir;                 /* Changing direction.                         */
  double tdelta;            /* Parameter intervals of the Curve.        */
  double tdist;             /* Euclidian norm of derivative vector         */
  double tprev;             /* Previous Euclidian norm of derivative vector*/
  double td,t1,tdn;         /* Distances between old and new parameter
			       value in the two parameter directions.      */
  double sval[4];           /* Value ,first and second derivatiev of Curve.*/ 
  double tnext;             /* Parameter values                            */
  double tol = (double)1000.0*REL_COMP_RES; /* Singularity tolerance      */
  /* --------------------------------------------------------------------- */
  
  /* Test input.  */
  if (pcurve->idim != 1) goto err106;
  
  /* Fetch endpoints and the interval of parameter interval of curves.  */
  
  tdelta = pcurve->et[pcurve->in] - pcurve->et[pcurve->ik - 1];
  
  /* Evaluate 0-2.st derivatives of curve */
  s1221(pcurve,kder,anext,&kleft,sval,&kstat);
  if (kstat < 0) goto error;

  /* Get Euclidian norm of derivative */
  tprev = fabs(sval[1]);
  
  /* Compute the Newton stepdistanse vector. */
  s1172_s9dir(&td,sval);
  
  /* Adjust if we are not inside the parameter intervall. */
  t1 = td;
  s1172_s9corr(&t1,anext,astart,aend);
  
  /* Iterate to find the intersection point.  */
  
  for (knbit = 0; knbit < 50; knbit++)
    {
      /* Evaluate 0-3.st derivatives of curve */
      
      tnext = anext + t1;
      
      s1221(pcurve,kder,tnext,&kleft,sval,&kstat);
      if (kstat < 0) goto error;

      /* Get Euclidian norm of derivative */
      tdist = fabs(sval[1]);
  
      /* Compute the Newton stepdistanse vector. */
      s1172_s9dir(&tdn,sval);
      
      /* Check if the direction of the step have change. */
      
      kdir = (td*tdn >= DZERO);     /* 0 if changed. */
      
      if (tdist <= tprev || kdir)
	{
	  /* Ordinary converging. */
      
          anext += t1;

          td = t1 = tdn;
	  
	  /* Adjust if we are not inside the parameter intervall. */
	  s1172_s9corr(&t1,anext,astart,aend);
	  
	  
          if (fabs(t1/tdelta) <= REL_COMP_RES)
	    {
	      anext += t1;
	      break;
	    }
	  
          tprev = tdist;
	}
      
      else
	{
	  /* Not converging, half step length try again. */
      
          t1 /= (double)2;
	  /*         knbit--;  */
	}
    }
  
  /* Iteration stopped, test if point is extremum */
  
  if (tdist <= tol)
    *jstat = 1;
  else
    *jstat = 0;

 
  /* Test if the iteration is close to a knot */
  if (fabs(anext - pcurve->et[kleft])/tdelta < tol)
    anext = pcurve->et[kleft];
  else if (fabs(anext - pcurve->et[kleft+1])/tdelta < tol)
    anext = pcurve->et[kleft+1];

  /* Uppdate output.  */
  *cpos = anext;
  
  /* Iteration completed.  */
  goto out;
  
 /* --------------------------------------------------------------------- */ 
  /* Error in input. Dimension not equal to 1 */
 err106: *jstat = -106;
  s6err("s1172",*jstat,kpos);
  goto out;                  
  
  /* Error in lower level routine.  */
  error : *jstat = kstat;
  s6err("s1172",*jstat,kpos);
  goto out;                  
  
 out:;
}


//===========================================================================
int sh6nmbhelp(SISLIntpt *pt,int *jstat)
//===========================================================================
{
   int num; /* Number of lists. */
   int ki; /* Loop variable.  */

   num=0;

   /* Count number of main lists pt lies in. */

   for(ki=0; ki<pt->no_of_curves; ki++)
   {
       if(pt->pnext[ki] == SISL_NULL) goto err1;
       if(sh6ishelp(pt->pnext[ki])) num++;
   }

   goto out;
   

err1:
   /* Error in data structure. */
   
   *jstat = -1;
   s6err("sh6nmbhelp",*jstat,0);
   goto out;
   
   
   out :
      return num;
}

//===========================================================================
int s1791(double et[],int ik,int in)
//===========================================================================
{
  register double tstart= et[ik - 1];
  register double tend  = et[in];
  register double tmid  = (tstart+tend)*(double)0.5;
  
  /* Check if it is possible to divide the parameter interval.  */
  
  if (DEQUAL(tmid,tstart) || DEQUAL(tmid,tend)) 
    return  0;
  else 
    return  1;
}

//===========================================================================
void sh6setdir(SISLIntpt *pt1,SISLIntpt *pt2,int *jstat)
//===========================================================================
{
   int kstat;         /* error flag. */
   int index1,index2; /* dummy indices.           */

   *jstat = 0;

   /* Check if pt1 and pt2 are already connected. */

   sh6getlist(pt1,pt2,&index1,&index2,&kstat);
   if(kstat < 0) goto err2;
   if(kstat > 1) goto err1; /* Not connected. */

   /* Set direction from pt1 to pt2. */

   pt1->curve_dir[index1] |= 1;
/*   pt2->curve_dir[index2]  = (-1 ^ 33); */
   pt2->curve_dir[index2] = -31;
   pt2->curve_dir[index2] |= pt1->curve_dir[index1];


   goto out;

   /* Points are not connected. */
err1:

   *jstat = -1;
   s6err("sh6setdir",*jstat,0);
   goto out;

   /* Error in subfuction. */
err2:

   *jstat = -2;
   s6err("sh6setdir",*jstat,0);
   goto out;

   out :
      return;
}



//===========================================================================
void sh1784 (SISLCurve * pcurve, SISLSurf * psurf, double aepsge,
	     double epar[], int icur, int idirc, double elast[],
	     double enext[], int *jstat)
//===========================================================================
{
  int kstat;			/* Status variable                                 */
  int ki;			/* Counter.                                        */
  int kleftc = 0;		/* Left indicator for point calculation            */
  int kleft1 = 0;		/* Left indicator for point calculation in 1. par.
			           direction of surface.                           */
  int kleft2 = 0;		/* Left indicator for point calculation in 2. par dir.*/
  int kleft1prev, kleft2prev;	/* Previous left indicators of surface.    */
  int kn;			/* The number of B-splines, i.e., the dimension of
			           the spline space associated with the knot
			           vector.                                         */
  int kk;			/* The polynomial order of the curve.              */
  int kk1, kk2, kn1, kn2;	/* Orders and nu,ber of vertices of surface        */
  int kdimc;			/* The dimension of the space in which the curve
			           lies. Equivalently, the number of components
			           of each B-spline coefficient.                   */
  int kdims;			/* Dimension of space where the surface lies       */
  int kpos = 0;			/* Position of error                               */
  int kderc = 2;		/* Number of derivatives to be claculated on curve */
  int kders = 1;		/* Number of derivatives to be calculated on surface
			           If step lenght is to be generated from surface,
			           kders must be equal to 2.                       */
  int kdum;			/* Temporary variable                              */
  int kpar;			/* Parameter value of constant parameter curve.    */
  int kiterate;                 /* Indicates if further iteration is necessary
				   after curve-curve iteration.                    */
  double tref;                  /* Referance value in equality test.               */
  double tclose1, tclose2;	/* Parameter values of closest point between curves. */
  double tangdot;               /* Scalar product between curve tangents.          */
  double snorm[3];		/* Normal vector of surface                        */
  double s3dinf1[10];		/* Pointer to storage for point info of curve
			           (10 dobules prpoint when idim=3, 7 when idim=3) */
  double *st;			/* Pointer to the first element of the knot vector
			           of the curve. The knot vector has [kn+kk]
			           elements.                                       */
  double *st1;			/* First knot direction of surface                 */
  double *st2;			/* Second knot direction of surface                */
  double sfirst[2];		/* Start parameter par in surface                  */
  double tfirst;		/* Fist parameter on curve                         */
  double tend;			/* Last parameter on curve                         */
  double sderc[9];		/* Position, first and second derivative of curve  */
  double stangprev[3];          /* Previous tangent of curve.                      */
  double sders[18];		/* Position, first and second derivatives of surface */
  double tx, tx1, tx2;		/* Parameter value */
  double tstep;			/* Final step length     */
  double tmaxinc;		/* Maximal increment in parameter value along curve*/
  double tlengthend;		/* Length of 1st derivative at end of segment */
  double tincre;		/* Parameter value increment */
  double tsmax, tcmax;		/* Local maximal step length based of boxsizes of objects */
  double tdist = DZERO;		/* Distance */
  double sstart[2];		/* Lower boundary of parameter intervals */
  double send[2];		/* Upper bounadry of parameter intervals */
  double snext[3];		/* Existing iteration point on  surface            */
  double spos[3];		/* New iteration  point on surface                 */
  double snext2[2];		/* Help parameter values.                          */
  SISLPoint *qpoint = SISL_NULL;
  SISLCurve *qc = SISL_NULL;		/* Constant parameter curve.                       */

  /* Pointer to curve evaluator routine of the curve.  */

  sh1784_fevalcProc fevalc;
/*
 #if defined(SISLNEEDPROTOTYPES)
   void (*fevalc) (SISLCurve *, int, double, int *, double[], int *);
 #else
   void (*fevalc) ();
 #endif
 */
  /* Make maximal step length based on box-size of surface */

  sh1992su (psurf, 0, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  tsmax = MAX (psurf->pbox->e2max[0][0] - psurf->pbox->e2min[0][0],
	       psurf->pbox->e2max[0][1] - psurf->pbox->e2min[0][1]);
  tsmax = MAX (tsmax, psurf->pbox->e2max[0][2] - psurf->pbox->e2min[0][2]);

  /* Make maximal step length based on box-size of curve */

  sh1992cu (pcurve, 0, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  tcmax = MAX (pcurve->pbox->e2max[0][0] - pcurve->pbox->e2min[0][0],
	       pcurve->pbox->e2max[0][1] - pcurve->pbox->e2min[0][1]);
  tcmax = MAX (tcmax, pcurve->pbox->e2max[0][2] - pcurve->pbox->e2min[0][2]);

  /* Copy curve attributes to local parameters.  */

  kdimc = pcurve->idim;
  kk = pcurve->ik;
  kn = pcurve->in;
  st = pcurve->et;

  /* Copy surface attributes to local parameters.  */

  kdims = psurf->idim;
  kk1 = psurf->ik1;
  kk2 = psurf->ik2;
  kn1 = psurf->in1;
  kn2 = psurf->in2;
  st1 = psurf->et1;
  st2 = psurf->et2;

  /* Set reference value.  */

  tref = MAX(st[kn]-st[kk-1],MAX(st1[kn1]-st1[kk1-1],st2[kn2]-st2[kk2-1]));

  /* Check that dimensions are 3 */

  if (kdimc != 3 || kdims != 3)
    goto err105;

  sstart[0] = st1[kk1 - 1];
  sstart[1] = st2[kk2 - 1];
  send[0] = st1[kn1];
  send[1] = st2[kn2];

  /* Copy interval description into local variables */

  if (icur == 1)
    {
      sfirst[0] = epar[1];
      sfirst[1] = epar[2];
      tfirst = epar[0];
      tend = (idirc == 1) ? st[kn] : st[kk - 1];
    }
  else
    {
      sfirst[0] = epar[0];
      sfirst[1] = epar[1];
      tfirst = epar[2];
      tend = (idirc == 1) ? st[kn] : st[kk - 1];
    }

  /* To make sure we do not start outside or end outside the curve we
     truncate tfirst to the knot interval of the curve */

  tfirst = (idirc == 1) ? MAX (tfirst, st[kk - 1]) : MIN (tfirst, st[kn]);

  /* Set start point of iteration on surface */

  spos[0] = sfirst[0];
  spos[1] = sfirst[1];

  /* Set curve evaluator of the curve.  */

  fevalc = (idirc == 1) ? s1221 : s1227;

  /* Store knot values at start of curve */

  tx2 = tfirst;
  kdum = MAX (kk1, kk2);
  kdum = MAX (kdum, kk);
  tmaxinc = fabs (tend - tfirst) / (kdum * kdum);

  /* Make start point of curve  */

  fevalc (pcurve, kderc, tx2, &kleftc, sderc, &kstat);
  if (kstat < 0) goto error;

  /* Make start point of surface.  */

  s1421 (psurf, kders, spos, &kleft1, &kleft2, sders, snorm, &kstat);
  if (kstat < 0) goto error;

  /* While end not reached */

  while (idirc * tx2 < idirc * tend)
    {
      /* Save parameters of previous step.   */

      tx1 = tx2;
      snext[0] = spos[0];
      snext[1] = spos[1];
      kleft1prev = kleft1;
      kleft2prev = kleft2;

      /* Calculate unit tangent and radius of curvature of curve. */

      s1307 (sderc, kdimc, s3dinf1, &kstat);
      if (kstat < 0)
	goto error;

      /* Calculate step length based on curvature */

      tstep = s1311 (s3dinf1[3 * kdimc], aepsge, tsmax, &kstat);
      if (kstat < 0)
	goto error;

      /* Remember length of start tangent, end of zero segment */

      tlengthend = s6length (sderc + kdimc, kdimc, &kstat);
      if (kstat < 0)
	goto error;


      /* Find candidate end point, make sure that no breaks in tangent or
         curvature exists between start and endpoints of the segment     */
      /* Make step length equal to resolution if the length is zero */

      if (DEQUAL (tlengthend, DZERO))
	tincre = REL_PAR_RES;
      else
	tincre = tstep / tlengthend;

      tincre = MIN (tincre, tmaxinc);

      /*  Make sure that we don't pass any knots of the curve. */

      if (idirc * (tx1 + tincre) > idirc * (st[kleftc + idirc] + REL_PAR_RES))
	tincre = idirc * (st[kleftc + idirc] - tx1);

      if (idirc < 0 && (tx1 - tincre < st[kleftc] - REL_PAR_RES))
	tincre = idirc * (st[kleftc] - tx1);

      /* Find parameter value of candidate end point of segment */

      tx2 = tx1 + idirc * tincre;

      for (ki = 0, tx = (tx1 + tx2) / (double) 2.0; ki < 2; ki++, tx = tx2)
	{
	  if (idirc * tx >= idirc * tend)
	    break;

	  /* Make point sderc at curve at tx */

	  fevalc (pcurve, kderc, tx, &kleftc, sderc, &kstat);
	  if (kstat < 0) goto error;

	  /* Test if the step is legal.  */

	  if (DNEQUAL(tx1,tfirst) || ki>0)
	  {
	     tangdot = s6scpr(stangprev, sderc+kdimc, kdimc);
	     while (tangdot < DZERO)
	     {
		/* The step is not legal. Reduce step length. */

		if (ki == 0)
		{
		   tx2 = tx;
		   tx = (tx1 + tx2)/(double)2.0;
		}
		else
		{
		   tx2 = tx1 + (double)0.75*(tx2-tx1);
		   tx = tx2;
		}

		/* Make point sderc at curve at tx */

		fevalc (pcurve, kderc, tx, &kleftc, sderc, &kstat);
		if (kstat < 0) goto error;

		tangdot = s6scpr(stangprev, sderc+kdimc, kdimc);
	     }
	  }
	  /* Find closest point on surface to sderc */

	  qpoint = newPoint (sderc, kdimc, 0);
	  if (qpoint == SISL_NULL)
	    goto err101;

	  snext2[0] = snext[0];
	  snext2[1] = snext[1];
	  s1773 (qpoint, psurf, aepsge, sstart, send, snext2, spos, &kstat);
	  if (kstat < 0)
	    goto error;

	  freePoint (qpoint);
	  qpoint = SISL_NULL;

	  /* Check to see if we have crossed an edge of the
	     surface, i.e. we have gone outside the parameter
	     area for psurf. */

          if(spos[0] <= st1[kk1-1] || spos[0] >= st1[kn1] ||
             spos[1] <= st2[kk2-1] || spos[1] >= st2[kn2])
          {
	      /* Coincidence! Finish with a message. */
	      goto edge_of_surf;
	  }

	  /* Calculate point and derivatives in surface */

	  s1421 (psurf, kders, spos, &kleft1, &kleft2, sders, snorm, &kstat);
	  if (kstat < 0)
	    goto error;

	  /* Check if point on curve and surface are within positional and
             angular tolerances */

	  tdist = s6dist (sderc, sders, kdimc);

	  if (tdist > aepsge)
	    {
	      /* Points not within tolerances, curve and surface do not
	         coincide */
	      goto no_coin;
	    }

	  /* Check if any parameter lines of the surface is crossed in the 1.
             parameter direction.  */

	  if (kleft1 != kleft1prev &&
	      ((DNEQUAL(spos[0]+tref,st1[kleft1]+tref) &&
		DNEQUAL(snext[0]+tref,st1[kleft1]+tref)) ||
	       kleft1 != kleft1prev+1) &&
	      ((DNEQUAL(snext[0]+tref,st1[kleft1prev]+tref) &&
		DNEQUAL(spos[0]+tref,st1[kleft1prev]+tref)) ||
	       kleft1 != kleft1prev - 1))
	    {
	      /* At least one parameter line is crossed. Fetch the constant parameter
	         curve at the closest parameter line in the direction of the marching. */

	      if (kleft1 > kleft1prev)
		kpar = kleft1prev + 1;
	      else if (snext[0] != st1[kleft1prev])
		kpar = kleft1prev;
	      else
		kpar = kleft1prev - 1;

	      /* Pick constant parameter curve.   */

	      s1437 (psurf, st1[kpar], &qc, &kstat);
	      if (kstat < 0)
		goto error;

	      /* Find the closest point between the input curve and the constant
	         parameter curve.    */

		/* UJK Oct 91, Nice trap ! tx1 > tx */
		/*  s1770 (pcurve, qc, aepsge, tx1, st2[kk2 - 1], tx, st2[kn2], (tx1 + tx) / (double) 2.0,
		     st2[kleft2], &tclose1, &tclose2, &kstat); */
	       s1770 (pcurve, qc, aepsge, min(tx1,tx), st2[kk2 - 1], max(tx1,tx),
		      st2[kn2], (tx1 + tx) / (double) 2.0,
		     (double)0.5*(st2[kleft2]+st2[kleft2+1]),
		     &tclose1, &tclose2, &kstat);
	      if (kstat < 0)
		goto error;

	      if (kstat == 2 || fabs(tclose1-tx1) < REL_PAR_RES)
		 /* No intersection point is found. Mark that surface-point
		    iteration is necessary.  */

		 kiterate = 1;
	      else kiterate = 0;

	      /* Set new parameter values to the iteration.  */

	      spos[0] = st1[kpar];
	      spos[1] = tclose2;
	      if (fabs(tclose1-tx1) > REL_PAR_RES) tx2 = tclose1;

	      /* Test midpoint of reduced step. First evaluate curve in midpoint. */

	      tx = (tx1 + tx2) / (double) 2.0;

	      fevalc (pcurve, kderc, tx, &kleftc, sderc, &kstat);
	      if (kstat < 0) goto error;

	      /* Find closest point on surface to sderc */

	      qpoint = newPoint (sderc, kdimc, 0);
	      if (qpoint == SISL_NULL)
		goto err101;

	      snext2[0] = snext[0];
	      snext2[1] = snext[1];
	      s1773 (qpoint, psurf, aepsge, sstart, send, snext2, snext2, &kstat);
	      if (kstat < 0)
		goto error;

	      freePoint (qpoint);
	      qpoint = SISL_NULL;

	      /* Calculate point and derivatives in surface */

	      s1421 (psurf, kders, snext2, &kleft1, &kleft2, sders, snorm, &kstat);
	      if (kstat < 0)
		goto error;

	      /* Check if point on curve and surface are within positional and
	         angular tolerances */

	      tdist = s6dist (sderc, sders, kdimc);

	      if (tdist > aepsge)
		{
		  /* Points not within tolerances, curve and surface do not
		     coincide */
		  goto no_coin;
		}

	      /* Calculate point and derivatives in the curve in the endpoint of the step. */

	      fevalc (pcurve, kderc, tx2, &kleftc, sderc, &kstat);
	      if (kstat < 0) goto error;

	      if (kiterate)
	      {
		 /* Relax the point on the curve down to the surface. */

		 qpoint = newPoint (sderc, kdimc, 0);
		 if (qpoint == SISL_NULL)
		    goto err101;

		 spos[0] = snext2[0];
		 spos[1] = snext2[1];
		 s1773 (qpoint, psurf, aepsge, sstart, send, spos, spos, &kstat);
		 if (kstat < 0)
		    goto error;

		 freePoint (qpoint);
		 qpoint = SISL_NULL;
	      }

	      /* Calculate point and derivatives in the surface.  */

	      s1421 (psurf, kders, spos, &kleft1, &kleft2, sders, snorm, &kstat);
	      if (kstat < 0)
		goto error;

	      /* Check if point on curve and surface are within positional and
	         angular tolerances */

	      tdist = s6dist (sderc, sders, kdimc);

	      if (tdist > aepsge)
		{
		  /* Points not within tolerances, curve and surface do not
		     coincide */
		  goto no_coin;
		}

	      /* Mark that a new step is to be initiated.  */

	      ki = 2;

	      /* Free constant parameter curve.  */

	      if (qc != SISL_NULL)
		freeCurve (qc);
	      qc = SISL_NULL;
	    }

	  /* Check if any parameter lines of the surface is crossed in the 2.
             parameter direction.  */

	  if (kleft2 != kleft2prev &&
	      ((DNEQUAL(spos[1]+tref,st2[kleft2]+tref) &&
		DNEQUAL(snext[1]+tref,st2[kleft2]+tref)) ||
	       kleft2 != kleft2prev+1) &&
	      ((DNEQUAL(snext[1]+tref,st2[kleft2prev]+tref) &&
		DNEQUAL(spos[1]+tref,st2[kleft2prev]+tref)) ||
	       kleft2 != kleft2prev - 1))
	    {
	      /* At least one parameter line is crossed. Fetch the constant parameter
	         curve at the closest parameter line in the direction of the marching. */

	      if (kleft2 > kleft2prev)
		kpar = kleft2prev + 1;
	      else if (snext[1] != st2[kleft2prev])
		kpar = kleft2prev;
	      else
		kpar = kleft2prev - 1;

	      /* Pick constant parameter curve.   */

	      s1436 (psurf, st2[kpar], &qc, &kstat);
	      if (kstat < 0)
		goto error;

	      /* Find the closest point between the input curve and the constant
	         parameter curve.    */

		/* UJK Oct 91, Nice trap ! tx1 > tx */
		s1770 (pcurve, qc, aepsge, min(tx1,tx), st1[kk1 - 1], max(tx,tx1),
		       st1[kn1], (tx1 + tx) / (double) 2.0,
		       (double)0.5*(st1[kleft1]+st1[kleft1+1]),
		       &tclose1, &tclose2, &kstat);
	      if (kstat < 0)
		goto error;

	      if (kstat == 2 || fabs(tclose1-tx1) < REL_PAR_RES)
		 /* No intersection point is found. Mark that surface-point
		    iteration is necessary.  */

		 kiterate = 1;
	      else kiterate = 0;

	      /* Set new parameter values to the iteration.  */

	      spos[0] = tclose2;
	      spos[1] = st2[kpar];
	      if (fabs(tclose1-tx1) > REL_PAR_RES) tx2 = tclose1;

	      /* Test midpoint of reduced step. First evaluate curve in midpoint. */

	      tx = (tx1 + tx2) / (double) 2.0;

	      fevalc (pcurve, kderc, tx, &kleftc, sderc, &kstat);
	      if (kstat < 0) goto error;

	      /* Find closest point on surface to sderc */

	      qpoint = newPoint (sderc, kdimc, 0);
	      if (qpoint == SISL_NULL)
		goto err101;

	      snext2[0] = snext[0];
	      snext2[1] = snext[1];
	      s1773 (qpoint, psurf, aepsge, sstart, send, snext2, snext2, &kstat);
	      if (kstat < 0)
		goto error;

	      freePoint (qpoint);
	      qpoint = SISL_NULL;

	      /* Calculate point and derivatives in surface */

	      s1421 (psurf, kders, snext2, &kleft1, &kleft2, sders, snorm, &kstat);
	      if (kstat < 0)
		goto error;

	      /* Check if point on curve and surface are within positional and
	         angular tolerances */

	      tdist = s6dist (sderc, sders, kdimc);

	      if (tdist > aepsge)
		{
		  /* Points not within tolerances, curve and surface do not
		     coincide */
		  goto no_coin;
		}

	      /* Calculate point and derivatives in the curve.    */

	      fevalc (pcurve, kderc, tx2, &kleftc, sderc, &kstat);
	      if (kstat < 0) goto error;

	      if (kiterate)
	      {
		 /* Relax the point on the curve down to the surface. */

		 qpoint = newPoint (sderc, kdimc, 0);
		 if (qpoint == SISL_NULL)
		    goto err101;

		 spos[0] = snext2[0];
		 spos[1] = snext2[1];
		 s1773 (qpoint, psurf, aepsge, sstart, send, spos, spos, &kstat);
		 if (kstat < 0)
		    goto error;

		 freePoint (qpoint);
		 qpoint = SISL_NULL;
	      }


	      /* Calculate point and derivatives in the surface.  */

	      s1421 (psurf, kders, spos, &kleft1, &kleft2, sders, snorm, &kstat);
	      if (kstat < 0)
		goto error;

	      /* Check if point on curve and surface are within positional and
	         angular tolerances */

	      tdist = s6dist (sderc, sders, kdimc);

	      if (tdist > aepsge)
		{
		  /* Points not within tolerances, curve and surface do not
		     coincide */
		  goto no_coin;
		}

	      /* Mark that a new step is to be initiated.  */

	      ki = 2;

	      /* Free constant parameter curve.  */

	      if (qc != SISL_NULL)
		freeCurve (qc);
	      qc = SISL_NULL;
	    }

	  /* Save tangent of curve.  */

	  memcopy(stangprev, sderc+kdimc, kdimc, DOUBLE);
	}
    }

  /* Coincidence interval along complete curve. */

  *jstat = 1;
  if (icur == 1)
    {
      elast[0] = tx1;
      elast[1] = snext[0];
      elast[2] = snext[1];
    }
  else
    {
      elast[0] = snext[0];
      elast[1] = snext[1];
      elast[2] = tx1;
    }
  goto out;

  /* Curve and surface not within tolerance */
no_coin:*jstat = 0;
  if (icur == 1)
    {
      elast[0] = tx1;
      elast[1] = snext[0];
      elast[2] = snext[1];
      enext[0] = tx2;
      enext[1] = spos[0];
      enext[2] = spos[1];
    }
  else
    {
      elast[0] = snext[0];
      elast[1] = snext[1];
      elast[2] = tx1;
      enext[0] = spos[0];
      enext[1] = spos[1];
      enext[2] = tx2;
    }
  goto out;

  /* Curve and surface are within tolerance up to an edge
     of the surface. */
edge_of_surf:
  *jstat = 2;
  if (icur == 1)
    {
      elast[0] = tx1;
      elast[1] = snext[0];
      elast[2] = snext[1];
      enext[0] = tx2;
      enext[1] = spos[0];
      enext[2] = spos[1];
    }
  else
    {
      elast[0] = snext[0];
      elast[1] = snext[1];
      elast[2] = tx1;
      enext[0] = spos[0];
      enext[1] = spos[1];
      enext[2] = tx2;
    }
  goto out;

  /* Error in memory allocation */

err101:*jstat = -101;
  s6err ("sh1784", *jstat, kpos);
  goto out;

  /* Error in input, dimension not equal to 2 or 3 */

err105:*jstat = -105;
  s6err ("sh1784", *jstat, kpos);
  goto out;

  /* Error in lower level function */

error:*jstat = kstat;
  s6err ("sh1784", *jstat, kpos);
  goto out;


out:

  return;
}


//===========================================================================
void sh1779 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** rintdat, SISLIntpt * pintpt, int *jnewpt, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int ki;			/* Counters.                               */
  int kleft1 = 0, kleft2 = 0;	/* Parameters to the evaluator.            */
  int kdim;			/* Dimension of geometry space.            */
  int kpos = 0;			/* Current position in int.pt. array.      */
  int kpar1, kpar2;		/* Index of parameter value of object.     */
  int kn;			/* Number of vertices of curve.            */
  int kk;			/* Order of curve.                         */
  int kmarch = 0;		/* Indicates if marching is necessary.     */
  int lleft[2];			/* Array storing pre-topology information. */
  int lright[2];		/* Array storing pre-topology information. */
  int *ll1, *ll2, *lr1, *lr2;	/* Pointers into pre-topology arrays.   */
  double tref;			/* Referance value in equality test.       */
  double *st;			/* Knot vector of curve.                   */
  double sder[9];		/* Result of curve evaluation.             */
  double stang[3];		/* Tangent vector of curve.                */
  double snorm[3];		/* Normal vector of surface.               */
  double slast[3];		/* Last parameter value of coincidence.    */
  double snext[3];		/* First parameter value outside interval
			           of coincidence.                         */
  double *ret_val;		/* Pointer to geo data from sh6getgeom     */
  double *ret_norm;		/* Pointer to geo data from sh6getgeom     */
  double *sptpar = pintpt->epar;/* Pointer to parameter values of int.pt.  */
  SISLCurve *qc;		/* Pointer to the curve.                   */
  SISLSurf *qs;			/* Pointer to the surface.                 */
  SISLIntpt *uintpt[2];		/* Array containing new intersection points. */
  SISLIntpt *qpt1, *qpt2;	/* Intersection points in list.            */
  double *nullp = SISL_NULL;
  double sf_low_lim[2];
  double sf_high_lim[2];

  /* Don't make pretop for help points ! */
  if (sh6ishelp (pintpt))
    {
      *jstat = 0;
      goto out;
    }

  /* Set pointers into the arrays storing pre-topology information. */

  if (po1->iobj == SISLCURVE)
    {
      qc = po1->c1;
      qs = po2->s1;

      kpar1 = 0;
      kpar2 = 1;
      ll1 = lleft;
      lr1 = lright;
      ll2 = lleft + 1;
      lr2 = lright + 1;
    }
  else
    {
      qc = po2->c1;
      qs = po1->s1;

      kpar1 = 2;
      kpar2 = 0;
      ll1 = lleft + 1;
      lr1 = lright + 1;
      ll2 = lleft;
      lr2 = lright;
    }

  /* Get pre-topology of intersection point.  */
  sh6gettop (pintpt, -1, lleft, lright, lleft + 1, lright + 1, &kstat);

  /* Describe curve partly by local parameters. */

  kdim = qc->idim;
  kk = qc->ik;
  kn = qc->in;
  st = qc->et;
  tref = st[kn] - st[kk - 1];

  sf_low_lim[0] = qs->et1[qs->ik1 - 1] + REL_COMP_RES;
  sf_low_lim[1] = qs->et2[qs->ik2 - 1] + REL_COMP_RES;
  sf_high_lim[0] = qs->et1[qs->in1] - REL_COMP_RES;
  sf_high_lim[1] = qs->et2[qs->in2] - REL_COMP_RES;

  /* Fetch geometry information, curve.  */
  sh6getgeom ((po1->iobj == SISLCURVE) ? po1 : po2,
	      (po1->iobj == SISLCURVE) ? 1 : 2,
	      pintpt, &ret_val, &ret_norm, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  /* Local copy of curve tangent */
  memcopy (stang, ret_val + kdim, kdim, DOUBLE);

  /* Fetch geometry information, surface.  */
  sh6getgeom ((po1->iobj == SISLSURFACE) ? po1 : po2,
	      (po1->iobj == SISLSURFACE) ? 1 : 2,
	      pintpt, &ret_val, &ret_norm, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  /* Local copy of surface normal */
  memcopy (snorm, ret_norm, kdim, DOUBLE);


  /* (ALA) Test if local information may be used to compute pre-topology. */
  s6length (snorm, kdim, &kstat);
  s6length (snorm, kdim, &ki);

  if (!kstat || !ki || fabs (PIHALF - s6ang (snorm, stang, kdim)) < 0.05)
    {
      /* Check if the intersection point lies at the start point of
         the curve. */

      if (DEQUAL (sptpar[kpar1] + tref, st[kn] + tref))
	;
      else
	{
	  /* Check if the intersection point is member of a list
             in this parameter direction of the curve. */

	  qpt1 = qpt2 = SISL_NULL;
	  kmarch = 1;

	  /* UPDATE (ujk) : only one list ? */
	  sh6getnhbrs (pintpt, &qpt1, &qpt2, &kstat);
	  if (kstat < 0)
	    goto error;

	  kmarch = 0;
	  if (qpt1 != SISL_NULL && qpt1->epar[kpar1] > sptpar[kpar1])
	    *lr1 = SI_ON;
	  else if (qpt2 != SISL_NULL && qpt2->epar[kpar1] > sptpar[kpar1])
	    *lr1 = SI_ON;
	  else
	    kmarch = 1;
	}

      if (kmarch)
	{
	  /* Perform marching to compute pre-topology. March first in the
             positive direction of the curve.  */

	  sh1784 (qc, qs, aepsge, sptpar, (kpar1 == 0), 1, slast, snext, &kstat);
	  if (kstat < 0)
	    goto error;

	  if (kstat == 1)
	    {
	      /* The endpoint of the curve is reached. */
	      ;
	    }
	  else if (kstat == 2)
	    ;
	  else
	    {

	      if (slast[kpar2] > sf_high_lim[0] ||
		  slast[kpar2 + 1] > sf_high_lim[1] ||
		  slast[kpar2] < sf_low_lim[0] ||
		  slast[kpar2 + 1] < sf_low_lim[1])
		;
	      else
		{


		  /* Create help point. First fetch geometry information. */

		  s1221 (qc, 0, slast[kpar1], &kleft1, sder, &kstat);
		  if (kstat < 0)
		    goto error;

		  s1221 (qc, 0, snext[kpar1], &kleft1, sder + kdim, &kstat);
		  if (kstat < 0)
		    goto error;
		  s6diff (sder + kdim, sder, kdim, stang);

		  s1421 (qs, 1, slast + kpar2, &kleft1, &kleft2, sder, snorm, &kstat);
		  if (kstat < 0)
		    goto error;

		  /* Discuss tangent- and normal vector, and set up pre-topology
	             in one direction of the curve. 		   */

		  if (s6scpr (snorm, stang, kdim) > DZERO)
		    *lr1 = SI_OUT;
		  else
		    *lr1 = SI_IN;

		  /* UPDATE (ujk) : Tuning on distance */
		  if (s6dist (sptpar, slast, 3) > (double) 0.05 * tref)
		    {
		      /* Create help point. Set pre-topology data as undefined. */
		      /* UPDATE (ujk) : If calculated values is stored, kder must
		         be 1 for curve and 2 for surface (sh6getgeom). Should
		         shevalc be used in stead of s1221 ? */

		      uintpt[kpos] = SISL_NULL;
		      if ((uintpt[kpos] = hp_newIntpt (3, slast, DZERO, -SI_ORD,
					      lleft[0], lright[0], lleft[1],
				    lright[1], 0, 0, nullp, nullp)) == SISL_NULL)
			goto err101;

		      kpos++;
		    }
		}
	    }
	}

      /* Check if the intersection point lies at the end point of
         the curve. */

      kmarch = 0;
      if (DEQUAL (sptpar[kpar1] + tref, st[kk - 1] + tref))
	;
      else
	{
	  /* Check if the intersection point is member of a list
             in this parameter direction of the curve. */

	  qpt1 = qpt2 = SISL_NULL;
	  kmarch = 1;

	  /* UPDATE (ujk) : only one list ? */
	  /* UPDATE (ujk) : only one list ? */
	  sh6getnhbrs (pintpt, &qpt1, &qpt2, &kstat);
	  if (kstat < 0)
	    goto error;

	  kmarch = 0;
	  if (qpt1 != SISL_NULL && qpt1->epar[kpar1] < sptpar[kpar1])
	    *ll1 = SI_ON;
	  else if (qpt2 != SISL_NULL && qpt2->epar[kpar1] < sptpar[kpar1])
	    *ll1 = SI_ON;
	  else
	    kmarch = 1;

	}

      if (kmarch)
	{
	  /* March in the negative direction of the curve. */

	  sh1784 (qc, qs, aepsge, sptpar, (kpar1 == 0), -1, slast, snext, &kstat);
	  if (kstat < 0)
	    goto error;

	  if (kstat == 1)
	    {
	      /* The endpoint of the curve is reached. */
	      ;
	    }
	  else if (kstat == 2)
	    ;
	  else
	    {
	      if (slast[kpar2] > sf_high_lim[0] ||
		  slast[kpar2 + 1] > sf_high_lim[1] ||
		  slast[kpar2] < sf_low_lim[0] ||
		  slast[kpar2 + 1] < sf_low_lim[1])
		;
	      else
		{

		  /* Create help point. First fetch geometry information. */

		  s1221 (qc, 0, slast[kpar1], &kleft1, sder, &kstat);
		  if (kstat < 0)
		    goto error;

		  s1221 (qc, 0, snext[kpar1], &kleft1, sder + kdim, &kstat);
		  if (kstat < 0)
		    goto error;
		  s6diff (sder + kdim, sder, kdim, stang);

		  s1421 (qs, 1, slast + kpar2, &kleft1, &kleft2, sder, snorm, &kstat);
		  if (kstat < 0)
		    goto error;

		  /* Discuss tangent- and normal vector, and set up pre-topology
	             in one direction of the curve. 		   */

		  if (s6scpr (snorm, stang, kdim) > DZERO)
		    *ll1 = SI_OUT;
		  else
		    *ll1 = SI_IN;

		  /* UPDATE (ujk) : Tuning on distance */
		  if (s6dist (sptpar, slast, 3) > (double) 0.05 * tref)
		    {
		      /* Create help point. Set pre-topology data as undefined. */
		      /* UPDATE (ujk) : If calculated values is stored, kder must
		         be 1 for curve and 2 for surface (sh6getgeom). Should
		         shevalc be used in stead of s1221 ? */

		      uintpt[kpos] = SISL_NULL;
		      if ((uintpt[kpos] = hp_newIntpt (3, slast, DZERO, -SI_ORD,
					      lleft[0], lright[0], lleft[1],
				    lright[1], 0, 0, nullp, nullp)) == SISL_NULL)
			goto err101;

		      kpos++;
		    }
		}
	    }
	}
    }
  else
    {
      /* Pre-topology data of the curve may be computed from
         local information. */

      if (s6scpr (snorm, stang, kdim) > DZERO)
	{
	  *ll1 = SI_IN;
	  *lr1 = SI_OUT;
	}
      else
	{
	  *ll1 = SI_OUT;
	  *lr1 = SI_IN;
	}

    }

  /* Update pre-topology of intersection point.  */
  /* UPDATE (ujk), index = -1 ?? */
  sh6settop (pintpt, -1, lleft[0], lright[0], lleft[1], lright[1], &kstat);

  /* Join intersection points, and set pretopology of help points.  */

  for (ki = 0; ki < kpos; ki++)
    {
      /* Help point ? */
      if (sh6ishelp (uintpt[ki]))
	sh6settop (uintpt[ki], -1, *(pintpt->left_obj_1), *(pintpt->right_obj_1),
		   *(pintpt->left_obj_2), *(pintpt->right_obj_2), &kstat);

      sh6idcon (rintdat, &uintpt[ki], &pintpt, &kstat);
      if (kstat < 0)
	goto error;
    }

  /* Pre-topology information computed. */

  *jnewpt = kpos;
  *jstat = 0;
  goto out;

  /* Error in scratch allocation.  */

err101:*jstat = -101;
  goto out;


  /* Error lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
  return;
}


//===========================================================================
void sh1787 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** rintdat, SISLIntpt * pintpt, int *jnewpt, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int kdim;			/* Dimension of geometry space.              */
  int kn1;			/* Nmb vertices of surface in 1st direc.     */
  int kn2;			/* Nmb vertices of surface in 1st direc.     */
  int kk1;			/* Order of surface in 1st direction.        */
  int kk2;			/* Order of surface in 1st direction.        */
  int kpos = 0;			/* Current position in int.pt. array.        */
  int lleft[2];			/* Array storing pre-topology information.   */
  int lright[2];		/* Array storing pre-topology information.   */
  int *ll1, *ll2, *lr1, *lr2;	/* Pointers into pre-topology arrays.        */
  double tpoint[3];		/* Value of point to intersect.              */
  double sder[21];		/* Result of surface evaluation.             */
  double *st1;			/* First knot vector of surface.             */
  double *st2;			/* Second knot vector of surface.            */
  double tref1;			/* Referance value in equality test.         */
  double tref2;			/* Referance value in equality test.         */
  SISLSurf *qs;		        /* Pointer to current surface.               */
  double *ret_val;		/* Pointer to geo data from sh6getgeom       */
  double *ret_norm;		/* Pointer to geo data from sh6getgeom       */
  int i;                        /* Loop variable.                            */
  double cross;                 /* utang x vtang.                            */
  double in_out[2];             /* To be used in touchy situations           */
  /* ----------------------------------------------------------------------  */

  /* Don't make pretop for help points ! */
  /* Oh, yes ?, 2D is some nice case ! */
  /* if (sh6ishelp (pintpt))
     {
     *jstat = 0;
     goto out;
     }
     */

  /* Set pointers into the arrays storing pre-topology information. */
  if (po1->iobj == SISLSURFACE)
    {
      ll1 = lleft;
      lr1 = lright;
      ll2 = lleft + 1;
      lr2 = lright + 1;
    }
  else
    {
      ll1 = lleft + 1;
      lr1 = lright + 1;
      ll2 = lleft;
      lr2 = lright;
    }

  /* Get pre-topology information. */
  sh6gettop (pintpt, -1, lleft, lright, lleft + 1, lright + 1, &kstat);
  if (kstat < 0)
    goto error;

  /* Test dimension of geometry space. */
  if (po1->iobj == SISLSURFACE)
      qs = po1->s1;
  else
      qs = po2->s1;

  kdim = qs->idim;
  if (kdim != 2)
    goto err106;

  /* Store surface information in local parameters. */

  kn1 = qs->in1;
  kn2 = qs->in2;
  kk1 = qs->ik1;
  kk2 = qs->ik2;
  st1 = qs->et1;
  st2 = qs->et2;
  tref1 = st1[kn1] - st1[kk1 - 1];
  tref2 = st2[kn2] - st2[kk2 - 1];

  /* Fetch geometry information, point.  */
  sh6getgeom ((po1->iobj == SISLPOINT) ? po1 : po2,
	      (po1->iobj == SISLPOINT) ? 1 : 2,
	      pintpt, &ret_val, &ret_norm, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  for(i=0; i<kdim; i++)
      tpoint[i]=ret_val[i];


  /* Fetch geometry information, surface.  */
  sh6getgeom ((po1->iobj == SISLSURFACE) ? po1 : po2,
	      (po1->iobj == SISLSURFACE) ? 1 : 2,
	      pintpt, &ret_val, &ret_norm, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  for(i=0; i<kdim*3; i++)
       sder[i]=ret_val[i];

/* Set normal vector from the 2D tangent vectors. */

  cross = sder[kdim]*sder[2*kdim+1] + sder[kdim+1]*sder[2*kdim];

  /*  Could improve this test. */
  if (fabs(cross) > ANGULAR_TOLERANCE)
    {
      /* Compute pre-topology using local information.  */

      if (cross > 0)
	{
	  *ll1 = SI_UNDEF;
	  *lr1 = SI_UNDEF;
	  *ll2 = SI_IN;
	  *lr2 = SI_OUT;
	}
      else
	{
	  *ll1 = SI_UNDEF;
	  *lr1 = SI_UNDEF;
	  *ll2 = SI_OUT;
	  *lr2 = SI_IN;
	}

    }
  else if (qs->pdir && qs->pdir->ecoef &&
	   (DNEQUAL(qs->pdir->ecoef[0],DZERO) ||
	    DNEQUAL(qs->pdir->ecoef[1],DZERO)))
    {
       /* March to find help points.
	   Not implemented yet. */
       /* UJK, I'm not sure, but something like this should work :
	  Remeber we are in a simple case situation !
	  */
       in_out[0] =  (double)1.0;
       in_out[1] = -(double)1.0;

       if (s6scpr(qs->pdir->ecoef,in_out,kdim) > 0)
	  {
	     *ll1 = SI_UNDEF;
	     *lr1 = SI_UNDEF;
	     if (*ll2 == SI_UNDEF &&
		 *lr2 == SI_UNDEF)
	     {
		*ll2 = SI_IN;
		*lr2 = SI_OUT;
	     }
	     else if (!((*ll2 == SI_IN && *lr2 == SI_IN) ||
		      (*ll2 == SI_OUT && *lr2 == SI_OUT)))
		{
		   if (*ll2 != SI_IN) *ll2 = SI_IN;
		}
	  }
	  else
	  {
	     *ll1 = SI_UNDEF;
	     *lr1 = SI_UNDEF;
	     if (*ll2 == SI_UNDEF &&
		 *lr2 == SI_UNDEF)
	     {
		*ll2 = SI_OUT;
		*lr2 = SI_IN;
	     }
	     else if (!((*ll2 == SI_IN && *lr2 == SI_IN) ||
		      (*ll2 == SI_OUT && *lr2 == SI_OUT)))
		{
		   if (*lr2 != SI_IN) *lr2 = SI_IN;
		}
	  }

    }

  /* Update pretopology of intersection point.  */

  sh6settop (pintpt, -1, lleft[0], lright[0], lleft[1], lright[1], &kstat);
  if (kstat < 0)
    goto error;

  /* Pre-topology information computed. */

  *jnewpt = kpos;
  *jstat = 0;
  goto out;

  /* Error in input. Incorrect dimension.  */

err106:*jstat = -106;
  goto out;

  /* Error lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
  return;
}



//===========================================================================
void sh1786 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** rintdat, SISLIntpt * pintpt, int *jnewpt, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int ki, kj;			/* Counters.                               */
  int kleft = 0;		/* Parameter to evaluator.                 */
  int korgleft = 0;		/* Knot index.                 		   */
  int kdim;			/* Dimension of geometry space.            */
  int kn;			/* Number of vertices of curve.            */
  int kk;			/* Order of curve.                         */
  int kpos = 0;			/* Current position in int.pt. array.      */
  double tpoint[3];		/* Value of point to intersect.            */
  double tpar0, tpar;		/* Parameter value of point on curve.      */
  double spar[1];		/* Parameter value of endpoint of curve.   */
  double sder[6];		/* Result of curve evaluation.             */
  double stang1[2];		/* Tangent vector of curve.                */
  double stang2[2];		/* Tangent vector of level value.          */
  double *st;			/* Pointer to knot vector of curve.        */
  double *sptpar = pintpt->epar;/* Pointer to parameter array of int.pt.   */
  double tref;			/* Referance value in equality test.       */
  SISLCurve *qc;		/* Pointer to current curve.               */
  SISLIntpt *uintpt[2];		/* Array storing new intersection points.  */
  double *ret_val;		/* Pointer to geo data from sh6getgeom     */
  double *ret_norm;		/* Pointer to geo data from sh6getgeom     */
  double *nullp = SISL_NULL;
  double dist;                  /* Distance from curve to point.           */
  double tot_ang;               /* Sum of angles between curve deriv. and 1*/
  int i;                        /* Loop variable.                          */
  int make_hp;                  /* Flag, make/not make help pt.            */
  /* --------------------------------------------------------------------- */

  /* Don't make help point for help points ! */
  if (sh6ishelp (pintpt))
    {
      *jstat = 0;
      goto out;
    }


  /* Test dimension of geometry space. */
  if (po1->iobj == SISLCURVE)
    {
      qc = po1->c1;
    }
  else
    {
      qc = po2->c1;
    }

  kdim = qc->idim;
  if (kdim != 2) goto err106;
	       
  /* Store curve information in local parameters. */

  kn = qc->in;
  kk = qc->ik;
  st = qc->et;
  tref = st[kn] - st[kk - 1];

  /* Fetch geometry information, point.  */
  sh6getgeom ((po1->iobj == SISLPOINT) ? po1 : po2,
	      (po1->iobj == SISLPOINT) ? 1 : 2,
	      pintpt, &ret_val, &ret_norm, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  for(i=0; i<kdim; i++)
      tpoint[i] = ret_val[i];

  /* Fetch geometry information, curve.  */
  sh6getgeom ((po1->iobj == SISLCURVE) ? po1 : po2,
	      (po1->iobj == SISLCURVE) ? 1 : 2,
	      pintpt, &ret_val, &ret_norm, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  s1219(st,kk,kn,&korgleft,sptpar[0],&kstat);
  if (kstat < 0) goto error;
  
  for(i=0; i<kdim*2; i++)
      sder[i] = ret_val[i];

/* Set tangent vectors. */

  stang1[0] = (double)1.0;
  stang2[0] = (double)1.0;
  stang2[1] = DZERO;
  tot_ang = (double)0.0;

  for(i=0; i<kdim; i++)
  {
      stang1[1] = sder[kdim+i];
      tot_ang += s6ang(stang1,stang2,2);
  }

  /*  tune */
  if (fabs(tot_ang) <= ANGULAR_TOLERANCE)
    {
      /* Test if the intersection point lies at the endpoint of
         the curve. */

      if (DEQUAL (sptpar[0] + tref, st[kn] + tref))
	{

	}
      else
	{
	  /* Find endpoint of coincidence interval in the positive
             direction of the curve. */
	  ki = 0;
	  tpar = sptpar[0] + (double) 2.0 *sqrt (aepsge);
	  tpar = min (tpar, st[kn]);
	  tpar0 = tpar = min (tpar, st[korgleft+1]);
	  shevalc (qc, 0, tpar, aepsge, &kleft, sder, &kstat);
          dist=s6dist(sder,tpoint,kdim);
          if (dist <= aepsge)
	    {
	       make_hp = TRUE;
	      for (ki = kleft - kk + 1; ki < kn; ki++)
		{
		  for (tpar = DZERO, kj = ki + 1; kj < ki + kk; kj++)
		    tpar += st[kj];
		  tpar /= (double) (kk - 1);

		  if (tpar > sptpar[0])
		    {
		      shevalc (qc, 0, tpar, aepsge, &kleft, sder, &kstat);
		      dist=s6dist(sder,tpoint,kdim);
		      if (dist > aepsge) break;
		      
		      tpar0 = tpar;  /* Store parameter value of 
					intersection point.          */
		    }
		}
	    }
	  else make_hp = FALSE;

	  /* Test if there is coincidence along the entire curve part. */

	  if (ki != kn && make_hp)
	    {
	      /* Create help point.  */
	       
	      spar[0] = tpar0;
	      uintpt[kpos] = SISL_NULL;
	      if ((uintpt[kpos] = hp_newIntpt (1, spar, DZERO, -SI_ORD,
					       SI_UNDEF, SI_UNDEF, SI_UNDEF,
				    SI_UNDEF, 0, 0, nullp, nullp)) == SISL_NULL)
		goto err101;

	      /* Insert the point into the data structure.  */

	      sh6idnpt (rintdat, &uintpt[kpos], 1, &kstat);
	      if (kstat < 0)
		goto error;

	      kpos++;
	    }
	}

      /* Test if the intersection point lies at the startpoint
         of the curve. */

      if (DEQUAL (sptpar[0] + tref, st[kk - 1] + tref))
	{
	}
      else
	{
	  /* Find endpoint of coincidence interval in the negative
             direction of the curve. */

	  ki = kn;
	  while (sptpar[0] == st[korgleft]) korgleft--;
	  tpar = sptpar[0] - (double) 2.0 *sqrt (aepsge);
	  tpar = max (tpar, st[kk - 1]);
	  tpar0 = tpar = max (tpar, st[korgleft]);	  
	  shevalc (qc, 0, tpar, aepsge, &kleft, sder, &kstat);
          dist=s6dist(sder,tpoint,kdim);
          if (dist <= aepsge)
	    {
	       make_hp = TRUE;
	       
	      for (ki = kleft; ki >= 0; ki--)
		{
		  for (tpar = DZERO, kj = ki + 1; kj < ki + kk; kj++)
		    tpar += st[kj];
		  tpar /= (double) (kk - 1);

		  if (tpar < sptpar[0])
		    {
		      shevalc (qc, 0, tpar, aepsge, &kleft, sder, &kstat);
		      dist=s6dist(sder,tpoint,kdim);
		      if (dist > aepsge) break;
		      
		      tpar0 = tpar;  /* Store parameter value of last
					found intersection point.  */
		    }
		}
	    }
	  else make_hp = FALSE;
	  
	  /* Test if there is coincidence along the entire curve part. */
	  if (ki >= 0 && make_hp)
	    {

	      /* Create intersection point.  */
	      spar[0] = tpar0;
	      uintpt[kpos] = SISL_NULL;
	      if ((uintpt[kpos] = hp_newIntpt (1, spar, DZERO, -SI_ORD,
					       SI_UNDEF,SI_UNDEF,SI_UNDEF,
					SI_UNDEF, 0, 0, nullp, nullp)) == SISL_NULL)
		goto err101;

	      /* Insert the point into the data structure.  */

	      sh6idnpt (rintdat, &uintpt[kpos], 1, &kstat);
	      if (kstat < 0)
		goto error;


	      kpos++;

	    }

	}
    }

  /* Join intersection points.  (kpos=0,1,2)*/
  for (ki = 0; ki < kpos; ki++)
    {
      sh6idnpt (rintdat, &uintpt[ki], 1, &kstat);
      if (kstat < 0)
	goto error;
      /* Mark that an intersection interval is found.  */
      if (sh6ishelp (uintpt[ki]) && uintpt[ki]->no_of_curves == 0)
	{
	  sh6idcon (rintdat, &uintpt[ki], &pintpt, &kstat);
	  if (kstat < 0)
	    goto error;
	}
    }

  /* Pre-topology information computed. */

  *jnewpt = kpos;
  *jstat = 0;
  goto out;

  /* Error in scratch allocation.  */

err101:*jstat = -101;
  goto out;

  /* Error in input. Incorrect dimension.  */

err106:*jstat = -106;
  goto out;

  /* Error lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
  return;
}


//===========================================================================
void s1307(double ep[],int idim,double egeo[],int *jstat)
//===========================================================================
{
  int k2dim=2*idim;   /* The dimension *2, Start of double derivative*/
  int kstat;          /* Local status variable                       */
  int ki,kj;          /* Variables in loop                           */
  double tlength;     /* Length of first derivative vector           */
  double tdum;        /* Dummy variable                              */
  
  /* Let c = c(w) be a parameterized curve.
   *  The curvature vector is defined as the derivative of the unit tangent
   *  vector with respect to the arc length a. If we don't have an arclength
   *  parametrization then this parametrization can be written as a function
   *  of the arc length w = w(a). By using the kernel rule for differentiation
   *  we get:
   *
   *         d            d       dw   d    c'(w)    dw   d    c'(w)      da
   *  k(a) = -- T(w(a)) = -- T(w) -- = -- ---------- -- = -- ---------- / --
   *         da           dw      da   dw sqrt(c'c') da   dw sqrt(c'c')   dw
   *
   *
   *         d       c'(w)                c"        c' (c'c'')
   *         -- ----------------- =   ---------- - ------------- 
   *         dw sqrt(c'(w) c'(w))     sqrt(c'c')   sqrt(c'c')**3
   *
   *
   *
   *         da
   *         -- = sqrt(c'c')
   *         dw 
   */
  
  /* Copy position */
  
  memcopy(egeo,ep,idim,DOUBLE);
  
  /* First we normalize the tangent vector */
  
  tlength = s6norm(ep+idim,idim,egeo+idim,&kstat);
  
  if (DEQUAL(tlength,(double)0.0)) goto war101;
  
  /* Make curvature vector */
  
  tdum = s6scpr(ep+k2dim,egeo+idim,idim)/tlength;
  
  for (ki=idim,kj=k2dim;ki<k2dim;ki++,kj++)
    {
      egeo[kj] = (ep[kj]/tlength - egeo[ki]*tdum)/tlength;
    }
  
  /* Make radius of curvature */
  
  tdum = s6length(egeo+k2dim,idim,&kstat);
  
  if (tdum!=DZERO && ((double)1.0/tdum) > MAXIMAL_RADIUS_OF_CURVATURE) 
    goto war101;
  
  if (DNEQUAL(tdum,(double)0.0))
    {
      egeo[3*idim] = (double)1.0/tdum;
    }
  else
    {
      goto war101;
    }
  
  /* Everyting is ok */
  
  *jstat = 0;
  goto out;
  
  /* Infinit radius of curvature */
  
 war101: *jstat=1;
  egeo[3*idim] = (double)-1.0;
  goto out;
  
 out:
  return;
}


//===========================================================================
void sh1992_s9mbox2(double ecoef[],int icoef1,int icoef2,double aeps1,
		    double aeps2,double e2max[],double e2min[])
//===========================================================================
{
  int ki,kj;             /* Counters.                                 */
  int kant = 4;          /* Number of box sides.                      */
  int kinset = 0;        /* Indicates if an inner box is found.       */
  double teps1 = aeps1+aeps1; /* Double tolerance in the inner.       */
  double teps2;               /* Tolerance at edge.                   */
  double teps3;               /* Double tolerance at edge.            */
  double t1,t2,t3;       /* To store elements of the rotation matrix. */
  double *tmin,*tmax;    /* Pointers used to traverse e2min and e2max.  */
  double sminin[4],smaxin[4];   /* Box boundaries in the inner.       */
  double sminedg[4],smaxedg[4]; /* Box boundaries at the edge.        */
  double *sc1,*sc2;      /* Pointers into coefficient array.          */
  
  /* Set tolerances at edge. If the tolerance is positive or dimension
     is 1D, the input tolerance is used, otherwise we must make sure 
     that the maximum distance from the total box at the edges to the
     reduced box is aeps2.                                             */
  
  if (aeps2 >= DZERO)
     teps2 = aeps2;
  else
     teps2 = (double)0.38268343*aeps2;   /* aeps2 * sin(PI/8).   */
  teps3 = teps2 + teps2;
 
  /* Initiate box boundaries of inner box.  */
  
  for (ki=0; ki<kant; ki++)
  {
     sminin[ki] = HUGE;
     smaxin[ki] = -HUGE;
  }
  
  /* Fetch value of first vertex.  */
  
  sc1 = ecoef;  sc2 = sc1 + 1;
  t1= ROTM * sc1[0];
  t2= ROTM * sc2[0];
  
  tmin = sminedg;
  tmax = smaxedg;
  *tmin = *tmax = *sc1;
  tmin++; tmax++;
  *tmin = *tmax = *sc2;
  tmin++; tmax++;
  *tmin = *tmax = t1-t2;
  tmin++; tmax++;
  *tmin = *tmax = t1+t2;
  
  /* For each vertex check and corrigate the box.  */
  
  for (ki=0,sc1+=2,sc2+=2; ki<icoef2; ki++)
     /* UJK, writing error */
     /*for (kj=(ki==1); kj<icoef1; kj++,sc1+=2,sc2+=2) */

     for (kj=(ki==0); kj<icoef1; kj++,sc1+=2,sc2+=2)
     {
	/* Set correct box boundaries.  */
	
	if (((ki==0 || ki==icoef2-1) && icoef2>1) ||
		  ((kj==0 || kj==icoef1-1) && icoef1>1))
	   tmin = sminedg,  tmax = smaxedg;
	else
	   kinset = 1,  tmin = sminin,  tmax = smaxin;
	
	t1= ROTM * sc1[0];
	t2= ROTM * sc2[0];

	if(*sc1 < *tmin) *tmin = *sc1;
	if(*sc1 > *tmax) *tmax = *sc1;
	tmin++; tmax++;
	if(*sc2 < *tmin) *tmin = *sc2;
	if(*sc2 > *tmax) *tmax = *sc2;
	tmin++; tmax++;
	t3= t1 - t2;
	if(t3 < *tmin) *tmin = t3;
	if(t3 > *tmax) *tmax = t3;
	tmin++; tmax++;
	t3= t1 + t2;
	if(t3 < *tmin) *tmin = t3;
	if(t3 > *tmax) *tmax = t3;
     }
  
  /* Merge the inner and the outer box, and adjust with the
     tolerance.  */
  
  if (!kinset)
  {
     memcopy(sminin,sminedg,kant,DOUBLE);
     memcopy(smaxin,smaxedg,kant,DOUBLE);
  }
  for (ki=0; ki<kant; ki++)
  {
     e2min[ki] = MIN(sminin[ki]-aeps1,sminedg[ki]-teps2);
     e2max[ki] = MAX(smaxin[ki]+aeps1,smaxedg[ki]+teps2);
     e2min[kant+ki] = MIN(sminin[ki]-teps1,sminedg[ki]-teps3);
     e2max[kant+ki] = MAX(smaxin[ki]+teps1,smaxedg[ki]+teps3);
  }
}

//===========================================================================
void sh1992_s9mbox(double ecoef[],int icoef1,int icoef2,int idim,
		   double aeps1,double aeps2,double e2max[],
		   double e2min[],int *jstat)
//===========================================================================
{
  int ki,ki1,kj;       /* Counters.  */
  int kant = idim;     /* Number of box sides.                        */
  int kinset = 0;      /* Indicates if the inner box is set.          */
  double noice = (double)100.0*REL_COMP_RES;   /* Noice killer.       */
  double teps1 = aeps1+aeps1; /* Double tolerance in the inner.       */
  double teps2;               /* Tolerance at edge.                   */
  double teps3;               /* Double tolerance at edge.            */
  double *tmin,*tmax;  /* Pointers into box boundary arrays.          */
  double *sc;          /* Pointer into coefficient array.             */
  double *sminin=SISL_NULL,*smaxin=SISL_NULL;  /* Box boundaries of the inner.  */
  double *sminedg=SISL_NULL,*smaxedg=SISL_NULL; /* Box boundaries of the edge.  */
  
  /* Set tolerances at edge. If the tolerance is positive or dimension
     is 1D, the input tolerance is used, otherwise we must make sure 
     that the maximum distance from the total box at the edges to the
     reduced box is aeps2.                                             */
  
  if (idim == 1 || aeps2 >= DZERO)
     teps2 = aeps2;
  else
     teps2 = aeps2/sqrt((double)idim);
  teps3 = teps2 + teps2;
  
  /* Allocate scratch for intermediate box arrays.  */
  
  if ((sminin = newarray(kant,double)) == SISL_NULL) goto err101;
  if ((smaxin = newarray(kant,double)) == SISL_NULL) goto err101;
  if ((sminedg = newarray(kant,double)) == SISL_NULL) goto err101;
  if ((smaxedg = newarray(kant,double)) == SISL_NULL) goto err101;
  
  /* Initiate box boundaries of inner box.  */
  
  for (ki=0; ki<kant; ki++)
  {
     sminin[ki] = HUGE;
     smaxin[ki] = -HUGE;
  }
  
  /* Fetch value of first vertex.  */
  
  for (ki = 0; ki < idim; ki++) 
     sminedg[ki] = smaxedg[ki] = ecoef[ki];
  
  /* For each vertice check and corrigate the box.  */
  
  for (sc=ecoef+idim, ki=0; ki<icoef2; ki++)
     for (kj=(ki==0); kj<icoef1; kj++)
     {
	/* Set correct box.  */
	
	if (((ki==0 || ki==icoef2-1) && icoef2>1) ||
		  ((kj==0 || kj==icoef1-1) && icoef1>1))
	   tmin = sminedg,  tmax = smaxedg;
	else 
	    kinset = 1,  tmin = sminin,  tmax = smaxin;
	
	for (ki1=0; ki1<idim; ki1++,sc++,tmin++,tmax++)
	{
	   if(*sc < *tmin) *tmin = *sc;
	   if(*sc > *tmax) *tmax = *sc;
	}
     }

  /* Merge the inner and the outer box, and adjust with the
     tolerance.  */
  
  if (!kinset)
  {
     memcopy(sminin,sminedg,kant,DOUBLE);
     memcopy(smaxin,smaxedg,kant,DOUBLE);
  }
  for (ki=0; ki<kant; ki++)
  {
     e2min[ki] = MIN(sminin[ki]-aeps1,sminedg[ki]-teps2);
     e2max[ki] = MAX(smaxin[ki]+aeps1,smaxedg[ki]+teps2);
     if (idim > 1)
     {
	e2min[kant+ki] = MIN(sminin[ki]-teps1,sminedg[ki]-teps3);
	e2max[kant+ki] = MAX(smaxin[ki]+teps1,smaxedg[ki]+teps3);
     }	
  }
  
  /* ALA and UJK 30.10.90, remove noice near by zero.  */
  
  if (idim == 1)
  {
     if (fabs(e2max[0]) < noice) e2max[0] = DZERO;
     if (fabs(e2min[0]) < noice) e2min[0] = DZERO;
  }
  
  *jstat = 0;
  goto out;
  
  /* Error in scratch allocation. */
  
  err101 : *jstat = -101;
  goto out;
  
  out :
  if (sminin != SISL_NULL) freearray(sminin);
  if (smaxin != SISL_NULL) freearray(smaxin);
  if (sminedg != SISL_NULL) freearray(sminedg);
  if (smaxedg != SISL_NULL) freearray(smaxedg);		       
}


//===========================================================================
void sh1992_s9mbox3(double ecoef[],int icoef1,int icoef2,double aeps1,
		    double aeps2,double e2max[],double e2min[])
//===========================================================================
{
  int ki,kj;             /* Counters.                                 */
  int kant = 9;          /* Number of box sides.                      */
  int kinset = 0;        /* Indicates if inner box is set.            */
  double teps1 = aeps1+aeps1; /* Double tolerance in the inner.       */
  double teps2;               /* Tolerance at edge.                   */
  double teps3;               /* Double tolerance at edge.            */
  double t1,t2,t3,t4;    /* To store elements of the rotation matrix. */
  double *tmin,*tmax;    /* Pointers used to traverse e2min and e2max.  */
  double sminin[9],smaxin[9];   /* Box boundaries in the inner.       */
  double sminedg[9],smaxedg[9]; /* Box boundaries at the edge.        */
  double *sc1,*sc2,*sc3; /* Pointers to coefficients.                 */
  
  /* Set tolerances at edge. If the tolerance is positive or dimension
     is 1D, the input tolerance is used, otherwise we must make sure 
     that the maximum distance from the total box at the edges to the
     reduced box is aeps2.                                             */
  
  if (aeps2 >= DZERO)
     teps2 = aeps2;
  else
     teps2 = (double)0.2767326953*aeps2; 
  teps3 = teps2 + teps2;

  /* Initiate box boundaries of inner box.  */
  
  for (ki=0; ki<kant; ki++)
  {
     sminin[ki] = HUGE;
     smaxin[ki] = -HUGE;
  }
  
  /* Fetch value of first vertex.  */
  
  sc1 = ecoef; sc2 = sc1+1;  sc3 = sc2 + 1;
  t1= ROTM * sc1[0];
  t2= ROTM * sc2[0];
  t3= ROTM * sc3[0];
  
  tmin = sminedg;
  tmax = smaxedg;
  *tmin = *tmax = *sc1;
  tmin++; tmax++;
  *tmin = *tmax = *sc2;
  tmin++; tmax++;
  *tmin = *tmax = *sc3;
  tmin++; tmax++;
  *tmin = *tmax = t2-t3;
  tmin++; tmax++;
  *tmin = *tmax = t2+t3;
  tmin++; tmax++;
  *tmin = *tmax = t1-t3;
  tmin++; tmax++;
  *tmin = *tmax = t1+t3;
  tmin++; tmax++;
  *tmin = *tmax = t1-t2;
  tmin++; tmax++;
  *tmin = *tmax = t1+t2;
  
  /* For each vertice at the edge check and corrigate the box.  */
  
  for (ki=0,sc1+=3,sc2+=3,sc3+=3; ki<icoef2; ki++)
     for (kj=(ki==0); kj<icoef1; kj++,sc1+=3,sc2+=3,sc3+=3)
     {
	
	/* Set correct pointers.  */ 
	
	if (((ki==0 || ki==icoef2-1) && icoef2>1) ||
		  ((kj==0 || kj==icoef1-1) && icoef1>1))
	   tmin = sminedg, tmax = smaxedg;
	else 
	   kinset = 1,  tmin = sminin,  tmax = smaxin;
	
	t1= ROTM * sc1[0];
	t2= ROTM * sc2[0];
	t3= ROTM * sc3[0];

	if(*sc1 < *tmin) *tmin = *sc1;
	if(*sc1 > *tmax) *tmax = *sc1;
	tmin++; tmax++;
	if(*sc2 < *tmin) *tmin = *sc2;
	if(*sc2 > *tmax) *tmax = *sc2;
	tmin++; tmax++;
	if(*sc3 < *tmin) *tmin = *sc3;
	if(*sc3 > *tmax) *tmax = *sc3;
	tmin++; tmax++;
	t4= t2 - t3;
	if(t4 < *tmin) *tmin = t4;
	if(t4 > *tmax) *tmax = t4;
	tmin++; tmax++;
	t4= t2 + t3;
	if(t4 < *tmin) *tmin = t4;
	if(t4 > *tmax) *tmax = t4;
	tmin++; tmax++;
	t4= t1 - t3;
	if(t4 < *tmin) *tmin = t4;
	if(t4 > *tmax) *tmax = t4;
	tmin++; tmax++;
	t4= t1 + t3;
	if(t4 < *tmin) *tmin = t4;
	if(t4 > *tmax) *tmax = t4;
	tmin++; tmax++;
	t4= t1 - t2;
	if(t4 < *tmin) *tmin = t4;
	if(t4 > *tmax) *tmax = t4;
	tmin++; tmax++;
	t4= t1 + t2;
	if(t4 < *tmin) *tmin = t4;
	if(t4 > *tmax) *tmax = t4;
     }
  
  /* Merge the inner and the outer box, and adjust with the
     tolerance.  */
  
  if (!kinset)
  {
     memcopy(sminin,sminedg,kant,DOUBLE);
     memcopy(smaxin,smaxedg,kant,DOUBLE);
  }
  for (ki=0; ki<kant; ki++)
  {
     e2min[ki] = MIN(sminin[ki]-aeps1,sminedg[ki]-teps2);
     e2max[ki] = MAX(smaxin[ki]+aeps1,smaxedg[ki]+teps2);
     e2min[kant+ki] = MIN(sminin[ki]-teps1,sminedg[ki]-teps3);
     e2max[kant+ki] = MAX(smaxin[ki]+teps1,smaxedg[ki]+teps3);
  }
}


//===========================================================================
void s6newbox(SISLbox *pbox,int inum,int itype,  double aepsge,int *jstat)
//===========================================================================
{
   int knum = (inum == 1) ? inum : 2*inum;  /* If the geometry space has
					       dimension larger than 1,
					       a double set of min- and
					       max-arrays is to be made. */

   if (itype < 0 || itype > 2) goto err126;
   
   /* Test no such box exist, create the necessary arrays.  */
   
   if (pbox->e2min[itype] == SISL_NULL)
   {
      if ((pbox->e2min[itype] = newarray(knum,DOUBLE)) == SISL_NULL) goto err101;
      if ((pbox->e2max[itype] = newarray(knum,DOUBLE)) == SISL_NULL) goto err101;
   }
  
   /* Set the tolerance. */
   
   if (itype != 0) pbox->etol[itype] = aepsge;
   
   *jstat = 0;
   goto out;
   
   /* Error in scratch allocation.  */
   
   err101 : *jstat = -101;
   goto out;
   
   /* Error in input.  Kind of box do not exist.  */
   
   err126 : *jstat = -126;
   goto out;
   
   out :
      return;
}


//===========================================================================
int s6existbox(SISLbox *pbox,int itype,double aepsge)
//===========================================================================
{
   if (pbox->e2min[itype] == SISL_NULL) return(0);  /* No box is made. */
   
   if (itype != 0 && DNEQUAL(pbox->etol[itype],aepsge))
      return(-1);  /* Box exist, but with another size of the expansion. */
   
   return(1);
}


//===========================================================================
SISLbox * newbox (int idim)
//===========================================================================
{
  SISLbox *qnew;		/* Local pointer to new direction structure.*/
  int ki;			/* Counter.                                 */
  int knum;			/* Number of corners in the box.	          */


  /* Initialise number of corners. */

  if (idim == 3)
    knum = 12;
  else if (idim == 2)
    knum = 4;
  else
    knum = idim;

  /* Allocate space for SISLbox structure.  */

  if ((qnew = newarray (1, SISLbox)) != SISL_NULL)
    {
      /* Initialise new direction structure. */

      qnew->imin = 0;
      qnew->imax = 0;

      /* Initialize arrays.  */

      for (ki = 0; ki < 3; ki++)
	{
	  qnew->e2max[ki] = SISL_NULL;
	  qnew->e2min[ki] = SISL_NULL;
	  qnew->etol[ki] = DZERO;
	}

      if ((qnew->emax = newarray (knum, double)) == SISL_NULL)
	{
	  freearray (qnew);
	  qnew = SISL_NULL;
	}
      else if ((qnew->emin = newarray (knum, double)) == SISL_NULL)
	{
	  freearray (qnew->emax);
	  freearray (qnew);
	  qnew = SISL_NULL;
	}
    }
  return (qnew);
}


//===========================================================================
void sh1992cu(SISLCurve *pc,int itype,double aepsge,int *jstat)
//===========================================================================
{
   int kstat = 0;                       /* Status variable.        */
   int kdim = pc->idim;                 /* Dimension of geometry space. */
   int ktype = itype % 10;              /* Kind of box.            */
   int knum;                            /* Number of sides of box. */
   int kbez = 0;                        /* Indicates if Bezier case. */
   double teps_inner;     /* Tolerance with which to expand in the inner. */
   double teps_edge;      /* Tolerance with which to expand at the edge.  */

   /* Set number of box sides.  */
   
   if (itype < 10 && kdim == 3) knum = 9;
   else if (itype < 10 && kdim == 2) knum = 4;
   else knum = kdim;
   
   /* Set correct tolerances.  */
   
   teps_inner = (ktype == 0) ? DZERO : (double)0.5*aepsge;
   teps_edge = (ktype == 2) ? -teps_inner : teps_inner;
   
   if (pc->pbox == SISL_NULL)
      if ((pc->pbox = newbox(pc->idim)) == SISL_NULL) goto err101;
   
   if (s6existbox(pc->pbox,ktype,aepsge) < 1)
   {
      /* The box do not exist already. In the Bezier case,
	 it is not necessary to expand in the inner of the curve.  */
      
      /* Create the box.  */
      
      s6newbox(pc->pbox,knum,ktype,aepsge,&kstat);
      if (kstat < 0) goto error;
		     
      if (pc->ik == pc->in) 
      {
          teps_inner = DZERO;
          kbez = 1;
      }
      
      /* Make the requested box. First allocate scratch for
	 box arrays.  */
      
      if (knum == 9) 
	 sh1992_s9mbox3(pc->ecoef,pc->in,1,teps_inner,teps_edge,
		 pc->pbox->e2max[ktype],pc->pbox->e2min[ktype]);
      else if (knum == 4)
	 sh1992_s9mbox2(pc->ecoef,pc->in,1,teps_inner,teps_edge,
		 pc->pbox->e2max[ktype],pc->pbox->e2min[ktype]);
      else
      {
	 sh1992_s9mbox(pc->ecoef,pc->in,1,kdim,teps_inner,teps_edge,
		pc->pbox->e2max[ktype],pc->pbox->e2min[ktype],&kstat);
	 if (kstat < 0) goto error;
       }
   }
  
  *jstat = kbez;
  goto out;
  
  /* Error in space allocation.  */
  
  err101 : *jstat = -101;
  goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  goto out;
  
 out:
    return;
}


//===========================================================================
void sh1783_s9relax(sh1783_fevalProc fevalc1,sh1783_fevalProc fevalc2,
		    SISLCurve * pc1, SISLCurve * pc2,int ider, double aepsge, 
		    double ax1, int *jleft1, double eder1[],double anext,
		    double *cx2, int *jleft2, double eder2[], int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.  */
  double tstart;		/* Start parameter value of curve 2.  */
  double tend;			/* End parameter value of curve 2.    */
  SISLPoint *qpoint = SISL_NULL;	/* SISLPoint instance used to represent point on curve 1. */

  /* Find endpoints of the parameter interval of curve 2.  */

  tstart = *(pc2->et + pc2->ik - 1);
  tend = *(pc2->et + pc2->in);

  /*  Make point sderc at curve at ax1 */

  fevalc1 (pc1, ider, ax1, jleft1, eder1, &kstat);
  if (kstat < 0) goto error;

  /* Find closest point on curve 2 to eder1 */

  qpoint = newPoint (eder1, pc1->idim, 0);
  if (qpoint == SISL_NULL) goto err101;

  s1771 (qpoint, pc2, aepsge, tstart, tend, anext, cx2, &kstat);
  if (kstat < 0)
    goto error;

  /* Calculate point and derivatives in second curve */

  fevalc2 (pc2, ider, *cx2, jleft2, eder2, &kstat);
  if (kstat < 0) goto error;

  *jstat = 0;
  goto out;

  /* Error in space allocation.  */

err101:
  *jstat = -101;
  goto out;

  /* Error in lower level routine.  */

error:
  *jstat = kstat;
  goto out;

out:
  if (qpoint != SISL_NULL)
    freePoint (qpoint);

  return;
}

//===========================================================================
void sh1783 (SISLCurve * pc1, SISLCurve * pc2, double aepsge, double epar[],
	     int idir1, int idir2, double elast[], double enext[], int *jstat)
//===========================================================================
{
  int kstat;			/* Status variable                                 */
  int ki;			/* Counter.                                        */
  int kleftc1 = 0;		/* Left indicator for point calculation of curve 1.*/
  int kleftc2 = 0;		/* Left indicator for point calculation of curve 2.*/
  int kk1, kk2, kn1, kn2;	/* Orders and number of vertices of curves         */
  int kdim;			/* The dimension of the space in which the curves lie. */
  int kpos = 0;			/* Position of error                               */
  int kderc = 2;		/* Number of derivatives to be claculated on the curves */
  int kdum;			/* Temporary variable                              */
  int kchange;			/* Indicates which curve that is marched along.
				   = 0 : First curve.
				   = 1 : Second curve.                             */
  double s3dinf1[20];		/* Pointer to storage for point info of curve 1
				    (10 dobules pr point when idim=3, 7 when idim=3) */
  double s3dinf2[20];		/* Pointer to storage for point info of curve 2
				    (10 dobules pr point when idim=3, 7 when idim=3) */
  double *st1;			/* Knot vector of first curve                      */
  double *st2;			/* Knot vector of second curve                     */
  double tfirst1, tfirst2;	/* First parameter value on curves              */
  double tend1, tend2;		/* Last parameter on curves                        */
  double sderc1[20];		/* Position, first and second derivatives on curve 1 */
  double sderc2[20];		/* Position, first and second derivatives on curve 2 */
  double tx, tx1, tx2;		/* Parameter values of first curve.  */
  double ty, ty1, ty2;		/* Parameter value of second curve.  */
  double tstep;			/* Final step length     */
  double txstep, tystep;	/* Step length     */
  double txmaxinc, tymaxinc;	/* Maximal increment in parameter value along curve*/
  double txlengthend, tylengthend;	/* Length of 1st derivative at start of segment */
  double txincre, tyincre;	/* Parameter value increment */
  double txmax, tymax;		/* Local maximal step length                       */
  double tdist = DZERO;		/* Distance */
  double tpos;			/* New iteration  point on curve pc2     */

  /* Pointer to curve evaluator routines */

  sh1783_fevalProc fevalc1;
  sh1783_fevalProc fevalc2;

  /* Make maximal step length based on box-size of curve 1 */

  sh1992cu (pc1, 0, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  txmax = MAX (pc1->pbox->e2max[0][0] - pc1->pbox->e2min[0][0],
	       pc1->pbox->e2max[0][1] - pc1->pbox->e2min[0][1]);
  txmax = MAX (txmax, pc1->pbox->e2max[0][2] - pc1->pbox->e2min[0][2]);

  /* Make maximal step length based on box-size of curve 2 */

  sh1992cu (pc2, 0, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  tymax = MAX (pc2->pbox->e2max[0][0] - pc2->pbox->e2min[0][0],
	       pc2->pbox->e2max[0][1] - pc2->pbox->e2min[0][1]);
  tymax = MAX (tymax, pc2->pbox->e2max[0][2] - pc2->pbox->e2min[0][2]);

  /* Copy curve pc1 attributes to local parameters.  */

  kdim = pc1->idim;
  kk1 = pc1->ik;
  kn1 = pc1->in;
  st1 = pc1->et;

  /* Copy curve pc2 attributes to local parameters.  */

  kk2 = pc2->ik;
  kn2 = pc2->in;
  st2 = pc2->et;

  /* Check that dimensions are equal */

  if (kdim != pc2->idim || kdim > 3)
    goto err105;

  /* Copy interval description into local variables */

  tfirst1 = epar[0];
  tfirst2 = epar[1];
  tend1 = (idir1 == 1) ? st1[kn1] : st1[kk1 - 1];
  tend2 = (idir2 == 1) ? st2[kn2] : st2[kk2 - 1];

  /* To make sure we do not start outside or end outside the curve we
     truncate tfirst1 to the knot interval of the curve */

  tfirst1 = (idir1 == 1) ? MAX (tfirst1, st1[kk1 - 1]) : MIN (tfirst1, st1[kn1]);

  /* To make sure we do not start outside or end outside the curve we
     truncate tstart2 and tend2 to the knot interval of the curve */

  tfirst2 = (idir2 == 1) ? MAX (tfirst2, st2[kk2 - 1]) : MIN (tfirst2, st2[kn2]);

  /* Set curve evaluator of 1. curve.  */

  fevalc1 = (idir1 == 1) ? s1221 : s1227;

  /* Set curve evaluator of 2. curve.  */

  fevalc2 = (idir2 == 1) ? s1221 : s1227;

  /* Store knot values at start of curve */

  tx1 = tfirst1;
  kdum = MAX (kk1, kk2);
  txmaxinc = fabs (tend1 - tfirst1) / (kdum * kdum);

  /* Make start point and intital step length based on first curve  */

  fevalc1 (pc1, kderc, tx1, &kleftc1, sderc1, &kstat);
  if (kstat < 0) goto error;

  ty1 = tfirst2;
  tymaxinc = fabs (tend2 - tfirst2) / (kdum * kdum);

  /* Make start point and intital step length based on second curve  */

  fevalc2 (pc2, kderc, ty1, &kleftc2, sderc2, &kstat);
  if (kstat < 0) goto error;

  /* While end not reached */

  while (idir1 * tx1 < idir1 * tend1 && idir2 * ty1 < idir2 * tend2)
    {

      /* Calculate unit tangent and radius of curvature of first curve. */

      s1307 (sderc1, kdim, s3dinf1, &kstat);
      if (kstat < 0)
	goto error;

      /* Calculate step length based on curvature of first curve. */

      txstep = s1311 (s3dinf1[3 * kdim], aepsge, tymax, &kstat);
      if (kstat < 0)
	goto error;

      /* Remember length of start tangent, end of zero segment */

      txlengthend = s6length (sderc1 + kdim, kdim, &kstat);
      if (kstat < 0)
	goto error;

      /* Calculate unit tangent and radius of curvature of second curve. */

      s1307 (sderc2, kdim, s3dinf2, &kstat);
      if (kstat < 0)
	goto error;

      /* Calculate step length based on curvature */

      tystep = s1311 (s3dinf2[3 * kdim], aepsge, txmax, &kstat);
      if (kstat < 0)
	goto error;

      /* Remember length of start tangent, end of zero segment */

      tylengthend = s6length (sderc2 + kdim, kdim, &kstat);
      if (kstat < 0)
	goto error;

      /*  Find minimum step length.  */

      tstep = MIN (txstep, tystep);
      kchange = (txstep <= tystep) ? 0 : 1;

      /*  Find candidate end point, make sure that no breaks in tangent or
	  curvature exists between start and endpoints of the segment      */
      /* Compute increment in the parameter values.  Use REL_PAR_RES if the
         tangent has zero length.  */

      if (DEQUAL (txlengthend, DZERO))
	txincre = REL_PAR_RES;
      else
	txincre = MIN (tstep / txlengthend, txmaxinc);

      if (DEQUAL (tylengthend, DZERO))
	tyincre = REL_PAR_RES;
      else
	tyincre = MIN (tstep / tylengthend, tymaxinc);

      /*  Make sure that we don't pass any knots of curve 1. */

      /* VSK. 01-93. Is it possible that several knots might be passed. */
      
      if (idir1 > 0 && (tx1 + txincre) > (st1[kleftc1 + 1] + REL_PAR_RES) &&
	  !(tx1 > (st1[kleftc1 + 1] - REL_PAR_RES)))
	{
	  txincre = st1[kleftc1 + 1] - tx1;
	  tstep = txincre * txlengthend;
	  tyincre = (tylengthend > DZERO) ? tstep / tylengthend : REL_PAR_RES;
	  kchange = 0;
	}

/*
  guen      if (idir1 < 0 && (tx1 - txincre < st1[kleftc1] - REL_PAR_RES))
  guen fixed to:
*/
      /* VSK. 01-93. Is it possible that several knots might be passed. */
      
      if (idir1 < 0 && (tx1 - txincre) < (st1[kleftc1] - REL_PAR_RES) &&
	  !(tx1 < (st1[kleftc1] + REL_PAR_RES)))
	{
	  txincre = idir1 * (st1[kleftc1] - tx1);
	  tstep = txincre * txlengthend;
	  tyincre = (tylengthend > DZERO) ? tstep / tylengthend : REL_PAR_RES;
	  kchange = 0;
	}

      /* Avoid passing next knot of curve 2. */
      
      /* VSK. 01-93. Is it possible that several knots might be passed. */

      if (idir2 > 0 && (ty1 + tyincre) > (st2[kleftc2 + 1] + REL_PAR_RES) &&
	  !(ty1 > (st2[kleftc2 + 1] - REL_PAR_RES)))
	{
	  tyincre = st2[kleftc2 + 1] - ty1;
	  tstep = tyincre * tylengthend;
	  txincre = (txlengthend > DZERO) ? tstep / txlengthend : REL_PAR_RES;
	  kchange = 1;
	}

      /* Avoid passing previous knot of curve 2. */

/*
  guen      if (idir2 < 0 && (ty1 - tyincre < st2[kleftc2] - REL_PAR_RES))
  guen fixed to:
*/
      /* VSK. 01-93. Is it possible that several knots might be passed. */

      if (idir2 < 0 && (ty1 - tyincre) < (st2[kleftc2] - REL_PAR_RES) &&
	  !(ty1 > (st2[kleftc2] + REL_PAR_RES)))
	{
	  tyincre = idir2 * (st2[kleftc2] - ty1);
	  tstep = tyincre * tylengthend;
	  txincre = (txlengthend > DZERO) ? tstep / txlengthend : REL_PAR_RES;
	  kchange = 1;
	}


      /* Set endpoints of step.  */

      tx2 = tx1 + idir1 * txincre;
      ty2 = ty1 + idir2 * tyincre;

      for (tx = (tx1 + tx2) / (double) 2.0, ty = (ty1 + ty2) / (double) 2.0, ki = 0;
	   ki < 2; ki++, tx = tx2, ty = ty2)
	{
	  if (kchange == 0)
	    {
	      if (idir1 * tx >= idir1 * tend1)
		break;

	      /* March along first curve. Iterate down to the second.  */

	      sh1783_s9relax (fevalc1, fevalc2, pc1, pc2, kderc, aepsge, tx, &kleftc1, sderc1, ty,
			      &tpos, &kleftc2, sderc2, jstat);
	      if (kstat < 0)
		goto error;
	    }
	  else
	    {
	      if (idir2 * ty >= idir2 * tend2)
		break;

	      /* March along second curve. Iterate down to the first.  */

	      sh1783_s9relax (fevalc2, fevalc1, pc2, pc1, kderc, aepsge, ty, &kleftc2, sderc2, tx,
			      &tpos, &kleftc1, sderc1, jstat);
	      if (kstat < 0)
		goto error;
	    }

	  /*  Check if point on curve and surface are within positional and
	      angular tolerances */

	  tdist = s6dist (sderc1, sderc2, kdim);

	  if (tdist > aepsge)
	    break;		/*   Points not within tolerances */
	}

      if (tdist > aepsge)
	break;			/*   Points not within tolerances */

      /*   Update start parameter value of segment.  */

      if (kchange == 0)
	{
	  tx1 = tx2;
	  ty1 = (idir2 > 0) ? MAX(ty1,tpos) : MIN(ty1,tpos);
	}
      else
	{
	  tx1 = (idir1 > 0) ? MAX(tx1,tpos) : MIN(tx1,tpos);
	  ty1 = ty2;
	}
    }

  elast[0] = tx1;
  elast[1] = ty1;
  if (tdist > aepsge)
    {
      enext[0] = (kchange == 0) ? tx : tpos;
      enext[1] = (kchange == 1) ? ty : tpos;
      *jstat = 0;
    }
  else if (idir1 * tx1 >= idir1 * tend1 && idir2 * ty1 >= idir2 * tend2)
    *jstat = 3;
  else if (idir2 * ty1 >= idir2 * tend2)
    *jstat = 2;
  else
    *jstat = 1;

  goto out;

/* Error in input, dimension not equal to 2 or 3 */

err105:*jstat = -105;
  s6err ("sh1783", *jstat, kpos);
  goto out;

/* Error in lower level function */

error:*jstat = kstat;
  s6err ("sh1783", *jstat, kpos);
  goto out;

out:
  return;
}


//===========================================================================
void sh1780 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** rintdat, SISLIntpt * pintpt, int *jnewpt, 
	     int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int ki;			/* Counters.                               */
  int kleft1 = 0;               /* Parameters to the evaluator.            */
  int kdim;			/* Dimension of geometry space.            */
  int kpos = 0;			/* Current position in output array.       */
  int kdir1, kdir2;		/* Directions in which to march the curves.*/
  int kk1, kk2;			/* Orders of the two curves.               */
  int kn1, kn2;			/* Number of vertices in the curves.       */
  int lleft[2];			/* Array storing pre-topology information. */
  int lright[2];		/* Array storing pre-topology information. */
  double tref;			/* Reference value in equality test.       */
  double *st1, *st2;		/* Pointers to knot vectors of curves.     */
  double sder[6];		/* Result of curve evaluation.             */
  double stang1[3];		/* Tangent vector of curve.                */
  double stang2[3];		/* Tangent vector of level value.          */
  double slast[3];		/* Last parameter value of coincidence.    */
  double snext[3];		/* First parameter value outside interval
			           of coincidence.                         */
  double *ret_val;		/* Pointer to geo data from sh6getgeom     */
  double *ret_norm;		/* Pointer to geo data from sh6getgeom     */
  double *sptpar = pintpt->epar;/* Parameter array of int.pt.        */
  SISLIntpt *uintpt[2];		/* Pointer to new intersection points.     */
  double *nullp = SISL_NULL;

  /* Don't make pretop for help points ! */
  if (sh6ishelp (pintpt))
    {
      *jstat = 0;
      goto out;
    }

  /* Test dimension of geometry space.  */

  kdim = po1->c1->idim;
  if (kdim > 3)
    goto err108;
  if (kdim != po2->c1->idim)
    goto err106;

  /* Express the curve by local parameters.  */

  kn1 = po1->c1->in;
  kk1 = po1->c1->ik;
  st1 = po1->c1->et;
  kn2 = po2->c1->in;
  kk2 = po2->c1->ik;
  st2 = po2->c1->et;
  tref = MAX (st1[kn1] - st1[kk1 - 1], st2[kn2] - st2[kk2 - 1]);

  /* Fetch already existing topology. */
  sh6gettop (pintpt, -1, lleft, lright, lleft + 1, lright + 1, &kstat);

  /* Fetch geometry information, first curve.  */
  sh6getgeom (po1, 1, pintpt, &ret_val, &ret_norm, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  /* Local copy of curve tangent */
  memcopy (stang1, ret_val + kdim, kdim, DOUBLE);

  /* Fetch geometry information,second curve.  */
  sh6getgeom (po2, 2, pintpt, &ret_val, &ret_norm, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  /* Local copy of curve tangent */
  memcopy (stang2, ret_val + kdim, kdim, DOUBLE);

  /* Compute the angle between the tangent vectors of the curves
     in the current intersection point, and check if marching is
     necessary to compute the pre-topology information.  */

  /* UPDATE (ujk) : tune */
  if (s6ang (stang1, stang2, kdim) <= ANGULAR_TOLERANCE)
    {
      /* Perform marching in positive direction of the first curve.  */

      kdir1 = 1;
      kdir2 = (s6scpr (stang1, stang2, kdim) >= DZERO) ? 1 : -1;

      /* Check if the intersection point is situated at the endpoint
	 of a curve.             */

      if (DEQUAL (sptpar[0] + tref, st1[kn1] + tref) ||
	  (kdir2 == 1 && DEQUAL (sptpar[1] + tref, st2[kn2] + tref)) ||
	  (kdir2 == -1 && DEQUAL (sptpar[1] + tref, st2[kk2 - 1] + tref)))
	{
	}
      else
	{
	  /* Perform marching.  */

	  sh1783 (po1->c1, po2->c1, aepsge, sptpar, kdir1, kdir2, slast,
		  snext, &kstat);
	  if (kstat < 0)
	    goto error;

	  if (kstat > 0)
	    {
	      /* An intersection interval is found. */
	      /* Set pre-topology */

	      lright[0] = SI_ON;
	      if (kdir2 == 1)
		lright[1] = SI_ON;
	      else
		lleft[1] = SI_ON;
	    }
	  else
	    {
	      /* Create help point. First fetch geometry information. */

	      s1221 (po1->c1, 0, slast[0], &kleft1, sder, &kstat);
	      if (kstat < 0)
		goto error;

	      s1221 (po1->c1, 0, snext[0], &kleft1, sder + kdim, &kstat);
	      if (kstat < 0)
		goto error;
	      s6diff (sder + kdim, sder, kdim, stang1);

	      s1221 (po2->c1, 0, slast[1], &kleft1, sder, &kstat);
	      if (kstat < 0)
		goto error;

	      s1221 (po2->c1, 0, snext[1], &kleft1, sder + kdim, &kstat);
	      if (kstat < 0)
		goto error;
	      s6diff (sder + kdim, sder, kdim, stang2);

	      /* Discuss directions of vectors and set up pre-topology
	         information in one direction of the curves.             */

	      if ((stang1[0] * stang2[1] - stang1[1] * stang2[0]) * (double) kdir2
		  < DZERO)
		lright[0] = SI_OUT;
	      else
		lright[0] = SI_IN;

	      if (kdir2 == 1)
		lright[1] = (lright[0] == SI_IN) ? SI_OUT : SI_IN;
	      else
		lleft[1] = (lright[0] == SI_OUT) ? SI_OUT : SI_IN;

	      /* UPDATE (ujk) : tune */
	      if (s6dist (sptpar, slast, 2) > (double) 0.05 * tref)
		{
		  /* Create help point. Set pre-topology data as SI_UNDEF. */

		  uintpt[kpos] = SISL_NULL;
		  if ((uintpt[kpos] = hp_newIntpt (2, slast, DZERO, -SI_ORD,
				     SI_UNDEF, SI_UNDEF, SI_UNDEF, SI_UNDEF,
					       0, 0, nullp, nullp)) == SISL_NULL)
		    goto err101;

		  kpos++;
		}
	    }
	}

      /* Perform marching in negative direction of the first curve.  */

      kdir1 = -1;
      kdir2 = -kdir2;

      /* Check if the intersection point is situated at the endpoint
	 of a curve.             */

      if (DEQUAL (sptpar[0] + tref, st1[kk1 - 1] + tref) ||
	  (kdir2 == 1 && DEQUAL (sptpar[1] + tref, st2[kn2] + tref)) ||
	  (kdir2 == -1 && DEQUAL (sptpar[1] + tref, st2[kk2 - 1] + tref)))
	{
	}
      else
	{
	  /* Perform marching.  */

	  sh1783 (po1->c1, po2->c1, aepsge, sptpar, kdir1, kdir2, slast,
		  snext, &kstat);
	  if (kstat < 0)
	    goto error;

	  if (kstat > 0)
	    {
	      /* An intersection interval is found. Set pre-topology. */

	      lleft[0] = SI_ON;
	      if (kdir2 == 1)
		lright[1] = SI_ON;
	      else
		lleft[1] = SI_ON;
	    }
	  else
	    {
	      /* Create help point. First fetch geometry information. */

	      s1221 (po1->c1, 0, slast[0], &kleft1, sder, &kstat);
	      if (kstat < 0)
		goto error;

	      s1221 (po1->c1, 0, snext[0], &kleft1, sder + kdim, &kstat);
	      if (kstat < 0)
		goto error;
	      s6diff (sder + kdim, sder, kdim, stang1);

	      s1221 (po2->c1, 0, slast[1], &kleft1, sder, &kstat);
	      if (kstat < 0)
		goto error;

	      s1221 (po2->c1, 0, snext[1], &kleft1, sder + kdim, &kstat);
	      if (kstat < 0)
		goto error;
	      s6diff (sder + kdim, sder, kdim, stang2);

	      /* Discuss directions of vectors and set up pre-topology
	         information in one direction of the curves.             */

	      if ((stang1[0] * stang2[1] - stang1[1] * stang2[0]) * (double) kdir2
		  < DZERO)
		lleft[0] = SI_OUT;
	      else
		lleft[0] = SI_IN;

	      if (kdir2 == -1)
		lleft[1] = (lleft[0] == SI_IN) ? SI_OUT : SI_IN;
	      else
		lright[1] = (lleft[0] == SI_OUT) ? SI_OUT : SI_IN;

	      /* UPDATE (ujk) : tune */
	      if (s6dist (sptpar, slast, 2) > (double) 0.05 * tref)
		{
		  /* Create help point. Set pre-topology data as SI_UNDEF. */

		  uintpt[kpos] = SISL_NULL;
		  if ((uintpt[kpos] = hp_newIntpt (2, slast, DZERO, -SI_ORD,
				     SI_UNDEF, SI_UNDEF, SI_UNDEF, SI_UNDEF,
					       0, 0, nullp, nullp)) == SISL_NULL)
		    goto err101;

		  kpos++;
		}
	    }
	}
    }
  else
    {
      /* The pretopology may be computed using local information. */

      if (stang1[0] * stang2[1] - stang1[1] * stang2[0] < DZERO)
	{
	  lleft[0] = SI_IN;
	  lright[0] = SI_OUT;
	  lleft[1] = SI_OUT;
	  lright[1] = SI_IN;
	}
      else
	{
	  lleft[0] = SI_OUT;
	  lright[0] = SI_IN;
	  lleft[1] = SI_IN;
	  lright[1] = SI_OUT;
	}


    }

  /* Update pre-topology of intersection point.  */
  /* UPDATE (ujk), index = -1 ?? */
  sh6settop (pintpt, -1, lleft[0], lright[0], lleft[1], lright[1], &kstat);

  /* Join intersection points, and set pretopology of help points.  */

  for (ki = 0; ki < kpos; ki++)
    {
      sh6idnpt (rintdat, &uintpt[ki], 1, &kstat);
      if (kstat < 0)
	goto error;

      if (sh6ishelp (uintpt[ki]) && uintpt[ki]->no_of_curves == 0)
	{
	  sh6settop (uintpt[ki], -1, *(pintpt->left_obj_1), *(pintpt->right_obj_1),
		     *(pintpt->left_obj_2), *(pintpt->right_obj_2), &kstat);

	  /* UPDATE (ujk) : Transfer pintpt to main point ?? */
	  /* Mark that an intersection interval is found.  */
	  sh6idcon (rintdat, &uintpt[ki], &pintpt, &kstat);
	  if (kstat < 0)
	    goto error;
	}
    }

  /* Pre-topology information computed. */

  *jnewpt = kpos;
  *jstat = 0;
  goto out;

  /* Error in scratch allocation.  */

err101:*jstat = -101;
  goto out;

  /* Error in input. Conflicting dimensions.  */

err106:*jstat = -106;
  goto out;

  /* Error in input. Dimension not equal to 2. */

err108:*jstat = -108;
  goto out;

  /* Error lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
  return;
}


//===========================================================================
void sh6settop(SISLIntpt *pt,int ilist,int left1,int right1,int left2,
	       int right2,int *jstat)
//===========================================================================
{
   *jstat=0;

   /* Check pt. */

   if(pt == SISL_NULL) goto err2;

   /* Check ilist. */

   if(ilist >= 0 && ilist < pt->no_of_curves)
   {
       pt->left_obj_1[ilist]=left1;
       pt->right_obj_1[ilist]=right1;
       pt->left_obj_2[ilist]=left2;
       pt->right_obj_2[ilist]=right2;
   }
   else if(pt->no_of_curves == 0 && ilist == 0)
   {
       pt->left_obj_1[0]=left1;
       pt->right_obj_1[0]=right1;
       pt->left_obj_2[0]=left2;
       pt->right_obj_2[0]=right2;
   }
   else if(ilist == -1)
   {
       pt->left_obj_1[0]=left1;
       pt->right_obj_1[0]=right1;
       pt->left_obj_2[0]=left2;
       pt->right_obj_2[0]=right2;
   }
   else goto err1;


   /* Data is set. */

   goto out;
   

err1:
   /* Error. ilist is out of range. */
   
   *jstat = -1;
   s6err("sh6settop",*jstat,0);
   goto out;

err2:
   /* Error in input. pt is SISL_NULL. */
   
   *jstat = -2;
   s6err("sh6settop",*jstat,0);
   goto out;
   
   
   out :
      return;
}

//===========================================================================
void shevalc(SISLCurve *pc1,int ider,double ax,double aepsge,int *ileft,
	     double eder[],int *jstat)
//===========================================================================
{
  int kstat=0;        /* Local status variable.                          */
  int kdim = pc1->idim;  /* Dimension of geometry space.                 */
  double *scoef=SISL_NULL;    /* Array storing filtered coefficients.         */
  double *s1,*s2,*s3,*s4; /* Pointers into coefficient arrays.           */
  SISLCurve *qc = SISL_NULL;   /* Curve to evaluate.                          */

  /* Make sure that the filtered coefficients of the curve exist.  */

  if (kdim == 1)
  {

    /*
     * PFU 09-94.
     * There should never be a rational 1D curve here according to UJK, but
     * I (PFU) added a test just in case...
     * A rational curve would have caused a memory usage error in newCurve
     * when trying to divide out the weights from the coefs.
     * This could result in a core dump (division by zero) since the data
     * would be "garbage".
     *
     * If future changes requires this to handle rational 1D curves, this
     * must be updated to use rcoef when input is rational.
     *
     */

    if ( pc1->ikind == 2 || pc1->ikind == 4 )
      goto err151;

     /* Create filtered coefficients. */

     if ((scoef = newarray(pc1->in,DOUBLE)) == SISL_NULL) goto err101;

     for (s1=pc1->ecoef, s2=scoef, s3=s1+pc1->in; s1<s3; s1=s4)
     {
	*s2 = *s1;
	for (s2++, s4=s1+1; s4<s3; s4++, s2++)
	{
	   if (fabs((*s4)-(*s1)) < aepsge) *s2 = *s1;
	   else break;
	}
     }

     /* Create curve object.  */

     if ((qc = newCurve(pc1->in,pc1->ik,pc1->et,scoef,pc1->ikind,
			kdim,0)) == SISL_NULL) goto err101;
  }
  else
    qc = pc1;

  /*
   * This previously used AN ANACRONISM ('pdir->esmooth') - taken out
   * (Confirmed by VSK).
   */



  /* Evaluate curve.  */

  s1221(qc,ider,ax,ileft,eder,&kstat);
  if (kstat < 0) goto error;

  /* UJK Let's have a normal exit possibility !*/
  *jstat = 0;
  goto out;


  /* Error in input (1D rationals is not handled) */
 err151:
  *jstat = -151;
  goto out;

  /* Error in scratch allocation.  */
 err101:
  *jstat = -101;
  goto out;

  /* Error in lower level routine.  */

 error:
  *jstat = kstat;
  goto out;

out:
   /* Free scratch occupied by local objects. */

   if (scoef != SISL_NULL) freearray(scoef);
   if (qc != SISL_NULL && qc != pc1 ) freeCurve(qc);

   return;
}

//===========================================================================
void sh6getgeom(SISLObject *ob, int obnr, SISLIntpt *pt,
		double **geom, double **norm, double aepsge, int *jstat)
//===========================================================================
{
   int kgeom;	/* Number of doubles pr object describing geometry. */
   int dim;	/* Geometric dimension. */
   int kpar;	/* Index of the parameter value of the object in pt. */
   int kstat;
   int left1=0,left2=0;
   double *val;
   
   /* UJK */
   *jstat = 0;

   kgeom = (obnr == 1 ? pt->size_1 : pt->size_2);
   
   if (ob->iobj == SISLPOINT)      dim = ob->p1->idim;
   else if (ob->iobj == SISLCURVE) dim = ob->c1->idim;
   else if (ob->iobj == SISLSURFACE)  dim = ob->s1->idim;
   
   kpar = (obnr == 1 ? 0 : (pt->ipar - ob->iobj));

   if (!kgeom)
      switch(ob->iobj)
      {
	 case SISLPOINT:
	    (*geom) = ob->p1->ecoef; 
	    (*norm) = SISL_NULL;
            return;	    
	 case SISLCURVE:
	    val = newarray(2*dim,DOUBLE);
	    shevalc(ob->c1,1,pt->epar[kpar],aepsge,&left1,val,&kstat);
	    if (kstat < 0) goto err1;
	    if (obnr == 1)
	    {
	       pt->geo_data_1 = val;
	       pt->size_1 = 2*dim;
	       kgeom = pt->size_1;
	    }
	    else
	    {
	       pt->geo_data_2 = val;
	       pt->size_2 = 2*dim;
	       kgeom = pt->size_2;
	    }
	    
	    break;
	 case SISLSURFACE:
	    val = newarray(7*dim,DOUBLE);
	    s1421(ob->s1,2,pt->epar+kpar,&left1,&left2,val,val+6*dim,&kstat);
	    if (kstat < 0) goto err1;
	    if (obnr == 1)
	    {
	       pt->geo_data_1 = val;
	       pt->size_1 = (dim == 3 ? 7 : 6)*dim;
	       kgeom = pt->size_1;
	    }
	    else
	    {
	       pt->geo_data_2 = val;
	       pt->size_2 = (dim == 3 ? 7 : 6)*dim;
	       kgeom = pt->size_2;
	    }

	    break;
      }
	    
   
   (*geom) = (obnr == 1 ? pt->geo_data_1 : pt->geo_data_2);
   
   if (ob->iobj == SISLSURFACE) (*norm) = (*geom) + kgeom - dim;
   else				(*norm) = SISL_NULL;
   goto out;
   
   err1: *jstat = kstat;
   goto out;
   
   out :
      return;
}


//===========================================================================
void sh6gettop(SISLIntpt *pt,int ilist,int *left1,int *right1,
	       int *left2,int *right2,int *jstat)
//===========================================================================
{
   *jstat=0;

   /* Check pt. */

   if(pt == SISL_NULL) goto err2;

   if(ilist >= 0 && ilist < pt->no_of_curves)
   {
       *left1=pt->left_obj_1[ilist];
       *right1=pt->right_obj_1[ilist];
       *left2=pt->left_obj_2[ilist];
       *right2=pt->right_obj_2[ilist];
   }
   else if(pt->no_of_curves == 0 && ilist == 0)
   {
       *left1=pt->left_obj_1[0];
       *right1=pt->right_obj_1[0];
       *left2=pt->left_obj_2[0];
       *right2=pt->right_obj_2[0];
   }
   /* UJK */
   else if( ilist == -1)
   {
       *left1=pt->left_obj_1[0];
       *right1=pt->right_obj_1[0];
       *left2=pt->left_obj_2[0];
       *right2=pt->right_obj_2[0];
   }
   else goto err1;


   /* Data is set. */

   goto out;
   

err1:
   /* Error. ilist is out of range. */
   
   *jstat = -1;
   s6err("sh6gettop",*jstat,0);
   goto out;

err2:
   /* Error in input. pt is SISL_NULL. */
   
   *jstat = -2;
   s6err("sh6gettop",*jstat,0);
   goto out;
   
   
   out :
      return;
}


//===========================================================================
void sh1781 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** rintdat, SISLIntpt * pintpt, int *jnewpt,
	     int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int ki, kj;			/* Counters.                               */
  int kleft = 0;		/* Parameter to evaluator.                 */
  int korgleft = 0;		/* Knot index.                 		   */
  int kdim;			/* Dimension of geometry space.            */
  int kn;			/* Number of vertices of curve.            */
  int kk;			/* Order of curve.                         */
  int kpos = 0;			/* Current position in int.pt. array.      */
  int lleft[2];			/* Array storing pre-topology information. */
  int lright[2];		/* Array storing pre-topology information. */
  int *ll1, *ll2, *lr1, *lr2;	/* Pointers into pre-topology arrays.   */
  double tpoint;		/* Level value.                            */
  double tpar0,tpar;    	/* Parameter value of point on curve.      */
  double spar[1];		/* Parameter value of endpoint of curve.   */
  double sder[2];		/* Result of curve evaluation.             */
  double stang1[2];		/* Tangent vector of curve.                */
  double stang2[2];		/* Tangent vector of level value.          */
  double *st;			/* Pointer to knot vector of curve.        */
  double *sptpar = pintpt->epar;/* Pointer to parameter array of int.pt. */
  double tref;			/* Referance value in equality test.       */
  SISLCurve *qc;		/* Pointer to current curve.               */
  SISLIntpt *uintpt[2];		/* Array storing new intersection points.  */
  double *ret_val;		/* Pointer to geo data from sh6getgeom     */
  double *ret_norm;		/* Pointer to geo data from sh6getgeom     */
  double *nullp = SISL_NULL;
  int make_hp;                  /* Flag, make/not make help pt.            */

  /* Don't make pretop for help points ! */
  if (sh6ishelp (pintpt))
    {
      *jstat = 0;
      goto out;
    }

  /* Set pointers into the arrays storing pre-topology information. */

  if (po1->iobj == SISLCURVE)
    {
      ll1 = lleft;
      lr1 = lright;
      ll2 = lleft + 1;
      lr2 = lright + 1;
    }
  else
    {
      ll1 = lleft + 1;
      lr1 = lright + 1;
      ll2 = lleft;
      lr2 = lright;
    }

  /* Get pre-topology information. */
  sh6gettop (pintpt, -1, lleft, lright, lleft + 1, lright + 1, &kstat);
  if (kstat < 0)
    goto error;

  /* Test dimension of geometry space. */
  if (po1->iobj == SISLCURVE)
    {
      qc = po1->c1;
    }
  else
    {
      qc = po2->c1;
    }

  kdim = qc->idim;
  if (kdim != 1)
    goto err106;

  /* Store curve information in local parameters. */

  kn = qc->in;
  kk = qc->ik;
  st = qc->et;
  tref = st[kn] - st[kk - 1];

  /* Fetch geometry information, point.  */
  sh6getgeom ((po1->iobj == SISLPOINT) ? po1 : po2,
	      (po1->iobj == SISLPOINT) ? 1 : 2,
	      pintpt, &ret_val, &ret_norm, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  tpoint = ret_val[0];

  /* Fetch geometry information, curve.  */
  sh6getgeom ((po1->iobj == SISLCURVE) ? po1 : po2,
	      (po1->iobj == SISLCURVE) ? 1 : 2,
	      pintpt, &ret_val, &ret_norm, aepsge, &kstat);
  if (kstat < 0)
    goto error;

  s1219(st,kk,kn,&korgleft,sptpar[0],&kstat);
  if (kstat < 0) goto error;
  
  sder[0] = ret_val[0];
  sder[1] = ret_val[1];

/* Set tangent vectors. */

  stang1[0] = (double) 1.0;
  stang1[1] = ret_val[1];
  stang2[0] = (double) 1.0;
  stang2[1] = DZERO;

  /* UPDATE (ujk) : tune */
  if (s6ang (stang1, stang2, 2) > 0.001*ANGULAR_TOLERANCE)
    {
      /* Compute pre-topology using local information.  */

      if (sder[1] > 0)
	{
	  *ll1 = SI_IN;
	  *lr1 = SI_OUT;
	  *ll2 = SI_OUT;
	  *lr2 = SI_IN;
	}
      else
	{
	  *ll1 = SI_OUT;
	  *lr1 = SI_IN;
	  *ll2 = SI_IN;
	  *lr2 = SI_OUT;
	}

    }
  else
    {
      /* Test if the intersection point lies at the endpoint of
         the curve. */

      if (DEQUAL (sptpar[0] + tref, st[kn] + tref))
	{

	}
      else
	{
	  /* Find endpoint of coincidence interval in the positive
             direction of the curve. */
	   
	  ki = 0;
	  tpar = sptpar[0] + (double) 2.0 *sqrt (aepsge);
	  tpar = min (tpar, st[kn]);
	  tpar0 = tpar = min (tpar, st[korgleft+1]);
	  shevalc (qc, 0, tpar, aepsge, &kleft, sder, &kstat);
	  if (fabs (sder[0] - tpoint) <= aepsge)
	    {
	      make_hp = TRUE;
	      for (ki = kleft - kk + 1; ki < kn; ki++)
		{
		  for (tpar = DZERO, kj = ki + 1; kj < ki + kk; kj++)
		    tpar += st[kj];
		  tpar /= (double) (kk - 1);

		  if (tpar > sptpar[0] && DNEQUAL(tpar,sptpar[0]))
		    {
		      shevalc (qc, 0, tpar, aepsge, &kleft, sder, &kstat);
		      if (fabs (sder[0] - tpoint) >= aepsge)
			break;
		      
		      tpar0 = tpar; /* Remember parameter value. */
		    }
		}
	    }
	  /*UJK, sept 92, don't make help pt close to main */
	  else make_hp = FALSE;
	  
	  /* Test if there is coincidence along the entire curve part. */

	  if (ki == kn)
	    {
	      /* Set right values of original point.  */
	      *lr1 = *lr2 = SI_ON;
	    }
	  else
	    {
	      /* Compute right values of intersection point. */
	      *lr1 = (sder[0] > tpoint) ? SI_OUT : SI_IN;
	      *lr2 = (*lr1 == SI_IN) ? SI_OUT : SI_IN;
	      
	      /*UJK, sept 92, don't make help pt close to main */
	      if (make_hp)
	      {
		 /* Create help point.  */
		 if (sptpar[0] < st[kleft]) 
		    spar[0] = MIN(tpar0,st[kleft]);
		 else
		    spar[0] = tpar0;
		 
		 uintpt[kpos] = SISL_NULL;
		 if ((uintpt[kpos] = hp_newIntpt (1, spar, DZERO, -SI_ORD,
						  SI_ON, lright[0], SI_ON,
						  lright[1], 0, 0, nullp, nullp)) == SISL_NULL)
		    goto err101;
		 
		 /* Insert the point into the data structure.  */
		 
		 sh6idnpt (rintdat, &uintpt[kpos], 1, &kstat);
		 if (kstat < 0)
		    goto error;
		 
		 kpos++;
	      }
	    }
	}

      /* Test if the intersection point lies at the startpoint
         of the curve. */

      if (DEQUAL (sptpar[0] + tref, st[kk - 1] + tref))
	{
	}
      else
	{
	  /* Find endpoint of coincidence interval in the negative
             direction of the curve. */

	  ki = kn;
	  while (sptpar[0] == st[korgleft]) korgleft--;
	  tpar = sptpar[0] - (double) 2.0 *sqrt (aepsge);
	  tpar = max (tpar, st[kk - 1]);
	  tpar0 = tpar = max (tpar, st[korgleft]);	  
	  shevalc (qc, 0, tpar, aepsge, &kleft, sder, &kstat);
	  if (fabs (sder[0] - tpoint) <= aepsge)
	    {
	      make_hp = TRUE;
	      for (ki = kleft; ki >= 0; ki--)
		{
		  for (tpar = DZERO, kj = ki + 1; kj < ki + kk; kj++)
		    tpar += st[kj];
		  tpar /= (double) (kk - 1);

		  if (tpar < sptpar[0] && DNEQUAL(tpar,sptpar[0]))
		  {
		     shevalc (qc, 0, tpar, aepsge, &kleft, sder, &kstat);
		     if (fabs (sder[0] - tpoint) >= aepsge)
			break;
		     
		     tpar0 = tpar;
		  }
		}
	    }
	  /*UJK, sept 92, don't make help pt close to main */
	  else make_hp = FALSE;
	  
	  /* Test if there is coincidence along the entire curve part. */
	  if (ki < 0)
	    {
	      /* Set left values of original point.  */
	      *ll1 = *ll2 = SI_ON;
	    }
	  else
	    {
	      /* Compute left values of intersection point. */

	      *ll1 = (sder[0] > tpoint) ? SI_OUT : SI_IN;
	      *ll2 = (*ll1 == SI_IN) ? SI_OUT : SI_IN;

	      /*UJK, sept 92, don't make help pt close to main */
	      if (make_hp)
	      {
		 /* Create intersection point.  */
		 if (sptpar[0] > st[kleft+1]) 
		    spar[0] = MAX(tpar0,st[kleft+1]);
		 else
		    spar[0] = tpar0;
		 
		 uintpt[kpos] = SISL_NULL;
		 if ((uintpt[kpos] = hp_newIntpt (1, spar, DZERO, -SI_ORD,
						  lleft[0], SI_ON, lleft[1],
						  SI_ON, 0, 0, nullp, nullp)) == SISL_NULL)
		    goto err101;
		 
		 /* Insert the point into the data structure.  */
		 
		 sh6idnpt (rintdat, &uintpt[kpos], 1, &kstat);
		 if (kstat < 0)
		    goto error;
		 
		 
		 kpos++;
	      }

	    }

	}
    }

  /* Update pretopology of intersection point.  */

  sh6settop (pintpt, -1, lleft[0], lright[0], lleft[1], lright[1], &kstat);
  if (kstat < 0)
    goto error;
  /* Change, if necessary, pintpt to mainpoint */
  sh6tomain (pintpt, &kstat);

  /* Join intersection points.  (kpos=0,1,2)*/
  for (ki = 0; ki < kpos; ki++)
    {
      sh6idnpt (rintdat, &uintpt[ki], 1, &kstat);
      if (kstat < 0)
	goto error;
      /* Mark that an intersection interval is found.  */
      if (sh6ishelp (uintpt[ki]) && uintpt[ki]->no_of_curves == 0)
	{
	  sh6idcon (rintdat, &uintpt[ki], &pintpt, &kstat);
	  if (kstat < 0)
	    goto error;
	}
    }

  /* Pre-topology information computed. */

  *jnewpt = kpos;
  *jstat = 0;
  goto out;

  /* Error in scratch allocation.  */

err101:*jstat = -101;
  goto out;

  /* Error in input. Incorrect dimension.  */

err106:*jstat = -106;
  goto out;

  /* Error lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
  return;
}


//===========================================================================
void s6idint(SISLObject *po1,SISLObject *po2,SISLIntdat *pintdat,SISLIntpt **rpt,
	     int iob)
//===========================================================================
{
  register int  ki,kj;
  int  kpar1,kpar2;
  double sstart1[2],send1[2];
  double sstart2[2],send2[2];
  
  
  /* Initiate to emty list. */
  
  *rpt = SISL_NULL;
  
  
  /* We have to be sure that we have an intdat structure. */
  
  if (pintdat == SISL_NULL)
    goto out;
  
  
  if (po1 == SISL_NULL || po1->iobj == SISLPOINT)
    kpar1 = 0;
  else if (po1->iobj == SISLCURVE)
    {
      kpar1 = 1;
      sstart1[0] = po1->c1->et[po1->c1->ik-1];
      send1[0] = po1->c1->et[po1->c1->in];
    }
  else if (po1->iobj == SISLSURFACE)
    {
      kpar1 = 2;
      sstart1[0] = po1->s1->et1[po1->s1->ik1-1];
      send1[0] = po1->s1->et1[po1->s1->in1];
      sstart1[1] = po1->s1->et2[po1->s1->ik2-1];
      send1[1] = po1->s1->et2[po1->s1->in2];
    }
  
  
  if (po2 == SISL_NULL || po2->iobj == SISLPOINT)
    kpar2 = 0;
  else if (po2->iobj == SISLCURVE)
    {
      kpar2 = 1;
      sstart2[0] = po2->c1->et[po2->c1->ik-1];
      send2[0] = po2->c1->et[po2->c1->in];
    }
  else if (po2->iobj == SISLSURFACE)
    {
      kpar2 = 2;
      sstart2[0] = po2->s1->et1[po2->s1->ik1-1];
      send2[0] = po2->s1->et1[po2->s1->in1];
      sstart2[1] = po2->s1->et2[po2->s1->ik2-1];
      send2[1] = po2->s1->et2[po2->s1->in2];
    }
  
  
  if (iob == 1 && kpar1 == 0)
    goto out;
  
  if (iob == 2 && kpar2 == 0)
    goto out;
  
  
  /* We have to go trough all intersection points to search for internal
     intersection points. */
  
  for (ki=pintdat->ipoint-1; ki>=0; ki--)
    {
      for (kj=0; kj<kpar1; kj++)
        if (sstart1[kj] > pintdat->vpoint[ki]->epar[kj]  ||
	    send1[kj] < pintdat->vpoint[ki]->epar[kj])
	  goto end;
      for (kj=0; kj<kpar2; kj++)
        if (sstart2[kj] > pintdat->vpoint[ki]->epar[kpar1+kj]  ||
	    send2[kj] < pintdat->vpoint[ki]->epar[kpar1+kj])
	  goto end;
      
      if (iob == 1)
        {
	  for (kj=0; kj<kpar1; kj++)
	    if (DEQUAL(sstart1[kj],pintdat->vpoint[ki]->epar[kj]) ||
	        DEQUAL(send1[kj],pintdat->vpoint[ki]->epar[kj]))
	      goto end;
        }
      else
        {
	  for (kj=0; kj<kpar2; kj++)
	    if (DEQUAL(sstart2[kj],pintdat->vpoint[ki]->epar[kpar1+kj]) ||
	        DEQUAL(send2[kj],pintdat->vpoint[ki]->epar[kpar1+kj]))
	      goto end;
        }
      
      
      (*rpt) = pintdat->vpoint[ki];
      goto out;
    end:;
    }
 out:;
}


//===========================================================================
void shmkhlppts (SISLObject * po1, SISLObject * po2, double aepsge,
		 SISLIntdat ** rintdat, SISLEdge * vedge[], int *jnewpt, 
		 int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int knum = 0;			/* Number of intpt on edges.               */
  int ki;			/* Counter.                                */
  int kdim;			/* Dimension of geometry space.            */
  int knewpt = 0;		/* Number of new intersection points.      */
  int kobj;			/* Number of obj, used in s6idint          */
  int index1, index2;		/* Dummy in this context                   */
  SISLIntpt **up = SISL_NULL;	/* Array of poiners to intersection point. */
  /*  SISLIntpt *lup[3];*/		/* Array of poiners to intersection point. */
  SISLIntpt *qptint = SISL_NULL;	/* Pointer to internal intersection point. */
  SISLIntpt *qpt = SISL_NULL;	/* Pointer to intersection point.          */
  /* --------------------------------------------------------------------- */

  /* Init */
  *jstat = 0;
  *jnewpt = 0;

  /* Test if an intersection data structure exist.  */
  if (*rintdat == SISL_NULL)
    goto out;


  /* Fetch dimension of geometry space. */
  if (po1->iobj == SISLPOINT)

    kdim = po1->p1->idim;
  else if (po1->iobj == SISLCURVE)
    kdim = po1->c1->idim;
  else
    kdim = po1->s1->idim;

  /* Treat only cases:
     crv vs pt 1D
     crv vs crv
     crv vs sf
     crv vs pt 2D
     sf vs pt 2D
     */

  if (!(((po1->iobj == SISLCURVE && po2->iobj >= SISLCURVE) ||
	 (po2->iobj == SISLCURVE && po1->iobj >= SISLCURVE)) ||
	(kdim == 1 && (po1->iobj + po2->iobj) == (SISLPOINT + SISLCURVE)) ||
	(kdim == 2 && (po1->iobj + po2->iobj) >= (SISLPOINT + SISLCURVE))))
    goto out;

  /* Compute number of intersection points on edges, 0 1 or 2. */
  if (vedge[0] == SISL_NULL)
    knum = 0;
  else
    knum = vedge[0]->ipoint;

  if (vedge[1] != SISL_NULL)
    knum += vedge[1]->ipoint;


  if (knum > 0)
    {
      sh6edgpoint (vedge, &up, &knum, &kstat);
      if (kstat < 0)
	goto error;
    }

  if (knum == 2)
    {
      /* when two edge points, check if they are connected */
      sh6getlist (up[0], up[1], &index1, &index2, &kstat);
      if (kstat == 0)
	knum = 0;
    }

  if (knum == 0) /* BOH & ALA Added: 200993 */
  {
    /* Task performed.  */

    *jstat = 0;
    goto out;
  }

  /* Copy pointer of edge points into local pointer array */
  /*for (ki = 0; ki < knum; ki++)

    lup[ki] = up[ki]; */

  /* Get the internal point if any */
  if (po1->iobj == SISLPOINT)
    kobj = 2;
  else
    kobj = 1;

    s6idint (po1, po2, *rintdat, &qptint, kobj);
    if (qptint)
    {
       qpt = qptint;
       ki=-1;
    }
    else
    {
       ki = 0;
       qpt = up[0];
    }

  for (; ki < knum; ki++ )
    {

      if (ki >= 0) qpt = up[ki];

      /* Browse on the dimension of geometry space and the type of
         the input objects.     */

      if (kdim == 1 && ((po1->iobj == SISLCURVE && po2->iobj == SISLPOINT)
		     || (po2->iobj == SISLCURVE && po1->iobj == SISLPOINT)))
	{
	  /* Compute pre-topology in one-dimensional curve-level value
             intersection.            */

	  sh1781 (po1, po2, aepsge, rintdat, qpt, &knewpt, &kstat);
	  if (kstat < 0)
	    goto error;
	  *jnewpt += knewpt;
	}
      else if (po1->iobj == SISLCURVE && po2->iobj == SISLCURVE)
	{
	  /* curve-curve intersection.  */
	  sh1780 (po1, po2, aepsge, rintdat, qpt, &knewpt, &kstat);
	  if (kstat < 0)
	    goto error;
	  *jnewpt += knewpt;
	}
      else if (kdim == 2 &&
	       ((po1->iobj == SISLCURVE && po2->iobj == SISLPOINT)
		|| (po2->iobj == SISLCURVE && po1->iobj == SISLPOINT)))
	{
	  /* 2 dimensional point-curve intersection.  */

	  sh1786 (po1, po2, aepsge, rintdat, qpt, &knewpt, &kstat);
	  if (kstat < 0)
	    goto error;
	  *jnewpt += knewpt;
	}
      else if (kdim == 2 &&
	       ((po1->iobj == SISLSURFACE && po2->iobj == SISLPOINT)
		|| (po2->iobj == SISLSURFACE && po1->iobj == SISLPOINT)))
	{
	  /* 2 dimensional point-surface intersection.  */

	  sh1787 (po1, po2, aepsge, rintdat, qpt, &knewpt, &kstat);
	  if (kstat < 0)
	    goto error;
	  *jnewpt += knewpt;
	}
      else if (kdim == 3 &&
	       ((po1->iobj == SISLCURVE && po2->iobj == SISLSURFACE) ||
		(po1->iobj == SISLSURFACE && po2->iobj == SISLCURVE)))
	{
	  /* Surface-curve intersection in 3-dimensional geometry space. */

	  sh1779 (po1, po2, aepsge, rintdat, qpt, &knewpt, &kstat);
	  if (kstat < 0)
	    goto error;
	  *jnewpt += knewpt;

	}
    }

  /* Task performed.  */

  *jstat = 0;
  goto out;

  /* Error in lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
  if (up != SISL_NULL)
    freearray (up);

  return;
}


//===========================================================================
void sh6tohelp(SISLIntpt *pt,int *jstat)
//===========================================================================
{
   int kstat; /* Local status */
   int num; 

   *jstat=0;

   if(pt == SISL_NULL) goto err1;

   if(sh6ismain(pt))  /* If pt is a help point. */
   {
      /* ??????????? */
      /* if(pt->no_of_curves > 2) goto err2; */
      
      num=sh6nmbmain(pt,&kstat);
      /* Problem in sh6edgred when starting reduction */
      /* if(num > 1) goto err2; */

       pt->iinter = -pt->iinter;  /* Convert status to main point. */
   }
   else
   {
       *jstat=1;
   }

   goto out;
   

err1:
   /* Error in input. pt is null. */
   
   *jstat = -1;
   s6err("sh6tohelp",*jstat,0);
   goto out;
   
   /* Error, Illegal to change status. */
   
   /* err2:
    *jstat = -2;
   s6err("sh6tohelp",*jstat,0);
   goto out; */
   
   
   out :
      return;
}


//===========================================================================
double s1173_s9del(double *eco, double *eco1, double *eco2, int idim)
//===========================================================================
{
  double t1,t2,t3,t4,t5,t6;   /* Constants in equation.                 */
  
  t1 =  s6scpr(eco,eco1,idim);
  t3 =  s6scpr(eco1,eco1,idim);
  t2 =  t3 - s6scpr(eco,eco2,idim);
  t4 =  -(double)2 * s6scpr(eco1,eco2,idim);
  
  
  
  if (DEQUAL(t4,DZERO))    /* The second degree part is degenerated. */
    {
      if (DEQUAL(t2,DZERO)) 
	{
          if (DEQUAL(t3,DZERO))            return DZERO;
          else                             return (t1/t3);
	}
      else                                  return (t1/t2);
    }
  else                /* An ordinary second degree equation.    */
    {
      t5 = t2*t2 - (double)2*t4*t1;
      if (t5 < DZERO)                       return (t1/t3);
      else
	{
          t6 = sqrt(t5);
          t5 = (t2 + t6)/t4;
          t6 = (t2 - t6)/t4;
	  t1 *= t3;
	  
	  
          /* We have two solutions and we want to use the one
	     with the same sign as we get while using an other
	     metode t1/t3. If both solutions have the same
	     sign we use the one with smallest value. */
	  
          if (t1 < DZERO)
	    {
	      if (t5 <= DZERO && t6 <= DZERO)
		{
		  if (t5 > t6)             return t5;
	          else                     return t6;
		}
	      else if (t5 <= DZERO)        return t5;
	      else if (t6 <= DZERO)        return t6;
              else                         return min(t5,t6);
	    }
	  else if (t1 > DZERO)
	    {
	      if (t5 >= DZERO && t6 >= DZERO)
		{
		  if (t5 < t6)             return t5;
	          else                     return t6;
		}
	      else if (t5 >= DZERO)        return t5;
	      else if (t6 >= DZERO)        return t6;
              else                         return max(t5,t6);
	    }
	  else                             return min(fabs(t5),fabs(t6));
	}
    }
}



//===========================================================================
void s1173_s9dir(double *cdist, double *cdiff1, double *cdiff2,
		 double gdiff[], double evalp[], double evals[], double aepsge)
//===========================================================================
{                        
  int kstat=0;		      /* Local status variable.                    */
  double tdiv;		      /* Determinant                               */
  double ta11,ta12,ta21,ta22; /* The matrix                  		   */
  double tmax;                /* The largest value in matrix               */
  double tb1,tb2;             /* The right hand side.                      */
  double tval,tderx,tderxx;   /* Function and deriv. 
				 values in one-dimentional case */
  double tdery,tderyy;
  double tderxy;
  double tdeltax,tdeltay;   /* Locals for the step value to be determined. */
  double ttemp;             /* Temporary value. */
  
  if (aepsge < 0) kstat=1;
  
  /* Computing the different vector */
  s6diff(evalp,evals,1,gdiff);
  
  /* Computing the length of the different vector. */
  *cdist = s6length(gdiff,1,&kstat);
  
  /* Init */
  tval   = evals[0];
  tderx  = evals[1];
  tdery  = evals[2];
  tderxx = evals[3];
  tderxy = evals[4];
  tderyy = evals[5];
  tdeltax = DZERO;
  tdeltay = DZERO;
  *cdiff1  = DZERO;
  *cdiff2  = DZERO;
  
  
  /* Building the matrix. */
  
  ta11 = (gdiff[0]*tderxx - tderx*tderx);
  ta12 = (gdiff[0]*tderxy - tderx*tdery);
  ta21 = (gdiff[0]*tderxy - tderx*tdery);
  ta22 = (gdiff[0]*tderyy - tdery*tdery);
  tb1  = -gdiff[0]*tderx;
  tb2  = -gdiff[0]*tdery;
  
  if (DEQUAL(tb1,DZERO) && DEQUAL(tb2,DZERO))
    {
      /* Finished, we have found a max. */
    }
  else
    {
      tdiv    = ta11*ta22 - ta21*ta12;
      tmax = max(fabs(ta11),max(fabs(ta12),max(fabs(ta21),fabs(ta22))));
      
      if (fabs(tdiv) > tmax*REL_COMP_RES)
	{
	  /* The matrix is ok, solve the system using Cramers rule. */
	  tdeltax = tb1*ta22 - tb2*ta12;    
	  tdeltay = ta11*tb2 - ta21*tb1;
	  tdeltax /= tdiv;
	  tdeltay /= tdiv;
	}
      else
	{
	  /* The matrix is nearly singular, 
	     use Newton on each parameter direction*/
	  tdeltax = s1173_s9del(gdiff,&tderx,&tderxx,1);
	  tdeltay = s1173_s9del(gdiff,&tdery,&tderyy,1);
	  
	  
	  if (fabs(tdeltax) < REL_COMP_RES || fabs(tdeltay) < REL_COMP_RES )
	    /* If one is very small, we use them as they are. */
	    ;
	  else
	    {
	      /* Use the shortest step; min (1-k)Dx + kDy */
	      ttemp   = tdeltay*tdeltax/(tdeltax*tdeltax + tdeltay*tdeltay);
	      tdeltax = tdeltay*ttemp;
	      tdeltay = tdeltax*ttemp;
	      
	    }
	  
	} 
    }  
  
  *cdiff1  = tdeltax;
  *cdiff2  = tdeltay;
  
}


//===========================================================================
void s1173_s9corr(double gd[], double acoef1,double acoef2,double astart1,
		  double aend1,double astart2, double aend2)
//===========================================================================
{
  if (acoef1 + gd[0] < astart1)  gd[0] = astart1 - acoef1;
  else if (acoef1 + gd[0] > aend1) gd[0] = aend1 - acoef1;
  
  if (acoef2 + gd[1] < astart2)  gd[1] = astart2 - acoef2;
  else if (acoef2 + gd[1] > aend2) gd[1] = aend2 - acoef2;
}


//===========================================================================
void  s1173(SISLPoint *ppoint, SISLSurf *psurf, double aepsge,double estart[],
	    double eend[], double enext[], double gpos[],int *jstat)
//===========================================================================
{                        
  int kstat = 0;            /* Local status variable.                      */
  int kpos = 0;             /* Position of error.                          */
  int kleft1=0;             /* Variables used in the evaluator.            */
  int kleft2=0;             /* Variables used in the evaluator.            */
  int kder=2;               /* Order of derivatives to be calulated        */
  int kdim=1;               /* Dimension of space the surface lies in      */
  int knbit;                /* Number of iterations                        */
  int kdir;                 /* Changing direction.                         */
  double tdelta[2];         /* Parameter intervals of the surface.         */
  double tdist;             /* Distance between position and origo.        */
  double td[2],t1[2],tdn[2];/* Distances between old and new parameter
			       value in the tree parameter directions.     */
  double tprev;             /* Previous difference between the curves.     */
  double *sval =SISL_NULL;       /* Value ,first and second derivatiev of surf. */ 
  double *sdiff;            /* Difference between the point and the surf.  */
  double *snorm;            /* Normal vector of the surface, dummy.        */
  double snext[2];          /* Parameter values                            */
  
  /* Test input.  */
  
  if (ppoint->idim != psurf->idim) goto err106;
  if (ppoint->idim != kdim) goto err106;
  
  /* Fetch endpoints and the intervals of parameter interval of curves.  */
  
  tdelta[0] = psurf->et1[psurf->in1] - psurf->et1[psurf->ik1 - 1];
  tdelta[1] = psurf->et2[psurf->in2] - psurf->et2[psurf->ik2 - 1];
  
  
  /* Allocate local used memory */
  
  sval = newarray(8*kdim,double);
  if (sval == SISL_NULL) goto err101;
  
  sdiff = sval + 6*kdim;
  snorm = sdiff + kdim;
  
  /* Initiate variables.  */
  
  tprev = (double)HUGE;
  
  
  /* Evaluate 0-1.st derivatives of surface */
  
  s1421(psurf,kder,enext,&kleft1,&kleft2,sval,snorm,&kstat);
  if (kstat < 0) goto error;
  
  /* Compute the distanse vector and value and the new step. */
  
  s1173_s9dir(&tdist,td,td+1,sdiff,ppoint->ecoef,sval,aepsge);
  
  
  /* Correct if we are not inside the parameter intervall. */
  
  
  t1[0] = td[0];
  t1[1] = td[1];
  s1173_s9corr(t1,enext[0],enext[1],estart[0],eend[0],estart[1],eend[1]);
  
  
  /* Iterate to find the intersection point.  */
  
  for (knbit = 0; knbit < 50; knbit++)
    {
      /* Evaluate 0-1.st derivatives of surface */
      
      snext[0] = enext[0] + t1[0];
      snext[1] = enext[1] + t1[1];
      
      s1421(psurf,kder,snext,&kleft1,&kleft2,sval,snorm,&kstat);
      if (kstat < 0) goto error;
      
      
      /* Compute the distanse vector and value and the new step. */
      
      s1173_s9dir(&tdist,tdn,tdn+1,sdiff,ppoint->ecoef,sval,aepsge);
      
      
      /* Check if the direction of the step have change. */
      
      kdir = (s6scpr(td,tdn,2) >= DZERO);     /* 0 if changed. */
      
      
      /* Ordinary converging. */
      
      if (tdist <= tprev || kdir)
	{
          enext[0] += t1[0];
          enext[1] += t1[1];
	  
          td[0] = t1[0] = tdn[0];
          td[1] = t1[1] = tdn[1];
	  
	  /* Correct if we are not inside the parameter intervall. */
	  
	  s1173_s9corr(t1,enext[0],enext[1],estart[0],eend[0],estart[1],eend[1]);
	  
	  
          if ( (fabs(t1[0]/tdelta[0]) <= REL_COMP_RES) &&
	      (fabs(t1[1]/tdelta[1]) <= REL_COMP_RES)) break;
	  
          tprev = tdist;
	}
      
      /* Not converging, corrigate and try again. */
      
      else
	{
          t1[0] /= (double)2;
          t1[1] /= (double)2;
	}
    }
  
  /* Iteration stopped, test if point is within resolution */
  
  if (tdist <= aepsge)
    *jstat = 1;
  else
    *jstat = 2;
  
  /* Test if the iteration is close to a knot */
  if (DEQUAL(enext[0],psurf->et1[kleft1]))
    gpos[0] = psurf->et1[kleft1];
  else if (DEQUAL(enext[0],psurf->et1[kleft1+1]))
    gpos[0] = psurf->et1[kleft1+1];
  else
    gpos[0] = enext[0];
  
  if (DEQUAL(enext[1],psurf->et2[kleft2]))
    gpos[1] = psurf->et2[kleft2];
  else if (DEQUAL(enext[1],psurf->et2[kleft2+1]))
    gpos[1] = psurf->et2[kleft2+1];
  else
    gpos[1] = enext[1];
  
  
  /* Iteration completed.  */
  
  
  goto out;
  
  
  /* Error in allocation */
  
 err101: *jstat = -101;
  s6err("s1173",*jstat,kpos);
  goto out;                  
  
  /* Error in input. Conflicting dimensions.  */
  
 err106: *jstat = -106;
  s6err("s1173",*jstat,kpos);
  goto out;                  
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("s1173",*jstat,kpos);
  goto out;                  
  
 out:    if (sval != SISL_NULL) freearray(sval);
}


//===========================================================================
void s1773_s9dir(double *cdist,double *cdiff1,double *cdiff2,
		 double PS[],double eval1[],double eval2[],
		 double aepsge, int idim,int *jstat)
//===========================================================================
{                        
  int kstat=0;		          /* Local status variable.       */
  register double tdet;		  /* Determinant                  */
  register double t1,t2,t3,t4,t5; /* Variables in equation system */
  register double *S, *Su, *Sv;
  /* register double *Suv, *Suu, *Svv; */
                                  /* Pointers to surf values      */
  register double ref, ang;       /* Referance value, angle       */
  register double l1, l2;         /* Vector norm                  */
  register double min_ang=10e-11; /* Min angle                    */
  /* ____________________________________________________________ */
  
  /* Init */
  *jstat = 0;
  *cdiff1 = DZERO;
  *cdiff2 = DZERO;
  
  /* Set pointers */
  S   = eval2;
  Su  = S   + idim;
  Sv  = Su  + idim;
  /* Suu = Sv  + idim;
  Suv = Suu + idim;
  Svv = Suv + idim; */

  /* Degenerate if Su=0 v Sv=0 v Su||Sv */
  l1 = s6length(Su,idim,&kstat);
  l2 = s6length(Sv,idim,&kstat);
  ang = s6ang(Su,Sv,idim);
  if (min(l1,l2) < aepsge || ang < min_ang) *jstat = 1;

  /* Computing difference vector and lenght */
  s6diff(eval1,S,idim,PS);
  *cdist = s6length(PS,idim,&kstat);
  
  if (*jstat == 1)
  {
     if (l1 < aepsge)
     {
	if (l2 > aepsge)
	   /* Su = 0 */
	   *cdiff2 = s6scpr(PS,Sv,idim)/l2*l2;
     }
     else if (l2 < aepsge)
	   /* Sv = 0 */
	   *cdiff1 = s6scpr(PS,Su,idim)/(l1*l1);
     else /* Su,Sv || */
     {
	/* Best strategy? */
	*cdiff1 = s6scpr(PS,Su,idim)/(l1*l1);
      }
	
  }
  else /* *jstat == 0 */
     
  {
     
     t1 =  s6scpr(Su,Su,idim) ; /* - s6scpr(PS,Suu,idim);*/
     t2 =  s6scpr(Su,Sv,idim) ; /* - s6scpr(PS,Suv,idim);*/
     t3 =  s6scpr(Sv,Sv,idim) ; /* - s6scpr(PS,Svv,idim);*/
     t4 =  s6scpr(PS,Su,idim);
     t5 =  s6scpr(PS,Sv,idim);
     
     ref = max(fabs(t1),fabs(t2));
     ref = max(ref,fabs(t3));
     /* Computing the determinant. */
     
     tdet = t1*t3 - t2*t2;
     
     if (DEQUAL(ref+fabs(tdet),ref))
     {
	*jstat = 1;
     }
     else 
     {
	/* Using Cramer's rule to find the solution of the system. */
	
	*cdiff1 =  (t4*t3-t5*t2)/tdet;
	*cdiff2 =  (t1*t5-t2*t4)/tdet;
     }
  }
}


//===========================================================================
void s1773_s9corr(double gd[],double acoef1,double acoef2,
		  double astart1,double aend1,double astart2,double aend2)
//===========================================================================
{
  if (acoef1 + gd[0] < astart1)  gd[0] = astart1 - acoef1;
  else if (acoef1 + gd[0] > aend1) gd[0] = aend1 - acoef1;
  
  if (acoef2 + gd[1] < astart2)  gd[1] = astart2 - acoef2;
  else if (acoef2 + gd[1] > aend2) gd[1] = aend2 - acoef2;
}


//===========================================================================
void s1773(SISLPoint *ppoint,SISLSurf *psurf,double aepsge,
	   double estart[],double eend[],double enext[],double gpos[],int *jstat)
//===========================================================================
{                        
  int kstat = 0;            /* Local status variable.                      */
  int kpos = 0;             /* Position of error.                          */
  int kleft1=0;             /* Variables used in the evaluator.            */
  int kleft2=0;             /* Variables used in the evaluator.            */
  int kder=1;               /* Order of derivatives to be calulated        */
  int kdim;                 /* Dimension of space the curves lie in        */
  int knbit;                /* Number of iterations                        */
  int kdir;                 /* Changing direction.                         */
  int kdeg;                 /* Degenaracy flag.                            */
  double tdelta[2];         /* Parameter intervals of the surface.         */
  double tdist;             /* Distance between position and origo.        */
  double td[2],t1[2],tdn[2];/* Distances between old and new parameter
			       value in the tree parameter directions.     */
  double tprev;             /* Previous difference between the curves.     */
  double *sval =SISL_NULL;       /* Value ,first and second derivatiev of surf. */ 
  double *sdiff;            /* Difference between the point and the surf.  */
  double *snorm;            /* Normal vector of the surface, dummy.        */
  double snext[2];          /* Parameter values                            */
  double guess[2];          /* Local copy of enext.                        */
  
  guess[0] = enext[0];
  guess[1] = enext[1];
  
  /* Test input.  */
  
  if (ppoint->idim != psurf->idim) goto err106;
  
  kdim = ppoint -> idim;
  
  if (kdim == 1)
    {
      s1173(ppoint,psurf,aepsge,estart,eend,guess,gpos,&kstat);
      if (kstat < 0)
        goto error;
      else
        {
	  if (DNEQUAL(gpos[0],estart[0]) &&
	      DNEQUAL(gpos[0],eend[0]) &&
	      DNEQUAL(gpos[1],estart[1]) &&
	      DNEQUAL(gpos[1],eend[1])) 
	    *jstat = (kstat==1 ? 1:3);
	  else
	    *jstat = 0;
	  goto out;
        }
    }
  
  /* Fetch endpoints and the intervals of parameter interval of curves.  */
  
  tdelta[0] = psurf->et1[psurf->in1] - psurf->et1[psurf->ik1 - 1];
  tdelta[1] = psurf->et2[psurf->in2] - psurf->et2[psurf->ik2 - 1];
  
  /* Allocate local used memory */
  
  sval = newarray(8*kdim,double);
  if (sval == SISL_NULL) goto err101;
  
  sdiff = sval + 6*kdim;
  snorm = sdiff + kdim;
  
  /* Initiate variables.  */
  
  tprev = (double)HUGE;
  
  /* Evaluate 0-1.st derivatives of surface */
  /* printf("\n lin: \n %#20.20g %#20.20g",
     guess[0],guess[1]); */
  
  s1421(psurf,kder,guess,&kleft1,&kleft2,sval,snorm,&kstat);
  if (kstat < 0) goto error;
  
  /* Compute the distanse vector and value and the new step. */
  
  s1773_s9dir(&tdist,td,td+1,sdiff,ppoint->ecoef,sval,
	      aepsge,kdim,&kdeg);
  
  /* Correct if we are not inside the parameter intervall. */
  
  t1[0] = td[0];
  t1[1] = td[1];
  s1773_s9corr(t1,guess[0],guess[1],estart[0],eend[0],estart[1],eend[1]);
  
  /* Iterate to find the intersection point.  */
  
  for (knbit = 0; knbit < 30; knbit++)
    {
      /* Evaluate 0-1.st derivatives of surface */
      
      snext[0] = guess[0] + t1[0];
      snext[1] = guess[1] + t1[1];
      
      s1421(psurf,kder,snext,&kleft1,&kleft2,sval,snorm,&kstat);
      if (kstat < 0) goto error;
      
      /* Compute the distanse vector and value and the new step. */
      
      s1773_s9dir(&tdist,tdn,tdn+1,sdiff,ppoint->ecoef,
	    sval,aepsge,kdim,&kdeg);
      
      /* Check if the direction of the step have change. */
      
      kdir = (s6scpr(td,tdn,2) >= DZERO);     /* 0 if changed. */
      
      /* Ordinary converging. */
      
      if (tdist < tprev/(double)2 || kdir)
	{
	   guess[0] += t1[0];
	   guess[1] += t1[1];
  
	  /* printf("\n %#20.20g %#20.20g",
	     guess[0],guess[1]); */
  
	  
          td[0] = t1[0] = tdn[0];
          td[1] = t1[1] = tdn[1];
	  
	  /* Correct if we are not inside the parameter intervall. */
	  
	  s1773_s9corr(t1,guess[0],guess[1],estart[0],eend[0],estart[1],eend[1]);
          tprev = tdist;

	  if ( (fabs(t1[0]/tdelta[0]) <= REL_COMP_RES) &&
	      (fabs(t1[1]/tdelta[1]) <= REL_COMP_RES)) break;
	}
      
      /* Not converging, adjust and try again. */
      
      else
	{
          t1[0] /= (double)2;
          t1[1] /= (double)2;
          /* knbit--;  */
	}
      if (guess[0]==guess[0]+t1[0] &&
	  guess[1]==guess[1]+t1[1]) break;
    }
  
  /* Iteration stopped, test if point founds found is within resolution */
  
  if (tdist <= aepsge)
  {
     *jstat = 1;
     /* printf("\n SUCCESS!!"); */
     
  }
  else if(kdeg)
     *jstat = 9;
  else
     *jstat = 2;
  
  gpos[0] = guess[0];
  gpos[1] = guess[1];
  
  /* Iteration completed.  */
  
  goto out;
  
  /* Error in allocation */
  
 err101: *jstat = -101;
  s6err("s1773",*jstat,kpos);
  goto out;                  
  
  /* Error in input. Conflicting dimensions.  */
  
 err106: *jstat = -106;
  s6err("s1773",*jstat,kpos);
  goto out;                  
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("s1773",*jstat,kpos);
  goto out;                  
  
 out:    if (sval != SISL_NULL) freearray(sval);
}


//===========================================================================
void sh6ptobj(double *point, SISLObject *obj, double aepsge,
	      double start[], double result[], int *jstat)
//===========================================================================
{                        
  int kstat = 0;            /* Local status variable.                      */
  int kpos = 0;             /* Position of error.                          */
  double pstart[2];
  double pend[2];
  SISLPoint *sislpt = SISL_NULL;
  double loc_start[2];
  
  /* Test input.  */
  
  if (obj == SISL_NULL) goto err106;
		   
  if ( obj->iobj == SISLSURFACE)
  {
     if ((sislpt = newPoint(point, obj->s1->idim, 0)) == SISL_NULL)
        goto error;

     memcopy(loc_start,start,2,double);
     
     pstart[0] = obj->s1->et1[obj->s1->ik1 - 1];
     pstart[1] = obj->s1->et2[obj->s1->ik2 - 1];
     pend[0]   = obj->s1->et1[obj->s1->in1];
     pend[1]   = obj->s1->et2[obj->s1->in2];
     
     s1773(sislpt, obj->s1, aepsge,
	   pstart, pend, loc_start, result, &kstat);
     if (kstat < 0) goto error;
  }
  else if ( obj->iobj == SISLCURVE)
  {
     if ((sislpt = newPoint(point, obj->c1->idim, 0)) == SISL_NULL)
        goto error;
     
     pstart[0] = obj->c1->et[obj->c1->ik - 1];
     pend[0]   = obj->c1->et[obj->c1->in];
  
     loc_start[0] = start[0];
     s1771(sislpt, obj->c1, aepsge,
	   pstart[0], pend[0], loc_start[0], result, &kstat);
     if (kstat < 0) goto error;
  }
  else if ( obj->iobj == SISLPOINT)
  {
     if(s6dist(point,obj->p1->ecoef,obj->p1->idim) < aepsge)
	kstat = 1;
     else
        kstat = 2;
  }
  else goto err106;
  
  *jstat = kstat;
  goto out;
  
  /* Error in input. */
  
 err106: *jstat = -106;
  s6err("sh6ptobj",*jstat,kpos);
  goto out;                  
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("sh6ptobj",*jstat,kpos);
  goto out;                  
	 
 out:    if (sislpt != SISL_NULL) freePoint(sislpt);
}


//===========================================================================
void sh6idnewunite (SISLObject *po1, SISLObject *po2, SISLIntdat ** intdat, 
		    SISLIntpt ** pt1, SISLIntpt ** pt2, double weight, 
		    double aepsge, int *jstat)
//===========================================================================
{
   int ki, kstat;
   int kpar;           /* Number of parameter directions in 1. object. */
   int kiterate;       /* Indicates if iteration is necessary.    */
   int kleft1=0,kleft2=0; /* Parameters used in evaluation.       */
   double spar[4];     /* Parameter values of intersection point. */
   double start[2];    /* Start parameter value to iteration.     */
   double spoint[3];   /* Position in curve or surface.           */
   double snorm[3];    /* Dummy vector. Surface normal.           */
   SISLIntpt *lpt;
   SISLIntpt *lpt1;
   SISLIntpt *lpt2;
   
   /* Test if one object is a point.  */
   
   if (po1->iobj == SISLPOINT || po2->iobj == SISLPOINT)
   {
      kpar = po1->iobj + po2->iobj;
      kiterate = 0;
   }
   else
   {
      kpar = po1->iobj;
      kiterate = 1;
   }

  sh6idnpt (intdat, pt1, 0, &kstat);
  if (kstat < 0)
    goto error;
  sh6idnpt (intdat, pt2, 0, &kstat);
  if (kstat < 0)
    goto error;

  if (sh6ismain (*pt1))
    {
      lpt1 = (*pt1);
      lpt2 = (*pt2);
    }
  else
    {
      lpt1 = (*pt2);
      lpt2 = (*pt1);
      weight = 1.0 - weight;
    }

  sh6disconnect (lpt1, lpt2, &kstat);
  if (kstat < 0)
    goto error;

  /* UJK, Oct. 91 */
  /* for (ki=0;;ki++) */
  for (ki = 0;;)
    {
      if ((lpt = sh6getnext (lpt2, ki)) == SISL_NULL)
	break;

      sh6disconnect (lpt2, lpt, &kstat);
      if (kstat < 0)
	goto error;


      sh6connect (lpt1, lpt, &kstat);
      if (kstat < 0)
	goto error;
    }

  for (ki = 0; ki < kpar; ki++)
    spar[ki] = lpt1->epar[ki] * (1.0 - weight) + lpt2->epar[ki] * weight;
  
  if (kiterate)
  {
     /* Compute start parameter to iteration.  */
     
     for (; ki < lpt1->ipar; ki++)
	start[ki-kpar] = lpt1->epar[ki] * (1.0 - weight) + lpt2->epar[ki] * weight;
	
     /* Iterate to closest point in second object. First evaluate
	value of intersection point in first object.  */
     
     if (po1->iobj == SISLCURVE)
     {
	s1221(po1->c1,0,spar[0],&kleft1,spoint,&kstat);
	if (kstat < 0) goto error;
     }
     else
     {
	s1421(po1->s1,0,spar,&kleft1,&kleft2,spoint,snorm,&kstat);
	if (kstat < 0) goto error;
     }
     
     /* Iterate. */
     
     sh6ptobj(spoint,po2,aepsge,start,spar+kpar,&kstat);
     if (kstat < 0) goto error;
  }
  
  /* Copy new parameter values into intersection point. */
  
  memcopy(lpt1->epar,spar,lpt1->ipar,DOUBLE);
     

  sh6idkpt (intdat, &lpt2, 0, &kstat);
  if (kstat < 0)
    goto error;

  (*pt1) = lpt1;
  (*pt2) = lpt2;

  goto out;

error:
  *jstat = kstat;
  s6err ("sh6idunite", kstat, 0);
  goto out;
out:
  ;
}


//===========================================================================
void sh6trimlist (SISLIntpt * pt, SISLIntpt *** ptlist, int *no_of_points,
		  int *no_alloc)
//===========================================================================
{
  int clean_up = FALSE;		/* Clean up on top level */
  int incr = 20;		/* Allocation size       */
  int ki;			/* Loop control          */
  /* --------------------------------------------------- */


  /* Check if point is a TRIM point */
  if (pt->iinter != SI_TRIM)
    goto out;

  /* Check if point is treated */
  if (pt->marker == -90)
    goto out;

  /* Mark point as treated */
  pt->marker = -90;


  if (*no_alloc <= *no_of_points)
    {
      if (*no_alloc == 0)
	{
	  clean_up = TRUE;
	  (*no_alloc) += incr;
	  *ptlist = newarray (*no_alloc, SISLIntpt *);
	  if (*ptlist == SISL_NULL)
	    goto out;
	}
      else
	{
	  clean_up = FALSE;
	  (*no_alloc) += incr;
	  *ptlist = increasearray (*ptlist, *no_alloc, SISLIntpt *);
	  if (*ptlist == SISL_NULL)
	    goto out;
	}
    }

  /* Fill in */
  (*ptlist)[*no_of_points] = pt;
  (*no_of_points)++;

  /* Treat all neighbours */
  for (ki = 0; ki < pt->no_of_curves; ki++)
    sh6trimlist (pt->pnext[ki], ptlist, no_of_points, no_alloc);


/* Must unmark the points in array if no_alloc == 0 */
  if (clean_up)
    for (ki = 0; ki < (*no_of_points); ki++)
      (*ptlist)[ki]->marker = 0;

  goto out;


out:
  return;
}


//===========================================================================
void sh6red (SISLObject * po1, SISLObject * po2,
	     SISLIntdat * pintdat, int *jstat)
//===========================================================================
{
  int kstat, i, j;
  double tepsge = (double)10000.0*REL_COMP_RES;
  double weight = (double) 0.5;
  int changed;
  SISLIntpt *pcurr,*pstart,*plast;	/* to traverse list of points.     */
  int indstart,indlast,inddum;		/* Indexes used in lists           */
  int log_1, log_2;

  /* Remove all internal points in a list when along a
     constant parameter direction */
  
  if (((po1->iobj == SISLSURFACE && po2->iobj == SISLPOINT
        && po1->s1->idim == 1) ||
       (po2->iobj == SISLSURFACE && po1->iobj == SISLPOINT
        && po2->s1->idim == 1) ||
       (po1->iobj == SISLSURFACE && po2->iobj == SISLSURFACE
        && po1->s1->idim == 3)) &&
        pintdat != SISL_NULL)
     for (j = 0; j < pintdat->ipoint; j++)
     {
	
	pcurr = pintdat->vpoint[j];
	sh6isinside (po1, po2, pcurr, &kstat);
	if (kstat < 0)
	   goto error;
	
	/* VSK && ALA. 01.93. Do not remove points at corners. */
	if (kstat != 1 && kstat != 2) continue;
	
	sh6getnhbrs (pcurr, &pstart, &plast, &kstat);
	if (kstat < 0)
	   goto error;
	
	if (kstat == 0)
	{
	   /* Two neighbours, check */
	   sh6getlist (pcurr, pstart, &indstart, &inddum, &kstat);
	   if (kstat < 0)
	      goto error;		/* Error. */
	   if (kstat == 1)
	      goto errinconsist;	/* pcurr and pstart are not linked. */
	   
	   sh6getlist (pcurr, plast, &indlast, &inddum, &kstat);
	   if (kstat < 0)
	      goto error;		/* Error. */
	   if (kstat == 1)
	      goto errinconsist;	/* pcurr and plast are not linked. */
	   
	   log_1 = pcurr->curve_dir[indstart];
	   log_1 = log_1>>1;
	   log_1 &= 15;
	   log_2 = pcurr->curve_dir[indlast];
	   log_2 = log_2>>1;
	   log_2 &= 15;
	   	   
	   if (log_1 & log_2 )
	   {
	      sh6idkpt (&pintdat, &pcurr, 1, &kstat);
	      if (kstat < 0)
		 goto error;
	      /* Recursive nature : */
	      j = -1;
	   }
	   
	   
	}
     }
   
  
  if (pintdat != SISL_NULL)
    {
      /* Weight value in 3D sf vs sf case is one */
      if (pintdat->vpoint[0]->ipar == 4)
	weight = (double) 1.0;

      /* Reduce an illegal trim_curve to one point. */

      for (i = 0; i < pintdat->ipoint; i++)
	{
	  if (pintdat->vpoint[i]->iinter == SI_TRIM)
	    {
	      SISLIntpt **trim = SISL_NULL;
	      int no_trim = 0;
	      int no_alloc = 0;
	      sh6trimlist (pintdat->vpoint[i], &trim, &no_trim, &no_alloc);
	      for (j = 0; j < no_trim; j++)
		{
		  sh6isinside (po1, po2, trim[j], &kstat);
		  if (kstat < 0)
		    goto error;
		  if (kstat != 1)
		    break;
		}
	      if (j == no_trim)
		{
		  /* Internal trim area. */
		  for (j = 1; j < no_trim; j++)
		    {
		       /* sh6idunite (&pintdat, &trim[0], &trim[j], weight, &kstat);
			  */
		       /* VSK. 01.93. */
		       sh6idnewunite(po1, po2, &pintdat, &trim[0], &trim[j], 
				     weight, tepsge, &kstat);
		      if (kstat < 0)
			goto error;

		      /* We now need to correct the intpoint. */
		    }
		  trim[0]->iinter = SI_SING;
		}
	      if (trim)
		freearray (trim);
	    }
	}

      /* Reduse ilegal main points to help points. */
      do
	{
	  changed = 0;
	  for (i = 0; i < pintdat->ipoint; i++)
	    {
	      sh6isinside (po1, po2, pintdat->vpoint[i], &kstat);
	      if (kstat < 0)
		goto error;
	      if (kstat == 1)
		{
		  if (sh6ismain (pintdat->vpoint[i]) &&
		      sh6nmbmain (pintdat->vpoint[i], &kstat) == 1)
		    {
		      sh6tohelp (pintdat->vpoint[i], &kstat);
		      if (kstat < 0)
			goto error;
		      changed = 1;
		    }
		}
	    }
      } while (changed);
 
      /*UJK, 12.08.93 */
      /* Disconnect trim pts with 3 neighbours */
      do
	{
	   int ind_1,ind_2;
	   SISLIntpt *p_neighb[3];
	   int log_check[3];
	   changed = 0;
	   for (i = 0; i < pintdat->ipoint; i++)
	   {
	      pcurr = pintdat->vpoint[i];
	      sh6isinside (po1, po2, pcurr, &kstat);
	      if (kstat < 0)
		 goto error;
	      if (kstat &&
		  pcurr->iinter == SI_TRIM &&
		  sh6nmbmain (pcurr, &kstat) == 3)
	      {
		 for (ind_1=ind_2=0;ind_1<pcurr->no_of_curves;ind_1++)
		    if (pcurr->pnext[ind_1]->iinter == SI_TRIM)
		    {
		       sh6isinside (po1, po2, pcurr->pnext[ind_1], &kstat);
		       if (kstat < 0)
			  goto error;
		       if (kstat)
		       {
			  p_neighb[ind_2]  = pcurr->pnext[ind_1];
			  log_check[ind_2] = pcurr->curve_dir[ind_1];
			  log_check[ind_2] = log_check[ind_2]>>1;
			  log_check[ind_2] &= 15;
			  ind_2++;
		       }
		    }
		 
		 if (ind_2 == 3)
		 {
		    if (log_check[0] & log_check[1])
		       ind_2 = 2;
		    else if (log_check[0] & log_check[2])
		       ind_2 = 1;
		    else if (log_check[1] & log_check[2])
		       ind_2 = 0;
		    
		    if (ind_2 < 3)
		    {
		       changed = TRUE;
		       sh6disconnect(pcurr,p_neighb[ind_2],&kstat);
		       if (kstat < 0) goto error;
		       /* afr: Changed line below from an empty if-statement. */
		       sh6nmbmain (p_neighb[ind_2], &kstat);
		       if (kstat < 0) goto error;
		       sh6idkpt (&pintdat, &p_neighb[ind_2], 0, &kstat);
		       if (kstat < 0) goto error;
		    }
		 }
	      }
	   }
	} while (changed);
    }


  /* Reduction done. */

  (*jstat) = 0;
  goto out;

errinconsist:
  *jstat = -500;
  s6err ("sh6red", *jstat, 0);
  goto out;
  
error:(*jstat) = kstat;
  s6err ("sh6red", *jstat, 0);
  goto out;

out:
  return;
}


//===========================================================================
void sh6idcon (SISLIntdat ** pintdat, SISLIntpt ** pintpt1, 
	       SISLIntpt ** pintpt2, int *jstat)
//===========================================================================
{
  int kstat;			/* Local status variable.                     */

  /* First we have to be sure that pintdat contain the two points. */

  sh6idnpt (pintdat, pintpt1, 1, &kstat);
  if (kstat < 0)
    goto error;

  sh6idnpt (pintdat, pintpt2, 1, &kstat);
  if (kstat < 0)
    goto error;

    /* Connect */
  sh6connect (*pintpt1, *pintpt2, &kstat);
  if (kstat < 0)
    goto error;

    /* Set direction of connection. */
    /*  sh6setdir(*pintpt1, *pintpt2, &kstat);
    if (kstat < 0)
    goto error; */


  *jstat = 0;
  goto out;

  /* Error from lower function */
error:
  *jstat = kstat;
  s6err ("sh6idcon", *jstat, 0);
  out:
     ;
}


//===========================================================================
void sh6insertpt (SISLIntpt * pt1, SISLIntpt * pt2, SISLIntpt * ptnew, int *jstat)
//===========================================================================
{
  int kstat;			/* Local status variable.                  */
  int index1=0,index2=0;
  int crv_dir1=0,crv_dir2=0;
  
  *jstat = 0;

  sh6getlist (pt1, pt2, &index1, &index2, &kstat);
  if (kstat < 0)
    goto error;			/* Error. */
  if (kstat == 1)
    goto err1;			/* pt1 and pt2 are not linked. */

  /* Save info in curve_dir */
  crv_dir1 = pt1->curve_dir[index1];
  crv_dir2 = pt2->curve_dir[index2];


  /* Check pt1,pt2,ptnew. */

  sh6connect (pt1, ptnew, &kstat);
  if (kstat < 0)
    goto error;			/* Error. */

  /* Set values in curve_dir */
  sh6getlist (pt1, ptnew, &index1, &index2, &kstat);
  pt1->curve_dir[index1]   = crv_dir1;
  ptnew->curve_dir[index2] = crv_dir2;

  sh6connect (pt2, ptnew, &kstat);
  if (kstat < 0)
    goto error;			/* Error. */

  /* Set values in curve_dir */
  sh6getlist (pt2, ptnew, &index1, &index2, &kstat);
  pt2->curve_dir[index1] = crv_dir2;
  ptnew->curve_dir[index2] = crv_dir1;


  sh6disconnect (pt1, pt2, &kstat);
  if (kstat < 0)
    goto error;			/* Error. */
  if (kstat == 1)
    goto err1;			/* pt1 and pt2 are not linked. */


  goto out;


/* Error. pt1 and pt2 are not linked.  */

err1:*jstat = -1;
  s6err ("sh6insertpt", *jstat, 0);
  goto out;

/* Error in sub function.  */

error:*jstat = kstat;
  s6err ("sh6insertpt", *jstat, 0);
  goto out;

out:
  return;
}


//===========================================================================
int sh6nmbmain(SISLIntpt *pt,int *jstat)
//===========================================================================
{
   int num; /* Number of lists. */
   int ki; /* Loop variable.  */

   num=0;

   /* Count number of main lists pt lies in. */

   for(ki=0; ki<pt->no_of_curves; ki++)
   {
       if(pt->pnext[ki] == SISL_NULL) goto err1;
       if(sh6ismain(pt->pnext[ki])) num++;
   }

   goto out;
   

err1:
   /* Error in data structure. */
   
   *jstat = -1;
   s6err("sh6nmbmain",*jstat,0);
   goto out;
   
   
   out :
      return num;
}


//===========================================================================
void sh6connect (SISLIntpt * pt1, SISLIntpt * pt2, int *jstat)
//===========================================================================
{
  int kstat;			/* error flag. */
  int index1, index2;		/* dummy indices.           */
  int num;			/* Number of main point pinters.  */

  *jstat = 0;
  
  if (pt1 == pt2)
    goto err4;

  /* Check if pt1 and pt2 are already connected. */

  sh6getlist (pt1, pt2, &index1, &index2, &kstat);
  if (kstat < 0)
    goto err3;
  if (kstat < 1)		/* Already connected. */
    {
      *jstat = 1;
      goto out;
    }

  /* Check that we can connect pt1. There are restrictions if it
     it a help point.  */

  if (sh6ishelp (pt1))		/* pt1 is a help point */
    {
      /* UJK, this is NO invariant */
      /*if (pt1->no_of_curves > 2)
         goto err2;
         if (pt1->no_of_curves == 2)
         goto err1; */

      if (sh6ismain (pt2))	/* pt2 is a main point. */
	{
	  num = sh6nmbmain (pt1, &kstat);

	  /* UJK, If invar does not hold, MAKE it hold */
	  /* if (num > 1)
	    goto err2;
	  if (num == 1)
	    goto err1; */
	  if (num >= 1)
	    sh6tomain (pt1, &kstat);
	  if (kstat < 0)
	    goto err2;

	  /* pt1 cannot be connected to two main points. */
	}
    }

  /* Check that we can connect pt2. There are restrictions if it
     it a help point.  */

  if (sh6ishelp (pt2))		/* pt2 is a help point */
    {
      /* UJK, this is NO invariant */
      /*if (pt2->no_of_curves > 2)
         goto err2;
         if (pt2->no_of_curves == 2)
         goto err1; */

      if (sh6ismain (pt1))	/* pt1 is a main point. */
	{
	  num = sh6nmbmain (pt2, &kstat);

	  /* UJK, If invar does not hold, MAKE it hold */
	  /*if (num > 1)
	    goto err2;
	  if (num == 1)
	    goto err1; */
	  if (num >= 1)
	    sh6tomain (pt2, &kstat);
	  if (kstat < 0)
	    goto err2;

	  /* pt2 cannot be connected to two main points. */
	}
    }

  /* Now make the connection. */


  /* Point pt1 to pt2. */

  /* Check if we need to reallocate the pnext and curve_dir arrays. */

  if (pt1->no_of_curves > pt1->no_of_curves_alloc)
    goto err2;
  if (pt1->no_of_curves == pt1->no_of_curves_alloc)
    {
      pt1->no_of_curves_alloc += 4;
      pt1->pnext = increasearray (pt1->pnext,
				  pt1->no_of_curves_alloc, SISLIntpt *);
      pt1->curve_dir = increasearray (pt1->curve_dir,
				      pt1->no_of_curves_alloc, int);
      /* UJK, Must have size of pretop arrays increased */
      pt1->left_obj_1 = increasearray (pt1->left_obj_1,
				       pt1->no_of_curves_alloc, int);
      pt1->left_obj_2 = increasearray (pt1->left_obj_2,
				       pt1->no_of_curves_alloc, int);
      pt1->right_obj_1 = increasearray (pt1->right_obj_1,
					pt1->no_of_curves_alloc, int);
      pt1->right_obj_2 = increasearray (pt1->right_obj_2,
					pt1->no_of_curves_alloc, int);
    }

  /* Set new pointer to new position in array. */
  /* Set new curve direction to 0 for now. */

  pt1->pnext[pt1->no_of_curves] = pt2;
  pt1->curve_dir[pt1->no_of_curves] = 0;

  /* Increment no_of_curves. */

  pt1->no_of_curves++;


  /* Point pt2 to pt1. */

  /* Check if we need to reallocate the pnext and curve_dir arrays. */

  if (pt2->no_of_curves > pt2->no_of_curves_alloc)
    goto err2;
  if (pt2->no_of_curves == pt2->no_of_curves_alloc)
    {
      pt2->no_of_curves_alloc += 4;
      /* UJK, pt1->pnext chaged to pt2->pnext */
      pt2->pnext = increasearray (pt2->pnext,
				  pt2->no_of_curves_alloc, SISLIntpt *);
      pt2->curve_dir = increasearray (pt2->curve_dir,
				      pt2->no_of_curves_alloc, int);
      /* UJK, Must have size of pretop arrays increased */
      pt2->left_obj_1 = increasearray (pt2->left_obj_1,
				       pt2->no_of_curves_alloc, int);
      pt2->left_obj_2 = increasearray (pt2->left_obj_2,
				       pt2->no_of_curves_alloc, int);
      pt2->right_obj_1 = increasearray (pt2->right_obj_1,
					pt2->no_of_curves_alloc, int);
      pt2->right_obj_2 = increasearray (pt2->right_obj_2,
					pt2->no_of_curves_alloc, int);
    }

  /* Set new pointer to new position in array. */
  /* Set new curve direction to 0 for now. */

  pt2->pnext[pt2->no_of_curves] = pt1;
  pt2->curve_dir[pt2->no_of_curves] = 0;

  /* Increment no_of_curves. */

  pt2->no_of_curves++;



  goto out;

  /* Illegal to connect. */
  /*err1:

  *jstat = -1;
  s6err ("sh6connect", *jstat, 0);
  goto out; */

  /* Error in data structure. */
err2:

  *jstat = -2;
  s6err ("sh6connect", *jstat, 0);
  goto out;

  /* Error in subfunction. */
err3:

  *jstat = -3;
  s6err ("sh6connect", *jstat, 0);
  goto out;

err4:
  /* Selfconnecting not legal */
  *jstat = -4;
  s6err ("sh6connect", *jstat, 0);
  goto out;


out:
  return;
}


//===========================================================================
void sh6disconnect(SISLIntpt *pt1,SISLIntpt *pt2,int *jstat)
//===========================================================================
{
  int kstat;                 /* Local status variable.            */
  int index1,index2;         /* Indices for pt1 and pt2.          */
  
   *jstat = 0;
  

   /* Check if pt1 and pt2 are connected. */

   sh6getlist(pt1,pt2,&index1,&index2,&kstat);
   if(kstat < 0) goto err1;
   if(kstat == 1)
   {
       *jstat = 1;
       goto out;
   }


   /* Disconnect. */

   pt1->no_of_curves--;
   pt1->pnext[index1] = pt1->pnext[pt1->no_of_curves];
   pt1->curve_dir[index1] = pt1->curve_dir[pt1->no_of_curves];

   pt2->no_of_curves--;
   pt2->pnext[index2] = pt2->pnext[pt2->no_of_curves];
   pt2->curve_dir[index2] = pt2->curve_dir[pt2->no_of_curves];

  
  goto out;  
  

  
  /* No connection exists. */

  err1 : *jstat = -1;
  s6err("sh6disconnect",*jstat,0);
  goto out;                       
  
  out: ;
}


//===========================================================================
void sh6idkpt (SISLIntdat ** pintdat, SISLIntpt ** pintpt, int join, int *jstat)
//===========================================================================
{
  int ki;			/* Counters.    */
  int knum;
  int kstat = 0;
  SISLIntpt *pnhbr_1 = SISL_NULL;	/* First neighbour  */
  SISLIntpt *pnhbr_2 = SISL_NULL;	/* Second neighbour */
  SISLIntpt *help_pt = SISL_NULL;	/* help point */
  int crv_dir_1 = 0;
  int crv_dir_2 = 0;
  int index1 = 0;
  int index2 = 0;
  int dummy;
  /* ------------------------------------------------*/
  
  *jstat = 0;
  
  if ((*pintpt) == SISL_NULL)
  {
     *jstat = 1;
     goto out;
  }
  
  if (join)
  {
     /* ALA-- We first remove all help point if this point is a main point. */
     if (sh6ismain(*pintpt))
	for (ki = 0; ki < (*pintpt)->no_of_curves; ki++)
	{
	   if (sh6ishelp(help_pt = sh6getnext(*pintpt, ki)))
	   {
	      sh6idkpt (pintdat, &help_pt, 1, &kstat);
	      if (kstat < 0)
		 goto error;
	   }
	}
     
     /* Remember the two neighbours */
     sh6getnhbrs (*pintpt, &pnhbr_1, &pnhbr_2, &kstat);
     if (kstat < 0)
	goto error;
     
     
     if (pnhbr_1 && pnhbr_2)
     {
	/* Two neighbours, remember crv_dir */
	sh6getlist (*pintpt, pnhbr_1, &dummy, &index1, &kstat);
	if (kstat < 0)
	   goto error;		/* Error. */
	if (kstat == 1)
	   goto err1;		/* pt1 and pt2 are not linked. */
	
	sh6getlist (*pintpt, pnhbr_2, &dummy, &index2, &kstat);
	if (kstat < 0)
	   goto error;		/* Error. */
	if (kstat == 1)
	   goto err1;		/* pt1 and pt2 are not linked. */
	
	crv_dir_1 = pnhbr_1->curve_dir[index1];
	crv_dir_2 = pnhbr_2->curve_dir[index2];
     }
  }

  
  for (; (*pintpt)->no_of_curves;)
  {
     /* Disconnect all */
     sh6disconnect (*pintpt, (*pintpt)->pnext[0], &kstat);
     if (kstat < 0)
	goto error;
  }
  
  /* Connect the two neighbours */
  if (pnhbr_1 && pnhbr_2)
  {
     sh6connect (pnhbr_1, pnhbr_2, &kstat);
     if (kstat < 0)
	goto error;
     
     /* UJK, MESZ 930617: Don't bother with curve_dir when 
	the points already were connected. */
     if (kstat != 1)
     {
	sh6getlist (pnhbr_1, pnhbr_2, &index1, &index2, &kstat);
	if (kstat < 0)
	   goto error;		/* Error. */
	if (kstat == 1)
	   goto err1;		/* pt1 and pt2 are not linked. */
	
	pnhbr_1->curve_dir[index1] = crv_dir_1;
	pnhbr_2->curve_dir[index2] = crv_dir_2;
     }
  }
  
  if ((*pintdat) == SISL_NULL)
  {
     freeIntpt (*pintpt);
     (*pintpt) = SISL_NULL;
     
     *jstat = 1;
     goto out;
  }
  
  
  /* Find pintpt in pintdat. */
  
  for (knum = -1, ki = 0; ki < (*pintdat)->ipoint; ki++)
  {
     if ((*pintdat)->vpoint[ki] == (*pintpt))
     {
	knum = ki;
	break;
     }
  }
  
  
  if (knum == -1)
     *jstat = 1;
  else
  {
     (*pintdat)->vpoint[knum] = (*pintdat)->vpoint[(*pintdat)->ipoint - 1];
     ((*pintdat)->ipoint)--;
     (*pintdat)->vpoint[(*pintdat)->ipoint] = SISL_NULL;
     
     
     
     if ((*pintdat)->ipoint == 0)
     {
	freeIntdat (*pintdat);
	(*pintdat) = SISL_NULL;
     }
  }
  
  freeIntpt (*pintpt);
  (*pintpt) = SISL_NULL;
  goto out;
  
  
err1:
  *jstat = -1;
  goto out;
  
error:
  *jstat = kstat;
  goto out;

out:;
}


//===========================================================================
void sh_div_crv (SISLCurve * pc, int which_end, double aepsge, 
		 SISLCurve ** rcnew, int *jstat)
//===========================================================================
{
  int kpos = 0;			/* Position of error.               */
  int ki,kj;                    /* Loop control                     */
  int kn,kk,kdim;               /* Attributes of inut curve         */			/* Position of error.               */
  double a,b;                   /* Bezier interval                  */
  double *et_new = SISL_NULL;        /* New knot array                   */
  double *ecoef_new = SISL_NULL;     /* New coefficient array            */
  SISLCurve *qc = SISL_NULL;		/* Pointer to new curve-object.     */


  /* Check that we have a curve. */
  if (!pc)
    goto err150;

  /* Minimum order allowed is 3. */
  if (pc->ik < 3)
     goto err151;
  
  /* The curve has to be of bezier type. */
  if (pc->in != pc->ik)
     goto err152;

  kn = pc->in;
  kk = pc->ik;
  a  = pc->et[kk-1];
  b  = pc->et[kn];
  kdim = pc->idim;

    /* Test if the corresponding coeficient is zero. */
/*  if (which_end == 0)
  {
     for (ki=0; ki < kdim; ki++)
	if (fabs(pc->ecoef[ki]) > aepsge)
	   goto err153;
  }
  else
  {
     for (ki=(kn-1)*kdim; ki < kn*kdim; ki++)
	if (fabs(pc->ecoef[ki]) > aepsge)
	   goto err153;
  }
  */
  
  /* create knot array. __________________________________________*/
  if ((et_new= newarray(kn+kk-2,DOUBLE)) == SISL_NULL) goto err101;

  for (ki=0; ki < kk-1; ki++)
  et_new[ki] = a;

    for (; ki < kn+kk-2; ki++)
  et_new[ki] = b;

  /* create coeficient array. _________________________________ */
  if ((ecoef_new= newarray(kdim*(kn-1),DOUBLE)) == SISL_NULL) goto err101;

  if (which_end)
     for (ki=0; ki < kn-1; ki++)
	for (kj=0; kj < kdim; kj++)
	   ecoef_new[ki*kdim +kj] = pc->ecoef[ki*kdim +kj]*(kn-1)/(kn-1-ki);
  else
     for (ki=0; ki < kn-1; ki++)
	for (kj=0; kj < kdim; kj++)
	   ecoef_new[ki*kdim +kj] = pc->ecoef[(ki+1)*kdim + kj]*(kn-1)/(ki+1);
  
  
  /* Create factor curve */
  if ((qc = newCurve (kn-1, kk-1, et_new, ecoef_new, pc->ikind, kdim, 2))
      == SISL_NULL) goto err101;

  *rcnew = qc;
  *jstat = 0;
  goto out;

/* ERROR EXITS ___________________________________________ */

/* Error. No input curve.  */
err150:
  *jstat = -150;
  s6err ("sh_div_crv", *jstat, kpos);
  goto out;


/* Error. order less than 3.  */
err151:
  *jstat = -151;
  s6err ("sh_div_crv", *jstat, kpos);
  goto out;

/* Error. Not a bezier curve.  */
err152:
  *jstat = -152;
  s6err ("sh_div_crv", *jstat, kpos);
  goto out;


/* Error in allocation.*/

err101:
  if (et_new) freearray(et_new);
  if (ecoef_new) freearray(ecoef_new);
  *jstat = -101;
  s6err ("sh_div_crv", *jstat, kpos);
  goto out;

out:
;
}


//===========================================================================
void sh_div_surf (SISLSurf * ps, int which_end_1, int which_end_2,
		  double aepsge, SISLSurf ** rsnew, int *jstat)
//===========================================================================
{
  int kstat;			/* Local status variable.		*/
  int kdim = ps->idim;		/* Dimension of geometry space.        */
  int kkind = ps->ikind;	/* Kind of surface.                    */
  int kk1;			/* Order in 1. par. dir.               */
  int kk2;			/* Order in 2. par. dir.               */
  int kn1;			/* Number of vertices in 1. par. dir.  */
  int kn2;			/* Number of vertices in 2. par. dir.  */
  double *st1;			/* Knot vector in 1. par. dir.         */
  double *st2;			/* Knot vector in 2. par. dir.         */
  double *scoef1 = SISL_NULL;	/* Coefficients of input curve to
			           factorize in 1. par. dir.           */
  double *scoef2 = SISL_NULL;	/* Coefficients of factorized surface. */
  double *scoef;		/* Coefficients of factorized surface. */
  SISLCurve *qc1 = SISL_NULL;	/* Input curve to sh_div_crv in 1. par. dir.    */
  SISLCurve *qc2 = SISL_NULL;	/* Output curve from sh_div_crv in 1. par. dir. */
  SISLCurve *qc3 = SISL_NULL;	/* Output curve from sh_div_crv in 2. par. dir. */
  /* __________________________________________________________________ */

  if (which_end_1 > -1)
    {
      /* Factorize 1. dir,
	 first express the surface as a curve.  */

      if ((scoef1 = newarray (kdim * ps->in1 * ps->in2, double)) == SISL_NULL)
	goto err101;

      /* Change parameter directions of surface.  */

      s6chpar (ps->ecoef, ps->in1, ps->in2, kdim, scoef1);

      /* Create curve.  */

      qc1 = newCurve (ps->in1, ps->ik1, ps->et1, scoef1, kkind, kdim * ps->in2, 0);
      if (qc1 == SISL_NULL)
	goto err101;

      /* Factorize the curve.  */
      sh_div_crv (qc1, which_end_1, aepsge, &qc2, &kstat);
      if (kstat < 0)
	goto error;

      /* Change parameter directions of the coefficient array of
         the resulting curve.  */

      if ((scoef2 = newarray (qc2->in *ps->in2 * kdim, DOUBLE)) == SISL_NULL)
	goto err101;
      s6chpar (qc2->ecoef, ps->in2, qc2->in, kdim, scoef2);

      /* Set local parameters of factorized surface. */

      kk1 = qc2->ik;
      kn1 = qc2->in;
      kk2 = ps->ik2;
      kn2 = ps->in2;
      st1 = qc2->et;
      st2 = ps->et2;

      /* Free curve used as input to the sh_div_crv. */

      if (qc1 != SISL_NULL)
	freeCurve (qc1);
      qc1 = SISL_NULL;
    }
  else
    {
      /* Set local parameters of input surface. */

      kk1 = ps->ik1;
      kk2 = ps->ik2;
      kn1 = ps->in1;
      kn2 = ps->in2;
      st1 = ps->et1;
      st2 = ps->et2;
      scoef2 = ps->ecoef;
    }

  if (which_end_2 > -1)
    {
      /* Factorize in second parameter direction of the
	 surface. First express the surface as a curve.           */

      if ((qc1 = newCurve (kn2, ps->ik2, st2, scoef2, kkind, kn1 * kdim, 0))
	  == SISL_NULL)
	goto err101;



      
      /* Factorize the curve.  */
      sh_div_crv(qc1, which_end_2, aepsge, &qc3, &kstat);
      if (kstat < 0)
	goto error;

      /*	Set local parameters of the surface. */

      kk2 = qc3->ik;
      kn2 = qc3->in;
      st2 = qc3->et;
      scoef = qc3->ecoef;
    }
  else
    scoef = scoef2;

  /* Express result as a surface.  */

  if ((*rsnew = newSurf (kn1, kn2, kk1, kk2, st1, st2,
			 scoef, kkind, kdim, 1)) == SISL_NULL)
    goto err101;

  /* Exit.  */

  *jstat = 0;
  goto out;

  /* Error in scratch allocation.  */

err101:*jstat = -101;
  goto out;

  /* Error in lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
  /* Free scratch occupied by local arrays and objects.  */

  if (which_end_1 > -1 && scoef1 != SISL_NULL)
    freearray (scoef1);
  if (which_end_1 > -1&& scoef2 != SISL_NULL)
    freearray (scoef2);
  if (qc1 != SISL_NULL)
    freeCurve (qc1);
  if (qc2 != SISL_NULL)
    freeCurve (qc2);
  if (qc3 != SISL_NULL)
    freeCurve (qc3);

  return;
}


//===========================================================================
void sh6comedg (SISLObject * po1, SISLObject * po2, SISLIntpt *pt1, SISLIntpt *pt2, int *jstat)
//===========================================================================
{
 int kstat=0;
 double minpar[4];
 double maxpar[4];
 int nrpar, np1, np2;
 int common_edg, i, j;
 int is_inside = 1;
 int on_edge1 = 0;
 int on_edge2 = 0;
 int ind1, ind2;
 /* ---------------------------------------------------------------- */
 
 *jstat = 0;
   
 if (pt1 != SISL_NULL && pt2 != SISL_NULL)
 {
    /* Making the parametric boarders */
 
    if (po1->iobj == SISLSURFACE)
    {
       nrpar = 2;
       np1 = 4;

       minpar[0] = po1->s1->et1[po1->s1->ik1-1];
       minpar[1] = po1->s1->et2[po1->s1->ik2-1];
       maxpar[0] = po1->s1->et1[po1->s1->in1];
       maxpar[1] = po1->s1->et2[po1->s1->in2];
    }
    else if (po1->iobj == SISLCURVE)
    {
       nrpar = 1;
       np1 = 2;

       minpar[0] = po1->c1->et[po1->c1->ik-1];
       maxpar[0] = po1->c1->et[po1->c1->in];
    }
    else    /* SISLPOINT */
       np1 = nrpar = 0;

    if (po2->iobj == SISLSURFACE)
    {
       minpar[nrpar]   = po2->s1->et1[po2->s1->ik1-1];
       minpar[nrpar+1] = po2->s1->et2[po2->s1->ik2-1];
       maxpar[nrpar]   = po2->s1->et1[po2->s1->in1];
       maxpar[nrpar+1] = po2->s1->et2[po2->s1->in2];
       nrpar += 2;
       np2 = 4;
    }
    else if (po2->iobj == SISLCURVE)
    {
       minpar[nrpar] = po2->c1->et[po2->c1->ik-1];
       maxpar[nrpar] = po2->c1->et[po2->c1->in];
       nrpar++;
       np2 = 2;
    }
    else   np2 = 0;     /* SISLPOINT */

    /* Testing. */
    
    /* UJK, aug.92 */
    /* for (i = 0; i < nrpar || !is_inside; i++) */
    for (i = 0; i < nrpar && is_inside; i++)
      {
	 if (pt1->epar[i] <= maxpar[i] + REL_PAR_RES &&
	     pt1->epar[i] >= minpar[i] - REL_PAR_RES)
	   {
	      /* pt1 is inside. */
	      
	      if (pt1->epar[i] >= maxpar[i] - REL_PAR_RES)
		on_edge1 +=  (1 << (2*i));	/* On edge/end */
	      if (pt1->epar[i] <= minpar[i] + REL_PAR_RES)
		on_edge1 +=  (1 << (2*i+1));	/* On edge/end */
	      
	   }
	 else  is_inside = 0;
	 
	 if (pt2->epar[i] <= maxpar[i] + REL_PAR_RES &&
	     pt2->epar[i] >= minpar[i] - REL_PAR_RES)
	   {
	      /* pt2 is inside. */
	      
	      if (pt2->epar[i] >= maxpar[i] - REL_PAR_RES)
		on_edge2 +=  (1 << (2*i));	/* On edge/end */
	      if (pt2->epar[i] <= minpar[i] + REL_PAR_RES)
		on_edge2 +=  (1 << (2*i+1));	/* On edge/end */
	      
	   }
	 else  is_inside = 0;
      }
    
    common_edg = on_edge1 & on_edge2;
    (*jstat) = 0;
    
    if(is_inside && common_edg)
    {
       if (np1 > 0)
       {
	  j = (15>>(4-np1));
	  if (common_edg & j)
	  {
	     sh6getlist(pt1,pt2,&ind1,&ind2,&kstat);
             if (kstat < 0) goto err106;
             if (kstat == 0)
	     {
		if (common_edg & 3) i = 2;
		else i = 0;
		if (common_edg & (3<<2)) i+= 4;
		if (pt1->curve_dir[ind1] & i)  (*jstat) = 1;
	     }
	  }
       }
       if (np2 > 0)
       {
	  j = (15>>(4-np2));
	  j <<= np1;
	  if (common_edg & j)
	  {
	     sh6getlist(pt1,pt2,&ind1,&ind2,&kstat);
             if (kstat < 0) goto err106;
             if (kstat == 0)
	     {
		if (common_edg & (3<<np1)) i = 8;
		else i = 0;
		if (common_edg & (3<<(np1+2))) i+= 16;
		if (pt1->curve_dir[ind1] & i)  (*jstat) += 2;
	     }
	  }
       }
    }
    else
       (*jstat) = 0;
 }
 else goto err108;

 
  /* Done. */

  goto out;

  /* Error in input. Conflicting dimensions.  */

err106:*jstat = -106;
  s6err("sh6comedg",*jstat,0);
  goto out;

  /* Error in input. No points */

err108:*jstat = -108;
  s6err("sh6comedg",*jstat,0);
  goto out;

out:
  return;
}


//===========================================================================
void sh6isinside (SISLObject * po1, SISLObject * po2, SISLIntpt *intpt, int *jstat)
//===========================================================================
{
 double minpar[4];
 double maxpar[4];
 int nrpar;
 int i;
 int is_inside = 1;
 int on_edge = 0;

   
 if (intpt != SISL_NULL)
 {
    /* Making the parametric boarders */
 
    if (po1->iobj == SISLSURFACE)
    {
       nrpar = 2;

       minpar[0] = po1->s1->et1[po1->s1->ik1-1];
       minpar[1] = po1->s1->et2[po1->s1->ik2-1];
       maxpar[0] = po1->s1->et1[po1->s1->in1];
       maxpar[1] = po1->s1->et2[po1->s1->in2];
    }
    else if (po1->iobj == SISLCURVE)
    {
       nrpar = 1;

       minpar[0] = po1->c1->et[po1->c1->ik-1];
       maxpar[0] = po1->c1->et[po1->c1->in];
    }
    else    /* SISLPOINT */
       nrpar = 0;

    if (po2->iobj == SISLSURFACE)
    {
       minpar[nrpar]   = po2->s1->et1[po2->s1->ik1-1];
       minpar[nrpar+1] = po2->s1->et2[po2->s1->ik2-1];
       maxpar[nrpar]   = po2->s1->et1[po2->s1->in1];
       maxpar[nrpar+1] = po2->s1->et2[po2->s1->in2];
       nrpar += 2;
    }
    else if (po2->iobj == SISLCURVE)
    {
       minpar[nrpar] = po2->c1->et[po2->c1->ik-1];
       maxpar[nrpar] = po2->c1->et[po2->c1->in];
       nrpar++;
    }
    /*else    SISLPOINT */
    
    if (nrpar != intpt->ipar) goto err106;

    /* Testing. */
    
    for (i = 0; (i < nrpar) && is_inside; i++)
    {
       if ((intpt->epar[i] <= maxpar[i] + REL_PAR_RES || 
	    DEQUAL(intpt->epar[i], maxpar[i])) &&
	    (intpt->epar[i] >= minpar[i] - REL_PAR_RES ||
	     DEQUAL(intpt->epar[i], minpar[i])))
	{
	   /* Int point is inside. */
	   
	   if (intpt->epar[i] >= maxpar[i] - REL_PAR_RES)
	      on_edge +=  (1 << (2*i));	/* On edge/end */
	   if (intpt->epar[i] <= minpar[i] + REL_PAR_RES)
	      on_edge +=  (1 << (2*i+1));	/* On edge/end */
	   
	}
	else  is_inside = 0;
    }
    
    if (is_inside)
    {
       (*jstat) = 1;
       if(on_edge)
       {
	  (*jstat) += 1;
	  if(on_edge > 1)
	  {
    	     if (po1->iobj == SISLSURFACE)
     	     {
		if ((on_edge & 1 || on_edge & 2) &&
		    (on_edge & 4 || on_edge & 8))
		   (*jstat) += 1;
	     }

	     if (po2->iobj == SISLSURFACE )
     	     {
		int ui = 2*(nrpar - 2);
		if ((on_edge & (1 << (ui)) || on_edge & (1 << (ui+1))) &&
		    (on_edge & (1 << (ui+2)) || on_edge & (1 << (ui+3))))
		   (*jstat) += 1;
	     }
	  }
       }
       
       /* Test if the intersection point lies at an edge in both
	  objects and is not registered as a corner point.       */
       
       if (*jstat == 2 && (on_edge & 15) && (on_edge & 240))
	  *jstat = 5;
    }
    else
       (*jstat) = 0;
 }
 else goto err108;

 
  /* Done. */

  goto out;

  /* Error in input. Conflicting dimensions.  */

err106:*jstat = -106;
  goto out;

  /* Error in input. No points */

err108:*jstat = -108;
  goto out;

out:
  return;
}


//===========================================================================
void freeTrimpar(SISLTrimpar *trimpar)
//===========================================================================
{


  /* Free the instance pointed at by trimpar. */

  freearray(trimpar);

  return;
}

//===========================================================================
void freeIntpt(SISLIntpt *ppt)
//===========================================================================
{
  /* Free the arrays contained in the instance. */

  if (ppt->ipar)
    freearray(ppt -> epar);
  if (ppt->pnext)       freearray(ppt->pnext);
  if (ppt->curve_dir)   freearray(ppt->curve_dir);
  if (ppt->left_obj_1)  freearray(ppt->left_obj_1);
  if (ppt->left_obj_2)  freearray(ppt->left_obj_2);
  if (ppt->right_obj_1) freearray(ppt->right_obj_1);
  if (ppt->right_obj_2) freearray(ppt->right_obj_2);
  if (ppt->geo_data_1)  freearray(ppt->geo_data_1);
  if (ppt->geo_data_2)  freearray(ppt->geo_data_2);

  if(ppt->trim[0] != SISL_NULL) freeTrimpar(ppt->trim[0]);
  if(ppt->trim[1] != SISL_NULL) freeTrimpar(ppt->trim[1]);

  /* Free the instance pointed at by ppt. */

  freearray(ppt);
}


//===========================================================================
void s6deCasteljau(double C[], double a, double b, double t, int k, double D[], int* jstat)
//===========================================================================
{
  int r,j,kk=k*k,kr;
  double alpha;
  double Al[16];
  double* A = SISL_NULL;


  *jstat = 1;
  if (a > b || DEQUAL(a,b) ) goto err109;

  if (k > 4 )
    {
      A = newarray(kk,double);
      if (A == SISL_NULL) goto err101;
    }
  else
    A = Al;

  for (j=0; j<k; j++)
    A[j] = C[j];

  alpha = (b-t)/(b-a);
  for (r = 1; r < k; r++)
    for (j = r; j < k; j++)
      A[k*r+j] = alpha*A[k*(r-1)+j-1] + (1-alpha)*A[k*(r-1)+j];
  
  for (kk--,kr=r=0; r<k; r++,kr+=k)
    {
      D[r] = A[kr+r];
      D[k+r] = A[kk-kr];
    }

  goto out;

 err109: *jstat = -109;
  goto out;

 err101: *jstat = -101;
  goto out;

 out: 
  if (A != SISL_NULL && A != Al)
    freearray(A);
  return ;
}


//===========================================================================
void s6sratder(double eder[],int idim,int ider1,int ider2,double gder[],int *jstat)
//===========================================================================
{
  int kpos=0;          /* Position of error.                     */
  double w0;           /* The denominator.                       */
  int ki;              /* Count through dimensions.              */
  int idu;             /* Count through derivatives in u.        */
  int idv;             /* Count through derivatives in v.        */
  int *binom=SISL_NULL;     /* Array for binomial coefficients.       */
  int *binomu=SISL_NULL;    /* Pointer to binomial coefficients in u. */
  int *binomv=SISL_NULL;    /* Pointer to binomial coefficients in v. */
  double *sum1=SISL_NULL;   /* Leibnitz expansion in u                */
  double *sum2=SISL_NULL;   /* Leibnitz expansion in u and v.         */
  double sumdum1[4];   /* Fixed space for sum1.                  */
  double sumdum2[4];   /* Fixed space for sum2.                  */
  int idimp1;          /* idim + 1.                              */
  int iw;              /* Pointer to a weight.                   */
  int iwbase;          /* Starting value of iw on each row.      */
  int igder;           /* Pointer to already calculated derivs.  */
  int igbase;          /* Starting value of igder on each row.   */
  int i,iu,iv,j,k;     /* Counters.                              */
  int ider1p1;         /* ider1 + 1.                             */
  int ider2p1;         /* ider2 + 1.                             */
  int igrow;           /* (ider1+1) * idim.                      */  
  int iwrow;           /* (ider1+1) * idimp1.                    */  
  int iwfix;           /* Index of initial weight in sum.        */
  int bidum[10];       /* Array for storing binomial coeffs.     */
  int idermax;         /* maximum of ider1 and ider2.            */
  double temp;         /* Temporary multiple.                    */
  
  if (ider1<0 || ider2<0) goto err178;
  if (idim<1) goto err102;
  
  *jstat = 0;

  /* Find denominator. */ 
  
  w0 = eder[idim];
  if (DEQUAL(w0,DZERO)) w0 = (double)1.0;

  /* If we're only asked for position, we'll do it
     now and exit for the sake of speed. */

  if(ider1 == 0 && ider2 == 0)
  {
      for(ki=0; ki<idim; ki++)
      {
          gder[ki] = eder[ki] / w0;
      }

      goto out;
  }

  /* Set up some constants. */

  idimp1  = idim + 1;
  ider1p1 = ider1 + 1;
  ider2p1 = ider2 + 1;
  igrow   = ider1p1 * idim;
  iwrow   = igrow + ider1p1;  /* = iderp1 * idimp1  */


  /* Set up  binomial coefficients.
     Use new array only when ider1 > 3 or ider2 > 3. */

  idermax = max(ider1,ider2);

  if (idermax > 3)
  { 
      binom = newarray(((idermax+1)*(idermax+2)) >> 1, INT);
      if(binom == SISL_NULL) goto err179;
  }
  else
  { 
      binom = bidum;
  }

  for(j=0,k=0; j<=idermax; j++,k+=j)
  {
      /* Calculate the new row of binomial coefficients. */
  
      binom[k] = 1;
  
      for(i=k+1; i<k+j; i++)
      {
          binom[i] = binom[i-j-1] + binom[i-j];
      }

      binom[k+j] = 1;
  }
  

  /* Set up space for sum1 and sum2 if necessary.
     Use new arrays only when idim > 4. */

  if (idim > 4)
  { 
      sum1 = newarray(idim, DOUBLE);
      if(sum1 == SISL_NULL) goto err179;
      sum2 = newarray(idim, DOUBLE);
      if(sum2 == SISL_NULL) goto err179;
  }
  else
  { 
      sum1=sumdum1;
      sum2=sumdum2;
  }


  /* Loop through derivatives in u and v. */

  for(idv=0,binomv=binom,j=0,k=0; idv<=ider2; idv++,binomv+=idv)
  {

      for(idu=0,binomu=binom; idu<=ider1; idu++,k++,binomu+=idu)
      {

    
          if(idu == 0 && idv == 0)
          {
  	      /* Position is a special case. */
    
              for(ki=0; ki<idim; ki++,j++,k++)
              {
                  gder[j] = eder[k] / w0;
              }
    
          }
          else
          {
    
              /* Calculate each coefficient of the (idu,idv)'th
		 derivative of the rational surface (in gder).
        
  	       This requires calculating the Liebnitz sum from
  	       the subarray of gder (0,..,idu, 0,...,idv) and
  	       the subarray of eder (0,..,idu, 0,...,idv). */
  
  	      iwfix = k + idim;
  
  	      /* Calculate the Leibnitz sum. */
        
              for(ki=0; ki<idim; ki++)
	      {
  	          sum2[ki] = (double)0.0;
	      }
        
              for(iv=0,igbase=0,iwbase=iwfix;
  	      iv<=idv;
  	      iv++,igbase+=igrow,iwbase-=iwrow)
              {
        
                  for(ki=0; ki<idim; ki++)
	          {
  	              sum1[ki] = (double)0.0;
	          }
 
                  for(iu=0,igder=igbase,iw=iwbase;
  	          iu<=idu;
  	          iu++,iw-=idimp1)
                  {
  		      /* Add the next Leibnitz term unless we
  		         have reached the last one (the unknown). */
  
  	              if(iu<idu || iv<idv)
  		      {
  			  /* If iu=0 or iu=idu, the u binomial
  			     coefficient is 1 so don't multiply. */
  
  		          if(iu>0 && iu<idu)
  			  {
  			    temp = (double)binomu[iu] * eder[iw];

                            for(ki=0; ki<idim; ki++,igder++)
                            {
  			      sum1[ki] += temp * gder[igder];
  			    }
  			  }
  			  else
  			  {
                            for(ki=0; ki<idim; ki++,igder++)
                            {
  			      sum1[ki] += eder[iw] * gder[igder];
  			    }
  			  }
  
  		      }
                  }
  
  		  /* If iv=0 or iv=idv, the v binomial
  		     coefficient is 1 so don't multiply. */
  
  		  if(iv>0 && iv<idv)
  		  {
                    for(ki=0; ki<idim; ki++)
		    {
  		        sum2[ki] += (double)binomv[iv] * sum1[ki];
		    }
  		  }
  		  else
  		  {
                    for(ki=0; ki<idim; ki++)
		    {
  		        sum2[ki] += sum1[ki];
		    }
  		  }
  
              }
        
              for(ki=0; ki<idim; ki++,j++,k++)
	      {
  	          gder[j] = (eder[k] - sum2[ki]) / w0;
	      }
        
          }
  
      }
    
  }


  /* Free arrays. */

  if (idermax > 3)
  { 
      freearray(binom);
  }
  
  if (idim > 4)
  { 
      freearray(sum1);
      freearray(sum2);
  }
  


  /* Done. */

  
  goto out;


/* idim less than 1. */
 err102: *jstat = -102;
         s6err("s6ratder",*jstat,kpos);
         goto out;

/* Derivative negative */
 err178: *jstat = -178;
         s6err("s6ratder",*jstat,kpos);
         goto out;


/* Not enough memory */
 err179: *jstat = -179;
         s6err("s6ratder",*jstat,kpos);
         goto out;


out: 
return;
}



//===========================================================================
void s1424(SISLSurf *ps1,int ider1,int ider2,double epar[],
	   int *ileft1,int *ileft2,double eder[],int *jstat)
//===========================================================================
{
  int kstat=0;        /* Local status variable.                          */
  int kpos=0;         /* The position of error.                          */
  int kn1,kn2;        /* The number of B-splines accociated with the knot
			 vectors st1 and st2.                            */
  int kk1,kk2;        /* The polynomial order of the surface in the two
			 directions.                                     */
  int kdim;           /* The dimension of the space in which the surface
			 lies. Equivalently, the number of components
			 of each B-spline coefficient.                   */
  int kder1,kder2;    /* Local versions of ider1 and ider2. Since
			 derivatives of order higher than kk1-1 and kk2-1,
			 respectively, are all zero, we set
			 kder1=min(kk1-1,ider1) and kder2=(kk2-1,ider2). */
  int kleft2,kleft1;  /* Local versions of ileft1 and ileft2 which are
			 used in order to avoid the pointers.            */
  int ki,kj,kih,kjh;  /* Control variables in for loops and for stepping
			 through arrays.                                 */
  int kh,kl,kl1,kl2;  /* Control variables in for loops and for stepping
			 through arrays.                                 */
  double *st1,*st2;   /* The knot vectors of the surface. These have
			 length [kn1+kk1] and [kn2+kk2],
			 respectively.                                   */
  double *scoef;      /* The B-spline coefficients of the surface.
			 This is an array of dimension [kn2*kn1*kdim].   */
  double tt;          /* Dummy variable used for holding an array element
			 in a for loop.                                  */
  double *ebder=SISL_NULL; /* Pointer to an array of dimension
			 [max(kk1*(ider1+1),kk2*(ider2+1))] which will
			 contain the values and ider first derivatives of
			 the kk1 (kk2) nonzero B-splines at epar[0] (epar[1]).
			 These are stored in the following order:
			 First the value, 1. derivative etc. of the
			 first nonzero B-spline, then the same for the
			 second nonzero B-spline and so on.              */
  
  double *ew=SISL_NULL;    /* Pointer to an array of dimension [kk1*(ider1+1)*kdim]
			 which will be used to store the result of the first
			 matrix multiplication in (2) above. This array is
			 initialized to all zeros.                       */
  double *sder=SISL_NULL;  /* Pointer to array used for storage of points, if
			 non rational sder points to eder, if rational sder
			 has to be allocated to make room for the homogenous
			 coordinate */
  
  double sdum1[49];   /* Arraye used for ebder */
  double sdum2[147];  /* Array used for ew */
  int knumb1;         /* Necessary size of ebder */   
  int knumb2;         /* Necessary size of ew */   
  
  kleft1 = *ileft1;
  kleft2 = *ileft2;
  
  /* Copy surface to local parameters.  */
  
  kn1 = ps1 -> in1;
  kn2 = ps1 -> in2;                                         
  kk1 = ps1 -> ik1;
  kk2 = ps1 -> ik2;
  st1 = ps1 -> et1;
  st2 = ps1 -> et2;
  kdim = ps1 -> idim;
  if (ps1->ikind == 2 || ps1->ikind == 4)
    {
      scoef = ps1 -> rcoef;
      kdim +=1;
      if((sder = newarray(kdim*(ider1+1)*(ider2+1),DOUBLE)) == SISL_NULL)
         goto err101;
    }
  else
    {
      scoef = ps1 -> ecoef;
      sder = eder;  
    }
  
  /* Check the input. */
  
  if (kdim < 1) goto err102;
  if (kk1 < 1) goto err115;
  if (kn1 < kk1 || kn2 < kk2) goto err116;
  if (ider1 < 0 || ider2 < 0) goto err178;
  if (st1[kk1-1] == st1[kk1] || st1[kn1-1] == st1[kn1]) goto err117;
  if (st2[kk2-1] == st2[kk2] || st2[kn2-1] == st2[kn2]) goto err117;
  if (ps1->ikind == 1 || ps1->ikind == 3)
  {
     kder1 = min(kk1-1,ider1);
     kder2 = min(kk2-1,ider2);
  }
  else
  {
     kder1 = ider1;
     kder2 = ider2;
  }
  
  /* Allocate space for B-spline values and derivatives and one work array. */
  
  knumb1 = max(kk1*(kder1+1),kk2*(kder2+1));
  
  /* ONly allocate ebder if sdum1 too small */
  
  if (knumb1>49)
    {
      if((ebder = newarray(knumb1,double)) == SISL_NULL) goto err101;
    }
  else
    {
      ebder = &sdum1[0];
      for (ki=0;ki<knumb1;ki++)
	ebder[ki] = DZERO;
    }
  
  if (ebder == SISL_NULL) goto err101;
  
  /* Only allocate ew if sdum2 too small */
  
  knumb2 = (kk1*(kder2+1)*kdim);
  if (knumb2>147)
    {
      if((ew = new0array(knumb2,double)) == SISL_NULL) goto err101;
    }
  else
    { 
      ew = &sdum2[0];
      for (ki=0;ki<knumb2;ki++)
	sdum2[ki] = DZERO;
    }
  
  if (ew == SISL_NULL) goto err101;
  
  /* Set all the elements of sder to 0. */
  
  for (ki=0; ki<(ider2+1)*(ider1+1)*kdim; ki++) sder[ki] = DZERO;
  
  /* Compute the values and derivatives of the nonzero B-splines in the
     second parameter direction.                                        */
  
  s1220(st2,kk2,kn2,&kleft2,epar[1],kder2,ebder,&kstat);
  
  if (kstat < 0) goto error;
  
  /* Update ileft1 (ileft2 was updated above, in s1220). */
  
  s1219(st1,kk1,kn1,&kleft1,epar[0],&kstat);
  
  if (kstat < 0) goto error;
  
  /* Compute the first matrix product in (2) above. */
  
  /* ki steps through the appropriate kk2 rows of B-spline coefficients
     while kih steps through the B-spline value and derivatives for the
     B-spline given by ki.                                              */
  
  kih = 0;
  for (ki=kleft2-kk2+1; ki<=kleft2; ki++)
    {
      
      /* kj counts through the kder2+1 derivatives to be computed.
	 kjh steps through ew once for each ki to accumulate the contribution
	 from the different B-splines.
	 kl1 points to the first component of the first B-spline coefficient
	 in row no. ki of the B-spline coefficient matrix that multiplies
	 a nonzero B-spline in the first parameter direction.
	 */
      
      kjh = 0; kl1 = ki*kdim*kn1 + kdim*(kleft1-kk1+1);
      for (kj=0; kj<=kder2; kj++)
	{
	  
	  /* The value of the B-spline derivative is stored in tt while
	     kl2 steps through the kdim components of all the B-spline
	     coefficients that multiplies nonzero B-splines along st1. 
	     */
	  
	  tt = ebder[kih++]; kl2 = kl1;
	  for (kl=0; kl<kdim*kk1; kl++,kjh++,kl2++)
	    {
	      ew[kjh] += scoef[kl2]*tt;
	    }
	}
    }
  
  /* Compute the values and derivatives of the nonzero B-splines in the
     first parameter direction.                                        */
  
  s1220(st1,kk1,kn1,&kleft1,epar[0],kder1,ebder,&kstat);         
  
  if (kstat < 0) goto error;
  
  /* Compute the remaining matrix product. */
  
  /* kh steps through the kder2+1 derivatives in the first parameter direction
     (the rows of ew if we image it as a kk1x(ider1+1) matrix with each element
     a kdim dimensional vector) while kl1 steps through the elements of ew
     (again considering each element to have kdim components).                   
     */
  
  kl1 = 0;
  for (kh=0; kh<=kder2; kh++)
    {
      
      /* ki steps through the kk1 columns of ew (corresponding to the columns
	 of scoef that multiply nonzero B-splines along st1), while kih
	 steps through the B-spline values and derivatives for the nonzero
	 B-splines along st1 (stored in ebder).
	 */
      
      kih = 0;
      for (ki=0; ki<kk1; ki++)
	{
	  
	  /* kj counts through the kder1+1 derivatives in the first
	     parameter direction (corresponding to the columns of sder).
	     kjh points to the row of sder corresponding to derivatives of
	     order kh in the second parameter direction (if sder is
	     considered a matrix with elements consisting of vectors with
	     kdim components.
	     */
	  
	  kjh = kh*(kder1+1)*kdim;
	  for (kj=0; kj<=kder1; kj++)
	    {
	      /* Pick out the current element of ebder.
		 kl2 steps through the kdim components of the (kh,ki)
		 element of ew.
		 */
	      
	      tt = ebder[kih++];
	      kl2 = kl1;
	      for (kl=0; kl<kdim; kl++,kjh++,kl2++)
		{
		  sder[kjh] += ew[kl2]*tt;
		}
	    }
	  kl1 += kdim;
	}
    }
  
  if (kder1 < ider1 || kder2 < ider2)
    
    /* The derivatives are not positioned in the right way in sder, 
       shift values into the right position 
       */
    
    for (kj=ider2 ; 0<=kj ; kj--)
      {
	for (ki=ider1 ; 0<=ki ; ki--)
	  {
	    if ( ki <= kder1 && kj <= kder2)
	      memcopy(sder+kdim*(ki+kj*(ider1+1)),sder+kdim*(ki+kj*(kder1+1)),
		      kdim,DOUBLE);
	    else
	      for (kl=0;kl<kdim;kl++)     
		*(sder+kdim*(ki+kj*(ider1+1))+kl) = DZERO;
	  }
      }

  /* Free memory. */
  
  /* If rational surface calculate the derivatives based on derivatives in
     homogenous coordinates */
  
  if (ps1->ikind == 2 || ps1->ikind == 4)
    {
      s6sratder(sder,ps1->idim,ider1,ider2,eder,&kstat);
      if (kstat<0) goto error;
      if(sder != SISL_NULL) freearray(sder);
    }
  
  /* Only free ew and ebder if the were allocated by newarray */
  
  if (knumb1 > 49 && ebder != SISL_NULL) freearray(ebder);
  if (knumb2 > 147 && ew != SISL_NULL) freearray(ew);
  
  /* Successful computations.  */
  
  *jstat = 0;
  goto out;
  
  /* Not enough memory. */

  err101: 
    *jstat = -101;
    s6err("s1424",*jstat,kpos);
    goto out;
  
  /* kdim less than 1. */

  err102: 
    *jstat = -102;
    s6err("s1424",*jstat,kpos);  
    goto out;
  
  /* Polynomial order less than 1. */

  err115: 
    *jstat = -115;
    s6err("s1424",*jstat,kpos);
    goto out;
  
  /* Fewer B-splines than the order. */

  err116: 
    *jstat = -116;
    s6err("s1424",*jstat,kpos); 
    goto out;
  
  /* Error in knot vector.
     (The first or last interval of one of the knot vectors is empty.) */

  err117: 
    *jstat = -117;
    s6err("s1424",*jstat,kpos);
    goto out;
  
  /* Illegal derivative requested. */

  err178: 
    *jstat = -178;
    s6err("s1424",*jstat,kpos);
    goto out;
  
  /* Error in lower level routine.  */
  
  error:  
    *jstat = kstat;
    s6err("s1424",*jstat,kpos); 
    goto out;
  
  out: 
    *ileft1 = kleft1;
    *ileft2 = kleft2;
    return;
}



//===========================================================================
void s6hermite_bezier(SISLSurf* s,double a[],double b[],int idim, double c[],int* jstat)
//===========================================================================
{
  int i,kstat,left1=0,left2=0;
  double dblocal[9];
  double *derive=SISL_NULL;


  if (DEQUAL(a[0],b[0]) && DEQUAL(a[1],b[1])) goto error;
  if (s->idim != idim) goto error;

  if ( idim > 3)
  {
    derive = newarray(3*idim,double);
    if (derive == SISL_NULL) goto err101;
  }
  else
    derive = dblocal;

  /* evaluate s and its derivative at a */

  s1424(s,1,1,a,&left1,&left2,derive,&kstat);
  if (kstat < 0) goto error;
  for (i=0; i < idim; i++)
  {
    c[i] = derive[i];
    c[idim+i] = c[i] + (derive[idim+i]*(b[0]-a[0])
			+ derive[2*idim+i]*(b[1]-a[1]))/3.0;
  }

  /* evaluate s and its derivative at b */

  s1424(s,1,1,b,&left1,&left2,derive,&kstat);
  if (kstat < 0) goto error;
  for (i=0; i < idim; i++)
  {
    c[3*idim+i] = derive[i];
    c[2*idim+i] = c[3*idim+i] - (derive[idim+i]*(b[0]-a[0])
				 + derive[2*idim+i]*(b[1]-a[1]))/3.0;
  }

  *jstat = 0;
  goto out;

  /* Error in space allocation.  */

  err101 :
    *jstat = -101;
    goto out;


  /* Error in lower level routine.  */

  error :
    *jstat = kstat;
    goto out;


  out :

    if (derive != SISL_NULL && derive != dblocal)
      freearray(derive);

  return;

}

//===========================================================================
void s6identify(SISLSurf* s,double a[], double b[], double level_val,
		double eps1,double eps2,int* jstat)
//===========================================================================
{
  double c[4],cref[8];
  int i,kstat;

  if ( s == SISL_NULL ||
      (a[0] < s->et1[0] || a[0] > s->et1[s->in1]) ||
      (a[1] < s->et2[0] || a[1] > s->et2[s->in2]) ||
      (b[0] < s->et1[0] || b[0] > s->et1[s->in1]) ||
      (b[1] < s->et2[0] || b[1] > s->et2[s->in2])   )
    goto err109;

  if (DEQUAL(a[0],b[0]) && DEQUAL(a[1],b[1]))
    {
      kstat = 1;
      goto out;
    }
  if ( sqrt((a[0]-b[0])*(a[0]-b[0]) + (a[1]-b[1])*(a[1]-b[1])) > eps1 )
    kstat = 0;
  else
    {
      s6hermite_bezier(s,a,b,1,c,&kstat);
      if (kstat < 0) goto error;

      s6deCasteljau(c,0.0,1.0,0.5,4,cref,&kstat);
      if (kstat < 0) goto error;

      kstat = 1;
      for (i=0; i<8; i++)
	if (fabs(cref[i]-level_val) > eps2)
	  kstat = 0;
    }
  
  goto out;

 err109: kstat = -109;
  s6err("s6identify",kstat,0);
  goto out;


 error: 
  s6err("s6identify",kstat,0);
  goto out;

 out: 
    *jstat = kstat;
    return ;
} 


//===========================================================================
SISLIntdat *newIntdat (void)
//===========================================================================
{
  SISLIntdat *pnew = SISL_NULL;	/* Local pointer to the instance.       */

  /* Allocate space for instance.                                      */

  if ((pnew = newarray (1, SISLIntdat)) != SISL_NULL)
    {
      /* Initiate the variables of the instance.                   */
      pnew->ipmax = 20;
      pnew->ilmax = 10;
      pnew->ipoint = 0;
      pnew->ilist = 0;

      /* Allocate space for array of pointers to Intlist.          */

      if ((pnew->vlist = new0array (pnew->ilmax, SISLIntlist *)) != SISL_NULL)
	{
	  /* Allocate space for array of pointers to SISLIntpt     */
	  if ((pnew->vpoint = new0array (pnew->ipmax, SISLIntpt *))
	      != SISL_NULL) ;

	  /* Task done.                                        */

	  else
	    {
	      /* Error in space allocation of pnew->vpoint.*/
	      freearray (pnew->vlist);
	      freearray (pnew);
	    }
	}
      else
	/* Error in space allocation of pnew->vlist.	     */
	freearray (pnew);
    }
  return pnew;
}


//===========================================================================
void sh_1d_div_sh9idnpt(SISLSurf* surf, SISLPoint* point, SISLIntdat **pintdat,
			SISLIntpt **pintpt, int itest, double aepsge, int *jstat)
//===========================================================================
{
  register int ki;              /* Counters.    */
  double eps_ball_par;
  int kstat;
  
  /* We have to be sure that we have an intdat structure. */
  
  if ((*pintdat) == SISL_NULL)
    {
      if (((*pintdat) = newIntdat()) == SISL_NULL) goto err101;
    }
  
  
  /* Then we have to be sure that we do not have the intersection point
     before or an equal point. */
  
  for (ki=0; ki<(*pintdat)->ipoint; ki++)
    if ((*pintdat)->vpoint[ki] == (*pintpt))
      {
	*jstat = 1;
	goto out;
      }
    else if (itest)
      {
	eps_ball_par = surf->et1[surf->in1]- surf->et1[surf->ik1];
	eps_ball_par = max(eps_ball_par,
			   surf->et2[surf->in2]- surf->et2[surf->ik2])+1;
	eps_ball_par *= 1e-6;

	s6identify(surf,(*pintpt)->epar,
		   (*pintdat)->vpoint[ki]->epar,
		   point->ecoef[0],eps_ball_par,aepsge,&kstat);
	if (kstat < 0 ) goto error;
	if (kstat == 1 ) 
	  {
	    freeIntpt(*pintpt);
	    (*pintpt) = (*pintdat)->vpoint[ki];
	    *jstat = 2;
	    goto out;
	  }
      }
  
  
  /* Then we have to be sure that the array vpoint is great enough. */
  
  if (ki == (*pintdat)->ipmax)
    {
      (*pintdat)->ipmax += 20;
      
      if (((*pintdat)->vpoint = increasearray((*pintdat)->vpoint,
					      (*pintdat)->ipmax,SISLIntpt *)) == SISL_NULL) 
	goto err101;
    }
  
  
  /* Now we can insert the new point. */
  
  (*pintdat)->vpoint[ki] = (*pintpt);
  (*pintdat)->ipoint++;
  *jstat = 0;
  goto out;
  

/* Error in space allocation.  */

err101: *jstat = -101;
        s6err("sh_1d_div_sh9idnpt",*jstat,0);
        goto out;
error: *jstat = kstat;
        s6err("sh_1d_div_sh9idnpt",*jstat,0);
        goto out;

 out: ;
}



//===========================================================================
void  sh_1d_div (SISLObject *po1, SISLObject *po2, double aepsge,
		 SISLIntdat **pintdat,  SISLEdge * vedge[], int *jstat)
//===========================================================================
{

   int kant;                    /* Number of parameter directions          */
   int cv_dir_1, cv_dir_2;      /* Locals for curve_dir                    */
   int ind1, ind2;              /* Locals indexes                          */
   int kpos = 0;		/* Position of error.                      */
   int kstat = 0;		/* Local error status.                     */
   int knum;                    /* Number of intersection pts on edge      */              
   int knum2;                   /* Number of intersection pts in corners   */              
   int which_end_1=-1;          /* Branch paraeter fro zero edge.          */
   int which_end_2=-1;          /* Branch paraeter fro zero edge.          */
   int kn, kj, ki;              /* Loop control                            */
   int edge_1=0, edge_2=0;      /* No of pts in pt_arr_1[2]                */
   int alloc_1=0, alloc_2=0;    /* Size of pt_arr_1[2]                     */
   SISLIntpt *pcurr = SISL_NULL;	/* Array of poiners to int points.         */
   SISLIntpt **uintpt = SISL_NULL;	/* Array of poiners to int points.         */
   SISLIntpt **up = SISL_NULL;	/* Array of poiners to edge int points.    */
   SISLIntpt **pt_arr_1 = SISL_NULL;	/* Array of poiners to ZERO edge.          */
   SISLIntpt **pt_arr_2 = SISL_NULL;	/* Array of poiners to ZERO edge.          */
   SISLIntpt **up2 = SISL_NULL;	/* Array of poiners to corner int points.  */
   SISLIntdat *qintdat = SISL_NULL;	/* Data structure of sub inters problem    */
   SISLObject *qo1 = SISL_NULL;      /* Pointer to surface in
				   object/point intersection. */
   double *nullp = SISL_NULL;
   /* ____________________________________________________________________ */

   *jstat = 0;
   
   /* Check input */
   if (po1->iobj != SISLSURFACE) goto err150;
   if (po1->s1->idim != 1) goto err150;
   
   /* Bezier case ? */
   if (po1->s1->ik1 != po1->s1->in1 ||
       po1->s1->ik2 != po1->s1->in2) goto out;

   if (po1->s1->ik1 < 3 ||
       po1->s1->ik2 < 3 ) goto out;
   
   sh6edgpoint (vedge, &up, &knum, &kstat);
   if (kstat < 0)
      goto error;
   if (knum < 2) goto out;
   
   /* Find corner points */
   /* Allocate an array for intersection points. */
   if ((up2= newarray (knum, SISLIntpt *)) == SISL_NULL)
      goto err101;
   
   for (knum2=ki=0;ki<knum;ki++)
   {
      sh6isinside (po1, po2, up[ki], &kstat);
      if (kstat < 0 ) goto error;
      
      if (kstat == 3)
      {
	 up2[knum2] = up[ki];
	 knum2++;
      }
   }
   
   if (knum2 < 2) goto out;
   
   /* Find connections */
   for (ki=0;ki<knum2-1;ki++)
      for (kj=1;kj<knum2;kj++)
      {
	 sh6comedg (po1, po2, up2[ki], up2[kj], &kstat);
	 if (kstat < 0) goto error;
	 
	 if (kstat == 1)
	 {
	    /* One edge is zero, find which */
	    if (DEQUAL(up2[ki]->epar[0], up2[kj]->epar[0]))
	    {
	       
	       /* Store the two corner points (sorted). */
	       if (alloc_1 == 0)
	       {
		  alloc_1 = 10;
		  if((pt_arr_1 = newarray(alloc_1,SISLIntpt *))
		     == SISL_NULL) goto err101;
	       }
	       edge_1 = 2;
	       if (up2[ki]->epar[1] < up2[kj]->epar[1])
	       {		   
		  pt_arr_1[0] = up2[ki];
		  pt_arr_1[1] = up2[kj];
	       }
	       else
	       {		   
		  pt_arr_1[1] = up2[ki];
		  pt_arr_1[0] = up2[kj];
	       }
	       
	       if (DEQUAL(up2[ki]->epar[0],po1->s1->et1[0]))
		  which_end_1 = 0;
	       else
		  which_end_1 = 1;
	    }
	    else
	    {
	       
	       /* Store the two corner points (sorted). */
	       if (alloc_2 == 0)
	       {
		  alloc_2 = 10;
		  if((pt_arr_2 = newarray(alloc_2,SISLIntpt *))
		     == SISL_NULL) goto err101;
	       }
	       edge_2 = 2;
	       if (up2[ki]->epar[0] < up2[kj]->epar[0])
	       {		   
		  pt_arr_2[0] = up2[ki];
		  pt_arr_2[1] = up2[kj];
	       }
	       else
	       {		   
		  pt_arr_2[1] = up2[ki];
		  pt_arr_2[0] = up2[kj];
	       }
	       
	       if (DEQUAL(up2[ki]->epar[1],po1->s1->et2[0]))
		  which_end_2 = 0;
	       else
		  which_end_2 = 1;
	    }
	    
	 }
      }
   
   if (which_end_1 >=0 || which_end_2 >=0)
   {
      
      /*
      * Create new object and create surface to object.
      * ------------------------------------------------
      */
      
      if (!(qo1 = newObject (SISLSURFACE)))
	 goto err101;
      qo1->s1 = SISL_NULL;
      qo1->o1 = qo1;
      
      /* Filter coefficients less than aepsge. */
      for (ki=0; ki< po1->s1->in1*po1->s1->in2;ki++)
	 if ( fabs(po1->s1->ecoef[ki]-po2->p1->ecoef[0]) < aepsge)
	    po1->s1->ecoef[ki] = po2->p1->ecoef[0];
      
      sh_div_surf(po1->s1,which_end_1, which_end_2, aepsge, &qo1->s1, &kstat);
      if (kstat < 0) goto error;
      
      sh1761 (qo1, po2, aepsge, &qintdat, &kstat);
      if (kstat < 0)
	 goto error;
      
      /* UJK, JUNE 93: start____________ */
      if (qintdat)
      {
	 
	 /* Kill all help.pts. */
	 for (ki = 0; ki < qintdat->ipoint; ki++)
	 {
	    pcurr = qintdat->vpoint[ki];
	    if(sh6ishelp(pcurr))
	    {
	       sh6idkpt (&qintdat, &pcurr, 0, &kstat);
	       if (kstat < 0) goto error;
	       ki--;
	    }
	 }
      }
      /* UJK, JUNE 93: end____________ */
      
      if (qintdat)
      {
	 /* Intersection found, transfere it to pintdat. */
	 
	 /* Number of parameter direction. */
	 kant = qintdat->vpoint[0]->ipar;
	 
	 /* Allocate an array for intersection points. */
	 if ((uintpt = newarray (qintdat->ipoint, SISLIntpt *)) == SISL_NULL)
	    goto err101;
	 
	 /* Copy all intersection points. */
	 for (ki = 0; ki < qintdat->ipoint; ki++)
	 {
	    
	    uintpt[ki] = hp_newIntpt (kant,  
				      qintdat->vpoint[ki]->epar, 
				      qintdat->vpoint[ki]->adist,
				      qintdat->vpoint[ki]->iinter,
				      qintdat->vpoint[ki]->left_obj_1[0],
				      qintdat->vpoint[ki]->right_obj_1[0],
				      qintdat->vpoint[ki]->left_obj_2[0],
				      qintdat->vpoint[ki]->right_obj_2[0],
				      0, 0,
				      nullp, nullp);
	    
	    if (uintpt[ki] == SISL_NULL)
	       goto err101;
	 }
	 
	 /* Insert all new intersection points in rintdat. */

	 for (ki = 0; ki < qintdat->ipoint; ki++)
	 {
	    sh_1d_div_sh9idnpt (po1->o1->s1,po2->p1,pintdat, &uintpt[ki], 1,aepsge,
				&kstat);
	    if (kstat < 0)
	       goto error;
	 }

	 
	 /* Insert points on edges divided out/(splitting strategy. */
	 for (ki = 0; ki < qintdat->ipoint; ki++)
	 {
	    if (which_end_1 >=0 &&
		DEQUAL(uintpt[ki]->epar[0], pt_arr_1[0]->epar[0]) &&
		DEQUAL(uintpt[ki]->epar[0], pt_arr_1[1]->epar[0]))
	    {
	       for (kj=0; kj < edge_1 - 1; kj++)
		  if (uintpt[ki]->epar[1] > pt_arr_1[kj]->epar[1] &&
		      uintpt[ki]->epar[1] < pt_arr_1[kj+1]->epar[1])
		  {
		     sh6insertpt(pt_arr_1[kj],pt_arr_1[kj+1],uintpt[ki],&kstat);
	             if (kstat < 0) goto error;
		     if (edge_1 >= alloc_1)
		     {
			alloc_1 += 10;
			if ((pt_arr_1 = 
			     increasearray(pt_arr_1,alloc_1,SISLIntpt *))
			    == SISL_NULL) goto err101;
		     }
		     
		     for (kn = edge_1; kn > kj+1; kn--)
			pt_arr_1[kn] = pt_arr_1[kn-1];
		     pt_arr_1[kj+1] = uintpt[ki];
		     edge_1++;
		     
		     break;
		  }
	    }
	    else if (which_end_2 >=0 &&
		DEQUAL(uintpt[ki]->epar[1], pt_arr_2[0]->epar[1]) &&
		DEQUAL(uintpt[ki]->epar[1], pt_arr_2[1]->epar[1]))
	    {
	       for (kj=0; kj < edge_2 - 1; kj++)
		  if (uintpt[ki]->epar[0] > pt_arr_2[kj]->epar[0] &&
		      uintpt[ki]->epar[0] < pt_arr_2[kj+1]->epar[0])
		  {
		     sh6insertpt(pt_arr_2[kj],pt_arr_2[kj+1],uintpt[ki],&kstat);
	             if (kstat < 0) goto error;
		     if (edge_2 >= alloc_2)
		     {
			alloc_2 += 10;
			if ((pt_arr_2 = 
			     increasearray(pt_arr_2,alloc_2,SISLIntpt *))
			    == SISL_NULL) goto err101;
		     }
		     
		     for (kn = edge_2; kn > kj+1; kn--)
			pt_arr_2[kn] = pt_arr_2[kn-1];
		     pt_arr_2[kj+1] = uintpt[ki];
		     edge_2++;
		     
		     break;
		  }
	    }
	    
	 }	      
	    
	    
	 /* Transform the connections. */
	 for (ki = 0; ki < qintdat->ipoint; ki++)
	 {
	    for (kj = ki + 1; kj < qintdat->ipoint; kj++)
	    {
	       sh6getlist (qintdat->vpoint[ki], qintdat->vpoint[kj],
			   &ind1, &ind2, &kstat);
	       if (kstat < 0)
		  goto error;
	       if (kstat == 0 && uintpt[kj] != uintpt[ki])
	       {
                  cv_dir_1 = qintdat->vpoint[ki]->curve_dir[ind1];
                  cv_dir_2 = qintdat->vpoint[kj]->curve_dir[ind2];

		  sh6idcon (pintdat, &uintpt[ki], &uintpt[kj], &kstat);
		  if (kstat < 0)
		    goto error;
	       
		  sh6getlist (uintpt[ki], uintpt[kj],
			   &ind1, &ind2, &kstat);
		  if (kstat != 0) goto error;
		  uintpt[ki]->curve_dir[ind1] |= cv_dir_1;
		  uintpt[kj]->curve_dir[ind2] |= cv_dir_2;
		  
	       }
	    }
	    
	    if (sh6ismain (qintdat->vpoint[ki]) &&
		sh6nmbmain (qintdat->vpoint[ki], &kstat))
	    {
	       sh6tomain (uintpt[ki], &kstat);
	       if (kstat < 0)
		  goto error;
	    }
	 }
	 
	 /* Remains splitting of zero curves inside edges ! */	 
	 
      }

      *jstat = 1;
    }
   
   
   
   goto out;
   /* ______________ ERROR EXITS ______________________________ */
/* Lower level problem. */
error:
   *jstat = kstat;
   s6err("sh_1d_div",*jstat,kpos);
   goto out;
   
/* Space problem. */
err101:
   *jstat = -101;
   s6err("sh_1d_div",*jstat,kpos);
   goto out;
   
/* Input wrong. */
err150:
   *jstat = -150;
   s6err("sh_1d_div",*jstat,kpos);
   goto out;


out:
   if (uintpt) freearray(uintpt);
   if (up) freearray(up);
   if (up2) freearray(up2);
   if (pt_arr_1) freearray(pt_arr_1);
   if (pt_arr_2) freearray(pt_arr_2);
   if (qo1)
      freeObject (qo1);
   if (qintdat)
      freeIntdat (qintdat);
}


//===========================================================================
void s1797(SISLSurf *ps1,SISLCurve *pc1,double aepsge,double aang,int *jstat)
//===========================================================================
{
  int kpos = 0;     /* Position of the error.                             */
  int kstat;        /* Local status variable.                             */
  int ki;           /* Counter.                                           */
  int kn;           /* Number of vertices of curve.                       */
  int kn1;          /* Number of vertices of surface in 1. par. direction.*/
  int kn2;          /* Number of vertices of surface in 2. par. direction.*/
  int kdim;	   /* Dimension of the space in which the objects lie.   */
  int kdim4;	   /* Help variable to contain  4*kdim.			 */
  int kver,khor;    /* The index to the vertice in the upper left corner 
		       to the patch to treat.				 */
  int k1,k2,k3,k4;  /* Control variables in loop. 			 */
  double *t=SISL_NULL;     /* Allocating t[5][kdim]. Five tangents around the
			 patch, the first and the last is the same.         */
  double *tn;         /* Allocating tn[4][kdim]. Four normals in the corner
		         of the patch.					 */
  double *scen1;     /* The orginal basis vector to the projection plan. */
  double *scen2;     /* The computed basis vector to the projection plan.*/
  double tlen;       /* The length of a vector.				 */
  double tang;	     /* An angle between two vectors.			 */
  double tang1=DZERO;/* An angle between two vectors.			 */
  double tang2=DZERO;/* An angle between two vectors.			 */
  double t1,t2;/* Help variables.					 */
  double slen[5];   /* Distances between coefficients.                    */
  double scorn[4];  /* Angle between derivatives in corner of patch.      */
  
  
  
  /* Initialate dimentions. */
  
  kdim = ps1 -> idim;
  kdim4 = 4*kdim;
  
  
  /* Allocate local used matrices, t[5][kdim] and tn[4][kdim]. */
  
  if ((t = newarray(10*kdim,double)) == SISL_NULL) goto err101;
  
  tn   = t + 5*kdim;  
  
  scen1 = ps1->pdir->ecoef;
  scen2 = tn + 4*kdim;
  tlen = s6scpr(scen1,pc1->pdir->ecoef,kdim);
  for (k1=0; k1 < kdim; k1++)
    scen2[k1] = pc1->pdir->ecoef[k1] - tlen*scen1[k1];
  tlen = s6length(scen2,kdim,&kstat);
  for (k1=0; k1 < kdim; k1++)
    scen2[k1] /= tlen;
  
  kn1  = ps1 -> in1;
  kn2  = ps1 -> in2;
  
  /* Here we are treating each patch in the control polygon separately.*/
  
  for (kver=0; kver < (kn2-1); kver++)
     for (khor=0; khor < (kn1-1); khor++)
     {
	slen[0] = slen[1] = slen[2] = slen[3] = DZERO;
	scorn[0] = scorn[1] = scorn[2] = scorn[3] = DZERO;
	
	/* Here we make the tangents in each corner of the patch,
           and in direction with the clock. The first and the last
	   vector contains both the first tangent. */
	
	k2 = (kver*kn1+khor)*kdim;
	
	for (k1=0; k1 < kdim; k1++,k2++)
	{
	   t[kdim+k1]   = ps1->pdir->esmooth[k2+kdim] - ps1->pdir->esmooth[k2];
	   t[2*kdim+k1] = ps1->pdir->esmooth[k2+(kn1+1)*kdim]-ps1->pdir->esmooth[k2+kdim];
	   t[3*kdim+k1] = ps1->pdir->esmooth[k2+kn1*kdim]-ps1->pdir->esmooth[k2+(kn1+1)*kdim];
	   t[kdim4+k1] = t[k1] = ps1->pdir->esmooth[k2]-ps1->pdir->esmooth[k2+kn1*kdim];
	   
	   slen[0] += t[k1]*t[k1];
	   slen[1] += t[k1+kdim]*t[k1+kdim];
	   slen[2] += t[k1+2*kdim]*t[k1+2*kdim];
	   slen[3] += t[k1+3*kdim]*t[k1+3*kdim];
	}
	slen[4] = slen[0] = sqrt(slen[0]);
	slen[1] = sqrt(slen[1]);
	slen[2] = sqrt(slen[2]);
	slen[3] = sqrt(slen[3]);
	
	scorn[0] = s6ang(t,t+kdim,kdim);
	scorn[1] = s6ang(t+kdim,t+2*kdim,kdim);
	scorn[2] = s6ang(t+2*kdim,t+3*kdim,kdim);
	scorn[3] = s6ang(t+3*kdim,t,kdim);
	
	
	/* Here we makes the normales in each corner of the patch.
	   We are using a cross product between two tangents.
	   The normals is also normalized by deviding with its
	   own length. */
	
	
	for (k1=0, ki=0; k1<kdim4; k1+=kdim, ki++)
	{
	   
	   for (tlen=DZERO,k2=0,k3=1,k4=2; k2 < kdim; k2++,k3++,k4++)
	   {
	      
	      if(k3 == kdim) k3 = 0;
	      if(k4 == kdim) k4 = 0;
	      tn[k1+k2] = t[k1+k3]*t[k1+kdim+k4]-t[k1+k4]*t[k1+kdim+k3];
	      
	      tlen += tn[k1+k2]*tn[k1+k2];
	   }
	   
	   tlen = sqrt(tlen);
	   if (slen[ki]>aepsge && slen[ki+1]>aepsge &&
	       scorn[ki] > ANGULAR_TOLERANCE)
	      for (k2=0; k2 < kdim; k2++) tn[k1+k2] /= tlen;
	   else 
	      for (k2=0; k2 < kdim; k2++) tn[k1+k2] = scen1[k2];
	   
	}
	
	for (k1=0; k1<kdim4; k1+=kdim)
	{
	   t2 = scen2[0]*tn[k1];
	   for (k2=1,k3=k1+1;k2<kdim;k2++,k3++)
	      t2 += scen2[k2]*tn[k3];
	   
	   if (aang > PIHALF)
	   {
	      if (t2 <= DZERO) continue;
	   }
	   else if (t2 >= DZERO) continue;
	   
	   t1 = scen1[0]*tn[k1];
	   for (k2=1,k3=k1+1;k2<kdim;k2++,k3++)
	      t1 += scen1[k2]*tn[k3];
	   
	   tang = t1/sqrt(t1*t1 + t2*t2);
	   
	   if (tang >= DZERO) tang = min((double)1,tang);
	   else               tang = max((double)-1,tang);
	   
	   tang = acos(tang);
	   
	   tang1 = max(tang1,tang);
	}
     }			
  
  
  /* The first basis vector. */
  
  scen1 = pc1 ->pdir-> ecoef;
  
  /* We must orthonormalize the second basis vector. */
  
  scen2 = t + kdim;
  tlen = s6scpr(scen1,ps1->pdir->ecoef,kdim);
  for (k1=0; k1 < kdim; k1++)
     scen2[k1] = ps1->pdir->ecoef[k1] - tlen*scen1[k1];
  tlen = s6length(scen2,kdim,&kstat);
  for (k1=0; k1 < kdim; k1++)
     scen2[k1] /= tlen;
  
  /* Here we are treating each part in the control polygon separately.*/
  
  for (kn=pc1->in,k2=0,khor=0; khor < kn-1; khor++)
  {
     
     /* Here we make an aproximative tangents to the curve
	using the control polygon. The tangents is also normalized
	by deviding with its own length. */
     
     for (tlen=DZERO,k1=0; k1 < kdim; k1++,k2++)
     {
	t[k1] = pc1->pdir->esmooth[k2+kdim] - pc1->pdir->esmooth[k2];
	tlen += t[k1]*t[k1];
     }
     
     tlen = sqrt(tlen);
     
     if (tlen > aepsge)
	for (k1=0; k1 < kdim; k1++) t[k1] /= tlen;
     else
	for (k1=0; k1 < kdim; k1++) t[k1] = scen1[k1];
     
     t2 = scen2[0]*t[0];
     for (k1=1; k1<kdim; k1++)
	t2 += scen2[k1]*t[k1];
     
     if (aang > PIHALF)
     {
	if (t2 <= DZERO) continue;
     }
     else if (t2 >= DZERO) continue;
     
     t1 = scen1[0]*t[0];
     for (k1=1; k1<kdim; k1++)
	t1 += scen1[k1]*t[k1];
     
     tang = t1/sqrt(t1*t1 + t2*t2);
     
     if (tang >= DZERO) tang = min((double)1,tang);
     else               tang = max((double)-1,tang);
     
     tang = acos(tang);
     
     tang2 = max(tang2,tang);
  }
  
  /* Performing a simple case check. */
  
  if (aang > PIHALF)	aang = PI - aang;
  
  if (tang1 + tang2 <= PIHALF - aang)
    *jstat = 1;       /* A simpel case.*/
  else
    *jstat = 0;
  
  goto out;
  
  
  /* Error in space allacation.  */
  
 err101: *jstat = -101;
  s6err("s1795",*jstat,kpos);
  goto out;
    
  /* Free local used memory. */
  
 out:    if (t != SISL_NULL) freearray(t);
}


//===========================================================================
void s1795(SISLSurf *ps1,SISLSurf *ps2,double aepsge,double aang,int *jstat)
//===========================================================================
{
  int kpos = 0;     /* Position of the error.                             */
  int kstat;        /* Local status variable.                             */
  int ki;           /* Counter.                                           */
  int kn1;          /* Number of vertices of surface in 1. par. direction.*/
  int kn2;          /* Number of vertices of surface in 2. par. direction.*/
  int kdim;	   /* Dimension of the space in which the objects lie.   */
  int kdim4;	   /* Help variable to contain  4*kdim.			 */
  int kver,khor;    /* The index to the vertice in the upper left corner 
		       to the patch to treat.				 */
  int k1,k2,k3,k4;  /* Control variables in loop. 			 */
  double *t=SISL_NULL;     /* Allocating t[5][kdim]. Five tangents around the
			 patch, the first and the last is the same.         */
  double *tn;         /* Allocating tn[4][kdim]. Four normals in the corner
		         of the patch.					 */
  double *scen1;     /* The orginal basis vector to the projection plan. */
  double *scen2;     /* The computed basis vector to the projection plan.*/
  double tlen;       /* The length of a vector.				 */
  double tang;	     /* An angle between two vectors.			 */
  double tang1=DZERO;/* An angle between two vectors.			 */
  double tang2=DZERO;/* An angle between two vectors.			 */
  double t1,t2;      /* Help variables.					 */
  double slen[5];   /* Distances between coefficients.                    */
  double scorn[4];  /* Angle between derivatives in corner of patch.      */
  
  
  /* Initialate dimentions. */
  
  kdim = ps1 -> idim;
  kdim4 = 4*kdim;
  
  
  /* Allocate local used matrices, t[5][kdim] and tn[4][kdim]. */
  
  if ((t = newarray(10*kdim,double)) == SISL_NULL) goto err101;
  
  tn   = t + 5*kdim;
  
  
  if (aang > PIHALF)
    aang = PI - aang;
  
  scen1 = ps1->pdir->ecoef;
  scen2 = tn + 4*kdim;
  tlen = s6scpr(scen1,ps2->pdir->ecoef,kdim);
  for (k1=0; k1 < kdim; k1++)
    scen2[k1] = ps2->pdir->ecoef[k1] - tlen*scen1[k1];
  tlen = s6length(scen2,kdim,&kstat);
  for (k1=0; k1 < kdim; k1++)
    scen2[k1] /= tlen;
  
  kn1  = ps1 -> in1;
  kn2  = ps1 -> in2;
  
  /* Here we are treating each patch in the control polygon separately.*/
  
  for (kver=0; kver < (kn2-1); kver++)
    for (khor=0; khor < (kn1-1); khor++)
      {
	slen[0] = slen[1] = slen[2] = slen[3] = DZERO;
	scorn[0] = scorn[1] = scorn[2] = scorn[3] = DZERO;
	
	/* Here we make the tangents in each corner of the patch,
           and in direction with the clock. The first and the last
	   vector contains both the first tangent. */
	
	k2 = (kver*kn1+khor)*kdim;
	
	for (k1=0; k1 < kdim; k1++,k2++)
	  {
	    t[kdim+k1]   = ps1->pdir->esmooth[k2+kdim] - ps1->pdir->esmooth[k2];
	    t[2*kdim+k1] = ps1->pdir->esmooth[k2+(kn1+1)*kdim]-ps1->pdir->esmooth[k2+kdim];
	    t[3*kdim+k1] = ps1->pdir->esmooth[k2+kn1*kdim]-ps1->pdir->esmooth[k2+(kn1+1)*kdim];
	    t[kdim4+k1] = t[k1] = ps1->pdir->esmooth[k2]-ps1->pdir->esmooth[k2+kn1*kdim];
	    
	    slen[0] += t[k1]*t[k1];
	    slen[1] += t[k1+kdim]*t[k1+kdim];
	    slen[2] += t[k1+2*kdim]*t[k1+2*kdim];
	    slen[3] += t[k1+3*kdim]*t[k1+3*kdim];
	  }
	slen[4] = slen[0] = sqrt(slen[0]);
	slen[1] = sqrt(slen[1]);
	slen[2] = sqrt(slen[2]);
	slen[3] = sqrt(slen[3]);
	
	scorn[0] = s6ang(t,t+kdim,kdim);
	scorn[1] = s6ang(t+kdim,t+2*kdim,kdim);
	scorn[2] = s6ang(t+2*kdim,t+3*kdim,kdim);
	scorn[3] = s6ang(t+3*kdim,t,kdim);

	
	/* Here we makes the normales in each corner of the patch.
	   We are using a cross product between two tangents.
	   The normals is also normalized by deviding with its
	   own length. */
	
	
	for (k1=0, ki=0; k1<kdim4; k1+=kdim, ki++)
	  {
	    
	    for (tlen=DZERO,k2=0,k3=1,k4=2; k2 < kdim; k2++,k3++,k4++)
	      {
		
		if(k3 == kdim) k3 = 0;
		if(k4 == kdim) k4 = 0;
		tn[k1+k2] = t[k1+k3]*t[k1+kdim+k4]-t[k1+k4]*t[k1+kdim+k3];
		
		tlen += tn[k1+k2]*tn[k1+k2];
	      }
	    
	    tlen = sqrt(tlen);
	    if (slen[ki]>aepsge && slen[ki+1]>aepsge &&
		scorn[ki] > ANGULAR_TOLERANCE)
	      for (k2=0; k2 < kdim; k2++) tn[k1+k2] /= tlen;
	    else 
	      for (k2=0; k2 < kdim; k2++) tn[k1+k2] = scen1[k2];
	    
	  }
	
	for (k1=0; k1<kdim4; k1+=kdim)
	  {
	    t2 = scen2[0]*tn[k1];
	    for (k2=1,k3=k1+1;k2<kdim;k2++,k3++)
	      t2 += scen2[k2]*tn[k3];
	    
	    if (t2 <= DZERO) continue;
	    
	    t1 = scen1[0]*tn[k1];
	    for (k2=1,k3=k1+1;k2<kdim;k2++,k3++)
	      t1 += scen1[k2]*tn[k3];
	    
	    tang = t1/sqrt(t1*t1 + t2*t2);
	    
	    if (tang >= DZERO) tang = min((double)1,tang);
	    else               tang = max((double)-1,tang);
	    
	    tang = acos(tang);
	    
	    tang1 = max(tang1,tang);
	  }
      }			
  
  scen1 = ps2 ->pdir-> ecoef;
  tlen = s6scpr(scen1,ps1->pdir->ecoef,kdim);
  for (k1=0; k1 < kdim; k1++)
    scen2[k1] = ps1->pdir->ecoef[k1] - tlen*scen1[k1];
  tlen = s6length(scen2,kdim,&kstat);
  for (k1=0; k1 < kdim; k1++)
    scen2[k1] /= tlen;
  
  kn1  = ps2 -> in1;
  kn2  = ps2 -> in2;
  
  /* Here we are treating each patch in the control polygon separately.*/
  
  for (kver=0; kver < (kn2-1); kver++)
    for (khor=0; khor < (kn1-1); khor++)
      {
	slen[0] = slen[1] = slen[2] = slen[3] = DZERO;
	scorn[0] = scorn[1] = scorn[2] = scorn[3] = DZERO;
	
	/* Here we make the tangents in each corner of the patch,
           and in direction with the clock. The first and the last
	   vector contains both the first tangent. */
	
	k2 = (kver*kn1+khor)*kdim;
	
	for (k1=0; k1 < kdim; k1++,k2++)
	  {
	    t[kdim+k1]   = ps2->pdir->esmooth[k2+kdim] - ps2->pdir->esmooth[k2];
	    t[2*kdim+k1] = ps2->pdir->esmooth[k2+(kn1+1)*kdim]-ps2->pdir->esmooth[k2+kdim];
	    t[3*kdim+k1] = ps2->pdir->esmooth[k2+kn1*kdim]-ps2->pdir->esmooth[k2+(kn1+1)*kdim];
	    t[kdim4+k1] = t[k1] = ps2->pdir->esmooth[k2]-ps2->pdir->esmooth[k2+kn1*kdim];
	    
	    slen[0] += t[k1]*t[k1];
	    slen[1] += t[k1+kdim]*t[k1+kdim];
	    slen[2] += t[k1+2*kdim]*t[k1+2*kdim];
	    slen[3] += t[k1+3*kdim]*t[k1+3*kdim];
	  }
	slen[4] = slen[0] = sqrt(slen[0]);
	slen[1] = sqrt(slen[1]);
	slen[2] = sqrt(slen[2]);
	slen[3] = sqrt(slen[3]);
	
	scorn[0] = s6ang(t,t+kdim,kdim);
	scorn[1] = s6ang(t+kdim,t+2*kdim,kdim);
	scorn[2] = s6ang(t+2*kdim,t+3*kdim,kdim);
	scorn[3] = s6ang(t+3*kdim,t,kdim);

	
	/* Here we makes the normales in each corner of the patch.
	   We are using a cross product between two tangents.
	   The normals is also normalized by deviding with its
	   own length. */
	
	
	for (k1=0, ki=0; k1<kdim4; k1+=kdim, ki++)
	  {
	    
	    for (tlen=DZERO,k2=0,k3=1,k4=2; k2 < kdim; k2++,k3++,k4++)
	      {
		
		if(k3 == kdim) k3 = 0;
		if(k4 == kdim) k4 = 0;
		tn[k1+k2] = t[k1+k3]*t[k1+kdim+k4]-t[k1+k4]*t[k1+kdim+k3];
		
		tlen += tn[k1+k2]*tn[k1+k2];
	      }
	    
	    tlen = sqrt(tlen);
	    if (slen[ki]>aepsge && slen[ki+1]>aepsge &&
		scorn[ki] > ANGULAR_TOLERANCE)
	      for (k2=0; k2 < kdim; k2++) tn[k1+k2] /= tlen;
	    else 
	      for (k2=0; k2 < kdim; k2++) tn[k1+k2] = scen1[k2];
	    
	  }
	
	
	for (k1=0; k1<kdim4; k1+=kdim)
	  {
	    t2 = scen2[0]*tn[k1];
	    for (k2=1,k3=k1+1;k2<kdim;k2++,k3++)
	      t2 += scen2[k2]*tn[k3];
	    
	    if (t2 <= DZERO) continue;
	    
	    t1 = scen1[0]*tn[k1];
	    for (k2=1,k3=k1+1;k2<kdim;k2++,k3++)
	      t1 += scen1[k2]*tn[k3];
	    
	    tang = t1/sqrt(t1*t1+t2*t2);
	    
	    if (tang >= DZERO) tang = min((double)1,tang);
	    else               tang = max((double)-1,tang);
	    
	    tang = acos(tang);
	    
	    tang2 = max(tang2,tang);
	  }
      }			
  
  
  /* Performing a simple case check. */
  
  if (tang1 + tang2 <= aang)
    *jstat = 1;       /* A simpel case.*/
  else
    *jstat = 0;
  
  goto out;
  
  
  /* Error in space allacation.  */
  
  err101: *jstat = -101;
  s6err("s1795",*jstat,kpos);
  goto out;
  
  
  
  /* Free local used memory. */
  
  out:    if (t != SISL_NULL) freearray(t);
}


//===========================================================================
void s1796(SISLCurve *pc1,SISLCurve *pc2,double aepsge,double aang,int *jstat)
//===========================================================================
{
  int kstat = 0;     /* Local status variable.                           */
  int kpos = 0;      /* Position of the error.                           */
  int turned = 0;    /* Use as mark if dir of curve2 is turned.		 */
  int kn;            /* Number of vertices of curve.                     */
  int kdim;	     /* Dimension of the space in which the objects lie. */
  int kin;           /* The index to the vertice to treat.               */
  int k1,k2;         /* Control variables in loop.                       */
  double *t=SISL_NULL;    /* Tangent at each coeficient.                      */
  double tlen;       /* The length of a vector.                          */
  double *scen1;     /* The orginal basis vector to the projection plan. */
  double *scen2;     /* The computed basis vector to the projection plan.*/
  double tang;	     /* An angle between two vectors.		         */
  double tang1=DZERO;/* An angle between two vectors.			 */
  double tang2=DZERO;/* An angle between two vectors.			 */
  double t1,t2;      /* Help variables.				         */
  
  
  /* Initialate space dimentions. */
  
  kdim = pc1 -> idim;
  
  
  /* Allocate local used array. */
  
  if ((t = newarray(2*kdim,double)) == SISL_NULL) goto err101;
  
  /* We have to turn the direction into the smallest angel. */
  
  if (aang > PIHALF)
  {
    aang = PI - aang;
    turned = 1;
  }
  
  /* The first basis vector. */
  
  scen1 = pc1->pdir->ecoef;
  
  /* We must orthonormalize the second basis vector. */
  
  scen2 = t + kdim;
  tlen = s6scpr(scen1,pc2->pdir->ecoef,kdim);
  for (k1=0; k1 < kdim; k1++)
    scen2[k1] = pc2->pdir->ecoef[k1] - tlen*scen1[k1];
  tlen = s6length(scen2,kdim,&kstat);
  for (k1=0; k1 < kdim; k1++)
    scen2[k1] /= tlen;
  
  if (turned)  
     for (k1=0; k1 < kdim; k1++)    scen2[k1] = -scen2[k1];
  
  
  /* Here we are treating each patch in the control polygon separately.*/
  
  for (kn=pc1->in,k2=0,kin=0; kin < kn-1; kin++)
    {
      
      /* Here we make an aproximative tangents to the curve
	 using the control polygon. The tangents are also normalized
	 by deviding with its own length. */
      
      for (tlen=DZERO,k1=0; k1 < kdim; k1++,k2++)
	{
	  t[k1] = pc1->pdir->esmooth[k2+kdim] - pc1->pdir->esmooth[k2];
	  tlen += t[k1]*t[k1];
	}
      
      tlen = sqrt(tlen);
      
      if (tlen > aepsge)
	for (k1=0; k1 < kdim; k1++) t[k1] /= tlen;
      else
	for (k1=0; k1 < kdim; k1++) t[k1] = scen1[k1];
      
      t2 = scen2[0]*t[0];
      for (k1=1; k1<kdim; k1++)
	t2 += scen2[k1]*t[k1];
      
      if (t2 <= DZERO) continue;
      
      t1 = scen1[0]*t[0];
      for (k1=1; k1<kdim; k1++)
	t1 += scen1[k1]*t[k1];
      
      tang = t1/sqrt(t1*t1 + t2*t2);
      
      if (tang >= DZERO) tang = min((double)1,tang);
      else               tang = max((double)-1,tang);
      
      tang = acos(tang);
      
      tang1 = max(tang1,tang);
    }
  
  /* The first basis vector. */
  
  scen1 = pc2->pdir->ecoef;
  
  /* We must orthonormalize the second basis vector. */
  
  scen2 = t + kdim;
  tlen = s6scpr(scen1,pc1->pdir->ecoef,kdim);
  for (k1=0; k1 < kdim; k1++)
    scen2[k1] = pc1->pdir->ecoef[k1] - tlen*scen1[k1];
  tlen = s6length(scen2,kdim,&kstat);
  for (k1=0; k1 < kdim; k1++)
    scen2[k1] /= tlen;
  
  if (turned)  
     for (k1=0; k1 < kdim; k1++)    scen2[k1] = -scen2[k1];
  
  /* Here we are treating each patch in the control polygon separately.*/
  
  for (kn =pc2->in,k2=0,kin=0; kin < kn-1; kin++)
    {
      
      /* Here we make an aproximative tangents to the curve
	 using the control polygon. The tangents are also normalized
	 by deviding with its own length. */
      
      for (tlen=DZERO,k1=0; k1 < kdim; k1++,k2++)
	{
	  t[k1] = pc2->pdir->esmooth[k2+kdim] - pc2->pdir->esmooth[k2];
	  tlen += t[k1]*t[k1];
	}
      
      tlen = sqrt(tlen);
      
      if (tlen > aepsge)
	for (k1=0; k1 < kdim; k1++) t[k1] /= tlen;
      else
	for (k1=0; k1 < kdim; k1++) t[k1] = scen1[k1];
      
      
      t2 = scen2[0]*t[0];
      for (k1=1; k1<kdim;k1++)
	t2 += scen2[k1]*t[k1];
      
      if (t2 <= DZERO) continue;
      
      t1 = scen1[0]*t[0];
      for (k1=1; k1<kdim; k1++)
	t1 += scen1[k1]*t[k1];
      
      tang = t1/sqrt(t1*t1 + t2*t2);
      
      if (tang >= DZERO) tang = min((double)1,tang);
      else               tang = max((double)-1,tang);
      
      tang = acos(tang);
      
      tang2 = max(tang2,tang);
    }
  
  
  
  /* Performing a simple case check. */
  
  if (tang1 + tang2 <= aang)
    *jstat = 1;       /* A simpel case.*/
  else
    *jstat = 0;
  
  goto out;
  
  
  /* Error in space allocation.  */
  
 err101: *jstat = -101;
  s6err("s1796",*jstat,kpos);
  goto out;
    
  
  /* Free local used memory. */
  
 out:    if (t != SISL_NULL) freearray(t);
  
}


//===========================================================================
double s6dplane(double eq1[],double eq2[],double eq3[],double epoint[],
		int idim,int *jstat)
//===========================================================================
{
   int kstat = 0;         /* Local status varaible.           */
   double tdist;          /* Distance between point and line. */
   double snorm[3];       /* Normal vector to the plane.      */
   double sdiff1[3];      /* Difference vector between points in the plane. */
   double sdiff2[3];      /* Difference vector between points in the plane. */
   double sdiff3[3];      /* Difference vector.               */
   
   /* Test dimension.     */
   
   if (idim != 3) goto err104;
   
   /* Compute difference vectors.  */
   
   s6diff(eq2,eq1,idim,sdiff1);
   s6diff(eq3,eq1,idim,sdiff2);
   s6diff(epoint,eq1,idim,sdiff3);
   
   /* Compute normalized plane normal.  */
   
   s6crss(sdiff1,sdiff2,snorm);
   (void)s6norm(snorm,idim,snorm,&kstat);
   
   /* Compute distance to closest point in plane. */
   
   if (kstat)
      tdist = fabs(s6scpr(sdiff3,snorm,idim));
   else 
      tdist = s6dist(eq1,epoint,idim);   /* Normal of zero length.  */

   /* Set status.  */
   
   *jstat = 0;
   goto out;
   
   /* Error in input, dimension not equal to 3.  */
   
   err104 : *jstat = -104;
   goto out;
   
   out :
      return tdist;
}


//===========================================================================
double s6dline(double estart[],double eend[],double epoint[],
	       int idim,int *jstat)
//===========================================================================
{
   int kstat = 0;         /* Local status varaible.           */
   int ki;                /* Counter.                         */
   double tpar;           /* Parameter of closest point.      */
   double tdist;          /* Distance between point and line. */
   double t1;             /* Scalar product.                  */
   double *sline = SISL_NULL;  /* Line vector.                     */
   double *sdiff = SISL_NULL;  /* Difference vector.               */
   
   /* Allocate scratch for local vectors.  */
   
   if ((sline = newarray(idim,DOUBLE)) == SISL_NULL) goto err101;
   if ((sdiff = newarray(idim,DOUBLE)) == SISL_NULL) goto err101;
   
   /* Compute help vectors.  */
   
   s6diff(eend,estart,idim,sline);
   s6diff(epoint,estart,idim,sdiff);
   
   /* Compute parameter of closest point. */
   
   t1 = s6scpr(sline,sline,idim);
   if (t1 <= REL_COMP_RES) 
   {
      /* Compute distance between point and first endpoint of line. */
      
      tdist = s6dist(estart,epoint,idim);
       
      /* Set a warning.  */
      
      *jstat = 2;
      goto out;
   }
   
   tpar = s6scpr(sline,sdiff,idim)/t1;
   
   /* Compute vector between input point and closest point on
      line.      */
   
   for (ki=0; ki<idim; ki++)
      sdiff[ki] = estart[ki] + tpar*sline[ki] - epoint[ki];
   
   /* Compute length of vector.  */
   
   tdist = s6length(sdiff,idim,&kstat);
   
   /* Set status.  */
   
   *jstat = (tpar < 0 || tpar > 1) ? 1 : 0;
   goto out;
   
   /* Error in scratch allocation.  */
   
   err101 : *jstat = -101;
   goto out;
   
   out :
      /* Free space occupied by local arrays.  */
      
      if (sline != SISL_NULL) freearray(sline); 
      if (sdiff != SISL_NULL) freearray(sdiff);
			 
      return tdist;
}


//===========================================================================
void s1990_s9smooth(double ecoef1[],int in1,int in2,int idim,
		    double aepsge,double ecoef2[],int *jstat)
//===========================================================================
{
   int kstat = 0;     /* Local status variable.        */
   int kn = MIN(in1/2,in2/2)+1;  /* Maximum numbers of 
				  coefficients to smooth. */
   int ki,kj,kh,kl;   /* Counters.                     */
   int kc;            /* Index of current corner.      */
   int k1;            /* Sign of change in 1. par dir  */
   int k2;            /* Sign of change in 2. par dir  */
   int lcorn[4];      /* Indexes of corners.           */
   int lsgn1[4];      /* Sign of changes in 1. par dir */
   int lsgn2[4];      /* Sign of changes in 2. par dir */
   double tdist;      /* Distance to closest point in plane. */
   
   /* Set contents of arrays.  */
   
   lcorn[0] = 0;
   lcorn[1] = (in1-1)*idim;
   lcorn[2] = (in1*in2-1)*idim;
   lcorn[3] = in1*(in2-1)*idim;
   
   lsgn1[0] = 1;
   lsgn1[1] = -1;
   lsgn1[2] = -1;
   lsgn1[3] = 1;
   
   lsgn2[0] = 1;
   lsgn2[1] = 1;
   lsgn2[2] = -1;
   lsgn2[3] = -1;
   
   /* Copy coefficients to output array.  */
   
   memcopy(ecoef2,ecoef1,in1*in2*idim,DOUBLE);

   /* For each corner, try to smooth the coefficients in the
      neighbourhood of the corner.  */
   
   for (ki=0; ki<4; ki++)
   {
      kc = lcorn[ki];   /* Index of current corner.   */
      k1 = lsgn1[ki];   /* Sign change in 1. par dir. */
      k2 = lsgn2[ki];   /* Sign change in 2. par dir. */
      
      /* Try to smooth coefficients on center line.  */
	 
      for (kj=2; kj<kn; kj++)
      {
	 if (s6dist(ecoef2+kc,ecoef2+kc+(k2*kj*in1+k1*kj)*idim,
		    idim) < aepsge) continue;
	 
	 for (kh=1; kh<kj; kh++)
	 {
	    tdist = s6dline(ecoef2+kc,ecoef2+kc+(k2*kj*in1+k1*kj)*idim,
			    ecoef2+kc+(k2*kh*in1+k1*kh)*idim,idim,&kstat);
	    if (kstat < 0) goto error;
	    if (kstat || tdist >= aepsge) break;
	 }
	 if (kh < kj) break;
      }
      
      /* Perform smoothing.  */
      
      kj--;
      for (kh=1; kh<kj; kh++)
	 memcopy(ecoef2+kc+(k2*kh*in1+k1*kh)*idim,ecoef2+kc,
		 idim,DOUBLE);
      
      /* Try to smooth coefficients on lower triangle.  */
      
      for (kj=2; kj<kn; kj++)
      {
	 for (kh=1; kh<kj; kh++)
	 {
	    for (kl=0; kl<kh; kl++)
	    {
	       tdist = s6dplane(ecoef2+kc,ecoef2+kc+k1*kj*idim,
				ecoef2+kc+(k2*kj*in1+k1*kj)*idim,
			        ecoef2+kc+(k2*kl*in1+k1*kh)*idim,
				idim,&kstat);
	       if (tdist >= aepsge) break;
	    }
	    if (tdist >= aepsge) break;
	 }
	 if (kh < kj) break;
      }
      
      /* Perform smoothing.  */
      
      kj--;
      for (kh=1; kh<kj; kh++)
	 for (kl=0; kl<kh; kl++)
	    memcopy(ecoef2+kc+(k2*kl*in1+k1*kh)*idim,ecoef2+kc,
		    idim,DOUBLE);
      
      /* Try to smooth coefficients on upper triangle.  */
      
      for (kj=2; kj<kn; kj++)
      {
	 for (kh=0; kh<kj; kh++)
	 {
	    for (kl=kh+1; kl<kj; kl++)
	    {
	       tdist = s6dplane(ecoef2+kc,ecoef2+kc+k2*kj*in1*idim,
				ecoef2+kc+(k2*kj*in1+k1*kj)*idim,
			        ecoef2+kc+(k2*kl*in1+k1*kh)*idim,
				idim,&kstat);
	       if (tdist >= aepsge) break;
	    }
	    if (tdist >= aepsge) break;
	 }
	 if (kh < kj) break;
      }
      
      /* Perform smoothing.  */
      
      kj--;
      for (kh=0; kh<kj; kh++)
	 for (kl=kh+1; kl<kj; kl++)
	    memcopy(ecoef2+kc+(k2*kl*in1+k1*kh)*idim,ecoef2+kc,
		    idim,DOUBLE);
   }
   
   /* Smoothing performed. */
   *jstat = 0;
   goto out;
   
   /* Error in lower level routine.  */
   
   error : *jstat = kstat;
   goto out;
   
   out :
      
   return;
}


//===========================================================================
void s1990_s9edg(double et[],double etan[],double esen[],double aepsge,
		 double *cang,int idim,int *jstat)
//===========================================================================
{
  int ki;
  double tlen;
  double tang;
  double t1,t2;
  
  
  /* Normalizing the tangent. */
  
  for (tlen = DZERO,ki=0; ki < idim; ki++)
    {
      etan[ki] = et[ki];
      tlen += etan[ki]*etan[ki];
    }
  tlen = sqrt(tlen);
  
  if (tlen > aepsge)
    for (ki=0; ki < idim; ki++) etan[ki] /= tlen;
  else
    {
      *jstat = 0;
      goto out;
    }
  
  
  /* Computing the angle beetween the senter of the cone
     and the tangent. */
  
  for (tang=DZERO,ki=0;ki<idim;ki++)
    tang += esen[ki]*etan[ki];
  
  if (tang >= DZERO) tang = min((double)1.0,tang);
  else               tang = max((double)-1.0,tang);
  
  tang = acos(tang);
  
  
  if (tang + *cang >= PI)
    {
      /* The angle is to great, give a meesage
	 to subdivied and exit this function. */
      
      *jstat = 1;
      goto out;
    }
  else if (tang > *cang)
    {
      /* The tangent is not inside the cone, and we
	 have to compute a new cone. */
      
      /* Computing the center coordinates.*/
      
      t1 = (tang - *cang)/((double)2*tang);
      t2 = (double)1 - t1;
      
      for (tlen=DZERO,ki=0; ki<idim; ki++)
        {
	  esen[ki] = esen[ki]*t2 + etan[ki]*t1;
	  tlen += esen[ki]*esen[ki];
        }
      tlen = sqrt(tlen);
      
      if (tlen > DZERO)
	for (ki=0; ki < idim; ki++) esen[ki] /= tlen;
      else
	{
	  /* Vi have to be aware of colapsed polygon. */
	  
	  *jstat = 1;
	  goto out;
	}
      
      /* Computing the angle of the cone. */
      
      *cang = (tang + *cang)/(double)2;
    }
  
  
  if (*cang >= SIMPLECASE)
    {
      /* The angle is to large, give a meesage
	 to subdivied and exit this function. */
      
      *jstat = 1;
      goto out;
    }
  
  
  *jstat = 0;
  
 out: ;
}



//===========================================================================
void s1990(SISLSurf *ps,double aepsge,int *jstat)
//===========================================================================
{
  int kpos = 0;     /* Position of the error.                             */
  int kstat = 0;    /* Local status variable.                             */
  int kfirst = 1;   /* Flag to mark if the first patch is treating.       */
  int kcount;       /* Counts number of vanishing normals.                */
  int kn1;          /* Number of vertices of surface in 1. par. direction.*/
  int kn2;          /* Number of vertices of surface in 2. par. direction.*/
  int kdim;	   /* Dimension of the space in which the objects lie.   */
  int kdim4;	   /* Help variable to contain  4*kdim.			 */
  int kver,khor;    /* The index to the vertice in the upper left corner 
		       to the patch to treat.				 */
  int k1,k2,k3,k4;  /* Control variables in loop. 			 */
  int ki;           /* Control variable in loop.  			 */
  int lcone[4];     /* Flag telling if the cone has been generated.       */
  double *t=SISL_NULL;   /* Allocating t[5][kdim]. Five tangents around the
		       patch, the first and the last is the same.         */
  double *tn;       /* Allocating tn[4][kdim]. Four normals in the corner
		       of the patch.					 */
  double *tsen;     /* Allocating tsen[4][kdim] for senter in edge cones. */
  double *ttan;     /* Allocating ttan[kdim] for tangent on edges.        */
  double tmax,tmin; /* Maximum and minimum coordinates to the narmals in
		       the first patch.					 */
  double tlen;      /* The length of a vector.				 */
  double tnlen;     /* The length of a normal vector.	   	         */
  double tang;	   /* An angle between two vectors.			 */
  double t1,t2;     /* Help variables.					 */
  double sang[4];   /* Angel to the cones to edges.                       */
  double svec1[3];  /* Vectors used to determin degeneration.             */
  double svec2[3];  /* Vectors used to determin degeneration.             */
  double *scoef;    /* Pointer to smoothed coefficient vector.            */
  double slen[5];   /* Distances between coefficients.                    */
  double scorn[4];  /* Angle between derivatives in corner of patch.      */
  
  /* Initiate output status */

  *jstat = 0;
  
  /* Test if the surfaces already have been treated.  */
  
  if (ps->pdir != SISL_NULL) goto out;
  
  /* Initialate dimentions. */
  
  kdim = ps -> idim;
  kn1  = ps -> in1;
  kn2  = ps -> in2;
  kdim4 = 4*kdim;
  
  lcone[0] = 1;
  lcone[1] = 1;
  lcone[2] = 1;
  lcone[3] = 1;
    
  /*Make a new direction cone. */
  
  if ((ps->pdir = newdir(kdim)) == SISL_NULL) goto err101;
  
  ps->pdir->aang = DZERO;
  for (k1=0;k1<kdim;k1++) ps->pdir->ecoef[k1] = DZERO;
  
  /* Allocate scratch for smoothed coefficients.  */
  
  if ((ps->pdir->esmooth = newarray(kn1*kn2*kdim,DOUBLE)) == SISL_NULL) goto err101;
  scoef = ps->pdir->esmooth;
  
  /* Compute coefficients of smoothed curve.  */
  
  /* s1990_s9smooth(ps->ecoef,kn1,kn2,kdim,aepsge,scoef,&kstat);
  if (kstat < 0) goto error; */
  
  memcopy(scoef,ps->ecoef,kn1*kn2*kdim,DOUBLE); 
  
  /* Allocate local used matrices, t[5][kdim] and tn[4][kdim]. */
  
  if ((t = newarray(14*kdim,double)) == SISL_NULL) goto err101;
  tn   = t + 5*kdim;
  tsen = tn + 4*kdim;
  ttan = tsen + 4*kdim;
  
  /* Here we are treating each patch in the control polygon separately.*/
  
  for (kver=0; kver < (kn2-1); kver++)
    for (khor=0; khor < (kn1-1); khor++)
      {
	slen[0] = slen[1] = slen[2] = slen[3] = DZERO;
	scorn[0] = scorn[1] = scorn[2] = scorn[3] = DZERO;
	
	/* Here we make the tangents in each corner of the patch,
           and in direction with the clock. The first and the last
	   vector contains both the first tangent. */
	
	k2 = (kver*kn1+khor)*kdim;
	
	for (k1=0; k1 < kdim; k1++,k2++)
	  {
	    t[kdim+k1]   = scoef[k2+kdim] - scoef[k2];
	    t[2*kdim+k1] = scoef[k2+(kn1+1)*kdim]-scoef[k2+kdim];
	    t[3*kdim+k1] = scoef[k2+kn1*kdim]-scoef[k2+(kn1+1)*kdim];
	    t[kdim4+k1] = t[k1] = scoef[k2]-scoef[k2+kn1*kdim];
	    
	    slen[0] += t[k1]*t[k1];
	    slen[1] += t[k1+kdim]*t[k1+kdim];
	    slen[2] += t[k1+2*kdim]*t[k1+2*kdim];
	    slen[3] += t[k1+3*kdim]*t[k1+3*kdim];
	  }
	slen[4] = slen[0] = sqrt(slen[0]);
	slen[1] = sqrt(slen[1]);
	slen[2] = sqrt(slen[2]);
	slen[3] = sqrt(slen[3]);
	
	scorn[0] = s6ang(t,t+kdim,kdim);
	scorn[1] = s6ang(t+kdim,t+2*kdim,kdim);
	scorn[2] = s6ang(t+2*kdim,t+3*kdim,kdim);
	scorn[3] = s6ang(t+3*kdim,t,kdim);
	
	/* If problems on edges is found we jump to the surface. */
	
	if (ps->pdir->igtpi > 0) goto next;
	
	/* Computing cones of edges in ends of parameter two. */
	
	if (kver == 0)
	  {
	    if (lcone[0])
	      {
		/* First time to generate cone. */
		 
		 memcopy(tsen,t+kdim,kdim,DOUBLE);
		 tlen = slen[1];
		
		if (tlen > aepsge)
		  {
		    for (k1=0; k1 < kdim; k1++) tsen[k1] /= tlen;
		    lcone[0] = 0;
		    sang[0] = (double)0;
		  }
	      }
	    else
	      {
		/* Modify existing cone. */
		 s1990_s9edg(t+(kdim),ttan,tsen,aepsge,sang,kdim,&kstat);
		
		if (kstat)   ps->pdir->igtpi = 10;
	      }
	  } 
	if (kver == kn2-2)
	  {
	    if (lcone[1])
	      {
		/* First time to generate cone. */
		 
		 memcopy(tsen+kdim,t+3*kdim,kdim,DOUBLE);
		 tlen = slen[3];
		
		if (tlen > aepsge)
		  {
		    for (k1=0; k1 < kdim; k1++) tsen[kdim+k1] /= tlen;
		    lcone[1] = 0;
		    sang[1] = (double)0;
		  }
	      }
	    else
	      {
		 s1990_s9edg(t+(3*kdim),ttan,tsen+kdim,aepsge,sang+1,kdim,&kstat);
		if (kstat) ps->pdir->igtpi = 10;
	      }
	  }
	
	/* Computing cones of edges in ends of parameter one. */
	
	if (khor == 0)
	  {
	    if (lcone[2])
	      /* First time to generate cone. */
	      {
		 memcopy(tsen+2*kdim,t,kdim,DOUBLE);
		 tlen = slen[0];
		
		if (tlen > aepsge)
		  {
		    for (k1=0; k1 < kdim; k1++) tsen[2*kdim+k1] /= tlen;
		    lcone[2] = 0;
		    sang[2] = (double)0;
		  }
	      }
	    else
	      {
		 s1990_s9edg(t,ttan,tsen+(2*kdim),aepsge,sang+2,kdim,&kstat);
		if (kstat) ps->pdir->igtpi = 10;
	      }
	  } 
	if (khor == kn1-2)
	  {
	    if (lcone[3])
	      {
		 memcopy(tsen+3*kdim,t+2*kdim,kdim,DOUBLE);
		 tlen = slen[2];
		
		if (tlen > aepsge)
		  {
		    for (k1=0; k1 < kdim; k1++) tsen[3*kdim+k1] /= tlen;
		    lcone[3] = 0;
		    sang[3] = (double)0;
		  }
	      }
	    else
	      {
		 s1990_s9edg(t+(2*kdim),ttan,tsen+(3*kdim),aepsge,sang+3,kdim,&kstat);
		if (kstat)  ps->pdir->igtpi = 10;
	      }
	  }
	
      next:
	
	/* Here we makes the normales in each corner of the patch.
	   We are using a cross product between two tangents.
	   The normals is also normalized by deviding with its
	   own length. */
	
	for (kcount=0, ki=0, k1=0; k1 < kdim4; k1+=kdim, ki++)
	  {
	    for (tlen=DZERO,k2=0,k3=1,k4=2; k2 < kdim; k2++,k3++,k4++)
	      {
		if(k3 == kdim) k3 = 0;
		if(k4 == kdim) k4 = 0;
		tn[k1+k2] = t[k1+k3]*t[k1+kdim+k4]-t[k1+k4]*t[k1+kdim+k3];
		
		tlen += tn[k1+k2]*tn[k1+k2];
	      }
	    tlen = sqrt(tlen);
	    /* KYS 070494 : multiplied ANGULAR_TOLERANCE by 1.0e-2 */
	    if (slen[ki]>aepsge && slen[ki+1]>aepsge &&
		scorn[ki] > 1.0e-2*ANGULAR_TOLERANCE)
	      for (k2=0; k2 < kdim; k2++) tn[k1+k2] /= tlen;
	    else 
	      {
	      for (k2=0; k2 < kdim; k2++) tn[k1+k2] = ps->pdir->ecoef[k2];
	      kcount++;
	      }
	  }
	
	if (kcount == 4) continue;   /* Degenerate control polygon patch */
	
	/* We are treating the first patch. */
	
	if (kfirst)
	  {
	    /* Computing the center coordinates of the cone.*/
	    
	    for (tlen=DZERO,k1=0; k1 < kdim; k1++)
	      {
		tmin = (double)1.0;
		tmax = - tmin;
		for (k2=0; k2 < kdim4; k2+=kdim)
		  {
		    tmax = max(tn[k2+k1],tmax);
		    tmin = min(tn[k2+k1],tmin);
		  }
		ps->pdir->ecoef[k1]=(tmax+tmin)/(double)2;
		
		tlen += ps->pdir->ecoef[k1]*ps->pdir->ecoef[k1];
	      }
	    tlen = sqrt(tlen);
	    if (tlen > DZERO)
	      for (k1=0; k1 < kdim; k1++) ps->pdir->ecoef[k1] /= tlen;
	    else
	      /* KYS 070494 : 'continue' replaced by the following block {} */
	      /* There are nonzero normals pointing in
		 opposite directions, i.e. not simple case */
	      {
		if (khor <= kver)
		  ps->pdir->igtpi = 1;
		else
		  ps->pdir->igtpi = 2;
		ps->pdir->aang = PI;
		goto out;
	      }
	    
	    /* Computing the angle of the cone. */
	    
	    for (ps->pdir->aang=DZERO,k1=0; k1<kdim4; k1+=kdim)
	      {
		 for (tnlen=DZERO,tlen=DZERO,k2=0;k2<kdim;k2++)
		   {
		      tlen += ps->pdir->ecoef[k2]*tn[k1+k2];
		      tnlen += tn[k1+k2]*tn[k1+k2];
		   }
		
		if (tlen >= DZERO) tlen = min((double)1.0,tlen);
		else               tlen = max((double)-1.0,tlen);
		
		tlen = acos(tlen);
		if (sqrt(tnlen) < aepsge) tlen = DZERO;
		
		ps->pdir->aang = max(ps->pdir->aang,tlen);
	      }
	    
	    kfirst = 0;   /* The first patch have been treated.*/
	  } 
	else
	  for (k1=0; k1<kdim4; k1+=kdim)
	    {
	      /* Computing the angle beetween the senter of the cone
		 and the normal. */
	      
	      for (tnlen=DZERO,tang=DZERO,k2=0;k2<kdim;k2++)
		{
		   tang += ps->pdir->ecoef[k2]*tn[k1+k2];
		   tnlen += tn[k1+k2]*tn[k1+k2];
		}
	      
	      if (tang >= DZERO) tang = MIN((double)1.0,tang);
	      else               tang = MAX((double)-1.0,tang);
	      
	      tang = acos(tang);
	      if (sqrt(tnlen) < aepsge) tang = DZERO;
	      
	      if (tang + ps->pdir->aang >= PI)
		{
		  /* The angle is to great, give a meesage
		     how to subdivied and exit this function. */
		  
		  if (khor <= kver)
		    ps->pdir->igtpi = 1;
		  else	
		    ps->pdir->igtpi = 2;
		  goto out;
		}
	      else if (tang > ps->pdir->aang)
		{
		  /* The normal is not inside the cone, than we
		     have to compute a new cone. */
		  
		  /* Computing the center coordinates.*/
		  
	          double sin_tang = sin(tang);                     /*@  hke  */
	          double delta    = (tang - ps->pdir->aang)/2.0;   /*@  hke  */

	          t1 = sin(delta)/sin_tang;                        /*@  hke  */
	          t2 = sin(tang - delta)/sin_tang;                 /*@  hke  */

		  /*
		  t1 = (tang - ps->pdir->aang)/((double)2*tang);
		  t2 = (double)1 - t1;
		  */
		  
		  for (tlen=DZERO,k2=0; k2<kdim; k2++)
		    {
		      ps->pdir->ecoef[k2] = 
			ps->pdir->ecoef[k2]*t2 + tn[k1+k2]*t1;
		      tlen += ps->pdir->ecoef[k2]*ps->pdir->ecoef[k2];
		    }
		  tlen = sqrt(tlen);
		  
		  for (k2=0; k2 < kdim; k2++)  ps->pdir->ecoef[k2] /= tlen;
		  
		  /* Computing the angle of the cone. */
		  
		  ps->pdir->aang = (tang + ps->pdir->aang)/(double)2;
		}
	    }
	
	if (ps->pdir->aang >= SIMPLECASE)
	  {
	    /* The angle is to great, give a meesage
	       how to subdivied and exit this function. */
	    
	    if (khor <= kver)
	      ps->pdir->igtpi = 10;
	    else	
	      ps->pdir->igtpi = 20;
	  }
      }			
  
  /* A final check if we have made a cone. */
  /* UJK, SI, 91-10, when 2D, return values from edge case */
  if (kfirst && kdim != 2)
    {
      /* No cone has been generated. We must examin if the surface is 
	 degenerated to a point or line. */
      for (k1 = 1; k1 < kn1*kn2; k1++)
	if (s6dist(scoef,scoef + (k1*kdim),kdim) >aepsge) break;
      
      if (k1 == kn1*kn2)
	{
	  /* Degenerated to a point. */
	  ps->pdir->igtpi = 0;
	  ps->pdir->aang  = DZERO;
	  ps->pdir->ecoef[0] = (double) 1.0;
	  for (k1 = 1; k1 < kdim; k1++) ps->pdir->ecoef[k1] = DZERO;
	}
      else
	{
	  s6diff(scoef,scoef + (k1*kdim),kdim,svec1);
	  
	  for (k2 = k1 + 1; k2 < kn1*kn2; k2++)
	    if (s6dist(scoef,scoef + (k2*kdim),kdim) >aepsge)
	      {
		s6diff(scoef,scoef + (k2*kdim),kdim,svec2);
		if (s6ang(svec1,svec2,kdim) > 1.0e-2*ANGULAR_TOLERANCE) break;
	      }
	  
	  if (k2 == kn1*kn2)
	    {
	      /* Degenerated to a line. */
	      ps->pdir->igtpi = 0;
	      ps->pdir->aang  = DZERO;
	      ps->pdir->ecoef[0] = (double) 1.0;
	      for (k1 = 1; k1 < kdim; k1++) ps->pdir->ecoef[k1] = DZERO;
	    }
	  else
	    {
	       /* Three points describing a plane found, continue subdividing. */
	       if (ps->et1[kn1] - ps->et1[ps->ik1-1] >=
		   ps->et2[kn2] - ps->et2[ps->ik2-1])
		  ps->pdir->igtpi = 1;
	       else
	       ps->pdir->igtpi = 2; 
	    }
	}
    }
  
  /* success */
  
  goto out;
  
  /* Error in space allacation.  */
  
  err101: 
    *jstat = -101;
    s6err("s1990",*jstat,kpos);
    goto out;
  
  /* Error in lower level routine.  */
  
  /* error : 
    *jstat = kstat;
    goto out; 
  */
  
  /* Free local used memory. */
  
  out:    
    if (t != SISL_NULL) freearray(t);
}




//===========================================================================
void sh1994(SISLSurf *s1,double aepsge,int *jstat)
//===========================================================================
{
  register int ki,kj,kh;
  int kk1, kk2, kn1, kn2;
  int kbez;
  
  double tmaxt, tmaxs;
  double tmint, tmins;
  double tdiff;
  double *scoef=SISL_NULL;
  
  /* Init to  simple case. */
  *jstat = 1;
  
  tmaxt = tmaxs = - HUGE;
  tmint = tmins =   HUGE;
  
  /* Get surface attributes. */
  kk1  = s1->ik1;
  kk2  = s1->ik2;
  kn1  = s1->in1;
  kn2  = s1->in2;
  kbez = (kk1 == kn1) && (kk2 == kn2); 
  
  
  /* If the surface is linear in some direction it is simpel case. */
  if ((kk1 == 2 && kn1 == 2) || (kk2 == 2 && kn2 == 2)) goto out;
  
  
  /* Run through vertices in first parameter direction to find
     intervall of first derivative. */
  
  /* UJK, 91-10 */
  /* for (kj=0, scoef=s1->ecoef; kj<kn2; kj++,scoef++) */
  for (kj=0, scoef=s1->ecoef; kj<kn2; kj++,scoef=s1->ecoef+kn1*kj)
     for (tdiff=DZERO, ki=1; ki<kn1; ki+=kh, scoef+=kh)
     {
	for (kh=1; ki+kh<=kn1; kh++)
	{
	   if (tdiff*(*(scoef+kh) - *(scoef+kh-1)) < DZERO)
	      {
		 scoef += (kh-1);
		 ki += (kh-1);
		 kh = 1;
	      }
	      tdiff = *(scoef + kh) - *scoef;
	      if (fabs(tdiff) >= aepsge) break;
	}
	if (ki+kh > kn1) break;
	
	tmint = min(tmint,tdiff);
	tmaxt = max(tmaxt,tdiff);
     }
  
  /* Run through vertices in second parameter direction to find
     intervall of first derivative. */
  
  for (ki=0; ki<kn1; ki++)
     for (tdiff=DZERO, kj=1, scoef=s1->ecoef+ki; kj<kn2; kj+=kh, scoef+=kh*kn1)
     {
	for (kh=1; kj+kh<=kn2; kh++)
	{
	   if (tdiff*(*(scoef+kh*kn1) - *(scoef+(kh-1)*kn1)) < DZERO)
	      {
		 scoef += (kh-1)*kn1;
		 kj += (kh-1);
		 kh = 1;
	      }
	      tdiff = *(scoef + kh*kn1) - *scoef;
	      if (fabs(tdiff) >= aepsge) break;
	}
	if (kj+kh > kn2) break;
	
	tmins = min(tmins,tdiff);
	tmaxs = max(tmaxs,tdiff);
     }

  /* UJK, 91-10, maybe parameters not set */
  if (tmint > tmaxt || tmins > tmaxs)
  {
     *jstat = 1;
     goto out;
  }
  
  /* The first derivatives decide directions of possible intersection curves. */
  if (kbez && (tmint*tmaxt >=DZERO || tmins*tmaxs >=DZERO))
    *jstat = 1;
  else if (tmint*tmaxt > DZERO || tmins*tmaxs > DZERO) 
    *jstat = 1;
  else if (tmint == tmaxt  || tmins == tmaxs) 
    *jstat = 1;
  else
    /* Not a simple case. */
    *jstat = 0;
  
  goto out;
 out: ;
}


//===========================================================================
SISLdir * newdir (int idim)
//===========================================================================
{
  SISLdir *qnew;		/* Local pointer to new direction structure.*/

  /* Allocate space for direction structure.  */

  if ((qnew = newarray (1, SISLdir)) != SISL_NULL)
    {
      /* Initialise new direction structure. */

      qnew->igtpi = 0;
      qnew->esmooth = SISL_NULL;
      if ((qnew->ecoef = newarray (idim, double)) == SISL_NULL)
	freearray (qnew);
    }
  return (qnew);
}

//===========================================================================
void s1991(SISLCurve *pc,double aepsge,int *jstat)
//===========================================================================
{
  int kpos = 0;     /* Position of the error.                          */
  int kfirst = 1;   /* Flag to mark if the first tangent is treating.  */
  int kn;           /* Number of vertices of curve.                    */
  int kdim;	    /* Dimension of the space in which the objects lie.*/
  int kin;          /* The index to the vertice to treat.              */
  int k1,k2;        /* Control variables in loop.                      */
  double *t=SISL_NULL;   /* Tangent at each coeficient.                     */
  double tlen;      /* The length of a vector.                         */
  double tang;	    /* An angle between two vectors.		       */
  double t1,t2;     /* Help variables.				       */
  double *scoef;    /* Pointer to coefficients.                        */



  /* Test if the surfaces already have been treated.  */

  if (pc->pdir != SISL_NULL) goto out;


  /* Initialate dimentions. */

  kdim = pc -> idim;
  kn = pc -> in;


  /* Make a new direction cone. */

  if ((pc->pdir = newdir(kdim))==SISL_NULL) goto err101;

  /* UJK, Set default values in pdir. */
  pc->pdir->aang = DZERO;
  pc->pdir->igtpi = 0;
  pc->pdir->ecoef[0] = (double) 1.0;

  for (k2 = 1;k2<kdim;k2++)
    pc->pdir->ecoef[k2] = DZERO;


  /* Allocate local used array. */

  if ((t = newarray(kdim,double)) == SISL_NULL) goto err101;

  /* Allocate scratch for smoothed coefficients.  */

  if ((pc->pdir->esmooth = newarray(kn*kdim,DOUBLE)) == SISL_NULL) goto err101;
  scoef = pc->pdir->esmooth;

  /* Compute coefficients of smoothed curve.  */

   /* s1991_s9smooth(pc->ecoef,kn,kdim,aepsge,scoef,&kstat);
      if (kstat < 0) goto error; */
   /* (VSK 02-1994: no point in smoothing) */
   memcopy(scoef, pc->ecoef, kn*kdim, DOUBLE);

  /* Here we are treating each patch in the control polygon separately.*/

  for (k2=0,kin=0; kin < kn-1; kin++)
    {

      /* Here we make an aproximative tangents to the curve
	 using the control polygon. The tangents is also normalized
	 by deviding with its own length. */

      for (tlen=DZERO,k1=0; k1 < kdim; k1++,k2++)
	{
	  t[k1] = scoef[k2+kdim] - scoef[k2];
	  tlen += t[k1]*t[k1];
	}

      tlen = sqrt(tlen);

      if (tlen > aepsge)
	for (k1=0; k1 < kdim; k1++) t[k1] /= tlen;
      else
	{
	  /* UJK, whats wrong with colapsed polygons when computing directions? */
	  continue;

	  /* Vi have to be aware of colapsed polygon. */
	  /* pc->pdir->igtpi = 1;
	     goto out;             */

	}


      /* We are treating the first tangent. */

      if (kfirst)
	{

	  /* Computing the center coordinates of the cone.*/

	  for (k1=0; k1 < kdim; k1++)
	    pc->pdir->ecoef[k1]= t[k1];

	  /* Computing the angle of the cone. */

	  pc->pdir->aang = DZERO;

	  kfirst = 0;   /* The first tangent have been treated.*/
	}
      else
	{

	  /* Computing the angle beetween the senter of the cone
	     and the tangent. */

	  for (tang=DZERO,k1=0;k1<kdim;k1++)
	    tang += pc->pdir->ecoef[k1]*t[k1];

	  if (tang >= DZERO) tang = min((double)1.0,tang);
	  else               tang = max((double)-1.0,tang);

	  tang = acos(tang);

	  if (tang + pc->pdir->aang >= PI)
	    {
	      /* The angle is to great, give a meesage
		 to subdivied and exit this function. */

	      pc->pdir->igtpi = 1;
	      goto out;
	    }
	  else if (tang > pc->pdir->aang)
	    {
	      /* The tangent is not inside the cone, and we
		 have to compute a new cone. */

	      /* Computing the center coordinates.*/

	      t1 = (tang - pc->pdir->aang)/((double)2*tang);
	      t2 = (double)1 - t1;

	      for (tlen=DZERO,k1=0; k1<kdim; k1++)
		{
		  pc->pdir->ecoef[k1] =
		    pc->pdir->ecoef[k1]*t2 + t[k1]*t1;
		  tlen += pc->pdir->ecoef[k1]*
		    pc->pdir->ecoef[k1];
		}
	      tlen = sqrt(tlen);

	      if (tlen > DZERO)
		for (k1=0; k1 < kdim; k1++)
		  pc->pdir->ecoef[k1] /= tlen;
	      else
		{
		  /* Vi have to be aware of colapsed polyg.*/

		  pc->pdir->igtpi = 1;
		  goto out;
		}


	      /* Computing the angle of the cone. */

	      pc->pdir->aang = (tang + pc->pdir->aang)/
		(double)2;
	    }
	}
    }



  if (pc->pdir->aang >= SIMPLECASE)
    {
      /* The angle is to great, give a message
	 to subdivied and exit this function. */

      pc->pdir->igtpi = 3;
      goto out;
    }


  *jstat = 0;
  goto out;


  /* Error in space allacation.  */

 err101: *jstat = -101;
  s6err("s1991",*jstat,kpos);
  goto out;

 out:    if (t != SISL_NULL) freearray(t);

}


//===========================================================================
void sh1993(SISLCurve *c1,double aepsge,int *jstat)
//===========================================================================
{
  register int ki,kj;

  int kk,kn;
  int kbez;
  double tmax;
  double tmin;
  double tdiff;
  double *scoef=SISL_NULL;
  /* ----------------------------------------------------------- */
  
  /* Init to  simple case. */
  *jstat = 1;
  
  tmax = - HUGE;
  tmin =   HUGE;
  
  /* Get curve attributes. */
  kk  = c1->ik;
  kn  = c1->in;
  kbez = (kk == kn);
  
  /* Run through vertices to find
     intervall of first derivative. */
  
  for (tdiff=DZERO, ki=1, scoef=c1->ecoef; ki<kn; ki+=kj, scoef+=kj)
  {
     for (kj=1; ki+kj<=kn; kj++)
     {
	if (tdiff*(*(scoef+kj) - *(scoef+kj-1)) < DZERO)
	   {
	      scoef += (kj-1);
	      ki += (kj-1);
	      kj = 1;
	   }
	   tdiff = *(scoef + kj) - *scoef;
	   if (fabs(tdiff) >= aepsge) break;
     }
     if (ki+kj > kn) break;
     
     tmin = min(tmin,tdiff);
     tmax = max(tmax,tdiff);
  }
  
  
  /* Simple case when no genuin zero's of first derivative. */
  if (kbez && (tmin*tmax >=DZERO)) 
    *jstat = 1;
  else if (tmin*tmax > DZERO) 
    *jstat = 1;
  else if (tmin == tmax)
    *jstat = 1;
  else
    /* Not a simple case. */
    *jstat = 0;

}


//===========================================================================
void s1741(SISLObject *po1,SISLObject *po2,double aepsge,int *jstat)
//===========================================================================
{
  int kstat = 0;    /* Local status variable.                          */
  int kpos = 0;     /* Position of the error.                          */
  int k1;           /* Control variable in loop.		       */
  double tang;	    /* Angel between two vectors.		       */
  double small_tang;/* Smallest angle between two vectors.	       */
  
  if (po1->iobj == SISLPOINT || po2->iobj == SISLPOINT)
    {
      SISLObject *qo1,*qo2;
      
      if(po1->iobj == SISLPOINT)
	{
	  qo1 = po1;
	  qo2 = po2;
	}
      else
	{
	  qo1 = po2;
	  qo2 = po1;
	}
      
      if (qo2->iobj == SISLCURVE)
	{
	  /* Test if the curve lies in the same space as the point.  */
	  
	  if (qo1->p1->idim != qo2->c1->idim) goto err106;
	  
	  if (qo2->c1->idim == 1)
	    {
	      sh1993(qo2->c1,aepsge,&kstat);
	      
	      *jstat = kstat;
	      goto out;
	    }
	  
	  /* Computing the direction cone of the curve. If the curve
	     have cones greater then pi we just return not a simple case.  */
	  
	  s1991(qo2->c1,aepsge,&kstat);
	  if (kstat < 0) goto error;
	  else if (qo2->c1->pdir->igtpi != 0) goto out2;/* Not a simple case.*/
	  
	  
	  /* Performing a simple case check. */
	  
	  if (qo2->c1->pdir->aang<PIHALF)
	    {
	      /* A simpel case. The iteration is able to
		 find intersection.*/
	      
	      *jstat = 1;
	      goto out;
	    }
	}
      else if (qo2->iobj == SISLSURFACE)
	{
	  /* Test if the surface lies in the same space as the point.  */
	  
	  if (qo1->p1->idim != qo2->s1->idim) goto err106;
	  
	  
	  if (qo2->s1->idim == 1)
	    {
	      sh1994(qo2->s1,aepsge,&kstat);
	      
	      *jstat = kstat;
	      goto out;
	    }
	  else
	    {
	      /* Computing the direction cone of the surface. If the surface
		 have cones greater then pi we just return not a simple case.*/
	      
	      s1990(qo2->s1,aepsge,&kstat);
	      if (kstat < 0) goto error;
	      else if (qo2->s1->pdir->igtpi != 0) goto out2; /*No simple case*/
	      
	      
	      /* Performing a simple case check. */
	      
	      if (qo2->s1->pdir->aang<PIHALF)
		{
		  /* A simpel case. The iteration is able to
		     find intersection.*/
		  
		  
		  *jstat = 1;
		  goto out;
		}
	    }
	}
    }
  else if (po1->iobj == SISLCURVE && po2->iobj == SISLCURVE)
    {
      /* Test if the curves lies in the same space.  */
      
      if (po2->c1->idim != po1->c1->idim) goto err106;
      
      
      
      /* Computing the direction cone of the two curves. If one of them
	 have cones greater then pi we just return not a simple case.  */
      
      s1991(po1->c1,aepsge,&kstat);
      if (kstat < 0) goto error;

      s1991(po2->c1,aepsge,&kstat);
      if (kstat < 0) goto error;

      if (po1->c1->pdir->igtpi != 0) goto out2;  /* Not a simple case.*/
      if (po2->c1->pdir->igtpi != 0) goto out2;  /* Not a simple case.*/
      
      
      /* Computing the angle beetween the senters of the two cones. */
      
      for (tang=DZERO,k1=0;k1<po1->c1->idim;k1++)
	tang += po1->c1->pdir->ecoef[k1]*po2->c1->pdir->ecoef[k1];
      
      if (tang >= DZERO)  tang = min((double)1.0,tang);
      else                tang = max((double)-1.0,tang);
      
      tang = acos(tang);
      
      if (tang > PIHALF)
         small_tang = PI - tang;
      else
         small_tang = tang;
      
      /* Performing a simple case check. */
      
      if ((tang+po1->c1->pdir->aang+po2->c1->pdir->aang)<PI &&
	  (po1->c1->pdir->aang+po2->c1->pdir->aang)<tang)
	{
	  /* A simpel case. The two cones and their mirrors
	     are not intersecting.*/
	  
	  *jstat = 1;
	  goto out;
	}
      else if (po1->c1->idim == 2)
        {
	  *jstat = 0;
	  goto out;
	}
      else if (tang < PI - ANGULAR_TOLERANCE && 
	       tang > ANGULAR_TOLERANCE      &&
	       po1->c1->pdir->aang <= (double)1.3*small_tang &&
	       po2->c1->pdir->aang <= (double)1.3*small_tang)
	 /*po1->c1->pdir->aang <= (double)1.3*tang &&
	       po2->c1->pdir->aang <= (double)1.3*tang)*/
	{
	  s1796(po1->c1,po2->c1,aepsge,tang,&kstat);
	  if (kstat<0) goto error;
	  else *jstat = kstat;
	  goto out;
	}
    }
  else if (po1->iobj == SISLSURFACE && po2->iobj == SISLSURFACE)
    {
      
      /* Test if the surfaces lies in the same space.  */
      
      if (po2->s1->idim != po1->s1->idim) goto err106;
      
      
      
      /* Computing the direction cone of the two surfaces. If one of them
	 have cones greater then pi we just return not a simple case.  */
      
      s1990(po1->s1,aepsge,&kstat);
      if (kstat < 0) goto error;
      
      s1990(po2->s1,aepsge,&kstat);
      if (kstat < 0) goto error;

      if (po1->s1->pdir->igtpi != 0) goto out2;  /* Not a simple case.  */

      if (po2->s1->pdir->igtpi != 0) goto out2;  /* Not a simple case.  */
      
      /* Computing the angle beetween the senters of the two cones. */
      
      for (tang=DZERO,k1=0;k1<po1->s1->idim;k1++)
	tang += po1->s1->pdir->ecoef[k1]*po2->s1->pdir->ecoef[k1];
      
      if (tang >= DZERO)  tang = min((double)1.0,tang);
      else                tang = max((double)-1.0,tang);
      
      tang = acos(tang);
      
      
      /* Performing a simple case check. */
      
      if ((tang+po1->s1->pdir->aang+po2->s1->pdir->aang)<PI &&
	  (po1->s1->pdir->aang+po2->s1->pdir->aang)<tang)
	{
	  /* A simpel case. The two cones and their mirrors
	     are not intersecting.*/
	  
	  po1->psimple = po2;
	  *jstat = 1;
	  goto out;
	}
      else if (tang < PI - ANGULAR_TOLERANCE && 
	       tang > ANGULAR_TOLERANCE      &&
	       po1->s1->pdir->aang <= (double)1.3*tang &&
	       po2->s1->pdir->aang <= (double)1.3*tang)
	{
	  s1795(po1->s1,po2->s1,aepsge,tang,&kstat);
	  if (kstat < 0) goto error;
	  if (kstat == 1) po1->psimple = po2;
	  *jstat = kstat;
	  goto out;
	}
    }
  else if (po1->iobj == SISLCURVE || po2->iobj == SISLCURVE)
    {
      SISLObject *qo1,*qo2;
      
      if(po1->iobj == SISLCURVE)
	{
	  qo1 = po1;
	  qo2 = po2;
	}
      else
	{
	  qo1 = po2;
	  qo2 = po1;
	}
      
      
      /* Test if the surface and curve lies in the same space.  */
      
      if (qo2->s1->idim != qo1->c1->idim) goto err106;
      
      
      
      /* Computing the direction cone of the curve and the surface. If one of
	 them have cones greater then pi we just return not a simple case. */
      
      
      s1990(qo2->s1,aepsge,&kstat);
      if (kstat < 0) goto error;
      
      s1991(qo1->c1,aepsge,&kstat);
      if (kstat < 0) goto error;

      if (qo1->c1->pdir->igtpi != 0) goto out2;  /* Not a simple case.  */
      if (qo2->s1->pdir->igtpi != 0) goto out2;  /* Not a simple case.  */

      
      
      /* Computing the angle beetween the senters of the two cones. */
      
      for (tang=DZERO,k1=0;k1<qo2->s1->idim;k1++)
	tang += qo2->s1->pdir->ecoef[k1]*qo1->c1->pdir->ecoef[k1];
      
      if (tang >= DZERO) tang = min((double)1.0,tang);
      else               tang = max((double)-1.0,tang);
      
      tang = acos(tang);
      
      
      /* Performing a simple case check. */
      
      if (((tang + qo1->c1->pdir->aang) < (PIHALF - qo2->s1->pdir->aang)) ||
	  ((tang - PIHALF - qo1->c1->pdir->aang) > qo2->s1->pdir->aang)) 
	{
	  /* A simpel case. The curve cone or the mirror cone
	     are tottally inside the inverted surface cone. */
	  
	  *jstat = 1;
	  goto out;
	}
      else if (tang < PI - ANGULAR_TOLERANCE && 
	       tang > ANGULAR_TOLERANCE      &&
	       min(tang,fabs(PI-tang)) < 
	       (double)0.8*(PIHALF - qo2->s1->pdir->aang) &&
	       qo1->c1->pdir->aang < (double)0.8*(PIHALF-qo2->s1->pdir->aang))
	{
	  s1797(qo2->s1,qo1->c1,aepsge,tang,&kstat);
	  if (kstat<0) goto error;
	  else *jstat = kstat;
	  goto out;
	}
    }
  

/* Not a simple case. */

out2:	*jstat = 0;
	goto out;

/* Error. Dimensions conflicting.  */

err106: *jstat = -106;
        s6err("s1741",*jstat,kpos);
        goto out;

/* Error in lower level routine.  */

error : *jstat = kstat;
        s6err("s1741",*jstat,kpos);
        goto out;

out:  ;
}


//===========================================================================
void sh6edgpoint (SISLEdge * vedge[], SISLIntpt *** wintpt, int *jnum,int *jstat)
//===========================================================================
{
  int lant[2];

  if (vedge[0] == SISL_NULL)
    lant[0] = 0;
  else
    lant[0] = vedge[0]->ipoint;

  if (vedge[1] == SISL_NULL)
    lant[1] = 0;
  else
    lant[1] = vedge[1]->ipoint;

  if (lant[0] + lant[1] > 0)
    {
      int kn1;			/* Number of int. pt. found.   */
      int kn, ki, kj;		/* Counters.                   */
      SISLPtedge *qpt;
      SISLIntpt *qintpt;	/* Intersection point.         */
      SISLIntpt *qmain;		/* Main point in chain of help points.      */

      /* Allocate array of pointers to the points. */

      if (((*wintpt) = newarray (lant[0] + lant[1],
				 SISLIntpt *)) == SISL_NULL)
	goto err101;


      /* Update the array. */

      for (kn1 = 0, kn = 0; kn < 2; kn++)
	if (lant[kn] > 0)
	  for (kj = 0; kj < vedge[kn]->iedge; kj++)
	    for (qpt = vedge[kn]->prpt[kj]; qpt != SISL_NULL; qpt = qpt->pnext)
	      {
		for (ki = 0; ki < kn1; ki++)
		  {
		    if (qpt->ppt == (*wintpt)[ki])
		      break;
		  }
		if (ki == kn1)
		  (*wintpt)[kn1++] = qpt->ppt;
	      }

      /* Traverse the array and remove help points if the corresponding
	 main point also lies in the array.     */

      for (ki = 0; ki < kn1; ki++)
	{
	  qintpt = (*wintpt)[ki];
	  if (sh6ishelp (qintpt))
	    {
	      /* A help point is found. Fetch the corresponding main point. */

	      qmain = sh6getmain (qintpt);

	      /* Check if the main point lies in the array. */

	      if (qmain)
		{
		  for (kj = 0; kj < kn1; kj++)
		    if (qmain == (*wintpt)[kj])
		      break;
		  if (kj < kn1)
		    (*wintpt)[ki] = SISL_NULL;
		}
	    }
	}

      /* Make sure that the array of int.pt. is dense.  */

      for (ki = 0, kj = kn1; ki < kj; ki++)
	if ((*wintpt)[ki] == SISL_NULL)
	  (*wintpt)[ki] = (*wintpt)[--kj];

      *jnum = kn1 = kj;
    }
  else
    *jnum = 0;

  *jstat = 0;
  goto out;

  /* Error in memory allocation.      */

err101:*jstat = -101;
  s6err ("sh6edgpoint", *jstat, 0);
  goto out;


out:;
}

//===========================================================================
void sh1762 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat ** pintdat, SISLEdge * vedge[], int *jstat)
//===========================================================================
{
  int kpos = 0;			/* Position of error.                 */
  int kstat = 0;		/* Local error status.                */
  int kdiv1 = 0;		/* Parameter direction of subdivsion. */
  int kdiv2 = 0;		/* Parameter direction of subdivsion. */
  int ki, ki1, ki2;		/* Counters.                          */
  int at_bottom=TRUE;           /* Flag, true on bottom level of recur*/
  int knewpt=0;                 /* No of points made in prtop part    */
  int kexpand = 2;		/* Expand box in the inner of object. */
  int kxintercept = (*jstat == 202);  /* Extra interception           */
  /* int knum;  */                   /* Number of intersection points at edges. */
  SISLObject *uob1[4];		/* Pointers to subdivided object.     */
  SISLObject *uob2[4];		/* Pointer to object to subdivide.    */

  int debug_flag=0;

  /*  FOR DEBUGGING define debug_flag as an extern variable, i.e.:
   *
   *                    extern int debug_flag;
   */

    if (debug_flag)
    {
       if ((po1->iobj == SISLSURFACE && po1->s1->idim == 1) ||
           (po1->iobj == SISLSURFACE  && po2->iobj == SISLSURFACE))
	   {
    	           /*	if (po1->s1->et1[0] >= 3.3 &&
		        po1->s1->et1[po1->s1->in1] <= 3.6 &&
		        po1->s1->et2[0] >= 0.7 &&
		        po1->s1->et2[po1->s1->in2] <= 0.9)
		        {
		   */
	   int knum;
	   int ipar = 2;
	   int kj, ki;
	   SISLIntpt **up = SISL_NULL;  /* Array of poiners to intersection point.*/

	   sh6edgpoint (vedge, &up, &knum, &kstat);
	   if (kstat < 0)
	      goto error;
	   if (debug_flag == 1)
	   {
	      printf("\n___________________________________________________");

	      printf("\n par val(1) :%#10.10g %#10.10g %#10.10g %#10.10g ",
		     po1->s1->et1[0],
		     po1->s1->et1[po1->s1->in1],
		     po1->s1->et2[0],
		     po1->s1->et2[po1->s1->in2]);
	      if (po2->iobj == SISLSURFACE)
	      {
		 ipar = 4;
		 printf("\n par val(2) :%#10.10g %#10.10g %#10.10g %#10.10g ",
			po2->s1->et1[0],
			po2->s1->et1[po2->s1->in1],
			po2->s1->et2[0],
			po2->s1->et2[po2->s1->in2]);
	      }
	      printf("\n No of pts: %d",knum);
	      for (ki = 0; ki < knum; ki++)
	      {
		 printf("\n point %d :",ki);
		 for (kj = 0; kj < ipar; kj++)
		    printf(" %#10.10g", up[ki]->epar[kj]);
	      }
	   }
	   else              /* if (debug_flag == 2) */
	   {
	      printf("fg: black \n");
	      printf("lin: \n%#10.10g %#10.10g \n",
		     po1->s1->et1[0],
		     po1->s1->et2[0]);

	      printf("%#10.10g %#10.10g \n",
		     po1->s1->et1[0],
		     po1->s1->et2[po1->s1->in2]);

	      printf("%#10.10g %#10.10g \n",
		     po1->s1->et1[po1->s1->in1],
		     po1->s1->et2[po1->s1->in2]);

	      printf("%#10.10g %#10.10g \n",
		     po1->s1->et1[po1->s1->in1],
		     po1->s1->et2[0]);

	      printf("%#10.10g %#10.10g \n",
		     po1->s1->et1[0],
		     po1->s1->et2[0]);

	   }

	   if (up) freearray(up);

	                     /*	   }  */
     }
  }

  sh1762_xc++;
  sh1762_xmax = MAX (sh1762_xmax, sh1762_xc);
  /*  printf("Max : %d \n",xc); */


  for (ki = 0; ki < 4; ki++)
    uob1[ki] = uob2[ki] = SISL_NULL;

  /* Initiate to no intersection. */

  *jstat = 0;

  /* Test if intersection is possible (perform box-test).  */

  /*  box_nmb++;
  time_before = clock();  */

  sh1790 (po1, po2, kexpand, aepsge, &kstat);

  /*  time_used = clock() - time_before;
  box_time += time_used; */
  if (kstat < 0)
    goto error;

  /*  printf("Box test. Status = %d \n",kstat); */

  /* We may have tree different values on kstat.
     kstat = 1 : The two boxes overlapp.
     kstat = 2 : The two "bezier" boxes is just touching.
     kstat = 3 : The two boxes is both inside a microbox of aepsge.
     kstat = 4 : One of the objects is degenerated to one 3D point.
     kstat = 5 : Danger of shadow area in point object intersection,
                 dimension > 1.   */

  if (kstat == 5)
  {
     /* VSK, 92-10.
	Either make sure that there is no overlap, or find the intersection.
	The situation that there is an intersection point in point-object
	intersection when dim > 1 where the usual box test fails to
	recognize the possibility may arise near the endpoints/edges of
	the other object. */

     sh1762_s9ptiter(po1, po2, aepsge, pintdat, vedge, &kstat);
     if (kstat < 0) goto error;

     /* kstat = 0 : No overlap.
	kstat = 1 : The boxes overlap, and the intersection is found. */

     if (kstat == 1) *jstat = 1;
  }

  else if (kstat == 4)

    goto out;

  else if (kstat == 3)
    {
      /* Microbox found.*/

      sh1762_s9mic (po1, po2, pintdat, &vedge, &kstat);
      if (kstat < 0)
	goto error;
      else
	*jstat = kstat;		/* Possible uppdating intersection found. */
    }
  else if (kstat == 1)
    {
      /* Simple Case test (more than one intersection possible?)  */

      /* UJK, div until bezier, due to problems in silhouettes */
       /* Must be opened again for silhouettes NO/YES?/NO!/...
	  ???????????????????????????????????
	  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


       if ((po1->iobj == SISLSURFACE && po1->s1->idim == 1 &&
	    (po1->s1->ik1 != po1->s1->in1 || po1->s1->ik2 != po1->s1->in2)) ||
	   (po2->iobj == SISLSURFACE && po2->s1->idim == 1 &&
	    (po2->s1->ik1 != po2->s1->in1 || po2->s1->ik2 != po2->s1->in2)))
	  kstat = 0;
       else
       { */

	  s1741 (po1, po2, aepsge, &kstat);
	  if (kstat < 0)
	    goto error;
	  else if (po1->iobj == SISLSURFACE && po2->iobj == SISLSURFACE &&
		   vedge[0]->ipoint + vedge[1]->ipoint > 0 && !kstat)
	    sh1762_s9simple (po1, po2, vedge, &kstat);
	  if (kstat < 0)
	    goto error;
	  /* } */
      /* We may have two different values on kstat.
	 kstat = 0 : No simple case.
	 kstat = 1 : Simple case (surfaces possible simple case). */

      if (kstat == 1)
      {
	 /* Possible simple Case, update intersection list. */

	 sh1762_s9update (po1, po2, aepsge, pintdat, &vedge, &kstat);
	 if (kstat < 0)
	    goto error;

	 /* We may have two different values on kstat.
	    kstat = 0 : No simple case, more than two edge intersection.
	    kstat = 1 : Intersection found. */

	 if (kstat == 1)
	    *jstat = 1;		/*Updating found intersection. */
      }

      /* UJK,20.01.93, Don't skip s9con when not success in s9update.
	 removed else.*/
      if (kstat ==0)
      {
	 /* UJK, 17.12.92, for a 1D surface of bezier type
	    there may be a posibility of dividing out edge
	    curve intersections */
	 if (po1->iobj == SISLSURFACE && po1->s1->idim ==1)
	 {
	    sh_1d_div(po1, po2, aepsge, pintdat, vedge, &kstat);
	    if (kstat < 0)
	       goto error;
	    if (kstat == 1)
	       *jstat = 1;		/*Updating found intersection. */
	 }
	 else if (po2->iobj == SISLSURFACE && po2->s1->idim == 1)
	 {
	    sh_1d_div(po2, po1, aepsge, pintdat, vedge, &kstat);
	    if (kstat < 0)
	       goto error;
	    if (kstat == 1)
	       *jstat = 1;		/*Updating found intersection. */
	 }

	 else
	 {

	    /* Check for interval intersection. */

	   kstat = (kxintercept) ? 202 : 0;
	    sh1762_s9con (po1, po2, aepsge, pintdat, vedge, &kstat);
	    if (kstat < 0)
	       goto error;

	    /*  printf("sh1762_s9con. Status = %d \n",kstat); */

	    /* We may have two different values on kstat.
	       kstat = 0 : No intervall intersection.
	       kstat = 1 : Intervall intersection found.
	       kstat = 2 : Intersection not possible */

	    if (kstat == 1)
	       *jstat = 1;		/*Updating found intersection. */
	 }
      }


      if (kstat == 0)
	{
	  /* Find number of possible subdivision directions.
	     kdiv1 and kdiv2 may have 4 difference values :
	     kdiv = 0 : Subdivision not possible.
	     kdiv = 1 : Subdivision in first parameter direction.
	     kdiv = 2 : Subdivision in second parameter direction.
	     kdiv = 3 : Subdivision in both parameter directions. */

	  sh1762_s9num (po1, po2, &kdiv1, &kstat);
	  if (kstat < 0)
	    goto error;

	  sh1762_s9num (po2, po1, &kdiv2, &kstat);
	  if (kstat < 0)
	    goto error;

	  if (kdiv1 + kdiv2 == 0)
	    {
	      /* There is two almost plane parallel objects, and
		 there is nothing at the edges (otherwise the
		 intersections should be found by s9con). Then the
		 only possibility is that there is no intersection. */
	       /* VSK, 11-92. Since partial coincidence is not
		  implemented, there might be intersections on the
		  edges. Check this.   This should not be necessary
		  any more.

	        Check if there are intersection points on edges.

	       if (vedge[0] == SISL_NULL)
		  knum = 0;
	       else
		  knum = vedge[0]->ipoint;

	       if (vedge[1] != SISL_NULL)
		  knum += vedge[1]->ipoint;



	       if (knum > 0)
	       {
		   Do something that makes the routine terminate
		     until partial coincidence is implemented.

		  sh1762_s9mic(po1, po2, pintdat, &vedge, &kstat);
		  if (kstat < 0) goto error;

		  *jstat = kstat;
	       }
	       else
	       {
		  *jstat = 0;
		  goto out;
	       } */

	       *jstat = 0;
	       goto out;
	    }
	  else
	    {
	      SISLEdge *uedge[2];	/* Array of pointers to edges
					      to use in subproblems.    */


	      /* We do not have simple case and it is possible to
		 subdivide. We therefor subdivide and update the
		 edge intersection and then do a recurcive call
		 to treat the sub problems. Curves are subdivided
		 into two, surfaces into four. We can therefor get
		 up to sexteen recurcive calls.*/



	      /***** Treating objects on sub problems. *****/

	      if (kdiv1 > 0)	/* New objects for subdivision of po1. */
		{
		  for (ki = 0; ki < (kdiv1 < 3 ? 2 : 4); ki++)
		    {
		      if ((uob1[ki] = newObject (po1->iobj)) == SISL_NULL)
			goto err101;

		      /* Initiate o1 pointer to point to top level object. */

		      uob1[ki]->o1 = po1->o1;
		    }

		  /* Subdivide the po1 object. */

		  sh1762_s9div (po1, po2, aepsge, 1, kdiv1, uob1, vedge, pintdat, &kstat);
		  if (kstat < 0)
		    goto error;
		  else if (kstat == 1)
		    *jstat = 1;
		}


	      if (kdiv2 > 0)	/* New objects for subdivision of po2. */
		{
		  for (ki = 0; ki < (kdiv2 < 3 ? 2 : 4); ki++)
		    {
		      if ((uob2[ki] = newObject (po2->iobj)) == SISL_NULL)
			goto err101;

		      /* Initiate o1 pointer to point to top level object. */

		      uob2[ki]->o1 = po2->o1;
		    }

		  /* Subdivide the po2 object. */

		  sh1762_s9div (po1, po2, aepsge, 2, kdiv2, uob2, vedge, pintdat, &kstat);
		  if (kstat < 0)
		    goto error;
		  else if (kstat == 1)
		    *jstat = 1;
		}


	      /***** Recursion. *****/

	      if (kdiv1 == 0)	/* Only second object subdivided. */
		for (ki = 0; ki < (kdiv2 < 3 ? 2 : 4); ki++)
		  {
		    /***** Treating edges on sub problems. *****/

		    /* Making new edge object to sub problems. */

		    if (po1->iobj == SISLPOINT)
		      uedge[0] = SISL_NULL;
		    else if ((uedge[0] = newEdge (vedge[0]->iedge)) == SISL_NULL)
		      goto err101;
		    if ((uedge[1] = newEdge (vedge[1]->iedge)) == SISL_NULL)
		      goto err101;

		    /* Update edge intersection on sub problems. */

		    sh6idalledg (po1, uob2[ki], *pintdat, uedge, &kstat);
		    if (kstat < 0)
		      goto error;

		    at_bottom = FALSE;
		    kstat = (kxintercept) ? 202 : 0;
		    sh1762 (po1, uob2[ki], aepsge, pintdat, uedge, &kstat);
		    if (kstat < 0)
		      goto error;
		    else
		      *jstat = *jstat || kstat;

		    if (uedge[0] != SISL_NULL)
		      freeEdge (uedge[0]);
		    if (uedge[1] != SISL_NULL)
		      freeEdge (uedge[1]);
		  }
	      else if (kdiv2 == 0)	/* Only first object subdivided.   */
		for (ki = 0; ki < (kdiv1 < 3 ? 2 : 4); ki++)
		  {
		    /***** Treating edges on sub problems. *****/

		    /* Making new edge object to sub problems. */

		    if ((uedge[0] = newEdge (vedge[0]->iedge)) == SISL_NULL)
		      goto err101;
		    if (po2->iobj == SISLPOINT)
		      uedge[1] = SISL_NULL;
		    else if ((uedge[1] = newEdge (vedge[1]->iedge)) == SISL_NULL)
		      goto err101;

		    /* Update edge intersection on sub problems. */

		    sh6idalledg (uob1[ki], po2, *pintdat, uedge, &kstat);
		    if (kstat < 0)
		      goto error;

		    at_bottom = FALSE;
		    kstat = (kxintercept) ? 202 : 0;
		    sh1762 (uob1[ki], po2, aepsge, pintdat, uedge, &kstat);
		    if (kstat < 0)
		      goto error;
		    else
		      *jstat = *jstat || kstat;

		    if (uedge[0] != SISL_NULL)
		      freeEdge (uedge[0]);
		    if (uedge[1] != SISL_NULL)
		      freeEdge (uedge[1]);
		  }
	      else		/* Both objects subdivided.        */
		for (ki1 = 0; ki1 < (kdiv1 < 3 ? 2 : 4); ki1++)
		  for (ki2 = 0; ki2 < (kdiv2 < 3 ? 2 : 4); ki2++)
		    {
		      /***** Treating edges on sub problems. *****/

		      /* Making new edge object to sub problems. */

		      if ((uedge[0] = newEdge (vedge[0]->iedge)) == SISL_NULL)
			goto err101;
		      if ((uedge[1] = newEdge (vedge[1]->iedge)) == SISL_NULL)
			goto err101;

		      /* Update edge intersection on sub problems. */

		      sh6idalledg (uob1[ki1], uob2[ki2], *pintdat, uedge, &kstat);
		      if (kstat < 0)
			goto error;


		      at_bottom = FALSE;
		      kstat = (kxintercept) ? 202 : 0;
		      sh1762 (uob1[ki1], uob2[ki2], aepsge, pintdat, uedge, &kstat);
		      if (kstat < 0)
			goto error;
		      else
			*jstat = *jstat || kstat;

		      if (uedge[0] != SISL_NULL)
			freeEdge (uedge[0]);
		      if (uedge[1] != SISL_NULL)
			freeEdge (uedge[1]);
		    }
	    }
	}
    }


  /* Must update vedge before going into reex */
  /* if (vedge[0] != SISL_NULL)
  {
     knedge1 = vedge[0]->iedge;
     freeEdge (vedge[0]);
     if ((vedge[0] = newEdge (knedge1)) == SISL_NULL)
        goto err101;
  }
  if (vedge[1] != SISL_NULL)
  {
     knedge2 = vedge[1]->iedge;
     freeEdge (vedge[1]);
     if ((vedge[1] = newEdge (knedge2)) == SISL_NULL)
	goto err101;
  }*/

  /* Making new edge object to sub problems. */


  /* sh6idalledg (po1, po2, *pintdat, vedge, &kstat);
  if (kstat < 0)
     goto error; */


  /* UPDATE (ujk): s9reex must be changed, interface = ?
     Now it connects points on edge when they are
     connected to an internal point ?*/
  /* Now changed! ALA and MSF.  */

  /* UJK, VSK, ALA, 09.02.93, don't need it any longer !? */
  /* sh1762_s9reex (po1, po2, vedge, aepsge, *pintdat, &kstat);
     if (kstat < 0)
     goto error; */

  /* VSK, 10.92. Set status if reex takes action.  */

  /* *jstat = MAX(*jstat,kstat);

  if (debug_flag && kstat)
     printf("\n Output reex: %d \n",kstat); */

  /* Reduction rules */

  sh6red (po1, po2, (*pintdat), &kstat);

  /* Make help points and pretopology at bottom */

  if (at_bottom)
    shmkhlppts (po1, po2, aepsge, pintdat, vedge, &knewpt, &kstat);

  /* UJK, aug.92, If we make help points, status must be set !,
     are there other updating statuses that we've missed ? */
  if (knewpt) *jstat = 1;

  /* Intersections in the inner found.  */

  goto out;

  /* Error in space allocation.         */

err101:*jstat = -101;
  s6err ("sh1762", *jstat, kpos);
  goto out;

  /* Error in lower level routine.      */

error:*jstat = kstat;
  s6err ("sh1762", *jstat, kpos);
  goto out;

  /* Free the space that is  allocated. */

out:
  for (ki = 0; ki < 4; ki++)
    {
      if (uob1[ki] != SISL_NULL)
	freeObject (uob1[ki]);
      if (uob2[ki] != SISL_NULL)
	freeObject (uob2[ki]);
    }
  sh1762_xc--;
}

//===========================================================================
void sh1762_s9mic (SISLObject * po1, SISLObject * po2, SISLIntdat ** rintdat,
		   SISLEdge ** vedge[], int *jstat)
//===========================================================================
{
  int kpos = 0;			/* Position of error.                      */
  int kstat = 0;		/* Local error status.                     */
  int knum = 0;			/* Number of intpt on edges.               */
  /*int klist1, klist2;	*/	/* List index in iintpt.                   */
  int ind1, ind2;		/* Help index in up array.                 */
  double *spar = SISL_NULL;		/* Array to store parameter values.        */
  SISLIntpt **up = SISL_NULL;	/* Array of poiners to intersection point. */
  double *nullp = SISL_NULL;
  double tepsge = 0.0000001;    /* Tolerance used in merging of points.    */

  /* Initiate to no new intersection point. */

  *jstat = 0;

  /* Compute number of intersection points on edges. */

  if ((*vedge)[0] == SISL_NULL)
    knum = 0;
  else
    knum = (*vedge)[0]->ipoint;

  if ((*vedge)[1] != SISL_NULL)
    knum += (*vedge)[1]->ipoint;


  if (knum > 0)
    {
      /* sh1762_s9edgpoint ((*vedge), &up, &knum, &kstat); */
      sh6edgpoint ((*vedge), &up, &knum, &kstat);
      if (kstat < 0)
	goto error;
    }


  if (knum > 1)
    {
      int kturn, ki;

      /* We have more than one intersection point on the edges,
	 we therefor have to treat these problem. */

      if ((po1->iobj == SISLPOINT && po1->p1->idim <= 2) ||
	  (po2->iobj == SISLPOINT && po2->p1->idim <= 2) ||
	  (po1->iobj == SISLCURVE && po2->iobj == SISLPOINT && knum == 2) ||
	  (po1->iobj == SISLPOINT && po2->iobj == SISLCURVE && knum == 2))
	{
	  SISLObject *qo1, *qo2;

	  /* In dimension one and two this function is not
	     a degenenerate treatment function, it is a coincidence
	     function. */

	  if (po1->iobj == SISLPOINT)
	    {
	      qo1 = po1;
	      qo2 = po2;
	      kturn = 0;
	    }
	  else
	    {
	      qo2 = po1;
	      qo1 = po2;
	      kturn = 1;
	    }

	  if (qo2->iobj == SISLSURFACE)
	    {

	       /* Trim area found */
	       for (ki=0; ki<(*rintdat)->ipoint; ki++)
	       {
		  sh6isinside(po1,po2,(*rintdat)->vpoint[ki],&kstat);
		  if (kstat < 0) goto error;
		  if (kstat)
		  {
		     sh6tomain((*rintdat)->vpoint[ki], &kstat);
		     if (kstat < 0) goto error;
		     (*rintdat)->vpoint[ki]->iinter = SI_TRIM;
		  }
	       }

	       /* UJK 18.09.90 Must set intersection found status */
	       *jstat = 1;
	       goto out;

	    }
	  else if (qo2->iobj == SISLCURVE && knum == 2)
	    {
	      double tres;

	      tres = (qo2->c1->et[qo2->c1->in] -
		      qo2->c1->et[qo2->c1->ik - 1]) /
		(qo2->o1->c1->et[qo2->o1->c1->in] -
		 qo2->o1->c1->et[qo2->o1->c1->ik - 1]);

	      if (tres > REL_PAR_RES)
		{
		  /* UJK newi :Main points, curve point 1+2D, connect */
		  sh6idcon (rintdat, up, up + 1, &kstat);
		  if (kstat < 0)
		    goto error;
		  /* Sort points */
		  ind1 = 0;
		  ind2 = 1;
		  if (up[0]->epar[0] > up[1]->epar[0])
		    {
		      ind1 = 1;
		      ind2 = 0;
		    }
		  sh6setdir (up[ind1], up[ind2], &kstat);
		  if (kstat < 0)
		    goto error;



		  /* Set pretopology */
		  /* No, it's there already */

		  /*		  ind1 = 1;
	          ind2 = 0;
	          if (up[0]->epar[0] < up[1]->epar[0])
	        {
	          ind1 = 0;
	          ind2 = 1;
	          }

	          sh6getlist (up[ind1], up[ind2], &klist1, &klist2, &kstat);
	          if (kstat != 0)
	        {
	          kstat = -1;
	          goto error;
	          }
	          if (kturn)
	        {
	          sh6settop (up[ind1], -1,
	          SI_AT, SI_ON, SI_UNDEF, SI_ON, &kstat);
	          if (kstat < 0)
	          goto error;
	          sh6settop (up[ind2], -1,
	          SI_ON, SI_AT, SI_ON, SI_UNDEF, &kstat);
	          if (kstat < 0)
	          goto error;
	          }
	          else
	        {
	          sh6settop (up[ind1], -1,
	          SI_UNDEF, SI_ON, SI_AT, SI_ON, &kstat);
	          if (kstat < 0)
	          goto error;
	          sh6settop (up[ind2], -1,
	          SI_ON, SI_UNDEF, SI_ON, SI_AT, &kstat);
	          if (kstat < 0)
	          goto error;
	          }

	          */

		  /* UJK 18.09.90 Must set intersection found status */
		  *jstat = 1;
		  goto out;
		}
	    }
	}


	/* VSK to treat degenerated curves.  */

	if (po1->iobj == SISLCURVE && po2->iobj == SISLCURVE && knum >= 2)
	{
	   /* The two curves is within a microbox. The intersection will
	      be represented with two points that are connectd. Merge
	      the rest of the points into one of the two remaining.   */

	   for (ki=1; ki<knum-1; ki++)
	     {
		sh6idnewunite(po1,po2,rintdat,&up[0],&up[ki],DZERO,
			      tepsge,&kstat);
		if (kstat < 0) goto error;
             }

	   sh6connect(up[0],up[knum-1],&kstat);
	   if (kstat < 0) goto error;

	   /* Update edge structure.  */

      if ((*vedge)[0] != SISL_NULL)
	{
	  ki = (*vedge)[0]->iedge;
	  freeEdge ((*vedge)[0]);
	  (*vedge)[0] = SISL_NULL;
	  if (((*vedge)[0] = newEdge (ki)) == SISL_NULL)
	    goto err101;
	}
      if ((*vedge)[1] != SISL_NULL)
	{
	  ki = (*vedge)[1]->iedge;
	  freeEdge ((*vedge)[1]);
	  (*vedge)[1] = SISL_NULL;
	  if (((*vedge)[1] = newEdge (ki)) == SISL_NULL)
	    goto err101;
	}

          sh6idalledg (po1, po2, *rintdat, *vedge, &kstat);
          if (kstat < 0)
            goto error;

           *jstat = 1;
	   goto out;
	}

      /* We have more than one intersection point on the edges.
	 We therefor kill these points and
	 try to find a new intersection point. */



      for (ki = 1; ki < knum; ki++)
	{
	  /* UJK newi, unite the points : */
	   sh6idnewunite (po1, po2, rintdat, &up[0], &up[ki], (double) 0.5,
			  tepsge, &kstat);
	  if (kstat < 0)
	    goto error;
	}

      if ((*vedge)[0] != SISL_NULL)
	{
	  ki = (*vedge)[0]->iedge;
	  freeEdge ((*vedge)[0]);
	  if (((*vedge)[0] = newEdge (ki)) == SISL_NULL)
	    goto err101;
	}
      if ((*vedge)[1] != SISL_NULL)
	{
	  ki = (*vedge)[1]->iedge;
	  freeEdge ((*vedge)[1]);
	  if (((*vedge)[1] = newEdge (ki)) == SISL_NULL)
	    goto err101;
	}
      /* UJK newi, one point kept : */
      knum = 1;
    }



  if (knum == 0)
    {
      int kpar = 0;
      SISLIntpt *qt;


      /* There is no intersection points on the edges.
	 We therfore make one new intersection point with parameter
	 values in senter of each object. */


      /* Number of parameter values of object 1. */

      if (po1->iobj == SISLCURVE)
	kpar = 1;
      else if (po1->iobj == SISLSURFACE)
	kpar = 2;
      else
	kpar = 0;

      /* Number of parameter values of object 2. */

      if (po2->iobj == SISLCURVE)
	kpar++;
      else if (po2->iobj == SISLSURFACE)
	kpar += 2;


      /* Allocate array to store midpoint parameter values. */

      if ((spar = newarray (kpar, double)) == SISL_NULL)
	goto err101;


      /* Compute midpoint parameter values. */

      if (po1->iobj == SISLCURVE)
	{
	  spar[0] = (po1->c1->et[po1->c1->ik - 1] +
		     po1->c1->et[po1->c1->in]) * (double) 0.5;
	  kpar = 1;
	}
      else if (po1->iobj == SISLSURFACE)
	{
	  spar[0] = (po1->s1->et1[po1->s1->ik1 - 1] +
		     po1->s1->et1[po1->s1->in1]) * (double) 0.5;
	  spar[1] = (po1->s1->et2[po1->s1->ik2 - 1] +
		     po1->s1->et2[po1->s1->in2]) * (double) 0.5;
	  kpar = 2;
	}
      else
	kpar = 0;

      if (po2->iobj == SISLCURVE)
	{
	  spar[kpar] = (po2->c1->et[po2->c1->ik - 1] +
			po2->c1->et[po2->c1->in]) * (double) 0.5;
	  kpar++;
	}
      else if (po2->iobj == SISLSURFACE)
	{
	  spar[kpar] = (po2->s1->et1[po2->s1->ik1 - 1] +
			po2->s1->et1[po2->s1->in1]) * (double) 0.5;
	  spar[kpar + 1] = (po2->s1->et2[po2->s1->ik2 - 1] +
			    po2->s1->et2[po2->s1->in2]) * (double) 0.5;
	  kpar += 2;
	}

      *jstat = 1;		/* Mark intersection found. */


      /* Making intersection point. */
      /* UJK newi */
      /* UPDATE: ? Be aware of this situation, can it occur ? */

      qt = hp_newIntpt (kpar, spar, DZERO, SI_ORD,
			SI_UNDEF, SI_UNDEF, SI_UNDEF, SI_UNDEF,
			0, 0, nullp, nullp);
      if (qt == SISL_NULL)
	goto err101;

      /* Uppdating pintdat. */

      sh6idnpt (rintdat, &qt, 1, &kstat);
      if (kstat < 0)
	goto error;
    }

  goto out;

/* Error in space allocation.         */

err101:*jstat = -101;
  s6err ("sh1762_s9mic", *jstat, kpos);
  goto out;

/* Error in lower level routine.      */

error:*jstat = kstat;
  s6err ("sh1762_s9mic", *jstat, kpos);
  goto out;

out:if (spar != SISL_NULL)
    freearray (spar);
  if (up != SISL_NULL)
    freearray (up);
}

//===========================================================================
double sh1762_sflength(SISLSurf *psurf, int idir, int *jstat)
//===========================================================================
{
  int kstat = 0;
  int kleft1 = 0, kleft2 = 0;
  int ki;
  int kdim = psurf->idim;
  double spar[2];  /* Parameter value in which to evaluate. */
  double sint[2];  /* Interval between parameter values.    */
  double sder[12]; /* Points on the surface.                */
  int kneval;      /* Number of points to evaluate.         */
  double tlength = 0.0;  /* Estimated length of surface.    */

  kneval = (idir == 1) ? psurf->ik1 : psurf->ik2;
  kneval = max(2, min(kneval, 4));

  /* Set first parameter in which to evaluate. */
  if (idir == 1)
    {
      spar[0] = psurf->et1[psurf->ik1-1];
      spar[1] = (double)0.5*(psurf->et2[psurf->ik2-1]+psurf->et2[psurf->in2]);

      sint[0] = (psurf->et1[psurf->in1] - spar[0])/(double)(kneval-1);
      sint[1] = 0.0;
    }
  else
    {
      spar[0] = (double)0.5*(psurf->et1[psurf->ik1-1]+psurf->et1[psurf->in1]);
      spar[1] = psurf->et2[psurf->ik2-1];

      sint[0] = 0.0;
      sint[1] = (psurf->et2[psurf->in2] - spar[1])/(double)(kneval-1);
    }

  /* Evaluate points. */

  for (ki=0; ki<kneval; ki++, spar[0]+=sint[0], spar[1]+=sint[1])
    {
      s1424(psurf, 0, 0, spar, &kleft1, &kleft2, sder+ki*kdim, &kstat);
      if (kstat < 0)
	goto error;
    }

  /*  Compute the distance between the points. */

  for (tlength=0.0, ki=1; ki<kneval; ki++)
    tlength += s6dist(sder+(ki-1)*kdim, sder+ki*kdim, kdim);

  *jstat = 0;
  goto out;

  /* Error in lower level routine.  */
  error:
  *jstat = kstat;
  s6err ("sh1762_sflength", *jstat, 0);
  goto out;

  out:
  return tlength;
}

//===========================================================================
void sh1762_s9num (SISLObject * po, SISLObject * poref, int *jdiv, int *jstat)
//===========================================================================
{
  int kstat = 0;
  int kgtpi1=0, kgtpi2=0;
  double tang1=DZERO, tang2=DZERO;
  int not_case_2d;
  int kbez1=1, kbez2=1;

  /* Init. */

  *jdiv = 0;

  if (po->iobj < SISLPOINT || po->iobj > SISLSURFACE)
    goto err121;
  if (poref->iobj < SISLPOINT || poref->iobj > SISLSURFACE)
    goto err121;

  if (po->iobj == SISLPOINT)
    goto out;

  kgtpi1 = 10;
  tang1 = HUGE;

  kgtpi2 = 0;
  tang2 = (double) 0.0;  /* VSK. 030394. Changed tang1 into tang2. */

  /* Get attributes from object to divide. */
  if (po->iobj == SISLCURVE)
    {
      if (po->c1->pdir != SISL_NULL)
	{
	  kgtpi1 = po->c1->pdir->igtpi;
	  tang1 = po->c1->pdir->aang;
	}
      kbez1 = (po->c1->ik == po->c1->in);
    }
  else
    {
      if (po->s1->pdir != SISL_NULL)
	{
	  kgtpi1 = po->s1->pdir->igtpi;
	  tang1 = po->s1->pdir->aang;
	}
      kbez1 = (po->s1->ik1 == po->s1->in1 && po->s1->ik2 == po->s1->in2);
    }

  /* Get attributes from referance object. */
  if (poref->iobj == SISLCURVE)
    {
      if (poref->c1->pdir != SISL_NULL)
	{
	  kgtpi2 = poref->c1->pdir->igtpi;
	  tang2 = poref->c1->pdir->aang;
	}
      kbez2 = (poref->c1->ik == poref->c1->in);
    }
  else if (poref->iobj == SISLSURFACE)
    {
      if (poref->s1->pdir != SISL_NULL)
	{
	  kgtpi2 = poref->s1->pdir->igtpi;
	  tang2 = poref->s1->pdir->aang;
	}
      kbez2 = (poref->s1->ik1 == poref->s1->in1 &&
	       poref->s1->ik2 == poref->s1->in2);
    }

    if (poref->iobj == SISLPOINT && poref->p1->idim == 2)
       not_case_2d = FALSE;
    else
       not_case_2d = TRUE;


    /* Test for number of division directions.     */
  /*---------------------------------------------*/
  /* If linear, we do not subdivide.             */
  if (kgtpi1 == 0 && tang1 <= ANGULAR_TOLERANCE/10.0 && not_case_2d &&
      !(kgtpi2 == 0 && tang2 < tang1))
    *jdiv = 0;

  else if (po->iobj == SISLCURVE && poref->iobj == SISLSURFACE)
    /* Subdivide curve. */
    {
      if (s1791 (po->c1->et, po->c1->ik, po->c1->in))
	*jdiv = 1;

      else
	*jdiv = 0;

    }

  else if (kgtpi1 == 0 && tang1 < SIMPLECASE / (double) 2.0 && kbez1 == 1 &&
	   (kgtpi2 != 0 || tang2 > tang1 * (double) 2.0))
    *jdiv = 0; 

  else if (po->iobj == SISLCURVE)
    {
      if (s1791 (po->c1->et, po->c1->ik, po->c1->in))
	*jdiv = 1;

      else
	*jdiv = 0;
    }
  else if (po->iobj == SISLSURFACE)
    {
	double tsfp1, tsfp2, tref;
	tref = 5.0;

	tsfp1 = sh1762_sflength(po->s1, 1, &kstat);
	if (kstat < 0)
	  goto error;

	tsfp2 = sh1762_sflength(po->s1, 2, &kstat);
	if (kstat < 0)
	  goto error;

	if (s1791 (po->s1->et1, po->s1->ik1, po->s1->in1)  &&
	  !(po->s1->ik1 == 2 && tsfp1 < tref*tsfp2))
	*jdiv = 1;

      else
	*jdiv = 0;

	if (s1791 (po->s1->et2, po->s1->ik2, po->s1->in2) &&
	  !(po->s1->ik2 == 2 && tsfp2 < tref*tsfp1))
	*jdiv += 2;

    }
  goto out;


  /* Error in lower level routine. */
  error:
  *jstat = kstat;
  s6err ("sh1762_s9num", *jstat, 0);
  goto out;

  /* Error. Kind of object does not exist.  */
err121:
  *jstat = -121;
  s6err ("sh1762_s9num", *jstat, 0);

out:;
}

//===========================================================================
int sh1762_is_taboo(SISLSurf *psurf1, SISLSurf *psurf2, SISLIntpt *pintpt, 
		    int idir, int *jstat)
//===========================================================================
{
   static double parallel    = 0.01;
   static double fuzzy_angle = 1e-4;
   static double tol = (double) 1000000.0 * REL_COMP_RES;

   int kstat = 0;
   int is_taboo = 0;
   double derivs1[9], derivs2[9], norm[3], nor1[3], nor2[3], angle;
   double abs_tang1[2], abs_tang2[2];
   double tmax;
   int ilfs = 0, ilft = 0;

   if (psurf1->idim == 2)
     return 0;

   /* Test input. */

   if (psurf2 && (psurf1->idim != psurf2->idim || psurf1->idim != 3))
     goto err104;

   if (!psurf2 && psurf1->idim != 1)
     goto err105;

   if (psurf2)
     {
       /* Evaluate the intersection point in both surfaces. */

       s1421(psurf1, 1, &pintpt->epar[0], &ilfs, &ilft, derivs1, norm, &kstat);
       if (kstat < 0)
	 goto error;

       s1421(psurf2, 1, &pintpt->epar[2], &ilfs, &ilft, derivs2, norm, jstat);
       if (kstat < 0)
	 goto error;

       s6crss(derivs2+3, derivs2+6, nor2);
       s6crss(derivs1+3, derivs1+6, nor1);

       /* If we have a singularity, we don't declare it as taboo. */

       angle = s6ang(nor1, nor2, 3);

       abs_tang1[0] = fabs(s6scpr(derivs1+6, nor2, 3));
       abs_tang1[1] = fabs(s6scpr(derivs1+3, nor2, 3));

       abs_tang2[0] = fabs(s6scpr(nor1, derivs2+6, 3));
       abs_tang2[1] = fabs(s6scpr(nor1, derivs2+3, 3));

       if (angle < fuzzy_angle)
	 is_taboo = 0;
       else if (idir == 1 && abs_tang1[0] < parallel*abs_tang1[1])
	 is_taboo = 1;
       else if (idir == 2 && abs_tang1[1] < parallel*abs_tang1[0])
	 is_taboo = 1;
       else 
	 is_taboo = 0;
     }
   else 
     {
       /* Evaluate the intersection point. */

       s1421(psurf1, 1, &pintpt->epar[0], &ilfs, &ilft, derivs1, norm, &kstat);
       if (kstat < 0)
	 goto error;

       /* If we have a singularity, we don't declare it as taboo. */

       tmax = sqrt(derivs1[1]*derivs1[1] + derivs1[2]*derivs1[2]);
       if (tmax < tol)
	  /* The length of the surface normal is less than the 
	     given tolerance*/
	is_taboo = 0;

       else if (idir == 1 && fabs(derivs1[2]) < parallel*tmax)
	 is_taboo = 1;
       else if (idir == 2 && fabs(derivs1[1]) < parallel*tmax)
	 is_taboo = 1;
       else 
	 is_taboo = 0;
     }

   *jstat = 0;
   goto out;

   /* Error in lower order routine. */
  error:
  *jstat = kstat;
  s6err ("sh1762_is_taboo", *jstat, 0);
   goto out;

  /* Error. Dimension not equal to 3.  */
err104:
  *jstat = -104;
  s6err ("sh1762_is_taboo", *jstat, 0);
   goto out;

  /* Error. Conflicting dimensions.  */
err105:
  *jstat = -105;
  s6err ("sh1762_is_taboo", *jstat, 0);
   goto out;

out:
   return is_taboo;
}

//===========================================================================
void sh1762_s9subdivpt (SISLObject * po1, SISLObject * po2, double aepsge,
			int iobj, int idiv, SISLEdge * vedge[], SISLIntdat ** pintdat,
			int *fixflag, SISLIntpt ** rpt, double epar[], int *jstat)
//===========================================================================
{
   int kstat = 0;
   int kpos = 0;
   int kpar;            /* First index of subdivision point in the
			   parameter value of in intersection point.        */
   int kfound = 0;      /* Indicates if in intersection point / extremal
			   point is to be used.                             */
   int kf1=0, kf2=0;    /* Indicates if an internal intersection point is
			   legal in the parameter directions of a surface.  */
   double tdel;		/* Parameter used to measure closeness to an edge.  */
   double tdel1, tdel2;	/* Parameters used to measure closeness to an edge. */
   double tstart, tend; /* Endparameters of curve.                          */
   double tstart2, tend2; /* Endparameters of second curve.                 */
   double tpar;         /* Parameter value of subdivision point. */
   double tpar2;        /* Parameter value of point from iteration. */
   double sstart[2], send[2];  /* Endparameters of surface.      */
   double spar[2];      /* Parameter value of subdivision point. */
   double spar2[2];     /* Parameter value of subdivision point. */
   double sparsave[2];  /* Parameter value of subdivision point. */
   SISLObject *qo1;	/* Pointer to the object that is to be subdivided. */
   SISLObject *qo2;	/* Pointer to the other object.          */
   SISLIntpt *qpt = SISL_NULL;  /* An internal intersection point.    */

   /* Set pointer to subdivision object. */

   qo1 = (iobj == 1 ? po1 : po2);
   qo2 = (iobj == 1 ? po2 : po1);
   kpar = (iobj == 1 ? 0 : po1->iobj);

  *jstat = 0;

  /* Branch on subdivision object. */

  if (qo1->iobj == SISLCURVE)
  {
     /* Find a proper subdivision value of the curve.  First set when a point
	is to close to an edge to be used as a subdivision point. */

     tdel = (double) 0.01 *(qo1->c1->et[qo1->c1->in] -
			    qo1->c1->et[qo1->c1->ik - 1]);

     /* Try to find an internal intersection point. */

     s6idint (po1, po2, *pintdat, &qpt, iobj);
     if (!(3*qo1->c1->ik > qo1->c1->in) &&
	 /* if (qo1->c1->ik != qo1->c1->in && */
	 (sh6ismain (qpt)) && sh6nmbhelp (qpt,&kstat) == 0)
	qpt = SISL_NULL;

      if (qpt != SISL_NULL)
	{
	  /* Internal intersection point found. */

	  tpar = qpt->epar[kpar];

	  if (tpar < (qo1->c1->et[qo1->c1->ik - 1] + tdel) ||
	      tpar > (qo1->c1->et[qo1->c1->in] -tdel))
	       qpt = SISL_NULL;  /* Do not use the point as a subdivision point. */
	}

      if (qpt == SISL_NULL &&
	  vedge[iobj - 1]->ipoint == 0 && qo1->c1->ik == qo1->c1->in)
      {
	 /* No internal intersection is found. The curve is of Bezier type,
	    and there is no intersection on the endpoints of the curve.
	    Then we try to iterate in order to find an intersection or
	    closest point to use as a subdivision point. Branch on the
	    various kind of other objects involved in the intersection. */

	 tstart = qo1->c1->et[qo1->c1->ik - 1];
	 tend = qo1->c1->et[qo1->c1->in];
	 tpar = (tstart + tend) * (double) 0.5;
	 kfound = 1;

	 if (qo2->iobj == SISLPOINT)
	 {
	    /* ALA & UJK start 31/10/90. */
	    if (qo2->p1->idim == 1)
	       s1172 (qo1->o1->c1, tstart, tend,
		      tpar, &tpar, &kstat);
	    else
	    {
	       kstat = 1;   /* Use quick iteration. */
	       s1771 (qo2->o1->p1, qo1->o1->c1, aepsge, tstart, tend,
		      tpar, &tpar, &kstat);
	    }
	    if (kstat < 0)
	       goto error;
	 }

	 else if (qo2->iobj == SISLCURVE)
	 {
	    tstart2 = qo2->c1->et[qo2->c1->ik - 1];
	    tend2 = qo2->c1->et[qo2->c1->in];
	    tpar2 = (tstart + tend) * (double) 0.5;
	    tdel2 = (double)0.01*(tend - tstart);

	    s1770 (qo1->o1->c1, qo2->o1->c1, aepsge, tstart, tstart2, tend,
		   tend2, tpar, tpar2, &tpar, &tpar2, &kstat);
	    if (kstat < 0)
	       goto error;

	    /* Test the subdivision point towards the endpoint of the
	       second curve. */

	    if (tpar2 < tstart2+tdel2 || tpar2 > tend2-tdel2)
	       kfound = 0;
	 }

	 else if (qo2->iobj == SISLSURFACE)
	 {
	    sstart[0] = qo2->s1->et1[qo2->s1->ik1 - 1];
	    sstart[1] = qo2->s1->et2[qo2->s1->ik2 - 1];

	    send[0] = qo2->s1->et1[qo2->s1->in1];
	    send[1] = qo2->s1->et2[qo2->s1->in2];

	    spar[0] = (sstart[0] + send[0]) * (double) 0.5;
	    spar[1] = (sstart[1] + send[1]) * (double) 0.5;

	    tdel1 = (double)0.01* (send[0] - sstart[0]);
	    tdel2 = (double)0.01* (send[1] - sstart[1]);

	    kstat = 1;    /* Use quick iteration. */
	    s1772 (qo1->o1->c1, qo2->o1->s1, aepsge, tstart, sstart, tend,
		   send, tpar, spar, &tpar, spar, &kstat);
	    if (kstat < 0)
	       goto error;

	    /* Test the subdivision point towards the edges of the surface. */

	    if (spar[0] < sstart[0]+tdel1 || spar[0] > send[0]-tdel1 ||
		spar[1] < sstart[1]+tdel2 || spar[1] > send[1]-tdel2)
	       kfound = 0;
	 }

	 /* Test the subdivision point towards the edges of the subdivision
	    curve. */

	 if (!kfound ||
	     tpar < tstart+tdel || tpar > tend-tdel)

	    /* Use the midpoint of the curve as subdivision point. */

	    tpar = s1792 (qo1->c1->et, qo1->c1->ik, qo1->c1->in);
      }
      else if (qpt == SISL_NULL)
	 /* Use the midpoint as a subdivision point. */

	 tpar = s1792 (qo1->c1->et, qo1->c1->ik, qo1->c1->in);

      /* Set output variables  */

      epar[0] = tpar;
      *rpt = qpt;
  }
  else if (qo1->iobj == SISLSURFACE)
  {
     /* Find a subdivision point of the surface. Branch on the other
	object involved in the intersection. First set the endparameters
	of the surface and when a point is to close to an edge
	to be used as a subdivision point. */

     sstart[0] = qo1->s1->et1[qo1->s1->ik1 - 1];
     sstart[1] = qo1->s1->et2[qo1->s1->ik2 - 1];

     send[0] = qo1->s1->et1[qo1->s1->in1];
     send[1] = qo1->s1->et2[qo1->s1->in2];

     tdel1 = (double) 0.01 *(send[0] - sstart[0]);
     tdel2 = (double) 0.01 *(send[1] - sstart[1]);

     /* In the Bezier case, search for an internal intersection point. */

     if (qo1->s1->ik1 == qo1->s1->in1 && qo1->s1->ik2 == qo1->s1->in2)
	s6idint (po1, po2, *pintdat, &qpt, iobj);
     if (qpt != SISL_NULL)
     {
	/* Internal intersection point found. */
	sparsave[0] = spar[0] = qpt->epar[kpar];
	sparsave[1] = spar[1] = qpt->epar[kpar + 1];
	kf1 = kf2 = 1;

	/* Test the point towards the edges of the surface. */

	if (spar[0] < sstart[0] + tdel1 || spar[0] > send[0] - tdel1)
	{
	   kf1--;
	   qpt = SISL_NULL;
	}
	if (spar[1] < sstart[1] + tdel2 || spar[1] > send[1] - tdel2)
	{
	   kf2--;
	   qpt = SISL_NULL;
	}
     }

     kfound = 0;   /* If no iteration is tryed, use the midpoint. */
     if ((!qpt) && qo2->iobj != SISLSURFACE &&
	 !(qo2->iobj == SISLPOINT && qo2->p1->idim == 1) &&
	 qo1->s1->ik1 == qo1->s1->in1 && qo1->s1->ik2 == qo1->s1->in2)
     {
	/* No internal intersection is found. The second object is not a
	   surface, and the subdivision surface is of Bezier type.
	   Prepare for iteration. */

	spar[0] = (sstart[0] + send[0]) * (double) 0.5;
	spar[1] = (sstart[1] + send[1]) * (double) 0.5;
	kfound = 3;

	if (qo2->iobj == SISLPOINT)
	{
	   s1773 (qo2->o1->p1, qo1->o1->s1, aepsge, sstart, send, spar,
		  spar, &kstat);
	   if (kstat < 0)
	      goto error;
	}

	else if (qo2->iobj == SISLCURVE)
	{
	   tstart = qo2->c1->et[qo2->c1->ik - 1];
	   tend = qo2->c1->et[qo2->c1->in];
	   tpar = (tstart + tend) * (double) 0.5;
	   tdel = (double)0.01*(tend - tstart);

	   kstat = 1;
	   s1772 (qo2->o1->c1, qo1->o1->s1, aepsge, tstart, sstart,
		  tend, send, tpar, spar, &tpar, spar, &kstat);
	   if (kstat < 0)
	      goto error;

	   /* Control the edges of the curve. */

	   if (tpar < tstart+tdel || tpar > tend-tdel)
	      kfound = 0;
	}

	/* Test the edges of the surface to be subdivided. */

	   if (spar[0] < sstart[0]+tdel1 || spar[0] > send[0]-tdel1)
	      kfound--;
	   if (spar[1] < sstart[1]+tdel2 || spar[1] > send[1]-tdel2)
	      kfound -= 2;
	}

     if ((!qpt) && (!(kfound==3) && qo2->iobj != SISLSURFACE &&
		    !(qo2->iobj == SISLPOINT && qo2->p1->idim == 1)))
	 {
	    /* Use the midpoint of the surface as a subdivision point. */

	    if (kfound != 1)
	       spar[0] = s1792 (qo1->s1->et1, qo1->s1->ik1, qo1->s1->in1);
	    if (kfound != 2)
	       spar[1] = s1792 (qo1->s1->et2, qo1->s1->ik2, qo1->s1->in2);

	    /* Test if this subdivision point is too close to an existing
	       inner intersection point. */

	    if (kf1 && fabs(spar[0]-sparsave[0]) < tdel1)
	       spar[0] = sparsave[0];
	    if (kf2 && fabs(spar[1]-sparsave[1]) < tdel2)
	       spar[1] = sparsave[1];
	 }

     if ((!qpt) && (qo2->iobj == SISLSURFACE ||
		    (qo2->iobj == SISLPOINT &&
		     (qo2->p1->idim == 1 || qo2->p1->idim == 2))))
     {
	SISLPtedge *qptedg;	/* Pointer used to traverse int. points on edges. */
	SISLIntpt *pt1 = SISL_NULL;  /* Intersection point on edge. */
	SISLIntpt *pt2 = SISL_NULL;  /* Intersection point on edge. */
	SISLIntpt *ptsing1 = SISL_NULL; /* Singular intersection point on edge. */
	SISLIntpt *ptsing2 = SISL_NULL; /* Singular intersection point on edge. */
	SISLIntpt *pcurr;          /* Current intersection point.          */
	int kj;                    /* Counter.                             */
	double tmean[2];           /* Middle parameter of the surface.     */
	double tpar1=HUGE, tpar2=HUGE;  /* Used for comparisement with
					   intersection point.             */
	int ktype1=-10, ktype2=-10;     /* As previous.                    */

	/* There is a surface-surface intersection or an intersection
	   between a surface and a point in 1D. In both cases intersection
	   curves are the expected output. Start by logging the intersection
	   points at the edges. */
	/* If the surface is almost a Bezier surface, make it Bezier. */

	s9simple_knot(qo1->s1, idiv, spar, fixflag, &kstat);
	if ( kstat < 0 ) goto error;

	memcopy(sparsave, spar, 2, DOUBLE);
	if (((*fixflag) == 1 || (*fixflag) == 3) &&
	    (spar[0] < sstart[0]+tdel1 || spar[0] > send[0]-tdel1))
	   *fixflag -= 1;
	if (((*fixflag) == 2 || (*fixflag) == 3) &&
	    (spar[1] < sstart[1]+tdel2 || spar[1] > send[1]-tdel2))
	   *fixflag -= 2;

	if ( *fixflag < 3 )
	{
	   /* In at least one parameter direction there is a freedom
	      of the subdivision point.                               */

	   /* Set the middle parameter.  */

	   tmean[0] = s1792 (qo1->s1->et1, qo1->s1->ik1, qo1->s1->in1);
	   tmean[1] = s1792 (qo1->s1->et2, qo1->s1->ik2, qo1->s1->in2);

	   if (!(*fixflag == 1) && vedge[iobj - 1]->ipoint > 0)
	   {
	      /* Search for intersection points on the edges in the
		 first paramter direction, i.e. edge 1 and 3. Find the
		 intersection point closest to the middle parameter value
		 and distinguish between ordinary intersection points and
		 singular or almost singular (touchy) points. */

	      /* Loop for edges no 1 and 3*/
	      for (kj = 0; kj < 3; kj += 2)
		 /* Loop for all points on edge*/
		 for (qptedg = vedge[iobj - 1]->prpt[kj]; qptedg != SISL_NULL;
	       qptedg = qptedg->pnext)
		 {
		    pcurr = qptedg->ppt;

		    /* Test if the point is too close to an edge. */

		    if (pcurr->epar[kpar] < sstart[0]+tdel1 ||
			pcurr->epar[kpar] > send[0]-tdel1) continue;

		    /* Check if the intersection curve passing through
		       the point is always parallel to an iso-curve. */
		    
		    if (sh1762_is_taboo(qo1->s1, 
					(qo2->iobj == SISLSURFACE) ? 
					qo2->s1 : SISL_NULL, 
					pcurr, 1, &kstat))
		      continue;

		    if (kstat < 0)
		      goto error;

		    if (pcurr->iinter == SI_SING)
		    {
		       /* Test if the singular/near singular point is the one
			  closest to the middle point.  */

		       if (!ptsing1 || fabs(pcurr->epar[kpar]-tmean[0]) <
			   fabs(ptsing1->epar[kpar]-tmean[0]))
			  ptsing1 = pcurr;
		    }
		    else
		    {
		       /* Test if the intersection point is the one closest
			  to the middle. */

		       if (!pt1 || fabs(pcurr->epar[kpar]-tmean[0]) <
			   fabs(pt1->epar[kpar]-tmean[0]))
			  pt1 = pcurr;
		    }
		 }
	   }

	   if (!(*fixflag == 2) && vedge[iobj - 1]->ipoint > 0)
	   {
	      /* Search for intersection points on the edges in the
		 second paramter direction, i.e. edge 2 and 4. Find the
		 intersection point closest to the middle parameter value
		 and distinguish between ordinary intersection points and
		 singular or almost singular (touchy) points. */

	      /* Loop for edges no 2 and 4*/
	      for (kj = 1; kj < 4; kj += 2)
		 /* Loop for all points on edge*/
		 for (qptedg = vedge[iobj - 1]->prpt[kj]; qptedg != SISL_NULL;
	       qptedg = qptedg->pnext)
		 {
		    pcurr = qptedg->ppt;

		    /* Test if the point is too close to an edge. */

		    if (pcurr->epar[kpar+1] < sstart[1]+tdel2 ||
			pcurr->epar[kpar+1] > send[1]-tdel2) continue;

		    /* Check if the intersection curve passing through
		       the point is always parallel to an iso-curve. */
		    
		    if (sh1762_is_taboo(qo1->s1,  
					(qo2->iobj == SISLSURFACE) ? 
					qo2->s1 : SISL_NULL, 
					pcurr, 2, &kstat))
		      continue;

		    if (kstat < 0)
		      goto error;

		    if (pcurr->iinter == SI_SING)
		    {
		       /* Test if the singular/near singular point is the one
			  closest to the middle point.  */

		       if (!ptsing2 || fabs(pcurr->epar[kpar+1]-tmean[1]) <
			   fabs(ptsing2->epar[kpar+1]-tmean[1]))
			  ptsing2 = pcurr;
		    }
		    else
		    {
		       /* Test if the intersection point is the one closest
			  to the middle. */

		       if (!pt2 || fabs(pcurr->epar[kpar+1]-tmean[1]) <
			   fabs(pt2->epar[kpar+1]-tmean[1]))
			  pt2 = pcurr;
		    }
		 }
	   }

	   if (qo1->s1->idim == 1)
	   {
	      /* One-dimensional case. Iterate to find an extremal point. */

	      if (!(*fixflag == 1) && ptsing1)
	      {
		 /* Set startpoint to iteration. */

		 spar[0] = ptsing1->epar[kpar];
		 spar[1] = ptsing1->epar[kpar+1];
	      }
	      else if (!(*fixflag == 2) && ptsing2)
	      {
		 spar[0] = ptsing2->epar[kpar];
		 spar[1] = ptsing2->epar[kpar+1];
	      }
	      else
	      {
		 /* No (almost) singular intersection point is found
		    at the edge. */

		 spar[0] = (double)0.5*(sstart[0] + send[0]);
		 spar[1] = (double)0.5*(sstart[1] + send[1]);
	      }

	      /* Perform iteration. */

	      kfound = 0;
	      s1174 (qo1->o1->s1, sstart, send, spar, spar, &kstat);
	      if (kstat < 0)
		goto error;
	      if (kstat == 1)
		{
		   /* An extremal point is found. Test if it is too close
		      to an edge. */

		   kfound = 3;
		   if (spar[0] < sstart[0]+tdel1 || spar[0] > send[0]-tdel1)
		      kfound--;
		   if (spar[1] < sstart[1]+tdel2 || spar[1] > send[1]-tdel2)
		      kfound -= 2;
		}

	      if (*fixflag == 0 && ptsing2 && ptsing1)
	      {
		 /* Try a second iteration for an extremal point
		    in order to find a subdivision parameter in the
		    second parameter direction.  */

		 spar2[0] = ptsing2->epar[kpar];
		 spar2[1] = ptsing2->epar[kpar+1];

		 s1174(qo1->o1->s1, sstart, send, spar2, spar2, &kstat);
		 if (kstat < 0)
		    goto error;
		 if (kstat == 1)
		 {
		    /* An extremal point is found. Test it against the edges. */

		    if (!(spar2[1] < sstart[1]+tdel2 || spar2[1] > send[1]-tdel2))
		    {
		       spar[1] = spar2[1];
		       if (kfound < 2) kfound += 2;
		    }
		 }
	      }

	      /* Set intermediate subdivision point. */

	      if (*fixflag == 1)
		 spar[0] = sparsave[0];
	      else if (kfound == 1 || kfound == 3)
		 (*fixflag)++;
	      else if (ptsing1)
	      {
		 spar[0] = ptsing1->epar[kpar];
		 (*fixflag)++;
	      }
	      else if (pt1)
	      {
		 spar[0] = pt1->epar[kpar];
		 (*fixflag)++;
	      }
	      else
		 spar[0] = tmean[0];

	      if (*fixflag == 2)
		 spar[1] = sparsave[1];
	      else if (kfound == 2 || kfound == 3)
		 (*fixflag) += 2;
	      else if (ptsing2)
	      {
		 spar[1] = ptsing2->epar[kpar+1];
		 (*fixflag) += 2;
	      }
	      else if (pt2)
	      {
		 spar[1] = pt2->epar[kpar+1];
		 (*fixflag) += 2;
	      }
	      else
		 spar[1] = tmean[1];
	   }
	   else
	   {
	      /* Surface-surface intersection. Set intermediate
		 subdivision point. */

	      if (*fixflag == 1)
		 spar[0] = sparsave[0];
	      else if (ptsing1 && pt1)
	      {
		 if (fabs(ptsing1->epar[kpar]-tmean[0]) <=
		     fabs(pt1->epar[kpar]-tmean[0]))
		    spar[0] = ptsing1->epar[kpar];
		 else
		    spar[0] = pt1->epar[kpar];
		 (*fixflag)++;
	      }
	      else if (ptsing1)
	      {
		 spar[0] = ptsing1->epar[kpar];
		 (*fixflag)++;
	      }
	      else if (pt1)
	      {
		 spar[0] = pt1->epar[kpar];
		 (*fixflag)++;
	      }
	      else spar[0] = tmean[0];

	      if (*fixflag == 2)
		 spar[1] = sparsave[1];
	      else if (ptsing2 && pt2)
	      {
		 if (fabs(ptsing2->epar[kpar+1]-tmean[1]) <=
		     fabs(pt2->epar[kpar+1]-tmean[1]))
		    spar[1] = ptsing2->epar[kpar+1];
		 else
		    spar[1] = pt2->epar[kpar+1];
		 (*fixflag) += 2;
	      }
	      else if (ptsing2)
	      {
		 spar[1] = ptsing2->epar[kpar+1];
		 (*fixflag) += 2;
	      }
	      else if (pt2)
	      {
		 spar[1] = pt2->epar[kpar+1];
		 (*fixflag) += 2;
	      }
	      else spar[1] = tmean[1];

	   }
	}

	/* Test if the found subdivision value lies very close to an
	   existing intersection point. In that case move the subdivision
	   point to the intersection point. The two parameter directions
	   are treated separately.  */

	if ((*pintdat) && (*pintdat)->ipoint > 0)
	   for (kj=0; kj<(*pintdat)->ipoint; kj++)
	   {
	      pcurr = (*pintdat)->vpoint[kj];

	      if ((*fixflag)==1 || (*fixflag)==3)
	      {
		 if (fabs(spar[0]-pcurr->epar[kpar]) < (double)0.001*tdel1)
		 {
		    if (fabs(spar[0]-pcurr->epar[kpar]) < fabs(tpar1-spar[0]) &&
			ktype1 <= pcurr->iinter)
		    {
		       tpar1 = pcurr->epar[kpar];
		       ktype1 = pcurr->iinter;
		    }
		 }
	      }
	      else
	      {
		 if (fabs(spar[0]-pcurr->epar[kpar]) < (double)0.1*tdel1 &&
		     pcurr->epar[kpar] >= sstart[0]+tdel1 &&
		     pcurr->epar[kpar] <= send[0]-tdel1)
		 {
		    if (fabs(spar[0]-pcurr->epar[kpar]) < fabs(tpar1-spar[0]) &&
			ktype1 <= pcurr->iinter)
		    {
		       tpar1 = pcurr->epar[kpar];
		       ktype1 = pcurr->iinter;
		    }
		 }
	      }

	      if ((*fixflag)==2 || (*fixflag)==3)
	      {
		 if (fabs(spar[1]-pcurr->epar[kpar+1]) < (double)0.001*tdel2)
		 {
		    if (fabs(spar[1]-pcurr->epar[kpar+1]) < fabs(tpar2-spar[1]) &&
			ktype2 <= pcurr->iinter)
		    {
		       tpar2 = pcurr->epar[kpar+1];
		       ktype2 = pcurr->iinter;
		    }
		 }
	      }
	      else
	      {
		 if (fabs(spar[1]-pcurr->epar[kpar+1]) < (double)0.1*tdel2 &&
		     pcurr->epar[kpar+1] >= sstart[1]+tdel2 &&
		     pcurr->epar[kpar+1] <= send[1]-tdel2)
		 {
		    if (fabs(spar[1]-pcurr->epar[kpar+1]) < fabs(tpar2-spar[1]) &&
			ktype2 <= pcurr->iinter)
		    {
		       tpar2 = pcurr->epar[kpar+1];
		       ktype2 = pcurr->iinter;
		    }
		 }
	      }
	   }

	if (ktype1 > -10 && tpar1 > sstart[0]+tdel1 && tpar1 < send[0]-tdel1)
	{
	   if (!((*fixflag == 1 || *fixflag == 3) && ktype1 < 0))
	      spar[0] = tpar1;
	}
	if (ktype2 > -10 && tpar2 > sstart[1]+tdel2 && tpar2 < send[1]-tdel2)
	{
	   if (!((*fixflag == 2 || *fixflag == 3) && ktype2 < 0))
	      spar[1] = tpar2;
	}
     }

      /* Set output variables.  */

     epar[0] = spar[0];
     epar[1] = spar[1];
     *rpt = qpt;
     *fixflag = ((*fixflag) >=2) ? 1 : 0;
  }
  else goto err122;  /* Unexpected kind of object. */

  goto out;

/* Error. Unexpected kind of object.  */

err122:*jstat = -122;
  s6err ("sh1762_s9subdivpt", *jstat, kpos);
  goto out;

/* Error in lower level routine.  */

error:*jstat = kstat;
  s6err ("sh1762_s9subdivpt", *jstat, kpos);
  goto out;

out:
   return;

}

//===========================================================================
void sh1762_s9div (SISLObject * po1, SISLObject * po2, double aepsge,
		   int iobj, int idiv, SISLObject * wob[], SISLEdge * vedge[],
		   SISLIntdat ** pintdat, int *jstat)
//===========================================================================

{
  int kpos = 0;			/* Position of error.      */
  int kstat = 0;		/* Local status variable.           */
  int ki, kn;			/* Counters.                        */
  int kpar;			/* First parameter direction corresponding the the object
			           that is to be subdivided.        */
  int knum;			/* Total number of points in the data structures of the
			           original problem, and the problem of reduced dimension. */
  double tdel;			/* Parameter used to measure closeness between an
			           intersection point and the subdivision point.    */
  double spar[2];		/* Parameter values of subdividing point. If a curve is to
			           be subdivided, only the first element is used.           */
  SISLCurve *qcrv = SISL_NULL;       /* Mother curve of subdivision curve.               */
  SISLObject *qso = SISL_NULL;	/* Subdivision object, it is a point if a curve is subdivided
			           and a curve if a surface is subdivided.          */
  SISLObject *qmotherobj = SISL_NULL; /* Mother object of subdivision object.            */
  SISLObject *qo1 = SISL_NULL;	/* Pointer to the object that is to be subdivided.  */
  SISLObject *qo2 = SISL_NULL;	/* Pointer to the other object.                     */
  SISLObject *qs1 = SISL_NULL, *qs2 = SISL_NULL;	/* Subobjects to be used in the case where a surface
				       is to be subdivided in both parameter direction to
				       store intermediate subsurfaces.               */
  SISLIntpt *qpt = SISL_NULL;	/* An eventual found inner intersection used as subdivision
			           point. If the subdivision point is found in another way,
			           qpt = SISL_NULL.                                      */
  SISLIntdat *qintdat = SISL_NULL;	/* Data structure of intersection problem with lower dim. */
  SISLIntpt *qp;		/* Closest intersection point to the subdiv point */
  SISLEdge *uedge[2];		/* Edge intersections of subproblem.                 */
  int fixflag = 0;		/* UJK 31.10.90 */
  int idummy;

  /* Fetch subdivision point of object.  */

  sh1762_s9subdivpt (po1, po2, aepsge, iobj, idiv, vedge, pintdat, &fixflag, &qpt, spar, &kstat);
  if (kstat < 0)
    goto error;

  qo1 = (iobj == 1 ? po1 : po2);
  qo2 = (iobj == 1 ? po2 : po1);
  kpar = (iobj == 1 ? 0 : po1->iobj);

  *jstat = 0;


  if (qo1->iobj == SISLCURVE)
    {
      /* Subdivide the curve at the found subdivision parameter value.  */

      /* printf("Subdivide curve. Parameter value = %10.6f \n",spar[0]); */

      s1231 (qo1->c1, spar[0], &(wob[0]->c1), &(wob[1]->c1), &kstat);
      if (kstat < 0)
	goto error;


      if (wob[0]->edg[1] == SISL_NULL)
	{
	  if ((qso = wob[0]->edg[1] = newObject (SISLPOINT)) == SISL_NULL)
	    goto err101;

	  /* Pick out end point from a curve. */

	  s1438 (wob[0]->c1, 1, &(qso->p1), &spar[0], &kstat);
	  if (kstat < 0)
	    goto error;
	}
      else
	qso = wob[0]->edg[1];

      if (po1->iobj + po2->iobj > SISLCURVE)
	{
	  /***** Treating edges on sub problems. *****/

	  /* We first have to transform intersection points to the the new
	     intersection format qintdat. */

	  /* UJK, newi */
	  sh6idget (po1, po2, kpar, spar[0], *pintdat, &qintdat, aepsge, &kstat);


	  /* Making new edge object to sub problems. */

	  if ((iobj == 1 ? qso : po1)->iobj == SISLPOINT)
	    uedge[0] = SISL_NULL;
	  else if ((uedge[0] = newEdge (vedge[0]->iedge - (iobj == 1 ? 2 : 0))) == SISL_NULL)
	    goto err101;
	  if ((iobj == 2 ? qso : po2)->iobj == SISLPOINT)
	    uedge[1] = SISL_NULL;
	  else if ((uedge[1] = newEdge (vedge[1]->iedge - (iobj == 2 ? 2 : 0))) == SISL_NULL)
	    goto err101;

	  /* Update edge intersection on sub problems. */

	  sh6idalledg ((iobj == 1 ? qso : po1), (iobj == 1 ? po2 : qso), qintdat, uedge, &kstat);
	  if (kstat < 0)
	    goto error;

	  /* Examine if the subdividing point intersect the second object. */

	  qso->o1 = qso;

	  sh1762 ((iobj == 1 ? qso : po1), (iobj == 1 ? po2 : qso), aepsge,
		  &qintdat, uedge, &kstat);
	  if (kstat < 0)
	    goto error;

	  if (uedge[0] != SISL_NULL)
	    freeEdge (uedge[0]);
	  if (uedge[1] != SISL_NULL)
	    freeEdge (uedge[1]);
	}
      else
	{
	  sh1761 ((iobj == 1 ? qso : po1), (iobj == 1 ? po2 : qso), aepsge,
		  &qintdat, &kstat);
	  if (kstat < 0)
	    goto error;
	}

      if (kstat)
	{
	  /* Total number of points. */

	  knum = (*pintdat == SISL_NULL ? 0 : (*pintdat)->ipoint) + qintdat->ipoint;

	  *jstat = 1;		/* Mark intersection found. */

	  /* Intersection found and we have to register the intersection
	     points. */

	  /* UJK newi */
	  sh1782 (po1, po2, aepsge, qintdat, kpar, spar[0], pintdat, &idummy, &kstat);
	  if (kstat < 0)
	    goto error;

	  /* UJK newi divide curve */
	  /* UPDATE: ? what about help points from s1782 knum?? */
	  if (qpt != SISL_NULL && (*pintdat)->ipoint == knum)
	    {
	      /* Find the closest poin to qpt. */

	      s6idcpt (*pintdat, qpt, &qp);

	      /* UJK newi, unite the points : */
	      sh6idnewunite (po1, po2, pintdat, &qpt, &qp, (double) 0.5,
			     aepsge, &kstat);
	      if (kstat < 0)
		goto error;
	    }
	}

      if (qintdat != SISL_NULL)
	{
	  freeIntdat (qintdat);
	  qintdat = SISL_NULL;
	}
    }
  else if (qo1->iobj == SISLSURFACE)
    {

      /* Subdivide surface and treat subdivision curves.  */

      for (ki = 0; ki < (idiv < 3 ? 1 : 3); ki++)
	{
	  if (idiv == 1)
	    {
	      /* printf("Subdivide surface. 1. par dir. par = %10.6f \n",spar[0]); */

	      s1711 (qo1->s1, 1, spar[0], &(wob[0]->s1), &(wob[1]->s1), &kstat);
	      if (kstat < 0)
		goto error;

	      if (wob[0]->edg[1] == SISL_NULL)
		{
		  if ((qso = wob[0]->edg[1] = newObject (SISLCURVE)) == SISL_NULL)
		    goto err101;

		  /* Pick out edge curve from a surface. */

		  s1435 (wob[0]->s1, 1, &(qso->c1), spar, &kstat);
		  if (kstat < 0)
		    goto error;
		}
	      else
		qso = wob[0]->edg[1];

	      /* Pick curve from mother object of surface, and make
		 motherobject of curve.                             */

	      s1437(qo1->o1->s1,spar[0],&qcrv,&kstat);
	      if (kstat < 0) goto error;

	      if ((qmotherobj = newObject(SISLCURVE)) == SISL_NULL) goto err101;
	      qmotherobj->c1 = qcrv;
	      qso->o1 = qmotherobj;
	    }
	  else if (idiv == 2)
	    {
	      /* printf("Subdivide surface. 2. par dir. par = %10.6f \n",spar[1]); */

	      s1711 (qo1->s1, 2, spar[1], &(wob[0]->s1), &(wob[1]->s1), &kstat);
	      if (kstat < 0)
		goto error;

	      if (wob[0]->edg[2] == SISL_NULL)
		{
		  if ((qso = wob[0]->edg[2] = newObject (SISLCURVE)) == SISL_NULL)
		    goto err101;

		  /* Pick out edge curve from a surface. */

		  s1435 (wob[0]->s1, 2, &(qso->c1), spar + 1, &kstat);
		  if (kstat < 0)
		    goto error;
		}
	      else
		qso = wob[0]->edg[2];

	      /* Pick curve from mother object of surface, and make
		 motherobject of curve.                             */

	      s1436(qo1->o1->s1,spar[1],&qcrv,&kstat);
	      if (kstat < 0) goto error;

	      if ((qmotherobj = newObject(SISLCURVE)) == SISL_NULL) goto err101;
	      qmotherobj->c1 = qcrv;
	      qso->o1 = qmotherobj;
	    }
	  else if (ki == 0)
	    {
	      if ((qs1 = newObject (SISLSURFACE)) == SISL_NULL)
		goto err101;
	      if ((qs2 = newObject (SISLSURFACE)) == SISL_NULL)
		goto err101;

	      /* printf("Subdivide surface. 1. par dir. par = %10.6f \n",spar[0]); */

	      s1711 (qo1->s1, 1, spar[0], &(qs1->s1), &(qs2->s1), &kstat);
	      if (kstat < 0)
		goto error;

	      if (qs1->edg[1] == SISL_NULL)
		{
		  if ((qso = qs1->edg[1] = newObject (SISLCURVE)) == SISL_NULL)
		    goto err101;

		  /* Pick out edge curve from a surface. */

		  s1435 (qs1->s1, 1, &(qso->c1), spar, &kstat);
		  if (kstat < 0)
		    goto error;
		}
	      else
		qso = qs1->edg[1];

	      /* Pick curve from mother object of surface, and make
		 motherobject of curve.                             */

	      s1437(qo1->o1->s1,spar[0],&qcrv,&kstat);
	      if (kstat < 0) goto error;

	      if ((qmotherobj = newObject(SISLCURVE)) == SISL_NULL) goto err101;
	      qmotherobj->c1 = qcrv;
	      qso->o1 = qmotherobj;
	    }
	  else if (ki == 1)
	    {
	      /* printf("Subdivide surface. 2. par dir. par = %10.6f \n",spar[1]); */

	      s1711 (qs1->s1, 2, spar[1], &(wob[0]->s1), &(wob[1]->s1), &kstat);
	      if (kstat < 0)
		goto error;

	      if (wob[0]->edg[2] == SISL_NULL)
		{
		  if ((qso = wob[0]->edg[2] = newObject (SISLCURVE)) == SISL_NULL)
		    goto err101;

		  /* Pick out edge curve from a surface. */

		  s1435 (wob[0]->s1, 2, &(qso->c1), spar + 1, &kstat);
		  if (kstat < 0)
		    goto error;
		}
	      else
		qso = wob[0]->edg[2];

	      /* Pick curve from mother object of surface, and make
		 motherobject of curve.                             */

	      s1436(qo1->o1->s1,spar[1],&qcrv,&kstat);
	      if (kstat < 0) goto error;

	      if ((qmotherobj = newObject(SISLCURVE)) == SISL_NULL) goto err101;
	      qmotherobj->c1 = qcrv;
	      qso->o1 = qmotherobj;
	    }
	  else
	    /* if (ki == 2) */
	    {
	      /* printf("Subdivide surface. 2. par dir. par = %10.6f \n",spar[1]); */

	      s1711 (qs2->s1, 2, spar[1], &(wob[2]->s1), &(wob[3]->s1), &kstat);
	      if (kstat < 0)
		goto error;

	      if (wob[2]->edg[2] == SISL_NULL)
		{
		  if ((qso = wob[2]->edg[2] = newObject (SISLCURVE)) == SISL_NULL)
		    goto err101;

		  /* Pick out edge curve from a surface. */

		  s1435 (wob[2]->s1, 2, &(qso->c1), spar + 1, &kstat);
		  if (kstat < 0)
		    goto error;
		}
	      else
		qso = wob[2]->edg[2];

	      /* Pick curve from mother object of surface, and make
		 motherobject of curve.                             */

	      s1436(qo1->o1->s1,spar[1],&qcrv,&kstat);
	      if (kstat < 0) goto error;

	      if ((qmotherobj = newObject(SISLCURVE)) == SISL_NULL) goto err101;
	      qmotherobj->c1 = qcrv;
	      qso->o1 = qmotherobj;
	    }

	  /***** Treating edges on sub problems. *****/

	  /* We first have to transform intersection points to the the new
	     intersection format qintdat. */

	  /* UJK, newi */
	  sh6idget ((iobj == 1 ? (ki == 0 ? po1 : (ki == 1 ? qs1 : qs2)) : po1),
		(iobj == 2 ? (ki == 0 ? po2 : (ki == 1 ? qs1 : qs2)) : po2),
		(ki == 0   ? (idiv == 2 ? 1 : 0) : 1) + kpar,
		(ki == 0   ? (idiv == 2 ? spar[1] : spar[0]) : spar[1]),
		    *pintdat, &qintdat, aepsge, &kstat);

	  /* Making new edge object to sub problems. */

	  if ((iobj == 1 ? qso : po1)->iobj == SISLPOINT)
	    uedge[0] = SISL_NULL;
	  else if ((uedge[0] = newEdge (vedge[0]->iedge - (iobj == 1 ? 2 : 0))) == SISL_NULL)
	    goto err101;
	  if ((iobj == 2 ? qso : po2)->iobj == SISLPOINT)
	    uedge[1] = SISL_NULL;
	  else if ((uedge[1] = newEdge (vedge[1]->iedge - (iobj == 2 ? 2 : 0))) == SISL_NULL)
	    goto err101;

	  /* Update edge intersection on sub problems. */

	  sh6idalledg ((iobj == 1 ? qso : po1), (iobj == 1 ? po2 : qso), qintdat, uedge, &kstat);
	  if (kstat < 0)
	    goto error;

	  /* START of update, UJK,jan.93.__________________________ */
	  /* UJK, jan 1993, 1D: test if end pt of curve is intersection pt
	     and not registred on edge.
	     This will very seldom ocurr, boarder line case. */
	  if (qso->c1->idim == 1)
	  {
	     int changes = FALSE;
	     int loop;
	     double endpar;
	     double qt_par[2];
	     SISLPoint  *end_point=SISL_NULL;
	     SISLObject *pt_obj=SISL_NULL;
	     SISLCurve  *pcrv=SISL_NULL;
	     int knum;
	     int ind_missing, ind_kept;
	     SISLIntpt *qt  = SISL_NULL;
	     SISLIntpt *pcl = SISL_NULL;
	     SISLIntpt **up = SISL_NULL;	 /* Array of poiners to intersection point. */

	     /* Get edge points to SUB-problem. */
	     sh6edgpoint (uedge, &up, &knum, &kstat);
	     if (kstat < 0)
		goto error;

	     /* Set up case navigators. */
	     pcrv   = qso->c1;
	     pt_obj = (iobj == 1 ? po2 :po1);
	     ind_missing = (ki == 0 ? (idiv == 2 ? 1 : 0) : 1);
	     ind_kept    = (ki == 0 ? (idiv == 2 ? 0 : 1) : 0);

	     if (knum < 2)
		for (loop = 0; loop < 2; loop++)
		{

		   /* Pick out end point from a curve. */
		   s1438 (pcrv, loop, &end_point, &endpar, &kstat);
		   if (kstat < 0)
		      goto error;
		   if (fabs(end_point->ecoef[0] - pt_obj->p1->ecoef[0]) < aepsge &&
		       (knum == 0 || DNEQUAL(up[0]->epar[0], endpar)))
		   {
		      /* Making intersection point. */
		      double *nullp = SISL_NULL;

		      changes = TRUE;
		      qt_par[ind_kept]    = endpar;
		      qt_par[ind_missing] = spar[ind_missing];
		      qt = hp_newIntpt (2, qt_par, DZERO, SI_ORD,
					SI_UNDEF, SI_UNDEF, SI_UNDEF, SI_UNDEF,
					0, 0, nullp, nullp);

		      if (qt == SISL_NULL)
			 goto err101;

		      sh6tohelp (qt,&kstat);
		      if (kstat < 0) goto error;

		      /* get closest point pcl to qt in pintdat. */
		      sh6idnpt(pintdat,&qt,TRUE,&kstat);
		      if (kstat < 0) goto error;
		      kpos=1;
		      if (kstat) goto errinconsis;

		      kpos=2;
		      s6idcpt(*pintdat,qt,&pcl);
		      if (!pcl) goto errinconsis;

		      if (DEQUAL(pcl->epar[ind_kept],qt_par[ind_kept]) &&
			  fabs(pcl->epar[ind_missing] - qt_par[ind_missing])
			  < 0.000001)
		      {
			 qt->epar[ind_missing] = pcl->epar[ind_missing];
			 pcl->epar[ind_missing] = qt_par[ind_missing];
			 sh6tomain (pcl,&kstat);
			 if (kstat < 0) goto error;
			 sh6idcon (pintdat,&qt,&pcl,&kstat);
			 if (kstat < 0) goto error;
		      }
		   }
		   if (end_point)
		      freePoint(end_point);
		   end_point = SISL_NULL;

		}

	     if (changes)
	     {
		/* Clean up and regenerate uedge and qintdat. */
		if (uedge[0] != SISL_NULL)
		   freeEdge (uedge[0]);
		if (uedge[1] != SISL_NULL)
		   freeEdge (uedge[1]);

		if (qintdat != SISL_NULL)
		{
		   freeIntdat (qintdat);
		   qintdat = SISL_NULL;
		}

		sh6idget ((iobj == 1 ? (ki == 0 ? po1 : (ki == 1 ? qs1 : qs2)) : po1),
			  (iobj == 2 ? (ki == 0 ? po2 : (ki == 1 ? qs1 : qs2)) : po2),
			  (ki == 0   ? (idiv == 2 ? 1 : 0) : 1) + kpar,
			  (ki == 0   ? (idiv == 2 ? spar[1] : spar[0]) : spar[1]),
			  *pintdat, &qintdat, aepsge, &kstat);

		/* Making new edge object to sub problems. */

		if ((iobj == 1 ? qso : po1)->iobj == SISLPOINT)
		   uedge[0] = SISL_NULL;
		else if ((uedge[0] = newEdge (vedge[0]->iedge - (iobj == 1 ? 2 : 0))) == SISL_NULL)
		   goto err101;
		if ((iobj == 2 ? qso : po2)->iobj == SISLPOINT)
		   uedge[1] = SISL_NULL;
		else if ((uedge[1] = newEdge (vedge[1]->iedge - (iobj == 2 ? 2 : 0))) == SISL_NULL)
		   goto err101;

		/* Update edge intersection on sub problems. */

		sh6idalledg ((iobj == 1 ? qso : po1), (iobj == 1 ? po2 : qso), qintdat, uedge, &kstat);
		if (kstat < 0)
		   goto error;


	     }
	     if (up) freearray(up);
	  }
	  /* END of update, UJK,jan.93.__________________________ */


	  /* Examine if the subdividing curve intersect the second object. */

	  sh1762 ((iobj == 1 ? qso : po1), (iobj == 1 ? po2 : qso), aepsge,
		  &qintdat, uedge, &kstat);
	  if (kstat < 0)
	    goto error;

	  if (uedge[0] != SISL_NULL)
	    freeEdge (uedge[0]);
	  if (uedge[1] != SISL_NULL)
	    freeEdge (uedge[1]);


	  /* Free mother object of the subdividing curve.  */

	  if (qmotherobj != SISL_NULL) freeObject(qmotherobj);
	  qmotherobj = SISL_NULL;
	  qcrv = SISL_NULL;
	  qso->o1 = qso;

	  /* Examine if there is an intersection point close to the
	     subdivision point. If there is, correct the subdivision point. */

	  /* ALA and UJK 31.10.90 don't change divide point
	     when fixflag is set */
	  if ((fixflag == 0) && idiv == 3 && ki == 0 && qintdat != SISL_NULL)
	    /*  if (idiv == 3 && ki == 0 && qintdat != SISL_NULL) */
	    {
	      tdel = (qso->c1->et[qso->c1->in] -
		      qso->c1->et[qso->c1->ik - 1]) * (double) 0.1;

	      for (kn = 0; kn < qintdat->ipoint; kn++)
		/* UJK, aug.92 Do NOT subdiv in a help point */
		if (sh6ismain(qintdat->vpoint[kn]))
		  if ((fabs (qintdat->vpoint[kn]->epar[kpar]
			     - spar[1]) < fabs (tdel)) &&
		      DNEQUAL (qintdat->vpoint[kn]->epar[kpar],
			       qso->c1->et[qso->c1->in]) &&
		      DNEQUAL (qintdat->vpoint[kn]->epar[kpar],
			       qso->c1->et[qso->c1->ik - 1]))
		    spar[1] = qintdat->vpoint[kn]->epar[kpar];
	    }

	  /*ujk, ala 921218, dont't split very close to a
	     new intersection point */
	  else if ((fixflag) && idiv == 3 && ki == 0 && qintdat != SISL_NULL)
	  {
	     tdel = (qso->c1->et[qso->c1->in] -
		     qso->c1->et[qso->c1->ik - 1]) * (double) 0.000001;

	     for (kn = 0; kn < qintdat->ipoint; kn++)
		if (DNEQUAL(qintdat->vpoint[kn]->epar[kpar],spar[1])
		    && (fabs (qintdat->vpoint[kn]->epar[kpar]
			      - spar[1]) < fabs (tdel))) break;

	     if (kn <  qintdat->ipoint)
		/* Using midpoint */
	     {
		spar[1] = s1792 (qo1->s1->et2, qo1->s1->ik2, qo1->s1->in2);
		fixflag = 0;
	     }
	  }

	  /* TDO,UJK 02.08.89 */
	  /* A possible better strategy for
	     subdividing is to divide in the
	     middle value of the first and last
	     intersection on the subdividing curve.*/
/*
	  if (idiv == 3 && ki == 0 && qintdat != SISL_NULL)
	    {
	      int kn;
	      double tdel,tdiv,tmin,tmax;

	      if(qintdat->ipoint > 0)
	      {
		  tmin = qintdat->vpoint[0]->epar[kpar];
		  tmax = qintdat->vpoint[0]->epar[kpar];

		  for (kn=1;kn<qintdat->ipoint;kn++)
		    {
		      if (tmin < qintdat->vpoint[kn]->epar[kpar])
			tmin = qintdat->vpoint[kn]->epar[kpar];

		      if (tmax > qintdat->vpoint[kn]->epar[kpar])
			tmax = qintdat->vpoint[kn]->epar[kpar];

		    }

		  tdiv = (tmax + tmin)/(double)2.0;

		  if (DNEQUAL(tdiv,qso->c1->et[qso->c1->in]) &&
		      DNEQUAL(tdiv,qso->c1->et[qso->c1->ik-1]))
		    spar[1]=tdiv;

		}
	    }
*/


	  if (kstat)
	    {
	      /* Total number of points. */

	      knum = (*pintdat == SISL_NULL ? 0 : (*pintdat)->ipoint) +
		qintdat->ipoint;

	      *jstat = 1;	/* Mark intersection found. */

	      /* Intersection found and we have to register the intersection
		 points. */

	      /* UJK newi */
	      sh1782 (po1, po2, aepsge, qintdat,
		      (ki == 0 ? (idiv == 2 ? 1 : 0) : 1) + kpar,
		      (ki == 0 ? (idiv == 2 ? spar[1] : spar[0]) : spar[1]),
		      pintdat, &idummy, &kstat);
	      if (kstat < 0)
		goto error;

	      /* UJK newi divide surface */
	      /* UPDATE: ? what about help points from s1782 knum?? */
	      if (qpt != SISL_NULL && (*pintdat)->ipoint == knum)
		{
		  /* Find the closest poin to qpt. */

		  s6idcpt (*pintdat, qpt, &qp);

		  /* UJK newi, unite the points : */
		  sh6idnewunite (po1, po2, pintdat, &qpt, &qp, (double) 0.5,
				 aepsge, &kstat);
		  if (kstat < 0)
		    goto error;
		}

	    }

	  if (qintdat != SISL_NULL)
	    {
	      freeIntdat (qintdat);
	      qintdat = SISL_NULL;
	    }
	}
      if (qs1 != SISL_NULL)
	freeObject (qs1);
      if (qs2 != SISL_NULL)
	freeObject (qs2);
    }
  else
    goto err121;


  goto out;

/* Error. Inconsistency.  */

errinconsis:*jstat = -231;
  s6err ("sh1762_s9div", *jstat, kpos);
  goto out;

/* Error. Kind of object does not exist.  */

err121:*jstat = -121;
  s6err ("sh1762_s9div", *jstat, kpos);
  goto out;

/* Error in space allocation.  */

err101:*jstat = -101;
  s6err ("sh1762_s9div", *jstat, kpos);
  goto out;

/* Error in lower level routine.  */

error:*jstat = kstat;
  s6err ("sh1762_s9div", *jstat, kpos);
  goto out;

out:;
}

//===========================================================================
void sh1762_s9update (SISLObject * po1, SISLObject * po2, double aepsge,
		      SISLIntdat ** pintdat, SISLEdge ** vedge[], int *jstat)
//===========================================================================
{
  /* UJK newi */
  int ki, no_new;
  SISLIntpt *qt = SISL_NULL;

  int kpos = 0;
  int kstat = 0;
  int kdim;
  SISLObject *qo;
  SISLIntpt **up = SISL_NULL;

  /* Test input.  */

  kdim = (po1->iobj == SISLPOINT ? po1->p1->idim :
	  (po1->iobj == SISLCURVE ? po1->c1->idim : po1->s1->idim));

  if (kdim != (po2->iobj == SISLPOINT ? po2->p1->idim :
	       (po2->iobj == SISLCURVE ? po2->c1->idim : po2->s1->idim)))
    goto err106;

  /* Initiate to no intersection. */

  *jstat = 2;

  if (po1->iobj == SISLPOINT || po2->iobj == SISLPOINT)
    {
      int kturn = 0;
      int knum = 0;

      if (po1->iobj != SISLPOINT)
	{
	  qo = po1;
	  po1 = po2;
	  po2 = qo;
	  kturn = 1;
	}

      knum = (*vedge)[1 - kturn]->ipoint;


      /* UPDATE ALA 010993. Start */
      if (knum == 0 && (*pintdat) != SISL_NULL)
      {
	for (ki = 0; ki < (*pintdat)->ipoint; ki++)
	  if (po2->iobj == SISLCURVE)
	  {
	    if ((*pintdat)->vpoint[ki]->epar[0] > po2->c1->et[po2->c1->ik-1] &&
		(*pintdat)->vpoint[ki]->epar[0] < po2->c1->et[po2->c1->in])
	    {
	      knum = 1;
	    }
	  }
	  else
	  {
	    if ((*pintdat)->vpoint[ki]->epar[0] > po2->s1->et1[po2->s1->ik1-1] &&
		(*pintdat)->vpoint[ki]->epar[0] < po2->s1->et1[po2->s1->in1]   &&
		(*pintdat)->vpoint[ki]->epar[1] > po2->s1->et2[po2->s1->ik2-1] &&
		(*pintdat)->vpoint[ki]->epar[1] < po2->s1->et2[po2->s1->in2])
	    {
	      knum = 1;
	    }
	  }
      }
      /* UPDATE ALA 010993.  End */


      if (knum > 1)
	{
	  /* sh1762_s9edgpoint ((*vedge), &up, &knum, &kstat); */
	  sh6edgpoint ((*vedge), &up, &knum, &kstat);
	  if (kstat < 0)
	    goto error;
	}


      /* We have more than one intersection point on the edges.
	 If the dimension is one and the second object is a point
	 we just connect the point else we kill these points and
	 try to find a new intersection point. */

      if (knum > 1)
	{
	  if (po2->iobj == SISLSURFACE && kdim == 1)
	    {
	      int ksimple;
	      if (po2->o1 == po2)
		ksimple = 0;
	      else
		ksimple = 1;

	      /* UPDATE: UJK, new parameter turn ?? */
	      sh1762_s9edgpscon ((*vedge)[1 - kturn], po1->p1->ecoef[0],
				 po2->s1, ksimple, *pintdat, aepsge, &kstat);
	      if (kstat < 0)
		goto error;
	      else if (kstat)
		*jstat = 0;	/* Not a simple case. */
	    }

	    else  if (po2->iobj == SISLSURFACE && kdim == 2 && knum == 2)
	       {
		  /* 2D point surf, connect */
		  sh6idcon (pintdat, up, up + 1, &kstat);
		  if (kstat < 0)
		     goto error;
	        }

	    else
	    {
	      /* UJK newi */
	      for (ki = 1; ki < knum; ki++)
		{
		   sh6idnewunite (po1, po2, pintdat, &up[0], &up[ki],
				(double) 0.5, aepsge, &kstat);
		  if (kstat < 0)
		    goto error;

		}
	      qt = up[0];

	      ki = (*vedge)[1 - kturn]->iedge;
	      freeEdge ((*vedge)[1 - kturn]);
	      if (((*vedge)[1 - kturn] = newEdge (ki)) == SISL_NULL)
		goto err101;
	      knum = 0;
	    }
	}

      if (knum == 0)
	{
	  double spar[2];

	  if (po2->iobj == SISLCURVE)
	    {
	      double tstart, tend;

	      tstart = po2->c1->et[po2->c1->ik - 1];
	      tend = po2->c1->et[po2->c1->in];
	      spar[0] = (tstart + tend) * (double) 0.5;


	      s1771 (po1->p1, po2->o1->c1, aepsge,
		     tstart, tend, spar[0], spar, &kstat);
	      if (kstat < 0)
		goto error;

	      if (kstat == 1)
		/*Intersection point found. Control edges. */
		if (DEQUAL (spar[0], tstart) || DEQUAL (spar[0], tend))
		  kstat = 0;
	    }
	  else if (po2->iobj == SISLSURFACE)
	    {
	      double sstart[2], send[2];

	      sstart[0] = po2->s1->et1[po2->s1->ik1 - 1];
	      sstart[1] = po2->s1->et2[po2->s1->ik2 - 1];

	      send[0] = po2->s1->et1[po2->s1->in1];
	      send[1] = po2->s1->et2[po2->s1->in2];

	      spar[0] = (sstart[0] + send[0]) * (double) 0.5;
	      spar[1] = (sstart[1] + send[1]) * (double) 0.5;

	      s1773 (po1->p1, po2->o1->s1, aepsge, sstart, send, spar, spar, &kstat);
	      if (kstat < 0)
		goto error;

	      if (kstat == 1)
		/*Intersection point found. Control edges. */
		if (DEQUAL (spar[0], sstart[0]) || DEQUAL (spar[0], send[0])
		|| DEQUAL (spar[1], sstart[1]) || DEQUAL (spar[1], send[1]))
		  kstat = 0;
	    }



	  /* UJK, October 91, 2D crv and surf's may be degenerate,
	     continue when iteration fails */
	  if (po1->p1->idim == 2)
	  {
	     if ((po2->iobj == SISLSURFACE && kstat == 9)||
		 (po2->iobj == SISLCURVE   && kstat != 1))
	     {
		*jstat = 0;
		goto out;
	     }
	  }


	  /* TESTING UJK !!!!!!!!!!!!!!!!!!!!! */
	    /* UJK, August 92, 1D crvs may be "degenerate",
	       continue when iteration fails */
	    if (kstat != 1 && po1->p1->idim == 1)
	    {
	       *jstat = 0;
	       goto out;
	    }


	    if (kstat == 1)	/* Intersection point found. */
	    {
	      *jstat = 1;	/* Mark intersection found.  */

	      /* UJK newi */
	      if (qt)
		{
		  /* We have an instance of a point, use it */
		  for (ki = 0; ki < qt->ipar; ki++)
		    qt->epar[ki] = spar[ki];
		}
	      else
		{
		  /* Making intersection point. */
		  double *nullp = SISL_NULL;
		  qt = hp_newIntpt (po2->iobj, spar, DZERO, SI_ORD,
				    SI_UNDEF, SI_UNDEF, SI_UNDEF, SI_UNDEF,
				    0, 0, nullp, nullp);

		  if (qt == SISL_NULL)
		    goto err101;

		  /* Uppdating pintdat. */
		  sh6idnpt (pintdat, &qt, 1, &kstat);
		  if (kstat < 0)
		    goto error;

		  /* Set pretopology */
		  if (po2->iobj == SISLCURVE)
		    {
		      /* Case point, curve */
		      if (po1->p1->idim == 1)
			{
			  /* 1D point curve treated,
			     2D, 3D is set to undef */

			  sh1781 ((kturn ? po2 : po1),
				  (kturn ? po1 : po2),
				  aepsge, pintdat, qt, &no_new, &kstat);
			  if (kstat < 0)
			    goto error;
			}
		      else
			{
			  /* UPDATE (ujk) 1D touch well defined ? */
			  /* Case point, surface */
			  if (po1->p1->idim == 2)
			    {
			      /* 2D point surface is treated,
			         1D, 3D is set to undef */
			      sh1786 ((kturn ? po2 : po1),
				      (kturn ? po1 : po2),
				      aepsge, pintdat, qt, &no_new, &kstat);

			      if (kstat < 0)
				goto error;
			    }
			}

		    }
		}
	    }
	}
    }
  else if (po1->iobj == SISLCURVE || po2->iobj == SISLCURVE)
    {
      int kturn1 = 1, kturn2 = 0;

      if (po1->iobj != SISLCURVE)
	{
	  qo = po1;
	  po1 = po2;
	  po2 = qo;
	  kturn1 = 0;
	  kturn2 = 2;
	}

      if ((*vedge)[0]->ipoint + (*vedge)[1]->ipoint > 1)
	{
	  int knum;

	  /* sh1762_s9edgpoint ((*vedge), &up, &knum, &kstat); */
	  sh6edgpoint ((*vedge), &up, &knum, &kstat);
	  if (kstat < 0)
	    goto error;

	  if (knum > 1)
	    {
	      int ki;

	      /* We have more than one intersection point on the edges.
	         We therefor kill these points and
	         try to find a new intersection point. */

	      /* UJK newi CONNECT */
	      for (ki = 1; ki < knum; ki++)
		{
		   /* sh6idnewunite (po1, po2, pintdat, &up[0], &up[ki],
		      (double) 0.5, aepsge, &kstat); */
		   sh6idcon(pintdat, &up[0], &up[ki], &kstat);
		  if (kstat < 0)
		    goto error;

		}

	      *jstat = 1;
	      goto out;

	      /* qt = up[0];

		 ki = (*vedge)[0]->iedge;
		 freeEdge ((*vedge)[0]);
		 if (((*vedge)[0] = newEdge (ki)) == SISL_NULL)
		 goto err101;
		 ki = (*vedge)[1]->iedge;
		 freeEdge ((*vedge)[1]);
		 if (((*vedge)[1] = newEdge (ki)) == SISL_NULL)
		 goto err101;
		 knum = 0; */
	    }
	}

      if ((*vedge)[0]->ipoint + (*vedge)[1]->ipoint == 0)
	{
	  double spar[3];

          /* UPDATE ALA 010993. Start */
          if ((*pintdat) != SISL_NULL)
          {
	  for (ki = 0; ki < (*pintdat)->ipoint; ki++)
	     if (po2->iobj == SISLCURVE)
	     {
	       if ((*pintdat)->vpoint[ki]->epar[0] > po1->c1->et[po1->c1->ik-1] &&
		   (*pintdat)->vpoint[ki]->epar[0] < po1->c1->et[po1->c1->in] &&
	           (*pintdat)->vpoint[ki]->epar[1] > po2->c1->et[po2->c1->ik-1] &&
		   (*pintdat)->vpoint[ki]->epar[1] < po2->c1->et[po2->c1->in])
	         goto out;
	     }
	     else
	     {
	       if ((*pintdat)->vpoint[ki]->epar[kturn2] > po1->c1->et[po1->c1->ik-1] &&
		   (*pintdat)->vpoint[ki]->epar[kturn2] < po1->c1->et[po1->c1->in] &&
	           (*pintdat)->vpoint[ki]->epar[kturn1] > po2->s1->et1[po2->s1->ik1-1] &&
		   (*pintdat)->vpoint[ki]->epar[kturn1] < po2->s1->et1[po2->s1->in1]   &&
		   (*pintdat)->vpoint[ki]->epar[kturn1+1] > po2->s1->et2[po2->s1->ik2-1] &&
		   (*pintdat)->vpoint[ki]->epar[kturn1+1] < po2->s1->et2[po2->s1->in2])
	         goto out;
	     }
         }
         /* UPDATE ALA 010993.  End */

	 if (po2->iobj == SISLCURVE)
	    {
	      double tstart1, tend1;
	      double tstart2, tend2;

	      tstart1 = po1->c1->et[po1->c1->ik - 1];
	      tend1 = po1->c1->et[po1->c1->in];
	      spar[0] = (tstart1 + tend1) * (double) 0.5;

	      tstart2 = po2->c1->et[po2->c1->ik - 1];
	      tend2 = po2->c1->et[po2->c1->in];
	      spar[1] = (tstart2 + tend2) * (double) 0.5;


	      s1770 (po1->o1->c1, po2->o1->c1, aepsge, tstart1,
		     tstart2, tend1, tend2, spar[0], spar[1], spar, spar + 1, &kstat);
	      if (kstat < 0)
		goto error;

	      if (kstat == 2)
		{
		  /* Search for a better start point for the
		     iteration. */
		  sh6cvvert(po1->c1, po2->c1, spar, spar+1);

		  /* Iterate. */
		  kstat = 0;
		  s1770 (po1->o1->c1, po2->o1->c1, aepsge, tstart1,
			 tstart2, tend1, tend2, spar[0], spar[1],  
			 spar, spar + 1, &kstat);
		  if (kstat < 0)
		    { kpos=__LINE__; goto error; }
		}

	      if (kstat == 1)
		/*Intersection point found. Control edges. */
		if (DEQUAL (spar[0], tstart1) || DEQUAL (spar[0], tend1)
		    || DEQUAL (spar[1], tstart2) || DEQUAL (spar[1], tend2))
		  kstat = 0;
	    }
	  else if (po2->iobj == SISLSURFACE)
	    {
	      double tstart, tend;
	      double sstart[2], send[2];

	      tstart = po1->c1->et[po1->c1->ik - 1];
	      tend = po1->c1->et[po1->c1->in];
	      spar[kturn2] = (tstart + tend) * (double) 0.5;


	      sstart[0] = po2->s1->et1[po2->s1->ik1 - 1];
	      sstart[1] = po2->s1->et2[po2->s1->ik2 - 1];

	      send[0] = po2->s1->et1[po2->s1->in1];
	      send[1] = po2->s1->et2[po2->s1->in2];

	      spar[kturn1] = (sstart[0] + send[0]) * (double) 0.5;
	      spar[kturn1 + 1] = (sstart[1] + send[1]) * (double) 0.5;

	      kstat = 0;
	      s1772 (po1->o1->c1, po2->o1->s1, aepsge, tstart, sstart, tend, send,
		     spar[kturn2], &spar[kturn1],
		     &spar[kturn2], &spar[kturn1], &kstat);
	      if (kstat < 0)
		goto error;

		if (kstat == 3)
		{
		   /* FLAT */
		   *jstat = 0;
		   goto out;
		}

	      /* UJIK, Retry, with better startpoint */
	      if (kstat == 2)
	      {
		/* No intersection point is found. Try again with a new
		   start point to the iteration.  */

		sh6closevert(po1->c1,po2->s1,&spar[kturn2],&spar[kturn1]);
		kstat = 0;
		s1772 (po1->o1->c1, po2->o1->s1, aepsge, tstart, sstart, tend, send,
		       spar[kturn2], &spar[kturn1],
		       &spar[kturn2], &spar[kturn1], &kstat);
		if (kstat < 0)
		  goto error;
	      }

	      if (kstat == 1)
		/*Intersection point found. Control edges. */
		if (DEQUAL (spar[kturn2], tstart) ||
		    DEQUAL (spar[kturn2], tend) ||
		    DEQUAL (spar[kturn1], sstart[0]) ||
		    DEQUAL (spar[kturn1], send[0]) ||
		    DEQUAL (spar[kturn1 + 1], sstart[1]) ||
		    DEQUAL (spar[kturn1 + 1], send[1]))
		  kstat = 0;
	    }

	  if (kstat == 1)	/* Intersection point found. */
	    {

	      *jstat = 1;	/* Mark intersection found.  */

	      /* UJK newi */
	      if (qt)
		{
		  /* We have an instance of a point, use it */
		  for (ki = 0; ki < qt->ipar; ki++)
		    qt->epar[ki] = spar[ki];
		}
	      else
		{
		  /* Making intersection point. */
		  double *nullp = SISL_NULL;
		  qt = hp_newIntpt (po1->iobj + po2->iobj, spar, DZERO, SI_ORD,
				    SI_UNDEF, SI_UNDEF, SI_UNDEF, SI_UNDEF,
				    0, 0, nullp, nullp);

		  if (qt == SISL_NULL)
		    goto err101;

		  /* Uppdating pintdat. */
		  sh6idnpt (pintdat, &qt, 1, &kstat);
		  if (kstat < 0)
		    goto error;

		  /* Set pretopology */
		  if (po2->iobj == SISLCURVE)
		    {
		      /* Case curve, curve */
		      if (po1->c1->idim == 2)
			{
			  /* Only 2D is treated */
			  sh1780 (po1, po2,
				  aepsge, pintdat, qt, &no_new, &kstat);
			  if (kstat < 0)
			    goto error;
			}
		    }
		  else if (po2->iobj == SISLSURFACE)
		    {
		      /* Case curve, surface */
		      if (po1->c1->idim == 3)
			{
			  /* Only 3D  */
			  sh1779 ((kturn1 ? po1 : po2),
				  (kturn1 ? po2 : po1),
				  aepsge, pintdat, qt, &no_new, &kstat);
			  if (kstat < 0)
			    goto error;
			}
		    }

		}
	    }
	}
    }
  else if (po1->iobj == SISLSURFACE && po2->iobj == SISLSURFACE)
    {
      if ((*vedge)[0]->ipoint + (*vedge)[1]->ipoint > 1)
	{
	  /* We have more than one intersection point on the edges,
             we therefor connect these points to each other. */
	  int ksimple;

	  if (po1->psimple == po2)
	    ksimple = 1;
	  else
	    ksimple = 0;

	  sh1762_s9edgsscon ((*vedge), po1->s1, po2->s1, *pintdat, ksimple,
			     aepsge, &kstat);
	  if (kstat < 0)
	    goto error;
	  else if (kstat)
	    *jstat = 0;		/* Not a simple case. */
	}
    }
  else
    goto err121;

  goto out;

/* Error. Kind of object does not exist.  */

err121:*jstat = -121;
  s6err ("sh1762_s9update", *jstat, kpos);
  goto out;

/* Error in input. Conflicting dimensions.  */

err106:*jstat = -106;
  s6err ("s1770", *jstat, kpos);
  goto out;

/* Error in space allocation.  */

err101:*jstat = -101;
  s6err ("sh1762_s9update", *jstat, kpos);
  goto out;

/* Error in lower level routine.  */

error:*jstat = kstat;
  s6err ("sh1762_s9update", *jstat, kpos);
  goto out;

out:if (up != SISL_NULL)
    freearray (up);
}

//===========================================================================
void sh1762_s9con (SISLObject * po1, SISLObject * po2, double aepsge,
		   SISLIntdat ** pintdat, SISLEdge * vedge[], int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int ki,kj;			/* Counter.                                */
  int knum = 0;			/* Number of intersection points on edges. */
  SISLIntpt **up = SISL_NULL;	/* Intersection points on edges.           */
  SISLdir *qd1, *qd2;		/* Direction cones of objects.             */
  SISLIntpt *qpt;               /* Evt 3. intersection point.              */
  int knpar=po1->iobj+po2->iobj; /* Number of parameter directions.        */
  int kcrv1;                    /* Indicates if 1. object is a curve.      */
  int kcrv2;                    /* Indicates if 2. object is a curve.      */
  int pretop[2][4];
  SISLObject *qobj;
  int ind1, ind2, perm[2], obj, ipar;
  int klist1, klist2;
  int linear = FALSE;
  int kpt,kpt2;                 /* Number of elements in int. list.        */
  int kstat2 = 0;               /* Remember status from s9toucharea.       */
  double mintang1;
  double mintang2;
  double tboxsize1;
  double tboxsize2;
  int kxintercept = (*jstat == 202);  /* Extra interception       */

  /*int loopcount;*/		/* Count up num intpts in a list. */
  int one_edge = 0;             /* Indicates if all intersection points
				   lies on one edge in each surface.     */
  SISLPtedge *qpt1, *qpt2;      /* Pointers used to traverse edge intersections. */

  /* Set kcrv parameters.  */

  kcrv1 = (po1->iobj == SISLCURVE) ? 1 : 0;
  kcrv2 = (po2->iobj == SISLCURVE) ? 1 : 0;

  if ((po1->iobj == SISLPOINT && po1->p1->idim == 1) ||
      (po2->iobj == SISLPOINT && po2->p1->idim == 1))
    *jstat = 0;
  else
    {

       if (po1->iobj == SISLPOINT) qd1 = SISL_NULL;
       else
	  qd1 = (po1->iobj == SISLCURVE ? po1->c1->pdir : po1->s1->pdir);

       if (po2->iobj == SISLPOINT) qd2 = SISL_NULL;
       else
	  qd2 = (po2->iobj == SISLCURVE ? po2->c1->pdir : po2->s1->pdir);

       knum = 0;
       if (vedge[0] != SISL_NULL) knum += vedge[0]->ipoint;
       if (vedge[1] != SISL_NULL) knum += vedge[1]->ipoint;

      if (knum > 0)
	{
	  /* Organize intersection points on an array. */

	  /* sh1762_s9edgpoint (vedge, &up, &knum, &kstat); */
	  sh6edgpoint (vedge, &up, &knum, &kstat);
	  if (kstat < 0)
	    goto error;
	}

      /* We test coincide by linearity. If the two object is liniar
         and have end/edge intersection we just connect these
         intersection points, else we have no internal intersections. */

      if (po1->iobj == SISLCURVE)
      {
	 tboxsize1 = po1->c1->pbox->e2max[2][0] - po1->c1->pbox->e2min[2][0];
	 if (po1->c1->idim > 1)
	    tboxsize1 = MAX(tboxsize1,
			   po1->c1->pbox->e2max[2][1] - po1->c1->pbox->e2min[2][1]);
	 if (po1->c1->idim > 2)
	    tboxsize1 = MAX(tboxsize1,
			   po1->c1->pbox->e2max[2][2] - po1->c1->pbox->e2min[2][2]);
	 mintang1 = aepsge/((double)2*tboxsize1);
      }
      else  if (po1->iobj == SISLSURFACE)
	 mintang1 = ANGULAR_TOLERANCE/(double)10;

      if (po2->iobj == SISLCURVE)
      {
	 tboxsize2 = po2->c1->pbox->e2max[2][0] - po2->c1->pbox->e2min[2][0];
	 if (po2->c1->idim > 1)
	    tboxsize2 = MAX(tboxsize2,
			   po2->c1->pbox->e2max[2][1] - po2->c1->pbox->e2min[2][1]);
	 if (po2->c1->idim > 2)
	    tboxsize2 = MAX(tboxsize2,
			   po2->c1->pbox->e2max[2][2] - po2->c1->pbox->e2min[2][2]);
	 mintang2 = aepsge/((double)2*tboxsize2);
      }
      else if (po2->iobj == SISLSURFACE)
	 mintang2 = ANGULAR_TOLERANCE/(double)10;

      /* if (qd1->igtpi || qd2->igtpi || qd1->aang > ANGULAR_TOLERANCE ||
	  qd2->aang > ANGULAR_TOLERANCE) */
      if (qd1 == SISL_NULL || qd2 == SISL_NULL)
	 *jstat = 0;
      else if (qd1->igtpi || qd2->igtpi || qd1->aang > mintang1 ||
	  qd2->aang > mintang2)
	*jstat = 0;
      else if (knum == 2)
	/* Newi (ujk) When linear and 2 points, we know how to set
           the pretopology for curves, this is done a bit further down */
	linear = TRUE;
      else if (po1->iobj + po2->iobj < 2*SISLSURFACE)
	{
	  if (knum > 1)
	    {
	      /* We have more than one intersection point on the edges.
                 We therefore connect these points. */
	      /* UPDATE (ujk) don't like this connection */

	      for (ki = 0; ki < knum; ki++)
		sh6tomain (up[ki], &kstat);

	      for (ki = 1; ki < knum; ki++)
		{
		  sh6idcon (pintdat, &up[ki - 1], &up[ki], &kstat);
		  if (kstat < 0)
		    goto error;
		}
	      *jstat = 1;
	    }
	  else
	    *jstat = 2;

	  goto out;		/* Test performed.  */
	}

      if (knum >= 2 &&
	  po1->iobj == SISLSURFACE &&
	  po2->iobj == SISLSURFACE)
      {
	 /* VSK. Change test on possibility of coincidence.
	    More than two intersection points on the edges.
	    Check if there is
	    coincidence between the (surface) objects.
	    Fetch all closed loops. Then call s9toucharea to
	    see if the surfaces coincide everywhere inside the loop. */

	 for (kstat2=0, kpt=0; kpt<knum; kpt+=kpt2)
	 {
	    sh6floop(up+kpt,knum-kpt,&kpt2,&kstat);

	    if (kstat == 1)
	    {
	       sh1762_s9toucharea (po1, po2, aepsge, kpt2, up+kpt, &kstat);
	       /*fprintf (stdout, "\n s9_toucharea, kstat=%d", kstat); */
	       if (kstat < 0)
		  goto error;
	       kstat2 = MAX(kstat2,kstat);
	    }
	    else if (kpt == 0 && kpt2 == knum)
	    {
	       /* Only one open edge curve. Test if the entire
		  curve lies on one edge in each surface.  */

	       for (one_edge=1, ki=1; ki<knum; ki++)
	       {
		  sh6comedg(po1, po2, up[ki-1], up[ki], &kstat);
		  if (kstat < 0) goto error;

		  if (kstat != 3) one_edge = 0;  /* Not a common edge. */
	       }
	    }

	 }

	 *jstat = kstat2;

	 if (kstat2 == 1)
	 {
	    /* Do something with the pertopology. */
	    /* fprintf (stdout, "\n Coincidence, kstat=%d", kstat); */
	 }
      }

      if (knum < 2 || (po1->iobj == SISLSURFACE &&
	  po2->iobj == SISLSURFACE && one_edge))
	{
	  /* Number of intersection points on the edges is less than
             two. Try to intercept further subdivision by performing
             improved box tests.  */

	  kstat = (kxintercept) ? 202 : 0;
	  sh1762_s9intercept (po1, po2, aepsge, knum, up, &kstat);
	  if (kstat < 0)
	    goto error;

	  *jstat = kstat;
	}
      else if (knum == 2 && !(po1->iobj == SISLSURFACE &&
			      po2->iobj == SISLSURFACE))
	{
	  /* Two intersection points on the edges. Check if there is
             coincidence between the objects.  */

	  if (linear)
	    kstat = 1;
	  else
	    {
	      sh1762_s9coincide (po1, po2, aepsge, knum, up, &kstat);
	      if (kstat < 0)
		goto error;
	    }

	  *jstat = kstat;

	  if (kstat == 1)
	    {
	      int kstat1 = 0;

	      for (ki = 0; ki < knum; ki++)
		sh6tomain (up[ki], &kstat);

	      sh6idcon (pintdat, &up[0], &up[1], &kstat);
	      if (kstat < 0)
		goto error;
	      /* Newi (ujk) */
	      /*	      for (ind1 = 0; ind1 < 2; ind1++)
		for (ind2 = 0; ind2 < 4; ind2++)
		pretop[ind1][ind2] = SI_UNDEF; */

	      /* Fetch existing pretopology. */
	      sh6gettop (up[0], -1, &pretop[0][0], &pretop[0][1],
			 &pretop[0][2], &pretop[0][3], &kstat1);

	      sh6gettop (up[1],  -1, &pretop[1][0], &pretop[1][1],
			 &pretop[1][2], &pretop[1][3], &kstat1);

	      for (qobj = po1, obj = 0, ipar = 0; obj < 2;
	       qobj = po2, obj++, ipar = ((po1->iobj == SISLCURVE) ? 1 : 2))
		/* Pretopology for curves */
		if (qobj->iobj == SISLCURVE)
		  {
		    if (up[0]->epar[ipar] < up[1]->epar[ipar])
		      {
			perm[0] = 0;
			perm[1] = 1;
			ind1 = 0;
			ind2 = 1;
		      }
		    else
		      {
			perm[0] = 1;
			perm[1] = 0;
			ind1 = 1;
			ind2 = 0;
		      }

		    /* Left point on curve */
		    pretop[ind1][1 + 2 * obj] = SI_ON;
		    /* Point at edge */
		    if (pretop[ind1][2 * obj] != SI_IN &&
			pretop[ind1][2 * obj] != SI_OUT &&
			DEQUAL (up[perm[0]]->epar[ipar],
				qobj->c1->et[qobj->c1->ik - 1]))
		      {
			/* Point at edge */
			pretop[ind1][2 * obj] = SI_AT;
		      }

		    /* Right point of curve */
		    pretop[ind2][2 * obj] = SI_ON;
		    if (pretop[ind2][1 + 2 * obj] != SI_IN &&
			pretop[ind2][1 + 2 * obj] != SI_OUT &&
			DEQUAL (up[perm[1]]->epar[ipar],
				qobj->c1->et[qobj->c1->in]))
		      {
			/* Point at edge */
			pretop[ind2][1 + 2 * obj] = SI_AT;
		      }

		    /*    / Left point on curve /
		    if (DEQUAL (up[perm[0]]->epar[ipar],
				qobj->c1->et[qobj->c1->ik - 1]))
		      {
			* Point at edge *
			pretop[ind1][2 * obj] = SI_AT;
			pretop[ind1][1 + 2 * obj] = SI_ON;
		      }
		    else
		      {
			pretop[ind1][1 + 2 * obj] = SI_ON;
		      }

		    * Right point of curve *
		    if (DEQUAL (up[perm[1]]->epar[ipar],
				qobj->c1->et[qobj->c1->in]))
		      {
			* Point at edge *
			pretop[ind2][2 * obj] = SI_ON;
			pretop[ind2][1 + 2 * obj] = SI_AT;
		      }
		    else
		      {
			pretop[ind2][2 * obj] = SI_ON;
			} */

		  }
	      sh6getlist (up[0], up[1], &klist1, &klist2, &kstat);
	      if (kstat != 0)
		{
		  kstat = -1;
		  goto error;
		}

	      sh6settop (up[0], -1, pretop[0][0], pretop[0][1],
			 pretop[0][2], pretop[0][3], &kstat);
	      if (kstat < 0)
		goto error;

	      sh6settop (up[1], -1, pretop[1][0], pretop[1][1],
			 pretop[1][2], pretop[1][3], &kstat);
	      if (kstat < 0)
		goto error;


	      if (knpar<4 && (*pintdat)->ipoint == 3)
		 {
		    /* There is 3 intersection points. Test if the 3. point
		       lies between the endpoints of the coincidence curve.
		       First fetch 3. point.         */

		    for (kj=0; kj<3; kj++)
		      {
			 qpt = (*pintdat)->vpoint[kj];
			 if (qpt!=up[0] && qpt!=up[1]) break;
		      }

		    /* Check if the point lies inside the current
		       intersection area.  */

		    sh6isinside(po1,po2,qpt,&kstat);
		    if (kstat < 0) goto error;

		    if (kstat == 1)
		    {
		       /* Check parameter value of evt curves. */

		       if ((kcrv1 &&
			   (up[0]->epar[0] < qpt->epar[0] &&
			    qpt->epar[0] < up[1]->epar[0])) ||
			   (up[1]->epar[0] < qpt->epar[0] &&
			    qpt->epar[0] < up[0]->epar[0])) kcrv1 = -1;

		       if ((kcrv2 &&
			   (up[0]->epar[po1->iobj] < qpt->epar[po1->iobj] &&
			    qpt->epar[po1->iobj] < up[1]->epar[po1->iobj])) ||
			   (up[1]->epar[po1->iobj] < qpt->epar[po1->iobj] &&
			     qpt->epar[po1->iobj] < up[0]->epar[po1->iobj]))
			  kcrv2 = -1;

		       if (kcrv1 < 1 && kcrv2 < 1)
		       {

			  /* The point lies inside the coincidence curve.
			     Place it between the endpoints of the curve. */

			  sh6tomain(qpt,&kstat);
			  sh6insertpt(up[0],up[1],qpt,&kstat);
			  if (kstat < 0) goto error;
			}
		     }
		 }

	    }
	}
      else if (knum > 2 && !(po1->iobj == SISLSURFACE &&
			     po2->iobj == SISLSURFACE))
      {
	 /* There is more than two edge intersection and it is no
	    surface - surface intersection. Check if the edge
	    intersections are already connected. */

	 sh6floop(up, knum, &kpt2, &kstat);
	 if (kpt2 == knum)
	    /* All edge intersections lie in one loop.  */

	    *jstat = 1;
	 else
	 {
	    /* Check if (one of) the curve(s) lies entirely in an
	       intersection curve found at an edge.  */

	    if (po1->iobj == SISLCURVE)
	    {
	       for (qpt1=vedge[0]->prpt[0]; qpt1!=SISL_NULL; qpt1=qpt1->pnext)
	       {
		  for (qpt2=vedge[0]->prpt[1]; qpt2!=SISL_NULL; qpt2=qpt2->pnext)
		  {
		     /* UJK, aug 93, oo-loop in sh6isconn, BEOrd20786. */
		     int is_conn,kcount;
		     is_conn = sh6isconnect(SISL_NULL, qpt1->ppt, qpt2->ppt);
		     for (kcount = 0;kcount<(*pintdat)->ipoint;kcount++)
			(*pintdat)->vpoint[kcount]->marker = 0;

		     if (is_conn) break;
		  }
		  if (qpt2 != SISL_NULL) break;
	       }

	       if (qpt1 != SISL_NULL && qpt2 != SISL_NULL) *jstat = 1;
	       else *jstat = 0;
	    }
	    if (*jstat != 1 && po2->iobj == SISLCURVE)
	    {
	       for (qpt1=vedge[1]->prpt[0]; qpt1!=SISL_NULL; qpt1=qpt1->pnext)
	       {
		  for (qpt2=vedge[1]->prpt[1]; qpt2!=SISL_NULL; qpt2=qpt2->pnext)
		  {
		     /* UJK, aug 93, oo-loop in sh6isconn, BEOrd20786. */
		     int is_conn,kcount;
		     is_conn = sh6isconnect(SISL_NULL, qpt1->ppt, qpt2->ppt);
		     for (kcount = 0;kcount<(*pintdat)->ipoint;kcount++)
			(*pintdat)->vpoint[kcount]->marker = 0;

		     if (is_conn) break;
		  }

		  if (qpt2 != SISL_NULL) break;
	       }

	       if (qpt1 != SISL_NULL && qpt2 != SISL_NULL) *jstat = 1;
	       else *jstat = 0;
	    }
	 }
      }
    }

  goto out;

  /* Error in subroutines      */

error:*jstat = kstat;
  s6err ("sh1762_s9con", *jstat, 0);
  goto out;

out:
  if (up != SISL_NULL)
    freearray (up);

  return;
}

//===========================================================================
void sh1762_s9intercept (SISLObject * po1, SISLObject * po2, double aepsge,
			 int inmbpt, SISLIntpt * vintpt[], int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.               */
  int kdim;			/* Dimension of geometry space.   */
  int kleft = 0;		/* Parameter to curve evaluation. */
  int kleft2 = 0;               /* Parameter to evaluator.        */
  int incr, ind;		/* indexes and loop control       */
  int ratflag = 0;              /* Indicates if rational object.  */
  int kxintercept = (*jstat == 202);  /* Extra interception       */
  double tepsge;                /* Local tolerance in 1D box test. */
  double testpar[2];		/* Par val when treating help p.  */
  double trad;                  /* Radius of geometry object.     */
  double spar[2];               /* Parameter pair of surface.     */
  double scentre[3];            /* Centre of sphere of cylinder.  */
  double sder1[9];		/* Value and derivative of object.  */
  double sder2[9];		/* Pointer to value of second object.*/
  double snorm1[3];             /* Normal to first surface.       */
  double snorm2[3];             /* Normal to second surface.      */
  double splitgeom[16];         /* Matrix description of a sphere
				   or cylinder.                   */
  SISLSurf *qs1=SISL_NULL;           /* B-spline surface put into sphere
				   or cylinder equation.          */
  SISLSurf *qs2=SISL_NULL;           /* B-spline surface put into sphere
				   or cylinder equation.          */
  SISLCurve *qc=SISL_NULL;           /* B-spline curve put into sphere
				   equation.                      */
  SISLCurve *qc2=SISL_NULL;           /* B-spline curve put into sphere
				   equation.                      */
  SISLPoint *pp1=SISL_NULL;
  SISLObject *qobjs;		/* Pointer to surface object.     */
  SISLObject *qobjc;		/* Pointer to curve object.       */

  /*   long time_before;
  long time_used = 0;  */

  /* Test number of found intersection points.  */

  /* VSK, 01/93. if (inmbpt > 1 || inmbpt < 0)
    goto err128; */

  *jstat = 0;

  if (po1->iobj == SISLSURFACE && po2->iobj == SISLSURFACE)
    {
       kdim = po1->s1->idim;

      /*      rotate_nmb++;
      time_before = clock(); */

       if (inmbpt == 0)
       {
	  /* No intersections at the edges.  */

	  if (sh1762_xc % 2 == 0)
	  {
	     sh1839 (po1, po2, aepsge, &kstat);
	     if (kstat < 0)
		goto error;
	  }
	  else
	  {
	     sh1839 (po2, po1, aepsge, &kstat);
	     if (kstat < 0)
		goto error;
	  }
	  /*   time_used = clock() - time_before; */

	  if (kstat == 1)
	  {
	     if (sh1762_xc % 2 == 0)
	     {
		sh6findsplit(po1->s1, po2->s1, aepsge, &kstat);
		if (kstat < 0) goto error;
	     }
	     else
	     {
		sh6findsplit(po2->s1, po1->s1, aepsge, &kstat);
		if (kstat < 0) goto error;
	     }
	  }

	  if (kstat == 0 || kstat == 2)
	  {
	     *jstat = 2;
	     goto out;
	  }

       }
       else
       {
	  /* Evaluate the surfaces in the first intersection point, and
	     use the partial derivatives in this point as rotation axises. */

	  s1421(po1->s1,1,vintpt[0]->epar,&kleft,&kleft2,sder1,snorm1,&kstat);
	  if (kstat < 0) goto error;

	  s1421(po2->s1,1,vintpt[0]->epar+2,&kleft,&kleft2,sder2,snorm2,&kstat);
	  if (kstat < 0) goto error;

	  sh1834(po1,po2,aepsge,kdim,sder1+kdim,sder1+2*kdim,&kstat);
	  if (kstat < 0) goto error;

	  if (kstat == 1 &&
	      fabs(s6ang(sder1+kdim,sder1+2*kdim,kdim) - PIHALF) > ANGULAR_TOLERANCE)
	  {
	     sh1834(po1,po2,aepsge,kdim,sder1+2*kdim,sder1+kdim,&kstat);
	     if (kstat < 0) goto error;
	  }

	  if (kstat == 1 &&
	      s6ang(sder1+kdim,sder2+kdim,kdim) > ANGULAR_TOLERANCE &&
	      s6ang(sder1+2*kdim,sder2+kdim,kdim) > ANGULAR_TOLERANCE)
	  {
	     sh1834(po1,po2,aepsge,kdim,sder2+kdim,sder2+2*kdim,&kstat);
	     if (kstat < 0) goto error;
	  }

	  if (kstat == 1 &&
	      fabs(s6ang(sder2+kdim,sder2+2*kdim,kdim) - PIHALF) > ANGULAR_TOLERANCE &&
	      s6ang(sder1+kdim,sder2+2*kdim,kdim) > ANGULAR_TOLERANCE &&
	      s6ang(sder1+2*kdim,sder2+2*kdim,kdim) > ANGULAR_TOLERANCE)

	  {
	     sh1834(po1,po2,aepsge,kdim,sder2+2*kdim,sder2+kdim,&kstat);
	     if (kstat < 0) goto error;
	  }

	  if (kstat == 0 || kstat == 2)
	  {
	     *jstat = 2;
	     goto out;
	  }

       }
    }
  else if ((po1->iobj == SISLSURFACE && po2->iobj == SISLCURVE) ||
	   (po1->iobj == SISLCURVE && po2->iobj == SISLSURFACE))
    {
      /*We test if intersection is possible using
	 rotated box tests. */

      if (po1->iobj == SISLSURFACE)
	{
	  qobjs = po1;
	  qobjc = po2;
	}
      else
	{
	  qobjs = po2;
	  qobjc = po1;
	}

      /* Perform improved box-test.  */

      /*   rotate_nmb++;
      time_before = clock(); */

      /* Improved box-test based on main tangent of curve and
	 main normal of surface.     */

      sh1830 (qobjs, qobjc, aepsge, &kstat);
      if (kstat < 0)
	goto error;

      if (kstat == 1)
	{
	  sh1839 (qobjs, qobjc, aepsge, &kstat);
	  if (kstat < 0)
	    goto error;
	}
      /*	time_used = clock() - time_before; */
      /*
      if (kstat == 1)
      {
	 Try to separate the objects by a sphere.

	 sh6sepgeom(qobjs->s1, qobjc->c1, aepsge, scentre, &trad, &kstat);
	 if (kstat < 0) goto error;

	  If kstat = 0 is returned, no splitting geometry is found,
	    and no further interception is to be tried.

	 if (kstat > 0)
	 {
	    The splitting geometry object is a sphere.
	       Make a matrix of dimension (idim+1)x(idim+1) describing a hyper
	       sphere as an implicit function.

	    s1321(scentre,trad,qobjc->c1->idim,1,splitgeom,&kstat);
	    if (kstat < 0) goto error;



	    * Put the description of the surface and the curve into the
	    * implicit equation for the sphere.
	    * ----------------------------------------------------------

	    ratflag = (qobjs->s1->ikind == 2 || qobjs->s1->ikind == 4) ? 1 : 0;
	    s1320(qobjs->s1,splitgeom,1,ratflag,&qs1,&kstat);
	    if (kstat < 0) goto error;

	    ratflag = (qobjc->c1->ikind == 2 || qobjc->c1->ikind == 4) ? 1 : 0;
	    s1370(qobjc->c1,splitgeom,qobjc->c1->idim,1,ratflag,&qc,&kstat);
	    if (kstat < 0) goto error;

	     Set up local tolerance.

	    tepsge = (double)2.0*trad*aepsge;

	     Make box of 1D surface.

	    sh1992su(qs1,2,tepsge,&kstat);
	    if (kstat < 0) goto error;

	     Make box of 1D curve.

	    sh1992cu(qc,2,tepsge,&kstat);
	    if (kstat < 0) goto error;

	     Check if the boxes overlap.

	    if (qs1->pbox->e2min[2][0] > qc->pbox->e2max[2][0] ||
		qs1->pbox->e2max[2][0] < qc->pbox->e2min[2][0])
	    {

	       No intersection is possible.

	       *jstat = 2;
	       goto out;
	    }
	    else kstat = 1;   Mark possibility of intersection.
	 }
	 else kstat = 1;   Mark possibility of intersection.
      } */

      if (kstat == 0 || kstat == 2)
	{
	  *jstat = 2;
	  goto out;
	}
    }
  else if (po1->iobj == SISLCURVE && po2->iobj == SISLCURVE &&
	   2*po1->c1->ik >= po1->c1->in && 2*po2->c1->ik >= po2->c1->in)
  {
     double spoint[3];  /* Point in splitting plane. */
     double snorm[3];   /* Normal to splitting plane. */
     double sn1[3], sn2[3];
     int ki;
     double t1, t2;
     int ksign;

     /* Find dimension of geometry space. */

     kdim = po1->c1->idim;
     if (kdim != po2->c1->idim)
	goto err106;

     if (inmbpt == 1)
     {
	/* One intersection point between two curves found. Find splitting
	   plane. */
	/* First allocate space for local arrays.  */
	/* NEWI, (ujk), Lets try to find a help point */

	incr = 0;
	if (DEQUAL (vintpt[0]->epar[0], po1->c1->et[po1->c1->ik - 1]))
	{
	   incr++;
	   testpar[0] = po1->c1->et[po1->c1->in];
	}
	else if (DEQUAL (vintpt[0]->epar[0], po1->c1->et[po1->c1->in]))
	{
	   incr++;
	   testpar[0] = po1->c1->et[po1->c1->ik - 1];
	}

	if (DEQUAL (vintpt[0]->epar[1], po2->c1->et[po2->c1->ik - 1]))
	{
	   incr++;
	   testpar[1] = po2->c1->et[po2->c1->in];
	}
	else if (DEQUAL (vintpt[0]->epar[1], po2->c1->et[po2->c1->in]))
	{
	   incr++;
	   testpar[1] = po2->c1->et[po2->c1->ik - 1];
	}

	if (incr == 2)
	   for (ind = 0; ind < vintpt[0]->no_of_curves; ind++)
	      if (sh6ishelp (vintpt[0]->pnext[ind]) &&
		  DEQUAL (vintpt[0]->pnext[ind]->epar[0], testpar[0]) &&
		  DEQUAL (vintpt[0]->pnext[ind]->epar[1], testpar[1]))
	      {
		 *jstat = 2;
		 goto out;
	      }

	/* Evaluate the curves in the intersection point.  */

	s1221 (po1->c1, 1, vintpt[0]->epar[0], &kleft, sder1, &kstat);
	if (kstat < 0)
	   goto error;

	s1221 (po2->c1, 1, vintpt[0]->epar[1], &kleft, sder2, &kstat);
	if (kstat < 0)
	   goto error;

	/* Normalize derivatives. */

	t1 = s6norm(sder1+kdim, kdim, sder1+kdim, &kstat);
	t2 = s6norm(sder2+kdim, kdim, sder2+kdim, &kstat);
	ksign = (s6scpr(sder1+kdim, sder2+kdim, kdim) >
		 DZERO) ? 1 : -1;
	for (ki=0; ki<kdim; ki++)
	{
	   /* sder1[kdim+ki] *= t2;
	   sder2[kdim+ki] *= t1; */
	   spoint[ki] = (double)0.5*(sder1[ki] + sder2[ki]);
	   //sn1[ki] = (double)0.5*(sder1[kdim+ki]+sder2[kdim+ki]);
	   sn1[ki] = (double)0.5*(sder1[kdim+ki] +
				  (double)ksign*sder2[kdim+ki]);
	}
	if (kdim == 2)
	{
	   snorm[0] = sn1[1];   /* KYS 5/7-94: normal corrected */
	   snorm[1] = -sn1[0];
	}
	else if (kdim == 3)
	{
	   s6crss(sder1+kdim, sder2+kdim, sn2);
	   s6crss(sn1, sn2, snorm);
	}
	(void)s6norm(snorm, kdim, snorm, &kstat);
	if (!kstat) kstat = 1;
	else kstat = 0;
     }
     else if (inmbpt == 0 && po1->c1->pdir->aang < ANGULAR_TOLERANCE &&
	      po2->c1->pdir->aang < ANGULAR_TOLERANCE  &&
	      s6ang(po1->c1->pdir->ecoef,po1->c1->pdir->ecoef,kdim) <
	      (double)10*ANGULAR_TOLERANCE)
     {
	double tpar2;
	SISLPoint *pt = SISL_NULL;
	double *s1, *s2, *s3, *s4;

	s1 = po1->c1->ecoef;
	s2 = po1->c1->ecoef+kdim*(po1->c1->in-1);
	s3 = po2->c1->ecoef;
	s4 = po2->c1->ecoef+kdim*(po2->c1->in-1);

	/* Evaluate midpoint of first curve. */

	/* tpar1 = (double)0.5*(po1->c1->et[po1->c1->ik-1] +
	   po1->c1->et[po1->c1->in]);
	   s1221 (po1->c1, 0, tpar1, &kleft, sder1, &kstat);
	   if (kstat < 0)
	   goto error; */
	if (MIN(s6dist(s1,s3,kdim),s6dist(s1,s4,kdim)) <
	    MIN(s6dist(s2,s3,kdim),s6dist(s2,s4,kdim)))
	   memcopy(sder1,s1,kdim,DOUBLE);
	else
	   memcopy(sder1,s2,kdim,DOUBLE);

	/* Find closest point on the other curve. */

	if ((pt = newPoint(sder1, kdim, 0)) == SISL_NULL) goto err101;

	/* tpar2 = (double)0.5*(po2->c1->et[po2->c1->ik-1] +
	   po2->c1->et[po2->c1->in]); */
	if (s6dist(s3,sder1,kdim) < s6dist(s4,sder1,kdim))
	   tpar2 = po2->c1->et[po2->c1->ik-1];
	else
	   tpar2 = po2->c1->et[po2->c1->in];
	s1771(pt, po2->c1, aepsge, po2->c1->et[po2->c1->ik-1],
	      po2->c1->et[po2->c1->in], tpar2, &tpar2, &kstat);

	if (pt) freePoint(pt);
	if (kstat < 0)
	   goto error;

	s1221 (po1->c1, 1, tpar2, &kleft, sder1, &kstat);
	if (kstat < 0)
	   goto error;
	s1221 (po2->c1, 1, tpar2, &kleft, sder2, &kstat);
	if (kstat < 0)
	   goto error;

	/* Let the splitting plane pass through the midpoint of the
	   points on the two curves and let the medium of the
	   axises of the direction cones of the curves lie in the
	   plane. */

	/* Normalize the tangents. */

	t1 = s6norm(sder1+kdim, kdim, sder1+kdim, &kstat);
	t2 = s6norm(sder2+kdim, kdim, sder2+kdim, &kstat);
	ksign = (s6scpr(sder1+kdim, sder2+kdim, kdim) >
		 DZERO) ? 1 : -1;
	for (ki=0; ki<kdim; ki++)
	{
	   /* sder1[kdim+ki] *= t2;
	   sder2[kdim+ki] *= t1; */
	   spoint[ki] = (double)0.5*(sder1[ki] + sder2[ki]);
	   sn1[ki] = (double)0.5*(sder1[kdim+ki] +
				  (double)ksign*sder2[kdim+ki]);
	}

	if (kdim == 3)
	{
	   s6crss(sder1+kdim, sder2+kdim, sn2);
	   s6crss(sn1, sn2, snorm);
	}
	else
	{
	   snorm[0] = sn1[1]; /* KYS 5/7-94: normal corrected */
	   snorm[1] = -sn1[0];
	}

	(void)s6norm(snorm, kdim, snorm, &kstat);
	if (!kstat) kstat = 1;
	else kstat = 0;
     }
     else kstat = 1;


     /* Try to intercept with the found plane. */

     if (kstat == 0)
     {
	/* nmb_rotated++; */
	sh1831(po1->c1, po2->c1, ksign, spoint, snorm, aepsge, &kstat);
	if (kstat < 0) goto error;
     }

     if (kstat == 0)
     {
	/* nmb_succ_rotated++; */
	*jstat = 2;
	goto out;
     }


     if (kstat == 1 && inmbpt == 0 && po1->c1->idim > 2)
     {
	/* kstat = 1; */			/* Make sure to subdivide further if there
						   is two curves and no intersection point. */
	/* Try to separate the objects by a sphere. */

	   if (sh1762_xc % 2 == 0)
	   {
	      /* nmb_sep++; */
	      sh6sepcrv(po1->c1, po2->c1, aepsge, scentre, &trad, &kstat);
	      if (kstat < 0) goto error;
	   }
	   else
	   {
	      /* nmb_sep++; */
	      sh6sepcrv(po2->c1, po1->c1, aepsge, scentre, &trad, &kstat);
	      if (kstat < 0) goto error;
	   }

	/* If kstat = 0 is returned, no splitting geometry is found,
	   and no further interception is to be tried.  */

	if (kstat)
	{
	   /* The splitting geometry object is a sphere.
	      Make a matrix of dimension (idim+1)x(idim+1) describing a hyper
	      sphere as an implicit function.      	      */

	   /* nmb_try_sep++; */
	   s1321(scentre,trad,po1->c1->idim,1,splitgeom,&kstat);
	   if (kstat < 0) goto error;


	   /*
	   * Put the description of the surface and the curve into the
	   * implicit equation for the sphere.
	   * ----------------------------------------------------------
	   */

	   ratflag = (po1->c1->ikind == 2 || po1->c1->ikind == 4) ? 1 : 0;
	   s1370(po1->c1,splitgeom,po1->c1->idim,1,ratflag,&qc,&kstat);
	   if (kstat < 0) goto error;

	   ratflag = (po2->c1->ikind == 2 || po2->c1->ikind == 4) ? 1 : 0;
	   s1370(po2->c1,splitgeom,po2->c1->idim,1,ratflag,&qc2,&kstat);
	   if (kstat < 0) goto error;

	   /* Set up local tolerance. */

	   tepsge = (double)2.0*trad*aepsge;

	   /* Make box of 1D surface. */

	   sh1992cu(qc,2,tepsge,&kstat);
	   if (kstat < 0) goto error;

	   /* Make box of 1D curve. */

	   sh1992cu(qc2,2,tepsge,&kstat);
	   if (kstat < 0) goto error;

	   /* Check if the boxes overlap.  */

	   if (qc2->pbox->e2min[2][0] > qc->pbox->e2max[2][0] ||
	       qc2->pbox->e2max[2][0] < qc->pbox->e2min[2][0])
	   {

	      /* No intersection is possible.  */

	      /* numb_succ_sep++; */
	      *jstat = 2;
	      goto out;
	   }
	   else kstat = 1;  /* Mark possibility of intersection.  */
	}
	else kstat = 1;
     }
     else kstat = 1;
  }
  else if ((po1->iobj == SISLSURFACE && po2->iobj == SISLPOINT &&
	   po2->p1->idim == 2) ||
	   (po2->iobj == SISLSURFACE && po1->iobj == SISLPOINT &&
	   po1->p1->idim == 2))
  {
     /* Compute the mid-parameter value of the surface. First set
	pointer to the surface.  */

     if (po1->iobj == SISLSURFACE) qs1 = po1->s1;
     else qs1 = po2->s1;

     spar[0] = (double)0.5*(qs1->et1[qs1->ik1-1] + qs1->et1[qs1->in1]);
     spar[1] = (double)0.5*(qs1->et2[qs1->ik2-1] + qs1->et2[qs1->in2]);

     /* Evaluate the surface in the midpoint. */

     s1421(qs1, 1, spar, &kleft, &kleft2, sder1, snorm1, &kstat);
     if (kstat < 0) goto error;

     if (s6ang(sder1+2, sder1+4, 2) < ANGULAR_TOLERANCE)
     {
	spar[0] = (double)0.5*(sder1[2]+sder1[4]);
	spar[1] = (double)0.5*(sder1[3]+sder1[5]);
	sh1834(po1, po2, aepsge, 2, spar, sder1+4, &kstat);
	if (kstat < 0) goto error;
	if (kstat == 5) kstat = 0;   /* No 45 degree testing for rotated
					box test meens no danger of
					intersection point near corner that
					is not caught by the box test. */
     }
     else kstat = 1;

     qs1 = SISL_NULL;     /* Make sure that the input surface is not freed. */
  }
  else if (((po1->iobj == SISLSURFACE && po2->iobj == SISLPOINT &&
	   po2->p1->idim == 3) ||
	   (po2->iobj == SISLSURFACE && po1->iobj == SISLPOINT &&
	   po1->p1->idim == 3)) && kxintercept && sh1762_xc > 7 && sh1762_xc % 2 == 0)
  {
    if (po1->iobj == SISLSURFACE) 
      {
	qs1 = po1->s1;
	pp1 = po2->p1;
      }
    else 
      {
	qs1 = po2->s1;
	pp1 = po1->p1;
      }
    kdim = qs1->idim;

    if (qs1->in1 > qs1->ik1 || qs1->in2 > qs1->ik2)
      kstat = 1;
    else
      {
	int ind1, ind2, ind3;
	int kpt = 0;
	int kcrv = 0;
	double *spar = SISL_NULL;
	SISLIntcurve **ucurve = SISL_NULL;
	double eps = 0.001*aepsge;

	/* Find the closest points between the surface and the point */
	s1954(qs1, pp1->ecoef, qs1->idim, 0.0, eps, &kpt, &spar,
	      &kcrv, &ucurve, &kstat);
	if (kstat < 0)
	  goto error;


	/* Test distance between the closest points on the surface and
	   the point  */
	for (ind1=0; ind1<kpt; ind1++)
	  {
	    s1421(qs1, 0, spar+2*ind1, &kleft, &kleft2, sder1, 
		  snorm1, &kstat);
	    if (s6dist(pp1->ecoef, sder1, kdim) <= aepsge)
	      break;
	  }

	for (ind2=0; ind2<kcrv; ind2++)
	  {
	    for (ind3=0; ind3<ucurve[ind2]->ipoint; ind3++)
	      {
		s1421(qs1, 0, ucurve[ind2]->epar1+2*ind3, &kleft, &kleft2, 
		      sder1, snorm1, &kstat);
		if (s6dist(pp1->ecoef, sder1, kdim) <= aepsge)
		  break;
	      }
	    if (ind3 < ucurve[ind2]->ipoint)
	      break;
	  }

	if (ind1 < kpt || ind2 < kcrv)
	  kstat = 1;
	else kstat = 0;

	/* fprintf(stdout,"%7.13f %7.13f %7.13f %7.13f \n",qs1->et1[0],
		qs1->et1[qs1->in1],qs1->et2[0],qs1->et2[qs1->in2]);
	fprintf(stdout,"Point-srf : kstat = %d\n",kstat); */

	if (spar)
	  freearray(spar);
	if (ucurve)
	  freeIntcrvlist(ucurve, kcrv);
      }
    qs1 = SISL_NULL;
  }  
  else kstat = 1;


  *jstat = (kstat == 0 || kstat == 2) ? 2 : 0;
  goto out;

  /* Error in scratch allocation.  */

  err101: *jstat = -101;
  goto out;

  /* Error in input. Confliciting dimensions.  */

err106:*jstat = -106;
  goto out;

  /* Wrong number of intersection points on edge.  */

  /* err128:*jstat = -128;
  goto out; */

  /* Error in lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
   /* Free scratch used by 1D surfaces. */

   if (qs1 != SISL_NULL) freeSurf(qs1);
   if (qs2 != SISL_NULL) freeSurf(qs2);
   if (qc != SISL_NULL) freeCurve(qc);
   if (qc2 != SISL_NULL) freeCurve(qc2);

  /*	rotate_box_time += time_used;	 */
  return;
}

//===========================================================================
void sh1762_s9coincide (SISLObject * po1, SISLObject * po2, double aepsge,
			int inmbpt, SISLIntpt * vintpt[], int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                           */
  int kdim;			/* Dimension of geometry space.               */
  int kcur;			/* Indicates the curve in curve-surface
				   intersection.                              */
  int kn;			/* Counter.                                   */
  int kleft1 = 0, kleft2 = 0;	/* Parameters used in evaluation.           */
  int kind1,kind2;              /* Dummy parameters to sh6getlist.            */
  double tang;			/* Angle between vectors.                     */
  double *snorm;		/* Pointer to surface normal.                 */
  double *sder1 = SISL_NULL;		/* Array containing position etc. of objects. */
  double *sder2;		/* Pointer to position of second object.      */
  SISLSurf *qs;			/* Pointer to surface.                        */
  SISLCurve *qc;		/* Pointer to curve.                          */
  SISLPoint *qp;

  if (inmbpt != 2)
    goto err128;

  if ((po1->iobj == SISLSURFACE && po2->iobj == SISLCURVE) ||
      (po1->iobj == SISLCURVE && po2->iobj == SISLSURFACE))
    {
      /* We test coincidence for curve-surface. */

       /* VSK, 10.92. First check if the points are already connected.     */

       sh6getlist(vintpt[0],vintpt[1],&kind1,&kind2,&kstat);
       if (kstat < 0) goto error;

       if (kstat == 0)
       {
	  /* The points are already connected.  */

	  *jstat = 1;
	  goto out;
       }

      if (po1->iobj == SISLSURFACE)
	{
	  qs = po1->s1;
	  qc = po2->c1;
	  kcur = 0;
	}
      else
	{
	  qs = po2->s1;
	  qc = po1->c1;
	  kcur = 1;
	}

      /* Allocate space for local arrays.  */

      if ((sder1 = newarray (6 * qc->idim, double)) == SISL_NULL)
	goto err101;
      sder2 = sder1 + 2 * qc->idim;
      snorm = sder2 + 3 * qc->idim;

      for (kn = 0; kn < 2; kn++)
	{
	  /* We have to test if the curve and the surface
	     have coinciding derivatives in intersection ponts. */

	  s1221 (qc, 1, vintpt[kn]->epar[(kcur ? 0 : 2)], &kleft1, sder1, &kstat);
	  if (kstat < 0)
	    goto error;

	  s1421 (qs, 1, vintpt[kn]->epar + kcur, &kleft1, &kleft2, sder2, snorm, &kstat);
	  if (kstat < 0)
	    goto error;
	  else if (kstat > 0)
	    {
	      /* Singular point.  */

	      *jstat = 0;
	      goto out;
	    }
/*
	  tang = s6ang (sder1 + qc->idim, snorm, qc->idim);

	  if (PIHALF - tang > ANGULAR_TOLERANCE)
	    {
	      *jstat = 0;
	      goto out;
	    }
*/
	}
      /* Removed the angle test. M.F. 30/8/91.  */
      /* If the first derivatives are equal we call a routine
	 to test further for coincidence.  */

      s1785 (qc, qs, aepsge, vintpt[0]->epar, vintpt[1]->epar, kcur, &kstat);
      if (kstat < 0)
	goto error;

    }
  else if (po1->iobj == SISLCURVE && po2->iobj == SISLCURVE)
    {
      kdim = po1->c1->idim;
      if (kdim != po2->c1->idim)
	goto err106;

      /* Test coincidence between two curves. First allocate
	 space for local arrays.  */

      if ((sder1 = newarray (8 * kdim, double)) == SISL_NULL)
	goto err101;
      sder2 = sder1 + 4 * kdim;

      /* Evaluate the curves in the first intersection point.  */

      s1221 (po1->c1, 1, vintpt[0]->epar[0], &kleft1, sder1, &kstat);
      if (kstat < 0)
	goto error;

      s1221 (po2->c1, 1, vintpt[0]->epar[1], &kleft1, sder2, &kstat);
      if (kstat < 0)
	goto error;

      /* Evaluate the curves in the second intersection point.  */

      s1221 (po1->c1, 1, vintpt[1]->epar[0], &kleft1, sder1 + (2 * kdim), &kstat);
      if (kstat < 0)
	goto error;

      s1221 (po2->c1, 1, vintpt[1]->epar[1], &kleft2, sder2 + (2 * kdim), &kstat);
      if (kstat < 0)
	goto error;

      /* Test if the curves are parallel in the endpoints. */

      tang = s6ang (sder1 + kdim, sder2 + kdim, kdim);

      if (tang > ANGULAR_TOLERANCE)
	{
	  *jstat = 0;
	  goto out;
	}

      tang = s6ang (sder1 + (3 * kdim), sder2 + (3 * kdim), kdim);

      if (tang > ANGULAR_TOLERANCE)
	{
	  *jstat = 0;
	  goto out;
	}

      s1786 (po1->c1, po2->c1, aepsge, vintpt[0]->epar, vintpt[1]->epar, &kstat);
      if (kstat < 0)
	goto error;

    }
  else if ((po1->iobj == SISLSURFACE && po2->iobj == SISLPOINT &&
	    po2->p1->idim >= 2) ||
	   (po2->iobj == SISLSURFACE && po1->iobj == SISLPOINT &&
	    po1->p1->idim >= 2))
  {
     if (po1->iobj == SISLSURFACE)
     {
	qs = po1->s1;
	qp = po2->p1;
     }
     else
     {
	qs = po2->s1;
	qp = po1->p1;
     }

     /* Allocate space for local arrays.  */

     if ((sder1 = newarray (7 * qs->idim, double)) == SISL_NULL)
	goto err101;
     sder2 = sder1 + 3 * qs->idim;
     snorm = sder2 + 3 * qs->idim;

     /* Evaluate the surface in the intersection points at the edges. */

     s1421 (qs, 1, vintpt[0]->epar, &kleft1, &kleft2, sder1, snorm, &kstat);
     if (kstat < 0)
	goto error;

     s1421 (qs, 1, vintpt[1]->epar, &kleft1, &kleft2, sder2, snorm, &kstat);
     if (kstat < 0)
	goto error;

     /* Test if this is a singular situation. */

     if (s6ang(sder1+qs->idim, sder1+2*qs->idim, qs->idim) <= 
	 ANGULAR_TOLERANCE &&
	 s6ang(sder2+qs->idim, sder2+2*qs->idim, qs->idim) <= 
	 ANGULAR_TOLERANCE)
     {
	/* Perform marching to check if there is coincidence between
	   the intersection points. */

	 /* fprintf(stdout,"Try coincidence marching \n"); 
	 fprintf(stdout,"%7.13f %7.13f %7.13f %7.13f \n",qs->et1[0],
		 qs->et1[qs->in1],qs->et2[0],qs->et2[qs->in2]); */

	s1789(qp, qs, aepsge, vintpt[0]->epar, vintpt[1]->epar, &kstat);
	if (kstat < 0) goto error;
	 /* fprintf(stdout,"kstat = %d \n",kstat); */
     }
     else
	kstat = 0;   /* No coincidence. */
  }

  *jstat = kstat;
  goto out;

  /* Error in scratc allocation.  */

err101:*jstat = -101;
  goto out;

  /* Error in input. Conflicting dimensions.  */

err106:*jstat = -106;
  goto out;

  /* Wrong number of edge intersections found.  */

err128:*jstat = -128;
  goto out;

  /* Error in lower level routine.  */

error:*jstat = kstat;
  goto out;

out:

  /* Free scratch occupied by local array.  */

  if (sder1 != SISL_NULL)
    freearray (sder1);

  return;
}

//===========================================================================
void sh1762_s9toucharea (SISLObject * po1, SISLObject * po2, double aepsge,
			 int inmbpt, SISLIntpt * vintpt[], int *jstat)
//===========================================================================
{
   int kstat = 0;         /* Local status variable. */
   int kntest1, kntest2;  /* Number of locations to test coincidence in
			     both parameter directions.                 */
   double tint1, tint2;   /* Parameter interval between testing spots.  */
   int ki,kj;             /* Counters.                                  */
   int kdim = po1->s1->idim; /* Dimension of geometry space.            */
   double spar[2];        /* Parameter of testing spot.                 */
   double sder1[3];       /* Position of first surface.                 */
   double sder2[3];       /* Position of second surface.                */
   double snorm1[3], snorm2[3];  /* Dummy normals of surface.           */
   int kleft11 = 0, kleft12 = 0; /* Pointers into knot arrays of surface. */
   int kleft21 = 0, kleft22 = 0; /* Pointers into knot arrays of surface. */
   int kn11 = po1->s1->in1;
   int kn12 = po1->s1->in2;
   int kk11 = po1->s1->ik1;
   int kk12 = po1->s1->ik2;
   double *st11 = po1->s1->et1;
   double *st12 = po1->s1->et2;
   int kn21 = po2->s1->in1;
   int kn22 = po2->s1->in2;
   int kk21 = po2->s1->ik1;
   int kk22 = po2->s1->ik2;
   double *st21 = po2->s1->et1;
   double *st22 = po2->s1->et2;
   SISLPoint *pt = SISL_NULL;       /* Point in point surface iteration.       */
   double sstart[2], send[2];  /* Parameter boundaries of second surface. */
   double spar2[2];            /* Parameter value of second surface.      */

   /* Set number of locations to test coincidence. */

   kntest1 = 30*(kn11 - kk11 + 1);
   kntest2 = 30*(kn12 - kk12 + 1);
   tint1 = (st11[kn11] - st11[kk11-1])/(double)(kntest1+1);
   tint2 = (st12[kn12] - st12[kk12-1])/(double)(kntest2+1);

   /* Set parameter boundaries and midpoint of second surface. */

   sstart[0] = st21[kk21-1];
   sstart[1] = st22[kk22-1];
   send[0] = st21[kn21];
   send[1] = st22[kn22];
   spar2[0] = (double)0.5*(sstart[0] + send[0]);
   spar2[1] = (double)0.5*(sstart[1] + send[1]);

   for (spar[0]=st11[kk11-1]+tint1, ki=0; ki<kntest1; ki++, spar[0]+=tint1)
   {
      for (spar[1]=st12[kk12-1]+tint2, kj=0; kj<kntest2; kj++, spar[1]+=tint2)
      {
	 /* Evaluate first surface. */

	 s1421(po1->s1, 0, spar, &kleft11, &kleft12, sder1, snorm1, &kstat);
	 if (kstat < 0) goto error;

	 /* Find closest point on the other surface. */

	 if ((pt =  newPoint(sder1, kdim, 0)) == SISL_NULL) goto err101;

	 s1773(pt, po2->s1, aepsge, sstart, send, spar2, spar2, &kstat);
	 if (kstat < 0) goto error;

	 /* Evalutate second surface. */

	 s1421(po2->s1, 0, spar2, &kleft21, &kleft22, sder2, snorm2, &kstat);
	 if (kstat < 0) goto error;

	 if (pt != SISL_NULL) freePoint(pt);
	 pt = SISL_NULL;

	 /* Check distance between the closest points. */

	 if (s6dist(sder1, sder2, kdim) > aepsge) break;  /* Not a coincidence.*/
      }
      if (kj < kntest2) break;  /* Not a coincidence. */
   }

   *jstat = (ki==kntest1 && kj==kntest2) ? 1 : 0;
   goto out;

   err101 : *jstat = -101;    /* Error in scratch allocation. */
   goto out;

   error : *jstat = kstat;    /* Error in lower level function. */
   goto out;

   out:
      if (pt != SISL_NULL) freePoint(pt);

      return;
}

//===========================================================================
void sh1762_s9edgsscon (SISLEdge * vedge[], SISLSurf * ps1, SISLSurf * ps2,
			SISLIntdat * rintdat, int isimple, double aepsge,
			int *jstat)
//===========================================================================
{
  int kstat,kstat1,kstat2;
  int kmarch = 0;               /* Indicates if marching is to be done. */
  int *ldir = SISL_NULL;		/* Local array containing one of the statusvalues for
				 * each point:
				 *  0 - The intersect.curve is parallel to one
				 *      parameter direction.
				 *  1 - The intersect.curve has direction into the
				 *      domain.
				 * -1 - The intersect.curve has direction out of the
				 *      domain.
				 *  2 - The point is singulear.
				 * 10 - The intersect.curve touch one corner of the
				 *      domain.
				 * --------------------------------------------------
				 */

  int lant[2];
  unsigned char *edg = SISL_NULL;
  double *sval1 = SISL_NULL;
  SISLIntpt **uipt = SISL_NULL;
  SISLIntpt **uinewpt = SISL_NULL;

  double *spar = SISL_NULL;		/* Local array with parameter values used as
				   input to s9surmarch. */
  int *lperm = SISL_NULL;		/* Local permutation array after sorting
				   input points to s9surmarch.*/
  int *lpermdir = SISL_NULL;		/* Local array with status values used as
				   input to s9surmarch. */
  int lstatus[4];		/* Local array containing the possible status
				   constants -1,1,0,2. */
  int lnumb[4];			/* Local array containing the number of points
				   with status lstatus. */

  double *sparout = SISL_NULL;	/* Local array with parameter values used as
				   output from s9surmarch.*/
  int *lpar = SISL_NULL;		/* Local array containing the connection information
				   from s9surmarch.*/
  int kpoints;			/* Local integer containing number of points returned
				   from s9surmarch.*/
  double *nullp = SISL_NULL;
  int klist1, klist2;		/* List index in iintpt.   */

  double tdist;                 /* Distance between surfaces in point.   */
  double tref;                  /* Reference value.                      */
  double spos[4];               /* Parameter value of singular point.    */
  double start[4];              /* Start parameter to iteration.         */
  double slimit[8];             /* Limits to the parameter areas.        */
  SISLIntpt *qsing=SISL_NULL;        /* Singular intersection point.          */

  /* Experiment UJK, sept 92 (BEOrd12754) */
    double tolpar = (double) 0.001;

    /* double tolpar = (double) 0.01; */

  if (ps1->idim != 3 || ps2->idim != 3)
    goto err200;

  *jstat = 0;

  if (vedge[0] == SISL_NULL)
    lant[0] = 0;
  else
    lant[0] = vedge[0]->ipoint;

  if (vedge[1] == SISL_NULL)
    lant[1] = 0;
  else
    lant[1] = vedge[1]->ipoint;


  if (lant[0] + lant[1] > 1)
    {
      int kn1, kn, ki, kj, kv, kant, klfs, klft, kdir, kpar;
      double *sval2, *snorm1, *snorm2, *stang, *sdec1, *sdec2;
      SISLPtedge *qpt;
      double tang;

      kant = lant[0] + lant[1];

      /* Allocate array of pointers to the points. */

      if ((uipt = newarray (kant, SISLIntpt *)) == SISL_NULL)
	goto err101;
      if ((edg = new0array (kant, unsigned char)) == SISL_NULL)
	goto err101;
      if ((ldir = new0array (kant, int)) == SISL_NULL)
	goto err101;
      if ((sval1 = newarray (33 * kant, double)) == SISL_NULL)
	goto err101;
      sval2 = sval1 + 9 * kant;
      snorm1 = sval2 + 9 * kant;
      snorm2 = snorm1 + 3 * kant;
      stang = snorm2 + 3 * kant;
      sdec1 = stang + 3 * kant;
      sdec2 = sdec1 + 3 * kant;


      /* UPDATE (ujk) Main point vs helppoints covered ? */
      /* Update the arrays. */

      for (kn1 = 0, kn = 0; kn < 2; kn++)
	if (lant[kn] > 0)
	  for (kj = 0; kj < vedge[kn]->iedge; kj++)
	    for (qpt = vedge[kn]->prpt[kj]; qpt != SISL_NULL; qpt = qpt->pnext)
	      {
		for (ki = 0; ki < kn1; ki++)
		  {
		    if (qpt->ppt == uipt[ki])
		      break;
		  }
		if (ki == kn1)
		  uipt[kn1++] = qpt->ppt;

		edg[ki] |= (unsigned char)(1 << (vedge[kn]->iedge * kn + kj));
	      }

      if (kn1 > 1)
	for (ki = 0; ki < kn1; ki++)
	  {
	    kv = 3 * ki;
	    kn = 9 * ki;
	    /* UPDATE (ujk) : getgeom !!  */

	    klfs = klft = 0;
	    s1421 (ps1, 1, uipt[ki]->epar, &klfs, &klft, sval1 + kn, snorm1 + kv,
		   &kstat);
	    if (kstat < 0)
	      goto error;
	    else if (kstat > 0)
	      {
		ldir[ki] = 2;
		continue;
	      }

	    klfs = klft = 0;
	    s1421 (ps2, 1, uipt[ki]->epar + 2, &klfs, &klft, sval2 + kn, snorm2 + kv,
		   &kstat);
	    if (kstat < 0)
	      goto error;
	    else if (kstat > 0)
	      {
		ldir[ki] = 2;
		continue;
	      }

	    tang = s6ang (snorm1 + kv, snorm2 + kv, 3);
	    if (tang < REL_PAR_RES)
	      /*	    if (tang < ANGULAR_TOLERANCE) */
	      {
		ldir[ki] = 2;
		continue;
	      }

	    s6crss (snorm1 + kv, snorm2 + kv, stang + kv);

	    s6decomp (stang + kv, sdec1 + kv, sval1 + kn + 3, sval1 + kn + 6,
		      snorm1 + kv, &kstat);
	    if (kstat < 0)
	      goto error;
	    else if (kstat > 0)
	      {
		ldir[ki] = 2;
		continue;
	      }


	    s6decomp (stang + kv, sdec2 + kv, sval2 + kn + 3, sval2 + kn + 6,
		      snorm2 + kv, &kstat);
	    if (kstat < 0)
	      goto error;
	    else if (kstat > 0)
	      {
		ldir[ki] = 2;
		continue;
	      }

	    for (kpar = 1, kj = 0; kj < 8; kj++)
	      if ((edg[ki] & 1 << kj) == 1 << kj)
		{
		  switch (kj)
		    {
		    case 0:
		      tang = s6ang (stang + kv, sval1 + kn + 3, 3);
		      kdir = (sdec1[kv + 1] > DZERO ? 1 : -1);
		      break;
		    case 4:
		      tang = s6ang (stang + kv, sval2 + kn + 3, 3);
		      kdir = (sdec2[kv + 1] > DZERO ? 1 : -1);
		      break;
		    case 1:
		      tang = s6ang (stang + kv, sval1 + kn + 6, 3);
		      kdir = (sdec1[kv] > DZERO ? -1 : 1);
		      break;
		    case 5:
		      tang = s6ang (stang + kv, sval2 + kn + 6, 3);
		      kdir = (sdec2[kv] > DZERO ? -1 : 1);
		      break;
		    case 2:
		      tang = s6ang (stang + kv, sval1 + kn + 3, 3);
		      kdir = (sdec1[kv + 1] > DZERO ? -1 : 1);
		      break;
		    case 6:
		      tang = s6ang (stang + kv, sval2 + kn + 3, 3);
		      kdir = (sdec2[kv + 1] > DZERO ? -1 : 1);
		      break;
		    case 3:
		      tang = s6ang (stang + kv, sval1 + kn + 6, 3);
		      kdir = (sdec1[kv] > DZERO ? 1 : -1);
		      break;
		    case 7:
		      tang = s6ang (stang + kv, sval2 + kn + 6, 3);
		      kdir = (sdec2[kv] > DZERO ? 1 : -1);
		    }

		  if (tang < tolpar)
		    kdir = 0;
		  /* if (tang < REL_PAR_RES)
		    kdir = 0; */
		  /*  if (tang < ANGULAR_TOLERANCE) kdir = 0;*/
		  if (kdir == 0)
		    kpar = 0;
		  else if (ldir[ki] != kdir)
		    {
		      if (ldir[ki] == 0)
			ldir[ki] = kdir;
		      else
			{
			  ldir[ki] = 10;
			  break;
			}
		    }
		}
	    if (kpar == 0 && ldir[ki] != 10)
	      ldir[ki] = 0;
	  }


      /* When only two points, check if they are connected. */
      if (kn1 == 2)
	{
	  sh6getlist (uipt[0], uipt[1], &klist1, &klist2, &kstat);
	  if (kstat == 0)
	    kn1 = 0;
	}


      for (kv = ki = 0; ki < kn1; ki++)
	if (ldir[ki] < 10)
	  kv++;

      if (kv == 1 && kn1 > 1 )
      {
	 int i,j;

	 if (kn1 > 2)
	 {
	    *jstat = 0;
	    for (i=0;i<kn1;i++)
	       if (ldir[i] == 1 || ldir[i] == -1)
		  *jstat = 1;
	    goto out;
	 }


	 if (ldir[0] == 1 || ldir[0] == -1)
	 {
	    i =  0;
	    j =  1;
	 }
	 else if (ldir[1] == 1 || ldir[1] == -1)
	 {
	    i =  1;
	    j =  0;
	 }
	 else						i = -1;

	 if (i >=0)
	 {
	    /* We have one point, and the direction is in/out.
	       The other point is touching a corner it is probably
	       an error and the point must be close to tangential.*/
	    if (ldir[i] == -1)
	    {
	       int k=j;
	       j  =  i;
	       i  =  k;
	    }

	    sh6tomain (uipt[i], &kstat);
	    sh6tomain (uipt[j], &kstat);

	    sh6idcon (&rintdat, &uipt[i], &uipt[j], &kstat);
	    if (kstat < 0)
	       goto error;
	    sh6setdir (uipt[i], uipt[j], &kstat);
	    if (kstat < 0)
	       goto error;
	    *jstat = 0;
	 }
      }
      else if (kv < 2)
	/* Less than two points, it's a simple case. */
	*jstat = 0;

      else if (kv > 8)
	/* More than eight points, it's not a simple case. */
	*jstat = 1;

      else if (kv == 4 && isimple > 0)
	{
	  /* Connect point in to closest point out. */
	  int kinn = 0, kout = 0;
	  int ki, ki1, ki2, ko1, ko2;

	  for (ki = 0; ki < kn1; ki++)
	    if (ldir[ki] == 1)
	      {
		if (kinn == 0)
		  ki1 = ki;
		else
		  ki2 = ki;
		kinn++;
	      }
	    else if (ldir[ki] == -1)
	      {
		if (kout == 0)
		  ko1 = ki;
		else
		  ko2 = ki;
		kout++;
	      }

	  if (kinn == 2 && kout == 2)
	    {
	      double tdist1, tdist2, tdir1, tdir2;

	      tdist1 = s6dist (sval1 + (ki1 * 9), sval1 + (ko1 * 9), 3);
	      tdist2 = s6dist (sval1 + (ki1 * 9), sval1 + (ko2 * 9), 3);

	      tdir1 = s6scpr (stang + (ki1 * 3), stang + (ko1 * 3), 3);
	      tdir2 = s6scpr (stang + (ki1 * 3), stang + (ko2 * 3), 3);

	      if (tdir2 < DZERO || (tdir1 >= DZERO && tdist1 <= tdist2))
		{
		  /* We can connect the points. */
		  /* UPDATE (ujk) : do we need to make conistency
	             between the points ? or can it be delayed until
	             s6idlis ?? (this comments is valid for all
	             connects in sscon and pscon)*/

		  sh6tomain (uipt[ki1], &kstat);
		  sh6tomain (uipt[ko1], &kstat);
		  sh6tomain (uipt[ki2], &kstat);
		  sh6tomain (uipt[ko2], &kstat);

		  sh6idcon (&rintdat, &uipt[ki1], &uipt[ko1], &kstat);
		  if (kstat < 0)
		    goto error;
		  /* Newi (ujk) Set in/out direction */
		  sh6setdir (uipt[ki1], uipt[ko1], &kstat);
		  if (kstat < 0)
		    goto error;

		  sh6idcon (&rintdat, &uipt[ki2], &uipt[ko2], &kstat);
		  if (kstat < 0)
		    goto error;
		  /* Newi (ujk) Set in/out direction */
		  sh6setdir (uipt[ki2], uipt[ko2], &kstat);
		  if (kstat < 0)
		    goto error;

		}
	      else
		{
		  /* We can connect the points. */

		  sh6tomain (uipt[ki1], &kstat);
		  sh6tomain (uipt[ko1], &kstat);
		  sh6tomain (uipt[ki2], &kstat);
		  sh6tomain (uipt[ko2], &kstat);

		  sh6idcon (&rintdat, &uipt[ki1], &uipt[ko2], &kstat);
		  if (kstat < 0)
		    goto error;
		  /* Newi (ujk) Set in/out direction */
		  sh6setdir (uipt[ki1], uipt[ko2], &kstat);
		  if (kstat < 0)
		    goto error;

		  sh6idcon (&rintdat, &uipt[ki2], &uipt[ko1], &kstat);
		  if (kstat < 0)
		    goto error;
		  /* Newi (ujk) Set in/out direction */
		  sh6setdir (uipt[ki2], uipt[ko1], &kstat);
		  if (kstat < 0)
		    goto error;

		}
	      *jstat = 0;
	    }
	  else
	    *jstat = 1;
	}

      else
	/* Prepare a marching strategy for connection.*/
	{
	  lstatus[0] = 1;
	  lstatus[1] = -1;
	  lstatus[2] = 0;
	  lstatus[3] = 2;

	  lnumb[0] = 0;
	  lnumb[1] = 0;
	  lnumb[2] = 0;
	  lnumb[3] = 0;

	  if ((lperm = new0array (kv, int)) == SISL_NULL)
	    goto err101;
	  if ((lpermdir = new0array (kv, int)) == SISL_NULL)
	    goto err101;
	  if ((spar = newarray (4 * kv, double)) == SISL_NULL)
	    goto err101;

	  for (kn = 0, kj = 0; kn < 4 && kj < kv; kn++)
	    {
	      /* We pass through the points four times, one for each
                 possible statusvalue.*/
	      /* In this way they will be sorted : 111..-1-1-1..000..222.. */

	      for (ki = 0; ki < kn1 && kj < kv; ki++)
		{

		  if (ldir[ki] == lstatus[kn])
		    {
		      lnumb[kn] += 1;
		      spar[4 * kj] = uipt[ki]->epar[0];
		      spar[4 * kj + 1] = uipt[ki]->epar[1];
		      spar[4 * kj + 2] = uipt[ki]->epar[2];
		      spar[4 * kj + 3] = uipt[ki]->epar[3];
		      lperm[kj] = ki;
		      lpermdir[kj] = ldir[ki];
		      kj++;
		    }
		}
	    }

	  /* If the first point is a parallel point, change status. */
	  if (lpermdir[0] == 0)
	    lpermdir[0] = 11;


	  /* UJK, aug. 92 */
	  if (kv == 3)
	    {
	       /* When three points, check if they are connected. */

	       sh6getlist (uipt[lperm[0]], uipt[lperm[1]],
			   &klist1, &klist2, &kstat);
	       if (kstat < 0) goto error;
	       sh6getlist (uipt[lperm[0]], uipt[lperm[2]],
			   &klist1, &klist2, &kstat1);
	       if (kstat1 < 0) goto error;
	       sh6getlist (uipt[lperm[1]], uipt[lperm[2]],
			   &klist1, &klist2, &kstat2);
	       if (kstat2 < 0) goto error;

	       if (kstat + kstat1 + kstat2 <= 1)
		 {
		    *jstat=0;
		    goto out;
		 }
	    }
	  if (kv == 3 &&  lpermdir[2] == 2)
	     {
		/* When three points, one singular, check if they are connected. */

		sh6getlist (uipt[lperm[0]], uipt[lperm[2]],
			    &klist1, &klist2, &kstat);
		sh6getlist (uipt[lperm[1]], uipt[lperm[2]],
			    &klist1, &klist2, &kstat1);

		if (kstat == 0 && kstat1 == 0)
		{
		   *jstat=0;
		   goto out;
		}
		else if (kstat1 == 0 &&
			 abs(lpermdir[0]) == 1 &&
			     lpermdir[1] == 0  &&
			     lpermdir[2] == 2)
		   {
		      /* Sing point is connected to parallell,
			 connect singular point to in(out) point. */
		      sh6tomain (uipt[lperm[0]], &kstat);
		      sh6tomain (uipt[lperm[2]], &kstat);

		      sh6idcon (&rintdat, &uipt[lperm[0]],
				&uipt[lperm[2]], &kstat);
		      if (kstat < 0)
			 goto error;

			 /* Set in/out direction */
			 if (lpermdir[0] == 1)
			    sh6setdir (uipt[lperm[0]],
				       uipt[lperm[2]], &kstat);
			 else
			 sh6setdir (uipt[lperm[2]],
				    uipt[lperm[0]], &kstat);

			 if (kstat < 0)
			    goto error;

			    /* Set status JUNCTION point. */
			    uipt[lperm[2]]->iinter = SI_SING;


		      *jstat=0;
		      goto out;
		   }
	     }


	  /* UJK 18.09.90 Connecting whenever we have two points and
             at least one of them is moving in or out. */
	  if (kv == 2 && (abs (lpermdir[0]) == 1))
/*	  if (kv==2 &&
	      ((lpermdir[0]*lpermdir[1] == -1) ||
	       (abs(lpermdir[0])==1 && lpermdir[1] == 0))) */
	    {
	      /* We have only two points and there has to be a curve,
                 connect. */
	      sh6tomain (uipt[lperm[0]], &kstat);
	      sh6tomain (uipt[lperm[1]], &kstat);

	      sh6idcon (&rintdat, &uipt[lperm[0]], &uipt[lperm[1]], &kstat);
	      if (kstat < 0)
		goto error;

	      /* Newi (ujk) Set in/out direction */
	      if (lpermdir[0] == 1)
		sh6setdir (uipt[lperm[0]],
			   uipt[lperm[1]], &kstat);
	      else
		sh6setdir (uipt[lperm[1]],
			   uipt[lperm[0]], &kstat);

	      if (kstat < 0)
		goto error;

	      /* ALA && UJK 19.09.90 Set status JUNCTION point. */
	      if (lpermdir[1] == 2)
		uipt[lperm[1]]->iinter = SI_SING;


	      *jstat = 0;
	      goto out;
	    }

	  else if (kv > 4 && lpermdir[kv - 1] != -1)
	     {
		/* More than four points, some with status /= +-1;
		   , it's not a simple case. */
		*jstat = 1;
		goto out;
	     }


	  else if (kv == 3 &&
		   lpermdir[0] == 1 &&
		   lpermdir[1] == -1 &&
		   lpermdir[2] == 0)
	    /* Three points, one in, one out, one parallel, connect in-out,
               delete parallel.. */
	    {

	      sh6tomain (uipt[lperm[0]], &kstat);
	      sh6tomain (uipt[lperm[1]], &kstat);
	      sh6idcon (&rintdat, &uipt[lperm[0]], &uipt[lperm[1]], &kstat);
	      if (kstat < 0)
		goto error;

	      /* Newi (ujk) Set in/out direction */
	      sh6setdir (uipt[lperm[0]], uipt[lperm[1]], &kstat);

	      /* UPDATE: (ujk) Avoid killing on edge !!! */
	      /* UJK, Aug.92, can't delete the parallel point
		 if it's in a corner. */

	      /* Corner first surface ? */
	      for (kn1 = kj = 0; kj < 4; kj++)
		if (edg[lperm[2]] & (1<<kj)) kn1++;

	      /* Corner second surface ? */
	      if (kn1 < 2)
		for (kn1 = 0, kj = 4; kj < 8; kj++)
		  if (edg[lperm[2]] & (1<<kj)) kn1++;

	      if (kn1 < 2)
		{
		   sh6idkpt (&rintdat, &uipt[lperm[2]], 1, &kstat);
		   if (kstat < 0)
		     goto error;
		}

	      *jstat = 0;
	      goto out;
	    }


	    else if (kv == 3 && (lpermdir[0] == 1 || lpermdir[0] == -1) &&
		     lpermdir[1] == 0 && lpermdir[2] == 0)
	       {
		  /* Set up parameters for search for singularity.  */

		  slimit[0] = *(ps1->et1 + ps1->ik1 - 1);
		  slimit[1] = *(ps1->et1 + ps1->in1);
		  slimit[2] = *(ps1->et2 + ps1->ik2 - 1);
		  slimit[3] = *(ps1->et2 + ps1->in2);
		  slimit[4] = *(ps2->et1 + ps2->ik1 - 1);
		  slimit[5] = *(ps2->et1 + ps2->in1);
		  slimit[6] = *(ps2->et2 + ps2->ik2 - 1);
		  slimit[7] = *(ps2->et2 + ps2->in2);
		  tref = MAX(MAX(slimit[1]-slimit[0],slimit[3]-slimit[2]),
			     MAX(slimit[5]-slimit[4],slimit[7]-slimit[6]));

		  for (kj=0; kj<4; kj++)
		  {
		     start[kj] = DZERO;
		     for (ki=1; ki<3; ki++) start[kj] += spar[ki*4+kj];
		     start[kj] /= (double)2;
		  }

		  /* Search for singularity.  */

		  shsing(ps1, ps2, slimit, start, spos, &kstat);
		  if (kstat < 0) goto error;

		  if (kstat == 1)
		  {
		     /* A singularity is found. Check if it is an
			intersection point. */

		     s1421(ps1, 0, spos, &klfs, &klft, sval1, snorm1, &kstat);
		     if (kstat < 0) goto error;

		     s1421(ps2, 0, spos+2, &klfs, &klft, sval2, snorm2, &kstat);
		     if (kstat < 0) goto error;

		     tdist = s6dist(sval1, sval2, 3);
		     if (tdist < aepsge)
		     {
			/* A singular intersection point is found. Check if
			   it is identical to any of the existing. */

			for (ki=0; ki<3; ki++)
			{
			   for (kj=0; kj<4; kj++)
			      if (DNEQUAL(spos[kj]+tref,spar[4*ki+kj]+tref)) break;
			   if (kj == 4) break;
			}

			if (ki > 0 && ki < 3)
			{
			   /* Connect the in/out point to the singular,
			      parallel point. */

			   sh6tomain(uipt[lperm[0]],&kstat);
			   sh6tomain(uipt[ki],&kstat);
			   sh6idcon(&rintdat,&uipt[lperm[0]],&uipt[ki],&kstat);
			   if (kstat < 0) goto error;

			   /* Newi Set in/out direction */
			   if (lpermdir[0] == 1)
			      sh6setdir (uipt[lperm[0]], uipt[ki], &kstat);
			   else
			      sh6setdir (uipt[ki], uipt[lperm[0]], &kstat);

			   goto out;
			}

			if (ki == 3)
			{
			   /* The singular intersection point do not exist already.
			      Create intersection point.  */

			   qsing = hp_newIntpt (4, spos, DZERO,
						SI_ORD, SI_UNDEF, SI_UNDEF,
						SI_UNDEF, SI_UNDEF,
						0, 0, nullp, nullp);
			   if (qsing == SISL_NULL) goto err101;

			  /*  Check if it lies on an edge.       */

			   for (kj=0; kj<4; kj++)
			      if (DEQUAL(spos[kj]+tref,slimit[2*kj]+tref) ||
				  DEQUAL(spos[kj]+tref,slimit[2*kj+1]+tref))
				 break;

			   if (kj < 4)
			   {
			      /* Singular intersection point at an edge.
				 Insert between the two parallel points.  */

			      sh6insert(&rintdat,uipt[lperm[1]],uipt[lperm[2]],
					&qsing, &kstat);
			      if (kstat < 0) goto error;

			      /* Connect to in/out point.  */

			      sh6tomain(uipt[lperm[0]],&kstat);
			      sh6tomain(qsing,&kstat);
			      sh6idcon(&rintdat,&uipt[lperm[0]],&qsing,&kstat);
			      if (kstat < 0) goto error;

			      /* Mark point as singular.  */

			      qsing -> iinter = SI_SING;

			      /* Newi Set in/out direction */
			      if (lpermdir[0] == 1)
				 sh6setdir (uipt[lperm[0]], qsing, &kstat);
			      else
				 sh6setdir (qsing, uipt[lperm[0]], &kstat);

			      goto out;
			   }
			   else
			   {
			      /* Singular point in the inner. Connect to
				 all edge points. First put into data structure. */

			      sh6idnpt (&rintdat, &qsing, 1, &kstat);
			      if (kstat < 0)
				 goto error;

			      sh6tomain(uipt[lperm[0]],&kstat);
			      sh6tomain(uipt[lperm[1]],&kstat);
			      sh6tomain(uipt[lperm[2]],&kstat);
			      sh6tomain(qsing,&kstat);
			      sh6idcon(&rintdat,&uipt[lperm[0]],&qsing,&kstat);
			      if (kstat < 0) goto error;
			      sh6idcon(&rintdat,&uipt[lperm[1]],&qsing,&kstat);
			      if (kstat < 0) goto error;
			      sh6idcon(&rintdat,&uipt[lperm[1]],&qsing,&kstat);
			      if (kstat < 0) goto error;

			      /* Mark point as singular.  */

			      qsing -> iinter = SI_SING;

			      /* Newi Set in/out direction */
			      if (lpermdir[0] == 1)
				 sh6setdir (uipt[lperm[0]], qsing, &kstat);
			      else
				 sh6setdir (qsing, uipt[lperm[0]], &kstat);

			      goto out;
			   }
			}
		     }
		  }
		  /* else
		  {
		      Check if only one of the parallel point is connected
			to only one point and the other is connected to two,
			connect to the first parallel point.

		     if ((sh6nmbmain(uipt[lperm[1]],&kstat) +
			  sh6nmbhelp(uipt[lperm[1]],&kstat) == 1) &&
			 (sh6nmbmain(uipt[lperm[2]],&kstat) +
			  sh6nmbhelp(uipt[lperm[2]],&kstat) == 2))
		     {
			sh6tomain(uipt[lperm[0]],&kstat);
			sh6tomain(uipt[lperm[1]],&kstat);
			sh6idcon(&rintdat,&uipt[lperm[0]],&uipt[lperm[1]],&kstat);
			if (kstat < 0) goto error;

			 Newi Set in/out direction
			if (lpermdir[0] == 1)
			   sh6setdir (uipt[lperm[0]], uipt[lperm[1]], &kstat);
			else
			   sh6setdir (uipt[lperm[1]], uipt[lperm[0]], &kstat);

			goto out;
	             }
		     else if ((sh6nmbmain(uipt[lperm[2]],&kstat) +
			       sh6nmbhelp(uipt[lperm[2]],&kstat) == 1) &&
			      (sh6nmbmain(uipt[lperm[1]],&kstat) +
			       sh6nmbhelp(uipt[lperm[1]],&kstat) == 2))
		     {
			sh6tomain(uipt[lperm[0]],&kstat);
			sh6tomain(uipt[lperm[2]],&kstat);
			sh6idcon(&rintdat,&uipt[lperm[0]],&uipt[lperm[2]],&kstat);
			if (kstat < 0) goto error;

			 Newi Set in/out direction
			if (lpermdir[0] == 1)
			   sh6setdir (uipt[lperm[0]], uipt[lperm[2]], &kstat);
			else
			   sh6setdir (uipt[lperm[2]], uipt[lperm[0]], &kstat);

			 Newi Set in/out direction
			if (lpermdir[0] == 1)
			   sh6setdir (uipt[lperm[0]], uipt[lperm[2]], &kstat);
			else
			   sh6setdir (uipt[lperm[2]], uipt[lperm[0]], &kstat);

			goto out;
	             }
		     else
		     {
			 Try to march from the non-parallel point.
			   Set parameter to enter marching.

			kmarch = 1;
		     }
		  }   */
	       }

	  if (kv == 3 &&  abs(lpermdir[2]) == 1)
	  {
	     /* There is three points, all of which pointing in or out.
		Prepare for a search for a singularity.  */

	     slimit[0] = *(ps1->et1 + ps1->ik1 - 1);
	     slimit[1] = *(ps1->et1 + ps1->in1);
	     slimit[2] = *(ps1->et2 + ps1->ik2 - 1);
	     slimit[3] = *(ps1->et2 + ps1->in2);
	     slimit[4] = *(ps2->et1 + ps2->ik1 - 1);
	     slimit[5] = *(ps2->et1 + ps2->in1);
	     slimit[6] = *(ps2->et2 + ps2->ik2 - 1);
	     slimit[7] = *(ps2->et2 + ps2->in2);
	     tref = MAX(MAX(slimit[1]-slimit[0],slimit[3]-slimit[2]),
			MAX(slimit[5]-slimit[4],slimit[7]-slimit[6]));

	     for (kj=0; kj<4; kj++)
	     {
		start[kj] = DZERO;
		for (ki=0; ki<3; ki++) start[kj] += spar[ki*4+kj];
		start[kj] /= (double)3;
	     }

	     /* Search for singularity.  */

	     shsing(ps1, ps2, slimit, start, spos, &kstat);
	     if (kstat < 0) goto error;

	     if (kstat == 1)
	     {
		/* A singularity is found. Check if it is an
		   intersection point. */

		s1421(ps1, 0, spos, &klfs, &klft, sval1, snorm1, &kstat);
		if (kstat < 0) goto error;

		s1421(ps2, 0, spos+2, &klfs, &klft, sval2, snorm2, &kstat);
		if (kstat < 0) goto error;

		tdist = s6dist(sval1, sval2, 3);
		if (tdist < aepsge)
		{
		   /* A singular intersection point is found. Check if
		      it is identical to any of the existing. */

		   for (ki=0; ki<3; ki++)
		   {
		      for (kj=0; kj<4; kj++)
			 if (DNEQUAL(spos[kj]+tref,spar[4*ki+kj]+tref)) break;
		      if (kj == 4) break;
		   }

		   if (ki < 3)
		   {
		      /* Something is wrong. Non of the existing
			 points are classified as singular. Continue
			 subdividing.   */
		   }
		   else
		   {
		      /* The singular intersection point do not exist already.
			 Create intersection point.  */

		      qsing = hp_newIntpt (4, spos, DZERO,
					   SI_ORD, SI_UNDEF, SI_UNDEF,
					   SI_UNDEF, SI_UNDEF,
					   0, 0, nullp, nullp);
		      if (qsing == SISL_NULL) goto err101;

		      /* Connect to all edge points. First put into
			 data structure. */

		      sh6idnpt (&rintdat, &qsing, 1, &kstat);
		      if (kstat < 0)
			 goto error;

		      sh6tomain(uipt[lperm[0]],&kstat);
		      sh6tomain(uipt[lperm[1]],&kstat);
		      sh6tomain(uipt[lperm[2]],&kstat);
		      sh6tomain(qsing,&kstat);
		      sh6idcon(&rintdat,&uipt[lperm[0]],&qsing,&kstat);
		      if (kstat < 0) goto error;
		      sh6idcon(&rintdat,&uipt[lperm[1]],&qsing,&kstat);
		      if (kstat < 0) goto error;
		      sh6idcon(&rintdat,&uipt[lperm[1]],&qsing,&kstat);
		      if (kstat < 0) goto error;

		      /* Mark point as singular.  */

		      qsing -> iinter = SI_SING;

		      /* Newi Set in/out direction */
		      if (lpermdir[0] == 1)
			 sh6setdir (uipt[lperm[0]], qsing, &kstat);
		      else
			 sh6setdir (qsing, uipt[lperm[0]], &kstat);

		      goto out;
		   }
		}
	     }
	  }

	  if (kv == 2 || lnumb[2] < 2 || kmarch == 1)
	  {
	      /* If we got two points, we always try marching as the second
                 strategy. */
	      /* If we got more than two points, we march only when
                 no more than one parallel point is given.*/

	      s9surmarch (ps1, ps2, spar, lpermdir, kv, &sparout,
			  &lpar, &kpoints, &kstat);
	      if (kstat < 0)
		goto error;

	      /* Branch on the given result from s9surmarch. */
	      if (kstat == 0)
		/* The points are not connected, continue subdividing. */
		*jstat = 1;

	      else if (kstat == 2)
		/* Only singulear points, set status ok. */
		*jstat = 0;

	      else
		{
		  if (kpoints > kv)
		    {
		      if ((uinewpt = newarray (kpoints - kv, SISLIntpt *))
			  == SISL_NULL)
			goto err101;
		      for (kj = kv, ki = 0; kj < kpoints; kj++, ki++)
			{
			  /* For each new point returned from s9surmarch,
                             we create an intersection point. */
			  SISLIntpt *qt;
			  double sintpar[4];

			  sintpar[0] = sparout[4 * kj];
			  sintpar[1] = sparout[4 * kj + 1];
			  sintpar[2] = sparout[4 * kj + 2];
			  sintpar[3] = sparout[4 * kj + 3];

			  uinewpt[ki] = qt = hp_newIntpt (4, sintpar, DZERO,
						 SI_ORD, SI_UNDEF, SI_UNDEF,
							  SI_UNDEF, SI_UNDEF,
							0, 0, nullp, nullp);


			  if (qt == SISL_NULL)
			    goto err101;

			  sh6idnpt (&rintdat, &qt, 1, &kstat);
			  if (kstat < 0)
			    goto error;

			}
		    }

		  /* Now we connect the points. */
		  *jstat = 0;

		  for (kj = 0; kj < kv; kj++)
		    {
		      ki = lpar[kj] - 1;

		      if (lpar[kj] > 0)
			{
			  if (lpar[kj] > kv)
			    {
			      /* SISLPoint is to be connected to a new point */

			      sh6tomain (uipt[lperm[kj]], &kstat);
			      sh6tomain (uinewpt[ki - kv], &kstat);

			      sh6idcon (&rintdat, &uipt[lperm[kj]],
					&uinewpt[ki - kv], &kstat);
			      if (kstat < 0)
				goto error;
			      /* Newi (ujk) Set in/out direction */
			      if (lpermdir[kj] == 1)
				sh6setdir (uipt[lperm[kj]],
					   uinewpt[ki - kv], &kstat);
			      else if (lpermdir[kj] == -1)
				sh6setdir (uinewpt[ki - kv],
					   uipt[lperm[kj]], &kstat);

			      if (kstat < 0)
				goto error;
			    }
			  else
			    {
			      /* SISLPoint is to be connected to an old point */
			      sh6tomain (uipt[lperm[kj]], &kstat);
			      sh6tomain (uipt[lperm[ki]], &kstat);
			      sh6idcon (&rintdat, &uipt[lperm[kj]],
					&uipt[lperm[ki]], &kstat);

			      /* Newi (ujk) Set in/out direction */
			      if (lpermdir[kj] == 1 || lpermdir[ki] == -1)
				sh6setdir (uipt[lperm[kj]],
					   uipt[lperm[ki]], &kstat);
			      else if (lpermdir[kj] == -1 ||
				       lpermdir[ki] == 1)
				sh6setdir (uipt[lperm[ki]],
					   uipt[lperm[kj]], &kstat);
			      if (kstat < 0)
				goto error;

			    }
			}
		    }
		}
	    }
	  else
	    /* No marching is to be done. */
	    *jstat = 1;
	}
    }


  goto out;



/* Error in sub rutines.      */

error:*jstat = kstat;
  s6err ("sh1762_s9edgsscon", *jstat, 0);
  goto out;

/* Error in memory allocation.      */

err101:*jstat = -101;
  s6err ("sh1762_s9edgsscon", *jstat, 0);
  goto out;

/* Error dimension.      */

err200:*jstat = -200;
  s6err ("sh1762_s9edgsscon", *jstat, 0);
  goto out;

out:
  if (uipt != SISL_NULL)
    freearray (uipt);
  if (edg != SISL_NULL)
    freearray (edg);
  if (ldir != SISL_NULL)
    freearray (ldir);
  if (sval1 != SISL_NULL)
    freearray (sval1);


  if (uinewpt != SISL_NULL)
    freearray (uinewpt);
  if (spar != SISL_NULL)
    freearray (spar);
  if (sparout != SISL_NULL)
    freearray (sparout);
  if (lpar != SISL_NULL)
    freearray (lpar);
  if (lperm != SISL_NULL)
    freearray (lperm);
  if (lpermdir != SISL_NULL)
    freearray (lpermdir);
}

//===========================================================================
void sh1762_s9edgpscon (SISLEdge * pedge, double alevel, SISLSurf * ps,
			int isimple, SISLIntdat * rintdat, double aepsge, int *jstat)
//===========================================================================
{
  int kstat,kstat1,kstat2;
  int *ldir = SISL_NULL;		/* Local array containing one of the statusvalues for
			         * each point:
	                         *  0 - The intersect.curve is parallel to one
			         *      parameter direction.
	                         *  1 - The intersect.curve has direction into the
			         *      domain.
	                         * -1 - The intersect.curve has direction out of the
			         *      domain.
	                         *  2 - The point is singulear.
	                         * 10 - The intersect.curve touch one corner of the
			         *      domain.
			         * ---------------------------------------------------
			         */

  unsigned char *edg = SISL_NULL;
  double *sval = SISL_NULL;
  SISLPtedge *qpt = SISL_NULL;
  SISLIntpt **uipt = SISL_NULL;
  SISLIntpt **uinewpt = SISL_NULL;

  double *spar = SISL_NULL;		/* Local array with parameter values used as
				   input to s9conmarch. */
  int *lperm = SISL_NULL;		/* Local permutation array after sorting
				   input points to s9conmarch.*/
  int *lpermdir = SISL_NULL;		/* Local array with status values used as
				   input to s9conmarch. */
  int lstatus[4];		/* Local array containing the possible status
				   constants -1,1,0,2. */
  int lnumb[4];			/* Local array containing the number of points
				   with status lstatus. */

  double *sparout = SISL_NULL;	/* Local array with parameter values used as
				   output from s9conmarch.*/
  int *lpar = SISL_NULL;		/* Local array containing the connection information
				   from s9conmarch.*/
  int kpoints;			/* Local integer containing number of points returned
				   from s9conmarch.*/
  int klist1, klist2;		/* Indices for Intpoints. */

  if (ps->idim != 1)
    goto err200;

  *jstat = 1;

  if (pedge->ipoint > 1)
    {
      int kn1, kn, ki, kj, kv, kant, klfs, klft, kdir, kpar;
      /* UJK 18.09.90  multiplying; treating near singularities as singularities.*/
      double ttol = (double) 1000000.0 * REL_COMP_RES;
      double tolpar = (double) 0.00001;

      double *snorm;
      double tmax;
      double *nullp = SISL_NULL;
      kant = pedge->ipoint;

      /* Allocate array of pointers to the points. */

      if ((uipt = newarray (kant, SISLIntpt *)) == SISL_NULL)
	goto err101;
      if ((edg = new0array (kant, unsigned char)) == SISL_NULL)
	goto err101;
      if ((ldir = new0array (kant, int)) == SISL_NULL)
	goto err101;
      if ((sval = newarray (4 * kant, double)) == SISL_NULL)
	goto err101;
      snorm = sval + 3 * kant;


      /* Update the arrays. */

      for (kn1 = kj = 0; kj < pedge->iedge; kj++)
	for (qpt = pedge->prpt[kj]; qpt != SISL_NULL; qpt = qpt->pnext)
	  {
	    for (ki = 0; ki < kn1; ki++)
	      {
		if (qpt->ppt == uipt[ki])
		  break;
	      }
	    if (ki == kn1)
	      uipt[kn1++] = qpt->ppt;

	    edg[ki] |= (unsigned char)(1 << kj);
	  }

      /* NEWI (ujk) some tuning ?! */
      if (kn1 == 2)
	tolpar = ttol;


      if (kn1 > 1)
	for (ki = 0; ki < kn1; ki++)
	  {
	    kn = 3 * ki;

	    klfs = klft = 0;
	    s1421 (ps, 1, uipt[ki]->epar, &klfs, &klft, sval + kn, snorm + ki, &kstat);
	    if (kstat < 0)
	      goto error;
	    else if (kstat > 0)
	      {
		ldir[ki] = 2;
		continue;
	      }

	    tmax = sqrt (sval[kn + 1] * sval[kn + 1] + sval[kn + 2] * sval[kn + 2]);
	    if (tmax < ttol)
	      {
		ldir[ki] = 2;
		continue;
	      }

	    for (kpar = 1, kj = 0; kj < 4; kj++)
	      if ((edg[ki] & 1 << kj) == 1 << kj)
		{
		  switch (kj)
		    {
		    case 0:
		      if (fabs (sval[kn + 1] / tmax) < tolpar)
			kdir = 0;
		      else
			kdir = (sval[kn + 1] > DZERO ? 1 : -1);
		      break;
		    case 1:
		      if (fabs (sval[kn + 2] / tmax) < tolpar)
			kdir = 0;
		      else
			kdir = (sval[kn + 2] > DZERO ? 1 : -1);
		      break;
		    case 2:
		      if (fabs (sval[kn + 1] / tmax) < tolpar)
			kdir = 0;
		      else
			kdir = (sval[kn + 1] > DZERO ? -1 : 1);
		      break;
		    case 3:
		      if (fabs (sval[kn + 2] / tmax) < tolpar)
			kdir = 0;
		      else
			kdir = (sval[kn + 2] > DZERO ? -1 : 1);
		    }

		  if (kdir == 0)
		    kpar = 0;
		  else if (ldir[ki] != kdir)
		    {
		      if (ldir[ki] == 0)
			ldir[ki] = kdir;
		      else
			{
			  ldir[ki] = 10;
			  break;
			}
		    }
		}
	    if (kpar == 0 && ldir[ki] != 10)
	      ldir[ki] = 0;
	  }
      /* End of for ki=0 ..... */


     /* When only two points, check if they are connected. */
      if (kn1 == 2)
	{
	  sh6getlist (uipt[0], uipt[1], &klist1, &klist2, &kstat);
	  if (kstat == 0)
	    kn1 = 0;
	}

      /* Count all the points that are candidates for connection. */
      for (kv = ki = 0; ki < kn1; ki++)
	if (ldir[ki] < 10)
	  kv++;


      if (kv == 1 && kn1 > 1 )
      {
	 int i,j;

	 if (kn1 > 2)
	 {
	    *jstat = 0;
	    for (i=0;i<kn1;i++)
	       if (ldir[i] == 1 || ldir[i] == -1)
		  *jstat = 1;
	    goto out;
	 }


	 if (ldir[0] == 1 || ldir[0] == -1)
	 {
	    i =  0;
	    j =  1;
	 }
	 else if (ldir[1] == 1 || ldir[1] == -1)
	 {
	    i =  1;
	    j =  0;
	 }
	 else						i = -1;

	 if (i >=0)
	 {
	    /* We have one point, and the direction is in/out.
	       The other point is touching a corner it is probably
	       an error and the point must be close to tangential.*/
	    if (ldir[i] == -1)
	    {
	       int k=j;
	       j  =  i;
	       i  =  k;
	    }

	    sh6tomain (uipt[i], &kstat);
	    sh6tomain (uipt[j], &kstat);

	    sh6idcon (&rintdat, &uipt[i], &uipt[j], &kstat);
	    if (kstat < 0)
	       goto error;
	    sh6setdir (uipt[i], uipt[j], &kstat);
	    if (kstat < 0)
	       goto error;
	    *jstat = 0;
	 }
      }
      else if (kv < 2)
	/* Less than two points, it's a simple case. */
	*jstat = 0;

      else if (kv > 8)
	/* More than eight points, it's not a simple case. */
	*jstat = 1;
      else
	/* We have two, three or four points, prepare a marching strategy
           for connection.*/
	{
	  lstatus[0] = 1;
	  lstatus[1] = -1;
	  lstatus[2] = 0;
	  lstatus[3] = 2;

	  lnumb[0] = 0;
	  lnumb[1] = 0;
	  lnumb[2] = 0;
	  lnumb[3] = 0;

	  if ((lperm = new0array (kv, int)) == SISL_NULL)
	    goto err101;
	  if ((lpermdir = new0array (kv, int)) == SISL_NULL)
	    goto err101;
	  if ((spar = newarray (2 * kv, double)) == SISL_NULL)
	    goto err101;

	  for (kn = 0, kj = 0; kn < 4 && kj < kv; kn++)
	    {
	      /* We pass through the points four times, one for each
                 possible statusvalue.*/
	      /* In this way they will be sorted : 111..-1-1-1..000..222.. */

	      for (ki = 0; ki < kn1 && kj < kv; ki++)
		{

		  if (ldir[ki] == lstatus[kn])
		    {
		      lnumb[kn] += 1;
		      spar[2 * kj] = uipt[ki]->epar[0];
		      spar[2 * kj + 1] = uipt[ki]->epar[1];
		      lperm[kj] = ki;
		      lpermdir[kj] = ldir[ki];
		      kj++;
		    }
		}
	    }

	  /* If the first point is a parallel point, change status. */
	  if (lpermdir[0] == 0)
	    lpermdir[0] = 11;

	  /* UJK, aug. 92 */
	  if (kv == 3)
	    {
	       /* When three points, check if they are connected. */

	       sh6getlist (uipt[lperm[0]], uipt[lperm[1]],
			   &klist1, &klist2, &kstat);
	       if (kstat < 0) goto error;
	       sh6getlist (uipt[lperm[0]], uipt[lperm[2]],
			   &klist1, &klist2, &kstat1);
	       if (kstat1 < 0) goto error;
	       sh6getlist (uipt[lperm[1]], uipt[lperm[2]],
			   &klist1, &klist2, &kstat2);
	       if (kstat2 < 0) goto error;

	       if (kstat + kstat1 + kstat2 <= 1)
		 {
		    *jstat=0;
		    goto out;
		 }
	    }

	  if (kv == 3 &&  lpermdir[2] == 2)
	     {
		/* When three points, one singular, check if they are connected. */

		sh6getlist (uipt[lperm[0]], uipt[lperm[2]],
			    &klist1, &klist2, &kstat);
		sh6getlist (uipt[lperm[1]], uipt[lperm[2]],
			    &klist1, &klist2, &kstat1);

		if (kstat == 0 && kstat1 == 0)
		{
		   *jstat=0;
		   goto out;
		}
		else if (kstat1 == 0 &&
			 abs(lpermdir[0]) == 1 &&
			     lpermdir[1] == 0  &&
			     lpermdir[2] == 2)
		   {
		      /* Sing point is connected to parallell,
			 connect singular point to in(out) point. */
		      sh6tomain (uipt[lperm[0]], &kstat);
		      sh6tomain (uipt[lperm[2]], &kstat);

		      sh6idcon (&rintdat, &uipt[lperm[0]],
				&uipt[lperm[2]], &kstat);
		      if (kstat < 0)
			 goto error;

			 /* Set in/out direction */
			 if (lpermdir[0] == 1)
			    sh6setdir (uipt[lperm[0]],
				       uipt[lperm[2]], &kstat);
			 else
			 sh6setdir (uipt[lperm[2]],
				    uipt[lperm[0]], &kstat);

			 if (kstat < 0)
			    goto error;

			    /* Set status JUNCTION point. */
			    uipt[lperm[2]]->iinter = SI_SING;


		      *jstat=0;
		      goto out;
		   }


	     }


	  /* UJK 18.09.90 Connecting whenever we have two points and
             at least one of them is moving in or out. */
	  if (kv == 2 && (abs (lpermdir[0]) == 1))
/*	  if (kv==2 &&
	      ((lpermdir[0]*lpermdir[1] == -1) ||
	       (abs(lpermdir[0])==1 && lpermdir[1] == 0))) */
	    {
	      /* We have only two points and there has to be a curve,
                 connect. */
	      sh6tomain (uipt[lperm[0]], &kstat);
	      sh6tomain (uipt[lperm[1]], &kstat);

	      sh6idcon (&rintdat, &uipt[lperm[0]], &uipt[lperm[1]], &kstat);
	      if (kstat < 0)
		goto error;

	      /* Newi (ujk) Set in/out direction */
	      if (lpermdir[0] == 1)
		sh6setdir (uipt[lperm[0]],
			   uipt[lperm[1]], &kstat);
	      else
		sh6setdir (uipt[lperm[1]],
			   uipt[lperm[0]], &kstat);

	      if (kstat < 0)
		goto error;

	      /* ALA && UJK 19.09.90 Set status JUNCTION point. */
	      if (lpermdir[1] == 2)
		uipt[lperm[1]]->iinter = SI_SING;

	      /* UJK,aug 93, Problems in sh1d_div, simple case may result
		 in connecting to edge pts that is singular in the original
		 problem, create one extra, internal pt if possible. */
	      if (DEQUAL(uipt[lperm[0]]->epar[0],uipt[lperm[1]]->epar[0]) ||
		  DEQUAL(uipt[lperm[0]]->epar[1],uipt[lperm[1]]->epar[1]))
	      {
		 SISLObject *obj=SISL_NULL;
		 SISLIntpt *pint=SISL_NULL;
		 double start;
		 double *result;
		 double coor[2];
		 if ((obj = newObject(SISLCURVE))== SISL_NULL) goto err101;
		 if (fabs(uipt[lperm[0]]->epar[0]-uipt[lperm[1]]->epar[0]) >
		     fabs(uipt[lperm[0]]->epar[1]-uipt[lperm[1]]->epar[1]))
		 {
		    coor[0] = (uipt[lperm[0]]->epar[0]+uipt[lperm[1]]->epar[0])/(double)2.0;
		    result = coor+1;
		    s1437(ps,coor[0],&(obj->c1),&kstat);
		    if (kstat < 0) goto error;
		 }
		 else
		 {
		    coor[1] = (uipt[lperm[0]]->epar[1]+uipt[lperm[1]]->epar[1])/(double)2.0;
		    result = coor;
		    s1436(ps,coor[1],&(obj->c1),&kstat);
		    if (kstat < 0) goto error;
		 }
		 start = s1792(obj->c1->et,obj->c1->ik,obj->c1->in);

		 sh6ptobj(&alevel, obj, aepsge, &start, result, &kstat);
		 if (kstat < 0) goto error;
		 if (kstat == 1)
		 {
		    pint = hp_newIntpt (2, coor, DZERO,
					SI_ORD, SI_UNDEF, SI_UNDEF,
					SI_UNDEF, SI_UNDEF,
					0, 0, SISL_NULL, SISL_NULL);


		    if (pint == SISL_NULL)
		       goto err101;

		    sh6insert (&rintdat, uipt[lperm[0]], uipt[lperm[1]],
			       &pint,&kstat);
		    if (kstat < 0)
		       goto error;


		 }
		 if (obj) freeObject(obj);

	      }
	      /* ______E N D aug.93________ */

	      *jstat = 0;
	    }

	  else if (kv > 4 && lpermdir[kv - 1] != -1)
	    /* More than four points, some with status /= +-1;
               , it's not a simple case. */
	    *jstat = 1;

	  else if (kv == 3 &&
		   lpermdir[0] == 1 &&
		   lpermdir[1] == -1 &&
		   lpermdir[2] == 0)
	    /* Three points, one in, one out, one parallel, connect in-out,
               delete parallel.. */
	    {

	      sh6tomain (uipt[lperm[0]], &kstat);
	      sh6tomain (uipt[lperm[1]], &kstat);

	      sh6idcon (&rintdat, &uipt[lperm[0]], &uipt[lperm[1]], &kstat);
	      if (kstat < 0)
		goto error;
	      sh6setdir (uipt[lperm[0]],
			 uipt[lperm[1]], &kstat);
	      if (kstat < 0)
		goto error;

	      /* UJK, Aug.92, can't delete the parallel point
		 if it's in the corner. */

	      for (kn1 = kj = 0; kj < pedge->iedge; kj++)
		if (edg[lperm[2]] & (1<<kj)) kn1++;

	       if (kn1 < 2)
		 {
		    sh6idkpt (&rintdat, &uipt[lperm[2]], 1, &kstat);
		    if (kstat < 0)
		      goto error;
		 }

	      *jstat = 0;
	    }
	  /* ALA UJK 31.10.90 Some special analysis when simple case
             and two nondirectional points. */
	  else if (kv == 2 && isimple > 0)
	    {
	      if (edg[lperm[0]] & edg[lperm[1]])
		{
		  /* The two points are on the same edge. */
		  sh6getlist (uipt[lperm[0]], uipt[lperm[1]], &klist1, &klist2, &kstat);
		  if (kstat == 0)
		    /* The points are connected, ok. */
		    *jstat = 0;
		  else
		    /* We must subdivide further. */
		    *jstat = 1;
		}
	      else
		{
		  /* The points are not on the same edge, connect. */

		  sh6tomain (uipt[lperm[0]], &kstat);
		  sh6tomain (uipt[lperm[1]], &kstat);

		  sh6idcon (&rintdat, &uipt[lperm[0]], &uipt[lperm[1]], &kstat);
		  if (kstat < 0)
		    goto error;
		  /* Set status JUNCTION point. */
		  if (lpermdir[0] == 2)
		    uipt[lperm[0]]->iinter = SI_SING;
		  if (lpermdir[1] == 2)
		    uipt[lperm[1]]->iinter = SI_SING;

		  *jstat = 0;
		}
	    }


	  /* end 31.10.90 */

	  /* UJK 18.09.90 Marching singular cases is VERY expensiv and leads
             to nothing.  (Number of points is here more than 2)*/
	  else if (lnumb[3] >= 2)
	    *jstat = 1;
	  /*end 18.09.90 */

	  else if (kv == 2 || (isimple > 0 && (lnumb[2] < 2)))
	    {
	      /* If we got two points, we always try marching as the second
                 strategy. */
	      /* If we got more than two points, we march only when the
                 input parameter isimple is set and the no more than one
                 parallel point is given.*/

	      s9conmarch (ps, alevel, spar, lpermdir, kv, &sparout,
			  &lpar, &kpoints, &kstat);
	      if (kstat < 0)
		goto error;

	      /* Branch on the given result from s9conmarch. */
	      if (kstat == 0)
		/* The points are not connected, continue subdividing. */
		*jstat = 1;

	      else if (kstat == 2)
		/* Only singulear points, set status ok. */
		*jstat = 0;

	      else
		{
		  if (kpoints > kv)
		    {
		      if ((uinewpt = newarray (kpoints - kv, SISLIntpt *))
			  == SISL_NULL)
			goto err101;
		      for (kj = kv, ki = 0; kj < kpoints; kj++, ki++)
			{
			  /* For each new point returned from s9conmarch,
                             we create an intersection point. */
			  SISLIntpt *qt;
			  double sintpar[2];

			  sintpar[0] = sparout[2 * kj];
			  sintpar[1] = sparout[2 * kj + 1];

			  uinewpt[ki] = qt = hp_newIntpt (2, sintpar, DZERO,
						 SI_ORD, SI_UNDEF, SI_UNDEF,
							  SI_UNDEF, SI_UNDEF,
							0, 0, nullp, nullp);


			  if (qt == SISL_NULL)
			    goto err101;

			  sh6idnpt (&rintdat, &qt, 1, &kstat);
			  if (kstat < 0)
			    goto error;

			}
		    }

		  /* Now we connect the points. */
		  *jstat = 0;

		  for (kj = 0; kj < kv; kj++)
		    {
		      ki = lpar[kj] - 1;

		      if (lpar[kj] > 0)
			{
			  if (lpar[kj] > kv)
			    {
			      /* SISLPoint is to be connected to a new point */
			      sh6tomain (uipt[lperm[kj]], &kstat);
			      sh6tomain (uinewpt[ki - kv], &kstat);

			      sh6idcon (&rintdat, &uipt[lperm[kj]],
					&uinewpt[ki - kv], &kstat);
			      if (kstat < 0)
				goto error;

			      /* Newi (ujk) Set in/out direction */
			      if (lpermdir[kj] == 1)
				sh6setdir (uipt[lperm[kj]],
					   uinewpt[ki - kv], &kstat);
			      else if (lpermdir[kj] == -1)
				sh6setdir (uinewpt[ki - kv],
					   uipt[lperm[kj]], &kstat);

			      if (kstat < 0)
				goto error;
			    }
			  else
			    {
			      /* SISLPoint is to be connected to an old point */
			      sh6tomain (uipt[lperm[kj]], &kstat);
			      sh6tomain (uipt[lperm[ki]], &kstat);
			      sh6idcon (&rintdat, &uipt[lperm[kj]],
					&uipt[lperm[ki]], &kstat);
			      if (kstat < 0)
				goto error;


			      /* Newi (ujk) Set in/out direction */
			      if (lpermdir[kj] == 1 || lpermdir[ki] == -1)
				sh6setdir (uipt[lperm[kj]],
					   uipt[lperm[ki]], &kstat);
			      else if (lpermdir[kj] == -1 ||
				       lpermdir[ki] == 1)
				sh6setdir (uipt[lperm[ki]],
					   uipt[lperm[kj]], &kstat);
			      if (kstat < 0)
				goto error;
			    }
			}
		    }
		}
	    }
	  else
	    /* The input parameter isimple is not set, no marching
               is to be done. */
	    *jstat = 1;
	}
    }


  goto out;

/* Error in sub rutines.      */

error:*jstat = kstat;
  s6err ("sh1762_s9edgpscon", *jstat, 0);
  goto out;

/* Error in memory allocation.      */

err101:*jstat = -101;
  s6err ("sh1762_s9edgpscon", *jstat, 0);
  goto out;

/* Error dimension.      */

err200:*jstat = -200;
  s6err ("sh1762_s9edgpscon", *jstat, 0);
  goto out;

out:
  if (uipt != SISL_NULL)
    freearray (uipt);
  if (edg != SISL_NULL)
    freearray (edg);
  if (ldir != SISL_NULL)
    freearray (ldir);
  if (sval != SISL_NULL)
    freearray (sval);

  if (uinewpt != SISL_NULL)
    freearray (uinewpt);
  if (spar != SISL_NULL)
    freearray (spar);
  if (sparout != SISL_NULL)
    freearray (sparout);
  if (lpar != SISL_NULL)
    freearray (lpar);
  if (lperm != SISL_NULL)
    freearray (lperm);
  if (lpermdir != SISL_NULL)
    freearray (lpermdir);
}

//===========================================================================
void sh1762_s9simple (SISLObject * po1, SISLObject * po2, SISLEdge * vedge[],
		      int *jstat)
//===========================================================================
{
  int kstat;
  int kk1, kk2;
  int kn1, kn2;
  int kdim, knum;
  int klin1 = 0, klin2 = 0;
  double *et1, *et2;
  double tstart1, tstart2, tend1, tend2;
  double tvolorg, tvol, tvolfac;
  SISLIntpt **up = SISL_NULL;

  kdim = po1->s1->idim;
  if (kdim != po2->s1->idim)
    goto err106;


  /* Init to no simpel case. */
  *jstat = 0;

  /* Count number of different edge-intersection points. */
  /* sh1762_s9edgpoint (vedge, &up, &knum, &kstat); */
  sh6edgpoint (vedge, &up, &knum, &kstat);
  if (kstat < 0)
    goto error;

  /* No point on edge, continue subdividing. */
  if (knum == 0)
    goto out;

  /* We test if one of the two objects is liniar. */
  if (po1->s1->pdir != SISL_NULL)
    if (po1->s1->pdir->igtpi == 0 && po1->s1->pdir->aang <= ANGULAR_TOLERANCE)
      klin1 = 1;

  if (po2->s1->pdir != SISL_NULL)
    if (po2->s1->pdir->igtpi == 0 && po2->s1->pdir->aang <= ANGULAR_TOLERANCE)
      klin2 = 1;
  /* UJK, This is a coincidence or simple case test ? */
  /* Both objects are linear, stop subdividing. */
  /*  if (klin1 == 1 && klin2 == 1)
     {
     *jstat = 1;
     goto out;
     } */

  /* Set different percent factor depending on number of edge points. */
  if (knum == 1)
    tvolfac = (double) 0.0001;
  else
    tvolfac = (double) 0.00390625;

  /* Get attributes from surface no 1. */
  tstart1 = po1->s1->et1[po1->s1->ik1 - 1];
  tend1 = po1->s1->et1[po1->s1->in1];
  tstart2 = po1->s1->et2[po1->s1->ik2 - 1];
  tend2 = po1->s1->et2[po1->s1->in2];

  et1 = po1->o1->s1->et1;
  et2 = po1->o1->s1->et2;
  kk1 = po1->o1->s1->ik1;
  kk2 = po1->o1->s1->ik2;
  kn1 = po1->o1->s1->in1;
  kn2 = po1->o1->s1->in2;

  tvolorg = (et1[kn1] - et1[kk1 - 1]) * (et2[kn2] - et2[kk2 - 1]);
  tvol = (tend1 - tstart1) * (tend2 - tstart2);

  /* Get attributes from surface no 1. */
  tstart1 = po2->s1->et1[po2->s1->ik1 - 1];
  tend1 = po2->s1->et1[po2->s1->in1];
  tstart2 = po2->s1->et2[po2->s1->ik2 - 1];
  tend2 = po2->s1->et2[po2->s1->in2];

  et1 = po2->o1->s1->et1;
  et2 = po2->o1->s1->et2;
  kk1 = po2->o1->s1->ik1;
  kk2 = po2->o1->s1->ik2;
  kn1 = po2->o1->s1->in1;
  kn2 = po2->o1->s1->in2;

  tvolorg = tvolorg * (et1[kn1] - et1[kk1 - 1]) * (et2[kn2] - et2[kk2 - 1]);
  tvol = tvol * (tend1 - tstart1) * (tend2 - tstart2);

  if (tvol <= tvolorg * tvolfac)
    *jstat = 1;

  goto out;

  /* Error in input. Dimensions of curves conflicting. */

err106:*jstat = -106;
  s6err ("sh1762_s9simple", *jstat, 0);
  goto out;

  /* Error in sub rutines.      */

error:*jstat = kstat;
  s6err ("sh1762_s9simple", *jstat, 0);
  goto out;

out:if (up != SISL_NULL)
    freearray (up);
}

//===========================================================================
void sh1762_s9reex (SISLObject * po1, SISLObject * po2, SISLEdge * vedge[],
		    double aepsge, SISLIntdat * pintdat, int *jstat)
//===========================================================================
{
  int kstat;
  SISLIntpt **up = SISL_NULL;

  *jstat = 0;

  if (po1->iobj == SISLSURFACE && po2->iobj == SISLSURFACE)
    {
      int knum = 0;

      if (vedge[0]->ipoint + vedge[1]->ipoint > 1)
	{
	  /* The edges might be corrupt caused by killpoint,
             check existance of edgepoints. */

	  int kn1, kn, ki, kj;
	  SISLPtedge *qpt;

	  kn1 = pintdat->ipoint;

	  /* Loop for both objects*/
	  for (kn = 0; kn < 2; kn++)
	    if (vedge[kn] != SISL_NULL)
	      /* Loop for objects edges*/
	      for (kj = 0; kj < vedge[kn]->iedge; kj++)
		/* Loop for all points on edge*/
		for (qpt = vedge[kn]->prpt[kj]; qpt != SISL_NULL; qpt = qpt->pnext)
		  {
		    /* Loop for all points in intersection data*/
		    for (ki = 0; ki < kn1; ki++)
		      if (qpt->ppt == pintdat->vpoint[ki])
			break;

		    /* SISLPoint not found, quit! */
		    if (ki == kn1)
		      goto out;

		  }

	  /* sh1762_s9edgpoint (vedge, &up, &knum, &kstat); */
	  sh6edgpoint (vedge, &up, &knum, &kstat);
	  if (kstat < 0)
	    goto error;
	}

      if (knum > 1)
	{
	  int ki, kj;
	  int klist1, klist2;
	  double *spar;

	  /* We have to examine if any intersection points
             point to an internal or an other edge point. */

	  for (ki = 0; ki < knum; ki++)
	    if (sh6nmbmain (up[ki], &kstat) > 0)
	      {
		for (kj = 0; kj < knum; kj++)
		  {
		    sh6getlist (up[ki], up[kj], &klist1, &klist2, &kstat);
		    if (kstat == 0)
		      goto out;
		  }

		for (kj = 0; kj < up[ki]->no_of_curves; kj++)
		  {
		    spar = up[ki]->pnext[kj]->epar;

		    if (spar[0] > po1->s1->et1[po1->s1->ik1 - 1] &&
			spar[0] < po1->s1->et1[po1->s1->in1] &&
			spar[1] > po1->s1->et2[po1->s1->ik2 - 1] &&
			spar[1] < po1->s1->et2[po1->s1->in2] &&
			spar[2] > po2->s1->et1[po2->s1->ik1 - 1] &&
			spar[2] < po2->s1->et1[po2->s1->in1] &&
			spar[3] > po2->s1->et2[po2->s1->ik2 - 1] &&
			spar[3] < po2->s1->et2[po2->s1->in2])
		      goto out;
		  }

	      }


	  sh1762_s9edgsscon (vedge, po1->s1, po2->s1, pintdat, 0,
			     aepsge, &kstat);
	  if (kstat < 0)
	    goto error;

	  /* Test if any connections is done in sh1762_s9edgsscon. */

	  if (kstat == 0) *jstat = 1;
	}
    }
  else if ((po1->iobj == SISLPOINT &&
	    po2->iobj == SISLSURFACE &&
	    po1->p1->idim == 1) ||
	   (po1->iobj == SISLSURFACE &&
	    po2->iobj == SISLPOINT &&
	    po2->p1->idim == 1))
    {
      int knum = 0;

      if (vedge[0] != SISL_NULL)
	knum = vedge[0]->ipoint;
      if (vedge[1] != SISL_NULL)
	knum += vedge[1]->ipoint;

      if (knum > 1)
	{
	  /* The edges might be corrupt caused by killpoint,
             check existance of edgepoints. */

	  int kn1, kn, ki, kj;
	  SISLPtedge *qpt;

	  kn1 = pintdat->ipoint;

	  /* Loop for both objects*/
	  for (kn = 0; kn < 2; kn++)
	    if (vedge[kn] != SISL_NULL)
	      /* Loop for objects edges*/
	      for (kj = 0; kj < vedge[kn]->iedge; kj++)
		/* Loop for all points on edge*/
		for (qpt = vedge[kn]->prpt[kj]; qpt != SISL_NULL; qpt = qpt->pnext)
		  {
		    /* Loop for all points in intersection data*/
		    for (ki = 0; ki < kn1; ki++)
		      if (qpt->ppt == pintdat->vpoint[ki])
			break;

		    /* SISLPoint not found, quit! */
		    if (ki == kn1)
		      goto out;

		  }

	  /* sh1762_s9edgpoint (vedge, &up, &knum, &kstat); */
	  sh6edgpoint (vedge, &up, &knum, &kstat);
	  if (kstat < 0)
	    goto error;
	}

      if (knum > 1)
	{
	  int ki, kj;
	  int klist1, klist2;
	  double *spar;
	  SISLSurf *qs1;

	  /* We have to examine if any intersection points
             point to an internal or an other edge point. */

	  if (po1->iobj == SISLSURFACE)
	    qs1 = po1->s1;
	  else
	    qs1 = po2->s1;

	  for (ki = 0; ki < knum; ki++)
	    if (sh6nmbmain (up[ki], &kstat) > 0)
	      {
		for (kj = 0; kj < knum; kj++)
		  {
		    sh6getlist (up[ki], up[kj], &klist1, &klist2, &kstat);
		    if (kstat == 0)
		      goto out;
		  }

		for (kj = 0; kj < up[ki]->no_of_curves; kj++)
		  {
		    spar = up[ki]->pnext[kj]->epar;

		    /* ALA and UJK 19.09.90, To treat the problem of
                       junction points, we have introduced equality
                       in this test. */
		    if (spar[0] >= qs1->et1[qs1->ik1 - 1] &&
			spar[0] <= qs1->et1[qs1->in1] &&
			spar[1] >= qs1->et2[qs1->ik2 - 1] &&
			spar[1] <= qs1->et2[qs1->in2])
		      goto out;
		  }

	      }


	  sh1762_s9edgpscon (vedge[(po1->iobj == SISLSURFACE ? 0 : 1)],
		       (po1->iobj == SISLSURFACE ? po2 : po1)->p1->ecoef[0],
			     qs1, 1, pintdat, aepsge, &kstat);
	  if (kstat < 0)
	    goto error;

	  /* Test if any connections is done in sh1762_s9edgpscon. */

	  if (kstat == 0) *jstat = 1;
	}
    }

  goto out;

/* Error in subroutines.      */

error:*jstat = kstat;
  s6err ("sh1762_s9reex", *jstat, 0);
  goto out;

out:if (up != SISL_NULL)
    freearray (up);
}

//===========================================================================
void sh1762_s9ptiter (SISLObject * po1, SISLObject * po2, double aepsge,
		      SISLIntdat ** pintdat, SISLEdge *vedge[], int *jstat)
//===========================================================================
{
   int kstat = 0;
   int kturn;      /* Indicates if the order of the objects is changed.      */
   int kdim;         /* Dimension of geometry space.                         */
   int kcrv;         /* Index of curve in array of edge intersections.       */
   double tptdist1;  /* Distance between point and first endpoint of curve.  */
   double tptdist2;  /* Distance between point and second endpoint of curve. */
   double tcoefd1,tcoefd2;   /* Distance between vertices of curve.          */
   double tstart,tend; /* Endparameters of curve used in iteration.          */
   double tref;        /* Referance value in equality test.                  */
   double tpar,tres;   /* Start- and endparameter of intersection point.     */
   double *sc1;      /* Pointer to coefficient of curve.                     */
   double *sc2;      /* Pointer to coefficient of curve.                     */
   double sdiff1[3]; /* Vector between point and endpoint of object.         */
   double sdiff2[3]; /* Vector between endpoint of object and closest inner
			vertex.                                              */
   double *nullp = SISL_NULL;
   SISLPoint *qpt;   /* Pointer to the point in the intersection.            */
   SISLObject *qobj2; /* Pointer to the other object in the intersection.    */
   SISLCurve *qcrv;  /* Pointer to the curve in the intersection.            */
   SISLIntpt *qt = SISL_NULL; /* Pointer to intersection point.                   */

   /* Find the order of the objects. */

   if (po1->iobj == SISLPOINT)
   {
      qpt = po1->p1;
      qobj2 = po2;
      kturn = 0;
   }
   else if (po2->iobj == SISLPOINT)
   {
      qpt = po2->p1;
      qobj2 = po1;
      kturn = 1;
   }
   else
      goto err122;

   /* Find dimension of geometry space. */

   kdim = qpt->idim;

   if (qobj2->iobj == SISLCURVE)
   {
      /* Curve object intersection. Compute distances between point and
	 endpoints of curve, and between endpoints of curve and closest
	 vertex.        */

      kcrv = 1 - kturn;
      qcrv = qobj2->c1;
      sc1 = qcrv->ecoef;
      sc2 = qcrv->ecoef + kdim*(qcrv->in - 1);

      if (qcrv->in == 2)
      {
	 /* No intersection is possible.  */

	 *jstat = 0;
	 goto out;
      }

      tptdist1 = s6dist(qpt->ecoef,sc1,kdim);
      tptdist2 = s6dist(qpt->ecoef,sc2,kdim);
      tcoefd1 = s6dist(sc1,sc1+kdim,kdim);
      tcoefd2 = s6dist(sc2,sc2-kdim,kdim);

      if (tptdist1 > (double)1.5*tcoefd1 && tptdist2 > (double)1.5*tcoefd2)
      {
	 /* The point is not close to an endpoint of the curve.
	    No intersection. NB! It may be necessary to make this
	    test less strict when we have gained some experience
	    with this routine. */

	 *jstat = 0;
	 goto out;
      }

      if (tptdist1 < tptdist2 && tptdist1 <= (double)1.5*tcoefd1)
      {
	 s6diff(qpt->ecoef,sc1,kdim,sdiff1);
	 s6diff(sc1+kdim,sc1,kdim,sdiff2);
      }
      else
      {
	 s6diff(qpt->ecoef,sc2,kdim,sdiff1);
	 s6diff(sc2-kdim,sc2,kdim,sdiff2);
      }

      /* Check if the point lies on the same side of the closest endpoint
	 of the curve as the curve itself.                                */

      if (s6scpr(sdiff1,sdiff2,kdim) < DZERO)
      {
	 /* No intersection.  */

	 *jstat = 0;
	 goto out;
      }

      /* Iterate to find the intersection point. */

      tstart = qcrv->et[qcrv->ik - 1];
      tend = qcrv->et[qcrv->in];
      tref = tend - tstart;

      if (tptdist1 < tptdist2 && tptdist1 <= (double)1.5*tcoefd1)
      {
	 tpar = tstart;

	 /* Check if there exists an intersection in the start of the
	    curve.  */

	 if (vedge[kcrv]->prpt[0] != SISL_NULL)
	 {
	    /* No iteration is to be performed. */

	    *jstat = 0;
	    goto out;
	 }
      }
      else
      {
	 tpar = tend;

	 /* Check if there exists an intersection in the end of the
	    curve.  */

	 if (vedge[kcrv]->prpt[1] != SISL_NULL)
	 {
	    /* No iteration is to be performed. */

	    *jstat = 0;
	    goto out;
	 }
      }

      s1771 (qpt, qcrv, aepsge,
	     tstart, tend, tpar, &tres, &kstat);
      if (kstat < 0)
	 goto error;

      if (kstat == 1)
	 /*Intersection point found. Control edges. */
	 if (DEQUAL (tres+tref, tstart+tref) || DEQUAL (tres+tref, tend+tref))
	    kstat = 0;

      if (kstat == 1)	/* Intersection point found. */
      {
	 *jstat = 1;	/* Mark intersection found.  */

	 /* Making intersection point. */
	 qt = hp_newIntpt (SISLCURVE, &tres, DZERO, SI_ORD,
			   SI_UNDEF, SI_UNDEF, SI_UNDEF, SI_UNDEF,
			   0, 0, nullp, nullp);

	 if (qt == SISL_NULL)
	    goto err101;

	 /* Uppdating pintdat. */
	 sh6idnpt (pintdat, &qt, 1, &kstat);
	 if (kstat < 0)
	    goto error;
      }
   }
   else
   {
      /* The other object is a surface. For the time being, set no
	 intersection. This part of the routine will be implemented
	 later. */

      *jstat = 0;
      goto out;
   }

   goto out;

   /* Error in space allocation.  */

   err101 : *jstat = -101;
   goto out;

   /* None of the objects is a point. */

   err122 : *jstat = -122;
   goto out;

   /* Error in lower level routine.  */

   error : *jstat = kstat;
   goto out;


   out:
      return;
}

//===========================================================================
void sh6tomain(SISLIntpt *pt,int *jstat)
//===========================================================================
{
   int ki; /* Loop variable. */
   int num; 
   int kstat;
   
   *jstat=0;

   if(pt == SISL_NULL) goto err1;

   if(sh6ishelp(pt))  /* If pt is a help point. */
   {
       pt->iinter = -pt->iinter;  /* Convert status to main point. */

       /* Go through all neighbours and keep invariant:
	  not more than one mainpoint connected to a help point. */
       for(ki=0; ki<pt->no_of_curves; ki++) 
       {
	   if(sh6ishelp(pt->pnext[ki]))
	   {
	      /* UJK, change all NON-terminators to main */
	      /* num=sh6nmbmain(pt->pnext[ki],&kstat); */
	       num = pt->pnext[ki]->no_of_curves;
	       if(num > 1) sh6tomain(pt->pnext[ki],&kstat);
	   }
       }

   }
   else
   {
       *jstat=1;
   }

   goto out;
   

err1:
   /* Error in input. pt is null. */
   
   *jstat = -1;
   s6err("sh6tomain",*jstat,0);
   goto out;
   
   
   out :
      return;
}


//===========================================================================
void s6fndintvl(double *et,int ik,int in,int *ileft,
		double ax1,double ax2,int mu_max,int *jstat)
//===========================================================================
{
  int kpos=0;           /* The position of the error.                      */
  int kstat=0;          /* Local status                                    */
  int kleft_1=*ileft;   /* Local version of ileft to avoid the pointer.    */
  int kleft_2=*ileft;   /* Local version of ileft to avoid the pointer.    */
  int mu = 0;           /* Knot mltiplicity.                               */
  double tmp;
  double tval;
  /* _____________________________________________________________________ */
  *jstat = 0;

  /* Sort position */
  if (ax1 > ax2)
  {
     tmp = ax1;
     ax1 = ax2;
     ax2 = tmp;
  }
  
  
  /* Find knot navigators */
  s1219(et,ik,in,&kleft_1,ax1,&kstat);
  if (kstat < 0) goto error;
  
  tval = et[kleft_1+1];
  while (tval < ax2 && tval < et[in])
  {
     mu = s6knotmult(et,ik,in,&kleft_2,tval, &kstat);
     if (mu > mu_max)
     {
	*jstat = 1;
	*ileft = kleft_2;
	break;
     }
     tval = et[kleft_2 +1];
  }
  
  /* Successful computations.  */
  goto out;
  
  
  /* Error */
 error: *jstat = kstat;
  s6err("s6fndintvl",*jstat,kpos);
  goto out;
  
 out: return;
}

//===========================================================================
int sh6getprev(SISLIntpt *pt1,SISLIntpt *pt2)
//===========================================================================
{
   int       ncurv;   /* number of curves pt1 is connected to       */
   int       index;   /* index number for pnext array              */

   index = -1;

   if(pt1 == SISL_NULL || pt2 == SISL_NULL) goto out;

   ncurv = pt1->no_of_curves;  /* note ncurv can be zero */

   index=0;
   while(index < ncurv && pt1->pnext[index] != pt2) index++;
   if(index == ncurv) index = -1;  /* no index found */

   goto out;

   out :
      return index;
}


//===========================================================================
void sh6getlist(SISLIntpt *pt1,SISLIntpt *pt2,int *index1,int *index2,int *jstat)
//===========================================================================
{
   *index1 = -1;
   *index2 = -1;

   *jstat=0;

   /* Find "next" link from pt1 to pt2. */

   *index1 = sh6getprev(pt1,pt2);
   *index2 = sh6getprev(pt2,pt1);

   if(*index1 >= 0 && *index2 < 0) goto err1;
   if(*index2 >= 0 && *index1 < 0) goto err1;

   if(*index1 < 0 && *index2 < 0) *jstat=1;


   goto out;

err1:
   /* Error --  bad data structure. */

   *jstat = -1;
   s6err("sh6getlist",*jstat,0);
   goto out;
   
   out :
      return;
}


//===========================================================================
void sh6getother(SISLIntpt *pt,SISLIntpt *pt1,SISLIntpt **pt2,int *jstat)
//===========================================================================
{
  int kstat;              /* Local status variable.    */
  int index,index1;      /* Indices for pt and pt1.   */
  int num;              /* count number of pointers    */
  int i;              /* Loop variable. */
  
   *pt2 = SISL_NULL;
   *jstat = 0;
  
  sh6getlist(pt,pt1,&index1,&index,&kstat);
  if(kstat < 0) goto error;
  if(kstat == 1) goto err1;

  if(sh6ismain(pt))  /* pt is main point. */
  {
      if(!sh6ismain(pt1)) goto err1;
      num=0;
      /* UJK, don't pass singular point ! */
      if (pt->iinter == SI_SING)
      {
	  *pt2 = SISL_NULL;
          *jstat = 2;
          goto out;
      }
	 
      for(i=0; i < pt->no_of_curves; i++)
      {
	  if(i != index1 && sh6ismain(pt->pnext[i]))
	  {
	      *pt2 = pt->pnext[i];
	      num++;
	  }
      }

      if(num == 0) *jstat = 1; /* pt is an end point. */
      else if(num > 1) /* pt is a junction point. */
      {
	  *pt2 = SISL_NULL;
          *jstat = 2;
      }
  }
  else  /* pt is help point. */
  {
      num=0;

      for(i=0; i < pt->no_of_curves; i++)
      {
	  if(i != index1)
	  {
	      *pt2 = pt->pnext[i];
	      num++;
	  }
      }

      if(num > 1) goto err2; /* Error in data structure. */
      if(num == 0) *jstat = 1; /* pt is an end point. */
  }
  
  goto out;
  

/* Error. pt1 and pt2 are not linked.  */

err1: *jstat = -1;
      s6err("sh6getother",*jstat,0);
      goto out;

/* Error in sub function.  */

/* Error in data structure. */

err2: *jstat = -2;
      s6err("sh6getother",*jstat,0);
      goto out;

/* Error in sub function.  */

error:  *jstat = kstat;
        s6err("sh6getother",*jstat,0);
        goto out;

   out:
      return;
}


//===========================================================================
void sh6getnhbrs(SISLIntpt *pt,SISLIntpt **pt1,SISLIntpt **pt2,int *jstat)
//===========================================================================
{
  int num;              /* count number of pointers    */
  int i;                /* Loop variable. */
  
   *pt1 = SISL_NULL;
   *pt2 = SISL_NULL;
   *jstat = 0;
  
  if(sh6ismain(pt))  /* pt is main point. */
  {
      num=0;

      for(i=0; i < pt->no_of_curves; i++)
      {
	  if(sh6ismain(pt->pnext[i]))
	  {
	      if(num == 0) *pt1 = pt->pnext[i];
	      else *pt2 = pt->pnext[i];
	      num++;
	  }
      }

      if(num == 0) *jstat = 3; /* pt is an isolated point. */
      else if(num == 1) *jstat = 1; /* pt is an end point. */
      else if(num > 2) /* pt is a junction point. */
      {
	  *pt1 = SISL_NULL;
	  *pt2 = SISL_NULL;
          *jstat = 2;
      }
  }
  else  /* pt is help point. */
  {
      num=pt->no_of_curves;

      if(num == 0) *jstat = 3; /* pt is an isolated point. */
      else
      {
          *pt1=pt->pnext[0];
          if(num == 1) *jstat = 1; /* pt is an end point. */
	  else
          {
              *pt2=pt->pnext[1];
              /* UJK; Oh, yeah ?, don't discriminate help points. */
	      /* if(num > 2) goto err1; Error in data structure. */
	      if (num > 2)
	      {
		 *pt1 = SISL_NULL;
		 *pt2 = SISL_NULL;
		 *jstat = 2;
	      }
          }
      }
  }
  
  goto out;
  

/* Error in data structure. */
  /*
err1: *jstat = -1;
      s6err("sh6getnhbrs",*jstat,0);
      goto out; */

   out:
      return;
}

//===========================================================================
int sh6ismain(SISLIntpt *pt)
//===========================================================================
{
   int flag = 0;

   if(pt != SISL_NULL && pt->iinter > 0) flag = 1;


   goto out;
   

   
   out :
      return flag;
}

//===========================================================================
SISLIntpt* sh6getnext(SISLIntpt *pt,int index)
//===========================================================================
{

   SISLIntpt *nextpt = SISL_NULL;

   /* check if index is within range */

   if(pt != SISL_NULL &&
      index >= 0 &&
      index < pt->no_of_curves) nextpt = pt->pnext[index];

   goto out;

   
   out :
      return nextpt;
}

//===========================================================================
int sh6ishelp(SISLIntpt *pt)
//===========================================================================
{
   int flag = 0;

   if(pt != SISL_NULL && pt->iinter < 0) flag = 1;


   goto out;
   

   
   out :
      return flag;
}

//===========================================================================
SISLIntpt * sh6getmain (SISLIntpt * pt)
//===========================================================================
{
  int ki;			/* Loop control */
  int kstat;			/* Local status */
  int more = TRUE;		/* Loop control */
  SISLIntpt *mainpt = SISL_NULL;
  SISLIntpt *pt1 = SISL_NULL;
  SISLIntpt *pt2 = SISL_NULL;
  SISLIntpt *prev = SISL_NULL;
  SISLIntpt *pcurr = SISL_NULL;
  SISLIntpt *pnext = SISL_NULL;
  /* ------------------------------------------------------------- */


  if (!sh6ishelp (pt))
    goto out;

  for (ki = 0; ki < pt->no_of_curves; ki++)
    {
      if (sh6ismain (pt1 = sh6getnext (pt, ki)))
	{
	  mainpt = pt1;
	  break;
	}
    }

  if (!mainpt)
    {
      /* No close neighbour is main, check along list
         if not meeting point. */
      sh6getnhbrs (pt, &pt1, &pt2, &kstat);
      if (kstat == 1)
	{
	  /* Terminator, go towards other end */
	  prev = pt;
	  pcurr = pt1;
	  more = TRUE;

	  while ((!mainpt) && more)
	    {
	      sh6getother (pcurr, prev, &pnext, &kstat);
	      if (kstat < 0)
		goto error;

	      if (pnext && (pnext != pt))
		{
		  if (sh6ismain (pnext))
		    mainpt = pnext;
		  else
		    {
		      prev = pcurr;
		      pcurr = pnext;
		      pnext = SISL_NULL;
		    }
		}
	      else
		more = FALSE;

	    }
	}

      else if (kstat == 0)
	{
	  /* Two neighbours, search both directions */
	  for (ki = 0, prev = pt, pcurr = pt1, more = TRUE; (!mainpt) && (ki < 2);
	       ki++, prev = pt, pcurr = pt2, more = TRUE)

	    while ((!mainpt) && more)
	      {
		sh6getother (pcurr, prev, &pnext, &kstat);
		if (kstat < 0)
		  goto error;

		if (pnext && (pnext != pt))
		  {
		    if (sh6ismain (pnext))
		      mainpt = pnext;
		    else
		      {
			prev = pcurr;
			pcurr = pnext;
			pnext = SISL_NULL;
		      }
		  }
		else
		  more = FALSE;

	      }
	}
    }

  goto out;

  /* ------------------------------------------------------------- */
error:mainpt = SISL_NULL;
  s6err ("sh6getmain", kstat, 0);
  goto out;



out:
  return mainpt;
}

//===========================================================================
void sh6idalledg (SISLObject * pob1, SISLObject * pob2, SISLIntdat * pintdat,
		  SISLEdge * wedge[], int *jstat)
//===========================================================================
{
  int kpos = 0;			/* Position of error.       */
  int kstat = 0;		/* Local error status.      */
  int ki,kj, kn;		/* Counters.                */
  int kj1, kn1;			/* Counters.                */
  int kndir;                    /* Number of par. dir.      */
  int kedg, kedg1;		/* Number of edges.         */
  int kpar;			/* Parameter number.        */
  int kleft1 = 0;               /* Index of knot.          */
  int ln[4];                    /* Number of vertices in each par. dir. */
  int lk[4];                    /* Order in each par. dir.  */
  double tpar;			/* Parameter value at edge. */
  double tparmain;              /* Parameter of main point. */
  double tparhelp;              /* Parameter of help point. */
  double *st[4];                /* Pointer to knot vector in each par. dir. */
  SISLObject *qob1, *qob2;	/* Help pointer to object.  */
  SISLObject *qob11, *qob21;	/* Help pointer to object.  */
  SISLPtedge *pte = SISL_NULL;
  SISLPtedge *prev = SISL_NULL;
  SISLPtedge *pte1 = SISL_NULL;
  SISLIntpt *pmain;
  int notfound;

  /* Set up information about the knot vector in each parameter direction. */

  if (pob1->iobj == SISLCURVE)
  {
     ln[0] = pob1->c1->in;
     lk[0] = pob1->c1->ik;
     st[0] = pob1->c1->et;
  }
  else if (pob1->iobj == SISLSURFACE)
  {
     ln[0] = pob1->s1->in1;
     lk[0] = pob1->s1->ik1;
     st[0] = pob1->s1->et1;
     ln[1] = pob1->s1->in2;
     lk[1] = pob1->s1->ik2;
     st[1] = pob1->s1->et2;
  }

  if (pob2->iobj == SISLCURVE)
  {
     ln[pob1->iobj] = pob2->c1->in;
     lk[pob1->iobj] = pob2->c1->ik;
     st[pob1->iobj] = pob2->c1->et;
  }
  else if (pob2->iobj == SISLSURFACE)
  {
     ln[pob1->iobj] = pob2->s1->in1;
     lk[pob1->iobj] = pob2->s1->ik1;
     st[pob1->iobj] = pob2->s1->et1;
     ln[pob1->iobj+1] = pob2->s1->in2;
     lk[pob1->iobj+1] = pob2->s1->ik2;
     st[pob1->iobj+1] = pob2->s1->et2;
  }

  for (kn = 0, qob1 = pob1, qob2 = pob2; kn < 2; kn++, qob1 = pob2, qob2 = pob1)
    {
      kedg = (qob1->iobj == SISLPOINT ? 0 : (qob1->iobj == SISLCURVE ? 2 : 4));

      if (kedg)
	wedge[kn]->ipoint = 0;

      for (kj = 0; kj < kedg; kj++)
	{
	  if (qob1->iobj == SISLCURVE)
	    {
	      tpar = (kj == 0 ? qob1->c1->et[qob1->c1->ik - 1] :
		      qob1->c1->et[qob1->c1->in]);
	      kpar = 1;
	    }
	  else if (kj == 0)
	    {
	      tpar = qob1->s1->et2[qob1->s1->ik2 - 1];
	      kpar = 2;
	    }
	  else if (kj == 1)
	    {
	      tpar = qob1->s1->et1[qob1->s1->in1];
	      kpar = 1;
	    }
	  else if (kj == 2)
	    {
	      tpar = qob1->s1->et2[qob1->s1->in2];
	      kpar = 2;
	    }
	  else
	    {
	      tpar = qob1->s1->et1[qob1->s1->ik1 - 1];
	      kpar = 1;
	    }

	  s6idedg ((kn == 0 ? qob1 : qob2), (kn == 0 ? qob2 : qob1),
		   kn + 1, kpar, tpar, pintdat,
		   &(wedge[kn]->prpt[kj]), &(wedge[kn]->ipoint), &kstat);
	  if (kstat < 0)
	    goto error;
	}
    }

  /* UJK newi; remove helppoints if main point is present */
  for (kn = 0, qob1 = pob1, qob2 = pob2; kn < 2; kn++, qob1 = pob2, qob2 = pob1)
    {
      kedg = (qob1->iobj == SISLPOINT ? 0 : (qob1->iobj == SISLCURVE ? 2 : 4));

      for (kj = 0; kj < kedg; kj++)
	{
	  for (pte = wedge[kn]->prpt[kj], prev = pte;
	       pte != SISL_NULL;)
	    {
	      notfound = TRUE;

	      if ((pmain = sh6getmain (pte->ppt)))
		{
		  /* pte is a help point and pmain is the
	             main point connected to it */

		   /* Check if the help point and main point lie
		      in different knot intervals in any parameter
		      direction. In that case, keep the help point.  */

		   for (kndir=pob1->iobj+pob2->iobj, ki=0;
		    ki<kndir; ki++)
		   {
		      tparmain = pmain->epar[ki];
		      tparhelp = pte->ppt->epar[ki];

		      /* Find position of parameter value in
			 to the knot vector.                  */

		      /* __________________________________ */
		      /* UJK, sept 93, this did not work
			 for left hand help pts. */
		      /*s1219(st[ki],lk[ki],ln[ki],&kleft1,tparmain,&kstat);
			 if (kstat < 0) goto error;

			 s1219(st[ki],lk[ki],ln[ki],&kleft2,tparhelp,&kstat);
			 if (kstat < 0) goto error;

			 if (kleft1 != kleft2) break;*/

		      s6fndintvl(st[ki],lk[ki],ln[ki],&kleft1,
				 tparmain,tparhelp,0,&kstat);
		      if (kstat < 0) goto error;

		      if (kstat) break;

		      /* UJK, sept 93, END */
		      /* __________________________________ */
		   }

		   if (ki == kndir)
		   {
		      /* Search for pmain */
		      for (kn1 = 0, qob11 = pob1, qob21 = pob2;
		       kn1 < 2 && notfound;
		       kn1++, qob11 = pob2, qob21 = pob1)
		      {
			 kedg1 = (qob11->iobj == SISLPOINT ?
				  0 : (qob11->iobj == SISLCURVE ? 2 : 4));

			 for (kj1 = 0; kj1 < kedg1 && notfound; kj1++)
			 {
			    for (pte1 = wedge[kn1]->prpt[kj1];
			     pte1 != SISL_NULL && notfound;
			     pte1 = pte1->pnext)
			       if (pte1->ppt == pmain)
				  notfound = FALSE;
			 }
		      }
		   }
		}

	      if (notfound == FALSE)
		{
		  /* Main point is present, remove help point. */
		  if (prev == pte)
		    {
		      wedge[kn]->prpt[kj] = pte->pnext;
		      freePtedge (pte);
		      pte = wedge[kn]->prpt[kj];
		      prev = pte;
		      wedge[kn]->ipoint--;
		    }
		  else
		    {
		      prev->pnext = pte->pnext;
		      freePtedge (pte);
		      pte = prev->pnext;
		      wedge[kn]->ipoint--;
		    }
		}
	      if (notfound == TRUE)
		{
		  sh6tomain(pte->ppt, &kstat);
		  prev = pte;
		  pte = pte->pnext;
		}

	    }
	}
    }


  *jstat = 0;

  goto out;

/* Error in lower level routine.      */

error:*jstat = kstat;
  s6err ("sh6idalledg", *jstat, kpos);
  goto out;

out:;
}

//===========================================================================
void freePtedge(SISLPtedge *p1)
//===========================================================================
{
  /* Free the space that p1 occupies. */

  freearray(p1);

  return;
}

//===========================================================================
void freeEdge(SISLEdge *pedge)
//===========================================================================
{

  SISLPtedge *p1,*p2;  /* Pointers to traverse lists of Ptedge-elements.*/
  SISLPtedge *(*pel);  /* Pointer to an array element.      */
  int ki;                 /* Counter.                          */

  /* First free the space occupied by the lists pointed at by
     the array prpt.                                           */

  pel = pedge -> prpt;
  for (ki=0; ki<pedge->iedge; ki++)
    {

      /* Traverse the list connected to edge nr ki and free the elements. */

      p1 = *pel;
      while (p1 != SISL_NULL)
	{
	  p2 = p1 -> pnext;
	  freePtedge(p1);
	  p1 = p2;
	}
      pel++;
    }

  /* Free the space occupied by the prpt array. */

  freearray(pedge -> prpt);

  /* Free the space occupied by the instance. */

  freearray(pedge);

  return;
}


//===========================================================================
void s1435(SISLSurf *ps1,int iedge,SISLCurve **rcedge,double *cpar,int *jstat)
//===========================================================================
{
  int kstat = 0;        /* Local status parameter.                        */
  int kpos = 0;         /* Position of error.                             */
  double tstart1,tend1; /* Endpoints of parameter interval in first 
			   direction.                                     */
  double tstart2,tend2; /* Endpoints of parameter interval in second 
			   direction.                                     */
  double tpar;          /* Parameter value of curve in constant parameter
			   direction.                                     */
  
  /* Fetch endpoints of parameter intervals.  */
  
  tstart1 = *(ps1->et1 + ps1->ik1 - 1);
  tend1 = *(ps1->et1 + ps1->in1);
  tstart2 = *(ps1->et2 + ps1->ik2 - 1);
  tend2 = *(ps1->et2 + ps1->in2);
  
  /* Find constant parameter of edge. */
  
  if (iedge == 0) tpar = tstart2;
  else if (iedge == 1) tpar = tend1;
  else if (iedge == 2) tpar = tend2;
  else if (iedge == 3) tpar = tstart1;
  
  if (iedge == 0 || iedge == 2)
    {
      
      /* Pick curve with constant second parameter.  */
      
      s1436(ps1,tpar,rcedge,&kstat);
      if (kstat < 0) goto error;
    }
  else if (iedge == 1 || iedge == 3)
    {
      
      /* Pick curve with constant first parameter.  */
      
      s1437(ps1,tpar,rcedge,&kstat);
      if (kstat < 0) goto error;
    }
  
  /* SISLCurve picked.  */
  
  *cpar = tpar;
  *jstat = 0;
  goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("s1435",*jstat,kpos);
  goto out;
  
 out: return;
}


//===========================================================================
SISLPtedge *newPtedge (SISLIntpt * ppt)
//===========================================================================
{
  SISLPtedge *pnew;		/* Local pointer to the instance to create. */

  /* Allocate space for the instance. */

  pnew = newarray (1, SISLPtedge);
  if (pnew == SISL_NULL)
    goto err101;

  /* Initialize instance.  */

  pnew->ppt = ppt;
  pnew->pnext = SISL_NULL;

  /* Task done.  */

  goto out;

  /* Error in space allocation. Return zero. */

err101:pnew = SISL_NULL;
  goto out;

out:return (pnew);
}


//===========================================================================
void s6idedg(SISLObject *po1,SISLObject *po2,int iobj,int ipar,double apar,
	     SISLIntdat *pintdat,SISLPtedge **rptedge,int *jnum,int *jstat)
//===========================================================================
{
  int kpos=0;                /* Position of error.                       */
  int kpar=0;                /* Numper of parameter direction second obj.*/
  int ki,kj;                 /* Counters                                 */
  double sstart[4],send[4];  /* Parameter boarders on the other obj.     */
  SISLPtedge *pte = SISL_NULL;    /* Pointers to new ptedge.                  */
  
  /* Initiate to emty list. */
  
  *rptedge = SISL_NULL;  
  *jstat = 0;
  
  /* We have to be sure that we have an intdat structure. */
  
  if (pintdat == SISL_NULL) goto out;
  
  /* Uppdate parameter boarder. */
  
  if (po1->iobj == SISLCURVE)
    {
      if (iobj == 1)
        {
	  sstart[0] = apar;
	  send[0]   = apar;
        }
      else
        {
	  sstart[0] = po1->c1->et[po1->c1->ik - 1];
	  send[0]   = po1->c1->et[po1->c1->in];
        }
      kpar = 1;
    }
  else if (po1->iobj == SISLSURFACE)
    {
      if (iobj == 1 && ipar == 1)
        {
	  sstart[0] = apar;
	  send[0]   = apar;
        }
      else
        {
	  sstart[0] = po1->s1->et1[po1->s1->ik1 - 1];
	  send[0]   = po1->s1->et1[po1->s1->in1];
        }
      if (iobj == 1 && ipar == 2)
        {
	  sstart[1] = apar;
	  send[1]   = apar;
        }
      else
        {
	  sstart[1] = po1->s1->et2[po1->s1->ik2 - 1];
	  send[1] = po1->s1->et2[po1->s1->in2];
        }
      kpar = 2;
    }
  
  
  if (po2->iobj == SISLCURVE)
    {
      if (iobj == 2)
        {
	  sstart[kpar] = apar;
	  send[kpar]   = apar;
        }
      else
        {
	  sstart[kpar] = po2->c1->et[po2->c1->ik - 1];
	  send[kpar]   = po2->c1->et[po2->c1->in];
        }
    }
  else if (po2->iobj == SISLSURFACE)
    {
      if (iobj == 2 && ipar == 1)
        {
	  sstart[kpar] = apar;
	  send[kpar]   = apar;
        }
      else
        {
	  sstart[kpar] = po2->s1->et1[po2->s1->ik1 - 1];
	  send[kpar] = po2->s1->et1[po2->s1->in1];
        }
      if (iobj == 2 && ipar == 2)
        {
	  sstart[kpar+1] = apar;
	  send[kpar+1]   = apar;
        }
      else
        {
	  sstart[kpar+1] = po2->s1->et2[po2->s1->ik2 - 1];
	  send[kpar+1]   = po2->s1->et2[po2->s1->in2];
        }
    }
    
  /* We have to go trough all intersection points to search for edges. */
  
  for (ki=0; ki<pintdat->ipoint; ki++)
    {
      for (kj=0; kj<pintdat->vpoint[ki]->ipar; kj++)
        if ((DEQUAL(sstart[kj],pintdat->vpoint[ki]->epar[kj]) ||
	     sstart[kj] < pintdat->vpoint[ki]->epar[kj]) &&
	    (DEQUAL(send[kj],pintdat->vpoint[ki]->epar[kj]) ||
	     send[kj] > pintdat->vpoint[ki]->epar[kj]));
	else
	  goto end;
      
      if (pte == SISL_NULL)
        {
	  pte = newPtedge(pintdat->vpoint[ki]);
	  if (pte == SISL_NULL) goto err101;
	  
	  (*rptedge) = pte;
	  
	  (*jnum)++;
        }
      else
        {
	  pte->pnext = newPtedge(pintdat->vpoint[ki]);
	  if (pte->pnext == SISL_NULL) goto err101;
	  
	  pte = pte->pnext;
	  
	  (*jnum)++;
        }
    end:;
    }
  
  goto out;
  
  /* Error in space allocation.  */

  err101: 
    *jstat = -101;
    s6err("s6idedg",*jstat,kpos);
    goto out;

 out:  ;
}


//===========================================================================
int s6knotmult(double et[],int ik,int in,int *ileft,double ax,int *jstat)
//===========================================================================
{
  int kpos=0;         /* The position of the error.                      */
  int kstat;          /* Local status variable                           */
  int kmult=0;        /* Multiplicity of knot                            */
  int ki;             /* Loop variable                                   */
  
  /* Localize knot interval */
  
  s1219(et,ik,in,ileft,ax,&kstat);
  if (kstat<0) goto error;
  
  if (et[*ileft] == ax)
    {
      kmult = 1;
      ki    = *ileft-1;
      for (ki=(*ileft)-1; 0 <= ki; ki--)
        if (et[ki] == ax) kmult++;
    }
  if (et[in] == ax)
    {
      for (ki=in ; ki<in+ik;ki++)
        if (et[ki] == ax) kmult++;
    }
  
  *jstat = 0;
  goto out;

/* Error in lower level function */

error:  *jstat = kstat;
        s6err("s6knotmult",*jstat,kpos);
        goto out;

out:
return(kmult);
}


//===========================================================================
void test_cyclic_knots(double et[],int in,int ik,int *jstat)
//===========================================================================
{
  int    kleft;          /* Pointer into knot interval             */
  int    kmult1;         /* Multiplicity of start parameter value  */
  int    kmult2;         /* Multiplicity of end  parameter value   */
  int    ki;             /* Control variable in loop               */
  int    kpos = 1;       /* Position of error                      */
  int    kant;           /* Number of knots before start parameter value */
  int    kcyclic;        /* Flag telling if cyclic basis           */
  int    kstat;          /* Local status variable                  */
  
  double tperiode;       /* Periode of basis                       */
  
  /* Find multiplicity of et[ik-1] and et[in] */
  
  kleft = ik-1;
  
  kmult1 = s6knotmult(et,ik,in,&kleft,et[ik-1],&kstat);
  if(kstat<0) goto error;
  
  kleft = in;
  
  kmult2 = s6knotmult(et,ik,in,&kleft,et[in],&kstat);
  if(kstat<0) goto error;
  
  if (kmult1 != kmult2 || kmult1 == ik) goto noncyclic;
  
  kant = ik - kmult1;
  tperiode = et[in] -et[ik-1];  
  
  /* Test that the first kant knots are repetitions of the knots in-kant,...,in-1 */
  
  for (ki=0, kcyclic=1; ki<kant ; ki++)
    if (DNEQUAL((et[ki]+tperiode),et[in-kant+ki])) kcyclic = 0;
  
  /* Test that the last kant knots are repetions of knots ik,..,ik+kant-1 */
  
  for (ki=0; ki<kant ; ki++)
    if (DNEQUAL((et[ik+ki]+tperiode),et[in+kmult1+ki])) kcyclic = 0;
  
  if (kcyclic == 0) goto noncyclic;
  
  /* The basis should have at least kant+ik degrees of freedom to allow for
     a proper cyclic curve with ik degrees of real freadom since kant vertices
     are repeated */
  
  if (in<ik+kant) goto missing_freedom; 
  
  /* Cyclic with enough degrees of freedom */
  
  *jstat = 2;
  goto out;
  
  /* Cyclic with less than ik+kant degrees of freedom */
 missing_freedom:
  
  *jstat = 1;
  goto out;
  
  /* Noncyclic basis */
 noncyclic:
  
  *jstat = 0;
  goto out;
  
 error:
  *jstat = kstat;
  s6err("test_cyclic_knots",*jstat,kpos);
  goto out;
  
 out:
  
  return;
  
}

//===========================================================================
double s1325(double aradiu,double angle)
//===========================================================================
{
  double tcos,tsin;          /* Dummy variables                     */
  double ta,tb,tc,tl;        /* Dummy variables                     */
  double tconst = (double)1.85530139760811990992528773586425;
                             /* Constant used in the calculation    */
  
  
  
  tcos = cos(angle);
  tsin = sin(angle);
  
  /*  Calculate length of tangents
   *   tconst = (3-2sqrt(2))**1/3 + (3+2sqrt(2))**1/3 - 0.5 */
  
  ta     = (double)0.6*tconst - (double)0.9*tcos;
  tb     = ((double)0.4*tconst+(double)1.8)*tsin;
  tc     = ((double)0.4*tconst+(double)1.0)
           * tcos - (double)0.4*tconst - (double)1.0;
  tl     = aradiu*(-tb+sqrt(tb*tb-4*ta*tc))/((double)2.0*ta);
  
  return(tl);
}

//===========================================================================
void s1359(double egeo[],double aepsge,int idim,int inbinf,
	   int ipar,double epar[],SISLCurve **rcurve,int *jstat)
//===========================================================================
{
  int kn;             /* Number of vertices                                 */
  int kk = 4;         /* Order of b-spline basis                            */
  int knt;            /* Number of knots produced so far                    */
  int kvert;          /* Pointer to first free variable in vertex array     */
  int kpos =1;        /* Position of error                                  */
  int kstat;          /* Local status variable                              */
  int ki,kj;          /* Running variables in loop                          */
  int kv1,kv2,kv3;    /* Running variables in loop                          */
  int kincre;         /* Number of doubles for each point in egeo           */
  int kcycpos;        /* Indicator telling if cyclic or open geometry       */
  double *sprevp;     /* Pointer to position at start of current segment    */
  double *sprevt;     /* Pointer to tangent  at start of current segment    */
  double *sprevc;     /* Pointer to curvature at start of current segment   */
  double *sprevr;     /* Pointer to radius of curvature start current segment*/
  double snprevt[3];  /* Nomralized version of sprevc                        */
  double *scurp;      /* Pointer to position at end   of current segment     */
  double *scurt;      /* Pointer to tangent  at end   of current segment     */
  double *scurc;      /* Pointer to curvature at end   of current segment    */
  double *scurr;      /* Pointer to radius of curvature end   current segment*/
  double sncurt[3];   /* Normalized version of scurc                         */
  double tcos;        /* Description of angle                                */
  double tl1,tl2;     /* Tangent lengths                                     */
  double tangle;      /* Arcus cosinus if tcos                               */
  double tdist;       /* Distance between start and end of current segment   */
  double tpar;        /* Parameter value at end of segment                   */
  double *st = SISL_NULL;  /* Pointer to knot vector                              */
  double *scoef=SISL_NULL; /* Pointer to vertices                                 */
  double tmpval=aepsge;/* Maximal difference in x, y and z coordinate        */
  double max_dist;
  /* Allocate space for knots and vertices */
  
  if (idim != 2 && idim != 3) goto err105;

  /* No. of points given must be > 1 since it makes no sence to interpolate
     over 0 or 1 point, so check inbinf.*/

  if (inbinf < 2) goto err181;
  
  
  if (idim==2)
    kincre = 7;
  else
    kincre = 10;
  
  
  /* To make sure that we don't make a too long jump in parametrization, find
     maximal difference in x, y and z coordinate. */
  
  if (ipar==0)
    {
      double tmin,tmax,*sp;
      
      for (kj=0 ; kj<idim ; kj++)
        {
	  tmin = *(egeo+kj);
	  tmax = tmin;
	  for (ki=0,sp=egeo+kj ; ki < inbinf ; ki++,sp+=kincre)
            {
	      tmin = MIN(tmin,*sp);
	      tmax = MAX(tmax,*sp);
            }
	  tmpval = MAX(tmpval,(tmax-tmin));
        }
    }
  
  kn = 3*(inbinf-1) + 1;
  scoef = newarray(idim*kn,DOUBLE);
  if (scoef == SISL_NULL) goto err101;
  
  st = newarray(kk+kn,DOUBLE);                                                  
  if (st == SISL_NULL) goto err101;
  
  /* Make four first knots */
  if (ipar==0)
    {
      epar[0] = DZERO;
    }
  
  st[0] = epar[0];
  st[1] = epar[0];
  st[2] = epar[0];
  st[3] = epar[0];
  
  /* Make first vertex */
  memcopy(scoef,egeo,idim,DOUBLE);
  
  
  /* Set pointers to start point, tangent, curvature and radius of curvature
   */
  
  sprevp = egeo;
  sprevt = sprevp + idim;
  sprevc = sprevt + idim;
  sprevr = sprevc + idim;
  
  /* Normalize curvature vector at start */
  
  (void)s6norm(sprevt,idim,snprevt,&kstat);
  
  for (ki=1,knt=4,kvert=idim;ki<inbinf;ki++)
    {
      
      /* For each pair of adjacent points in egeo make an Hermit segment */
      
      /* Set pointers position, tangent, curvature and radius of end of
	 current segment segment */
      
      scurp = sprevp + kincre;
      scurt = sprevt + kincre;
      scurc = sprevc + kincre;
      scurr = sprevr + kincre;
      
      /* Normalize curvature vector at end of segment */
      
      (void)s6norm(scurt,idim,sncurt,&kstat);
      
      /* Make cosine of angle between tangent vectors by making the scalar
	 product of the normalized versions of the two vectors */
      
      tcos = s6scpr(snprevt,sncurt,idim);
      
      /* Find the actual angle by making the arcus tangens of this value */
      
      if (tcos >= DZERO)             
	tcos = MIN((double)1.0,tcos);
      else
	tcos = MAX((double)-1.0,tcos);
      
      tangle = fabs(acos(tcos));
      
      if (tangle < ANGULAR_TOLERANCE) tangle = DZERO;
      
      tdist = s6dist(sprevp,scurp,idim);
      
      /* Make tangent length of start of segment */
      
      
/* UJK and VSK 24.10.90 */
/*      if (DEQUAL(tangle,DZERO) || *sprevr < (double)-1.0) */
      if (DEQUAL(tangle,DZERO) || *sprevr < DZERO)
        {
	  /* Parallel tangents or infinit radius of curvature use 1/3 of
	     the distance between the points as tangent length    */
	  tl1 = tdist/(double)3.0;
        }
      else
        {
	  /* Base tangent length on radius of curvature and opening angle */
	  tl1 = s1325(*sprevr,tangle);
        }
      
      /*  Make tangent length of end of segment */
      
      if (DEQUAL(tangle,DZERO) || *scurr < DZERO)
        {
	  /* Parallel tangents or infinit radius of curvature use 1/3 of
	     the distance between the points as tangent length         */
	  tl2 = tdist/(double)3.0;
        }
      else
        {
	  /* Base tangent length on radius of curvature and opening angle */
	  tl2 = s1325(*scurr,tangle);
        }
      
      /* Make sure that the tangent does not explode due to numeric errors,
	 and make a controlled tangent when the radius is zero or almost zero*/
      
      /* ALA 28.10.93  An improved control was nessesary*/

      if (tangle < 0.1)		max_dist = (double)0.35*tdist;
      else if (tangle < 0.35)	max_dist = (double)0.40*tdist;
      else if (tangle < 0.75)	max_dist = (double)0.50*tdist;
      else 			max_dist = (double)0.70*tdist;

      if ( tl1 > max_dist) tl1 = max_dist;
      if ( tl2 > max_dist) tl2 = max_dist;
      
      /* We want to have a parametrization that is as close as possible to an
         arc length parametrization */                                             
      
      
      if (ipar==0)
        {
	  /* Make parametrization of segment by making an average of arc of a
	     circle with radius sprevr and scurr spanning an angle tangle.
	     If one or both radius infinit use the distance between the points
	     */
	  
	  if (DNEQUAL(*sprevr,(double)-1.0) && 
	      DNEQUAL(*scurr,(double)-1.0))
            {
	      tpar = (double)0.5*tangle*(*sprevr+*scurr);
            }
	  else if (DNEQUAL(*sprevr,(double)-1.0) && 
		   DEQUAL(*scurr,(double)-1.0))
            {
	      tpar = (double)0.5*(*sprevr*tangle + tdist);
            }
	  else if (DEQUAL(*sprevr,(double)-1.0) && 
		   DNEQUAL(*scurr,(double)-1.0))
            {
	      tpar = (double)0.5*(tdist + tangle*(*scurr));
            }
	  else
            {
	      tpar =  tdist;
            }
	  
	  tpar = MAX(tpar,tdist);
	  tpar = MAX(tpar,aepsge);
	  
	  /* Make sure that we don't make a parameter inteval greater than
	     the maximal length of a SISLbox around the input points */
	  
          /* tpar = MIN(tpar,tmpval);
             BOH:220793: Start change */
	  
          if (tangle <= PIHALF)
	     tpar = MIN(tpar, ((double)1.1*tdist));
          else
	     tpar = MIN(tpar,tmpval);
	  
          /* BOH: End change. */
	  
	  if (DEQUAL((epar[ki-1]+tpar),epar[ki-1]))
            {
	      tpar = fabs(epar[ki-1])*(double)0.1;
            }
	  
	  if (DEQUAL(tpar,DZERO))
            {
	      tpar = (double)1.0;
            }
	  
	  epar[ki] = epar[ki-1] + tpar;
	  
        }
      
      /*  Make 3 new knots */
      st[knt]   = epar[ki];
      st[knt+1] = epar[ki];
      st[knt+2] = epar[ki];
      
      /*  Make 3 new vertices of segment */
      
      for (kj=0,kv1=kvert,kv2=kv1+idim,kv3=kv2+idim ; kj<idim ;
	   kj++,kv1++,kv2++,kv3++)
        {
	  scoef[kv1] = sprevp[kj] + tl1*sprevt[kj];
	  scoef[kv2] = scurp[kj]  - tl2*scurt[kj];
	  scoef[kv3] = scurp[kj];
        }
      
      /*  Update pointers */
      sprevp = scurp;
      sprevt = scurt;
      sprevc = scurc;
      sprevr = scurr;
      for (kj=0;kj<idim;kj++) snprevt[kj] = sncurt[kj];
      
      /*  Only update number of vertices if epar[ki-1] != epar[ki] */ 
      
      if (DNEQUAL(epar[ki-1],epar[ki]))
        {
	  kvert+=(3*idim);
	  knt+=3;
        }
    }
  
  /* VSK, 07.94. Moved this statement before inserting the last knot.
     Update number of vertices */
  
  kn = kvert/idim;
  
  /* Insert last knot */
  
  st[kn+kk-1] = st[kn+kk-2];
  
  /* Test if cyclic curve */

  for (ki=0, kcycpos=1 ; ki<idim ; ki++)
    if (egeo[ki] != egeo[(inbinf-1)*kincre+ki]) kcycpos=0;
  
  if (kcycpos ==1)
    {
      st[0] -= (st[kn] - st[kn-1]);
      st[kn+kk-1] += (st[kk] - st[kk-1]);
    }
  
  
  /* Make the curve */
  
  kpos = 1;
  *rcurve = SISL_NULL;
  *rcurve = newCurve(kn,kk,st,scoef,1,idim,1);
  if (*rcurve == SISL_NULL) goto err101;
  
  /* Periodicity flag */
  if (kcycpos)
    {
       test_cyclic_knots(st,kn,kk,&kstat);
       if (kstat<0) goto error;
      if (kstat == 2) (*rcurve)->cuopen = SISL_CRV_PERIODIC;
    }
  *jstat = 0;
  goto out;
  
  /* Error in space allocation.  */
  
 err101: *jstat = -101;
  s6err("s1359",*jstat,kpos);
  goto out;

  /* Error in lower level.  */
  
 error: *jstat = kstat;
  s6err("s1359",*jstat,kpos);
  goto out;
  
  /* Error in input, negative relative tolerance given */
  
 err105: *jstat = -105;
  s6err("s1359",*jstat,kpos);
  goto out;

  /* Error in input, to few points given(inbinf < 2. */

  err181: *jstat = -181;
   s6err("s1359",*jstat,kpos);
   goto out;
  
  /* Free allocated arrays */
 out:
  
  
  if (st != SISL_NULL)    freearray(st);
  if (scoef != SISL_NULL) freearray(scoef);
  
  
  return;
}

//===========================================================================
void s1421(SISLSurf *ps1,int ider,double epar[],int *ilfs,int *ilft,
	   double eder[],double enorm[],int *jstat)
//===========================================================================
{
  int kstat=0;        /* Local status variable.                          */
  int kpos=0;         /* The position of error.                          */
  int kn1,kn2;        /* The number of B-splines accociated with the knot
			 vectors st1 and st2.                            */
  int kk1,kk2;        /* The polynomial order of the surface in the two
			 directions.                                     */
  int kdim;           /* The dimension of the space in which the surface
			 lies. Equivalently, the number of components
			 of each B-spline coefficient.                   */
  int kleft2,kleft1;  /* Local versions of ilfs and ilft which are
			 used in order to avoid the pointers.            */
  int ki,kj,kih,kjh;  /* Control variables in for loops and for stepping
			 through arrays.                                 */
  int kh,kl,kl1,kl2;  /* Control variables in for loops and for stepping
			 through arrays.                                 */
  double *st1,*st2;   /* The knot vectors of the surface. These have
			 length [kn1+kk1] and [kn2+kk2],
			 respectively.                                   */
  double *scoef;      /* The B-spline coefficients of the surface.
			 This is an array of dimension [kn2*kn1*kdim].   */
  double tt;          /* Dummy variable used for holding an array element
			 in a for loop.                                  */
  double *ebder=SISL_NULL; /* Pointer to an array of dimension
			 [max(kk1*(ider+1),kk2*(ider+1))] which will
			 contain the values and ider first derivatives of
			 the kk1 (kk2) nonzero B-splines at epar[0] (epar[1]).
			 These are stored in the following order:
			 First the value, 1. derivative etc. of the
			 first nonzero B-spline, then the same for the
			 second nonzero B-spline and so on.              */
  
  double *ew=SISL_NULL;    /* Pointer to an array of dimension [kk1*(ider+1)*kdim]
			 which will be used to store the result of the first
			 matrix multiplication in (2) above. This array is
			 initialized to all zeros.                       */
  double *sder=SISL_NULL;  /* Pointer to array used for storage of points, if
			 non rational sder points to eder, if rational sder
			 has to be allocated to make room for the homogenous
			 coordinate */
  
  double sdum1[49];   /* Arraye used for ebder */
  double sdum2[147];  /* Array used for ew */
  int knumb1;         /* Necessary size of ebder */   
  int knumb2;         /* Necessary size of ew */   

  int tot,temp;       /* Temporary variables. */
  int kinc;           /* For controlling kih.                */
  
  kleft1 = *ilfs;
  kleft2 = *ilft;
  
  /* Copy surface to local parameters.  */
  
  kn1 = ps1 -> in1;
  kn2 = ps1 -> in2;                                         
  kk1 = ps1 -> ik1;
  kk2 = ps1 -> ik2;
  st1 = ps1 -> et1;
  st2 = ps1 -> et2;
  kdim = ps1 -> idim;
  if (ps1->ikind == 2 || ps1->ikind == 4)
    {
      scoef = ps1 -> rcoef;
      kdim +=1;
      if((sder=newarray(kdim*(ider+1)*(ider+2)/2,DOUBLE)) == SISL_NULL)
         goto err101;
    }
  else
    {
      scoef = ps1 -> ecoef;
      sder = eder;  
    }
  
  /* Check the input. */
  
  if (kdim < 1) goto err102;
  if (kk1 < 1) goto err115;
  if (kn1 < kk1 || kn2 < kk2) goto err116;
  if (ider < 0) goto err178;
  if (st1[kk1-1] == st1[kk1] || st1[kn1-1] == st1[kn1]) goto err117;
  if (st2[kk2-1] == st2[kk2] || st2[kn2-1] == st2[kn2]) goto err117;  
  
  /* Allocate space for B-spline values and derivatives and one work array. */
  
  knumb1 = max(kk1*(ider+1),kk2*(ider+1));
  
  /* ONly allocate ebder if sdum1 too small */
  
  if (knumb1>49)
    { 
      if((ebder = newarray(knumb1,double)) == SISL_NULL) goto err101;
    }
  else
    {
      ebder = &sdum1[0];
      for (ki=0;ki<knumb1;ki++)
	ebder[ki] = DZERO;
    }
  
  if (ebder == SISL_NULL) goto err101;
  
  /* Only allocate ew if sdum2 too small */
  
  knumb2 = (kk1*(ider+1)*kdim);
  if (knumb2>147)
    {
      if((ew=new0array(knumb2,double)) == SISL_NULL) goto err101;
    }
  else
    { 
      ew = &sdum2[0];
      for (ki=0;ki<knumb2;ki++)
	sdum2[ki] = DZERO;
    }
  
  if (ew == SISL_NULL) goto err101;
  
  /* Set all the elements of sder to 0. */
  
  for (ki=0; ki<kdim*(ider+1)*(ider+2)/2; ki++) sder[ki] = DZERO;
  
  /* Compute the values and derivatives of the nonzero B-splines in the
     second parameter direction.                                        */
  
  s1220(st2,kk2,kn2,&kleft2,epar[1],ider,ebder,&kstat);
  
  if (kstat < 0) goto error;
  
  /* Update ilfs (ilft was updated above, in s1220). */
  
  s1219(st1,kk1,kn1,&kleft1,epar[0],&kstat);
  
  if (kstat < 0) goto error;
  
  /* Compute the first matrix product in (2) above. */
  
  /* ki steps through the appropriate kk2 rows of B-spline coefficients
     while kih steps through the B-spline value and derivatives for the
     B-spline given by ki.                                              */
  
  kih = 0;
  for (ki=kleft2-kk2+1; ki<=kleft2; ki++)
    {      
      /* kj counts through the ider+1 derivatives to be computed.
	 kjh steps through ew once for each ki to accumulate the contribution
	 from the different B-splines.
	 kl1 points to the first component of the first B-spline coefficient
	 in row no. ki of the B-spline coefficient matrix that multiplies
	 a nonzero B-spline in the first parameter direction.
	 */
      
      kjh = 0; kl1 = ki*kdim*kn1 + kdim*(kleft1-kk1+1);
      for (kj=0; kj<=ider; kj++)
	{
	  
	  /* The value of the B-spline derivative is stored in tt while
	     kl2 steps through the kdim components of all the B-spline
	     coefficients that multiplies nonzero B-splines along st1. 
	     */
	  
	  tt = ebder[kih++]; kl2 = kl1;
	  for (kl=0; kl<kdim*kk1; kl++,kjh++,kl2++)
	    {
	      ew[kjh] += scoef[kl2]*tt;
	    }
	}
    }
  
  /* Compute the values and derivatives of the nonzero B-splines in the
     first parameter direction.                                        */
  
  s1220(st1,kk1,kn1,&kleft1,epar[0],ider,ebder,&kstat);         
  
  if (kstat < 0) goto error;
  
  /* Compute the remaining matrix product. */
  
  /* kh steps through the ider+1 derivatives in the first parameter direction
     (the rows of ew if we image it as a kk1x(ider+1) matrix with each element
     a kdim dimensional vector) while kl1 steps through the elements of ew
     (again considering each element to have kdim components).                   
     */
  
  kl1 = 0;
  for (kh=0; kh<=ider; kh++)
    {      
      /* ki steps through the kk1 columns of ew (corresponding to the columns
	 of scoef that multiply nonzero B-splines along st1), while kih
	 steps through the B-spline values and derivatives for the nonzero
	 B-splines along st1 (stored in ebder).
	 */

      kinc = 0;
      for (ki=0; ki<kk1; ki++,kinc+=(ider+1))
	{
	  
	  kih = kinc;

	  /* kj counts through the ider+1 derivatives in the first
	     parameter direction (corresponding to the columns of sder).
	     kjh points to the row of sder corresponding to derivatives of
	     order kh in the second parameter direction (if sder is
	     considered a matrix with elements consisting of vectors with
	     kdim components).
	     */
	  
	  for (kj=0; kj<=ider-kh; kj++)
	    {
	      /* Find index for sder (a triangular matrix). */

              tot = kj + kh;

	      temp = ((tot * (tot+1)) >> 1) + kh;

	      kjh = temp * kdim;

	      /* Pick out the current element of ebder.
		 kl2 steps through the kdim components of the (kh,ki)
		 element of ew.
		 */
	      
	      tt = ebder[kih++];
	      kl2 = kl1;
	      for (kl=0; kl<kdim; kl++,kjh++,kl2++)
		{
		  sder[kjh] += ew[kl2]*tt;
		}
	    }
	  kl1 += kdim;
	}
    }
  
  /* Free memory. */
  
  /* If rational surface calculate the derivatives based on derivatives in
     homogenous coordinates */
  
  if (ps1->ikind == 2 || ps1->ikind == 4)
    {
      s6strider(sder,ps1->idim,ider,eder,&kstat);
      if (kstat<0) goto error;
      if(sder != SISL_NULL) freearray(sder);
    }
  
  /* Only free ew and ebder if the were allocated by newarray */
  
  if (knumb1 > 49 && ebder != SISL_NULL)
     freearray(ebder);
  if (knumb2 > 147 && ew != SISL_NULL)
     freearray(ew);
  
  /* Make cross products of tangents, if idim==3 and derivative >0 */
  
  if (ider>0 && ps1->idim ==3)
    {
      double tlen1,tlen2,tnorm,tang=(double)0.0;
      
      s6crss(eder+ps1->idim,eder+2*ps1->idim,enorm);
      
      /*  Make length of tangents and normal */
      
      tlen1 = s6length(eder+ps1->idim,ps1->idim,&kstat);
      tlen2 = s6length(eder+2*ps1->idim,ps1->idim,&kstat);
      tnorm = s6length(enorm,ps1->idim,&kstat);
      
      /*  Calculate angle between tangents */
      
      if (tlen1 != DZERO && tlen2 != DZERO && tnorm != DZERO)
        tang = tnorm/(tlen1*tlen2);
      
      if (tang == DZERO) *jstat = 2;
      else if (tang <= ANGULAR_TOLERANCE) *jstat = 1;   
      else *jstat = 0;
      goto out;
    }
  
  /* Successful computations.  */
  
  *jstat = 0;
  goto out;
  
  /* Not enough memory. */
 err101: *jstat = -101;
  s6err("s1421",*jstat,kpos);
  goto out;
  
  /* kdim less than 1. */
 err102: *jstat = -102;
  s6err("s1421",*jstat,kpos);
  goto out;
  
  /* Polynomial order less than 1. */
 err115: *jstat = -115;
  s6err("s1421",*jstat,kpos);
  goto out;
  
  /* Fewer B-splines than the order. */
 err116: *jstat = -116;
  s6err("s1421",*jstat,kpos);
  goto out;
  
  /* Error in knot vector.
     (The first or last interval of one of the knot vectors is empty.) */
 err117: *jstat = -117;
  s6err("s1421",*jstat,kpos);
  goto out;
  
  /* Illegal derivative requested. */
 err178: *jstat = -178;
  s6err("s1221",*jstat,kpos);
  goto out;
  
  /* Error in lower level routine.  */
  
 error:  *jstat = kstat;
  s6err("s1421",*jstat,kpos);
  goto out;
  
 out:
    *ilfs = kleft1;
    *ilft = kleft2;
    return;
}

//===========================================================================
void s1851(SISLSurf *ps1,double epoint[],double enorm[],int idim,
	   double aepsco,double aepsge,int *jpt,double **gpar,
	   int *jcrv,SISLIntcurve ***wcurve,int *jstat)
//===========================================================================
{
  int kstat = 0;              /* Local status variable.                      */
  int kpos = 0;               /* Position of error.                          */
  int i;
  int trackflag = 0;
  int jtrack;
  SISLTrack **wtrack=SISL_NULL;
  int jsurf = 0;
  SISLIntsurf **wsurf=SISL_NULL;
  int *pretop=SISL_NULL;

  sh1851(ps1, epoint, enorm, idim, aepsco, aepsge,trackflag, &jtrack,
	 &wtrack,jpt, gpar,&pretop,jcrv,wcurve,&jsurf,&wsurf,&kstat);
  if(kstat < 0) goto error;

  if(pretop != SISL_NULL) freearray(pretop);

  for(i=0; i<jsurf; i++)
    freeIntsurf(wsurf[i]);
  if(wsurf != SISL_NULL) freearray(wsurf);

  if(jsurf > 0)
    *jstat=10;
  else
    *jstat = 0;
  goto out;

  /* Error in lower level routine.  */

  error :
    *jstat = kstat;
    s6err("s1851",*jstat,kpos);
    goto out;

  out:
    return;
}

void s1853(SISLSurf *ps1,double epoint[],double edirec[],double aradius,
	   int idim,double aepsco,double aepsge,int *jpt,double **gpar,
	   int *jcrv,SISLIntcurve ***wcurve,int *jstat)
/*
*********************************************************************
*
*********************************************************************
*                                                                   
* PURPOSE    : Find all intersections between a tensor-product surface
*              and a cylinder.
*
*
*
* INPUT      : ps1      - Pointer to surface.
*              epoint   - SISLPoint on the axis of the cylinder.
*              edirec   - The direction vector of the axis of the cylinder.
*              aradius  - Radius of the cylinder.
*              idim     - Dimension of the space in which the cylinder lies.
*              aepsco   - Computational resolution.
*              aepsge   - Geometry resolution.
*                                                                        
*
*
* OUTPUT     : *jpt   - Number of single intersection points.
*              gpar   - Array containing the parameter values of the
*                       single intersection points in the parameter
*                       plane of the surface. The points lie continuous. 
*                       Intersection curves are stored in wcurve.
*              *jcrv  - Number of intersection curves.
*              wcurve  - Array containing descriptions of the intersection
*                       curves. The curves are only described by points
*                       in the parameter plane. The curve-pointers points
*                       to nothing. (See description of Intcurve
*                       in intcurve.dcl).
*              jstat  - status messages  
*                                         > 0      : warning
*                                         = 0      : ok
*                                         < 0      : error
*
*
* METHOD     : The vertices of the surface are put into the equation of the
*              cylinder achieving a surface in the one-dimentional space.
*              Then the zeroes of this surface is found.
*
*
* REFERENCES : Main routine written by Vibeke Skytt, SI, 1988.
*
* CALLS      : sh1853, s6err.
*
* WRITTEN BY : Christophe Rene Birkeland, SINTEF, 93-06.
*
*********************************************************************
*/
{
  int kstat = 0;              /* Local status variable.                      */
  int kpos = 0;               /* Position of error.                          */
  int i;
  int trackflag = 0;
  int jtrack;
  SISLTrack **wtrack=SISL_NULL;
  int jsurf;
  SISLIntsurf **wsurf=SISL_NULL;
  int *pretop=SISL_NULL;

  sh1853(ps1,epoint,edirec,aradius,idim,aepsco,aepsge,trackflag,&jtrack,
	 &wtrack,jpt,gpar,&pretop,jcrv,wcurve,&jsurf,&wsurf,&kstat);
  if(kstat < 0) goto error;

  if(pretop != SISL_NULL) freearray(pretop);

  for(i=0; i<jsurf; i++)
    freeIntsurf(wsurf[i]);
  if(wsurf != SISL_NULL) freearray(wsurf);

  if(jsurf > 0) 
    *jstat=10;
  else 
    *jstat = 0;
  goto out;

  /* Error in lower level routine.  */

  error : 
    *jstat = kstat;
    s6err("s1853",*jstat,kpos);
    goto out;

  out:
    return;
}                                               

//===========================================================================
void s1859(SISLSurf *ps1,SISLSurf *ps2,double aepsco,double aepsge,
	   int *jpt,double **gpar1,double **gpar2,int *jcrv,
	   SISLIntcurve ***wcurve,int *jstat)
//===========================================================================
{            
  int kstat = 0;               /* Local status variable.                   */
  int kpos = 0;                /* Position of error.                       */
  int i;

  int trackflag = 0;
  int jtrack;
  SISLTrack **wtrack=SISL_NULL;
  int *pretop=SISL_NULL;
  int jsurf;
  SISLIntsurf **wsurf=SISL_NULL;

  sh1859 (ps1, ps2, aepsco, aepsge, trackflag, &jtrack, &wtrack, jpt, gpar1, 
	  gpar2, &pretop, jcrv, wcurve,&jsurf,&wsurf,&kstat);
  if(kstat < 0) goto error;

  if(pretop != SISL_NULL) freearray(pretop);

  for(i=0; i<jsurf; i++)
    freeIntsurf(wsurf[i]);
  if(wsurf != SISL_NULL) freearray(wsurf);

  if(jsurf > 0) 
    *jstat=10;
  else 
    *jstat = 0;
  goto out;

  /* Error in lower level routine.  */

  error : 
    *jstat = kstat;
    s6err("s1859",*jstat,kpos);
    goto out;

  out:

  /*
   * Exit s1859.
   * -----------
   */

    return;
}                                               

//===========================================================================
void s1770(SISLCurve *pcurve1,SISLCurve *pcurve2,double aepsge,
	   double astart1,double astart2,double aend1,double aend2,
	   double anext1,double anext2,double *cpos1,double *cpos2,int *jstat)
//===========================================================================
{                        
  int kstat = 0;            /* Local status variable.                      */
  int kpos = 0;             /* Position of error.                          */
  int kleft1=0,kleft2=0;    /* Variables used in the evaluator.            */
  int kder=1;               /* Order of derivatives to be calulated        */
  int kdim;                 /* Dimension of space the curves lie in        */
  int knbit;                /* Number of iterations                        */
  int kdir;                 /* Changing direction.                         */
  double tdelta1,tdelta2;   /* Parameter interval of the curves.           */
  double tdist;             /* Distance between position and origo.        */
  double td[2],t1[2],tdn[2];/* Distances between old and new parameter
			       value in the two parameter directions.      */
  double tprev;             /* Previous difference between the curves.     */
  double *sval1=SISL_NULL;       /* Value ,first and second derivatie on curve 1*/ 
  double *sval2;            /* Value ,first and second derivatie on curve 1*/ 
  double *sdiff;            /* Difference between the curves               */
  
  /* Test input.  */
  
  if (pcurve1->idim != pcurve2->idim) goto err106;
  
  kdim = pcurve1 -> idim;
  if (kdim == 2)
  {
     s1770_2D(pcurve1,pcurve2,aepsge,astart1,astart2,
           aend1,aend2,anext1,anext2,cpos1,cpos2,jstat);
     goto out;
  }
  
  /* Fetch endpoints and the intervals of parameter interval of curves.  */
  
  tdelta1 = pcurve1->et[pcurve1->in] - pcurve1->et[pcurve1->ik - 1];
  tdelta2 = pcurve2->et[pcurve2->in] - pcurve2->et[pcurve2->ik - 1];
  
  /* Allocate local used memory */
  
  sval1 = newarray((2*kder+5)*kdim,double);
  if (sval1 == SISL_NULL) goto err101;
  
  sval2 = sval1 + (kder+2)*kdim;
  sdiff = sval2 + (kder+2)*kdim;
  
  /* Initiate variables.  */
  
  tprev = (double)HUGE;
  
  /* Evaluate 0-1.st derivatives of both curves */
  
  s1221(pcurve1,kder,anext1,&kleft1,sval1,&kstat);
  if (kstat < 0) goto error;
  
  s1221(pcurve2,kder,anext2,&kleft2,sval2,&kstat);
  if (kstat < 0) goto error;
  
  /* Compute the distanse vector and value and the new step. */
  
  s1770_s9dir(&tdist,td,td+1,sdiff,sval1,sval2,kdim);
  
  /* Correct if we are not inside the parameter intervall. */
  
  t1[0] = td[0];
  t1[1] = td[1];
  s1770_s9corr(t1,anext1,anext2,astart1,aend1,astart2,aend2);
  
  /* Iterate to find the intersection point.  */
  
  for (knbit = 0; knbit < 30; knbit++)
    {
      /* Evaluate 0-1.st derivatives of both curves */
      
      s1221(pcurve1,kder,anext1+t1[0],&kleft1,sval1,&kstat);
      if (kstat < 0) goto error;
      
      s1221(pcurve2,kder,anext2+t1[1],&kleft2,sval2,&kstat);
      if (kstat < 0) goto error;
      
      
      /* Compute the distanse vector and value and the new step. */
      
      s1770_s9dir(&tdist,tdn,tdn+1,sdiff,sval1,sval2,kdim);
      
      /* Check if the direction of the step have change. */
      
      kdir = (s6scpr(td,tdn,2) >= DZERO);     /* 0 if changed. */
      
      /* Ordinary converging. */
      
      if (tdist < tprev*(double)0.9 || kdir)
	{
          anext1 += t1[0];
          anext2 += t1[1];
	  
          td[0] = tdn[0];
          td[1] = tdn[1];
	  
	  /* Correct if we are not inside the parameter intervall. */
	  
	  t1[0] = td[0];
	  t1[1] = td[1];
	  s1770_s9corr(t1,anext1,anext2,astart1,aend1,astart2,aend2);
	  
          if ( (fabs(t1[0]/tdelta1) <= REL_COMP_RES) &&
	      (fabs(t1[1]/tdelta2) <= REL_COMP_RES) ) break;
	  
          tprev = tdist;
	}
      
      /* Not converging, corrigate and try again. */
      
      else
	{
          t1[0] /= (double)2;
          t1[1] /= (double)2;
          /* knbit--; */
	}
    }
  
  /* Iteration stopped, test if point founds found is within resolution */
  
  if (tdist <= aepsge)
    *jstat = 1;
  else
    *jstat = 2;
  
  *cpos1 = anext1;
  *cpos2 = anext2;
  
  /* Iteration completed.  */
  
  
  goto out;
  
  /* Error in allocation */
  
 err101: *jstat = -101;
  s6err("s1770",*jstat,kpos);
  goto out;                  
  
  /* Error in input. Conflicting dimensions.  */
  
 err106: *jstat = -106;
  s6err("s1770",*jstat,kpos);
  goto out;                  
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("s1770",*jstat,kpos);
  goto out;                  
  
 out:    if (sval1 != SISL_NULL) freearray(sval1);
}

//===========================================================================
void s1220(double *et,int ik,int in,int *ileft,
	   double ax,int ider,double ebder[],int *jstat)
//===========================================================================
{
  int kstat=0;        /* Local status variable.                          */
  int kpos=0;         /* The position of the error.                      */
  int kdeg;           /* Convenience variable which is set to ik-1.      */
  int kleft;          /* Local version of ileft in order to avoid
			 the pointer.                                    */
  int ki,kj,ks;       /* Control variables in for loops and for stepping
			 through arrays.                                 */
  int ki1,ki2,kjh;    /* Control variables in for loops and for stepping
			 through arrays.                                 */
  int kder;           /* Local version of ider. All derivatives of order
			 higher than ik-1 are zero so
			 kder=min(ik-1,ider).                            */
  double td1,td2;     /* These variables are used to store the inverse of
			 the number that divides B(i,k-1) and B(i+1,k-1)
			 in (2) above.                                   */
  double tw1,tw2;     /* These variabels are used to store the factors
			 multiplying B(i,k-1) and B(i+1,k-1) in (1)
			 above.                                          */
  double ts1,ts2;     /* These variables are similar to td1 and td2 except
			 that they will also contain the appropriate
			 integer factor stemming from (2).               */
  double tt,tth;      /* Auxiliary variables used to avoid unnecessary
			 look ups in the knot vector.                    */
  /* Check the input. */                                       
  
  if (ider < 0) goto err178;
  
  /* Find the right value of ileft and check input. */
  
  s1219(et,ik,in,ileft,ax,&kstat);
  
  if (kstat < 0) goto error;
  
  /* Initialize. */
  
  kleft = *ileft;
  kdeg = ik - 1;
  kder = min(ik-1,ider);
  
  /* The fact that kder can be less than ider causes some problems.
     If kder < ider we know that ebder in the end should be a (kder+1)xik
     matrix augmented with ider-kder rows of zeros at the bottom.
     Since we store the matrix column by column, care must be taken to
     access the entries correctly.
     In the comments below ebder will usually be considered to be a
     (kder+1)xik matrix.
     ki2 is set to point to the last element of ebder (the lower right entry
     of the matrix, cf. above), and this element is set to one
     (this is the lower right corner of the (kder+1)*ik part of ebder). */
  
  ki2 = (ik-1)*(ider+1) + kder;
  ebder[ki2] = (double)1.0;
  
  if (ik == 1)
  {
     /* VSK. Constant. Task is done.  */
     
     *jstat = 0;
     goto out;
  }
  
  /* Get ready for the main iteration loop where (1) and/or (2) are applied
     each time. In these iterations ki1 will run through the entries of ebder
     to be computed, starting at the upper left corner and running down the
     rows.
     ki2 will follow ki1 but be one row ahead of ki1 to take care of the second
     term in (1) and (2).
     Note that when accessing the entries of ebder the convention is
     used that the pointer to the entry has to be incremented first.
     ki1 is therefore initialized to point to the element before the first
     element to be computed in the first iteration (the second but 
     last diagonal element of ebder).
     If (ider == ik-1) then we first have to copy up the last row and
     initialize ki1 to point to the entry above the second but last diagonal
     element of ebder.                                                       */
  
  ki1 = ki2 - ider - 2;
  if (kder == kdeg)
    {
      ebder[ki2-1] = (double)1.0;
      ki1 -= 1;
    }
  
  /* ki2 should be one row ahead of ki1 and each row has ider+1 entries. */
  
  ki2 = ki1 + ider + 1;
  
  /* Iterate and apply (1) and/or (2) each time. ks counts the degree of the
     B-splines whose values and derivaties are to be computed in this
     iteration.                                                          */
  
  for(ks=1; ks<ik; ks++)
    {
      
      /* In (1) and (2) the denominators that divide B(i,k-1) and B(i+1,k-1)
	 are on the form (t(i+k-1)-t(i)). Below kj is used as the (i) index
	 and kjh as the (i+k-1) index. It is the alternative form (3) of
	 (1) that is used below and tw2 is used as 1-w(i+1) and tw1 as
	 w(i).
	 For the first nonzero B-spline of degree ks, the first term in
	 (1) and (2) is zero.
	 kj is initialized to point to the first knot that gives a contribution
	 during this iteration and kjh to point to `t(kj+ks)=t(kleft+1)'.
	 If (t(kjh)-t(kj)) <= 0.0 there must be an error in the knot vector. */
      
      kj = kleft - ks + 1;
      kjh = kleft + 1;
      tt = et[kjh++];
      tth = tt - et[kj];
      if (tth <= (double)0.0) goto err112;
      td2 = (double)1.0/tth;
      tw2 = (tt-ax)*td2;
      
      ebder[++ki1] = tw2*ebder[++ki2];
      
      /* Check to see if there is either copying or differentiation to do. */
      
      if (ks >= kdeg-kder && kder > 0)
	{
	  /* Copy the first element of the row up to the previous
	     unless it is the last iteration.                     */
	  
	  if (ks < kdeg)
	    ebder[ki1-1] = ebder[ki1];
	  
	  /* Apply (2) to the rest of this column. Remember that this
	     is the first nonzero column of ebder so the first term in (2)
	     is zero.                                                     */
	  
	  ts2 = ks*td2;
	  for (ki=0; ki<ks-kdeg+kder; ki++)
	    ebder[++ki1] = -ts2*ebder[++ki2];
	  
	  /* Step to the top of the next column (the last time ebder
	     is full and there is no stepping to do (unless kder <ider). */
	  
	  ki1 += ider - kder + kdeg - ks;
	  ki2 = ki1 + ider + 1;
	}
      else
	{
	  
	  /* If there was no copying or differentiation to be done
	     we just step to the top of the next column. This step is zero
	     if there are no derivatives to be computed.                  */
	  
	  ki1 += ider;
	  ki2 += ider;
	}
      
      /*  Loop through the ks-1 middle columns of ebder. */
      
      for (kj=kleft-ks+2; kj<=kleft; kj++)
	{
	  
	  /* Compute the denominators and weights (w(i+1)) to be used.
	     See the comments above for more details.                  */
	  
	  tt = et[kjh++];
	  tth = tt - et[kj];
	  if (tth <= (double)0.0) goto err112;
	  td1 = td2; td2 = (double)1.0/tth;
	  tw1 = (double)1.0 - tw2; tw2 = (tt-ax)*td2;
	  
	  ki1 += 1;
	  ebder[ki1] = tw1*ebder[ki1] + tw2*ebder[++ki2];
	  
	  /* Check if there is copying and differentiation to be done. */
	  
	  if (ks >= kdeg-kder && kder > 0)
	    {
	      
	      /* Copy unless it is the last iteration. */
	      
	      if (ks < kdeg)
		ebder[ki1-1] = ebder[ki1];
	      
	      /* Do the differentiation. */
	      
	      ts1 = ts2; ts2 = ks*td2;
	      for (ki=0; ki<ks-kdeg+kder; ki++)
		{
		  ki1 += 1;
		  ebder[ki1] = ts1*ebder[ki1] - ts2*ebder[++ki2];
		}
	      
	      /* Jump to the next column. */
	      
	      ki1 += ider - kder + kdeg - ks;
	      ki2 = ki1 + ider + 1;
	    }
	  else
	    {
	      
	      /* Jump to the next column. */
	      
	      ki1 += ider;
	      ki2 += ider;
	    }
	}
      
      /* Compute the last column of ebder. Remember that now the last term
	 in (1) and (2) is zero, so there is no new td2 or tw2 to compute. */
      
      td1 = td2;
      tw1 = (double)1.0 - tw2;
      
      ki1 += 1;
      ebder[ki1] = tw1*ebder[ki1];
      
      /* Check if there is copying or differentiation to do. */
      
      if (ks >= kdeg-kder && kder > 0)
	{
	  
	  /* Copy. */
	  
	  if (ks < kdeg)
	    ebder[ki1-1] = ebder[ki1];
	  
	  /* Differentiate. */
	  
	  ts1 = ts2;
	  for (ki=0; ki<ks-kdeg+kder; ki++)
	    {
	      ki1 += 1;
	      ebder[ki1] = ts1*ebder[ki1];
	    }
	  
	  /* Move ki1 back to the first nonzero element of the last column.
	     Each column now has ks-kdeg+kder+2 nonzero elements.         */
	  
	  ki1 -= ks - kdeg + kder + 1;
	}
      
      /* Move ki1 from the first element of the last column to the element
	 prior to the first nonzero element in the first column.
	 ki2 is as usual one column ahead of ki1.                          */
      
      ki1 -= (ks+1)*(ider+1) + 1;
      ki2 = ki1 + ider + 1;
    }
  
  /* Set the remaining derivatives to zero. */
  
  for (ki=kder+1; ki<=ider; ki++)
    {
      ki1 = ki;
      for (kj=0; kj<ik; kj++)
	{
	  ebder[ki1] = (double)0.0;
	  ki1 += ider + 1;
	}
    }
  
  /* Successful computations.  */
  
  *jstat = 0;
  goto out;
  
  
  /* Error in knot vector.
     (The first or last interval of the knot vector is empty
     or it is decreasing or has to high multiplicity.)      */
 err112: *jstat = -112;
  s6err("s1220",*jstat,kpos);
  goto out;
  
  /* Illegal derivative requested. */
 err178: *jstat = -178;
  s6err("s1220",*jstat,kpos);
  goto out;
  
  /* Error in lower level routine.  */
  
 error:  *jstat = kstat;
  s6err("s1220",*jstat,kpos);
  goto out;
  
 out: return;
}

//===========================================================================
void s1219(double *et,int ik,int in,int *ileft,double ax,int *jstat)
//===========================================================================
{
  int kpos=0;         /* The position of the error.                      */
  int kleft;          /* Local version of ileft to avoid the pointer.    */
  
  /* Check the input. */
  
  if (ik < 1) goto err110;
  
  if (in < ik) goto err111;
  
  if (et[ik-1] == et[ik] || et[in-1] == et[in]) goto err112;
  
  /* Make sure that kleft is in the legal range. */
  
  kleft = min(max(ik-1,*ileft),in-1);
  
  /* Check if the current value of kleft is acceptable. */
  
  if (et[kleft] <= ax && ax < et[kleft+1]) ;
  
  /* Check if ax is outside (et[ik-1],et[in]). */
  
  else if (ax >= et[in-1])
    kleft = in - 1;
  else if (ax <= et[ik-1])
    kleft = ik - 1;
  
  /* Check if it is sufficient to increase or decrease kleft by one. */
  
  else if (et[kleft+1] <= ax && ax < et[kleft+2])
    kleft += 1;
  else if (kleft > 0 && et[kleft-1] <= ax && ax < et[kleft])
    kleft -= 1;
  
  /* Last resort - a binary search. */
  else
    {
      
      /* kmin and kmax gives the upper and lower limits on the possible values
	 of kleft.                                                       */
      
      int kmin,kmax;
      
      kmin = ik - 1; kmax = in - 1;
      kleft = (kmin+kmax)/2;
      
      while (ax < et[kleft] || et[kleft+1] <= ax)
	{
	  if (ax < et[kleft])
	    kmax = kleft;
	  else
	    kmin = kleft;
	  
	  kleft = (kmin+kmax)/2;
	}
    }
  
  *ileft = kleft;
  
  /* Successful computations.  */
  
  *jstat = 0;
  goto out;
  
  /* Polynomial order less than 1. */
 err110: *jstat = -110;
  s6err("s1219",*jstat,kpos);
  goto out;
  
  /* Fewer B-splines than the order. */
 err111: *jstat = -111;
  s6err("s1219",*jstat,kpos);
  goto out;
  
  /* Error in knot vector.
     (The first or last interval of the knot vector is empty.) */
 err112: *jstat = -112;
  s6err("s1219",*jstat,kpos);
  goto out;
  
 out: return;
}

//===========================================================================
void s6strider(double eder[],int idim,int ider,double gder[],int *jstat)
//===========================================================================
{
  int kpos=0;          /* Position of error.                     */
  double w0;           /* The denominator.                       */
  int ki;              /* Count through dimensions.              */
  int idu;             /* Count through derivatives in u.        */
  int idv;             /* Count through derivatives in v.        */
  int *binom=SISL_NULL;     /* Array for binomial coefficients.       */
  int *binomu=SISL_NULL;    /* Pointer to binomial coefficients in u. */
  int *binomv=SISL_NULL;    /* Pointer to binomial coefficients in v. */
  double *sum1=SISL_NULL;   /* Leibnitz expansion in u                */
  double *sum2=SISL_NULL;   /* Leibnitz expansion in u and v.         */
  double sumdum1[4];   /* Fixed space for sum1.                  */
  double sumdum2[4];   /* Fixed space for sum2.                  */
  int idimp1;          /* idim + 1.                              */
  int iw;              /* Pointer to a weight.                   */
  int igder;           /* Pointer to already calculated derivs.  */
  int i,iu,iv,j,k;     /* Counters.                              */
  int iderp1;          /* ider + 1.                              */
  int igrow;           /* (ider+1) * idim.                       */  
  int iwrow;           /* (ider+1) * idimp1.                     */  
  int iutemp,ivtemp;   /* Used to find next weight in the sum.   */
  int tot,temp1;       /* Temporary variables.                   */
  int bidum[10];       /* Array for storing binomial coeffs.     */
  double temp;         /* Temporary multiple.                    */
  
  if (ider<0) goto err178;
  if (idim<1) goto err102;
  
  *jstat = 0;

  /* Find denominator. */ 
  
  w0 = eder[idim];
  if (DEQUAL(w0,DZERO)) w0 = (double)1.0;

  /* If we're only asked for position, we'll do it
     now and exit for the sake of speed. */

  if(ider == 0)
  {
    for(ki=0; ki<idim; ki++)
      gder[ki] = eder[ki] / w0;

    goto out;
  }

  /* Set up some constants. */

  idimp1  = idim + 1;
  iderp1 = ider + 1;
  igrow   = iderp1 * idim;
  iwrow   = igrow + iderp1;  /* = iderp1 * idimp1 */

  /* Set up  binomial coefficients.
     Use new array only when ider > 3. */

  if (ider > 3)
  { 
    binom = newarray((iderp1*(iderp1+1)) >> 1, INT);
    if(binom == SISL_NULL) goto err179;
  }
  else
  { 
    binom = bidum;
  }

  for(j=0,k=0; j<=ider; j++,k+=j)
  {
      /* Calculate the new row of binomial coefficients. */
  
      binom[k] = 1;
  
      for(i=k+1; i<k+j; i++)
      {
          binom[i] = binom[i-j-1] + binom[i-j];
      }

      binom[k+j] = 1;
  }

  /* Set up space for sum1 and sum2 if necessary.
     Use new arrays only when idim > 4. */

  if (idim > 4)
  { 
    sum1 = newarray(idim, DOUBLE);
    if(sum1 == SISL_NULL) goto err179;
    sum2 = newarray(idim, DOUBLE);
    if(sum2 == SISL_NULL) goto err179;
  }
  else
  { 
    sum1=sumdum1;
    sum2=sumdum2;
  }
  
  /* Loop through derivatives in u and v. */

  for(idv=0,binomv=binom; idv<=ider; idv++,binomv+=idv)
  {
    for(idu=0,binomu=binom; idu<=ider-idv; idu++,binomu+=idu)
    {
      if(idu == 0 && idv == 0)
      {
          /* Position is a special case. */
    
          for(ki=0; ki<idim; ki++)
            gder[ki] = eder[ki] / w0;
      }
      else
      {
          /* Calculate indices in eder and gder. */
    
          tot = idu + idv;
          temp1 = ((tot * (tot+1)) >> 1) + idv;
    
          j = temp1 * idim;
          k = j + temp1;

          /* Calculating each coefficient of the (idu,idv)'th
	     derivative of the rational surface (in gder).
        
  	     This requires calculating the Liebnitz sum from
  	     the subarray of gder (0,..,idu, 0,...,idv) and
             the subarray of eder (0,..,idu, 0,...,idv). */

          /* Calculate the Leibnitz sum. */

          for(ki=0; ki<idim; ki++)
            sum2[ki] = (double)0.0;        

          for(iv=0; iv<=idv; iv++)
          {
            for(ki=0; ki<idim; ki++)
               sum1[ki] = (double)0.0;	               
            ivtemp = idv-iv;

            for(iu=0; iu<=idu; iu++)
            {
                tot = iu + iv;
                temp1 = ((tot * (tot+1)) >> 1) + iv;

	        igder = temp1 * idim;
                iutemp = idu-iu;

                tot = iutemp + ivtemp;
	        temp1 = ((tot * (tot+1)) >> 1) + ivtemp;

                iw   = temp1 * idimp1 + idim;

     	      /* Add the next Leibnitz term unless we
       		 have reached the last one (the unknown). */
  
                if(iu<idu || iv<idv)
  	        {
  	       	  /* If iu=0 or iu=idu, the u binomial
  	       	     coefficient is 1 so don't multiply. */
  
  	            if(iu>0 && iu<idu)
  	       	    {
  		      temp = (double)binomu[iu] * eder[iw];
                      for(ki=0; ki<idim; ki++,igder++)
  	       	         sum1[ki] += temp * gder[igder];
  		     }
  		     else
                       for(ki=0; ki<idim; ki++,igder++)
  		         sum1[ki] += eder[iw] * gder[igder];
                }
            }
  
  	    /* If iv=0 or iv=idv, the v binomial
  	       coefficient is 1 so don't multiply. */
  
  	    if(iv>0 && iv<idv)
              for(ki=0; ki<idim; ki++)
  	          sum2[ki] += (double)binomv[iv] * sum1[ki];
  	    else
              for(ki=0; ki<idim; ki++)
		 sum2[ki] += sum1[ki];		    
          }
          for(ki=0; ki<idim; ki++,j++,k++)
            gder[j] = (eder[k] - sum2[ki]) / w0;
      }
    }
  }  

  /* Free arrays. */

  if (ider > 3 && binom != SISL_NULL)
     freearray(binom);
  
  if (idim > 4)
  { 
     if(sum1 != SISL_NULL) freearray(sum1);
     if(sum2 != SISL_NULL) freearray(sum2);
  }

  /* Done. */

  goto out;

  /* idim less than 1. */

  err102: 
    *jstat = -102;
    s6err("s6strider",*jstat,kpos);
    goto out;

  /* Derivative negative */

  err178: 
    *jstat = -178;
    s6err("s6strider",*jstat,kpos);
    goto out;

  /* Not enough memory */

  err179: 
    *jstat = -179;
    s6err("s6strider",*jstat,kpos);
    goto out;

  out:
    return;
}

//===========================================================================
double s6length(double e1[],int idim,int *jstat)
//===========================================================================
{
  register int ki;            /* Running variable in loop */
  register double tsum=DZERO; /* Dummy variables in summing loop */
  
  /* If the dimension is 1 the length of the vector is the same as the
   *  absolute value of the number */
  
  if (idim == 1)
    tsum = fabs(e1[0]);
  else
    {
      for (ki=0;ki<idim;ki++)
	tsum += (e1[ki]*e1[ki]);

      tsum = sqrt(tsum);
    }
  
  if (DNEQUAL(tsum,DZERO))
    goto mes01;

  /* Length of vector is zero    */

  *jstat = 0;
  goto out;

  /* Length of vector different from zero   */

 mes01: *jstat = 1;
        goto out;

 out: return(tsum);
}

//===========================================================================
double s6scpr(double e1[],double e2[],int idim)
//===========================================================================
{
  register int ki;
  register double tsum=DZERO; 

  for (ki=0;ki<idim;ki++)
    tsum += e1[ki]*e2[ki];

  return(tsum);
}

//===========================================================================
void s6err(const char *rut,int jstat,int ipos)
//===========================================================================
{
   (void)fprintf(stderr,"\nError status : %d",jstat);
   (void)fprintf(stderr,"   Call from routine : %s",rut);
   (void)fprintf(stderr,"   Position : %d\n",ipos);
}

//===========================================================================
SISLCurve *newCurve (int in, int ik, double *et, double *ecoef,
	  int ikind, int idim, int icopy)
//===========================================================================
{
  SISLCurve *qnew;		/* Local pointer to new curve.  */
  int i, j, J, jj, k;		/* loop variables               */
  int k1,k2;                    /* Superflous knots in the ends. */
  int kdim;			/* Dimension of space (also including potential
				   homogenous coordinate        */
  double *st = SISL_NULL;		/* Copy of knotvector.          */
  double *rcoef = SISL_NULL;		/* Copy of vertices in rational case.  */
  double *scoef = SISL_NULL;		/* Copy of vertices.            */


  /* Allocate space for curve.  */

  if ((qnew = newarray (1, SISLCurve)) == SISL_NULL)
    goto err101;

  if (ikind == 2 || ikind == 4)
    kdim = idim + 1;
  else
    kdim = idim;

  /* Count superflous knots in the start.  */
  
  for (k1=0; k1<in; k1++)
     if (et[ik-1] < et[ik+k1]) break;
  
  /* Count superflous knots in the end.  */
  
  for (k2=0; k2<in; k2++)
     if (et[in] > et[in-1-k2]) break;
  
  /* Reduce knots and vertices according to k1 and k2.  */
  
  if (k1 > 0)
  {
     memcopy(ecoef,ecoef+k1*kdim,(in-k1)*kdim,DOUBLE);
     memcopy(et,et+k1,in+ik-k1,DOUBLE);
  }
  in -= (k1+k2);

  /* Check if the curve is still valid. Otherwise return zero. */
  
  if (in < ik) goto err101;
     
  if (icopy == 1)
    {

      /* Copy input arrays. First allocate space for new arrays. */

      if ((st = newarray (in +ik, DOUBLE)) == SISL_NULL ||
	  (scoef = newarray (in *kdim, DOUBLE)) == SISL_NULL)
	goto err101;

      /* Copy contents of arrays.  */

      memcopy (st, et, in +ik, double);
      memcopy (scoef, ecoef, in *kdim, double);
    }
  else
    {
      st = et;
      scoef = ecoef;
    }

  /* Initialize new curve.  */

  qnew->in = in;
  qnew->ik = ik;
  qnew->ikind = ikind;
  qnew->idim = idim;
  qnew->icopy = icopy;
  qnew->et = st;
  qnew->pdir = SISL_NULL;
  qnew->pbox = SISL_NULL;

  if (ikind == 2 || ikind == 4)
    {
      /* Calculate the weighted control points if the object is rational  */
      rcoef = newarray (in *idim, DOUBLE);
      if (rcoef == SISL_NULL)
	goto err101;
      for (i = 0, j = 0, J = 0, k = idim; i < in; i++, k += kdim)
	{
	  for (jj = 0; jj < idim; jj++, j++, J++)
	    {
	      rcoef[J] = scoef[j] / scoef[k];
	    }
	  j++;
	}
      qnew->ecoef = rcoef;
      qnew->rcoef = scoef;
    }
  else
    {
      qnew->ecoef = scoef;
      qnew->rcoef = SISL_NULL;
    }


  /* UJK, 92.03.27 Default value must be set for cuopen */
  qnew->cuopen = SISL_CRV_OPEN;

  /* Task done. */
  goto out;

  /* Error in space allocation. Return zero. */

err101:if (qnew != SISL_NULL)
          { freearray (qnew);  qnew = SISL_NULL;}  
  if (st != SISL_NULL)
    freearray (st);
  if (rcoef != SISL_NULL)
    freearray (rcoef);
  if (scoef != SISL_NULL)
    freearray (scoef);
  goto out;

out:return (qnew);
}

//===========================================================================
SISLSurf *
newSurf (int in1, int in2, int ik1, int ik2, double *et1, double *et2,
	 double *ecoef, int ikind, int idim, int icopy)
//===========================================================================
{
  SISLSurf *qnew;		/* Local pointer to new surface.       */
  int i, j, J, jj, k;		/* loop variables                      */
  int k1, k2;                   /* Superfluous knots at the ends.      */
  int kdim;			/* Dimension indicator.                */
  double *st1 = SISL_NULL, *st2 = SISL_NULL;	/* Copy of knotvectors.        */
  double *rcoef = SISL_NULL;		/* Copy of vertices in rational case.  */
  double *scoef = SISL_NULL;		/* Copy of vertices.                   */
  double *ucoef = SISL_NULL;         /* Utility coefficient array.          */

  /* Allocate space for surface.  */

  if ((qnew = newarray (1, SISLSurf)) == SISL_NULL)
    goto err101;

  if (ikind == 2 || ikind == 4)
    kdim = idim + 1;
  else
    kdim = idim;

  /* Count superfluous knots at ends, first in u parameter directions. */

  if (ik1 == 0)
  {
    k1 = k2 = 0;
  }
  else
  {
    /* Count superfluous knots in the start. */

    for (k1 = 0; k1 < in1; k1++)
      if (et1[ik1 - 1] < et1[ik1 + k1]) break;

    /* Count superfluous knots in the end. */

    for (k2 = 0; k2 < in1; k2++)
      if (et1[in1] > et1[in1 - 1 - k2]) break;
  }

  /* Reduce knots and vertices according to k1 and k2. */

  if (k1 > 0 || k2 > 0)
  {
     ucoef = newarray(in1*in2*kdim, DOUBLE);
     s6chpar(ecoef, in1, in2, kdim, ucoef);
  }
  if (k1 > 0)
  {
     memcopy(ucoef, ucoef + k1*in2*kdim, (in1 - k1)*in2*kdim, DOUBLE);
     memcopy(et1, et1 + k1, in1 + ik1 - k1, DOUBLE);
  }
  in1 -= (k1 + k2);
  if (k1 > 0 || k2 > 0)
  {
     s6chpar(ucoef, in2, in1, kdim, ecoef);
     if (ucoef != SISL_NULL) freearray(ucoef);
  }

  /* Count superfluous knots at ends in v parameter directions. */

  if (ik2 == 0)
  {
    k1 = k2 = 0;
  }
  else
  {
    /* Count superfluous knots in the start. */

    for (k1 = 0; k1 < in2; k1++)
     if (et2[ik2 - 1] < et2[ik2 + k1]) break;

    /* Count superfluous knots in the end. */

    for (k2 = 0; k2 < in2; k2++)
      if (et2[in2] > et2[in2 - 1 - k2]) break;
  }
  /* Reduce knots and vertices according to k1 and k2. */

  if (k1 > 0)
  {
     memcopy(ecoef, ecoef + k1*in1*kdim, (in2 - k1)*in1*kdim, DOUBLE);
     memcopy(et2, et2 + k1, in2 + ik2 - k1, DOUBLE);
  }
  in2 -= (k1 + k2);

  if (icopy == 1)
    {

      /* Copy input arrays. First allocate space for new arrays. */

      st1 = newarray (in1 + ik1, DOUBLE);
      st2 = newarray (in2 + ik2, DOUBLE);
      scoef = newarray (in1 * in2 * kdim, DOUBLE);
      if (st1 == SISL_NULL || st2 == SISL_NULL || scoef == SISL_NULL)
	goto err101;

      /* Copy contents of arrays.  */
      memcopy (st1, et1, in1 + ik1, double);
      memcopy (st2, et2, in2 + ik2, double);
      memcopy (scoef, ecoef, in1 * in2 * kdim, double);
    }
  else
    {
      st1 = et1;
      st2 = et2;
      scoef = ecoef;
    }

  /* Initialize new surface. */

  qnew->in1 = in1;
  qnew->in2 = in2;
  qnew->ik1 = ik1;
  qnew->ik2 = ik2;
  qnew->ikind = ikind;
  qnew->idim = idim;
  qnew->icopy = icopy;
  qnew->et1 = st1;
  qnew->et2 = st2;
  qnew->pdir = SISL_NULL;
  qnew->pbox = SISL_NULL;

  if (ikind == 2 || ikind == 4)
    {
      /* Calculate the weighted control points if the object is rational  */
      rcoef = newarray (in1 * in2 * idim, DOUBLE);
      if (rcoef == SISL_NULL)
	goto err101;
      for (i = 0, j = 0, J = 0, k = idim; i < in1 * in2; i++, k += kdim)
	{
	  for (jj = 0; jj < idim; jj++, j++, J++)
	    {
	      rcoef[J] = scoef[j] / scoef[k];
	    }
	  j++;
	}
      qnew->ecoef = rcoef;
      qnew->rcoef = scoef;
    }
  else
    {
      qnew->ecoef = scoef;
      qnew->rcoef = SISL_NULL;
    }
  
  /* UJK, 92.05.05 Default value must be set for cuopen */
  qnew->cuopen_1 = SISL_SURF_OPEN;
  qnew->cuopen_2 = SISL_SURF_OPEN;

  /* Task done. */

  goto out;

  /* Error in space allocation. Return zero. */

err101:if (qnew != SISL_NULL)
    freearray (qnew);
  if (st1 != SISL_NULL)
    freearray (st1);
  if (st2 != SISL_NULL)
    freearray (st2);
  if (rcoef != SISL_NULL)
    freearray (rcoef);
  if (scoef != SISL_NULL)
    freearray (scoef);
  goto out;

out:return (qnew);
}

//===========================================================================
void s6chpar(double ecoef1[],int in1,int in2,int idim,double ecoef2[])
//===========================================================================
{
  register int ki,kj,kk;  /* Counters.  */
  
  for (ki=0; ki<in1; ki++)
    for (kj=0; kj<in2; kj++)
      for (kk=0; kk<idim; kk++)
	ecoef2[(ki*in2+kj)*idim+kk] = ecoef1[(kj*in1+ki)*idim+kk];
}

//===========================================================================
SISLObject *newObject (int iobj)
//===========================================================================
{
  SISLObject *qnew;		/* Local pointer to new object.  */

  qnew = newarray (1, SISLObject);
  if (qnew == SISL_NULL)
    goto out;

  qnew->iobj = iobj;

  qnew->p1 = SISL_NULL;
  qnew->c1 = SISL_NULL;
  qnew->s1 = SISL_NULL;
  qnew->o1 = SISL_NULL;
  qnew->edg[0] = SISL_NULL;
  qnew->edg[1] = SISL_NULL;
  qnew->edg[2] = SISL_NULL;
  qnew->edg[3] = SISL_NULL;
  qnew->psimple = SISL_NULL;

  /* Task done.  */

out:return qnew;
}

//===========================================================================
void freeCurve(SISLCurve *pcurve)
//===========================================================================
{
  int ki;         /* Counter.  */


  if ( pcurve->icopy != 0 )
  {

    /* Free arrays.  */

    freearray(pcurve->et);
    freearray(pcurve->ecoef);
    if ( pcurve->rcoef != SISL_NULL )  freearray(pcurve->rcoef);
  }
  else if ( pcurve->ikind == 2  ||  pcurve->ikind == 4 )
  {
    /* VSK, 940902. The array pcurve->ecoef is ALWAYS allocated in the
       constructor for rationals and must be free'ed.                  */

    freearray(pcurve->ecoef);
  }

  if ( pcurve->pdir )
  {

    /* Free direction structure. */

    if ( pcurve->pdir->ecoef )  freearray(pcurve->pdir->ecoef);
    if ( pcurve->pdir->esmooth != SISL_NULL )  freearray(pcurve->pdir->esmooth);
    freearray(pcurve->pdir);
  }

  if ( pcurve->pbox )
  {

    /* Free surrounded SISLbox structure. */

    if ( pcurve->pbox->emax )  freearray(pcurve->pbox->emax);
    if ( pcurve->pbox->emin )  freearray(pcurve->pbox->emin);

    for ( ki=0;  ki < 3;  ki++ )
    {
      if ( pcurve->pbox->e2max[ki] )  freearray(pcurve->pbox->e2max[ki]);
      if ( pcurve->pbox->e2min[ki] )  freearray(pcurve->pbox->e2min[ki]);
    }
    freearray(pcurve->pbox);
  }

  /* Free instance of curve. */

  freearray(pcurve);

  return;
}

//===========================================================================
void freeSurf(SISLSurf *psurf)
//===========================================================================
{
  int ki;     /* Counter.  */


  if ( psurf->icopy != 0 )
  {

    /* Free arrays.  */

    freearray(psurf->et1);
    freearray(psurf->et2);
    freearray(psurf->ecoef);
    if ( psurf->rcoef != SISL_NULL )  freearray(psurf->rcoef);
  }
  else if ( psurf->ikind == 2  ||  psurf->ikind == 4 )
  {
    /* VSK, 940902. The array pcurve->ecoef is ALWAYS allocated in the
       constructor for rationals and must be free'ed.                  */

    freearray(psurf->ecoef);
  }


  if ( psurf->pdir )
  {

    /* Free direction structure. */

    if ( psurf->pdir->ecoef )  freearray(psurf->pdir->ecoef);
    if ( psurf->pdir->esmooth != SISL_NULL )  freearray(psurf->pdir->esmooth);
    freearray(psurf->pdir);
  }

  if ( psurf->pbox )
  {

    /* Free surrounded SISLbox structure. */

    if ( psurf->pbox->emax )  freearray(psurf->pbox->emax);
    if ( psurf->pbox->emin )  freearray(psurf->pbox->emin);

    for ( ki=0;  ki < 3;  ki++ )
    {
      if ( psurf->pbox->e2max[ki] )  freearray(psurf->pbox->e2max[ki]);
      if ( psurf->pbox->e2min[ki] )  freearray(psurf->pbox->e2min[ki]);
    }
    freearray(psurf->pbox);
  }

  /* Free instance of surface. */

  freearray(psurf);

  return;
}

//===========================================================================
void freeIntcrvlist(SISLIntcurve **viclist, int icrv)
//===========================================================================
{
  /*
   * Local declarations
   * ------------------
   */

  int         ki;

  /*
   * Free each SISLIntcurve from bottom of the list and u to the top.
   * ------------------------------------------------------------
   */

  if (viclist)
    {
      for ( ki = icrv - 1; ki >= 0; ki --)
	{
	  if (viclist[ki])
	    {
	      freeIntcurve(viclist[ki]);
	      viclist[ki] = SISL_NULL;
	    }
	}
      freearray(viclist);
      viclist = SISL_NULL;
    }
}

//===========================================================================
void freeIntcurve(SISLIntcurve *pintc)
//===========================================================================
{
  /* Free whatever is allocated */

  if (pintc)
    {
      if (pintc->epar1) freearray(pintc->epar1);
      if (pintc->epar2) freearray(pintc->epar2);
      if (pintc->pgeom) freeCurve(pintc->pgeom);
      if (pintc->ppar1) freeCurve(pintc->ppar1);
      if (pintc->ppar2) freeCurve(pintc->ppar2);
      freearray(pintc);
    }
  return;
}

//===========================================================================
void s1770_s9corr(double gdn[],double acoef1,double acoef2,
		   double astart1,double aend1,double astart2,double aend2)
//===========================================================================
{
  if (acoef1 + gdn[0] < astart1) 
    gdn[0] = astart1 - acoef1;
  else if (acoef1 + gdn[0] > aend1)   
    gdn[0] = aend1 - acoef1;

  if (acoef2 + gdn[1] < astart2) 
    gdn[1] = astart2 - acoef2;
  else if (acoef2 + gdn[1] > aend2)   
    gdn[1] = aend2 - acoef2;
}

//===========================================================================
void s1770_s9dir(double *cdist,double *cdiff1,double *cdiff2,
		  double gdiff[],double eval1[],double eval2[],int idim)
//===========================================================================
{                        
  int kstat;		           /* Local status variable. */
  register double tdet;		   /* Determinant */
  register double t1,t2,t3,t4,t5;  /* Variables in equation system */
  
  /* Computing the different vector */
  
  s6diff(eval1,eval2,idim,gdiff);
  
  /* Computing the length of the different vector. */
  
  *cdist = s6length(gdiff,idim,&kstat);
  
  t1 =  s6scpr(eval1+idim,eval1+idim,idim);
  t2 =  s6scpr(eval1+idim,eval2+idim,idim);
  t3 =  s6scpr(eval2+idim,eval2+idim,idim);
  t4 =  s6scpr(gdiff,eval1+idim,idim);
  t5 =  s6scpr(gdiff,eval2+idim,idim);
  
  /* Computing the determinant. */
  
  tdet = t2*t2 - t1*t3;
  
  if (DEQUAL(tdet,DZERO))
    {
      *cdiff1 = DZERO;
      *cdiff2 = DZERO;
    }
  else 
    {
      /* Using Cramer's rule to find the solution of the system. */
      
      *cdiff1 =  (t4*t3 - t5*t2)/tdet;
      *cdiff2 =  (t2*t4 - t1*t5)/tdet;
    }
}

//===========================================================================
void s1314(SISLSurf *ps1,double *epoint,double *enorm,int idim,double aepsco,
	   double aepsge,double amax,SISLIntcurve *pintcr,int icur,
	   int igraph,int *jstat)
//===========================================================================
{            
  int kpos=0;         /* Position of error                                  */
  int kdeg=1;         /* The degree of the implicit equation of the plane   */
  int kstat;          /* Local status variable                              */
  double simpli[4];   /* Array containing the implicit description of plane */
  double snorm[3];    /* Normalized version of normal vector                */
  
  
  
  if (idim != 3) goto err104;
  
  /* Normalize normal vector */
  
  (void)s6norm(enorm,idim,snorm,&kstat);
  
  simpli[0] = snorm[0];
  simpli[1] = snorm[1];
  simpli[2] = snorm[2];
  simpli[3] = -s6scpr(epoint,snorm,idim);
  
  
  /* Make intersection of implicit surface and B-spline surface */
  
  s1313(ps1,simpli,kdeg,aepsco,aepsge,amax,pintcr,icur,igraph,&kstat);
  if (kstat == -185) goto err185;
  if (kstat < 0) goto error;
  
  *jstat = kstat;
  goto out;
  
  /* Dimension not 3 */
  
 err104: 
  *jstat = -104;                
  s6err("s1314",*jstat,kpos);
  goto out;
  
  /* Couldn't march */
  
 err185:
  *jstat = -185;
  goto out;
  
  /* Error in lower level routine.  */
  
 error: 
  *jstat = kstat;     
  s6err("s1314",*jstat,kpos);
  goto out;
  
 out:
  return;
}                                               

void
     s1316(SISLSurf *ps1,double *epoint,double *edirec,double aradiu,
	   int idim,double aepsco,double aepsge,double amax,
	   SISLIntcurve *pintcr,int icur,int igraph,int *jstat)
/*
*********************************************************************
*
*********************************************************************
*
* PURPOSE    : To march an intersection curve desribed by parameter pairs
*              in an intersection curve object, a B-spline surface and
*              a cylinder.
*
*
* INPUT      : ps1    - Pointer to surface.
*              epoint - SISLPoint on cylinder axis
*              edirec - Direction vector of cylinder axis
*              aradiu - Radius of sphere
*              idim   - Dimension of the space in which the plane lies.
*              aepsco - Computational resolution.
*              aepsge - Geometry resolution.
*              amax   - Maximal allowed step length. If amax <=aepsge
*                       amax is neglected.
*              icur   - Indicator telling if a 3-D curve is to be made
*                        0 - Don't make 3-D curve
*                        1 - Make 3-D curve
*                        2 - Make 3-D curve and curves in parameter plane
*              igraph - Indicator telling if the curve is to be outputted
*                       through function calls:
*                        0 - don't output curve through function call
*                        1 - output as straight line segments through
*                            s6move and s6line.
*
*
*
* INPUT/OUTPUT:pintcr - The intersection curve. When comming as input
*                       only parameter values it the parameter plane
*                       exist. When comming as output the 3-D geometry
*                       and possibly the curve in the parameter plane
*                       of the surface is added.
*
* OUTPUT:      jstat  - status messages
*                         = 3      : Iteration stopped due to singular
*                                    point or degenerate surface. A part
*                                    of intersection curve may have been
*                                    traced out. If no curve is traced out
*                                    the curve pointers in the Intcurve
*                                    object point to SISL_NULL.
*                         = 0      : ok
*                         < 0      : error
*                         = -185   : No points produced on intersection curve.
*
*
* METHOD     : An implicit description of the cylinder is made and then
*              a routine for intersecting implicit represented geometry
*              by a B-spline surface is used.
*
* REFERENCES :
*
*-
* CALLS      : s6err, s1313, s1322
* WRITTEN BY : Tor Dokken, SI, Oslo, Norway, 2. July 1988
*
*********************************************************************
*/
{
  int kpos=0;         /* Position of error                                  */
  int kdeg=2;         /* The degree of the implicit equation of the plane   */
  int knumb=1;        /* Number of implicit representations to be made      */
  int kstat;          /* Local status variable                              */
  double simpli[16];  /* Array containing the implicit description of sphere*/

  if (idim != 3) goto err104;

  /* Make description of cylinder */

  s1322(epoint,edirec,aradiu,idim,knumb,simpli,&kstat);
  if (kstat < 0) goto error;

  /* Make intersection of implicit surface and B-spline surface */

  s1313(ps1,simpli,kdeg,aepsco,aepsge,amax,pintcr,icur,igraph,&kstat);
  if (kstat == -185) goto err185;
  if (kstat < 0) goto error;

  *jstat = kstat;
  goto out;

  /* Dimension not 3 */

 err104: *jstat = -104;
  s6err("s1316",*jstat,kpos);
  goto out;

  /* Couldn't march */

 err185:
  *jstat = -185;
  goto out;

  /* Error in lower level routine.  */

 error:
  *jstat = kstat;
  s6err("s1316",*jstat,kpos);
  goto out;

 out:
  return;
}

//===========================================================================
void sh1857(SISLCurve *pc1,SISLCurve *pc2,double aepsco,double aepsge,
	    int trackflag, int *jtrack, SISLTrack *** wtrack,
	    int *jpt,double **gpar1,double **gpar2,int **pretop,
	    int *jcrv,SISLIntcurve ***wcurve,int *jstat)
//===========================================================================
{            
  double *nullp = SISL_NULL;
  int kstat = 0;                 /* Local status variable.                   */
  int kpos = 0;                  /* Position of error.                       */
  SISLObject *qo1 = SISL_NULL;            /* Object containing first curve in 
				    the intersection.                        */
  SISLObject *qo2 = SISL_NULL;            /* Object containing second curve in 
				    the intersection.                        */
  SISLIntdat *qintdat = SISL_NULL;       /* Structure holding the intersection data. */
  int      ksurf=0;         /* Dummy number of Intsurfs. */
  SISLIntsurf **wsurf=SISL_NULL;    /* Dummy array of Intsurfs. */
  int kdeg=0;
  
  *jpt  = 0;
  *jcrv = 0;
  *jtrack = 0;

  /* 
   * Check dimensions.  
   * -----------------
   */

  if (pc1 -> idim != pc2 -> idim) goto err106;

  /* 
   * Create objects and connect curves to the objects.  
   * -------------------------------------------------
   */

  if ((qo1 = newObject(SISLCURVE)) == SISL_NULL) goto err101;
  qo1 -> c1 = pc1;
  qo1 -> o1 = qo1;
  
  if ((qo2 = newObject(SISLCURVE)) == SISL_NULL) goto err101;
  qo2 -> c1 = pc2;
  qo2 -> o1 = qo2;
  
  /* 
   * Find intersections.  
   * -------------------
   */

  sh1761(qo1,qo2,aepsge,&qintdat,&kstat);
  if (kstat < 0) goto error;

  /* Join periodic curves */
  int_join_per( &qintdat,qo1,qo2,nullp,kdeg=0,aepsge,&kstat);
  if (kstat < 0)
    goto error;

  /* Create tracks */
  if (trackflag && qintdat)
    {
      make_tracks (qo1, qo2, 0, nullp,
		   qintdat->ilist, qintdat->vlist, 
		   jtrack, wtrack, aepsge, &kstat);
      if (kstat < 0)
	goto error;
    }

  /* 
   * Express intersections on output format.  
   * ---------------------------------------
   */

  if (qintdat)/* Only if there were intersections found */
    {
      hp_s1880(qo1, qo2, kdeg,
	       1,1,qintdat,jpt,gpar1,gpar2,pretop,jcrv,wcurve,&ksurf,&wsurf,&kstat);
      if (kstat < 0) goto error;
    }
  
  /* 
   * Intersections found.  
   * --------------------
   */

  *jstat = 0;
  goto out;

  /* 
   * Error in space allocation.  
   * --------------------------
   */

 err101: *jstat = -101;                
        s6err("sh1857",*jstat,kpos);
        goto out;

  /* Dimensions conflicting.  */

 err106: *jstat = -106;
        s6err("sh1857",*jstat,kpos);
        goto out;

  /* Error in lower level routine.  */

  error : *jstat = kstat;
        s6err("sh1857",*jstat,kpos);
        goto out;

 out:

  /* 
   * Free allocated space.  
   * ---------------------
   */

  if (qo1) 
    {
      qo1 -> c1 = SISL_NULL;  freeObject(qo1);
    }
  if (qo2) 
    {
      qo2 -> c1 = SISL_NULL;  freeObject(qo2);
    }
  if (qintdat) freeIntdat(qintdat);

  /*
   * Exit sh1857.
   * -----------
   */
                                        
return;
}                                               

//===========================================================================
void
   s1871(SISLCurve *pc1, double *pt1, int idim, double aepsge,
	 int *jpt,double **gpar1,int *jcrv,SISLIntcurve ***wcurve,int *jstat)
//===========================================================================

/*
*********************************************************************
*
*********************************************************************
*
* PURPOSE    : Find all intersections between a B-spline curve
*              and a point.
*
*
*
* INPUT      : pc1    - Pointer to the curve.
*              pt1    - coordinates of the point.
*	       idim   - number of coordinates in pt1.
*              aepsge - Geometry resolution.
*
*
*
* OUTPUT     : jpt    - Number of single intersection points.
*              gpar1  - Array containing the parameter values of the
*                       single intersection points in the parameter
*                       interval of the curve. The points lie
*                       continuous. Intersection curves are stored in wcurve.
*              jcrv   - Number of intersection curves.
*              wcurve - Array containing descriptions of the intersection
*                       curves. The curves are only described by points
*                       in the parameter plane. The curve-pointers points
*                       to nothing. (See description of Intcurve
*                       in intcurve.dcl).
*                       If the curves given as input are degnenerate an
*                       intersection point can be returned as an intersection
*                       curve. Use s1327 to decide if an intersection curve
*                       is a point on one of the curves.
*              jstat  - status messages
*                                         > 0      : warning
*                                         = 0      : ok
*                                         < 0      : error
*
*
*
*********************************************************************
*/
{
  int kstat = 0;           /* Local status variable.                       */
  int kpos = 0;            /* Position of error.                           */
  int trackflag = 0;
  int jtrack;
  int *pretop=SISL_NULL;
  SISLTrack **wtrack=SISL_NULL;
  double aepsco = REL_COMP_RES;

  sh1871(pc1, pt1, idim, aepsco, aepsge, trackflag, &jtrack, &wtrack,
	 jpt, gpar1, &pretop, jcrv, wcurve, &kstat);
  if(kstat < 0) goto error;

  if(pretop != SISL_NULL) freearray(pretop);

  /*
   * Intersections found.
   * --------------------
   */

  *jstat = kstat;
  goto out;

  /* Error in lower level routine.  */

  error :
    *jstat = kstat;
    s6err("s1871",*jstat,kpos);
    goto out;

  out:
    return;
}

//===========================================================================
void 
sh1871(SISLCurve *pc1, double *pt1, int idim, double aepsco, double aepsge,
	int trackflag, int *jtrack, SISLTrack *** wtrack,
	   int *jpt,double **gpar1,int **pretop,int *jcrv,SISLIntcurve ***wcurve,int *jstat)
//===========================================================================

/*
*********************************************************************
*
*********************************************************************
*                                                                   
* PURPOSE    : Find all intersections between a B-spline curve
*              and a point.
*
*
*
* INPUT      : pc1    - Pointer to the curve.
*              pt1    - coordinates of the point.
*	       idim   - number of coordinates in pt1.	
*              aepsco - Computational resolution.
*              aepsge - Geometry resolution.
*              trackflag - For future use. Should now be 0.
*
*
*
* OUTPUT     : jtrack - Number of tracks created
*              wtrack - Array of pointers to tracks
*              jpt    - Number of single intersection points.
*              gpar1  - Array containing the parameter values of the
*                       single intersection points in the parameter
*                       interval of the curve. The points lie 
*                       continuous. Intersection curves are stored in wcurve.
*              pretop - Topology info. for single intersection points.
*              jcrv   - Number of intersection curves.
*              wcurve - Array containing descriptions of the intersection
*                       curves. The curves are only described by points
*                       in the parameter plane. The curve-pointers points
*                       to nothing. (See description of Intcurve
*                       in intcurve.dcl).
*                       If the curves given as input are degnenerate an
*                       intersection point can be returned as an intersection
*                       curve. Use s1327 to decide if an intersection curve
*                       is a point on one of the curves.
*              jstat  - status messages  
*                                         > 0      : warning
*                                         = 0      : ok
*                                         < 0      : error
*
*
*********************************************************************
*/
{            
  double *nullp = SISL_NULL;
  int kstat = 0;                 /* Local status variable.                   */
  int kpos = 0;                  /* Position of error.                       */
  SISLObject *qo1 = SISL_NULL;            /* Object containing the curve in 
				    the intersection.                        */
  SISLObject *qo2 = SISL_NULL;            /* Object containing the point in 
				    the intersection.*/
  SISLPoint  *pp1 = SISL_NULL;	   /* Point object containing the point */
  SISLIntdat *qintdat = SISL_NULL;        /* Structure holding the intersection data. */
  int      ksurf=0;         /* Dummy number of Intsurfs. */
  SISLIntsurf **wsurf=SISL_NULL;    /* Dummy array of Intsurfs. */
  int kdeg=0;
  
  /* 
   * Check dimensions.  
   * -----------------
   */

  *jpt  = 0;
  *jcrv = 0;
  *jtrack = 0;

  if (pc1 -> idim != idim) goto err106;

  /* 
   * Create objects and connect curve/point to the objects.  
   * --------------------------------------------------------
   */

  if ((qo1 = newObject(SISLCURVE)) == SISL_NULL) goto err101;
  qo1 -> c1 = pc1;
  qo1 -> o1 = qo1;

  if ((pp1 = newPoint(pt1,idim, 0)) == SISL_NULL) goto err101;
  
  if ((qo2 = newObject(SISLPOINT)) == SISL_NULL) goto err101;
  qo2 -> p1 = pp1;
  qo2 -> o1 = qo2;
  
  /* 
   * Find intersections.  
   * -------------------
   */

  sh1761(qo1,qo2,aepsge,&qintdat,&kstat);
  if (kstat < 0) goto error;

  /* Represent degenerated intersection curves as one point.  */

  sh6degen(qo1,qo2,&qintdat,aepsge,&kstat);
  if (kstat < 0) goto error;

  /* Join periodic curves */
/*    int_join_per( &qintdat,qo1,qo2,nullp,kdeg=0,aepsge,&kstat); */
/*    if (kstat < 0) */
/*      goto error; */

  /* Create tracks */
  if (trackflag && qintdat)
    {
      make_tracks (qo1, qo2, kdeg=0, nullp,
		   qintdat->ilist, qintdat->vlist, 
		   jtrack, wtrack, aepsge, &kstat);
      if (kstat < 0)
	goto error;

    }

  /* 
   * Express intersections on output format.  
   * ---------------------------------------
   */

  if (qintdat)/* Only if there were intersections found */
    {
      hp_s1880(qo1, qo2, 0,
	       1,0,qintdat,jpt,gpar1,&nullp,pretop,jcrv,wcurve,&ksurf,&wsurf,&kstat);
      if (kstat < 0) goto error;
    }
  
  /* 
   * Intersections found.  
   * --------------------
   */

  *jstat = 0;
  goto out;

  /* 
   * Error in space allocation.  
   * --------------------------
   */

 err101: *jstat = -101;                
        s6err("sh1871",*jstat,kpos);
        goto out;

  /* Dimensions conflicting.  */

 err106: *jstat = -106;
  s6err("sh1871",*jstat,kpos);
        goto out;

  /* Error in lower level routine.  */

  error : *jstat = kstat;
        s6err("sh1871",*jstat,kpos);
        goto out;

 out:

  /* 
   * Free allocated space.  
   * ---------------------
   */

  if (qo1) 
    {
      qo1 -> c1 = SISL_NULL;  freeObject(qo1);
    }
  if (qo2)  freeObject(qo2);

  if (qintdat) freeIntdat(qintdat);

  /*
   * Exit sh1871.
   * -----------
   */
                                        
  return;
}                                               


//===========================================================================
void s1310(SISLSurf *psurf1,SISLSurf *psurf2,SISLIntcurve *pinter,
	   double aepsge,double amax,int icur,int igraph,int *jstat)
//===========================================================================
{
  int ki,kj,kl;            /* Control variables in for loops            */
  int kcont;               /* Stop condition for loop                   */
  int kk,kn;               /* Dummy variables                           */
  int kstpch;              /* Status of iteration step                  */
  int kpoint;              /* Number of points in guide curve           */
  int kpar1;               /* Number of parameter direction in 1st. obj */
  int kpar2;               /* Number of parameter direction in 2nd. obj */
  int kpar;                /* Indicater tellin if s1359 shall make
			      parametrization or use parametrization
			      in spar                                   */
  int ktype;               /* Type of intersection curve                */
  int klfu=0;              /* Pointers into knot vectors                */
  int klfv=0;              /* Pointers into knot vectors                */
  int klfs=0;              /* Pointers into knot vectors                */
  int klft=0;              /* Pointers into knot vectors                */
  int kder = 2;            /* Calculate up to second derivatives        */
  int kdim = 3;            /* The dimension of the space we work in     */
  int kfirst = 0;          /* Indicator telling if first guide point
			      degenerate */
  int klast = 0;           /* Indicator telling if last guide point
			      degenerate */
  int kpos = 0;            /* Position of error                         */
  int kstat,kstat1;        /* Status variable returned form routine     */
  int kmaxinf=0;           /* Number of entries object that can be stored
			      in s3dinf, sp1inf, sp2inf                 */
  int knbinf=0;            /* Number of entries stored so far on s3dinf,
			      sp1inf and sp2inf                         */
  int kstart;              /* Start point for iteration among guide pnts*/
  int kguide;              /* Current guide point                       */
  int kdir;                /* March direction                           */
  int kgdir;               /* Direction we march guide point vector     */
  int krem,krem1,krem2;    /* REmember status of boundary crossing      */
  int kbound;              /* Whci boundary is crossed                  */
  int koutside_resolution; /* Flag telling if current seg. outside res. */
  int kdiv=0;              /* Flag telling if iteration diverged        */
  double tlnorm=DZERO;     /* Length of normal vector                   */
  double tltan1=DZERO;     /* Length of tangents                        */
  double tltan2=DZERO;     /* Length of tangents                        */
  double tang1,tang2;      /* Angles                                    */
  int knb1=0;              /* Remember number of points after marching
			      in first marching direction               */
  int kgd1=0;              /* Remeber last guide point used in first
			      marching direction                        */
  double *scorpnt=SISL_NULL;    /* Corrected marching points                 */
  double *scorpr1=SISL_NULL;    /* Corrected marching parameter values in ps1*/
  double *scorpr2=SISL_NULL;    /* Corrected marching parameter values in ps2*/
  double smidd[6];         /* Description of midpoint and tangent of
			      current Bezier segment                    */
  double tcurstep;         /* Current step length                       */
  double tdist;            /* Error at middle of current Bezier segement*/
  double tang;             /* Angle error at midpoint Bezier segement   */
  double tnew;             /* Candidate for new step length             */
  double tfak;             /* How much is the step length to be reduced */
  double *start;           /* Pointer to start of current segment       */
  double *st;              /* Pointer to knot vector                    */
  double tstep;            /* Iteration step length                     */
  double tmax;             /* Local maximal step length                 */
  double tstartstp;        /* Start step length                         */
  double trad;             /* Radius of curvature                       */
  double spar1[2];         /* Parameter pair of current point surface 1 */
  double spar2[2];         /* Parameter pair of current point surface 2 */
  double sparmid1[2];      /* Parameter values at middle of Bezier segm */
  double sparmid2[2];      /* Parameter values at middle of Bezier segm */
  double sipar1[2];        /* Parameter pair iteration point surface  1 */
  double sipar2[2];        /* Parameter pair iteration point surface 2  */
  double simiddpnt[10];    /* Middle point and tangent of segment       */
  double simiddpar1[7];    /* Parameter value at middle point of segment*/
  double simiddpar2[7];    /* Parameter value at middle point of segment*/
  double startg[3];        /* Tangent of start point of iteration       */
  double *sgpar1=SISL_NULL;     /* Parameter pairs of guide point in surf 1  */
  double *sgpar2=SISL_NULL;     /* Parameter pairs of guide point in surf 2  */
  double *sgpara=SISL_NULL;     /* Parameter pairs of guide point in surf 1  */
  double *sgparb=SISL_NULL;     /* Parameter pairs of guide point in surf 2  */
  double *sgd1 = SISL_NULL;     /* 0-2 derivative of guide point + normal
			      of first object                           */
  double *sgd2 = SISL_NULL;     /* 0-2 derivative of guide point + normal
			      of second object                          */
  double spnt1[21];        /* Info on current point in first surface    */
  double spnt2[21];        /* Info on current point in second surface   */
  double sipnt1[21];       /* Info on iteration point in first surface  */
  double sipnt2[21];       /* Info on iteration point in second surface */
                           /* For spnt1, spnt2, sipnt1, sipnt2,         */
                           /* the information is stored 3-tuppels       */
                           /* in the following sequence                 */
                           /* Position, (1,0)-der, (0,1)-der,           */
                           /* (2,0)-der, (1,1)-der (0,2)-der and normal */
                           /* This is compatible with output of s1421   */
  double spntend1[21];     /* End values of candidate end point in surf1*/
  double spntend2[21];     /* End values of candidate end point in surf1*/
  double sparend1[2];      /* Parameter value at candidate end point    */
  double sparend2[2];      /* Parameter value at candidate end point    */
  double *snxt1;           /* SISLPoint in psurf1 we have accepted          */
  double *snxt2;           /* SISLPoint in psurf2 we have accepted          */
  double *snxp1;           /* Parameter value belonging to snxt1        */
  double *snxp2;           /* Parameter value belonging to snxt2        */
  double *s3dinf=SISL_NULL;     /* Pointer to array used for storing 3-D position
			      tangent, curvature and radius of curvature found
			      during the marching process */
  double *sp1inf=SISL_NULL;     /* Pointer to array used for storing position
			      tangent, curvature and radius of curvature found
			      in the first parameter plane during the
			      marching process */
  double *sp2inf=SISL_NULL;     /* Pointer to array used for storing position
			      tangent, curvature and radius of curvature found
			      in the first parameter plane during the
			      marching process */
  double *spar=SISL_NULL;       /* Parametrization of points                 */
  double sval1[2];         /* Limits of parameter plane in first SISLdir    */
  double sval2[2];         /* Limits of parameter plane in second SISLdir   */
  double sval3[2];         /* Limits of parameter plane in third SISLdir    */
  double sval4[2];         /* Limits of parameter plane in fourth SISLdir   */
  double tref1,tref2;      /* Reference values for knot vectors         */
  double tref3,tref4;      /* Reference values for knot vectors         */
  double start1[21];       /* Description of start point in psurf1      */
  double start2[21];       /* Description of start point in psurf1      */
  double stpar1[2];        /* Parameter pair belonging to start1        */
  double stpar2[2];        /* Parameter pair belonging to start2        */
  double sdum1[3],sdum2[3];/* Dummy vectors                             */
  double tdum,tdump1,tdump2;/*Dummy variable                            */
  double *sp1=SISL_NULL;        /* Pointer used when moving information      */
  double *sp2=SISL_NULL;        /* Pointer used when moving information      */
  double stdum[10];        /* Dummy array used when moving information  */
  double *stang;           /* Pointer to tangent of current point       */
  double *stangp1;         /* Pointer to tangent of current point in pp1*/
  double *stangp2;         /* Pointer to tangent of current point in pp2*/
  double *spoint;          /* Pointer to current point                  */
  double t1distgd,t2distgd;/* Distances to guide points                 */
  SISLCurve *q3dcur=SISL_NULL;/* Pointer to 3-D curve                     */
  SISLCurve *qp1cur=SISL_NULL;/* Pointer to curve in first parameter plane*/
  SISLCurve *qp2cur=SISL_NULL;/* Pointer to curve in 2.nd  parameter plane*/


  *jstat = 0;

  if ( pinter == SISL_NULL )  goto err150;


  /* Check if the geometry already has been generated in the topology part.
     This will be the case if the geometry is along a constant parameter line.
     Freeing the geometry her makes it possible to generate curves for both
     parameter planes if required (the pointers will be set to SISL_NULL further
     down, i.e. would cause a memory leak if they weren't free'ed here. */

  if (pinter->itype == 9)
  {
    if (pinter->pgeom)  freeCurve(pinter->pgeom);
    if (pinter->ppar1)  freeCurve(pinter->ppar1);
    if (pinter->ppar2)  freeCurve(pinter->ppar2);
  }


  /* Make maximal step length based on box-size of surface */

  sh1992su(psurf1,0,aepsge,&kstat);
  if (kstat < 0) goto error;

  tmax = MAX(psurf1->pbox->e2max[0][0] - psurf1->pbox->e2min[0][0],
	     psurf1->pbox->e2max[0][1] - psurf1->pbox->e2min[0][1]);
  tmax = MAX(tmax,psurf1->pbox->e2max[0][2] - psurf1->pbox->e2min[0][2]);

  sh1992su(psurf2,0,aepsge,&kstat);
  if (kstat < 0) goto error;

  tmax = MAX(tmax,psurf2->pbox->e2max[0][0] - psurf2->pbox->e2min[0][0]);
  tmax = MAX(tmax,psurf2->pbox->e2max[0][1] - psurf2->pbox->e2min[0][1]);
  tmax = MAX(tmax,psurf2->pbox->e2max[0][2] - psurf2->pbox->e2min[0][2]);

  if (amax>DZERO) tmax = MIN(tmax,amax);

  /* Find a none singular start point for the marching process */

  kpoint = pinter->ipoint;
  kpar1  = pinter->ipar1;
  kpar2  = pinter->ipar2;
  sgpara = pinter->epar1;
  sgparb = pinter->epar2;
  ktype  = pinter->itype;


  /* To support closed curve the first guide point must be copied after
     the last guide point */

  if((sgpar1=newarray(2*kpoint+2,DOUBLE)) == SISL_NULL) goto err101;
  if((sgpar2=newarray(2*kpoint+2,DOUBLE)) == SISL_NULL) goto err101;
  memcopy(sgpar1,sgpara,2*kpoint,DOUBLE);
  memcopy(sgpar2,sgparb,2*kpoint,DOUBLE);

  if (ktype ==2 || ktype == 3)
    {
      /*Closed curve copy first guide point to end of string of guide points */
      memcopy(sgpar1+2*kpoint,sgpara,2,DOUBLE);
      memcopy(sgpar2+2*kpoint,sgparb,2,DOUBLE);
      kpoint = kpoint + 1;
    }

  /* Initiate pointers to intersection curve and intersection curve in
     parameter plane */

  pinter -> pgeom = SISL_NULL;
  pinter -> ppar1 = SISL_NULL;
  pinter -> ppar2 = SISL_NULL;

  /* Initiate parameter direction boundaries */

  kk    = psurf1 -> ik1;
  kn    = psurf1 -> in1;
  st    = psurf1 -> et1;
  sval1[0] = st[kk-1];
  sval1[1] = st[kn];
  tref1 = (double)3.0*MAX(fabs(*sval1),fabs(*(sval1+1)));
  kk    = psurf1 -> ik2;
  kn    = psurf1 -> in2;
  st    = psurf1 -> et2;
  sval2[0] = st[kk-1];
  sval2[1] = st[kn];
  tref2 = (double)3.0*MAX(fabs(*sval2),fabs(*(sval2+1)));
  kk    = psurf2 -> ik1;
  kn    = psurf2 -> in1;
  st    = psurf2 -> et1;
  sval3[0] = st[kk-1];
  sval3[1] = st[kn];
  tref3 = (double)3.0*MAX(fabs(*sval3),fabs(*(sval3+1)));
  kk    = psurf2 -> ik2;
  kn    = psurf2 -> in2;
  st    = psurf2 -> et2;
  sval4[0] = st[kk-1];
  sval4[1] = st[kn];
  tref4 = (double)3.0*MAX(fabs(*sval4),fabs(*(sval4+1)));



  /* Test the both objects have 2 parameter directions */

  if (kpar1 != 2 || kpar2 != 2) goto err123;

  /*THE POINTS , TANGENT, CURVATURE AND RADIUS OF CURVATURE FOUND DURING
    THE MARCHING PROCESS SHOULD ALL BE STORED IN ARRAYS. ALLOCATE ONE ARRAY
    FOR 3-D INFORMATION , ONE ARRAY FOR INFORMATION IN FIRST PARAMETER PLANE
    AND ONE ARRAY FOR INFORMATION IN SECOND PARAMETER PLANE. THESE ARRAYS
    ARE GIVEN AN INITIAL CAPACITY OF STORING 100 POINTS WITH OTHER INFORMATION.
    IF THEY ARE TO SHORT THEY WILL BE REALLOCATED AT A LATER STAGE.

    SINCE THE STEPPING WILL GO IN BOTH DIRECTIONS WE WILL HAVE TO TURN THE
    INFORMATION FOUND WHEN MARCHING IN NEGATIVE DIRECTION, SO THAT IT CAN
    BE COMBINED WITH THE INFORMATION FOUND WHEN WE ARE MARCHING IN POSITVE
    DIRECTION.
    */

  kmaxinf = 100;
  s3dinf = newarray(10*kmaxinf,DOUBLE);
  if (s3dinf == SISL_NULL) goto err101;
  sp1inf = newarray(7*kmaxinf,DOUBLE);
  if (sp1inf == SISL_NULL) goto err101;
  sp2inf = newarray(7*kmaxinf,DOUBLE);
  if (sp2inf == SISL_NULL) goto err101;



  /* Evaluate 0-1-2nd. derivative + normal of all guide points in both
     surfaces, first allocate arrays for storing the information */

  sgd1 = newarray(21*kpoint,DOUBLE);
  if (sgd1==SISL_NULL) goto err101;
  sgd2 = newarray(21*kpoint,DOUBLE);
  if (sgd2==SISL_NULL) goto err101;

  kpos = 5;

  /* Initiate kstart to point at no point */

  kstart = 0;

  for (ki=0,kj=0,kl=0 ; ki<kpoint ; ki++,kj+=2,kl+=21)
    {
      s1421(psurf1,kder,&sgpar1[kj],&klfu,&klfv,&sgd1[kl],&sgd1[kl+18],&kstat);
      if (kstat<0) goto error;

      /*  Find length of normal vector and tangent vectors */

      tlnorm = s6length(&sgd1[kl+18],kdim,&kstat);
      tltan1 = s6length(&sgd1[kl+ 3],kdim,&kstat);
      tltan2 = s6length(&sgd1[kl+ 6],kdim,&kstat);

      /* The cross product satisifes the following conditions:
	 length(axb) = length(a) length(b) sin(angle(a,b)).
	 Thus the angle between the two vectors can be found, close to 0
	 sin(a) is a good approximation of a */

      if (tlnorm == DZERO || tltan1 ==DZERO || tltan2 == DZERO)
        tang1 = DZERO;
      else
        tang1 = tlnorm/(tltan1*tltan2);

      s1421(psurf2,kder,&sgpar2[kj],&klfs,&klft,&sgd2[kl],&sgd2[kl+18],&kstat);
      if (kstat<0) goto error;

      /*  Find length of normal vector and tangent vectors */

      tlnorm = s6length(&sgd2[kl+18],kdim,&kstat);
      tltan1 = s6length(&sgd2[kl+ 3],kdim,&kstat);
      tltan2 = s6length(&sgd2[kl+ 6],kdim,&kstat);

      /*  The cross product satisifes the follwing conditions:
	  length(axb) = length(a) length(b) sin(angle(a,b)).
	  Thus the angle between the two vectors can be found, close to 0
	  sin(a) is a good approximation of a */

      if (tlnorm == DZERO || tltan1 ==DZERO || tltan2 == DZERO)
        tang2 = DZERO;
      else
        tang2 = tlnorm/(tltan1*tltan2);


      if (tang1 >= ANGULAR_TOLERANCE && tang2 >= ANGULAR_TOLERANCE)
        {
	  /* Make tangent of intersection curve */

	  s6crss(&sgd1[kl+18],&sgd2[kl+18],sdum1);

	  tlnorm = s6length(sdum1,kdim,&kstat);

	  /* Remember if start, internal or end point */

	  if (tlnorm != DZERO)
	    {
	      if (ki == 0)
		kfirst = 1;
	      else if (ki == kpoint-1)
		klast = kpoint;
	      else
		kstart = ki+1;
	    }
        }
    }


  /* Check if only degenerate points or singularities exist on the
     intersection curve */

  if (kstart == 0)
    {
      /*  No internal nondegenerate point exits, start marching from first
	  or last point if possible */

      if (kfirst != 0 && ktype != 5 && ktype != 7) kstart = kfirst;
      else if (klast != 0 && ktype != 6 &&
	       ktype != 7 && ktype != 3) kstart = klast;
      else if (kfirst != 0) kstart = kfirst;
      else if (klast != 0) kstart = klast;
      else goto interpolate;
    }


  /* To speed up the marching process when many guide points are given,
     remove guide points that are not at the start, end or the start point */

  if (kpoint >2 && (kstart==1 || kstart==kpoint) )
    {
      /*  No internal guide point necessary, copy last point to second point */
      memcopy(sgd1+21,sgd1+21*(kpoint-1),21,DOUBLE);
      memcopy(sgpar1+2,sgpar1+2*(kpoint-1),2,DOUBLE);
      memcopy(sgd2+21,sgd2+21*(kpoint-1),21,DOUBLE);
      memcopy(sgpar2+2,sgpar2+2*(kpoint-1),2,DOUBLE);

      if (kstart ==  kpoint) kstart = 2;
      kpoint = 2;
    }
  else if (kpoint>2)
    {
      /*  Internal guide point exists, copy this to second position and
	  copy end point to third position */

      memcopy(sgd1+21,sgd1+21*(kstart-1),21,DOUBLE);
      memcopy(sgpar1+2,sgpar1+2*(kstart-1),2,DOUBLE);
      memcopy(sgd2+21,sgd2+21*(kstart-1),21,DOUBLE);
      memcopy(sgpar2+2,sgpar2+2*(kstart-1),2,DOUBLE);

      memcopy(sgd1+2*21,sgd1+21*(kpoint-1),21,DOUBLE);
      memcopy(sgpar1+4,sgpar1+2*(kpoint-1),2,DOUBLE);
      memcopy(sgd2+2*21,sgd2+21*(kpoint-1),21,DOUBLE);
      memcopy(sgpar2+4,sgpar2+2*(kpoint-1),2,DOUBLE);

      kpoint = 3;
      kstart = 2;
    }

  /* Remember description of start point in both surfaces,
     copy point indicated by kstart into spnt1,spnt2,spar1,spar2 */

  memcopy(spnt1,sgd1+21*(kstart-1),21,DOUBLE);
  memcopy(spnt2,sgd2+21*(kstart-1),21,DOUBLE);
  memcopy(spar1,sgpar1+2*(kstart-1),2,DOUBLE);
  memcopy(spar2,sgpar2+2*(kstart-1),2,DOUBLE);

  /* Make position, unit tangent, curvature and radius of curvature for
     start point of iteration, store them in the arrays just allocated */

  kpos = 10;
  s1304(spnt1,spnt2,spar1,spar2,s3dinf,sp1inf,sp2inf,&kstat);

  if (kstat<0) goto error;

  /* Remember start tangent */

  memcopy(startg,s3dinf+3,3,DOUBLE);


  /* Iterate intersection point down to the intersection curve */

  tstep = DZERO;
  s9iterate(s3dinf,spnt1,spnt2,spar1,spar2,psurf1,psurf2,tstep,
	    aepsge,sipnt1,sipnt2,sipar1,sipar2,&kstat);
  if (kstat < 0) goto error;

  /* Copy result of iteration into spnt1,spnt2,spar1,spar2 */


  if (kstat==0 &&
      (s6dist(spnt1,sipnt1,3) > aepsge || s6dist(spnt2,sipnt2,3) > aepsge))
    {
      /*  Copy result of iteration of convergence to no singular point */

      memcopy(spnt1,sipnt1,21,DOUBLE);
      memcopy(spnt2,sipnt2,21,DOUBLE);
      memcopy(spar1,sipar1,2,DOUBLE);
      memcopy(spar2,sipar2,2,DOUBLE);
    }

  if (kstat==0)
    {
      memcopy(start1,sipnt1,21,DOUBLE);
      memcopy(start2,sipnt2,21,DOUBLE);
      memcopy(stpar1,sipar1,2,DOUBLE);
      memcopy(stpar2,sipar2,2,DOUBLE);
    }
  else
    {
      memcopy(start1,spnt1,21,DOUBLE);
      memcopy(start2,spnt2,21,DOUBLE);
      memcopy(stpar1,spar1,2,DOUBLE);
      memcopy(stpar2,spar2,2,DOUBLE);
    }

  /* Make position, unit tangent, curvature and radius of curvature for
     start point of iteration, store them in the arrays just allocated */

  kpos = 10;
  s1304(start1,start2,stpar1,stpar2,s3dinf,sp1inf,sp2inf,&kstat);

  if (kstat<0) goto error;

  /* Test if singular point reached */

  if (kstat == 2) goto war03;

  /* Remember that start point is already stored */

  knbinf = 1;

  /* Make step length based on 3-D radius of curvature, tolerances and
     maks step length */

  kpos = 20;
  tstep = s1311(s3dinf[9],aepsge,tmax,&kstat);
  if (kstat<0) goto error;
  tstartstp = tstep;

  /* STEP IN BOTH DIRECTIONS FROM THE FOUND START POINT */

  /* Indicate that direction in guide point array not determined */

  kguide = kstart;
  kgdir = 0;

  for (kdir=1;kdir<3;kdir++)
    {

      if (kdir == 2)
        {
	  /* Remember result of marching in first direction */

	  knb1 = knbinf;
	  kgd1 = kguide;

	  /* If the previous step direction made no points then knbinf==0. To
	     enable the marching we start from the same start point as the
	     previous step direction, thus in this case knbinf should be 1. */

	  knbinf = MAX(1,knbinf);

	  /* We now step in the second step direction. Turn the sequence of
	     the points found as well as change tangent directions */

	  /* First interchange 3-D info */

	  for (sp1=s3dinf,sp2=s3dinf+10*(knbinf-1) ; sp1<sp2 ; sp1+=10,sp2-=10)
            {
	      memcopy(stdum,sp1,  10,DOUBLE);
	      memcopy(sp1  ,sp2,  10,DOUBLE);
	      memcopy(sp2  ,stdum,10,DOUBLE);
            }

	  for (sp1=s3dinf+3;sp1<s3dinf+10*knbinf;sp1+=10)
            {
	      sp1[0] = - sp1[0];
	      sp1[1] = - sp1[1];
	      sp1[2] = - sp1[2];
            }

	  /* Then interchange info in first parameter plane */

	  for (sp1=sp1inf,sp2=sp1inf+7*(knbinf-1) ; sp1<sp2 ; sp1+=7,sp2-=7)
            {
	      memcopy(stdum,sp1  ,7,DOUBLE);
	      memcopy(sp1  ,sp2  ,7,DOUBLE);
	      memcopy(sp2  ,stdum,7,DOUBLE);
            }

	  for (sp1=sp1inf+2;sp1<sp1inf+7*knbinf;sp1+=7)
            {
	      sp1[0] = - sp1[0];
	      sp1[1] = - sp1[1];
	      sp1[2] = - sp1[2];
            }

	  /* Then interchange info in second parameter plane */

	  for (sp1=sp2inf,sp2=sp2inf+7*(knbinf-1) ; sp1<sp2 ; sp1+=7,sp2-=7)
            {
	      memcopy(stdum,sp1  ,7,DOUBLE);
	      memcopy(sp1  ,sp2  ,7,DOUBLE);
	      memcopy(sp2  ,stdum,7,DOUBLE);
            }

	  for (sp1=sp2inf+2;sp1<sp2inf+7*knbinf;sp1+=7)
            {
	      sp1[0] = - sp1[0];
	      sp1[1] = - sp1[1];
	      sp1[2] = - sp1[2];
            }

	  /* Turn direction of remembered start tangent */

	  for (ki=0;ki<3;ki++)
	    startg[ki] = -startg[ki];


	  /* Update spnt1, spnt2, spar1 and spar2 to
	     have the start point values */

	  memcopy(spnt1,start1,21,DOUBLE);
	  memcopy(spnt2,start2,21,DOUBLE);
	  memcopy(spar1,stpar1,2,DOUBLE);
	  memcopy(spar2,stpar2,2,DOUBLE);

	  /* Turn the direction we march the guide point vector,
	     and set current guide point to kstart */

	  kgdir  = -kgdir;
	  kguide = kstart;

	  /* Update step length */

	  tstep = tstartstp;
        }

      kpos = 30;

      /* Step direction ok, perform marching until stop condition reached */

      kcont = 1;

      while (kcont)
        {


	  /* We must make sure that we are not stepping past a guide point.
	   * Thus if we get close to a guide point, make sure that we step
	   * through this. The direction we travers the guide point array
	   * might not have been determined yet. Thus we have to test in
	   * both directions in guide point array.
	   *
	   * Remember how we step in the varaible kstpch:
	   *       kstpch = -1 : Try to step to previous guide point
	   *       kstpch =  0 : Try not to step through guide point
	   *       kstpch =  1 : Try to step to next guide point
	   *       kstpch =  3 : Step to start point and stop marching
	   *       kstpch =  4 : Don't step through guide point, candidate
	   *                     end point of segement found in iteration loop
	   */


	  kstpch = 0;
	  stang = s3dinf + 10*(knbinf-1) + 3;
	  stangp1 = sp1inf + 7*(knbinf-1) + 2;
	  stangp2 = sp2inf + 7*(knbinf-1) + 2;

	  if (kgdir >=0)
            {

	      /* We are stepping in positive direction in guide point vector
	       * calculate distance to next guide point. If the guide point
	       * is lying closer than the step length to the current point
	       * we should step directly to this point provided that the cross
	       * product of the normal vectors at current point and at the
	       * guide point have the same direction, e.g. that their scalar
	       * product is positiv
	       */

	      t1distgd = (double)2.0*tstep;
	      if (kguide < kpoint)
                {
		  /* Decide if we should step through the guide point */

		  kpos = 40;
		  t1distgd = s9adstep(spnt1,spar1,spnt2,spar2,&sgd1[kguide*21],
				      &sgpar1[kguide*2],&sgd2[kguide*21],
				      &sgpar2[kguide*2],stang,
				      stangp1,stangp2,tstep,&kstat);
		  if (kstat<0) goto error;
		  if (kstat == 1)
                    {
		      /* Step through guide point remember this */

		      kstpch = 1;
		      snxt1 = sgd1 + 21*kguide;
		      snxt2 = sgd2 + 21*kguide;
		      snxp1 = sgpar1 + 2*kguide;
		      snxp2 = sgpar2 + 2*kguide;
                      tstep = MIN(tstep,t1distgd);
		    }
                }
            }

	  if (kgdir <=0)
            {

	      /* We are stepping in negative direction in guide point vector
	       * calculate distance to previous guide point. If the guide point
	       * is lying closer than the step length to the current point
	       * we should step directly to this point provided that the cross
	       * product of the normal vectors at current point and at the
	       * guide point have the same direction, e.g. that their scalar
	       * product is positiv
	       */

	      if (1 < kguide)
                {
		  /* Decide if we should step through the guide point */

		  kpos = 50;
		  t2distgd = s9adstep(spnt1,spar1,spnt2,spar2,
				    &sgd1[(kguide-2)*21],&sgpar1[(kguide-2)*2],
				    &sgd2[(kguide-2)*21],&sgpar2[(kguide-2)*2],
				    stang,stangp1,stangp2,tstep,&kstat);

		  if (kstat<0) goto error;
		  if ((kstat == 1 &&kstpch == 0) ||
		      (kstat == 1 && kstpch == 1 && t2distgd < t1distgd))
                    {
		      /* Step through guide point remember this */

		      kstpch = -1;
		      snxt1 = sgd1 + 21*(kguide-2);
		      snxt2 = sgd2 + 21*(kguide-2);
		      snxp1 = sgpar1 + 2*(kguide-2);
		      snxp2 = sgpar2 + 2*(kguide-2);
                      tstep = MIN(tstep,t2distgd);
                    }
                }
            }

	  /* Check if we step through the start point, should only be necessary
	     if at least 3 points found in this marching direction */

	  if ((kdir==1 && knbinf>3) || (kdir==2 && knbinf>knb1+2))
            {
	      kpos = 60;
	      tdum = s9adstep(spnt1,spar1,spnt2,spar2,start1,stpar1,start2,
			      stpar2,stang,stangp1,stangp2,tstep,&kstat);
	      if (kstat<0) goto error;
	      if (kstat == 1)
		{
		  /* Step to start point remember this */

		  kstpch = 3;
		  snxt1 = start1;
		  snxt2 = start2;
		  snxp1 = stpar1;
		  snxp2 = stpar2;
                  tstep = MIN(tstep,tdum);

		}
	    }

	  /* At this stage kstpch=0 if we have not reached a guide point or
	     if we have not reached the start point of the iteration.

	     Now we want to find a Bezier segement that is lying within the
	     geometric tolerance that is approximating the intersection curve.
	     If a guide point is reached (kstpch=-1 or 1), then we have a
	     candidate for the end point of the Bezier segement. If the start
	     point is reached (kstpch=3) then we also have a candidate
	     end point for the segment.

	     The next loop use kstpch to indicate if we have a candidate
	     end point for the segment:

	     kstpch==0  :  No candidate end point exists
	     kstpch!=0  :  Candidate end point exists


	     To indicate if the segement is within the resolution we
	     use koutside_resolution:

	     koutside_resolution==0 : Segment outside resolution
	     koutside_resolution!=0 : Segment inside resolution
	     */

	  koutside_resolution = 0;


	  /* Make sure that there is enough space for one more point */

	  if (knbinf>=kmaxinf)
            {
	      kmaxinf = kmaxinf + 100;
	      s3dinf = increasearray(s3dinf,((3*kdim+1)*kmaxinf),DOUBLE);
	      if (s3dinf==SISL_NULL) goto err101;
	      sp1inf = increasearray(sp1inf,7*kmaxinf,DOUBLE);
	      if (sp1inf==SISL_NULL) goto err101;
	      sp2inf = increasearray(sp2inf,7*kmaxinf,DOUBLE);
	      if (sp2inf==SISL_NULL) goto err101;
            }


	  /*Make description of candidate endpoint if it exists and store it */

	  if (kstpch != 0)
            {
	      s1304(snxt1,snxt2,snxp1,snxp2,s3dinf+10*knbinf,
		    sp1inf+7*knbinf,sp2inf+7*knbinf,&kstat);
	      if (kstat<0) goto error;

	      /* It is allowed to jump on to a singular point
		 Make sure that the tangents of previous and the new point
		 point in the same direction */

	      if (knbinf>0)
		tdum = s6scpr(s3dinf+10*(knbinf-1)+3,
			      s3dinf+10*knbinf+3,kdim);
	      else
		tdum = s6scpr(startg,s3dinf+3,kdim);


	      if (tdum < DZERO)
                {
		  /* Change tangent direction 3-D and in parameter plane */
		  sp1 = s3dinf + 10*knbinf + 3;
		  sp1[0] = -sp1[0];
		  sp1[1] = -sp1[1];
		  sp1[2] = -sp1[2];
		  sp1 = sp1inf + 7*knbinf + 2;
		  sp1[0] = -sp1[0];
		  sp1[1] = -sp1[1];
		  sp1 = sp2inf + 7*knbinf + 2;
		  sp1[0] = -sp1[0];
		  sp1[1] = -sp1[1];
                }

	      /* Copy the candidate point to spntend1, spntend2,sparend1
		 and sparend2 */

	      memcopy(spntend1,snxt1,21,DOUBLE);
	      memcopy(sparend1,snxp1,2,DOUBLE);
	      memcopy(spntend2,snxt2,21,DOUBLE);
	      memcopy(sparend2,snxp2,2,DOUBLE);
            }


	  while (kstpch == 0 || koutside_resolution == 0)
            {
	      if (kstpch!=0)
                {
		  /* Candidate end point exist, iterate to find point close
		     to the midpoint of the Bezier segement */


		  /* Decide if Hermit shape acceptable and find position and
		     tangent at midpoint of segment */

		  start = s3dinf + 10*(knbinf-1);

		  s1361(start,start+10,3,smidd,smidd+3,&kstat);
		  if (kstat<0) goto error;

		  tcurstep = DZERO;
		  spoint = smidd;
                }
	      else
                {

		  /* Iterate to find end point of segment */

		  /* ITERATE by intersecting the two surface and the plane
		     defined by current point (s3dinf), the tangent (s3dinf+3)
		     and the step length */

		  spoint = s3dinf + 10*(knbinf-1);
		  tcurstep = tstep;
                }

	      /* Perform the actual iteration */

	      kpos = 70;
	      s9iterate(spoint,spnt1,spnt2,spar1,spar2,psurf1,psurf2,tcurstep,
			aepsge,sipnt1,sipnt2,sipar1,sipar2,&kstat);
	      if (kstat < 0) goto error;

	      /* Initiate distance between midpoint and iteration point
		 to -1 to enable detection of divergence */

	      tdist = (double)-1.0;

	      /* Check if iteration has converged */

	      if (kstat == 2)
                {
		  /* Iteration has diverged, half step length if possible,
		     find new endpoint of segement. */

		  kstpch = 0;
		  koutside_resolution = 0;
                }
	      else if(kstat == 1 && kstpch != 0)
                {
		  /* The point found is closer to the input point than
		     the relative computer resolution or is a singular point.
		     We stop the marching in this direction here
		     Half step length if possible, find new endpoint of
		     segement. */

		  kstpch = 0;
		  koutside_resolution = 0;
                }
	      else if (kstpch!=0)
                {


		  /* Make description of intersection point */

		  s1304(sipnt1,sipnt2,sipar1,sipar2,simiddpnt,simiddpar1,
			simiddpar2,&kstat);
		  if (kstat<0) goto error;


		  if (kstat != 2)
                    {
		      /* We iterated to find midpoint of segment, test if
			 it is within resolution */

		      tdist = s6dist(simiddpnt,smidd,3);
		      tang  = s6ang(simiddpnt+3,smidd+3,3);
                    }

		  /* If point is singular or not within resolution a new
		     Hermit segment has to be made */

		  if (kstat == 2 || (fabs(tdist) > aepsge ||
				     (fabs(tang) > ANGULAR_TOLERANCE &&
				      tstep      > aepsge)))
                    {
		      kstpch = 0;
		      koutside_resolution = 0;
                    }
		  else
                    {
		     /*Segment within tolerance.
		       Check that the relationship between the two surfaces
		       has not been interchanged, by making the cross product
		       of the normal vectors in current point and the point
		       found by iteration. Then make the scalar product of
		       these vectors. If the scalar product is negative then
		       we have either jumped to another branch or passed a
		       singularity,iterprete this as the iteration has diverged
		       In addition we don't want the direction of the tangents
		       change to much. We set a limit of approximately PI/3
		       Make normal vectors in implicit surface for both points
		       Make also sure that the curve in the parameter plane
		       does not turn more than 90 degrees.
		       by testing on a cosin value of 0.5
		      */

		      s6crss(spnt1+18,spnt2+18,sdum1);
		      (void)s6norm(sdum1,kdim,sdum1,&kstat);
		      if (kstat < 0) goto error;

		      s6crss(spntend1+18,spntend2+18,sdum2);
		      (void)s6norm(sdum2,kdim,sdum2,&kstat);
		      if (kstat < 0) goto error;

		      tdum = s6scpr(sdum1,sdum2,kdim);

                      s6diff(sipar1,spar1,2,sdum1);
                      tdump1 = s6scpr(sdum1,sp1inf+7*(knbinf-1)+2,2);

                      s6diff(sipar2,spar2,2,sdum1);
                      tdump2 = s6scpr(sdum1,sp2inf+7*(knbinf-1)+2,2);

		      if (tdum == DZERO)
                        {
			  double tl1,tl2;

			  /* If one of the tangents have zero length,
			     accept segment */

			  tl1 = s6length(sdum1,kdim,&kstat);
			  tl2 = s6length(sdum2,kdim,&kstat);

			  if (tl1 == DZERO || tl2 == DZERO)
			    koutside_resolution = 1;
			  else
                            {
			      /* Find new end point of segment */

			      koutside_resolution = 0;
			      kstpch = 0;
                            }

                        }
		      else if (tdum <= (double)0.5 || tdump1 <= DZERO
                               || tdump2 <= DZERO)
                        {
			  /*Find new end point of segment */

			  koutside_resolution = 0;
			  kstpch = 0;
                        }
		      else
                        {
			  koutside_resolution = 1;
                        }
                    }
                }
	      else
                {
		  /* We iterated to find end point of segment,
		     update pointer */

		  memcopy(spntend1,sipnt1,21,DOUBLE);
		  memcopy(sparend1,sipar1,2,DOUBLE);
		  memcopy(spntend2,sipnt2,21,DOUBLE);
		  memcopy(sparend2,sipar2,2,DOUBLE);

		  s1304(sipnt1,sipnt2,sipar1,sipar2,s3dinf+10*knbinf,
			sp1inf+7*knbinf,sp2inf+7*knbinf,&kstat);
		  if (kstat<0) goto error;

		  /* Make sure that the tangents of previous and the new point
		     point in the same direction, singular end point allowed' */

		  if (knbinf>0)
		    tdum = s6scpr(s3dinf+10*(knbinf-1)+3,
				  s3dinf+10*knbinf+3,kdim);
		  else
		    tdum = s6scpr(startg,s3dinf+3,kdim);


		  if (tdum < DZERO)
                    {
		      /* Change tangent direction 3-D and in parameter plane */

		      sp1 = s3dinf + 10*knbinf + 3;
		      sp1[0] = -sp1[0];
		      sp1[1] = -sp1[1];
		      sp1[2] = -sp1[2];
		      sp1 = sp1inf + 7*knbinf + 2;
		      sp1[0] = -sp1[0];
		      sp1[1] = -sp1[1];
		      sp1 = sp2inf + 7*knbinf + 2;
		      sp1[0] = -sp1[0];
		      sp1[1] = -sp1[1];
                    }
		  /* Indicate that end point accepted */

		  kstpch = 4;
		  koutside_resolution = 0;
                }
	      /* It the segment is acceptable clip to the boundary */

	      if (kstpch != 0 && koutside_resolution == 1)
		{

		  /* Check if the curve between the start and end point
		     cross the boundary */

		  memcopy(sparmid1,sipar1,2,double);
		  memcopy(sparmid2,sipar2,2,double);

		  s1330(spar1,spar2,sparend1,sparend2,sval1,sval2,sval3,sval4,
			&kbound,sipar1,sipar2,&kstat);
		  if (kstat<0) goto error;


		  /* In case of kstat==4 (we go from the boundary and out)
		     or kstat==0 and the start is within computer resolution
		     from the boundary, make sure that the tangent points out
		     in both parameter planes.
		     If not set status to 1 e.g, we are inside the patch */

		  if(kstat==0 || kstat==4)
		    {
		      /* Set pointer to tangents at start point */
		      ki = 7*(knbinf-1)+2;

		      if(((DEQUAL(spar1[1]+tref2,sval2[0]+tref2) &&
			   sp1inf[ki+1]>DZERO) ||
			   (DEQUAL(spar1[1]+tref2,sval2[1]+tref2) &&
			    sp1inf[ki+1]<DZERO) ||
			   (DEQUAL(spar1[0]+tref1,sval1[0]+tref1) &&
			    sp1inf[ki  ]>DZERO) ||
			   (DEQUAL(spar1[0]+tref1,sval1[1]+tref1) &&
			    sp1inf[ki  ]<DZERO)
			   ) &&
			 ((DEQUAL(spar2[1]+tref4,sval3[0]+tref4) &&
			   sp2inf[ki+1]>DZERO) ||
			  (DEQUAL(spar2[1]+tref4,sval3[1]+tref4) &&
			   sp2inf[ki+1]<DZERO) ||
			  (DEQUAL(spar2[0]+tref3,sval2[0]+tref3) &&
			   sp2inf[ki  ]>DZERO) ||
			  (DEQUAL(spar2[0]+tref3,sval2[1]+tref3) &&
			   sp2inf[ki  ]<DZERO)))
			kstat = 1;
		    }
		  krem1 = kstat;

		  /* Check if the curve between the start and midpoint cross
		     the boundary */

		  s1330(spar1,spar2,sparmid1,sparmid2,sval1,sval2,sval3,sval4,
			&kbound,sipar1,sipar2,&kstat);
		  if (kstat<0) goto error;

		  krem2 = kstat;

		  /* We now have the following cases:
		     kstat == 0 :
		     Line between (spar1,spar2) and (sparend1,sparend2)
		     outside. If this happens when kdir=1, then
		     just forget the start point. If it happens
		     when kdir=2, then we just stop the marching.
		     kstat == 1 : Line between epar1 and epar2 inside.
		     Continue iteration.
		     kstat == 2 : We step out of the patch. Clip to the edge
		     of the patch. Update start point.
		     kstat == 3 : We step into the patch. Clip to the edge
		     of the patch. Update endpoint
		     kstat == 4 : We go from the boundary and out. Try next
		     iteration direction.
		     */

		  if (krem1 == 0 || krem2 == 0)
		    {
		      if (kdir==1) knbinf--;
		      goto nextdir;
		    }
		  else if ((krem1 !=1 || krem2 !=1) &&
			   krem1 != 4 && krem2 != 4)
		    {

		      /* If we clip to the boundary,
			 forget any guide point identified */

		      kstat1 = 0;
		      if (krem2 == 2 || krem2 == 3)
			{
			  s9clipit(spar1,spar2,sparmid1,sparmid2,psurf1,psurf2,
				   sval1,sval2,sval3,sval4,aepsge,
				   sipnt1,sipnt2,sipar1,sipar2,&kstat);
			  if (kstat<0) goto error;
			  if (krem2==3 && kstat==1) kstpch = 4;
			  kstat1 = kstat;
			  krem = krem2;
			}
		      if (kstat1 !=1 && (krem1 == 2 || krem1 == 3))
			{
			  s9clipit(spar1,spar2,sparend1,sparend2,psurf1,psurf2,
				   sval1,sval2,sval3,sval4,aepsge,
				   sipnt1,sipnt2,sipar1,sipar2,&kstat);
			  if (kstat<0) goto error;
			  if (krem1==3 && kstat==1) kstpch = 4;
			  kstat1 = kstat;
			  krem = krem1;
			}

		      if (kstat1 == 1)
			{
			  /*Check that the relationship between the two
			    surfaces has not been interchanged,
			    by making the cross product
			    of the normal vectors in current point and
			    the point found by iteration.
			    Then make the scalar product of these vectors.
			    If the scalar product is negative then
			    we have either jumped to another branch or passed a
			    singularity, iterprete this as the iteration
			    has diverged.
			    In addition we don't want the direction of the
			    tangents change to much. We set a limit of
			    approximately PI/3 by testing on a
			    cosin value of 0.5
			    Make normal vectors in implicit surface for both
			    points Make also sure that the curves in the
			    parameter plane does not turn more than 90 degrees.
			    */

			  s6crss(spnt1+18,spnt2+18,sdum1);
			  (void)s6norm(sdum1,kdim,sdum1,&kstat);
			  if (kstat < 0) goto error;

			  s6crss(sipnt1+18,sipnt2+18,sdum2);
			  (void)s6norm(sdum2,kdim,sdum2,&kstat);
			  if (kstat < 0) goto error;

			  tdum = s6scpr(sdum1,sdum2,kdim);

			  /*Check that sipar1 lies on the same side of spar1 as
			    the tangent at spar1 */

			  s6diff(sipar1,spar1,2,sdum1);
			  tdump1 = s6scpr(sdum1,sp1inf+7*(knbinf-1)+2,2);

			  s6diff(sipar2,spar2,2,sdum1);
			  tdump2 = s6scpr(sdum1,sp2inf+7*(knbinf-1)+2,2);
			}

		      /* An intersection point has only been
			 found when kstat==1 */

		      if ( kstat1==1 && tdump1 >= DZERO &&
			  tdump1 >= DZERO && tdum > (double)0.5)

			{
			  /* If krem=3 we step into the patch,
			     if krem=2 we step
			     out of the patch */

			  if (krem==2 || krem==3)
			    {
			      /* If krem==3 we step into the patch, make new
				 start point of segment */

			      if (krem==3) knbinf--;

			      memcopy(spntend1,sipnt1,21,DOUBLE);
			      memcopy(sparend1,sipar1,2,DOUBLE);
			      memcopy(spntend2,sipnt2,21,DOUBLE);
			      memcopy(sparend2,sipar2,2,DOUBLE);

			      s1304(sipnt1,sipnt2,sipar1,sipar2,
				    s3dinf+10*knbinf,
				    sp1inf+7*knbinf,
				    sp2inf+7*knbinf,&kstat);
			      if (kstat<0) goto error;

			      /* Make sure that the tangents of previous
				 and the new point
				 point in the same direction */

			      if (knbinf>0)
				tdum = s6scpr(s3dinf+10*(knbinf-1)+3,
					      s3dinf+10*knbinf+3,kdim);
			      else
				tdum = s6scpr(startg,s3dinf+3,kdim);


			      if (tdum < DZERO)
				{
				  /* Change tangent direction 3-D and in
				     parameter plane */

				  sp1 = s3dinf + 10*knbinf + 3;
				  sp1[0] = -sp1[0];
				  sp1[1] = -sp1[1];
				  sp1[2] = -sp1[2];
				  sp1 = sp1inf + 7*knbinf + 2;
				  sp1[0] = -sp1[0];
				  sp1[1] = -sp1[1];
				  sp1 = sp2inf + 7*knbinf + 2;
				  sp1[0] = -sp1[0];
				  sp1[1] = -sp1[1];
				}
			      /* If the new end point tangent points out go to
				 next direction */

			      ki = 7*knbinf;
			      if((sp1inf[ki+1] <= sval2[0] &&
				  sp1inf[ki+3] < DZERO) ||
				 (sp1inf[ki+1] >= sval2[1] &&
				  sp1inf[ki+3] > DZERO) ||
				 (sp1inf[ki  ] <= sval1[0] &&
				  sp1inf[ki+2] < DZERO) ||
				 (sp1inf[ki  ] >= sval1[1] &&
				  sp1inf[ki+2] > DZERO) ||
				 (sp2inf[ki+1] <= sval4[0] &&
				  sp2inf[ki+3] < DZERO) ||
				 (sp2inf[ki+1] >= sval4[1] &&
				  sp2inf[ki+3] > DZERO) ||
				 (sp2inf[ki  ] <= sval3[0] &&
				  sp2inf[ki+2] < DZERO) ||
				 (sp2inf[ki  ] >= sval3[1] &&
				  sp2inf[ki+2] > DZERO))
				{
				  knbinf++;
				  goto nextdir;
				}
			      else if (krem == 2 &&
				       ((sp1inf[ki+1] <= sval2[0] &&
					 sp1inf[ki+3] >= DZERO) ||
					(sp1inf[ki+1] >= sval2[1] &&
					 sp1inf[ki+3] <= DZERO) ||
					(sp1inf[ki  ] <= sval1[0] &&
					 sp1inf[ki+2] >= DZERO) ||
					(sp1inf[ki  ] >= sval1[1] &&
					 sp1inf[ki+2] <= DZERO) ||
					(sp2inf[ki+1] <= sval4[0] &&
					 sp2inf[ki+3] >= DZERO) ||
					(sp2inf[ki+1] >= sval4[1] &&
					 sp2inf[ki+3] <= DZERO) ||
					(sp2inf[ki  ] <= sval3[0] &&
					 sp2inf[ki+2] >= DZERO) ||
					(sp2inf[ki  ] >= sval3[1] &&
					 sp2inf[ki+2] <= DZERO)))
				{
				  /* We were marching out of the patch
				     but the tangent
				     is pointing in half step length */
				  kstpch = 0;
				}



			    }
			}
		      else
			{
			  /* Divergence or point on wrong side in the parameter
			     plane or 3-d */
			  kstpch = 0;
			  koutside_resolution = 0;
			}
		    }
		  else if (kstat==4)
		    goto nextdir;
		}

	      /* Update step length if new endpoint is to be found */

	      if (kstpch==0)
                {
		  if (tdist<DZERO)
                    {
		      tnew = tstep/(double)10.0;
                    }
		  else
                    {
		      tfak = MAX(tdist/aepsge,(double)1.0);
		      tfak = (double)2.0*pow(tfak,ONE_FOURTH);
		      tnew = MIN(tstep/(double)2.0,tstep/tfak);
                    }
		  if (DEQUAL(tmax+tnew,tmax+tstep)) goto nextdir;
		  tstep = tnew;
                }
            }

	  /* If kstpch= -1,1,3 or 4 then a point is accepted and
	     snxt1 points to the position and derivatives
	     of the accepted point. */


	  /* Update number of intersection points */

	  knbinf++;

	  /* Copy point and parameter pair descriptions */

	  memcopy(spnt1,spntend1,21,DOUBLE);
	  memcopy(spar1,sparend1,2,DOUBLE);
	  memcopy(spnt2,spntend2,21,DOUBLE);
	  memcopy(spar2,sparend2,2,DOUBLE);

	  /* Update guide point pointers */


	  if (kstpch ==  1)
            {
	      kguide++;
	      kgdir   = 1;

	      /* Test if end of guide point array reached */

	      if (kguide >= kpoint) goto nextdir;

            }
	  if (kstpch == -1)
            {
	      kguide--;
	      kgdir   = -1;

	      /* Test if start of guide point array reached */

	      if (1 >= kguide) goto nextdir;
            }

	  /* Make new radius of curvature */

	  trad = *(s3dinf + 10*knbinf - 1);
	  tstep = s1311(trad,aepsge,tmax,&kstat);
	  if (kstat<0) goto error;

	  /* Test if start point reached, e.g. that the curve is closed */

	  if (kstpch == 3)
            {
	      /* Closed curve found */

	      goto finished;
            }


	  /*  End while loop */
        }

    nextdir:;

      /*  End two step directions */
    }

 finished:

  /* In certain cases too many marched point may be found. These cases are:

     - Open curve and start of marching first guide point
     - Open curve and start of marching last guide point
     - Closed curve and this found in second marching direction

     In these cases some of the found points have to be discarded */

  scorpnt = s3dinf;
  scorpr1 = sp1inf;
  scorpr2 = sp2inf;

  if (kstpch !=3 && kpoint>1)
    {

      /*  Open curve */

      if ( (kstart==1 && kgd1 == kpoint) ||
	  (kstart==kpoint && kgd1==1)      )
        {
	  /* First marching direction traced curve */

	  knbinf = knb1;
        }
      else if ( (kstart==1 && kguide==kpoint) ||
	       (kstart==kpoint && kguide==1)    )
        {
	  /* Second marching direction traced curve */

	  scorpnt = scorpnt + 10*(knb1-1);
	  scorpr1 = scorpr1 +  7*(knb1-1);
	  scorpr2 = scorpr2 +  7*(knb1-1);
	  knbinf  = knbinf - knb1 + 1;
        }
    }
  else if (kpoint>1)
    {
      /*  Closed curve, correct if result of second marching direction */

      if (kdir != 1)
        {
	  /* Second marching direction, disc ard result of first direction */

	  scorpnt = scorpnt + 10*(knb1-1);
	  scorpr1 = scorpr1 +  7*(knb1-1);
	  scorpr2 = scorpr2 +  7*(knb1-1);
	  knbinf  = knbinf - knb1 + 1;
        }
    }

 interpolate:

  if (knbinf>1)
    {
      if (igraph == 1 && knbinf > 1)
	{
	  /* Output curve through s6line and s6move */

	  s6move(scorpnt);
	  for (ki=1,sp1=scorpnt+10;ki<knbinf;ki++,sp1+=10)
	    s6line(sp1);
	}

      /* A curve is traced out only if at least two points are found */

      if (icur > 0 && knbinf > 1)
	{

	  /*  Make 3-D representation of intersection curve */

	  kpar = 0;

	  spar = newarray(knbinf,DOUBLE);
	  if (spar == SISL_NULL) goto err101;
	  s1359(scorpnt,aepsge,kdim,knbinf,kpar,spar,&q3dcur,&kstat);
	  if (kstat < 0) goto error;

	  /*  Set pointer in intcurve object to 3-D curve */

	  pinter -> pgeom = q3dcur;

	  if (icur == 2)
	    {
	      /* Make curves in parameter planes */

	      kdim = 2;
	      kpar = 1;
	      s1359(scorpr1,aepsge,kdim,knbinf,kpar,spar,&qp1cur,&kstat);
	      if (kstat < 0) goto error;


	      s1359(scorpr2,aepsge,kdim,knbinf,kpar,spar,&qp2cur,&kstat);
	      if (kstat < 0) goto error;

	      /* Set pointers in intcurve object to curves in parameter plane*/

	      pinter -> ppar1 = qp1cur;
	      pinter -> ppar2 = qp2cur;
	    }
	}
    }
  else if( pinter->ipoint > 1)
    {
      /* If no points produced on intersection curve */

       s1310_s9constline(psurf1,psurf2,pinter,aepsge,icur,igraph,&kstat);
      if (kstat<0) goto error;
      if (kstat==0) goto err185;
    }
  else
    goto err185;

  if (kdiv == 1) goto war03;
  *jstat = 0;

  goto out;

  /* Iteration can not continue */
 war03:  *jstat = 3;
  goto out;

  /* Error in space allocation */
 err101: *jstat = -101;
  s6err("s1310",*jstat,kpos);
  goto out;


  /* Error in surface description parameter direction does not exist */
 err123: *jstat = -123;
  s6err("s1310",*jstat,kpos);
  goto out;


/* Error - SISL_NULL pointer was given */
  err150 :
    *jstat = -150;
    s6err("s1310",*jstat,kpos);
    goto out;

  /* Only degenerate or singular guide points */
 err185: *jstat = -185;
  goto out;

  /* Error in lower leve function */
 error:
  *jstat = kstat;
  s6err("s1310",*jstat,kpos);
  goto out;

 out:

  /* Free allocated space */

  if (sgd1   != SISL_NULL) freearray(sgd1);
  if (sgd2   != SISL_NULL) freearray(sgd2);
  if (s3dinf != SISL_NULL) freearray(s3dinf);
  if (sp1inf != SISL_NULL) freearray(sp1inf);
  if (sp2inf != SISL_NULL) freearray(sp2inf);
  if (spar   != SISL_NULL) freearray(spar);
  if (sgpar1 != SISL_NULL) freearray(sgpar1);
  if (sgpar2 != SISL_NULL) freearray(sgpar2);


  return;
}

//===========================================================================
void sh1851(SISLSurf * ps1, double epoint[], double enorm[], int idim, 
	    double aepsco, double aepsge,int trackflag, int *jtrack, 
	    SISLTrack *** wtrack,int *jpt, double **gpar, int **pretop, 
	    int *jcrv, SISLIntcurve *** wcurve, int *jsurf, 
	    SISLIntsurf ***wsurf, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Local status varible.                      */
  int kpos = 0;			/* Position of error.                         */
  int kdim = 1;			/* Dimension of space in which the point in the
			           intersect point and surface problem lies.  */
  double *spar = SISL_NULL;		/* Dummy array containing parameter values of
			           second object of single intersection points.*/
  double spoint[1];		/* SISLPoint to intersect with object.            */
  SISLSurf *qs = SISL_NULL;		/* Pointer to surface in
			       surface/point intersection.*/
  SISLPoint *qp = SISL_NULL;		/* Pointer to point in
			       surface/point intersection.  */
  SISLObject *qo1 = SISL_NULL;	/* Pointer to surface in
			       object/point intersection. */
  SISLObject *qo2 = SISL_NULL;	/* Pointer to point in
			       object/point intersection    */
  SISLIntdat *qintdat = SISL_NULL;	/* Intersection result */
  int kdeg = 1;			/* Implisit descr. to track  */
  double simpli[16];
  double snorm[3];
  SISLObject *track_obj=SISL_NULL;
  SISLSurf *qkreg=SISL_NULL; /* Input surface ensured k-regularity. */

  /* -------------------------------------------------------- */  

  if (ps1->cuopen_1 == SISL_SURF_PERIODIC ||
      ps1->cuopen_2 == SISL_SURF_PERIODIC)
  {
     /* Cyclic surface. */

     make_sf_kreg(ps1,&qkreg,&kstat);
     if (kstat < 0) goto error;
   }
  else
    qkreg = ps1;
  
  /*
  * Create new object and connect surface to object.
  * ------------------------------------------------
  */
  
  if (!(track_obj = newObject (SISLSURFACE)))
    goto err101;
  track_obj->s1 = ps1;
  
  /*
  * Check dimension.
  * ----------------
  */
  
  *jpt = 0;
  *jcrv = 0;
  *jtrack = 0;

  if (idim != qkreg->idim)
    goto err106;

  /*
   * Put surface into plane-equation.
   * --------------------------------
   */

  s1329 (qkreg, epoint, enorm, idim, &qs, &kstat);
  if (kstat < 0)
    goto error;

  /*
   * Create new object and connect surface to object.
   * ------------------------------------------------
   */

  if (!(qo1 = newObject (SISLSURFACE)))
    goto err101;
  qo1->s1 = qs;
  qo1->o1 = qo1;

  /*
   * Create new object and connect point to object.
   * ----------------------------------------------
   */

  if (!(qo2 = newObject (SISLPOINT)))
    goto err101;
  spoint[0] = DZERO;
  if (!(qp = newPoint (spoint, kdim, 1)))
    goto err101;
  qo2->p1 = qp;

  /*
   * Find intersections.
   * -------------------
   */

  sh1761 (qo1, qo2, aepsge, &qintdat, &kstat);
  if (kstat < 0)
    goto error;

  /* Represent degenerated intersection curves as one point.  */

  sh6degen(track_obj,track_obj,&qintdat,aepsge,&kstat);
  if (kstat < 0) goto error;

  /* BUG BEOrd13026, simpli is now always in use, UJK */
  /* Normalize plane normal */
  
  (void) s6norm (enorm, 3, snorm, &kstat);
  
  simpli[0] = snorm[0];
  simpli[1] = snorm[1];
  simpli[2] = snorm[2];
  simpli[3] = -s6scpr (epoint, snorm, 3);
       
  
  /* Create tracks */
  if (trackflag && qintdat)
    {
       refine_all (&qintdat, track_obj, track_obj, simpli, kdeg, aepsge, &kstat);
       if (kstat < 0)
	 goto error;
    }
  
  /* Join periodic curves */
  int_join_per( &qintdat,track_obj, track_obj, simpli, kdeg,aepsge,&kstat);
  if (kstat < 0)
    goto error;
  
  if (trackflag && qintdat)
    {
       make_tracks (track_obj, track_obj, kdeg, simpli,
		    qintdat->ilist, qintdat->vlist, 
		    jtrack, wtrack, aepsge, &kstat);
       if (kstat < 0)
	 goto error;
    }

  /*
   * Express intersections on output format.
   * ---------------------------------------
   */

  if (qintdat)			/* Only if there were intersections found */
    {
      hp_s1880 (track_obj, track_obj, kdeg,
		2, 0, qintdat, jpt, gpar, &spar, pretop, jcrv, wcurve, jsurf,wsurf,&kstat);
      if (kstat < 0)
	goto error;
    }

  /*
   * Intersections found.
   * --------------------
   */

  *jstat = 0;
  goto out;

  /* Error in space allocation.  */

err101:*jstat = -101;
  s6err ("sh1851", *jstat, kpos);
  goto out;

  /* Dimensions conflicting.  */

err106:*jstat = -106;
  s6err ("sh1851", *jstat, kpos);
  goto out;

  /* Error in lower level routine.  */

error:*jstat = kstat;
  s6err ("sh1851", *jstat, kpos);
  goto out;

out:

  /* Free allocated space.  */

  if (spar)
    freearray (spar);
  if (qo1)
    freeObject (qo1);
  if (qo2)
    freeObject (qo2);
  if (qintdat)
    freeIntdat (qintdat);
  if (track_obj)
    {
       track_obj->s1 = SISL_NULL;
       freeObject(track_obj);
    }

  /* Free local surface.  */
    if (qkreg != SISL_NULL && qkreg != ps1) freeSurf(qkreg);
  
  return;
}

void sh1853(SISLSurf *ps1,double epoint[],double edirec[],double aradius,
	    int idim, double aepsco,double aepsge,
	    int trackflag, int *jtrack, SISLTrack *** wtrack,
	    int *jpt,double **gpar,int **pretop,int *jcrv,
	    SISLIntcurve ***wcurve,int *jsurf, 
	    SISLIntsurf *** wsurf, int *jstat)
/*
*********************************************************************
*
*********************************************************************
*                                                                   
* PURPOSE    : Find all intersections between a tensor-product surface
*              and a cylinder.
*
*
*
* INPUT      : ps1      - Pointer to surface.
*              epoint   - SISLPoint on the axis of the cylinder.
*              edirec   - The direction vector of the axis of the cylinder.
*              aradius  - Radius of the cylinder.
*              idim     - Dimension of the space in which the cylinder lies.
*              aepsco   - Computational resolution.
*              aepsge   - Geometry resolution.
*              trackflag - If true, create tracks.
*                                                                        
*
*
* OUTPUT     : jtrack - Number of tracks created
*              wtrack - Array of pointers to tracks
*              jpt    - Number of single intersection points.
*              gpar   - Array containing the parameter values of the
*                       single intersection points in the parameter
*                       plane of the surface. The points lie continuous. 
*                       Intersection curves are stored in wcurve.
*              pretop - Topology info. for single intersection points.
*              *jcrv  - Number of intersection curves.
*              wcurve  - Array containing descriptions of the intersection
*                       curves. The curves are only described by points
*                       in the parameter plane. The curve-pointers points
*                       to nothing. (See description of Intcurve
*                       in intcurve.dcl).
*              jstat  - status messages  
*                                         > 0      : warning
*                                         = 0      : ok
*                                         < 0      : error
*
*
* METHOD     : The vertices of the surface are put into the equation of the
*              cylinder achieving a surface in the one-dimentional space.
*              Then the zeroes of this surface is found.
*
*
* REFERENCES :
*
*-
* CALLS      : sh1761       - Perform point object-intersection.
*              s1320       - Put equation of surface into equation of implicit
*                            surface.
*              s1322       - Represent cylinder as implicit function.
*              hp_s1880       - Put intersections on output format.
*              make_sf_kreg   - Ensure k-regularity of surface.
*              newObject   - Create new object.
*              newPoint    - Create new point.
*              freeObject  - Free space occupied by an object.
*              freeIntdat  - Free space occupied by an intersection data.
*
* WRITTEN BY : Vibeke Skytt, SI, 88-06.
* REWRITTEN BY : Bjoern Olav Hoset, SI, 89-06.
*
*********************************************************************
*/
{            
  int kstat = 0;           /* Local status varible.                       */
  int kpos = 0;            /* Position of error.                          */
  int kdim = 1;            /* Dimension of space in which the point in the
			      intersect point/surface problem lies.       */
  double *spar = SISL_NULL;     /* Dummy array containing parameter values of
			      second object of single intersection points.*/
  double spoint[1];        /* SISLPoint to intersect with object.         */
  double eps_1d;           /* The tolerance converted to 1D               */
  int kdeg=2;              /* The degree of the implicit equation of the cyl*/
  double *scyl = SISL_NULL;     /* Description of cylinder as implicit surface.*/
  SISLSurf *qs = SISL_NULL;         /* Pointer to surface in 
			      surface/point intersection.*/
  SISLPoint *qp = SISL_NULL;        /* Pointer to point in 
			      surface/point intersection.  */
  SISLObject *qo1 = SISL_NULL;      /* Pointer to surface in 
			      object/point intersection. */
  SISLObject *qo2 = SISL_NULL;      /* Pointer to point in 
			      object/point intersection    */
  SISLIntdat *qintdat = SISL_NULL;  /* Intersection result */
  SISLObject *track_obj=SISL_NULL;
  SISLSurf *qkreg=SISL_NULL; /* Input surface ensured k-regularity. */

  int ki;
  double nmax=(double)1.0;
  /* -------------------------------------------------------- */  

  if (ps1->cuopen_1 == SISL_SURF_PERIODIC ||
      ps1->cuopen_2 == SISL_SURF_PERIODIC)
  {
     /* Cyclic surface. */

     make_sf_kreg(ps1,&qkreg,&kstat);
     if (kstat < 0) goto error;
   }
  else
    qkreg = ps1;
  
  
  /*
  * Create new object and connect surface to object.
  * ------------------------------------------------
  */
  
  if (!(track_obj = newObject (SISLSURFACE)))
    goto err101;
  track_obj->s1 = ps1;
  
  /* 
   * Check dimension.  
   * ----------------
   */

  *jpt  = 0;
  *jcrv = 0;
  *jtrack = 0;

  if (idim != qkreg -> idim) goto err106;

  /* 
   * Allocate space for matrix describing a cylinder. 
   * ------------------------------------------------
   */

  if ((scyl = newarray((idim+1)*(idim+1),double)) == SISL_NULL) goto err101;

  /* 
   * Make a matrix of dimension (idim+1)x(idim+1) describing a 
   * cylinder as an implicit function.                           
   * ---------------------------------------------------------
   */

  s1322(epoint,edirec,aradius,idim,1,scyl,&kstat);
  if (kstat < 0) goto error;

  /* 
   * Put the description of the input surface into the implicit
   * equation for the cylinder.                                   
   * ----------------------------------------------------------
   */

  s1320(qkreg,scyl,1,0,&qs,&kstat);
  if (kstat < 0) goto error;

  /* 
   * Create new object and connect surface to object.  
   * ------------------------------------------------
   */

  if(!(qo1 = newObject(SISLSURFACE))) goto err101;
  qo1 -> s1 = qs;
  qo1 -> o1 = qo1;

  /*
   * Create new object and connect point to object.
   * ----------------------------------------------
   */

  if(!(qo2 = newObject(SISLPOINT))) goto err101;
  spoint[0] = DZERO;
  if(!(qp = newPoint(spoint,kdim,1))) goto err101;
  qo2 -> p1 = qp;

  /* 
   * Find intersections.  
   * -------------------
   */

  /* UJK, 21.01.93, use another tolerance in 1D. */
  eps_1d = 2*aradius*aepsge;

  /* UJK,sept 93, Normalize to get angle tolerances correct */
  for(ki=0; ki<qs->in1*qs->in2;ki++)
     nmax = max(fabs(qs->ecoef[ki]),nmax);
  
  if (nmax >(double)10.0)
  {
     for(ki=0; ki<qs->in1*qs->in2;ki++)
        qs->ecoef[ki] /= nmax;
     eps_1d = eps_1d/nmax;
  }
  
  /* UJK,sept 93, End of change */
  
  sh1761(qo1,qo2,eps_1d,&qintdat,&kstat);
  if (kstat < 0) goto error;

  /* Represent degenerated intersection curves as one point.  */

  sh6degen(track_obj,track_obj,&qintdat,aepsge,&kstat);
  if (kstat < 0) goto error;

  /* Create tracks */
  if (trackflag && qintdat)
    {
 
      refine_all (&qintdat, track_obj, track_obj, scyl, kdeg, aepsge, &kstat);
      if (kstat < 0)
	goto error;

    }
  
  /* Join periodic curves */
  int_join_per( &qintdat,track_obj, track_obj, scyl, kdeg,aepsge,&kstat);
  if (kstat < 0)
    goto error;

  /* Create tracks */
  if (trackflag && qintdat)
    {
      make_tracks (track_obj, track_obj, kdeg, scyl,
		   qintdat->ilist, qintdat->vlist, 
		   jtrack, wtrack, aepsge, &kstat);
      if (kstat < 0)
	goto error;
    }

  /* 
   * Express intersections on output format.  
   * ---------------------------------------
   */

  if (qintdat)/* Only if there were intersections found */
    {
      hp_s1880(track_obj, track_obj, kdeg,
	       2,0,qintdat,jpt,gpar,&spar,pretop,jcrv,wcurve,jsurf,wsurf,&kstat);
      if (kstat < 0) goto error;
    }
  
  /* 
   * Intersections found.  
   * --------------------
   */

  *jstat = 0;
  goto out;

  /* Error in space allocation.  */

 err101: *jstat = -101;
        s6err("sh1853",*jstat,kpos);
        goto out;

  /* Dimensions conflicting.  */

 err106: *jstat = -106;
        s6err("sh1853",*jstat,kpos);
        goto out;

  /* Error in lower level routine.  */

  error : *jstat = kstat;
        s6err("sh1853",*jstat,kpos);
        goto out;

 out:

  /* Free allocated space.  */

  if (spar)    freearray(spar);
  if (scyl)    freearray(scyl);
  if (qo1)     freeObject(qo1);
  if (qo2)     freeObject(qo2);
  if (qintdat) freeIntdat(qintdat);
  if (track_obj)
    {
       track_obj->s1 = SISL_NULL;
       freeObject(track_obj);
    }

  /* Free local surface.  */
    if (qkreg != SISL_NULL && qkreg != ps1) freeSurf(qkreg);

return;
}                                               

//===========================================================================
void freeIntsurf(SISLIntsurf *intsurf)
//===========================================================================
{
  /* Free the arrays if not SISL_NULL. */

  if(intsurf->epar != SISL_NULL) freearray(intsurf->epar);
  if(intsurf->const_par != SISL_NULL) freearray(intsurf->const_par);

  /* Free the instance pointed at by intsurf. */

  freearray(intsurf);

  return;
}

//===========================================================================
void sh1859 (SISLSurf * ps1, SISLSurf * ps2, double aepsco, double aepsge,
	     int trackflag, int *jtrack, SISLTrack *** wtrack,
	     int *jpt, double **gpar1, double **gpar2, int **pretop, 
	     int *jcrv, SISLIntcurve *** wcurve, int *jsurf, 
	     SISLIntsurf *** wsurf, int *jstat)
//===========================================================================
{
  double *nullp = SISL_NULL;
  int kstat = 0;		/* Local status variable.                   */
  int kpos = 0;			/* Position of error.                       */
  SISLObject *qo1 = SISL_NULL;	/* Object containing first curve in
			       the intersection.                        */
  SISLObject *qo2 = SISL_NULL;	/* Object containing second curve in
			       the intersection.                        */
  SISLIntdat *qintdat = SISL_NULL;	/* Structure holding the intersection data. */
  int      kdeg=0;              /* input to int_join_per. */

  /*
   * Check dimensions.
   * -----------------
   */

  *jpt = 0;
  *jcrv = 0;
  *jtrack = 0;
  *jsurf = 0;

  if (ps1->idim != ps2->idim)
    goto err106;

  /*
   * Create objects and connect surfaces to the objects.
   * ---------------------------------------------------
   */

  if ((qo1 = newObject (SISLSURFACE)) == SISL_NULL)
    goto err101;
  qo1->s1 = ps1;
  qo1->o1 = qo1;

  if ((qo2 = newObject (SISLSURFACE)) == SISL_NULL)
    goto err101;
  qo2->s1 = ps2;
  qo2->o1 = qo2;

  /*
   * Find intersections.
   * -------------------
   */

  sh1761 (qo1, qo2, aepsge, &qintdat, &kstat);
  if (kstat < 0)
    goto error;

  /* Represent degenerated intersection curves as one point.  */

  sh6degen(qo1,qo2,&qintdat,aepsge,&kstat);
  if (kstat < 0) goto error;

  /* Create tracks */
  if (trackflag && qintdat)
    {
      refine_all( &qintdat,qo1,qo2,nullp,kdeg=0,aepsge,&kstat);
      if (kstat < 0)
	goto error; 
    }

  /* Join periodic curves */
  int_join_per( &qintdat,qo1,qo2,nullp,kdeg=0,aepsge,&kstat);
  if (kstat < 0)
    goto error;
  
  /* Create tracks */
  if (trackflag && qintdat)
    {
      make_tracks (qo1, qo2, 0, nullp,
		   qintdat->ilist, qintdat->vlist, 
		   jtrack, wtrack, aepsge, &kstat);
      if (kstat < 0)
	goto error;
    }


  /*
* Express intersections on output format.
* ---------------------------------------
*/

  if (qintdat)			/* Only if there were intersections found */
    {
      hp_s1880(qo1, qo2, 0,
	       2,2,qintdat,jpt,gpar1,gpar2,pretop,jcrv,wcurve,jsurf,wsurf,&kstat);
      if (kstat < 0)
	goto error;
    }


  /*
   * Intersections found.
   * --------------------
   */

  *jstat = 0;
  goto out;

  /*
   * Error in space allocation.
   * --------------------------
   */

err101:*jstat = -101;
  s6err ("sh1859", *jstat, kpos);
  goto out;

  /* Dimensions conflicting.  */

err106:*jstat = -106;
  s6err ("sh1859", *jstat, kpos);
  goto out;

  /* Error in lower level routine.  */

error:*jstat = kstat;
  s6err ("sh1859", *jstat, kpos);
  goto out;

out:

  /*
   * Free allocated space.
   * ---------------------
   */

  if (qo1)
    {
      qo1->s1 = SISL_NULL;
      freeObject (qo1);
    }
  if (qo2)
    {
      qo2->s1 = SISL_NULL;
      freeObject (qo2);
    }
  if (qintdat)
    freeIntdat (qintdat);

  /*
   * Exit sh1859.
   * -----------
   */

  return;
}

void 
sh1858(SISLSurf *ps1,SISLCurve *pc1,double aepsco,double aepsge,
	int trackflag, int *jtrack, SISLTrack *** wtrack,
	   int *jpt,double **gpar1,double **gpar2,int **pretop,int *jcrv,SISLIntcurve ***wcurve,int *jstat)
/*
*********************************************************************
*
*********************************************************************
*                                                                   
* PURPOSE    : Find all intersections between a B-spline surface
*              and a B-spline curve.
*
*
*
* INPUT      : ps1    - Pointer to the surface.
*              pc1    - Pointer to the curve.
*              aepsco - Computational resolution.
*              aepsge - Geometry resolution.
*              trackflag - If true, create tracks.
*
*
*
* OUTPUT     : jtrack - Number of tracks created
*              wtrack - Array of pointers to tracks
*              jpt    - Number of single intersection points.
*              gpar1  - Array containing the parameter values of the
*                       single intersection points in the parameter
*                       interval of the first curve. The points lie 
*                       continuous. Intersection curves are stored in wcurve.
*              gpar2  - Array containing the parameter values of the
*                       single intersection points in the parameter
*                       interval of the second curve.
*              pretop - Topology info. for single intersection points.
*              jcrv   - Number of intersection curves.
*              wcurve - Array containing descriptions of the intersection
*                       curves. The curves are only described by points
*                       in the parameter plane. The curve-pointers points
*                       to nothing. (See description of Intcurve
*                       in intcurve.dcl).
*                       If the curves given as input are degnenerate an
*                       intersection point can be returned as an intersection
*                       curve. Use s1327 to decide if an intersection curve
*                       is a point on one of the curves.
*              jstat  - status messages  
*                                         > 0      : warning
*                                         = 0      : ok
*                                         < 0      : error
*
*
* REFERENCES :
*
*-
* CALLS      : sh1761      - Perform object/object-intersection.
*              hp_s1880      - Put intersections on output format.
*              newObject  - Create new object.
*              freeObject - Free space occupied by an object.
*              freeIntdat - Free space occupied by the intdat structure.
*
* WRITTEN BY : Vibeke Skytt, SI, 88-10.
* REWRITTEN BY : B.O. Hoset, SI, 89-06.
*
*********************************************************************
*/
{            
  double *nullp = SISL_NULL;
  int kstat = 0;                 /* Local status variable.                   */
  int kpos = 0;                  /* Position of error.                       */
  SISLObject *qo1 = SISL_NULL;            /* Object containing first curve in 
				    the intersection.                        */
  SISLObject *qo2 = SISL_NULL;            /* Object containing second curve in 
				    the intersection.                        */
  SISLIntdat *qintdat = SISL_NULL;        /* Structure holding the intersection data. */
  int      ksurf=0;         /* Dummy number of Intsurfs. */
  SISLIntsurf **wsurf=SISL_NULL;    /* Dummy array of Intsurfs. */
  int kdeg=0;
  
  /* 
   * Check dimensions.  
   * -----------------
   */

  *jpt  = 0;
  *jcrv = 0;
  *jtrack = 0;

  if (ps1 -> idim != pc1 -> idim) goto err106;

  /* 
   * Create objects and connect surface/curve to the objects.  
   * --------------------------------------------------------
   */

  if ((qo1 = newObject(SISLSURFACE)) == SISL_NULL) goto err101;
  qo1 -> s1 = ps1;
  qo1 -> o1 = qo1;
  
  if ((qo2 = newObject(SISLCURVE)) == SISL_NULL) goto err101;
  qo2 -> c1 = pc1;
  qo2 -> o1 = qo2;
  
  /* 
   * Find intersections.  
   * -------------------
   */

  sh1761(qo1,qo2,aepsge,&qintdat,&kstat);
  if (kstat < 0) goto error;

  /* Represent degenerated intersection curves as one point.  */

  sh6degen(qo1,qo2,&qintdat,aepsge,&kstat);
  if (kstat < 0) goto error;

  /* Join periodic curves */
  int_join_per( &qintdat,qo1,qo2,nullp,kdeg=0,aepsge,&kstat);
  if (kstat < 0)
    goto error;

  /* Create tracks */
  if (trackflag && qintdat)
    {
      make_tracks (qo1, qo2, 0, nullp,
		   qintdat->ilist, qintdat->vlist, 
		   jtrack, wtrack, aepsge, &kstat);
      if (kstat < 0)
	goto error;

    }

  /* 
   * Express intersections on output format.  
   * ---------------------------------------
   */

  if (qintdat)/* Only if there were intersections found */
    {
      hp_s1880(qo1, qo2, kdeg,
	       2,1,qintdat,jpt,gpar1,gpar2,pretop,jcrv,wcurve,&ksurf,&wsurf,&kstat);
      if (kstat < 0) goto error;
    }
  
  /* 
   * Intersections found.  
   * --------------------
   */

  *jstat = 0;
  goto out;

  /* 
   * Error in space allocation.  
   * --------------------------
   */

 err101: *jstat = -101;                
        s6err("sh1858",*jstat,kpos);
        goto out;

  /* Dimensions conflicting.  */

 err106: *jstat = -106;
  s6err("sh1858",*jstat,kpos);
        goto out;

  /* Error in lower level routine.  */

  error : *jstat = kstat;
        s6err("sh1858",*jstat,kpos);
        goto out;

 out:

  /* 
   * Free allocated space.  
   * ---------------------
   */

  if (qo1) 
    {
      qo1 -> s1 = SISL_NULL;  freeObject(qo1);
    }
  if (qo2) 
    {
      qo2 -> c1 = SISL_NULL;  freeObject(qo2);
    }
  if (qintdat) freeIntdat(qintdat);

  /*
   * Exit sh1858.
   * -----------
   */
                                        
  return;
}                                               

//===========================================================================
void s1770_2D(SISLCurve *pcurve1,SISLCurve *pcurve2,double aepsge,
	      double astart1,double astart2,double aend1,double aend2,
	      double anext1,double anext2,double *cpos1,double *cpos2,int *jstat)
//===========================================================================
{
  int kstat = 0;            /* Local status variable.                      */
  int kpos = 0;             /* Position of error.                          */
  int ki;
  int kleft1=0,kleft2=0;    /* Variables used in the evaluator.            */
  int dim;                  /* Dimension of space the curves lie in        */
  int knbit;                /* Number of iterations                        */
  int p_dir;                /* Changing direction in par-space.            */
  int g_up,ng_up,g_dir;     /* Changing direction in geometric space.      */
  int order;		    /* Order of methode.			   */
  int sing = 0;		    /* Mark that singularity has ocured.	   */
  int keep_order = 0;
  int max_it = 20;          /* Maximum number of iterations.               */
  double delta[2];          /* Parameter interval of the curves.           */
  double dist;              /* Distance between the positions.             */
  double prev_dist;         /* Previous difference between the curves.     */
  double d[2];		    /* Clipped distances between old and new par.
			       value in the two parameter directions.      */
  double det;
  double c_d[2];	    /* Computed distances ....			   */
  double nc_d[2];	    /* New computed distances ....		   */
  double *c1=SISL_NULL;          /* Value  of first curve.			   */
  double *c1_t;		    /* First derivatiev of curve.		   */
  double *c1_tt;	    /* Second derivatiev of curve.		   */
  double *c2;               /* Value of second curve.   		   */
  double *c2_t;		    /* First derivative of second curve. 	   */
  double *c2_tt;       	    /* Second  derivative of second curve.	   */
  double *diff;             /* Difference between the curves.              */
  double *prev_diff;        /* Previous difference.			   */
  double *norm;		    /* Normal to the second curve.		   */
  double *norm_1;	    /* Normal to the first curve.		   */
  double par_val[2];        /* Parameter values                            */
  double local[48];
  int corr = 0, div2 = 0, quick = *jstat;

  if (quick) max_it = 10;  /* Reduce requirement on exactness. */

  /* Test input.  */

  if (pcurve1->idim != pcurve2->idim) goto err106;

  dim = pcurve1 -> idim;

  /* Fetch endpoints and the intervals of parameter interval of curves.  */

  delta[0] = pcurve1->et[pcurve1->in] - pcurve1->et[pcurve1->ik - 1];
  delta[1] = pcurve2->et[pcurve2->in] - pcurve2->et[pcurve2->ik - 1];

  /* Allocate local used memory */

    if (dim > 3)
  {
     c1 = newarray(10*dim,double);
     if (c1 == SISL_NULL) goto err101;
  }
  else
     c1 = local;

  c1_t  = c1 + dim;
  c1_tt = c1_t + dim;
  c2    = c1_tt + dim;
  c2_t  = c2 + dim;
  c2_tt = c2_t + dim;
  diff  = c2_tt + dim;
  prev_diff = diff + dim;
  norm      = prev_diff + dim;
  norm_1    = norm + dim;



  /* Initiate variables.  */


  par_val[0] = anext1;
  par_val[1] = anext2;

  for (ki=1; ki<3; ki++)
  {
      s1770_2D_set_order(ki);

     /* Evaluate 0-2.st derivatives of curve 1 */

     if (par_val[0] == aend1)
	s1227(pcurve1,1+order,par_val[0],&kleft1,c1,&kstat);
     else
	s1221(pcurve1,1+order,par_val[0],&kleft1,c1,&kstat);
     if (kstat < 0) goto error;


     /* Evaluate 0-2.st derivatives of curve 2 */

     if (par_val[1] == aend2)
	s1227(pcurve2,1+order,par_val[1],&kleft2,c2,&kstat);
     else
	s1221(pcurve2,1+order,par_val[1],&kleft2,c2,&kstat);
     if (kstat < 0) goto error;


     /* Compute the distanse vector and value and the new step. */

     s1770_2D_s9dir(&dist,diff,c_d, c1,c1_t,c1_tt,
		    		    c2,c2_t,c2_tt,dim,order,&det,&kstat);
     if (kstat < 0) goto error;
     if (kstat == 1) 		/* Singular matrix. */
     {
	if (order == 1 && dist > aepsge) goto singular;
	else if (order == 1) goto not_singular;
     }
     else break;
  }

  /* Correct if we are not inside the parameter intervall. */

  d[0] = c_d[0];
  d[1] = c_d[1];
  norm_1[0] = -c1_t[1]; norm_1[1] = c1_t[0];
  norm[0]   = -c2_t[1]; norm[1]   = c2_t[0];
  g_up = (s6scpr(diff,norm,dim) >= DZERO) ? 1 : -1;
  g_up += ((s6scpr(diff,norm_1,dim) >= DZERO) ? 10 : -10);
  s1770_2D_s9corr(d,par_val,astart1,aend1,astart2,aend2,&corr);

  prev_dist = dist;
  prev_diff[0] = diff[0];
  prev_diff[1] = diff[1];

  /* Iterate to find the intersection point.  */

  for (knbit = 0; knbit < max_it; knbit++)
  {
      s1770_2D_incr2(par_val,d,2);

     while (1)
     {
	/* Evaluate 0-2.st derivatives of curve */

	if (par_val[0] == aend1)
	   s1227(pcurve1,1+order,par_val[0],&kleft1,c1,&kstat);
	else
	   s1221(pcurve1,1+order,par_val[0],&kleft1,c1,&kstat);
	if (kstat < 0) goto error;

	if (par_val[1] == aend2)
	   s1227(pcurve2,1+order,par_val[1],&kleft2,c2,&kstat);
	else
	   s1221(pcurve2,1+order,par_val[1],&kleft2,c2,&kstat);
	if (kstat < 0) goto error;

	/* Compute the distanse vector and value and the new step. */

	s1770_2D_s9dir(&dist,diff,nc_d,c1,c1_t,c1_tt,c2,c2_t,c2_tt,
		    dim,order,&det,&kstat);
	if (kstat < 0) goto error;
	if (kstat == 1)             /* Singular matrix.  */
	{
	   sing++;
	   if (order == 1 && dist > aepsge) goto singular;
	   else if (order == 1) goto not_singular;
	   else s1770_2D_set_order(2);               /* Change order to 2. */
	}
	else
	{
	   norm_1[0] = -c1_t[1]; norm_1[1] = c1_t[0];
	   norm[0]   = -c2_t[1]; norm[1]   = c2_t[0];

	   ng_up = (s6scpr(diff,norm,dim) >= DZERO) ? 1 : -1;
	   ng_up += ((s6scpr(diff,norm_1,dim) >= DZERO) ? 10 : -10);
	   g_dir = (ng_up+g_up != 0);			/* 0 if changed. */
	   p_dir = (c_d[0]*nc_d[0] >= DZERO &&
		    c_d[1]*nc_d[1] >= DZERO);		/* 0 if changed. */

	   if (!order && g_dir && (!p_dir || dist > 0.4*prev_dist)
							&& !keep_order)
	   {
	      if (!quick && div2) div2 = 0;
	      s1770_2D_set_order(2);
	   }
	   else if (order && !g_dir)
	   {
	      if (sing && dist > aepsge) goto singular;
	      else if (sing) goto not_singular;
	      if (div2) div2 = 0;
	      s1770_2D_set_order(1);
	   }
 	   else
	   {
              keep_order = 0;
	      if (sing) sing = 0;
	      break;
	   }
	}
     }

     if (corr)
	if (!(p_dir && g_dir)) corr = 0;

     if (dist < prev_dist || p_dir)
     {

	/* Corrigate if we are not inside the parameter interval. */

	g_up = ng_up;
	s1770_2D_copy3(d,c_d,nc_d,2);
	s1770_2D_s9corr(d, par_val, astart1, aend1, astart2, aend2, &corr);
	prev_dist = dist;
	s1770_2D_copy2(prev_diff,diff,dim);

	/* if (corr > 3) break; */

	if (corr > 2 ||
	    ((fabs(d[0]/MAX(par_val[0],delta[0])) <= REL_COMP_RES) &&
	     (fabs(d[1]/MAX(par_val[1],delta[1])) <= REL_COMP_RES))) break;
	if (div2) div2 = 0;

	     if (corr > 1 && order)
	     {
		keep_order = 1;
		s1770_2D_set_order(1);
	     }
     }

     else if (corr > 2 ||
	      ((fabs(d[0]/MAX(par_val[0],delta[0])) <= REL_COMP_RES) &&
	       (fabs(d[1]/MAX(par_val[1],delta[1])) <= REL_COMP_RES))) break;
     else
     {
	/* Not converging, corrigate and try again.  */

	if (dist > prev_dist && div2 > 5) break;
	if (quick && dist > prev_dist && div2 > 3) break;
	div2++;
	s1770_2D_decr2(par_val,d,2);
	d[0] /= (double)2; d[1] /= (double)2;

/*	printf("XXX %d, dist=%f, orden=%d\n",div2,dist,order); */
     }
  }

  /* Iteration stopped, test if point founds found is within resolution */


  if (dim == 2 && fabs(det)<0.1)
  {
    if (order < 1)
    {
      s1770_2D_set_order(2);

      if (par_val[0] == aend1)
	s1227(pcurve1,1+order,par_val[0],&kleft1,c1,&kstat);
      else
	s1221(pcurve1,1+order,par_val[0],&kleft1,c1,&kstat);
      if (kstat < 0) goto error;

      if (par_val[1] == aend2)
	s1227(pcurve2,1+order,par_val[1],&kleft2,c2,&kstat);
      else
	s1221(pcurve2,1+order,par_val[1],&kleft2,c2,&kstat);
      if (kstat < 0) goto error;
    }
    goto singular;
  }

  goto not_singular;

  singular:

     /*  if (!quick && dist > aepsge) */
     if (!quick && dist > aepsge && dim == 2)
     {
	ki = s1770_2D_s6local_pretop(dist,diff,norm,c1,c1_t,c1_tt,
				  c2,c2_t,c2_tt,dim,&kstat);

	if (kstat < 0) goto error;
	if (ki == 0)
	{
	   s1770_2D_s6sekant1(pcurve1,pcurve2,par_val,c_d[0],&dist,aepsge,
			   astart1,astart2,aend1,aend2,c1,c2,norm,&kstat);
	   if (kstat < 0) goto error;

	}
     }

not_singular:

  if (dist <= aepsge)
  {
    *jstat = 1;
  }
  else
  {

     s6diff(c1,c2,dim,norm);
     if ((PIHALF-s6ang(c1_t,norm,dim)) < ANGULAR_TOLERANCE &&
         (PIHALF-s6ang(c2_t,norm,dim)) < ANGULAR_TOLERANCE)
	*jstat = 3;
     else
	*jstat = 2;
  }

  *cpos1 = par_val[0];
  *cpos2 = par_val[1];

  /* Iteration completed.  */


  goto out;

  /* Error in allocation */

 err101: *jstat = -101;
  s6err("s1770_2D",*jstat,kpos);
  goto out;

  /* Error in input. Conflicting dimensions.  */

 err106: *jstat = -106;
  s6err("s1770_2D",*jstat,kpos);
  goto out;

  /* Error in lower level routine.  */

  error : *jstat = kstat;
  s6err("s1770_2D",*jstat,kpos);
  goto out;

 out:
    if (c1 != local && c1 != SISL_NULL) freearray(c1);

    return;
}

//===========================================================================
void s1770_2D_s9corr(double gd[],double acoef[],double astart1,double aend1,
		     double astart2,double aend2,int *corr)
//===========================================================================
{
  int lcorr = 0;
  if (acoef[0] + gd[0] < astart1)
    {
       gd[0] = astart1 - acoef[0];
       lcorr=1;
    }
  else if (acoef[0] + gd[0] > aend1)
    {
       gd[0] = aend1 - acoef[0];
       lcorr=1;
    }

  if (acoef[1] + gd[1] < astart2)
    {
       gd[1] = astart2 - acoef[1];
       lcorr=1;
    }
  else if (acoef[1] + gd[1] > aend2)
    {
       gd[1] = aend2 - acoef[1];
       lcorr=1;
    }

  if (lcorr)
    (*corr)++;
  else
    (*corr) = 0;
}

//===========================================================================
void s1770_2D_s9dir(double *dist,double diff[],double delta[],
		    double c1[],double c1_t[],double c1_tt[],
		    double c2[],double c2_t[],double c2_tt[],
		    int dim, int second, double* det,int* jstat)
//===========================================================================
{
  int kstat;			/* Local status variable. 		  */
  double a1,a2,a3;		/* The A matrix, diagonal and A12.	  */
  double b1,b2;			/* The B matrix, diagonal.	  	  */
  double A[4],mat[4];		/* Matrix in linear equation to be solved */
  double h[2];			/* Left side in the equation.		  */
  double x[2];			/* Left side in the equation.		  */
  double r[2];			/* Left side in the equation.		  */
  long double ss,aa,xx,bb;	/* For use in iterative improvement.      */
  int    piv[2];		/* Pivotation array                       */
  int k,k3,j;			/* Counters.				  */


  /* Computing the different vector */

  s6diff(c1,c2,dim,diff);

  /* Computing the length of the different vector. */

  *dist = s6length(diff,dim,&kstat);
  if (kstat<0) goto error;

  if (second || dim != 2)
  {
     a1 = s6scpr(c1_t,c1_t,dim);
     a2 = s6scpr(c2_t,c2_t,dim);
     a3 = s6scpr(c1_t,c2_t,dim);
  }

  if (second)
  {
     b1 = s6scpr(diff,c1_tt,dim);
     b2 = s6scpr(diff,c2_tt,dim);
  }
  else b1=b2=0.0;

  if (second || dim != 2)
  {
     mat[0] = -a1-b1;	mat[1] = a3;
     mat[2] = -a3;	mat[3] = a2-b2;

     h[0] =  s6scpr(diff,c1_t,dim);
     h[1] =  s6scpr(diff,c2_t,dim);
  }
  else
  {
     mat[0] = -c1_t[0];	mat[1] = c2_t[0];
     mat[2] = -c1_t[1];	mat[3] = c2_t[1];

     h[0] =  diff[0];
     h[1] =  diff[1];
  }

  for (k=0;k<4;k++) A[k]=mat[k];
  for (k=0;k<2;k++) x[k]=h[k];

  *det = A[0]*A[3]-A[1]*A[2];
  if (fabs(*det) < 1.0e-16)
  {
     *jstat = 1;
     goto out;
  }

  /* solve the linear 2x2 system */

  s6lufacp(mat,piv,2,&kstat);
  if (kstat<0) goto error;
  if (kstat == 1)
  {
     *jstat = 1;
     goto out;
  }

  s6lusolp(mat,x,piv,2,&kstat);
  if (kstat<0) goto error;
  if (kstat == 1)
  {
     *jstat = 1;
     goto out;
  }

  for (k=0;k<2;k++) delta[k] = x[k];


  for (k=k3=0; k<2; k++,k3+=2)
  {
     for (ss=0.0,j=0; j<2; j++)
     {
	aa = A[j+k3];
	xx = x[j];
	ss += aa*xx;
     }
     bb = h[k];
     ss = bb-ss;
     r[k] = (double)ss;
  }
  s6lusolp(mat,r,piv,2,&kstat);
  if (kstat<0) goto error;
  if (kstat == 1)
  {
     *jstat = 1;
     goto out;
  }

  for (k=0;k<2;k++) delta[k] = x[k] + r[k];

  *jstat = 0;
  goto out;

  error :
    *jstat = kstat;
    s6err("s1770_2D_s9dir",*jstat,0);
    goto out;

  out:
    return;
}

//===========================================================================
void s1770_2D_s6sekant1(SISLCurve *pcurve1,SISLCurve *pcurve2,
			double  par_val[], double delta, double *dist, double aepsge,
			double astart1,double astart2,double aend1,double aend2,
			double c1[], double c2[], double norm[],
			int *jstat)
//===========================================================================
{
  int ki,kj;		    /* Counter.					   */
  int kstat = 0;            /* Local status variable.                      */
  int kpos = 0;             /* Position of error.                          */
  int dim;                  /* Dimension of space the curves lie in        */
  int knbit;                /* Number of iterations                        */
  double cu_val[2];	    /* Parameter values on curve.		   */
  double new_cu_val;	    /* New parameter value on curve.		   */
  double *diff;		    /* Difference vector between curve surface.    */
  double y[2],new_y,delta_y;/* Signed distance.				   */
  SISLPoint *pt=SISL_NULL;	    /* Point for use in closest point point/surface*/
  int cu1_left = 0;	    /* Keep left knot information for evaluator.   */
  int cu2_left = 0;	    /* Keep left knot information for evaluator.   */
  int shift = 0;	    /* Mark that the diriction have been changed.  */

  *jstat = 0;

  /* Test input.  */

  if (pcurve1->idim != pcurve2->idim) goto err106;
  dim = pcurve1->idim;
  diff = c1 + dim;

  if ((pt = newPoint(c1,dim,0)) == SISL_NULL) goto err101;

  if (delta == 0.0) delta =1e-15;

  if (par_val[0] < astart1) par_val[0] = astart1;
  else if (par_val[0] > aend1) par_val[0] = aend1;

  if ((par_val[0] == astart1 && delta < 0.0) ||
      (par_val[0] == aend1   && delta > 0.0))
  {
     delta = -delta;
     shift++;
  }

  if (fabs(delta) < (aend1 -astart1)/100.0)
  {
     if (delta < 0.0)
	delta = (astart1 - aend1)/100.0;
     else
	delta = (aend1 - astart1)/100.0;
  }
  else if (fabs(delta) > (aend1 -astart1)/10.0)
  {
     if (delta < 0.0)
	delta = (astart1 - aend1)/10.0;
     else
	delta = (aend1 - astart1)/10.0;
  }


  cu_val[0] = par_val[0];
  s1221(pcurve1,0,cu_val[0],&cu1_left,pt->ecoef,&kstat);
  if (kstat < 0) goto error;
  s1771(pt,pcurve2,aepsge,astart2,aend2,par_val[1],par_val+1,&kstat);
  if (kstat < 0) goto error;
  s1221(pcurve2,1,par_val[1],&cu2_left,c2,&kstat);
  if (kstat < 0) goto error;
  norm[0] = -c2[3]; norm[1] = c2[2];
  for(kj=0; kj<dim; kj++) diff[kj] = c2[kj] - pt->ecoef[kj];
  new_y = s6norm(norm,dim,norm,&kstat);
  if (kstat == 0)
  {
     (*dist)=s6length(diff,dim,&kstat);
     new_cu_val = cu_val[0];
     goto out;
  }
  if (((*dist)=s6length(diff,dim,&kstat)) < aepsge)
  {
     new_cu_val = cu_val[0];
     goto out;
  }
  y[0] = s6scpr(norm,diff,dim);
  cu_val[1] = cu_val[0] + delta;
  if (cu_val[1] < astart1) cu_val[1] = astart1;
  else if (cu_val[1] > aend1) cu_val[1] = aend1;

  for (ki=0; ki<20; ki++)
  {
    s1221(pcurve1,0,cu_val[1],&cu1_left,pt->ecoef,&kstat);
    if (kstat < 0) goto error;
    s1771(pt,pcurve2,aepsge,astart2,aend2,par_val[1],par_val+1,&kstat);
    if (kstat < 0) goto error;
    s1221(pcurve2,1,par_val[1],&cu2_left,c2,&kstat);
    if (kstat < 0) goto error;
    norm[0] = -c2[3]; norm[1] = c2[2];
    for(kj=0; kj<dim; kj++) diff[kj] = c2[kj] - pt->ecoef[kj];
    new_y = s6norm(norm,dim,norm,&kstat);
    if (kstat == 0)
    {
      (*dist)=s6length(diff,dim,&kstat);
      new_cu_val = cu_val[1];
      goto out;
    }
    if (((*dist)=s6length(diff,dim,&kstat)) < aepsge)
    {
      new_cu_val = cu_val[1];
      goto out;
    }
    y[1] = s6scpr(norm,diff,dim);
    new_y = y[1]/y[0];
    if (new_y > 1.0000000000001)
    {
      if (shift)
      {
	new_cu_val = cu_val[1];
	goto out;
      }
      delta = -delta;
      cu_val[1] = cu_val[0] + delta;
      if (cu_val[1] < astart1) cu_val[1] = astart1;
      else if (cu_val[1] > aend1) cu_val[1] = aend1;
      shift++;
    }
    else if (y[0]*y[1] <= 0.0 || new_y < 0.6) break;
    else
    {
      if (cu_val[1]+delta <= aend1 &&
	  cu_val[1]+delta >= astart1) cu_val[1] += delta;
      else if (cu_val[1] < aend1)  	cu_val[1] = aend1;
      else if (cu_val[1] > astart1)   cu_val[1] = astart1;
      else
      {
	new_cu_val = cu_val[1];
	goto out;
      }
    }
  }

  if (ki == 20)
  {
     *jstat = 2;
     new_cu_val = par_val[0];
     goto out;
  }

  for (knbit=0; knbit < 25; knbit++)
  {
     delta_y = y[0]-y[1];
     if (fabs(delta_y) < REL_COMP_RES) break;

     if (y[0]*y[1] < 0.0 &&
	 (fabs(y[0]) < 6*fabs(y[1]) || fabs(y[1]) < 6*fabs(y[0])))
       new_cu_val = 0.5*(cu_val[1]+cu_val[0]);
     else
	new_cu_val = cu_val[1] + y[1]*(cu_val[1]-cu_val[0])/delta_y;
     if (new_cu_val >= aend1)
     {
	new_cu_val = aend1;
	if (cu_val[0] == aend1 || cu_val[1] == aend1) goto out;
     }
     else if (new_cu_val <= astart1)
     {
	new_cu_val = astart1;
	if (cu_val[0] == astart1 || cu_val[1] == astart1) goto out;
     }

     s1221(pcurve1,0,new_cu_val,&cu1_left,pt->ecoef,&kstat);
     if (kstat < 0) goto error;
     s1771(pt,pcurve2,aepsge,astart2,aend2,par_val[1],par_val+1,&kstat);
     if (kstat < 0) goto error;
     s1221(pcurve2,1,par_val[1],&cu2_left,c2,&kstat);
     if (kstat < 0) goto error;
     for(kj=0; kj<dim; kj++) diff[kj] = c2[kj] - pt->ecoef[kj];
     norm[0] = -c2[3]; norm[1] = c2[2];
     new_y = s6norm(norm,dim,norm,&kstat);
     if (kstat == 0)
     {
	(*dist) = s6length(diff,dim,&kstat);
	goto out;
     }
     if (((*dist)=s6length(diff,dim,&kstat)) < aepsge) goto out;
     new_y = s6scpr(norm,diff,dim);

     if ((y[0] < 0.0 && y[1] > 0.0) ||
	 (y[0] > 0.0 && y[1] < 0.0))
     {
	if ((new_y > 0.0 && y[0] > 0.0) ||
	    (new_y < 0.0 && y[0] < 0.0))
	{
	   cu_val[0] = new_cu_val;
	   y[0] = new_y;
	}
	else
	{
	   cu_val[1] = new_cu_val;
	   y[1] = new_y;
	}
     }
     else
     {
	if ( y[0] < 0.0 && new_y > 0.0)
	{
	   if (y[0] < y[1])
	   {
	      cu_val[0] = new_cu_val;
	      y[0] = new_y;
	   }
	   else
	   {
	      cu_val[1] = new_cu_val;
	      y[1] = new_y;
	   }
	}
	else if ( y[0] > 0.0 && new_y < 0.0)
	{
	   if (y[0] > y[1])
	   {
	      cu_val[0] = new_cu_val;
	      y[0] = new_y;
	   }
	   else
	   {
	      cu_val[1] = new_cu_val;
	      y[1] = new_y;
	   }
	}
	else if (y[0] > 0.0)
	{
	   if (y[0] > y[1])
	   {
	      if (new_y >=  y[0]) break;
	      cu_val[0] = new_cu_val;
	      y[0] = new_y;
	   }
	   else
	   {
	      if (new_y >=  y[1]) break;
	      cu_val[1] = new_cu_val;
	      y[1] = new_y;
	   }

	}
	else if (y[0] < 0.0)
	{
	   if (y[0] < y[1])
	   {
	      if (new_y <=  y[0]) break;
	      cu_val[0] = new_cu_val;
	      y[0] = new_y;
	   }
	   else
	   {
	      if (new_y <=  y[1]) break;
	      cu_val[1] = new_cu_val;
	      y[1] = new_y;
	   }
	}
     }
  }

  /* Iteration completed.  */

  goto out;

  /* Error in allocation */

  err101:
    *jstat = -101;
    s6err("s1770_2D_s6sekant1",*jstat,kpos);
    goto out;

  /* Error in input. Conflicting dimensions.  */

  err106:
    *jstat = -106;
    s6err("s1770_2D_s6sekant1",*jstat,kpos);
    goto out;

  /* Error in lower level routine.  */

  error :
    *jstat = kstat;
    s6err("s1770_2D_s6sekant1",*jstat,kpos);
    goto out;

  out:
    par_val[0] = new_cu_val;
    if(pt) freePoint(pt);
}

//===========================================================================
int s1770_2D_s6local_pretop(double dist,double diff[],double normal[],
			    double c1[],double c1_t[],double c1_tt[],
			    double c2[],double c2_t[],double c2_tt[],
			    int dim, int*jstat)
//===========================================================================
{
  int kpos = 0;
  int return_val;	 /* For return value.				*/
  double l_1,l_2;
  double v_1,v_2;
  double k_1,k_2;
  double r_1,r_2;


  *jstat = 0;

  if (dim != 2) goto err101;

  l_1 = s6scpr(c1_tt,diff,dim);
  l_2 = s6scpr(c2_tt,diff,dim);

  if (( l_1 < 0.0 && l_2 > 0.0) || (l_1 > 0.0 && l_2 < 0.0))
  {
    return_val = 1;
    goto out;
  }

  v_1 = s6scpr(c1_t,c1_t,dim);
  v_1 = v_1*sqrt(v_1);
  k_1 = fabs(c1_t[0]*c1_tt[1] - c1_tt[0]*c1_t[1]);
  if (k_1 < REL_COMP_RES)	r_1 = 0.0;
  else				r_1 = v_1/k_1;

  v_2 = s6scpr(c2_t,c2_t,dim);
  v_2 = v_2*sqrt(v_2);
  k_2 = fabs(c2_t[0]*c2_tt[1] - c2_tt[0]*c2_t[1]);
  if (k_2 < REL_COMP_RES)	r_2 = 0.0;
  else				r_2 = v_2/k_2;


  if (( l_1 < 0.0 || l_2 < 0.0) && (r_1 > r_2 + dist))
    return_val = 1;
  else if (( l_1 > 0.0 || l_2 > 0.0) && (r_2 > r_1 + dist))
    return_val = 1;
  else
    return_val = 0;

  goto out;


    /* Error in allocation */

  err101:
    *jstat = -101;
    s6err("s1770_2D_s6local_pretop",*jstat,kpos);
    goto out;

  out:
    return return_val;
}

//===========================================================================
void s1221(SISLCurve *pc1,int ider,double ax,int *ileft,double eder[],int *jstat)
//===========================================================================
{
  int kstat=0;        /* Local status variable.                          */
  int kpos=0;         /* The position of the error.                      */
  int kn;             /* The number of B-splines, i.e., the dimension of
			 the spline space associated with the knot
			 vector.                                         */
  int kk;             /* The polynomial order of the curve.              */
  int kdim;           /* The dimension of the space in which the curve
			 lies. Equivalently, the number of components
			 of each B-spline coefficient.                   */
  int kleft;          /* Local version of ileft which is used in order to
			 avoid the pointer.                              */
  int kder;           /* Local version of ider. Since derivatives of order
			 higher than kk-1 are all zero, we set
			 kder = min(kk-1,ider).                          */
  int kind;           /* Type of curve                                   */
  int ki,kj,kih,kjh;  /* Control variables in for loops and for stepping
			 through arrays.                                 */
  int kl,kl1,kl2;     /* Control variables in for loops and for stepping
			 through arrays.                                 */
  double *st;         /* Pointer to the first element of the knot vector
			 of the curve. The knot vector has [kn+kk]
			 elements.                                       */
  double *scoef;      /* Pointer to the first element of the curve's
			 B-spline coefficients. This is assumed to be an
			 array with [kn*kdim] elements stored in the
			 following order:
			 First the kdim components of the first B-spline
			 coefficient, then the kdim components of the
			 second B-spline coefficient and so on.          */
  double tt;          /* Dummy variable used for holding an array element
			 in a for loop.                                  */
  double *ebder=SISL_NULL; /* Pointer to an array of dimension [kk*(ider+1)]
		       which will contain the values and ider first derivatives
			 of the kk nonzero B-splines at ax.
			 These are stored in the following order:
			 First the value, 1. derivative etc. of the
			 first nonzero B-spline, then the same for the
			 second nonzero B-spline and so on.              */
  double *sder=SISL_NULL;  /* Pointer to array used for storage of points, if
			 non rational sder points to eder, if rational sder
			 has to be allocated to make room for the homogenous
			 coordinate */

  /* Copy curve attributes to local parameters.  */

  kn = pc1 -> in;
  kk = pc1 -> ik;
  st = pc1 -> et;
  kdim = pc1 -> idim;
  kind = pc1 ->ikind;

  if (kind == 2 || kind == 4)
    {
      scoef = pc1 -> rcoef;
      kdim +=1;
      sder = newarray(kdim*(ider+1),DOUBLE);
      if (sder==SISL_NULL) goto err101;
    }
  else
    {
      scoef = pc1 -> ecoef;
      sder = eder;
    }

  /* Check the input. */

  if (kdim < 1) goto err102;

  if (kk < 1) goto err110;

  if (kn < kk) goto err111;

  if (st[kk-1] == st[kk] || st[kn-1] == st[kn]) goto err112;

  if (ider < 0) goto err178;

  if (pc1->ikind == 1 || pc1->ikind == 3)
    kder = min(kk-1,ider);
  else
    kder = ider;

  /* Allocate space for B-spline values and derivatives. */

  ebder = newarray(kk*(kder+1),double);
  if (ebder == SISL_NULL) goto err101;

  /* Set all the elements of sder to 0. */

  for (ki=0; ki<(ider+1)*kdim; ki++) sder[ki] = DZERO;

  /* Compute the values and derivatives of the nonzero B-splines and
     update ileft if necessary.                                      */

  s1220(st,kk,kn,ileft,ax,kder,ebder,&kstat);

  if (kstat < 0) goto error;

  kleft = *ileft;

  /* Multiply together as indicated above. */

  /* ki steps through the appropriate kk B-spline coefficients while kih steps
     through the B-spline value and derivatives for the B-spline given by ki.*/

  kih = 0;
  for (ki=kleft-kk+1; ki<=kleft; ki++)
    {

      /* kj counts through the kder+1 derivatives to be computed.
	 kjh steps through sder once for each ki to accumulate the contribution
	 from the different B-splines.
	 kl1 points to the first component of B-spline coefficient no. ki. */

      kjh = 0; kl1 = kdim*ki;
      for (kj=0; kj<=kder; kj++)
	{

	  /* The value of the B-spline derivative is stored in tt while
	     kl2 steps through the idim components of this B-spline
	     coefficient. */

	  tt = ebder[kih++]; kl2 = kl1;
	  for (kl=0; kl<kdim; kl++,kjh++,kl2++)
	    {
	      sder[kjh] += scoef[kl2]*tt;
	    }
	}
    }

  /* Free memory. */

  /* If rational curve calculate the derivatives based on derivatives in
     homogenous coordinates */

  if (kind == 2 || kind == 4)
    {
      s6ratder(sder,pc1->idim,ider,eder,&kstat);
      if (kstat<0) goto error;
      freearray(sder);
    }

  freearray(ebder);

  /* Successful computations.  */

  *jstat = 0;
  goto out;

/* Not enough memory. */
 err101: *jstat = -101;
         s6err("s1221",*jstat,kpos);
         goto out;

/* kdim less than 1. */
 err102: *jstat = -102;
         s6err("s1221",*jstat,kpos);
         goto out;

/* Polynomial order less than 1. */
 err110: *jstat = -110;
         s6err("s1221",*jstat,kpos);
         goto out;

/* Fewer B-splines than the order. */
 err111: *jstat = -111;
         s6err("s1221",*jstat,kpos);
         goto out;

/* Error in knot vector.
   (The first or last interval of the knot vector is empty.) */
 err112: *jstat = -112;
         s6err("s1221",*jstat,kpos);
         goto out;

/* Illegal derivative requested. */
 err178: *jstat = -178;
         s6err("s1221",*jstat,kpos);
         goto out;

/* Error in lower level routine.  */

 error:  *jstat = kstat;
         s6err("s1221",*jstat,kpos);
         goto out;

out: return;
}

//===========================================================================
void s6diff(double e1[],double e2[],int idim,double e3[])
//===========================================================================
{
  int ki;
  for (ki=0;ki<idim;ki++)
    e3[ki] = e1[ki] - e2[ki];
  return;
}

//===========================================================================
double s6norm(double e1[],int idim,double e2[],int *jstat)
//===========================================================================
{
  register int ki;      /* Running variable in loop */
  register double tsum=DZERO; /* Dummy variables in summing loop */
  
  /* If the dimension is 1 the length of the vector is the same as the
   *  absolute value of the number */
  
  if (idim == 1)
    tsum = fabs(e1[0]);
  else
    {
      for (ki=0;ki<idim;ki++)
	tsum += (e1[ki]*e1[ki]);
      
      tsum = sqrt(tsum);
    }
  
  if (DNEQUAL(tsum,DZERO))
    for (ki=0;ki<idim;ki++)
      e2[ki] = e1[ki]/tsum;
  else
    {
      for (ki=0;ki<idim;ki++)
        e2[ki] = DZERO;
      goto mes00;
    }
  goto mes01;

  /* Length of vector is zero    */

 mes00: 
  *jstat = 0;
       goto out;

  /* Length of vector different from zero   */

 mes01: 
  *jstat = 1;
  goto out;
out: return(tsum);
}

//===========================================================================
void s1313(SISLSurf *ps1,double eimpli[],int ideg,double aepsco,double aepsge,
	   double amax,SISLIntcurve *pintcr,int icur,int igraph,int *jstat)
//===========================================================================
{
  int ki,kj,kl;            /* Control variables in for loops            */
  int kcont;               /* Stop condition for loop                   */
  int kk,kn;               /* Dummy variables                           */
  int kstpch;              /* Status of iteration step                  */
  int kpoint;              /* Number of points in guide curve           */
  int kpar1;               /* Number of parameter direction in 1st. obj */
  int kpar2;               /* Number of parameter direction in 2st. obj */
  int kpar;                /* Indicater tellin if S1359 shall make
			      parametrization or use parametrization
			      in spar                                   */
  int ktype;               /* Type of intersection curve                */
  int klfu=0;              /* Pointers into knot vectors                */
  int klfv=0;              /* Pointers into knot vectors                */
  int kder = 2;            /* Calculate up to second derivatives        */
  int kdim = 3;            /* The dimension of the space we work in     */
  int kfirst = 0;          /* Indicator telling if first guide point degenerate */
  int klast = 0;           /* Indicator telling if last guide point degenerate */
  int kpos = 0;            /* Position of error                         */
  int kstat,kstat1;        /* Status variable returned form routine     */
  int kmaxinf=0;           /* Number of entries object that can be stored
			      in s3dinf, sp1inf, sp2inf                 */
  int knbinf=0;            /* Number of entries stored so far on s3dinf,
			      sp1inf and sp2inf                         */
  int kstart;              /* Start point for iteration among guide pnts*/
  int kguide;              /* Current guide point                       */
  int kdir;                /* March direction                           */
  int kgdir;               /* Direction we march guide point vector     */
  int krem,krem1,krem2;    /* Remember if we step in or out of patch    */
  int kbound;              /* Dummy variiable                           */
  int koutside_resolution; /* Flag telling if current seg. outside res. */
  int ksize;               /* Number of doubles for storage of derivateves
			      and normal vector */
  int ksizem3;             /* ksize - 3                                 */
  int kdiv=0;              /* Flag remembering if iteration diverged    */
  int knb1=0;              /* Remember number of points after marching
			      in first marching direction               */
  int kgd1=0;              /* Remeber last guide point used in first
			      marching direction                        */
  double *scorpnt=SISL_NULL;    /* Corrected marching points                 */
  double *scorpar=SISL_NULL;    /* Corrected marching parameter values       */
  double smidd[6];         /* Description of midpoint and tangent of
			      current Bezier segment                    */
  double tcurstep;         /* Current step length                       */
  double tdist;            /* Error at middle of current Bezier segement*/
  double tang;             /* Angle error at midpoint Bezier segement   */
  double tnew;             /* Candidate for new step length             */
  double tfak;             /* How much is the step length to be reduced */
  double *start;           /* Pointer to start of current segment       */
  double *st;              /* Pointer to knot vector                    */
  double sval1[2];         /* Limits of parameter plane in first SISLdir    */
  double tref1,tref2;      /* Reference values for knot vectors         */
  double sval2[2];         /* Limits of parameter plane in second SISLdir   */
  double tstep;            /* Iteration step length                     */
  double tmax;             /* Local maximal step length                 */
  double tstartstp;        /* Start step length                         */
  double trad;             /* Radius of curvature                       */
  double tval[6];             /* Dummy array in s1331                  */
  double *spar=SISL_NULL;       /* Parametrization of points in Hermit interp*/
  double spar1[2];         /* Parameter pair of current point surface 1 */
  double spar2[2];         /* Parameter pair of boundarypoint surface 1 */
  double siparmid[2];      /* Parameter value at middle of Bezier segment*/
  double sipar1[2];        /* Parameter pair iteration point surface  1 */
  double simiddpnt[10];    /* Middle point and tangent of segment       */
  double simiddpar[7];     /* Parameter value at middle point of segment*/
  double *sgpar1=SISL_NULL;     /* Parameter pairs of guide point in surf 1  */
  double *sgpar2=SISL_NULL;     /* Parameter pairs of guide point in surf 2  */
  double *sgpar=SISL_NULL;      /* guide points used                         */
  double *sgd1 = SISL_NULL;     /* 0-2 derivative of guide point + normal
				   of first object                           */
  double spnt1[33];        /* Info on current point in first surface    */
  double spnt2[33];        /* Info on boundary point in first surface   */
  double sipnt1[33];       /* Info on iteration point in first surface  */
  /* For spnt1, sipnt1, the                    */
  /* information is stored 3-tuppels in the    */
  /* following sequence                        */
  /* Position, (1,0)-der, (0,1)-der,           */
  /* (2,0)-der, (1,1)-der, (0,2)-der and normal*/
  /* This is compatible with output of s1421   */
  double snorm1[3];        /* Normal vector of implicit surface         */
  double snorm2[3];        /* Normal vector of implicit surface         */
  double startg[3];        /* Start tangent of iteration                */

  double *snxt1;           /* SISLPoint in ps1 we have accepted          */
  double *snxp1;           /* Parameter value belonging to snxt1        */
  double *s3dinf=SISL_NULL;     /* Pointer to array used for storing 3-D position
				   tangent, curvature and radius of curvature found
				   during the marching process if possible */
  double *sp1inf=SISL_NULL;     /* Pointer to array used for storing position
				   tangent, curvature and radius of curvature found
				   in the first parameter plane during the
				   marching process */
  double start1[33];       /* Description of start point in ps1      */
  double stpar1[2];        /* Parameter pair belonging to start1        */
  double sdum1[3],sdum2[3];/* Dummy vectors                             */
  double tdum,tdump;       /* Dummy variable                            */
  double *sp1=SISL_NULL;        /* Pointer used when moving information      */
  double *sp2=SISL_NULL;        /* Pointer used when moving information      */
  double stdum[10];        /* Dummy array used when moving information  */
  double *stang;           /* Pointer to tangent of current point       */
  double *sptang;          /* Pointer to tangent in parameter plane     */
  double *spoint;          /* Pointer to current point                  */
  double t1distgd,t2distgd;/* Distances to guide points                 */
  double tlnorm;           /* Length of normal vector                   */
  double tltan1,tltan2;    /* Tangent lengths                           */
  SISLCurve *q3dcur=SISL_NULL;/* Pointer to 3-D curve                     */
  SISLCurve *qp1cur=SISL_NULL;/* Pointer to curve in first parameter plane*/
  double sdiffcur[3];        /* Difference between current and previous point found */
  double sdiffprev[3];        /* Difference between previous point and the one before that */


  *jstat = 0;

  if (pintcr == SISL_NULL)  goto err150;


  /* Check if the geometry already has been generated in the topology part.
     This will be the case if the geometry is along a constant parameter line. */

  if (pintcr->itype == 9)  goto out;



  /* Make maximal step length based on box-size of surface */

  sh1992su(ps1,0,aepsge,&kstat);
  if (kstat < 0) goto error;

  tmax = MAX(ps1->pbox->e2max[0][0] - ps1->pbox->e2min[0][0],
	     ps1->pbox->e2max[0][1] - ps1->pbox->e2min[0][1]);
  tmax = MAX(tmax,ps1->pbox->e2max[0][2] - ps1->pbox->e2min[0][2]);

  if (amax>DZERO) tmax = MIN(tmax,amax);


  /* If ideg=1,2 or 1001 then only derivatives up to second order
     are calculated, then 18 doubles for derivatives and 3 for the
     normal vector are to be used for calculation of points in the
     spline surface. For ideg=1003,1004,1005 we have a silhouette curve and
     derivatives up to the third are to be calculated,
     thus 30 +3 a total of 33 doubles are to be calculated */

  if (ideg==1003 || ideg==1004 || ideg==1005)
    {
      kder = 3;
      ksize = 33;
    }
  else
    {
      ksize = 21;
      kder =2;
    }
  ksizem3 = ksize -3;


  /* Find a none singular start point for the marching process */

  kpoint = pintcr->ipoint;
  kpar1  = pintcr->ipar1;
  kpar2  = pintcr->ipar2;
  sgpar1 = pintcr->epar1;
  sgpar2 = pintcr->epar2;
  ktype  = pintcr->itype;


  /* Initiate pointers to intersection curve and intersection curve in
     parameter plane */

  pintcr -> pgeom = SISL_NULL;
  pintcr -> ppar1 = SISL_NULL;
  pintcr -> ppar2 = SISL_NULL;


  /* Initiate parameter direction boundaries */
  kk    = ps1 -> ik1;
  kn    = ps1 -> in1;
  st    = ps1 -> et1;
  sval1[0] = st[kk-1];
  sval1[1] = st[kn];
  tref1 = (double)3.0*MAX(fabs(*sval1),fabs(*(sval1+1)));
  kk    = ps1 -> ik2;
  kn    = ps1 -> in2;
  st    = ps1 -> et2;
  sval2[0] = st[kk-1];
  sval2[1] = st[kn];
  tref2 = (double)3.0*MAX(fabs(*sval2),fabs(*(sval2+1)));

  /* Test that first object has 2 parameter direction and second object 0*/

  if (kpar1 == 2 && kpar2 == 0)
    {
      /*  Everithing is ok */
      ;
    }
  else if (kpar1 == 0 && kpar2 == 2)
    {
      sgpar1 = sgpar2;
    }
  else
    {
      goto err123;
    }

  /* To support closed curve the first guide point must be copied after
     the last guide point */

  if((sgpar=newarray(2*kpoint+2,DOUBLE)) == SISL_NULL) goto err101;
  memcopy(sgpar,sgpar1,2*kpoint,DOUBLE);
  if (ktype ==2 || ktype == 3)
    {
      /* Closed curve copy first guide point to end of string of guide points */
      memcopy(sgpar+2*kpoint,sgpar1,2,DOUBLE);
      kpoint = kpoint + 1;
    }

  /* THE POINTS , TANGENT, CURVATURE AND RADIUS OF CURVATURE FOUND DURING
   *  THE MARCHING PROCESS SHOULD ALL BE STORED IN ARRAYS. ALLOCATE ONE ARRAY
   *  FOR 3-D INFORMATION AND ONE ARRAY FOR INFORMATION IN THE PARAMETER PLANE.
   *  THESE ARRAYS ARE GIVEN AN INITIAL CAPACITY OF STORING 100 POINTS WITH
   *  OTHER INFORMATION.
   *  IF THEY ARE TOO SHORT THEY WILL BE REALLOCATED AT A LATER STAGE.
   *
   *  SINCE THE MARCHING WILL GO IN BOTH DIRECTIONS WE WILL HAVE TO TURN THE
   *  INFORMATION FOUND WHEN MARCHING IN NEGATIVE DIRECTION, SO THAT IT CAN
   *  BE COMBINED WITH THE INFORMATION FOUND WHEN WE ARE MARCHING IN POSITVE
   *  DIRECTION.
   */

  kmaxinf = 100;
  s3dinf = newarray(10*kmaxinf,DOUBLE);
  if (s3dinf == SISL_NULL) goto err101;
  sp1inf = newarray(7*kmaxinf,DOUBLE);
  if (sp1inf == SISL_NULL) goto err101;

  /* Evaluate 0-1-2nd. derivative + normal of all guide points in the surface,
     first allocate arrays for storing the information, check that the points
     have a defined normal, and that the combination of the implicit surface
     and the surface defines a tangent direction in the curve */

  sgd1 = newarray(ksize*kpoint,DOUBLE);
  if (sgd1==SISL_NULL) goto err101;

  kpos = 5;

  /* Initiate kstart to point at no point */

  kstart = 0;

  for (ki=0,kj=0,kl=0 ; ki<kpoint ; ki++,kj+=2,kl+=ksize)
    {
      s1421(ps1,kder,&sgpar[kj],&klfu,&klfv,&sgd1[kl],&sgd1[kl+ksizem3],&kstat);
      if (kstat<0) goto error;



      if (ideg == 1003 || ideg == 1004 || ideg == 1005)
	{
	  /*  Find length of normal vector and tangent vectors */

	  tlnorm = s6length(&sgd1[kl+ksizem3],kdim,&kstat);
	  tltan1 = s6length(&sgd1[kl+kdim],kdim,&kstat);
	  tltan2 = s6length(&sgd1[kl+kdim+kdim],kdim,&kstat);

	  /*  The cross product satisifes the follwing conditions:
	      length(axb) = length(a) length(b) sin(angle(a,b)).
	      Thus the angle between the two vectors can be found, close to 0
	      sin(a) is a good approximation of a
	  */
	  if (tlnorm == (double)0.0 || tltan1 ==(double)0.0 || tltan2 == (double)0.0)
	    tang = (double)0.0;
	  else
	    tang = tlnorm/(tltan1*tltan2);

	  /* Silhouette line calculation no normal can be found in implicit surface
	     accept point as candidate start point if tang greater tha angular
	     resolution */

	  if (tang >= ANGULAR_TOLERANCE) kstart = ki+1;
	}
      else
	{
	  /* Make direction of intersection curve */

	  s1306(&sgd1[kl],&sgpar[kj],eimpli,ideg,s3dinf,sp1inf,&kstat);
	  if (kstat < 0) goto error;


	  /* Remember if start, internal or end point */

	  if (kstat != 2)
	    {
	      if (ki == 0) kfirst = 1;
	      else if (ki == kpoint-1) klast = kpoint;
	      else  kstart = ki+1;
	    }
	}
    }

  /* Check if only degenerate points or singularities exist on the
     intersection curve */

  if (kstart == 0)
    {
      /*  No internal nondegenerate point exits, start marching from first
	  or last point if possible */
      if (kfirst != 0 && ktype != 5 && ktype != 7) kstart = kfirst;
      else if (klast != 0 && ktype != 6 &&
	       ktype != 7 && ktype != 3) kstart = klast;
      else if (kfirst != 0) kstart = kfirst;
      else if (klast != 0) kstart = klast;
      else goto interpolate;
    }

  /* To speed up the marching process when many guide points are given,
     remove guide points that are not at the start, end or the start point */

  if (kpoint >2 && (kstart==1 || kstart==kpoint) )
    {
      /*  No internal guide point necessary, copy last point
	  to second point */

      memcopy(sgd1+ksize,sgd1+ksize*(kpoint-1),ksize,DOUBLE);
      memcopy(sgpar+2,sgpar+2*(kpoint-1),2,DOUBLE);

      if (kstart ==  kpoint) kstart = 2;
      kpoint = 2;
    }
  else if (kpoint>2)
    {
      /*Internal guide point exists, copy this to second position and
	copy end point to third position */

      memcopy(sgd1+ksize,sgd1+ksize*(kstart-1),ksize,DOUBLE);
      memcopy(sgpar+2,sgpar+2*(kstart-1),2,DOUBLE);

      memcopy(sgd1+2*ksize,sgd1+ksize*(kpoint-1),ksize,DOUBLE);
      memcopy(sgpar+4,sgpar+2*(kpoint-1),2,DOUBLE);

      kpoint = 3;
      kstart = 2;
    }



  /* Remember description of start point in both surfaces,
   *  copy point indicated by kstart into spnt1,spar1 */

  memcopy(spnt1,sgd1+ksize*(kstart-1),ksize,DOUBLE);
  memcopy(spar1,sgpar+2*(kstart-1),2,DOUBLE);

  /* Make position, unit tangent, curvature and radius of curvature for
   *  start point of iteration, store them in the arrays just allocated */

  kpos = 10;
  s1306(spnt1,spar1,eimpli,ideg,s3dinf,sp1inf,&kstat);

  if (kstat<0) goto error;

  /* Test if singular point reached */

  if (kstat == 2) goto war03;

  /* Remember start tangent */
  memcopy(startg,s3dinf+3,3,DOUBLE);


  /* Iterate intersection point down to the intersection curve */

  tstep = DZERO;
  s9iterimp(s3dinf,spnt1,spar1,ps1,eimpli,ideg,tstep,
	    aepsge,sipnt1,sipar1,&kstat);
  if (kstat < 0) goto error;

  if (kstat==0 && s6dist(spnt1,sipnt1,3) > aepsge)
    {

      /* Nonsingular point found and adjustment greater than aepsge,
	 copy result of iteration into spnt1,spar1 */

      memcopy(spnt1,sipnt1,ksize,DOUBLE);
      memcopy(spar1,sipar1,2,DOUBLE);
    }

  /* Remember start point */

  if (kstat==0)
    {
      memcopy(start1,sipnt1,ksize,DOUBLE);
      memcopy(stpar1,sipar1,2,DOUBLE);
    }
  else
    {
      memcopy(start1,spnt1,ksize,DOUBLE);
      memcopy(stpar1,spar1,2,DOUBLE);
    }

  /* Make position, unit tangent, curvature and radius of curvature for
     start point of iteration, store them in the arrays just allocated */

  kpos = 10;
  s1306(start1,stpar1,eimpli,ideg,s3dinf,sp1inf,&kstat);

  if (kstat<0) goto error;


  /* Test if singular point reached */

  if (kstat == 2) goto war03;

  /* Remember that start point is already stored */

  knbinf = 1;

  /* Make step length based on 3-D radius of curvature, tolerances and
     maks step length */

  kpos = 20;
  tstep = s1311(s3dinf[9],aepsge,tmax,&kstat);
  if (kstat<0) goto error;
  tstartstp = tstep;

  /* STEP IN BOTH DIRECTIONS FROM THE FOUND START POINT */

  /* Indicate that direction in guide point array not determined */
  kguide = kstart;
  kgdir = 0;

  for (kdir=1;kdir<3;kdir++)
    {

      if (kdir == 2)
	{

	  /* Remember result of marching in first direction */

	  knb1 = knbinf;
	  kgd1 = kguide;


	  /* If the previous step direction made no points then knbinf==0. To
	     enable the marching we start from the same start point as the
	     previous step direction, thus in this case knbinf should be 1. */

	  knbinf = MAX(1,knbinf);

	  /* We now step in the second step direction. Turn the sequence of
	     the points found as well as change tangent directions */

	  /* First interchange 3-D info */

	  for (sp1=s3dinf,sp2=s3dinf+10*(knbinf-1) ; sp1<sp2 ; sp1+=10,sp2-=10)
	    {
	      memcopy(stdum,sp1,  10,DOUBLE);
	      memcopy(sp1  ,sp2,  10,DOUBLE);
	      memcopy(sp2  ,stdum,10,DOUBLE);
	    }

	  for (sp1=s3dinf+3;sp1<s3dinf+10*knbinf;sp1+=10)
	    {
	      sp1[0] = - sp1[0];
	      sp1[1] = - sp1[1];
	      sp1[2] = - sp1[2];
	    }

	  /* Then interchange info in parameter plane */

	  for (sp1=sp1inf,sp2=sp1inf+7*(knbinf-1) ; sp1<sp2 ; sp1+=7,sp2-=7)
	    {
	      memcopy(stdum,sp1  ,7,DOUBLE);
	      memcopy(sp1  ,sp2  ,7,DOUBLE);
	      memcopy(sp2  ,stdum,7,DOUBLE);
	    }

	  for (sp1=sp1inf+2;sp1<sp1inf+7*knbinf;sp1+=7)
	    {
	      sp1[0] = - sp1[0];
	      sp1[1] = - sp1[1];
	      sp1[2] = - sp1[2];
	    }

	  /* Turn direction of remembered start tangent */

	  for (ki=0;ki<3;ki++)
	    startg[ki] = -startg[ki];


	  /* Update spnt1 and  spar1 to have the start point values */

	  memcopy(spnt1,start1,ksize,DOUBLE);
	  memcopy(spar1,stpar1,2,DOUBLE);

	  /* Turn the direction we march the guide point vector, and set current
	     guide point to kstart */

	  kgdir  = -kgdir;
	  kguide = kstart;

	  /*      Update step length */
	  tstep = tstartstp;
	}


      stang = s3dinf + 10*(knbinf-1) + 3;
      kpos = 30;

      /* Step direction ok, perform marching until stop condition reached */

      kcont = 1;

      while (kcont)
	{

	  /* We must make sure that we are not stepping past a guide point.
	   * Thus if we get close to a guide point, make sure that we step
	   * through this. The direction we travers the guide point array
	   * might not have been determined yet. Thus we have to test in
	   * both directions in guide point array.
	   *
	   * Remember how we step in the varaible kstpch:
	   *   kstpch = -1 : Try to step to previous guide point
	   *   kstpch =  0 : Try not to step through guide point
	   *   kstpch =  1 : Try to step to next guide point
	   *   kstpch =  3 : Step to start point and stop marching
	   *   kstpch =  4 : Don't step through guide point, candidate
	   *                 end point of segement found in iteration loop
	   */


	  kstpch = 0;
	  stang = s3dinf + 10*(knbinf-1) + 3;
	  sptang = sp1inf + 7*(knbinf-1) + 2;
	  if (kgdir >=0)
	    {

	      /*  We are stepping in positive direction in guide point vector
	       *  calculate distance to next guide point. If the guide point
	       *  is lying closer than the step length to the current point
	       *  we should step directly to this point provided that the cross
	       *  product of the normal vectors at current point and at the
	       *  guide point have the same direction, e.g. that their scalar
	       *  product is positiv                          */

	      t1distgd = (double)2.0*tstep;
	      if (kguide < kpoint)
		{
		  /* Decide if we should step through the guide point */

		  kpos = 40;
		  t1distgd = s9adsimp(spnt1,spar1,eimpli,ideg,
				      &sgd1[kguide*ksize],
				      &sgpar[kguide*2],
				      stang,sptang,tstep,&kstat);
		  if (kstat < 0) goto error;
		  if (kstat == 1)
		    {
		      /* Step through guide point remember this */

		      kstpch = 1;
		      snxt1 = sgd1 + ksize*kguide;
		      snxp1 = sgpar + 2*kguide;
		      tstep = MIN(tstep,t1distgd);
		    }
		}
	    }

	  if (kgdir <=0)
	    {

	      /* We are stepping in negative direction in guide point vector
	       * calculate distance to previous guide point. If the guide point
	       * is lying closer than the step length to the current point
	       * we should step directly to this point provided that the cross
	       * product of the normal vectors at current point and at the
	       * guide point have the same direction, e.g. that their scalar
	       * product is positiv                          */

	      if (1 < kguide)
		{
		  /* Decide if we should step through the guide point */

		  kpos = 50;
		  t2distgd = s9adsimp(spnt1,spar1,eimpli,ideg,
				      &sgd1[(kguide-2)*ksize],&sgpar[2*kguide-4],
				      stang,sptang,tstep,&kstat);
		  if (kstat<0) goto error;
		  if ((kstat == 1 &&kstpch == 0) ||
		      (kstat == 1 && kstpch == 1 && t2distgd < t1distgd))
		    {
		      /* Step through guide point remember this */

		      kstpch = -1;
		      snxt1 = sgd1 + ksize*(kguide-2);
		      snxp1 = sgpar + 2*(kguide-2);
		      tstep = MIN(tstep,t2distgd);
		    }
		}
	    }

	  /* Check if we step through the start point. Should only be done if at least
	     three points found in this marching direction, a full closed curve will
	     require 6 segments. */
	  if ((kdir==1 && knbinf>3) || (kdir==2 && knbinf>knb1+3))
	    {

	      kpos = 60;
	      tdum = s9adsimp(spnt1,spar1,eimpli,ideg,start1,stpar1,stang,sptang,
			      tstep,&kstat);
	      if (kstat < 0) goto error;
	      if (kstat == 1)
		{
		  /* Step to start point remember this */

		  kstpch = 3;
		  snxt1 = start1;
		  snxp1 = stpar1;
		  tstep = MIN(tstep,tdum);
		}
	    }


	  /* At this stage kstpch=0 if we have not reached a guide point or
	     if we have not reached the start point of the iteration.

	     Now we want to find a Bezier segement that is lying within the
	     geometric tolerance that is approximating the intersection curve.
	     If a guide point is reached (kstpch=-1 or 1), then we have a
	     candidate for the end point of the Bezier segement. If the start
	     point is reached (kstpch=3) then we also have a candidate end point
	     for the segment.

	     The next loop use kstpch to indicate if we have a candidate
	     end point for the segment:

	     kstpch==0  :  No candidate end point exists
	     kstpch!=0  :  Candidate end point exists


	     To indicate if the segement is within the resolution we
	     use koutside_resolution:

	     koutside_resolution==0 : Segment outside resolution
	     koutside_resolution!=0 : Segment inside resolution
	  */

	  koutside_resolution = 0;

	  /* Make sure that there is enough space for one more point */
	  if (knbinf>=kmaxinf)
	    {
	      kmaxinf = kmaxinf + 100;
	      s3dinf = increasearray(s3dinf,((3*kdim+1)*kmaxinf),DOUBLE);
	      if (s3dinf==SISL_NULL) goto err101;
	      sp1inf = increasearray(sp1inf,7*kmaxinf,DOUBLE);
	      if (sp1inf==SISL_NULL) goto err101;
	    }

	  /* Make description of candidate endpoint if it exists and store it */

	  if (kstpch != 0)
	    {
	      s1306(snxt1,snxp1,eimpli,ideg,s3dinf+10*knbinf,
		    sp1inf+7*knbinf,&kstat);
	      if (kstat<0) goto error;

	      /* It is allowed to jump on to a singular point */

	      /* Make sure that the tangents of previous and the
		 candidate end point point in the same direction */

	      if (knbinf>0)
		tdum = s6scpr(s3dinf+10*(knbinf-1)+3,
			      s3dinf+10*knbinf+3,kdim);
	      else
		tdum = s6scpr(startg,s3dinf+3,kdim);


	      if (tdum < DZERO)
		{
		  /* Change tangent direction 3-D and in parameter plane */
		  sp1 = s3dinf + 10*knbinf + 3;
		  sp1[0] = -sp1[0];
		  sp1[1] = -sp1[1];
		  sp1[2] = -sp1[2];
		  sp1 = sp1inf + 7*knbinf + 2;
		  sp1[0] = -sp1[0];
		  sp1[1] = -sp1[1];
		}

	      /* Copy the candidate point to spnt2 and spar2 */

	      memcopy(spnt2,snxt1,ksize,DOUBLE);
	      memcopy(spar2,snxp1,2,DOUBLE);
	    }

	  while (kstpch == 0 || koutside_resolution == 0)
	    {
	      if (kstpch!=0)
		{
		  /* Candidate end point exist, iterate to find point close
		     to the midpoint of the Bezier segement */


		  /* Decide if Hermit shape acceptable and find position and
		     tangent at midpoint of segment */

		  start = s3dinf + 10*(knbinf-1);

		  s1361(start,start+10,3,smidd,smidd+3,&kstat);
		  if (kstat<0) goto error;

		  tcurstep = DZERO;
		  spoint = smidd;
		}
	      else
		{

		  /* Iterate to find end point of segment */

		  /* ITERATE by intersecting the two surface and the plane
		   * defined by current point (s3dinf), the tangent (s3dinf+3)
		   * and the step length */

		  spoint = s3dinf + 10*(knbinf-1);
		  tcurstep = tstep;
		}

	      /*  Perform the actual iteration */

	      kpos = 70;
	      s9iterimp(spoint,spnt1,spar1,ps1,eimpli,ideg,tcurstep,
			aepsge,sipnt1,sipar1,&kstat);
	      if (kstat < 0) goto error;

	      /*             Initiate distance between midpoint and iteration point
			     to -1 to enable detection of divergence */

	      tdist = -1;

	      /*  Check if iteration has converged        */

	      if (kstat == 2)
		{
		  /*  Iteration has diverged, half step length if possible,
		      find new endpoint of segement. */

		  kstpch = 0;
		  koutside_resolution = 0;
		}
	      else if(kstat == 1 && kstpch != 0)
		{
		  /* The point found is closer to the input point than
		     the relative computer resolution or is a singular point.
		     Half step length if possible, find new endpoint of
		     segement. */

		  kstpch = 0;
		  koutside_resolution = 0;
		}
	      else if (kstpch!=0)
		{


		  /*  Make description of intersection point */

		  s1306(sipnt1,sipar1,eimpli,ideg,simiddpnt,simiddpar,&kstat);
		  if (kstat<0) goto error;

		  if (kstat != 2)
		    {
		      /* We iterated to find midpoint of segment, test if
			 it is within resolution */

		      tdist = s6dist(simiddpnt,smidd,3);
		      tang  = s6ang(simiddpnt+3,smidd+3,3);
		    }

		  /* If point is singular or not within resolution a new
		     Hermit segment has to be made */

		  if (kstat == 2 || (fabs(tdist) > aepsge ||
				     (fabs(tang) > ANGULAR_TOLERANCE && tstep>aepsge)))
		    {
		      kstpch = 0;
		      koutside_resolution = 0;
		    }
		  else
		    {
		      /* Segment within tolerance.
		       * Check that the relationship between the two surfaces
		       * has not been interchanged, by making the cross product
		       * of the normal vectors in current point and the point
		       * found by iteration. Then make the scalar product of
		       * these vectors. If the scalar product is negative then
		       * we have either jumped to another branch or passed a
		       * singularity, iterprete this as the iteration has diverged
		       * In addition we don't want the direction of the tangents
		       * change to much. We set a limit of approximately 41 degrees
		       * by testing on a cosin value of 0.75
		       * Make normal vectors in implicit surface for both points
		       * Make also sure that the curve in the parameter plane
		       * does not turn more than 90 degrees.
		       */

		      s1331(spnt1,eimpli,ideg,-1,tval,snorm1,&kstat);
		      if (kstat < 0) goto error;
		      s1331(spnt2,eimpli,ideg,-1,tval,snorm2,&kstat);
		      if (kstat < 0) goto error;

		      if(ideg == 1003 || ideg == 1004 || ideg == 1005)
			{
			  tdum = s6scpr(snorm1,snorm2,kdim);
			}
		      else
			{
			  s6crss(spnt1+ksizem3,snorm1,sdum1);
			  (void)s6norm(sdum1,kdim,sdum1,&kstat);
			  if (kstat < 0) goto error;
			  s6crss(sipnt1+ksizem3,snorm2,sdum2);
			  (void)s6norm(sdum2,kdim,sdum2,&kstat);
			  if (kstat < 0) goto error;
			  tdum = s6scpr(sdum1,sdum2,kdim);
			}

		      s6diff(spar2,spar1,2,sdum1);
		      tdump = s6scpr(sdum1,sp1inf+7*(knbinf-1)+2,2);
		      /* The test below was added to detect the case when the
			 normal of the parametric surface turns */
		      if(s6scpr(spnt1+ksizem3,sipnt1+ksizem3,kdim) < 0.0)
			{
			  tdum = -tdum;
			}
		      if (tdum == DZERO)
			{
			  double tl1,tl2;

			  /* If one of the tangents have zero length, accept
			     segment */

			  tl1 = s6length(sdum1,kdim,&kstat);
			  tl2 = s6length(sdum2,kdim,&kstat);

			  if (tl1 == DZERO || tl2 == DZERO)
			    koutside_resolution = 1;
			  else
			    {
			      /* Find new end point of segment */
			      koutside_resolution = 0;
			      kstpch = 0;
			    }

			}
		      else if (tdum <= (double)0.75 || tdump <= (double)0.0)
			{
			  /* Find new end point of segment */
			  koutside_resolution = 0;
			  kstpch = 0;
			}
		      else
			{
			  koutside_resolution = 1;
			}
		    }
		}
	      else
		{
		  /* We iterated to find end point of segment, update pointer */

		  memcopy(spnt2,sipnt1,ksize,DOUBLE);
		  memcopy(spar2,sipar1,2,DOUBLE);

		  s1306(sipnt1,sipar1,eimpli,ideg,s3dinf+10*knbinf,
			sp1inf+7*knbinf,&kstat);
		  if (kstat<0) goto error;

		  /* Make sure that the tangents of previous and the new point
		     point in the same direction, singular end point allowed */

		  if (knbinf>0)
		    tdum = s6scpr(s3dinf+10*(knbinf-1)+3,
				  s3dinf+10*knbinf+3,kdim);
		  else
		    tdum = s6scpr(startg,s3dinf+3,kdim);


		  if (tdum < DZERO)
		    {
		      /* Change tangent direction 3-D and in parameter plane */
		      sp1 = s3dinf + 10*knbinf + 3;
		      sp1[0] = -sp1[0];
		      sp1[1] = -sp1[1];
		      sp1[2] = -sp1[2];
		      sp1 = sp1inf + 7*knbinf + 2;
		      sp1[0] = -sp1[0];
		      sp1[1] = -sp1[1];
		    }

		  /* Indicate that end point accepted */

		  kstpch = 4;
		  koutside_resolution = 0;
		}

	      /* If the segment is accepted. check if we cross the
		 boundary of the patch  */

	      if (kstpch !=0 && koutside_resolution == 1)
		{

		  /*               Check if curve between start and endpoint cross the
				   boundary */

		  memcopy(siparmid,sipar1,2,double);

		  s1305(spar1,spar2,sval1,sval2,&kbound,sipar1,&kstat);
		  if (kstat<0) goto error;


		  if(kstat==0 || kstat==4)
		    {
		      /* Set pointer to tangents at start point */
		      ki = 7*(knbinf-1)+2;

		      if( (DEQUAL(spar1[1]+tref2,sval2[0]+tref2) && sp1inf[ki+1]>DZERO) ||
			  (DEQUAL(spar1[1]+tref2,sval2[1]+tref2) && sp1inf[ki+1]<DZERO) ||
			  (DEQUAL(spar1[0]+tref1,sval1[0]+tref1) && sp1inf[ki]>DZERO) ||
			  (DEQUAL(spar1[0]+tref1,sval1[1]+tref1) && sp1inf[ki]<DZERO)

			  )
			kstat = 1;
		    }
		  krem1 = kstat;



		  /*               Check if curve between start and  midd point cross the
				   boundary */

		  s1305(spar1,siparmid,sval1,sval2,&kbound,sipar1,&kstat);
		  if (kstat<0) goto error;
		  krem2 = kstat;

		  /* We now have the following cases:
		     kstat == 0 : Line between epar1 and epar2 outside,
		     If this happens when kdir=1, then
		     just forget the start point. If it happens
		     when kdir=2, then we just stop the marching.
		     kstat == 1 : Line between epar1 and epar2 inside.
		     Continue iteration.
		     kstat == 2 : We step out of the patch. Clip to the edge
		     of the patch. Update start point.
		     kstat == 3 : We step into the patch. Clip to the edge
		     of the patch. Update endpoint
		     kstat == 4 : We go from the boundary and out. Try next
		     iteration direction.

		  */
		  if (krem1==0 || krem2==0)
		    {
		      if (kdir==1) knbinf--;
		      goto nextdir;
		    }
		  else if ((krem1 !=1 || krem2 !=1) && krem1 != 4 && krem2 !=4)
		    {

		      /* If we clip to the boundary, forget any guide point
			 identified. The actual action is dependent on which
			 of the points spar2 or sipar1 indicates the crossing */

		      kstat1 = 0;
		      if (krem2==2 || krem2==3)
			{
			  s9clipimp(spar1,siparmid,ps1,eimpli,ideg,sval1,sval2,
				    aepsge,sipnt1,sipar1,&kstat);
			  if (kstat<0) goto error;
			  if (krem2==3 && kstat==1) kstpch = 4;
			  kstat1 = kstat;
			  krem = krem2;
			}
		      if (kstat1 != 1 && (krem1 ==2 || krem1==3))
			{
			  s9clipimp(spar1,spar2,ps1,eimpli,ideg,sval1,sval2,
				    aepsge,sipnt1,sipar1,&kstat);
			  if (kstat<0) goto error;
			  if (krem1==3 && kstat==1) kstpch = 4;
			  kstat1 = kstat;
			  krem = krem1;
			}

		      if (kstat1 == 1)
			{
			  /* Check that the relationship between the two surfaces
			   * has not been interchanged, by making the cross product
			   * of the normal vectors in current point and the point
			   * found by iteration. Then make the scalar product of
			   * these vectors. If the scalar product is negative then
			   * we have either jumped to another branch or passed a
			   * singularity, iterprete this as the iteration has diverged
			   * In addition we don't want the direction of the tangents
			   * change to much. We set a limit of approximately 41 degrees
			   * by testing on a cosin value of 0.75
			   * Make normal vectors in implicit surface for both points
			   * Make also sure that the curve in the parameter plane
			   * does not turn more than 90 degrees.
			   */

			  s1331(spnt1,eimpli,ideg,-1,tval,snorm1,&kstat);
			  if (kstat < 0) goto error;
			  s1331(sipnt1,eimpli,ideg,-1,tval,snorm2,&kstat);
			  if (kstat < 0) goto error;

			  if(ideg == 1003 || ideg == 1004 || ideg == 1005)
			    {
			      tdum = s6scpr(snorm1,snorm2,kdim);
			    }
			  else
			    {
			      s6crss(spnt1+ksizem3,snorm1,sdum1);
			      (void)s6norm(sdum1,kdim,sdum1,&kstat);
			      if (kstat < 0) goto error;
			      s6crss(sipnt1+ksizem3,snorm2,sdum2);
			      (void)s6norm(sdum2,kdim,sdum2,&kstat);
			      if (kstat < 0) goto error;

			      tdum = s6scpr(sdum1,sdum2,kdim);
			    }


			  /* Check that sipar1 lies on the same side of spar1 as
			     the tangent at spar1 */

			  s6diff(sipar1,spar1,2,sdum1);
			  tdump = s6scpr(sdum1,sp1inf+7*(knbinf-1)+2,2);
			  /* The test below was added to detect the case when the
			     normal of the parametric surface turns */
			  if(s6scpr(spnt1+ksizem3,sipnt1+ksizem3,kdim) < 0.0)
			    {
			      tdum = -tdum;
			    }
			}

		      /* An intersection point has only been found when kstat==1
		       */
		      if (kstat1==1 && tdump >= (double)0.0 && tdum > (double)0.75)
			{
			  /* If krem=3 we step into the patch, if krem=2 we step
			     out of the patch */

			  if (krem==2 || krem==3)
			    {
			      /* Since we clip, set kstpch=0, no guide point reached */

			      /* If krem==3 we step into the patch, make new
				 start point of segment */

			      if (krem==3) knbinf--;

			      memcopy(spnt2,sipnt1,ksize,DOUBLE);
			      memcopy(spar2,sipar1,2,DOUBLE);

			      s1306(sipnt1,sipar1,eimpli,ideg,s3dinf+10*knbinf,
				    sp1inf+7*knbinf,&kstat);
			      if (kstat<0) goto error;


			      /* Make sure that the tangents of previous and the new point
				 point in the same direction */

			      if (knbinf>0)
				tdum = s6scpr(s3dinf+10*(knbinf-1)+3,
					      s3dinf+10*knbinf+3,kdim);
			      else
				tdum = s6scpr(startg,s3dinf+3,kdim);


			      if (tdum < DZERO)
				{
				  /* Change tangent direction 3-D and in
				     parameter plane
				  */
				  sp1 = s3dinf + 10*knbinf + 3;
				  sp1[0] = -sp1[0];
				  sp1[1] = -sp1[1];
				  sp1[2] = -sp1[2];
				  sp1 = sp1inf + 7*knbinf + 2;
				  sp1[0] = -sp1[0];
				  sp1[1] = -sp1[1];
				}

			      /* If the new end point tangent points out go
				 to next direction */

			      ki = 7*knbinf;
			      if( (sp1inf[ki+1] <= sval2[0] && sp1inf[ki+3] < DZERO) ||
				  (sp1inf[ki+1] >= sval2[1] && sp1inf[ki+3] > DZERO) ||
				  (sp1inf[ki  ] <= sval1[0] && sp1inf[ki+2] < DZERO) ||
				  (sp1inf[ki  ] >= sval1[1] && sp1inf[ki+2] > DZERO)   )
				{
				  knbinf++;
				  goto nextdir;
				}
			      else if(krem == 2 &&
				      ((sp1inf[ki+1] <= sval2[0] && sp1inf[ki+3] >= DZERO) ||
				       (sp1inf[ki+1] >= sval2[1] && sp1inf[ki+3] <= DZERO) ||
				       (sp1inf[ki  ] <= sval1[0] && sp1inf[ki+2] >= DZERO) ||
				       (sp1inf[ki  ] >= sval1[1] && sp1inf[ki+2] <=DZERO)    ))
				{
				  /* We were marching out ou the patch, but the tangent
				     points in, half step length */
				  kstpch = 0;
				}



			    }
			}

		      else
			{
			  /* Divergence or point on wrong side in the parameter
			     plane or 3-d */
			  kstpch = 0;
			  koutside_resolution = 0;
			}
		    }
		  else if (krem1==4 || krem2==4)
		    goto nextdir;

		}

	      /* Update step length if new endpoint is to be found */

	      if (kstpch==0)
		{
		  if (tdist<DZERO)
		    {
		      tnew = tstep/(double)10.0;
		    }
		  else
		    {
		      tfak = MAX(tdist/aepsge,(double)1.0);
		      tfak = (double)2.0*pow(tfak,ONE_FOURTH);
		      tnew = MIN(tstep/(double)2.0,tstep/tfak);
		    }
		  if (DEQUAL(tmax+tnew,tmax+tstep)) goto nextdir;
		  tstep = tnew;
		}
	    }

	  /* If kstpch= -1,1,3 or 4 then a point is accepted and
	   * snxt1 points to the position and derivatives
	   * of the accepted point. */

	  /* If we have accepted a segment pointing in the opposite
	   * direction of the previous segment, something very wrong
	   * has happened, and we go out with an error. */
	  if (knbinf >= 2)
	    {
	      s6diff(s3dinf + 10*knbinf, s3dinf + 10*(knbinf - 1), kdim, sdiffcur);
	      s6diff(s3dinf + 10*(knbinf-1), s3dinf + 10*(knbinf - 2), kdim, sdiffprev);
	      if (s6scpr(sdiffcur, sdiffprev ,kdim) < DZERO)
		{
		  /* We have a problem with degeneracy, quit now. */
		  goto war03;
		}
	      /* printf("%7.13f\n", s6scpr(sdiffcur, sdiffprev ,kdim)); */
	    }

	  /* Update number of intersection points */

	  knbinf++;

	  /* Copy point and parameter pair descriptions */

	  memcopy(spnt1,spnt2,ksize,DOUBLE);
	  memcopy(spar1,spar2,2,DOUBLE);

	  /* Update guide point pointers */

	  if (kstpch ==  1)
	    {
	      kguide++;
	      kgdir   = 1;

	      /* Test if end of guide point array reached */

	      if (kguide >= kpoint) goto nextdir;

	    }
	  if (kstpch == -1)
	    {
	      kguide--;
	      kgdir   = -1;

	      /* Test if start of guide point array reached */

	      if (1 >= kguide) goto nextdir;
	    }

	  /* Make new radius of curvature */

	  trad = *(s3dinf + 10*knbinf - 1);
	  tstep = s1311(trad,aepsge,tmax,&kstat);
	  if (kstat<0) goto error;

	  /* Test if start point reached, e.g. that the curve is closed */

	  if (kstpch == 3)
	    {
	      /*             Closed curve found */
	      goto finished;
	    }


	  /*         End while loop */
	}
      /* End inside */
      /* INSIDE TEST REMOVED BECAUSE OF CHANGED STRATEGY
	 }
      */
    nextdir:;
      /* End two step directions */
    }

 finished:

  /* In certain cases too many marched point may be found. These cases are:

  - Open curve and start of marching first guide point
  - Open curve and start of marching last guide point
  - Closed curve and this found in second marching direction

  In these cases some of the found points have to be discarded */

  scorpnt = s3dinf;
  scorpar = sp1inf;

  if (kstpch !=3 && kpoint>1)
    {

      /*  Open curve */

      if ( (kstart==1 && kgd1 == kpoint) ||
	   (kstart==kpoint && kgd1==1)      )
	{
	  /*  First marching direction traced curve */

	  knbinf = knb1;
	}
      else if ( (kstart==1 && kguide==kpoint) ||
		(kstart==kpoint && kguide==1)    )
	{
	  /* Second marching direction traced curve */

	  scorpnt = scorpnt + 10*(knb1-1);
	  scorpar = scorpar +  7*(knb1-1);
	  knbinf  = knbinf - knb1 + 1;
	}
    }
  else if (kpoint>1)
    {
      /*  Closed curve, correct if result of second marching direction */

      if (kdir != 1)
	{
	  /* Second marching direction, disc ard result of first direction */

	  scorpnt = scorpnt + 10*(knb1-1);
	  scorpar = scorpar +  7*(knb1-1);
	  knbinf  = knbinf - knb1 + 1;
	}
    }

  /* A curve is traced out only if at least two points are found, if less
     points found try to pick out constant parameter line */

 interpolate:

  if (knbinf>1)
    {
      if (igraph == 1 && knbinf > 1)
	{
	  /*  Output curve through s6line and s6move */

	  s6move(scorpnt);
	  for (ki=1,sp1=scorpnt+10;ki<knbinf;ki++,sp1+=10)
	    s6line(sp1);
	}

      if (icur > 0 && knbinf >1)
	{

	  /*  Make 3-D representation of intersection curve */

	  kpar = 0;

	  /*  We allocate space for parametrization array */


	  spar = newarray(knbinf,DOUBLE);
	  if (spar == SISL_NULL) goto err101;

	  s1359(scorpnt,aepsge,kdim,knbinf,kpar,spar,&q3dcur,&kstat);
	  if (kstat < 0) goto error;

	  /*  Set pointer in intcurve object to 3-D curve */
	  pintcr -> pgeom = q3dcur;

	  if (icur == 2)
	    {
	      /* Make curve in parameter plane */

	      kdim = 2;
	      kpar = 1;
	      s1359(scorpar,aepsge,kdim,knbinf,kpar,spar,&qp1cur,&kstat);
	      if (kstat < 0) goto error;


	      /* Set pointersin intcurve object to curves in parameter plane */
	      if (kpar1 ==2)
		{
		  pintcr -> ppar1 = qp1cur;
		}
	      else
		{
		  pintcr -> ppar2 = qp1cur;
		}
	    }
	}
    }
  /*  Dont use s9constline for the silhouette curves -- it won't work! */
  else if(pintcr->ipoint > 1 && ideg < 1003)
    {

      /* If no points produced on intersection curve */

      s1313_s9constline(ps1,eimpli,ideg,aepsge,pintcr,
			icur,igraph,&kstat);
      if (kstat<0) goto error;
      if (kstat==0) goto err185;
    }
  else
    goto err185;

  if (kdiv==1) goto war03;
  *jstat = 0;

  goto out;

  /* Iteration can not continue */
 war03:  *jstat = 3;
  goto out;

  /* Error in space allocation */
 err101: *jstat = -101;
  s6err("s1313",*jstat,kpos);
  goto out;

  /* Error in surface description parameter direction does not exist */
 err123: *jstat = -123;
  s6err("s1313",*jstat,kpos);
  goto out;


  /* Error - SISL_NULL pointer was given */
  err150 :
    *jstat = -150;
  s6err("s1313",*jstat,kpos);
  goto out;


  /* Only degenerate or singular guide points */
 err185: *jstat = -185;
  goto out;


  /* Error in lower leve function */
 error:
  *jstat = kstat;
  s6err("s1313",*jstat,kpos);
  goto out;

 out:

  /* Free allocated space */

  if (sgpar  != SISL_NULL) freearray(sgpar);
  if (sgd1   != SISL_NULL) freearray(sgd1);
  if (s3dinf != SISL_NULL) freearray(s3dinf);
  if (sp1inf != SISL_NULL) freearray(sp1inf);
  if (spar   != SISL_NULL) freearray(spar);


  return;
}


//===========================================================================
void sh1761 (SISLObject * po1, SISLObject * po2, double aepsge, 
	     SISLIntdat ** pintdat, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Local status variable.                 */
  int kpos = 0;			/* Position of error.                     */
  int ktotal = 1;		/* Make totally expanded box.             */
  int kxintercept = (*jstat == 202);  /* Extra interception               */
  double tpar;			/* Help variable used for parameter value
				   and geometric distance.                */
  SISLObject *po1_kreg=SISL_NULL;    /* Pointer to first object converted to
				   k-regular basis.                       */
  SISLObject *po2_kreg=SISL_NULL;    /* Pointer to second object converted to
				   k-regular basis.                       */
  SISLIntpt *qt = SISL_NULL;         /* Temporary intersection point. */
  SISLEdge *qedge[2];	        /* Edges for use in s1862().      */
  SISLIntdat *qintdat = SISL_NULL;	/* Intdat for use in recurson.    */

  double *nullp = SISL_NULL;
  int idummy;

  qedge[0] = qedge[1] = SISL_NULL;  /* PFU - to fix memory leak */


  /* Ensure K-regularity on B-spline basis ________________*/
  if (po1->iobj == SISLCURVE)
    {
       if (po1->c1->cuopen == SISL_CRV_PERIODIC)
	 {
	    if ((po1_kreg = newObject (SISLCURVE)) == SISL_NULL)
	      goto err101;
	    make_cv_kreg(po1->c1, &po1_kreg->c1, &kstat);
	    if (kstat < 0) goto error;
	 }
       else po1_kreg = po1;

    }
  else if (po1->iobj == SISLSURFACE)
    {
       if (po1->s1->cuopen_1 == SISL_CRV_PERIODIC ||
	   po1->s1->cuopen_2 == SISL_CRV_PERIODIC)
	 {
	    if ((po1_kreg = newObject (SISLSURFACE)) == SISL_NULL)
	      goto err101;
	    make_sf_kreg(po1->s1, &po1_kreg->s1, &kstat);
	    if (kstat < 0) goto error;
	 }
       else po1_kreg = po1;
    }
  else po1_kreg = po1;



  if (po2->iobj == SISLCURVE)
    {
       if (po2->c1->cuopen == SISL_CRV_PERIODIC)
	 {
	    if ((po2_kreg = newObject (SISLCURVE)) == SISL_NULL)
	      goto err101;
	    make_cv_kreg(po2->c1, &po2_kreg->c1, &kstat);
	    if (kstat < 0) goto error;
	 }
       else po2_kreg = po2;
    }
  else if (po2->iobj == SISLSURFACE)
    {
       if (po2->s1->cuopen_1 == SISL_CRV_PERIODIC ||
	   po2->s1->cuopen_2 == SISL_CRV_PERIODIC)
	 {
	    if ((po2_kreg = newObject (SISLSURFACE)) == SISL_NULL)
	      goto err101;
	    make_sf_kreg(po2->s1, &po2_kreg->s1, &kstat);
	    if (kstat < 0) goto error;
	 }
       else po2_kreg = po2;
    }

  else po2_kreg = po2;

  /* End of ensure K-regularity on B-spline basis ________________*/


  if (po1_kreg->iobj == SISLPOINT && po2_kreg->iobj == SISLPOINT)
    {
      /* Control the dimension of the two points. */

      if (po1_kreg->p1->idim != po2_kreg->p1->idim)
	goto err106;

      /* Computing the distanse beetween the points. */

      tpar = s6dist (po1_kreg->p1->ecoef, po2_kreg->p1->ecoef, po1_kreg->p1->idim);

      if (tpar <= aepsge)
	{
	  /* PFU, moved to top to fix memory leak: SISLIntpt *qt = SISL_NULL; */

	  *jstat = 1;		/* Mark intersection found. */
	  /* UJK , newi */
	  /* Making intersection point. */

	  qt = hp_newIntpt (0, &tpar, DZERO, SI_ORD,
			    SI_UNDEF, SI_UNDEF, SI_UNDEF, SI_UNDEF,
			    0, 0, nullp, nullp);
	  if (qt == SISL_NULL)
	    goto err101;

	  /* Uppdating pintdat. */

	  sh6idnpt (pintdat, &qt, 1, &kstat);
	  if (kstat < 0)
	    goto error;

	  qt = SISL_NULL;      /* PFU - to fix memory leak */
	}
      else
	*jstat = 0;
    }
  else
    {
      /* Test if intersection is possible (perform box-test).  */

      sh1790 (po1_kreg, po2_kreg, ktotal, aepsge, &kstat);
      if (kstat < 0)
	goto error;

      /* We may have four different values on kstat.
	 kstat = 0 : Intersection not possible.
	 kstat = 1 : The two boxes overlap.
	 kstat = 2 : The two "bezier" boxes is just touching.
	 kstat = 3 : The two boxes is both inside a microbox of aepsge. */


      if (kstat)
	{
	  int ki, kj;		/* Counters.                      */
	  int kedg = 0;		/* Number of parameter direction. */
	  SISLObject *qo1 = SISL_NULL;  /* Help pointer.                  */
	  SISLObject *qo2 = SISL_NULL;  /* Help pointer.                  */

	  /* PFU, moved to top to fix memory leak:
	   *  SISLEdge *qedge[2];
	   *  SISLIntdat *qintdat = SISL_NULL;
	   */

	  qintdat = SISL_NULL; /* PFU to fix memory leak. */
	  qedge[0] = qedge[1] = SISL_NULL;
	  *jstat = 0;

	  for (kj = 0, qo1 = po1_kreg, qo2 = po2_kreg; kj < 2; kj++, qo1 = po2_kreg, qo2 = po1_kreg)
	    if (qo1->iobj == SISLPOINT)
	      qedge[kj] = SISL_NULL;	/* Not necessary to compute edge intersection.*/
	    else if (qo1->iobj == SISLCURVE)
	      {
		if ((qedge[kj] = newEdge (2)) == SISL_NULL)
		  goto err101;

		for (ki = 0; ki < 2; ki++)
		  {
		    if (qo1->edg[ki] == SISL_NULL)
		      {
			if ((qo1->edg[ki] = newObject (SISLPOINT)) == SISL_NULL)
			  goto err101;

			/* Pick out end point from a curve. */

			s1438 (qo1->c1, ki, &(qo1->edg[ki]->p1), &tpar, &kstat);
			if (kstat < 0)
			  goto error;
		      }
		    else
		      tpar = (ki == 0 ? qo1->c1->et[qo1->c1->ik - 1] :
			      qo1->c1->et[qo1->c1->in]);

		    /* Recursiv computing of end intersection. */

		    sh1761 (kj == 0 ? qo1->edg[ki] : qo2, kj == 0 ? qo2 : qo1->edg[ki],
			    aepsge, &qintdat, &kstat);
		    if (kstat < 0)
		      goto error;


		    if (kstat)
		      {
			*jstat = 1;	/* Mark intersection found. */

			/* Put intersection found on edges into pintdat. */


			/* Get parameter border values of qo2. */

			/* UJK , newi */
			sh1782 (po1_kreg, po2_kreg, aepsge, qintdat, kedg, tpar,
				pintdat, &idummy, &kstat);
			if (kstat < 0)
			  goto error;


			/* Uppdate edge structure. */
			s6idedg (po1_kreg, po2_kreg, kj + 1, 1, tpar, *pintdat,
			  &qedge[kj]->prpt[ki], &qedge[kj]->ipoint, &kstat);
			if (kstat < 0)
			  goto error;
		      }

		    if (qintdat != SISL_NULL)
		      freeIntdat (qintdat);
		    qintdat = SISL_NULL;
		  }
		kedg++;
	      }

	    else if (qo1->iobj == SISLSURFACE)
	      {
		int kpar;	/* Parameter direction.            */

		if ((qedge[kj] = newEdge (4)) == SISL_NULL)
		  goto err101;

		for (ki = 0; ki < 4; ki++)
		  {
		    if (qo1->edg[ki] == SISL_NULL)
		      {
			if ((qo1->edg[ki] = newObject (SISLCURVE)) == SISL_NULL)
			  goto err101;

			/* Pick out edge curve from a surface. */

			s1435 (qo1->s1, ki, &(qo1->edg[ki]->c1), &tpar, &kstat);
			if (kstat < 0)
			  goto error;
		      }
		    else
		      tpar = (ki == 0 ? qo1->s1->et2[qo1->s1->ik2 - 1] :
			      (ki == 1 ? qo1->s1->et1[qo1->s1->in1] :
			       (ki == 2 ? qo1->s1->et2[qo1->s1->in2] :
				qo1->s1->et1[qo1->s1->ik1 - 1])));

		    /* Recursiv computing of edge intersection. */

		    if (kj == 0)
		      sh1761 (qo1->edg[ki], qo2, aepsge, &qintdat, &kstat);
		    else
		      sh1761 (qo2, qo1->edg[ki], aepsge, &qintdat, &kstat);
		    if (kstat < 0)
		      goto error;


		    if (kstat)
		      {
			*jstat = 1;	/* Mark intersection found. */

			/* Compute Parameter direction of edge. */

			kpar = ((ki == 0 || ki == 2) ? 2 : 1);


			/* Put intersection found on edges into pintdat. */

			/* UJK , newi */
			sh1782 (po1_kreg, po2_kreg, aepsge, qintdat, kpar + kedg - 1, tpar,
				pintdat, &idummy, &kstat);
			if (kstat < 0)
			  goto error;


			/* Uppdate edge structure. */
			s6idedg (po1_kreg, po2_kreg, kj + 1, kpar, tpar, *pintdat,
			  &qedge[kj]->prpt[ki], &qedge[kj]->ipoint, &kstat);
			if (kstat < 0)
			  goto error;
		      }

		    if (qintdat != SISL_NULL)
		      freeIntdat (qintdat);
		    qintdat = SISL_NULL;
		  }
		kedg += 2;
	      }

	    else
	      goto err121;

	  /* Before we enter internal intersection and subdivision we
	     initiate pointers to top level objects. */

	  if (po1_kreg->o1 == SISL_NULL)
	    po1_kreg->o1 = po1_kreg;
	  if (po2_kreg->o1 == SISL_NULL)
	    po2_kreg->o1 = po2_kreg;

	  /* Find the intersections in the inner of the object.  */

	  /* NEWI (ujk) Must treat helppoint on edges */
	  if (qedge[0] != SISL_NULL)
	    freeEdge (qedge[0]);
	  qedge[0] = SISL_NULL;
	  if (qedge[1] != SISL_NULL)
	    freeEdge (qedge[1]);
	  qedge[1] = SISL_NULL;

	  if (po1_kreg->iobj == SISLPOINT)
	    qedge[0] = SISL_NULL;
	  else if ((qedge[0] = newEdge (2 * po1_kreg->iobj)) == SISL_NULL)
	    goto err101;

	  if (po2_kreg->iobj == SISLPOINT)
	    qedge[1] = SISL_NULL;
	  else if ((qedge[1] = newEdge (2 * po2_kreg->iobj)) == SISL_NULL)
	    goto err101;

	  sh6idalledg (po1_kreg, po2_kreg, *pintdat, qedge, &kstat);
	  if (kstat < 0)
	    goto error;

	  kstat = (kxintercept) ? 202 : 0;
	  sh1762 (po1_kreg, po2_kreg, aepsge, pintdat, qedge, &kstat);
	  if (kstat < 0)
	    goto error;
	  else if (kstat)
	    *jstat = 1;


	  /* Free the edges used in s1762. */

	  if (qedge[0] != SISL_NULL)
	    freeEdge (qedge[0]);
	  qedge[0] = SISL_NULL;
	  if (qedge[1] != SISL_NULL)
	    freeEdge (qedge[1]);
	  qedge[1] = SISL_NULL;


	  /* UJK, edge reduction rules */
	     sh6edgred (po1_kreg, po2_kreg, (*pintdat), &kstat);

	  /* Organize the list in pintdat. */
	    sh6idlis (po1_kreg, po2_kreg, pintdat, aepsge, &kstat);
	  if (kstat < 0)
	    goto error;

          /* Convert any degenerate intersection curves (Intlists)
	     to intersection points (Intpts).
	     This may be necessary when
	     either of the intersection objects po1_kreg and po2_kreg
	     are parametrically degenerate. */
/*
	  sh6degen(po1_kreg,po2_kreg,pintdat,aepsge,&kstat);
	  if (kstat < 0) goto error;
*/
	  if (qintdat)  freeIntdat(qintdat);  /* PFU                  */
	  qintdat = SISL_NULL;                     /* - to fix memory leak */
	}
      else
	*jstat = 0;
    }

  goto out;

  /* Error in space allocation.  */

err101:*jstat = -101;
  s6err ("sh1761", *jstat, kpos);
  goto out;

  /* Error. Dimensions conflicting.  */

err106:*jstat = -106;
  s6err ("sh1761", *jstat, kpos);
  goto out;

  /* Error. Kind of object does not exist.  */

err121:*jstat = -121;
  s6err ("sh1761", *jstat, kpos);
  goto out;

  /* Error in lower order routine.  */

error:*jstat = kstat;
  s6err ("sh1761", *jstat, kpos);
  goto out;

  out:
     /* Kill kreg temporary geometry */
     if (po1_kreg && po1_kreg != po1)
       {
	  freeObject(po1_kreg);
	  po1_kreg = SISL_NULL;
       }

     if (po2_kreg && po2_kreg != po2)
       {
	  freeObject(po2_kreg);
	  po2_kreg = SISL_NULL;

       }

     if (qt)  freeIntpt(qt);             /* PFU                   */
     if (qintdat)  freeIntdat(qintdat);  /* - to fix memory leak. */
     if (qedge[0])  freeEdge(qedge[0]);
     if (qedge[1])  freeEdge(qedge[1]);

}

//===========================================================================
void int_join_per (SISLIntdat ** pintdat,
		   SISLObject * po1,
		   SISLObject * po2,
		   double eimpli[],
		   int ideg,
		   double aepsge,
		   int *jstat)
//===========================================================================
{
  int kstat;			/* Local status variable.          */
  int kpos = 0;			/* Position of error.              */
  int ki=0, kj=0;		        /* Counter                         */
  SISLIntpt *pcurr;		/* to traverse list of points.     */
  SISLIntpt *pnext;	        /* to traverse list of points.     */
  SISLIntpt *pother;	/* to traverse list of points.     */
  int logtest=0;                /* used for constant crv test      */

  SISLIntpt *pfirst_1;		/* First point in a list, periodicity     */
  SISLIntpt *pfirst_2;		/* First point in a list, periodicity     */
  SISLIntpt *plast_1;		/* Last point in a list, periodicity      */
  SISLIntpt *plast_2;		/* Last point in a list, periodicity      */
  double *curve_val_3d  = SISL_NULL; /* Pos, tang and curvature ,3d    */
  double *curve_val_2d_1= SISL_NULL; /* Pos, tang and curvature ,2d    */
  double *curve_val_2d_2= SISL_NULL; /* Pos, tang and curvature ,2d    */
  double delta_par[4];          /* Delta vector in par space, periodicity */
  double *delta_1=delta_par;    /* Delta vector in par space, periodicity */
  double *delta_2=delta_par+2;  /* Delta vector in par space, periodicity */
  double dot;                   /* Scalar product, periodicity            */
  double dist;                  /* Distance in 3D, periodicity            */
  double dist_a;                /* Distance in 3D, periodicity            */
  double dist_b;                /* Distance in 3D, periodicity            */
  double dist_c;                /* Distance in 3D, periodicity            */
  double dist_d;                /* Distance in 3D, periodicity            */
  double ang;                   /* Angel between tangents, periodicity    */
  int dimobj;                   /* Dimension 3, periodicity               */
  //int dim2=2;                   /* Dimension 2, periodicity               */
  int join=TRUE;                /* Flag to kill int point, periodicity    */
  int const_crv_1;              /* Constant parameter direction           */
  int const_crv_2;              /* Constant parameter direction           */
  int same_curve;               /* Flag                                   */
  int no_of_main;               /* No of mainpts connected to curr pt     */
  int treat_2d;                 /* Flag, shifting of parameter values is 
				   only done in surf/surf cases.          */
  int cas;                      /* Flag, surf surf, surf analytic, other. */ 
  double epar[2];
  double *nullp = SISL_NULL;
  SISLIntpt *pturn=SISL_NULL;	/* Last point in a list, periodicity      */
  int log_1, log_2;             /* To test on an edge curve lies along
				   the same parameter direction.          */
  int kp,no_par,index_1;
  double min_par[4],max_par[4],legal_min[4],legal_max[4];
  SISLObject *qo=SISL_NULL;
  /* -------------------------------------------------------------------- */ 
       
  /* If we do not have any intersection data we just return. */     
  
  if ((*pintdat) == SISL_NULL)
     goto out;
  if ((*pintdat)->ipoint <=1)
     goto out;
  
  
  if      (po1->iobj == SISLSURFACE) dimobj = po1->s1->idim;
  else if (po1->iobj == SISLCURVE)   dimobj = po1->c1->idim;
  else goto errinp;
  
  /* UJK, 13.08.93 : Check periodicity flag.*/
  no_par = (*pintdat)->vpoint[0]->ipar;
  if (no_par > 4) goto errinp;
  
  for (kp=0;kp<4;kp++)
  {
     legal_min[kp] = -HUGE;
     legal_max[kp] =  HUGE;
  }
  
  for (ki=0,qo=po1,index_1=0;ki<2;ki++,qo=po2)
     if (qo)
     {
	if (qo->iobj == SISLSURFACE) 
	{
	   if (qo->s1->cuopen_1 != SISL_SURF_PERIODIC)
	   {
	      legal_min[index_1] = qo->s1->et1[qo->s1->ik1-1];
	      legal_max[index_1] = qo->s1->et1[qo->s1->in1];
	   }
	   
	   index_1++;
	   if (qo->s1->cuopen_2 != SISL_SURF_PERIODIC)
	   {
	      legal_min[index_1] = qo->s1->et2[qo->s1->ik2-1];
	      legal_max[index_1] = qo->s1->et2[qo->s1->in2];
	   }
	   index_1++;
	}
	else if (qo->iobj == SISLCURVE) 
	{
	   if (qo->c1->cuopen != SISL_CRV_PERIODIC)
	   {
	      legal_min[index_1] = qo->c1->et[qo->c1->ik-1];
	      legal_max[index_1] = qo->c1->et[qo->c1->in];
	   }
	   index_1++;
	}
     }
  
  
  /*________________________________________ */
  /* UJK, TESTING !!!!!!!!!!!!!!!!!!! For the moment: */
  if      (dimobj == 3 && po2->iobj == SISLPOINT) goto out;
  /*________________________________________ */
  
  if (po1->iobj == SISLSURFACE && 
      po2->iobj == SISLSURFACE &&  ideg == 0)
     /* Two B-spline surf's in 3D. */
     cas = 1;
  else if (po1->iobj == SISLSURFACE && ideg != 2000 && ideg !=0) 
     /* B-spline surf vs analytic. */
     cas = 2;
  else 
     cas = 0;
  
  
  
  if (ideg != 2000 && po1->iobj == SISLSURFACE) treat_2d = TRUE;
  else treat_2d = FALSE;
  
  for (ki=1;ki<5;ki++) logtest |= 1<< ki;
  
  /* Ensure that object space information is in place. */
  for (kj = 0; kj < (*pintdat)->ipoint; kj++)
  {
     pcurr = (*pintdat)->vpoint[kj];
     sh6evalint (po1, po2, eimpli, ideg, pcurr, aepsge,
		 &curve_val_3d, &curve_val_2d_1,
		 &curve_val_2d_2, &kstat);
     if (kstat < 0)
	goto error;
  }
  
  /* Check direction for const_crvs. */
  if (cas)
     for (ki = 0; ki < (*pintdat)->ilist; ki++)
     {
	pfirst_1 = (*pintdat)->vlist[ki]->pfirst;
	plast_1  = (*pintdat)->vlist[ki]->plast;
	
	if(((*pintdat)->vlist[ki]->inumb == 2) &&
	   (pfirst_1->curve_dir[(*pintdat)->vlist[ki]->ind_first] & logtest))
	{
	   if (cas == 1)
	   {
	   }
	   else /*if (cas == 2)*/
	   {
	      /* Select midpoint. */
	      epar[0] = (pfirst_1->epar[0] + plast_1->epar[0])/2.0;
	      epar[1] = (pfirst_1->epar[1] + plast_1->epar[1])/2.0;
	      pturn = hp_newIntpt (2, epar, DZERO, SI_ORD,
				   SI_UNDEF, SI_UNDEF, SI_UNDEF, SI_UNDEF,
				   0, 0, nullp, nullp);
	      if (pturn == SISL_NULL)
		 goto err101;
	      
	      sh6evalint (po1, po2, eimpli, ideg, pturn, aepsge,
			  &curve_val_3d, &curve_val_2d_1,
			  &curve_val_2d_2, &kstat);
	      if (kstat < 0)
		 goto error;
	      
	      if (pturn->iinter == SI_ORD)
	      {
		 double dot;
		 dot = (plast_1->epar[0]-pfirst_1->epar[0])*curve_val_2d_1[2]+
		    (plast_1->epar[1]-pfirst_1->epar[1])*curve_val_2d_1[3];
		 if (dot < 0) 
		 {
		    /* Turn direction. */
		    int ind_1, ind_2, dir_1, dir_2;
		    
		    ind_1    = (*pintdat)->vlist[ki]->ind_first;
		    ind_2    = (*pintdat)->vlist[ki]->ind_last;
		    dir_1    = pfirst_1->curve_dir[ind_1];
		    dir_2    = plast_1->curve_dir[ind_2];
		    
		    (*pintdat)->vlist[ki]->pfirst = plast_1;
		    (*pintdat)->vlist[ki]->plast  = pfirst_1;
		    (*pintdat)->vlist[ki]->ind_first = ind_2;
		    (*pintdat)->vlist[ki]->ind_last  = ind_1;
		    pfirst_1->curve_dir[ind_1] = dir_2;
		    plast_1->curve_dir[ind_2]  = dir_1;
		    
		 }
	      }		 
	      if (pturn) freeIntpt(pturn);
	      pturn = SISL_NULL;
	      
	   }
	}
     }
  
  /* Traverse the lists to remove doubly represented curves along
     periodic edges.     */
  
  for (ki = 0; ki < (*pintdat)->ilist; ki++)
  {
     pfirst_1 = (*pintdat)->vlist[ki]->pfirst;
     plast_1  = (*pintdat)->vlist[ki]->plast;
     
     if(((*pintdat)->vlist[ki]->inumb == 2) &&
	(pfirst_1->curve_dir[(*pintdat)->vlist[ki]->ind_first] & logtest))
	const_crv_1 = TRUE;
     else 
	const_crv_1 = FALSE;
     
     
     if (pfirst_1 == plast_1) continue;
     
     for (kj = 0; kj < (*pintdat)->ilist; kj++)
     {
	
	same_curve = (ki == kj); 
	pfirst_2 = (*pintdat)->vlist[kj]->pfirst;
	plast_2 = (*pintdat)->vlist[kj]->plast;
	
	if(((*pintdat)->vlist[kj]->inumb == 2) &&
	   (pfirst_2->curve_dir[(*pintdat)->vlist[kj]->ind_first] & logtest))
	   const_crv_2 = TRUE;
	else 
	   const_crv_2 = FALSE;
	
	/* To treat the case when two curves are on an periodic edge */
	if (const_crv_1 && const_crv_2 && !same_curve)
	{
	   log_1 = pfirst_1->curve_dir[(*pintdat)->vlist[ki]->ind_first];
	   log_1 = log_1>>1;
	   log_1 &= 15;
	   log_2 = pfirst_2->curve_dir[(*pintdat)->vlist[kj]->ind_first];
	   log_2 = log_2>>1;
	   log_2 &= 15;
	   
	   if (log_1 & log_2)
	   {
	      dist_a = s6dist(plast_1->geo_track_3d,
			      pfirst_2->geo_track_3d,
			      dimobj);
	      dist_b = s6dist(plast_1->geo_track_3d,
			      plast_2->geo_track_3d,
			      dimobj);
	      dist_c = s6dist(pfirst_1->geo_track_3d,
			      pfirst_2->geo_track_3d,
			      dimobj);
	      dist_d = s6dist(pfirst_1->geo_track_3d,
			      plast_2->geo_track_3d,
			      dimobj);
	      if ((dist_a <aepsge && dist_d < aepsge) ||	
		  (dist_b <aepsge && dist_c < aepsge)	)
	      {
		 /* Kill the two points */
		 sh6idkpt(pintdat, &pfirst_2, join=FALSE, &kstat);
		 if (kstat < 0) goto error;
		 
		 sh6idkpt(pintdat, &plast_2, join=FALSE, &kstat);
		 if (kstat < 0) goto error;
		 
		 /* Remove the curve list kj, and pack vlist array */
		 freeIntlist ((*pintdat)->vlist[kj]);
		 (*pintdat)->ilist--;
		 (*pintdat)->vlist[kj] =
		    (*pintdat)->vlist[(*pintdat)->ilist];
		 
		 /* Reset to start */
		 ki = -1;
		 break; /* kj loop */
	      }
	      
	   }
	}
     }
  }
  
  for (ki = 0; ki < (*pintdat)->ilist; ki++)
  {
     pfirst_1 = (*pintdat)->vlist[ki]->pfirst;
     plast_1  = (*pintdat)->vlist[ki]->plast;
     
     if(((*pintdat)->vlist[ki]->inumb == 2) &&
	(pfirst_1->curve_dir[(*pintdat)->vlist[ki]->ind_first] & logtest))
	const_crv_1 = TRUE;
     else 
	const_crv_1 = FALSE;
     
     
     if (pfirst_1 == plast_1) continue;
     
     for (kj = 0; kj < (*pintdat)->ilist; kj++)
     {
	
	same_curve = (ki == kj); 
	pfirst_2 = (*pintdat)->vlist[kj]->pfirst;
	plast_2 = (*pintdat)->vlist[kj]->plast;
	
	if(((*pintdat)->vlist[kj]->inumb == 2) &&
	   (pfirst_2->curve_dir[(*pintdat)->vlist[kj]->ind_first] & logtest))
	   const_crv_2 = TRUE;
	else 
	   const_crv_2 = FALSE;
	
	/* Joining of curves */
	if (plast_1 == pfirst_2 ||
	    plast_1->iinter == SI_TRIM ||
	    plast_1->iinter == SI_SING ||
	    plast_1->iinter == SI_TOUCH ||
	    pfirst_2->iinter == SI_TRIM ||
	    pfirst_2->iinter == SI_SING ||
	    pfirst_2->iinter == SI_TOUCH)
	{
	   /* Test on edge ? */
	   continue;
	}
	else
	{
	   dist = s6dist(plast_1->geo_track_3d,
			 pfirst_2->geo_track_3d,
			 dimobj);
	   ang  = s6ang(plast_1->geo_track_3d + dimobj,
			pfirst_2->geo_track_3d + dimobj,
			dimobj);
	   dot  = s6scpr(plast_1->geo_track_3d + dimobj,
			 pfirst_2->geo_track_3d + dimobj,
			 dimobj);
	   
	   if (dist < aepsge &&
	       dot  > 0      &&
	       ang  < ANGULAR_TOLERANCE)
	   { 
	      /* HIT, Join the two lists of curves */
	      if (same_curve)
	      {
		 /*sh6connect(pfirst_1, plast_1, &kstat);
		    if (kstat != 0) goto error;
		    sh6idkpt (pintdat, &plast_1, join=TRUE, &kstat);
		    if (kstat < 0) goto error;
		    
		    (*pintdat)->vlist[ki]->inumb -= 1; 
		    
		    periodic set to true ! 
		    
		    (*pintdat)->vlist[ki]->plast = 
		    pfirst_1; */
	      }
	      else
	      {
		 /* Move 2D values of second part */
		 s6diff(plast_1->epar,
			pfirst_2->epar,
			no_par,
			delta_par);
		 
		 /* Last check to see if we move outside legal area */
		 for(kp=0;kp<no_par;kp++)
		 {
		    min_par[kp] = HUGE;
		    max_par[kp] = -HUGE;
		 }
		 
		 pcurr = pfirst_2;
		 pnext = pfirst_2->pnext[(*pintdat)->vlist[kj]->ind_first];
		 while (pcurr != plast_2 && pcurr && pnext)
		 {
		    for(kp=0;kp<no_par;kp++)
		    {
		       min_par[kp] = min(pnext->epar[kp]+delta_par[kp],min_par[kp]);
		       max_par[kp] = max(pnext->epar[kp]+delta_par[kp],max_par[kp]);
		    }
		    
		    sh6getother (pnext, pcurr, &pother, &kstat);
		    if (kstat && pnext != plast_2) goto errinconsist;
		    pcurr = pnext;
		    pnext = pother;
		 }		     
		 
		 for(kp=0;kp<no_par;kp++)
		 {
		    if (min_par[kp] < legal_min[kp] && 
			DNEQUAL(min_par[kp],legal_min[kp])) break;
		    if (max_par[kp] > legal_max[kp] && 
			DNEQUAL(max_par[kp],legal_max[kp])) break;
		    
		 }
		 
		 
		 /* _______________________ */
		 if (kp == no_par)
		 {
		    pcurr = pfirst_2;
		    pnext = pfirst_2->pnext[(*pintdat)->vlist[kj]->ind_first];
		    while (pcurr != plast_2 && pcurr && pnext)
		    {
		       for(kp=0;kp<no_par;kp++)
			  pnext->epar[kp] += delta_par[kp];
		       
		       if (treat_2d)
		       {
			  pnext->geo_track_2d_1[0] += delta_1[0];
			  pnext->geo_track_2d_1[1] += delta_1[1];
			  if (cas==1)
			  {
			     pnext->geo_track_2d_2[0] += delta_2[0];
			     pnext->geo_track_2d_2[1] += delta_2[1];
			  }
		       }
		       sh6getother (pnext, pcurr, &pother, &kstat);
		       if (kstat && pnext != plast_2) goto errinconsist;
		       pcurr = pnext;
		       pnext = pother;
		    }		     
		 
		 sh6connect(plast_1, pfirst_2, &kstat);
		 if (kstat != 0) goto error;
		 sh6idkpt (pintdat, &pfirst_2, join=TRUE, &kstat);
		 if (kstat < 0) goto error;
		 
		 if (const_crv_1 && const_crv_2)
		 {
		    sh6idkpt (pintdat, &plast_1, join=TRUE, &kstat);
		    if (kstat < 0) goto error;
		    
		    sh6getlist(pfirst_1,plast_2,
			       &((*pintdat)->vlist[ki]->ind_first),
			       &((*pintdat)->vlist[ki]->ind_last),
			       &kstat);
		    kpos = 111;
		    if (kstat != 0) goto errinconsist;
		    (*pintdat)->vlist[ki]->inumb = 2; 
		    
		    (*pintdat)->vlist[ki]->plast = 
		       plast_2;
		    
		 }
		 else 
		 {
		    
		    (*pintdat)->vlist[ki]->inumb += 
		       (*pintdat)->vlist[kj]->inumb -1;
		    
		    (*pintdat)->vlist[ki]->plast = 
		       plast_2;
		    (*pintdat)->vlist[ki]->ind_last = 
		       (*pintdat)->vlist[kj]->ind_last;
		 }
		 
		 /* Remove the curve list kj, and pack vlist array */
		 freeIntlist ((*pintdat)->vlist[kj]);
		 (*pintdat)->ilist--;
		 (*pintdat)->vlist[kj] =
		    (*pintdat)->vlist[(*pintdat)->ilist];
		 
		 
		 /* Reset to start */
		 ki = -1;
		 break; /* kj loop */
		 }
	      } /* End of else not same curve */
	      
	   } /* if hit */
	   
	} /* else */
     } /* kj */
  } /* ki */
  
  
  /* Treat single points */
  for (ki = 0; ki < (*pintdat)->ipoint; ki++)
  {
     kstat = 0;
     pcurr = (*pintdat)->vpoint[ki];
     if (sh6ismain(pcurr)) no_of_main = sh6nmbmain(pcurr, &kstat);
     else no_of_main = -1;
     if (kstat < 0) goto error;
     
     if (no_of_main == 0)		  
	for (kj = 0; kj < (*pintdat)->ipoint; kj++)
	{
	   pother = (*pintdat)->vpoint[kj];
	   if (sh6ismain(pother) && pother != pcurr)
	   {
	      dist = s6dist(pcurr->geo_track_3d,
			    pother->geo_track_3d,
			    dimobj);
	      if (dist < aepsge)
	      {
		 sh6idkpt(pintdat, &pcurr, join = FALSE, &kstat);
		 if (kstat < 0) goto error;
		 ki--; /* New point in array place no ki, redo the job */
		 break; /* kj loop */
	      }
	   }
	}
  }
  
  
  
  *jstat = 0;
  goto out;

  /* _________________________ EXIT ____________________________ */
  /* Error in alloc */
err101:
  *jstat = -101;
  s6err ("int_join_per", *jstat, kpos);
  goto out;

  /* Error inconsistency */
errinconsist:
  *jstat = -500;
  s6err ("int_join_per", *jstat, kpos);
  goto out;

  /* Error in input */
errinp:
     *jstat = -200;
  s6err ("int_join_per", *jstat, kpos);
  goto out;

  /* Error in lower level function */
error:
     *jstat = kstat;
  s6err ("int_join_per", *jstat, kpos);
  goto out;

out:
  ;
}

//===========================================================================
void make_tracks (SISLObject * po1, SISLObject * po2, int ideg,
		  double eimpli[], int icrv, SISLIntlist ** vlist,
		  int *jtrack,SISLTrack *** wcrv, double aepsge, int *jstat)
//===========================================================================
{
  *jstat  = 0;
  *jtrack = 0;
}
//===========================================================================
void hp_s1880(SISLObject * po1, SISLObject * po2,
	      int ideg,
	      int ipar1, int ipar2, SISLIntdat *pintdat,
	      int *jpar, double **gpar1, double **gpar2, int **pretop,
	      int *jcrv, SISLIntcurve *** wcrv, int *jsurf, SISLIntsurf *** wsurf,
	      int *jstat)
//===========================================================================
{
  int kstat;			/* Local status                                */
  int kpos = 0;			/* Position of error.                          */
  int ki, kj, kk;		/* Counters.                                   */
  int kpoint;			/* Number of points in an intersection list.   */
  int ktype;			/* Kind of intersection curve. (See SISLIntcurve). */
  int kpt;			/* Used to find number of single intersection points.*/
  int index;			/* Array index for next point at start        */
  int sing_1, sing_2;		/* Sing point flag at start and end           */
  double *spar1, *spar2;	/* Values of points belonging to an intersection
				     curve in the parameter area of the objects
				     involved in the intersection.                 */
  double *stpar1, *stpar2, *stpar3;	/* Pointers used to travers arrays
				           containing parameter values.        */
  int *top1;	                /* Pointers used to travers pretop. */
  SISLIntcurve **ucrv;		/* Pointer used to traverse *wcrv array.     */
  SISLIntsurf **usurf;		/* Pointer used to traverse *wsurf array.    */
  SISLIntpt *qpt;		/* Pointer to an intersection point.         */
  SISLIntpt *qprev;		/* Pointer to an intersection point.         */
  SISLIntpt *qnext;		/* Pointer to an intersection point.         */
  SISLIntpt *qpfirst;		/* Pointer to first intersection point.      */
  SISLIntpt *qplast;		/* Pointer to last intersection point.       */

  int jpt = pintdat->ipoint;
  SISLIntpt **vpoint = pintdat->vpoint;
  int jlist = pintdat->ilist;
  SISLIntlist **vlist = pintdat->vlist;
  SISLObject *qo2 = SISL_NULL;
  int kdir,kdir1=-1,kdir2=-1;
  int exact=FALSE, exact_treat=FALSE;
  int log_test = 0;
  double dummy;
  /* ------------------------------------------------------------------ */

  for (ki = 1; ki < 5; ki++)
     log_test |= 1 << ki;

  if (po1->iobj == SISLSURFACE && ideg != 0)
  {
     /* Surf vs Implicit geometry */
     qo2 = newObject (SISLPOINT);
     exact_treat = TRUE;
  }
  else  if (po1->iobj == SISLSURFACE &&
	    po2->iobj == SISLSURFACE &&
	    ideg ==0)
  {
     /* Surf vs Implicit geometry */
     qo2 = po2;
     exact_treat = TRUE;
  }


  /* Initiate output.  */

  *gpar1 = *gpar2 = SISL_NULL;
  *wcrv = SISL_NULL;
  *wsurf = SISL_NULL;

  *jcrv = 0;
  *jsurf = 0;

  /* Allocate space for intersection curve and surface array.  */

  *wcrv = newarray (jlist, SISLIntcurve *);
  if (jlist > 0 && *wcrv == SISL_NULL)
    goto err101;
  *wsurf = newarray (jlist, SISLIntsurf *);
  if (jlist > 0 && *wcrv == SISL_NULL)
    goto err101;

  /* Transfer curve-information from vlist array to wcrv and wsurf arrais. */

  ucrv  = *wcrv;
  usurf = *wsurf;

  for (kpt = ki = 0; ki < jlist; ki++)
  {
     qpfirst = qpt = (*vlist)->pfirst;
     qplast = (*vlist)->plast;
     index = (*vlist)->ind_first;
     kpoint = (*vlist)->inumb;
     if (kpoint == 0)
	goto err137;

     if (qpfirst->iinter == SI_TRIM && qpfirst == qplast)
     {
	/* Create new intersection surf.  */

	*usurf = newIntsurf(*vlist);
	if (*usurf == SISL_NULL)
	   goto err101;

	/* Copy pretopology
	   memcopy((*usurf)->pretop,(*vlist)->pretop,4,int); */

	kpt += kpoint-1;
	usurf++;
	(*jsurf)++;
     }
     else
     {
	if (qpfirst->iinter == SI_SING ||
	    (sh6nmbmain (qpfirst,&kstat)) > 2)
	   sing_1 = TRUE;
	else
	   sing_1 = FALSE;

	if (qplast->iinter == SI_SING ||
	    (sh6nmbmain (qplast,&kstat)) > 2)
	   sing_2 = TRUE;
	else
	   sing_2 = FALSE;


	/* Allocate space for arrays containing parameter values of points
	   in intersection curves.                                          */

	spar1 = newarray (ipar1 * kpoint, double);
	spar2 = newarray (ipar2 * kpoint, double);
	if ((ipar1 > 0 && spar1 == SISL_NULL) ||
	    (ipar2 > 0 && spar2 == SISL_NULL))
	   goto err101;

	/* Collect parameter values of the points in this intersection list
	   and distribute values to the objects in the intersection.         */

	kj = 0;
	stpar1 = spar1;
	stpar2 = spar2;
	while (qpt != SISL_NULL && kj < kpoint)
	{
	   stpar3 = qpt->epar;
	   for (kk = 0; kk < ipar1; kk++)
	      *(stpar1++) = *(stpar3++);
	   for (kk = 0; kk < ipar2; kk++)
	      *(stpar2++) = *(stpar3++);

	   /* Reduce no of single points */
	   if (qpt->marker != -99)
	   {
	      kpt++;

	      /* Flag point */
	      qpt->marker = -99;
	   }
	   if (qpt == qpfirst)
	   {
	      qprev = qpt;
	      qpt = qpt->pnext[index];
	   }
	   else
	   {
	      sh6getother (qpt, qprev, &qnext, &kstat);
	      qprev = qpt;
	      qpt = qnext;
	   }
	   kj++;
	}

	/* Find type of intersection curve.  */

	if (sing_1 && sing_2)
	   /* Both ends junction */
	   ktype = 7;
	else if (qpfirst == qplast)
	   /* Closed curve, not singular */
	   ktype = 2;
	else if (sing_1)
	   /* Junction at start */
	   ktype = 5;
	else if (sing_2)
	   /* Junction at end */
	   ktype = 6;
	else
	   /* Open and clean */
	   ktype = 4;


	exact = FALSE;
	/* UJK, March 1995, when curve type is 9 and the curve is
	   an iso-line in both surfaces, we want to return both
	   ppar1 and ppar2. The logic is simple:
	   kdir1 > -1 (ie eq 0 or 1) means constant in 1. surf.
	   kdir2 > -1 (ie eq 2 or 3) means constant in 2. surf. 
	   The object space curve pgeom is picked from the 1. surf
	   if kdir1 is set and from 2. surf if only kdir2 is set. */
	
	/* UJK, January 1993, if exact curve mark it with type 9. */
	kdir1 = kdir2 = -1;
	if (exact_treat &&
	    kj == 2 &&
	    (qpfirst->curve_dir[(*vlist)->ind_first] & log_test))
	{
	   /* Constant parameter curve */
	   for (kdir = 0; kdir < qpfirst->ipar; kdir++)
	      if (qpfirst->curve_dir[(*vlist)->ind_first] &
		  (1 << (kdir + 1)))
	      {
		 exact = TRUE;
		 ktype = 9;
		 if (kdir >= po1->iobj) kdir2 = kdir;
		 else                   kdir1 = kdir;
	      }
	}
	
	if (kdir1>-1) kdir = kdir1;
	else          kdir = kdir2;
	
	/* Create new intersection curve.  */
	*ucrv = newIntcurve (kj, ipar1, ipar2, spar1, spar2, ktype);
	if (*ucrv == SISL_NULL)
	   goto err101;
	
	/* Copy pretopology */
	memcopy((*ucrv)->pretop,(*vlist)->pretop,4,int);
	
	
	/* UJK, January 1993, if exact curve mark it with type 9. */
	if (exact)
	{
	   
	   pick_crv_sf (po1, qo2, kdir, qpfirst, 
			qplast, &(*ucrv)->pgeom, &kstat);
	   if (kstat < 0)
	      goto error;
	   
	   /* UJK, Pick 2D line  */
	   
	   if (kdir2 >= po1->iobj)
	   {
	      s1602(&(qpfirst->epar[po1->iobj]),
		    &(qplast->epar[po1->iobj]),
		    2,
		    2,
		    (*ucrv)->pgeom->et[(*ucrv)->pgeom->ik - 1],
		    &dummy,
		    &(*ucrv)->ppar2,
		    &kstat);
	      if (kstat < 0) goto error;
	   }
	   
	   if (kdir1 >= 0)
	   {
	      s1602(qpfirst->epar,
		    qplast->epar,
		    2,
		    2,
		    (*ucrv)->pgeom->et[(*ucrv)->pgeom->ik - 1],
		    &dummy,
		    &(*ucrv)->ppar1,
		    &kstat);
	      
	      if (kstat < 0) goto error;
	   }
	   
	}
	
	
	ucrv++;
	(*jcrv)++;
     }
     vlist++;
  }

  /* Find number of single intersection points.  */

  kpt = jpt - kpt;
  if (kpt < 0) goto err137;

  /* Create arrays to keep parameter values of intersection points.  */

  *gpar1 = newarray (ipar1 * kpt, double);
  *gpar2 = newarray (ipar2 * kpt, double);
  *pretop = newarray (4 * kpt, int);
  if ((ipar1 * kpt > 0 && *gpar1 == SISL_NULL)
      || (ipar2 * kpt > 0 && *gpar2 == SISL_NULL)
      || (4 * kpt > 0 && *pretop == SISL_NULL))
    goto err101;

  /* Copy parameters of single intersection points into output-arrays. */

  kj = 0;
  stpar1 = *gpar1;
  stpar2 = *gpar2;
  top1 = *pretop;
  for (ki = 0; ki < jpt; ki++)
    {
      qpt = *vpoint;
      if (qpt != SISL_NULL)
	{
	  if (sh6ismain(qpt) && qpt->marker != -99)
	    {
	      kj++;
	      stpar3 = qpt->epar;
	      for (kk = 0; kk < ipar1; kk++)
		*(stpar1++) = *(stpar3++);
	      for (kk = 0; kk < ipar2; kk++)
		*(stpar2++) = *(stpar3++);
              *(top1++) = qpt->left_obj_1[0];
              *(top1++) = qpt->right_obj_1[0];
              *(top1++) = qpt->left_obj_2[0];
              *(top1++) = qpt->right_obj_2[0];
	    }
	}

      vpoint++;
    }

  *jpar = kj;

  /* Adjust output arrays to correct length.  */

  if ((*jcrv) < jlist)
  {
     if ((*jcrv) > 0)
     {
        if (((*wcrv) = increasearray (*wcrv, *jcrv, SISLIntcurve *)) == SISL_NULL)
           goto err101;
     }
     else
     {
        if (*wcrv != SISL_NULL)
	freearray (*wcrv);
        *wcrv = SISL_NULL;
     }
  }
  if ((*jsurf) < jlist)
  {
     if ((*jsurf) > 0)
     {
        if (((*wsurf) = increasearray (*wsurf, *jsurf, SISLIntsurf *)) == SISL_NULL)
           goto err101;
     }
     else
     {
        if (*wsurf != SISL_NULL)
	freearray (*wsurf);
        *wsurf = SISL_NULL;
     }
  }
  if (kj * ipar1 > 0)
    {
      if ((*gpar1 = increasearray (*gpar1, kj * ipar1, double)) == SISL_NULL)
	goto err101;
    }
  else
    {
      if (*gpar1 != SISL_NULL)
	freearray (*gpar1);
      *gpar1 = SISL_NULL;
    }
  if (kj * ipar2 > 0)
    {
      if ((*gpar2 = increasearray (*gpar2, kj * ipar2, double)) == SISL_NULL)
	goto err101;
    }
  else
    {
      if (*gpar2 != SISL_NULL)
	freearray (*gpar2);
      *gpar2 = SISL_NULL;
    }
  if (kj  > 0)
    {
      if ((*pretop= increasearray (*pretop, kj * 4, int)) == SISL_NULL)
	goto err101;
    }
  else
    {
      if (*pretop != SISL_NULL)
	freearray (*pretop);
      *pretop = SISL_NULL;
    }

  /* Intersections copied to output format.  */

  *jstat = 0;
  goto out;

  /* Error in space allocation.  */

err101:*jstat = -101;
  s6err ("hp_s1880", *jstat, kpos);
  goto out;

  /* Error in data-strucuture. Expected intersection point not found. */

err137:*jstat = -137;
  s6err ("hp_s1880", *jstat, kpos);
  goto out;

  /* Error in lower level routine. */
error:
  *jstat = kstat;
  s6err ("hp_s1880", *jstat, kpos);
  goto out;


out:
   if (po1->iobj == SISLSURFACE && ideg != 0)
      freeObject (qo2);
return;
}

//===========================================================================
void freeObject(SISLObject *pobj)
//===========================================================================
{
  int ki;

  /* Free point, curve or surface represented by pobj.                */

  if (pobj -> iobj == SISLPOINT)
    { if (pobj -> p1 != SISL_NULL) freePoint(pobj -> p1); }
  else if (pobj -> iobj == SISLCURVE)
    { if (pobj -> c1 != SISL_NULL) freeCurve(pobj -> c1); }
  else if (pobj -> iobj == SISLSURFACE)
    { if (pobj -> s1 != SISL_NULL) freeSurf(pobj -> s1);  }

  for (ki=0; ki<4; ki++)
    if (pobj->edg[ki] != SISL_NULL) freeObject(pobj->edg[ki]);

  /* Free instance of object. */

  freearray(pobj);

  return;
}

//===========================================================================
void freeIntdat(SISLIntdat *pintdat)
//===========================================================================
{
  int ki;                    /* Counter.                                     */

  if (pintdat == SISL_NULL) goto out;

  /* First free the space occupied by the Intpt's pointed at by
     the array vpoint.                                                       */

  for (ki=0; ki<pintdat->ipoint; ki++)
    if (pintdat -> vpoint[ki])   freeIntpt(pintdat -> vpoint[ki]);

  /* Free the space occupied by the vpoint array. */

  freearray(pintdat -> vpoint);

  /* Next free the space occupied by the Intlists pointed at by
     the array vlist.                                                       */

  for (ki=0; ki<pintdat->ilist; ki++)
    if    (pintdat -> vlist[ki])   freeIntlist(pintdat -> vlist[ki]);

  /* Free the space occupied by the vpoint array. */

  freearray(pintdat -> vlist);

  /* Free the space occupied by the instance. */

  freearray(pintdat);

 out:
  return;
}

//===========================================================================
void sh1992su(SISLSurf *ps,int itype,double aepsge,int *jstat)
//===========================================================================
{
   int kstat = 0;                       /* Status variable.        */
   int kdim = ps->idim;                 /* Dimension of geometry space. */
   int ktype = itype % 10;              /* Kind of box.            */
   int knum;                            /* Number of sides of box. */
   int kbez = 0;                        /* Indicates if Bezier.    */
   double teps_inner;     /* Tolerance with which to expand in the inner. */
   double teps_edge;      /* Tolerance with which to expand at the edge.  */

   /* Set correct tolerances.  */
   
   teps_inner = (ktype == 0) ? DZERO : (double)0.5*aepsge;
   teps_edge = (ktype == 2) ? -teps_inner : teps_inner;
   
   /* Set number of box sides.  */
   
   if (itype < 10 && kdim == 3) knum = 9;
   else if (itype < 10 && kdim == 2) knum = 4;
   else knum = kdim;
   
   if (ps->pbox == SISL_NULL)
      if ((ps->pbox = newbox(ps->idim)) == SISL_NULL) goto err101;
   
   if (s6existbox(ps->pbox,ktype,aepsge) < 1)
   {
      /* The box do not exist already. In the Bezier case, it
	 is not necessary to expand in the inner of the surface.  */
      
      /* Create the box.  */
      
      s6newbox(ps->pbox,knum,ktype,aepsge,&kstat);
      if (kstat < 0) goto error;
      
      if (ps->ik1 == ps->in1 && ps->ik2 == ps->in2) 
      {
	 teps_inner = DZERO;
         kbez = 1;
      }
      
      /* Make the requested box. First allocate scratch for
	 box arrays.  */
      
      if (knum == 9) 
	 sh1992_s9mbox3(ps->ecoef,ps->in1,ps->in2,teps_inner,teps_edge,
		 ps->pbox->e2max[ktype],ps->pbox->e2min[ktype]);
      else if (knum == 4)
	 sh1992_s9mbox2(ps->ecoef,ps->in1,ps->in2,teps_inner,teps_edge,
		 ps->pbox->e2max[ktype],ps->pbox->e2min[ktype]);
      else
      {
	 sh1992_s9mbox(ps->ecoef,ps->in1,ps->in2,kdim,
		teps_inner,teps_edge,ps->pbox->e2max[ktype],
		ps->pbox->e2min[ktype],&kstat);
	 if (kstat < 0) goto error;
      }
   }  
  
  *jstat = 0;
  goto out;
  
  /* Error in space allocation.  */
  
  err101 : *jstat = -101;
  goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  goto out;
  
 out:
    return;
}

//===========================================================================
void s1304(double ep[],double eq[],double eparp[],double eparq[],double egeo3d[],
	   double egeop[],double egeoq[],int *jstat)
//===========================================================================
{
  int kdim = 3;           /* Dimension of 3-D space                      */
  int k2dim = 2;          /* Dimension of the parameter planes           */
  int kstat = 0;          /* Local status variable                       */
  int ki;                 /* Control variable in loop                    */
  double snpu[3];         /* Nomalized version of epu                    */
  double snpv[3];         /* Nomalized version of epv                    */
  double spn[3];          /* Vector snpu x snpv                          */
  double snqs[3];         /* Nomalized version of eqs                    */
  double snqt[3];         /* Nomalized version of eqt                    */
  double sqn[3];          /* Vector snqs x snqt                          */
  double sright[3];       /* Right hand side when finding s"             */
  double sdc[3];          /* Derivative of intersection curve by w       */
  double sddc[3];         /* Second Derivative of intersection curve by w*/
  double *sqs;            /* Pointer to first row of matrix              */
  double *sqt;            /* Pointer to second row of matrix             */
  double *spu;            /* Pointer to third row of matrix              */
  double *spw;            /* Pointer to fourth row of matrix             */
  double *spuu;           /* Pointer to renamed (2,0)-derivative         */
  double *spuw;           /* Pointer to renamed (1,1)-derivative         */
  double *spww;           /* Pointer to renamed (0,2)-derivative         */
  double *sqss;           /* Pointer to renamed (2,0)-derivative         */
  double *sqst;           /* Pointer to renamed (1,1)-derivative         */
  double *sqtt;           /* Pointer to renamed (0,2)-derivative         */
  double tt;              /* Value of det(snpu,snpv,snqs)                */
  double ts;              /* Value of det(snpu,snpv,snqt)                */
  double tv;              /* Value of det(snqs,snqt,snpu)                */
  double tu;              /* Value of det(snqs,snqt,snpv)                */
  double tlpu;            /* Length of epu                               */
  double tlpv;            /* Length of epv                               */
  double tlqs;            /* Length of eqs                               */
  double tlqt;            /* Length of eqt                               */
  double tmax1;           /* Variable used for maximal value             */
  double tmax2;           /* Variable used for maximal value             */
  double tdum;            /* Dummy variable                              */
  double tdom;            /* The denominator in an equation              */
  double tds;             /* ds/dw                                       */
  double tdt;             /* dt/dw                                       */
  double tdu;             /* du/dw                                       */
  double tddu;            /* ddu/dwdw                                    */
  double tdds;            /* dds/dwdw                                    */
  double tddt;            /* ddt/dwdw                                    */
  double twds;            /* ds/dw after renaming variable second time   */
  double twdt;            /* dt/dw after renaming variable second time   */
  double twdds;           /* dds/dwdw after renaming variable second time*/
  double twddt;           /* ddt/dwdw after renaming variable second time*/
  double twdu;            /* du/dw after renaming variable second time   */
  double twdv;            /* dv/dw after renaming variable second time   */
  double twddu;           /* ddu/dwdw after renaming variable second time*/
  double twddv;           /* ddv/dwdw after renaming variable second time*/
  
  
  /* Get input values into output. */
  egeoq[0] = eparq[0];
  egeoq[1] = eparq[1];
  egeop[0] = eparp[0];
  egeop[1] = eparp[1];
  
  for (ki=2;ki<7;ki++)
    {
      egeop[ki] = DZERO;
      egeoq[ki] = DZERO;
    }
  
  /* Make position of intersection */
  
  for (ki=0;ki<3;ki++)
    {
      egeo3d[ki] = (double)0.5 * (ep[ki]+eq[ki]);
    }
  
  for (ki=3;ki<10;ki++) egeo3d[ki] = DZERO;
  
  
  /* Nomalize derivative vectors */
  
  tlpu = s6norm(ep+3,kdim,snpu,&kstat);
  tlpv = s6norm(ep+6,kdim,snpv,&kstat);
  tlqs = s6norm(eq+3,kdim,snqs,&kstat);
  tlqt = s6norm(eq+6,kdim,snqt,&kstat);
  
  /* Make normal vector for both derivative pairs */
  
  s6crss(snpu,snpv,spn);
  s6crss(snqs,snqt,sqn);                                 
  
  /* Make four scalar product to decide which of the 3 vectors snpu, snpv, 
   * snqs, snqt spans the 3-D space best. (Have the biggest determinant)
   * Remember (axb)c = det(a,b,c). The naming convention is that the
   * name of the variable not present on the left hand side is used for
   * the naming of the determinants. The determinants tt, ts, tu and tv tells
   * which direction is most linearly dependent on the other directions  
   */
  
  tt = fabs(s6scpr(spn,snqs,kdim));
  ts = fabs(s6scpr(spn,snqt,kdim));
  tv = fabs(s6scpr(sqn,snpu,kdim));
  tu = fabs(s6scpr(sqn,snpv,kdim));
  
  /* We want to use the parameter direction names s, t and u on the left
   * hand side of the equation system, thus we want to express all derivatives
   * of the curve as functions of a new parameter  value w, which is chosen
   * to be the parameter direction with partial first derivative most
   * lineary dependent of the other parameter directions 
   */
  
  tmax1 = MAX(tt,ts);
  tmax2 = MAX(tv,tu);
  
  if (tmax1 > tmax2)
    {
      
      /*  The s or t variable should not be used on the left hand side of
       *  the equation system                                                
       */
      
      if (ts>tt) 
        {
	  
	  /*  The s variable should not be used on the left hand side of the 
	   *  equation system
	   *  The renaming of variables is as follows s->w, t->u, u->s, v->t 
	   */
	  
	  spu  = eq+6;
	  spw  = eq+3;
	  spuu = eq+15;
	  spuw = eq+12;
	  spww = eq+9;
	  sqs  = ep+3;
	  sqt  = ep+6;
	  sqss = ep+9;
	  sqst = ep+12;
	  sqtt = ep+15;
        }
      else
        {
	  
	  /* The t variable should not be used on the left hand side of the 
	   * equation system
	   *  The renaming of variables is as follows s->u, t->w, u->s, v->t 
	   */
	  
	  spu  = eq+3;
	  spw  = eq+6;
	  spuu = eq+9;
	  spuw = eq+12;
	  spww = eq+15;
	  sqs  = ep+3;
	  sqt  = ep+6;
	  sqss = ep+9;
	  sqst = ep+12;
	  sqtt = ep+15;
        }
    }
  else
    {
      
      /* The u or v variable should not be used on the left hand side of
       * the equation system                                                
       */
      
      if (tu>tv)
	
        {
	  
	  /* The u variable should not be used on the left hand side of the
	   * equation system.
	   * The renaming of variables is as follows s->s, t->t, u->w, v->u
	   */
	  
	  spu  = ep+6;
	  spw  = ep+3;
	  spuu = ep+15;
	  spuw = ep+12;
	  spww = ep+9;
	  sqs  = eq+3;
	  sqt  = eq+6;
	  sqss = eq+9;
	  sqst = eq+12;
	  sqtt = eq+15;
	  
        }
      
      else
	
        {
	  /* The v variable should not be used on the left hand side of the
	   * equation system.
	   * The renaming of variables is as follows s->s, t->t, u->u, v->w 
	   */
	  
	  spu  = ep+3;
	  spw  = ep+6;
	  spuu = ep+9;
	  spuw = ep+12;
	  spww = ep+15;
	  sqs  = eq+3;
	  sqt  = eq+6;
	  sqss = eq+9;
	  sqst = eq+12;
	  sqtt = eq+15;
	  
        }
    }
  
  /* Now we can solve the equation systems for finding
   *  ds/dw, dt/dw and du/dw and afterwards for
   *  dds/(dwdw), ddt/(dwdw) and ddu/(dwdw), using Cramers Rule.
   *
   *  This equation system is derived in the following way:
   *  Our problem is defined as P(u,w) - Q(s,t) = 0. By taking the derivative
   *  of this equation with repsect to w, we get:
   *
   *  dP(u,w) du   dP(u,w)   dQ(s,t) ds   dQ(s,t) dt
   *  ------- -- + ------- - ------- -- - ------- -- = 0
   *  du      dw   dw        ds      dw   dt      dw    
   *
   *  By using a simplified notation this can be written:
   *
   *  P u' + P  - Q s' - Q t' = 0
   *   u      w    s      t
   *
   *  We can thus set up the equation system:
   *
   *              s'
   *  (Q  Q -P ) (t') = P
   *    s t   u   u'     w
   * 
   *
   *
   *  By making one futher derivative we get an equation systen for s",t" and
   *  u".
   *
   *               s"         2                       2                   2
   *  (Q  Q  -P ) (t") = P  u'  + 2P  u' + P   - Q  s'  - 2Q  s't' - Q  t' 
   *    s  t   u   u"     uu        uw      ww    ss        st        tt
   *
   *
   */
  
  /* Prepare normal vectors for determinants */
  
  s6crss(spu,spw,spn);
  s6crss(sqs,sqt,sqn);
  
  tdom =  -s6scpr(sqn,spu,kdim);
  
  if (DEQUAL(tdom,(double)0.0)) goto war101;
  
  /*  Lineary dependent vectors on left hand side if tdom = 0.0 */
  
  tds = -s6scpr(spn,sqt,kdim)/tdom;
  tdt =  s6scpr(spn,sqs,kdim)/tdom;
  tdu =  s6scpr(sqn,spw,kdim)/tdom;
  
  for (ki=0;ki<3;ki++)
    {
      sright[ki] = (spuu[ki]*tdu + (double)2.0*spuw[ki])*tdu + spww[ki]
	           - (sqss[ki]*tds + sqst[ki]*tdt)*tds
	           - (sqtt[ki]*tdt + sqst[ki]*tds)*tdt;
    }
  
  /* Calculate second derivatives of parameter direction with respect to
   * the w-direction 
   */
  
  tddu = s6scpr(sqn,sright,kdim)/tdom;
  
  /* Use sqn for temporary storage of cross products */
  
  s6crss(sright,sqt,sqn);
  tdds = -s6scpr(sqn,spu,kdim)/tdom;
  s6crss(sqs,sright,sqn);
  tddt = -s6scpr(sqn,spu,kdim)/tdom;
  
  /* We will now express the intersection curve locally as a function
   *  of the w-parameter.
   *
   *  c(w) = p(u(w),w)
   *
   *  This gives the derivative
   *                         
   *   
   *  c' = P u' + P                                                   
   *        u      w
   *
   *  And the second derivative
   *
   *            2
   *  c" = P  u'  + 2P  u' + P   + P u"
   *        uu        uw      ww    u
   *
   *  The curvature vector is defined as the derivative of the unit tangent
   *  vector with respect to the arc length a(w):
   *
   *         d         d    c'(w)    dw   d    c'(w)      da
   *  k(a) = -- T(a) = -- ---------- -- = -- ---------- / --
   *         da        dw sqrt(c'c') da   dw sqrt(c'c')   dw
   *
   *
   *         d       c'(w)                c"        c' (c'c'')
   *         -- ----------------- =   ---------- - ------------- 
   *         dw sqrt(c'(w) c'(w))     sqrt(c'c')   sqrt(c'c')**3
   *
   *
   *
   *         da
   *         -- = sqrt(c'c')
   *         dw 
   */
  for (ki=0;ki<3;ki++)
    {
      sdc[ki] = spu[ki]*tdu + spw[ki];                
      sddc[ki] = (spuu[ki]*tdu+(double)2.0*spuw[ki])*tdu +
	spu[ki]*tddu + spww[ki];
    }
  
  /* To simplify futher calculations we want to normalize the tangent vector
   *  and correspondingly divide the second derivative by the tangent length
   */
  
  tlpu = s6norm(sdc,kdim,egeo3d+3,&kstat);
  
  if (DEQUAL(tlpu,(double)0.0)) goto war101;
  
  for (ki=0;ki<3;ki++)
    {
      sddc[ki] = sddc[ki]/tlpu;
    }
  
  /* Make curvature vector */
  
  tdum = s6scpr(sddc,egeo3d+3,kdim);
  for (ki=0;ki<3;ki++)
    {
      egeo3d[ki+6] = (sddc[ki] - egeo3d[ki+3]*tdum)/tlpu;
    }
  
  /* TO CALCULATE UNIT TANGENT CURVATURE AND RADIUS OF CURVATURE OF THE
   * INTERSECTION POINT IN THE PARAMETER PLANES OF THE TWO SURFACES, WE
   * NOW WANT TO CALCULATE THE TRUE VALUES OF ds/dw, dt/dw, dds/dw,
   * ddt/dwdw, du/dw, dv/dw, ddu/dwdw, ddv/dwdw, where w is the parameter
   * direction we have chosen the other directions to be expressed in.
   * THUS UNDO the changing of parameter directions 
   */
  
  if (tmax1 > tmax2)
    {
      
      /* First and second row of the surface were originally interchanged
       * Thus change sequence of these back again 
       */ 
      
      if (ts>tt) 
        {
	  /* We used the following renaming of variables:
	   * s->w, t->u, u->s, v->t, now express the behavior in the parameter
	   * plane with the original ordering 
	   */
	  
	  twds  = (double)1.0;
	  twdt  = tdu;
	  twdds = (double)0.0;
	  twddt = tddu;
	  twdu  = tds;
	  twdv  = tdt;
	  twddu = tdds;
	  twddv = tddt;
	  
        }
      else
        {
	  
	  /* We used the following renaming of variables:
	   * s->u, t->w, u->s, v->t, now express the behavior in the parameter
	   * plane with the original ordering 
	   */
	  
	  /* The renaming of variables is as follows s->v, t->u, u->s, v->t */
	  
	  twds  = tdu;
	  twdt  = (double)1.0;
	  twdds = tddu;
	  twddt = (double)0.0;
	  twdu  = tds;
	  twdv  = tdt;
	  twddu = tdds;
	  twddv = tddt;
	  
        }
    }
  else
    {
      
      /*  Keep the sequence of surfaces */
      
      if (tu>tv)
	
        {
	  
	  /* We used the following renaming of variables:
	   * s->s, t->t, u->w, v->u, now express the behavior in the parameter
	   * plane with the original ordering 
	   */
	  
	  twds  = tds;
	  twdt  = tdt;
	  twdds = tdds;
	  twddt = tddt;
	  twdu  = (double)1.0;
	  twdv  = tdu;
	  twddu = (double)0.0;
	  twddv = tddu;
	  
        }                  
      
      else
	
        {
	  
	  /* We used the following renaming of variables:
	   * s->s, t->t, u->u, v->w, now express the behavior in the parameter
	   * plane with the original ordering */
	  
	  twds  = tds;
	  twdt  = tdt;
	  twdds = tdds;
	  twddt = tddt;
	  twdu  = tdu;
	  twdv  = (double)1.0;
	  twddu = tddu;
	  twddv = (double)0.0;
	  
        }
    }
  
  /* Now the variable twds, twdt, twdu, twdv contains derivatives of the
   * parameter directions with respect to the w-variable. Correspondingly
   * the second derivatives with respect to w are contained in twdds, twddt,
   * twddu and twddv.
   *
   * THE UNIT TANGENT, CURVATURE VECTOR AND RADIUS OF CURVATURE CAN NOW
   * BE CALCULATED IN BOTH PARAMETER PLANES                                
   */
  
  /* Make description of intersection curve in 
   * parameter plane of first patch
   */
  
  
  tdum = sqrt(twdu*twdu + twdv*twdv);
  if (DEQUAL(tdum,(double)0.0))
    {
      egeop[2] = (double)0.0;
      egeop[3] = (double)0.0;
      egeop[4] = (double)0.0;
      egeop[5] = (double)0.0;
      egeop[6] = (double)0.0;
    }
  else
    {
      
      /* Make unit tangent        */
      
      egeop[2] = twdu/tdum;
      egeop[3] = twdv/tdum;
      
      /* Make curvature vector    */
      
      tdom = egeop[2]*twddu + egeop[3]*twddv;
      egeop[4] = (twddu/tdum - egeop[2]*tdom/tdum)/tdum;
      egeop[5] = (twddv/tdum - egeop[3]*tdom/tdum)/tdum;
    }
  
  /* Make radius of curvature in parameter plane 1 */
  
  tdum = s6length(egeop+4,k2dim,&kstat);
  if (DNEQUAL(tdum,(double)0.0))
    {
      egeop[6] = (double)1.0/tdum;
    }
  else
    {
      egeop[6] = (double)-1.0;
    }
  
  /* Make description of intersection curve in parameter 
   * plane of second patch
   */
  tdum = sqrt(twds*twds + twdt*twdt);
  if (DEQUAL(tdum,(double)0.0))
    {
      egeoq[2] = (double)0.0;
      egeoq[3] = (double)0.0;
      egeoq[4] = (double)0.0;
      egeoq[5] = (double)0.0;
      egeoq[6] = (double)0.0;
    }
  else
    {
      
      /* Make unit tangent  */
      
      egeoq[2] = twds/tdum;
      egeoq[3] = twdt/tdum;
      
      /* Make curvature vector */
      
      tdom     = egeoq[2]*twdds + egeoq[3]*twddt;
      egeoq[4] = (twdds/tdum - egeoq[2]*tdom/tdum)/tdum;
      egeoq[5] = (twddt/tdum - egeoq[3]*tdom/tdum)/tdum;
    }
  
  /* Make radius of curvature in parameter plane 2 */
  
  tdum = s6length(egeoq+4,k2dim,&kstat);
  if (DNEQUAL(tdum,(double)0.0))
    {
      egeoq[6] = (double)1.0/tdum;
    }
  else
    {
      egeoq[6] = (double)-1.0;
    }
  
  /* Make 3-D radius of curvature */
  
  tdum = s6length(egeo3d+6,kdim,&kstat);
  
  if (DNEQUAL(tdum,(double)0.0))
    {
      egeo3d[9] = (double)1.0/tdum;
    }
  else
    {
      egeo3d[9] = (double)-1.0;
      goto war101;
    }
  
  
  *jstat = 0;
  goto out;
  
  /* Infinit radius of curvature */
  
 war101: *jstat=1;
  goto out;
  
 out:
  return;
}

//===========================================================================
void s9iterate(double epoint[],double epnt1[],double epnt2[],double epar1[],
	       double epar2[],SISLSurf *psurf1,SISLSurf *psurf2,double astep,
	       double aepsge,double gpnt1[],double gpnt2[],double gpar1[],
	       double gpar2[],int *jstat)
//===========================================================================
{
  int ki;                 /* Variable used in loop                          */
  int kcont;              /* Indicator telling if iteration is not finished */
  int kder = 2;           /* Derivative indicator                           */
  int klfu=0;             /* Pointer into knot vector                       */
  int klfv=0;             /* Pointer into knot vector                       */
  int klfs=0;             /* Pointer into knot vector                       */
  int klft=0;             /* Pointer into knot vector                       */
  int kstat;              /* Status variable                                */
  int knbit;              /* Counter for number of iterations               */
  int kdim = 3;           /* Set dimension to 3                             */
  int kmaxit = 100;       /* Maximal number of iterations allowed           */
  int kpos=1;             /* Position indicator ofr errors                  */
  double spoint[3];       /* SISLPoint in intersection plane                    */
  double *snorm;          /* Pointer to normal vector of intersection plane */
  double *sp,*spu,*spv,*spn; /* Pointers into gpnt1                         */
  double *sq,*sqs,*sqt,*sqn; /* Pointers into gpnt2                         */
  double ta11,ta12,ta21;  /* Variables used in equation systems             */
  double ta22,tb1,tb2;    /* Variables used in equation systems             */
  double sdiff[3];        /* Difference between two vectors                 */
  double tdum1,tdum2;     /* Dummy variables                                */
  double tdum3,tdum;      /* Dummy variables                                */
  double tdist;           /* Distance betweentwo points in iteration        */
  
  
  
  /* Make description of intersection plane */
  
  for (ki=0;ki<3;ki++)
    {
      spoint[ki] = epoint[ki] + astep*epoint[ki+3];
    }
  
  snorm = epoint + 3;
  
  /* Copy input variables to output variables */
  
  memcopy(gpnt1,epnt1,21,DOUBLE); 
  memcopy(gpnt2,epnt2,21,DOUBLE);
  memcopy(gpar1,epar1,2,DOUBLE); 
  memcopy(gpar2,epar2,2,DOUBLE);
  
  /* At the start of the iteration the two point gpnt1 and gpnt2 might be
     very close since we in most cases start from a point on the intersection
     curve. */
  
  /* Set a number of local pointers that ar used often */
  sp  = gpnt1;
  spu = gpnt1 + 3;
  spv = gpnt1 + 6;
  spn = gpnt1 + 18;
  sq  = gpnt2;
  sqs = gpnt2 + 3;
  sqt = gpnt2 + 6;
  sqn = gpnt2 + 18;
  
  kcont = 1;
  knbit = 0;
  
  while (kcont)
    
    {
      
      /* Put a parametric representation of the tangent 
	 plane of surface 1 into
	 the implicit representation of the tangent 
	 plane of surface 2 and also
	 into the implicit representation of 
	 the intersection plane */
      
      ta11 = s6scpr(spu,sqn,kdim);
      ta12 = s6scpr(spv,sqn,kdim);
      ta21 = s6scpr(spu,snorm,kdim);
      ta22 = s6scpr(spv,snorm,kdim);
      
      s6diff(sq,sp,kdim,sdiff);
      tb1  = s6scpr(sdiff,sqn,kdim);
      
      tdum = MAX(fabs(ta11),fabs(ta12));
      tdum = MAX(tdum,fabs(tb1));
      if (tdum == DZERO) tdum = (double)1.0;
      ta11 /= tdum;
      ta12 /= tdum;
      tb1  /= tdum;
      
      s6diff(spoint,sp,kdim,sdiff);
      tb2  = s6scpr(sdiff,snorm,kdim);
      
      tdum = MAX(fabs(ta21),fabs(ta22));
      tdum = MAX(tdum,fabs(tb2));
      if (tdum == DZERO) tdum = (double)1.0;
      ta21 /= tdum;
      ta22 /= tdum;
      tb2  /= tdum;
      
      /* Calculate determinant of equation system */
      
      tdum1 = ta11*ta22 - ta12*ta21;
      tdum  = MAX(fabs(ta11),fabs(ta22));
      tdum  = MAX(fabs(ta12),tdum);
      tdum  = MAX(fabs(ta21),tdum);
      
      if (DEQUAL((tdum+tdum1),tdum)) tdum1 =DZERO;
      
      
      /* If tdum1 = 0.0, then the equation system is singular, 
	 iteration not possible */

      if (DNEQUAL(tdum1,DZERO))
        {
	  gpar1[0] += (tb1*ta22-tb2*ta12)/tdum1;
	  gpar1[1] += (ta11*tb2-ta21*tb1)/tdum1;
        }
      
      /* Put a parametric representation of the 
	 tangent plane of surface 2 into
	 the implicit representation of the 
	 tangent plane of surface 1 and also
	 into the implicit representation 
	 of the intersection plane */
      
      ta11 = s6scpr(sqs,spn,kdim);
      ta12 = s6scpr(sqt,spn,kdim);
      ta21 = s6scpr(sqs,snorm,kdim);
      ta22 = s6scpr(sqt,snorm,kdim);
      
      s6diff(sp,sq,kdim,sdiff);
      tb1  = s6scpr(sdiff,spn,kdim);
      
      s6diff(spoint,sq,kdim,sdiff);
      tb2  = s6scpr(sdiff,snorm,kdim);
      
      /*Calculate determinant of equation system */

      tdum2 = ta11*ta22 - ta12*ta21;
      
      tdum2 = ta11*ta22 - ta12*ta21;
      tdum  = MAX(fabs(ta11),fabs(ta22));
      tdum  = MAX(fabs(ta12),tdum);
      tdum  = MAX(fabs(ta21),tdum);
      
      if (DEQUAL((tdum+tdum2),tdum)) tdum2 =DZERO;
      
      /* If tdum2 = 0.0, then the equation system is singular, 
	 iteration not possible */

      if (DNEQUAL(tdum2,DZERO))
        {
	  gpar2[0] += (tb1*ta22-tb2*ta12)/tdum2;
	  gpar2[1] += (ta11*tb2-ta21*tb1)/tdum2;
        }
      
      /* Calculate values of new points */
      
      s1421(psurf1,kder,gpar1,&klfu,&klfv,gpnt1,gpnt1+18,&kstat); 
      if (kstat<0) goto error;
      
      /* If the surface normal has zero length no use in continuing */
      
      if (kstat == 2) goto war02;
      
      s1421(psurf2,kder,gpar2,&klfs,&klft,gpnt2,gpnt2+18,&kstat); 
      if (kstat<0) goto error;
      
      /* If the surface normal has zero length no use in continuing */
      
      if (kstat == 2) goto war02;
      
      /* Make difference between the two points, 
	 and calculate length of difference */
      s6diff(gpnt1,gpnt2,kdim,sdiff);
      tdum3 = s6length(sdiff,kdim,&kstat);
      if (kstat==0) 
        {
	  /* Length is zero iteration has converged */

	  kcont = 0;
        }
      
      if (knbit==0)
        {
	  /* First iteration intitate distance variable, if the equation
	     systems were not singular */

	  if (DEQUAL(tdum1,DZERO) || DEQUAL(tdum2,DZERO)) goto war02;
	  tdist = tdum3;
	  knbit = 1;
        }
      else
        {
	  /* More than one iteration done, stop if distance is not decreasing.
	     Then decide if we converge distance between the points is within
	     the tolerance and the last step had singular or none singular
	     equation systems. */

	  knbit = knbit + 1;
	  if (tdum3>=tdist)
            {
	      /* Distance is not decreasing */
	      if (tdist <= aepsge)
                {
		  /* Distance within tolerance */
		  if (DEQUAL(tdum1,DZERO) || DEQUAL(tdum2,DZERO))
                    {
		      /* Singular equation system */
		      goto war01;
                    }
		  else
                    {
		      /* Nonsingular equation system */
		      goto war00;
                    }
                }
	      else
                {
		  /* Distance is not within tolerance, divergence */
		  goto war02;
                }
            }
	  /*      Distance still decreasing */
	  
	  tdist = tdum3;
        }
      
      /*  Make sure that not to many iteration are being done */
      if (knbit > kmaxit) goto war02;
    }
  
  
  /* Iteration converged */
 war00:
  
  *jstat = 0;
  goto out;
  
  /* Iteration converged, singular point found */
 war01: 
  *jstat = 1;
  goto out;
  
  /* To many iterations or iteration diverging */
 war02: 
  *jstat = 2;
  goto out;
  
  /* Error in lower level routine.  */
  
  error : 
    *jstat = kstat;
  s6err("s9iterate",*jstat,kpos);
  goto out;
  
 out:
  return;
}

//===========================================================================
double s6dist(double epoint1[],double epoint2[],int idim)
//===========================================================================
{
  register double *s1,*s2,*s3; /* Pointers used to travers epoint1 and epoint2
				  arrays.                                      */
  register double tdist=DZERO; /* Distance between the points.                 */
  
  for (s1=epoint1,s2=epoint2,s3=epoint1+idim; s1<s3; s1++,s2++)
    tdist += (*s1 - *s2)*(*s1 - *s2);
  
  return(sqrt(tdist));
}

//===========================================================================
double s1311(double arad,double aepsge,double amax,int *jstat)
//===========================================================================
{
  int    kpos=1;            /* Position of error                 */
  double tstep;             /* Preliminary value for step length */
  double t1sixth;           /* The value of 1/6                  */
  double talfa;             /* Angle                             */

  if (amax < DZERO) goto err177;

  if (aepsge < DZERO) goto err120;

  if (arad > DZERO)
    {
      t1sixth = (double)1.0/(double)6.0;
      /*  Estimat the opening angle of the segments based on the error
       *   formula. */
      talfa = PI*pow(aepsge/arad,t1sixth)/((double)0.4879);

      /*  Estimate step length equal to curve length of this circular arc,
       *   We limit the step length to half the radius of curvature  */

      tstep = MIN(fabs(talfa*arad),fabs(arad/(double)2.0));
    }
  else if (DEQUAL(arad,DZERO))
    {
      /*  Radius of curvature is zero */
      tstep = (double)100.0*aepsge;
    }

  else
    {
      /*  Infinit radius of curvatur  */
      tstep = amax;
    }

  if ( amax > DZERO && amax < tstep )
    tstep = MAX(amax,aepsge);

  tstep = MAX(tstep,aepsge);

  *jstat = 0;
  goto out;

/* Negative tolerance */

err120: *jstat = -120;
        s6err("s1311",*jstat,kpos);
goto out;

/* Maximal step length zero are less than geometry tolerance */

err177: *jstat = -177;
        s6err("s1311",*jstat,kpos);
goto out;

out:
return(tstep);
}

//===========================================================================
double s9adstep(double epnt1[],double epar1[],double epnt2[],double epar2[],
		double egd1[],double epgd1[],double egd2[],double epgd2[],
		double etang[],double eptan1[],double eptan2[],double astep,int *jstat)
//===========================================================================
{
  int kstat;               /* Dummy status variable                   */
  int kdim=3;              /* This routine is only working in 3-D     */
  int k2dim=2;             /* Dimension of parameter plane            */
  double tdum;             /* Variable for storage of reals           */
  double tdist=DZERO;      /* Distance between guide point and point  */
  double sdiff[3];         /* Vector for difference between two points*/
  double scr1[3],scr2[3];  /* Normal vectors                          */
  
  
  
  /* First see that we are not turning direction in the parameter plane 1
   */
  
  s6diff(epgd1,epar1,k2dim,sdiff);
  if (s6scpr(sdiff,eptan1,k2dim) <= DZERO) goto dontstepthrough;
  
  /* Then see that we are not turning direction in the parameter plane 2
   */
  
  s6diff(epgd2,epar2,k2dim,sdiff);
  if (s6scpr(sdiff,eptan2,k2dim) <= DZERO) goto dontstepthrough;
  
  
  s6diff(egd1,epnt1,kdim,sdiff);
  tdum  = s6scpr(sdiff,etang,kdim);
  tdist = s6length(sdiff,kdim,&kstat);
  *jstat = 0;
  if (tdum > DZERO)
    {
      
      /* Step onto point if it is within 2.0*astep */
      
      if (DZERO < tdist && tdist <= (double)2.0*astep)
        {
	  /* Guide point lies within step length and in step direction, test
	     if cross products of normal vectors at current point and guide point
	     point in the same direction */
	  
	  /* Make cross product of normals in start point */
	  s6crss(epnt1+18,epnt2+18,scr1);
	  
	  /* Make cross product of normals in guide point */
	  s6crss(egd1+18,egd2+18,scr2);
	  
	  /* Make scalar product of these two vectors     */
	  tdum = s6scpr(scr1,scr2,kdim);
	  
	  /* If positive scalar product the curve at the two points point in
	     the same direction, step through point */
	  if (tdum > DZERO) goto stepthrough;
	  else if (tdum == DZERO)
            {
	      
	      double tl1,tl2;
	      
	      /* Vectors orthogonal or at least one has length zero */
	      
	      tl1 = s6length(scr1,kdim,&kstat);
	      tl2 = s6length(scr2,kdim,&kstat);
	      
	      if (tl1 != DZERO && tl2 != DZERO)
		goto dontstepthrough;
	      else if (tl1 == DZERO && tl2 == DZERO)
		goto stepthrough;
	      else if (tl2 == DZERO)
		goto stepthrough;
	      else if (tl2 != DZERO)
		{
		  /* Test if scr2 points in the direction from start */
		  
		  tl1 = s6scpr(sdiff,scr2,kdim);
		  
		  if (tl1 < DZERO)
		    goto dontstepthrough;
		  else 
		    goto stepthrough;
		}
            }
        }
    }
  
 dontstepthrough:
  
  *jstat = 0;
  goto out;
  
 stepthrough:
  *jstat = 1;
  goto out;
  
 out:
  return(tdist);
}

//===========================================================================
void s1361(double epnt1[],double epnt2[],int idim,
	   double gmidd[],double gmtang[],int *jstat)
//===========================================================================
{
  double tang1,tang2;    /* Tangent lengths */
  double tscal1,tscal2;  /* The cosine of an angle         */
  double ta1,ta2;        /* An angle                       */
  double tlength;        /* The length of a vector         */
  double tdiff;          /* Difference between two numbers */
  double tdist;          /* Distance between points        */
  double tv2,tv3;        /* Vertex compnents               */
  int    ki;             /* Variable in loop               */
  int    kstat;          /* Local status variable          */
  
  /* Find angle between tangents of epnt1 and epnt2, we assume that
     the tangents are normalized */
  
  tscal1  = s6scpr(epnt1+idim,epnt2+idim,idim);
  
  if (tscal1 >= DZERO)
    tscal1  = MIN((double)1.0,tscal1);
  else
    tscal1  = MAX((double)-1.0,tscal1);
  
  ta1 = acos(tscal1);
  
  if (fabs(ta1) < ANGULAR_TOLERANCE) ta1 = DZERO;
  
  
  /* Make distance between epnt1 and epnt2 */
  
  tdist = s6dist(epnt1,epnt2,idim);
  
  /* Make tangent lengths for start and end points */
  
  if (DNEQUAL(ta1,DZERO))
    {
      /*  Make tangents based on radius of curvature */
      
      tang1 = s1325(epnt1[3*idim],ta1);
      tang2 = s1325(epnt2[3*idim],ta1);
    }
  
  /* Make sure that the tangent does not explode due to numeric errors, and
     make a controlled tangent when the radius is zero or almost zero  */
  
  /* UJK, October 90, must include the case negative curvature */
  if (DEQUAL(ta1,DZERO) || tang1 > tdist || epnt1[3*idim] <= DZERO)
    tang1 = tdist/(double)3.0;
  if (DEQUAL(ta1,DZERO) || tang2 > tdist || epnt2[3*idim] <= DZERO) 
    tang2 = tdist/(double)3.0;
  
  
  /* We now know the Bezier polygon of the Hermit curve. Make angles
     between line 1 and 2 and between line 2 and 3. Make length of line 3
     */
  
  tscal1 = DZERO;
  tscal2 = DZERO;
  tlength = DZERO;
  
  for (ki=0;ki<idim;ki++)
    {
      /*  Make difference between second and third vertex, and accumulte
	  scalar products between polygon lines */
      tv2 = epnt1[ki] + tang1*epnt1[ki+idim]; 
      tv3 = epnt2[ki] - tang2*epnt2[ki+idim];
      tdiff = tv3 - tv2 ;
      tlength += tdiff*tdiff;
      tscal1  += tdiff*epnt1[ki+idim]; 
      tscal2  += tdiff*epnt2[ki+idim];
      
      /*  Make midpoint and tangent at midpoint */
      
      gmidd[ki]  = (epnt1[ki] + (double)3.0*(tv2+tv3) + epnt2[ki])/(double)8.0;
      gmtang[ki] = (epnt2[ki] + tv3 - tv2 - epnt1[ki])/(double)8.0;
      
    }                                                      
  tlength = sqrt(tlength);
  if (DEQUAL(tlength,DZERO)) tlength = (double)1.0;
  
  tscal1 = tscal1/tlength;
  tscal2 = tscal2/tlength;

  if (tscal1 >= DZERO)
    tscal1  = MIN((double)1.0,tscal1);
  else
    tscal1  = MAX((double)-1.0,tscal1);

  if (tscal2 >= DZERO)
    tscal2  = MIN((double)1.0,tscal2);
  else
    tscal2  = MAX((double)-1.0,tscal2);
  
  ta1    = acos(tscal1);
  ta2    = acos(tscal2);
  
  /* Normalize tangent at midpoint */
  
  (void)s6norm(gmtang,idim,gmtang,&kstat);
  
  
  /* Make total angular change of polygon */
  
  ta1 = fabs(ta1) + fabs(ta2);
  
  /* If total angular change is greater than PI/3 or the length is greater
     than 0.45 x the distance don't accept. The last condition make sure
     that the middle span in the polygon is less that what we get when
     we have a 90 circular arc. The first condition makes sure that the
     polygon direction is not oscillating too much*/
  
  if (ta1 > (double)1.0 || tlength > (double)0.45*tdist)
    *jstat = 0;
  else
    *jstat = 1;
}

//===========================================================================
double s6ang(double evec1[],double evec2[],int idim)
//===========================================================================
{
  double tscpr,tang,tlength1,tlength2,tcos;
  int    kstat1,kstat2;
  
  tscpr = s6scpr(evec1,evec2,idim);
  
  tlength1 = s6length(evec1,idim,&kstat1);
  tlength2 = s6length(evec2,idim,&kstat2);
  
  if (!kstat1 || !kstat2)
    tang = DZERO;
  else
    {
      tcos = fabs(tscpr/(tlength1*tlength2));
      tcos = MIN((double)1.0,tcos);
      tang = acos(tcos);
    }
  
  return(tang);
}

//===========================================================================
void s1330(double epar11[],double epar12[],double epar21[],double epar22[],
	   double eval11[],double eval12[],double eval21[],double eval22[],
	   int *jbound,double gpar1[],double gpar2[],int *jstat)
//===========================================================================
{
  int    kstat1,kstat2;  /* Local status variable                            */
  int    kstat;          /* Local status variable                            */
  int    kpos=0;         /* Position of error                                */
  int    kins1;          /* epar1 inside/outside SISLbox                         */
  int    kins2;          /* epar2 inside/outside SISLbox                         */
  int    kbound1;        /*Intersection indicator along boundary of surface 1*/
  int    kbound2;        /*Intersection indicator along boundary of surface 2*/
  
  double tdom;           /* Denominator of last intersection point           */
  double tfak1,tfak2;    /* Distance to straight line                        */
  double spar11[2];      /*Candidate intersection point two first coordinates*/
  double spar12[2];      /*Candidate intersection point two last coordinates */
  double spar21[2];      /*Candidate intersection point two first coordinates*/
  double spar22[2];      /*Candidate intersection point two last coordinates */
  
  *jbound = 0;
  
  /* Test if both ends are inside */
  
  kins1 = kins2 = 0; 
  
  if (eval11[0] <= epar11[0] && epar11[0] <= eval11[1] &&
      eval12[0] <= epar11[1] && epar11[1] <= eval12[1] &&
      eval21[0] <= epar12[0] && epar12[0] <= eval21[1] &&
      eval22[0] <= epar12[1] && epar12[1] <= eval22[1]) kins1 = 1;
  
  if (eval11[0] <= epar21[0] && epar21[0] <= eval11[1] &&
      eval12[0] <= epar21[1] && epar21[1] <= eval12[1] &&
      eval21[0] <= epar22[0] && epar22[0] <= eval21[1] &&
      eval22[0] <= epar22[1] && epar22[1] <= eval22[1]) kins2 = 1;
  
  
  /* Test if we step from the boundary and out */
  
  if ((eval11[0] == epar11[0] && epar21[0] < eval11[0]) ||
      (epar11[0] == eval11[1] && eval11[1] < epar21[0]) ||
      (eval12[0] == epar11[1] && epar21[1] < eval12[0]) ||
      (epar11[1] == eval12[1] && eval12[1] < epar21[1]) ||
      (eval21[0] == epar12[0] && epar22[0] < eval21[0]) ||
      (epar12[0] == eval21[1] && eval21[1] < epar22[0]) ||
      (eval22[0] == epar12[1] && epar22[1] < eval22[0]) ||
      (epar12[1] == eval22[1] && eval22[1] < epar22[1])) goto war04;
  
  if (kins1==1 && kins2==1) goto war01;
  
  /* Test if both ends are to the left, right, below or above */
  
  if ( (epar11[0]  < eval11[0] && epar21[0]  < eval11[0]) ||
      (eval11[1] < epar11[0]  && eval11[1] < epar21[0] ) ||
      (epar11[1]  < eval12[0] && epar21[1]  < eval12[0]) ||
      (eval12[1] < epar11[1]  && eval12[1] < epar21[1] ) ||
      (epar12[0]  < eval21[0] && epar22[0]  < eval21[0]) ||
      (eval21[1] < epar12[0]  && eval21[1] < epar22[0] ) ||
      (epar12[1]  < eval22[0] && epar22[1]  < eval22[0]) ||
      (eval22[1] < epar12[1]  && eval22[1] < epar22[1] )   ) goto war00;
  
  
  
  /* Check if intersection in first two dimensions */                            
  
  s1305(epar11,epar21,eval11,eval12,&kbound1,spar11,&kstat);
  
  if (kstat<0) goto error;
  kstat1 = kstat;
  if (kstat1==0) goto war00;
  
  /* Calculate two last coefficients */
  
  if (kstat1==2 || kstat1==3)
    {
      tfak1 = fabs(spar11[0]-epar11[0]) + fabs(spar11[1]-epar11[1]);
      tfak2 = fabs(epar21[0]-spar11[0]) + fabs(epar21[1]-spar11[1]);
      tdom = tfak1 + tfak2;
      if (DNEQUAL(tdom,DZERO))
        {
	  spar12[0] = (tfak2*epar12[0] + tfak1*epar22[0])/tdom;
	  spar12[1] = (tfak2*epar12[1] + tfak1*epar22[1])/tdom;
	  
	  /* If the two last coefficients are zero, then then this intersection
	     point must be discarded */
	  
	  if (spar12[0]<eval21[0] || eval21[1]<spar12[0] ||
	      spar12[1]<eval22[0] || eval22[1]<spar12[1])
            {
	      /* Intersection point outside */
	      
	      kbound1 = 0;
            }
        }
      else
        {
	  /* epar1, spar and epar2 has equal first coordinates, since there
	     is an intersection all must lie on the boundary, thus all are
	     inside */
	  
	  kbound1 = 0;
        }
    }
  else if (kstat1==4 && kins1==1)
    {
      /* On boundary and stepping out */
      goto war04;
    }
  
  /* Check if intersection in last two dimensions */
  
  s1305(epar12,epar22,eval21,eval22,&kbound2,spar22,&kstat);
  
  if (kstat<0) goto error;
  kstat2 = kstat;
  if (kstat2==0) goto war00;
  
  if (kstat1==1 && kstat2==1) goto war01;
  
  
  /* Calculate two last coefficients */
  
  if (kstat2==2 || kstat2==3)
    {
      tfak1 = fabs(spar22[0]-epar12[0]) + fabs(spar22[1]-epar12[1]);
      tfak2 = fabs(epar22[0]-spar22[0]) + fabs(epar22[1]-spar22[1]);
      tdom = tfak1 + tfak2;
      if (DNEQUAL(tdom,DZERO))
        {
	  spar21[0] = (tfak2*epar11[0] + tfak1*epar21[0])/tdom;
	  spar21[1] = (tfak2*epar11[1] + tfak1*epar21[1])/tdom;
	  
	  /* If the two last coefficients are zero, then then this intersection
	     point must be discarded */
	  
	  if (spar21[0]<eval11[0] || eval11[1]<spar21[0] ||
	      spar21[1]<eval12[0] || eval12[1]<spar21[1])
            {
	      /*          Intersection point outside */
	      
	      kbound2 = 0;
            }
        }
      else
        {
	  /* epar1, spar and epar2 has equal last coordinates, since there
	     is an intersection all must lie on the boundary, thus all are
	     inside */
	  
	  kbound2 = 0;
        }
    }
  else if (kstat2==4 && kins1==1)
    {
      /*  On boundary and stepping out */
      goto war04;
    }
  
  /* kbound1 and kbound2 tells if we have got and intersection with the
     boundary */
  
  
  /* If intersections along both boundaries then find which intersection
     is closest to epar1 */
  
  if (kbound1!=0 && kbound2!=0)
    {
/*guen      int t1,t2,t3,t4;*/ /* temporary varuiables */
/*guen changed to           */
      double t1,t2,t3,t4; /* temporary variables */

      t1 = s6dist(spar11,epar11,2);
      t2 = s6dist(spar12,epar12,2);
      t3 = s6dist(spar21,epar11,2);
      t4 = s6dist(spar22,epar12,2);
      
      if ((t1*t1+t2*t2) < (t3*t3+t4*t4) )
        kbound2 = 0;
      else
        kbound1 = 0;
    }
  
  if (kbound1==0 && kbound2 ==0)
    {
      /*  No intersection */
      goto war00;
    }
  else if (kbound1!=0 && kbound2==0)
    {
      /*  Intersection with boundary of first patch */
      memcopy(gpar1,spar11,2,DOUBLE);
      memcopy(gpar2,spar12,2,DOUBLE);
      *jbound = kbound1;
    }
  else if (kbound1==0 && kbound2!=0)
    {
      /*  Intersection with boundary of second patch */
      memcopy(gpar1,spar21,2,DOUBLE);
      memcopy(gpar2,spar22,2,DOUBLE);
      *jbound = kbound2+4;
    }
  
  if (kins1 == 1)
    {
      if (eval11[0] == epar11[0] || epar11[0] == eval11[1] ||
	  eval12[0] == epar11[1] || epar11[1] == eval12[1] ||
	  eval21[0] == epar12[0] || epar12[0] == eval21[1] ||
	  eval22[0] == epar12[1] || epar12[1] == eval22[1])
        {
	  goto war04;
	}
      else
	{
	  goto war02; 
	}
    }
  
  if (kins2 == 1) goto war03; 
  
  goto war05;
  
  /* Line outside */
  
 war00:
  *jstat = 0;
  goto out;                                                                      
  
  /* Line inside */                          
  
 war01:
  *jstat = 1;
  goto out;
  
  /* epar1 inside epar2 outside */
 war02:
  *jstat = 2;
  goto out;
  
  /* epar2 inside epar1 outside */
 war03:
  *jstat = 3;
  goto out;
  
  /* epar1 on boundary, epar2 outside */
 war04:
  *jstat = 4;
  goto out;
  
  /* Special error */
 war05:
  *jstat = 5;
  goto out;
  
  /* Error in lower leve function */
 error:
  *jstat = kstat;
  s6err("s1330",*jstat,kpos);
  goto out;
  
  
 out:
  return;
}

//===========================================================================
void s9clipit(double epar11[],double epar12[],double epar21[],double epar22[],
	      SISLSurf *psurf1,SISLSurf *psurf2,double euval[],double evval[],
	      double esval[], double etval[],double aepsge,double gpnt1[],
	      double gpnt2[], double gpar1[],double gpar2[],int *jstat)
//===========================================================================
{
  int kpos=0;                   /* Position of error                       */
  int klfu=0;                   /* Variable used as pointer in knot vector */
  int klfv=0;                   /* Variable used as pointer in knot vector */
  int klfs=0;                   /* Variable used as pointer in knot vector */
  int klft=0;                   /* Variable used as pointer in knot vector */
  int kder=2;                   /* Number of derivatives to be calculated  */
  int kstat;                    /* Local status variable                   */
  int kdir;                     /* Parameter direction of tpar             */
  int kcross;                   /* Control variable in while loop          */
  int knbit;                    /* Number of iterations                    */
  int krem;                     /* Remember status                         */
  int kbound;                   /* Numbering of boundary                   */
  double tpar;                  /* Constant parameter value                */
  double spnt1[21];             /* Coordinates of point                    */
  double spnt2[21];             /* Coordinates of point                    */
  double spar11[2],spar12[2];   /* Local parameter values                  */
  double spar21[2],spar22[2];   /* Local parameter values                  */
  double spar31[2],spar32[2];   /* Local parameter values                  */
  
  /* Make local copy of parameters */
  
  memcopy(spar11,epar11,2,DOUBLE);
  memcopy(spar12,epar12,2,DOUBLE);
  memcopy(spar21,epar21,2,DOUBLE);
  memcopy(spar22,epar22,2,DOUBLE);
  
  kcross = 1;
  knbit  = 0;
  
  while(kcross && knbit<8)
    {
      
      /* Find intersection between boundary of parameter area and patch */
      
      s1330(spar11,spar12,spar21,spar22,euval,evval,esval,etval,
	    &kbound,spar31,spar32,&kstat);
      if (kstat<0) goto error;
      
      /* Remember status so that the line can be updated properly */

      krem = kstat;
      
      if (kstat<2 || kbound == 0)
        {
	  /* No intersection */

	  kcross = 0;
        }
      else
        {
	  
	  /* Calculate start point for iteration */
	  
	  s1421(psurf1,kder,spar31,&klfu,&klfv,spnt1,spnt1+18,&kstat); 
	  if (kstat<0) goto error;
	  
	  s1421(psurf2,kder,spar32,&klfs,&klft,spnt2,spnt2+18,&kstat); 
	  if (kstat<0) goto error;
	  
	  if (kbound==1)
            {
	      kdir = 1;
	      tpar = euval[0];
            }
	  else if (kbound==2)
            {
	      kdir = 2;
	      tpar = evval[1];
            }
	  else if (kbound==3)
            {
	      kdir = 1;                                   
	      tpar = euval[1];
            }
	  else if (kbound==4)
            {
	      kdir = 2;
	      tpar = evval[0];
            }
	  else if (kbound==5)
            {
	      kdir = 3;
	      tpar = esval[0];
            }
	  else if (kbound==6)
            {
	      kdir = 4;
	      tpar = etval[1];
            }
	  else if (kbound==7)
            {
	      kdir = 3;                                   
	      tpar = esval[1];
            }
	  else if (kbound==8)
            {
	      kdir = 4;
	      tpar = etval[0];
            }
	  
	  
	  /* Iterate to boundary intersection */
	  
	  s9boundit(spnt1,spnt2,spar31,spar32,psurf1,psurf2,tpar,kdir,aepsge,
		    gpnt1,gpnt2,gpar1,gpar2,&kstat);
	  if (kstat<0) goto error;
	  if (kstat==2) goto war02;
	  
	  /* Iteration converged, copy output if new loop necessary */
	  
	  if (krem == 2)
            {
	      /* spar1 was inside, update spar2 */

	      memcopy(spar21,gpar1,2,double);
	      memcopy(spar22,gpar2,2,double);
            }
	  else
            {
	      /* spar2 was inside, update spar1 */

	      memcopy(spar11,gpar1,2,double);
	      memcopy(spar12,gpar2,2,double);
            }
	  
	  /* Update number of iterations */
	  
	  knbit++;
        }
    }
  
  
  
  /* Problem solved if kcross==0. In this case we might have two cases:
     - iteration not used: Then knbit=0
     - iteration used    : Then knbit>0
     
     if kcross==1, then we have stopped on the condition knbit>7, and we
     have no success. */
  
  if (kcross==0 && knbit ==0)
    {
      /* Iteration not used because boundary not crossed */

      *jstat = 0;
    }
  else if (kcross==0 && knbit > 0)
    {
      /* Boundary crossed, point found, more than one intersection point
	 is possible, check which to return */
      
      if (spar11[0] == epar11[0] && spar11[1] == epar11[1] &&
	  spar12[0] == epar12[0] && spar12[1] == epar12[1] )
        {
	  memcopy(gpar1,spar21,2,double);
	  memcopy(gpar2,spar22,2,double);
        }
      else
        {
	  memcopy(gpar1,spar11,2,double);
	  memcopy(gpar2,spar12,2,double);
	  
	  /* Calculate crossing point, only necessary when we step into
	     the patch since we already could have stepped out and this
	     point is recorded in gpnt1 */
	  
	  s1421(psurf1,kder,gpar1,&klfu,&klfv,gpnt1,gpnt1+18,&kstat); 
	  if (kstat<0) goto error;
	  
	  s1421(psurf2,kder,gpar2,&klfu,&klfv,gpnt2,gpnt2+18,&kstat); 
	  if (kstat<0) goto error;
        }
      
      *jstat = 1;
    }
  else
    {
      /*  To many tries */
      goto war02;
    }
  goto out;
  
  /* Iteration without success */
  
  war02: 
    *jstat = 2;
    goto out;
  
  /* Error in lower level routine.  */
  
  error : 
    *jstat = kstat;
    s6err("s9clipit",*jstat,kpos);
    goto out;
  
  out:
    return;
}

//===========================================================================
void s6move(double epoint[])
//===========================================================================
{
  printf("\n s6move: %f    %f    %f ",epoint[0],epoint[1],epoint[2]);
}

//===========================================================================
void s6line(double epoint[])
//===========================================================================
{
  printf("\n s6line: %f    %f    %f ",epoint[0],epoint[1],epoint[2]);
}


//===========================================================================
void s1310_s9constline(SISLSurf *ps1,SISLSurf *ps2,SISLIntcurve *pintcr,
		       double aepsge,int icur,int igraph,int *jstat)
//===========================================================================
{
  int kguide1,kguide2,kguide3,kguide4; /* Pointers to guide points       */
  /*int kderc=2;         Number of derivatives to be claculated on curve */
  int kders=1;        /* Number of derivatives to be calculated on surface*/
  int ki,kj,kl;            /* Control variables in for loops            */
  int kk,kn,kk1,kn1,kk2,kn2;/* Orders and numbers of knots               */
  int       kk3,kn3,kk4,kn4;/* Orders and numbers of knots               */
  int kpoint;              /* Number of points in guide curve           */
  int kleft = 0;           /* Pointer into knot vector                  */
  int kpar1;               /* Number of parameter direction in 1st. obj */
  int kpar2;               /* Number of parameter direction in 2st. obj */
  int ktype;               /* Type of intersection curve                */
  int kpos=0;              /* Position of error                         */
  int kstat;               /* Status variable returned form routine     */
  int kdir=0;              /* constant parameter line direction         */
  int knbpnt;              /* Number of points on constant parameter line */
  int kleft1=0,kleft2=0;   /* Pointers into knot vectors                */
  int kstop;               /* Stop value in loop                        */
  double *sp=SISL_NULL;         /* Array for storage of points in
			      parameter plane */
  double *sv=SISL_NULL;         /* Array for storage of tangents in
			      parameter plane*/
  double *spar=SISL_NULL;       /* Array for storage of parameter values     */
  double *stp,*stv,*stpar; /* Pointers to sp,sv and spar                */
  double tdistp,tdistc;    /* Distances between points                  */
  double tfak;             /* Scaling factor                            */
  double sstart[4];        /* Lower boundary of parameter intervals     */
  double send[4];          /* Upper bounadry of parameter intervals     */
  double snext[3];         /* Existing iteration point on  surface      */
  double tmax1,tmin1;      /* Minimum and maximum of 1.rst comp of
			      guide points */
  double tmax2,tmin2;      /* Minimum and maximum of 2.nd. comp of
			      guide points */
  double tmax3,tmin3;      /* Minimum and maximum of 3.rd. comp of
			      guide points */
  double tmax4,tmin4;      /* Minimum and maximum of 4.th  comp of
			      guide points */
  double tmax;             /* Maximum 3-D SISLbox side                      */
  double tdist,tang;       /* Distance and angle error                  */
  double *st,*st1,*st2;    /* Pointers to knot vectors                  */
  double     *st3,*st4;    /* Pointers to knot vectors                  */
  double *spoint;          /* Pointer to points on constant parameter line */
  double *sp1;             /* Pointer into array                        */
  double tsize1,tsize2;    /* Length of knot intervals                  */
  double tsize3,tsize4;    /* Length of knot intervals                  */
  double sval1[2];         /* Limits of parameter plane in first SISLdir    */
  double sval2[2];         /* Limits of parameter plane in second SISLdir   */
  double sval3[2];         /* Limits of parameter plane in third SISLdir    */
  double sval4[2];         /* Limits of parameter plane in fourth SISLdir   */
  double sderc[6];         /* SISLPoint and derivative on curve             */
  double sders[9];         /* SISLPoint and derivative on curve             */
  double snorm[3];         /* Normal on implicit surface                */
  double tsumold,tsum,tval;/* Parameter values                    */
  double ta11,ta12,ta22;   /* Coefficients in equation system           */
  double tb1,tb2,tdom;     /* Left side of eq.syst. and determinant     */
  double t1,t2;            /* Derivatives in parameter plane            */
  double *sgpar1=SISL_NULL;     /* Parameter pairs of guide point in surf 1  */
  double *sgpar2=SISL_NULL;     /* Parameter pairs of guide point in surf 2  */
  SISLCurve *qc1=SISL_NULL;  /* Pointer to 3-D curve                     */
  SISLCurve *qc2=SISL_NULL;  /* Pointer to 3-D curve                     */

  SISLCurve *qp1cur=SISL_NULL;/* Pointer to curve in first parameter plane*/
  SISLCurve *qp2cur=SISL_NULL;/* Pointer to curve in second parameter plane*/
  SISLSurf  *qsurf =SISL_NULL;
  SISLPoint *qpoint=SISL_NULL;


  /* Make maximal step length based on box-size of surface */

  sh1992su(ps1,0,aepsge,&kstat);
  if (kstat < 0) goto error;

  tmax = MAX(ps1->pbox->e2max[0][0] - ps1->pbox->e2min[0][0],
	     ps1->pbox->e2max[0][1] - ps1->pbox->e2min[0][1]);
  tmax = MAX(tmax,ps1->pbox->e2max[0][2] - ps1->pbox->e2min[0][2]);

  sh1992su(ps2,0,aepsge,&kstat);
  if (kstat < 0) goto error;

  tmax = MAX(tmax,ps1->pbox->e2max[0][0] - ps1->pbox->e2min[0][0]);
  tmax = MAX(tmax,ps1->pbox->e2max[0][1] - ps1->pbox->e2min[0][1]);
  tmax = MAX(tmax,ps1->pbox->e2max[0][2] - ps1->pbox->e2min[0][2]);

  /* Find a none singular start point for the marching process */

  kpoint = pintcr->ipoint;
  kpar1  = pintcr->ipar1;
  kpar2  = pintcr->ipar2;
  sgpar1 = pintcr->epar1;
  sgpar2 = pintcr->epar2;
  ktype  = pintcr->itype;


  /* Initiate pointers to intersection curve and intersection curve in
     parameter plane */

  pintcr -> pgeom = SISL_NULL;
  pintcr -> ppar1 = SISL_NULL;
  pintcr -> ppar2 = SISL_NULL;



  /* Test that both objects has 2 parameter direction */

  if (kpar1 == 2 && kpar2 == 2)
    {
      /*  Everything is ok */
      ;
    }
  else
    {
      goto err123;
    }


  /* Run through the parameter pairs to decide if a constant parameter line
     is possible */

  tmax1 = tmin1 = sgpar1[0];
  tmax2 = tmin2 = sgpar1[1];
  tmax3 = tmin3 = sgpar2[0];
  tmax4 = tmin4 = sgpar2[1];

  /* Remember which guide point have minimum value in a specific parameter
     direction */

  kguide1 = kguide2 = kguide3 = kguide4 = 0;

  for (ki=1,kj=2,kl=3 ; ki < kpoint ; ki++,kj+=2,kl+=2)
    {
      if (tmin1>sgpar1[kj])
        {
	  tmin1 = sgpar1[kj];
	  kguide1 = ki;
        }
      if (tmin2>sgpar1[kl])
        {
	  tmin2 = sgpar1[kl];
	  kguide2 = ki;
        }
      if (tmin3>sgpar2[kj])
        {
	  tmin3 = sgpar2[kj];
	  kguide3 = ki;
        }
      if (tmin4>sgpar2[kl])
        {
	  tmin4 = sgpar2[kl];
	  kguide4 = ki;
        }
      tmax1 = MAX(tmax1,sgpar1[kj]);
      tmax2 = MAX(tmax2,sgpar1[kl]);
      tmax3 = MAX(tmax3,sgpar2[kj]);
      tmax4 = MAX(tmax4,sgpar2[kl]);
    }

  /* Initiate parameter direction boundaries */
  kk1    = ps1 -> ik1;
  kn1    = ps1 -> in1;
  st1    = ps1 -> et1;
  sval1[0] = st1[kk1-1];
  sval1[1] = st1[kn1];
  kk2    = ps1 -> ik2;
  kn2    = ps1 -> in2;
  st2    = ps1 -> et2;
  sval2[0] = st2[kk2-1];
  sval2[1] = st2[kn2];

  /* Initiate parameter direction boundaries */
  kk3    = ps2 -> ik1;
  kn3    = ps2 -> in1;
  st3    = ps2 -> et1;
  sval3[0] = st3[kk3-1];
  sval3[1] = st3[kn3];
  kk4    = ps2 -> ik2;
  kn4    = ps2 -> in2;
  st4    = ps2 -> et2;
  sval4[0] = st4[kk4-1];
  sval4[1] = st4[kn4];

  tsize1 = st1[kn1] - st1[kk1-1];
  tsize2 = st2[kn2] - st2[kk2-1];
  tsize3 = st3[kn3] - st3[kk3-1];
  tsize4 = st4[kn4] - st4[kk4-1];

  /* Check if constant parameter value within tolerance */

  if (DEQUAL((tmin1+tsize1),(tmax1+tsize1)) )
    {
      /* Intersection possible constant parameter line with first parameter
	 constant value constant.

	 1. Pick out curve from surface
	 2. Pick out relevant part of curve */

      kdir = 1;

      s1437(ps1,((tmin1+tmax1)/(double)2.0),&qc1,&kstat);
      if (kstat < 0) goto error;

      s1712(qc1,tmin2,tmax2,&qc2,&kstat);
      if (kstat < 0) goto error;

      /* Copy start point of iteration in surface */

      memcopy(snext,sgpar2+2*kguide1,2,DOUBLE);
    }
  else if (DEQUAL((tmin2+tsize2),(tmax2+tsize2)) )
    {
      /* Intersection possible constant parameter line with first parameter
	 constant value constant.

	 1. Pick out curve from surface
	 2. Pick out relevant part of curve
	 */

      kdir = 2;

      s1436(ps1,((tmin2+tmax2)/(double)2.0),&qc1,&kstat);
      if (kstat < 0) goto error;

      s1712(qc1,tmin1,tmax1,&qc2,&kstat);
      if (kstat < 0) goto error;

      /* Copy start point of iteration in surface */

      memcopy(snext,sgpar2+2*kguide2,2,DOUBLE);

    }
  else if (DEQUAL((tmin3+tsize3),(tmax3+tsize3)) )
    {
      /* Intersection possible constant parameter line with first parameter
	 constant value constant from second surface.

	 1. Pick out curve from surface
	 2. Pick out relevant part of curve */

      kdir = 3;

      s1437(ps2,((tmin3+tmax3)/(double)2.0),&qc1,&kstat);
      if (kstat < 0) goto error;

      s1712(qc1,tmin4,tmax4,&qc2,&kstat);
      if (kstat < 0) goto error;

      /* Copy start point of iteration in surface */

      memcopy(snext,sgpar1+2*kguide3,2,DOUBLE);

    }
  else if (DEQUAL((tmin4+tsize4),(tmax4+tsize4)) )
    {
      /* Intersection possible constant parameter line with first parameter
	 constant value constant.

	 1. Pick out curve from surface
	 2. Pick out relevant part of curve */

      kdir = 4;

      s1436(ps2,((tmin4+tmax4)/(double)2.0),&qc1,&kstat);
      if (kstat < 0) goto error;

      s1712(qc1,tmin3,tmax3,&qc2,&kstat);
      if (kstat < 0) goto error;

      /* Copy start point of iteration in surface */

      memcopy(snext,sgpar1+2*kguide4,2,DOUBLE);

    }
  else
    goto war00;

  st = qc2 -> et;
  kk = qc2 -> ik;
  kn = qc2 -> in;

  /* Set boundaries of surface to be iterated in */

  if (kdir==3 || kdir ==4)
    {
      sstart[0] = sval1[0];
      sstart[1] = sval2[0];
      send[0]   = sval1[1];
      send[1]   = sval2[1];
      qsurf = ps1;

    }
  else
    {
      sstart[0] = sval3[0];
      sstart[1] = sval4[0];
      send[0]   = sval3[1];
      send[1]   = sval4[1];
      qsurf = ps2;
    }

  /* Allocate array for storage of points, tangents and parameter values of
     curve in the parameter plane of the surface we test */

  if ((sp=newarray(4*kn,DOUBLE)) == SISL_NULL) goto err101;
  if ((sv=newarray(4*kn,DOUBLE)) == SISL_NULL) goto err101;
  if ((spar=newarray(2*kn,DOUBLE)) == SISL_NULL) goto err101;


  /* Run through 2*kn points of the curve and check that they lie in the
     implicit surface by calculating the 2*kn points. */

  tsumold = st[kk-1];

  for (ki=0,stp=sp,stv=sv,stpar=spar ; ki <kn ; ki++)
    {
      if (kk>1)
        {
	  /* Make parameter value to use for calculation of curve point */

	  for (kl=1,kj=ki+1,tsum=DZERO ; kl<kk ; kl++)
            tsum += st[kj++];

	  tsum = tsum/(double)(kk-1);
        }
      else
        tsum = st[ki];

      tval = (tsum+tsumold)/(double)2.0;

      for (kj=0 ; kj<2 ; kj++,stp+=2,stv+=2,stpar++)
        {

	  /* Calculate point on curve */

	  s1221(qc2,1,tval,&kleft,sderc,&kstat);
	  if (kstat < 0) goto error;

	  /* Remember the parameter value */

	  *stpar = tval;

	  /* Find closest point on surface to sderc */

	  qpoint = newPoint(sderc,3,0);
	  if (qpoint==SISL_NULL) goto err101;

	  /* Calculate closest point to surface */

	  s1773(qpoint,qsurf,aepsge,sstart,send,snext,stp,&kstat);
	  if(kstat<0) goto error;

	  freePoint(qpoint);

	  /* Calculate point and derivatives in surface */

	  s1421(qsurf,kders,stp,&kleft1,&kleft2,sders,snorm,&kstat);

	  if (kstat<0) goto error;

	  /* Find tangent of curve in parameter plane */

	  ta11 = s6scpr(sders+3,sders+3,3);
	  ta12 = s6scpr(sders+3,sders+6,3);
	  ta22 = s6scpr(sders+6,sders+6,3);
	  tb1  = s6scpr(sders+3,sderc+3,3);
	  tb2  = s6scpr(sders+6,sderc+3,3);

	  tdom = ta11*ta22 - ta12*ta12;
	  if (tdom != DZERO)
            {
	      t1 = (ta22*tb1-ta12*tb2)/tdom;
	      t2 = (ta11*tb2-ta12*tb1)/tdom;

	      tdom = sqrt(t1*t1+t2*t2);
	      if (tdom != DZERO)
                {
		  t1 /= tdom;
		  t2 /= tdom;
                }
            }
	  else
            t1 = t2 = DZERO;

	  /* Remember the tangent */

	  *stv     = t1;
	  *(stv+1) = t2;


	  /*Both the position of the two points should be within the relative
	    computer resolution for the point to be accepted.
	    Correspondingly the direction of the intersection curve and the
	    constant parameter line should be within the computer
	    resolution to be accepted. */

	  tdist = s6dist(sders,sderc,3);

	  if (DNEQUAL(tdist+tmax,tmax))
            goto war00;

	  /* Distance within tolerance, check that the angle between surface
	     normal and curve tangent is PIHALF, if both these vectors have a
	     nonzero length. */

	  if (s6length(snorm,3,&kstat) != DZERO &&
	      s6length(sderc+3,3,&kstat) != DZERO  )
	    {
	      tang = s6ang(snorm,sderc+3,3);
	      if (DNEQUAL(fabs(tang),PIHALF) ) goto war00;
	    }
	  tval = tsum;

	  /* Remember start point of iteration */

	  memcopy(snext,stp,2,DOUBLE);
        }
      tsumold = tsum;
    }

  /* Intersection curve along constant parameter line, make right actions
     concerning drawing and/or creation of the curve */

  if (igraph == 1)
    {
      /* Draw curve, first break into straight line segments */

      s1605(qc2,aepsge,&spoint,&knbpnt,&kstat);
      if (kstat < 0) goto error;

      if (knbpnt>1)
        {
	  /* Draw curve */

	  s6move(spoint);
	  for (ki=1,sp1=spoint+3 ; ki<knbpnt ; ki++,sp1+=3)
            s6line(sp1);
        }
      freearray(spoint);
    }

  if (icur >= 1)
    {
      /* Set pointer to 3-D curve */

      pintcr -> pgeom = qc2;
      qc2 = SISL_NULL;
    }

  if (icur == 2)
    {
      /* Make curves in parameter planes */

      double svert[4],sknot[4];


      /* Adjust the tangent lengths to match distance between adjacent points,
	 remember that first and second points are equal and that first point
	 is not used futher on */

      tdistp = s6dist(sp+2,sp+4,2);
      *(sv+2) *= tdistp;
      *(sv+3) *= tdistp;

      for (ki=2,stp=sp+4,stv=sv+4,kstop=kn+kn-1 ; ki < kstop ;
	   ki++,stp+=2,stv+=2)
	{
	  tdistc = s6dist(stp,stp+2,2);
	  tfak = (tdistp+tdistc)/(double)2.0;
	  *stv     *= tfak,
	  *(stv+1) *= tfak;
	  tdistp = tdistc;
	}
      *stv     *= tdistp;
      *(stv+1) *= tdistp;


      /* The first parameter pair is doubly represented */

      stp = sp+2;
      stv = sv+2;
      stpar = spar+1;

      if (kdir==1)
        {
	  svert[0] = svert[2] = (tmin1+tmax1)/(double)2.0;
	  svert[1] = tmin2;
	  svert[3] = tmax2;
	  sknot[0] = sknot[1] = tmin2;
	  sknot[2] = sknot[3] = tmax2;
	  qp1cur = newCurve(2,2,sknot,svert,1,2,1);
	  if (qp1cur==SISL_NULL) goto err101;
	  s1379(stp,stv,stpar,2*kn-1,2,&qp2cur,&kstat);
	  if (kstat<0) goto error;
	}
      else if (kdir==2)
        {
	  svert[0] = tmin1;
	  svert[2] = tmax1;
	  svert[1] = svert[3] = (tmin2+tmax2)/(double)2.0;
	  sknot[0] = sknot[1] = tmin1;
	  sknot[2] = sknot[3] = tmax1;
	  qp1cur = newCurve(2,2,sknot,svert,1,2,1);
	  if (qp1cur==SISL_NULL) goto err101;
	  s1379(stp,stv,stpar,2*kn-1,2,&qp2cur,&kstat);
	  if (kstat<0) goto error;
        }
      else if (kdir==3)
        {
	  svert[0] = svert[2] = (tmin3+tmax3)/(double)2.0;
	  svert[1] = tmin4;
	  svert[3] = tmax4;
	  sknot[0] = sknot[1] = tmin4;
	  sknot[2] = sknot[3] = tmax4;
	  qp2cur = newCurve(2,2,sknot,svert,1,2,1);
	  if (qp2cur==SISL_NULL) goto err101;
	  s1379(stp,stv,stpar,2*kn-1,2,&qp1cur,&kstat);
	  if (kstat<0) goto error;
        }
      else
        {
	  svert[0] = tmin3;
	  svert[2] = tmax3;
	  svert[1] = svert[3] = (tmin4+tmax4)/(double)2.0;
	  sknot[0] = sknot[1] = tmin3;
	  sknot[2] = sknot[3] = tmax3;
	  qp2cur = newCurve(2,2,sknot,svert,1,2,1);
	  if (qp2cur==SISL_NULL) goto err101;
	  s1379(stp,stv,stpar,2*kn-1,2,&qp1cur,&kstat);
	  if (kstat<0) goto error;
        }
      pintcr -> ppar1 = qp1cur;
      pintcr -> ppar2 = qp2cur;
    }

  *jstat = 1;
  goto out;

  /* Iteration can not continue */
 war00:  *jstat = 0;
  goto out;


  /* Error in space allocation */
 err101: *jstat = -101;
  s6err("s1310_s9constline",*jstat,kpos);
  goto out;

  /* Error in surface description parameter direction does not exist */
 err123: *jstat = -123;
  s6err("s1310_s9constline",*jstat,kpos);
  goto out;

  /* Error in lower leve function */
 error:
  *jstat = kstat;
  s6err("s1310_s9constline",*jstat,kpos);
  goto out;

 out:;
  if (qc1 != SISL_NULL) freeCurve(qc1);
  if (qc2 != SISL_NULL) freeCurve(qc2);
  if (sp  != SISL_NULL) freearray(sp);
  if (sv  != SISL_NULL) freearray(sv);
  if (spar  != SISL_NULL) freearray(spar);
}

//===========================================================================
void make_sf_kreg (SISLSurf * ps, SISLSurf ** rsnew, int *jstat)
//===========================================================================
{
  int kn1=ps->in1;	/* Number of vertices in 1. par. dir.  */
  int kn2=ps->in2;	/* Number of vertices in 2. par. dir.  */
  int kk1=ps->ik1;	/* Order in 1. par. dir.               */
  int kk2=ps->ik2;	/* Order in 2. par. dir.               */
  /* --------------------------------------------------------- */

  s1001 (ps, ps->et1[kk1-1], ps->et2[kk2-1],
		ps->et1[kn1], ps->et2[kn2], rsnew, jstat);
  if (*jstat < 0)  goto error;

  goto out;

  /* Error in lower level routine */
error:
  s6err ("make_sf_kreg", *jstat, 0);

out:;

}

//===========================================================================
void s1329(SISLSurf *psold,double epoint[],double enorm[],int idim,
	   SISLSurf **rsnew,int *jstat)
//===========================================================================
{
  int kpos = 0;    /* Position of error.                            */
  int kdim;        /* Dimension of the space in which the output 
		      surface lies.                                 */
  int kn1,kn2;     /* Number of coefficients of surface.            */
  int kk1,kk2;     /* Order of surface.                             */
  int ikind;       /* kind of surface psold is                      */
  double *scoef = SISL_NULL; /* Coeffecient array of new surface.        */
  double *s1,*s2;  /* Pointers used to traverse scoef.              */
  double *sc=SISL_NULL; /* Pointer used to traverse psold->ecoef.        */
  double *scSave=SISL_NULL; /* Pointer to vertices in rational case.     */
  double *rscoef;  /* Scaled coefficients if psold is rational      */
  double *s3;      /* Stop pointer for each vertex in psold->ecoef. */
  double *spoint;  /* Pointer used to traverse the point epoint.    */
  double *snorm;   /* Pointer used to traverse the normal enorm.    */
  double wmin,wmax;/* min and max values of the weights if rational */
  double scale;    /* factor for scaling weights if rational        */
  int i;           /* loop variable                                 */
  int idimp1;      /* idim+1                                        */
  
  /* Test input.  */
  
  if (idim != psold -> idim) goto err106;
  
  /* Set simple variables of the new surface.  */
  
  kdim = 1;
  kn1 = psold -> in1;
  kn2 = psold -> in2;
  kk1 = psold -> ik1;
  kk2 = psold -> ik2;
  ikind = psold -> ikind;
  
  /* rational surfaces are a special case */
  if(ikind == 2 || ikind == 4)
  {
      /* scale the coeffs so that min. weight * max. weight = 1  */
      idimp1=idim+1;
      rscoef = psold -> rcoef;
      wmin=rscoef[idim];
      wmax=rscoef[idim];
      for(i=idim; i< kn1*kn2*idimp1; i+=idimp1)
      {
          if(rscoef[i] < wmin) wmin=rscoef[i];
          if(rscoef[i] > wmax) wmax=rscoef[i];
      } 
      scale=1.0/sqrt(wmin*wmax);
      if ((sc = newarray(idimp1*kn1*kn2,DOUBLE)) == SISL_NULL) goto err101;
      for(i=0; i< kn1*kn2*idimp1; i++)
      {
          sc[i]=rscoef[i]*scale;
      } 

      scSave = sc;
  }
  else
  {
      sc = psold -> ecoef;
  }

  /* Allocate space for coeffecient of the new surface.  */
  
  if ((scoef = newarray(kdim*kn1*kn2,DOUBLE)) == SISL_NULL) goto err101;
  
  /* Compute coefficients of new surface.  */
  
  for (s1=scoef,s2=s1+kn1*kn2; s1<s2; s1++)
    {
      *s1 = (double)0.0;
      if(ikind == 2 || ikind == 4)
      {
      /* surface is rational so we're using idim+1 - d homogeneous coords */
          for (s3=sc+idim,spoint=epoint,snorm=enorm; sc<s3; sc++,spoint++,snorm++)
          {
	     /* UJK, Turned direction to get right sign in 1D*/
	     /* *s1 += ((*s3)*(*spoint) - *sc)*(*snorm); */
	     *s1 += (*sc - (*s3)*(*spoint))*(*snorm);
          }
          sc++;
      }
      else
      {
      /* surface is not rational so we're using ordinary idim - d coords */
          for (s3=sc+idim,spoint=epoint,snorm=enorm; sc<s3; sc++,spoint++,snorm++)
	     /* UJK, Turned direction to get right sign in 1D*/
	     /* *s1 += (*spoint - *sc)*(*snorm); */
	     *s1 += (*sc - *spoint)*(*snorm);
      }
    }
  
  if(ikind == 2 || ikind == 4) freearray(scSave);

  /* Create output surface.  */
  
  *rsnew = newSurf(kn1,kn2,kk1,kk2,psold->et1,psold->et2,scoef,1,kdim,1);
  if (*rsnew == SISL_NULL) goto err101;
  
  /* Task done.  */
  
  *jstat = 0;
  goto out;
  
  /* Error in space allocation.  */
  
  err101: 
    *jstat = -101;
    s6err("s1329",*jstat,kpos);
    goto out;
  
  /* Error in input. Confliction dimensions.  */
  
  err106 : 
    *jstat = -106;
    s6err("s1329",*jstat,kpos);
    goto out;
  
  out:
    /* Free space allocated for local array.  */
  
    if (scoef != SISL_NULL) freearray(scoef);
    return;    
}

//===========================================================================
SISLPoint *newPoint (double *ecoef, int idim, int icopy)
//===========================================================================
{
  SISLPoint *qnew;		/* Local pointer to new point.  */
  double *scoef = SISL_NULL;		/* Copy of coordinates          */


  /* Allocate space for point.  */

  if ((qnew = newarray (1, SISLPoint)) == SISL_NULL)
    goto err101;


  if (icopy == 1)
    {

      /* Copy input array. First allocate space for new array. */

      if (idim < 4) 	scoef = qnew->ec;
      else if ((scoef = newarray (idim, double)) == SISL_NULL) goto err101;

      /* Copy contents of arrays.  */

      memcopy (scoef, ecoef, idim, double);
    }
  else
    {
      scoef = ecoef;
    }

  /* Initialize new point.  */

  qnew->idim = idim;
  qnew->icopy = icopy;
  qnew->ecoef = scoef;
  qnew->pbox = SISL_NULL;

  /* Task done. */

  goto out;

  /* Error in space allocation. Return zero. */

err101:if (qnew != SISL_NULL)
    freearray (qnew);
  qnew = SISL_NULL;
  goto out;
out:return qnew;
}

//===========================================================================
void freePoint(SISLPoint *ppoint)
//===========================================================================
{
   int ki;   /* Counter.  */

  if (ppoint != SISL_NULL)
    {
      if (ppoint -> pbox != SISL_NULL)
      {
	 if (ppoint->pbox->emax) freearray(ppoint->pbox->emax);
	 if (ppoint->pbox->emin) freearray(ppoint->pbox->emin);

	 for (ki=0; ki<3; ki++)
	 {
	    if (ppoint->pbox->e2max[ki]) freearray(ppoint->pbox->e2max[ki]);
	    if (ppoint->pbox->e2min[ki]) freearray(ppoint->pbox->e2min[ki]);
	 }
	 freearray(ppoint->pbox);
	}

      if ((ppoint -> idim > 3) &&
	  (ppoint -> icopy != 0) &&
	  (ppoint -> ecoef != SISL_NULL))
	freearray(ppoint -> ecoef);	/* Free array.  */

      freearray(ppoint);		/* Free instance of point. */
    }
  return;
}

//===========================================================================
void sh6degen_geom(SISLObject *po1,SISLObject *po2,double epar[],
		   double geom[],int *jstat)
//===========================================================================
{
   int kstat = 0;             /* Local status variable.             */
   int kdim;                  /* Dimension.                         */
   int kder = 0;              /* Evaluate position.                 */
   int kleft1 = 0;            /* Parameter to the evaluator.        */
   int kleft2 = 0;            /* Parameter to the evaluator.        */
   int keval = *jstat;        /* Indicates which object to evaluate. */
   double sder[3];            /* Position and derivatives.          */
   double snorm[3];           /* Dummy normal in surf. evalutation. */

   *jstat = 0;
   if (keval == 0)
   {
      if (po1->iobj == SISLSURFACE)
      {
	 /* Evaluate the surface.  */
	 
	 kdim = po1->s1->idim;
	 s1421(po1->s1,kder,epar,&kleft1,&kleft2,sder,snorm,&kstat);
	 if (kstat < 0) goto error;
      }
      
      else if (po1->iobj == SISLCURVE)
      {
	 
	 /* Evaluate the curve.  */
	 
	 kdim = po1->c1->idim;
	 s1221(po1->c1,kder,epar[0],&kleft1,sder,&kstat);
	 if (kstat < 0) goto error;
      }
      
      else if (po1->iobj == SISLPOINT)
      {
	 
	 /* Copy the value of the point. */
	 
	 kdim = po1->p1->idim;
	 memcopy(sder,po1->p1->ecoef,kdim,DOUBLE);
      }
   }
   else if (keval == 1)
   {
      if (po2->iobj == SISLSURFACE)
      {
	 /* Evaluate the surface.  */
	 
	 kdim = po2->s1->idim;
	 s1421(po2->s1,kder,epar+po1->iobj,&kleft1,&kleft2,sder,snorm,&kstat);
	 if (kstat < 0) goto error;
      }
      
      else if (po2->iobj == SISLCURVE)
      {
	 
	 /* Evaluate the curve.  */
	 
	 kdim = po2->c1->idim;
	 s1221(po2->c1,kder,epar[po1->iobj],&kleft1,sder,&kstat);
	 if (kstat < 0) goto error;
      }
      
      else if (po2->iobj == SISLPOINT)
      {
	 
	 /* Copy the value of the point. */
	 
	 kdim = po2->p1->idim;
	 memcopy(sder,po1->p1->ecoef,kdim,DOUBLE);
      }
   }
      

   /* Copy result to output.  */
   
   memcopy(geom,sder,kdim,DOUBLE);
   
   *jstat = 0;
   goto out;
   
   /* Error in lower level function. */
   
   error :
      *jstat = kstat;
   goto out;
   
   out :
      return;
}
    
//===========================================================================
void sh6degen(SISLObject * po1, SISLObject * po2, SISLIntdat ** pintdat,
	      double aepsge, int *jstat)
//===========================================================================
{
  int kstat;		/* Local status variable.          */
  int kpos = 0;		/* Position of error.              */
  int ki,kj, kl;        /* Loop variables.        */
  int kpoint;           /* Number of points in list.       */
  int kstoremark;       /* Save marker of point.   */
  int knumbpt;          /* Number of points in intersection list. */
  int knpar;            /* Number of parameter directions.        */
  int kexact;           /* Indicates which parameter direction is exact. */
  SISLIntpt** vpoint;   /* Array of Int points.    */
  int ipoint;           /* Number of Intpoints.            */
  int ipmax;            /* Size of vpoint array.           */
  SISLIntlist** vlist;  /* Array of Intlists.   */
  int ilist;            /* Number of Intlists.             */
  int ilmax;            /* Size of vlist array.           */
  int isdegen;          /* Flag. Is curve degenerate? */
  double spar[4];       /* Parameter value on intersection curve of
			   the  objects.                         */
  SISLIntpt *pprev, *pcurr, *pnext;    /*    Pointers to Intpts. */    
  SISLIntpt *pfirst, *plast;           /*    Pointers to Intpts. */    
  SISLIntpt *qpt;  
  SISLObject *qo2=SISL_NULL; /* Either po2 or dummy point. */
  int newilist;         /* New number of Intlists. */
  int idim;              /* Dimension of space. */
  double geomfirst[3]; /* geometric info --- position etc. */
  double geomcurr[3];  /* geometric info --- position etc. */
  double geommid[3];   /* geometric info --- position etc. */
  double len;    /* Distance between two vectors. */
  
  knpar = po1->iobj + po2->iobj;
  *jstat = 0;

  if(*pintdat == SISL_NULL) goto out;

  /* Set up local variables. */

  vpoint = (*pintdat) -> vpoint;
  ipoint = (*pintdat) -> ipoint;
  ipmax = (*pintdat) -> ipmax;
  vlist = (*pintdat) -> vlist;
  ilist = (*pintdat) -> ilist;
  ilmax = (*pintdat) -> ilmax;

  if(ipoint == 0 && ilist == 0) goto out;

  /* Make dimension of geometry space. */

  if (po1->iobj == SISLPOINT) idim = po1->p1->idim;
  else if (po1->iobj == SISLCURVE) idim = po1->c1->idim;
  else idim = po1->s1->idim;

  /* UJK, feb 93, often po1 and po2 is the same geometry ie po2
     is a dummy, so let create a dummy point in those cases. */
  if ((*pintdat) -> vpoint[0]->ipar == po1->iobj)
  {
     if ((qo2 = newObject(SISLPOINT)) == SISL_NULL) goto err101;
     knpar = po1->iobj;
  }
  else qo2 = po2;
  
     
     for(ki=0; ki<ilist; ki++)
  {
      /* Find out whether the curve vlist[ki] is degenerate.
      We assume that if all the guide points in vlist[ki]
      are equal then it is degenerate. This should be
      correct if SISL has done its job properly before
      reaching this stage of the intersection algorithm.
      Otherwise it clearly is not degenerate. */


      isdegen = TRUE;

      pfirst = vlist[ki]->pfirst;
      plast  = vlist[ki]->plast;
      knumbpt = vlist[ki]->inumb;

      /* VSK, 02-93. Check if the list describes a trimming area.
	 In that case no reduction is to be performed.            */
      
      if (pfirst->iinter == SI_TRIM) continue;
      
      kstat = 0;
      sh6degen_geom(po1,qo2,pfirst->epar,geomfirst,&kstat);
      if(kstat < 0) goto error;

      pprev = pfirst;

      pcurr = sh6getnext(pprev,vlist[ki]->ind_first);

      /* Loop through the guide points and compare with pfirst. */

      while(pcurr != plast)
      {
	 kstat = 0;
	  sh6degen_geom(po1,qo2,pcurr->epar,geomcurr,&kstat);
	  if(kstat < 0) goto error;

	  len = s6dist(geomcurr,geomfirst,idim);
	  if(len > aepsge)
	  {
	      isdegen = FALSE;
	      break;
	  }

	  sh6getother(pcurr,pprev,&pnext,&kstat);
	  if(kstat < 0) goto error;
  
	  pprev = pcurr;
	  pcurr = pnext;
      }
      
      /* Compare plast with pfirst. */

      if(isdegen == TRUE)
      {
	 kstat = 0;
	  sh6degen_geom(po1,qo2,plast->epar,geomcurr,&kstat);
	  if(kstat < 0) goto error;

	  len = s6dist(geomcurr,geomfirst,idim);
	  if(len > aepsge)
	  {
	      isdegen = FALSE;
	  }
      }
      
      /* Test if it is only 2 points in the intersection list. In that
	 case it may be a cyclic constant parameter curve, and it is
	 necessary to check in an internal point. */
      
      if (isdegen && knumbpt == 2)
      {
	 for (kexact=0, kj=0; kj<knpar; kj++) 
	 {
	    if (pfirst->curve_dir[vlist[ki]->ind_first] &
		(1 << (kj + 1))) 
	       kexact = kj + 1;
	    spar[kj] = (double)0.5*(pfirst->epar[kj]+plast->epar[kj]);
	 
	 }
	 
	 /* UJK, 930811:
	    kstat = (kexact == 0 || kexact > po1->iobj) ? 1 : 0; */
	 kstat = (kexact > po1->iobj) ? 1 : 0;
	 sh6degen_geom(po1,qo2,spar,geommid,&kstat);
	 
	 len = s6dist(geommid,geomfirst,idim);
	 if(len > aepsge)
	 {
	    isdegen = FALSE;
	 }
	 else
	 {
	    len = s6dist(geommid,geomcurr,idim);
	    if(len > aepsge)
	    {
	       isdegen = FALSE;
	    }
	 }
	 
      }

      if(isdegen == TRUE)
      {
	  /* Curve vlist[ki] is degenerate, i.e. it's just a point.  
	     Free the list in pintdat, but make sure that there is one
	     point left. If there is a point that is an endpoint of an
	     other list, and that are equal to this degenerate list,
	     this endpoint should represent these point.
	     
	     First pass through the list and mark all points as removed.  */

	 pcurr = pfirst;
	 kstoremark = pfirst->marker;
	 pnext = sh6getnext(pcurr,vlist[ki]->ind_first);
	 kpoint = vlist[ki]->inumb;
	 
	 for (kl=0; kl<kpoint; kl++)
	   {
	      /* Mark the point as removed.  */
	      
	      pcurr->marker = -99;
		 
	       pprev = pcurr;
	       pcurr = pnext;
	       
	       if (kl < kpoint-1)
	       {
		  sh6getother(pcurr,pprev,&pnext,&kstat);
		  if (kstat < 0) goto error;
	       }
	    }
	 
	 /* Free the list.  */
	 
	 freeIntlist(vlist[ki]);
	 vlist[ki] = SISL_NULL;
	 
	  /* Check the intersection points. If no point represent the
	     degenerated curve,restore the first point of the curve. */

          for(kj=0; kj<ipoint; kj++)
	  {
	     qpt = vpoint[kj];
	     if (qpt->marker == -99) continue;
	     kstat = 0;
	    sh6degen_geom(po1,qo2,qpt->epar,geomcurr,&kstat);
	    if(kstat < 0) goto error;
    
	    len = s6dist(geomfirst,geomcurr,idim);
	    if(len <= aepsge) break;
	  }
	  if (kj >= ipoint) pfirst->marker = kstoremark;

      }
  }

  /*  Tidy up the vlist array afterwards since some of the
      lists have been freed. */

  newilist = 0;

  for(ki=0; ki<ilist; ki++)
  {
      if(vlist[ki] != SISL_NULL)
      {
	  newilist++;
	  if(newilist < ki+1)
	  {
	      vlist[newilist-1] = vlist[ki];
	      vlist[ki] = SISL_NULL;
	  }
      }
  }

  ilist = newilist;

  /* Pass through the points and remove all marked points. */
  
  for (kj=0; kj<(*pintdat) -> ipoint; )
  {
     qpt = (*pintdat)->vpoint[kj];
     if (qpt->marker == -99)
     {
	/* Remove point.  */
	
	sh6idkpt (pintdat, &qpt, 0, &kstat);
	if (kstat < 0) goto error;
     }
     else kj++;
  }
  
  /* Reset the integer pintdat variables with the local
  ones in case they have changed. */

  (*pintdat)->ipmax =  ipmax;
  (*pintdat)->ilist =  ilist;
  (*pintdat)->ilmax =  ilmax;


  /* Degeneracies removed. Finish. */

  *jstat = 0;
  goto out;

  /* Error in alloc. */
err101:
  *jstat = -101;
  s6err ("sh6degen", *jstat, kpos);
  goto out;

  /* Error in lower level routine. */
error:
  *jstat = kstat;
  s6err ("sh6degen", *jstat, kpos);
  goto out;

out:
   if (qo2 && qo2 != po2) freeObject(qo2);

}

//===========================================================================
void refine_all (SISLIntdat ** pintdat, SISLObject * po1, SISLObject * po2,
		 double eimpli[], int ideg, double aepsge, int *jstat)
//===========================================================================
{
  *jstat = 0;
}

//===========================================================================
void s1227(SISLCurve *pc1,int ider,double ax,int *ileft,double eder[],int *jstat)
//===========================================================================
{
  int kind;           /* Type of curve                                   */
  int kstat=0;        /* Local status variable.                          */
  int kpos=0;         /* The position of the error.                      */
  int kn;             /* The number of B-splines, i.e., the dimension of
			 the spline space associated with the knot
			 vector.                                         */
  int kk;             /* The polynomial order of the curve.              */
  int kmult;          /* Multiplicity of knot value                      */
  int kdim;           /* The dimension of the space in which the curve
			 lies. Equivalently, the number of components
			 of each B-spline coefficient.                   */
  int kleft=0;        /* Local version of ileft which is used in order to
			 avoid the pointer.                              */
  int kder;           /* Local version of ider. Since derivatives of order
			 higher than kk-1 are all zero, we set
			 kder = min(kk-1,ider).                          */
  int ki,kj,kih,kjh;  /* Control variables in for loops and for stepping
			 through arrays.                                 */
  int kl,kl1,kl2;     /* Control variables in for loops and for stepping
			 through arrays.                                 */
  double *st;         /* Pointer to the first element of the knot vector
			 of the curve. The knot vector has [kn+kk]
			 elements.                                       */
  double *scoef;      /* Pointer to the first element of the curve's
			 B-spline coefficients. This is assumed to be an
			 array with [kn*kdim] elements stored in the
			 following order:
			 First the kdim components of the first B-spline
			 coefficient, then the kdim components of the
			 second B-spline coefficient and so on.          */
  double tt;          /* Dummy variable used for holding an array element
			 in a for loop.                                  */
  double *ebder=SISL_NULL; /* Pointer to an array of dimension [kk*(ider+1)]
		       which will contain the values and ider first derivatives
			 of the kk nonzero B-splines at ax.
			 These are stored in the following order:
			 First the value, 1. derivative etc. of the
			 first nonzero B-spline, then the same for the
			 second nonzero B-spline and so on.              */
  double *sder=SISL_NULL;  /* Pointer to array used for storage of points, if
			 non rational sder points to eder, if rational sder
			 has to be allocated to make room for the homogenous
			 coordinate */
  
  /* Copy curve attributes to local parameters.  */
  
  kn = pc1 -> in;
  kk = pc1 -> ik;
  st = pc1 -> et;
  scoef = pc1 -> ecoef;
  kdim = pc1 -> idim;
  kind = pc1 ->ikind;
  
  if (kind == 2 || kind == 4)
    {
      scoef = pc1 -> rcoef;
      kdim +=1;
      sder = newarray(kdim*(ider+1),DOUBLE); 
      if (sder==SISL_NULL) goto err101;
    }
  else
    {
      scoef = pc1 -> ecoef;
      sder = eder;  
    }
  
  /* Check the input. */
  
  if (kdim < 1) goto err102;
  
  if (kk < 1) goto err110;
  
  if (kn < kk) goto err111;
  
  /* Find in which interval ax lies */
  
  s1219(st,kk,kn,&kleft,ax,&kstat);
  if (kstat<0) goto error;
  
  /* To force the derivative to be taken from the left we artificially
     shorten the curve if ax==st[kleft]  */
  
  kmult = s6knotmult(st,kk,kn,&kleft,ax,&kstat);
  if (kstat < 0) goto error;
  
  
  if (ax == st[kleft] && kleft > kk-1) kn = kleft-kmult+1;
  if (st[kk-1] == st[kk] || st[kn-1] == st[kn]) goto err112;
  
  if (ider < 0) goto err178;
  
  if (pc1->ikind == 1 || pc1->ikind == 3)
    kder = min(kk-1,ider);
  else
    kder = ider;
  
  /* Allocate space for B-spline values and derivatives. */
  
  ebder = newarray(kk*(kder+1),DOUBLE);
  if (ebder == SISL_NULL) goto err101;
  
  /* Set all the elements of sder to 0. */
  
  for (ki=0; ki<(ider+1)*kdim; ki++) sder[ki] = (double)0.0;
  
  /* Compute the values and derivatives of the nonzero B-splines and
     update ileft if necessary.                                      */
  
  s1220(st,kk,kn,ileft,ax,kder,ebder,&kstat);
  
  if (kstat < 0) goto error;
  
  kleft = *ileft;
  
  /* Multiply together as indicated above. */
  
  /* ki steps through the appropriate kk B-spline coefficients while kih steps
     through the B-spline value and derivatives for the B-spline given by ki.*/
  
  kih = 0;
  for (ki=kleft-kk+1; ki<=kleft; ki++)
    {
      
      /* kj counts through the kder+1 derivatives to be computed.
	 kjh steps through sder once for each ki to accumulate the contribution
	 from the different B-splines.
	 kl1 points to the first component of B-spline coefficient no. ki. */
      
      kjh = 0; kl1 = kdim*ki;
      for (kj=0; kj<=kder; kj++)
	{
	  
	  /* The value of the B-spline derivative is stored in tt while
	     kl2 steps through the idim components of this B-spline
	     coefficient.                                                */
	  
	  tt = ebder[kih++]; kl2 = kl1;
	  for (kl=0; kl<kdim; kl++,kjh++,kl2++)
	    {
	      sder[kjh] += scoef[kl2]*tt;
	    }
	}
    }
  
  /* Free memory. */
  
  /* If rational curve calculate the derivatives based on derivatives in
     homogenous coordinates */
  
  if (kind == 2 || kind == 4)
    {
      s6ratder(sder,pc1->idim,ider,eder,&kstat);
      if (kstat<0) goto error;
      freearray(sder);
    }
  
  freearray(ebder);
  
  /* Successful computations.  */
  
  *jstat = 0;
  goto out;
  
  /* Not enough memory. */
 err101: *jstat = -101;
  s6err("S1227",*jstat,kpos);
  goto out;
  
  /* kdim less than 1. */
 err102: *jstat = -102;
  s6err("S1227",*jstat,kpos);
  goto out;
  
  /* Polynomial order less than 1. */
 err110: *jstat = -110;
  s6err("S1227",*jstat,kpos);
  goto out;
  
  /* Fewer B-splines than the order. */
 err111: *jstat = -111;
  s6err("S1227",*jstat,kpos);
  goto out;
  
  /* Error in knot vector.
     (The first or last interval of the knot vector is empty.) */
 err112: *jstat = -112;
  s6err("S1227",*jstat,kpos);
  goto out;
  
  /* Illegal derivative requested. */
 err178: *jstat = -178;
  s6err("S1227",*jstat,kpos);
  goto out;
  
  /* Error in lower level routine.  */
  
 error:  *jstat = kstat;
  s6err("S1227",*jstat,kpos);
  goto out;
  
 out: return;
}

//===========================================================================
void s6lufacp(double ea[],int nl[],int im,int *jstat)
//===========================================================================
{
  int kpos = 0;   /* Position of error.                               */
  int ki,kj,kk;   /* Counters.                                        */
  int kmax = 0;   /* Number of row with maximum greates element.      */
  int kchange;    /* Help variable to change order of two rows.       */
  double tmult;   /* Factor with which to multiply a row before it is 
		     added to another.                                */
  double t1;      /* Help variabel to find maximum of a number of elements.*/
  double tmax;    /* Maximum of a number of elements.                 */
  double tdiv;    /* Dividend in expression.                          */
  double *smax = SISL_NULL; /* Maximum elements in the rows of ea.         */
  
  /* Allocate space for local array.  */
  
  if ((smax = new0array(im,double)) == SISL_NULL) goto err101;
  
  /* Find largest element in each row.  */
  
  for (ki=0; ki<im; ki++)
    {                      
      nl[ki] = ki;
      for (kj=0; kj<im; kj++) 
	smax[ki] = MAX(smax[ki],fabs(ea[ki*im+kj]));
    }
  
  for (ki=0; ki<im-1; ki++)
    {
      
      /* Find row with maximum greates element to treat now.  */
      
      tmax = DZERO;  
      for (kj=ki; kj<im; kj++)
	{
	  tdiv = smax[nl[kj]];
	  if (DEQUAL(tdiv,DZERO)) goto warn1;
	  t1 = fabs(ea[nl[kj]*im+ki]/tdiv);
	  if (t1 > tmax)
	    {
	      tmax = t1; 
	      kmax = kj;
	    }
	}
      kchange  = nl[kmax];
      nl[kmax] = nl[ki];
      nl[ki]   = kchange;
      
      /* Add a multiplum of current row to all later rows in order to
	 get an upper triangular matrix ea.                           */
      
      for (kj=ki+1; kj<im; kj++)
	{
	  tdiv = ea[ki+kchange*im];
	  if (DEQUAL(tdiv,DZERO)) goto warn1;
	  tmult = ea[ki+nl[kj]*im]/tdiv;
	  ea[ki+nl[kj]*im] = tmult;
	  
	  for (kk=ki+1; kk<im; kk++)
	    ea[kk+nl[kj]*im] -= ea[kk+kchange*im]*tmult;
	}                                     
    }
  
  /* LU-factorizing performed.  */
  
  *jstat = 0;
  goto out;

/* Singular equation system.  */

warn1 : *jstat = 1;
        goto out;

/* Error in space allocation.  */

err101: *jstat = -101;
        s6err("s6lufacp",*jstat,kpos);
        goto out;

out:

/* Free space occupied by local array.  */

if (smax != SISL_NULL) freearray(smax);

return;
}

//===========================================================================
void s6lusolp(double ea[],double eb[],int nl[],int im,int *jstat)
//===========================================================================
{
  int kpos = 0;      /* Position of error.                             */
  int ki,kj;         /* Counters.                                      */
  double *sx = SISL_NULL; /* Array used to keep solution of equation system
			internally.                                    */
  double tdiv;       /* Dividend in expression.                        */
  
  /* Allocate space for local array.  */
  
  if ((sx = newarray(im,double)) == SISL_NULL) goto err101;
  
  for (ki=0; ki<im-1; ki++)
    {
      /*  Gauss on right side of equation  */
      
      for (kj=ki+1; kj<im; kj++)      
	eb[nl[kj]] -= eb[nl[ki]]*ea[ki+nl[kj]*im];
    }
  
  tdiv = ea[im-1+nl[im-1]*im];
  if (DEQUAL(tdiv,DZERO)) goto warn1;
  sx[im-1] = eb[nl[im-1]]/tdiv;
  
  for (ki=im-2; ki>=0; ki--)
    {
      /*  Backwards substitution.   */
      
      for (kj=ki+1; kj<im; kj++)
	eb[nl[ki]] -= sx[kj]*ea[kj+nl[ki]*im];
      
      tdiv = ea[ki+nl[ki]*im];
      if (DEQUAL(tdiv,DZERO)) goto warn1;
      sx[ki] = eb[nl[ki]]/tdiv;
    }   
  for (ki=0; ki<im; ki++) eb[ki] = sx[ki];
  
  /* Equation system solved.  */
  
  *jstat = 0; 
  goto out;

/* Singular equation system.  */

warn1 : *jstat = 1;
        goto out;

/* Error in space allocation.  */

err101: *jstat = -101;
        s6err("s6lusolp",*jstat,kpos);
        goto out;

out:

/* Free space occupied by local array.  */

if (sx != SISL_NULL) freearray(sx);

return;
}


//===========================================================================
void s1771_s9point(SISLCurve *pcurve,double eval1[],double eval2[],double ediff[],
		   double astart,double aend,int max_it,double *cnext,double *ad,
		   double adel,double *cdist,double aprev,int ileft,int *jstat)
//===========================================================================
{
  int kstat = 0;            /* Local status variable.                      */
  int kdim = pcurve->idim;  /* Dimension of space the curves lie in        */
  int knbit;                /* Number of iterations                        */
  int kdiv = 0;             /* Counts number of diverging steps.           */
  int kdiv2 = 0;            /* Counts number of almost divergence.         */

  /* Correct if we are not inside the parameter intervall. */

  if (*cnext + *ad < astart)    *ad = astart - *cnext;
  else if (*cnext + *ad > aend) *ad = aend - *cnext;

  for (knbit=0;knbit<max_it;knbit++)
    {
      /* Evaluate 0-2.st derivatives of the curve. */

      s1221(pcurve,2,*cnext + *ad,&ileft,eval2,&kstat);
      if (kstat < 0) goto error;

      s6diff(eval1,eval2,kdim,ediff);

      *cdist = s6length(ediff,kdim,&kstat);

      if (*cdist -aprev  <= REL_COMP_RES)
	{
	   if (kdiv2 > 4) break;
	   if (*cdist -aprev >= DZERO) kdiv2++;

	   kdiv = 0;
	  aprev = *cdist;
	  *cnext += *ad;

	  *ad = s1771_s9del(ediff,eval2+kdim,eval2+kdim+kdim,kdim);

	  /* Correct if we are not inside the parameter intervall. */

	  if (*cnext + *ad < astart)    *ad = astart - *cnext;
	  else if (*cnext + *ad > aend) *ad = aend - *cnext;
	}
      else
	{
	   kdiv++;
	   if (kdiv > 3) break;
	  (*ad) /= (double)2;
	  /** knbit--; */
	}
      if (fabs((*ad)/MAX(fabs(*cnext),adel)) <= REL_COMP_RES) break;
    }

  goto out;

  /* Error in lower level routine.  */

  error : *jstat = kstat;
  s6err("s1771_s9point",*jstat,0);
  goto out;

 out:   ;
}

//===========================================================================
double s1771_s9del(double *eco,double *eco1,double *eco2,int idim)
//===========================================================================
{
  double t1,t2,t3,t4,t5,t6;   /* Constants in equation.                    */
  double tmax,tmax1;          /* Max values in equation.                   */
  double ttol=(double)1e-10;  /* Relative tolerance in equation.           */

  t1 =  s6scpr(eco,eco1,idim);
  t3 =  s6scpr(eco1,eco1,idim);
  t2 =  t3 - s6scpr(eco,eco2,idim);
  t4 =  -(double)2 * s6scpr(eco1,eco2,idim);

  tmax  = max(fabs(t1),fabs(t2));
  tmax1 = max(fabs(t3),fabs(t4));
  tmax  = max(tmax1,tmax);

  if (DEQUAL(tmax,DZERO))                    return DZERO;

  else if (fabs(t4)/tmax < ttol) /* The second degree part is degenerated. */
    {
      if (fabs(t2)/tmax < ttol)
	{
          if (fabs(t3)/tmax < ttol)        return DZERO;
          else                             return (t1/t3);
	}
      else                                  return (t1/t2);
    }
  else  /* An ordinary second degree equation.    */
    {
      t5 = t2*t2 - (double)2*t4*t1;
      if (t5 < DZERO)                       return (t1/t3);
      else
	{
          t6 = sqrt(t5);
          t5 = (t2 + t6)/t4;
          t6 = (t2 - t6)/t4;
	  t1 *= t3;


          /* We have two solutions and we want to use the one
	     with the same sign as we get while using an other
	     metode t1/t3. If both solutions have the same
	     sign we use the one with smallest value. */

          if (t1 < DZERO)
	    {
	      if (t5 <= DZERO && t6 <= DZERO)
		{
		  if (t5 > t6)             return t5;
	          else                     return t6;
		}
	      else if (t5 <= DZERO)        return t5;
	      else if (t6 <= DZERO)        return t6;
              else                         return min(t5,t6);
	    }
	  else if (t1 > DZERO)
	    {
	      if (t5 >= DZERO && t6 >= DZERO)
		{
		  if (t5 < t6)             return t5;
	          else                     return t6;
		}
	      else if (t5 >= DZERO)        return t5;
	      else if (t6 >= DZERO)        return t6;
              else                         return max(t5,t6);
	    }
	  else                             return min(fabs(t5),fabs(t6));
	}
    }
}

//===========================================================================
void s6ratder(double eder[],int idim,int ider,double gder[],int *jstat)
//===========================================================================
{
  int kpos=0;          /* Position of error.                     */
  double w0;           /* The denominator.                       */
  int ki;              /* Count through dimensions.              */
  int id;              /* Count through derivatives.             */
  int *binom = SISL_NULL;   /* Array for binomial coefficients.       */
  double sum;          /* Binomial (Leibnitz) expansion.         */
  int idimp1;          /* idim + 1.                              */
  int iw;              /* Pointer to a weight.                   */
  int igder;           /* Pointer to already calculated derivs.  */
  int i,j,k;           /* Counters.                              */
  int iwfix;           /* Initial value of iw in Leibnitz loop.  */

  if (ider<0) goto err178;
  if (idim<1) goto err102;

  idimp1 = idim + 1;

  /* Find denominator. */

  w0 = eder[idim];
  if (DEQUAL(w0,DZERO)) w0 = (double)1.0;

  /* Set up initial binomial coefficient (1). */

  binom = newarray(ider+1, INT);
  if(binom == SISL_NULL) goto err179;

  binom[0] = 1;


  /* Calculate position first. */

  for(ki=0; ki<idim; ki++)
  {
      gder[ki] = eder[ki] / w0;
  }



  /* Then derivatives if there are any. */

  for(id=1,j=idim,k=idimp1; id<=ider; id++,k++)
  {
      /* Calculate the new row of binomial coefficients. */

      binom[id] = 1;

      for(i=id-1; i>=1; i--)
      {
	  binom[i] += binom[i-1];
      }


      /* Run through the idim dimensions, calculating each
	 coefficient of the id'th derivative of
	 the rational curve (in gder). */

      iwfix = k + idim;

      for(ki=0; ki<idim; ki++,j++,k++)
      {
	  /* Calculate the Leibnitz sum (the binomial
	     coefficient in the first term is always 1). */

	  sum = eder[iwfix] * gder[ki];

          for(i=1,igder=idim+ki,iw=iwfix-idimp1;
	  i<id;
	  i++,igder+=idim,iw-=idimp1)
          {
	      sum += (double)binom[i] * eder[iw] * gder[igder];
          }

	  gder[j] = (eder[k] - sum) / w0;

      }

  }

  /* Done. */


  *jstat = 0;
  goto out;

/* idim less than 1. */
 err102: *jstat = -102;
         s6err("s6ratder",*jstat,kpos);
         goto out;

/* Derivative negative */
 err178: *jstat = -178;
         s6err("s6ratder",*jstat,kpos);
         goto out;


/* Not enough memory */
 err179: *jstat = -179;
         s6err("s6ratder",*jstat,kpos);
         goto out;


out:
  if (binom != SISL_NULL) freearray(binom);

  return;
}

//===========================================================================
void s1771(SISLPoint *ppoint,SISLCurve *pcurve,double aepsge,
	   double astart,double aend,double anext,double *cpos,int *jstat)
//===========================================================================
{
  int kstat = 0;         /* Local status variable.                           */
  int kpos = 0;          /* Position of error.                               */
  int kleft=0;           /* Variables used in the evaluator.                 */
  int kdim;              /* Dimension of space the curves lie in             */
  double tdelta;         /* Parameter interval of the curve.                 */
  double tdist;          /* Distance between position and origo.             */
  double td;             /* Distances between old and new parameter value in
			    the two parameter directions.                    */
  double tprev;          /* Previous difference between the curves.          */
  double *sval=SISL_NULL;     /* Value ,first and second derivatie on curve 1    */
  double *sdiff;         /* Difference between the curves                    */
  int quick = (*jstat);  /* Indicates if the exactness requirement is
                            relaxed.                                         */
  int max_it = 20;       /* Maximum number of iterations.                    */

  if (quick) max_it = 10;

  /* Test input.  */

  if (ppoint->idim != pcurve->idim) goto err106;

  kdim = pcurve -> idim;

  /* Fetch endpoints and the intervals of parameter interval of curves.  */

  tdelta = pcurve->et[pcurve->in] - pcurve->et[pcurve->ik - 1];

  /* Allocate local used memory */

  sval = newarray(4*kdim,double);
  if (sval == SISL_NULL) goto err101;

  sdiff = sval + 3*kdim;

  /* Initiate variable.  */

  tprev = (double)HUGE;

  /* Evaluate 0-2.st derivatives of the curve. */

  s1221(pcurve,2,anext,&kleft,sval,&kstat);
  if (kstat < 0) goto error;

  s6diff(ppoint->ecoef,sval,kdim,sdiff);

  tdist = s6length(sdiff,kdim,&kstat);

  td = s1771_s9del(sdiff,sval+kdim,sval+kdim+kdim,kdim);

  /* Correct if we are not inside the parameter intervall. */

  if (anext + td < astart) td = astart - anext;
  else if (anext + td > aend) td = aend - anext;

  s1771_s9point(pcurve,ppoint->ecoef,sval,sdiff,astart,aend,max_it,&anext,
	  &td,tdelta,&tdist,tprev,kleft,&kstat);
  if (kstat < 0) goto error;

  /* Iteration stopped, test if point found is within resolution */

  if (tdist <= aepsge)
    *jstat = 1;
  else
    *jstat = 2;

  *cpos = anext;

  /* Iteration completed.  */

  goto out;

  /* Error in allocation */

 err101: *jstat = -101;
  s6err("s1771",*jstat,kpos);
  goto out;

  /* Error in input. Conflicting dimensions.  */

 err106: *jstat = -106;
  s6err("s1771",*jstat,kpos);
  goto out;

  /* Error in lower level routine.  */

  error : *jstat = kstat;
  s6err("s1771",*jstat,kpos);
  goto out;

 out:    if (sval != SISL_NULL) freearray(sval);
}

//===========================================================================
void s1306(double ep[],double eparp[],double eimpli[],int ideg,
	   double egeo3d[],double egeop[],int *jstat)
//===========================================================================
{
  int fuzzy_sing = FALSE;
  int sing = FALSE;
  int kstat = 0;          /* Local status variable                       */
  int ki,kj,kl;           /* Control variables in loop                   */
  int kpos = 0;           /* Position of error                           */
  int ksize;              /* Number of doubles for storage of derivateves
			     and normal vector */      
  int ksizem3;            /* ksize - 3                                   */
  double *sps;            /* Pointer to dP/ds                            */
  double *spt;            /* Pointer to dP/dt                            */
  double *spss;           /* Pointer to ddP/(dsds)                       */
  double *spst;           /* Pointer to ddP/(dsdt)                       */
  double *sptt;           /* Pointer to ddP/(dtdt)                       */
  double tfs,tft,tfss;    /* Derivatives of parametric surface put into  */
  double tfst,tftt;       /* the implicit equation                       */
  double tsu,ttu,tsuu,ttuu;/* Derivatives of parameter direction         */
  double sder[6];         /* Derivatives of parametric surface           */
  double snorm[3];        /* Normal vector of implicit surface at ep     */
  double sp[9];           /* Points, first and second deriv. of intcur   */
  
  
  /* If ideg=1,2 or 1001 then only derivatives up to second order
     are calculated, then 18 doubles for derivatives and 3 for the
     normal vector are to be used for calculation of points in the
     spline surface. For ideg=1003,1004,1005 we have a silhouette curve and
     derivatives up to the third are to be calculated,
     thus 30 +3 a total of 33 doubles are to be calculated */
  
  if (ideg==1003 || ideg==1004 || ideg==1005)
    {
      ksize = 33;
    }
  else
    {
      ksize = 21;
    }
  ksizem3 = ksize -3;
  
  /* Calculated derivatives of the parametric surface put into the implicit
     surface at the point ep */
  
  s1331(ep,eimpli,ideg,2,sder,snorm,&kstat);
  if (kstat<0) goto error;
  
  tfs  = sder[1];
  tft  = sder[2];
  tfss = sder[3];
  tfst = sder[4];
  tftt = sder[5];
  
  
  /* Calculate ds/du and dt/du */
  /* UJK, aug.92 */
  
  /* if (DEQUAL(tfs,(double)0.0) && 
      DEQUAL(tft,(double)0.0) ) */

  /* UJK, 13.08.93, save suzzy singular information. */
  if (fabs(tfs) < 0.000001 && 
      fabs(tft) < 0.000001) fuzzy_sing = TRUE;
  else
     fuzzy_sing = FALSE;
  
  if (DEQUAL((double)1.0 + tfs,(double)1.0) && 
      DEQUAL((double)1.0 + tft,(double)1.0) )
    {
      double tdum1,tdum2,tafss,tafst,taftt;
      
      /* Singular point found, copy position and derivative value of input to
	 output, if not second order derivatives uniqely describes a tangent*/
      
      memcopy(egeo3d,ep,3,DOUBLE);
      memcopy(egeop,eparp,2,DOUBLE);
      
      tafss = fabs(tfss);
      tafst = fabs(tfst);
      taftt = fabs(tftt);
      
      tdum1 = tfst*tfst - tfss*tftt;
      tdum2 = MAX(tafss,taftt);
      tdum2 = MAX(tafst,tdum2);
      
      for (ki=3 ; ki<10 ; ki++) egeo3d[ki] = DZERO;
      for (ki=2 ; ki<7  ; ki++) egeop[ki]  = DZERO;
      
      if (DEQUAL(tdum2+tdum1,tdum2) &&
	  (DNEQUAL(tafss+tafst,tafst) || DNEQUAL(taftt+tafst,tafst)) )
        {
	  /* A unique tangent can be calculated */
	  
	  if (tafss>taftt)
            {
	      tsu = -tfst/tfss;
	      ttu = 1;
            }
	  else
            {
	      tsu = 1;
	      ttu = -tfst/tftt;
            }
	  tsuu = 0.0;
	  ttuu = 0.0;
	  /* Flag singular case */
	  sing = TRUE;
	}
      else
        {
	  /* A tangent can not be calulated */
	  goto war02;
        }
    }
  else
    {
      /* A noneisngular point found */
      if (fabs(tfs) > fabs(tft))
	{
	  /*  Use u=t */
	  
	  tsu = -tft/tfs;
	  ttu = (double)1.0;   
	  
	  tsuu = -(tfss*tsu*tsu + (double)2.0*tfst*tsu*ttu + tftt*ttu*ttu)/tfs;
	  ttuu = (double)0.0;
	}
      else
	{ 
	  /*  Use u=t */
	  
	  tsu = (double)1.0;
	  ttu = -tfs/tft;  
	  
	  tsuu = (double)0.0;
	  ttuu = -(tfss*tsu*tsu + (double)2.0*tfst*tsu*ttu + tftt*ttu*ttu)/tft;
	}
    }
  
  /* The calculation of the derivatives of one parameter direction with
     respect to the other is dependent on the degree of the implicit equation*/
  
  /* Set local pointers */
  
  sps = ep + 3;
  spt = ep + 6;
  spss = ep + 9;
  spst = ep + 12;
  sptt = ep + 15;
  
  /* Make description of intersection point in 3-D including
     curvature and radius of curvature, first make description of
     intersection point in parameter plane */
  
  /* We will now express the intersection curve locally as a function
   *  of a w-parameter.                                              
   *
   *  c(w) = p(s(w),t(w))
   *
   *  This gives the derivative
   *                         
   *   
   *  c' = P s' + P t'                                                      
   *        s      t
   *
   *  And the second derivative
   *
   *            2                   2
   *  c" = P  s'  + 2P  s't' + P  t' + P s" + P t"
   *        ss        st        tt      s      t  
   */
  
  for (ki=0,kj=3,kl=6 ; ki<3 ; ki++,kj++,kl++)
    {
      
      /*  Copy position */
      
      sp[ki] = ep[ki];
      
      /*  Make tangent  */
      
      sp[kj] = sps[ki]*tsu + spt[ki]*ttu;
      
      /*  Make curvature */
      
      sp[kl] = spss[ki]*tsu*tsu + (double)2.0*spst[ki]*tsu*ttu + 
	sptt[ki]*ttu*ttu + sps[ki]*tsuu + spt[ki]*ttuu;
    }
  
  /* Make 3-D curvature and radius of curvature */
  
  s1307(sp,3,egeo3d,&kstat);
  if (kstat < 0 )goto error;
  
  /* Make description of intersection point in parameter plane including
     curvature and radius of curvature, first make description of
     intersection point in parameter plane */
  
  sp[0] = eparp[0];
  sp[1] = eparp[1];
  sp[2] = tsu;
  sp[3] = ttu;
  sp[4] = tsuu;
  sp[5] = ttuu;
  
  s1307(sp,2,egeop,&kstat);
  if (kstat < 0) goto error;
  
  /* Everyting is ok */
  
  *jstat = 0;
  goto out;
  
  
  /* SISLPoint lying on torus axis */
  
 war02: *jstat=2;
  goto out;
  
  /* Error in lower level function */
 error:
  *jstat = kstat;
  s6err("s1306",*jstat,kpos);
  goto out;
  
 out: 
    if (sing && *jstat>=0) *jstat = 10;
    else if (fuzzy_sing && *jstat>=0) *jstat = 11;
  return;
}

//===========================================================================
void s1313_s9constline(SISLSurf *ps1,double eimpli[],int ideg,
		       double aepsge,SISLIntcurve *pintcr,int icur,
		       int igraph,int *jstat)
//===========================================================================
{
  int ki,kj,kl;            /* Control variables in for loops            */
  int kk,kn,kk1,kn1,kk2,kn2;/* Orders and numbers of knots               */
  int kpoint;              /* Number of points in guide curve           */
  int kleft = 0;           /* Pointer into knot vector                  */
  int kpar1;               /* Number of parameter direction in 1st. obj */
  int kpar2;               /* Number of parameter direction in 2st. obj */
  int ktype;               /* Type of intersection curve                */
  int kpos=0;              /* Position of error                         */
  int kstat;               /* Status variable returned form routine     */
  int kdir=0;              /* constant parameter line direction         */
  int knbpnt;              /* Number of points on constant parameter line */
  double tmax1,tmin1;      /* Minimum and maximum of first comp of guide points */
  double tmax2,tmin2;      /* Minimum and maximum of first comp of guide points */
  double tmax;             /* Maximum 3-D SISLbox side                      */
  double tdist,tang;       /* Distance and angle error                  */
  double *st,*st1,*st2;    /* Pointers to knot vectors                  */
  double *spoint;          /* Pointer to points on constant parameter line */
  double *sp1;             /* Pointer into array                        */
  double tsize1,tsize2;    /* Length of knot intervals                  */
  double sval1[2];         /* Limits of parameter plane in first SISLdir    */
  double sval2[2];         /* Limits of parameter plane in second SISLdir   */
  double sder[6];          /* SISLPoint and derivative on curve             */
  double sider[3];         /* SISLPoint on implicit surface                 */
  double snorm[3];         /* Normal on implicit surface                */
  double tsumold,tsum,tval;/* Parameter values                    */
  double *sgpar1=SISL_NULL;     /* Parameter pairs of guide point in surf 1  */
  double *sgpar2=SISL_NULL;     /* Parameter pairs of guide point in surf 2  */
  SISLCurve *qc1=SISL_NULL;         /* Pointer to 3-D curve                     */
  SISLCurve *qc2=SISL_NULL;         /* Pointer to 3-D curve                     */

  SISLCurve *qp1cur=SISL_NULL;      /* Pointer to curve in first parameter plane*/



  /* Make maximal step length based on box-size of surface */

  sh1992su(ps1,0,aepsge,&kstat);
  if (kstat < 0) goto error;

  tmax = MAX(ps1->pbox->e2max[0][0] - ps1->pbox->e2min[0][0],
	     ps1->pbox->e2max[0][1] - ps1->pbox->e2min[0][1]);
  tmax = MAX(tmax,ps1->pbox->e2max[0][2] - ps1->pbox->e2min[0][2]);

  /* Find a none singular start point for the marching process */

  kpoint = pintcr->ipoint;
  kpar1  = pintcr->ipar1;
  kpar2  = pintcr->ipar2;
  sgpar1 = pintcr->epar1;
  sgpar2 = pintcr->epar2;
  ktype  = pintcr->itype;


  /* Initiate pointers to intersection curve and intersection curve in
     parameter plane */

  pintcr -> pgeom = SISL_NULL;
  pintcr -> ppar1 = SISL_NULL;
  pintcr -> ppar2 = SISL_NULL;


  /* Initiate parameter direction boundaries */
  kk1    = ps1 -> ik1;
  kn1    = ps1 -> in1;
  st1    = ps1 -> et1;
  sval1[0] = st1[kk1-1];
  sval1[1] = st1[kn1];
  kk2    = ps1 -> ik2;
  kn2    = ps1 -> in2;
  st2    = ps1 -> et2;
  sval2[0] = st2[kk2-1];
  sval2[1] = st2[kn2];


  /* Test that first object has 2 parameter
     direction and second object 0 */

  if (kpar1 == 2 && kpar2 == 0)
    {
      /*  Everithing is ok */
      ;
    }
  else if (kpar1 == 0 && kpar2 == 2)
    {
      sgpar1 = sgpar2;
    }
  else
    {
      goto err123;
    }


  /* Run through the parameter pairs to decide if a constant parameter line
     is possible */

  tmax1 = tmin1 = sgpar1[0];
  tmax2 = tmin2 = sgpar1[1];

  for (ki=1,kj=2,kl=3 ; ki < kpoint ; ki++,kj+=2,kl+=2)
    {
      tmin1 = MIN(tmin1,sgpar1[kj]);
      tmax1 = MAX(tmax1,sgpar1[kj]);
      tmin2 = MIN(tmin2,sgpar1[kl]);
      tmax2 = MAX(tmax2,sgpar1[kl]);
    }

  tsize1 = st1[kn1] - st1[kk1-1];
  tsize2 = st2[kn2] - st2[kk2-1];

  /* Check if constant parameter value within tolerance */

  if (DEQUAL((tmin1+tsize1),(tmax1+tsize1)) )
    {
      /*  Intersection possible constant parameter line with first parameter
	  constant value constant.

	  1. Pick out curve from surface
	  2. Pick out relevant part of curve */

      kdir = 1;

      s1437(ps1,(tmin1+tmax1)/2.0,&qc1,&kstat);
      if (kstat < 0) goto error;

      s1712(qc1,tmin2,tmax2,&qc2,&kstat);
      if (kstat < 0) goto error;
    }
  else if (DEQUAL((tmin2+tsize2),(tmax2+tsize2)) )
    {
      /*  Intersection possible constant parameter line with first parameter
	  constant value constant.

	  1. Pick out curve from surface
	  2. Pick out relevant part of curve */

      kdir = 2;

      s1436(ps1,(tmin2+tmax2)/2.0,&qc1,&kstat);
      if (kstat < 0) goto error;

      s1712(qc1,tmin1,tmax1,&qc2,&kstat);
      if (kstat < 0) goto error;
    }
  else
    goto war00;

  st = qc2 -> et;
  kk = qc2 -> ik;
  kn = qc2 -> in;

  /* Run through 2*kn points of the curve and check that they lie in the
     implicit surface by calculating the 2*kn points. */

  tsumold = st[kk-1];

  for (ki=0 ; ki <kn ; ki++)
    {
      if (kk>1)
	{
	  /* Make parameter value to use for calculation of curve point */

	  for (kl=1,kj=ki+1,tsum=(double)0.0 ; kl<kk ; kl++)
	    tsum += st[kj++];

	  tsum = tsum/(kk-1);
	}
      else
	tsum = st[ki];

      tval = tsum;

      for (kj=0 ; kj<2 ; kj++)
	{
	  /* Calculate point on curve */

	  s1221(qc2,1,tval,&kleft,sder,&kstat);
	  if (kstat < 0) goto error;

	  /* Calculate normal to implicit surface */

	  s1331(sder,eimpli,ideg,-1,sider,snorm,&kstat);
	  if (kstat < 0) goto error;

	  /* Project point onto implicit surface */

	  tdist = fabs(s1309(sder,snorm,eimpli,ideg,&kstat));
	  if (kstat<0) goto error;
	  if (kstat==2) goto war00;

	  /* Both the position of the two points should be within the relative
	     computer resolution for the point to be accepted. Correspondingly the
	     direction of the intersection curve and the constant parameter line
	     should be within the computer resolution to be accepted. */

	  if (DNEQUAL(tdist+tmax,tmax))
	    goto war00;

	  /* Distance within tolerance, check that the angle between surface
	     normal and curve tangent is PIHALF, if both these vectors have a
	     nonzero length. */

	  if (s6length(snorm,3,&kstat) != (double)0.0 &&
	      s6length(sder+3,3,&kstat) != (double)0.0  )
	    {
	      tang = s6ang(snorm,sder+3,3);
	      if (DNEQUAL(fabs(tang),PIHALF) ) goto war00;
	    }
	  tval = (tsumold+tsum)/(double)2.0;
	}
      tsumold = tsum;
    }

  /* Intersection curve along constant parameter line, make right actions
     concerning drawing and/or creation of the curve */

  if (igraph == 1)
    {
      /* Draw curve, first break into straight line segments */

      s1605(qc2,aepsge,&spoint,&knbpnt,&kstat);
      if (kstat < 0) goto error;

      if (knbpnt>1)
	{
	  /* Draw curve */

	  s6move(spoint);
	  for (ki=1,sp1=spoint+3 ; ki<knbpnt ; ki++,sp1+=3)
	    s6line(sp1);
	}
      freearray(spoint);
    }

  if (icur >= 1)
    {
      /* Set pointer to 3-D curve */

      pintcr -> pgeom = qc2;
      qc2 = SISL_NULL;
    }

  if (icur == 2)
    {
      /* Make curve in parameter plane */

      double svert[4],sknot[4];

      if (kdir==1)
	{
	  svert[0] = svert[2] = (tmin1+tmax1)/(double)2.0;
	  svert[1] = tmin2;
	  svert[3] = tmax2;
	  sknot[0] = sknot[1] = tmin2;
	  sknot[2] = sknot[3] = tmax2;
	}
      else
	{
	  svert[0] = tmin1;
	  svert[2] = tmax1;
	  svert[1] = svert[3] = (tmin2+tmax2)/(double)2.0;
	  sknot[0] = sknot[1] = tmin1;
	  sknot[2] = sknot[3] = tmax1;
	}
      qp1cur = newCurve(2,2,sknot,svert,1,2,1);
      if (qp1cur==SISL_NULL) goto err101;
      pintcr -> ppar1 = qp1cur;
    }

  /* war01: */
  *jstat = 1;
  goto out;

  /* Iteration can not continue */
 war00:  *jstat = 0;
  goto out;


  /* Error in space allocation */
 err101: *jstat = -101;
  s6err("s1313",*jstat,kpos);
  goto out;

  /* Error in surface description parameter direction does not exist */
 err123: *jstat = -123;
  s6err("s1313_s9constline",*jstat,kpos);
  goto out;

  /* Error in lower leve function */
 error:
  *jstat = kstat;
  s6err("s1313_s9constline",*jstat,kpos);
  goto out;

 out:;
  if (qc1 != SISL_NULL) freeCurve(qc1);
  if (qc2 != SISL_NULL) freeCurve(qc2);
}


//===========================================================================
void s9iterimp(double epoint[],double epnt1[],double epar1[],SISLSurf *psurf1,
	       double eimpli[],int ideg,double astep,double aepsge,
	       double gpnt1[],double gpar1[],int *jstat)
//===========================================================================
{
  int ki;                 /* Variable used in loop                          */
  int kcont;              /* Indicator telling if iteration is not finished */
  int kder = 1;           /* Derivative indicator                           */
  int klfu=0;             /* Pointer into knot vector                       */
  int klfv=0;             /* Pointer into knot vector                       */
  int kstat;              /* Status variable                                */
  int knbit;              /* Counter for number of iterations               */
  int kdim = 3;           /* Set dimension to 3                             */
  int kmaxit = 100;       /* Maximal number of iterations allowed           */
  int kpos=1;             /* Position indicator ofr errors                  */
  int ksing;              /* Singularity indicator                          */
  int ksize;              /* Number of doubles for storage of derivateves
			     and normal vector */
  int ksizem3;            /* ksize - 3                                      */
  double spoint[3];       /* SISLPoint in intersection plane                    */
  double *snorm;          /* Pointer to normal vector of intersection plane */
  double sbinorm[3];      /* Vector normal tu curve tangent                 */
  double *sp,*spu,*spv,*spn; /* Pointers into gpnt1                         */
  double sprev[3];        /* Coordinates of previous point in iteration     */
  double ta11,ta12,ta21;  /* Variables used in equation systems             */
  double ta22,tb1,tb2;    /* Variables used in equation systems             */
  double sdiff[3];        /* Difference between two vectors                 */
  double tdum,tdum1;      /* Dummy variables                                */
  double tdist;           /* Error so fare in iteration                     */
  double tcurdst;         /* Error at current step in the iteration         */
  double sder[3];         /* Derivatives of comb. of impl. surf and par.surf*/
  double sproj[3];        /* Projection direction                           */
  double tlnorm;          /* Length of normal vector of step plane          */
  double tdiststep;       /* Distance from step plane                       */
  double titer;           /* Iteration criteria                             */
  
  /* If ideg=1,2 or 1001 then only derivatives up to second order
     are calculated, then 18 doubles for derivatives and 3 for the
     normal vector are to be used for calculation of points in the
     spline surface. For ideg=1003,1004,1005 we have a silhouette curve and
     derivatives up to the third are to be calculated,
     thus 30 +3 a total of 33 doubles are to be calculated */
  
  if (ideg==1003 || ideg==1004 || ideg==1005)
    {
      kder = 3;
      ksize = 33;
    }
  else
    {
      ksize = 21;
      kder =2;
    }                                                       
  ksizem3 = ksize -3;
  
  /* Make description of intersection plane */
  
  tlnorm = s6length(epoint+3,3,&kstat);
  if (kstat<0) goto error;
  if (DEQUAL(tlnorm,DZERO)) tlnorm = (double)1.0;
  
  for (ki=0;ki<3;ki++)
    {
      spoint[ki] = epoint[ki] + astep*epoint[ki+3]/tlnorm;
    }
  
  snorm = epoint + 3;
  
  /* Copy input variables to output variables */
  
  memcopy(gpnt1,epnt1,ksize,DOUBLE); 
  memcopy(gpar1,epar1,2,DOUBLE); 
  
  /* At the start of the iteration the point gpnt1 is put into both implicit
     equations */
  
  /* Set a number of local pointers that are used often */
  sp  = gpnt1;
  spu = gpnt1 + 3;
  spv = gpnt1 + 6;
  spn = gpnt1 + ksizem3;
  
  kcont = 1;
  knbit = 0;
  
  while (kcont)
    
    {             
      
      /* For all degrees we have to put the B-spline surface into the plane
	 determining the step length before we branch degree on the degree
	 of the implicit surface. */
      
      ta21 = s6scpr(spu,snorm,kdim);
      ta22 = s6scpr(spv,snorm,kdim);
      s6diff(spoint,sp,kdim,sdiff);
      tb2  = s6scpr(sdiff,snorm,kdim);
      tdum = max(fabs(ta21),fabs(ta22));
      tdum = max(tdum,fabs(tb2));
      if (DEQUAL(tdum,DZERO)) tdum = (double)1.0;
      ta21 /= tdum;
      ta22 /= tdum;
      tb2  /= tdum;
      
      
      /* Calculate value and derivatives of the parametric surface put into
	 the equation of the implicit surface */
      
      s1331(gpnt1,eimpli,ideg,1,sder,sproj,&kstat);
      
      ta11 = sder[1];
      ta12 = sder[2];
      tb1  = -sder[0];
      
      tdum = max(fabs(ta11),fabs(ta12));
      tdum = max(tdum,fabs(tb1));
      if (DEQUAL(tdum,DZERO)) tdum = (double)1.0;
      ta11 /= tdum;
      ta12 /= tdum;
      tb1  /= tdum;
      
      
      /* Calculate determinant of equation system */
      
      tdum1 = ta11*ta22 - ta12*ta21;
      tdum  = MAX(fabs(ta11),fabs(ta22));
      tdum  = MAX(fabs(ta12),tdum);
      tdum  = MAX(fabs(ta21),tdum);
      
      if (DEQUAL((tdum+tdum1),tdum)) tdum1 =DZERO;
      
      
      /* If tdum1 = 0.0, then the equation system is singular, try an
	 alternative setup of the equation system */
      
      if (tdum1 == DZERO && ideg < 1003)
        {
	  s6crss(sproj,snorm,sbinorm);
	  ta11 = s6scpr(spu,sbinorm,kdim);
	  ta12 = s6scpr(spv,sbinorm,kdim);
	  tb1  = s6scpr(sdiff,sbinorm,kdim);
	  
	  tdum = max(fabs(ta11),fabs(ta12));
	  tdum = max(tdum,fabs(tb1));
	  if (DEQUAL(tdum,DZERO)) tdum = (double)1.0;
	  ta11 /= tdum;
	  ta12 /= tdum;
	  tb1  /= tdum;
	  
	  /* Calculate determinant of equation system */
	  
	  tdum1 = ta11*ta22 - ta12*ta21;
	  tdum  = MAX(fabs(ta11),fabs(ta22));
	  tdum  = MAX(fabs(ta12),tdum);
	  tdum  = MAX(fabs(ta21),tdum);
	  
	  if (DEQUAL((tdum+tdum1),tdum)) tdum1 =DZERO;
        }
      
      if (DNEQUAL(tdum1,DZERO))
        {
	  gpar1[0] += (tb1*ta22-tb2*ta12)/tdum1;
	  gpar1[1] += (ta11*tb2-ta21*tb1)/tdum1;
        }
      
      /* Calculate value of new points */
      
      s1421(psurf1,kder,gpar1,&klfu,&klfv,gpnt1,gpnt1+ksizem3,&kstat); 
      if (kstat<0) goto error;
      
      /* If the surface normal has zero length no use in continuing */
      
      if (kstat == 2) goto war02;
      
      
      tcurdst = s1309(gpnt1,sproj,eimpli,ideg,&kstat);
      if (kstat < 0) goto error;
      if (kstat ==2) goto war02;
      
      tcurdst = fabs(tcurdst);
      
      /* Calculate distance from step plane */
      
      s6diff(spoint,gpnt1,kdim,sdiff);
      tdiststep  = fabs(s6scpr(sdiff,snorm,kdim)/tlnorm);
      
      
      /* tcurdst now contains the distance between the point in the parametric
	 surface and the projection along sproj of this point onto the implicit
	 surface if ideg== 1,2 or 1001. In the case ideg==1003,1004,1005 we have a
	 silhouette line and tcurdst contains the angle PI minus the angle 
	 between the view direction and the normal of the surface */
      
      /* We continue iteration so long as the error titer is not decreasing */
      
      
      if (ideg==1003 || ideg==1004 || ideg==1005)
        {
	  /* tcurdst contains an angle and is compared with ANGULAR_TOLERANCE,
	     while tdiststep contains a distance and is compared with aepsge.
	     To make a measure of these that is consistent they have to have
	     the same unit measure thus we make.   */
	  
	  titer = tcurdst*aepsge + tdiststep*ANGULAR_TOLERANCE;
        }
      else
        titer = tcurdst + tdiststep;
      
      if (DEQUAL(tcurdst,DZERO) && DEQUAL(tdiststep,DZERO))
        {
	  /* Length is zero iteration has converged   */
	  kcont = 0;
        }
      
      if (knbit==0)
        {
	  /* First iteration intitate distance variable, if the equation
	     systems were not singular */

	  if (DEQUAL(tdum1,DZERO)) goto war02;
	  tdist = titer;
	  knbit = 1;
        }
      else
        {
	  /* More than one iteration done, stop if distance is not decreasing.
	     Then decide if we converge distance between the points is within
	     the tolerance and the last step had singular or none singular
	     equation systems. */

	  knbit = knbit + 1;
	  if (titer>=tdist)
            {
	      /* Distance is not decreasing */

	      if (fabs(s6dist(sprev,gpnt1,kdim)) <= aepsge)
                {               
		  /* Distance within tolerance */
		  
		  /* Check if singularity reached. 
		     This is the case if tdum1=0.0
		     or if the relative distance between
		     the input point and
		     the output point is within the 
		     relative computer resolution */

		  ksing = 1;
		  for (ki=0 ; ki<3; ki++)
                    {
		      tdum = MAX(fabs(epnt1[ki]),fabs(gpnt1[ki]));
		      if (DEQUAL(tdum,DZERO)) tdum = (double)1.0;
		      if(fabs(epnt1[ki]-gpnt1[ki])/tdum > REL_COMP_RES)
                        ksing = 0;
                    }
		  if (DEQUAL(tdum1,DZERO) || ksing == 1)
                    {
		      /* Singular equation system */
		      goto war01;
                    }
		  else
                    {
		      /* Nonsingular equation system */
		      goto war00; 
                    }
                }
	      else
                {
		  /* Distance is not within tolerance, divergence */
		  goto war02;
                }
            }
	  /* Distance still decreasing */
	  
	  tdist = titer;
        }
      
      /*  Make sure that not to many iteration are being done */
      if (knbit > kmaxit) goto war02;
      /*  Remember this point */
      memcopy(sprev,gpnt1,3,DOUBLE);
    }
  
  /* Iteration converged, calculate also second derivatives */
 war00:
  
  kder = 2;
  s1421(psurf1,kder,gpar1,&klfu,&klfv,gpnt1,gpnt1+ksizem3,&kstat); 
  if (kstat<0) goto error;
  
  *jstat = 0;
  goto out;
  
  /* Iteration converged, singular point found */
 war01: 
  *jstat = 1;
  goto out;
  
  /* To many iterations or iteration diverging */
 war02: 
  *jstat = 2;
  goto out;
  
  /* Error in lower level routine.  */
  
  error : 
    *jstat = kstat;
  s6err("s9iterimp",*jstat,kpos);
  goto out;
  
 out:
  return;
}

//===========================================================================
double s9adsimp(double epnt1[],double epar1[],double eimpli[],int ideg,double egd1[],
		double epgd1[],double etang[],double eptan[],double astep,int *jstat)
//===========================================================================
{
  int kpos=1;              /* Position indicator for errors           */
  int kstat;               /* Dummy status variable                   */
  int kdim=3;              /* This routine is only working in 3-D     */
  int k2dim=2;             /* Dimension of parameter plane            */
  int ksize;               /* Number of doubles for storage of derivateves
			      and normal vector */
  int ksizem3;             /* ksize - 3                               */
  double tdum;             /* Variable for storage of reals           */
  double tdist=(double)0.0;/* Distance between guide point and point  */
  double sdiff[3];         /* Vector for difference between two points*/
  double scr1[3],scr2[3];  /* Normal vectors                          */
  double snorm[3];         /* Normal vector                           */
  
  
  /* If ideg=1,2 or 1001 then only derivatives up to second order
     are calculated, then 18 doubles for derivatives and 3 for the
     normal vector are to be used for calculation of points in the
     spline surface. For ideg=1003,1004,1005 we have a silhouette curve and
     derivatives up to the third are to be calculated,
     thus 30 +3 a total of 33 doubles are to be calculated */
  
  if (ideg==1003 || ideg==1004 || ideg==1005)
    {
      ksize = 33;
    }
  else
    {
      ksize = 21;
    }
  ksizem3 = ksize -3;
  
  /* First see that we are not turning direction in the parameter plane */
  
  s6diff(epgd1,epar1,k2dim,sdiff);
  if (s6scpr(sdiff,eptan,k2dim) < DZERO) goto dontstepthrough;
  
  s6diff(egd1,epnt1,kdim,sdiff);
  tdum  = s6scpr(sdiff,etang,kdim);
  tdist = s6length(sdiff,kdim,&kstat);
  
  /* Step onto point if it is within 2.0*aepsge */
  
  if (tdum > DZERO)
    {
      if (DZERO < tdist && tdist <= (double)2.0*astep)
        {
	  /* Guide point lies within step length and in step direction, test
	     if cross products of normal vectors at current point and guide point
	     point in the same direction, this is not possible to test on for
	   silhouette curves */
	  
	  if (ideg < 1003)
            {
	      
	      /* Make normal to implicit surface at epnt1 */
	      s1308(epnt1,3,eimpli,ideg,snorm,&kstat);
	      if (kstat<0) goto error;
	      
	      /* Make cross product of normals in start point */
	      s6crss(epnt1+ksizem3,snorm,scr1);
	      
	      
	      /* Make normal to implicit surface at epnt1 */
	      s1308(epnt1,3,eimpli,ideg,snorm,&kstat);
	      if (kstat<0) goto error;
	      
	      /* Make cross product of normals in guide point */
	      s6crss(egd1+ksizem3,snorm,scr2);
	      
	      
	      /* Make scalar product of these two vectors     */
	      tdum = s6scpr(scr1,scr2,kdim);
	      if (kstat<0) goto error;
	      
	      /* If positive scalar product the curve at the two points point in
		 the same direction, step through point */
	      if (tdum > DZERO) goto stepthrough;
	      else if (tdum == DZERO)
                {
		  
		  double tl1,tl2;
		  
		  /* Vectors orthogonal or at least one has length zero */
		  
		  tl1 = s6length(scr1,kdim,&kstat);
		  tl2 = s6length(scr2,kdim,&kstat);
		  
		  if (tl1 != DZERO && tl2 != DZERO)
		    goto dontstepthrough;
		  else if (tl1 == DZERO && tl2 == DZERO)
		    goto stepthrough;
		  else if (tl2 == DZERO)
		    goto stepthrough;
		  else if (tl2 != DZERO)
		    {
		      /* Test if scr2 points in the direction from start */
		      
		      tl1 = s6scpr(sdiff,scr2,kdim);
		      
		      if (tl1 < DZERO)
			goto dontstepthrough;
		      else 
			goto stepthrough;
		    }
                }
            }
	  else
            goto stepthrough;
        }
    }
  
 dontstepthrough:
  
  *jstat = 0;
  goto out;
  
 stepthrough:
  *jstat = 1;
  goto out;
  
  /* Error in lower leve function */
 error:
  *jstat = kstat;
  s6err("s9adsimp",*jstat,kpos);
  goto out;
  
 out:
  return(tdist);
}

//===========================================================================
void s1331(double ep[],double eimpli[],int ideg,int ider,
	   double gder[],double gnorm[],int *jstat)
//===========================================================================
{
  int kstat = 0;          /* Local status variable                       */
  int ki,kj,kl;           /* Control variables in loop                   */
  int kpos = 0;           /* Position of error                           */
  int ksize;              /* Number of doubles for storage of derivateves
			     and normal vector */
  int ksizem3;            /* ksize - 3                               */
  double *spu;            /* Pointer to dP/ds                            */
  double *spv;            /* Pointer to dP/dt                            */
  double *spuu;           /* Pointer to ddP/(dsds)                       */
  double *spuv;           /* Pointer to ddP/(dsdt)                       */
  double *spvv;           /* Pointer to ddP/(dtdt)                       */
  
  
  /* If ideg=1,2 or 1001 then only derivatives up to second order
     are calculated, then 18 doubles for derivatives and 3 for the
     normal vector are to be used for calculation of points in the
     spline surface. For ideg=1003,1004,1005 we have a silhouette curve and
     derivatives up to the third are to be calculated,
     thus 30 +3 a total of 33 doubles may be calculated.
     Note, gnorm in these cases is replaced by f P - f P
                                                v u   u v
     so we need ideg to be at least 1. */
  
  if (ideg == 1003 || ideg == 1004 || ideg == 1005)
    {
      ksize = 33;
      ider=max(ider,1);
    }
  else
    {
      ksize = 21;
    }

  ksizem3 = ksize -3;
  
  /* The calculation of the derivatives of one parameter direction with
   *  respect to the other is dependent on the degree of the implicit equation
   */
  
  /* Set local pointers */
  
  spu = ep + 3;
  spv = ep + 6;
  spuu = ep + 9;
  spuv = ep + 12;
  spvv = ep + 15;
  
  if (ideg == 1)
    {
      /*  First degree implicit geometry. 
       *
       *   Let A = (eimpli[0],eimpli[1],eimpli[2],eimpli[3]) and
       *       Q= (P(s,t),1), 
       *   then putting  Q into the implicit equation gives
       *
       *    f(u,v) = A Q
       *
       *    df         dQ
       *    --     = A -- = N P , where N is the normal vector of the plane.
       *    du         du      u
       *
       *    df         dQ
       *    --     = A -- = N P 
       *    dv         dv      v
       *
       *     2          2
       *    d f        d Q
       *    --     = A --- = N P 
       *      2          2      uu
       *    du         du     
       *
       *     2          2
       *    d f        d Q
       *    --     = A --- = N P 
       *    dudv       dudv     uv
       *
       *     2          2
       *    d f        d Q
       *    --     = A --- = N P 
       *      2          2      vv
       *    dv         dv     
       *
       */
      if (ider>=0)
        {
	  gder[0] = s6scpr(ep,eimpli,3) + eimpli[3];
	  if (ider>=1)
            {
	      gder[1] = s6scpr(spu,eimpli,3);
	      gder[2] = s6scpr(spv,eimpli,3);
	      if (ider>=2)
                {
		  gder[3] = s6scpr(spuu,eimpli,3); 
		  gder[4] = s6scpr(spuv,eimpli,3);
		  gder[5] = s6scpr(spvv,eimpli,3); 
                }
            }
        }
      memcopy(gnorm,eimpli,3,DOUBLE);
    }
  else if (ideg == 2)
    {   
      double sq[4],sduq[4],sdvq[4];    /*vectors*/
      double tsum1,tsum2,tsum3;        /*Accumulation of matrix product */ 
      
     /*  Second degree implicit geometry.
     *   Denote the 4x4 matrix representing the implicit surface a A.*
     *
     *   We can now calculate the u and v derivatives of the point put into
     *   the left hand side of the implicit surface equation:
     *
     *            T              T
     *      f(u,v) = Q A Q = sq Q 
     *
     *      d        d        T      dQ    T        dQ
     *      - f    = -- (Q A Q ) = 2 -- A Q  = 2 sq --
     *      du       du              du             du
     *
     *      d        d        T      dQ    T        dQ
     *      - f    = -- (Q A Q ) = 2 -- A Q  = 2 sq --
     *      dv       dv              dv             dv
     *
     *       2        2               2                  T        2
     *      d        d        T      d Q    T     dQ   dQ       dQ        dQ
     *      -- f   = -- (Q A Q ) = 2 --- A Q  + 2 -- A -- = 2(sq--- + sduq--)
     *        2        2               2          du   du         2       du
     *      du       du              du                         du
     *                                                          
     *       2        2                 2               T        2
     *      d        d          T      d Q    T    dQ dQ        d Q        dQ
     *      --  f  = --   (Q A Q ) = 2 ----AQ  + 2 --A--  = 2(sq---- + sduq--)
     *      dudv     dudv              dudv        du dv        dudv       dv
     *
     *       2        2               2                  T        2
     *      d        d        T      d Q    T     dQ   dQ       dQ        dQ
     *      -- f   = -- (Q A Q ) = 2 --- A Q  + 2 -- A -- = 2(sq--  + sdvq--)
     *        2        2               2          dv   dv         2       dv
     *      dv       dv              dv                         dv
     *
     *                                       dQ             dQ
     *      First calculate sq = QA, sduq =  --A and sdvq = --A
     *                                      du             dv
     *
     */
      for (ki=0;ki<4;ki++)
        {
	  tsum1 = eimpli[ki+12];
	  tsum2 = DZERO;
	  tsum3 = DZERO;
	  for (kj=0,kl=ki;kj<3;kj++,kl+=4)
            {
	      tsum1 += eimpli[kl]*ep[kj];
	      if (ider>=1)
                {
		  tsum2 += eimpli[kl]*spu[kj];
		  tsum3 += eimpli[kl]*spv[kj];
                }
            }
	  sq[ki]   = tsum1;
	  sduq[ki] = tsum2;
	  sdvq[ki] = tsum3;
        }
      
      /*  Make value and partial derivatives */
      
      if (ider>=0)
        {
	  gder[0] = s6scpr(sq,ep,3) + sq[3];
	  if(ider>=1)
            {
	      gder[1] = (double)2.0*s6scpr(sq,spu,3);
	      gder[2] = (double)2.0*s6scpr(sq,spv,3);
	      if (ider>1)
                {
		  gder[3] = (double)2.0*(s6scpr(sq,spuu,3) + 
					 s6scpr(sduq,spu,3));
		  gder[4] = (double)2.0*(s6scpr(sq,spuv,3) + 
					 s6scpr(sduq,spv,3));
		  gder[5] = (double)2.0*(s6scpr(sq,spvv,3) + 
					 s6scpr(sdvq,spv,3));
                }
            }
        }
      memcopy(gnorm,sq,3,DOUBLE);
    }
  
  else if (ideg == 1001)
    {
      double sy[3],sz[3],szu[3],szv[3],szuu[3],szuv[3],szvv[3];/* Derivatives */
      double tzn,tzun,tzvn,tzuun,tzuvn,tzvvn;            /* Scalar products */
      double tzduz,tzdvz,tzduduz,tzdudvz,tzdvdvz;        /* Scalar products */
      double tduzduz,tdvzdvz,tduzdvz;                    /* Scalar products */
      double tlenz,tlenz3,tlenz5;                        /* Vector lengths  */
      double sp[3],sdup[3],sdvp[3];                      /* temporary vectrs*/ 
      double sdudup[3],sdudvp[3],sdvdvp[3];              /* temporary vectrs*/ 
      double *scentr,*saxis,tbigr,tsmalr;                /* Torus descript  */

      /*  Torus surface. */
      
      scentr = eimpli;
      saxis  = eimpli + 3;
      tbigr  = *(eimpli+6);
      tsmalr = *(eimpli+7);
      
      
/*     Intersection of implicit function of 1 and implicit torus surface
*      and the the surface. Make the following temporary variables.
*
*      y = p - scentr
*      z = y - (y saxis) saxis
*
*      Put the point and accompanying derivatives into the implicit
*      representation of the torus
*
*                                   2    2
*      f(u,v) = (y - R z/sqrt(z z) )  - r
* 
*
*                                                                
*                                    R z          (z z )
*      df            R z                u      R z    u
*      -- = 2(y - ---------)(y  -  --------- + ----------)
*      du         sqrt(z z)   u    sqrt(z z)            3
*                                              sqrt(z z)
*
*         = 2 sp sdup
*
*
*                                 R z            (z z ) 
*      df            R z             v        R z    v
*      -- = 2(y - ---------)(y  - --------- + ----------)
*      dv         sqrt(z z)   v   sqrt(z z)            3
*                                             sqrt(z z)
*
*         = 2 sp sdvp
*
*
*
*                                                                
*       2             R z            (z z )
*      d f               u      R z      u  2
*      --  = 2(y  - --------- + -----------)  + 
*        2      u   sqrt(z z)             3
*      du                        sqrt(z z)
*
*
*                                    R z           z (z z )
*                     R z               uu      2R  u    u
*            2(y - ---------)(y   - --------- + ----------- +
*                  sqrt(z z)   uu   sqrt(z z)             3
*                                                sqrt(z z)
*
*
*                                                       2
*                            R z(z z +zz  )       z(zz )
*                                 u u   uu      R     u
*                            -------------- - 3 --------- )
*                                        3               5
*                               sqrt(z z)       sqrt(z z)
*
*          = 2 sdup sdup + sp sdudup 
*
*                                                                
*       2               R z           (z z )          R z           (z z )
*      d  f                u      R z     u              v      R z     v   
*      ----  = 2(y  - --------- + -----------)(y  - --------- + -----------) +
*                 u   sqrt(z z)             3   v   sqrt(z z)             3
*      dudv                        sqrt(z z)                    sqrt(z z) 
*
*
*                                   R z           z (z z )       z (z z )
*                    R z               uv       R  u    v      R  v    u
*           2(y - ---------)(y   - --------- + ------------ + ------------ +
*                 sqrt(z z)   uv   sqrt(z z)             3              3
*                                               sqrt(z z)      sqrt(z z) 
*
*
*                                                        
*                            R z(z z +zz  )       z(zz )(zz )
*                                 v u   uv      R     u    v
*                            -------------- - 3 -------------)
*                                        3                 5
*                               sqrt(z z)         sqrt(z z)
*
*
*          = 2 sdup sdvp + sp sdudvp 
*
*                                                                
*       2             R z           (z z )
*      d f               v      R z     v   2
*      --  = 2(y  - --------- + -----------)  + 
*        2      v   sqrt(z z)             3
*      dv                        sqrt(z z)
*
*
*                                    R z            z (z z )
*                     R z               vv       2R  v    v
*            2(y - ---------)(y   - --------- + ------------ +
*                  sqrt(z z)   vv   sqrt(z z)             3
*                                                sqrt(z z)
*
*
*                                                       2
*                             R z(z z +zz  )       z(zz )
*                                  v v   vv      R     v
*                             -------------- - 3 --------- )
*                                         3               5
*                                sqrt(z z)       sqrt(z z)
*
*
*          = 2 sdvp sdvp + sp sdvdvp 
*
*
*                          
*      y  = (p - scentr)  = p
*       u               u    u
*
*      y  = (p - scentr)  = p
*       v               v    v
*
*      y  = (p - scentr)  = p
*       uu              uu   uu
*
*      y  = (p - scentr)  = p
*       uv              uv   uv
*
*      y  = (p - scentr)  = p
*       vv              vv   vv
*
*      z  = (y - (y N)N)  = p  - (p N)N          N = saxis (Torus axis)
*       u               u    u     u
*
*      z  = (y - (y N)N)  = p  - (p N)N
*       v               v    v     v
*
*      z  = (y - (y N)N)  = p  - (p  N)N
*       uu              uu   uu    uu
*
*      z  = (y - (y N)N)  = p  - (p  N)N 
*       uv              uv   uv    uv
*
*      z  = (y - (y N)N)  = p  - (p  N)N
*       vv              vv   vv    vv
*
*/
      for (ki=0;ki<3;ki++)
        sy[ki] = ep[ki] - scentr[ki];
      
      tzn   = s6scpr(sy  ,saxis,3);
      tzun  = s6scpr(spu ,saxis,3);
      tzvn  = s6scpr(spv ,saxis,3);
      if (ider>1)
        {
	  tzuun = s6scpr(spuu,saxis,3);
	  tzuvn = s6scpr(spuv,saxis,3);
	  tzvvn = s6scpr(spvv,saxis,3);
        }
      
      /*  Make z and necessary derivatives of z */ 
      for (ki=0;ki<3;ki++)
        {    
	  sz[ki]   = sy[ki]   - tzn*saxis[ki];
	  szu[ki]  = spu[ki]  - tzun*saxis[ki];
	  szv[ki]  = spv[ki]  - tzvn*saxis[ki];
	  if (ider>1)
            {
	      szuu[ki] = spuu[ki] - tzuun*saxis[ki];
	      szuv[ki] = spuv[ki] - tzuvn*saxis[ki];
	      szvv[ki] = spvv[ki] - tzvvn*saxis[ki];
            }
        }
      
      /*  Make a number of necessary scalar products */
      
      tzduz   = s6scpr(sz,szu,3);
      tzdvz   = s6scpr(sz,szv,3);
      tduzduz = s6scpr(szu,szu,3);
      tduzdvz = s6scpr(szu,szv,3);
      tdvzdvz = s6scpr(szv,szv,3);
      if (ider>1)
        {
	  tzduduz = s6scpr(sz,szuu,3);
	  tzdudvz = s6scpr(sz,szuv,3);
	  tzdvdvz = s6scpr(sz,szvv,3);
        }      
      
      /*  Find lengt of sz */
      
      tlenz = s6length(sz,3,&kstat);
      
      if (kstat<0) goto error;
      if (DEQUAL(tlenz,DZERO)) tlenz =(double)1.0;
      tlenz3 = tlenz*tlenz*tlenz;
      tlenz5 = tlenz3*tlenz*tlenz;
      
      /* Make a number of necessary vectors */
      
      for (ki=0;ki<3;ki++)                    
	{
	  sp[ki]   = sy[ki]  - tbigr*sz[ki]/tlenz;
	  if (ider>=1)
	    {
	      sdup[ki] = spu[ki] - tbigr*(szu[ki]/tlenz - sz[ki]*tzduz/tlenz3);
	      sdvp[ki] = spv[ki] - tbigr*(szv[ki]/tlenz - sz[ki]*tzdvz/tlenz3);
	      if (ider>=2)
		{
		  sdudup[ki] = spuu[ki] -
		    tbigr*(szuu[ki]/tlenz -
			   ((double)2.0*szu[ki]*tzduz+
			    sz[ki]*(tduzduz+tzduduz))/tlenz3 +
			   (double)3.0*sz[ki]*tzduz*tzduz/tlenz5);
		  
		  sdudvp[ki] = spuv[ki] -
		    tbigr*(szuv[ki]/tlenz -
			   (szu[ki]*tzdvz+szv[ki]*tzduz+
			    sz[ki]*(tduzdvz+tzdudvz))/tlenz3 +
			   (double)3.0*sz[ki]*tzduz*tzdvz/tlenz5);
		  
		  sdvdvp[ki] = spvv[ki] -
		    tbigr*(szvv[ki]/tlenz -
			   ((double)2.0*szv[ki]*tzdvz+
			    sz[ki]*(tdvzdvz+tzdvdvz))/tlenz3 +
			   (double)3.0*sz[ki]*tzdvz*tzdvz/tlenz5);
		}
	    }
	}
      
      /*  Make the derivatives */
      if (ider>=0)
        {
	  gder[0] = s6scpr(sp,sp,3) - tsmalr*tsmalr;
	  if (ider>=1)
            {
	      gder[1] = (double)2.0*s6scpr(sp,sdup,3);
	      gder[2] = (double)2.0*s6scpr(sp,sdvp,3);
	      if (ider>=2)
                {
		  gder[3] = (double)2.0*(s6scpr(sdup,sdup,3)+
					 s6scpr(sp,sdudup,3)); 
		  gder[4] = (double)2.0*(s6scpr(sdup,sdvp,3)+
					 s6scpr(sp,sdudvp,3));
		  gder[5] = (double)2.0*(s6scpr(sdvp,sdvp,3)+
					 s6scpr(sp,sdvdvp,3));
                }
            }
        }
      memcopy(gnorm,sp,3,DOUBLE);
    }
  
  else if (ideg == 1003)
    
    {
      
     /* Silhouette curve, the first three elements of eimpli describes
	the viewing direction.
	
	The silhouette line is descibed by the implicit equation, when
	Q(u,v) is the description of the surface:
	
	f(u,v) = (Q x Q ) view = 0
	u   v          
	
	f      = (Q  x Q ) view + (Q x Q  ) view
	u         uu   v           u   uv
	
	
	f      = (Q  x Q ) view + (Q x Q  ) view
	v         uv   v           u   vv
	
	
	
	f      = (Q    x Q ) view + 2 (Q  x Q  ) view + (Q  x Q   ) view
	uu        uuu    v             uu   uv           u    uuv
	
	
	f      = (Q    x Q )view + (Q  x Q  )view + (Q  x Q  )view + (Q xQ)view
	uv        uuv    v          uu   vv          uv   uv          u  uvv
	
	
	f      = (Q    x Q ) view + 2 (Q  x Q  ) view + (Q  x Q   ) view
	vv        uvv    v             uv   vv           u    vvv
	
	
	Note that Q  x Q   has zero length.
	uv   uv
      */
      double *spuuu = ep + 18;
      double *spuuv = ep + 21;
      double *spuvv = ep + 24;
      double *spvvv = ep + 27;
      double sdum1[3],sdum2[3],sdum3[3];
      
      if (ider>=0)
        {
	  s6crss(spu,spv,sdum1);
	  gder[0] = s6scpr(sdum1,eimpli,3);
	  if (ider>=1)
            {
	      s6crss(spuu,spv,sdum1);
	      s6crss(spu,spuv,sdum2);
	      gder[1] = s6scpr(sdum1,eimpli,3) + s6scpr(sdum2,eimpli,3);
	      s6crss(spuv,spv,sdum1);
	      s6crss(spu,spvv,sdum2);
	      gder[2] = s6scpr(sdum1,eimpli,3) + s6scpr(sdum2,eimpli,3);
	      if (ider>=2)
                {
		  s6crss(spuuu,spv,  sdum1);
		  s6crss(spuu, spuv, sdum2);
		  s6crss(spu,  spuuv,sdum3);
		  gder[3] = s6scpr(sdum1,eimpli,3) +
		    (double)2.0*s6scpr(sdum2,eimpli,3)
		      + s6scpr(sdum3,eimpli,3);;
		  s6crss(spuuv,spv,  sdum1);
		  s6crss(spuu, spvv, sdum2);
		  s6crss(spu,  spuvv,sdum3);
		  gder[4] = s6scpr(sdum1,eimpli,3) + s6scpr(sdum2,eimpli,3)
		    + s6scpr(sdum3,eimpli,3);;
		  s6crss(spuvv,spv,  sdum1);
		  s6crss(spuv, spvv, sdum2);
		  s6crss(spu,  spvvv,sdum3);
		  gder[5] = s6scpr(sdum1,eimpli,3) +
		    (double)2.0*s6scpr(sdum2,eimpli,3)
		      + s6scpr(sdum3,eimpli,3);;
                }
            }
        }
    }
  
  else if (ideg == 1004)
    
    {
      
     /* Perspective silhouette curve, the first three elements of eimpli
        describe the eye point E.
	
	The silhouette line is descibed by the implicit equation, when
	P(u,v) is the description of the surface and
        N(u,v) = P x P  is the normal to the surface:
                  u   v
	
	f(u,v) = N(u,v) . (P(u,v) - E) = 0
	
        Differentiating N gives:

        N = P  x  P   + P  x  P
         u   uu    v     u     uv

        N = P  x  P   + P  x  P
         v   uv    v     u     vv

        N  = P   x  P   + 2 P  x  P   + P x P
         uu   uuu    v       uu    uv    u   uuv

        N  = P   x  P   +  P  x  P   + P x P
         uv   uuu    v      uu    vv    u   uuv

        N  = P   x  P   + 2 P  x  P   + P x P
         vv   uvv    v       uv    vv    u   vvv



        Differentiating f gives:

	f = N  . (P - E)
         u   u   

	f = N  . (P - E)
         v   v   

	f  = N   . (P - E) + N  . P
         uu   uu              u    u 

	f  = N   . (P - E) + N  . P
         uv   uv              u    v 

	f  = N   . (P - E) + N  . P
         vv   vv              v    v 

	
      */
      double *spuuu = ep + 18;
      double *spuuv = ep + 21;
      double *spuvv = ep + 24;
      double *spvvv = ep + 27;
      double norm[3],normu[3],normv[3],normuu[3],normuv[3],normvv[3];
      double cprod1[3],cprod2[3],cprod3[3];
      double pediff[3];
      

      if (ider>=0)
        {
	  s6diff(ep,eimpli,3,pediff);

	  s6crss(spu,spv,norm);
	  gder[0] = s6scpr(norm,pediff,3);

	  if (ider>=1)
            {
	      s6crss(spuu,spv,cprod1);
	      s6crss(spu,spuv,cprod2);
              for (ki=0;ki<3;ki++)
              {    
                  normu[ki] = cprod1[ki] + cprod2[ki];
              }    
	      s6crss(spuv,spv,cprod1);
	      s6crss(spu,spvv,cprod2);
              for (ki=0;ki<3;ki++)
              {    
                  normv[ki] = cprod1[ki] + cprod2[ki];
              }    

	      gder[1] = s6scpr(normu,pediff,3);
	      gder[2] = s6scpr(normv,pediff,3);

	      if (ider>=2)
                {
		  s6crss(spuuu,spv,cprod1);
		  s6crss(spuu,spuv,cprod2);
		  s6crss(spu,spuuv,cprod3);
		  for (ki=0;ki<3;ki++)
		  {    
		  normuu[ki] = cprod1[ki] + 2.0 * cprod2[ki] + cprod3[ki];
		  }    

           /*    Note that spuv x spuv = 0 in the formula for normuv  */
		  s6crss(spuuv,spv,cprod1);
		  s6crss(spuu,spvv,cprod2);
		  s6crss(spu,spuvv,cprod3);
		  for (ki=0;ki<3;ki++)
		  {    
		  normuv[ki] = cprod1[ki] + cprod2[ki] + cprod3[ki];
		  }    

		  s6crss(spuvv,spv,cprod1);
		  s6crss(spuv,spvv,cprod2);
		  s6crss(spu,spvvv,cprod3);
		  for (ki=0;ki<3;ki++)
		  {    
		  normvv[ki] = cprod1[ki] + 2.0 * cprod2[ki] + cprod3[ki];
		  }    

		  gder[3] = s6scpr(normuu,pediff,3) + s6scpr(normu,spu,3);
		  gder[4] = s6scpr(normuv,pediff,3) + s6scpr(normu,spv,3);
		  gder[5] = s6scpr(normvv,pediff,3) + s6scpr(normv,spv,3);

                }
            }
        }
    }
  
  else if (ideg == 1005)
    
    {
      
     /* Perspective silhouette curve, the first three elements of eimpli
        describe Q, the next three  describe B.
	
	The silhouette line is descibed by the implicit equation, when
	P(u,v) is the description of the surface and
        N(u,v) = P x P  is the normal to the surface:
                  u   v
	
	f(u,v) = N(u,v) x (P(u,v) - Q) . B = 0
	
        Differentiating N gives:

        N = P  x  P   + P  x  P
         u   uu    v     u     uv

        N = P  x  P   + P  x  P
         v   uv    v     u     vv

        N  = P   x  P   + 2 P  x  P   + P x P
         uu   uuu    v       uu    uv    u   uuv

        N  = P   x  P   +  P  x  P   + P x P
         uv   uuu    v      uu    vv    u   uuv

        N  = P   x  P   + 2 P  x  P   + P x P
         vv   uvv    v       uv    vv    u   vvv



        Differentiating f gives:

	f = { N  x (P - Q) + N x P } . B
         u     u                  u

	f = { N  x (P - Q) + N x P } . B
         v     v                  v

	f  = { N   x (P - Q) + 2 N x P  + N x P  } . B
         uu     uu                u   u        uu

	f  = { N   x (P - Q) + N x P  + N x P  + N x P  } . B
         uv     uv              u   v    v   u        uv

	f  = { N   x (P - Q) + 2 N x P  + N x P  } . B
         vv     vv                v   v        vv

	
      */
      double *spuuu = ep + 18;
      double *spuuv = ep + 21;
      double *spuvv = ep + 24;
      double *spvvv = ep + 27;
      double *bvec  = eimpli + 3;
      double norm[3],normu[3],normv[3],normuu[3],normuv[3],normvv[3];
      double cprod1[3],cprod2[3],cprod3[3],cprod4[3];
      double pqdiff[3],sum[3];
      

      if (ider>=0)
        {
	  s6diff(ep,eimpli,3,pqdiff);

	  s6crss(spu,spv,norm);
	  s6crss(norm,pqdiff,cprod1);
	  gder[0] = s6scpr(cprod1,bvec,3);

	  if (ider>=1)
            {
	      s6crss(spuu,spv,cprod1);
	      s6crss(spu,spuv,cprod2);
              for (ki=0;ki<3;ki++)
              {    
                  normu[ki] = cprod1[ki] + cprod2[ki];
              }    
	      s6crss(spuv,spv,cprod1);
	      s6crss(spu,spvv,cprod2);
              for (ki=0;ki<3;ki++)
              {    
                  normv[ki] = cprod1[ki] + cprod2[ki];
              }    

	      s6crss(normu,pqdiff,cprod1);
	      s6crss(norm,spu,cprod2);
              for (ki=0;ki<3;ki++)
              {    
                  sum[ki] = cprod1[ki] + cprod2[ki];
              }    
	      gder[1] = s6scpr(sum,bvec,3);

	      s6crss(normv,pqdiff,cprod1);
	      s6crss(norm,spv,cprod2);
              for (ki=0;ki<3;ki++)
              {    
                  sum[ki] = cprod1[ki] + cprod2[ki];
              }    
	      gder[2] = s6scpr(sum,bvec,3);

	      if (ider>=2)
                {
		  s6crss(spuuu,spv,cprod1);
		  s6crss(spuu,spuv,cprod2);
		  s6crss(spu,spuuv,cprod3);
		  for (ki=0;ki<3;ki++)
		  {    
		  normuu[ki] = cprod1[ki] + 2.0 * cprod2[ki] + cprod3[ki];
		  }    

           /*    Note that spuv x spuv = 0 in the formula for normuv  */
		  s6crss(spuuv,spv,cprod1);
		  s6crss(spuu,spvv,cprod2);
		  s6crss(spu,spuvv,cprod3);
		  for (ki=0;ki<3;ki++)
		  {    
		  normuv[ki] = cprod1[ki] + cprod2[ki] + cprod3[ki];
		  }    

		  s6crss(spuvv,spv,cprod1);
		  s6crss(spuv,spvv,cprod2);
		  s6crss(spu,spvvv,cprod3);
		  for (ki=0;ki<3;ki++)
		  {    
		  normvv[ki] = cprod1[ki] + 2.0 * cprod2[ki] + cprod3[ki];
		  }    

	          s6crss(normuu,pqdiff,cprod1);
	          s6crss(normu,spu,cprod2);
	          s6crss(norm,spuu,cprod3);
                  for (ki=0;ki<3;ki++)
                  {    
                      sum[ki] = cprod1[ki] + 2.0 * cprod2[ki] + cprod3[ki];
                  }    
	          gder[3] = s6scpr(sum,bvec,3);

	          s6crss(normuv,pqdiff,cprod1);
	          s6crss(normu,spv,cprod2);
	          s6crss(normv,spu,cprod3);
	          s6crss(norm,spuv,cprod4);
                  for (ki=0;ki<3;ki++)
                  {    
                      sum[ki] = cprod1[ki] + cprod2[ki] + cprod3[ki] + cprod4[ki];
                  }    
	          gder[4] = s6scpr(sum,bvec,3);

	          s6crss(normvv,pqdiff,cprod1);
	          s6crss(normv,spv,cprod2);
	          s6crss(norm,spvv,cprod3);
                  for (ki=0;ki<3;ki++)
                  {    
                      sum[ki] = cprod1[ki] + 2.0 * cprod2[ki] + cprod3[ki];
                  }    
	          gder[5] = s6scpr(sum,bvec,3);

                }
            }
        }
    }

  if(ideg == 1003 || ideg == 1004 || ideg == 1005)
    {
      /*  The normal vector has no meaning in this case
          so we calculate the direction D(u,v) of the solution curve
          on the surface P(u,v)
          of  f(u,v) = N(u,v) . d = 0  (ideg = 1003)
          or  f(u,v) = N(u,v) . (P(u,v) - E) = 0  (ideg = 1004)
          or  f(u,v) = N(u,v) x (P(u,v) - Q) . B = 0  (ideg = 1005)
          (through the present solution point)
          directly. This direction D is in fact  f P  - f P
                                                  v u    u v
          where P(u,v) is the parameterised
          surface, N is the normal P  x P  , and d is the 
                                    u    v
	  view direction. The direction D is used by s1331.  */
     
      for(ki=0; ki<3; ki++)
        {
          gnorm[ki] = gder[2] * spu[ki] - gder[1] * spv[ki];
        }
      (void)s6norm(gnorm,3,gnorm,&kstat);
    }

  /* Everyting is ok */
  
  *jstat = 0;
  goto out;
  
  
  /* Error in lower level function */
 error:
  *jstat = kstat;
  s6err("s1331",*jstat,kpos);
  goto out;
  
 out:
  return;
}

//===========================================================================
void s1305(double epar1[],double epar2[],double eval1[],double eval2[],
	   int *jbound,double gpar[],int *jstat)
//===========================================================================
{
  int    kstat;          /* Local status variable                            */
  int    kins1;          /* epar1 inside/outside SISLbox                         */
  int    kins2;          /* epar2 inside/outside SISLbox                         */
  double tdom;           /* Denominator of last intersection point           */
  double tfak1,tfak2;    /* Distance to straight line                        */
  double tcdist=HUGE;    /* Current distance                                 */
  double tpdist=HUGE;    /* Previous distance                                */
  double simpli[5];      /* Corners of the parameter area pu into the
			    implicit equation of the line through epar1 and
			    epar2.                                           */
  double snorm[2];       /* Normal vector                                    */
  double stemp[2];       /* Candidate point                                  */
  double *outside=epar1; /* Pointer to the point that is outside;            */
  *jbound = 0;
  
  /* Test if both ends are inside */
  
  kins1 = kins2 = 0; 
  
  if (eval1[0] <= epar1[0] && epar1[0] <= eval1[1] &&
      eval2[0] <= epar1[1] && epar1[1] <= eval2[1]) kins1 = 1;
  
  if( eval1[0] <= epar2[0] && epar2[0] <= eval1[1] &&
     eval2[0] <= epar2[1] && epar2[1] <= eval2[1]) kins2 = 1;
  
  if (kins1==1 && kins2==1) goto war01;
  
  if (kins1) outside = epar2;
  
  /* Test if we step from the boundary and out */
  
  if ((eval1[0] == epar1[0] && epar2[0] < eval1[0]) ||
      (epar1[0] == eval1[1] && eval1[1] < epar2[0]) ||
      (eval2[0] == epar1[1] && epar2[1] < eval2[0]) ||
      (epar1[1] == eval2[1] && eval2[1] < epar2[1])    ) goto war04;
  
  /* Test if both ends are to the left, right, below or above */
  
  if ( (epar1[0] < eval1[0] && epar2[0] < eval1[0]) ||
      (eval1[1] < epar1[0] && eval1[1] < epar2[0]) ||
      (epar1[1] < eval2[0] && epar2[1] < eval2[0]) ||
      (eval2[1] < epar1[1] && eval2[1] < epar2[1])   ) goto war00;
  
  /* Make normal vector of line though epar1 and epar2 */
  
  snorm[0] = -(epar2[1] - epar1[1]);
  snorm[1] =   epar2[0] - epar1[0];
  
  (void)s6norm(snorm,2,snorm,&kstat);
  
  /* Put corners of parameter area into the implicit equation of the straight
     line */
  
  simpli[0] = (eval1[0]-epar1[0])*snorm[0] + (eval2[0]-epar1[1])*snorm[1];  
  simpli[1] = (eval1[0]-epar1[0])*snorm[0] + (eval2[1]-epar1[1])*snorm[1];  
  simpli[2] = (eval1[1]-epar1[0])*snorm[0] + (eval2[1]-epar1[1])*snorm[1];  
  simpli[3] = (eval1[1]-epar1[0])*snorm[0] + (eval2[0]-epar1[1])*snorm[1];  
  simpli[4] = simpli[0];
  
  /* If simpli[0:3] all have the same sign, the straight line is outside */
  
  if ((simpli[0]>(double)0.0 && simpli[1]>(double)0.0 && 
       simpli[2]>(double)0.0 && simpli[3]>(double)0.0) ||
      (simpli[0]<(double)0.0 && simpli[1]<(double)0.0 && 
       simpli[2]<(double)0.0 && simpli[3]<(double)0.0)   ) goto war00;
  
  /* Treate intersections with left boundary */
  
  if (simpli[0]*simpli[1] <= (double)0.0 && epar1[0] != eval1[0])
    {
      /*  Intersection along left boundary */
      
      tfak1 = fabs(simpli[0]);
      tfak2 = fabs(simpli[1]);
      tdom  = tfak1 + tfak2;
      
      if (DNEQUAL(tdom,(double)0.0))
        {
	  /* The straight line and the left boundary does not coinside */
	  
	  stemp[0] = eval1[0];
	  stemp[1] = (tfak2*eval2[0] + tfak1*eval2[1])/tdom;
	  tcdist   = s6dist(stemp, outside,2);
	  if (*jbound == 0 || tcdist < tpdist)
            {
	      /* New point closer than previous intersection point */
	      
	      gpar[0] = stemp[0];
	      gpar[1] = stemp[1];
	      *jbound  = 1;
	      tpdist  = tcdist;
            }
        }
    }
  
  /* Treate intersections with upper boundary */                       
  
  if (simpli[1]*simpli[2] <= (double)0.0 && epar1[1] != eval2[1])
    {
      /* Intersection along upper boundary */
      
      tfak1 = fabs(simpli[1]);
      tfak2 = fabs(simpli[2]);
      tdom  = tfak1 + tfak2;
      if (DNEQUAL(tdom,(double)0.0))
        {
	  /* The straight line and the upper boundary does not coinside */
	  
	  stemp[0] = (tfak2*eval1[0] + tfak1*eval1[1])/tdom;
	  stemp[1] = eval2[1];
	  tcdist   = s6dist(stemp, outside,2);
	  
	  if (*jbound == 0 || tcdist < tpdist)
            {
	      /* New point closer than previous intersection point */   
	      
	      gpar[0] = stemp[0];
	      gpar[1] = stemp[1];
	      *jbound  = 2;
	      tpdist  = tcdist;
            }
        }
    }
  
  /* Treate intersections with right boundary */
  
  if (simpli[2]*simpli[3] <= (double)0.0 && epar1[0] != eval1[1])
    {
      /* Intersection along right boundary */
      
      tfak1 = fabs(simpli[2]);
      tfak2 = fabs(simpli[3]);
      tdom  = tfak1 + tfak2;
      if (DNEQUAL(tdom,(double)0.0))
        {
	  /* The straight line and the right boundary does not coinside */
	  
	  stemp[0] = eval1[1];
	  stemp[1] = (tfak2*eval2[1] + tfak1*eval2[0])/tdom;
	  tcdist   = s6dist(stemp, outside,2);
	  
	  if (*jbound == 0 || tcdist < tpdist)
            {
	      /* New point closer than previous intersection point */
	      
	      gpar[0] = stemp[0];
	      gpar[1] = stemp[1];
	      *jbound  = 3;
	      tpdist  = tcdist;
            }
        }
    }
  
  /* Treate intersections with lower boundary */
  
  if (simpli[3]*simpli[4] <= (double)0.0 && epar1[1] != eval2[0])
    {
      /* Intersection along lower boundary */
      
      tfak1 = fabs(simpli[3]);
      tfak2 = fabs(simpli[4]);
      tdom  = tfak1 + tfak2;
      if (DNEQUAL(tdom,(double)0.0))
        {
	  /* The straight line and the lower boundary does not coinside */
	  
	  stemp[0] = (tfak2*eval1[1] + tfak1*eval1[0])/tdom;
	  stemp[1] = eval2[0];
	  tcdist   = s6dist(stemp, outside,2);
	  
	  if (*jbound == 0 || tcdist < tpdist)
            {
	      /* New point closer than previous intersection point */   
	      
	      gpar[0] = stemp[0];
	      gpar[1] = stemp[1];
	      *jbound = 4;
	      tpdist  = tcdist;
            }
        }
    }
  
  if (kins1 == 1)
    goto war02; 
  
  if (kins2 == 1 || *jbound != 0) goto war03; 
  
  goto war05;
  
  /* Line outside */
  
 war00:
  *jstat = 0;
  goto out;                                                                      
  
  /* Line inside */                          
  
 war01:
  *jstat = 1;
  goto out;
  
  /* epar1 inside epar2 outside */
 war02:
  *jstat = 2;
  goto out;
  
  /* epar2 inside epar1 outside */
 war03:
  *jstat = 3;
  goto out;
  
  /* epar1 on boundary, epar2 outside */
 war04:
  *jstat = 4;
  goto out;
  
  /* Special error */
 war05:
  *jstat = 5;
  goto out;
  
 out:
  return;
}

//===========================================================================
void s9clipimp(double epar1[],double epar2[],SISLSurf *psurf1,double eimpli[],
	       int ideg,double euval[],double evval[],double aepsge,
	       double gpnt1[],double gpar1[],int *jstat)
//===========================================================================
{
  int kpos=0;                   /* Position of error                           */
  int klfu=0;                   /* Variable used as pointer in knot vector     */
  int klfv=0;                   /* Variable used as pointer in knot vector     */
  int kder=2;                   /* Number of derivatives to be calculated      */
  int kstat;                    /* Local status variable                       */
  int kdir;                     /* Parameter direction of tpar                 */
  int kcross;                   /* Control variable in while loop              */
  int knbit;                    /* Number of iterations                        */
  int krem;                     /* Remember status                             */
  int kbound;                   /* Numbering of boundary                       */
  int ksize;                    /* Number of doubles for storage of derivateves
				   and normal vector */
  int ksizem3;                  /* ksize - 3                                   */
  double tpar;                  /* Constant parameter value                    */
  double spnt1[33];             /* Coordinates of point                        */
  double spar1[2],spar2[2];     /* Local parameter values                      */
  double spar3[2];              /* Local parameter values                      */
  
  
  
  /* If ideg=1,2 or 1001 then only derivatives up to second order
     are calculated, then 18 doubles for derivatives and 3 for the
     normal vector are to be used for calculation of points in the
     spline surface. For ideg=1003,1004,1005 we have a silhouette curve and
     derivatives up to the third are to be calculated,
     thus 30 +3 a total of 33 doubles are to be calculated */
  
  if (ideg==1003 || ideg==1004 || ideg==1005)
    {
      kder = 3;
      ksize = 33;
    }
  else
    {
      ksize = 21;
      kder =2;
    }
  ksizem3 = ksize -3;
  
  
  /* Make local copy of parameters */
  
  memcopy(spar1,epar1,2,DOUBLE);                        
  memcopy(spar2,epar2,2,DOUBLE);
  
  kcross = 1;
  knbit  = 0;
  
  while(kcross && knbit<4)
    {
      
      /*  Find intersection between boundary of parameter area and patch */
      
      s1305(spar1,spar2,euval,evval,&kbound,spar3,&kstat);
      if (kstat<0) goto error;
      
      /*  Remember status so that the line can be updated properly */
      krem = kstat;
      
      if (kstat<2 || kbound == 0)
        {
	  /*      No intersection */
	  kcross = 0;
        }
      else
        {
	  
	  /*      Calculate start point */
	  
	  s1421(psurf1,kder,spar3,&klfu,&klfv,spnt1,spnt1+ksizem3,&kstat); 
	  if (kstat<0) goto error;
	  
	  if (kbound==1)
            {
	      kdir = 1;
	      tpar = euval[0];
            }
	  else if (kbound==2)
            {
	      kdir = 2;
	      tpar = evval[1];
            }
	  else if (kbound==3)
            {
	      kdir = 1;                                   
	      tpar = euval[1];
            }
	  else if (kbound==4)
            {
	      kdir = 2;
	      tpar = evval[0];
            }
	  
	  
	  /* Iterate to boundary intersection */
	  
	  s9boundimp(spnt1,gpar1,psurf1,eimpli,ideg,tpar,kdir,aepsge,
		     gpnt1,gpar1,&kstat);
	  if (kstat<0) goto error;
	  if (kstat==2) goto war02;
	  
	  /* Iteration converged, copy output if new loop necessary */
	  
	  
	  if (krem == 2)
            {
	      /* spar1 was inside, update spar2 */
	      memcopy(spar2,gpar1,2,double);
            }
	  else
            {
	      /* spar2 was inside, update spar1 */
	      memcopy(spar1,gpar1,2,double);
            }
	  
	  /* Update number of iterations */
	  
	  knbit++;
        }
    }
  
  
  
  /* Problem solved if kcross==0. In this case we might have two cases:
     - iteration not used: Then knbit=0
     - iteration used    : Then knbit>0
     
     if kcross==1, then we have stopped on the condition knbit>3, and we
     have no sucess. */
  
  if (kcross==0 && knbit ==0)
    {
      /*  Iteration not used because boundary not crossed */
      *jstat = 0;
    }
  else if (kcross==0 && knbit > 0)
    {
      /*  Boundary crossed, point found, more than one intersection point
	  is possible, check which to return */
      
      if (spar1[0] == epar1[0] && spar1[1] == epar1[1])
        {
	  memcopy(gpar1,spar2,2,double);
        }
      else
        {
	  memcopy(gpar1,spar1,2,double);
	  
	  /*  Calculate crossing point, only necessary when we step into
	      the patch since we already could have stepped out and this
	      point is recorded in gpnt1 */
	  
	  s1421(psurf1,kder,gpar1,&klfu,&klfv,gpnt1,gpnt1+ksizem3,&kstat); 
	  if (kstat<0) goto error;
        }
      
      *jstat = 1;
    }
  else
    {
      /*  To many tries */
      goto war02;
    }
  goto out;
  
  /* Iteration without sucess */
  
 war02: *jstat = 2;
  goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("s9clipimp",*jstat,kpos);
  goto out;
  
 out:
  return;                                                                        
  
}

//===========================================================================
void s1437(SISLSurf *ps1,double apar,SISLCurve **rcurve,int *jstat)
//===========================================================================
{
  int kstat = 0;     /* Local status variable.                           */
  int kpos = 0;      /* Position of error.                               */
  int kind = 0;      /* Kind of curve
                         = 1 : Polynomial B-spline curve.
                         = 2 : Rational B-spline curve.
                         = 3 : Polynomial Bezier curve.
                         = 4 : Rational Bezier curve.                 */
  int kdim;          /* Dimension of the space in which the surface lies.*/
  int kder = 0;      /* Number of derivatives of curve to evaluate.      */
  int kleft = 0;     /* Parameter used in evalutation of curve.          */
  double *ecoef = SISL_NULL;  /* Pointer to vertices                          */
  double *scoef = SISL_NULL;  /* Vertices of surface with changed parameter
			    directions.                                  */
  double *scurve = SISL_NULL; /* Vertices of constant parameter curve.        */
  SISLCurve *qc = SISL_NULL;  /* Intermediate curve.                       */
  
  /* Get dimension of space.  */
  
  kdim = ps1 -> idim;
  kind = ps1->ikind;
                       
  /* Prepare for rational description. */

  if(ps1->ikind == 2 || ps1->ikind == 4)
  {
      ecoef = ps1->rcoef;
      kdim = kdim+1;
  }
  else
  {
      ecoef = ps1->ecoef;
  }

  
  /* Allocate space for coefficients of constant parameter curve
     and of surface with changed parameter direction.                */
  
  if ((scurve = newarray(kdim*ps1->in2,double)) == SISL_NULL) goto err101;
  if ((scoef = newarray(kdim*ps1->in1*ps1->in2,double)) == SISL_NULL) goto err101;
  
  /* Change parameter directions of surface.  */
  
  s6chpar(ecoef,ps1->in1,ps1->in2,kdim,scoef);
  
  /* Create curve to evaluate.  */
  
  qc = newCurve(ps1->in1,ps1->ik1,ps1->et1,scoef,1,kdim*ps1->in2,0);
  if (qc == SISL_NULL) goto err101;
  
  /* Evaluate this curve in given parameter value.  */
  
  s1221(qc,kder,apar,&kleft,scurve,&kstat);
  if (kstat < 0) goto error;
  
  /* Create constant parameter curve.  */
  
  *rcurve = newCurve(ps1->in2,ps1->ik2,ps1->et2,scurve,kind,ps1->idim,1);
  if (*rcurve == SISL_NULL) goto err101;
  
  /* Set periodicity flag.      */
		       
  (*rcurve)->cuopen = ps1->cuopen_2;		       
  
  /* Curve picked.  */
  
  *jstat = 0;
  goto out;
  
  /* Error in space allocation.  */
  
 err101: *jstat = -101;
  s6err("s1437",*jstat,kpos);
  goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("s1437",*jstat,kpos);
  goto out;
  
 out: 
  
  /* Free space occupied by local arrays.  */
  
  if (scoef != SISL_NULL) freearray(scoef);
  if (scurve != SISL_NULL) freearray(scurve);
  if (qc != SISL_NULL) freeCurve(qc);
  
  return;
}

//===========================================================================
void s1712 (SISLCurve * pc, double abeg, double aend, SISLCurve ** rcnew, int *jstat)
//===========================================================================
{
  int kstat;			/* Local status variable.           */
  int kpos = 0;			/* Position of error.               */
  double tbeg, tend;		/* The less and greater point.      */
  SISLCurve *q1 = SISL_NULL;		/* Pointer to new curve-object.     */
  SISLCurve *q2 = SISL_NULL;		/* Pointer to new curve-object.     */
  SISLCurve *q3 = SISL_NULL;		/* Pointer to new curve-object.     */
  int kturn = 0;

  /* Check that we have a curve to pick a part of. */

  if (!pc)
    goto err150;

  /* Check that the intersection points are interior points. */

  if ((abeg < pc->et[0] && DNEQUAL(abeg,pc->et[0])) ||
      (abeg > pc->et[pc->in+pc->ik-1] && DNEQUAL(abeg,pc->et[pc->in+pc->ik-1])))
    goto err151;
  if ((aend < pc->et[0] && DNEQUAL(aend,pc->et[0])) ||
      (aend > pc->et[pc->in+pc->ik-1] && DNEQUAL(aend,pc->et[pc->in+pc->ik-1])))
    goto err151;

  /* Check that abeg is not like aend. */

  if (DEQUAL(abeg,aend))
    goto err151;

  if (pc->cuopen == SISL_CRV_PERIODIC)
  {
      double delta = pc->et[pc->in] - pc->et[pc->ik - 1];

      if (abeg > aend)	kturn = 1;

      if (abeg < pc->et[pc->ik - 1] && DNEQUAL(abeg, pc->et[pc->ik - 1]))
	abeg += delta;
      if (abeg > pc->et[pc->in] || DEQUAL(abeg, pc->et[pc->in]))
	abeg -= delta;

      if (aend < pc->et[pc->ik - 1] && DNEQUAL(aend, pc->et[pc->ik - 1]))
	aend += delta;
      if (aend > pc->et[pc->in] && DNEQUAL(aend, pc->et[pc->in]))
	aend -= delta;

      if ((abeg > aend && !kturn) || (abeg < aend && kturn))
	 kturn = 1;
      else
	 kturn = 0;
  }

  /* Find the smaller and greater of the intersection points. */

  if (abeg < aend)
    {
      tbeg = abeg;
      tend = aend;
    }
  else
    {
      tbeg = aend;
      tend = abeg;
    }

  /* Divide into two at each point. The new curve is
     the middelmost curve.*/

  /* We start with dividing at the first point, and free the curv at
     left. */

  s1710 (pc, tbeg, &q1, &q2, &kstat);
  if (kstat < 0)
    goto err153;
  /* UJK, periodicity */
  if (kstat && q1 && !q2)
    {
      q2 = q1;
      q1 = SISL_NULL;
    }
  else if (q1)
    {
      freeCurve (q1);
      q1 = SISL_NULL;
    }

  /* Then we divide at the last point. The curve to left is the new curve.*/

  s1710 (q2, tend, &q1, &q3, &kstat);
  if (kstat < 0)
    goto err153;
  /* BOH, periodicity */
  if (kstat && !q1 && q3)
  {
    q1 = q3;
    q3 = SISL_NULL;
  }

  /* The curve is turned if nessesary. */

  if ((abeg > aend && !kturn) || (abeg < aend && kturn))
    s1706 (q1);

  /* Updating output. */

  *rcnew = q1;
  *jstat = 0;
  goto out;


/* Error. Error at low level function. */

err153:
  *jstat = kstat;
  goto outfree;


/* Error. No curve to pick a part of.  */

err150:
  *jstat = -150;
  s6err ("s1712", *jstat, kpos);
  goto out;


/* Error. No part, abeg and aend has illegal values.  */

err151:
  *jstat = -151;
  s6err ("s1712", *jstat, kpos);
  goto out;


/* Error in output. */

outfree:
  if (q1)
    freeCurve (q1);


/* Free local used memory. */

out:
   if (q2)
      freeCurve (q2);
   if (q3)
      freeCurve (q3);
   return;
}

//===========================================================================
void s1436(SISLSurf *ps1,double apar,SISLCurve **rcurve,int *jstat)
//===========================================================================
{
  int kstat = 0;     /* Local status variable.                        */
  int kpos = 0;      /* Position of error.                            */
  int kder = 0;      /* Number of derivatives of curve to evalutate.  */
  int kleft = 0;     /* Parameter used in evaluation of curve.        */
  int kind = 0;      /* Kind of curve
                         = 1 : Polynomial B-spline curve.
                         = 2 : Rational B-spline curve.
                         = 3 : Polynomial Bezier curve.
                         = 4 : Rational Bezier curve.                 */
  int kdim;
  double *scoef;     /* Pointer to vertices.                          */
  double *scurve = SISL_NULL; /* Vertices of constant parameter curve.     */
  SISLCurve *qc = SISL_NULL;  /* Pointer to intermediate curve.         */

  /* Prepare for rational description. */

  kdim = ps1->idim;
  kind = ps1->ikind;
  if(ps1->ikind == 2 || ps1->ikind == 4)
  {
      scoef = ps1->rcoef;
      kdim = kdim+1;
  }
  else
  {
      scoef = ps1->ecoef;
  }

  /* Create the curve describing the surface as a curve.  */
  
  if ((qc = newCurve(ps1->in2,ps1->ik2,ps1->et2,scoef,1,
		     ps1->in1*kdim,0)) == SISL_NULL) goto err101;
  
  /* Allocate space for value of curve.  */
  
  if ((scurve = newarray(ps1->in1*kdim,double)) == SISL_NULL) goto err101;
  
  /* Evaluate this curve at given parameter value.  */
  
  s1221(qc,kder,apar,&kleft,scurve,&kstat);
  if (kstat < 0) goto error;
  
  /* Create constant parameter curve.  */
  
  *rcurve = newCurve(ps1->in1,ps1->ik1,ps1->et1,scurve,kind,ps1->idim,1);
  if (*rcurve == SISL_NULL) goto err101;
  
  /* Set periodicity flag.      */
	
  (*rcurve)->cuopen = ps1->cuopen_1;
  
  /* Curve picked.  */
  
  *jstat = 0;
  goto out;
  
  /* Error in space allocation.  */
  
 err101: *jstat = -101;
  s6err("s1436",*jstat,kpos);
  goto out;
  
  /* Error in lower level routine.  */
  
  error : *jstat = kstat;
  s6err("s1436",*jstat,kpos);
  goto out;
  
 out: 
  
  /* Free space occupied by local arrays.  */
  
  if (scurve != SISL_NULL) freearray(scurve);
  if (qc != SISL_NULL) freeCurve(qc);
  
  return;
}

//===========================================================================
double s1309(double epnt[],double edir[],double eimpli[],int ideg,int *jstat)
//===========================================================================
{
  double sdir[3];         /* Normilized direction vector          */
  double tb1,ta11,ta12;   /* Dummy variables                      */
  double tsum,t1,t2,tdum1;/* Dummy variables                      */
  double tcurdst=0.0;     /* The distance                         */
  double sq[4];           /* Array used for temporary results     */
  int ksize;              /* Number of doubles for storage of derivatives
			     and normal vector */
  int ksizem3;            /* ksize - 3                                      */
  int    kstat;           /* Local status variable                */
  int    kdim=3;          /* Dimesnon of 3-D space                */
  int    ki,kj,kl,kp;     /* Control variables in loop            */
  int    kpos=1;          /* Position of error                    */



  /* If ideg=1,2 or 1001 then only derivatives up to second order
     are calculated, then 18 doubles for derivatives and 3 for the
     normal vector are to be used for calculation of points in the
     spline surface. For ideg=1003,1004,1005 we have a silhouette curve and
     derivatives up to the third are to be calculated,
     thus 30 +3 a total of 33 doubles are to be calculated */

  if (ideg==1003 || ideg==1004 || ideg==1005)
    {
      ksize = 33;
    }
  else
    {
      ksize = 21;
    }

  ksizem3 = ksize -3;
  (void)s6norm(edir,kdim,sdir,&kstat);
  if (kstat < 0) goto error;

  if (ideg==1)
    {
      /* Put parametric representation of projection line into
	 implicit equation of plane */
      tb1  = s6scpr(eimpli,epnt,kdim);
      ta11 = s6scpr(eimpli,sdir,kdim);
      if( ta11 == (double)0.0) goto war02;
      tcurdst = -(eimpli[3]+tb1)/ta11;
    }
  else if (ideg==2)
    {

      /*  Find distance from the new point to the implicit surface, by
	  intersecting  the straight line throught the point and with
	  sdir as normalized direction vector, normalized version of 3
	  first coordinates of sq the implicit surface and P0 = (P,1).

	  This problem can be written:

	  T                T    2                    T
	  P0 A P0  + 2 t P0 A sdir  + t  (sdir,0) A (sdir,0)  = 0

	  T
	  We have to calulate calculate  tb1=P0 A P  and qs=P0 A, thus:
	  T    2                    T
	  tb1 + 2 t sq sdir  + t  (sdir,0) A (sdir,0)  = 0

	  Thus the first step is to calculate qs = A (P,1)
	  */
      for (ki=0;ki<4;ki++)
        {
	  tsum = eimpli[12+ki];
	  for (kj=0,kl=ki ; kj<3 ; kj++,kl+=4)
            {
	      tsum +=(eimpli[kl]*epnt[kj]);
            }
	  sq[ki] = tsum;
        }

      tb1  = s6scpr(epnt,sq,kdim) + sq[3];

      ta11 = (double)2.0*s6scpr(sq,sdir,kdim);

      ta12 = (double)0.0;
      for (ki=0,kl=0;ki<3;ki++,kl+=4)
        {
	  kp = kl;
	  for (kj=0;kj<3;kj++,kp++)
            {
	      ta12 += sdir[ki]*eimpli[kp]*sdir[kj];
            }
        }

      /*  Now our equation system is:
	  2
	  ta12 t  + ta11 t + tb1 = 0

	  we want the root with the smallest absolute value:
	  2
	  t = (-ta11 +/- sqrt(ta11 -4ta12 tb1))/(2ta12)
	  */
      if (DNEQUAL(ta12,(double)0.0))
        {
	  tdum1 = ta11*ta11 - (double)4.0*ta12*tb1;
	  if (tdum1 < DZERO) goto war02;
	  tdum1 = sqrt(tdum1);
	  t1 = (-ta11 + tdum1)/((double)2.0*ta12);
	  t2 = (-ta11 - tdum1)/((double)2.0*ta12);
	  if (fabs(t1)<fabs(t2))
            {
	      tcurdst = t1;
            }
	  else
            {
	      tcurdst = t2;
            }
        }
      else if(DNEQUAL(ta11,(double)0.0))
        {
	  tcurdst = tb1/ta11;
        }
      else
        {
	  /*      Unsolvable system */
	  goto war02;
        }
    }
  else if (ideg==1001)
    {
      /*  Torus surface */

      double *scentr;  /* The center of the torus */
      double *snorm;   /* The normal of the torus symmetry plane */
      double tbigr;    /* The big radius of the torus */
      double tsmalr;   /* The small radius of the torus */
      double sdum1[3]; /* Temporary storage for point */
      double sdum2[3]; /* Temporary storage for point */
      double tproj;    /* Projection of vector onto snorm */


      scentr = eimpli;
      snorm  = eimpli+3;
      tbigr  = *(eimpli+6);
      tsmalr = *(eimpli+7);

      /*  Find projection of vector from torus center on to torus axis */
      s6diff(epnt,scentr,kdim,sdum1);
      tproj = s6scpr(sdum1,snorm,kdim);

      /*  Project vector from torus center to epnt onto torus plane */
      for (ki=0;ki<kdim;ki++)
        sdum2[ki] = sdum1[ki] - tproj*snorm[ki];
      (void)s6norm(sdum2,kdim,sdum2,&kstat);
      if (kstat<0) goto error;

      /*  Find vector from torus circle to epnt */
      for (ki=0;ki<kdim;ki++)
        sdum1[ki] = sdum1[ki] - tbigr*sdum2[ki];

      /*  Find length of this vector and compare with tsmalr */

      tcurdst = fabs(s6length(sdum1,kdim,&kstat)-tsmalr);
      if (kstat<0) goto error;
    }
  else if (ideg==1003)
    {
      /*  Silhouette line/curve */

      double sdum1[3]; /* Temporary storage for point */

      (void)s6norm(epnt+ksizem3,kdim,sdum1,&kstat);
      if (kstat<0) goto error;

      /*  eimpli[0,1,2] is assumed to, be normalized */

      t1 = s6scpr(sdum1,eimpli,kdim);

      /*  t1 now contains the cosine of the angle between the view direction
	  and the normal vector. This is Equal to sin of PI/2 minus the angle
	  between the vectors, thus the actual angle can be calulated */

      tcurdst = asin(t1);
      tcurdst = fabs(tcurdst);
    }

  else if (ideg==1004)
    {
      /*  Perspective silhouette line/curve */

      double sdum1[3],sdum2[3]; /* Temporary storage for point */

      s6diff(epnt,eimpli,kdim,sdum1);
      (void)s6norm(sdum1,kdim,sdum2,&kstat);
      /* OK if sdum1 is zero -- tcurdst will be zero as well  */
      (void)s6norm(epnt+ksizem3,kdim,sdum1,&kstat);


      t1 = s6scpr(sdum1,sdum2,kdim);

      /*  t1 now contains the cosine of the angle between the direction of the
          point epnt relative to the eyepoint E (in eimpli)
	  and the normal vector. This is Equal to sin of PI/2 minus the angle
	  between the vectors, thus the actual angle can be calulated */

      tcurdst = asin(t1);
      tcurdst = fabs(tcurdst);
    }

  else if (ideg==1005)
    {
      /*  Circular silhouette line/curve */

      double sdum1[3],sdum2[3]; /* Temporary storage for point */
      double *bvec=eimpli+3;

      s6diff(epnt,eimpli,kdim,sdum1);
      s6crss(epnt+ksizem3,sdum1,sdum2);
      (void)s6norm(sdum2,kdim,sdum1,&kstat);
      /* OK if sdum2 is zero -- tcurdst will be zero as well  */

      /*  bvec  = eimpli[3,4,5] is assumed to, be normalized */

      t1 = s6scpr(sdum1,bvec,kdim);

      /*  t1 now contains the cosine of the angle between
          (the cross product of the normal vector and the direction of the
          point epnt relative to the point Q (in eimpli))
	  and the direction vector B. This is Equal to sin of PI/2 minus the angle
	  between the vectors, thus the actual angle can be calulated */

      tcurdst = asin(t1);
      tcurdst = fabs(tcurdst);
    }

  *jstat = 0;
  goto out;

  /* Projection not possible */
 war02: *jstat = 2;
  goto out;

  /* Error in lower level routine.  */

  error : *jstat = kstat;
  s6err("s1309",*jstat,kpos);
  goto out;

 out:
  return(tcurdst);
}

//===========================================================================
void s1605(SISLCurve *pc,double aepsge,double **gpoint,int *jnbpnt,int *jstat)
//===========================================================================
{
  int kstat = 0;           /* Status variable.  */
  int kpos  = 0;           /* Position of error reported. */
  int ki,kj,kk,kh,kr,kl;   /* Counters.         */
  int kikr;                /* Order of current derivative curve. */
  int kih;                 /* Current location in sdd2.          */
  int kihn;                /* Next location in sdd2.             */
  int kjh;                 /* Index in sdd2.                     */
  int kstop;               /* Number of divided differences to compute.   */
  int kdim = pc->idim;     /* Dimension of space in which the curve lies. */
  int kncoef = pc->in;     /* Number of vertices of curve.  */
  int korder = pc->ik;     /* Order of curve.               */
  int kordnew = korder-2;  /* Order of derivative curve of which 
			      to find an upper bound.         */
  int knmbel = 100;        /* Number of elements with which the output
			      array is to be increased.                   */       
  int kmaxpar = knmbel;    /* Length of output parameter array.           */
  int kpar = 0;            /* Number of parameter values computed.        */
  int kant;                /* Number of sampling points at a knot interval. */
  int left = 0;            /* Help index to evaluator.                    */
  double tant;             /* Number of sampling points at a knot interval. */
  double tfac;             /* Factor used in taking divided differences.    */
  double ta;               /* Start value of parameter interval.          */
  double tb;               /* End value of parameter interval.            */
  double th;               /* Distance between output parameter values.   */
  double *st;              /* Pointer to knot vector of curve.            */
  double *par = SISL_NULL;      /* Array used to store parameter values.       */
  double *sh  = SISL_NULL;      /* Work array.    */
  double *sh1 = SISL_NULL;      /* Work array.    */
  double *sdd = SISL_NULL;      /* Work array used to compute divided differences. */
  double *sdd2 = SISL_NULL;     /* Array used to store final divided differences.  */
  double *smaxd = SISL_NULL;    /* Array used to store maximum divided differences.*/
  
  /* Test input.  */
  
  if (korder < 1) goto err110;
  if (kncoef < korder) goto err111;
  if (kdim < 1) goto err102;
  
  if (korder == 1)
    {
      kpar = kncoef;
      if ((*gpoint = newarray(kpar*kdim,DOUBLE)) == SISL_NULL) goto err101;
      memcopy(gpoint,pc->ecoef,kpar*kdim,DOUBLE);
      *jnbpnt = kpar;
      *jstat = 0;
      goto out;
    }
  
  
  /* Set local pointer to knot vector of curve.  */
  
  st = pc->et;
  
  /* Allocate some scratch for output array.  */
  
  if ((par = newarray(knmbel,DOUBLE)) == SISL_NULL) goto err101;
  
  /* Allocate scratch for internal arrays.  */
  
  if ((sdd = new0array((kordnew+6)*kdim,DOUBLE)) == SISL_NULL) goto err101;
  sdd2 = sdd+3*kdim;
  smaxd = sdd2+kordnew*kdim;
  sh = smaxd+kdim;
  sh1 = sh+kdim;
  
  /* Main loop to determine the interpolation points in each knot interval
     by computing 2. order differences and taking the maximum of the 
     appropriate kordnew 2. order differences on each knot interval. The
     number of uniform interplation points in the knot interval can then
     by estimated using the bound described in METHOD.
     In the following the index ki will point at the next coefficient to be 
     included in the computation of the 2. order derivatives.
     kpar points to the location in the array par where the parameter value
     of the next interpolation point is to be stored.
     kih points to the location in sdd2 where the next 2. order difference
     is to be stored.        */
  
  kpar=0;
  tb = st[korder-1];
  
  for (kih=0, ki=0; ki<kncoef; ki=kj)
    {
      /* Compute the index of the first knot greater than tb.  */
      
      for (kj=MAX(korder-1,ki)+1; st[kj]==tb; kj++);
      ta = tb;
      tb = st[kj];
      
      /* Check if the multiplisity of the knot is greater than 
	 korder-2. */
      
      if (kj-ki >= korder-1)
	{
	  if (kpar+1 > kmaxpar)
	    if ((par = increasearray(par,(kmaxpar+=knmbel),DOUBLE)) 
		== SISL_NULL) goto err101;
	  par[kpar] = ta;
	  kpar++;
	}
      
      /* If the 2. order differences may be different from zero, 
	 Compute them.   */
      
      for (kk=ki; korder>2 && kk<kj; kk++)
	{
	  /* Pick the next coefficient.  */
	  
	  memcopy(sh,pc->ecoef+kk*kdim,kdim,DOUBLE);
	  
	  /* Compute the 1, 2 difference at kk.  */
	  
	  kikr = korder - 1;
	  kstop = MIN(2,korder-kj+kk);
	  for (kr=0; kr<kstop; kr++)
	    {
	      tfac = (double)kikr/(st[kk+kikr] - ta);
	      kikr--;
	      for (kh=0; kh<kdim; kh++)
		sh1[kh] = (sh[kh] - sdd[kr*kdim+kh])*tfac;
	      memcopy(sdd+kr*kdim,sh,kdim,DOUBLE);
	      memcopy(sh,sh1,kdim,DOUBLE);
	    }
	  memcopy(sdd+kr*kdim,sh,kdim,DOUBLE);
	  
	  /* Compute the maximum of the 2. order difference. The
	     kordnew previous 2. order differences are stored in
	     sdd2 and the current one (sdd+3*kdim) is to overwrite
	     sdd2+kih*kdim. The fact that only one new element enters
	     sdd2 at a time can be taken advantage of in computing 
	     the maximum difference.   */
	  
	  if (kstop == 2)
	    {
	      for (kihn=(kih+1)%kordnew, kh=0; kh<kdim; kh++)
		{
		  sh[kh] = fabs(sh[kh]);
		  if (sdd2[kih*kdim+kh] < smaxd[kh])
		    smaxd[kh] = MAX(smaxd[kh],sh[kh]);
		  else if (sh[kh] >= smaxd[kh])
		    smaxd[kh] = sh[kh];
		  else
		    {
		      for (kjh=kihn, smaxd[kh]=sh[kh], kl=0;
			   kl<kordnew-1; kl++, kjh=(kjh+1)%kordnew)
			smaxd[kh] = MAX(smaxd[kh],sdd2[kjh*kdim+kh]);
		    }
		  sdd2[kih*kdim+kh] = sh[kh];
		}
	      kih = kihn;
	    }
	}
      
      /* Compute the number of interpolation points.  */
      
      for (kant=0, kh=0; kh<kdim; kh++)
	{
	  tant = (tb-ta)*sqrt(smaxd[kh]/((double)8.0*aepsge));
	  kant = MAX(MAX(kant,(int)tant),1);
	}
      
      /* Make sure that par is great enough.  */
      
      if (kpar+kant >= kmaxpar)
	if ((par = increasearray(par,(kmaxpar+=MAX(kant,knmbel)),DOUBLE)) 
	    == SISL_NULL) goto err101;
      
      /* Compute the parameter values of the interpolation points.  */
      
      for (th=(tb-ta)/(double)(kant+1), kk=0; kk<kant; kpar++,kk++)
	par[kpar] = ta + (double)(kk+1)*th;
      par[kpar] = tb;
      kpar++;
    }
  
  /* Make the points.  */
  
  if ((*gpoint = newarray(kpar*kdim,DOUBLE)) == SISL_NULL) goto err101;
  
  for (kh=kk=0; kk<kpar; kk++,kh+=kdim)
    {
      s1221(pc,0,par[kk],&left,*gpoint+kh,&kstat);
      if (kstat < 0) goto err101;
    }
  
  /* Task performed.  */
  
  *jnbpnt = kpar;
  *jstat = 0;
  goto out;
  
  
  /* Error in scratch allocation.  */
  
  err101 :
    *jstat = -101;
    s6err("s1605",*jstat,kpos);
    goto out;
  
  /* Error in input. Dimension less than one.  */
  
  err102 :
    *jstat = -102;
    s6err("s1605",*jstat,kpos);
    goto out;
  
  /* Error in input. Order less than one.  */
  
  err110 :
    *jstat = -110;
    s6err("s1605",*jstat,kpos);
    goto out;
  
  /* Error in input. Number of coefficients less than order.  */
  
  err111 :
    *jstat = -111;
    s6err("s1605",*jstat,kpos);
    goto out;
  
  out :
    /* Free scratch occupied by local arrays.  */
    
    if (sdd != SISL_NULL) freearray(sdd);
    if (par != SISL_NULL) freearray(par);
}

//===========================================================================
void make_cv_kreg (SISLCurve * pc, SISLCurve ** rcnew, int *jstat)
//===========================================================================
{
   int kn=pc->in;	/* Number of vertices in 1. par. dir.  */
   int kk=pc->ik;	/* Order in 1. par. dir.               */
   /* --------------------------------------------------------- */
   /* Pick part of curve */
   s1712 (pc, pc->et[kk-1], pc->et[kn], rcnew, jstat);
  if (*jstat < 0)  goto error;

   if (pc->cuopen == SISL_CRV_PERIODIC )
     (*rcnew)->cuopen = SISL_CRV_CLOSED;

  goto out;

  /* Error in lower level routine */
error:
  s6err ("make_cv_kreg", *jstat, 0);

out:;

}

//===========================================================================
SISLIntpt * hp_newIntpt (int ipar, double *epar, double adist, int itype,
			 int ileft1, int iright1, int ileft2, int iright2,
			 int size_1, int size_2, double egeom1[], double egeom2[])
//===========================================================================
{
  SISLIntpt *pnew;		/* Local pointer to instance to create. */
  int ki;			/* Counter.                             */


  /* Allocate space for instance of Intpt. */

  pnew = new0array (1, SISLIntpt);
  if (pnew == SISL_NULL)
    goto err101;

  /* Initialize parameters concerning the size of arrays describing
     the intersection curves in which this points lie, and allocate
     scratch for the arrays.      */

  pnew->no_of_curves_alloc = 4;
  pnew->no_of_curves = 0;

  if ((pnew->pnext = newarray (pnew->no_of_curves_alloc, SISLIntpt *)) == SISL_NULL)
    goto err101;
  if ((pnew->curve_dir = newarray (pnew->no_of_curves_alloc, INT)) == SISL_NULL)
    goto err101;
  if ((pnew->left_obj_1 = newarray (pnew->no_of_curves_alloc, INT)) == SISL_NULL)
    goto err101;
  if ((pnew->left_obj_2 = newarray (pnew->no_of_curves_alloc, INT)) == SISL_NULL)
    goto err101;
  if ((pnew->right_obj_1 = newarray (pnew->no_of_curves_alloc, INT)) == SISL_NULL)
    goto err101;
  if ((pnew->right_obj_2 = newarray (pnew->no_of_curves_alloc, INT)) == SISL_NULL)
    goto err101;

  /* Initialize instance. First allocate space for parameter array. */

  pnew->epar = SISL_NULL;
  if (ipar > 0)
    {
      pnew->epar = newarray (ipar, DOUBLE);
      if (pnew->epar == SISL_NULL)
	goto err101;
    }


  /* Initialize the variables of the instance. */

  pnew->ipar = ipar;
  for (ki = 0; ki < ipar; ki++)
    pnew->epar[ki] = epar[ki];
  pnew->adist = adist;
  pnew->pcurve = SISL_NULL;
  pnew->edge_1 = 0;
  pnew->edge_2 = 0;
  pnew->iinter = itype;
  pnew->marker = 0;
  pnew->evaluated = 0;

  if (size_1 > 0)
    {
      pnew->geo_data_1 = newarray (size_1, DOUBLE);
      pnew->size_1 = size_1;
      memcopy (pnew->geo_data_1, egeom1, size_1, double);
    }
  else
    {
      pnew->geo_data_1 = SISL_NULL;
      pnew->size_1 = 0;
    }

  if (size_2 > 0)
    {
      pnew->geo_data_2 = newarray (size_2, DOUBLE);
      pnew->size_2 = size_2;
      memcopy (pnew->geo_data_2, egeom2, size_2, double);
    }
  else
    {
      pnew->geo_data_2 = SISL_NULL;
      pnew->size_2 = 0;
    }


  *(pnew->left_obj_1) = ileft1;
  *(pnew->left_obj_2) = ileft2;
  *(pnew->right_obj_1) = iright1;
  *(pnew->right_obj_2) = iright2;

  for (ki = 0; ki < pnew->no_of_curves_alloc; ki++)
    pnew->pnext[ki] = SISL_NULL;

  /*  for (ki=0; ki<6; ki++) pnew -> geo_aux[ki] = DZERO; */

  pnew->trim[0] = SISL_NULL;
  pnew->trim[1] = SISL_NULL;

  /* Init the left/right evaluator to default value zero. */
  pnew->iside_1 = 0;
  pnew->iside_2 = 0;
  
  /* Task done.  */

  goto out;

  /* Error in space allocation. Return zero. */

err101:pnew = SISL_NULL;
  goto out;

out:return (pnew);
}

//===========================================================================
void sh6idnpt(SISLIntdat **pintdat,SISLIntpt **pintpt,int itest,int *jstat)
//===========================================================================
{
  register int ki,kj;              /* Counters.    */
  
  /* We have to be sure that we have an intdat structure. */
  
  if ((*pintdat) == SISL_NULL)
    {
      if (((*pintdat) = newIntdat()) == SISL_NULL) goto err101;
    }
  
  
  /* Then we have to be sure that we do not have the intersection point
     before or an equal point. */
  
  for (ki=0; ki<(*pintdat)->ipoint; ki++)
    if ((*pintdat)->vpoint[ki] == (*pintpt))
      {
	*jstat = 1;
	goto out;
      }
    else if (itest)
      {
	for (kj=0; kj<(*pintpt)->ipar; kj++)
	  if (DNEQUAL((*pintpt)->epar[kj],(*pintdat)->vpoint[ki]->epar[kj]))
	    break;
	
	if (kj == (*pintpt)->ipar)
	  {
	    freeIntpt(*pintpt);
	    (*pintpt) = (*pintdat)->vpoint[ki];
	    *jstat = 2;
	    goto out;
	  }
      }
  
  
  /* Then we have to be sure that the array vpoint is great enough. */
  
  if (ki == (*pintdat)->ipmax)
    {
      (*pintdat)->ipmax += 20;
      
      if (((*pintdat)->vpoint = increasearray((*pintdat)->vpoint,
					      (*pintdat)->ipmax,SISLIntpt *)) == SISL_NULL) 
	goto err101;
    }
  
  
  /* Now we can insert the new point. */
  
  (*pintdat)->vpoint[ki] = (*pintpt);
  (*pintdat)->ipoint++;
  *jstat = 0;
  goto out;
  

/* Error in space allocation.  */

err101: *jstat = -101;
        s6err("sh6idnpt",*jstat,0);
        goto out;

 out: ;
}

//===========================================================================
void sh1790(SISLObject *po1,SISLObject *po2,int itype, double aepsge,int *jstat)
//===========================================================================
{
  int kstat = 0;        /* Local status error.                        */
  int kpos = 0;         /* Position of error.                         */
  int ktype = itype%10; /* Type of box to make.                       */
  int kant;             /* Number of sides in all boxes.              */
  int kdim1,kdim2;      /* Dimension of space.	    	   	      */
  int ki,kj=0;          /* Counters.                                  */
  int kpttest=0;        /* Indicates wether one object is a point and
			   the geometry has dimension greater than 1.
			   In that case the boundaries of the box is
			   placed further out in the min- and max-arrays. */
  int kshadow = 0;      /* Indicates if there is a risk of a shadow areas */
  int kbez = 0;         /* Indicates if any object is a bezier object.    */
  double tdist;         /* Distance between boxes.                    */
  double teps1;         /* To be used in 1D.                          */
  double teps2;         /* Two times aepsge if expanded box.          */
  double tepsge = aepsge; /* Tolerance to be used locally. In 1D 
			     tepsge=2*aepsge since the point is not
			     expended.                                */
  double t1,t2,t3,t4;   /* Help variables.                            */
  double t01,t02,t03,t04;   /* Help variables.                        */
  double *tmin1,*tmax1; /* Smallest and larges value of the vertices of
			   first object in each box in all dimension. */
  double *tmin2,*tmax2; /* Smallest and larges value of the vertices of
                           second object in each box in all dimension.*/
  
  /* Set local tolerance.  */
  
  teps2 = (ktype == 0) ? aepsge : (double)2.0*aepsge;
  
  /* Check if one object is a point. */
  
  if (po1->iobj == SISLPOINT) kdim1 = po1->p1->idim;
  else if (po1->iobj == SISLCURVE) kdim1 = po1->c1->idim;
  else if (po1->iobj == SISLSURFACE) kdim1 = po1->s1->idim;
  
  if (kdim1 == 1)
  {
     if (ktype != 0) teps2 = (double)3.0*aepsge;
     teps1 = (ktype == 0) ? aepsge : aepsge+aepsge;
     
     if (po1->iobj == SISLPOINT || po2->iobj == SISLPOINT)
	tepsge += aepsge;
  }
  else
  {
     teps1 = DZERO;
     if (po1->iobj == SISLPOINT || po2->iobj == SISLPOINT)
	kpttest = 1;
  }

	       
  /* Compute the box of the first object.  */ 
  
  sh1992(po1,itype,tepsge,&kstat);
  if (kstat < 0) goto error;
  
  /* VSK. 06.93. Adjust microbox tolerance in bezier case. */
 
  if (ktype != 0 && kstat == 1) kbez = 1;

  /* Set pointers to box boundaries.  */
  
  if (po1->iobj == SISLPOINT)
  {
     tmin1 = po1->p1->pbox->e2min[ktype];
     tmax1 = po1->p1->pbox->e2max[ktype];
  }
  else if (po1->iobj == SISLCURVE)
  {
     tmin1 = po1->c1->pbox->e2min[ktype];
     tmax1 = po1->c1->pbox->e2max[ktype];
  }       
  else if (po1->iobj == SISLSURFACE)
  {
     tmin1 = po1->s1->pbox->e2min[ktype];
     tmax1 = po1->s1->pbox->e2max[ktype];
  }         
  else goto err121;
  
  /* Make requested box.  */
		 
  sh1992(po2,itype,tepsge,&kstat);
  if (kstat < 0) goto error;

  /* VSK. 06.93. Adjust microbox tolerance in bezier case. */

  if (ktype != 0 && kstat == 1) kbez += 1;
  if (kdim1 == 1 && kbez > 0) teps2 -= (double)2.0*aepsge;
  else if (kbez > 0) teps2 -= aepsge;
  if (kbez) teps1 = aepsge;

  /* Set pointers to box boundaries.  */
  
  if (po2->iobj == SISLPOINT)
  {
     tmin2 = po2->p1->pbox->e2min[ktype];
     tmax2 = po2->p1->pbox->e2max[ktype];
     kdim2 = po2->p1->idim;
  }  
  else if (po2->iobj == SISLCURVE)
  {
     tmin2 = po2->c1->pbox->e2min[ktype];
     tmax2 = po2->c1->pbox->e2max[ktype];
     kdim2 = po2->c1->idim;
  }       
  else if (po2->iobj == SISLSURFACE)
  {
     tmin2 = po2->s1->pbox->e2min[ktype];
     tmax2 = po2->s1->pbox->e2max[ktype];
     kdim2 = po2->s1->idim;
  }       
  else goto err121;
  
  /* Check dimension. */
  
  if (kdim1 != kdim2 ) goto err106;
  else
    if (kdim1 < 1 )   goto err105;
  
  
  /* Compute total number of SISLbox edges. */
  
  if (itype < 10 && kdim1 == 3) kant = 9;
  else
    if (itype < 10 && kdim1 == 2) kant = 4;
    else           kant = kdim1;
  
  
  /* For each dimension in all boxes perform box-test. First check
     that we point on the right place in the min- and max-arrays.  */	
  
  if (kpttest)
  {
     tmin1 += kant;
     tmin2 += kant;
     tmax1 += kant;
     tmax2 += kant;
  }
  
  for (ki=0; ki<kant; ki++,tmin1++,tmax1++,tmin2++,tmax2++)
    {
      /* Sorting: t1-t2 The SISLbox with largest max value.
	 t3-t4 The other box. */
      
      if (*tmax1 > *tmax2)
	{
	  t1 = *tmax1;   t01 = *(tmax1 - kant*kpttest);
	  t2 = *tmin1;   t02 = *(tmin1 - kant*kpttest);
	  t3 = *tmax2;   t03 = *(tmax2 - kant*kpttest);
	  t4 = *tmin2;   t04 = *(tmin2 - kant*kpttest);
	}
      else
	{
	  t1 = *tmax2;   t01 = *(tmax2 - kant*kpttest);
	  t2 = *tmin2;   t02 = *(tmin2 - kant*kpttest);
	  t3 = *tmax1;   t03 = *(tmax1 - kant*kpttest);
	  t4 = *tmin1;   t04 = *(tmin1 - kant*kpttest);
	}
      tdist = t2 - t3;

      /* Use non-expanded boxes when testing if minibox is possible. */
      
      if (t01 - min(t02,t04) <= teps2)
	kj++;                 /* Minibox is possible. */
      else if (kdim1 == 1 && t01-t04 <= teps1 && t03-t02 <= teps1)
	kj++;                 /* Minibox is possible. */
      else if (t3 < t2 && (tdist > teps2 || !kpttest))
	{
	  *jstat = 0;           /* No overlap. */
	  goto out;
	}
      else if (t3 < t2)
	 kshadow = 1;           /* Danger of shadow area.  */

      /* UJK and ALA, 91-08: The tolerance is now
	 incorporated in the box. 
	 else if (kdim1 != 1 && t3 - t2 < tepsge && t3 - t4 > teps2 &&
	 t1 - t2 > teps2)
	 {
	 *jstat = 2;           Only edge touching possible. 
	 goto degenerate;
	 }
	 else if ( kdim1 == 1 && (t1 - t4 < tepsge || t3 - t2 < tepsge))
	 {
	 *jstat = 2;            Only edge touching possible. 
	 goto out;
	 } */
	
      /* else possible overlap. */
    }
  
  if (kj == kant)
    *jstat = 3;                   /* Minibox found. */
  else if (kshadow)
     *jstat = 5;                  /* Danger of shadow area.  */
  else
    *jstat = 1;                   /* Overlap.  */
  
  
  /* Box-test performed. */
  
  /* degenerate: */
  /* Test if one of the objects has collapsed. Use non-expanded box.  */
  if (kdim1 != 1 && po1->iobj > SISLPOINT)
    {
      if (po1->iobj == SISLCURVE)
	{
	  tmin1 = po1->c1->pbox->e2min[ktype];
	  tmax1 = po1->c1->pbox->e2max[ktype];
	}
      
      else if (po1->iobj == SISLSURFACE)
	{
	  tmin1 = po1->s1->pbox->e2min[ktype];
	  tmax1 = po1->s1->pbox->e2max[ktype];
	}
      
      /* Make sure that we are correct place in the min- and max-arrays. */
      
      if (kpttest)
      {
	 tmin1 += kant;
	 tmax1 += kant;
      }
      
      for(ki=0;ki<kdim1;ki++,tmin1++,tmax1++)
	if (fabs(tmax1[0]-tmin1[0]) > tepsge) break;
      
      if (ki == kdim1+1)
	{
	  *jstat = 4;
	  goto out;
	}
    }
  
  if (kdim1 != 1 && po2->iobj > SISLPOINT)
    {
      if (po2->iobj == SISLCURVE)
	{
	  tmin1 = po2->c1->pbox->e2min[ktype];
	  tmax1 = po2->c1->pbox->e2max[ktype];
	}
      
      else if (po2->iobj == SISLSURFACE)
	{
	  tmin1 = po2->s1->pbox->e2min[ktype];
	  tmax1 = po2->s1->pbox->e2max[ktype];
	}
      
      /* Make sure that we are correct place in the min- and max-arrays. */
      
      if (kpttest)
      {
	 tmin1 += kant;
	 tmax1 += kant;
      }
      
      for(ki=0;ki<kdim1;ki++,tmin1++,tmax1++)
	if (fabs(tmax1[0]-tmin1[0]) > tepsge) break;
      
      if (ki == kdim1+1)
	{
	  *jstat = 4;
	  goto out;
	}
    }
  goto out;
  
  /* Dimensions conflicting. */
  
 err106: *jstat = -106;
  s6err("sh1790",*jstat,kpos);
  goto out;
  
  /* Dimensions less than one. */
  
 err105: *jstat = -105;
  s6err("sh1790",*jstat,kpos);
  goto out;
  
  /* Kind of object does not exist. */
  
 err121: *jstat = -121;
  s6err("sh1790",*jstat,kpos);
  goto out;
  
  /* Error in lower level routine. */
  
 error:  *jstat = kstat;
  s6err("sh1790",*jstat,kpos);
  goto out;
  
 out:	return;
}

//===========================================================================
SISLEdge *newEdge (int iedge)
//===========================================================================
{
  int ki;			/* Counter.                          */
  SISLEdge *pnew;		/* Local pointer to the instance.    */
  SISLPtedge *(*ppt);		/* Pointer to traverst array prpt of
			       pointers to Ptedge-instances.     */

  /* Allocate space for instance.  */

  pnew = newarray (1, SISLEdge);
  if (pnew == SISL_NULL)
    goto err101;

  /* Allocate space for array of pointers to Ptedge. */

  pnew->prpt = newarray (iedge, SISLPtedge *);
  if (pnew->prpt == SISL_NULL)
    goto err101;

  /* Initiate the variables of the instance. */

  pnew->iedge = iedge;
  pnew->ipoint = 0;

  ppt = pnew->prpt;
  for (ki = 0; ki < iedge; ki++)
    *(ppt++) = SISL_NULL;

  /* Task done. */

  goto out;

  /* Error in space allocation. Retrun zero. */

err101:pnew = SISL_NULL;
  goto out;

out:return (pnew);
}

//===========================================================================
void s1438(SISLCurve  *pc,int iedge,SISLPoint **rpedge,double *cpar,int *jstat)
//===========================================================================
{
  int kpos = 0;         /* Position of error.                             */
  
  if (iedge == 0)
    {
      *cpar = pc->et[pc->ik - 1];
      
      if (((*rpedge) = newPoint(pc->ecoef,pc->idim,1)) == SISL_NULL)
	goto err101;
    }
  else if (iedge == 1)
    {
      *cpar = pc->et[pc->in];
      
      if (((*rpedge)=newPoint(pc->ecoef+pc->idim*(pc->in-1),pc->idim,1))==SISL_NULL)
	goto err101;
    }
  else goto err141;
  
  /* SISLPoint picked.  */
  
  *jstat = 0;
  goto out;
  
  
  /* Error in space allocation.  */
  
 err101: *jstat = -101;
  s6err("s1438",*jstat,kpos);
  goto out;
  
  /* Error in number of edges.  */
  
  err141 : *jstat = -141;
  s6err("s1438",*jstat,kpos);
  goto out;
  
 out: ;
}

//===========================================================================
void sh1782 (SISLObject * po1, SISLObject * po2, double aepsge,
	     SISLIntdat * pintdat, int ipar, double apar,
	     SISLIntdat ** rintdat, int *jnewpt, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                     */
  int kdim;			/* Dimension of geometry space.         */
  int knpoint;			/* Number of int.pt. in array.          */
  SISLIntpt **uintpt = SISL_NULL;	/* Array storing intersection points.   */

  *jnewpt = 0;

  /* Test if an intersection data structure exist.  */

  if (pintdat == SISL_NULL)
    {
      *jstat = 0;
      goto out;
    }

  /* Fetch dimension of geometry space. */

  if (po1->iobj == SISLPOINT)
    kdim = po1->p1->idim;
  else if (po1->iobj == SISLCURVE)
    kdim = po1->c1->idim;
  else
    kdim = po1->s1->idim;

  /* Insert the intersection points from pintdat into the structure
     *rintdat belonging to the current problem.  */

  sh6idput (po1, po2, rintdat, pintdat, ipar, apar, &uintpt, &knpoint, &kstat);
  if (kstat < 0)
    goto error;

  if (knpoint == 0)
    {
      *jstat = 0;
      goto out;
    }


  /* Browse on the dimension of geometry space and the type of
     the input objects.     */

  if (kdim <= 2 && ((po1->iobj == SISLSURFACE && po2->iobj == SISLPOINT)
		    || (po2->iobj == SISLSURFACE && po1->iobj == SISLPOINT)))
    {
      /* Compute pre-topology in one-dimensional surface-level value
         intersection.           */

      sh1782_s9sf_pt (po1, po2, aepsge, rintdat, uintpt, knpoint,
		      ipar, &kstat);
      if (kstat < 0)
	goto error;

    }

  else if (kdim == 3 && 
	 ((po1->iobj == SISLSURFACE && po2->iobj == SISLCURVE) ||
	  (po1->iobj == SISLCURVE && po2->iobj == SISLSURFACE )))
    {
      /* Surface-surface intersection in 3-dimensional geometry space. */

      sh1782_s9sf_cu (po1, po2, aepsge, rintdat, uintpt, knpoint,
		      ipar, &kstat);
      if (kstat < 0)
	goto error;
    }

  else if (kdim == 3 && po1->iobj == SISLSURFACE
	   && po2->iobj == SISLSURFACE)
    {
      /* Surface-surface intersection in 3-dimensional geometry space. */

      sh1782_s9sf_sf (po1, po2, aepsge, rintdat, uintpt, knpoint,
		      ipar, &kstat);
      if (kstat < 0)
	goto error;
    }

  /* Task performed.  */

  *jstat = 0;
  goto out;

  /* Error in lower level routine.  */

error:*jstat = kstat;
  goto out;

out:if (uintpt != SISL_NULL)
    freearray (uintpt);
}

//===========================================================================
void sh1782_s9sf_pt (SISLObject * po1, SISLObject * po2, double aepsge,
		     SISLIntdat ** rintdat, SISLIntpt ** uintpt, int kpoint,
		     int ipar, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int kdim;			/* Dimension of geometry space.            */
  double tdum, tsign;		/* Parameters used to browse between cases.*/
  double *sder;			/* Surface geometry values.                */
  double *sdum;			/* Normal of surface(dummy)                */
  int ind;			/* Index for curve's par val.              */
  int ki, kj, klow, khigh;	/* Help indexes into uintpt                */
  int index1, index2;		/* Dummy in this context                   */
  int kant;			/* Edge indicator                          */
  int *edge_f, *edge_l;		/* Pointers to atribute edge in intpt      */
  SISLSurf *ps;			/* The 1D Surface                          */
  /* --------------------------------------------------------------------- */

  /* Test input */
  kdim = (po1->iobj == SISLSURFACE) ? po1->s1->idim : po2->s1->idim;
  if (kdim != 1 && kdim !=2)
    goto err106;

  if (ipar == 0)
    ind = 1;
  else
    ind = 0;

  if (po1->iobj == SISLSURFACE)
    tsign = (double) 1.0;
  else
    tsign = -(double) 1.0;

  /* Loop for all points */
  for (ki = 0; ki < kpoint; ki++)
    for (kj = ki + 1; kj < kpoint; kj++)
      /* Connected ? */
      {
	sh6getlist (uintpt[ki], uintpt[kj], &index1, &index2, &kstat);
	if (kstat < 0)
	  goto error;
	if (!kstat)
	  {
	    /* They are connected, sort on edge par val*/
	    if (uintpt[ki]->epar[ind] <
		uintpt[kj]->epar[ind])
	      {
		klow = ki;
		khigh = kj;
	      }
	    else
	      {
		klow = kj;
		khigh = ki;
	      }

	    /* Fetch geometry of surface */
	    sh6getgeom ((po1->iobj == SISLSURFACE) ? po1 : po2,
			(po1->iobj == SISLSURFACE) ? 1 : 2,
			uintpt[klow], &sder, &sdum, aepsge, &kstat);

	    if (kstat < 0)
	      goto error;

	    if (ipar == 0)
	      tdum = tsign * sder[1];
	    else
	      tdum = -tsign * sder[2];

	    if (tdum > DZERO)
	      sh6setdir (uintpt[klow], uintpt[khigh], &kstat);
	    else if (tdum < 0)
	      sh6setdir (uintpt[khigh], uintpt[klow], &kstat);

	      sh6setcnsdir (uintpt[klow], uintpt[khigh], ipar, &kstat);

	    /* Mark edge intersection curve */
	    if (sh6ismain (uintpt[ki]) && sh6ismain (uintpt[kj]) &&
		po1->o1 == po1 &&
		po2->o1 == po2)
	      {

		ps = po1->s1;
		edge_f = &(uintpt[ki]->edge_1);
		edge_l = &(uintpt[kj]->edge_1);

		if (po2->iobj == SISLSURFACE)
		  {
		    edge_f = &(uintpt[ki]->edge_2);
		    edge_l = &(uintpt[kj]->edge_2);
		    ps = po2->s1;
		  }

		kant = 0;
		if (ipar == 0)
		  {
		    if (DEQUAL (uintpt[ki]->epar[ipar],
				ps->et1[ps->ik1 - 1]))
		      kant = -1;
		    else if (DEQUAL (uintpt[ki]->epar[ipar],
				     ps->et1[ps->in1]))
		      kant = 1;
		  }
		else
		  {
		    if (DEQUAL (uintpt[ki]->epar[ipar], ps->et2[ps->ik2 - 1]))
		      kant = 1;
		    else if (DEQUAL (uintpt[ki]->epar[ipar],
				     ps->et2[ps->in2]))
		      kant = -1;
		  }

		if (kant)
		  {
		    if ((double) kant * tdum > DZERO)
		      *edge_f = *edge_l = SI_RIGHT;
		    else if ((double) kant * tdum < DZERO)
		      *edge_f = *edge_l = SI_LEFT;

		  }

	      }

	  }
      }

  *jstat = 0;
  goto out;

  /* Error in input. Incorrect dimension.  */

err106:*jstat = -106;
  goto out;

  /* Error lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
  return;
}

//===========================================================================
void sh1782_s9sf_cu (SISLObject * po1, SISLObject * po2, double aepsge,
		     SISLIntdat ** rintdat, SISLIntpt ** uintpt, int kpoint,
		     int ipar, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int kdim;			/* Dimension of geometry space.            */
  double tdum;			/* Parameter used to browse on the cases.  */
  double *val_s1;		/* Surface geometry                        */
  double *val_s2;		/* Surface geometry                        */
  double *snorm1;		/* Normal vector of surface.               */
  double *snorm2;		/* Normal vector of surface.               */
  double *sdir;	        	/* Direction vector of intersection curve. */
  double *stang;		/* Tangent vector of edge curve.           */
  int ind;			/* Index for curve's par val.              */
  int ki, kj, klow, khigh;	/* Help indexes into uintpt                */
  int index1, index2;		/* Dummy in this context                   */
  int kcurve;			/* Which object is the curve?		   */
  /* --------------------------------------------------------------------- */
  
  *jstat = 0;

  /* Test input */
  
  if (po1->iobj == SISLCURVE && po2->iobj == SISLSURFACE)
  {
     kcurve = 1;
     kdim = po1->c1->idim;
     if (kdim != 3)
	goto err104;
     if (kdim != po2->s1->idim)
	goto err106;
  }
  else if (po1->iobj == SISLSURFACE && po2->iobj == SISLCURVE)
  {
     kcurve = 2;
     kdim = po1->s1->idim;
     if (kdim != 3)
	goto err104;
     if (kdim != po2->c1->idim)
	goto err106;
  }
  else
    goto err104;
  
  /* Get index for curve par val  */
  if (kcurve == 1 && ipar == 1)
    ind = 2;
  else  if ((kcurve == 1 && ipar == 2) ||
	    (kcurve == 2 && ipar == 0))
    ind = 1;
  else  if (kcurve == 2 && ipar == 1)
    ind = 0;
  else
     goto out;
  
  /* Loop for all points */
  for (ki = 0; ki < kpoint; ki++)
    for (kj = ki + 1; kj < kpoint; kj++)
      /* Connected ? */
      {
	sh6getlist (uintpt[ki], uintpt[kj], &index1, &index2, &kstat);
	if (kstat < 0)
	  goto error;
	if (!kstat)
	  {
	    /* They are connected, sort on edge par val*/
	    if (uintpt[ki]->epar[ind] <
		uintpt[kj]->epar[ind])
	      {
		klow = ki;
		khigh = kj;
	      }
	    else
	      {
		klow = kj;
		khigh = ki;
	      }

	    /* Get geometry first object */
	    sh6getgeom (po1, 1, uintpt[klow], &val_s1, &snorm1, aepsge, &kstat);
	    if (kstat < 0)
	      goto error;

	    /* Get geometry second object */
	    sh6getgeom (po2, 2, uintpt[klow], &val_s2, &snorm2, aepsge, &kstat);
	    if (kstat < 0)
	      goto error;

	    /* Fetch tangent of edge curve.  */
	    if (ipar == 0)
	      stang = val_s1 + 6;
	    else if (ipar == 1 && kcurve == 2)
	      stang = val_s1 + 3;
	    else if (ipar == 1 && kcurve == 1)
	      stang = val_s2 + 6;
	    else
	      stang = val_s2 + 3;

	    /* The direction of the intersection curve is set along
	       the direction of the curve in the intersection.  */
	    if (kcurve == 1)
	       sdir = val_s1 + 3;
	    else
	       sdir = val_s2 + 3;

	    tdum = s6scpr (sdir, stang, kdim);

	    if (tdum > 0)
	      sh6setdir (uintpt[klow], uintpt[khigh], &kstat);
	    else if (tdum < 0)
	      sh6setdir (uintpt[khigh], uintpt[klow], &kstat);

	      sh6setcnsdir (uintpt[klow], uintpt[khigh], ipar, &kstat);
	  }
      }
  *jstat = 0;
  goto out;


  /* Error in input. Dimension not equal to 3. */

err104:*jstat = -104;
  goto out;

  /* Error in input. Conflicting dimensions.  */

err106:*jstat = -106;
  goto out;

  /* Error lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
  return;
}

//===========================================================================
void sh1782_s9sf_sf (SISLObject * po1, SISLObject * po2, double aepsge,
		     SISLIntdat ** rintdat, SISLIntpt ** uintpt, int kpoint,
		     int ipar, int *jstat)
//===========================================================================
{
  int kstat = 0;		/* Status variable.                        */
  int kdim;			/* Dimension of geometry space.            */
  double tdum;			/* Parameter used to browse on the cases.  */
  double *val_s1;		/* Surface geometry                        */
  double *val_s2;		/* Surface geometry                        */
  double *snorm1;		/* Normal vector of surface.               */
  double *snorm2;		/* Normal vector of surface.               */
  double sdir[3];		/* Direction vector of intersection curve. */
  double *stang;		/* Tangent vector of edge curve.           */
  int ind;			/* Index for curve's par val.              */
  int ki, kj, klow, khigh;	/* Help indexes into uintpt                */
  int index1, index2;		/* Dummy in this context                   */
  int *edge_f, *edge_l;		/* Pointers to atribute edge in intpt      */
  int kant;			/* Edge indicator                          */
  SISLSurf *ps;			/* The 3D Surface enhanced                 */
  /* --------------------------------------------------------------------- */

  /* Test input */
  kdim = po1->s1->idim;
  if (kdim != 3)
    goto err104;
  if (kdim != po2->s1->idim)
    goto err106;

  /* Get index for curve par val  */
  if (ipar == 0)
    ind = 1;
  else if (ipar == 1)
    ind = 0;
  else if (ipar == 2)
    ind = 3;
  else
    ind = 2;

  /* Loop for all points */
  for (ki = 0; ki < kpoint; ki++)
    for (kj = ki + 1; kj < kpoint; kj++)
      /* Connected ? */
      {
	sh6getlist (uintpt[ki], uintpt[kj], &index1, &index2, &kstat);
	if (kstat < 0)
	  goto error;
	if (!kstat)
	  {
	    /* They are connected, sort on edge par val*/
	    if (uintpt[ki]->epar[ind] <
		uintpt[kj]->epar[ind])
	      {
		klow = ki;
		khigh = kj;
	      }
	    else
	      {
		klow = kj;
		khigh = ki;
	      }




	    /* Get geometry first object */
	    sh6getgeom (po1, 1, uintpt[klow], &val_s1, &snorm1, aepsge, &kstat);
	    if (kstat < 0)
	      goto error;

	    /* Get geometry second object */
	    sh6getgeom (po2, 2, uintpt[klow], &val_s2, &snorm2, aepsge, &kstat);
	    if (kstat < 0)
	      goto error;

	    /* Get geometry lower level object */
	    /* Fetch tangent of edge curve.  */
	    if (ipar == 0)
	      stang = val_s1 + 6;
	    else if (ipar == 1)
	      stang = val_s1 + 3;
	    else if (ipar == 2)
	      stang = val_s2 + 6;
	    else
	      stang = val_s2 + 3;

	    /* Compute direction of intersection curve.  */
	    s6crss (snorm1, snorm2, sdir);

	    tdum = s6scpr (sdir, stang, kdim);

	    if (tdum > 0)
	      sh6setdir (uintpt[klow], uintpt[khigh], &kstat);
	    else if (tdum < 0)
	      sh6setdir (uintpt[khigh], uintpt[klow], &kstat);

	      sh6setcnsdir (uintpt[klow], uintpt[khigh], ipar, &kstat);
	    /* Mark edge intersection curve */
	    if (sh6ismain (uintpt[ki]) && sh6ismain (uintpt[kj]) &&
		po1->o1 == po1 &&
		po2->o1 == po2)
	      {

		if (ipar < 2)
		  /* First surf */
		  {
		    edge_f = &(uintpt[ki]->edge_1);
		    edge_l = &(uintpt[kj]->edge_1);
		    ps = po1->s1;
		  }
		else
		  {
		    edge_f = &(uintpt[ki]->edge_2);
		    edge_l = &(uintpt[kj]->edge_2);
		    ps = po2->s1;
		  }

		kant = 0;
		if (ipar == 0 || ipar == 2)
		  {
		    if (DEQUAL (uintpt[ki]->epar[ipar],
				ps->et1[ps->ik1 - 1]))
		      kant = -1;
		    else if (DEQUAL (uintpt[ki]->epar[ipar],
				     ps->et1[ps->in1]))
		      kant = 1;
		  }
		else
		  {
		    if (DEQUAL (uintpt[ki]->epar[ipar], ps->et2[ps->ik2 - 1]))
		      kant = 1;
		    else if (DEQUAL (uintpt[ki]->epar[ipar],
				     ps->et2[ps->in2]))
		      kant = -1;
		  }

		if (kant)
		  {
		    if ((double) kant * tdum > DZERO)
		      *edge_f = *edge_l = SI_RIGHT;
		    else if ((double) kant * tdum < DZERO)
		      *edge_f = *edge_l = SI_LEFT;

		  }





	      }
	  }
      }
  *jstat = 0;
  goto out;


  /* Error in input. Dimension not equal to 3. */

err104:*jstat = -104;
  goto out;

  /* Error in input. Conflicting dimensions.  */

err106:*jstat = -106;
  goto out;

  /* Error lower level routine.  */

error:*jstat = kstat;
  goto out;

out:
  return;
}

/// \endcond SISL
