###############################################################################
# Perl module containing base subroutines and functions for handling the 
# 2dF QSO Redshift Survey (2QZ) catalogue and related files.  Can also
# be used on 6QZ (same format!).
#
# Written by Scott Croom (18/02/01)
#
# v1.1 SMC: 06/03/01 Added sector entry to catalogue.
# v2.0 SMC: 14/06/01 Added class and methods for a line from a 
#                    .dcheckedresults file.
# v2.1 SMC: 26/10/01 Updated for 4th decimal place in redshift for wline.
# v2.2 SMC: 06/12/01 SpecID class updated to take value 'auto' to let the
#                    user decide whether to use AUTOZ or checked IDs.
# v2.3 SMC: 24/01/02 Added a routine rlinerep to read a line of the repeats
#                    files.
# v2.4 SMC: 02/05/02 sector string length increased after addition of MGC 
#                    fields to 25 characters
# v2.5 SMC: 06/05/02 Extended the length of the extracted string for
#                    IDs by one (to 8) in the getpars method for the specID
#                    class.
# v2.6 SMC: 07/05/02 Now do check for IDs with ?? quality but actual IDs and
#                    set them to ?? IDs instead (done in translate_quality
#                    method)..
# v2.7 SMC: 30/05/02 Fix for IDs with ?? quality but actual IDs moved to
#                    the translate_IDs method, to stop problems with
#                    cont IDs.
# v2.8 SMC: 21/02/03 Fix a bug with AUTOLOAD method for versions of perl
#                    later than 5.005.  This was to do with DESTROYing
#                    objects when they have been finished with.
# v2.9 SMC  05/06/03 Removed SpecID class from this package and put it
#                    into its own package.  Also remove data_check 
#                    subroutine as it used the old date format.  Tidy
#                    up for public release.
# v3.0 SMC  09/06/03 Update repeats file format to include positions
#                    and magnitudes.  Also add wlinerep routine
#
################################################################################
#                                                                              #
#          LICENCE                                                             #
#                                                                              #
#          This program is free software; you can redistribute it and/or       #
#          modify it under the terms of the GNU General Public License         #
#          as published by the Free Software Foundation; 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, Inc., 59 Temple Place - Suite 330,                      #
#          Boston, MA  02111-1307, USA.                                        #
#                                                                              #
################################################################################
#
# standard package stuff:
package TWOQZ_CAT;
use Exporter ();
@ISA    = qw(Exporter);
@EXPORT = qw(rline wline wlinepub rlinepub $iauname $ra1j $ra2j 
$ra3j $dsigncharj $dec1j $dec2j $dec3j $catno $catname $ra1 $ra2 $ra3 
$dsignchar $dec1 $dec2 $dec3 $ukstfld $apmx $apmy $rarad $decrad $b $ub $br 
$nobs $z1 $zq1 $id1 $date1 $fobs1 $fibre1 $sn1 $z2 $zq2 $id2 $date2 $fobs2 
$fibre2 $sn2 $zprev $radio $xray $dust $comment1 $comment2 $raradj $decradj 
$dsignj $dsign $sector date_fix rlinerep wlinerep readcents);
@EXPORT_OK = qw();

# Version control:
$VERSION="3.0";
BEGIN {print "TWOQZ_CAT module version 3.0\n";}

###############################################################################
# function to fix up the date so that 990101 -> 19990101 etc.
#
# usage: date_fix($indate)

sub date_fix {
    my $indate = shift @_;
    if ($indate < 900000) {
	$indate=$indate+20000000;
    }
    else {
	$indate=$indate+19000000;
    }    
    return $indate;
}

