#!/bin/perl -w

# Script to decode (very partially) a land or ship synop
#
# Note that certain groups (LA, LO, ICE) will be null if we're a land synop
# Note that a null is returned if some serious error occurs.
#
# WMC: early/97 - original
# WMC: 30/04/97 - add conversion of m/s to kts if required
# WMC: 29/07/97 - realise that DEWT can be coded as 29rel: fix code to throw this case away
# WMC: 20/11/97 - return null in wind group bit if message null
#
# This script comes with no warranty of its fitness for any purpose.
# In fact, I guarantee that there are bugs in it somewhere.
# Use it non-commercially as you will; but don't come back and complain about problems.
#
# - W. M. Connolley July 1997.

require "guess_mon_year.pl";

sub decode_synop {
  my(@GROUPS)=split(' ',$_[0]);
  my($TYPE,$NAME,$YEAR,$MON,$DAY,$HOUR,$LA,$Q,$LO,$T,$TOTAL_CLOUD,$DIR,$SPD,$IW,%IWs,$ICE,$DEWT,$PSTA);
  my($PTND,$PTND_code,$PTND_value,$PPN,$PPN_code,$PPN_value);
  my($H,$Ir,$Ix,$CLOUD_H,$VV);
  my($WW,$W1,$W2,$WEATHER);
  my($NH,$CL,$CM,$CH,$CLOUD);
  my($V,@VALUES);
  
# Get type - AAXX or BBXX. Return null if not one of the two.
  $TYPE=shift @GROUPS;
  if ($TYPE !~ /^(AAXX|BBXX)$/) { if ($DEBUG > 1) { warn "Returing null since wrong type" }; return '' };

# If this is a land group, exchange the first two groups
  if ($TYPE eq "AAXX") {@GROUPS[0,1]=@GROUPS[1,0]};

# Get identifier
  $NAME=shift @GROUPS;
  if ($DEBUG > 1) { warn "Id is $NAME" };

# Now, check that the rest of the message (up to  333/444/555/ICE) consists of 5 figure groups
# Groups that aren't 5 figures get deleted.
  for ($I=0; $I<$#GROUPS; $I++) { 
    last if ($GROUPS[$I] =~ /333|444|555|ICE/);
    if (length($GROUPS[$I]) != 5) { splice(@GROUPS,$I,1) } 
  };

# Get date (day and hour)
  $DAY=substr($GROUPS[0],0,2);
  $IW=substr($GROUPS[0],4,1);
  $HOUR=substr(shift @GROUPS,2,2);
  %IWs=(0, "m/s -> kts (estimated)", 1, "m/s -> kts (anemometer)", 3, "kts (estimated)", 4, "kts (anemometer)");
  $IW=$IWs{$IW};

# Now guess the year and month, based on the current date.
  ($MON,$YEAR)=guess_mon_year($DAY);

# Only get lat, lon if a ship
  if ($TYPE eq "BBXX") {
 
# Get latitude. Should be headed by "99" - return null if not
    $LA=shift @GROUPS;
    if (substr($LA,0,2) ne '99') { if ($DEBUG > 1) { warn "Returning null: LA group not headed by 99 but by ".substr($LA,0,2) }; return '' };
    $LA=substr($LA,2,3)/10.;

# Get longitude. First char is quadrant: 5 for SW, 3 for SE
    $Q=substr($GROUPS[0],0,1);
    $LO=substr(shift @GROUPS,1,4)/10.;
    if ($Q == 3 or $Q == 5) {$LA=-$LA};
    if ($Q == 5 or $Q == 7) {$LO=-$LO};

  };

# iivVV
#
# Get i_r i_x h VV group
#
  ($Ir,$Ix,$CLOUD_H,$VV) = (shift(@GROUPS) =~ /(.)(.)(.)(..)/ );
# Ir (ppn presence)
# Ir == 3              means ppn omitted later *and is zero*
# Ir == something else mean ppn not available/reported later
  if ($Ir eq "3") { $PPN_value=0 };
# Ix (station type/weather)
  if ($Ir =~ /(1|2|3)/ ) {
    $ST_TYPE="Manned"
  } elsif ($Ir =~ /(4|5|6|7)/ ) {
    $ST_TYPE="AWS"
  } else {
    $ST_TYPE="Unknown ($Ir)"
  };
# h (cloud base height) (code table 1600)
  if ($CLOUD_H =~ /\d/) { $CLOUD_H = (0,50,100,200,300,600,1000,1500,2000,2500)[$CLOUD_H] }
  else { undef $CLOUD_H };
  if ($VV !~ /\d{2}/) { undef $VV };

# Nddff
#
# Wind group. Note conversion to kts if in m/s based on IW (30/4/97)
#
  $GROUPS[0]=&check($GROUPS[0]);
  if ($GROUPS[0]) {
    $TOTAL_CLOUD=substr($GROUPS[0],0,1);
    $DIR=10*substr($GROUPS[0],1,2);
    if ($DIR == 990) {undef $DIR};
    if ($DIR > 360) {$DIR.=" (really???)"};
    $SPD=substr(shift @GROUPS,3,2);
    if ($SPD !~ /\d{2}/) {undef $SPD};
    if ($IW =~ /m\/s/) {$SPD=int($SPD*10/0.5148+0.5)/10.}
  } else {
#
# Note - if the wind group is null, we may as well return nothing at this point
#
    if ($DEBUG > 1) { warn "Returning null: wind group null" };
    return ""
  };

# 1sTTT
#
# Get temperature (checking leading digit is a 1)
#
  ($GROUP_ID,$S,$T)=(shift(@GROUPS) =~ /(.)(.)(...)/);
  if ($GROUP_ID eq "1") {
    if ($T =~ /\d{3}/ and $S =~ /0|1/) {
      $T=$T/10.;
      if ($S) { $T=-$T } 
    } else {
      undef $T 
    }
  } else {
    unshift(@GROUPS,$GROUP_ID.$S.$T); undef $T
  };

# 2sTTT
#
# Get dew temperature (checking leading digit is a 2. If it isn't, return it to the list)
# If S (sign) is not 0 or 1 (it could be 9, for relative humidity) then throw DEWT away.
#
  ($GROUP_ID,$S,$DEWT)=(shift(@GROUPS) =~ /(.)(.)(...)/);
  if ($GROUP_ID eq "2") {
    if ($DEWT =~ /\d{3}/ and $S =~ /0|1/) { 
      $DEWT=$DEWT/10.;
      if ($S) { $DEWT=-$DEWT } 
    } else {
      undef $DEWT
    }
  } else {
    unshift(@GROUPS,$GROUP_ID.$S.$DEWT); undef $DEWT 
  };

# 3PPPP
#
# Get station pressure group (checking leading digit is a 3. If it isn't, return it to the list)
#
  $PSTA=shift @GROUPS;
  if (substr($PSTA,0,1) eq "3") { $PSTA=substr($PSTA,1,4)/10.; if ($PSTA<400) { $PSTA+=1000 } }
  else { unshift(@GROUPS,$PSTA); undef $PSTA };

# 4PPPP
#
# Get MSLP pressure group (4) (checking leading digit is a 4. If it isn't, return it to the list)
#
  $PRED=shift @GROUPS;
  if (substr($PRED,0,1) eq "4") {
    $PRED=substr($PRED,1,4);
    if ($PRED !~ /\d{4}/) {
      undef $PRED
    } else {
      $PRED/=10.;
      if ($PRED<400) { $PRED+=1000 } 
    }
  } else { 
    unshift(@GROUPS,$PRED); undef $PRED 
  };

# 5aPPP
#
# Get P tendency group (5)
#
  $PTND=shift @GROUPS;
  if (substr($PTND,0,1) eq "5") { 
    $PTND_code=substr($PTND,1,1)." (code table 200)";
    $PTND_value=substr($PTND,2,3);
    if ($PTND_value !~ /\//) {$PTND_value/=10.} else { undef $PTND_value };
  } else { unshift(@GROUPS,$PTND); undef $PTND };

# 6RRRt
#
# Get ppn group (6)
#
  $PPN=shift @GROUPS;
  if (substr($PPN,0,1) eq "6") {
    $PPN_code=substr($PPN,4,1)." (code table 3590)";
    $PPN_value=substr($PPN,1,3);
    if ($PPN_value !~ /\//) {
      if ($PPN_value == 990) { $PPN_value="trace" } elsif ($PPN_value > 990) {
        $PPN_value=($PPN_value-990)/10.
      }
    } else {
      undef $PPN_value
    };
  } else { unshift(@GROUPS,$PPN); undef $PPN };

# 7wwWW
#
# Get weather type groups
#
# Ix codes for whether these groups are supposed to be present or not.
# However, since we've got no-where to complain to there's not a lot
# of point checking.
  ($GROUP_ID,$WEATHER) = (shift(@GROUPS) =~ /(.)(....)/ );
  if ($GROUP_ID eq "7") {
    ($WW,$W1,$W2) = ($WEATHER =~ /(..)(.)(.)/ );
    if ($W1!~/\d/) { undef $W1 }; 
    if ($W2!~/\d/) { undef $W2 }; 
    if ($WW!~/\d\d/) { undef $WW }; 
  } else { unshift(@GROUPS,$GROUP_ID.$WEATHER); undef $WEATHER };

# 8NCCC
#
# Cloud group - 8NhClCmCh
#
  ($GROUP_ID,$CLOUD) = (shift(@GROUPS) =~ /(.)(....)/ );
  if ($GROUP_ID eq "8") {
    ($NH,$CL,$CM,$CH) = ($CLOUD =~ /(.)(.)(.)(.)/ );
  } else { unshift(@GROUPS,$GROUP_ID.$CLOUD); undef $CLOUD };

# End - see if we can find an ICE group (we'll fail if this is a land one! (and indeed for most ships))
  while ($GROUP=shift @GROUPS) {
    if ($GROUP eq "ICE") { $ICE=join(" ",@GROUPS); undef @GROUPS; 
# Lets try to decode the ICE group a bit (if it doesn't look like plain text)
      if (length($ICE) == 5 and $ICE !~ /[^\d\/]/) {
        local @Ices = ( $ICE=~/(.)(.)(.).(.)/ );
        for (@Ices) { s#/#10# };
        $Ices[0]='Concentration: '.('No ice in sight','in open lead or fast ice','uniform; < 3/10','uniform; 4/10 to 6/10','uniform 7/10 to 8/10','uniform 9/10+','varied; low','varied','varied; high','varied; very high','unable to report')[$Ices[0]];
        $Ices[1]='Thickness: '.('new ice','nilas < 10cm','young 10-30cm','mostly new','mostly thin 1st-year','1st-year 30-70cm','mostly 1st-year 70-120cm','1st-year medium & thick','mostly baby oil','mostly old','unable to report')[$Ices[1]];
        $GB='growlers/bergy bits';
        $Ices[2]='Type: '.('None','1-5 bergs','6-10 bergs','11-20 bergs',"<=10 $GB","1-5 bergs + $GB","6-10 bergs + $GB","11-20 bergs + $GB","20+ bergs + $GB - nav. hazard",'unable to report')[$Ices[2]];
        $Ices[3]='Situation/Trend: '.('open water; ice in sight','easy penetration; improving','easy penetration','easy penetration; worsening','hard penetration; improving','hard penetration','hard penetration; ice forming; worsening','hard penetration; ice pressure; worsening','hard penetration; heavy ice pressure; worsening','beset; worsening','unable to report')[$Ices[3]];
        $ICE=join(" ",@Ices);
      };
    };
  };

# return
@VALUES=($NAME,$YEAR,$MON,$DAY,$HOUR,$LA,$LO,$T,$DIR,$SPD,$IW,$TOTAL_CLOUD,$ICE,$DEWT,$PSTA,$PRED,$PTND_code,$PTND_value,$PPN_code,$PPN_value,$ST_TYPE,$WW,$W1,$W2,$NH,$CL,$CM,$CH,$CLOUD_H,$VV);
foreach $V (@VALUES) { if ( ($V=~/^\/+$/) or (!$V and $V !~ /0/) ) { $V="null" } };
return @VALUES

};

# Check that a group has 5 characters, all digits or "/"'s
# IF the group is null, let that pass
sub check {
  local($_)=@_;

  return $_ if (!$_);

  if ((length($_) != 5) or /[^\d\/]/) {
    if ($DEBUG) { print "Invalid group: expected 5 digits or \"\/\"'s: $_" };
    $_="/////";
    if ($DEBUG) { print " changed to: $_\n" };
  };

  return $_;
};

1;