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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <syserr.h>
include <mach.h>
include "fxf.h"
# FXFUPK.X -- Routines to upack an IEEE vector into native format.
#
# fxf_unpack_data (cbuf, npix, pixtype, bscale, bzero)
# fxf_altmr (a, b, npix, bscale, bzero)
# fxf_altmd (a, b, npix, bscale, bzero)
# fxf_altmu (a, b, npix)
# fxf_astmr (a, b, npix, bscale, bzero)
define NBITS_DOU (SZB_CHAR * SZ_DOUBLE)
define IOFF 1
# FITUPK -- Unpack cbuf in place from FITS binary format to local machine type.
procedure fxf_unpack_data (cbuf, npix, pixtype, bscale, bzero)
char cbuf[ARB] #U buffer with input,output data
int npix #I number of pixels in buffer
int pixtype #I input pixtype
double bscale #I scale factor to applied to input data
double bzero #I offset to applied to input data
int nchars, nbytes
bool fp_equald()
errchk syserr
include <szpixtype.inc>
begin
nchars = npix * pix_size[pixtype]
nbytes = nchars * SZB_CHAR
switch (pixtype) {
case TY_SHORT, TY_USHORT:
if (BYTE_SWAP2 == YES)
call bswap2 (cbuf, 1, cbuf, 1, nbytes)
if (pixtype == TY_USHORT)
call fxf_altmu (cbuf, cbuf, npix)
case TY_INT, TY_LONG:
if (BYTE_SWAP4 == YES)
call bswap4 (cbuf, 1, cbuf, 1, nbytes)
case TY_REAL:
### Rather than perform this test redundantly a flag should be
### passed in from the high level code telling the routine whether
### or not it should apply the scaling. Testing for floating
### point equality (e.g. bscale != 1.0) is not portable.
if (!fp_equald(bscale,1.0d0) || !fp_equald(bzero,0.0d0)) {
if (BYTE_SWAP4 == YES)
call bswap4 (cbuf, 1, cbuf, 1, nbytes)
call iscl32 (cbuf, cbuf, npix, bscale, bzero)
} else
call ieevupkr (cbuf, cbuf, npix)
case TY_DOUBLE:
### Same as above.
if (!fp_equald(bscale,1.0d0) || !fp_equald(bzero,0.0d0)) {
if (BYTE_SWAP4 == YES)
call bswap4 (cbuf, 1, cbuf, 1, nbytes)
call iscl64 (cbuf, cbuf, npix, bscale, bzero)
} else
call ieevupkd (cbuf, cbuf, npix)
default:
call syserr (SYS_FXFUPKDTY)
}
end
# FXF_ALTMR -- Scale a real array.
procedure fxf_altmr (a, b, npix, bscale, bzero)
int a[ARB] #I input array
real b[ARB] #O output array
int npix #I number of pixels
double bscale, bzero #I scaling parameters
int i
begin
do i = 1, npix
b[i] = a[i] * bscale + bzero
end
# FXF_ALTMD -- Scale a double array.
procedure fxf_altmd (a, b, npix, bscale, bzero)
int a[ARB] #I input array
double b[ARB] #O output array
int npix #I number of pixels
double bscale, bzero #I scaling parameters
int i
begin
### int and double are not the same size so if this operation is
### to allow an in-place conversion it must go right to left instead
### of left to right.
do i = npix, 1, -1
b[i] = a[i] * bscale + bzero
end
# FXF_ALTMU -- Scale an array to unsigned short.
procedure fxf_altmu (a, b, npix)
short a[ARB] #I input array
char b[ARB] #O output array
int npix #I number of pixels
int i
pointer sp, ip
begin
call smark (sp)
call salloc (ip, npix+1, TY_INT)
do i = 1, npix
Memi[ip+i] = a[i] + 32768
call achtlu (Memi[ip+1], b, npix)
call sfree (sp)
end
# FXF_ASTMR -- Scale an input short array into a real.
procedure fxf_astmr (a, b, npix, bscale, bzero)
short a[ARB] #I input array
real b[ARB] #O output array
int npix #I number of pixels
double bscale, bzero #I scaling parameters
int i
begin
do i = npix, 1, -1
b[i] = a[i] * bscale + bzero
end
|
