#===============================================
# CIFObject
#===============================================
package CIFObject;
use Exporter;
@ISA = qw(Exporter);

#公開したいサブルーチン
@EXPORT = qw();

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

use Utils;
use Crystal::Crystal;
use Crystal::SpaceGroup;
use Crystal::AtomType;
use Crystal::AtomSite;

my $LF = "<br>\n";
my $Debug = 0;

#============================================================
#　静的メンバー関数
#============================================================
sub BuildCreationDateStr {
	my ($sec, $min, $hour, $mday, $mon, $year,
	        $wday, $yday, $isdst) = localtime(time());
	$mon++;
	$year += 1900;
	my $s = sprintf "%04d/%02d/%02d", $year, $mon, $mday;
	return $s;
}

#============================================================
#　コンストラクタ、デストラクタ
#============================================================
sub new
{
	my ($module, $filename) = @_;
	my $this = {};
	bless $this;
	$this->SetFileName($filename);
	return $this;
}

sub DESTROY
{
	my $this = shift;
}

#============================================================
#　一般関数
#============================================================
sub ReadCrystal
{
	my ($this, $cifpath) = @_;

	unless($this->Read($cifpath, 0)) {
		return undef;
	}
	return $this->GetCCrystal();
}

sub SetCrystalName
{
	my ($this,$name) = @_;
	Utils::DelSpace($name);
	$this->{'CrystalName'} = $name;
	return $name;
}

sub CrystalName
{
	my ($this) = @_;
	return $this->{'CrystalName'};
}

sub SetFormula
{
	my ($this,$s) = @_;
	$this->{'_chemical_formula_sum'} = $s;
	$this->{'_chemical_formula_structural'} = $s
		if($this->{'_chemical_formula_structural'} eq '');
	return $s;
}

sub Formula
{
	my ($this) = @_;
	return $this->{'_chemical_formula_structural'} if(defined $this->{'_chemical_formula_sum'});
	return $this->{'_chemical_formula_sum'} if(defined $this->{'_chemical_formula_sum'});
	return undef;
}
sub SetFileName
{
	my $this = shift;
	my $s = shift;
	Utils::DelSpace($s);
#no strict;
	$this->{'FileName'} = $s;
#use strict;	
}

sub FileName
{
	my $this = shift;
	return $this->{'FileName'};
}

sub Read
{
	my ($this, $f) = @_;
#	$this->SetFileName($f) if($f ne '');

	my $in = new JFile;
	unless($in->Open($f, "r")) {
#		print "$!: $f\n";
		return 0;
	}
	my $ret = $this->ReadByJFile($in);
	$in->Close();

	return $ret;
}

