package SpaceGroup;
use Crystal::SpaceGroupObject;
@ISA = qw(SpaceGroupObject);

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

use strict;
use Deps;

#use Crystal::MyUtility;

my $DirectorySeparator = '\\';

my $WebRootDir      = "d:\\MyWebs";
my $DBDir = Deps::MakePath($WebRootDir, "Research", 0);
   $DBDir = Deps::MakePath($DBDir, "Databases", 0);
my $SpaceGroupDBPath = Deps::MakePath($DBDir, "SPGRA", 0);

sub SymOpToMatrix
{
	my ($op) = @_;
	return SpaceGroupObject::SymOpToMatrix($op);
}

# From struct.pl in WIEN2k package
#
#######################################
# SPACEGROUPS                         #
#######################################

sub GetWIEN2kSPG
{
	my ($spgnum, $NotDeleteiSPG) = @_;

	my @lattype = qw/P F B CXY CYZ CXZ R H 1_P1 
			 2_P-1 3_P2 3_P2 3_P2 4_P21 
			 4_P21 4_P21 5_B2 6_Pm 6_Pm 
			 6_Pm 7_Pc 7_Pa 7_Pb 7_Pb 7_Pc 
			 7_Pa 7_Pn 7_Pn 7_Pn 8_Bm 9_Bb 
			 10_P2\/m 10_P2\/m 10_P2\/m 11_P21\/m 
			 11_P21\/m 11_P21\/m 12_B2\/m 13_P2\/c 
			 13_P2\/a 13_P2\/b 13_P2\/b 13_P2\/c 
			 13_P2\/a 13_P2\/n 13_P2\/n 13_P2\/n 
			 14_P21\/c 14_P21\/a 14_P21\/b 14_P21\/b 
			 14_P21\/c 14_P21\/a 14_P21\/n 14_P21\/n 
			 14_P21\/n 15_B2\/b 16_P222 17_P2221 
			 17_P2122 17_P2212 18_P21212 18_P22121 
			 18_P21221 19_P212121 20_C2221 20_A2122 
			 20_B2212 21_C222 21_A222 21_B222 22_F222 
			 23_I222 24_I212121 25_Pmm2 25_P2mm 25_Pm2m 
			 26_Pmc21 26_P21ma 26_Pb21m 26_Pcm21 26_P21am 
			 26_Pm21b 27_Pcc2 27_P2aa 27_Pb2b 28_Pma2 
			 28_P2mb 28_Pc2m 28_Pbm2 28_P2cm 28_Pm2a 
			 29_Pca21 29_P21ab 29_Pc21b 29_Pbc21 29_P21ca 
			 29_Pb21a 30_Pnc2 30_P2na 30_Pb2n 30_Pcn2 
			 30_P2an 30_Pn2b 31_Pmn21 31_P21mn 31_Pn21m 
			 31_Pnm21 31_P21nm 31_Pm21n 32_Pba2 32_P2cb 
			 32_Pc2a 33_Pna21 33_P21nb 33_Pc21n 33_Pbn21 
			 33_P21cn 33_Pn21a 34_Pnn2 34_P2nn 34_Pn2n 
			 35_Cmm2 35_A2mm 35_Bm2m 36_Cmc21 36_A21ma 
			 36_Bb21m 36_Ccm21 36_A21am 36_Bm21b 37_Ccc2 
			 37_A2aa 37_Bb2b 38_Amm2 38_B2mm 38_Cm2m 39_Abm2 
			 39_B2cm 39_Cm2a 39_Bma2 39_C2mb 39_Ac2m 40_Ama2 
			 40_B2mb 40_Cc2m 40_Bbm2 40_C2cm 40_Am2a 41_Aba2 
			 41_B2cb 41_Cc2a 41_Bba2 41_C2cb 41_Ac2a 42_Fmm2 
			 42_F2mm 42_Fm2m 43_Fdd2 43_F2dd 43_Fd2d 44_Imm2 
			 44_I2mm 44_Im2m 45_Iba2 45_I2cb 45_Ic2a 46_Ima2 
			 46_I2mb 46_Ic2m 46_Ibm2 46_I2cm 46_Im2a 47_Pmmm 
			 48_Pnnn 49_Pccm 49_Pmaa 49_Pbmb 50_Pban 50_Pncb 
			 50_Pcna 51_Pmma 51_Pbmm 51_Pmcm 51_Pmam 51_Pmmb 
			 51_Pcmm 52_Pnna 52_Pbnn 52_Pncn 52_Pnan 52_Pnnb 
			 52_Pcnn 53_Pmna 53_Pbmn 53_Pncm 53_Pman 53_Pnmb 
			 53_Pcnm 54_Pcca 54_Pbaa 54_Pbcb 54_Pbab 54_Pccb 
			 54_Pcaa 55_Pbam 55_Pmcb 55_Pcma 56_Pccn 56_Pnaa 
			 56_Pbnb 57_Pbcm 57_Pmca 57_Pbma 57_Pcmb 57_Pcam 
			 57_Pmab 58_Pnnm 58_Pmnn 58_Pnmn 59_Pmmn 59_Pnmm 
			 59_Pmnm 60_Pbcn 60_Pnca 60_Pbna 60_Pcnb 60_Pcan 
			 60_Pnab 61_Pbca 61_Pcab 62_Pnma 62_Pbnm 62_Pmcn 
			 62_Pnam 62_Pmnb 62_Pcmn 63_Cmcm 63_Amma 63_Bbmm 
			 63_Bmmb 63_Ccmm 63_Amam 64_Cmca 64_Abma 64_Bbcm 
			 64_Bmab 64_Ccmb 64_Acam 65_Cmmm 65_Ammm 65_Bmmm 
			 66_Cccm 66_Amaa 66_Bbmb 67_Cmma 67_Abmm 67_Bmcm 
			 67_Bmam 67_Cmmb 67_Acmm 68_Ccca 68_Abaa 68_Bbcb 
			 68_Bbab 68_Cccb 68_Acaa 69_Fmmm 70_Fddd 71_Immm 
			 72_Ibam 72_Imcb 72_Icma 73_Ibca 73_Icab 74_Imma 
			 74_Ibmm 74_Imcm 74_Imam 74_Immb 74_Icmm 75_P4 
			 76_P41 77_P42 78_P43 79_I4 80_I41 81_P-4 82_I-4 
			 83_P4\/m 84_P42\/m 85_P4\/n 86_P42\/n 87_I4\/m 
			 88_I41\/a 89_P422 90_P4212 91_P4122 92_P41212 
			 93_P4222 94_P42212 95_P4322 96_P43212 97_I422 
			 98_I4122 99_P4mm 100_P4bm 101_P42cm 102_P42nm 
			 103_P4cc 104_P4nc 105_P42mc 106_P42bc 107_I4mm 
			 108_I4cm 109_I41md 110_I41cd 111_P-42m 112_P-42c 
			 113_P-421m 114_P-421c 115_P-4m2 116_P-4c2 117_P-4b2 
			 118_P-4n2 119_I-4m2 120_I-4c2 121_I-42m 122_I-42d 
			 123_P4\/mmm 124_P4\/mcc 125_P4\/nbm 126_P4\/nnc 
			 127_P4\/mbm 128_P4\/mnc 129_P4\/nmm 130_P4\/ncc 
			 131_P42\/mmc 132_P42\/mcm 133_P42\/nbc 134_P42\/nnm 
			 135_P42\/mbc 136_P42\/mnm 137_P42\/nmc 138_P42\/ncm 
			 139_I4\/mmm 140_I4\/mcm 141_I41\/amd 142_I41\/acd 
			 143_P3 144_P31 145_P32 146_R3 147_P-3 148_R-3 
			 149_P312 150_P321 151_P3112 152_P3121 153_P3212 
			 154_P3221 155_R32 156_P3m1 157_P31m 158_P3c1 
			 159_P31c 160_R3m 161_R3c 162_P-31m 163_P-31c 
			 164_P-3m1 165_P-3c1 166_R-3m 167_R-3c 168_P6 
			 169_P61 170_P65 171_P62 172_P64 173_P63 174_P-6 
			 175_P6\/m 176_P63\/m 177_P622 178_P6122 179_P6522 
			 180_P6222 181_P6422 182_P6322 183_P6mm 184_P6cc 
			 185_P63cm 186_P63mc 187_P-6m2 188_P-6c2 189_P-62m 
			 190_P-62c 191_P6\/mmm 192_P6\/mcc 193_P63\/mcm 
			 194_P63\/mmc 195_P23 196_F23 197_I23 198_P213 
			 199_I213 200_Pm-3 201_Pn-3 202_Fm-3 203_Fd-3 
			 204_Im-3 205_Pa-3 206_Ia-3 207_P432 208_P4232 
			 209_F432 210_F4132 211_I432 212_P4332 213_P4132 
			 214_I4132 215_P-43m 216_F-43m 217_I-43m 218_P-43n 
			 219_F-43c 220_I-43d 221_Pm-3m 222_Pn-3n 223_Pm-3n 
			 224_Pn-3m 225_Fm-3m 226_Fm-3c 227_Fd-3m 228_Fd-3c 
			 229_Im-3m 230_Ia-3d/; 

	for(my $i = 0 ; $i < @lattype ; $i++) {
		my $s = $lattype[$i];
		next unless($s =~ /^(\d+)_(.*)$/);
		my $num = $1;
		my $spgname = $2;
#print "$num: $spgname ($spgnum)$LF";
		next if($num != $spgnum);
		return $s if($NotDeleteiSPG);
		return $spgname;
	}
	return "NotFound";
}


