#!/usr/bin/perl 

# Script to "stashsplit" pp-fields
#
# Note that we attempt to do byte-reordering, in the 
# sense that if Reorder is set (default) bytes are
# swapped from 01234567... to 32107654...
# If the first number read (which should be the length of
# the first header, 256 bytes) is not 256, it will try 
# inverting Reorder.
# If this script is running on an alpha or on linux, you
# probably need Reorder set (default).
#
# Use: pp2ss.pl [options] ppfile 
#  or: cat ppfile | pp2txt.pl [options] 
#
# Options: OUTBASE=dir/ - (NB trailing slash!) - output directory, else use .
#          SC=SC1,SC2...,SCn - Stashcodes to output (else all)
#          LBLEV=lev1,lev2...,levn - levels to output (nb this is the lblev parameter, thus applies
#                                    in all cases (eg is 8888 for MSLP)
#          BLEV=blev1,blev2,...blevn - ditto, for blev
#          or
#          SC=SC1+BLEV=blev1%blev2+LBLEV=lblev,SC2...
#          (If this first form is used, *all* fields have to match SC *and* levels (if given);
#           If the second form is used, fields match case-by-case)
#          (example: SC=16202+BLEV=500%300,16203+LBEV=1%2%3)
#          Outmode=">" or ">>" (or indeed any of perls other magics...)
#          T=1 - test mode. Don't write
#
# ...with output to stash-split files
#
# Notes: the handling of the "period" bit isn't as good
# as pp_period. I just do lbyrd-lbyr, etc. This should
# suffice for standard model run output.
#
# Author: wmc 2001/10/11

# Options
$D=0;		# Debug
$T=0;		# Test mode
$SC=undef;	# Comma separated list of desired stash codes
$LBLEV=undef;	# Ditto for lblev
$BLEV=undef;	# Ditto for blev
$OutMode=">"; 	# New or Append
$oldoutfile=""; # So we know to append to multiple fields-in-file
$Sub=1;		# Include submodel identifier in SS name from lbuser[6]
$Reorder=0;	# Swap endians on input for purposes of interpretation. Set to =1 to swap. Will auto-sense.
$Outorder=1;    # Swap endians on output (independent of Reorder). Note: correct use is
                # probably Reorder=0 and Outorder=1
$FieldNo=0;	# Field number, for debug output
$OUTBASE="";	# Base for output filenames. Default current directory. Don't forget the trailing "/"

# Override options, eg "pp2ss.pl SC='1,16222'
eval "\$$1=\$2" while $ARGV[0] =~ /^(\w+)=(.*)/ && shift;

if ($OutMode =~ /Append/i) { $OutMode = ">>" };

# Make an assoc array of stashcodes, if desired
if ($SC) { for $SC (split(/,/,$SC)) { 
# If we have selected it as SC+BLEV=blev or somesuch, then...
  if ($SC=~/\+/) {
    ($sc,@a)=split(/\+/,$SC);
    for (@a) {
      ($a1,$a2)=split(/=/); 
      for $v (split(/\%/,$a2)) {
        if ($a1 eq "BLEV") { $v=sprintf("%.3f",$v) };
        ${"$sc"."_"."$a1"}{$v}=1; 
      }
    };  
# Otherwise include it in the normal SC list. Note that if we include SC twice
# in the two ways we can get it into both lists (is this useful!?!)
  } else {
    $SC{$SC}=1 
  }
} };
# Make an assoc array of (l)blev's, if desired
if ($LBLEV) { for $lblev (split(/,/,$LBLEV)) { $LBLEV{$lblev}=1 } };
if ($BLEV) { for $blev (split(/,/,$BLEV)) { $tblev=sprintf("%.3f",$blev); $BLEV{$tblev}=1 } };
  