sub ReadByJFile
{
	my ($this, $in) = @_;

	$this->SetFileName($in->{FileName});
	my $FileEnd = 0;
#最初の一行
	my $header;
	while(!$FileEnd) {
		$header = $in->ReadLine();
		if(!defined $header) {
			return 0;
		}
		Utils::DelSpace($header);
		if($header =~ /^_/) {
			$in->rewind();
			last;
		}
		if($header ne '') {
			$this->{header} = $header;
			last;
		}
	}

	my $ExitLoop = 0;
	while(!$FileEnd) {
		last if($ExitLoop);

		my $line = $in->ReadLine();
		last if(!defined $line);

		Utils::DelSpace($line);
if($Debug) {
	print "line: $line$LF";
}
# 空行はスキップ
		next if($line =~ /^$/);
#		next if($line =~ /^#/);
# #Endを見つけたら終わる
		if($line =~ /^#End/i) {
			$FileEnd = 1;
			last;
		}
		next if($line =~ /^#/);
#print "l0: $line\n";

#loop_の無いデータを読み込み
		if($line =~ /^_/) {
			my ($key, $content) = ($line =~ /^(\S+?)\s+(.*)$/);
#			if(defined $key and $key ne '') {
			if($content ne '') {
				$this->{$key} = $content;
				next;
			}
			else {
				$line = $in->ReadLine();
#print "ll0: $line";
				Utils::DelSpace($line);
				next if($line ne ';');
				$content = '';
				while(1) {
					$line = $in->ReadLine();
#print "ll1: $line";
					Utils::DelSpace($line);
					last if($line eq ';' or $line =~ /^#End/i);
					$content .= "$line\n";
				}
				$content =~ s/[\r\n]+$//;
#print "cont: [$content]\n";
				$this->{$key} = $content;
				next;
			}
		}
#loop_のデータを読み込み
		elsif($line =~ /^loop_$/i) {
#print "l: $line\n";
			my @Params;
			my $Count = 0;
			my $line2 = '';
#loop_内のパラメータ名を取得
#			my $pos = 0;
			my $pos = $in->tell();
#print "loop_<br>\n";
			while(!$FileEnd) {
				$line2 = $in->ReadLine();
#print "l2: $line2";
				last if(!defined $line2);
				if($line2 =~ /^#End/i) {
					$FileEnd = 1;
					last;
				}
				next if($line2 =~ /^#/);

				Utils::DelSpace($line2);
#print "line2: $line2<br>\n";
				unless($line2 =~ /^(_|loop_)/) {
#2006/5/4 Na.cifのためにコメントをはずす
					$in->seek($pos, 0) if($pos > 0);
					last;
				}

				$Params[$Count] = $line2;
				$Count++;
#2006/5/4 Na.cifのためにコメントをはずす
				$pos = $in->tell();
			}
#$Debug=1;
if($Debug) {
	foreach my $s (@Params) {
		print "Key: $s$LF";
	}
}
#loop_内のパラメータを取得
#2006/5/4 Na.cifのために''で初期化するように変更
#			my $LoopContent = $line2;
			my $LoopContent = '';
			$pos = 0;
			while(!$FileEnd) {
				$line2 = $in->ReadLine();
				last if(!defined $line2);
				if($line2 =~ /^#End/i) {
					$FileEnd = 1;
					last;
				}
				next if($line2 =~ /^#/);
#print "l3: $line2";

				Utils::DelSpace($line2);
				next if($line2 eq '');
#				last if($line2 eq '');
#次のloop_を見つけたら、LoopContentを解析
				if($line2 =~ /^(_|loop_)/) {
					$in->seek($pos, 0) if($pos > 0);
					last;
				}
				$LoopContent = "$LoopContent $line2";
				$pos = $in->tell();
			}
			last if($ExitLoop);

#print "LoopC: [$LoopContent]\n";
			my $pt = 0;
			my $c = 0;
			while($LoopContent =~ /(\'.*?\'|\S+)/g) {
				my $s = $1;
				my $i = int($c / $Count) + 1;
				$c++;
#				if($ShowCIFInf ne '') {
#					print "  <b>$Params[$pt]" . "[$i] " . ":</b> $s\n";
#					print "  $i: $Params[$pt]: $s\n";
#				}

#				$Params[$pt] =~ s/[\r\n\s]//g;
				my $key = "${Params[$pt]}[$i]";
#print "k: $key: $s\n";
				$this->{$key} = $s;
if($Debug) {
	print "akey: {$key}  :  $s$LF";
}
				$pt++;
				$pt = 0 if($pt >= $Count);
			}
		}
		last if($ExitLoop);
	}
	$this->SetOtherParameters();
#exit;

	return 1;
}

sub SetOtherParameters
{
	my ($this) = @_;
	my $nAtomType = 0;
	for(my $i = 1 ; ; $i++) {
		my $val = &GetValue($this, "_atom_type_symbol", $i);
#		if(!defined $val or $val eq '') {
#			$val = &GetValue($this, "_atom_site_label", $i);
#			$val =~ s/[\d+-]+//g;
#		}
		last if(!defined $val or $val eq '');
		$this->{"iAtomType_$val"} = $i;
		$nAtomType++;
	}
	$this->{"nAtomType"} = $nAtomType;

	my $nAsymmetricAtomSite = 0;
	for(my $i = 1 ; ; $i++) {
		my $val = &GetValue($this, "_atom_site_fract_x", $i);
		last if(!defined $val or $val eq '');
		$nAsymmetricAtomSite++;
	}
	$this->{"nAsymmetricAtomSite"} = $nAsymmetricAtomSite;

#	if($nAtomType == 0) {
		for(my $i = 1 ; $i <= $nAsymmetricAtomSite ; $i++) {
			my $val = &GetValue($this, "_atom_site_type_symbol", $i);
			if(!defined $val or $val eq '') {
				$val = &GetValue($this, "_atom_site_label", $i);
				$val =~ s/[\d+-]+//g;
			}
#print "v: $val$LF";
			if($val =~ /^(\w+)([\+-])([\d\.]+)$/i) {
				if($3 == 1) {
					$val = "$1$2";
				}
				else {
					$val = "$1$3$2";
				}
#print " => v: $val$LF";
			}
#print "v: $val$LF";
			$this->AddAtomType($val);
			&SetContent($this, "_atom_site_type_symbol", $i, $val);
		}
#	}

	my $a = &GetValue($this, "_cell_length_a");
	my $b = &GetValue($this, "_cell_length_b");
	my $c = &GetValue($this, "_cell_length_c");
	my $alpha = &GetValue($this, "_cell_angle_alpha");
	my $beta  = &GetValue($this, "_cell_angle_beta");
	my $gamma = &GetValue($this, "_cell_angle_gamma");
	my $lattice = $this->{"_symmetry_cell_setting"};
#print "lat: $a $b $c$LF";

	my $SPG = new SpaceGroup();
	my ($SPGName, $iSPG) = $this->GetSpaceGroup();
	$SPG->SetSPGName($SPGName);
	$SPG->SetiSPG($iSPG);
#print "SPGName1 in CIFObject: $SPGName\n";
	$SPG->SetLatticeParameters($a,$b,$c,$alpha,$beta,$gamma);
	$SPG->SetLatticeSystem($lattice);
	$this->{"_symmetry_cell_setting"} = $SPG->LatticeSystem();

	$this->{"nTranslation"} = $SPG->AnalyzeTranslation();

#	my $nSymmetryOperation = 0;
	for(my $i = 1 ; ; $i++) {
		my $val = &GetValue($this, "_symmetry_equiv_pos_as_xyz", $i);
		$val = &GetValue($this, "_space_group_symop_operation_xyz", $i) if($val eq '');
		last if(!defined $val or $val eq '');
		$SPG->AddSymmetryOperation($val);
#		$nSymmetryOperation++;
	}
	$this->{"nSymmetryOperation"} = $SPG->nSymmetryOperation();
#print "a$LF";
	return;
}

sub AddSymmetryOperation
{
	my ($this,$symop) = @_;

	my $nSymmetryOperation = $this->{"nSymmetryOperation"};
	$nSymmetryOperation++;
#print "Add: i=$nSymmetryOperation: $symop<br>";
	$this->SetContent("_symmetry_equiv_pos_as_xyz", $nSymmetryOperation, $symop);
	return $this->{"nSymmetryOperation"} = $nSymmetryOperation;
}

sub GetCSpaceGroup
{
	my ($this) = @_;

	my $a = &GetValue($this, "_cell_length_a");
	my $b = &GetValue($this, "_cell_length_b");
	my $c = &GetValue($this, "_cell_length_c");
	my $alpha = &GetValue($this, "_cell_angle_alpha");
	my $beta  = &GetValue($this, "_cell_angle_beta");
	my $gamma = &GetValue($this, "_cell_angle_gamma");
	my $lattice = $this->{"_symmetry_cell_setting"};

	my $SPG = new SpaceGroup();
	my ($SPGName, $iSPG) = &GetSpaceGroup($this);
	$SPG->SetSPGName($SPGName);
	$SPG->SetiSPG($iSPG);
	$SPG->SetLatticeParameters($a,$b,$c,$alpha,$beta,$gamma);
	$SPG->SetLatticeSystem($lattice);
	$SPG->AnalyzeTranslation();
	for(my $i = 1 ; ; $i++) {
		my $val = &GetValue($this, "_symmetry_equiv_pos_as_xyz", $i);
		$val = &GetValue($this, "_space_group_symop_operation_xyz", $i) if($val eq '');
		last if(!defined $val or $val eq '');
		$SPG->AddSymmetryOperation($val);
	}
	return $SPG;
}

sub SetContent
{
	my ($this, $key, $idx, $content) = @_;

	if(@_ == 3) {
		$content = $idx;
		$idx = '';
	}
	$key = ${key} . "[$idx]" if($idx ne '' and $idx > 0);
	$this->{$key} = $content;
	return $content;
}

sub GetContent
{
	my ($this, $key, $idx, $defvalue) = @_;

	$key = ${key} . "[$idx]" if(defined $idx and $idx ne '' and $idx > 0);
	my $val = $this->{$key};
#print "key: $key\n";
#print "val: $val\n";
#print "keys: ", keys %$this, "\n";
#print "v1: $val => ";
	$val =~ s/^(\')(.*)(\1)$/$2/ if(defined $val);
#print "$val => ";
	$val = $defvalue if(defined $val and $val eq '');
#print "$val<br>\n";
	return $val;
}

sub GetValue
{
	my ($this, $key, $idx) = @_;

	my $val = &GetContent($this, $key, $idx);
#数値の最後の(誤差)を削除
	$val =~ s/^([+-\.\deE]+)\s*(\(.*?\))$/$1/ if(defined $val);
#両端の引用符を削除
	$val =~ s/^\s*(['"])(.*)\1\s*$/$2/ if(defined $val);
	
	return $val;
}

sub SetVolume
{
	my ($this,$v) = @_;
	return $this->SetContent("_cell_volume", $v);
}

sub Volume
{
	my ($this) = @_;
	return $this->GetValue("_cell_volume");
}

sub SetLatticeParameters
{
	my ($this,$a,$b,$c,$alpha,$beta,$gamma) = @_;
	$a = Utils::Round($a, 6);
	$b = Utils::Round($b, 6);
	$c = Utils::Round($c, 6);
	$alpha = Utils::Round($alpha, 6);
	$beta  = Utils::Round($beta , 6);
	$gamma = Utils::Round($gamma, 6);

	$this->SetContent("_cell_length_a", $a);
	$this->SetContent("_cell_length_b", $b);
	$this->SetContent("_cell_length_c", $c);
	$this->SetContent("_cell_angle_alpha", $alpha);
	$this->SetContent("_cell_angle_beta", $beta);
	$this->SetContent("_cell_angle_gamma", $gamma);

	return ($a,$b,$c,$alpha,$beta,$gamma);
}

sub LatticeParameters
{
	my ($this) = @_;

	my $a = &GetValue($this, "_cell_length_a");
	my $b = &GetValue($this, "_cell_length_b");
	my $c = &GetValue($this, "_cell_length_c");
	my $alpha = &GetValue($this, "_cell_angle_alpha");
	my $beta  = &GetValue($this, "_cell_angle_beta");
	my $gamma = &GetValue($this, "_cell_angle_gamma");

	return ($a,$b,$c,$alpha,$beta,$gamma);
}

sub GetSpaceGroup
{
	my ($this) = @_;

	my $SPGName = &GetValue($this, "_symmetry_space_group_name_H-M");
	$SPGName = &GetValue($this, "_space_group_name_H-M_alt") if($SPGName eq '');
	my $iSPG = &GetValue($this, "_symmetry_Int_Tables_number");
	$iSPG = &GetValue($this, "_space_group_IT_number") if($iSPG eq '');
	if($iSPG eq '') {
		$iSPG = 1;
		$SPGName = 'P 1';
	}
	return ($SPGName, $iSPG);
}

sub SetSpaceGroup
{
	my ($this, $SPGName, $iSPG) = @_;

	$this->SetContent("_symmetry_space_group_name_H-M", $SPGName);
	$this->SetContent("_symmetry_Int_Tables_number", $iSPG);

#	$this->{"nTranslation"} = $this->AnalyzeTranslation();

	return ($SPGName, $iSPG);
}

sub SetSpaceGroupInformation
{
	my ($this, $SPG) = @_;

	$this->SetSpaceGroup($SPG->SPGName(), $SPG->iSPG());
	my $nSymmetryOperation = $SPG->nSymmetryOperation();
	for(my $i = 0 ; $i < $nSymmetryOperation ; $i++) {
		my $symop = $SPG->SymmetryOperation($i);
		$this->AddSymmetryOperation($symop);
	}
}

sub LatticeSystem
{
	my ($this) = @_;

	return &GetValue($this, "_symmetry_cell_setting");
}

sub nTranslation
{
	my ($this) = @_;

	return &GetValue($this, "nTranslation");
}

sub nSymmetryOperation
{
	my ($this) = @_;

	return &GetValue($this, "nSymmetryOperation");
}

sub SymmetryOperation
{
	my ($this, $i) = @_;
	my $val = &GetValue($this, "_symmetry_equiv_pos_as_xyz", $i);
#print "Get: i=$i: $val<br>";
	return $val;
}

sub nAtomType
{
	my ($this, $i) = @_;

	return &GetValue($this, "nAtomType");
}

sub SetnAtomType
{
	my ($this, $n) = @_;
	return $this->SetContent("nAtomType", $n);
}

sub GetCAtomType
{
	my ($this, $i) = @_;

	my ($atomname, $charge) = $this->AtomType($i);
	my $atom = new AtomType();
	$atom->SetAtomName($atomname);
	$atom->SetCharge($charge); 
	return $atom;
}

sub GetCAtomTypeList
{
	my ($this) = @_;
	my $natom = $this->nAtomType();
	my @atomlist;
	for(my $i = 0 ; $i < $natom ; $i++)
	{
		my $atom = $this->GetCAtomType($i+1);
		push(@atomlist, $atom);
	}
	return @atomlist;
}

sub AtomType
{
	my ($this, $i) = @_;

	my $name   = &GetValue($this, "_atom_type_symbol", $i);
	my $charge = &GetValue($this, "_atom_type_oxidation_number", $i);
	if(!defined $name or $name eq '') {
		$name   = &GetValue($this, "_atom_site_label", $i);
		$name =~ s/[\d+-]+//g;
		$charge = 0.0;
	}
#print "name: $name, $charge<br>\n";
	return ($name, $charge);
}

sub AddAtomType
{
	my ($this, $atomtype) = @_;
	$atomtype = ucfirst $atomtype;
#print "AtomType: $atomtype\n";

	my $nAtomType = $this->nAtomType();
#print "na=$nAtomType\n";
	for(my $i = 0 ; ; $i++) {
		my $val = $this->GetContent("_atom_type_symbol", $i+1);
#		if(!defined $val or $val eq '') {
#			$val = &GetValue($this, "_atom_site_label", $i);
#			$val =~ s/[\d+-]+//g;
#		}
#print "i=$i: $val:$atomtype\n";
		last if($val eq '');
		return $nAtomType if($val eq $atomtype);
	}

	my ($name,$charge,$sign) = ($atomtype =~ /^(\D+)(\d+)?([\+-])?/);
	$charge = -$charge if($sign =~ /-/);
#print "name: $name - $charge - $sign<br>";
	$nAtomType++;
	$this->SetContent("_atom_type_symbol",           $nAtomType, $atomtype);
	$this->SetContent("_atom_type_oxidation_number", $nAtomType, $charge);
	$this->SetnAtomType($nAtomType);
	return $nAtomType;
}

#配列の引数は1からはじまる
sub SetAsymmetricAtomSiteVelocity
{
	my ($this, $i, $vx, $vy, $vz) = @_;
	$this->SetContent("Atom_site_velocity_x", $i, $vx);
	$this->SetContent("Atom_site_velocity_y", $i, $vy);
	$this->SetContent("Atom_site_velocity_z", $i, $vz);
	my $nSites = $this->nAsymmetricAtomSite();
	return $nSites;
}

sub AsymmetricAtomSiteVelocity
{
	my ($this, $i) = @_;
	my $vx = $this->GetContent("Atom_site_velocity_x", $i);
	my $vy = $this->GetContent("Atom_site_velocity_y", $i);
	my $vz = $this->GetContent("Atom_site_velocity_z", $i);
#print "CIF:AsymmetricAtomSiteVelocity: $i: ($vx, $vy, $vz)<br>\n";
	return ($vx, $vy, $vz);
}

sub AddAsymmetricAtomSiteWithVelocity
{
	my ($this, $label, $atomtype, $x, $y, $z, $occ,
		$vx, $vy, $vz) = @_;
	$vx = 0.0 if($vx eq '');
	$vy = 0.0 if($vy eq '');
	$vz = 0.0 if($vz eq '');
	my $i = $this->AddAsymmetricAtomSite($label,$atomtype,$x,$y,$z,$occ);
	$this->SetAsymmetricAtomSiteVelocity($i, $vx, $vy, $vz);
#print "CIF: $i: ($x,$y,$z) ($vx,$vy,$vz)<br>\n";
}

#配列の引数は1からはじまる
sub AddAsymmetricAtomSite
{
	my ($this, $label, $atomtype, $x, $y, $z, $occ) = @_;
	my $nSites = $this->nAsymmetricAtomSite();
	$nSites++;
	$this->SetContent("_atom_site_label",       $nSites, $label);
	$this->SetContent("_atom_site_type_symbol", $nSites, $atomtype);
#print "t: $atomtype\n";
	$this->AddAtomType($atomtype);
	$this->SetContent("_atom_site_fract_x",     $nSites, $x);
	$this->SetContent("_atom_site_fract_y",     $nSites, $y);
	$this->SetContent("_atom_site_fract_z",     $nSites, $z);
	$this->SetContent("_atom_site_occupancy",   $nSites, $occ);
	$this->SetnAsymmetricAtomSite($nSites);
#print "n: $nSites ($label)<br>";
	return $nSites;
}


sub SetnAsymmetricAtomSite
{
	my ($this,$n) = @_;

	return $this->SetContent("nAsymmetricAtomSite", $n);
}

sub nAsymmetricAtomSite
{
	my ($this) = @_;

	return &GetValue($this, "nAsymmetricAtomSite");
}

sub GetCAsymmetricAtomSite
{
	my ($this, $i) = @_;

	my ($label,$type,$x,$y,$z,$occupancy) 
		= $this->AsymmetricAtomSite($i);
	my ($vx,$vy,$vz)
		= $this->AsymmetricAtomSiteVelocity($i);

	my $atom = new AtomSite();
	$atom->SetLabel($label);
	$atom->SetAtomName($type); 
	$atom->SetPosition($x, $y, $z); 
	$atom->SetOccupancy($occupancy); 
#print "v2: $i: ($vx,$vy,$vz)<br>\n";
	$atom->SetVelocity($vx, $vy, $vz);

#	my ($vx,$vy,$vz) = $atom->Velocity();
#print "v3: $i: ($vx,$vy,$vz)<br>\n";
	
	return $atom;
}

sub GetCAsymmetricAtomSiteList
{
	my ($this) = @_;
	my $natom = $this->nAsymmetricAtomSite();
	my @atomlist;
	for(my $i = 0 ; $i < $natom ; $i++)
	{
		my $atom = $this->GetCAsymmetricAtomSite($i+1);
		push(@atomlist, $atom);
	}
	return @atomlist;
}

sub AsymmetricAtomSite
{
	my ($this, $i) = @_;

	my $label = &GetValue($this, "_atom_site_label", $i);
	my $type  = &GetValue($this, "_atom_site_type_symbol", $i);
	if(!defined $type or $type eq '') {
		$type = &GetValue($this, "_atom_site_label", $i);
		$type =~ s/[\d+-]+//g;
	}
	my $x = &GetValue($this, "_atom_site_fract_x", $i);
	my $y = &GetValue($this, "_atom_site_fract_y", $i);
	my $z = &GetValue($this, "_atom_site_fract_z", $i);
	my $occupancy = &GetValue($this, "_atom_site_occupancy", $i);
	return ($label,$type,$x,$y,$z,$occupancy);
}

sub FillCIFData
{
	my ($this) = @_;

	my $crystal = new Crystal();
	$crystal->SetCrystalName($this->CrystalName());
	$crystal->SetLatticeParameters($this->LatticeParameters());
	$this->SetContent("_cell_volume", $crystal->Volume());
	my $SPG = $this->GetCSpaceGroup();
	$crystal->SetCSpaceGroup($SPG);
	$crystal->SetCAtomTypeList($this->GetCAtomTypeList() );
	$crystal->SetCAsymmetricAtomSiteList($this->GetCAsymmetricAtomSiteList() );
	$crystal->ExpandCoordinates();

	my @MultList = $crystal->GetCnMultiplicityExpandedAtomSiteList();
	for(my $i = 0 ; $i < @MultList ; $i++) {
		$this->SetContent("_atom_site_symmetry_multiplicity", 
				$i+1, $MultList[$i]);
	}

	if($this->GetContent("_symmetry_cell_setting") eq '') {
		$this->SetContent("_symmetry_cell_setting", 
				$SPG->LatticeSystem());
	}
	if($SPG->SPGName() =~ /^P\s*1$/i) {
		$this->SetContent("_symmetry_cell_setting", 'triclinic');
	}

	my %AtomCount;
	my $nAsymmetricAtomSite = $crystal->nAsymmetricAtomSite();
	for(my $i = 0 ; $i < $nAsymmetricAtomSite ; $i++) {
		my $site = $crystal->GetCAtomSite($i);
		my $mult = $MultList[$i];
		my $name = $site->AtomNameOnly();
		$AtomCount{$name} += $mult * $site->Occupancy();
#print "occ: ", $site->Occupancy(), "<BR>";
	}
	my $s = '';
	my @keys = keys %AtomCount;
	for(my $i = 0 ; $i < @keys ; $i++) {
		my $name = $keys[$i];
		my $n    = $AtomCount{$name};
		my $s1 = substr("$n", 0, 5);
#print "$n:$s1<br>";
		$s = "$s $name$s1";
	}
	$s =~ s/^\s+//;
	$this->SetContent("_chemical_formula_structural", $s);
	$this->SetContent("_chemical_formula_sum", $s);
	$s =~ s/\s//g;
	$this->SetContent("_chemical_name_systematic", $s);
	$this->SetContent("_cell_formula_units_Z", 1);
	
	my $date = $this->GetContent("_audit_creation_date");
	if($date eq '') {
		my ($sec, $min, $hour, $mday, $mon, $year,
		        $wday, $yday, $isdst) = localtime(time());
		$mon++;
		$year += 1900;
		my $s = sprintf "%04d/%02d/%02d", $year, $mon, $mday;
		$this->SetContent("_audit_creation_date", $s);
	}
	
	$this->SetContent("_audit_creation_method", "generated by Perl:CIF.pm 0.1");
	return $crystal;
}

sub GetCCrystal
{
	my ($this) = @_;
	my $crystal = new Crystal();
	$crystal->{'CIFFileName'} = $this->{'FileName'};
	my $Sample = $this->{'FileName'};
	$Sample =~ s/^(.*[\\\/])?(.*?)(\..*?)?$/$2/;
	$crystal->SetCrystalName($Sample);
	my $SPG = $this->GetCSpaceGroup();
	$crystal->SetCSpaceGroup($SPG);
	$crystal->SetLatticeParameters($this->LatticeParameters() );
	my @AtomTypeList = $this->GetCAtomTypeList();
	$crystal->SetCAtomTypeList(@AtomTypeList);
	$crystal->SetCAsymmetricAtomSiteList($this->GetCAsymmetricAtomSiteList() );
	$crystal->ExpandCoordinates();
	return $crystal;
}

sub InsertSpaceToSPGName
{
	my ($this, $SPGName) = @_;
	if($SPGName =~ /[RH]$/) {
		return $SPGName if($SPGName =~ /\s.+\S\s+[RHS]$/);
	}
	else {
		return $SPGName if($SPGName =~ /\s/);
	}

	$SPGName =~ s/(.)/$1 /g;
	$SPGName =~ s/\s\s+/ /g;
	$SPGName =~ s/- /-/g;
	$SPGName =~ s/ \/ /\//g;
	$SPGName =~ s/([^\-])2 1/${1}21/g;
	$SPGName =~ s/([^\-])3 1/${1}31/g;
	$SPGName =~ s/([^\-])3 2/${1}32/g;
	$SPGName =~ s/([^\-])4 1/${1}41/g;
	$SPGName =~ s/([^\-])4 2/${1}42/g;
	$SPGName =~ s/([^\-])4 3/${1}43/g;
	$SPGName =~ s/([^\-])6 1/${1}61/g;
	$SPGName =~ s/([^\-])6 2/${1}62/g;
	$SPGName =~ s/([^\-])6 3/${1}63/g;
	$SPGName =~ s/([^\-])6 4/${1}64/g;
	$SPGName =~ s/([^\-])6 5/${1}65/g;

print "SPGN: $SPGName\n";
	return $SPGName;

	my ($Lattice, $res) = ($SPGName =~ /^(.)(.*)$/);
	my ($Sym0, $res2);
	if($res =~ /^(.+\/.)(.*)$/) {
		($Sym0, $res2) = ($1, $2);
	}
	else {
		($Sym0, $res2) = ($res =~ /^(-?.)(.*)$/);
	}

	$res2 =~ s/([^\-\/])/$1 /g;
	$res2 =~ s/^\s*//;
	$res2 =~ s/\s*$//;
	$res2 =~ s/\s+/ /g;
	$SPGName = "$Lattice $Sym0 $res2";
#print "SPGN: $SPGName\n";
	return $SPGName;
}

sub WriteSimpleCIFFile
{
	my ($this, $NewFile, $WritePublication, $strCRLF) = @_;

#print "<H1>CIFObject::WriteSimpleCIFFile</H1>\n";

	$this->FillCIFData();
#ファイル名を（ベース名, ディレクトリ名, 拡張子）に分解
	my @filenames = fileparse($NewFile, "\.[^\.]+");
	my $fname = $filenames[0];
	$fname = $fname . $filenames[2] if($filenames[2] ne '');

	unless(open(OUT,">$NewFile")) {
		return 0;
	}
	binmode(OUT) if(defined $strCRLF and $strCRLF =~ /unix/i);
	my $dbcodeICSD = $this->{"_database_code_ICSD"};
	$dbcodeICSD = 99999 if($dbcodeICSD eq '');
	print OUT "data_${dbcodeICSD}-ICSD\n";
	print OUT "\n";

	my ($key, $val);

	$val = $this->GetContent(
		$key = "_audit_creation_date", '', '2005/01/01');
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->GetContent(
		$key = "_audit_creation_method", '', 'Perl CIFObject.pm 0.1');
	printf OUT "%-35s'%s'\n", $key, $val;
	print OUT "\n";

	printf OUT "%-35s%s\n", "_database_code_ICSD", $dbcodeICSD;
	print OUT "\n";

	$val = $this->GetContent(
		$key = "_chemical_name_systematic", '', 'undefined');
	printf OUT "%-35s'%s'\n", $key, $val;

	$val = $this->GetContent(
		$key = "_chemical_formula_structural", '', 'undefined');
	printf OUT "%-35s'%s'\n", $key, $val;
	$val = $this->GetContent(
		$key = "_chemical_formula_sum", '', 'undefined');
	printf OUT "%-35s'%s'\n", $key, $val;
	print OUT "\n";

	if($WritePublication) {
		$val = $this->GetContent(
			$key = "_journal_name_full", '', 'undefined');
		printf OUT "%-35s'%s'\n", $key, $val;
		print  OUT "\n";
	}
if(0) {
	printf OUT "%-35s%s\n", "_publ_section_title", "";
	print OUT ";\n";
	print OUT "title\n";
	print OUT ";\n";
	print OUT "loop_\n";
	$key = "_publ_author_name";
	printf OUT "%-35s%s\n", $key, "";
	for(my $i = 1 ; ; $i++) {
		$val = $this->GetContent($key, $i);
		last if($val eq '');
		print OUT "  $val\n";
	}
	$val = $this->{$key = "_journal_name_full"};
	$val = 'undefined' if($val eq '');
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->{$key = "_journal_coden_ASTM"};
	$val = 'undefined' if($val eq '');
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->{$key = "_journal_volume"};
	$val = 'undefined' if($val eq '');
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->{$key = "_journal_year"};
	$val = 'undefined' if($val eq '');
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->{$key = "_journal_page_first"};
	$val = 'undefined' if($val eq '');
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->{$key = "_journal_page_last"};
	$val = 'undefined' if($val eq '');
	printf OUT "%-35s%s\n", $key, $val;
	print OUT "\n";
}

	$val = $this->GetContent($key = "_cell_length_a");
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->GetContent($key = "_cell_length_b");
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->GetContent($key = "_cell_length_c");
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->GetContent($key = "_cell_angle_alpha");
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->GetContent($key = "_cell_angle_beta");
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->GetContent($key = "_cell_angle_gamma");
	printf OUT "%-35s%s\n", $key, $val;
	$val = 'undefined' if($val eq '');
	$val = $this->{$key = "_cell_volume"};
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->{$key = "_cell_formula_units_Z"};
	$val = 'undefined' if($val eq '');
	printf OUT "%-35s%s\n", $key, $val;
	print OUT "\n";

	$val = $this->GetContent($key = "_symmetry_space_group_name_H-M");
	$val = 'undefined' if($val eq '');
	$val = $this->InsertSpaceToSPGName($val);
	printf OUT "%-35s'%s'\n", $key, $val;
	$val = $this->GetContent($key = "_symmetry_Int_Tables_number");
	$val = 'undefined' if($val eq '');
	printf OUT "%-35s%s\n", $key, $val;
	$val = $this->GetContent($key = "_symmetry_cell_setting");
	$val = 'undefined' if($val eq '');
#print "SPG: $val<br>\n";
	printf OUT "%-35s%s\n", $key, $val;
	print OUT "\n";

	print OUT "loop_\n";
	$key = "_symmetry_equiv_pos_as_xyz";
	printf OUT "%-35s%s\n", $key, "";
	my $nsymop = $this->nSymmetryOperation();
#print "nSym: $nsymop<br>\n";
	for(my $i = 1 ; $i <= $nsymop ; $i++) {
		$val = $this->SymmetryOperation($i);
#print "val: [$val]\n";
		$val = "'$val'" if($val !~ /'/); #if($val !~ /^\'.*\'$/);
		print OUT "  $val\n" if($val ne '');
	}
	print OUT "\n";

	print OUT "loop_\n";
	my $key1 = "_atom_type_symbol";
	my $key2 = "_atom_type_oxidation_number";
	printf OUT "%-35s%s\n", $key1, "";
	printf OUT "%-35s%s\n", $key2, "";
	for(my $i = 1 ; ; $i++) {
		my $key1a = ${key1} . "[$i]";
		my $key2a = ${key2} . "[$i]";
		my $atomtype = $this->GetContent($key1a);
		my $oxidationstate = $this->GetContent($key2a);
		last if(!defined $atomtype or $atomtype eq '');
		$oxidationstate = 0 if($oxidationstate eq '');
		printf OUT "  %-6s%6s\n",
			$atomtype, $oxidationstate;
	}
	print OUT "\n";

	print OUT "loop_\n";
	$key1  = "_atom_site_label";
	$key2  = "_atom_site_type_symbol";
	my $key3  = "_atom_site_symmetry_multiplicity";
	my $key4  = "_atom_site_Wyckoff_symbol";
	my $key5  = "_atom_site_fract_x";
	my $key6  = "_atom_site_fract_y";
	my $key7  = "_atom_site_fract_z";
	my $key8  = "_atom_site_occupancy";
	my $key9  = "_atom_site_attached_hydrogens";
	my $key10 = "_atom_site_calc_flag";

	print OUT "$key1\n";
	print OUT "$key2\n";
	print OUT "$key3\n";
	print OUT "$key4\n";
	print OUT "$key5\n";
	print OUT "$key6\n";
	print OUT "$key7\n";
	print OUT "$key8\n";
	print OUT "$key9\n";
	print OUT "$key10\n";
	for(my $i = 1 ; ; $i++) {
		my $key1a  = ${key1} . "[$i]";
		my $key2a  = ${key2} . "[$i]";
		my $key3a  = ${key3} . "[$i]";
		my $key4a  = ${key4} . "[$i]";
		my $key5a  = ${key5} . "[$i]";
		my $key6a  = ${key6} . "[$i]";
		my $key7a  = ${key7} . "[$i]";
		my $key8a  = ${key8} . "[$i]";
		my $key9a  = ${key9} . "[$i]";
		my $key10a = ${key10} . "[$i]";
		my $val1  = $this->GetContent($key1a);
		my $val2  = $this->GetContent($key2a);
		my $val3  = $this->GetContent($key3a);
		my $val4  = $this->GetContent($key4a);
		my $val5  = $this->GetContent($key5a);
		my $val6  = $this->GetContent($key6a);
		my $val7  = $this->GetContent($key7a);
		my $val8  = $this->GetContent($key8a);
		my $val9  = $this->GetContent($key9a);
		my $val10 = $this->GetContent($key10a);
		last if(!defined $val1 or $val1 eq '');
		$val1  = $val2 if(!defined $val1 or $val1  eq '');
		$val2  = '--'  if(!defined $val2 or $val2  eq '');
		$val3  = 1     if(!defined $val3 or $val3  eq '');
		$val4  = 'x'   if(!defined $val4 or $val4  eq '');
		$val5  = '-'   if(!defined $val5 or $val5  eq '');
		$val6  = '-'   if(!defined $val6 or $val6  eq '');
		$val7  = '-'   if(!defined $val7 or $val7  eq '');
		$val8  = 1.0   if(!defined $val8 or $val8  eq '');
		$val9  = '0'   if(!defined $val9 or $val9  eq '');
		$val10 = 'a'   if(!defined $val10 or $val10 eq '');
		$val5 = sprintf("%11.6f", $val5) if($val5 =~ /^\s*[+\-\d\.eEdD]+\s*$/);
		$val6 = sprintf("%11.6f", $val6) if($val6 =~ /^\s*[+\-\d\.eEdD]+\s*$/);
		$val7 = sprintf("%11.6f", $val7) if($val7 =~ /^\s*[+\-\d\.eEdD]+\s*$/);
		$val8 = sprintf("%9.4f",  $val8)  if($val8 =~ /^\s*[+\-\d\.eEdD]+\s*$/);
		printf OUT "  %-6s%-6s%2d %s %s %s %s %s  %s %s\n",
			$val1, $val2, $val3, $val4, $val5,
			$val6, $val7, $val8, $val9, $val10;
	}
	print OUT "\n";
if(0) {
	my $Rf = $this->{$key = "_refine_ls_R_factor_all"};
	print OUT "$key \t$Rf\n";
}
	print OUT "\n";
	print OUT "#End of data_${dbcodeICSD}-ICSD\n";
	print OUT "\n";
	print OUT "\n";

	close(OUT);

	return 1;
}

sub CreateCIFFileFromCCrystal
{
	my ($this, $Crystal, $NewFile, $IsChooseRandomly, $strCRLF, $IsPrint) = @_;
	$IsPrint = 1 if(!defined $IsPrint);

	return 0 unless(open(OUT,">$NewFile"));
	binmode(OUT) if($strCRLF =~ /unix/i);

	my $dbcodeICSD =  99999;
	print OUT "data_${dbcodeICSD}-ICSD\n";
	print OUT "\n";

	my ($key, $val);

	printf OUT "%-35s%s\n", "_audit_creation_date", BuildCreationDateStr();

	printf OUT "%-35s'%s'\n", "_audit_creation_method", 'Perl CIFObject.pm 0.1';
	print OUT "\n";

	printf OUT "%-35s%s\n", "_database_code_ICSD", $dbcodeICSD;
	print OUT "\n";

	my $Composition = $Crystal->ChemicalComposition();
	$Composition =~ s/\s//g;
	my $name = $Composition;
	$name = $Crystal->CrystalName() unless($name);
	$name = $Crystal->SampleName() unless($name);
	$name = 'undefined' unless($name);
	printf OUT "%-35s'%s'\n", "_chemical_name_systematic", $name;

	$Composition = $Crystal->ChemicalComposition();
	printf OUT "%-35s'%s'\n", "_chemical_formula_structural", $Composition;
	my $SumComposition = $Crystal->SumChemicalComposition();
	printf OUT "%-35s'%s'\n", "_chemical_formula_sum",  $SumComposition;
	print OUT "\n";

	my ($a,$b,$c,$alpha,$beta,$gamma) = $Crystal->LatticeParametersByOutputMode(0);
#	$a = sprintf("%12.6f", $a);
#	$b = sprintf("%12.6f", $b);
#	$c = sprintf("%12.6f", $c);
#	$alpha = sprintf("%12.6f", $alpha);
#	$beta  = sprintf("%12.6f", $beta);
#	$gamma = sprintf("%12.6f", $gamma);
	$a = Utils::Round($a, 6);
	$b = Utils::Round($b, 6);
	$c = Utils::Round($c, 6);
	$alpha = Utils::Round($alpha, 6);
	$beta  = Utils::Round($beta, 6);
	$gamma = Utils::Round($gamma, 6);
	printf OUT "%-35s%s\n", "_cell_length_a", $a;
	printf OUT "%-35s%s\n", "_cell_length_b", $b;
	printf OUT "%-35s%s\n", "_cell_length_c", $c;
	printf OUT "%-35s%s\n", "_cell_angle_alpha", $alpha;
	printf OUT "%-35s%s\n", "_cell_angle_beta",  $beta;
	printf OUT "%-35s%s\n", "_cell_angle_gamma", $gamma;
	printf OUT "%-35s%s\n", "_cell_volume", $Crystal->Volume();
	printf OUT "%-35s%s\n", "_cell_formula_units_Z", $Crystal->FormulaUnit();
	print OUT "\n";

	my $SPGName = $Crystal->SPGNameByOutputMode();
	$SPGName = $this->InsertSpaceToSPGName($SPGName);
#print "SPGName: $SPGName<br>\n";
	my $iSPG    = $Crystal->iSPGByOutputMode();
	my $SPG = $Crystal->GetCSpaceGroup();
	my $LatticeSystem = $SPG->LatticeSystem();
	printf OUT "%-35s'%s'\n", "_symmetry_space_group_name_H-M", $SPGName;
	printf OUT "%-35s%s\n", "_symmetry_Int_Tables_number", $iSPG;
	printf OUT "%-35s%s\n", "_symmetry_cell_setting", $LatticeSystem;
	print OUT "\n";

	my @SymmetryOperation = $SPG->ExpandSymmetryOperation();
	my $nsymop = @SymmetryOperation;
#print "nsymop: $nsymop<br>\n";
	if($iSPG == 1 or $nsymop == 0) {
#		$nsymop = 1;
#		$SymmetryOperation[1] = "x,y,z";
		$nsymop = 0;
		$SymmetryOperation[0] = "x,y,z";
	}
	print OUT "loop_\n";
	printf OUT "%-35s%s\n", "_symmetry_equiv_pos_as_xyz", "";
		print OUT "  'x,y,z'\n";
	for(my $i = 0 ; $i <= $nsymop ; $i++) {
		my $SymOp = $SymmetryOperation[$i];
		Utils::DelSpace($SymOp);
		next if(!defined $SymOp or $SymOp =~ /^x\s*,\s*y\s*,\s*z$/i);
		print OUT "  \'$SymOp\'\n" if($SymOp ne '');
	}
	print OUT "\n";

	my @AtomTypeList = $Crystal->GetCAtomTypeList();
	print OUT "loop_\n";
	printf OUT "%-35s%s\n", "_atom_type_symbol", "";
	printf OUT "%-35s%s\n", "_atom_type_oxidation_number", "";
	for(my $i = 0 ; $i < @AtomTypeList ; $i++) {
		my $atom = $AtomTypeList[$i];
		my $atomtype = $atom->AtomNameOnly();
next if($atomtype eq '');
		my $oxidationstate = $atom->Charge();
		$oxidationstate = 0 unless(defined $oxidationstate);
		printf OUT "  %-6s%6s\n", $atomtype, $oxidationstate;
	}
	print OUT "\n";

	my @ExpandedAtomSiteList = $Crystal->GetCExpandedAtomSiteListByOutputMode();
	my $nExpandedAtomSite    = @ExpandedAtomSiteList;
	print OUT "loop_\n";
	print OUT "_atom_site_label\n";
	print OUT "_atom_site_type_symbol\n";
	print OUT "_atom_site_symmetry_multiplicity\n";
	print OUT "_atom_site_Wyckoff_symbol\n";
	print OUT "_atom_site_fract_x\n";
	print OUT "_atom_site_fract_y\n";
	print OUT "_atom_site_fract_z\n";
	print OUT "_atom_site_occupancy\n";
	print OUT "_atom_site_attached_hydrogens\n";
	print OUT "_atom_site_calc_flag\n";
#Occupancyが1のサイト
	my $count = 0;
	my %AtomCount;
	for(my $i = 0 ; $i < $nExpandedAtomSite ; $i++) {
		my $atom      = $ExpandedAtomSiteList[$i];
		my $atomname  = $atom->AtomNameOnly();
		my $charge    = $atom->Charge();
		my ($x,$y,$z) = $atom->Position(1);
		my $occupancy = $atom->Occupancy();
		my $mult      = $atom->Multiplicity();
		$mult = 1 if($Crystal->OutputMode() =~ /expand/i or $IsChooseRandomly);
		$mult = 1 if($mult <= 0.0);
		next if($occupancy < 0.9999);

		$AtomCount{$atomname}++;
		$count++;
		my $label = $atomname . $AtomCount{$atomname};
		printf OUT "  %-8s%-8s%2d %s %11.6f %11.6f %11.6f %9.4f  %s %s\n",
			$label, $atomname, $mult, "a", $x, $y, $z,
			$occupancy, "0", "a";
	}
#Occupancyが1未満のサイト
	if(@ExpandedAtomSiteList > $count and !$IsChooseRandomly) {
my $PrintShareAtomWarning = 0;
		if($PrintShareAtomWarning) {
			print "<H3>***Warning***: One line should be removed from $NewFile.</H3>\n";
			print OUT "*** Shared atoms: Remove this line for calculation: OCC=";
			for(my $i = 0 ; $i < @ExpandedAtomSiteList ; $i++) {
				my $atom      = $ExpandedAtomSiteList[$i];
				my $occupancy = $atom->Occupancy();
				next if($occupancy >= 0.9999);
				printf OUT "%lg ", $occupancy;
			}
			print OUT "\n";
		}
	}
	for(my $i = 0 ; $i < $nExpandedAtomSite ; $i++) {
		my $atom      = $ExpandedAtomSiteList[$i];
		my $atomname  = $atom->AtomNameOnly();
		my $charge    = $atom->Charge();
		my ($x,$y,$z) = $atom->Position(1);
		my $occupancy = $atom->Occupancy();
		my $mult      = $atom->Multiplicity();
		$mult = 1 if($Crystal->OutputMode() =~ /expand/i or $IsChooseRandomly);
		next if($occupancy >= 0.9999);

		$AtomCount{$atomname}++;
		$count++;
		$occupancy = 1 if($IsChooseRandomly);
		my $label = $atomname . $AtomCount{$atomname};
		printf OUT "  %-8s%-8s%2d %s %11.6f %11.6f %11.6f %9.4f  %s %s\n",
			$label, $atomname, $mult, "a", $x, $y, $z,
			$occupancy, "0", "a";
	}

	print OUT "\n";
	print OUT "\n";
	print OUT "#End of data_${dbcodeICSD}-ICSD\n";
	print OUT "\n";
	print OUT "\n";

	close(OUT);

	return 1;
}

1;