/* This file contains some modifications to the LODSCORE program */
/* described in the papers: */
/* R. W. Cottingham Jr., R. M. Idury, And A. A. Schaffer, */
/* Faster Sequential Genetic Linkage Computations */
/* American Journal of Human Gentics, 53(1993), pp. 252-263 */
/* and A. A. Schaffer, S. K. Gupta, K. Shriram, and R. W. Cottingham, Jr. */
/* Avoiding Recomputation in Linkage Analysis */
/* Human Heredity 44(1994), pp. 225-237. */

#include "commondefs.h"
#if !defined(DOS)
#include "checkpointdefs.h"
#endif
#include "gemdefs.h"
#include "lodefs.h"
#ifndef LESSMEMORY
#include "moddefs.h"
#endif

Void setiterate();

static Void getinformative()
{
  int i, j, k, l, m, count, nchild;
  thisperson *child;
  int FORLIM1, FORLIM3;
  phenotype *WITH;
  locusvalues *WITH1;

  if (fitmodel) {
    for (i = 0; i < nuped; i++)
      informative[i] = true;
    return;
  }
  for (i = 0; i < nuped; i++) {
    informative[i] = false;
    FORLIM1 = endped[i];
    /*Is there any data to use*/
    for (j = startped[i]; j <= FORLIM1; j++) {
      count = 0;
      for (k = 0; k < mlocus; k++) {
	WITH = person[j]->phen[k];
	WITH1 = thislocus[k];
	switch (WITH1->which) {

	case binary_:
	  if (WITH->phenf != 0)
	    count++;
	  break;

	case affection:
	  if (WITH->aff != missaff)
	    count++;
	  break;

	case quantitative:
	  if (person[j]->male && sexlink) {
	    if (WITH->x[0] != missaff)
	      count++;
	    else if (!WITH->missing)
	      count++;
	  }
	  break;
	/* cgh - gcc */
	case null_:
	default:
	  break;
	}
      }
      if (count > 1)
	informative[i] = true;
    }
    if (informative[i]) {
      informative[i] = false;
      FORLIM1 = endped[i];
      for (j = startped[i]; j <= FORLIM1; j++) {
	if (person[j]->foff != NULL) {
	  nchild = 0;
	  child = person[j]->foff;
	  do {
	    nchild++;
	    if (person[j]->male)
	      child = child->nextpa;
	    else
	      child = child->nextma;
	  } while (child != NULL);
	  count = 0;
	  if (nchild > 1 || (nchild == 1 && person[j]->pa != NULL)) {
	    for (k = 0; k < mlocus; k++) {
	      WITH = person[j]->phen[k];
	      WITH1 = thislocus[k];
	      if (WITH1->which != binary_)
		count++;
	      else {
		if (WITH->phenf == 0)
		  count++;
		else {
		  l = 0;
		  FORLIM3 = WITH1->nallele;
                  if (binformat == WITH1->format) {
		    for (m = 1; m <= FORLIM3; m++) {
		      if ((unsigned int)m < 32 &&
			  ((1L << m) & WITH->phenf) != 0)
			l++;
		    }
                  }
                  else
                    if ((WITH->allele1 > 0) && (WITH->allele2 > 0) &&
                        (WITH->allele1 != WITH->allele2))
                      l = 2;
		  if (l > 1)
		    count++;
		}
	      }
	    }
	  }
	  if (count > 1)
	    informative[i] = true;
	}
      }
    }
  }
}


static Void setlods(ilocus, jlocus)
int ilocus, jlocus;
{
  /*setup for lods; does not work with
    disequilibrium*/
  int i, j, thisperson_;
  thisperson *WITH;
  locusvalues *WITH1;

  mlocus = 2;
  for (thisperson_ = 1; thisperson_ <= totperson; thisperson_++) {
    WITH = person[thisperson_];
    WITH->phen[0] = WITH->holdphen[ilocus - 1];
    WITH->phen[1] = WITH->holdphen[jlocus - 1];
  }
  thislocus[0] = holdlocus[ilocus - 1];
  thislocus[1] = holdlocus[jlocus - 1];
  if (ilocus == holdmutsys) {
    mutsys = 1;
    mutmale = holdmutmale;
    mutfemale = holdmutfemale;
  } else {
    if (jlocus == holdmutsys) {
      mutsys = 2;
      mutmale = holdmutmale;
      mutfemale = holdmutfemale;
    }
  }
  increment[mlocus - 1] = 1;
  for (i = mlocus - 1; i >= 1; i--)
    increment[i - 1] = increment[i] * thislocus[i]->nallele;
  fgeno = 1;
  for (j = 0; j < mlocus; j++)
    fgeno *= thislocus[j]->nallele;
  mgeno = fgeno;
  nuhap = fgeno;
  for (i = 0; i < mlocus; i++) {
    nohom[i] = false;
    WITH1 = thislocus[i];
    if (WITH1->which == affection || WITH1->which == quantitative) {
      if (WITH1->freq[affall - 1] < minfreq)
	nohom[i] = true;
    }
  }
  fgeno = fgeno * (fgeno + 1) / 2;
  if (!sexlink)
    mgeno = fgeno;
  maletheta->theta[0] = holdmtheta;
  maletheta->theta[1] = 0.0;
  femaletheta->theta[1] = 0.0;
  if (sexdif) {
    if (!readfemale)
      distratio = holdratio;
    else
      femaletheta->theta[0] = holdftheta;
  }
  memcpy(itp, holditp, sizeof(itertype));
  if (ilocus == hitsys)
    itsys = 1;
  else {
    if (jlocus == hitsys)
      itsys = 2;
    else
      itsys = 0;
  }
  getinformative();
}


static Void outcontrol(z)
double *z;
{
  int i, j;

  j = 0;
  for (i = 0; i < n; i++) {
    fprintf(outfile, "% .5e", z[i]);
    j++;
    if (j == 4) {
      putc('\n', outfile);
      j = 0;
    }
  }
  if (j != 0)
    putc('\n', outfile);
}


double mapfunction(theta1, theta2)
double theta1, theta2;
{
  /*User defined function giving recombination between
    flanking markers as a function of recombination
    between adjacent markers*/
  return ((theta1 + theta2) / (1 + 4 * theta1 * theta2));
}


double getdist(theta)
double *theta;
{
  if (*theta < 0.5)
    return (log(1.0 - 2.0 * *theta) / -2.0);
  else
    return 10.0;
}


double invdist(dist)
double *dist;
{
  if (*dist != 10.0)
    return ((1.0 - exp(-2 * *dist)) / 2.0);
  else
    return 0.5;
}

/* saveparams saves the parameter values at the beginning of gforward
or gcentral, so we catch the optimal thetas */
Local Void saveparams()
{
  int i;
  
  for(i = 0; i < nall; i++) 
    outsavex[i] = x[i];
}

static Void fun(f, x)
double *f;
double *x;
{
  int i, k;

  k = 0;
  for (i = 0; i < nall; i++) {
    if (itp[i] == 1) {
      k++;
      xall[i] = x[k - 1];
    }
  }

  setparam();
  if (penalty) {
    *f = 1.5 * penlike;
    return;
  }
  for (i = 1; i <= totperson; i++) {
    person[i]->done = false;
    person[i]->firstpass = true;
  }
  recombination();
  alike = 0.0;
  thisc = minint;
  for (i = 1; i <= nuped; i++) {
    likelihood(i, proband[i - 1]);
    alike += like;
    likebyped[i-1] = like; /*Store likelihood for later*/
  }
  if (firsttime) {
    if (thisc < maxcensor)
      printf("Maxcensor can be reduced to %12d\n", thisc);
    else {
      if (thisc > maxcensor)
	printf("You may gain efficiency by increasing maxcensor\n");
    }
  }
  firsttime = false;
  *f = -2 * alike;
  penlike = *f;
  firsttime = false;
}


/* Local variables for outf: */
struct LOC_outf {
  double lods;
  double thisval[maxped];
} ;

Local Void getlods(f, x, LINK)
double *f;
double *x;
struct LOC_outf *LINK;
{
  int i, k;

  firstapprox = true;
  k = 0;
  for (i = 0; i < nall; i++) {
    if (itp[i] == 1) {
      k++;
      xall[i] = x[k - 1];
    }
  }
  for (i = 0; i < nuped; i++)
    LINK->thisval[i] = 0.0;
  setparam();
  if (!penalty) {
    if (byfamily) {
      for (i = 1; i <= 35; i++)
	putc('-', final);
      fprintf(final, "\nPEDIGREE |  LN LIKE  | LOG 10 LIKE\n");
      for (i = 1; i <= 35; i++)
	putc('-', final);
      putc('\n', final);
    }
    if (byfamily) { /*Then need to redo likelihoods on a by-family basis*/
    for (i = 1; i <= totperson; i++) {
      person[i]->done = false;
      person[i]->firstpass = true;
    }
    recombination();
    thisc = minint;
    for (i = 1; i <= nuped; i++) {
      likelihood(i, proband[i - 1]);
      LINK->thisval[i - 1] = like;
    }
  }
  }
  firsttime = true;
  for (i = 0; i < mlocus; i++) {
    maletheta->theta[i] = 0.5;
    femaletheta->theta[i] = 0.5;
  }
  if (penalty) {
    *f = 1.5 * penlike;
    return;
  }
  dolod = true;
  for (i = 1; i <= totperson; i++) {
    person[i]->done = false;
    person[i]->firstpass = true;
  }
  recombination();
  alike = 0.0;
  thisc = minint;
  for (i = 0; i < nuped; i++) {
    likelihood(i + 1, proband[i]);
    alike += like;
    if (byfamily) {
      fprintf(final, "%9d %9d %12.6f",
	      i + 1, proband[i]->ped, LINK->thisval[i] - like);
      fprintf(final, "%12.6f", (LINK->thisval[i] - like) / log10_);
      if (like == zerolike)
	fprintf(final, " inconsistent data\n");
      else
	putc('\n', final);
     if (byfamily) /* Need to compute family lodscore*/ 
       if (like != zerolike)
	  LINK->thisval[i] -= like;
    }
  }
  *f = -2 * alike;
  penlike = *f;
  dolod = false;
}

