/*                                                                            *
 *   This file is part of the ESO UVES Pipeline                               *
 *   Copyright (C) 2004,2005 European Southern Observatory                    *
 *                                                                            *
 *   This library 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; either version 2 of the License, or        *
 *   (at your option) any later version.                                      *
 *                                                                            *
 *   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, write to the Free Software              *
 *   Foundation, 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA     *
 *                                                                           */
/*
 * $Author: amodigli $
 * $Date: 2012-10-27 15:26:47 $
 * $Revision: 1.30 $
 * $Name: not supported by cvs2svn $
 * $Log: not supported by cvs2svn $
 * Revision 1.29  2012/10/27 11:47:57  amodigli
 * fixed mem leaks
 *
 * Revision 1.28  2012/10/27 10:28:20  amodigli
 * fixed mem leaks
 *
 * Revision 1.27  2012/10/26 18:23:25  amodigli
 * fixed mem leaks
 *
 * Revision 1.26  2012/10/10 09:08:13  amodigli
 * less verbose
 *
 * Revision 1.25  2010/12/20 16:37:07  amodigli
 * added call to uves_tablename_remove_units to fix a problem on raw order fibre table generated by flames_cal_prep_sff_ofpos that has in an instance units filled by a string like '   ' and is being merged with a table with empty units. CPL5.3 makes a check on table column units consistency
 *
 * Revision 1.24  2010/09/24 09:31:29  amodigli
 * put back QFITS dependency to fix problem spot by NRI on FIBER mode (with MIDAS calibs) data
 *
 * Revision 1.22  2008/09/29 06:51:09  amodigli
 * add #include <string.h>
 *
 * Revision 1.21  2007/10/23 06:44:19  amodigli
 * fixed compilation warnings
 *
 * Revision 1.20  2007/07/03 14:27:50  jmlarsen
 * Removed debugging code
 *
 * Revision 1.19  2007/07/03 14:04:17  jmlarsen
 * Added comments
 *
 * Revision 1.18  2007/07/03 08:44:54  jmlarsen
 * Removed debugging code
 *
 * Revision 1.17  2007/06/28 09:34:27  jmlarsen
 * Removed debugging code
 *
 * Revision 1.16  2007/06/25 06:02:18  amodigli
 * removed some compilation warnings
 *
 * Revision 1.15  2007/06/22 14:51:10  jmlarsen
 * Expanded, again, interface of uves_save_image()
 *
 * Revision 1.14  2007/06/22 09:46:13  jmlarsen
 * Changed interface of uves_save_image
 *
 * Revision 1.13  2007/06/18 09:17:55  jmlarsen
 * Parametrize poly. degree
 *
 * Revision 1.12  2007/06/06 07:22:02  jmlarsen
 * Fixed mixed code and declarations
 *
 * Revision 1.11  2007/06/04 11:27:38  jmlarsen
 * Commented out unused variables
 *
 * Revision 1.10  2007/05/31 11:37:37  jmlarsen
 * Compute properly REFSTART, REFSTEP, REFNPIX
 *
 * Revision 1.9  2007/05/14 13:26:01  jmlarsen
 * Moved flames_crate_ordertable to lower level function
 *
 * Revision 1.8  2007/05/11 09:41:51  jmlarsen
 * Don't use TBLCONTR descriptor
 *
 * Revision 1.7  2007/05/10 14:04:16  jmlarsen
 * Save properly table null values
 *
 * Revision 1.6  2007/04/24 12:49:34  jmlarsen
 * Replaced cpl_propertylist -> uves_propertylist which is much faster
 *
 * Revision 1.5  2007/04/20 14:53:45  jmlarsen
 * Converted code
 *
 * Revision 1.4  2007/04/20 07:01:32  jmlarsen
 * Converted more code
 *
 * Revision 1.3  2007/04/10 07:32:33  jmlarsen
 * Converted more MIDAS code
 *
 * Revision 1.2  2007/03/23 13:44:37  jmlarsen
 * Implemented SCKWR- functions
 *
 * Revision 1.1  2007/03/23 08:04:55  jmlarsen
 * Work on conversion
 *
 * Revision 1.14  2007/02/23 13:55:55  jmlarsen
 * Document to user that recipes are incomplete
 *
 */
#ifdef HAVE_CONFIG_H
#  include <config.h>
#endif

/*----------------------------------------------------------------------------*/
/**
 * @defgroup flames_ordpos   FLAMES order definition
 */
/*----------------------------------------------------------------------------*/

/*-----------------------------------------------------------------------------
                                Includes
 -----------------------------------------------------------------------------*/

#include <flames_preordpos.h>

#include <flames_ordpos.h>
#include <flames_multimatch.h>
#include <flames_matchorders.h>
#include <flames_create_ordertable.h>
#include <flames_tracing.h>
#include <flames_fitting.h>
#include <flames_dfs.h>
#include <flames_def_drs_par.h>
#include <flames_utils.h>

