#!/opsw/hst/bin/perl -d
#!/usr/cadc/misc/bin/perl
#/*+
#*******************************************************************
#** S P A C E   T E L E S C O P E                                 **
#**  E U R O P E A N   C O O R D I N A T I N G   F A C I L I T Y  **
#*
#*   Script Name:	asn_maint.pl
#*
#*   Purpose:
#*	Maintenance of WFPC2 associations (type "B")
#*
#*   Date		: Feb 12, 2001
#*
#*   SCCS data		: %Z%
#*	Module Name	: %M%
#*	Version Number	: %I%
#*	Release Number	: %R%
#*	Last Updated	: %G%
#*
#*   Programmer		: A. Micol [ST-ECF], D. Durand [CADC]
#*
#*  Requirements: 
#*      PERL5LIB must contain the path to the libECF.pl library 
#*      The libECF.pl includes the db_connect, dosql and Sybase2DMF routines
#*
#*   Modification History:
#*
#**        S        T        --        E        C        F        **
#*******************************************************************
#-*/

require 'libECF.pl'; 
require "getopts.pl";

#
# Defining the LOCATION: CADC or ECF
#

$LOCATION = "ECF";

# $ASN_OUTPUT_DIR = "/export/diskf/amicol/Basn/sw/asn/";
$ASN_OUTPUT_DIR = "./";

$ASN_LOG_DIR = "/export/diskf/amicol/Basn/sw/log/";

#
# Nineth character for asn_ids
#
$ASN_LETTER = "B";

#
# On going proposals are those having new observations taken
# in the last PAST_N_DAYS days.
# Those programs won't be touched by this procedure.
#
$PAST_N_DAYS = 12;

$LOAD = "load";
$EXEC = "exec";

$SAFEDEBUG = 0;    # dosql_batch_trans are not executed (if > 1 they are shown )
$DEBUG = 0;
$CREATE_DESCR_FILE = 1;
$LOG = 1;
$TODAY = 0;
undef %ONGOING_PEP_IDS;
undef @PROGRAMS;


( $PEP_ID, $FILTER ) = &Init;

&ongoing_programs( $dbpmain );

if ( $MODE eq "MAINTENANCE" )
{
   &select_programs( $dbploop );
}
else
{
   &print_running_on;
   $CONSTRAINT = &build_constraint( $PEP_ID, $FILTER );
   &compute_associations( $CONSTRAINT );
}

#
#  --- END OF MAIN ---
#

sub select_programs
{
   my ( $dbp ) = @_;
   my ( $sql, %R );

   $sql = "select distinct sci_pep_id 
         from hstdads..science
         where sci_data_set_name like \"U%\"
         ";

   &dosql( $dbp, $sql );

   while( %R = $dbp->dbnextrow(1) )
   {
   
      if ( $ONGOING_PEP_IDS{ $R{'sci_pep_id'} } )
      {
         #
         # This proposal is still "on-going". Let's skip it.
         #
         next;
      }

      $CONSTRAINT = &build_constraint( $R{'sci_pep_id'} );
      &compute_associations( $CONSTRAINT );
   }
}

#
# ****************************STARTING THE REAL THING************************
# LEADER