Local Void streamout(LINK)
struct LOC_outf *LINK;
{
  int i, j, k, l;
  double dist;
  int FORLIM;
  locusvalues *WITH;
  int FORLIM1, FORLIM2;
  thetavalues *WITH1;

  inconsistent = false;
  setparam();
  recombination();
  firstapprox = true;
  /*Start lodscore stream*/
  fprintf(stream, "LODSCORE\n");

  /*Gemini information*/
  fprintf(stream, "% .5e %12d % .5e %12d %12d %12d\n",
	  f, nit, ptg, idg, nall, n);
  /*Valid or not*/
  if ((nit > 1 && fabs(ptg) < 0.001) || n == 0)
    fprintf(stream, " 2\n");
  else {
    if (nit > 1 && fabs(ptg) < 0.1)
      fprintf(stream, " 1\n");
    else
      fprintf(stream, " 0\n");
  }
  for (i = 0; i < nall; i++)
    fprintf(stream, " % .5e\n", xall[i]);
  putc('\n', stream);
  for (i = 0; i < nall; i++)
    fprintf(stream, " %2d\n", itp[i]);
  putc('\n', stream);
  for (i = 0; i < n; i++)
    fprintf(stream, " % .5e\n", g[i]);
  putc('\n', stream);
  /*Variance-covariance calculated if ivar=1 and icall=0*/
  if (ivar == 1 && icall == 0)
    fprintf(stream, "1\n");
  else
    fprintf(stream, "0\n");

  if (inconsistent)
    fprintf(stream, "1\n");
  else
    fprintf(stream, "0\n");

  /*Control parameters for sexlink,interference and sex difference*/
  if (sexlink)
    fprintf(stream, "1\n");
  else
    fprintf(stream, "0\n");
  if (sexdif && readfemale)
    fprintf(stream, "2 ");
  else {
    if (sexdif)
      fprintf(stream, "1\n");
    else
      fprintf(stream, "0\n");
  }

  /*Genetic information*/
  fprintf(stream, "%12d %12d\n", iplace, jplace);

  if (itsys != 0)
    fprintf(stream, "%3d\n", itsys);
  else
    fprintf(stream, " 0\n");
  if (itsys != 0) {
    if (disequi) {
      fprintf(stream, "1 %12d %12d\n", thislocus[itsys - 1]->nallele, nuhap);
      for (i = 0; i < nuhap; i++)
	fprintf(stream, "%9.6f", hapfreq->genarray[i]);
    } else {
      WITH = thislocus[itsys - 1];
      fprintf(stream, "0 %12d\n", WITH->nallele);
      FORLIM = WITH->nallele;
      for (i = 0; i < FORLIM; i++)
	fprintf(stream, "%9.6f", WITH->freq[i]);
    }
    WITH = thislocus[itsys - 1];
    if (WITH->which == binary_ && WITH->format == allformat)
      fprintf(stream, " 3\n");
    else {
      if (WITH->which == binary_ && WITH->format == binformat)
	fprintf(stream, " 2\n");
      else {
	if (WITH->which == quantitative) {
	  fprintf(stream, "0 %12ld\n", WITH->UU.U1.ntrait);
	  invert(WITH->UU.U1.vmat, WITH->UU.U1.ntrait, &WITH->UU.U1.det);
	  FORLIM = WITH->UU.U1.ntrait;
	  for (i = 0; i < FORLIM; i++) {
	    FORLIM1 = WITH->nallele;
	    for (j = 1; j <= FORLIM1; j++) {
	      FORLIM2 = WITH->nallele;
	      for (k = j - 1; k < FORLIM2; k++)
		fprintf(stream, "%6.3f ", WITH->UU.U1.pm[j][k][i]);
	    }
	    putc('\n', stream);
	  }
	  FORLIM = WITH->UU.U1.ntrait;
	  for (i = 0; i < FORLIM; i++) {
	    FORLIM1 = WITH->UU.U1.ntrait;
	    for (j = i; j < FORLIM1; j++)
	      fprintf(stream, "%6.3f ", WITH->UU.U1.vmat[i][j]);
	    putc('\n', stream);
	  }
	} else {
	  if (WITH->which == affection) {
	    fprintf(stream, "1 %12ld\n", WITH->UU.U0.nclass);
	    FORLIM = WITH->UU.U0.nclass;
	    for (l = 0; l < FORLIM; l++) {
	      FORLIM1 = WITH->nallele;
	      for (i = 1; i <= FORLIM1; i++) {
		FORLIM2 = WITH->nallele;
		for (j = i - 1; j < FORLIM2; j++)
		  fprintf(stream, " %5.3f", WITH->UU.U0.pen[i][j][2][l]);
	      }
	      putc('\n', stream);
	      if (sexlink) {
		FORLIM1 = WITH->nallele;
		for (i = 0; i < FORLIM1; i++)
		  fprintf(stream, "%5.3f ", WITH->UU.U0.pen[0][i][2][l]);
	      }
	      putc('\n', stream);
	    }
	  }
	}
      }
    }
  }

  WITH1 = maletheta;
  FORLIM = mlocus - 2;
  /*Recombination*/
  for (i = 0; i <= FORLIM; i++)
    fprintf(stream, " %5.3f", WITH1->theta[i]);
  putc('\n', stream);
  if (sexdif) {
    WITH1 = femaletheta;
    FORLIM = mlocus - 2;
    for (i = 0; i <= FORLIM; i++)
      fprintf(stream, " %5.3f", WITH1->theta[i]);
    putc('\n', stream);
    if (readfemale) {
      FORLIM = mlocus - 2;
      for (i = 0; i <= FORLIM; i++) {
	dist = getdist(&maletheta->theta[i]);
	if (dist != 0.0)
	  dist = getdist(&femaletheta->theta[i]) / dist;
	else
	  dist = 0.0;
	fprintf(stream, " %5.3f\n", dist);
      }
    } else
      fprintf(stream, "%5.3f\n", distratio);
  }

  /*Valid parameters or not*/
  /*Lod scores are valid only if penalty is false*/
  if (penalty)
    fprintf(stream, "1\n");
  else
    fprintf(stream, "0\n");
  /*Number of pedigrees*/
  fprintf(stream, "%12d\n", nuped);
  for (i = 0; i < nuped; i++)
    fprintf(stream, "%12d % .5e % .5e\n",
	    proband[i]->ped, outsavelike[i], outsavelike[i] / log10_);
  /*Total lod-score*/
  fprintf(stream, "% .5e\n", (LINK->lods - f) / (2 * log10_));
  if (ivar != 1 || icall != 0)
    return;
  /*Stop stream*/
  for (i = 0; i < n; i++) {
    for (j = i; j < n; j++)
      fprintf(stream, " % .5e\n", 2.0 * bmat[i][j]);
    putc('\n', stream);
  }

  /*sexdif=true and readfemale=false*/
}


