pkg/tbtables/fitsio/fti1i1.f


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

C----------------------------------------------------------------------
        subroutine fti1i1(input,n,scale,zero,tofits,
     &          chktyp,chkval,setval,flgray,anynul,output,status)

C       copy input i*1 values to output i*1 values, doing optional
C       scaling and checking for null values

C       input   c*1 input array of values
C       n       i  number of values 
C       scale   d  scaling factor to be applied
C       zero    d  scaling zero point to be applied
C       tofits  l  true if converting from internal format to FITS
C       chktyp  i  type of null value checking to be done if TOFITS=.false.
C                       =0  no checking for null values
C                       =1  set null values = SETVAL
C                       =2  set corresponding FLGRAY value = .true.
C       chkval  c*1 value in the input array that is used to indicated nulls
C       setval  c*1 value to set output array to if value is undefined
C       flgray  l   array of logicals indicating if corresponding value is null
C       anynul  l   set to true if any nulls were set in the output array
C       output  c*1 returned array of values
C       status  i  output error status (0 = ok)

        character*1 input(*),chkval
        character*1 output(*),setval
        integer n,i,chktyp,status,itemp
        double precision scale,zero,dval
        logical tofits,flgray(*),anynul,noscal

        if (status .gt. 0)return

        if (scale .eq. 1. .and. zero .eq. 0)then
                noscal=.true.
        else
                noscal=.false.
        end if
        
        if (tofits) then
C               we don't have to worry about null values when writing to FITS
                if (noscal)then
                        do 10 i=1,n
                                output(i)=input(i)
10                      continue
                else
                        do 20 i=1,n
                          itemp=ichar(input(i))
                          if (itemp .lt. 0)itemp=itemp+256
                          dval=(itemp-zero)/scale
C                         trap any values that overflow the I*1 range
                          if (dval.lt. 255.49 .and. dval.gt. -.49)then      
                                output(i)=char(nint(dval))
                          else if (dval .ge. 255.49)then
                                status=-11
                                output(i)=char(255)
                          else
                                status=-11
                                output(i)=char(0)
                          end if
20                      continue
                end if
        else
C               converting from FITS to internal format; may have to check nulls
                if (chktyp .eq. 0)then
C                   don't have to check for nulls
                    if (noscal)then
                                do 30 i=1,n
                                        output(i)=input(i)
30                              continue
                    else
                        do 40 i=1,n
                            itemp=ichar(input(i))
                            if (itemp .lt. 0)itemp=itemp+256
                            dval=itemp*scale+zero
C                           trap any values that overflow the I*1 range
                          if (dval.lt. 255.49 .and. dval.gt. -.49)then      
                                    output(i)=char(int(dval))
                            else if (dval .ge. 255.49)then
                                    status=-11
                                    output(i)=char(255)
                            else
                                    status=-11
                                    output(i)=char(0)
                            end if
40                      continue
                    end if
                else 
C                       must test for null values
                        if (noscal)then
                                do 50 i=1,n
                                        if (input(i) .eq. chkval)then
                                            anynul=.true.
                                            if (chktyp .eq. 1)then
                                                output(i)=setval
                                            else
                                                flgray(i)=.true.
                                            end if
                                        else
                                            output(i)=input(i)
                                        end if
50                              continue
                        else
                         do 60 i=1,n
                          if (input(i) .eq. chkval)then
                                    anynul=.true.
                                    if (chktyp .eq. 1)then
                                        output(i)=setval
                                    else
                                        flgray(i)=.true.
                                    end if
                          else
                            itemp=ichar(input(i))
                            if (itemp .lt. 0)itemp=itemp+256
                            dval=itemp*scale+zero
C                           trap any values that overflow the I*1 range
                            if (dval.lt. 255.49 .and. dval.gt. -.49)then      
                                    output(i)=char(int(dval))
                            else if (dval .ge. 255.49)then
                                    status=-11
                                    output(i)=char(255)
                            else
                                    status=-11
                                    output(i)=char(0)
                            end if
                          end if
60                       continue
                        end if
                end if
        end if
        end