/*****************************************************************************
******************************************************************************
**<AUTO>
**
** FILE:	tclCalibrate.c
**
**<HTML>
**	This file contains TCL functions to calibrate object lists.
**</HTML>
**</AUTO>
**
**
** ENVIRONMENT:
**	ANSI C.
**
******************************************************************************
******************************************************************************
*/

#include <dervish.h>
#include <astrotools.h>
#include "taCalibObj.h"
#include "arObjectStatus.h"
#include "arObjectType.h"
#include "arDetectionFlag.h"
#include "taCosmic.h"

#define MAX_ROW_BORDER  100  /* Maximum number of objects in a row border */
#define MAX_NU_BORDER   100000  /* Maximum number of objects in a nu border */

/* Matching objects from adjacent segments along the eta border. */
static TA_BORDER_OBJ etaBorder[2][MAX_NU_BORDER];
static int nEtaBorder[2] = {0, 0};


/*============================================================================
**<AUTO EXTRACT>
**
** TCL VERB: objsCalibrate
**
**<HTML>
**	Calibrate a CHAIN of uncalibrated objects.  The calibration is done
**	in place.  Thus, the TA_CALIB_OBJ chain should contain instrumental
**	quantities on input, and will contain calibrated quantities on output.
**	For DCR corrections in astrometric transformations, PSF magnitudes are
**	used for stars and model magnitudes for galaxies.
**	All objects' status flags are set
**	appropriately as if this were a primary segment (with no mu bounds).
**</HTML>
**
**</AUTO>
**============================================================================
*/
static char objsCalibrateCmd[] = "objsCalibrate";
static int objsCalibrateFlg = FTCL_ARGV_NO_LEFTOVERS;
static ftclArgvInfo objsCalibrateTbl[] = {
  {NULL, FTCL_ARGV_HELP, NULL, NULL,
   "Calibrate an object list\n"},
  {"<chain>", FTCL_ARGV_STRING, NULL, NULL, "CHAIN of TA_CALIB_OBJ"},
  {"<ptrans>", FTCL_ARGV_STRING, NULL, NULL,
   "TA_PTRANS structure for photometric calibrations"},
  {"<u>", FTCL_ARGV_STRING, NULL, NULL,
   "u TRANS structure for astrometric calibrations"},
  {"<g>", FTCL_ARGV_STRING, NULL, NULL,
   "g TRANS structure for astrometric calibrations"},
  {"<r>", FTCL_ARGV_STRING, NULL, NULL,
   "r TRANS structure for astrometric calibrations"},
  {"<i>", FTCL_ARGV_STRING, NULL, NULL,
   "i TRANS structure for astrometric calibrations"},
  {"<z>", FTCL_ARGV_STRING, NULL, NULL,
   "z TRANS structure for astrometric calibrations"},
  {"<node>", FTCL_ARGV_DOUBLE, NULL, NULL,
   "Scanned (i.e., TRANS) great circle ascending node (degrees, J2000)"},
  {"<incl>", FTCL_ARGV_DOUBLE, NULL, NULL,
   "Scanned (i.e., TRANS) great circle inclination (degrees, J2000)"},
  {"<refFilter>", FTCL_ARGV_STRING, NULL, NULL,
   "Reference filter for primary positions of objects"},
  {"<expTime>", FTCL_ARGV_DOUBLE, NULL, NULL,
   "Exposure time (seconds)"},
  {"<geometry>", FTCL_ARGV_STRING, NULL, NULL,
   "TA_GEOMETRY structure specifying survey geometry to use when resolving"},
  {"-firstField", FTCL_ARGV_CONSTANT, (void *) 1, NULL,
   "Select if objects belong to first field in segment"},
  {"-lastField", FTCL_ARGV_CONSTANT, (void *) 1, NULL,
   "Select if objects belong to last field in segment"},
  {"-loMuBorder", FTCL_ARGV_STRING, NULL, NULL,
   "CHAIN of TA_BORDER_OBJ on mu border of previous abutting segment on same scanline"},
  {"-hiMuBorder", FTCL_ARGV_STRING, NULL, NULL,
   "CHAIN of TA_BORDER_OBJ on mu border of next abutting segment on same scanline"},
  {NULL, FTCL_ARGV_END, NULL, NULL, NULL}
};