sub ICONDTypeStrByRietanIndex
{
	my ($idx) = @_;

	my @ICONDTypeStr = (
		"00L", "0K0", "0KL", "H00", "H0L",
		"HK0", "HKL", "0KK", "HH0", "HHL",
		"H0H", "HKK", "HKH", "HHH"
	);

	return $ICONDTypeStr[$idx];
}

sub ICONDCondStrByRietanIndex
{
	my ($idx) = @_;

	my @ICONDCondStr = (
		"None",
		"H=2N",          "K=2N",           "L=2N",     "K+L=2N",    "H+L=2N",
		"H+K=2N",        "H,K,L ODD/EVEN", "K+L=4N",   "H+L=4N",    "H+K=4N",
		"2H+L=2N",       "2H+L=4N",        "H+K+L=2N", "-H+K+L=3N", "H-K+L=3N",
		"H=4N",          "K=4N",           "L=3N",     "L=4N",      "L=6N",
		"|H|>=|K|>=|L|", "2H+K=2N",        "2H+K=4N",  "H+2K=2N",   "H+2K=4N",
		"H=2N,K=2N",     "K=2N,L=2N",      "H=2N,L=2N"
	);

	return $ICONDCondStr[$idx];
}

sub iLaueGroup { return shift->{iLaueG}; }
sub LaueGroup  { return shift->{LaueG}; }
sub SetiLaueGroup
{
	my ($this, $iLaueG) = @_;
	$this->{iLaueG} = $iLaueG;
	$this->{LaueG}  = SpaceGroup::LaueGroupByRietanIndex($iLaueG);
	$this->{LatticeSystem} = $this->LatticeSystemFromLaueGroup($this->{LaueG});
	return $this->{LaueG};
}