static Void outf()
{
  struct LOC_outf V;
  int i, j, k, l;
  double dist;
  thetavalues *WITH;
  int FORLIM;
  locusvalues *WITH1;
  int FORLIM1, FORLIM2;

#if !defined(DOS)
  /* Shriram: begin */
  if ( normalRun == checkpointStatus )
  {
    funCallPath = fCP_outf ;
    performCheckpoint ( functionLocation , funCallPath , 0 ) ;

    fclose ( recfile ) ;
    copyFile ( "recfile.dat" , OutfLODSCORERecfileDat ) ;
#ifdef vms
    recfile = fopen ( "recfile.dat" , "a", "ctx=rec", "shr = get,put,upd") ;
#else
    recfile = fopen ( "recfile.dat" , "a") ;
#endif

    if ( dostream )
    {
      fclose ( stream ) ;
      copyFile ( "stream.dat" , OutfLODSCOREStreamDat ) ;
#ifdef  vms
      stream = fopen ( "stream.dat" , "a", "ctx=rec", "shr=get,put,upd") ; 
#else
      stream = fopen ( "stream.dat" , "a" ) ;
#endif
    }
  }
  else
  {
    if ( ( functionLocation == ckptTuple . ckptLocation ) &&
	( fCP_outf == ckptTuple . ckptAttribute ) )
    {
      recoverCheckpoint ( NULL ) ;

      fclose ( recfile ) ;
      copyFile ( OutfLODSCORERecfileDat , "recfile.dat" ) ;
#ifdef vms
      recfile = fopen ( "recfile.dat" , "a", "ctx=rec", "shr=get,put,upd") ; 
#else
      recfile = fopen ( "recfile.dat" , "a" ) ;
#endif
      
      if ( dostream )
      {
        fclose ( stream ) ;
	copyFile ( OutfLODSCOREStreamDat , "stream.dat" ) ;
#ifdef vms
        stream = fopen ( "stream.dat" , "a", "ctx=rec", "shr=get,put,upd") ; 
#else
        stream = fopen ( "stream.dat" , "a" ) ;
#endif
      }
    }
  }
  /* Shriram: end */
#endif
  firstapprox = true;
  lasttime = true;
  /*recover optimal x and f values, put x value into xall*/
  f = outsavefvalue;
  k = 0;
  for (i = 0; i< nall; i++) {
    if (itp[i] == 1) {
      k++;
      xall[i] = outsavex[k - 1];
    }
  }
  /*recover xall values into maletheta and femaletheta*/
  setparam();
  fprintf(recfile, "%3d%3d", ilocus, jlocus);
  WITH = maletheta;
  FORLIM = mlocus - 2;
  for (i = 0; i <= FORLIM; i++)
    fprintf(recfile, " %5.3f", WITH->theta[i]);
  if (interfer)
    fprintf(recfile, " %5.3f", maletheta->theta[mlocus - 1]);
  WITH = femaletheta;
  FORLIM = mlocus - 2;
  for (i = 0; i <= FORLIM; i++)
    fprintf(recfile, " %5.3f", WITH->theta[i]);
  if (interfer)
    fprintf(recfile, " %5.3f", femaletheta->theta[mlocus - 1]);
  fprintf(final, "CHROMOSOME ORDER OF LOCI : \n");
  fprintf(final, "%3d%3d\n\n", ilocus, jlocus);
  if (itsys != 0) {
    fprintf(final, "****************** FINAL VALUES **********************\n");
    fprintf(final, "PROVIDED FOR LOCUS %3d (CHROMOSOME ORDER)\n", itsys);
    fprintf(final, "******************************************************\n");
    WITH1 = thislocus[itsys - 1];
    if (disequi) {
      fprintf(final, "HAPLOTYPE FREQUENCIES:\n");
      for (i = 0; i < nuhap; i++)
	fprintf(final, "%9.6f", hapfreq->genarray[i]);
    } else {
      fprintf(final, "GENE FREQUENCIES :\n");
      FORLIM = WITH1->nallele;
      for (i = 0; i < FORLIM; i++)
	fprintf(final, "%9.6f", WITH1->freq[i]);
    }
    putc('\n', final);
    if (WITH1->which == quantitative) {
      fprintf(final, "VALUES FOR GENOTYPE MEANS:\n");
      invert(WITH1->UU.U1.vmat, WITH1->UU.U1.ntrait, &WITH1->UU.U1.det);
      FORLIM = WITH1->UU.U1.ntrait;
      for (i = 0; i < FORLIM; i++) {
	FORLIM1 = WITH1->nallele;
	for (j = 1; j <= FORLIM1; j++) {
	  FORLIM2 = WITH1->nallele;
	  for (k = j - 1; k < FORLIM2; k++)
	    fprintf(final, "%6.3f ", WITH1->UU.U1.pm[j][k][i]);
	}
	putc('\n', final);
      }
      fprintf(final, "COVARIANCE MATRIX:\n");
      FORLIM = WITH1->UU.U1.ntrait;
      for (i = 1; i <= FORLIM; i++) {
	for (j = 0; j < i; j++)
	  fprintf(final, "%6.3f ", WITH1->UU.U1.vmat[i - 1][j]);
	putc('\n', final);
      }
    } else {
      if (WITH1->which == affection) {
	fprintf(final, "PENETRANCES:\n");
	FORLIM = WITH1->UU.U0.nclass;
	for (l = 0; l < FORLIM; l++) {
	  FORLIM1 = WITH1->nallele;
	  for (i = 1; i <= FORLIM1; i++) {
	    FORLIM2 = WITH1->nallele;
	    for (j = i - 1; j < FORLIM2; j++)
	      fprintf(final, "%5.3f ", WITH1->UU.U0.pen[i][j][2][l]);
	  }
	  putc('\n', final);
	  if (sexlink) {
	    FORLIM1 = WITH1->nallele;
	    for (i = 0; i < FORLIM1; i++)
	      fprintf(final, "%5.3f ", WITH1->UU.U0.pen[0][i][2][l]);
	  }
	  putc('\n', final);
	}
      }
    }
  }
  fprintf(final, "******************************************************\n");
  fprintf(final, "THETAS:\n");
  WITH = maletheta;
  FORLIM = mlocus - 2;
  for (i = 0; i <= FORLIM; i++)
    fprintf(final, " %5.3f", WITH->theta[i]);
  if (interfer)
    fprintf(final, " %5.3f\n", maletheta->theta[mlocus - 1]);
  else
    putc('\n', final);
  if (sexdif) {
    fprintf(final, "FEMALE:\n");
    WITH = femaletheta;
    FORLIM = mlocus - 2;
    for (i = 0; i <= FORLIM; i++)
      fprintf(final, " %5.3f", WITH->theta[i]);
    if (interfer)
      fprintf(final, " %5.3f\n", femaletheta->theta[mlocus - 1]);
    else
      putc('\n', final);
    if (readfemale) {
      fprintf(final, "FEMALE/MALE DIST RATIO :\n");
      FORLIM = mlocus - 2;
      for (i = 0; i <= FORLIM; i++) {
	dist = getdist(&maletheta->theta[i]);
	if (dist != 0.0)
	  dist = getdist(&femaletheta->theta[i]) / dist;
	else
	  dist = 0.0;
	fprintf(final, " %5.3f", dist);
      }
    } else {
      fprintf(final, "CONSTANT FEMALE/MALE DIST RATIO :\n");
      fprintf(final, "%5.3f\n", distratio);
    }
  }
  fprintf(final, "******************************************************\n");
  fprintf(final, "-2 LN(LIKE) = % .5e\n", f);
  getlods(&V.lods, x, &V);
  if (mlocus != 2)
    fprintf(final, "OTTS GENERALIZED LOD SCORE  =% .5e\n",
	    (V.lods - f) / (2 * log10_));
  else
    fprintf(final, "LOD SCORE  =% .5e\n", (V.lods - f) / (2 * log10_));
  fprintf(recfile, " %8.3f % .5e % .5e\n",
	  (V.lods - f) / (2 * log10_), f, ptg);
  fprintf(final, "NUMBER OF ITERATIONS = %5d\n", nit);
  fprintf(final, "NUMBER OF FUNCTION EVALUATIONS = %5d\n", nfe);
  fprintf(final, "PTG = % .5e\n", ptg);
  idg++;
  fprintf(outfile, "EXIT CONDITION%12d\n", idg);
  switch (idg) {

  case 1:
    fprintf(outfile, "Maximum possible accuracy reached\n");
    break;

  case 2:
    fprintf(outfile, "Search direction no longer downhill\n");
    break;

  case 3:
    fprintf(outfile,
	    "Accumulation of rounding error prevents further progress\n");
    break;

  case 4:
    fprintf(outfile,
      "All significant differences lost through cancellation in conditioning\n");
    break;

  case 5:
    fprintf(outfile, "Specified tolerance on normalized gradient met\n");
    break;

  case 6:
    fprintf(outfile, "Specified tolerance on gradient met\n");
    break;

  case 7:
    fprintf(outfile, "Maximum number of iterations reached\n");
    break;

  case 8:
    fprintf(outfile, "Excessive cancellation in gradient\n");
    break;
  }
  if (ivar == 1 && icall == 0) {
    fprintf(final, "VARIANCE-COVARIANCE OF THE ESTIMATES\n");
    if (interfer && !mapping)
      fprintf(final, "VALUES GIVEN FOR P VALUES\n");
    for (i = 0; i < n; i++) {
      for (j = 0; j < n; j++)
	fprintf(final, "% .5e ", 2.0 * bmat[i][j]);
      putc('\n', final);
    }
  }
  fprintf(final, "******************************************************\n");
  fprintf(final, "******************************************************\n");
  if (dostream)
    streamout(&V);
}


/* Local variables for step: */
struct LOC_step {			/* If this structure is changed,    */
  enum {				/* some code may have to be altered */
    go_, exit1, exit2, exit3		/* in performCheckpoint() and       */
  } cont; 				/* recoverCheckpoint().             */
} ;					/*                        --Shriram */

Local Void firststep(LINK)
struct LOC_step *LINK;
{
  int i;

#if !defined(DOS)
  /* Shriram: begin */
  if ( normalRun == checkpointStatus )
  {
    funCallPath = fCP_gem_iter_st_first ;
    performCheckpoint ( functionLocation , funCallPath , LINK -> cont ) ;
  }
  else
  {
    if ( ( functionLocation == ckptTuple . ckptLocation )
        && ( fCP_gem_iter_st_first == ckptTuple . ckptAttribute ) )
    {
      recoverCheckpoint ( & LINK -> cont ) ;
      funCallPath = ckptTuple . ckptAttribute ;
    }
  }
  /* Shriram: end */
#endif
  sumt = 0.0;
  idg = 0;
  for (i = 0; i < n; i++)
    xt[i] = x[i] + t * p[i];
  fun(&ft, xt);
  /*save likelihood values for later*/
  for (i=0; i < nuped; i++)
    outsavelike[i] = likebyped[i];
  nfe++;
}