###############################################################################
# The rline subroutine to read a catalogue entry line:
#
# Log of old changes:
#
# 9/10/98:  Extra element for E(B-V) value added.  
#           ID string lengthened to 10 characters.
#
# 9/12/98:  Third routine added: WFULLLINE which 
#           writes out every element again (not just
#           the ones which might have changed).
#           + slight alterations to handling of 
#           declination signs.
#
# 4/2/99:   fixed bug in WLINE and WFULLLINE for zq2.
#
# 20/4/99:  further alterations to handling of declination signs
#           write $dec1 as a string to keep the format +01 or -01
#           rather than potentially + 1 or --1 in wfullline.
#
# 7/7/99:   changed fobs1,fobs2 handling now a 4 digit number, with 
#           the last number being a 1 or 2 denoting which spectrograph 
#           is used.
#
# 1/10/99:  increased the size of the catname entry to 10 characters
#           so that we have a north/south indentifier. e.g. TQ123_123
#           now becomes TQN123_123 in the NGP catalogue (really should
#           have been like this from the start).
#
# 07/08/00: Update of catalogue format to include signal-to-noise ($sig1/2)
#           and fibre number ($fibre1/2).
#
# 03/11/00: updated to include IAU names, J2000 Ra/Dec and comments.  Only 
#           use wfullline (change its name to wline).  Also add wshortline 
#           write a smaller (but useful) number of parameters.
#