while ($File = shift) { 

if ($D) { print "$File\n" };

open STDIN,$File or die "Failed to open $File";

# Read in the length of the first header. Expect 256.
while (read(STDIN,$IN,4)) {

  $INs=$IN;

  if ($Reorder) { $IN=byteorder($IN) };
  $rl=unpack("i",$IN);
  if ($rl != 256) { 
    print "Record length is $rl not 256 as I expected. I'll try (un)setting Reorder\n";
    $Reorder=1-$Reorder;
    $IN=byteorder($IN);
    $rl=unpack("i",$IN);
    if ($rl != 256) { die "Record length is *still* not 256, its $rl" }
  };
  if ($D > 2) { print "Read in header record length $rl\n" };

# Read in the integer part of the header (45 integers) and the real part (19 reals)
  read(STDIN,$IN,4*45);
  $INs.=$IN;
  if ($Reorder) { $IN=byteorder($IN) };
  @ih=unpack("i45",$IN);
  read(STDIN,$IN,4*19);
  @rh=unpack("f45",$IN);
  $INs.=$IN;
  if ($Reorder) { $IN=byteorder($IN) };

# Read in the trailer for the header
  read(STDIN,$IN,4);
  $INs.=$IN;

# Read the length of the data record
  read(STDIN,$IN,4); 
  $INs.=$IN;
  if ($Reorder) { $IN=byteorder($IN) };
  $rl=unpack("i",$IN);
  if ($D >2) { print "Read in data record length $rl\n" };

# Read the data but don't bother unpack it
  read(STDIN,$IN,$rl);
  $INs.=$IN;

# Read in the length of the record again, in case its a multi-field file
  read(STDIN,$IN,4); 
  $INs.=$IN;

# Make the SS filename. This also makes all the codes in the
# name available, eg lbuser[3] as sc
  $outfile = ${OUTBASE} . ss_filename();

# Debug info
  if ($D > 1) { 
    print "F",$FieldNo++,": $lbyr/$lbmon/$lbdat $lbhr:$lbmin $sc ($lblev, $tblev)\n" 
  };

# Write it out, if desired
# print "$sc"."_BLEV ($blev / $tblev) [".${"$sc"."_BLEV"}{$tblev}."]\n";
# print "$sc"."_LBLEV ($lblev / $lblev) [".${"$sc"."_LBLEV"}{$lblev}."]\n";

  if (${"$sc"."_BLEV"}{$tblev} or ${"$sc"."_LBLEV"}{$lblev}
      or
      ((!$SC or $SC{$sc}) and (!$LBLEV or $LBLEV{$lblev}) and (!$BLEV or $BLEV{$tblev}))) {
    if (!$T) {
      if ($D >1) { print "Writing to: $outfile\n" };
      if ($outfile ne $oldoutfile) { open OUT, "$OutMode $outfile" or warn $! };
      $oldoutfile=$outfile;
      if ($Outorder) { 
        if ($D >2) { print "Swapping endians on output\n" };
        $INs=byteorder($INs) 
      };
      print OUT $INs
    } else {
      print "Would write to: $outfile\n";
    };
  };
};
 
};

# ---------------------------------------------------------

sub ss_filename {

$lbyr  = $ih[0];
$lbmon = $ih[1];
$lbdat = $ih[2];
$lbhr  = $ih[3];
$lbmin = $ih[4];
$lbtim = $ih[12];

$lblev = $ih[32];
$blev = $rh[6];
$tblev=sprintf("%.3f",$blev);

$lbtim1=$lbtim/10 % 10;
if ($lbtim1 == 0) {
  $per="0000000000"
} else {
  $p1=$lbmin +($lbhr +($lbdat+($lbmon+$lbyr *12)*30)*24)*60;
  $p2=$ih[10]+($ih[9]+($ih[8]+($ih[7]+$ih[6]*12)*30)*24)*60;
  $p=$p2-$p1;

  $dmin=$p % 60; $p-=$dmin; $p/=60;
  $dhr =$p % 24; $p-=$dhr ; $p/=24;
  $ddat=$p % 30; $p-=$ddat; $p/=30;
  $dmon=$p % 12; $p-=$dmon; $p/=12;
  $dyr =$p;
 
  $per=sprintf("%4.4d%2.2d%2.2d%2.2d%2.2d",$dyr,$dmon,$ddat,$dhr,$dmin);
};

$date=sprintf("%4.4d.%2.2d.%2.2d.%2.2d.%2.2d",
              $lbyr,$lbmon,$lbdat,$lbhr,$lbmin
             );

$lbproc= $ih[24];
$pc=sprintf("%6.6d",$lbproc);

$sc   = $ih[41];
$sc1=sprintf("%2.2d.%3.3d",$sc/1000,$sc % 1000);

if ($Sub != 0) {
  $submodel=$ih[44];
  $sub=sprintf("%2.2d.",$submodel)
};

return "$per.$sub$sc1.$pc.$date.pp";

};

sub byteorder {

  ($In)=@_;

  for ($i=0; $i<(length($In)-1)/4; $i++) {
    substr($In,$i*4,4)=reverse(substr($In,$i*4,4));
  };

  return $In;

};