static int
tclObjsCalibrate (ClientData clientData,
		  Tcl_Interp *interp,
		  int argc,
		  char **argv)
{
  CHAIN *chain = NULL;
  TA_PTRANS *ptrans = NULL;
  TRANS *trans[TA_NFILTERS] = {NULL, NULL, NULL, NULL, NULL};
  char *chainHandle = NULL;
  char *ptransHandle = NULL;
  char *transHandle[TA_NFILTERS] = {NULL, NULL, NULL, NULL, NULL};
  double node, incl, expTime;
  float cosmicMag[5], cosmicMagScatter[5];
  char *refFilter;
  TA_GEOMETRY *geometry = NULL;
  char *geometryHandle = NULL;
  int firstField = 0;
  int lastField = 0;
  CHAIN *muBorderChain[2] = {NULL, NULL};
  char *muBorderHandle[2] = {NULL, NULL};
  int status;

  TA_CALIB_OBJ *obj;
  CURSOR_T curse;
  int i, inSurvey, scanlineNumber;
  double mu, nu, matchRadius, matchRadiusPix;
  static int previousScanlineNumber = -1;
  static TA_BORDER_OBJ previousField[MAX_ROW_BORDER];
  static int nPreviousField = 0;
  static TA_BORDER_OBJ nextField[MAX_ROW_BORDER];
  static int nNextField = 0;
  static TA_BORDER_OBJ previousScanline[MAX_NU_BORDER];
  static int nPreviousScanline = 0;
  static TA_BORDER_OBJ nextScanline[MAX_NU_BORDER];
  static int nNextScanline = 0;
  static TA_BORDER_OBJ muBorder[2][MAX_ROW_BORDER];
  static int nMuBorder[2] = {0, 0};
  TA_BORDER_OBJ *muBorderPtr[2];
  TA_BORDER_OBJ *etaBorderPtr[2];
  TA_BORDER_OBJ *borderObj;
  double scale;

  /* Parse the arguments */
  objsCalibrateTbl[1].dst = &chainHandle;
  objsCalibrateTbl[2].dst = &ptransHandle;
  objsCalibrateTbl[3].dst = &transHandle[0];
  objsCalibrateTbl[4].dst = &transHandle[1];
  objsCalibrateTbl[5].dst = &transHandle[2];
  objsCalibrateTbl[6].dst = &transHandle[3];
  objsCalibrateTbl[7].dst = &transHandle[4];
  objsCalibrateTbl[8].dst = &node;
  objsCalibrateTbl[9].dst = &incl;
  objsCalibrateTbl[10].dst = &refFilter;
  objsCalibrateTbl[11].dst = &expTime;
  objsCalibrateTbl[12].dst = &geometryHandle;
  objsCalibrateTbl[13].dst = &firstField;
  objsCalibrateTbl[14].dst = &lastField;
  objsCalibrateTbl[15].dst = &(muBorderHandle[0]);
  objsCalibrateTbl[16].dst = &(muBorderHandle[1]);
  if ((status = shTclParseArgv(interp, &argc, argv, objsCalibrateTbl,
			       objsCalibrateFlg, objsCalibrateCmd))
      != FTCL_ARGV_SUCCESS)
    return status;
   
  /* Get handle to chain */
  if (shTclAddrGetFromName (interp, chainHandle, (void **)&chain, "CHAIN")
      != TCL_OK)
    {
      Tcl_AppendResult(interp, objsCalibrateCmd,
		       ": error getting handle to chain", NULL);
      return TCL_ERROR;
    }
  
  /* Verify that chain is for TA_CALIB_OBJ */
  if (shChainTypeGet(chain) != shTypeGetFromName("TA_CALIB_OBJ"))
    {
      Tcl_AppendResult(interp, objsCalibrateCmd,
		       ": input CHAIN not of type TA_CALIB_OBJ", NULL);
      return TCL_ERROR;
    }

  /* Get handle to PTRANS */
  if (shTclAddrGetFromName (interp, ptransHandle, (void **)&ptrans, "TA_PTRANS")
      != TCL_OK)
    {
      Tcl_AppendResult(interp, objsCalibrateCmd,
		       ": error getting handle to ptrans", NULL);
      return TCL_ERROR;
    }
  
  /* Get handles to TRANS structures */
  for (i = 0; i < TA_NFILTERS; i++)
    if (shTclAddrGetFromName (interp, transHandle[i], (void **)&trans[i],
    "TRANS") != TCL_OK)
      {
	Tcl_AppendResult(interp, objsCalibrateCmd,
			 ": error getting handle to trans", NULL);
	return TCL_ERROR;
      }
  
  /* Get handle to TA_GEOMETRY structure */
  if (shTclAddrGetFromName (interp, geometryHandle,
			    (void **)&geometry, "TA_GEOMETRY") != TCL_OK)
    {
      Tcl_AppendResult(interp, objsCalibrateCmd,
		       ": error getting handle to geometry", NULL);
      return TCL_ERROR;
    }
  
  /* If mu border chains passed in, get their handles */
  for (i = 0; i < 2; i++)
    if (muBorderHandle[i] != NULL)
      {
	if (shTclAddrGetFromName (interp, muBorderHandle[i],
				(void **)&(muBorderChain[i]), "CHAIN")
	    != TCL_OK)
	  {
	    Tcl_AppendResult(interp, objsCalibrateCmd,
			     ": error getting handle to mu border chain",
			     NULL);
	    return TCL_ERROR;
	  }
  
	/* Verify that chain is for TA_BORDER_OBJ */
	if (shChainTypeGet(muBorderChain[i]) !=
	    shTypeGetFromName("TA_BORDER_OBJ"))
	  {
	    Tcl_AppendResult(interp, objsCalibrateCmd,
			     ": mu border CHAIN not of type TA_BORDER_OBJ",
			     NULL);
	    return TCL_ERROR;
	  }
      }

  /* Set up cosmic color for use by atTransApply(). */
  taTransCosmicSet(cosmicColor, cosmicScatter);

  /* Initialize row border arrays.  Copy next field border from previous
   * field to previous field border for this field. */
  shAssert(nPreviousField >= 0 && nPreviousField <= MAX_ROW_BORDER);
  shAssert(nNextField >= 0 && nNextField <= MAX_ROW_BORDER);
  if (firstField)
    {
      nPreviousField = 0;
      nNextField = 0;
    }
  else
    {
      for (i = 0; i < nNextField; i++)
	previousField[i] = nextField[i];
      nPreviousField = nNextField;
      nNextField = 0;
    }

  /* Initialize nu border arrays.  Copy next nu border from previous
   * scanline to previous nu border for this scanline. */
  shAssert(geometry->strip == 'N' || geometry->strip == 'S' ||
	   geometry->strip == 'O');
  shAssert(geometry->camCol >= 1 && geometry->camCol <= 6);
  shAssert(nPreviousScanline >= 0 && nPreviousScanline <= MAX_NU_BORDER);
  shAssert(nNextScanline >= 0 && nNextScanline <= MAX_NU_BORDER);
  if (geometry->skyVersion == -1 || geometry->strip == 'O')
    {
      /* No nu border resolution for "other" strips, or for stage export. */
      previousScanlineNumber = -1;
      scanlineNumber = -1;
      nPreviousScanline = 0;
      nNextScanline = 0;
    }
  else
    {
      /* Resolving within a chunk. */
      scanlineNumber =
	(geometry->camCol - 1) * 2 + (geometry->strip == 'S' ? 1 : 2);
      if (scanlineNumber == previousScanlineNumber + 1)
	{
	  /* Starting next scanline in the chunk.  Copy old next mu border
	   * objects to previous mu border objects. */
	  for (i = 0; i < nNextScanline; i++)
	    previousScanline[i] = nextScanline[i];
	  nPreviousScanline = nNextScanline;
	  nNextScanline = 0;
	}
      else if (scanlineNumber != previousScanlineNumber)
	{
	  /* Starting a new scanline, but out of order.  Fine if this is
	   * the first scanline in a new chunk, but else print a warning. */
	  if (scanlineNumber != 1)
	    printf("WARNING: %s: starting a new scanline out of order within a chunk\n", objsCalibrateCmd);
	  nPreviousScanline = 0;
	  nNextScanline = 0;
	}
    }

  /* Initialize mu border arrays. */
  for (i = 0; i < 2; i++)
    {
      shAssert(nMuBorder[i] >= 0 && nMuBorder[i] <= MAX_ROW_BORDER);
      if (muBorderChain[i] != NULL)
	{
	  shAssert(scanlineNumber > -1);
	  nMuBorder[i] = 0;
	  curse = shChainCursorNew(muBorderChain[i]);
	  while ((borderObj = (TA_BORDER_OBJ*) shChainWalk(muBorderChain[i],
							   curse, NEXT))
		 != NULL)
	    {
	      shAssert(nMuBorder[i] < MAX_ROW_BORDER);
	      muBorder[i][nMuBorder[i]] = *borderObj;
	      nMuBorder[i]++;
	    }
	  shChainCursorDel(muBorderChain[i], curse);
	}
      else
	{
	  /* If this is the first field in a segment in the same scanline as
	   * the previous segment, and we are resolving a full chunk, then use
	   * the border objects from the last field in the previous segment. */
	  if (i == 1 || scanlineNumber == -1 ||
	      scanlineNumber != previousScanlineNumber || ! firstField)
	    nMuBorder[i] = 0;
	}
      muBorderPtr[i] = &(muBorder[i][0]);
      etaBorderPtr[i] = &(etaBorder[i][0]);
    }

  /* Need pixel scale to convert matching radius in arcsec to matching
   * radius in pixels. */
  scale = at_deg2Asec * sqrt((double)(trans[2]->b * trans[2]->f -
				      trans[2]->e * trans[2]->c));

  /* For each object ... */
  matchRadius = geometry->matchRadius * at_asec2Deg;
  matchRadiusPix = geometry->matchRadius / scale;
  curse = shChainCursorNew(chain);
  while ((obj = (TA_CALIB_OBJ*) shChainWalk(chain, curse, NEXT)) != NULL)
    {
      /* Calibrate it */
      if (taObjCalibrate(obj, ptrans, (const TRANS**)trans, 
			 (const TRANS**)trans, node, incl,
			 refFilter[0], expTime, 0) != SH_SUCCESS)
	{
	  shTclInterpAppendWithErrStack(interp);
	  return TCL_ERROR;
	}

      /* Set object status */
      if (taObjectStatusSet(obj, geometry->nRowsPerField, geometry->nOverlap,
			    matchRadiusPix, previousField, nPreviousField))
	{
	  /* This object is in border region with next field.  Add it to
	   * the next field border array. */
	  shAssert(nNextField < MAX_ROW_BORDER);
	  nextField[nNextField].lambda = obj->objc_rowc.val -
	    geometry->nRowsPerField;
	  nextField[nNextField].eta = obj->objc_colc.val;
	  nextField[nNextField].status = obj->status;
	  nNextField++;
	}

      /* Resolve */
      if (taSegmentResolve(obj, firstField, geometry,
			   (const TA_BORDER_OBJ **) muBorderPtr, nMuBorder,
			   previousScanline, nPreviousScanline,
			   (const TA_BORDER_OBJ **) etaBorderPtr, nEtaBorder ))
	{
	  /* This object is matchable. */

	  /* Get great circle coordinates. */
	  atEqToGC(obj->ra, obj->dec, &mu, &nu, geometry->stripeNode,
		   geometry->stripeIncl);

	  /* If its in the border region with the next scanline, then add it to
	   * the next scanline border array. */
	  if (scanlineNumber >= 1 && scanlineNumber < 12 &&
	      nu > geometry->nuLimits[1] - matchRadius &&
	      nu < geometry->nuLimits[1] + matchRadius)
	    {
	      shAssert(nNextScanline < MAX_NU_BORDER);
	      nextScanline[nNextScanline].lambda = obj->lambda;
	      nextScanline[nNextScanline].eta = obj->eta;
	      nextScanline[nNextScanline].status = obj->status;
	      nNextScanline++;
	    }

	  /* If its in the last field of a segment and in the border region,
	   * then treat it for now as if its in the border region for the
	   * first field of an abutting segment. */
	  if (scanlineNumber > -1 && lastField)
	    if (mu > geometry->muLimits[1] - matchRadius &&
		mu < geometry->muLimits[1] + matchRadius)
	      {
		shAssert(nMuBorder[0] < MAX_ROW_BORDER);
		muBorder[0][nMuBorder[0]].lambda = obj->lambda;
		muBorder[0][nMuBorder[0]].eta = obj->eta;
		muBorder[0][nMuBorder[0]].status = obj->status;
		nMuBorder[0]++;
	      }
	}
    }
  shChainCursorDel(chain, curse);
  
  /* Bookkeeping */
  previousScanlineNumber = scanlineNumber;

  /* Return */
  Tcl_SetResult(interp, "", TCL_VOLATILE);
  return TCL_OK;
}