#include <uves_dfs.h>
#include <uves_orderpos_hough.h>
#include <uves_utils_cpl.h>
#include <uves_utils_wrappers.h>
#include <uves_dump.h>
#include <uves_error.h>
#include <uves_msg.h>
#include <string.h>
#include <cpl.h>
#include <stdbool.h>
/*-----------------------------------------------------------------------------
                            Functions prototypes
 -----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
/**
  @brief    computes the relative shift along the y-axis of the
            format check frame against the FF fibre frames.  
  @param    ord_gue_tab    guess
  @param    out_filename   out table
  @param    b_parOdd       fibre odd
  @param    b_parEven      fibre even
  @param    b_parOrdTra
  @param    NBTRACES       number of traces to find
  @param    DRS_P8_OFPOS   
  @param    chipchoice     CCD chip
  @param    DEFPOL          Degree of bivariate polynomial

  
  Input: odd/even fibres FF frames: we use it/them in order to compute the mutual
  between FrmtChk and FF (and science too) exposures 
**/
/*----------------------------------------------------------------------------*/
void
flames_ordpos(const cpl_frame *ord_gue_tab, 
              const char *out_filename,
              const cpl_frameset *FFCAT,
              int NBTRACES,
              double DRS_P8_OFPOS[5],
              char chipchoice,
              int wlen,
              int DEFPOL[2])
{
    uves_propertylist *ltab_header = NULL;
    cpl_image *ORDREF_image = NULL;
    cpl_table *ordertable = NULL;
    cpl_table *ltab = NULL;
    cpl_table *middummr = NULL;
    uves_propertylist *middummr_header = NULL;
    cpl_image *htrans = NULL;
    cpl_image *htrans_orig = NULL;
    double *refstart = NULL;
    double *refstep = NULL;
    int *refnpix = NULL;

    /* Per frame fibre mask */
    uves_propertylist *ORDREF_header = NULL;
    int fib_msk_length;
    cpl_type fib_msk_type;
    const int *fib_msk = NULL;

    const char *fibremask_string = NULL;
    int hot_thres = 100000;
    int step = 10;
    int WIDTHI = 0;     /* Half-width, automatic if 0 */
    const char *P4 = "DENSE"; /* Step, nb of traces or ALL,CENTER,DENSE,NO,FOLLOW */
    //int THRESI;              /* Low Threshold or keyword names (integer + real) */

//define/local GTAB/c/1/80 "order.tbl"
//define/local OTAB/c/1/80 "outtab.tbl" +lower_levels
//define/local FFCAT/c/1/80 "flat.cat"
    const char *GTAB;
    const char *OTAB;
    cpl_frameset *CATNAME = NULL;
    
//define/local MAXEXTEND/I/1/1 3
//define/local in_a/c/1/80 middummi.bdf +lower_levels
//define/local in_b/c/1/80 middummr.tbl +lower_levels
//define/local LTAB/C/1/80 middummd.tbl
    int MAXEXTEND = 3;
    const char *in_a = "middummi.fits";
    const char *in_b = "middummr.fits";
    const char *LTAB = "middummd.fits";

//define/local k/i/1/1 0
//define/local ngueord/i/1/1 0
    //int k = 0;
    int ngueord = 0;
    const char *ORDTAB = "ordtab.fits";
    const char *BAKTAB = "baktab.fits";

//k = m$parse(p1,"par")
//else if k .eq. 3 then
//  GTAB = "{par01}"
//  OTAB = "{par02}"
//  FFCAT = "{par03}"
//  MAXEXTEND = {MAXEXTEND}
    GTAB = cpl_frame_get_filename(ord_gue_tab);
    OTAB = out_filename;

//define/local CATNAME/C/1/80 {FFCAT}
    CATNAME = cpl_frameset_duplicate(FFCAT);

//define/local   pid/c/1/80 ordpos
//define/local   NBHW/I/1/2   {P2},{P3}
//define/local   VALI/I/1/2   {P7}
//define/local   FLAG/C/1/3   HMN 
//define/local   THRES/R/1/1  0
//define/local   P4INT/C/1/20 {P4}
//define/local   FILTER/C/1/1 Y        ! Flag for filtering (Yes/No)
//define/local   STNB/I/1/2   0,50    ! Number of columns processed
//define/local   TAB_IO_YSHIFT/D/1/1 0
    //const char *pid = "ordpos";
    {
        int NBHW[2];
        int VALI[2];
        const char *P4INT = P4;
        int STNB[] = {0, 50};
        double TAB_IO_YSHIFT = 0;
        NBHW[0] = NBTRACES;
        NBHW[1] = WIDTHI;
        VALI[0] = hot_thres;
        VALI[1] = step;
        //const char *FLAG = "HMN";
        //double THRES = 0;
        //bool FILTER = true;

//!
//! Global keywords
//!
//mess/out {DRS_MES_LEV} {pid} "Entering preordpos module: exact value for y coordinate is computed"
        uves_msg("Entering preordpos module: exact value for y coordinate is computed");
//run PIPE_EXE:preordpos.exe
        check( flames_preordpos(GTAB,
                                &MAXFIBRES,
                                CATNAME,
                                &MAXEXTEND,
                                LTAB,
                                &TAB_IO_YSHIFT),
               "preordpos failed");
        
//mess/out {DRS_MES_LEV} {pid} "Leaving preordpos module: "
//mess/out {DRS_MES_LEV} {pid} "Check {LTAB} table for computed y values"
//mess/out {DRS_MES_LEV} {pid} "Table {GTAB} contains the first guess "
//mess/out {DRS_MES_LEV} {pid} " for orders/x/y values"
        uves_msg("Leaving preordpos module:");
        uves_msg("Check %s table for computed y values", LTAB);
        uves_msg("Table %s contains the first guess", GTAB);
        uves_msg(" for orders/x/y values");
        
//define/local REFSTART/D/1/2 0,0
//copy/dkey {LTAB} REFSTART/D/1/2 REFSTART
//define/local REFSTEP/D/1/2 0,0
//copy/dkey {LTAB} REFSTEP/D/1/2 REFSTEP
//define/local REFNPIX/I/1/2 0,0
//copy/dkey {LTAB} REFNPIX/I/1/2 REFNPIX
//define/local CHIPCHOICE/C/1/1 "n"
//copy/dkey {LTAB} CHIPCHOICE/C/1/1 CHIPCHOICE
//define/local XCENTER/D/1/3
        {
            double REFSTART[2] = {0, 0};
            double REFSTEP[2] = {0, 0};
            int REFNPIX[2] = {0, 0};
            char CHIPCHOICE = chipchoice;
            double XCENTER[3];
            int length;
            cpl_type refstart_type;
            cpl_type refstep_type;
            cpl_type refnpix_type;
            
            check( ltab_header = uves_propertylist_load(LTAB, 0),
                   "Failed to load %s FITS header", LTAB);

            /* REFSTART */
            check( refstart = uves_read_midas_array(
                       ltab_header, "REFSTART", 
                       &length,
                       &refstart_type, NULL),
                   "Error reading REFSTART from %s", LTAB);
            
            assure( refstart_type == CPL_TYPE_DOUBLE,
                    CPL_ERROR_TYPE_MISMATCH,
                    "Type of REFSTART is %s, double expected",
                    uves_tostring_cpl_type(refstart_type));
            
            REFSTART[0] = refstart[0];
            REFSTART[1] = refstart[1];

            /* REFSTEP */
            check( refstep = uves_read_midas_array(
                       ltab_header, "REFSTEP", 
                       &length,
                       &refstep_type, NULL),
                   "Error reading REFSTEP from %s", LTAB);
            
            assure( refstep_type == CPL_TYPE_DOUBLE,
                    CPL_ERROR_TYPE_MISMATCH,
                    "Type of REFSTEP is %s, double expected",
                    uves_tostring_cpl_type(refstep_type));
            
            REFSTEP[0] = refstep[0];
            REFSTEP[1] = refstep[1];

            /* REFNPIX */
            check( refnpix = uves_read_midas_array(
                       ltab_header, "REFNPIX", 
                       &length,
                       &refnpix_type, NULL),
                   "Error reading REFNPIX from %s", LTAB);
            
            assure( refnpix_type == CPL_TYPE_INT,
                    CPL_ERROR_TYPE_MISMATCH,
                    "Type of REFNPIX is %s, double expected",
                    uves_tostring_cpl_type(refnpix_type));
            
            REFNPIX[0] = refnpix[0];
            REFNPIX[1] = refnpix[1];
            
            
            /* Save the new header */
//    check( ltab = cpl_table_load(LTAB, 1, 1), "Error loading %s", LTAB);
//    check( uves_table_save(ltab, ltab_header, NULL, LTAB, CPL_IO_DEFAULT),
//           "Error saving %s", LTAB); 
        
//        XCENTER(1) = REFSTART(1)+((REFNPIX(1)-1)*(REFSTEP(1)*.4))
//        XCENTER(2) = REFSTART(1)+((REFNPIX(1)-1)*(REFSTEP(1)*.5))
//        XCENTER(3) = REFSTART(1)+((REFNPIX(1)-1)*(REFSTEP(1)*.6))
            XCENTER[0] = REFSTART[0] + ((REFNPIX[0]-1)*(REFSTEP[0]*.4));
            XCENTER[1] = REFSTART[0] + ((REFNPIX[0]-1)*(REFSTEP[0]*.5));
            XCENTER[2] = REFSTART[0] + ((REFNPIX[0]-1)*(REFSTEP[0]*.6));
            
//if m$exist(GTAB)  .eq. 0 then
//mess/out {DRS_MES_LEV} {pid} "No guess table {GTAB} has been found!"
//mess/out {DRS_MES_LEV} {pid} "Please provide a valid file name or accept default"
//return
//else
// mess/out {DRS_MES_LEV} {pid} "Guess table {GTAB} will be used"
//endif

//if m$exist(FFCAT) .eq. 0 then
//mess/out {DRS_MES_LEV} {pid} " No catalog {FFCAT} has been found!"
//mess/out {DRS_MES_LEV} {pid} "  Please provide a valid catalog file name"
//else
// mess/out {DRS_MES_LEV} {pid} "FF catalog {FFCAT} will be used"
//endif

            uves_msg("Guess table %s will be used", GTAB);

//IF NBTRACES .LT. 0   NBHW(1) = M$ABS(NBTRACES)
            if (NBTRACES < 0) NBHW[0] = fabs(NBTRACES);

//define/local ALLFRAME/C/1/320  {FFCAT}
            char ALLFRAME[320];    // initial value is not used
    
//define/local LENGTH/I/1/9 0,0,0,0,0,0,0,0,0
            int LENGTH[9] = {0, 0, 0, 0, 0, 0, 0, 0, 0};

//define/local fibrepos/I/1/1 0
            //int fibrepos = 0;

//run PIPE_EXE:multimatch.exe
            check( flames_multimatch(CATNAME,
                                     ALLFRAME,
                                     LENGTH),
                   "multimatch failed");

//define/local NUMBER/I/1/1 0
//define/local limit/I/1/1 {LENGTH(1)}
//define/local seq/I/1/1 0
//define/local UPPER/I/1/1 {LENGTH(2)}
//define/local lower/I/1/1 1
//define/local fibreson/I/1/1 0
//define/local frame/C/1/60
//define/local maxtraces/I/1/1 0
            int NUMBER = 0;
            int limit = LENGTH[0];
            int seq = 0;
            int UPPER = LENGTH[1];
            int lower = 1;
            int fibreson = 0;
            char frame[60];
            int maxtraces = 0;

//!AM: to fix a problem
//define/local index/i/1/1 0
            int index = 0;

//compute/keyword maxtraces = limit*MAXFIBRES
            maxtraces = limit * MAXFIBRES;

//define/local FIBRENUMBERS/I/1/{maxtraces}
//write/keyword FIBRENUMBERS 0 ALL
//define/local FIBRESHIFTS/D/1/{maxtraces}
//write/keyword FIBRESHIFTS 0 ALL
            int *FIBRENUMBERS = cpl_calloc(sizeof(int), maxtraces);
            double *FIBRESHIFTS = cpl_calloc(sizeof(double), maxtraces);

//compute/keyword limit = limit +2
            limit = limit + 2;

//mess/out {DRS_MES_LEV} {pid} "Looping over catalogue FF frames ......"
            uves_msg("Looping over catalogue FF frames...");
//do seq = 3 limit
            for (seq = 3; seq <= limit; seq++) {

//  write/keyword frame/C/1/60 {ALLFRAME({lower}:{upper})} 
//  mess/out {DRS_MES_LEV} {pid} "{ALLFRAME({lower}:{upper})}"
//  mess/out {DRS_MES_LEV} {pid} "{frame}"  
                int j = 0;
                const char *ORDREF;
                int SCAN[2];
                for (j = lower; j <= UPPER; j++)
                    {
                        frame[j-lower] = ALLFRAME[j-1];
                    }
                frame[j-lower] = '\0';
                uves_msg("%s", frame);

//  compute/keyword lower = upper +1
//  compute/keyword upper =  upper + LENGTH({seq}) 
//        lower = upper + 1;
//        upper = upper + LENGTH[seq-1];
                lower = UPPER + 1;
                UPPER = UPPER + LENGTH[seq-1];

//  WRITE/KEYW  ORDREF/C/1/60  {frame}
                ORDREF = frame;
        
//  VERIFY/ECHELLE  {ORDREF} {SESSOUTV}
//  DISPLAY/ECHELLE {ORDREF} {SESSOUTV}

//  IF P4INT(1:1) .EQ. "-" THEN
//     FILTER = "N"
//     WRITE/KEYW P4INT/C/1/20 {P4INT(2:20)}
//  ENDIF
                passure( strcmp(P4, "DENSE") == 0, "%s", P4);

//  IF P4INT(1:1) .EQ. "+" THEN
//     COPY/II {P4INT(2:)} &h
//     COPY/DD {P4INT(2:)} *,3 &h
//     WRITE/KEYW P4INT/C/1/2  "NO"
//  ENDIF
//
//  WRITE/OUT  "****    Order Definition    ****"
                uves_msg("****    Order Definition    ****");

//  IF OUTMODE(1:1) .NE. "S" THEN
//    IF P4INT(1:1) .EQ. "F"   THEN
//       mess/out {DRS_MES_LEV} {pid} "No detection. Order detection read from middummr.tbl."
//       mess/out {DRS_MES_LEV} {pid} "Orders  are followed on the filtered frame middummi.bdf"
//       GOTO FOLLOW
//    ELSE
//       mess/out {DRS_MES_LEV}  {pid} "Order reference fibre FF frame: ORDREF={ORDREF}"
//       mess/out {DRS_MES_LEV}  {pid} "Preprocessed frame:    middummi.bdf"
//       mess/out {DRS_MES_LEV}  {pid} "Hough transform:       midddumh.bdf"
//       mess/out {DRS_MES_LEV}  {pid} "Orders detection:      middummr.tbl"
//       mess/out {DRS_MES_LEV}  {pid} "Output tables:         ORDTAB={ORDTAB} and BAKTAB={BAKTAB}"
//    ENDIF
//  ENDIF
                uves_msg("Order reference fibre FF frame: ORDREF=%s", ORDREF);
                uves_msg("Preprocessed frame:    middummi.fits");
                uves_msg("Hough transform:       middummh.fits");
                uves_msg("Orders detection:      middummr.fits");
                uves_msg("Output tables:         ORDTAB=%s and BAKTAB=%s", ORDTAB, BAKTAB);

//  IF NBHW(2) .NE. 0     WRITE/KEYW  FLAG/C/1/3  HLN
//        if (NBHW[1] != 0) flag = "HLN";

//  IF P4INT(1:1) .EQ. "N"   THEN
//    WRITE/KEYW  FLAG/C/1/1  N
//  ELSE

//    IF FILTER(1:1) .EQ. "Y"   THEN
                /* true */
//      mess/out {DRS_MES_LEV} {pid} " Preprocessing {ORDREF}: median filter started...."
                uves_msg("Preprocessing %s: median filter started...", ORDREF);

//      FILTER/MEDIAN  {ORDREF} &i  2,1 {SESSOUTV}
        
                {
                    bool extrapolate_border = true;

                    check( ORDREF_image = cpl_image_load(ORDREF, CPL_TYPE_DOUBLE, 0, 0),
                           "Error loading %s", ORDREF);

                    check( uves_filter_image_median(&ORDREF_image, 2, 1, extrapolate_border),
                           "Median filtering failed");
                }

//      mess/out {DRS_MES_LEV} {pid} " Preprocessing {ORDREF}: median filter applied...."
//      mess/out {DRS_MES_LEV} {pid} " Output is frame middummi.bdf "
                uves_msg("Preprocessing %s: median filter applied...", ORDREF);
                uves_msg("Output is frame middummi.fits");

                check( uves_save_image(ORDREF_image, "middummi.fits", NULL, true, true),
                       "Error saving image to middummi.fits");

//    ELSE
//      COPY/II {ORDREF} &i
//    ENDIF
//  ENDIF

//  IF P4INT(1:1) .EQ. "D" THEN           ! Option DENSE
                /* true */
//    STNB(1) = {{frame},NPIX(1)}/STNB(2)    ! Distance between columns
                STNB[0] = cpl_image_get_size_x(ORDREF_image)/STNB[1];
//    WRITE/KEYW P4INT/C/1/20  {STNB(1)},{STNB(2)}
                P4INT = uves_sprintf("%d, %d", STNB[0], STNB[1]);
//  ENDIF

//  IF P4INT(1:1) .EQ. "C" THEN             ! Option CENTER
//    STNB(1) = {{frame},NPIX(1)}/STNB(2)/4    ! Distance between columns
//    WRITE/KEYW P4INT/C/1/20  {STNB(1)},{STNB(2)}
//  ENDIF
//!
//  mess/out {DRS_MES_LEV} {pid} " HOUGH/ECHELLE running.. "
                uves_msg("Hough transform running...");

//!AM: MODIFIED TO SEARCH EXACT NUMBER OF ORDERS
//copy/dk &i FIBREMASK fib_msk

                check( ORDREF_header = uves_propertylist_load(ORDREF, 0),
                       "Error loading %s header", ORDREF);

                check( fib_msk = uves_read_midas_array(
                           ORDREF_header, "FIBREMASK", 
                           &fib_msk_length,
                           &fib_msk_type, NULL),
                       "Error reading FIBREMASK");
        
                assure( fib_msk_type == CPL_TYPE_INT, CPL_ERROR_TYPE_MISMATCH,
                        "Type of FIBREMASK is %s, int expected",
                        uves_tostring_cpl_type(fib_msk_type));
      
//DRS_NLIT_FIBRES = 0
                DRS_NLIT_FIBRES = 0;
//do index = 1 MAXFIBRES
//   DRS_NLIT_FIBRES = DRS_NLIT_FIBRES + {fib_msk({index})}
//enddo
                //uves_msg("Before Fibres = %d", DRS_NLIT_FIBRES);
                for (index = 1; index <= fib_msk_length; index++) 
                    {
                        DRS_NLIT_FIBRES += fib_msk[index-1];
                    }
                //uves_msg("Fibres = %d", DRS_NLIT_FIBRES);
                //exit(0);
//statistic/table {ORDTAB} :ORDER {SESSOUTV}
//ngueord = outputr(2)-outputr(1)+1
                check( ordertable = cpl_table_load(GTAB, 1, 1),
                       "Error loading table %s", GTAB);

                ngueord = 
                    cpl_table_get_column_max(ordertable, "ORDER") -
                    cpl_table_get_column_min(ordertable, "ORDER") + 1;
		uves_free_table(&ordertable);

//if {NBTRACES} .gt. 0 then
//   NBHW(1) = ({ngueord})*{DRS_NLIT_FIBRES} +{DRS_NLIT_FIBRES}/2
//endif
                if (NBTRACES > 0)
                    NBHW[0] = ngueord*DRS_NLIT_FIBRES + DRS_NLIT_FIBRES/2;

//mess/out {DRS_MES_LEV} {pid} "ntraces={NBHW(1)} nord={ngueord} echord={ECHORD} nfib={DRS_NLIT_FIBRES}"
                uves_msg("ntraces=%d, nord=%d, echord=%d nfib=%d",
                         NBHW[0], ngueord, ngueord, DRS_NLIT_FIBRES);

//WLEN = {&i,{h_cwlen({PATHID})}}
//if WLEN .eq. 520. then
//  SCAN(1) = {DRS_SCAN_MIN(1)}
//  SCAN(2) = {DRS_SCAN_MAX(1)}
//else if WLEN .eq. 580. then
//  SCAN(1) = {DRS_SCAN_MIN(2)}
//  SCAN(2) = {DRS_SCAN_MAX(2)}
//else if WLEN .eq. 860. then
//  SCAN(1) = {DRS_SCAN_MIN(3)}
//  SCAN(2) = {DRS_SCAN_MAX(3)}
//else
//  SCAN(1) = 1
//  SCAN(2) = 2048
//endif
                switch(wlen) {
                case 520: 
                    SCAN[0] = DRS_SCAN_MIN_1;
                    SCAN[1] = DRS_SCAN_MAX_1;
                    break;
                case 580: 
                    SCAN[0] = DRS_SCAN_MIN_2;
                    SCAN[1] = DRS_SCAN_MAX_2;
                    break;
                case 860: 
                    SCAN[0] = DRS_SCAN_MIN_3;
                    SCAN[1] = DRS_SCAN_MAX_3;
                    break;
                default:
                    SCAN[0] = 0;
                    SCAN[1] = 2048;
                    break;
                }

//!w/o "CCDSCAN1={SCAN(1)}, CCDSCAN2={SCAN(2)}"
                uves_msg("CCDSCAN1 = %d, CCDSCAN2 = %d", SCAN[0], SCAN[1]);

//  hough/echelle &i  {SCAN(1)},{SCAN(2)} {P4INT} {NBHW(1)} {FLAG(1:3)} {NBHW(2)} 3,0.5,{VALI(1)},1  {P8} {SESSOUTV}
                bool norders_is_guess = true;
                double PTHRES = 0.2;
                double minslope = 0;
                double maxslope = DRS_P8_OFPOS[2];
                double slopestep = DRS_P8_OFPOS[3];
                slopestep = 0.0005;
                int sloperes = (maxslope-minslope)/slopestep + 1;

                check( middummr = uves_hough(ORDREF_image, SCAN[0], SCAN[1],
                                             //NBHW[0], 
                                             DRS_NLIT_FIBRES * ngueord,
                                             norders_is_guess,
                                             STNB[0], PTHRES, 
                                             minslope, maxslope, sloperes,
                                             false,  /* Consecutive order lines? */
                                             &htrans, &htrans_orig),
                       "Hough transform failed");

                cpl_table_cast_column (middummr, "Slope", "SLOPE", CPL_TYPE_FLOAT);
                cpl_table_erase_column(middummr, "Slope");
                cpl_table_cast_column (middummr, "Intersept", "ORIG", CPL_TYPE_FLOAT);
                cpl_table_erase_column(middummr, "Intersept");


                check( uves_save_image(htrans_orig, "middummh.fits", NULL, true, true),
                       "Error saving middummh.fits");

//  mess/out {DRS_MES_LEV} {pid} " HOUGH/ECHELLE completed... "
                uves_msg("Hough transform completed");

//  mess/out {DRS_MES_LEV} {pid} " Output from HOUGH/ECHELLE is middummr table. "
                uves_msg("Output from Hough transform is middummr table");

//  copy/dd &i FIBREMASK middummr.tbl
                middummr_header = uves_propertylist_new();

                {
                    fibremask_string = uves_sprintf("%d %d %d %d %d %d %d %d %d",
                                                    fib_msk[0],
                                                    fib_msk[1],
                                                    fib_msk[2],
                                                    fib_msk[3],
                                                    fib_msk[4],
                                                    fib_msk[5],
                                                    fib_msk[6],
                                                    fib_msk[7],
                                                    fib_msk[8]);

                    check( flames_dfs_set_history_val(middummr_header, 'I',
                                                      "FIBREMASK", fibremask_string),
                           "Could not write FIBREMASK to middummr table");
                }
        
//  mess/out {DRS_MES_LEV} {pid} " Creating columns :YCENTER, :NEWORD and :FIBRE ..... "
                uves_msg("Creating columns YCENTER, NEWORD and FIBRE ...");

//  create/column middummr.tbl :YQUART1 " " F8.2
//  create/column middummr.tbl :YCENTER " " F8.2
//  create/column middummr.tbl :YQUART3 " " F8.2
//  create/column middummr.tbl :NEWORD " " I11
//  create/column middummr.tbl :FIBRE " " I11

//! WARNING: the dimension of the chip must be read each time. Freezing temporary....
//  compute/table middummr.tbl :YQUART1 = :SLOPE * {XCENTER(1)} + :ORIG
//  compute/table middummr.tbl :YCENTER = :SLOPE * {XCENTER(2)} + :ORIG
//  compute/table middummr.tbl :YQUART3 = :SLOPE * {XCENTER(3)} + :ORIG

                cpl_table_new_column(middummr, "NEWORD", CPL_TYPE_INT);
                cpl_table_new_column(middummr, "FIBRE", CPL_TYPE_INT);
                cpl_table_fill_invalid_int(middummr, "NEWORD", -1);
                cpl_table_fill_invalid_int(middummr, "FIBRE", -1);

                cpl_table_cast_column(middummr, "SLOPE", "YQUART1", CPL_TYPE_DOUBLE);
                cpl_table_cast_column(middummr, "SLOPE", "YCENTER", CPL_TYPE_DOUBLE);
                cpl_table_cast_column(middummr, "SLOPE", "YQUART3", CPL_TYPE_DOUBLE);
                cpl_table_multiply_scalar(middummr, "YQUART1", XCENTER[0]);
                cpl_table_multiply_scalar(middummr, "YCENTER", XCENTER[1]);
                cpl_table_multiply_scalar(middummr, "YQUART3", XCENTER[2]);
                cpl_table_add_columns(middummr, "YQUART1", "ORIG");
                cpl_table_add_columns(middummr, "YCENTER", "ORIG");
                cpl_table_add_columns(middummr, "YQUART3", "ORIG");

                check( uves_table_save(middummr, middummr_header, NULL, "middummr.fits", CPL_IO_DEFAULT),
                       "Error saving middummr table");

//  mess/out {DRS_MES_LEV} {pid} " matchorders module is now running: " 
                uves_msg("matchorders module is now running:");
//  RUN PIPE_EXE:matchorders.exe

                check( flames_matchorders(&MATCHTHRES,
                                          &limit,
                                          &TAB_IO_YSHIFT,
                                          FIBRENUMBERS,
                                          FIBRESHIFTS,
                                          LTAB,
                                          &NUMBER,
                                          &DYRANGE,
                                          &DYSTEP,
                                          &fibreson),
                       "matchorders failed");

//  if NICE_CREA .eq. "Y" then
//     !AM: the following command on PC gives a warning:
//     !sh: lpr: command not found
//     PLOT/TABL middummf.tbl ? :DELTA ? 0 1
//  endif
//  SET/MIDAS OUTPUT=YES

//  compute/keyword number = number + fibreson;
                NUMBER = NUMBER + fibreson;
//  mess/out {DRS_MES_LEV} {pid} "Number value is" {number}
//  mess/out {DRS_MES_LEV} {pid} "We left matchorders module. "
//  mess/out {DRS_MES_LEV} {pid} "middummr :NEWORD and :FIBRE columns filled"
                uves_msg("Number value is %d", NUMBER);
                uves_msg("We left matchorders module");
                uves_msg("middummr NEWORD and FIBRE columns filled");
//!
//! Start tracing of the fibres / orders
//!
//COMPUTE/TABLE middummr :THRES = 0.0

                uves_free_table(&middummr);
                uves_free_propertylist(&middummr_header);
                check( middummr = cpl_table_load("middummr.fits", 1, 1),
                       "Could not load table middummr.fits");

                check( middummr_header = uves_propertylist_load("middummr.fits", 0),
                       "Could not load table middummr.fits header");
                cpl_table_new_column(middummr, "THRES", CPL_TYPE_FLOAT);
                cpl_table_fill_column_window_float(middummr, "THRES", 
                                                   0, cpl_table_get_nrow(middummr), 
                                                   0);

                uves_table_save(middummr, middummr_header, NULL, "middummr.fits", CPL_IO_DEFAULT);
		uves_free_table(&middummr);


//! WRITE/KEYW   IN_A/C/1/30  {in_a}
//! WRITE/KEYW   IN_B/C/1/30  {in_b}
//! WRITE/KEYW   OUT_A/C/1/30 {out_a}
//!
//  WRITE/KEYW   INPUTI/I/1/1  {VALI(2)}
//  WRITE/KEYW   INPUTI/I/2/2  {SCAN(1)},{SCAN(2)}  
                int INPUTI[3];
                INPUTI[0] = VALI[1];
                INPUTI[1] = SCAN[0];
                INPUTI[2] = SCAN[1];
//  mess/out {DRS_MES_LEV} {pid}  {SCAN(1)},{SCAN(2)}
                uves_msg("CCDSCAN1 = %d, CCDSCAN2 = %d", SCAN[0], SCAN[1]);
//  WRITE/KEYW   INPUTR/R/1/1  {VALI(1)}
                float INPUTR[1];
                INPUTR[0] = VALI[0];
        
//  select/table middummr :NEWORD .ne. NULL {SESSOUTV}
                check_nomsg( flames_select_non_null("middummr.fits", "NEWORD"));

//mess/out {DRS_MES_LEV} {pid} "Creating table {OTAB}...."
                uves_msg("Creating table %s...", OTAB);

//run PIPE_EXE:create_ordertable.exe
//        check( flames_create_ordertable(OTAB,
//                                        &MAXROWS,
//                                        &MAXCOLS),
//               "Could not create ordertable");

//  mess/out {DRS_MES_LEV} {pid} "Entering flames_tracing....."
                uves_msg("Entering flames_tracing...");

//  RUN PIPE_EXE:flames_tracing.exe
 
                check( flames_tracing(in_a,
                                      in_b,
                                      OTAB,
                                      INPUTI,
                                      INPUTR,
                                      &MAXORDER),
                       "Order tracing failed");
               
//   select/table {OTAB} :Y .NE. NULL {SESSOUTV}
//   !clear/over
//if NICE_CREA .eq. "Y" then
//   mess/out {DRS_MES_LEV} {pid} "Plotting traced orders/fibres..."
//   load/table {OTAB} :X :Y :ORDERFIB 0 0 4
//endif
//   select/table {OTAB} ALL {SESSOUTV}

                /* skip plotting */

//  mess/out {DRS_MES_LEV} {pid} "Leaving flames_tracing....."
                uves_msg("Leaving flames_tracing...");


//  if {seq} .eq. 3 then
//!  if m$exist("first.tbl") .eq. 0 then
//    rename/table middummr third
//    rename/table {OTAB} first
//  else
//    merge/table third middummr fourth
//    rename/table fourth third
//    merge/table first {OTAB} second
//    rename/table second first
//  endif

                if (seq == 3)
                    {
                        check_nomsg( flames_rename_table("middummr.fits", "third.fits"));
                        check_nomsg( flames_rename_table(OTAB, "first.fits"));
                    }
                else
                    {
                        check_nomsg( flames_merge_table("third.fits", "middummr.fits"));
                      /* TO BE FIXED: 
                         OTAB get empty string units from seq=4 on. 
                         As cpl_table_insert (called by flames_merge_table) 
                         makes a check we need to remve those units 
                       */
                        check_nomsg(uves_tablename_remove_units(OTAB));
                        check_nomsg( flames_merge_table("first.fits", OTAB));
                    }
            uves_free_string_const(&P4INT);

//enddo
            } /* for seq */

//rename/table first {OTAB}
//rename/table third middummr
            check_nomsg( flames_rename_table("first.fits", OTAB));
            check_nomsg( flames_rename_table("third.fits", "middummr.fits"));


//sort/table {OTAB} :ORDER,:FIBRE,:X
            check_nomsg( flames_sort_table(OTAB, "ORDER", "FIBRE", "X"));
    
//select/table {OTAB} :Y .NE. NULL {SESSOUTV}
            check_nomsg( flames_select_non_null(OTAB, "Y"));
    

//if NICE_CREA .eq. "Y" then
//   clear/over
//   load/table {OTAB} :X :Y :ORDERFIB 0 0 4
//endif


//mess/out {DRS_MES_LEV} {pid} "Entering flames_fitting......"
            uves_msg("Entering flames_fitting...");

//RUN PIPE_EXE:flames_fitting.exe
            check( flames_fitting(&HALFIBREWIDTH,
                                  &MAXFIBRES,
                                  &limit,
                                  &NUMBER,
                                  FIBRENUMBERS,
                                  FIBRESHIFTS,
                                  OTAB,
                                  DEFPOL,
                                  in_b,
                                  REFSTART,
                                  REFSTEP,
                                  REFNPIX,
                                  &CHIPCHOICE),
                   "flames_fitting failed");
    
//mess/out {DRS_MES_LEV} {pid} "Leaving flames_fitting."
            uves_msg("Leaving flames_fitting");
//!COPY/KD REFSTART {OTAB}
//!COPY/KD REFSTEP {OTAB}
//!COPY/KD REFNPIX {OTAB}

//if NICE_CREA .eq. "Y" then
//   mess/out {DRS_MES_LEV} {pid} "Plotting fitted orders/fibres..."
//   clear/over
//   select/table {OTAB} ALL {SESSOUTV}
//   load/table {OTAB} :X :YFIT :ORDERFIB 0 0 4
//   mess/out {DRS_MES_LEV} {pid} "Check table {OTAB} for details"
//endif
//!
//!mess/out {DRS_MES_LEV} {pid} "...copying non-standard descriptors to {OTAB} "
//!copy/dd middummr.tbl coeffd,coeffi,fibremask,maxfibres,fibreson,orderlim,halfibrewidth {OTAB}
//!copy/dd middummr.tbl fibrepos,correctred {OTAB}
	    cpl_free(FIBRENUMBERS);
	    cpl_free(FIBRESHIFTS);
        } /* end scope */
    } /* end scope */

  cleanup:

    uves_free_frameset(&CATNAME);
    uves_free_propertylist(&ltab_header);
    uves_free_image(&ORDREF_image);
    uves_free_image(&htrans);
    uves_free_image(&htrans_orig);
    uves_free_propertylist(&ORDREF_header);
    uves_free_int_const(&fib_msk);
    uves_free_table(&ordertable);
    uves_free_table(&ltab);
    uves_free_table(&middummr);
    uves_free_double(&refstart);
    uves_free_double(&refstep);
    uves_free_int(&refnpix);

    uves_free_propertylist(&middummr_header);
    uves_free_string_const(&fibremask_string);
    return;
}

/**@}*/
