When an exact match to an observer's data is absent from the set of CAL-G files, AAC choses an alternative based on minimising a penalty function calculated by the fragment of code listed below. The penalty function is made up of distances in selection parameter space weighted by factors which include parameter priority order.
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFIER CCD_PENALTY
C.PURPOSE Returns value of best-fit penalty function.
C.VERSION 1 Steve 03-05-1995 Original
C.VERSION 2 Andy 24-07-1996 cam$penalty report
C.VERSION 3 Andy 30-07-1996 cfo_ccd_names & cfo_ccd_values
C.VERSION 4 Andy 02-02-2000 cfo_ccd_values key_id
C.CALLS CCD_GET_MULTS
C CCD_DIFF
C CAM_REPORT
C CAM_INFO
C------------------------------------------------------------------------
subroutine ccd_penalty (new_keys, deid, n_key, key_id, val1, val2,
& penalty, status)
* Global constants:
include 'aac_inc:aac_ccd_constants.inc'
include 'aac_inc:aac_cam_codes.inc'
* Import:
logical new_keys ! in: new set of keys?
integer deid ! in: detector id
integer n_key ! in: number of keys
character*(*) key_id(*) ! in: names of keys
real val1(*) ! in: set of values, each key
real val2(*) ! in: set of values, each key
real penalty ! out: calculated penalty value
* Status:
integer status
* Locals variables:
real*4 pen_mult(ccd$maxkeys)
integer*4 i_key
real*4 diff
* External references:
real*4 ccd_diff
character*(cam$lo) cfo_ccd_names
character*(cam$lo) cfo_ccd_values
character*(cam$lc) cam_channel
*-
if(status.ne.cam$normal)return
* Derive the penalty multipliers.
if (new_keys) call ccd_get_mults (n_key, key_id, pen_mult, status)
* Initialise.
penalty = 0.0
* Use these to sum the penalty function.
do i_key = 1, n_key
! find absolute 'distance' between the values
diff = ccd_diff (deid, key_id(i_key),
& val1(i_key), val2(i_key))
if (diff.ge.0.0) then
penalty = penalty + diff*pen_mult(i_key)
else
status=cam$penalty
call cam_report(' ',key_id(i_key),status)
endif
end do
* Report more details of any failure
if(status.ne.cam$normal)then
call cam_info(cfo_ccd_names(cam_channel(deid),n_key,key_id))
call cam_info(cfo_ccd_values('Tried: ',n_key,key_id,val1))
call cam_info(cfo_ccd_values('Failed:',n_key,key_id,val2))
endif
return
end
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFIER CCD_GET_MULTS
C.PURPOSE Returns penalty multipliers for each key.
C.VERSION 1 Steve 03-05-1995 Original
C.VERSION 2 Andy 24-07-1996 cam$multiplier report
C.CALLS CCD_MAXKEY
C CAM_REPORT
C------------------------------------------------------------------------
subroutine ccd_get_mults (n_key, key_id, pen_mult, status)
implicit none
* Arguments:
integer n_key ! in: number of keys
character*(*) key_id(*) ! in: names of keys
real pen_mult(*) ! out: penalty multiplier, each key
integer status ! i/o: status value
* Include files.
include 'aac_inc:aac_cam_codes.inc'
* Locals.
real maxval ! returned by ccd_maxkey
integer i_key ! key index
* Functions.
real ccd_maxkey ! returns maximum value of key
* Inherited status.
if (status.ne.cam$normal) return
* Muliplier for the last key is one by definition.
pen_mult(n_key) = 1.0
* Construct the other multipliers as the product of the maximum values of the
* ones that follow it ie pen_mult(i) = product(pen_mult(i+1)...pen_mult(n))
do i_key = n_key-1, 1, -1
maxval = ccd_maxkey(key_id(i_key+1))
if (maxval.ge.0.0) then
pen_mult(i_key) = pen_mult(i_key+1) * maxval
else
status=cam$multiplier
call cam_report(' ',key_id(i_key+1),status)
endif
end do
return
end
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFIER CCD_MAXKEY
C.PURPOSE Returns maximum value of a key; -1 if none.
C.VERSION 1 Steve 03-05-1995 Original
C.VERSION 2 Steve 09-05-1996 Use pixel fraction in PSF selection
C.VERSION 3 Andy 16-02-2000 ccd$proc & ccd$rev
C------------------------------------------------------------------------
real function ccd_maxkey (key_id)
implicit none
* Arguments:
character*(*) key_id ! in: name of the key
* Include files:
include 'aac_inc:aac_ccd_constants.inc'
* Local constants.
real bad_val
parameter (bad_val = -1.0)
if (key_id.eq.ccd$ewhl) then
ccd_maxkey = 8.0
else if (key_id.eq.ccd$swhl) then
ccd_maxkey = 5.0
else if (key_id.eq.ccd$tint) then
ccd_maxkey = 431.0
else if (key_id.eq.ccd$gain) then
ccd_maxkey = 5.0
else if (key_id.eq.ccd$pfov) then
ccd_maxkey = 8.0
else if (key_id.eq.ccd$proc) then
ccd_maxkey = 2.0
else if (key_id.eq.ccd$signal) then
ccd_maxkey = 5001.0
! do nothing for y - treat as null key and wait for z
else if (key_id.eq.ccd$ys) then
ccd_maxkey = 1.0
! maximum is corner-to-corner distance + an allowance of 3 times
! that for the fractional pixel weighting
else if (key_id.eq.ccd$zs) then
ccd_maxkey = 4.0 * sqrt(2.0) * cam$ny
! maximum is in wavelength
else if (key_id.eq.ccd$fcvf) then
ccd_maxkey = 18.0
else if (key_id.eq.ccd$rev) then
ccd_maxkey = 907.0
else
ccd_maxkey = bad_val
endif
return
end
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFIER CCD_DIFF
C.PURPOSE Returns 'difference' between values; -1 if undefined.
C.VERSION 1 Steve 03-05-1995 Original
C.VERSION 2 Steve 08-01-1996 don't allow diff=0 unless val1=val2;
C penalise CVF/non-CVF pairs
C------------------------------------------------------------------------
real*4 function ccd_diff(deid, key_id, val1, val2)
* Global constants:
include 'aac_inc:aac_ccd_constants.inc'
* Import:
integer*4 deid
character*(*) key_id
real*4 val1
real*4 val2
* Local constants:
real bad_val
parameter (bad_val = -1.0)
real epsilon
parameter (epsilon = 1.0e-6) ! arbitrary small value
* Local variables:
real*4 trans_val1
real*4 trans_val2
* External references:
real ccd_transval ! translates raw values to 'difference system'
real ccd_maxkey ! returns maximum value of key
logical ccd_iscvf ! check if CVF position
*-
* Translate the values to our 'difference weighting system'.
trans_val1 = ccd_transval (deid, key_id, val1)
trans_val2 = ccd_transval (deid, key_id, val2)
* If OK, return the absolute value, -1 otherwise.
if (trans_val1.ge.0.0 .and. trans_val2.ge.0.0) then
ccd_diff = abs (trans_val1 - trans_val2)
! don't allow diff=0 unless the inputs were the same
! instead return difference between inputs multiplied by
! some (small) arbitrary value
if (ccd_diff.le.0.0 .and. val1.ne.val2)
& ccd_diff = epsilon * abs(val1 - val2)
! for filter wheels, penalise CVF/non-CVF pairs
if (key_id.eq.ccd$fcvf) then
if (ccd_iscvf(deid,nint(val1)) .xor.
& ccd_iscvf(deid,nint(val2)))
& ccd_diff = ccd_diff + ccd_maxkey(key_id)
endif
else
ccd_diff = bad_val
endif
return
end
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFIER CCD_TRANSVAL
C.PURPOSE Returns value in 'difference' system; -1 if undefined.
C.VERSION 1 Steve 03-05-1995 Original
C.VERSION 2 Steve 09-05-1996 Use pixel fraction in PSF selection
C.VERSION 3 Andy 10-02-1998 Alpha tidy up
C.CALLS None.
C------------------------------------------------------------------------
real*4 function ccd_transval(deid,key_id,val)
* Include files:
include 'aac_inc:aac_ccd_constants.inc'
include 'aac_inc:aac_cam_codes.inc'
* Import:
integer*4 deid
character*(*) key_id
real*4 val
* Local constants:
real*4 bad_val
parameter (bad_val=-1.0)
real*4 val_undef
parameter (val_undef=-1.0)
* Local variables:
integer*4 ival
real*4 dist
real*4 frac
real*4 yval1
real*4 yval2
real*4 zval1
real*4 bandwidth
integer*4 status
* Local data:
data yval1 /val_undef/
data yval2 /val_undef/
data zval1 /val_undef/
* Saved variables:
save yval1, yval2, zval1
* External references:
real*4 ccd_wavelength
*-
if (key_id.eq.ccd$ewhl) then
ival = nint(val)
if (ival.eq.cam$ewhl_pol1) then
ccd_transval = 1.0
else if (ival.eq.cam$ewhl_pol2) then
ccd_transval = 2.0
else if (ival.eq.cam$ewhl_pol3) then
ccd_transval = 3.0
else if (ival.eq.cam$ewhl_hole) then
ccd_transval = 6.0
else if (ival.eq.cam$ewhl_dark) then
ccd_transval = 7.0
else
ccd_transval = bad_val
endif
else if (key_id.eq.ccd$swhl) then
ival = nint(val)
if (deid.eq.cam$sw) then
if (ival.eq.cam$swhl_sw_sm) then ! SW small mirror
ccd_transval = 1.0
else if (ival.eq.cam$swhl_sw_lm) then ! SW large mirror
ccd_transval = 3.0
else if (ival.eq.cam$swhl_sw_ics) then ! SW ics
ccd_transval = 4.0
else
ccd_transval = bad_val
endif
else if (deid.eq.cam$lw) then
if (ival.eq.cam$swhl_lw_sm) then ! LW small mirror
ccd_transval = 1.0
else if (ival.eq.cam$swhl_lw_lm) then ! LW large mirror
ccd_transval = 3.0
else if (ival.eq.cam$swhl_lw_ics) then ! LW ics
ccd_transval = 4.0
else
ccd_transval = bad_val
endif
else
ccd_transval = bad_val
endif
else if (key_id.eq.ccd$pfov) then
ival = nint(val)
if (deid.eq.cam$sw) then
if (ival.eq.cam$sw_pfov1) then
ccd_transval = 1.0
else if (ival.eq.cam$sw_pfov2) then
ccd_transval = 2.0
else if (ival.eq.cam$sw_pfov3) then
ccd_transval = 4.0
else if (ival.eq.cam$sw_pfov4) then
ccd_transval = 8.0
else
ccd_transval = bad_val
endif
else if (deid.eq.cam$lw) then
if (ival.eq.cam$lw_pfov1) then
ccd_transval = 1.0
else if (ival.eq.cam$lw_pfov2) then
ccd_transval = 2.0
else if (ival.eq.cam$lw_pfov3) then
ccd_transval = 4.0
else if (ival.eq.cam$lw_pfov4) then
ccd_transval = 8.0
else
ccd_transval = bad_val
endif
else
ccd_transval = bad_val
endif
else if (key_id.eq.ccd$tint) then
ccd_transval = val
else if (key_id.eq.ccd$signal) then
ccd_transval = val
else if (key_id.eq.ccd$gain) then
ival = nint(val)
if (ival.eq.cam$gain1) then
ccd_transval = 2.0
else if (ival.eq.cam$gain2) then
ccd_transval = 1.0
else if (ival.eq.cam$gain4) then
ccd_transval = 3.0
else
ccd_transval = bad_val
endif
! do nothing for y - treat as null key and wait for z
! we always return the same number, so the difference will be 0
else if (key_id.eq.ccd$ys) then
ccd_transval = 1.0
if (yval1.lt.0.0) then
yval1 = val
else if (yval2.lt.0.0) then
yval2 = val
else
ccd_transval = bad_val
endif
! now calculate distance between z & remembered y plus 96*sqrt(2) times
! the fractional distance (this assumes the PSFs are sampled at one
! third intervals) - the factor is sqrt(2) * 32 * sample rate. The
! point is that the fractional distance is always more important than
! the real distance.
! The first call will correspond to yval1. Return 0 for z1 and the
! calculated value for z2 so the difference will be correct.
else if (key_id.eq.ccd$zs) then
if (zval1.lt.0.0) then ! z1
zval1 = val
ccd_transval = 0.0
else if (yval1.ge.0.0 .and. yval2.ge.0) then ! z2
dist = sqrt ((val - zval1)**2 +
& (yval2 - yval1)**2)
frac = sqrt ((val - real(nint(val)) -
& zval1 + real(nint(zval1)))**2 +
& (yval2 - real(nint(yval2)) -
& yval1 + real(nint(yval1)))**2)
ccd_transval = dist + frac * 96.0 * sqrt(2.0)
yval1 = val_undef
yval2 = val_undef
zval1 = val_undef
else
ccd_transval = bad_val
endif
else if (key_id.eq.ccd$fcvf) then
ival = nint(val)
status=cam$normal
ccd_transval=ccd_wavelength(deid,ival,bandwidth,status)
if (ccd_transval.lt.0.0) ccd_transval = bad_val
else if (key_id.eq.ccd$proc) then
ccd_transval = val
else if (key_id.eq.ccd$rev) then
ccd_transval = val
else
ccd_transval = bad_val
endif
return
end