#!/usr/bin/perl -ws

use vars '$h';
if ($h) {
  print "
Usage: $0 file.in ...

Зависимости: perl, gamess (optional)

Переводит input-файлы GAMESS'а и Природы в molden-формат.
Ориентируется по расширению (.inp для GAMESS, .in для Природы).
Output-файлы не создаются, результат выводится на консоль. 
Его можно перенаправить в файл, либо через pipe в mldn.

Для Природы геометрия д.б. в xyz-формате.
Для GAMESS'а если coord=cart, то геометрия берется из inp-файла,
иначе в этот inp-файл добавляются слова runtyp=optimize exetyp=check
пропускается через gamess и координаты берутся из выдачи.
  \n";
  exit;
}

# Вгоняем таблицу Менделеева
@ATOM = qw (XX
            H                                                  He
            Li Be                               B  C  N  O  F  Ne
            Na Mg                               Al Si P  S  Cl Ar
            K  Ca Sc Ti V  Cr Mn Fe Co Ni Cu Zn Ga Ge As Se Br Kr
            Rb Sr Y  Zr Nb Mo Tc Ru Rh Pd Ag Cd In Sn Sb Te I  Xe
            Cs Ba La
                    Ce Pr Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb Lu
                     Hf Ta W  Re Os Ir Pt Au Hg Tl Pb Bi Po At Rn
            Fr Ra Ac
                    Th Pa U  Np Pu Am Cm Bk Cf Es Fm Md No Lr
           );

while (@ARGV) {
  $file = shift;
  ($ext) = $file=~/\.(inp?)$/;
  
  warn "Unknown extension of file $file\n" and next unless $ext;
  
  open INP, $file or warn "Can't open $file: $!\n" and next;
  $D = '-?\d+\.\d+';
  $N = 1;
  
  if ($ext eq 'in')  { # Priroda input
    while (<INP>) {
      if (/^\s*(\d+)\s+($D)\s+($D)\s+($D)/) {
        $atom[$N] = $ATOM[$1];
        ($x[$N],$y[$N],$z[$N]) = ($2,$3,$4);
        $N++;
      }
    }
  } 
  
  if ($ext eq 'inp') { # GAMESS input
    @INP = <INP>;
    $coord_cart = 0;
    foreach (@INP) {
      $coord_cart = 1 if /coord=cart/;
      if ($coord_cart) {
        if (/^\s*\w+\s+(\d+)(?:\.0+)?\s+($D)\s+($D)\s+($D)/) {
          $atom[$N] = $ATOM[$1];
          ($x[$N],$y[$N],$z[$N]) = ($2,$3,$4);
          $N++;
        }
      }
    }
    unless ($coord_cart) {
      $gms = '/usr/local/lib/gamess/rungms';
      warn "No $gms executable\n" and next unless -x $gms;
      
      open TMP, '> inp2xyz_tmp.inp' or warn "Can't wrire to tmp: $!\n" and next;
      print TMP @INP;
      print TMP ' $contrl runtyp=optimize exetyp=check nprint=-5 $end', "\n";
      close TMP;
      
      open GMS, "$gms inp2xyz_tmp.inp 2>/dev/null |" or warn "$!\n";
      while (<GMS>) {
        #print;
        if (m/^ COORDINATES OF ALL ATOMS ARE \(ANGS\)$/) {
          <GMS>;
          <GMS>;
          while (<GMS>=~/^\s*\w+\s+(\d+)(?:\.0+)?\s+($D)\s+($D)\s+($D)/) {
            $atom[$N] = $ATOM[$1];
            ($x[$N],$y[$N],$z[$N]) = ($2,$3,$4);
            $N++;
          }
        }
      }
      
      close GMS;
      
      unlink 'inp2xyz_tmp.inp';
      unlink "$ENV{HOME}/scr/inp2xyz_tmp.dat";
    }
  }
  close INP;
  $N--;
  write_molden();
}

sub write_molden {
  if (@atom && @x && @y && @z) {
    print " $#atom\n";
    print " Energy $energy" if $energy;
    print "\n";
    for ($i=1; $i<=$#atom; $i++) {
      if ($atom[$i] && $x[$i] && $y[$i] && $z[$i]) {
        printf " %-2s %12.8f %12.8f %12.8f",$atom[$i],$x[$i],$y[$i],$z[$i];
        printf $atom[$i] eq 'H' ? " %10.3f" : " %9.2f"  , $ppm[$i] if $ppm[$i];
        print "\n";
      }
    }
  }
}