sub LatticeSystem { return shift->{LatticeSystem}; }
sub LatticeSystemFromLaueGroup
{
	my ($this, $LaueG) = @_;
	my ($LatticeSystem) = ($LaueG =~ /^\s*([^\s,]+)/);
	return $LatticeSystem;
}

sub LaueGroupByRietanIndex
{
	my ($idx) = @_;
	return '' if(not defined $idx or $idx < 1 or $idx > 15);

	my @LaueGroup = (
		"Triclinic (1)",	# 1
		"Monoclinic, a (2/m)",	# 2
		"Monoclinic, b (2/m)",	# 3
		"Monoclinic, c (2/m)",	# 4
		"Orthorhombic (mmm)",	# 5
		"Tetragonal (4/m)",	# 6
		"Tetragonal (4/mmm)",	# 7
		"Trigonal, Rhombohedral (3)",	# 8
		"Trigonal, Hexagonal (3)",	# 9
		"Trigonal, Rhombohedral (3m)",	# 10
		"Trigonal, Hexagonal (3m)",	# 11
		"Hexagonal (6/m)",	# 12
		"Hexagonal (6/mmm)",	# 13
		"Cubic (m3)",		# 14
		"Cubic (m3m)"		# 15
	);

	return $LaueGroup[$idx-1];
}

