#!/usr/bin/perl
#!/opt/local/bin/perl
#
# Read input files containing addfsech calls, add equivalent 
#   new addfld calls, and remove old addfsech calls.
#
# If -comment option is set, the new addfld call will be commented out.
#   (tried to make this work to comment out an existing addfsech call,
#    but could not get it to work)
#
# 5/18/06 btf: using this to add addfld calls to timegcm1.3
#
use Getopt::Long;
#
$comment = 0;
&GetOptions(
   "comment" => \$comment
) or usage();
if ($comment) { print "Will comment out addfld calls\n"; }

while (@ARGV) {
  $file_in = shift;
  push(@files_in,$file_in);
}
$nfiles = $#files_in + 1;
#print "File args: @files_in\n";
#
foreach $file_in (@files_in) {
  open(FILE_IN ,"< $file_in") || die "Error opening input file $file_in\n";
  $file_out = $file_in . '.addfld';
  open(FILE_OUT,"> $file_out") || die "Error opening output file $file_out\n";
# print "\nFile in: $file_in  File out: $file_out\n";
  $call_line = '';
  while (<FILE_IN>) {
    $cont_line = '';
    if ($call_line and 
      (/^\s{5}\S{1}\s*(.*)/ or /^!\s{4}\S{1}\s*(.*)/)) { # continuation line
      $cont_line = $1;
    } 
    if ($call_line) { 
      $addfld_call = &procline($call_line,$cont_line); 
      if ($comment) {
        print FILE_OUT "!     $addfld_call\n"; # add new commented call to output file
      } else {
        print FILE_OUT "      $addfld_call\n"; # add new call to output file
      }
    } 
    $call_line = '';
    if (/call addfsech(.*)/) { 
      $call_line = $1; 

    } elsif (/call addfld(.*)/) {
      $line = "!      call addfld$1";
      print FILE_OUT $line;
    } elsif (not $cont_line) {
      print FILE_OUT $_;
    }
  } # while file_in
#
# Print readable list of field names, that can be
# used in model and post-proc namelist read input files.
#
  @fnames= &deredund($file_in,@fnames);
  &printnames($file_in,@fnames);
#
# Update list of fields from all files:
#
  if ($#fnames > -1) { 
    print"\n"; 
    push @fnames_all,@fnames;
  }
  @fnames = ();
  @fnames_new = ();
} # foreach file
#
# Print list of all fields:
#
  @fnames_all = &deredund($file_in,@fnames_all);
  $ntot = $#fnames_all + 1;
  &printnames('all',@fnames_all);
