#!/usr/bin/perl
# convert DeFT output file to GAMESS input file
# command line arguments are filename for output_ and optimization type
# $opt='s' single point; $opt='o' optimize; $opt='r' optimize just bond lengths
$file = shift(@ARGV).'.dft' ; 	# Extract first argument into pattern
$opt = shift(@ARGV); 	# Extract second argument into pattern
open(ARC,$file) || die "Can't find file $file\n";
	$i = 0 ;
while (<ARC>) {
	if (/^\n/) {
		$i++ ;
		if ( $i == 4 ) { goto data };
			}
	   else { $i = 0 }
	}
data:
chop( $comment = scalar(<ARC>)) ;	# get comment
# find multiplicity and charge if not default
	$mult = '' ;
	$charge = '' ;
while ( <ARC> ) {
	if (/orbital/) { goto endspec } ;
	if (/multiplicity/) {
		s/^.*is\b// ;
		s/^[ ]*//;
		$mult = $_ ;
		chop($mult) ;
			    }
	if (/charge/) {
		s/^.*is\b// ;
		s/^[ ]*//;
		$charge = $_ ;
		chop($charge) ;
		}
  }
endspec:
# find number of internal coordinates
while ( <ARC> ) {
	if (/z-matrix/) { goto internals }
	}
internals:
$_ = scalar(<ARC>) ;
	$iatms = 0 ;
while ( <ARC> ) {
	if (/^\n/) { goto numint }
	$iatms++ ;
		}
numint:
	$icoor = 0 ;
	if ( $iatms == 2 ) { $icoor = 1 }
	if ( $iatms >= 3 ) { $icoor = 3*$iatms - 6 }
# form control card
print " \$CONTRL" ;
if ( $mult eq '' ) { print " SCFTYP=RHF" }
	else { print " SCFTYP=UHF" }
if ( $opt eq 'o' || $opt eq 'r' ) {
	print " RUNTYP=OPTIMIZE" ;
		if ( $opt eq 'r' ) {
			print " NZVAR=$icoor\n";
				   }
			   }
	else { print " RUNTYP=ENERGY" }
print " MULT=$mult" if $mult ne '' ;
print " ICHARG=$charge\n" if $charge ne '' ;
print " \$END\n" ;
print " \$BASIS GBASIS=TZV DIFFSP=.TRUE. NDFUNC=1 NPFUNC=1 \$END\n" ;
# form data cards
print " \$DATA\n";
print "$comment\n" ;
print "C1  0\n" ;		#don't worry about symmetry
%AN = (
'h' , '1.0',
'he', '2.0',
'li', '3.0',
'be', '4.0',
'b' , '5.0',
'c' , '6.0',
'n' , '7.0',
'o' , '8.0',
'f' , '9.0',
'ne', '10.0',
'na', '11.0',
'mg', '12.0',
'al', '13.0',
'si', '14.0',
'p' , '15.0',
's' , '16.0',
'cl', '17.0',
'ar', '18.0',
'k' , '19.0',
'ca', '20.0',
'sc', '21.0',
'ti', '22.0',
'v' , '23.0',
'cr', '24.0',
'mn', '25.0',
'fe', '26.0',
'co', '27.0',
'ni', '28.0',
'cu', '29.0',
'zn', '30.0',
);
while (<ARC>) {
	die "Sorry: geometry not optimized\n" if /not optimized/ ;
if (/coordinates :/) {
$_ = scalar(<ARC>) ;	# get blank line
$i = 0 ;
while (<ARC>) { 
$i++ ;
($sp,$el[$i],$x[$i],$y[$i],$z[$i]) = split ;
if ( $el[$i] eq '' ) {
	goto fin ;
		}
	   }
	}
fin:
   }
# now print out coordinates
$i-- ;
for ($j=1 ; $j<=$i ; $j++) { 
	print "\u$el[$j]  $AN{$el[$j]}  $x[$j]  $y[$j]  $z[$j]\n" ;
			}
print " \$END\n" ;
if ( $opt eq 'r' ){		# freeze the angles if opt=r
	print " \$STATPT IFREZ(1)=3";
	$k = 3 ;
	for ( $j=4; $j<=$i; $j++ ) {
		$k += 2 ;
		print ",",$k ;
		$k++ ;
		print ",",$k ;
		}
			print "\n" ;
	print " \$END\n" ;
	}
print " \$NBO PRINT=1 NBOSUM RESONANCE E2PERT=4.78 \$END\n" ;