sub rline {
    my @tmp=split(/\s+/," ".$_[0]);
    $iauname=$tmp[1];
    $ra1j=$tmp[2];
    $ra2j=$tmp[3];
    $ra3j=$tmp[4];
    $dec1j=$tmp[5];
    $dec2j=$tmp[6];
    $dec3j=$tmp[7];
    $catno=$tmp[8];
    $catname=$tmp[9];
    $sector=$tmp[10];
    $ra1=$tmp[11];
    $ra2=$tmp[12];
    $ra3=$tmp[13];
    $dec1=$tmp[14];
    $dec2=$tmp[15];
    $dec3=$tmp[16];
    $ukstfld=$tmp[17];
    $apmx=$tmp[18];
    $apmy=$tmp[19];
    $rarad=$tmp[20];
    $decrad=$tmp[21];
    $b=$tmp[22];
    $ub=$tmp[23];
    $br=$tmp[24];
    $nobs=$tmp[25];
    $z1=$tmp[26];
    $zq1=$tmp[27];
    $id1=$tmp[28];
    $date1=$tmp[29];
    $fobs1=$tmp[30];
    $fibre1=$tmp[31];
    $sn1=$tmp[32];
    $z2=$tmp[33];
    $zq2=$tmp[34];
    $id2=$tmp[35];
    $date2=$tmp[36];
    $fobs2=$tmp[37];
    $fibre2=$tmp[38];
    $sn2=$tmp[39];
    $zprev=$tmp[40];
    $radio=$tmp[41];
    $xray=$tmp[42];
    $dust=$tmp[43];
    $comment1=$tmp[44];
    $comment2=$tmp[45];
# set up checks for declination sign:
    $dsign=1.0;
    $dsignchar="+";
    if ($dec1 =~ /-/) {
	$dsign=-1;
	$dsignchar="-";
    }
    $dsignj=1.0;
    $dsigncharj="+";
    if ($dec1j =~ /-/) {
	$dsignj=-1;
	$dsigncharj="-";
    }
# remove signs (-/+) from declination:
    $dec1=~s/-//;
    $dec1=~s/\+//;
    $dec1j=~s/-//;
    $dec1j=~s/\+//;
    return;
}
###############################################################################
# wline(): subroutine to write 2QZ catalogue entries to a single string
#
# 02/05/02 (SMC): updated to have sector string 25 chars long
#
sub wline {
# truncate ID comments to 10 characters:
    my $id1a=substr($id1,0,10);
    my $id2a=substr($id2,0,10);
# truncate comments to 20 characters (should already 
# be only 20 but we'll just check):
    my $comment1a=substr($comment1,0,20);
    my $comment2a=substr($comment2,0,20);
# if comment field is blank just add a "-":
    if ($comment1a !~ /\w/) {$comment1a="-";}
    if ($comment2a !~ /\w/) {$comment2a="-";}
# Write all the data to a string:
    my $line=sprintf("%16s %2s %2s %5.2f %1s%2s %2s %4.1f %5d %10s %-25s %2d %2d %5.2f %1s%2s %2d %4.1f %3s %9.2f %9.2f %11.8f %11.8f    %6.3f   %7.3f   %7.3f  %2d %6.4f %2d %-10s %-8s %4s %3d %7.2f %6.4f %2d %-10s %-8s %4s %3d %7.2f %5.3f %6.1f %7.4f %7.5f %-20s %-20s",$iauname,$ra1j,$ra2j,$ra3j,$dsigncharj,$dec1j,$dec2j,$dec3j,$catno,$catname,$sector,$ra1,$ra2,$ra3,$dsignchar,$dec1,$dec2,$dec3,$ukstfld,$apmx,$apmy,$rarad,$decrad,$b,$ub,$br,$nobs,$z1,$zq1,$id1a,$date1,$fobs1,$fibre1,$sn1,$z2,$zq2,$id2a,$date2,$fobs2,$fibre2,$sn2,$zprev,$radio,$xray,$dust,$comment1a,$comment2a);
    return $line;
}
###############################################################################
# subroutine to write a catalogue entry in the format of the old (10k) 
# public 2QZ catalogue.  This is now obselete, but it retained for backwards
# compatibility:
sub wlinepub {
    $start=shift;
    $line=sprintf ("%3s %16s %2s %2s %5.2f %1s%2s %2s %4.1f %8.6f %9.6f %5.2f %5.2f %6.2f %1d %6.4f %2d %-11s %-8s %4s %6.2f %6.4f %2d %-11s %-8s %4s %6.2f %5.3f %6.1f %7.4f %5.3f",$start,$iauname,$ra1j,$ra2j,$ra3j,$dsigncharj,$dec1j,$dec2j,$dec3j,$raradj,$decradj,$b,$ub,$br,$nobs,$z1,$zq1,$id1,$date1,$fobs1,$sn1,$z2,$zq2,$id2,$date2,$fobs2,$sn2,$zprev,$radio,$xray,$dust);
    return $line;

}
###############################################################################
# subroutine to read a catalogue entry in the format of the old (10k) 
# public 2QZ catalogue.  This is now obselete, but it retained for backwards
# compatibility:
sub rlinepub {
    ($dum,$iauname,$ra1j,$ra2j,$ra3j,$dec1j,$dec2j,$dec3j,$raradj,$decradj,$b,$ub,$br,$nobs,$z1,$zq1,$id1,$date1,$fobs1,$sn1,$z2,$zq2,$id2,$date2,$fobs2,$sn2,$zprev,$radio,$xray,$dust)=split(/\s+/,$_[0]);
# set up checks for declination sign:
    if ($dec1j =~ /-/) {
	$dsignj=-1;
	$dsigncharj="-";
    }
    else {
	$dsignj=1.0;
	$dsigncharj="+";
    }
# remove signs (-/+) from declination:
    $dec1j=~s/-//;
    $dec1j=~s/\+//;
    return;
}
###############################################################################
# A subroutine to read in the line of a catalogue repeats file
#
sub rlinerep {
    my @tmp=split(/\s+/," ".$_[0]);
    $iauname=$tmp[1];
    $ra1j=$tmp[2];
    $ra2j=$tmp[3];
    $ra3j=$tmp[4];
    $dec1j=$tmp[5];
    $dec2j=$tmp[6];
    $dec3j=$tmp[7];
    $catname=$tmp[8];
    $b=$tmp[9];
    $ub=$tmp[10];
    $br=$tmp[11];
    $z1=$tmp[12];
    $zq1=$tmp[13];
    $id1=$tmp[14];
    $date1=$tmp[15];
    $fobs1=$tmp[16];
    $fibre1=$tmp[17];
    $sn1=$tmp[18];
    $nobs=$tmp[19];
    $comment1=$tmp[20];
# sort out signs:
    if ($dec1j =~ /-/) {
	$dsignj=-1;
	$dsigncharj="-";
    }
    else {
	$dsignj=1.0;
	$dsigncharj="+";
    }
# remove signs (-/+) from declination:
    $dec1j=~s/-//;
    $dec1j=~s/\+//;    return;
}
###############################################################################
# a subroutine to write the line of a catalogue repeats file. Note that
# for this we need to pass some variables, and not rely on implicit
# passing of global variables.  The variables passed are specific to this
# observation, not the object observed.
#
sub wlinerep {
    my $id = shift;
    my $z = shift;
    my $qual = shift;
    my $date = shift;
    my $fobs = shift;
    my $fibre = shift;
    my $sn = shift;
    my $nobs = shift;
    my $comment = shift;
    my $repline = sprintf("%16s %2s %2s %5.2f %1s%2s %2s %4.1f %10s %6.3f %7.3f %7.3f %6.4f %2d %-10s %8s %04d %3d %7.3f %2d %-20s",$iauname,$ra1j,$ra2j,$ra3j,$dsigncharj,$dec1j,$dec2j,$dec3j,$catname,$b,$ub,$br,$z,$qual,$id,$date,$fobs,$fibre,$sn,$nobs,$comment);
    return $repline;
}