#-----------------------------------------------------------------------
sub deredund {
  my ($file,@fnames) = @_;
  my $name; my $found; my $nnew; my $i; my $fnames_new;
  foreach $name (@fnames) {
    $found = 0;
    $nnew = $#fnames_new + 1;
    for ($i = 0; $i <= $#fnames_new + 1; $i++) { 
      if ($fnames_new[$i] eq $name ) { $found = 1; } 
    }
    if (not $found) { 
      push @fnames_new,$name; 
    } else {
      print "Redundant name in file $file: $name\n";
    }
#   print "nnew=$nnew fnames_new=@fnames_new\n";
  }
# print "exit deredund: fnames_new=@fnames_new\n";
  return @fnames_new;
}
#-----------------------------------------------------------------------
  sub printnames {
  my ($file,@fnames) = @_;
#
# Construct quoted list of field names from @fnames, suitable for
# namelist read. This works best if field names are <= 8 chars.
# 
  my $name;
  my @fnames_new;
  foreach $name (@fnames) {
    $name =~ s/ //g;         # remove blanks
    my $len = length($name);
# Append blanks to the end up to 10 chars (8-char name + 2 quotes + 1 comma)
    if ($len < 10) {        
      for ($i=$len+1; $i <= 10; $i++) { $name = $name . ' '; }
    }
    $name = $name . ',';     # add trailing comma
    $len = length($name);
    push @fnames_new,$name;
  } 
  @fnames = @fnames_new;
#
  my $npergroup = 5;
  my $nnames = $#fnames + 1;
  my $ngroups = int($nnames / $npergroup);
  my $nextra = $nnames % $npergroup;
# print "nnames=$nnames npergroup=$npergroup ngroups=$ngroups nextra=$nextra\n";
  if ($file ne 'all') {
    print "; $nnames fields from file $file\n";
  } else {
    print "; Total of $nnames fields from $nfiles files:\n";
  }
  for (my $ig=0; $ig<=$ngroups-1; $ig++) {
    if ($ig==0) { 
      print " SECFLDS = "; 
    } else {
      print "           ";
    } 
    for (my $i=0; $i<=$npergroup-1; $i++) {
      $ii = $ig * $npergroup + $i;
      print "$fnames[$ii]";
    }
    print "\n";
  }
  if ($nextra > 0) {
    for (my $i=1; $i<=$nextra; $i++) { 
      if ($i==1) { print "           "; }
      print "$fnames[$nnames - $nextra + $i - 1]";
    }
    print "\n";
  }
}
#-----------------------------------------------------------------------
sub procline {
  my ($call_line,$cont_line) = @_;
  my $line = $call_line;
#
# Pre-process addfsech call:
#
  if ($line =~ /(.*)(\!)(.*)/ ) { $line = $1; }   # remove comment
  if ($cont_line) { $line = $line . $cont_line; } # join continuation line
  if ($line =~ /^\((.*)/ ) { $line = $1; }        # remove leading (
  $paren = rindex $line,')';                      # remove trailing )
  if ($paren > -1) { $line = substr($line,0,$paren); }
#
# Assume open and closed params is an array ref:
  if ($line =~ /(.*)\((.*)\)(.*)/ ) {      # array ref (..)
    $line1 = $1;
    $aref  = '(' . $2 . ')';
    $line2 = $3;
#
# Temporarilly replace commas in array-ref with semicolons
    $aref =~ s/,/;/g;       
    $line = $line1 . $aref . $line2; # put it back together
  }
#
# Split the processed addfsech call into args, based on commas:
  @args = split /,/, $line;
  $nargs = $#args + 1;
  foreach $arg (@args) { 
    $arg =~ s/;/,/g;        # put comma back in array ref
  }
  if ($nargs != 9) { 
    print ">>> WARNING: nargs of addfsech call = $nargs (should be 9)\n"; 
  }

#     subroutine addfsech(name,long_name,units,f2d,lon0,lon1,levdim,
#    |  nlevreq,lat)

  foreach $arg (@args) { 
    if ($arg =~ /^(\s+)(.*)/) { $arg = $2; } # remove leading blanks
  }

  %addfsech_args = (
    name      => $args[0],    
    long_name => $args[1],
    units     => $args[2],
    f2d       => $args[3],
    lon0      => $args[4],
    lon1      => $args[5],
    levdim    => $args[6],
    nlevreq   => $args[7],
    lat       => $args[8]
  );

#     subroutine addfld(name,long_name,units,
#    |  f,dname1,lb1,ub1,dname2,lb2,ub2,idx)

  @addfld_argnames = ("name","long_name","units","f","dname1",
                      "lb1","ub1","dname2","lb2","ub2","idx");
  %addfld_args = ();
  $addfld_args{"name"}      = $addfsech_args{"name"};
  $addfld_args{"long_name"} = $addfsech_args{"long_name"};
  $addfld_args{"units"}     = $addfsech_args{"units"};
  $addfld_args{"f"}         = $addfsech_args{"f2d"};
  $addfld_args{"dname1"}    = "\'lev\'";
  $addfld_args{"lb1"}       = "lev0";
  $addfld_args{"ub1"}       = "lev1";
  $addfld_args{"dname2"}    = "\'lon\'";
  $addfld_args{"lb2"}       = $addfsech_args{"lon0"};
  $addfld_args{"ub2"}       = $addfsech_args{"lon1"};
  $addfld_args{"idx"}       = $addfsech_args{"lat"};

  $call_addfld = "call addfld(";
  $call_addfld = $call_addfld . $addfld_args{"name"}      . ",";
  $call_addfld = $call_addfld . $addfld_args{"long_name"} . ",";
  $call_addfld = $call_addfld . $addfld_args{"units"}     . ",";
  $call_addfld = $call_addfld . $addfld_args{"f"}         . ",";
  $call_addfld = $call_addfld . $addfld_args{"dname1"}    . ",";
  $call_addfld = $call_addfld . $addfld_args{"lb1"}       . ",";
  $call_addfld = $call_addfld . $addfld_args{"ub1"}       . ",";
  $call_addfld = $call_addfld . $addfld_args{"dname2"}    . ",";
  $call_addfld = $call_addfld . $addfld_args{"lb2"}       . ",";
  $call_addfld = $call_addfld . $addfld_args{"ub2"}       . ",";
  $call_addfld = $call_addfld . $addfld_args{"idx"}       . ")";

# print "$call_addfld\n";
#
  @chars = split //, $call_addfld;
  $nchars = $#chars + 1 + 6;
# print "procline: nchars=$nchars\n";
  if ($nchars > 72) {
    $call_addfld = "call addfld(";
    $call_addfld = $call_addfld . $addfld_args{"name"}      . ",";
    $call_addfld = $call_addfld . $addfld_args{"long_name"} . ",";
    $call_addfld = $call_addfld . $addfld_args{"units"}     . ",";

    if ($comment) {
      $call_addfld = $call_addfld . $addfld_args{"f"}         . ",\n!    |  ";
    } else {
      $call_addfld = $call_addfld . $addfld_args{"f"}         . ",\n     |  ";
    }

    $call_addfld = $call_addfld . $addfld_args{"dname1"}    . ",";
    $call_addfld = $call_addfld . $addfld_args{"lb1"}       . ",";
    $call_addfld = $call_addfld . $addfld_args{"ub1"}       . ",";
    $call_addfld = $call_addfld . $addfld_args{"dname2"}    . ",";
    $call_addfld = $call_addfld . $addfld_args{"lb2"}       . ",";
    $call_addfld = $call_addfld . $addfld_args{"ub2"}       . ",";
    $call_addfld = $call_addfld . $addfld_args{"idx"}       . ")";
  }
# if ($comment) {
#   $call_addfld = '!     ' . $call_addfld;
# }
  push @fnames, $addfld_args{"name"};
  return $call_addfld;
} # sub procline
#-------------------------------------------------------------------------
sub usage {
  die <<EOF;

DESCIPTION
  $0 utility for manipulating addfld and addfsech calls

SYNOPSIS
  $0 [options] [file1,file2,...]

OPTIONS
  -comment   Comment out final addfld call
EOF
}
#-------------------------------------------------------------------------