sub SearchiSPGFromSPGName
{
	my ($this, $spgname, $iset) = @_;
	$spgname =~ s/\s//g;

	unless(open(IN, "<$SpaceGroupDBPath")) {
		return 0;
	}
	my $NSPGR;
	my $NSET;
	my $LAUEG;
	my $NCENTR;
	my $NSYM;
	my $SPGR;
	my $BravaisCell;
	my $nTranslate;
	my $TotalSymOperation;
	my $ICONDLine;
	my @ICOND;
	my @strICOND;
	my @SymmetryOperation;
	while(<IN>) {
		my $line = $_;
		$line =~ /^\s*?(\d+?)\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)\s+?(\S.*)$/;
		$NSPGR  = $1;
		$NSET   = $2;
		$LAUEG  = $3;
		$NCENTR = $4;
		$NSYM   = $5;
		$SPGR   = $6;

		$BravaisCell = substr($SPGR, 0, 1);
		$nTranslate = 1;
		$nTranslate = 2 if($BravaisCell eq 'I');
		$nTranslate = 2 if($BravaisCell eq 'A');
		$nTranslate = 2 if($BravaisCell eq 'B');
		$nTranslate = 2 if($BravaisCell eq 'C');
		$nTranslate = 4 if($BravaisCell eq 'F');

		$TotalSymOperation = $NSYM * (1+$NCENTR) * $nTranslate;
		$ICONDLine = <IN>;
		@ICOND = unpack("a2a2a2a2a2a2a2a2a2a2a2a2a2a2", $ICONDLine);
		for(my $i = 0 ; $i < 14 ; $i++) {
			Utils::DelSpace($ICOND[$i]);
			next if($ICOND[$i] eq '' or $ICOND[$i] <= 0);
			my $s = sprintf "%3s: %s",
				&ICONDTypeStrByRietanIndex($i),
				&ICONDCondStrByRietanIndex($ICOND[$i]);
			push(@strICOND, $s);
		}
		for(my $i = 0 ; $i < $NSYM ; $i++) {
			my $SymOp = <IN>;
			Utils::DelSpace($SymOp);
			push(@SymmetryOperation, $SymOp);
		}

		my $SPGR2 = $SPGR;
		$SPGR2 =~ s/\s//g;
		if($iset and uc $spgname eq uc $SPGR2 and $NSET == $iset) {
			close(IN);
#print "S: $SPGR $NSET\n";
			return ($SPGR, $NSPGR, $NSET);
		}
		elsif(uc $spgname eq uc $SPGR) {
			close(IN);
			return ($SPGR, $NSPGR, $NSET);
		}
	}
	close(IN);

	return 1;
}

