1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
|
#!/usr/bin/perl -w
######################################################################
## This program is copyright (c) 1999 Bruce Ravel
## <ravel@phys.washington.edu>
## http://feff.phys.washington.edu/~ravel/software/atoms/
##
## -------------------------------------------------------------------
## All rights reserved. This program is free software; you can
## redistribute it and/or modify it under the same terms as Perl
## itself.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## Artistic License for more details.
## -------------------------------------------------------------------
######################################################################
## Time-stamp: <99/04/20 22:00:15 bruce>
######################################################################
## This program generates the edge and line energy data from flat text
## files for use with the Absorption::CL module. The edge energy data
## was converted from the Fortran source into flat text and resides in
## the file cl/cl.dat. The line energy data comes from McMaster, so
## only contains Kalpha, Kbeta, Lalpha, and Lbeta without
## distinguishing the sub-lines. The data is stored as a Storable
## binary database. The data is stored in "network" order so it can
## be accessed over a network and across disparate platforms.
##
## No data regarding cross section or anomalous scattering is stored
## in the database file. Insetad it is generated from the fortran
## using CLdata.pm.
##
## The data is stored a big hash. There is a hash entry for each
## element keyed off its lower case symbol. There is an entry keyed
## off "version" which contains a scalar identifying the database.
## There is an entry called "energy_list" which is used by the
## "next_energy" method.
######################################################################
## Code:
use strict;
use Storable qw/nstore/;
## use Data::Dumper;
use File::Spec;
use Chemistry::Elements qw(get_symbol);
my $cvs_info = '$Id: cl2st.PL,v 1.3 2001/09/20 17:44:22 bruce Exp $ ';
my $version = (split(' ', $cvs_info))[2] || "pre_release";
$| = 1;
my %cl = ();
$cl{'version'} = $version;
print "CL data conversion tool $version for Absorption 0.10$/";
my $thisdir = &identify_self;
##my $cldir = File::Spec -> catfile($thisdir, "cl");
print " Parsing lines ... ";
my $infile = File::Spec -> catfile($thisdir, "cl_lines");
open CL, $infile or die $!;
while (<CL>) {
next if /^\s*\#/;
next if /^\s*$/;
chomp;
my @line = split;
my $el = lc( get_symbol($line[0]) );
$cl{$el}{"energy_kalpha"} = $line[1];
$cl{$el}{"energy_kbeta"} = $line[2];
$cl{$el}{"energy_lalpha"} = $line[3];
$cl{$el}{"energy_lbeta"} = $line[4];
};
close CL;
print "energies ...";
$infile = File::Spec -> catfile($thisdir, "cl.dat");
open CL, $infile or die $!;
my ($l, $el);
while (<CL>) {
next if /^\s*\#/;
next if /^\s*\#/;
chomp;
my @line = split;
if (/^\s*[a-z]/i) { # element line
$el = lc( get_symbol($line[0]) );
$l = 0;
} else { # or one of 5 energy lines
++$l;
if ($l == 1) {
$cl{$el}{"energy_k"} = $line[0];
$line[1] and $cl{$el}{"energy_l1"} = $line[1];
$line[2] and $cl{$el}{"energy_l2"} = $line[2];
$line[3] and $cl{$el}{"energy_l3"} = $line[3];
} elsif ($l == 2) {
$line[0] and $cl{$el}{"energy_m1"} = $line[0];
$line[1] and $cl{$el}{"energy_m2"} = $line[1];
$line[2] and $cl{$el}{"energy_m3"} = $line[2];
$line[3] and $cl{$el}{"energy_m4"} = $line[3];
$line[4] and $cl{$el}{"energy_m5"} = $line[4];
} elsif ($l == 3) {
$line[0] and $cl{$el}{"energy_n1"} = $line[0];
$line[1] and $cl{$el}{"energy_n2"} = $line[1];
$line[2] and $cl{$el}{"energy_n3"} = $line[2];
$line[3] and $cl{$el}{"energy_n4"} = $line[3];
$line[4] and $cl{$el}{"energy_n5"} = $line[4];
$line[5] and $cl{$el}{"energy_n6"} = $line[5];
$line[6] and $cl{$el}{"energy_n7"} = $line[6];
} elsif ($l == 4) {
$line[0] and $cl{$el}{"energy_o1"} = $line[0];
$line[1] and $cl{$el}{"energy_o2"} = $line[1];
$line[2] and $cl{$el}{"energy_o3"} = $line[2];
$line[3] and $cl{$el}{"energy_o4"} = $line[3];
$line[4] and $cl{$el}{"energy_o5"} = $line[4];
} elsif ($l == 5) {
$line[0] and $cl{$el}{"energy_p1"} = $line[0];
$line[1] and $cl{$el}{"energy_p2"} = $line[1];
$line[2] and $cl{$el}{"energy_p3"} = $line[2];
};
};
};
print "$/ Getting energy list keys ... ";
my @energy_list = ();
foreach my $key (keys %cl) {
next if ($key eq "version");
next if ($key eq "nu");
foreach my $s ("k" , "l1", "l2", "l3", "m1", "m2", "m3", "m4", "m5",
"n1", "n2", "n3", "n4", "n5", "n6", "n7",
"o1", "o2", "o3", "o4", "o5", "o6", "o7",
"p1", "p2", "p3") {
exists $cl{$key}->{"energy_".$s} and
push @energy_list, $key . "_" . $s ;
};
};
print "sorting energy list ... ";
@energy_list =
sort {
$cl{shift @{[split(/_/,$a)]}}{"energy_". pop @{[split(/_/,$a)]}}
<=>
$cl{shift @{[split(/_/,$b)]}}{"energy_". pop @{[split(/_/,$b)]}}
} @energy_list;
print "and making energy hash$/";
#my %energy_hash = ();
while (@energy_list) {
my $this = shift(@energy_list);
if (@energy_list) {
my $that = $energy_list[0];
my ($elem, $edge) = split(/_/, $that);
my $energy = $cl{$elem}{"energy_".$edge};
$cl{energy_list}{$this} = [$elem, $edge, $energy];
} else { # taking care with last element
$cl{energy_list}{$this} = [];
};
};
my $outfile = File::Spec -> catfile($thisdir, "cl.db");
if (-e $outfile) {
print " Removing stale database, $outfile.$/";
unlink $outfile or die "could not remove old database $!";
};
print " Saving new database, $outfile.$/";
## my %foo = %{$cl{u}};
## print Data::Dumper->Dump([\%foo], [qw(*element)]);
nstore(\%cl, $outfile) or die "can't store hash: $!\n";
sub identify_self {
my @caller = caller;
use File::Basename qw(dirname);
return dirname($caller[1]);
};
|
