#!/usr/bin/perl

# Routine to make preliminary PDS labels from the information in the 
# FITS headers of the IRSP FITS files.
#
# Format: % makelbl irsp.hdr
#
# Output is to irsp.lbl
#
# 12 May 2006, A.C.Raugh
#=======================================================================

if (@ARGV==0)
  { die "Usage: makelbl irsp.hdr\n"; }

foreach $file (@ARGV)
  { if ($file !~ /\.hdr/)
      { printf STDERR "$file is not a FITS header, is it?\n";
        next;
      }

    # Find and open files:

    $name = $file;
    $name =~ s/\.hdr//;

    $outfile = "$name.lbl";
    $datfile = "$name.dat";
    $tabfile = "$name.tab";

    $FILE = "$name.tab";
    $FILE =~ tr/a-z/A-Z/;

    open(FIT,$file) || die "Could not open $file for reading ($!)";
    open(LBL,"| ppodl -p >temp/$outfile") || 
        die "Could not open $outfile for writing ($!)";

    # We'll completely parse the FITS header first, then write the label.

    $processing_level = "3";
    $cc = 0;
    read FIT, $line, 80;
    $lc = 1;
    while ($line !~ /^END /)
      { if ($line =~ /^NAXIS1/)
          { $columns = substr($line,27,3); }
        elsif ($line =~ /^NAXIS2/)
          { $rows   = substr($line,27,3); }
        elsif ($line =~ /^OBJECT/)
          { $target = substr($line,11,60);
            $target =~ s/'\s+$//;
            if ($target =~ /HALLEY/)
              { $target = "1P/HALLEY 1 (1682 Q1)";
                undefine $target_desc if ($target_desc);
              }
            else
              { $target =~ s/\s+$//;
                $target_desc = $target;
                $target = "CALIBRATION";
              }
          }
        elsif ($line =~ /^FILE-NUM/)
          { $filenum = substr($line,24,6); }
        elsif ($line =~ /^DATE-OBS/)
          { $dd = substr($line,11,2);
            $mm = substr($line,14,2);
            $yy = substr($line,17,2);
            $date = "19$yy-$mm-${dd}T";
          }
        elsif ($line =~ /^TIME-OBS/)
          { $d = substr($line,20,10);
            $d = $d * 24.0;
            $hh = int($d);
            $d = ($d - $hh) * 60.0;
            $mm = int($d);
            $time = sprintf "%02d:%02d",$hh, $mm;
          }
        elsif ($line =~ /^LONG-OBS/)
          { $dd = substr($line,11,3);
            $mm = substr($line,15,2);
            $ss = substr($line,18,2);
            $val = ($dd * 1.0) + ($mm / 60.0) + ($ss / 3600.0);
            $obs_long = sprintf "%8.4f",$val;
          }
        elsif ($line =~ /^LAT--OBS/)
          { $s  = substr($line,11,1);
            $dd = substr($line,12,2);
            $mm = substr($line,15,2);
            $ss = substr($line,18,2);
            $val = ($dd * 1.0) + ($mm / 60.0) + ($ss / 3600.0);
            $obs_lat = sprintf "%s%07.4f",$s,$val;
          }
        elsif ($line =~ /^SYSTEM/)
          { $system = substr($line,11,8); }
        elsif ($line =~ /^OBSERVER/)
          { $line =~ /'(.*)'\s+$/;
            $observer = $1;
          }
        elsif ($line =~ /^INSTRUME/)
          { $instrument = substr($line,11,60);
            $instrument =~ s/'\s+$//;
          }
        elsif ($line =~ /^OBSVTORY/)
          { $observatory = substr($line,11,60);
            $observatory =~ s/'\s+//;
          }
        elsif ($line =~ /^LOCATION/)
          { $location = substr($line,11,60);
            $location =~ s/'\s+//;
          }
        elsif ($line =~ /^TELESCOP/)
          { $telescope = substr($line,11,60);
            $telescope =~ s/'\s+//;
          }
        elsif ($line =~ /^BSCALE/)
          { $scale = substr($line,11,20);
            $scale =~ s/\s+//g;
          }
        elsif ($line =~ /^RANGE-SP= '(.*) *'/)
          { $spec_range = $1; }
        elsif ($line =~ /^RESOL-SP= '(.*) *'/)
          { $spec_res = $1; }
        elsif ($line =~ /^APERSIZE= '(.*) *'/)
          { $aperture = $1; }
        elsif ($line =~ /^COMMENT/)
          { $val = substr($line,10,70);
            $val =~ s/\s+$//;
            $val =~ s/"/''/g;
            $comment[$cc] = "  $val";
            $cc++;

            if ($line =~ /raw /)
              { $processing_level = 1; }
          }
        elsif ($line =~ /^HISTORY/)
          { $val = substr($line,10,70);
            $val =~ s/\s+$//;
            $comment[$cc] = "  $val";
            $cc++;

            if ($line =~ /raw /)
              { $processing_level = 1; }
          }

        # Next line:

        read FIT,$line,80;
        $lc++;
      }

    # Done with the FITS header:

    close(FIT);

    $start_time = $date . $time;

    # Now we write the PDS label:

    printf LBL "PDS_VERSION_ID = PDS3\n\n";
    printf LBL "RECORD_TYPE = \"FIXED_LENGTH\"\n";
    printf LBL "RECORD_BYTES =  \n";
    printf LBL "FILE_RECORDS = $rows\n\n";
    printf LBL "DATA_SET_ID = \"IHW-C-IRSPEC-3-EDR-HALLEY-V2.0\"\n";
    printf LBL "PRODUCT_ID = \"$name\"\n";
    printf LBL "PRODUCT_NAME = \"IHW IR SPECTROSCOPY $filenum\"\n";
    printf LBL "PRODUCT_CREATION_TIME = 2006-05-12\n";
    printf LBL "\n";
    printf LBL "INSTRUMENT_HOST_NAME = \"IHW INFRARED STUDIES NETWORK\"\n";
    printf LBL "INSTRUMENT_HOST_ID = \"IRSN\"\n";
    printf LBL "INSTRUMENT_NAME = \"IHW INFRARED SPECTROSCOPY DATA\"\n";
    printf LBL "INSTRUMENT_ID = \"IRSPEC\"\n";
    printf LBL "TARGET_NAME = \"$target\"\n";
    printf LBL "TARGET_DESC = \"$target_desc\"\n" if ($target_desc);
    printf LBL "START_TIME = $start_time\n";
    printf LBL "STOP_TIME = \"UNK\"\n";
    printf LBL "OBSERVATION_TIME = $start_time\n";
    printf LBL "PROCESSING_LEVEL_ID = \"$processing_level\"\n";
    printf LBL "OBSERVATION_ID = \"$filenum\"\n";
    printf LBL "OBSERVER_FULL_NAME = \"$observer\"\n";
    printf LBL "\n";
    printf LBL "DESCRIPTION = \"\n";
    printf LBL "System code: $system\n";
    printf LBL "Observatory Info\n";
    printf LBL "            Name: $observatory\n";
    printf LBL "        Location: $location\n";
    printf LBL "  East Longitude: $obs_long\n";
    printf LBL "  North Latitude: $obs_lat\n";
    printf LBL "       Telescope: $telescope\n";
    printf LBL "      Instrument: $instrument\n";
    printf LBL "  Spectral Range: $spec_range microns\n";
    printf LBL "      Resolution: $spec_res microns\n";
    printf LBL "   Aperture Size: $aperture arcseconds\n";
    printf LBL "\n";
    printf LBL "Comments from the FITS header:\n";
    printf LBL "\n";
    for ($i=0; $i<$cc; $i++)
      { printf LBL "$comment[$i]\n"; }
    printf LBL "\"\n";
    printf LBL "\n";
    printf LBL "NOTE = \"\n";
    printf LBL "  The START_TIME listed is actually the OBSERVATION_TIME,\n";
    printf LBL "  i.e., the midpoint of the observation.  Exposure times\n";
    printf LBL "  were not reported, so it was not possible to determine\n";
    printf LBL "  the actual starting time of the observation.  However, \n";
    printf LBL "  START_TIME is a keyword used to search for data across\n";
    printf LBL "  large sections of the PDS archives, so the midpoint \n";
    printf LBL "  time has been repeated as the START_TIME to prevent \n";
    printf LBL "  these data being lost for want of a more accurate\n";
    printf LBL "  value.\n";
    printf LBL "  \"\n";
    printf LBL "\n";
    printf LBL "^TABLE = \"$FILE\"\n";
    printf LBL "\n";
    printf LBL "OBJECT = TABLE\n";
    printf LBL "INTERCHANGE_FORMAT = \"ASCII\"\n";
    printf LBL "ROWS = $rows\n";
    printf LBL "ROW_BYTES = \n";
    printf LBL "COLUMNS = $columns\n";
    printf LBL "\n";
    printf LBL "OBJECT = COLUMN\n";
    printf LBL "COLUMN_NUMBER = 1\n";
    printf LBL "NAME = \"WAVELENGTH\"\n";
    printf LBL "START_BYTE = 1\n";
    printf LBL "BYTES = \n";
    printf LBL "DATA_TYPE = \"ASCII_REAL\"\n";
    printf LBL "FORMAT = \n";
    printf LBL "UNIT = \"MICRON\"\n";
    printf LBL "END_OBJECT = COLUMN\n";
    printf LBL "\n";
    printf LBL "OBJECT = COLUMN\n";
    printf LBL "COLUMN_NUMBER = 2\n";
    printf LBL "NAME = \"FLUX\"\n";
    printf LBL "START_BYTE = \n";
    printf LBL "BYTES = \n";
    printf LBL "DATA_TYPE = \"ASCII_REAL\"\n";
    printf LBL "FORMAT = \n";
    printf LBL "UNIT = \"WATT/CM^2/MICRON\"\n";
    printf LBL "SCALING_FACTOR = \n";
    printf LBL "DESCRIPTION = \n";
    printf LBL "END_OBJECT = COLUMN\n";
    printf LBL "\n";
    printf LBL "OBJECT = COLUMN\n";
    printf LBL "COLUMN_NUMBER = 3\n";
    printf LBL "NAME = \"ERROR\"\n";
    printf LBL "START_BYTE = \n";
    printf LBL "BYTES = \n";
    printf LBL "DATA_TYPE = \"ASCII_REAL\"\n";
    printf LBL "FORMAT = \n";
    printf LBL "UNIT = \"WATT/CM^2/MICRON\"\n";
    printf LBL "SCALING_FACTOR = \n";
    printf LBL "DESCRIPTION = \n";
    printf LBL "END_OBJECT = COLUMN\n";
    printf LBL "\n";
    printf LBL "END_OBJECT = TABLE\n";
    printf LBL "\n";
    printf LBL "END\n";

    # Done with the label:

    close(LBL);

    # Now we call a routine to process the .dat file so we can generate
    # the beginnings of a table file.  We'll apply the scaling factor.

    open (DAT,"gettab $datfile $rows $columns |") ||
      die "Could not open data file pipe ($!)";
    open (TAB,">temp/$tabfile") || die "Could not open table file ($!)";

    while ($line=<DAT>)
      { chop $line; 
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        @val = split(/\s+/,$line);
        for ($i=0; $i<@val; $i++)
          { $val[$i] = $val[$i] * $scale; 
            printf TAB "%20.10f ", $val[$i];
          }
        printf TAB "\r\n";
      }

    close(DAT);
    close(TAB);

    # Next file:

  }