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
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
include "../lib/parser.h"
include "../lib/fitparams.h"
# T_FITPARAMS - Main fitting task. This task will determine the value of the
# fitting parameters, either interactively or non-interactively, by using
# the INLFIT package.
procedure t_fitparams()
pointer observations # list of observations files
pointer catalogs # list of standard catalogs
int stdlist # file list of standards
pointer config # pointer to configuration file name
pointer output # pointer to output file name
pointer logfile # pointer to the output log file
int wtflag # weighting type
int addscatter # compute an additional scatter term
real tol # fit tolerance
int itmax # max number of iterations
int niterate # number of rejection iterations
real high, low # rejection thresholds
real grow # rejection growing radius
bool interactive # interactive fit ?
pointer catdir # the standard catalogs directory
pointer graphics # pointer to the graphics device name
int obslist, nstd, nobs, nstdvars, getid
pointer sp, dir, str, otable, ntable, stable
bool clgetb()
int fntopnb(), fntlenb(), clgeti(), clgwrd(), btoi(), pr_parse(), pr_geti()
int fnldir(), access()
real clgetr()
begin
# Allocate working space.
call smark (sp)
call salloc (observations, SZ_FNAME, TY_CHAR)
call salloc (catalogs, SZ_FNAME, TY_CHAR)
call salloc (config, SZ_FNAME, TY_CHAR)
call salloc (output, SZ_FNAME, TY_CHAR)
call salloc (logfile, SZ_FNAME, TY_CHAR)
call salloc (catdir, SZ_FNAME, TY_CHAR)
call salloc (graphics, SZ_FNAME, TY_CHAR)
call salloc (dir, SZ_PATHNAME, TY_CHAR)
call salloc (str, SZ_LINE, TY_CHAR)
# Open the observations files list.
call clgstr ("observations", Memc[observations], SZ_FNAME)
obslist = fntopnb (Memc[observations], NO)
if (Memc[observations] == EOS || fntlenb (obslist) <= 0) {
call eprintf ("ERROR: The observations files list is empty\n")
call fntclsb (obslist)
call sfree (sp)
return
}
# Get the list of catalog files.
call clgstr ("catdir", Memc[catdir], SZ_FNAME)
call clgstr ("catalogs", Memc[catalogs], SZ_FNAME)
# Get the configuration file name.
call clgstr ("config", Memc[config], SZ_FNAME)
if (access (Memc[config], READ_ONLY, TEXT_FILE) == NO) {
call eprintf (
"ERROR: Cannot open the configuration file for reading\n")
call fntclsb (obslist)
call sfree (sp)
return
}
# Get the output parameters database nam and check that the user
# can create or append to the database.
call clgstr ("parameters", Memc[output], SZ_FNAME)
if (Memc[output] == EOS || access (Memc[output], 0,
DIRECTORY_FILE) == YES) {
call eprintf ("ERROR: The parameters file is undefined\n")
call fntclsb (obslist)
call sfree (sp)
return
} else if (access (Memc[output], 0, 0) == NO) {
if (fnldir (Memc[output], Memc[dir], SZ_LINE) == 0)
call strcpy (".", Memc[dir], SZ_LINE)
if (access (Memc[dir], APPEND, DIRECTORY_FILE) == NO) {
call eprintf ("ERROR: Cannot open directory %s for writing\n")
call pargstr (Memc[dir])
call fntclsb (obslist)
call sfree (sp)
return
}
} else if (access (Memc[output], APPEND, TEXT_FILE) == NO) {
call eprintf (
"ERROR: Cannot open existing parameters file %s for writing\n")
call pargstr (Memc[output])
call fntclsb (obslist)
call sfree (sp)
return
}
# Get the log file.
call clgstr ("logfile", Memc[logfile], SZ_FNAME)
if (Memc[logfile] != EOS)
call io_logtime (Memc[logfile])
# Get weighting parameters.
wtflag = clgwrd ("weighting", Memc[str], SZ_LINE, FWT_OPTIONS)
addscatter = btoi (clgetb ("addscatter"))
# Get the fitting parameters.
tol = clgetr ("tolerance")
itmax = clgeti ("maxiter")
# Get the rejection parameters.
low = clgetr ("low_reject")
high = clgetr ("high_reject")
niterate = clgeti ("nreject")
grow = clgetr ("grow")
# Get the graphics parameters.
interactive = clgetb ("interactive")
call clgstr ("graphics", Memc[graphics], SZ_LINE)
# Parse the configuration table.
if (pr_parse (Memc[config]) == ERR) {
call eprintf ("ERROR: Cannot parse the configuration file\n")
call fntclsb (obslist)
call sfree (sp)
return
}
# Read standard data catalog if the catalog section was in the
# configuration file, the catalog section is not empty and the
# catalogs files list. This can be tested by checking the value
# of the minimum input column, the number of catalog variables
# and the contents of the standard catalogs list respectively.
stable = NULL
ntable = NULL
nstd = 0
nstdvars = pr_geti (NCATVARS)
if (pr_geti (MINCOL) == 1) {
getid = NO
} else if (nstdvars == 0) {
getid = YES
} else if (Memc[catalogs] == EOS) {
getid = YES
call eprintf ("WARNING: Cannot load catalog variables from ")
call eprintf ("the empty catalog files list\n")
} else {
getid = YES
stdlist = fntopnb (Memc[catalogs], NO)
call io_gcatdat (Memc[catdir], stdlist, stable, nstd, nstdvars)
call fntclsb (stdlist)
}
# Quit if there is no data.
if (stable != NULL && nstd <= 0) {
call eprintf ("ERROR: No data was read from the catalog files")
call stclose (stable)
call fntclsb (obslist)
call pr_free ()
call sfree (sp)
return
}
# Read in the observations.
if (clgetb ("log_unmatched"))
call io_gcatobs (obslist, stable, nstdvars, getid, Memc[logfile],
otable, ntable, nobs)
else
call io_gcatobs (obslist, stable, nstdvars, getid, "", otable,
ntable, nobs)
# Free standard data table since it's no longer needed for the
# parameter fitting.
if (stable != NULL)
call stclose (stable)
# Process all transformation equations if there are enough observations.
if (nobs > 0) {
call ft_trneqs (Memc[output], Memc[logfile], Memc[graphics],
otable, ntable, wtflag, addscatter, tol, itmax, interactive,
high, low, niterate, grow, clgetb ("log_fit"),
clgetb ("log_results"))
} else if (nstd > 0) {
call eprintf ("ERROR: No observations could be matched with ")
call eprintf ("the catalog entries\n")
} else {
call eprintf ("ERROR: No observations could be read from ")
call eprintf ("the observations files\n")
}
# Free all space.
call pr_free()
call mct_free (otable)
if (ntable != NULL)
call mct_free (ntable)
call fntclsb (obslist)
call sfree (sp)
end
|
