#!/usr/bin/perl

BEGIN {
#use lib 'd:/Programs/Perl/lib';
#use lib '/home/tkamiya/bin/lib';
my $BaseDir = $ENV{'TkPerlDir'};
#print "\nBaseDir: $BaseDir\n";
@INC = ("$BaseDir/lib", "$BaseDir/VNL", "c:/Programs/Perl/lib", "d:/Programs/Perl/lib", @INC);
}

use strict;
#use warnings;
use File::Path;
use File::Basename;
use File::Find;

use Deps;
use Utils;
use JFile;

use MyApplication;
use Sci qw($pi);

use Crystal::CIF;
use Crystal::Crystal;
use Crystal::VASP;
use Crystal::LD;

#===============================================
# デバッグ関係変数
#===============================================
#$PrintLevelが大きいほど、情報が詳しくなる
my $PrintLevel = 0;

#===============================================
# 文字コード関係変数
#===============================================
# sjis, euc, jis, noconv
my $PrintCharCode      = Deps::PrintCharCode();
my $OSCharCode         = Deps::OSCharCode();
my $FileSystemCharCode = Deps::FileSystemCharCode();

my $DirSep    = Deps::DirSep();
my $RegDirSep = Deps::RegDirSep();

#===============================================
# Applicationオブジェクト作成
#===============================================
my $App = new MyApplication;
exit if($App->Initialize() < 0);

#$App->SetLF("<br>\n");
#$App->SetPrintCharCode("sjis");
#$App->SetDebug($Debug);
$App->SetDeleteHTMLFlag(1);

#===============================================
# スクリプト大域変数
#===============================================
my $InitialDirectory = Deps::GetWorkingDirectory();
my %ParamHash;

#==========================================
# コマンドラインオプション読み込み
#==========================================
$App->AddArgument("--Action",    "--Action=[MakeInput]", '');
$App->AddArgument("--Function",  "--Function=[Energy|Permit|WMin|xLSQ|Phonon]", 'Energy');
$App->AddArgument("--DebugMode", "--DebugMode: Set DebugMode", '');
exit 1 if($App->ReadArgs(1, "sjis", 0) != 1);
my $Args = $App->Args();
#my $form = new CGI;
#$Args->SetCGIForm($form);
#$Args->parseInput($WebCharCode);

my %ArgHash = $Args->GetArgHash();
foreach my $key (keys %ArgHash) {
#print "key: $key: $ArgHash{$key}\n";
	if($key =~ /^Param:(.*?)$/i) {
		$ParamHash{$1} = $ArgHash{$key};
#print "$1:  $ArgHash{$key}\n";
	}
}
$App->{pParamHash} = \%ParamHash;

#==========================================
# メイン関数スタート
#==========================================

#Utils::InitHTML("Research", $WebCharSet, "_self");

my $Debug = $Args->GetGetArg("DebugMode");
$App->SetDebug($Debug);
my $Action = $Args->GetGetArg("Action");

my $ret = 0;
if($Action =~ /MakeInput/i) {
	&MakeInput();
}
else {
	$App->print("Error: Invalid Action: [$Action]\n");
}

#Utils::EndHTML();

exit $ret;

#===============================================
# スクリプト終了
#===============================================

#==========================================
# &Subroutines
#==========================================
sub MakeInput
{
	$App->print("<H2>Make LD files from VASP files.</H2>\n");

	my $Function = $Args->GetGetArg("Function");

	my $vasp     = new VASP;
	my $CARDir   = $Args->GetGetArg(0);
	my $BaderOut = $Args->GetGetArg(1);
	my $INCAR    = $vasp->GetINCARFileName($CARDir);

	$App->print("<b>Function :</b> $Function\n");
	$App->print("<b>CAR dir  :</b> $CARDir\n");
	$App->print("<b>INCAR    :</b> $INCAR\n");
	$App->print("<b>bader.out:</b> $BaderOut\n");

	my $pINCAR = $vasp->ReadINCARtoHash($INCAR);
	my $fname ='LDEnergy';
#	my $fname = $pINCAR->{Source};
#	if($fname) {
#		my ($drive, $directory, $filename, $ext1, $lastdir, $filebody) = Deps::SplitFilePath($fname);
#		$fname = $filebody;
#	}
#	else {
#		$fname = $pINCAR->{SYSTEM};
#		$fname =~ s/ .*$//;
#	}

	my $Crystal = $vasp->ReadStructureFromCARFiles($CARDir);
	my $pCharges;
	unless($Crystal) {
		$App->print("Error: Can not read from [$CARDir].\n");
		return 0;
	}

	if(-f $BaderOut) {
		print "Read [$BaderOut]\n";
		$pCharges = &ReadBaderCharges($BaderOut);
		print "\n";
	}
	elsif($BaderOut) {
		print "Warning: bader.out [$BaderOut] does not exist.\n";
		print "Use formal charge.\n";
		print "\n";
	}
	else {
	}

	print "Create LD files for [$fname]\n";
	my $LD = new LD();
	$LD->SetSampleName($fname);
	if($LD->MakeLDFiles($Crystal, $Function, $fname, $pCharges) <= 0) {
		$App->print("Error in Research.pl::MakeLDFile: Can not write files.\n");
		return 0;
	}

	$App->print("<H2>Make LD files from VASP files: finished</H2>\n");

	return 1;
}


sub ReadBaderCharges
{
	my ($baderout) = @_;

	my $in = JFile->new($baderout, 'r');
	if(!$in) {
		print "Warning: Bader output [$baderout] does not exist.\n";
		return 0;
	}
	my @chg;
	$in->SkipTo("Ion charges re-adjusted");
	my $c = 0;
	while(1) {
		my $line = $in->ReadLine();
		last if(!$line or $line =~ /Total charge:/);
		
		$line =~ /AtomType\s+(\d+):\s*(\S+):\s*Charge=\s*([0-9\-\+\.eEdD]+)/;
		$chg[$c] = {
			iAtom  => $1,
			Name   => $2,
			Charge => $3,
			};
print "$chg[$c]->{iAtom}: $chg[$c]->{Name}: Z=$chg[$c]->{Charge}\n";
		$c++;
	}

	$in->Close();

	return \@chg;
}