###############################################################################
# A subroutine to read a field centres file and place the RA and Dec (in
# radians) into a hash
# 
sub readcents {
    my $centfile = shift;
    print "reading field centres... ";
    open(CENT, $centfile);
    my ($line,$fldname,$rac,$decc);
    my (@tmp,%ra,%dec);
    my $nlines=0; 
    my $pi = atan2(1,1) * 4;
    while($line = <CENT>) {
	chomp($line);
	$line = " ".$line;
	@tmp=split(/\s+/,$line);
	if ($tmp[5] < -20) {
	    $fldname="sgp".$tmp[1];
	}
	else {
	    $fldname="ngp".$tmp[1];
	}
	$rac=($tmp[2]+$tmp[3]/60.0+$tmp[4]/3600.0)*15.0*$pi/180.0;
	$decc=(abs($tmp[5])+$tmp[6]/60.0+$tmp[7]/3600.0)*$pi/180.0;
	if ($tmp[5] =~ /-/) {
	    $decc=-1.0*$decc;
	}
	$ra{$fldname}=$rac;
	$dec{$fldname}=$decc;
	$nlines++;
    }
    close(CENT);
    print "done, $nlines lines read.\n";
    return(\%ra,\%dec);
}

###############################################################################
###############################################################################
# THE CATALOGUE FORMAT:
#
# last updated 03/06/01 (SMC)
#
# IAU_name RA_J2000(hh mm ss.ss) Dec_J2000(dd mm ss.s) Object_no 
#
# object_ID sector RA(hh mm ss.ss)  Dec(dd mm ss.s)  UKST_field  APM_x  
#
# APM_y  RA_radians Dec_radians  bj_mag  u-bj_col  bj-r_col  no_of_obs
#
# z1  z1_qual  ID1  date1  2df_fld_no1(last digit = spectrograph) fibre1 S/N1
#
# z2  z2_qual  ID2  date2  2df_fld_no2(last digit = spectrograph) fibre1 S/N1
#
# z_prev  radio_flux  xray_flux Schlegel_dust_value comments1 comments2
#
#
# Alternative catalogue format list, giving the entry for each column:
#
# col.    Entry
# 
#  1     IAU name 
#  2     RA(J2000) hours
#  3     RA(J2000) minutes
#  4     RA(J2000) seconds
#  5     Dec(J2000) degrees
#  6     Dec(J2000) arcminutes
#  7     Dec(J2000) arcseconds
#  8     Object number
#  9     Object catalogue name
# 10     Sector
# 11     RA(B1950) hours    
# 12     RA(B1950) minutes
# 13     RA(B1950) seconds
# 14     Dec(B1950) degrees
# 15     Dec(B1950) arcminutes
# 16     Dec(B1950) arcseconds
# 17     UKST field number
# 18     APM x position
# 19     APM y position
# 20     RA(B1950) radians
# 21     Dec(B1950) radians
# 22     b_J magnitude
# 23     u-b_J colour
# 24     b_J-r colour
# 25     Number of spectroscopic observations
# 26     Redshift 1
# 27     Quality 1
# 28     ID 1
# 29     Date of observation 1
# 30     2dF field number 1 (including spectrograph, last digit = spectrograph)
# 31     fibre 1
# 32     Signal-to-noise 1
# 33     Redshift 2
# 34     Quality 2
# 35     ID 2
# 36     Date of observation 2
# 37     2dF field number 2 (including spectrograph, last digit = spectrograph)
# 38     fibre 2
# 39     Signal-to-noise 2
# 40     Previously known redshift (Veron & Veron 2000)
# 41     NVSS radio flux
# 42     RASS X-ray flux
# 43     E(B-V) from Schlegel et al (1998)
# 44     Comments 1
# 45     Comments 2
#
#------------------------------------------------------------------------------
# The catalogue file is designed to be free format, so every object has to have
# an entry irespective of whether an observation has been made.  Any field with
# a "-" is basically a blank field.