/*============================================================================
**<AUTO EXTRACT>
**
** TCL VERB: etaBordersInit
**
**<HTML>
**	Initialize eta borders for matching.  Object along the eta border
**	regions from adjacent chunks are passed in as TA_BORDER_OBJ chains
**	and used to initialize the matching when resolving.  If a chain
**	is not specified, then that border is initialized with no objects.
**</HTML>
**
**</AUTO>
**============================================================================
*/
static char etaBordersInitCmd[] = "etaBordersInit";
static int etaBordersInitFlg = FTCL_ARGV_NO_LEFTOVERS;
static ftclArgvInfo etaBordersInitTbl[] = {
  {NULL, FTCL_ARGV_HELP, NULL, NULL,
   "Initialize eta borders for matching\n"},
  {"[loBorder]", FTCL_ARGV_STRING, NULL, NULL,
   "CHAIN of TA_BORDER_OBJ on lo eta border from chunks from previous stripe"},
  {"[hiBorder]", FTCL_ARGV_STRING, NULL, NULL,
   "CHAIN of TA_BORDER_OBJ on hi eta border from chunks from next stripe"},
  {NULL, FTCL_ARGV_END, NULL, NULL, NULL}
};

static int
tclEtaBordersInit (ClientData clientData,
		   Tcl_Interp *interp,
		   int argc,
		   char **argv)
{
  CHAIN *etaBorderChain[2] = {NULL, NULL};
  char *etaBorderHandle[2] = {NULL, NULL};
  int status;

  TA_BORDER_OBJ *obj;
  CURSOR_T curse;
  int i;

  /* Parse the arguments */
  etaBordersInitTbl[1].dst = &(etaBorderHandle[0]);
  etaBordersInitTbl[2].dst = &(etaBorderHandle[1]);
  if ((status = shTclParseArgv(interp, &argc, argv, etaBordersInitTbl,
			       etaBordersInitFlg, etaBordersInitCmd))
      != FTCL_ARGV_SUCCESS)
    return status;
   
  /* If border chains passed in, get their handles */
  for (i = 0; i < 2; i++)
    if (etaBorderHandle[i] != NULL)
      if (strlen(etaBorderHandle[i]) > 0)
	{
	  if (shTclAddrGetFromName (interp, etaBorderHandle[i],
				    (void **)&(etaBorderChain[i]), "CHAIN")
	      != TCL_OK)
	    {
	      Tcl_AppendResult(interp, etaBordersInitCmd,
			       ": error getting handle to eta border chain",
			       NULL);
	      return TCL_ERROR;
	    }
  
	  /* Verify that chain is for TA_BORDER_OBJ */
	  if (shChainTypeGet(etaBorderChain[i]) !=
	      shTypeGetFromName("TA_BORDER_OBJ"))
	    {
	      Tcl_AppendResult(interp, etaBordersInitCmd,
			       ": eta border CHAIN not of type TA_BORDER_OBJ",
			       NULL);
	      return TCL_ERROR;
	    }
	}

  /* Initialize eta border arrays. */
  for (i = 0; i < 2; i++)
    {
      nEtaBorder[i] = 0;
      if (etaBorderChain[i] != NULL)
	{
	  curse = shChainCursorNew(etaBorderChain[i]);
	  while ((obj = (TA_BORDER_OBJ*) shChainWalk(etaBorderChain[i],
						 curse, NEXT)) != NULL)
	    {
	      shAssert(nEtaBorder[i] < MAX_NU_BORDER);
	      etaBorder[i][nEtaBorder[i]] = *obj;
	      nEtaBorder[i]++;
	    }
	  shChainCursorDel(etaBorderChain[i], curse);
	}
    }

  /* Return */
  Tcl_SetResult(interp, "", TCL_VOLATILE);
  return TCL_OK;
}