sub ReadRietanSpaceGroupDB
{
	my ($this, $spgnum, $iset) = @_;

	unless(open(IN, "<$SpaceGroupDBPath")) {
		return 0;
	}
	my $NSPGR;
	my $NSET;
	my $LAUEG;
	my $NCENTR;
	my $NSYM;
	my $SPGR;
	my $BravaisCell;
	my $nTranslate;
	my $TotalSymOperation;
	my $ICONDLine;
	my @ICOND;
	my @strICOND;
	my @SymmetryOperation;
	while(<IN>) {
		my $line = $_;
		$line =~ /^\s*?(\d+?)\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)\s+?(\S.*)$/;
#print "spgnum: $spgnum\n";
#print "line: $line";
		$NSPGR  = $1;
		$NSET   = $2;
		$LAUEG  = $3;
		$NCENTR = $4;
		$NSYM   = $5;
		$SPGR   = $6;
#print "SPGInf: $NSPGR ($spgnum): $SPGR [$NSET ($iset)]  (nSym=$NSYM)\n";

		$BravaisCell = substr($SPGR, 0, 1);
		$nTranslate = 1;
		$nTranslate = 2 if($BravaisCell eq 'I');
		$nTranslate = 2 if($BravaisCell eq 'A');
		$nTranslate = 2 if($BravaisCell eq 'B');
		$nTranslate = 2 if($BravaisCell eq 'C');
		$nTranslate = 4 if($BravaisCell eq 'F');

		$TotalSymOperation = $NSYM * (1+$NCENTR) * $nTranslate;
		$ICONDLine = <IN>;
		@ICOND = unpack("a2a2a2a2a2a2a2a2a2a2a2a2a2a2", $ICONDLine);
		for(my $i = 0 ; $i < 14 ; $i++) {
			Utils::DelSpace($ICOND[$i]);
			next if($ICOND[$i] eq '' or $ICOND[$i] <= 0);
			my $s = sprintf "%3s: %s",
				&ICONDTypeStrByRietanIndex($i),
				&ICONDCondStrByRietanIndex($ICOND[$i]);
			push(@strICOND, $s);
		}
		@SymmetryOperation = ();
		for(my $i = 0 ; $i < $NSYM ; $i++) {
			my $SymOp = <IN>;
			Utils::DelSpace($SymOp);
			push(@SymmetryOperation, $SymOp);
#print "Check: SymOp[$i]: $SymOp\n";
		}
		if($iset > 0) {
			last if($NSPGR == $spgnum and $NSET == $iset);
		}
		else {
			last if($NSPGR == $spgnum);
		}
	}
	close(IN);

	return undef unless($NSPGR == $spgnum);

	$this->SetSPGName($SPGR);
	my $LatticeSystem = LaueGroupByRietanIndex($LAUEG);
	($LatticeSystem) 
		= Utils::Split("[,\\s]+", LaueGroupByRietanIndex($LAUEG));
	$LatticeSystem = lc $LatticeSystem;
print "LatticeSystem: $LatticeSystem\n";
	$this->SetLatticeSystem($LatticeSystem);
	$this->AnalyzeTranslation();
	for(my $i = 0 ; $i < $NSYM ; $i++) {
		$this->AddSymmetryOperation($SymmetryOperation[$i]);
print "SymOp[$i]: $SymmetryOperation[$i]\n";
	}
#print "nSym0=", $this->{'nSymmetryOperation'}, "\n";

	return 1;
}

BEGIN {
}

sub new
{
	my ($module) = @_;
	my $this = {};
	bless $this;
	return $this;
}

sub DESTROY
{
	my $this = shift;
}

sub SetRietanDiffractinCondition
{
	my ($this, @ICOND) = @_;
	for(my $i = 0 ; $i < @ICOND ; $i++) {
		$this->{"RietanDiffractionCondition[$i]"} = $ICOND[$i];
	}
	return;
}

sub RietanDiffractinCondition
{
	my ($this, $i) = @_;
	return $this->{"RietanDiffractionCondition[$i]"};
}

1;