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
|
include <error.h>
include <imhdr.h>
include <imset.h>
include <math/nlfit.h>
include "starfocus.h"
# STF_MEASURE -- PSF measuring routine.
# This is a stand-alone routine that can be called to return the FWHM.
# It is a greatly abbreviated version of starfocus.
procedure stf_measure (im, xc, yc, beta, level, radius, nit,
sbuffer, swidth, saturation, gp, logfd,
bkg, renclosed, dfwhm, gfwhm, mfwhm)
pointer im #I Image pointer
real xc #I Initial X center
real yc #I Initial Y center
real beta #I Moffat beta
real level #I Measurement level
real radius #U Profile radius
int nit #I Number of iterations on radius
real sbuffer #I Sky buffer (pixels)
real swidth #I Sky width (pixels)
real saturation #I Saturation
pointer gp #I Graphics output if not NULL
int logfd #I Log output if not NULL
real bkg #O Background used
real renclosed #O Enclosed flux radius
real dfwhm #O Direct FWHM
real gfwhm #O Gaussian FWHM
real mfwhm #O Moffat FWHM
int i
bool ignore_sat
pointer sp, str, sf, sfd, sfds
int strdic()
real stf_r2i()
errchk stf_find, stf_bkgd, stf_profile, stf_widths, stf_fwhms, stf_organize
begin
call smark (sp)
call salloc (str, SZ_FNAME, TY_CHAR)
call salloc (sf, SF, TY_STRUCT)
call salloc (sfd, SFD, TY_STRUCT)
call salloc (sfds, 1, TY_POINTER)
call aclri (Memi[sf], SF)
call aclri (Memi[sfd], SFD)
Memi[sfds] = sfd
# Initialize parameters.
SF_TASK(sf) = PSFMEASURE
SF_WCODE(sf) = strdic ("FWHM", SF_WTYPE(sf), SF_SZWTYPE, SF_WTYPES)
SF_SCALE(sf) = 1.
SF_LEVEL(sf) = level
SF_BETA(sf) = beta
SF_RADIUS(sf) = radius
SF_SBUF(sf) = sbuffer
SF_SWIDTH(sf) = swidth
SF_SAT(sf) = saturation
SF_NIT(sf) = nit
SF_OVRPLT(sf) = NO
SF_NCOLS(sf) = IM_LEN(im,1)
SF_NLINES(sf) = IM_LEN(im,2)
SF_XF(sf) = (IM_LEN(im,1) + 1) / 2.
SF_YF(sf) = (IM_LEN(im,2) + 1) / 2.
ignore_sat = false
call imstats (im, IM_IMAGENAME, SFD_IMAGE(sfd), SF_SZFNAME)
SFD_ID(sfd) = 1
SFD_X(sfd) = xc
SFD_Y(sfd) = yc
SFD_F(sfd) = INDEF
SFD_STATUS(sfd) = 0
SFD_SFS(sfd) = NULL
SFD_SFF(sfd) = NULL
SFD_SFI(sfd) = NULL
if (SF_LEVEL(sf) > 1.)
SF_LEVEL(sf) = SF_LEVEL(sf) / 100.
SF_LEVEL(sf) = max (0.05, min (0.95, SF_LEVEL(sf)))
# Evaluate PSF data.
iferr {
do i = 1, SF_NIT(sf) {
if (i == 1)
SFD_RADIUS(sfd) = SF_RADIUS(sf)
else
SFD_RADIUS(sfd) = 3. * SFD_DFWHM(sfd)
SFD_NPMAX(sfd) = stf_r2i (SFD_RADIUS(sfd)) + 1
SFD_NP(sfd) = SFD_NPMAX(sfd)
call stf_find (sf, sfd, im)
call stf_bkgd (sf, sfd)
if (SFD_NSAT(sfd) > 0 && i == 1) {
if (ignore_sat)
call error (0,
"Saturated pixels found - ignoring object")
else
call eprintf (
"WARNING: Saturated pixels found.\n")
}
call stf_profile (sf, sfd)
call stf_widths (sf, sfd)
call stf_fwhms (sf, sfd)
}
# Set output results.
radius = SFD_RADIUS(sfd)
bkg = SFD_BKGD(sfd)
renclosed = SFD_R(sfd)
dfwhm = SFD_DFWHM(sfd)
mfwhm = SFD_MFWHM(sfd)
gfwhm = SFD_GFWHM(sfd)
call asifree (SFD_ASI1(sfd))
call asifree (SFD_ASI2(sfd))
} then
call erract (EA_WARN)
# Finish up
call stf_free (sf)
call sfree (sp)
end
# STF_FREE -- Free the starfocus data structures.
procedure stf_free (sf)
pointer sf #I Starfocus structure
int i
begin
do i = 1, SF_NSTARS(sf)
call mfree (SF_SFS(sf,i), TY_STRUCT)
do i = 1, SF_NFOCUS(sf)
call mfree (SF_SFF(sf,i), TY_STRUCT)
do i = 1, SF_NIMAGES(sf)
call mfree (SF_SFI(sf,i), TY_STRUCT)
call mfree (SF_STARS(sf), TY_POINTER)
call mfree (SF_FOCUS(sf), TY_POINTER)
call mfree (SF_IMAGES(sf), TY_POINTER)
SF_NSTARS(sf) = 0
SF_NFOCUS(sf) = 0
SF_NIMAGES(sf) = 0
end
|