/*============================================================================
**<AUTO EXTRACT>
**
** TCL VERB: fieldAreaGet
**
**<HTML>
**	Fetch segment and primary field areas for a field.
**	They are returned, in units of deg^2, as a TCL keyed list with
**	the keys "segmentArea" and "primaryArea".
**</HTML>
**
**</AUTO>
**============================================================================
*/
static char fieldAreaGetCmd[] = "fieldAreaGet";
static int fieldAreaGetFlg = FTCL_ARGV_NO_LEFTOVERS;
static ftclArgvInfo fieldAreaGetTbl[] = {
  {NULL, FTCL_ARGV_HELP, NULL, NULL,
   "Get the segment and primary field areas for a field\n"},
  {"<trans>", FTCL_ARGV_STRING, NULL, NULL,
   "r TRANS structure for the field"},
  {"<geometry>", FTCL_ARGV_STRING, NULL, NULL,
   "TA_GEOMETRY structure for the segment"},
  {NULL, FTCL_ARGV_END, NULL, NULL, NULL}
};

static int
tclFieldAreaGet (ClientData clientData,
		 Tcl_Interp *interp,
		 int argc,
		 char **argv)
{
  TRANS *trans = NULL;
  char *transHandle = NULL;
  TA_GEOMETRY *geometry = NULL;
  char *geometryHandle = NULL;
  int status;

  double segmentArea, primaryArea;
  char result[400];

  /* Parse the arguments */
  fieldAreaGetTbl[1].dst = &transHandle;
  fieldAreaGetTbl[2].dst = &geometryHandle;
  if ((status = shTclParseArgv(interp, &argc, argv, fieldAreaGetTbl,
			       fieldAreaGetFlg, fieldAreaGetCmd))
      != FTCL_ARGV_SUCCESS)
    return status;
   
  /* Get handle to PTRANS */
  if (shTclAddrGetFromName (interp, transHandle, (void **)&trans, "TRANS")
      != TCL_OK)
    {
      Tcl_AppendResult(interp, fieldAreaGetCmd,
		       ": error getting handle to trans", NULL);
      return TCL_ERROR;
    }
  
  /* Get handle to TA_GEOMETRY structure */
  if (shTclAddrGetFromName (interp, geometryHandle,
			    (void **)&geometry, "TA_GEOMETRY") != TCL_OK)
    {
      Tcl_AppendResult(interp, fieldAreaGetCmd,
		       ": error getting handle to geometry", NULL);
      return TCL_ERROR;
    }
  
  /* Do it. */
  taFieldArea(trans, geometry, &segmentArea, &primaryArea);
  
  /* Return */
  sprintf(result, "{segmentArea %14.12f} {primaryArea %14.12f}",
	  segmentArea, primaryArea);
  Tcl_SetResult(interp, result, TCL_VOLATILE);
  return TCL_OK;
}