Local Void decreaset(LINK)
struct LOC_step *LINK;
{
  int i;

#if !defined(DOS)
  /* Shriram: begin */
  if ( normalRun == checkpointStatus )
  {
    funCallPath = fCP_gem_iter_st_decr ;
    performCheckpoint ( functionLocation , funCallPath , LINK -> cont ) ;
  }
  else
  {
    if ( ( functionLocation == ckptTuple . ckptLocation )
        && ( fCP_gem_iter_st_decr == ckptTuple . ckptAttribute ) )
    {
      recoverCheckpoint ( & LINK -> cont ) ;
      funCallPath = ckptTuple . ckptAttribute ;
    }
  }
  /* Shriram: end */
#endif
  /*Modified by M. Lathrop 29/04/86 to trap tmin=0 problem*/
  if (tmin < small)
    tmin = small;
  LINK->cont = go_;
  while (LINK->cont == go_) {
    if (f - fsave == 0.0 && idif == 2)
      idg = 2;
    if (t < tmin) {
      LINK->cont = exit3;
      break;
    }
    t = 0.5 * t;
    for (i = 0; i < n; i++)
      xt[i] = x[i] + t * p[i];
    fun(&ft2, xt);
    nfe++;
    if (ft2 < f) {
      sumt += t;
      f = ft2;
      idg = 0;
      memcpy(x, xt, sizeof(vector));
      /*save likelihood values for later*/
      for(i=0; i< nuped; i++)
        outsavelike[i] = likebyped[i];
      if (sumt < tmin)
	LINK->cont = exit3;
      else
	LINK->cont = exit2;
      continue;
    }
    if (ft + f - ft2 - ft2 <= 0.0)
      scal = 0.1;
    else {
      scal = 1.0 + 0.5 * (f - ft) / (f + ft - ft2 - ft2);
      if (scal < 0.1)
	scal = 0.1;
    }
    t = scal * t;
    for (i = 0; i < n; i++)
      xt[i] = x[i] + t * p[i];
    fun(&ft, xt);
    nfe++;
    if (f <= ft)
      continue;
    sumt += t;
    idg = 0;
    f = ft;
    memcpy(x, xt, sizeof(vector));
    /*save likelihood values for later*/
    for(i=0; i< nuped; i++)
      outsavelike[i] = likebyped[i];
    if (t < tmin)
      LINK->cont = exit3;
    else
      LINK->cont = exit2;
  }
}

Local Void increaset(LINK)
struct LOC_step *LINK;
{
  int i;

#if !defined(DOS)
  /* Shriram: begin */
  if ( normalRun == checkpointStatus )
  {
    funCallPath = fCP_gem_iter_st_incr ;
    performCheckpoint ( functionLocation , funCallPath , LINK -> cont ) ;
  }
  else
  {
    if ( ( functionLocation == ckptTuple . ckptLocation )
        && ( fCP_gem_iter_st_incr == ckptTuple . ckptAttribute ) )
    {
      recoverCheckpoint ( & LINK -> cont ) ;
      funCallPath = ckptTuple . ckptAttribute ;
    }
  }
  /* Shriram: end */
#endif
  sumt += t;
  LINK->cont = go_;
  while (LINK->cont == go_) {
    twot = t + t;
    if (ibnd > 0 && tbnd >= 0.0 && twot > tbnd) {
      f = ft;
      memcpy(x, xt, sizeof(vector));
      fprintf(outfile, "****** ACTIVE BOUNDARY CONSTRAINT *****\n");
      LINK->cont = exit1;
      continue;
    }
    memcpy(x, xt, sizeof(vector));
    for (i = 0; i < n; i++)
      xt[i] = x[i] + t * p[i];
    fun(&f2t, xt);
    nfe++;
    if (f2t > ft) {
      f = ft;
      LINK->cont = exit2;
      break;
    }
    if (f2t + f - ft - ft < 0.0 || ft - f2t + curv * (ft - f) >= 0.0) {
      sumt += t;
      t += t;
      ft = f2t;
    } else {
      sumt += t;
      f = f2t;
      memcpy(x, xt, sizeof(vector));
      /*save likelihood values for later*/
      for(i=0; i< nuped; i++)
        outsavelike[i] = likebyped[i];
      LINK->cont = exit2;
    }
  }
}

static Void step()
{
  struct LOC_step V;
#if !defined(DOS)
  /* Shriram: begin */
  int    ckptFunCallPath = ckptTuple . ckptAttribute ;

  if ( ( checkpointedRun == checkpointStatus ) &&
      ( functionLocation == ckptTuple . ckptLocation ) )
  {
    if ( fCP_gem_iter_st_first == ckptFunCallPath )
      goto FunRecover3 ;
    else if ( fCP_gem_iter_st_decr == ckptFunCallPath )
      goto FunRecover4 ;
    else if ( fCP_gem_iter_st_incr == ckptFunCallPath )
      goto FunRecover5 ;
  }
  /* Shriram: end */
#endif
  firstapprox = true;
#if !defined(DOS)  /* cgh - gcc */
 FunRecover3:
#endif  /* !defined(DOS) */
  firststep(&V);
  if (f > ft)
#if !defined(DOS)  /* cgh - gcc */
 FunRecover5:
#endif  /* !defined(DOS) */
    increaset(&V);
  else
#if !defined(DOS)  /* cgh - gcc */
 FunRecover4:
#endif  /* !defined(DOS) */
    decreaset(&V);
  if (V.cont == exit2)
    t = sumt;
  if (V.cont == exit3) {
    iret = 1;
    return;
  }
  memcpy(gsave, g, sizeof(vector));
  isw = 0;
  iret = 2;
}


/* Local variables for update: */
struct LOC_update {
  int j, jm1;
  boolean cont, dfp;
} ;

Local Void prep(LINK)
struct LOC_update *LINK;
{
  int i, k;

  iswup = 1;
  wtil[0] = -gsave[0];
  ztil[0] = y[0];
  for (k = 2; k <= n; k++) {
    wtil[k - 1] = -gsave[k - 1];
    ztil[k - 1] = y[k - 1];
    for (i = 0; i <= k - 2; i++) {
      tl[i][k - 1] = tl[k - 1][i];
      wtil[k - 1] -= tl[k - 1][i] * wtil[i];
      ztil[k - 1] -= tl[k - 1][i] * ztil[i];
    }
  }
  sb = 0.0;
  sc = 0.0;
  sd = 0.0;
  for (i = 0; i < n; i++) {
    sb += t * ztil[i] * wtil[i] / d[i];
    sc += t * t * wtil[i] * wtil[i] / d[i];
    sd += ztil[i] * ztil[i] / d[i];
  }
}

Local Void sr1update(LINK)
struct LOC_update *LINK;
{
  alpha = -1.0;
  if (sc - sb == 0.0 || sb - sd == 0.0 || sd - 2.0 * sb + sc == 0.0) {
    idg = 3;
    return;
  }
  sa = 1.0 / (sqrt(fabs(sc - sb)) * sqrt(fabs(sb - sd)));
  thet1 = ((sd - sb) * sa + 1.0) / (2.0 * sb - sd - sc);
  thet2 = sa + (sa * (sb - sc) + 1.0) / (sd - 2.0 * sb + sc);
}

Local Void sr2update(LINK)
struct LOC_update *LINK;
{
  aa = sb / sc - 2.0 * (sd / sb) + sd / sc;
  bb = sb / sc - 1.0;
  cc = 1.0 - sb / sd;
  del2 = bb * bb - aa * cc;
  LINK->dfp = true;
  if (del2 > 0.00000001) {
    LINK->dfp = false;
    del = sqrt(del2);
    alph1 = (del - bb) / aa;
    alph2 = (-bb - del) / aa;
    if (fabs(alph1) < fabs(alph2))
      alpha = alph1;
    else
      alpha = alph2;
    if (fabs(alpha) < 0.00001)
      LINK->dfp = true;
    else {
      sa = (alpha + 1.0) * (alpha + 1.0) + sc / sb -
	   alpha * alpha * (sc / sb) * (sd / sb) - 1.0 + alpha * alpha * sd / sb;
      if (sa <= 0.0)
	sa = 0.0;
      else {
	sa = sqrt(sa);
	sa = 1.0 / (sa * sb);
      }
      rdiv = 1.0 / (alpha * alpha * sd + 2.0 * alpha * sb + sc);
      thet1 = -(sa * alpha * (alpha * sd + sb) + 1.0) * rdiv;
      thet2 = sa + (alpha * sa * (sc + alpha * sb) - alpha) * rdiv;
    }
  }
  if (!LINK->dfp)
    return;
  alpha = 0.0;
  sa = 1.0 / (sqrt(sb) * sqrt(sc));
  thet1 = -1.0 / sc;
  thet2 = sa;
}

Local Void getwzs(LINK)
struct LOC_update *LINK;
{
  int i, k;

  for (i = 0; i < n; i++) {
    w[i] = t * wtil[i] + alpha * ztil[i];
    z[i] = t * thet1 * wtil[i] + thet2 * ztil[i];
  }
  s[n - 1] = 0.0;
  for (k = 1; k < n; k++) {
    LINK->j = n - k + 1;
    LINK->jm1 = LINK->j - 1;
    s[LINK->jm1 - 1] = s[LINK->j - 1] +
		       w[LINK->j - 1] * w[LINK->j - 1] / d[LINK->j - 1];
  }
  nu = 1.0;
  eta = 0.0;
}

Local Void recur(LINK)
struct LOC_update *LINK;
{
  int i, k;