sub compute_associations
{

   my ( $CONSTRAINT ) = @_;

my ( $JA, $JD, $A1, $D1, $COSDEC, $a1, $d1, $MAX_COORD_STD, $MAX_ROLL_STD );
my ( $asnname, $matches, $asnnameold, $FILTER, $FILTERold, $PP, $PPold );
my ( $asnnameold, $ds, $sqldads, $Aold, $Ass_ID, $sqlcmd );
my @dataset = ();
local %done = ();
local @ldrlist = ();
local @single  = ();

$PP = "";
$PPold = "start";
$Aold = "";
$Ass_ID = "";

# THE OLD DEFINITION OF A LEADER    *** NOT VALID ANY LONGER ***
#?   # --------------- DEFINING A NEW LEADER -------------------
#?   # At this stage, a dataset is defined to be the leader by a random choice.
#?   # The first one picked up (for the combination of PEP_ID and FILTER)
#?   # is, temporarily, the leader.
#?   # Later, see ClosePrevious comments, the leader is re-defined
#?   # to avoid cases where the leader is not processable.
#?   # In ClosePrevious the leader is the first dataset (in alphabetical order)
#?   # which has the member_flag = "P".
#?   # Previously, in time, I WRONGLY called leader the one having
#?   # the maximum number of neighbours.
# THE OLD DEFINITION OF A LEADER    *** NOT VALID ANY LONGER ***

# THE NEW DEFINITION OF A LEADER
# ---------------------------------------------------------------
#
# A leader of an association is the earliest deepest observation
# (min. start time, max. exposure time) in our science tables
# which is found to be closer than (ASN_RADIUS, MAX_DELTA_ROLL)
# to at least one other observation of the same PEP_ID taken with
# the same FILTER and APERTURE
#             
# ---------------------------------------------------------------
$sqlcmd = "select sci_pep_id, sci_data_set_name,
                sci_spec_1234 filter,
                sci_ra, sci_dec,
                sci_v3_pos_angle,
                sci_aper_1234,
                sci_pi_last_name,
                sci_targname,
                sci_actual_duration exptime,
                sci_start_time,
                sci_release_date
         from hstdads..science
         where sci_data_set_name like \"U%\"
         $CONSTRAINT
         order by sci_pep_id asc, sci_spec_1234,
                  sci_actual_duration desc,
                  sci_start_time asc
     ";
#                datediff(ss, \"1-1-1980\", sci_start_time) start_time_dmf,
#                datediff(ss, \"1-1-1980\", sci_release_date) release_date

if($DEBUG > 1) { print $sqlcmd,"\n"; }

&dosql($dbpmain, $sqlcmd);

$matches     = 0;
$count       = 0;
$tot_members = 0;
undef @ldrlist;
undef @ALBERTO;

print "CONSTRAINT: $CONSTRAINT ", "-"x30,"\n";

while  (%S = $dbpmain->dbnextrow(1))
{
   $matches = 1;
   $ds                        = $S{'sci_data_set_name'};
   $PP                        = $S{'sci_pep_id'};
   $FILTER                    = $S{'filter'};
   ${$ds}{'pep_id'}           = $PP;
   ${$ds}{'filter'}           = $FILTER;
   ${$ds}{'dataset_name'}     = $ds;
   ${$ds}{'ra_targ_int'}      = int($S{'sci_ra'}*3600000.0+0.5);
   ${$ds}{'dec_targ_int'}     = int($S{'sci_dec'}*3600000.0+0.5);
   ${$ds}{'v3_pos_angle'}     = int($S{'sci_v3_pos_angle'}*3600000.0+0.5);
   ${$ds}{'pi_last_name'}     = $S{'sci_pi_last_name'};
   ${$ds}{'targname'}         = $S{'sci_targname'};
   ${$ds}{'exptime'}          = $S{'exptime'};
   ${$ds}{'start_time_dmf'}   = int(&Sybase2DMF($S{'sci_start_time'}));
   ${$ds}{'release_date_dmf'} = int(&Sybase2DMF($S{'sci_release_date'}));

   if ( $ONGOING_PEP_IDS{ $PP } )
   {
      next;
   }
   
   if ( ${$ds}{'targname'} eq "INTFLAT" ||  
        ${$ds}{'targname'} eq "UVFLAT"  ||  
        ${$ds}{'targname'} eq "VISFLAT" ||  
        ${$ds}{'targname'} eq "BIAS"    ||  
        ${$ds}{'targname'} eq "DARK"     )
   {
      next;
   }

   #
   # ****************** LOOKING FOR OTHER REQUIRED PARAMETERS ***************
   #
   
   #
   # Getting the gain from hstdads..wfpc2_ref_data
   # Skipping this entry otherwise
   #
   $sqldads = "select w2r_atodgain from hstdads..wfpc2_ref_data
               where w2r_data_set_name=\"${$ds}{'dataset_name'}\" ";
   &dosql($dbpaux, $sqldads);
   $matches = 0;
   while  (%WFPC2_REF_DATA = $dbpaux->dbnextrow(1)) {
      $matches = 1;
      ${$ds}{'gain'} = $WFPC2_REF_DATA{'w2r_atodgain'};
   }
   if (! $matches) {
      print LOG "$ds: No entry in hstdads..wfpc2_ref_data for ";
      print LOG "ds ${$ds}{'dataset_name'}: skipping\n";
      next;
   }
   
   #
   # Getting the gen_date_str from dads_received where class=CAL
   # Skipping this entry otherwise
   #
   $sqldads = "select gen_date, gen_date_str from $DADS_RECEIVED
               where archive_class=\"CAL\"
               and dataset_name=\"${$ds}{'dataset_name'}\"
               and curr=\"Y\" and science in (\"Y\",\"A\",\"S\") ";
   &dosql($dbpaux, $sqldads);
   $matches = 0;
   while  (%DADSRECEIVED = $dbpaux->dbnextrow(1)) {
      $matches = 1;
      ${$ds}{'gen_date'} = $DADSRECEIVED{'gen_date'};
      ${$ds}{'gen_date_str'} = $DADSRECEIVED{'gen_date_str'};
   }
   if (! $matches) {
      print LOG "$ds: No entry (no science ?) in dads_received for ";
      print LOG "ds ${$ds}{'dataset_name'} class CAL: skipping\n";
      next;
   }
   
   #
   # getting the roll angle from the jitter table (if available)
   # hstmisc..jit_member
   #

   $sqldads = "select ra_jit,dec_jit,roll_jit,
               ra_sd, dec_sd, roll_sd,
               parallel, lockloss, tm_gap, tlmform,
               slewing, guideact, aperture
               from $JIT_MEMBER where dataset_name=\"".
               substr(${$ds}{'dataset_name'},0,8)."J\" ";
   &dosql($dbpaux, $sqldads);
   $matches = 0;
   while  (%JIT = $dbpaux->dbnextrow(1))
   {

      $matches = 1;

      ${$ds}{'ra_jit'} = $JIT{'ra_jit'};
      ${$ds}{'dec_jit'} = $JIT{'dec_jit'};
      ${$ds}{'roll_jit'} = $JIT{'roll_jit'};

      if ( ${$ds}{'ra_jit'} == 0 && ${$ds}{'dec_jit'} == 0 )
      {
         ${$ds}{'ra_jit'} = "INDEF";
         ${$ds}{'dec_jit'} = "INDEF";
      }
      ${$ds}{'ra_sd'}       = $JIT{'ra_sd'};
      ${$ds}{'dec_sd'}      = $JIT{'dec_sd'};
      ${$ds}{'roll_sd'}     = $JIT{'roll_sd'};
      ${$ds}{'parallel'}    = $JIT{'parallel'};
      ${$ds}{'lockloss'}    = $JIT{'lockloss'};
      ${$ds}{'tm_gap'}      = $JIT{'tm_gap'};
      ${$ds}{'tlmform'}     = $JIT{'tlmform'};
      ${$ds}{'slewing'}     = $JIT{'slewing'};
      ${$ds}{'guideact'}    = $JIT{'guideact'};
      ${$ds}{'japerture'}   = $JIT{'aperture'};

      ${$ds}{'member_flag'} = "P";

      $JA            = ${$ds}{'ra_jit'};
      $JD            = ${$ds}{'dec_jit'};
      $COSDEC        = cos($JD * $marcsec2rad);
      $MAX_COORD_STD =  5;
      $MAX_ROLL_STD  = 5000;

      if ( ${$ds}{'tlmform'} eq "FN" ||
           ${$ds}{'slewing'} eq "T"  ||
           ${$ds}{'japerture'}  eq ""  ||
           ${$ds}{'ra_sd'} * $COSDEC > 2*$ASN_RADIUS   ||  #milliarcsec
           ${$ds}{'dec_sd'} > 2*$ASN_RADIUS  ||  #milliarcsec
           ${$ds}{'roll_sd'} > 2*$MAX_DELTA_ROLL ||  #milliarcsec
           ($JA eq "" && $JD eq "" && ${$ds}{'roll_jit'} eq "") ||
           (!$JA  && !$JD && ! ${$ds}{'roll_jit'}) ||
           ($JA < 0.0 || $JD < -324000000. || ${$ds}{'roll_jit'} < 0.0)
         )
      {
         # This exposure is NOT GROUPABLE => It is BAD
         ${$ds}{'member_flag'} = "B";
         if ($JA eq "") { $JA = 0; }
         if ($JD eq "") { $JD = 0; }
         if (${$ds}{'roll_jit'} eq "") { ${$ds}{'roll_jit'} = 0; }
      }

      elsif ( ${$ds}{'guideact'} ne "FINELOCK"   ||
           ${$ds}{'ra_sd'} * $COSDEC > $MAX_COORD_STD ||
           ${$ds}{'dec_sd'} > $MAX_COORD_STD     || #milliarcsec
           ${$ds}{'roll_sd'} > $MAX_ROLL_STD     || #milliarcsec
           ${$ds}{'ra_sd'} eq ""                 ||
           ${$ds}{'dec_sd'} eq ""                ||
           ${$ds}{'roll_sd'} eq ""               ||
           ${$ds}{'lockloss'} > 0.
           )
      {
         # This exposure is GROUPABLE but NOT PROCESSABLE
         ${$ds}{'member_flag'} = "G";
      }
   }
   if (! $matches)
   {

      print LOG "$ds: No entry in jit_member for ";
      print LOG "ds ${$ds}{'dataset_name'}: using the science value\n";
      
      ${$ds}{'ra_jit'} = "INDEF";
      ${$ds}{'dec_jit'} = "INDEF";
      ${$ds}{'member_flag'} = "I";
   }
   #
   # getting the aperture name (and ra,dec only if needed)
   # from hstdads..shp_data
   #
   $sqldads = "select shp_aperobj,shp_ra_v1, shp_dec_v1
               from hstdads..shp_data
               where shp_data_set_name=\"${$ds}{'dataset_name'}\" ";
   &dosql($dbpaux, $sqldads);

   $matches = 0;
   while  (%SHP = $dbpaux->dbnextrow(1))
   {

      $matches = 1;

      ${$ds}{'aperture'} = $SHP{'shp_aperobj'};
      if ( ${$ds}{'ra_targ_int'} == 0 && ${$ds}{'dec_targ_int'} == 0 )
      {
         ${$ds}{'ra_targ_int'}  = $SHP{'shp_ra_v1'};
         ${$ds}{'dec_targ_int'} = $SHP{'shp_dec_v1'};
      }
      
   }
   if (! $matches) {
      print LOG "$ds: No entry (aperobj) in shp_data for ";
      print LOG "ds ${$ds}{'dataset_name'}: skipping\n";
      next;
   }
   
   #
   # We have 1 ASSOCIATION per  1 PP,FILTER couple
   #
   if ( $PP != $PPold || $FILTER ne $FILTERold)
   {
      # New association's leader
      $A1  = $Ara;                 # milliarcsec
      $D1  = $Adec;                # milliarcsec
      $a1  = $A1  * $marcsec2rad;  # radians
      $d1  = $D1 * $marcsec2rad;   # radians
      $COSDEC = cos($d1);          # pre-computed cosine of declination
      
      &BuildAsn( $PPold, $FILTERold, \@dataset);
      @dataset = ();
      @$asnnameold = ();
      $asnname = $PP.$FILTER;
   }
   
   #
   # ******* END OF LOOKING FOR OTHER REQUIRED PARAMETERS *******
   #
   
   $PPold = $PP;
   $FILTERold = $FILTER;
   $asnnameold = $asnname;
   
   #
   # If you get here is because this dataset survived all
   # the necessary queries. Therefore let's keep it as a good member.
   #
   
   push( @dataset, $ds );
   $count++;
push ( @ALBERTO, $ds );
}
# End of first SELECT STATEMENT ($A)

&BuildAsn( $PPold, $FILTERold, \@dataset);

print "\n\t TOT NUM. OF DATASETS THAT PAST THE TESTS: $count\n";
print "CMP WITH ", $#ALBERTO+1, " \@ALBERTO\n";
&Conclusions($descrfile);

if ( $CREATE_DESCR_FILE )
{
   close(DESCR);
}
if ( $LOG )
{
   close(LOG);
}

print "\n\nDescription file $descrfile:\n\n";
# NOT IN THIS TEST MODE open(READ,"<$descrfile");
# NOT IN THIS TEST MODE while(<READ>) { print; }
# NOT IN THIS TEST MODE close(READ);

if ( $#single > -1 )
{
   print "See also the SINGLE file: ${descrfile}.single\n";
}
print "See also the log file: $logfile\n";
}

# -------------- END OF COMPUTE_ASSOCIATIONS --------------------------------


#*
#* BUILD_ASN ------------------------------------------------------
#*
sub BuildAsn
{
   my ( $PP, $FILTER, $rdataset ) = @_;
   my ( @tmp, @pepfilter );

   if ( $PP eq "start" ) { return; }
   # At this point we've got a list of datasets (@dataset)
   # belonging to the PP.FILTER combination
   # order by exptime
   # The i-th dataset attribute X can be accessed in this way:
   #
   #   $X =  ${$rvalue}{$$rdataset[$i]}{'X'};  
   #
   
   if ($DEBUG == 1) { print "Select B\n";}
   
   #
   # QUERYING THE SECOND (B) TIME
   #
   
   @tmp = keys( %done );
   $tot_members += $#tmp+1;

   undef %done;

   @pepfilter = @$rdataset;
   while( $leader = shift @pepfilter )
   { 
      if (  $done{$leader} )
      {
         # Being already a member, it doesn't qualify as a leader
         next;
      }

      $APER1 = ${$leader}{'aperture'};
      $A1    = ${$leader}{'ra_targ_int'};
      $D1    = ${$leader}{'dec_targ_int'};
      $a1    = ${$leader}{'ra_targ_int'} * $marcsec2rad;
      $d1    = ${$leader}{'dec_targ_int'} * $marcsec2rad;
      $ROLL1 = ${$leader}{'v3_pos_angle'};
      $roll1 = ${$leader}{'v3_pos_angle'} * $marcsec2rad;

      $JA1    = ${$leader}{'ra_jit'};
      $JD1    = ${$leader}{'dec_jit'};
      $ja1    = ${$leader}{'ra_jit'} * $marcsec2rad;
      $jd1    = ${$leader}{'dec_jit'} * $marcsec2rad;
      $JROLL1 = ${$leader}{'roll_jit'};
      $jroll1 = ${$leader}{'roll_jit'} * $marcsec2rad;

      # build list of leaders in the order they appear (sorted by exptime!)
      push ( @ldrlist, $leader );
      
      foreach $ds (@pepfilter)
      {
         if ( 
         ${$ds}{'dec_targ_int'} >= $D1 - $ASN_RADIUS
         && ${$ds}{'dec_targ_int'} <= $D1 + $ASN_RADIUS
         && ${$ds}{'v3_pos_angle'} <= $ROLL1 + $MAX_DELTA_ROLL
         && ${$ds}{'v3_pos_angle'} >= $ROLL1 - $MAX_DELTA_ROLL
         && ${$ds}{'aperture'}     eq $APER1
         && $A1 >= 0
         )
         {
            $a2 = ${$ds}{'ra_targ_int'} * $marcsec2rad;
            $d2 = ${$ds}{'dec_targ_int'} * $marcsec2rad;
            $dist = &Distance($a1, $d1, $a2, $d2);
            if ( $dist > $asn_radius )
            {
               next; # go to NEXT B ("A" will take care of it later)
            }
            
            if ( $done{$ds} )
            {
               # this dataset is already part of an association
               # (see leader = $done{$ds}
               # we could actually see which leader is the closest to this one
               # in some space (exptime, ra, dec, ???) and in case change leader!
               if ( $dist >= ${$ds}{'distance'} )
               {
                  # The previous leader is closer
                  next;
               }
               else
               {
                  # This leader is closer!
                  # Remove previous leader related definitions
                  # But first be sure you can compute the shifts!
                  # previous leader handling will be done later ...
                  # print "New LEADER ($leader) for $ds (prev.: $done{$ds})\n";
                  # print "deleting the entry ($ds, ". ${$done{$ds}}{$ds} .")",
                  #                 "from %".$done{$ds}."\n";
                  #                   delete ${$done{$ds}}{$ds};
               }
            }
            # --------- COMPUTING DX and DY ! ONLY FOR WFPC2 or STIS ! --------
            
            if ($INSTRUMENT eq "U")
            {

               if ( $DEBUG == 1 )
               {
                  print "-"x80,"\n";
                  print "SCIENCE: $a1, $d1, $a2, $d2\n";
               }
               ($dx,$dy) = &Shifts("WF4",${$leader}{'aperture'},
                              $a1, $d1, $a2, $d2, $roll1, $dist);

               if ( $DEBUG == 1 )
               {
                  print "$leader->$ds SWF4(${$leader}{'aperture'}): $dx, $dy\n";
                  print "-"x80,"\n";
               }
            }
            else
            {
               # NOT A WFPC2, STIS !!!
               $dx = 0.0;
               $dy = 0.0;
            }
            
            if ( $dx eq "INDEF" )
            {
               print LOG "$ds: No aperture available for ds: ",
                         "$ds ${$ds}{'targname'}. Skipping.\n";
               next;
            }

            # --------- COMPUTING JITTER DX and DY ! just to know ! --------

            if ( $JA1 eq "INDEF" || ${$ds}{'ra_jit'} eq "INDEF")
            {
               ${$ds}{'jdx'} = "INDEF";
               ${$ds}{'jdy'} = "INDEF";
            }
            else
            {
               if ( ${$ds}{'ra_jit'} < 1 && ${$ds}{'dec_jit'} < 1 )
               {
                  ${$ds}{'jdx'} = "INDEF";
                  ${$ds}{'jdy'} = "INDEF";
               } 
               else
               {
                 $ja2 = ${$ds}{'ra_jit'} * $marcsec2rad;
                 $jd2 = ${$ds}{'dec_jit'} * $marcsec2rad;
                 $jdist = &Distance($ja1, $jd1, $ja2, $jd2);
 
                 if ($INSTRUMENT eq "U")
                 {
                    ($jdx,$jdy) = &Shifts("WF4", ${$leader}{'japerture'},
                                     $ja1, $jd1, $ja2, $jd2, $jroll1, $jdist);
                 }
                 else
                 {
                    #
                    # NOT A WFPC2, STIS !!!
                    #
                    &Inform(" *** WARNING: UNKOWN INSTRUMENT -> NO SHIFTS !");
                    $jdx = "NV";
                    $jdy = "NV";
                 }

                 if ( $jdx eq "INDEF" )
                 {
                    print LOG "$ds: No aperture available for ds: ",
                              "$ds ${$ds}{'targname'}.\n";

                    print STDERR "$ds: No aperture available for ds: ",
                              "$ds ${$ds}{'targname'}.\n";
                 }

                 if ( ${$leader}{'japerture'} ne ${$ds}{'japerture'} )
                 {
                    #
                    # The jitter aperture values differ,
                    # but not the science ones!\n"; 
                    #

                    print LOG "$ds: APERTURE ERROR: ",
                              "$leader ${$leader}{'japerture'} ->  ",
                              "ds ${$ds}{'japerture'}\n";

                    print STDERR "$ds: APERTURE ERROR: ",
                              "$leader ${$leader}{'japerture'} -> ",
                              "$ds ${$ds}{'japerture'}\n";
                 }
             
                 if ( ${$ds}{'member_flag'} eq "P"      &&
		      ${$leaders}{'member_flag'} eq "P" &&
		      abs( ${$leader}{'roll_jit'} - ${$ds}{'roll_jit'} ) > $MAX_DELTA_ROLL )
                 {
                    #
                    # The roll jit values differ by more than $MAX_DELTA_ROLL,
                    # but not the science values!\n"; 
                    #

                    print LOG "$ds: ROLL ERROR: ",
                              "$leader ${$leader}{'roll_jit'} -> ",
                              "$ds ${$ds}{'roll_jit'}\n";

                    print STDERR "$ds: ROLL ERROR: $leader -> $ds SCI: ",
			 ${$leader}{'v3_pos_angle'} - ${$ds}{'v3_pos_angle'},
			 "  JIT: ",
                         ${$leader}{'roll_jit'} - ${$ds}{'roll_jit'},"\n";

                    ${$ds}{'member_flag'} = "R";
                    ${$leader}{'member_flag'} = "R";
                 }
                 ${$ds}{'jdx'} = $jdx * $precfact; 
                 ${$ds}{'jdy'} = $jdy * $precfact; 
               }
            }
            #
            # --------- COMPUTATION JITTER DX and DY DONE ! --------
            #
            
            if ( $done{$ds} )
            {
               #
               # This leader is closer!
               # Remove previous leader related definitions
               #
               print "New LEADER ($leader) for $ds (prev.: $done{$ds})\n";
               print "deleting the entry ($ds, ". ${$done{$ds}}{$ds} .") ",
                              "from %".$done{$ds}."\n";

               $previous_leader                    = $done{$ds};
               ${$previous_leader}{'tot_exptime'} -= ${$ds}{'exptime'};
               ${$previous_leader}{'num_members'}--;

               delete ${"members_".$previous_leader}{$ds};
               delete ${$previous_leader}{$ds};
               
               #
               # if you get here is probably because the ASN_RADIUS
               # was chosen too small!
               #

               print "$ds is a bridge between $done{$ds} and $leader\n";
               &Inform( "Current ASN_RADIUS=$ASN_RADIUS_WF4 DELTA_ROLL=$max_delta_roll; Increase it!" );
            }
            
            #
            # Getting here means this is associatable with the given leader
            #
            
            #
            # Keep track: later do not consider this dataset again.
            #
            $done{$ds} = $leader;
            ${$ds}{'leader'} = $leader;
            push ( @{$leader}, $ds );
            
            ${$leader}{'num_members'}++;
            ${"members_".$leader}{$ds} = ${$ds}{'exptime'};
            ${$leader}{'tot_exptime'} += ${$ds}{'exptime'};
            
            #
            # Store the distance from the leader
            #
            ${$ds}{'distance'} = $dist;
            
            #
            # OUTPUT by default precision=2 => hundredth of a pixel
            #
            ${$ds}{'dx'} = $dx * $precfact;
            ${$ds}{'dy'} = $dy * $precfact;

            #
            # --------------- END of COMPUTATION DX and DY -------------------
            #
            
         }
      }
      #
      # now we have:
      #    a leader ($leader), a hash of members ( %${leader} ), their shifts
      # (and we also have the %done hash telling us which one is the
      #  leader of a given dataset)
      # this doesn't mean that the association is ready!
      # In fact, this asn could be found to be associatable with a later asn!
      # 
      if ( ! ${$leader}{'num_members'} )
      {
         push ( @single, pop(@ldrlist) );
      }
      else
      {
         ${$leader}{'tot_exptime'} += ${$leader}{'exptime'};
         ${$leader}{'num_members'}++;
         if ( $DEBUG > 0 )
         {
            print "$leader has ${$leader}{'num_members'} members.\n";
         }
      }
      
   }
   #
   # here we have:
   #  1.- a list of leaders (@ldrlist) 
   #  2.- a hash of members for each leader ( %{"members_".$leader} )
   #      and a list of members for each leader (sorted by exptime!)
   #  3.- the hash %done, which returns the leader given a member
   #  4.- the member attributes $
   #  5.- the list of single datasets (@single)
}
# End of BuildAsn


#*
#* INFORM ------------------------------------------------------
#*
sub Inform
{
   my ( $msg ) = @_;
   
   print "x"x80,"\n";
   print $msg,"\n";
   print "x"x80,"\n";
}


#*
#* CONCLUSIONS ------------------------------------------------------
#*
sub Conclusions
{
   my ( $descrfile ) = @_;
   my ( @tmp );

   #? Let's check whether some element of @ldrlist is obsolete
   #? (i.e., if %done doesn't report it)

   @tmp          = keys( %done );
   $tot_members += $#tmp + 1;
   undef @tmp;

   #
   # At this point we (should) have:
   #
   #   $tot_members : the overall number of members in any asn of this pep_id
   #                  (the leaders are not counted in tot_members!!!)
   #   @ldrlist     : the list of leaders of an association 
   #   @single      : the list of non-associatable exposures
   #   $count       : the total number of datasets in this pep_id
   #
   printf "\t %5d num of ASSOCIATIONS\n\n", $#ldrlist+1;
   printf "\t %5d num of SINGLEs\n",        $#single+1;
   printf "\t %5d num of MEMBERs\n",        $tot_members + $#ldrlist+1;
   print  "\t ----------------------------\n";
   printf "\t %5d/%d\n",  $#ldrlist+1 + $#single+1 + $tot_members , $count;
  
   #
   # If the total number of datasets in this pep_id doesn't match ...
   # 
   if ( $#ldrlist+1 + $#single+1 + $tot_members != $count )
   {
      #
      # ... the  we are in big troubles!
      #
      print "   ","*"x7," YOU GOT A PROBLEM! ","*"x7,"\n";
      exit 666;
   }
   
   foreach $leader (@ldrlist)
   {
      @l_members = @{$leader};

      &check_asn_maint( $dbpmain, $leader, @l_members );

      if ( $CREATE_ASN_FILE )
      {
         &PrintAsn($leader, @l_members);
      }

      #
      # Destructor to free some memory
      #
      &clean_up( $leader, \@l_members )
   }
   # Let's prepare an array of members for each leader in @ldrlist
   close(O);
   
   if ( $#single > -1 )
   {
      #
      # Report about single exposures
      #
      &single;
   }
}


#*
#* SINGLE ------------------------------------------------------
#*
sub single
{
   my ( $descrfile ) = @_;
   my ( $s, $a1, $d1, $a2, $d2, $l, $found, %aper_single, $single_path );

   $single_path = $ASN_OUTPUT_DIR . $descrfile.".single";
   open(S,">$single_path") || die "Couldn't create $single_path\n";
   undef $single_path;

   foreach $s (@single)
   {
      $aper_single{${$s}{'aperture'}}++;
      $a1 = ${$s}{'ra_targ_int'} * $marcsec2rad;
      $d1 = ${$s}{'dec_targ_int'} * $marcsec2rad;
      ${$s}{'distance'} = 100000000000000000;
      $found = 0;
      foreach $l (@ldrlist)
      {
         if ( ${$l}{'filter'} ne ${$s}{'filter'} ||
         ${$l}{'aperture'} ne ${$s}{'aperture'} )
         {
            next;
         }
         $found++;
         $a2 = ${$l}{'ra_targ_int'} * $marcsec2rad;
         $d2 = ${$l}{'dec_targ_int'} * $marcsec2rad;
         
         $dist = &Distance($a1, $d1, $a2, $d2);
         if ( $dist < ${$s}{'distance'} )
         {
            ${$s}{'distance'} = $dist;
            ${$s}{'leader'}   = $l;
         }
      }
      
      if ( $found )
      {
         print S "$s : is ";
         printf S "%11.2f", ${$s}{'distance'}/$marcsec2rad/$WF4MAS;
         print S "  pixels from ${$s}{'leader'} [${$s}{'targname'} ($found)]\n";
      }
      else
      {
         print S "$s : no other dataset having same filter+aperture\n";
      }
   }
   if ( $#single > -1 )
   {
      print "\n\n\t Num. of SINGLE observations: ", $#single+1, "\n";
      print "\t Aperture       Num of single having that aperture\n";
      print "\t ------------   ----------------------------------\n";
      foreach $ap (keys %aper_single)
      {
         printf "\t %-12s   %d\n", $ap || "NULL" , $aper_single{$ap},"\n";
      }
   }
   close(S);
}


#*
#* PRINTASN ------------------------------------------------------
#*
sub PrintAsn
{
   my ($leader, @its_members) = @_;
   my ( $asn_id, $asnfile, $asn_path );
   
   $asn_id = substr($leader,0,8).$ASN_LETTER;
   $asnfile = lc($asn_id).".asn";

   $asn_path = $ASN_OUTPUT_DIR . $asnfile;   
   open(OASN,">$asn_path") || die "Couldn't create $asn_path\n";
   undef $asn_path;

   # $num_mem = $#its_members+2;
   #  pep_id , filter , exptime, no_members,
   
   $asn_header = "\n";
   $asn_header .= "Association file\n";
   $asn_header .= "****************\n";
   $asn_header .= "\n";
   $asn_header .= "            /* Association Info */\n";
   $asn_header .= "\n";
   $asn_header .= "Association ID              : $asn_id\n";
   $asn_header .= "Proposal ID                 : ${$leader}{'pep_id'}\n";
   $asn_header .= "Filter                      : ${$leader}{'filter'}\n";
   $asn_header .= "Principal Investigator      : ${$leader}{'pi_last_name'}\n";
   $asn_header .= "Target Name                 : ${$leader}{'targname'}\n";
   $asn_header .= "Aperture                    : ${$leader}{'aperture'}\n";
   $asn_header .= "Total Exposure Time         : ${$leader}{'tot_exptime'}\n";
   $asn_header .= "Total Number of Members     : ${$leader}{'num_members'}\n";
   $asn_header .= "Association Creation Date   : $TODAY\n";
   $asn_header .= "\n";
   $asn_header .= "            /* Association Parameters */\n";
   $asn_header .= "\n";
   $asn_header .= sprintf "Association Radius          : %8.3f [WF4 pixels]\n",
                                                         $ASN_RADIUS_WF4;
   $asn_header .= sprintf "Association Delta Roll      : %8.3f [degrees]\n",
                                                         $max_delta_roll;
   $asn_header .= "\n";

# ***************   

   $header = "
   
            /* Members Info */
assoc_id: [char 9]    : association identifier
dataset : [char 9]    : dataset name         
wf4_dx  : [float 7.2] : xcorr shift along the X WF4 axis [0\".099539]
wf4_dy  : [float 7.2] : xcorr shift along the Y WF4 axis [0\".099635]
xcorrerr: [float 8.3] : cross correlation shifts error (in WF4 pixels)
m       : [char 1]    : member jitter quality flag { P | G | B | I | R }
                      :        P : precise jitter info        (PROCESSABLE)
                      :        G : not reliable jitter info   (GROUPABLE)
                      :        B : bad jitter info            (BAD)
                      :        I : jitter files not available (INDEF)
                      :        R : jitter roll disagreement   (ROLL)
exptime : [float 10.2]: dataset exposure time [seconds]
ra      : [float 12.8]: science header right ascension (J2000) [degrees]
dec     : [float 11.7]: science header declination     (J2000) [degrees]
roll    : [float 7.3] : science header roll angle (North -> V3 axis east-word)
gain    : [float 4.1] : nominal atodgain
pc1_dx  : [float 7.2] : xcorr shift along PC1 X axis in PC1 units
pc1_dy  : [float 7.2] : xcorr shift along PC1 Y axis in PC1 units
wf2_dx  : [float 7.2] : xcorr shift along WF2 X axis in WF2 units
wf2_dy  : [float 7.2] : xcorr shift along WF2 Y axis in WF2 units
wf3_dx  : [float 7.2] : xcorr shift along WF3 X axis in WF3 units
wf3_dy  : [float 7.2] : xcorr shift along WF3 Y axis in WF3 units
err_dx  : [float 7.2] : xcorr shift error along X WF4 axis [0\".099539]
err_dy  : [float 7.2] : xcorr shift error along Y WF4 axis [0\".099635]
jit_dx  : [float 7.2] :  jitter shift along X WF4 axis [0\".099539]
jit_dy  : [float 7.2] :  jitter shift along Y WF4 axis [0\".099635]
sci_dx  : [float 7.2] : science shift along X WF4 axis [0\".099539]
sci_dy  : [float 7.2] : science shift along Y WF4 axis [0\".099635]
vote1   : [float 5.3] : xcorr vote for chip 1 
vote2   : [float 5.3] : xcorr vote for chip 2 
vote3   : [float 5.3] : xcorr vote for chip 3 
vote4   : [float 5.3] : xcorr vote for chip 4 
target  : [char 36]   : target name 
   
";
   $header .= "assoc_id  dataset   x-shift y-shift xcorrerr m exptime    ra           dec         roll    gain pc1_dx  pc1_dy  wf2_dx  wf2_dy  wf3_dx  wf3_dy  err_dx  err_dy  jit_dx  jit_dy  sci_dx  sci_dy  vote1 vote2 vote3 vote4 target name\n";
   $header .= "--------- --------- ------- ------- -------- - ---------- ------------ ----------- ------- ---- ------- ------- ------- ------- ------- ------- ------- ------- ------- ------- ------- ------- ----- ----- ----- ----- ------------------------------------\n";
   
   # pc1_x 0.045528
   # pc1_y 0.045507
   # wf4_x 0.099539
   # wf4_y 0.099635
   
   print OASN $asn_header;
   print OASN $header;
   
   $ds = $leader;

   $tmp = sprintf " %07.3f %05.2f%+06.2f",
                  ${$ds}{'v3_pos_angle'}/3600000.,
                  ${$ds}{'ra_targ_int'}/3600000./15.,
                  ${$ds}{'dec_targ_int'}/3600000.;

   $descr = sprintf "%5d %-12s %10s", ${$leader}{'pep_id'}, ${$leader}{'filter'}, ${$leader}{'aperture'};
   
   $descr =~ s/;/:/g;
   $descr .= $tmp; # ." $ASN_RADIUS $MAX_DELTA_ROLL";
   $descr .= sprintf "%4d"  , ${$leader}{'num_members'};
   $descr .= sprintf "%9.2f", ${$leader}{'tot_exptime'};
   $descr .= " $asnfile";
   # $descr .= " ${$leader}{'pi_last_name'}";

   if ( ${$ds}{'jdx'} eq "INDEF" ) { $jitfrmt = "%7s"; } else { $jitfrmt = "%7.2f"; }

   $rec = sprintf "%9s %9s %7s %7s %8s %s %10.2f %12.8f %11.7f %7.3f %4.1f %7s %7s %7s %7s %7s %7s %7s %7s $jitfrmt $jitfrmt %7.2f %7.2f %5s %5s %5s %5s %s\n",
                  $asn_id,${$ds}{'dataset_name'},
                  "INDEF", "INDEF", "INDEF",
                  ${$ds}{'member_flag'},
                  ${$ds}{'exptime'},
                  ${$ds}{'ra_targ_int'}/3600000.,
                  ${$ds}{'dec_targ_int'}/3600000.,
                  ${$ds}{'v3_pos_angle'}/3600000.,
                  ${$ds}{'gain'},
                  "INDEF", "INDEF",
                  "INDEF", "INDEF",
                  "INDEF", "INDEF",
                  "INDEF", "INDEF",
                  ${$ds}{'jdx'}, ${$ds}{'jdy'},
                  ${$ds}{'dx'}, ${$ds}{'dy'},
                  "INDEF", "INDEF", "INDEF", "INDEF",
                  ${$ds}{'targname'};
   print OASN $rec;
   
   foreach $ds (@its_members)
   {
      if ( ${$ds}{'leader'} ne $leader )
      {
         print " ### dataset $ds was part of $asn_id and moved to ${$ds}{'leader'}\n";
         print " ### skipping $ds here!\n";
         next;
      }
      if ( ${$ds}{'jdx'} eq "INDEF" )
      {
         $jitfrmt = "%7s";
      }
      else
      {
         $jitfrmt = "%7.2f";
      }
      $rec = sprintf "%9s %9s %7s %7s %8s %s %10.2f %12.8f %11.7f %7.3f %4.1f %7s %7s %7s %7s %7s %7s %7s %7s $jitfrmt $jitfrmt %7.2f %7.2f %5s %5s %5s %5s %s\n",
                     $asn_id,${$ds}{'dataset_name'},
                     "INDEF", "INDEF", "INDEF",
                     ${$ds}{'member_flag'},
                     ${$ds}{'exptime'},
                     ${$ds}{'ra_targ_int'}/3600000.,
                     ${$ds}{'dec_targ_int'}/3600000.,
                     ${$ds}{'v3_pos_angle'}/3600000.,
                     ${$ds}{'gain'},
                     "INDEF", "INDEF",
                     "INDEF", "INDEF",
                     "INDEF", "INDEF",
                     "INDEF", "INDEF",
                     ${$ds}{'jdx'}, ${$ds}{'jdy'},
                     ${$ds}{'dx'},${$ds}{'dy'},
                     "INDEF", "INDEF", "INDEF", "INDEF",
                     ${$ds}{'targname'};
      print OASN $rec;
   }
   close(OASN);
   print DESCR $descr,"\n";
}

#-----------------
# Compute Distance
# GLOBAL VARIABLES: a1, a2, d1, d2 (radians)
# Returns: radians
#-----------------

#*
#* DISTANCE ------------------------------------------------------
#*
sub Distance
{
   my ( $a1, $d1, $a2, $d2 ) = @_;
   my($tmp,$deltad,$deltaa);

   # within 36000 marcsec (=0.01 degrees =36 arcsecs =790 PC pixels)
   $deltaa = abs($a2-$a1);
   $deltad = abs($d2-$d1);

   #
   # What if a1=23:59 and a2=00:01 ???
   # Swap $deltaa with 2.pi-$deltaa
   #
   $tmp = 2.*$pi - $deltaa;
   if ($tmp < $deltaa) { $deltaa = $tmp; }
   
   if ($deltaa<0.0001745 && $deltad<0.0001745 )
   {
      $distance = $deltad*$deltad + $deltaa*$deltaa*cos($d1)*cos($d2);
      $distance = sqrt($distance);
   }
   else 
   #  Computation of the distance is not needed since is certainly
   #  higher than 790 PC pixels !
   {
     # $distance = 1.;
         $distance =  sin($d2)*sin($d1)
                       + cos($d2)*cos($d1) * cos($a2-$a1);
         $tmp = abs(1. - ($distance*$distance));
         $distance = atan2(sqrt($tmp) ,$distance);
   }
   # The real formula should be:
   #   {
   #      $distance =  sin($d2)*sin($d1)
   #                    + cos($d2)*cos($d1) * cos($a2-$a1);
   #      $tmp = abs(1. - ($distance*$distance));
   #      $distance = atan2(sqrt($tmp) ,$distance);
   #   }
   $distance;
}

# --------------- COMPUTING DX and DY -------------------

#
# COMPUTING WFPC2 SHIFTS
#

#*
#* SHIFTS ------------------------------------------------------
#*
sub Shifts {
   my( $refchip, $aaperture, $a1, $d1, $a2, $d2, $v3, $dist ) = @_;

   my($achip, $bin, $pfovx, $pfovy, $apfovx, $apfovy);
   my($Da, $ateta_v3, $tmp, $tmp1, $fi);
   my($aTeta, $adx, $ady, $dx, $dy, @aperture);
   my($dx_new, $dy_new);

   if ( $DEBUG == 1 )
   {
       printf " %12.7f %11.7f %12.7f %11.7f %11.7f %11.7f\n",
              $a1/$scale/15., $d1/$scale, $a2/$scale/15., $d2/$scale,
              $v3/$scale, $dist;
   }
   $Da = $a2 - $a1;

   if ($aaperture =~ /S$/) { $bin = "S" } else { $bin = ""; }
   $refchip =~ s/^U//;
   if ( $refchip ne "PC1" && $refchip ne "WF2" &&
        $refchip ne "WF3" && $refchip ne "WF4" )
   {
      print " *** Error in Routine Shifts: ref.chip $refchip not recognised\n";
      exit 1;
   }
   $refaper = "U".$refchip.$bin;

   if ( $DEBUG == 1 )
   {
      print "RefChip: $refchip\n";
      print "RefAper: $refaper\n";
   }

   # 
   # The given aperture refers a certain chip; 
   # This chip is NOT the refchip.
   # 
   $achip = $CHIP{$aaperture};

   if ( $DEBUG == 1 )
   {
       print "achip: $achip\n";
       print "aaper: $aaperture\n";
   }

   #  
   #  Pixel scale of such chip (in radians)
   #
   $apfovx = $pfov_x{$aaperture} / 3600. * $scale;
   $apfovy = $pfov_y{$aaperture} / 3600. * $scale;
   
   #  
   #  teta_v3: TETA Angle of such chip (in radians)
   #
   $ateta_v3 = $scale * $TETA_V3{$achip};
   
   if ($apfovx == 0 || $apfovy == 0) {
      print LOG "$ds: Unknown Aperture $aaperture  ***\n";
      return ("INDEF", "INDEF");
   }
   
   if ($dist) {
      $tmp = cos($d2)*sin($Da)/sin($dist) ;
      $tmp1 = abs(1. - ($tmp*$tmp));
      if ($tmp1 < 0.0000000000001)
      {
         $fi = 0.0;
      }
      else
      {
         $fi = atan2($tmp, sqrt($tmp1));
      }
      
      if ($d2-$d1 < 0.0)
      {
         $fi = $pi - $fi;
      }
      $aTeta = $ateta_v3 - $v3 + $fi;
      
      # dx and dy are the shifts (in X and Y) on the chip
      # defined by $achip (i.e., $aaperture could be any of WF2, WF3, WF4, PC1)
      
      $adx= $dist / $apfovx * cos ($aTeta);
      $ady= $dist / $apfovy * sin ($aTeta);
      
      # NOW DX AND DY HAVE TO BE TRANSFORMED IN UNITS OF $refaper PIXELS
      
      $pfovx = $pfov_x{$refaper} / 3600. * $scale;
      $pfovy = $pfov_y{$refaper} / 3600. * $scale;
     
       
      if ($apfovx == 0 || $pfovx ==0)
      { die " *** Wrong Apertures: $aaperture, $refaper ***\n\n"; }
      
      $DT =  - $scale * ( $TETA_V3{$refchip} - $TETA_V3{$achip} ) ;
      
      $dx_new =   $adx * cos($DT) * $apfovx / $pfovx +
                  $ady * sin($DT) * $apfovy / $pfovy ;
      $dy_new = - $adx * sin($DT) * $apfovx / $pfovx +
                  $ady * cos($DT) * $apfovy / $pfovy ;
   } else {
      
      $dx_new = 0;
      $dy_new = 0;
   }

   # These are the DX and DY that we want, that is,
   # in $refchip pixels units
   $dx = sprintf ("%10.${precision}f", $dx_new);
   $dy = sprintf ("%10.${precision}f", $dy_new);

   return ($dx, $dy);
}


#*
#* DOSQL_TRANS ------------------------------------------------------
#*
sub dosql_batch_trans
{
   my($adbp, $sql, $action ) = @_;
   my $status, $n_sql_stmt = 0;

   if ( $action eq $LOAD || $action eq $EXEC )
   {
      $adbp->dbcmd( $sql );
   } 

   if ( $SAFEDEBUG )
   {
      print "FULLDEBUG mode:\n";
      print "The following transaction is not going to be executed:\n{n";
      print $sql,"\n}\n";
      return -1;
   }

   if ( $action eq $EXEC )
   {
      #
      # Sends the content of the current command buffer to the dataserver
      # for execution.
      # (See the DB-library documentation for a discussion of return values.)
      #
      $status = $adbp->dbsqlexec;

      if ( $status != 1 )
      {
         print STDERR "DB_ERROR: <$DB_ERROR>\n";
         return 0;
      }
         
      #print "************** SUCCESSFULL SQLEXEC ******************** \n";
         
      #
      # Until the buffer contains unexecuted queries
      #
      while( ($status = $adbp->dbresults) != eval NO_MORE_RESULTS )
      {
         if ( $status != 1 )
         {
            print STDERR "DB_ERROR: <$DB_ERROR>\n";
            return 0;
         }
         
         $n_sql_stmt++;
            
         while( %R1 = $adbp->dbnextrow(1) )
         {
            ;
         }
      }

      # print "*************** SUCCESSFULL DBRESULTS & DBNEXTROW ********* \n";

      #
      # Returns the number of successful statements
      #
      return $n_sql_stmt; 
   }

   #
   # Getting here means that it was only a LOAD (dbcmd) action
   #
   return 1;
}


sub print_running_on
{
   print "\nWFPC2 Associations: Preparing Input File\n";
   print "------------------------------------------------------------\n";
   print "\n   Input Values:\n\n";
   print "\t INSTRUMENT: ", $INSTRUMENT || "NULL", "\n";
   print "\t PEP_ID:     $PEP_ID\n";
   print "\t FILTER:     ", $FILTER || "NULL", "\n";
   print "\t ASN_RADIUS: ", $ASN_RADIUS || "NULL", " (wf4 pixels)\n";
   print "\t DELTA_ROLL: ", $max_delta_roll || "NULL", " (degrees)\n";
}


#*
#* INIT ------------------------------------------------------
#*
sub Init
{
   $WF4MAS = 99.5;

   if ( ! -r $ASN_OUTPUT_DIR )
   {
      mkdir( $ASN_OUTPUT_DIR, 0775 ) || 
         die " *** ERROR $0: Couldn't create dir <$ASN_OUTPUT_DIR>\n";
   }

   #
   # TABLE DEFINITIONS:
   # ------------------
   #
   # Do you want to build ECF or STSCI associations of associations ?
   #   for STSCI ones: $JIT_MEMBER = "jit_stsci";
   #   for ECF ones:   $JIT_MEMBER = "jit_member";

   if ( $LOCATION eq "ECF" )
   {
      $ASN_MAINT        = "hstmisc..asn_maint";
      $ASN_MAINT_MEMBER = "hstmisc..asn_maint_mem";

      $JIT_MEMBER    = "hstmisc..jit_member";
      $ENV{'SYBASE'} = "/opsw/util/sybase" unless $ENV{'SYBASE'};
      $DBSERVER      = "ESOECF";
      $DBUSER        = "operator";
      $DBDATABASE    = "hstmisc";
   }
   elsif ( $LOCATION eq "CADC" )
   {
      $ASN_MAINT        = "hstmisc..asn_maint";
      $ASN_MAINT_MEMBER = "hstmisc..asn_maint_mem";

      $JIT_MEMBER    = "hstecf..jit_member";
      $ENV{'SYBASE'} = "/usr/cadc/sybase" unless $ENV{'SYBASE'};
      $DBSERVER      = "SYBASE";
      $DBUSER        = "cadcuser51";
      $DBDATABASE    = "hstmisc";
   }

   if ( $#ARGV < 0 || $ARGV[0] =~ /-*h/ )
   {
      &Usage;
      exit -1;
   } 
 
   use Sybase::DBlib;

   $DADS_RECEIVED = "hstmisc..dads_received";
   $DADS_ASN_FIELD = "jitter"; # ???
   
   $initial{'WFPC2'} = "U%";
   $initial{'U'} = "U%";
   
   #
   # Commented out this option buisness and using perl module instead!
   #

   &Getopts('i:p:f:a::d:mcs');

   $INSTRUMENT = "U";

    $no_arg = 0;
    if( $opt_i ) 
    { 
	$INSTRUMENT = uc( $opt_i); 
	$no_arg++;
    }
    if( $opt_p ) 
    { 
	$PEP_ID = $opt_p; 
        $MODE = "UPDATE";
	$no_arg++;
    }
    if( $opt_f ) 
    {
	$FILTER = uc( $opt_f ); 
        $MODE = "UPDATE";
	$no_arg++;
    }
    if( $opt_a )
    {
	$max_delta_roll = $opt_a; 
	$no_arg++;
    }
    if( $opt_r )
    {
	$ASN_RADIUS = $opt_r * $WF4MAS; 
	$no_arg++;
    }
    if( $opt_d )
    {
	$DEBUG = $opt_d;
        print " *** $0: Switching DEBUG on (level $DEBUG)\n";
    }
    if( $opt_m )
    {
        if ( $PEP_ID )
        {
           print " --- WARNING: Cannot run MAINTENANCE (-m) if a PEP_ID is provided (-p).\n";
           $MODE = "SINGLE_PEP";
        }
        else
        {
           $MODE = "MAINTENANCE" unless $MODE;
        }
	$no_arg++;
    }
    if( $opt_c )
    {
       $CREATE_ASN_FILE = 1;
       $CREATE_DESCR_FILE           = 1;
    }
    else
    {
       $CREATE_ASN_FILE = 0;
       $CREATE_DESCR_FILE           = 0;
    }
    if( $opt_s )
    {
       $SAFEDEBUG = 1;
    }
    else
    {
       $SAFEDEBUG = 0 unless $SAFEDEBUG;
    }

   #
   # roll of 2nd exposure within +/- MAX_DELTA_ROLL
   #
   if ( $max_delta_roll eq "" )
   {
      $max_delta_roll=0.03;
   }
   $MAX_DELTA_ROLL = int($max_delta_roll * 3600000. + 0.5);
   
   $pi = 3.1415926535;
   $scale = $pi / 180.;
   $marcsec2rad = $pi / 180. /3600000.;

   #   
   # Distance(expos1, expos2) < ASN_RADIUS
   #
   $ASN_RADIUS=100.*$WF4MAS unless $ASN_RADIUS;
   $ASN_RADIUS_WF4 = $ASN_RADIUS/$WF4MAS;

   $asn_radius=$ASN_RADIUS * $marcsec2rad; # The same but in radians
   
   print "\n   Values Used:\n\n";
   printf "\t INSTRUMENT USED:     %11s\n", $INSTRUMENT;
   printf "\t ASN_RADIUS USED:     %11d mas (%6.2f pixels)\n", $ASN_RADIUS, $ASN_RADIUS_WF4;
   printf "\t MAX_DELTA_ROLL USED:     %7.5f degrees\n",
                                   $max_delta_roll;
   print "------------------------------------------------------------\n";
  

   # An exposure is flagged "P" (Processable) if:
   #        $guideact eq "FINELOCK"      &&
   #        $ra_sd * $COSDEC <= $MAX_COORD_STD     && #milliarcsec
   #        $dec_sd <= $MAX_COORD_STD    && #milliarcsec
   #        $roll_sd <= $MAX_ROLL_STD    && #milliarcsec
   #        $ra_sd ne ""                 &&
   #        $dec_sd ne ""                &&
   #        $roll_sd ne ""               &&
   #        $lockloss = 0
   
   $precision = 2;
   $precfact = 1;
   # $precfact = &pow(10.0, $precision);

   if ( $no_arg <= 0 )
   {
      $MODE="full"; # not available yet
      print "\n\t *** YOU MUST PROVIDE A PEP_ID, A INSTRUMENT AND A FILTER.\n"; 
      print "\t *** OTHERWISE, YOU CAN RUN IT IN MAINTENANCE MODE (-m switch).\n";
      exit;
   }
   
   $descrfile = lc($INSTRUMENT)."_".$PEP_ID."_".$FILTER."_".$ASN_RADIUS_WF4."_".$max_delta_roll;
   if ( $CREATE_DESCR_FILE )
   {
      $descr_path = $ASN_OUTPUT_DIR . $descrfile;
      open(DESCR, ">$descr_path" ) ||
         die "\n *** Couldn't create DESCR file ($descr_path)\n\n";
      undef  $descr_path;
   }
   
   # THE FOLLOWING IS NOT TRUE ANYMORE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!?
   # $CONSTRAINT .= " and sci_start_time > \"12.10.1993\""; # Otherwise ...
   # ... the datediff query crashes this script because of 2 datasets
   # which have start_time = Nov 17 1858 12:00AM (U29J1801T, U3EK0307M)
   # and anyway we don't have jitter files for the period preceeding 20 Oct 94.
   # => Two datasets are lost!
   
#   $chip[2] = "PC1";    # Fixed to be PC1 for all exposures in all associations
#   # which means that all DX and DY are expressed on 
#   # respect of a PC pixel disregarding the aperture used.

#  $chip[2] = "WF4";     # Fixed to be WF4 for all exposures in all associations
   # which means that all DX and DY are expressed on 
   # respect of a WF4 pixel disregarding the aperture used.
   # ! Changing this to use with ALL INSTRUMENTS
   # $chip[2] will be = "STIS" for stis, etc ... see later!
   
   print "Calling wfpc2_focal_plane_geometry \n";

   &wfpc2_focal_plane_geometry;
   
   print "Connecting to database\n";

   $dbpaux = &DBConnect($DBSERVER, $DBUSER, $DBDATABASE);
   $dbpmain = &DBConnect($DBSERVER, $DBUSER, $DBDATABASE);

   if ( $MODE eq "MAINTENANCE" )
   {
      $dbploop = &DBConnect($DBSERVER, $DBUSER, $DBDATABASE);
   }
   
   #
   # Get Sybase today date
   #

   $sql = "select today = getdate()";
   &dosql( $dbpmain, $sql );
   while( %R = $dbpmain->dbnextrow(1) )
   {
      $TODAY = $R{'today'};
   }

   if ($LOG)
   {
      my ( @log_date, $logfile );

      if ( ! -r $ASN_LOG_DIR )
      {
         mkdir( $ASN_LOG_DIR, 0775 ) || 
            die " *** ERROR $0: Couldn't create dir <$ASN_LOG_DIR>\n";
      }

      ( @log_date ) = split ( /\s+/, $TODAY );
      $log_date[2].$log_date[0].$log_date[1].$log_date[3];

      $logfile = $ASN_LOG_DIR . "asn_maint." .
                 $log_date[2] . $log_date[0] . $log_date[1];

      open(LOG, ">>$logfile") ||
         die "\n *** Couldn't create LOG file ($logfile)\n\n";

      print LOG " Running $0 with @ARGV\n";
      print LOG `date`,"\n";
   }

   return ( $PEP_ID, $FILTER );

}

sub build_constraint
{   
   my ( $PEP_ID, $FILTER ) = @_;
   my ( $CONSTRAINT );

   print "PEP_ID = $PEP_ID\n";
   if ($PEP_ID) {
      $CONSTRAINT .= " and sci_pep_id = $PEP_ID ";
   }
   else
   {
      print " *** ERROR: No PEP_ID was provided, nor -m. Aborting.\n";
      exit -1;
   }
   if ($INSTRUMENT) {
      if (! $initial{$INSTRUMENT}) {
         die "\n *** Invalid $INSTRUMENT
         (must be one of: WFPC2|U NICMOS|N STIS|O)\n\n";
      }
      $CONSTRAINT .= " and sci_data_set_name like \"$initial{$INSTRUMENT}\"";
   }
   else
   {
      $INSTRUMENT = "U";
      $CONSTRAINT .= " and sci_data_set_name like \"U%\" ";
   }
   if ($FILTER) {
      $CONSTRAINT .= " and sci_spec_1234 = \"$FILTER\" ";
   }
   return ( $CONSTRAINT );
}      
      

#*
#* ONGOING_PROGRAMS ------------------------------------------------------
#*
sub ongoing_programs
{
   my ( $dbp ) = @_;
   my ( $just_now, $since_then, $sql, %R );

   use Time::Local;

   #
   # get local time in number of seconds (since 1970)
   #
   $just_now = timelocal( localtime()  );

   #
   # n days ago:
   #
   $since_then = $just_now - $PAST_N_DAYS * 86400;

   #
   # and those since_then seconds correspond to a date of:
   #
   ( @since_then ) = localtime ( $since_then );

   #
   # ... which in SYBASE datetime is:
   #
   $since_then = sprintf "%02d/%02d/%4d %02d:%02d:%02d",
                         1 + $since_then[4],   # month
                             $since_then[3],   # day
                      1900 + $since_then[5],   # year
                             $since_then[2],   # hour
                             $since_then[1],   # minute
                             $since_then[0];   # second

   print "Skipping any program touched in the last $PAST_N_DAYS days: $since_then\n";

   #
   # Get those propgrams that are still being observed
   #

   $sql = "select distinct sci_pep_id
           from hstdads..science
           where sci_data_set_name like \"U%\"
           and sci_start_time > \"$since_then\"
           ";
   &dosql( $dbp, $sql );
   while( %R = $dbp->dbnextrow(1) )
   {
      $ONGOING_PEP_IDS{ $R{'sci_pep_id'} } = 1;
   }
}


#*
#* POW ------------------------------------------------------
#*
sub pow 
{
   my($base,$exp) = @_;
   my($i,$p);

   $p=1;
   for ($i=0 ; $i < $exp; $i++)
   { $p = $p * $base; }
   $p;
}


#*
#* COMPUTE_SHIFTS ------------------------------------------------------
#*
sub compute_shifts
{
   local($dx, $dy, $given_aper) = @_;
   my (@dx, @dy, @aper, $aper, $rx_arr, $ry_arr, $prec);
   $prec = 2;

# AT CADC THE wfpc2_shift_chip ROUTINE INCLUDES THE do wfpc2.dat STEP

#   #
#   # Better to use the CHIP instead of the aperture name
#   # In fact, it's easier to loop on the chip name,
#   # but impossible on the aperture name
#   #

   if ($given_aper =~ /S$/) { $bin = "S" } else { $bin = ""; }
   $refaper = "U".$CHIP{$given_aper}.$bin;

   $aper[1] = "UPC1".$bin;
   $aper[2] = "UWF2".$bin;
   $aper[3] = "UWF3".$bin;
   $aper[4] = "UWF4".$bin;
   #
   # Anyway useful to run even when $refaper eq $aper[$i] because
   # that way we get dx and dy with the correct precision.
   #
   for($i=1; $i<5; $i++) {
      ($dx[$i], $dy[$i]) = &wfpc2_shift_chip($dx,$dy,$refaper,$aper[$i], $prec);
   }
   $rx_arr = \@dx;
   $ry_arr = \@dy;

   return ( $rx_arr, $ry_arr );
}


#*
#* USAGE ------------------------------------------------------
#*
sub Usage
{
   print "

Usage: asn_maint.pl [-p pep_id] [-f filter] [-r asn_radius] [-a delta_roll] \\
                    [-s] [-m] [-c]

 where: 

       pep_id :=  proposal id       (e.g., 6337)
       filter :=  valid filter name (e.g., F814W)
   asn_radius :=  maximum allowed distance from the leader [WF4 pixels {100}]
   delta_roll :=  maximum allowed difference in roll angle [degrees   {0.03}]

   -s := SAFEDEBUG   : sql updates are not executed, only displayed
   -m := MAINTENANCE : to loop on all the pep_ids
                        (if -p is used -m is discarded)
   -c := CREATE      : to create the .asn file (not created by default) <***!

 Mandatory options:  

    At least one of the two must be provided on the command line:

       1)  -p pep_id
       2)  -m


 Example 1:

   asn_maint.pl -m

      will loop on all the pep_ids that didn't progress
      in the last $PAST_N_DAYS (see \$PAST_N_DAYS variable).
      The .asn files won't be created (no -c option).
      The database will show:

         - new associations for the most recently completed programs
           (according to the PAST_N_DAYS theshold)
         - new versions for already existing associations that
           might have changed since last run. Examples:

                o  new members came in
                o  rearchiviation of some member raw files
                o  change in the jitter shifts

           If a new member happens to be the new leader of the association
           
                o  a completely new association is created (different asn_id)
                o  the old association is now obsolete => curr is reset to 'N'

           If a new member happens to be a bridge between two associations
           the relative members of the two asns could be reshuffled.
           (NOTE: those two associaitons cannot be unified into a single one
                  since the separation among their members is bigger than
                  the ASN_RADIUS)

         - new validation_date for all the other unaffected current associations

         - some association is likely not a valid one anymore
           its curr flag is set to 'N'



 Example 2:

   asn_maint.pl -p 6337 -r 100 -a 0.02 -c

      returns 4 association files (one per filter)
              1 description file (U.6337..9950.72000)
        (9950 being 100 WF4 pixels in mas and  72000 being 0.02 degrees in mas)
      the database ($ASN_MAINT & $ASN_MAINT_MEMBER) is updated
      (see Example 1 above)



 Example 3:

   asn_maint.pl -p 6337 -c

      [ by default, -r 100 and -a 0.03 are assumed ]
      returns 4 association files (one per filter)
              1 description file (U.6337..9950.108000)
        (9950 being 100 WF4 pixels in mas and 108000 being 0.03 degrees in mas)
      the database ($ASN_MAINT & $ASN_MAINT_MEMBER) is updated
      (see Example 1 above)



 Example 4:

   asn_maint.pl -p 6337 -f F814W -r 100 -a 0.02

      does NOT return 1 association file (for the F814W filter)
                      1 description file (U.6337.F814W.9950.72000)
        (9950 being 100 WF4 pixels in mas and  72000 being 0.02 degrees in mas)
      the database ($ASN_MAINT & $ASN_MAINT_MEMBER) is updated
      (see Example 1 above)


";
}

# *
# * ********************************************************************
# * ********************************************************************
# * ********************************************************************
# *


#*
#* CHECK_ASN_MAINT ------------------------------------------------------
#*
sub check_asn_maint
{
    my ( $dbp, $leader, @its_members ) = @_;
    my ( $asn_id, $pasn_id );
    my ( %R );
    my ( @current_members, @previous_members );

    local $DIFFMEMBERS = 4;
    local $DIFFPIPE    = 3;
    local $DIFFJITTER  = 2;
    local $DIFFVERSION = 1;
    local $NODIFF      = 0;

    $asn_id = substr($leader,0,8).$ASN_LETTER;

    #
    # Building current array of members (including the leader)
    #
    push ( @current_members, $leader );

    foreach $ds (@its_members)
    {
       if ( ${$ds}{'leader'} eq $leader )
       {
          # dataset $ds was part of $asn_id and moved to ${$ds}{'leader'}
          # skipping $ds here!
          push ( @current_members, $ds );
       }
    }

    #
    # Associating to the asn_id a HASH as from the leader
    # This will be useful later if
    #
    #  1) we will insert this new association in ASN_MAINT,
    #  2) we will compare this new association with the "current" one.
    #

    %{$asn_id} = %{$leader};

    #
    # Computed fields
    #
    {
       my $min_start_time = 9.e+12;
       my $max_start_time = 0.0;
       my $max_mydate = "0";
       my ( @gendatestr );

       #
       # Computing:
       #     jflag
       #     type (for members)
       #     time_span
       #     max_gen_date_str
       #     validation date
       #     creation date
       #     type (for asn)

       foreach $ds ( @current_members )
       {
          my ( $sign );
          ${$ds}{'asn_id'} = $asn_id;
          ${$ds}{'asn_creation_date'} = $TODAY;
          ${$ds}{'sroll'} = ${$ds}{'v3_pos_angle'};
          ${$ds}{'jflag'} = ${$ds}{'member_flag'};

          if ( ${$ds}{'jdx'} >= 0.0 ) { $sign = 1; } else { $sign = -1; }
          ${$ds}{'jdx'} = int(${$ds}{'jdx'} * 100 + $sign * 0.5);

          if ( ${$ds}{'jdy'} >= 0.0 ) { $sign = 1; } else { $sign = -1; }
          ${$ds}{'jdy'} = int(${$ds}{'jdy'} * 100 + $sign * 0.5);

          if ( ${$ds}{'sdx'} >= 0.0 ) { $sign = 1; } else { $sign = -1; }
          ${$ds}{'sdx'} = int(${$ds}{'dx'} * 100 + $sign * 0.5);

          if ( ${$ds}{'sdy'} >= 0.0 ) { $sign = 1; } else { $sign = -1; }
          ${$ds}{'sdy'} = int(${$ds}{'dy'} * 100 + $sign * 0.5);

          ${$ds}{'sdx'} = 0 unless ${$ds}{'sdx'};
          ${$ds}{'sdy'} = 0 unless ${$ds}{'sdy'};

          #
          # The type for each member can be:
          #   "W" for shifts computed using WCS info
          #   "J" for shifts computed using JITTER info
          #   "X" for shifts computed using XCORR info
          # At this level we don't know yet whether "X" applies,
          # still we can decide if "J" is better than "W".
          #
          # The Jitter shifts are reliable if both the leader
          # and the member are reliable (jflag="P")
          #
          # But HOW TO DEAL WITH THE ZERO-POINT SHIFT ????????????????
          #
          # If it is not a brand new association we might migrate
          # into this structure the old 'type' info ... see the migrate sub.
          #
          if ( ${$current_members[0]}{'jflag'} ne "P" || ${$ds}{'jflag'} ne "P" )
          {
             ${$ds}{'type'} = "W";       
          }
          else
          {
             ${$ds}{'type'} = "J";
          }

          #
          # recording min and max start_time_dmf
          #

          if ( ${$ds}{'start_time_dmf'} < $min_start_time )
          {
             $min_start_time = ${$ds}{'start_time_dmf'};
          }
   
          if ( ${$ds}{'start_time_dmf'} > $max_start_time )
          {
             $max_start_time = ${$ds}{'start_time_dmf'};
          }

          #
          # Max Gen Dates ?
          #
          push ( @gendatestr, ${$ds}{'gen_date_str'} );
       }

       ${$asn_id}{'time_span'} = $max_start_time - $min_start_time;

       ${$asn_id}{'asn_validation_date'} = $TODAY;

       ${$asn_id}{'asn_id'} = $asn_id;
       ${$asn_id}{'sdx'} = 0;
       ${$asn_id}{'sdy'} = 0;
       ${$asn_id}{'jdx'} = 0;
       ${$asn_id}{'jdy'} = 0;
       ${$asn_id}{'exptime'} = ${$asn_id}{'tot_exptime'};
       ${$asn_id}{'curr'} = "Y";

       #
       # The "new" asn_creation_date is today
       # We don't use this to compare "new" and "current" hence no problem
       # in setting it up here.
       #
       ${$asn_id}{'asn_creation_date'} = $TODAY;
       ${$asn_id}{'asn_creation_date_str'} = &GenDate2Str($TODAY);

       #
       # Computing the max_gen_date_str of all members
       #
       ${$asn_id}{'max_gen_date_str'} = &MaxGenDates( @gendatestr );

       #
       # asn_radius and asn_delta_roll
       #
       ${$asn_id}{'asn_radius'}     = $ASN_RADIUS;
       ${$asn_id}{'asn_delta_roll'} = $MAX_DELTA_ROLL;

       ${$asn_id}{'type'} = " "; # XXX ???
    }
 
    #
    # Getting the all the info of the old leader.
    # get_old_asn returns 1 if found,  0 otherwise.
    # get_old_asn also creates (if found) a hash %{$pasn_id}
    #

    $pasn_id = "P" . $asn_id;

    $status = &get_old_asn( $dbp, $asn_id );

    if( ! $status )
    {
	#
	# First make obsolete all the associations containing 
        # the members of this new association
        # Second, insert this brand new association (no older version of it)
	#

	$status = &reset_insert_all( $dbp, $TODAY, $asn_id, \@current_members );

	return( $status );
    }
    else
    {
	#
	# Get all the info on old members
	#

        @previous_members = &get_old_members( $dbp, $asn_id );
	
	#
	# Compare old value with new values to dictate action
	# to take
	#

	$status = &compare_old_new ( \@current_members, \@previous_members );
  

	#
	# Update associations tables 
	#

        &update_asn_tables( $dbp, $TODAY, $status, $asn_id, \@current_members, \@previous_members );

    }

    #
    # Destructor to free some memory
    #
#    &clean_up( $asn_id, $pasn_id, \@current_members, \@previous_members )
    &clean_up( $pasn_id, \@previous_members )
}


#*
#* CLEAN_UP ------------------------------------------------------
#*
sub clean_up
{
   my ( $asn_id, $rn ) = @_;
   my ( $ds );

   foreach $ds ( @$rn )
   {
      undef %$ds;
   }
   undef %{$asn_id};
}


#*
#* UPDATE_ASN_TABLES ------------------------------------------------------
#*
sub update_asn_tables
{
   my ( $dbp, $today, $new_version, $asn_id, $rn, $rp ) = @_;

   # 
   # Returned new_version has one of the values
   # prioratised as follows:
   #
   #  4 - the "current" and the "new" association carry different datasets
   #  3 - same datasets, at least one dataset needs PIPE attention
   #  2 - same datasets, different JITTER information
   #  1 - same datasets, no PIPE required, at least one dataset has newer info
   #  0 - no differences 
   #

   if ( $new_version == $NODIFF )
   {
      #
      # The only required change is the asn_validation_date
      # in ASN_MAINT.
      #
      &update_validation_date( $dbp, $today, $asn_id );
   }
   else
   {
      # It's a new version!
      &migrate_pipe_info( $new_version, $asn_id, $rn );

      #
      # Only after migration it is possible to update the min and max distance
      #
      &compute_min_max_distance( $asn_id, $rn );

      &reset_insert_all ( $dbp, $today, $asn_id, $rn );
   }
}


#*
#* COMPUTE_MIN_MAX_DISTANCE -----------------------------------------------
#*
sub compute_min_max_distance
{
   my ( $asn_id, $rn ) = @_;
   my ( $ds, $dy, $dist_2, $max_dist_2, $min_dist_2 );

   $min_dist_2 =  1.e50;
   $max_dist_2 = -1.e50;

   #
   # Let's review the min_distance and max_distance fields
   #
   foreach $ds ( @$rn )
   {
      if ( ${$ds}{'type'} eq "X" )
      {
         $dx = ${$ds}{'cdx'};
         $dy = ${$ds}{'cdy'};
      }
      elsif ( ${$ds}{'type'} eq "J" )
      {
         $dx = ${$ds}{'jdx'};
         $dy = ${$ds}{'jdy'};
      }
      elsif ( ${$ds}{'type'} eq "W" )
      {
         $dx = ${$ds}{'sdx'};
         $dy = ${$ds}{'sdy'};
      }
   
      print "${$ds}{'type'} $dx $dy\n";

      $dist_2 = $dx*$dx + $dy*$dy ;
      if ( $max_dist_2 < $dist_2 )
      {
         $max_dist_2 = $dist_2;
      }
      if ( $min_dist_2 > $dist_2 )
      {
         $min_dist_2 = $dist_2;
      }
   }

   ${$asn_id}{'min_distance'} = int( sqrt( $min_dist_2 ) * 100. + 0.5 );   
   ${$asn_id}{'max_distance'} = int( sqrt( $max_dist_2 ) * 100. + 0.5 );   

}


#*
#* MIGRATE_PIPE_INFO ------------------------------------------------------
#*
sub migrate_pipe_info
{
   my ( $new_version, $asn_id, $rn ) = @_;
   my $pasn_id = "P" . $asn_id;

   #
   # Migrating Member info (not available via wai.pl)
   # from the previously "current" member to the "new" one.
   #
   foreach $ds ( @$rn )
   {
      $pds = "P" . $ds;
      ${$ds}{'cdx'}      = ${$pds}{'cdx'};
      ${$ds}{'cdy'}      = ${$pds}{'cdy'};
      ${$ds}{'cerror'}   = ${$pds}{'cerror'};
      ${$ds}{'cvote1'}   = ${$pds}{'cvote1'};
      ${$ds}{'cvote2'}   = ${$pds}{'cvote2'};
      ${$ds}{'cvote3'}   = ${$pds}{'cvote3'};
      ${$ds}{'cvote4'}   = ${$pds}{'cvote4'};
      ${$ds}{'pipe_status'}   = ${$pds}{'pipe_status'};

      #
      # Migrate the type only if of superior quality
      #
      if ( ${$pds}{'type'} eq "X"                &&
           ${$ds}{'differences'} != $DIFFMEMBERS &&
           ${$ds}{'differences'} != $DIFFPIPE      )
      {
         ${$ds}{'type'} = "X";
      }

      #
      # If the differences for this ds (member or leader)
      # are such that PIPE has to be activated,
      # then, let's reset its pipe_status to blank.
      #
      # NOTE: If the leader ($rn->[0]) itself demands a PIPE run,
      # then, all the members have to undergo PIPE again!
      #
      if ( ${$ds}{'differences'} == $DIFFMEMBERS      ||
           ${$ds}{'differences'} == $DIFFPIPE         ||
           ${$rn->[0]}{'differences'} == $DIFFMEMBERS ||
           ${$rn->[0]}{'differences'} == $DIFFPIPE     )
      {
         ${$ds}{'pipe_status'} = " ";
      }
   }

   #
   # Migrating Asn info (not available via wai.pl)
   # from the previously "current" asn to the "new" one.
   #

   ${$asn_id}{'pipe_date'}     = ${$pasn_id}{'pipe_date'};
   ${$asn_id}{'pipe_date_dmf'} = ${$pasn_id}{'pipe_date_dmf'};
   ${$asn_id}{'pipe_status'}   = ${$pasn_id}{'pipe_status'};

   if ( $new_version == $DIFFMEMBERS ||
        $new_version == $DIFFPIPE     )
   {
      ${$asn_id}{'pipe_status'} = " ";
   }
}


#*
#* UPDATE_VALIDATION_DATE -------------------------------------------------
#*
sub update_validation_date
{
   my ( $dbp, $today, $asn_id ) = @_;

   my ( $sql, $status  );

   $sql = "update $ASN_MAINT
           set asn_validation_date=\"$today\"
           where asn_id=\"$asn_id\" and
                 curr=\"Y\"                ";
   print LOG "$asn_id: update asn_validation_date=\"$today\"\n";
   $status = &dosql_batch_trans( $dbp, $sql, $EXEC );

   if ( $status == 0 && $SAFEDEBUG == 0 )
   {
      print LOG " *** Couldn't update DB <$sql>\n";
      print STDERR " *** Couldn't update DB <$sql>\n";
      die " *** $0 aborting ...\n";
   }
   if ( $status > 1 )
   {
      print " *** INCONSISTENCY: single update can't result in $status stmts\n";
   }
}


#*
#* COMPARE_OLD_NEW ------------------------------------------------------
#*
sub compare_old_new
{
   my ( $rn, $rp ) = @_;

   my ( %seen );
   my $new_version = 0;

   #
   # First, check any member of this new association
   # against the ASN_MAINT "current" version of it.
   # If any of the datasets differ, then a new version is to be created.
   # The full check of all members is performed to gather information
   # on each member, to know whether any change is triggering PIPE or not.
   #
   foreach $ds ( @$rn )
   {
      $seen{$ds} = 1;
      $status = &compare_one_dataset( $ds );

      #
      # Preserve the comparison returned status for each dataset
      # Needed ?
      #
      ${$ds}{'differences'} = $status;

      #
      # If there is a difference, then return with a DIFF status
      #
      if ( $status > $new_version )
      {
         $new_version = $status;
      }
   }

   #
   # Still there could be members in the current one which don't belong
   # anymore to the new one (e.g., change in roll angle, filter, or
   # because of de-archiviation, etc. )
   #
   # We need to check all the "current" members vs. the "new" ones.
   #

   foreach $pds ( @$rp )
   {
      $ds = substr( $pds, 1, 9 );
      if ( ! $seen{$ds} )
      {
         #
         # This "current" dataset doesn't belong to the "new" association.
         # Hence the "new" and the "current" association differ.
         #
         if ( $new_version < $DIFFMEMBERS )
         {
            $new_version = $DIFFMEMBERS;
         }
      }
   }

   #
   # At this point we have 5 possible values for $new_version
   # prioratised as follows:
   #
   #  4 - the "current" and the "new" association carry different datasets
   #  3 - same datasets, at least one dataset needs PIPE attention
   #  2 - same datasets, different JITTER information
   #  1 - same datasets, no PIPE required, at least one dataset has newer info
   #  0 - no differences 
   #
   return ( $new_version );
}


#*
#* COMPARE_ONE_DATASET ------------------------------------------------------
#*
sub compare_one_dataset
{
   my ( $ds ) = @_;
   my ( $status );
   my $pds = "P" . $ds;

   #
   # If a CAL class is re-archived, or the FILTER has changed
   # we might want to run PIPE again.
   #
   # NOTE: any entry removed from %PIPE MUST be entered in %VERSION !!!
   #
   my %PIPE = ( "gen_date_str" => "S",
                "filter"   => "S" );

   #
   # If any JITTER value has changed
   # we have to have a new version for this association.
   #
   my %JITTER = ( "jdx"    => "N",
                  "jdy"    => "N",
                  "jflag"  => "S" );

   #
   # If any value (other than JITTER and PIPE output) has changed
   # we have to have a new version for this association.
   #
   my %VERSION = ( "sroll"    => "N",
                   "sdx"      => "N",
                   "sdy"      => "N",
                   "jdx"      => "N",
                   "jdy"      => "N",
                   "jflag"    => "S",
                   "gen_date_str" => "S",
                   "filter"   => "S", 
                   "exptime"  => "N",
                   "start_time_dmf" => "N"
                  );

   #
   # Is this dataset present in the previous version of this association ?
   #
   if ( ${$pds}{'asn_id'} ne ${$ds}{'asn_id'} )
   {
      return ( $DIFFMEMBERS );
   }

   $status = &compare_specific_fields ( $DIFFPIPE, %PIPE );
   if ( $status != $NODIFF )
   {
      return ( $status );
   }

   $status = &compare_specific_fields ( $DIFFJITTER, %JITTER );
   if ( $status != $NODIFF )
   {
      return ( $status );
   }

   $status = &compare_specific_fields ( $DIFFVERSION, %VERSION );
   if ( $status != $NODIFF )
   {
      return ( $status );
   }

   return ( $NODIFF );
}

sub compare_specific_fields
{
   my ( $diffstatus, %type_of_action ) = @_;

   #
   # See if there is a difference which triggers the type_of_action action
   #
   foreach $field ( keys %type_of_action )
   {
      #
      # Numeric fields comparison
      #
      if ( $type_of_action{ $field } eq "N" )
      {
         if (${$ds}{$field} != ${ "P".$ds }{$field} )
         {
            return ( $diffstatus );
         }
      }
      #
      # String fields comparison
      #
      else
      {
         if (${$ds}{$field} ne ${ "P".$ds }{$field} )
         {
            return ( $diffstatus );
         }
      }
   }
   return ( $NODIFF );
}

#    #
#    # See if there is a difference which does not trigger the PIPE action
#    # but does trigger a new version.
#    #
#    foreach $field ( keys %VERSION )
#    {
#       if ( $VERSION{ $field } eq "N" )
#       {
#          if (${$ds}{$field} != ${ "P".$ds }{$field} )
#          {
#             return ( $DIFFVERSION );
#          }
#       }
#       else
#       {
#          if (${$ds}{$field} ne ${ "P".$ds }{$field} )
#          {
#             return ( $DIFFVERSION );
#          }
#       }
#    }
#    return ( $NODIFF );
# }


#*
#* RESET_INSERT_ALL ------------------------------------------------------
#*
sub reset_insert_all
{
    my ( $dbp, $today, $asn_id, $rn ) = @_;
    my ( $sql, %R, $status, $old_asn_id, %old_asns );
    my $num_requested_sql_stmt = 0;

    #
    # Reset: set curr="O" for all associations previously 
    #        including members from this new association (if any).
    #

    foreach $ds ( @$rn )
    {
      $sql = "select a.asn_id
              from $ASN_MAINT_MEMBER m, $ASN_MAINT a
              where m.asn_id=a.asn_id    and
                    a.asn_creation_date=m.asn_creation_date and
                    dataset_name=\"$ds\" and
                    curr=\"Y\"              ";
      &dosql( $dbp, $sql );
      if ( $DEBUG > 1 ) { print "$asn_id, $sql\n"; }
      while(  %R = $dbp->dbnextrow(1) )
      {
         if ( $DEBUG > 1 ) { print " -> $R{'asn_id'}\n"; }
         $old_asns{ $R{'asn_id'} } = 1;
      }
    }

    foreach $old_asn_id ( keys %old_asns )
    {
       $sql = "update $ASN_MAINT
               set curr=\"N\",
                   asn_validation_date=\"$today\"
               where
                   asn_id=\"$old_asn_id\" and curr=\"Y\" ";

       print LOG "$old_asn_id: update curr \"Y\" to \"N\" ($today)\n";
       $status = &dosql_batch_trans( $dbp, $sql, $LOAD );

       if ( $status == 0 && $SAFEDEBUG == 0 )
       {
          print LOG " *** Couldn't update DB <$sql>\n";
          print STDERR " *** Couldn't update DB <$sql>\n";
          die " *** $0 aborting ...\n";
       }

       $num_requested_sql_stmt++;
    }

    #
    # Insert the new association and its members
    #

    %TYPE_MEMBER = (
                  asn_id            => "S",
                  asn_creation_date => "S",
                  dataset_name      => "S",
                  gen_date          => "S",
                  gen_date_str      => "S",
                  exptime           => "N",
                  start_time_dmf    => "N",
                  filter            => "S",
                  sroll             => "N",
                  sdx               => "N",
                  sdy               => "N",
                  jdx               => "N",
                  jdy               => "N",
                  jflag             => "S",
                  cdx               => "N",
                  cdy               => "N",
                  cerror            => "N",
                  cvote1            => "N",
                  cvote2            => "N",
                  cvote3            => "N",
                  cvote4            => "N",
                  type              => "S",
                  pipe_status       => "S"
               );

    $insert_sql = "insert into $ASN_MAINT_MEMBER ( \n"; 

    foreach $kw ( sort keys %TYPE_MEMBER )
    {
       $insert_sql .= " $kw,\n";
    }
    chomp( $insert_sql );
    chop( $insert_sql );

    #
    # This string is the same for each $ds
    #
    $insert_sql .=  "\n)\n values (\n";

    foreach $ds ( @$rn )
    {
       $sql_values = "";

       foreach $kw ( sort keys %TYPE_MEMBER )
       {
          if ( ${$ds}{ $kw } eq "" )
          {
             $sql_values .= " NULL,\n";
          }
          else
          {
             if ( $TYPE_MEMBER{ $kw } eq "S" )
             {
                $sql_values .= " \"${$ds}{ $kw }\",\n";
             }
             else
             {
                $sql_values .= " ${$ds}{ $kw },\n";
             }
          }
       }
       chomp( $sql_values );
       chop( $sql_values );

       $sql = $insert_sql . $sql_values . "\n)\n"; 

       if ( $sql =~ /INDEF/ ||
            $sql =~ /,\s*,/  )
       {
          print " *** WARNING: Bad NULL value in SQL <$sql>\n";
       }
       if ( $DEBUG > 1 ) { print "INSERT MEMBERS: < $sql >\n\n"; }

       print LOG "$asn_id: insert member ($ds) asn_creation_date=\"$today\"\n";
       $status = &dosql_batch_trans( $dbp, $sql, $LOAD );

       if ( $status == 0 && $SAFEDEBUG == 0 )
       {
          print LOG " *** Couldn't update DBCMD <$sql>\n";
          print STDERR " *** Couldn't update DB <$sql>\n";
          die " *** $0 aborting ...\n";
       }

       $num_requested_sql_stmt++;

    }


    %TYPE_ASN = (
                  asn_id              => "S",
                  asn_creation_date   => "S",
                  asn_creation_date_str   => "S",
                  pep_id              => "N",
                  filter              => "S",
                  asn_radius          => "N",
                  asn_delta_roll      => "N",
                  asn_validation_date => "S",
                  pipe_status         => "S",
                  pipe_date           => "S",
                  curr                => "S",
                  num_members         => "N",
                  exptime             => "N",
                  start_time_dmf      => "N",
                  time_span           => "N",
                  max_gen_date_str        => "S",
                  min_distance        => "N",
                  max_distance        => "N",
                  asn_type            => "S"
                );

    $insert_sql = "insert into $ASN_MAINT ( \n";

    foreach $kw ( sort keys %TYPE_ASN )
    {
       $insert_sql .= " $kw,\n";
    }
    chomp( $insert_sql );
    chop( $insert_sql );

    $insert_sql .=  "\n)\n values (\n";

    $sql_values = "";

    foreach $kw ( sort keys %TYPE_ASN )
    {
       if ( ${$asn_id}{ $kw } eq "" )
       {
          $sql_values .= " NULL,\n";
       }
       else
       {
          if ( $TYPE_ASN{ $kw } eq "S" )
          {
             $sql_values .= " \"${$asn_id}{ $kw }\",\n";
          }
          else
          {
             $sql_values .= " ${$asn_id}{ $kw },\n";
          }
       }
    }
    chomp( $sql_values );
    chop( $sql_values );

    $sql = $insert_sql . $sql_values . "\n)\n";

    if ( $sql =~ /INDEF/ ||
         $sql =~ /,\s*,/  )
    {
       print " *** WARNING: Bad NULL value in SQL <$sql>\n";
    }

    if ( $DEBUG > 1 ) { print "INSERT ASN: < $sql >\n\n"; }

    print LOG "$asn_id: insert asn_id asn_creation_date=\"$today\"\n";
    $status = &dosql_batch_trans( $dbp, $sql, $EXEC );

    if ( $status == 0 && $SAFEDEBUG == 0 )
    {
       print LOG " *** Couldn't update DB <$sql>\n";
       print STDERR " *** Couldn't update DB <$sql>\n";
       die " *** $0 aborting ...\n";
    }

    $num_requested_sql_stmt++;

    if ( $status !=  $num_requested_sql_stmt && $SAFEDEBUG == 0 )
    {
       print LOG " *** INCONSISTENCY: requested $num_requested_sql_stmt SQLs resulted in $status stmts\n";
       print STDERR " *** INCONSISTENCY: requested $num_requested_sql_stmt SQLs resulted in $status stmts\n";
       die " *** $0 aborting ...\n";
       
    }
    # else
    # {
    #    print STDERR "CONSISTENT:  $status for $num_requested_sql_stmt sqls\n";
    # }

}


#*
#* GET_OLD_ASN ------------------------------------------------------
#*
sub get_old_asn
{
    my ( $dbp, $asn_id ) = @_;
    my ( %R );
    my $found = 0;
    my $pasn_id = "P" . $asn_id;
    undef %{$pasn_id};
    #
    # Let's get actual entry for this association
    #

    $sql = "select *
            from $ASN_MAINT
            where asn_id = \"$asn_id\" and curr = \"Y\" ";

    &dosql( $dbp, $sql );
    while( %R = $dbp->dbnextrow(1) )
    {
        $found = 1;
        foreach $key ( %R )
        {
           ${$pasn_id}{ $key } = $R{ $key };
        }
    }
    return( $found );
}


#*
#* GET_OLD_MEMBERS ------------------------------------------------------
#*
sub get_old_members
{
    my( $dbp, $asn_id ) = @_;
    my( %R, $pasn_id );
    my( @previous_members );

    $pasn_id = "P" . $asn_id;

    #
    # Let's get previous value for this association member
    #

    $sql = "select *
	    from $ASN_MAINT_MEMBER 
	    where asn_id = \"$asn_id\" and
                  asn_creation_date = \"${$pasn_id}{'asn_creation_date'}\" ";

    &dosql( $dbp, $sql );
    while( %R = $dbp->dbnextrow(1) )
    {
       $pds = "P" . $R{'dataset_name'};
       foreach $kw ( %R )
       {
          ${$pds}{$kw} = $R{ $kw };
       }

       push ( @previous_members, $pds );
    }
    return ( @previous_members );
}
#--
1;