/*============================================================================
**<AUTO EXTRACT>
**
** TCL VERB: taLCaliApply
**
**<HTML>
**</HTML>
**
**</AUTO>
**============================================================================
*/
static char taLCaliApplyCmd[] = "taLCaliApply";
static int taLCaliApplyFlg = FTCL_ARGV_NO_LEFTOVERS;
static ftclArgvInfo taLCaliApplyTbl[] = {
  {NULL, FTCL_ARGV_HELP, NULL, NULL,
   "Apply the calibration to the observed counts to yield a luptitude:  \nRETURN:  a keyed list of calMag, calMagErr, status, and retInt\n" },
  {"<filterIndex>", FTCL_ARGV_INT, NULL, NULL, 
   "which filter; 0=u, 1=g, 2=r, 3=i, 4=z"},
  {"<maggies>", FTCL_ARGV_INT, NULL, NULL, 
   "0=asinh mag, 1=maggie flux, 2 = Jy flux"},
  {"<counts>", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "number of counts in the reference filter"},
  {"<countsErr>", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "error in counts"},
  {"<cCounts>", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "number of counts in the adjacent filter"},
  {"<cCountsErr>", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "error in cCounts"},
  {"<intTime>", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "exposure time in the reference filter (seconds)"},
  {"<cIntTime>", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "exposure time in the adjacent filter (seconds)"},
  {"<airmass>", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "airmass:  sec of the zenith angle"},
  {"<zeropt>", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "magnitude zeropoint for the reference filter (a)"},
  {"<extinct>", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "extinction  for the reference filter (k)"},
  {"<colorTerm>", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "color term (b)"},
  {"<secColorTerm>", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "second order color term (c)"},
  {"[cosmicColor]", FTCL_ARGV_DOUBLE, NULL, NULL, 
   "typical instrumental color (reference-adjacent), default(i)=2.29,0.70,0.10,-1.3,-1.3"},
  {"[cosmicError]", FTCL_ARGV_DOUBLE, NULL, NULL, "error in cosmicColor"},
  {NULL, FTCL_ARGV_END, NULL, NULL, NULL}
};
static int
tclTaLCaliApply (ClientData clientData,
		 Tcl_Interp *interp,
		 int argc,
		 char **argv)
{
  int filterIndex = 0;
  int maggies = 0;
  double counts = 0.0;
  double countsErr = 0.0;
  double cCounts = 0.0;
  double cCountsErr = 0.0;
  double intTime = 0.0;
  double cIntTime = 0.0;
  double airmass = 0.0;
  double zeropt = 0.0;
  double extinct = 0.0;
  double colorTerm = 0.0;
  double secColorTerm = 0.0;
  double cosmicColor = -100000.0;
  double cosmicError = -100000.0;
  int status = 0;

  double calMag = 0.0, calMagErr = 0.0;
  int retInt;
  char answer[100];

  taLCaliApplyTbl[1].dst = &filterIndex;
  taLCaliApplyTbl[2].dst = &maggies;
  taLCaliApplyTbl[3].dst = &counts;
  taLCaliApplyTbl[4].dst = &countsErr;
  taLCaliApplyTbl[5].dst = &cCounts;
  taLCaliApplyTbl[6].dst = &cCountsErr;
  taLCaliApplyTbl[7].dst = &intTime;
  taLCaliApplyTbl[8].dst = &cIntTime;
  taLCaliApplyTbl[9].dst = &airmass;
  taLCaliApplyTbl[10].dst = &zeropt;
  taLCaliApplyTbl[11].dst = &extinct;
  taLCaliApplyTbl[12].dst = &colorTerm;
  taLCaliApplyTbl[13].dst = &secColorTerm;
  taLCaliApplyTbl[14].dst = &cosmicColor;
  taLCaliApplyTbl[15].dst = &cosmicError;

  if ((status = shTclParseArgv(interp, &argc, argv, taLCaliApplyTbl,
			       taLCaliApplyFlg, taLCaliApplyCmd))
      != FTCL_ARGV_SUCCESS)
    return status;

  if (filterIndex < 0 || filterIndex > 4)
    {
      calMag = -1000;
      calMagErr = -1000;
      status = 2;
    }
  else
    {
      if (cosmicColor < -99999.)
	cosmicColor = cosmicSkyColor[cosmicIdx[filterIndex]];
      if (cosmicError < -99999.)
	cosmicColor = cosmicSkyScatter[cosmicIdx[filterIndex]];
      retInt = taLCaliApply(filterIndex, maggies, counts, countsErr,
			    cCounts, cCountsErr, intTime, cIntTime,
			    airmass, zeropt, extinct, colorTerm, secColorTerm,
			    0, cosmicColor, cosmicError,
			    &calMag, &calMagErr, &status);
    }
  if (maggies > 0)
    {
      sprintf(answer,"calMag %g"   , calMag);    Tcl_AppendElement(interp, answer);
      sprintf(answer,"calMagErr %g", calMagErr); Tcl_AppendElement(interp, answer);
    }
  else
    {
      sprintf(answer,"calMag %f"   , calMag);    Tcl_AppendElement(interp, answer);
      sprintf(answer,"calMagErr %f", calMagErr); Tcl_AppendElement(interp, answer);
    }
  sprintf(answer,"status %d"   , status);    Tcl_AppendElement(interp, answer);
  sprintf(answer,"retInt %d"   , status);    Tcl_AppendElement(interp, answer);
  return TCL_OK;
}