  LINK->cont = true;
  while (LINK->cont) {
    LINK->cont = false;
    if (iswup < 2) {
      for (i = 0; i < n; i++)
	wtjp1[i] = -gsave[i];
      memcpy(ztjp1, y, sizeof(vector));
    } else {
      for (i = 0; i < n; i++) {
	wtil[i] = alpha * y[i] - t * g[i];
	ztil[i] = thet2 * y[i] - t * thet1 * g[i];
      }
    }
    LINK->j = 0;
    lambj2 = 0.0;
    while (LINK->j < n - 1) {
      LINK->j++;
      if (iswup < 2) {
	for (k = LINK->j; k < n; k++) {
	  wtjp1[k] -= wtil[LINK->j - 1] * tl[k][LINK->j - 1];
	  ztjp1[k] -= ztil[LINK->j - 1] * tl[k][LINK->j - 1];
	}
      } else {
	for (k = LINK->j; k < n; k++) {
	  wtjp1[k] = wtil[k] - w[LINK->j - 1] * tl[k][LINK->j - 1];
	  ztjp1[k] = ztil[k] - z[LINK->j - 1] * tl[k][LINK->j - 1];
	}
      }
      aj = nu * z[LINK->j - 1] - eta * w[LINK->j - 1];
      thj = 1.0 + aj * w[LINK->j - 1] / d[LINK->j - 1];
      lambj2 = thj * thj + aj * aj * s[LINK->j - 1] / d[LINK->j - 1];
      if (iswup < 2) {
	if (lambj2 > 10.0) {
	  LINK->cont = true;
	  iswup = 2;
	  for (k = 2; k <= n; k++) {
	    for (i = 0; i <= k - 2; i++)
	      tl[k - 1][i] = tl[i][k - 1];
	  }
	  LINK->j = n;
	}
      }
      if (LINK->cont)
	continue;
      dp[LINK->j - 1] = d[LINK->j - 1] * lambj2;
      lambj = sqrt(lambj2);
      if (thj > 0.0)
	lambj = -lambj;
      muj = thj - lambj;
      bj = thj * w[LINK->j - 1] + aj * s[LINK->j - 1];
      gamlj = bj * nu / (lambj2 * d[LINK->j - 1]);
      betlj = (aj - bj * eta) / (lambj2 * d[LINK->j - 1]);
      nu = -(nu / lambj);
      eta = -((eta + aj * aj / (muj * d[LINK->j - 1])) / lambj);
      if (iswup < 2) {
	for (k = LINK->j; k < n; k++)
	  tl[k][LINK->j - 1] += t * (betlj + thet1 * gamlj) * wtjp1[k] +
				(alpha * betlj + thet2 * gamlj) * ztjp1[k];
      } else {
	for (k = LINK->j; k < n; k++) {
	  tl[k][LINK->j - 1] = tl[k][LINK->j - 1] / lambj2 + betlj * wtil[k] +
			       gamlj * ztil[k];
	  wtil[k] = wtjp1[k];
	  ztil[k] = ztjp1[k];
	}
      }
    }
  }
  aj = nu * z[n - 1] - eta * w[n - 1];
  lambj = 1.0 + aj * w[n - 1] / d[n - 1];
  dp[n - 1] = d[n - 1] * lambj * lambj;
  memcpy(d, dp, sizeof(vector));
}


/*UPDATE*/
static Void update()
{
  struct LOC_update V;

  prep(&V);
  if (sb < sc)
    fbcd = sb;
  else
    fbcd = sc;
  if (sd < fbcd)
    fbcd = sd;
  if (fbcd > small) {
    fbcd = 2.0 * sc * (sd / sb) / (sc + sd);
    if (fbcd < 1.0)
      sr1update(&V);
    else
      sr2update(&V);
  } else
    sr1update(&V);
  if (idg != 3) {
    getwzs(&V);
    recur(&V);
  }
}


Local Void bldlt(b)
vector *b;
{
  int i, j, ic, k;
  double su, tlic, ff, hh, temp, temp1;
  matrix s;
  vector tu, xvec;

  firstapprox = true;
  ff = f;
  if (icall > 0 && ihess <= 0) {
    memcpy(xvec, xall, sizeof(vector));
    hh = 10 * h;
    for (i = 0; i < n; i++) {
      temp = x[i];
      x[i] += hh;
      fun(&f, x);
      tu[i] = f;
      for (j = 0; j < i + 1; j++) {
	temp1 = x[j];
	x[j] += hh;
	fun(&f, x);
	b[i][j] = f;
	b[j][i] = b[i][j];
	x[j] = temp1;
      }
      x[i] = temp;
    }
    memcpy(xall, xvec, sizeof(vector));
    for (i = 0; i < n; i++) {
      for (j = 0; j < i + 1; j++) {
	b[i][j] = (ff + b[i][j] - tu[i] - tu[j]) / (hh * hh);
	b[j][i] = b[i][j];
      }
    }
  }
  ic = 1;
  while (b[ic - 1][ic - 1] > 0.0 && ic <= n) {
    temp = b[ic - 1][ic - 1];
    d[ic - 1] = b[ic - 1][ic - 1];
    tl[ic - 1][ic - 1] = 1.0;
    if (ic != n) {
      for (k = ic; k < n; k++)
	tl[k][ic - 1] = b[k][ic - 1] / temp;
      for (i = ic; i < n; i++) {
	tlic = tl[i][ic - 1];
	for (k = i; k < n; k++)
	  b[k][i] -= tlic * tl[k][ic - 1] * temp;
      }
    }
    ic++;
  }
  if (ic > n) {
    icall--;
    fprintf(outfile, "FACTORIZATION SUCCEEDED\n");
  } else {
    icall++;
    fprintf(outfile, "FACTORIZATION FAILED\n");
  }
  if (icall != 0)
    return;
  s[0][0] = 1.0;
  for (i = 2; i <= n; i++) {
    for (k = 0; k <= i - 2; k++) {
      su = 0.0;
      for (j = k; j <= i - 2; j++)
	su += tl[i - 1][j] * s[j][k];
      s[i - 1][k] = -su;
    }
    s[i - 1][i - 1] = 1.0;
  }
  for (i = 0; i < n; i++) {
    for (j = i; j < n; j++) {
      su = 0.0;
      for (k = j; k < n; k++)
	su += s[k][i] * s[k][j] / d[k];
      b[i][j] = su;
      b[j][i] = su;
    }
  }
  fprintf(outfile, "B-MATRIX\n");
  for (i = 1; i <= n; i++) {
    for (j = 0; j < i; j++)
      fprintf(outfile, "% .5e", b[i - 1][j]);
    putc('\n', outfile);
  }
  if (ivar != 1)
    return;
  k = 0;
  for (i = 0; i < nall; i++) {
    se[i] = 0.0;
    if (itp[i] == 1) {
      k++;
      se[i] = sqrt(b[k - 1][k - 1]);
    }
  }
}

Local Void inib()
{
  int i, j;
  FILE *in1;

  in1 = NULL;
  if (icall != 1 && ihess > 1) {
    if (in1 != NULL)
      in1 = freopen("in1.dat", "r", in1);
    else
      in1 = fopen("in1.dat", "r");
    if (in1 == NULL)
      exit(FileNotFound);
    for (i = 1; i <= n; i++) {
      for (j = 0; j < i; j++)
	fscanf(in1, "%lf", &bmat[i - 1][j]);
    }
    for (i = 0; i < n; i++) {
      for (j = 0; j < i + 1; j++)
	bmat[j][i] = bmat[i][j];
    }
  }
  bldlt(bmat);
  if (icall == 1) {
    for (i = 0; i < n; i++) {
      for (j = 0; j < i + 1; j++)
	tl[i][j] = 0.0;
      tl[i][i] = 1.0;
      d[i] = 1.0;
    }
  }
  if (in1 != NULL)
    fclose(in1);
}

Void initialize()
{
  int i, j;

#if !defined(DOS)
  /* Shriram: begin */
  if ( normalRun == checkpointStatus )
  {
    funCallPath = fCP_gem_init ;
    performCheckpoint ( functionLocation , funCallPath , 0 ) ;
  }
  else
  {
    if ( ( functionLocation == ckptTuple . ckptLocation )
        && ( fCP_gem_init == ckptTuple . ckptAttribute ) )
    {
      recoverCheckpoint ( NULL ) ;
      funCallPath = ckptTuple . ckptAttribute ;
    }
  }
  /* Shriram: end */
#endif
  firstapprox = true;
  fprintf(outfile, "DIFFER INTER = % .5e TRUNC UPPER = % .5e\n", h, trupb);
  nit = 0;
  idg = 0;
  idif = 1;
  t = 0.1;
  tmin = 0.0;
  fsmf = 0.0;
  fun(&f, x);
  /*save likelihood values for later*/
  for(i=0; i< nuped; i++)
    outsavelike[i] = likebyped[i];
  nfe = 1;
  for (i = 0; i < n; i++) {
    for (j = 0; j < i + 1; j++)
      tl[i][j] = 0.0;
    tl[i][i] = 1.0;
    d[i] = 1.0;
  }
  if (ihess <= 0)
    return;
  icall = 0;
  inib();
  icall = 1;
  t = 1.0;
}

Local Void gforward()
{
  int i, k;
  /*The following definition was introduced by A. A. Schaffer 7/27/94
    to fix a bug inherited from LINKAGE*/
  double xallsave[maxn]; /*Save xall, so it can be recovered at end*/

  firstapprox = true;
  outsavefvalue = f;
  saveparams();
  k = 0;
  for (i = 0; i< maxn; i++) {
    if (itp[i] == 1) {
      k++;
      xallsave[i] = outsavex[k - 1];
    }
    else
      xallsave[i] = outsavex[k -1];
  }
  for (i = 0; i < n; i++) {
#if !defined(DOS)
    /* Shriram: begin */
    if ( normalRun == checkpointStatus )
    {
      if ( fCP_gem_iter_ == funCallPath )
        funCallPath = fCP_gem_iter_gfor ;
      else if ( fCP_gem_ == funCallPath )
        funCallPath = fCP_gem_gfor ;
      performCheckpoint ( functionLocation , funCallPath , i ) ;
    }
    else if ( ( functionLocation == ckptTuple . ckptLocation ) &&
             ( ( fCP_gem_iter_gfor == ckptTuple . ckptAttribute ) ||
              ( fCP_gem_gfor == ckptTuple . ckptAttribute ) ) )
    {
      recoverCheckpoint ( & i ) ;
      if ( i >= n )
        break ;
      funCallPath = ckptTuple . ckptAttribute ;
    }
    /* Shriram: end */
#endif
    hx = h;
    if (ihx == 1) {
      if (fabs(x[i]) < 0.1)
	hx = h * 0.1;
      else
	hx = h * fabs(x[i]);
    }
    xsave = x[i];
    x[i] += hx;
    if (continue_ != quit) {
      fun(&fxph, x);
      savedf[i] = fxph;
    }
    else
      fxph = savedf[i];
    firstapprox = false;
    g[i] = (fxph - f) / hx;
    x[i] = xsave;
  }
  for(i=0; i < maxn; i++)
    xall[i] = xallsave[i];
  if (continue_ != quit)
    nfe += n;
}

