#!/usr/bin/perl -ws

our($gms,$gms_opt,$out,$scr);

# Default command line parameters
$gms ||= 'gms';
#$gms ||= "$ENV{HOME}/gamess/rungms";

$gms_opt ||= '';
#$gms_opt ||= "00 1 $ENV{HOME}/tmp";

$out ||= ''; # extension of output files
#$out ||= '.out';

$scr ||= "$ENV{HOME}/scr";
#$src ||= `perl -ne "/set USERSCR=/ && print \$'" $gms`; chomp $scr;

our ($h,$help);
(my $program = $0) =~ s/^.*[\/\\]//;
if ($h or $help) {
  print "Relaxed scan for GAMESS.\n
Usage: $program first,last,N file.inp
  first,last - the first and the last FVALUE in \$ZMAT group
  N - number of points, step=(last-first)/(N-1)\n
Scan coordinate is given by IFZMAT(1) in \$ZMAT group\n";
  exit;
}

die "Usage: $program first,last,N file.inp\n" unless @ARGV;

my $d = qr/-?\d+(?:\.\d+)?/; # Regexp for number

my $file_inp = $ARGV[1];
(my $name = $file_inp) =~ s/\.inp$//;

my $inp = '';
my @data;
open L, '<', "$file_inp" or die "Can't open $file_inp: $!\n";
while (<L>) {
  if (m/\$DATA/i .. m/\$END/i) {
    push @data, $_;
  }
  else {
    $inp .= $_;
  }
}
close L;

my (@data_head,@data_end);
@data_head = splice @data, 0, $data[2]=~/C1/i ? 3 : 4;
@data_end = pop @data; # $END string
@data = grep {! /^\s*$/} @data; # remove blank lines
#print $inp,@data_head,@data,@data_end; exit;

my ($first,$last,$N) = split ',', $ARGV[0];
$first =~ /^$d$/ or die "invalid first value\n";
$last =~ /^$d$/ or die "invalid last value\n";
$N =~ /^\d+$/ or die "invalid N\n";

for (my $i=0; $i<$N; $i++) {
  my @vec;
  my $ifreez = $first + ($last-$first)/($N-1)*$i;
  #print "$ifreez\n";
  $inp =~ s/(\$ZMAT[^\$]*?FVALUE\s*=\s*)$d([^\$]*?\$END)/${1}$ifreez$2/i 
    or die "No fvalue in \$ZMAT group\n";
  if ($i>0) {
    $inp =~ s/(\$CONTRL[^\$]*?COORD\s*=\s*)\w+([^\$]*?\$END)/${1}UNIQUE$2/i;
    $inp =~ s/^\s*\$VEC[^\$]+\$END\s*$//mi;
    #@data = (data_dat("$scr/$name$I.dat"))[-1];
    my (@curr_data,@curr_vec);
    my $prev_dat = sprintf("$scr/$name%02d.dat", $i-1);
    open DAT, '<', $prev_dat or die "Can't open $prev_dat: $!\n";
    while (<DAT>) {
      if (m/^----- RESULTS FROM SUCCESSFUL.+?GEOMETRY SEARCH -----$/) {
        while (<DAT>) {
          if (m/COORDINATES OF SYMMETRY UNIQUE ATOMS/) {
            <DAT>; <DAT>;
            while (<DAT>) {
              m/^\s*\w+\s+$d\s+$d\s+$d\s+$d\s*$/ or last;
              push @curr_data, $_;
            }
          }
          if (m/\$VEC/i .. m/\$END/i) {
            push @curr_vec, $_;
          }
        }
      }
    }
    close DAT;
    @data = @curr_data;
    last unless @data;
    @vec = @curr_vec;
    if (@vec) {
      $inp =~ s/(\$GUESS[^\$]*?GUESS\s*=\s*)\w+([^\$]*?\$END)/${1}MOREAD$2/i
      or $inp .= "\$GUESS GUESS=MOREAD \$END\n";
    }
  }
  my $I = sprintf "%02d", $i;
  open INP, '>', "$name$I.inp" or die "Can't write to $name$I.inp: $!\n";
  print INP $inp,@data_head,@data,@data_end;
  print INP @vec if $i>0;
  close INP;
  warn "\n$gms $name$I $gms_opt > $name$I$out\n";
  system("$gms $name$I $gms_opt > $name$I$out") == 0 
    or die "Can't run `$gms $name$I $gms_opt > $name$I$out'\n";
}