/*****************************************************************************
 *
 * Declare my new tcl verbs to tcl
 */
void
taTclCalibrateDeclare(Tcl_Interp *interp) 
{
  char *tclHelpFacil = "ta";
  shTclDeclare(interp, objsCalibrateCmd,
	       (Tcl_CmdProc *)tclObjsCalibrate,
	       (ClientData) 0,	(Tcl_CmdDeleteProc *)NULL, tclHelpFacil,
	       shTclGetArgInfo(interp, objsCalibrateTbl, objsCalibrateFlg,
			       objsCalibrateCmd),
	       shTclGetUsage(interp, objsCalibrateTbl, objsCalibrateFlg,
			     objsCalibrateCmd));
  shTclDeclare(interp, etaBordersInitCmd,
	       (Tcl_CmdProc *)tclEtaBordersInit,
	       (ClientData) 0,	(Tcl_CmdDeleteProc *)NULL, tclHelpFacil,
	       shTclGetArgInfo(interp, etaBordersInitTbl, etaBordersInitFlg,
			       etaBordersInitCmd),
	       shTclGetUsage(interp, etaBordersInitTbl, etaBordersInitFlg,
			     etaBordersInitCmd));
  shTclDeclare(interp, fieldAreaGetCmd,
	       (Tcl_CmdProc *)tclFieldAreaGet,
	       (ClientData) 0,	(Tcl_CmdDeleteProc *)NULL, tclHelpFacil,
	       shTclGetArgInfo(interp, fieldAreaGetTbl, fieldAreaGetFlg,
			       fieldAreaGetCmd),
	       shTclGetUsage(interp, fieldAreaGetTbl, fieldAreaGetFlg,
			     fieldAreaGetCmd));
  shTclDeclare(interp, taLCaliApplyCmd,
	       (Tcl_CmdProc *)tclTaLCaliApply,
	       (ClientData) 0,	(Tcl_CmdDeleteProc *)NULL, tclHelpFacil,
	       shTclGetArgInfo(interp, taLCaliApplyTbl, taLCaliApplyFlg,
			       taLCaliApplyCmd),
	       shTclGetUsage(interp, taLCaliApplyTbl, taLCaliApplyFlg,
			     taLCaliApplyCmd));
}