Local Void gcentral()
{
  int i, k;
  double xallsave[maxn];

  firstapprox = true;
  outsavefvalue = f;
  saveparams();
  k = 0;
  for (i = 0; i< maxn; i++) {
    if (itp[i] == 1) {
      k++;
      xallsave[i] = outsavex[k - 1];
    }
    else
      xallsave[i] = xall[i];
  }
  for (i = 0; i < n; i++) {
#if !defined(DOS)
    /* Shriram: begin */
    if ( normalRun == checkpointStatus ) 
    {
      if ( fCP_gem_iter_gcen1_ == funCallPath )
        funCallPath = fCP_gem_iter_gcen1 ;
      else if ( fCP_gem_iter_gcen2_ == funCallPath )
        funCallPath = fCP_gem_iter_gcen2 ;
      performCheckpoint ( functionLocation , funCallPath, i ) ;
    }
    else if ( ( functionLocation == ckptTuple . ckptLocation ) &&
             ( ( fCP_gem_iter_gcen1 == ckptTuple . ckptAttribute ) ||
              ( fCP_gem_iter_gcen2 == ckptTuple . ckptAttribute ) ) )
    {
      recoverCheckpoint ( & i ) ;
      if ( i >= n)
        break ;
      funCallPath = ckptTuple . ckptAttribute ;
    }
    /* Shriram: end */
#endif
    hx = h;
    if (ihx == 1) {
      if (fabs(x[i]) < 0.1)
	hx = h * 0.1;
      else
	hx = h * fabs(x[i]);
    }
    xsave = x[i];
    x[i] += hx;
    if (continue_ != quit) {
      fun(&fxph, x);
      savedf[2*i] = fxph;
    }
    else
      fxph = savedf[2*i];
    firstapprox = false;
    x[i] = xsave - hx;
    if (continue_ != quit) {
      fun(&fxmh, x);
      savedf[2*i + 1] = fxmh;
    }
    else
      fxmh = savedf[2*i + 1];
    g[i] = (fxph - fxmh) / (hx + hx);
    x[i] = xsave;
  }
  for(i=0; i < maxn; i++)
    xall[i] = xallsave[i];
  if (continue_ != quit)
    nfe += 2 * n ;			/* Shriram */
}

Local Void getp()
{
  int i, nmj, j;

  nit++;
  fsav2 = fsave;
  fsave = f;
  fprintf(outfile, "\nITERATION %5d T = %10.3f NFE = %5d F = % .5e\n",
	  nit, t, nfe, f);
  printf("ITERATION %5d T = %10.3f NFE = %5d F = % .5e\n", nit, t, nfe, f);
  if (nit > maxit) {
    idg = 6;
    return;
  }
  if (n < 20) {
    fprintf(outfile, "X= ");
    outcontrol(x);
    fprintf(outfile, "G= ");
    outcontrol(g);
  }
  if (n == 1)
    p[0] = -(g[0] / d[0]);
  else {
    v[0] = -g[0];
    for (i = 2; i <= n; i++) {
      v[i - 1] = -g[i - 1];
      for (j = 0; j <= i - 2; j++)
	v[i - 1] -= tl[i - 1][j] * v[j];
    }
    p[n - 1] = v[n - 1] / d[n - 1];
    for (j = 1; j < n; j++) {
      nmj = n - j;
      p[nmj - 1] = v[nmj - 1] / d[nmj - 1];
      for (i = nmj; i < n; i++)
	p[nmj - 1] -= tl[i][nmj - 1] * p[i];
    }
  }
  fprintf(outfile, "P= ");
  outcontrol(p);
  if (ibnd == 1) {
    for (i = 0; i < n; i++) {
      if (p[i] == 0.0)
	idg = 7;
    }
  }
  if (idg == 7)
    return;
  ptg = 0.0;
  for (i = 0; i < n; i++)
    ptg += p[i] * g[i];
  if (ptg >= 0.0) {
    idg = 1;
    return;
  }
  if (fabs(ptg) < tol) {
    idg = 4;
    fsmf = fsav2 - f;
    fprintf(outfile, "FSMF = % .5e PTG = % .5e TMIN = % .5e\n",
	    fsmf, ptg, tmin);
    return;
  }
  xpm = xpmcon;
  if (nit == 1)
    return;
  for (i = 0; i < n; i++) {
    if (ihx == 1) {
      xp = fabs(x[i]);
      if (xp < 0.1)
	xp = 0.1;
      xp /= fabs(p[i]);
      if (xp < xpm)
	xpm = xp;
    } else {
      if (xpm > fabs(1.0 / p[i]))
	xpm = fabs(1.0 / p[i]);
    }
  }
  tmin = 0.5 * xpm * h / trupb;
  if (idif == 2)
    t = 1.0;
  else {
    t = -2.0 * fsmf / ptg;
    if (t <= 0.0)
      t = 1.0;
    else {
      if (1.0 < t)
	t = 1.0;
    }
  }
  fprintf(outfile, "FSMF = % .5e PTG =% .5e TMIN=% .5e\n", fsmf, ptg, tmin);
  fprintf(outfile, "INITIAL T = % .5e\n", t);
}

Local Void getytp()
{
  int i;

  ytp = 0.0;
  fsmf = fsave - f;
  for (i = 0; i < n; i++) {
    y[i] = g[i] - gsave[i];
    ytp += y[i] * p[i];
  }
}

Local Void chkbnd()
{
  /*This procedure modified by M. Lathrop 29/04/86
    with the introduction of continue and repeat*/
  int i, j, k, ik, ii, jk;
  boolean continue_;

  do {
    clb = clbcon;
    for (j = 1; j <= 2; j++) {
      k = 0;
      for (i = 1; i <= nall; i++) {
	if (itp[i - 1] == 1) {
	  k++;
	  check = fabs(x[k - 1] - bnd[i - 1][j - 1]);
	  if (check <= clb) {
	    clb = check;
	    ik = k;
	    ii = i;
	    jk = j;
	  }
	}
      }
    }
    if (clb < 0.1 * h) {
      ihess = 0;
      if (jk == 2)
	eh = -h - h;
      else
	eh = h + h;
      x[ik - 1] = bnd[ii - 1][jk - 1] + eh;
      xall[ii - 1] = x[ik - 1];
      itp[ii - 1] = 0;
      for(k = ik; k < nall; k++)
        outsavex[k-1] = outsavex[k];
      k = 0;
      for (i = 0; i < nall; i++) {
	if (itp[i] == 1) {
	  k++;
	  x[k - 1] = xall[i];
	}
      }
      n = k;
      tol = tolconst;
      /*            tol:=tolconst*sqrt(n);*/
      continue_ = true;
      fprintf(outfile, "******* A VARIABLE WAS SET TO A BOUND ***********\n");
    } else {
      tbnd = tbndcon;
      for (j = 0; j <= 1; j++) {
	k = 0;
	for (i = 0; i < nall; i++) {
	  if (itp[i] == 1) {
	    k++;
	    teq = (bnd[i][j] - x[k - 1]) / p[k - 1];
	    if (teq < tbnd && teq > 0.0)
	      tbnd = teq;
	  }
	}
      }
      continue_ = false;
      if (t * (2.0 + h) >= tbnd)
	t = tbnd * (0.5 - h);
      fprintf(outfile, "TBND = % .5e RESET T = % .5e\n", tbnd, t);
    }
  } while (continue_);
}

Local Void iterate()
{
#if !defined(DOS)
  /* Shriram: begin */
  int  ckptFunCallPath = ckptTuple . ckptAttribute ;

  if ( normalRun == checkpointStatus )
    funCallPath = fCP_gem_iter_ ;
  /* Shriram: end */
#endif
  while (continue_ == go) {
    active = false;
#if !defined(DOS)
    /* Shriram: begin */
    if ( checkpointedRun == checkpointStatus )
    {
      if ( iterationLocation == ckptTuple . ckptLocation )
        checkpointStatus = normalRun ;
      else      /* checkpointedRun AND functionLocation */
      {
        if ( ( fCP_gem_iter_st_first == ckptFunCallPath ) ||
            ( fCP_gem_iter_st_decr == ckptFunCallPath ) ||
            ( fCP_gem_iter_st_incr == ckptFunCallPath ) )
          goto FunRecover345 ;
        else if ( fCP_gem_iter_gcen1 == ckptFunCallPath )
          goto FunRecover6 ;
        else if ( fCP_gem_iter_gfor == ckptFunCallPath )
          goto FunRecover7 ;
        else if ( fCP_gem_iter_gcen2 == ckptFunCallPath )
          goto FunRecover9 ;
      }
    }
    else
      performCheckpoint ( iterationLocation , nit , 0 ) ;
#endif
    getp();
    /* Shriram: end */
    if (idg != 0)
      continue_ = quit;
    else {    /*idg == 0*/         /*Shriram*/
      iret = 2;
      if (ibnd == 1)
	chkbnd();
      if (n == 0)
	continue_ = quit;
      if (!active)
      {
#if !defined(DOS)
      FunRecover345:
	funCallPath = fCP_gem_iter_ ;
#endif
	step();
#if !defined(DOS)
	funCallPath = fCP_gem_iter_ ;
#endif
      }
    }
    /* THE NEXT IS NOT TRUE IF ACTIVE */
    if (iret != 2) {
      if (idif != 1) {
	continue_ = quit;
	break;
      }
      idif = 2;
      isw = 1;
#if !defined(DOS)
    FunRecover9:
      funCallPath = fCP_gem_iter_gcen2_ ;
#endif
      gcentral();
#if !defined(DOS)
      funCallPath = fCP_gem_iter_ ;
#endif
      fprintf(outfile, "***** SWITCHING TO CENTRAL DIFFERERENCE*****\n");
      continue;
    }
    if (active) {
      continue_ = restart;
      break;
    }
    if (idif == 1)
    {
#if !defined(DOS)
    FunRecover7:
      funCallPath = fCP_gem_iter_ ;
#endif
      gforward();
#if !defined(DOS)
      funCallPath = fCP_gem_iter_ ;
#endif
    }
    else
    {
#if !defined(DOS)
    FunRecover6:
      funCallPath = fCP_gem_iter_gcen1_ ;
#endif
      gcentral();
#if !defined(DOS)
      funCallPath = fCP_gem_iter_ ;
#endif
    }
    if (isw != 0)
      continue;
    getytp();
    if (ytp <= 0.0)
      continue;
    if (n == 1)
      d[0] = -(y[0] * d[0] / (t * gsave[0]));
    else
      update();
    if (idg == 3)
      continue_ = quit;
  }
}

