;
my ($aname) = ($line1 =~ /^(\S+)\s/);
#print "aname: $aname ";
if($aname =~ /^($name(\.v|[\d\+-]*))$/i) {
#print "aname: $aname ";
my ($c, $sign) = ($aname =~ /(\d*)([\+-])/);
$c = 1 if($c eq '');
#print "aname: $aname c:$c s:$sign
";
if($sign eq '-') {
$c = -$c;
}
if(abs($charge-$NearestCharge) >= abs($charge-$c)) {
$NearestCharge = $c;
$NearestName = $aname;
#print "nearestname: $NearestName, charge: $NearestCharge
";
}
push(@list, $aname);
}
}
close(IN);
return ($NearestName, @list);
}
sub FindIdenticalSpaceGroup
{
my ($this,$SPG) = @_;
my $iSPG = $SPG->iSPG();
my $Crystal = new Crystal();
$Crystal->SetLatticeParameters(3, 4, 5, 80, 85, 75);
$Crystal->SetCSpaceGroup($SPG);
$Crystal->AddAtomSite("H1", "H", 0.1, 0.15, 0.2, 1.0);
$Crystal->ExpandCoordinates();
my @AtomList = $Crystal->GetCExpandedAtomSiteList();
my $neq = @AtomList;
print "+++*** neq=$neq
\n";
for(my $i = 1 ; $i < 100 ; $i++) {
my $RSPG = $this->ReadSpaceGroup($iSPG, $i);
last if($RSPG == 0);
#my $ns = $RSPG->nSymmetryOperation();
#for(my $k = 0 ; $k < $ns ; $k++) {
# my $symop = $RSPG->SymmetryOperation($k+1);
# print "sym$k: $symop
\n";
#}
my $RCrystal = new Crystal();
$RCrystal->SetLatticeParameters(3, 4, 5, 80, 85, 75);
$RCrystal->SetCSpaceGroup($RSPG);
$RCrystal->AddAtomSite("H1", "H", 0.1, 0.15, 0.2, 1.0);
$RCrystal->ExpandCoordinates();
my @RAtomList = $RCrystal->GetCExpandedAtomSiteList();
my $Rneq = @RAtomList;
#print "+++*** $i: Rneq=$Rneq
\n";
next if($Rneq != $neq);
my $IsPassed = 1;
for(my $j = 0 ; $j < $neq ; $j++) {
my $atom0 = $AtomList[$j];
my ($x0, $y0, $z0) = $atom0->Position(1);
my $IsPassed0 = 0;
for(my $l = 0 ; $l < $neq ; $l++) {
my $atom1 = $RAtomList[$l];
my ($x1, $y1, $z1) = $atom1->Position(1);
my $dis = $Crystal->GetNearestInterAtomicDistance(
$x0, $y0, $z0, $x1, $y1, $z1);
#print "j=$j, l=$l: $dis: ($x0, $y0, $z0) - ($x1, $y1, $z1)
\n";
if($dis < 0.01) {
$IsPassed0 = 1;
last;
}
}
if($IsPassed0 == 0) {
$IsPassed = 0;
last;
}
}
next if($IsPassed == 0);
return $RSPG;
}
return -1;
}
sub Execute
{
my ($this, $filepath, $Actgion, $Program) = @_;
$Program = 'Rietan2000' if(!defined $Program);
my $LF = "
\n";
if($Program eq 'RietanFP') {
$RietanDir = ProgVars::RietanFPDir();
$RietanProgramPath = Deps::MakePath($RietanDir, ["RIETAN_VENUS"], 0);
$RietanPath = Deps::MakePath($RietanProgramPath, "rietan.exe", 0);
if($^O eq 'linux') {
$RietanDir = "$HOME/rietan" ;
$RietanProgramPath = "$HOME/rietan/bin";
$RietanPath = Deps::MakePath($RietanProgramPath, "rietan", 0);
}
}
#ファイル名を（ベース名, ディレクトリ名, 拡張子）に分解
my @filenames = fileparse($filepath, "\.[^\.]+");
my $WorkingDir = $filenames[1];
my $inspath = "$filenames[0].ins";
my $intpath = "$filenames[0].int";
my $bkgpath = "$filenames[0].bkg";
my $patpath = "$filenames[0].pat";
my $lstpath = "$filenames[0].lst";
my $csvpath = "$filenames[0].csv";
print "[$patpath] was deleted.$LF" if(unlink("$WorkingDir$patpath"));
print "[$lstpath] was deleted.$LF" if(unlink("$WorkingDir$lstpath"));
print "[$csvpath] was deleted.$LF" if(unlink("$WorkingDir$csvpath"));
$WorkingDir =~ s/[\\\/]$//;
if($WorkingDir ne '' and $WorkingDir ne '.') {
print "Change working directory to ($WorkingDir)$LF";
unless(-d $WorkingDir) {
print " ($WorkingDir) does not exist.$LF$LF";
return 0;
}
chdir($WorkingDir);
my $CurrentDirectory = cwd();
my $cd = $CurrentDirectory;
$cd =~ s/\\/\//g;
my $wd = $WorkingDir;
$wd =~ s/\\/\//g;
if(uc $cd ne uc $wd) {
print " Can not change to ($wd).$LF";
print " Current directory is ($cd)$LF$LF";
return 0;
}
}
print "Set Rietan=$RietanProgramPath$LF";
$ENV{"Rietan"} = $RietanProgramPath;
my $command = "$RietanPath $inspath $intpath $bkgpath $patpath";
#"%RIETAN%\rietan.exe" "%SAMPLE%.ins" "%SAMPLE%.int" "%SAMPLE%.bkg" "%SAMPLE%.pat"
#"%SAMPLE%.hkl" "%SAMPLE%.xyz" "%SAMPLE%.mem" "%SAMPLE%.ffe" "%SAMPLE%.fba"
#"%SAMPLE%.ffi" "%SAMPLE%.ffo" "%SAMPLE%.vcs" | "%RIETAN%\tee.exe" "%SAMPLE%.lst"
print "Execute: [$command]...$LF";
print "\n";
unless(open(OUT, ">$lstpath")) {
print "Error in Rietan.pm:Execute: Can not write to [$lstpath].$LF";
return;
}
unless(open(IN, "$command|")) {
close(OUT);
print "Error in Rietan.pm:Execute: Can not execute $RietanPath.$LF";
return;
}
while() {
print OUT $_;
print $_;
}
close(IN);
close(OUT);
print "\n";
print "Convert $patpath file to CSV file ($csvpath).$LF";
unless(open(IN,"<$patpath")) {
print "Error in Rietan.pm:Execute: Can not read [$patpath].$LF";
return;
}
unless(open(OUT,">$csvpath")) {
print "Error in Rietan.pm:Execute: Can not write to [$csvpath].$LF";
return;
}
my $line = ; #Title;
Utils::DelSpace($line);
print "Title: $line\n";
$line = ;
my ($ndata, $start, $step, $npeak) = Utils::Split("\\s+", $line);
print "nData: $ndata, Start angle: $start, Step: $step, nPeaks: $npeak$LF";
print OUT "2Theta,Intensity\n";
my $count = 0;
while() {
my @data = split(/\s+/, $_);
for(my $i = 0 ; $i < @data ; $i++) {
next if($data[$i] eq '');
my $angle = $start + $step * $count;
$count++;
print OUT "$angle,$data[$i]\n";
last if($count >= $ndata);
}
last if($count >= $ndata);
}
close(OUT);
close(IN);
print "$LF";
$inspath = Deps::MakePath($WorkingDir, $inspath, 0);
$intpath = Deps::MakePath($WorkingDir, $intpath, 0);
$patpath = Deps::MakePath($WorkingDir, $patpath, 0);
$lstpath = Deps::MakePath($WorkingDir, $lstpath, 0);
$csvpath = Deps::MakePath($WorkingDir, $csvpath, 0);
return ($inspath, $intpath, $patpath, $lstpath, $csvpath);
}
sub SaveInsFile
{
my ($this, $Crystal, $filename, $IsExpandCoordinate, $IsChooseRandomly,
$IsSimulation, $StartAngle, $EndAngle, $StepAngle, $Program) = @_;
$Program = 'Rietan2000' if(!defined $Program);
if(!defined $IsSimulation or lc $IsSimulation eq 'simulation' or $IsSimulation eq '1') {
$IsSimulation = 1;
}
else {
$IsSimulation = 0;
}
my $LF = "
\n";
print "IsSimulation: $IsSimulation\n";
print "Program $Program\n";
print "Angle: ($StartAngle - $EndAngle), $StepAngle\n";
$StartAngle = 5.0 if($StartAngle eq '');
$EndAngle = 120.0 if($EndAngle eq '');
$StepAngle = 0.02 if($StepAngle eq '');
my $RefineTemplateDir = ($Program eq 'Rietan2000')? ProgVars::RietanTemplateDir() : ProgVars::RietanFPTemplateDir();
#print "Temp: $RefineTemplateDir\n";
my $TemplatePath = Deps::MakePath($RefineTemplateDir, "Refinement-Template.ins", 0);
if($IsSimulation) {
$TemplatePath = Deps::MakePath($RefineTemplateDir, "Simulation-Template.ins", 0);
}
print "Template: $TemplatePath\n";
print "Save to [$filename]\n";
my $Content;
unless(open(IN,"<$TemplatePath")) {
print "Can not open template $TemplatePath.$LF$LF";
return;
}
while() {
$Content .= $_;
}
close(IN);
#Rietanに使える原子名をasfdcから取得
my @AtomTypeList = $Crystal->GetCAtomTypeList();
my $nAtomType = @AtomTypeList;
my %RietanAtomName;
print "Search atom/ion names available for Rietan.
\n";
for(my $i = 0 ; $i < $nAtomType ; $i++) {
my $atom = $AtomTypeList[$i];
my $name = $atom->AtomNameOnly();
my $charge = $atom->Charge() + 0;
my $namecharge = $name;
if($charge > 0) {
$namecharge = "$name$charge+";
}
elsif($charge < 0) {
my $c = -$charge;
$namecharge = "$name$c-";
}
$namecharge =~ s/1//g;
my ($NearestName, @list) = $this->FindNearestAtom($name, $charge);
$RietanAtomName{$name} = $NearestName;
print "++ $NearestName is chosen for $namecharge from (@list)
\n";
}
#一致する空間群を取得
print "Search space group number/origin set.
\n";
my $SPG = $Crystal->GetCSpaceGroup();
my $RSPG = $this->FindIdenticalSpaceGroup($SPG);
if($RSPG <= 0) {
print "Error in Rietan.pm::SaveInsFile: Identical space group was not found.$LF";
return -1;
}
my $SPGName = $RSPG->SPGName();
my $iSPG = $RSPG->iSPG();
my $iSet = $RSPG->iSet();
print "+++ Name: ($SPGName) [#$iSPG - $iSet]$LF";
#置換開始
my $SampleName = $this->SampleName();
$Content =~ s/{Title}/$SampleName/sig;
$Content =~ s/{PHNAME1}/$SampleName/sig;
print "T: $TemplatePath ($StartAngle, $EndAngle, $StepAngle)\n";
$Content =~ s/{StartAngle}/$StartAngle/sig;
$Content =~ s/{EndAngle}/$EndAngle/sig;
$Content =~ s/{StepAngle}/$StepAngle/sig;
my $Atoms = '';
for(my $i = 0 ; $i < $nAtomType ; $i++) {
my $atom = $AtomTypeList[$i];
my $atomname = $atom->AtomNameOnly();
my $name = $RietanAtomName{$atomname};
$Atoms .= " '$name'"
if($Atoms !~ /$name/);
}
$Content =~ s/{Atoms}/$Atoms/sig;
# my $iSPG = $Crystal->iSPGByOutputMode();
# my $iSet = $Crystal->iSetByOutputMode();
my $RietanSPG = "A-$iSPG";
$RietanSPG = "$RietanSPG-$iSet" if($iSet ne '');
$Content =~ s/{SPG}/$RietanSPG/sig;
$Content =~ s/{SPGName}/$SPGName/sig;
my ($a,$b,$c,$alpha,$beta,$gamma) = $Crystal->LatticeParametersByOutputMode(0);
my $CELLQ;
$CELLQ = "$a $b $c $alpha $beta $gamma";
$Content =~ s/{CELLQ}/$CELLQ/sig;
my @ExpandedAtomSiteList = $Crystal->GetCExpandedAtomSiteListByOutputMode();
my $nExpandedAtomSite = @ExpandedAtomSiteList;
my $ATOMCOORDS;
my %AtomCount;
for(my $i = 0 ; $i < $nExpandedAtomSite ; $i++) {
my $atom = $ExpandedAtomSiteList[$i];
my $atomname = $atom->AtomName();
my $atomnameonly = $atom->AtomNameOnly();
my $name = $RietanAtomName{$atomnameonly};
my ($x,$y,$z) = $atom->Position(1);
my $occupancy = $atom->Occupancy();
my $i1 = $i+1;
$AtomCount{$atomname}++;
my $c = $AtomCount{$atomname};
my $label = "$atomnameonly$c";
$ATOMCOORDS .= " $label/$name $occupancy $x $y $z 0.5000 01101\n";
}
$Content =~ s/{ATOMCOORDS}/$ATOMCOORDS/sig;
unless(open(OUT,">$filename")) {
print "Can not write to $filename.$LF$LF";
return;
}
print OUT $Content;
print OUT "\n";
close(OUT);
return 1;
}
1;