/*START GEMINI*/
static Void gemini()
{
#if !defined(DOS)
  /* Shriram: begin */
  int  ckptFunCallPath = ckptTuple . ckptAttribute ;
  
  if ( normalRun == checkpointStatus )
    funCallPath = fCP_gem_ ;
  /* Shriram: end */
#endif
  continue_ = go;
  while (continue_ != quit) {
#if !defined(DOS)
    /* Shriram: begin */
    if ( ( checkpointedRun == checkpointStatus ) &&
         ( iterationLocation == ckptTuple . ckptLocation ) )
      recoverCheckpoint ( NULL ) ;
    else
    {
      if ( checkpointedRun == checkpointStatus )
      {
        /* must be a functionLocation checkpoint, but which? */
        if ( fCP_gem_init == ckptFunCallPath )
          goto FunRecover2 ;
        else if ( ( fCP_gem_iter_st_first == ckptFunCallPath ) ||
                  ( fCP_gem_iter_st_decr == ckptFunCallPath ) ||
                  ( fCP_gem_iter_st_incr == ckptFunCallPath ) ||
                  ( fCP_gem_iter_gcen1 == ckptFunCallPath ) ||
                  ( fCP_gem_iter_gcen2 == ckptFunCallPath ) ||
                  ( fCP_gem_iter_gfor == ckptFunCallPath ) )
          goto FunRecover34567 ;
        else if ( fCP_gem_gfor == ckptFunCallPath )
          goto FunRecover8 ;
      }
    FunRecover2:
#endif
      initialize();
#if !defined(DOS)
      funCallPath = fCP_gem_ ;
    FunRecover8:
#endif
      isw = 0;
      gforward();
#if !defined(DOS)
      funCallPath = fCP_gem_ ;
    }
    /* Shriram: end */
#endif
    continue_ = go;
#if !defined(DOS)  /* cgh - gcc */
  FunRecover34567:
#endif  /* !defined(DOS) */
    iterate();
#if !defined(DOS)
    funCallPath = fCP_gem_ ;
#endif
  }
  if (ivar == 1)
    inib();
}



static void printVersion()
{
  printf("\nProgram LODSCORE version%6.2f (1-Feb-1991)\n\n", fVersion);
  printf("\nFASTLINK ");
#if defined(LESSMEMORY)
  printf("(slow) ");
#endif  
  printf("version %s (6-Oct-1997)\n\n", fastversion);
}



static Void initilink()
{
  printVersion();
  printf("The program constants are set to the following maxima:\n");
  printf("%6d loci in mapping problem\n", (int)maxsys);
  printf("%6d alleles at a single locus\n", (int)maxall);
/*  printf("%6ld recombination probabilities (maxneed)\n", (int)maxneed); */
  printf("%6d maximum of censoring array (maxcensor)\n", (int)maxcensor);
  printf("%6d individuals in all pedigrees combined\n", (int)maxind);
  printf("%6d pedigrees (maxped\n", (int)maxped);
  printf("%6d quantitative factor(s) at a single locus\n", (int)maxtrait);
  printf("%6d liability classes\n", (int)maxliab);
  printf("%6d binary codes at a single locus\n", (int)maxfact);
  printf("%8.2f base scaling factor for likelihood (scale)\n", scale);
  printf("%8.2f scale multiplier for each locus (scalemult)\n", scalemult);
  printf("%8.5f frequency for elimination of heterozygotes (minfreq)\n",
	 minfreq);
  if (minfreq != 0.0) {
    printf("IMPORTANT : RECOMPILE THIS PROGRAM WITH MINFREQ=0.0\n");
    printf("FOR THE ANALYSIS OF RECESSIVE TRAITS\n");
  }
  putchar('\n');
}



static void printLoInfo()
{
  printVersion();
  printf("\nLODSCORE has been compiled with the following options:\n\n");
  
  printf("       CHECKPOINTING is ");
#if defined(DOS)
  printf("disabled (DOS defined)\n");
#else
  printf("enabled (DOS not defined)\n");
#endif  /* defined(DOS) */

#if defined(LESSMEMORY)  
  printf("       SLOW version (LESSMEMORY defined)\n");
#else
  printf("       FAST version (LESSMEMORY not defined)\n");  
#endif  /* defined(LESSMEMORY) */
  
  printf("\nProgram constants are set to the following maxima:\n\n");
  printf("%6d maximum number of loci (maxlocus)\n", (int)maxlocus);
  printf("%6d maximum number of alleles at a single locus (maxall)\n",
	 (int)maxall);
  printf("%6d maximum number of individuals in a pedigree (maxind)\n",
	 (int)maxind);
  printf("%6d maximum number of loops (maxloop)\n", (int)maxloop);
  printf("%6d maximum number of children in a nuclear family (maxchild)\n",
	 (int)maxchild);
  printf("\n");
  exit(0);
}




static boolean checkdone(ilocus, jlocus)
int ilocus, jlocus;
{
  int i, j;

  if (ilocus == locuslist1[0])
    return false;
  else {
    i = 0;
    do {
      i++;
    } while (jlocus != locuslist1[i - 1] && locuslist1[i - 1] != ilocus);
    j = 0;
    do {
      j++;
    } while (ilocus != locuslist2[j - 1] && j != nlocus2);
    return (locuslist1[i - 1] == jlocus && locuslist2[j - 1] == ilocus);
  }
}


main(argc, argv)
int argc;
char *argv[];
{
#if !defined(DOS)  /* cgh - gcc */
  /* K. Shriram: begin */
  char          dateTimeStamp [ DateTimeStampStringLength ] ;
  FILE          * scriptCheckpoint ;
  int           scriptRun , scriptToSleep ;
  FILE          * fileTester ;
  /* K. Shriram: end */
#endif  /* !defined(DOS) */

  /* cgh -- seqStartup() from commoncode.c */
  int c;
#ifdef vms
  ;
#else
  while ((c = getopt(argc, argv, "i")) != -1)
    switch (c) {
    case 'i':
      printLoInfo();
      break;
    case '?':
      exit(-1);
    default:
      break;
    }
#endif
  
#ifdef vms
  recfile = fopen("recfile.dat", "w", "ctx=rec", "shr=get,put,upd") ; 
#else
  recfile = fopen("recfile.dat", "w");  /* If you change things in        */
#endif
  if (recfile == NULL)                  /* connexion with either final    */
    exit(FileNotFound);               /* or stream, be sure to make     */
  if (dostream) {                       /* the appropriate modifications  */
#ifdef vms
    stream = fopen("stream.dat", "w", "ctx=rec", "shr=get,put,upd") ; 
#else
    stream = fopen("stream.dat", "w");   /* to the checkpointing code near */
#endif
    if (stream == NULL)                 /* the beginning of outf().       */
      exit(FileNotFound);             /*                      --Shriram */
  }
  else
    stream = NULL;

#if !defined(DOS)
  /* Shriram: begin */

  /* We perform the script-level checkpointing work here because we want
     the files recfile and stream, which will be used by external scripts,
     to have been created at this point. */

  scriptCheckpoint = NULL;
#ifdef vms
  scriptCheckpoint = fopen ( ScriptLODSCORECheckpointFilename , "r", "ctx=rec", "shr=get,put,upd") ; 
#else
  scriptCheckpoint = fopen ( ScriptLODSCORECheckpointFilename , "r" ) ;
#endif
  if ( NULL != scriptCheckpoint )
  {
    fscanf ( scriptCheckpoint , "%d %d" , & scriptRun , & scriptToSleep ) ;
    fclose ( scriptCheckpoint ) ;
    if ( 0 != scriptToSleep )
    {
#ifdef vms
      scriptCheckpoint = fopen ( ScriptLODSCORECheckpointFilename , "w", "ctx=rec", "shr=get,put,upd") ; 
#else
      scriptCheckpoint = fopen ( ScriptLODSCORECheckpointFilename , "w" ) ;
#endif
      scriptRun ++ ;  scriptToSleep -- ;
      fprintf ( scriptCheckpoint , "%d %d\n" , scriptRun , scriptToSleep ) ;
      fclose ( scriptCheckpoint ) ;
      printf ( "Recovering to checkpoint: %d more run(s)\n" ,
               scriptToSleep + 1 ) ;
      if ( NULL != recfile )
        fclose ( recfile ) ;
      if ( NULL != stream )
        fclose ( stream ) ;
      if ( 0 == scriptToSleep )
      {
#ifdef vms
        fileTester = fopen ( ScriptLODSCOREFinalOut , "r", "ctx=rec", "shr=get,put,upd") ; 
#else
        fileTester = fopen ( ScriptLODSCOREFinalOut , "r" ) ;
#endif
        if ( NULL != fileTester )
        {
          fclose ( fileTester ) ;
	  copyFile ( ScriptLODSCOREFinalOut , "final.out" ) ;
        }
        if ( dostream )
        {
#ifdef vms
          fileTester = fopen ( ScriptLODSCOREStreamOut , "r", "ctx=rec", "shr=get,put,upd") ; 
#else
          fileTester = fopen ( ScriptLODSCOREStreamOut , "r" ) ;
#endif
          if ( NULL != fileTester )
          {
            fclose ( fileTester ) ;
	    copyFile ( ScriptLODSCOREStreamOut , "stream.out" ) ;
          }
        }
      }
      exit ( EXIT_FAILURE ) ;
    }
  }

  /* Shriram: end */
#endif
  
  init_ped_loc_all(); /* dwix */

  datafile = fopen("datafile.dat", "r");
  if (datafile == NULL)
    exit(FileNotFound);
  pedfile = fopen("pedfile.dat", "r");
  if (pedfile == NULL)
    exit(FileNotFound);
#ifdef vms
  outfile = fopen("outfile.dat", "w", "ctx=rec", "shr=get,put,upd") ; 
#else
  outfile = fopen("outfile.dat", "w");
#endif
  if (outfile == NULL)
    exit(FileNotFound);
#ifdef vms
  final = fopen("final.dat", "w", "ctx=rec", "shr=get,put,upd") ;
#else
  final = fopen("final.dat", "w");
#endif
  if (recfile == NULL)
    exit(FileNotFound);
  if (dostream)
    fprintf(stream, "@\n");
  initilink();
  ihess = 0;
  ibnd = 1;
  icall = 1;
  ivar = 0;
  ihx = 1;
  inconsistent = false;
  inputdata();
  if (datafile != NULL)
    fclose(datafile);
  datafile = NULL;
  if (pedfile != NULL)
    fclose(pedfile);
  pedfile = NULL;

  /* dwix */
  if (DIAGNOSTIC)
    allele_downcode_check();
#if ALLELE_SPEED
  adjust_alleles();
  allele_adjust_persons();
#endif
  /* end dwix */
  
#if !defined(DOS)
  /* Shriram: begin */
#ifdef vms  
  checkpointDatafile = fopen ( CheckpointLODSCOREFilename , "r", "ctx=rec", "shr=get,put,upd") ; 
#else
  checkpointDatafile = fopen ( CheckpointLODSCOREFilename , "r" ) ;
#endif
  if ( NULL != checkpointDatafile )
  {
    checkpointStatus = checkpointedRun ;
    puts ( "NOTE: attempting to continue previous (unfinished) run" ) ;
    fgets ( dateTimeStamp , DateTimeStampStringLength , checkpointDatafile ) ;
    printf ( "      from %s" , dateTimeStamp ) ;
    getCkptTuple ( ) ;
  }

  /* Shriram: end */
#endif

#if !defined(DOS)
  if ( checkpointStatus != checkpointedRun )    /* Shriram */
  {
#endif
    h = sqrt(exp(-nbit * log(2.0)));
    tol = tolconst;
    /* tol:=tolconst*sqrt(n);*/
    trupb = sqrt(h);
#if !defined(DOS)
  }
#endif
  nlocus = 2;
  censorstruct = (censorrec *)Malloc(sizeof(censorrec));
  if (censorstruct == NULL)
    malloc_err("censorstruct");

#if !defined(DOS)
  /* Shriram: begin */
  if ( checkpointedRun == checkpointStatus )
    iplace = ckptTuple . iplace ;
  else
#endif
    iplace = 1 ;
  for ( /* do nothing */ ; iplace <= nlocus1; iplace++) {
#if !defined(DOS)
    if ( checkpointedRun == checkpointStatus )
     jplace = ckptTuple . jplace ;
    else
#endif
     jplace = 1 ;
    for ( /* do nothing */ ; jplace <= nlocus2; jplace++) {
#if !defined(DOS)
      ckptTuple . iplace = iplace ;
      ckptTuple . jplace = jplace ;

      if ( normalRun == checkpointStatus )
      {
	fclose ( recfile ) ;
	copyFile ( "recfile.dat" , MainLODSCORERecfileDat ) ;
#ifdef vms
	recfile = fopen ( "recfile.dat" , "a", "ctx=rec", "shr=get,put,upd") ; 
#else
	recfile = fopen ( "recfile.dat" , "a" ) ;
#endif
	
	if ( dostream )
	{
	  fclose ( stream ) ;
	  copyFile ( "stream.dat" , MainLODSCOREStreamDat ) ;
#ifdef vms
	  stream = fopen ( "stream.dat" , "a", "ctx=rec", "shr=get,put,upd") ; 
#else
	  stream = fopen ( "stream.dat" , "a" ) ;
#endif
	}
      }
      else
      {
	fclose ( recfile ) ;
	copyFile ( MainLODSCORERecfileDat , "recfile.dat" ) ;
#ifdef vms
	recfile = fopen ( "recfile.dat" , "a", "ctx=rec", "shr=get,put,upd") ; 
#else
	recfile = fopen ( "recfile.dat" , "a" ) ;
#endif
	
	if ( dostream )
	{
	  fclose ( stream ) ;
	  copyFile ( MainLODSCOREStreamDat , "stream.dat" ) ;
#ifdef vms
	  stream = fopen ( "stream.dat" , "a", "ctx=rec", "shr=get,put,upd") ;
#else
	  stream = fopen ( "stream.dat" , "a" ) ;
#endif
	}
      }
      
      /* Shriram: end */
#endif
      if (locuslist1[iplace - 1] != locuslist2[jplace - 1]) {
	if (!checkdone(locuslist1[iplace - 1], locuslist2[jplace - 1])) {
	  printf("loci %4d%4d\n",
		 locuslist1[iplace - 1], locuslist2[jplace - 1]);
#if !defined(DOS)
	  if ( normalRun == checkpointStatus )
	  {
#endif
	    ihess = 0;
	    ibnd = 1;
	    icall = 1;
	    ivar = 0;
	    ihx = 1;
	    f = 0.0;
	    ptg = 0.0;
	    inconsistent = false;
#if !defined(DOS)
	  }
#endif
	  ilocus = locuslist1[iplace - 1];
	  jlocus = locuslist2[jplace - 1];
#if !defined(DOS)
	  if ( normalRun == checkpointStatus )
	  {
#endif
	    firsttime = true;
	    lasttime = false;
	    dolod = false;
	    firstapprox = true;
#if !defined(DOS)
	  }
#endif
	  setlods(ilocus, jlocus);
	  setiterate();
	  maxit = n * iterationMultiple;
          if (DIAGNOSTIC)   /*A. A. Schaffer*/
            check_constants();
#if !ALLELE_SPEED
          allocategenetables();
	  getlocations();
#endif
	  getgeneindices(); /*R. M. Idury*/
          allocate_loopbreaker_vectors(); /* A. A. Schaffer*/
#if !defined(DOS)
	  /* K. Shriram: begin */
	  if ( ( checkpointedRun == checkpointStatus ) &&
	      ( ( functionLocation == ckptTuple . ckptLocation ) &&
	       ( fCP_outf == ckptTuple . ckptAttribute ) ) )
	    goto FunRecover1 ;
	  /* K. Shriram: end */
#endif
	  gemini();
#if !defined(DOS)  /* cgh - gcc */
	FunRecover1:
#endif  /* !defined(DOS) */
	  outf();
          freegenetables();
	}
      }
    }
  }
  if (dostream) {
    fprintf(stream, "~\n");
    if (stream != NULL)
      fclose(stream);
  }
  if (recfile != NULL)
    fclose(recfile);

#if !defined(DOS)
  /* Shriram: begin */

  /* This is the time at which to update the script-level checkpointing
     routine, since we have closed recfile and stream; any disasters that
     occur after this are "safe". */

#ifdef vms
  scriptCheckpoint = fopen ( ScriptLODSCORECheckpointFilename , "r+", "ctx=rec", "shr=get,put,upd" ) ;
#else
  scriptCheckpoint = fopen ( ScriptLODSCORECheckpointFilename , "r+" ) ;
#endif
  if ( NULL != scriptCheckpoint )
  {
    rewind ( scriptCheckpoint ) ;
    scriptRun ++ ;
    fprintf ( scriptCheckpoint , "%d 0\n" , scriptRun ) ;
    fclose ( scriptCheckpoint ) ;

    copyFile ( "final.out" , ScriptLODSCOREFinalOut ) ;
    appendFile ( "recfile.dat" , ScriptLODSCOREFinalOut ) ;
    
    if ( dostream )
    {
      copyFile ( "stream.out" , ScriptLODSCOREStreamOut ) ;
      appendFile ( "stream.dat" , ScriptLODSCOREStreamOut ) ;
    }
  }

  if ( NULL != checkpointDatafile )
    fclose ( checkpointDatafile ) ;
  
  unlink ( CheckpointLODSCOREFileBackup ) ;
  unlink ( CheckpointLODSCOREFilename ) ;

  unlink ( OutfLODSCORERecfileDat ) ;
  unlink ( OutfLODSCOREStreamDat ) ;
  unlink ( MainLODSCORERecfileDat ) ;
  unlink ( MainLODSCOREStreamDat ) ;

  /* Shriram: end */
#endif

  if (final != NULL)
    fclose(final);
  final = NULL;
  if (outfile != NULL)
    fclose(outfile);
  if (pedfile != NULL)
    fclose(pedfile);
  if (datafile != NULL)
    fclose(datafile);

  exit(EXIT_SUCCESS);
}



/* End. */
