File: iter_a.f

package info (click to toggle)
cfitsio 3.470-3
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 14,484 kB
  • sloc: ansic: 106,145; yacc: 4,883; sh: 3,259; fortran: 2,613; lex: 504; makefile: 162
file content (224 lines) | stat: -rw-r--r-- 6,874 bytes parent folder | download | duplicates (19)
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
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
      program f77iterate_a

      external flux_rate
      integer ncols
      parameter (ncols=3)
      integer units(ncols), colnum(ncols), datatype(ncols)
      integer iotype(ncols), offset, rows_per_loop, status
      character*70 colname(ncols)
      integer iunit, blocksize
      character*80 fname

C     include f77.inc -------------------------------------
C     Codes for FITS extension types
      integer IMAGE_HDU, ASCII_TBL, BINARY_TBL
      parameter (
     &     IMAGE_HDU  = 0,
     &     ASCII_TBL  = 1,
     &     BINARY_TBL = 2  )

C     Codes for FITS table data types

      integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT
      integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX
      parameter (
     &     TBIT        =   1,
     &     TBYTE       =  11,
     &     TLOGICAL    =  14,
     &     TSTRING     =  16,
     &     TSHORT      =  21,
     &     TINT        =  31,
     &     TFLOAT      =  42,
     &     TDOUBLE     =  82,
     &     TCOMPLEX    =  83,
     &     TDBLCOMPLEX = 163  )

C     Codes for iterator column types

      integer InputCol, InputOutputCol, OutputCol
      parameter (
     &     InputCol       = 0,
     &     InputOutputCol = 1,
     &     OutputCol      = 2  )
C     End of f77.inc -------------------------------------


      iunit = 15

      units(1) = iunit
      units(2) = iunit
      units(3) = iunit

C open the file
      fname = 'iter_a.fit'
      call ftopen(iunit,fname,1,blocksize,status)

C move to the HDU containing the rate table
      call ftmnhd(iunit, BINARY_TBL, 'RATE', 0, status)

C Select iotypes for column data
      iotype(1) = InputCol
      iotype(2) = InputCol
      iotype(3) = OutputCol

C Select desired datatypes for column data
      datatype(1) = TINT
      datatype(2) = TFLOAT
      datatype(3) = TFLOAT

C find the column number corresponding to each column
      call ftgcno( iunit, 0, 'counts', colnum(1), status )
      call ftgcno( iunit, 0, 'time', colnum(2), status )
      call ftgcno( iunit, 0, 'rate', colnum(3), status )

C use default optimum number of rows
      rows_per_loop = 0
      offset = 0

C apply the rate function to each row of the table
      print *, 'Calling iterator function...', status

C although colname is not being used, still need to send a string
C array in the function
      call ftiter( ncols, units, colnum, colname, datatype, iotype,
     &      offset, rows_per_loop, flux_rate, 3, status )

      call ftclos(iunit, status)
      stop
      end

C***************************************************************************
C   Sample iterator function that calculates the output flux 'rate' column
C   by dividing the input 'counts' by the 'time' column.
C   It also applies a constant deadtime correction factor if the 'deadtime'
C   keyword exists.  Finally, this creates or updates the 'LIVETIME'
C   keyword with the sum of all the individual integration times.
C***************************************************************************
      subroutine flux_rate(totalrows, offset, firstrow, nrows, ncols,
     &     units, colnum, datatype, iotype, repeat, status, userData,
     &     counts, interval, rate )

      integer totalrows, offset, firstrow, nrows, ncols
      integer units(ncols), colnum(ncols), datatype(ncols)
      integer iotype(ncols), repeat(ncols)
      integer userData

C     include f77.inc -------------------------------------
C     Codes for FITS extension types
      integer IMAGE_HDU, ASCII_TBL, BINARY_TBL
      parameter (
     &     IMAGE_HDU  = 0,
     &     ASCII_TBL  = 1,
     &     BINARY_TBL = 2  )

C     Codes for FITS table data types

      integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT
      integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX
      parameter (
     &     TBIT        =   1,
     &     TBYTE       =  11,
     &     TLOGICAL    =  14,
     &     TSTRING     =  16,
     &     TSHORT      =  21,
     &     TINT        =  31,
     &     TFLOAT      =  42,
     &     TDOUBLE     =  82,
     &     TCOMPLEX    =  83,
     &     TDBLCOMPLEX = 163  )

C     Codes for iterator column types

      integer InputCol, InputOutputCol, OutputCol
      parameter (
     &     InputCol       = 0,
     &     InputOutputCol = 1,
     &     OutputCol      = 2  )
C     End of f77.inc -------------------------------------

      integer counts(*)
      real interval(*),rate(*)

      integer ii, status
      character*80 comment

C**********************************************************************
C  must preserve these values between calls
      real deadtime, livetime
      common /fluxblock/ deadtime, livetime
C**********************************************************************

      if (status .ne. 0) return

C    --------------------------------------------------------
C      Initialization procedures: execute on the first call  
C    --------------------------------------------------------
      if (firstrow .eq. 1) then
         if (ncols .ne. 3) then
C     wrong number of columns
            status = -1
            return
         endif

         if (datatype(1).ne.TINT .or. datatype(2).ne.TFLOAT .or.
     &        datatype(3).ne.TFLOAT ) then
C     bad data type
            status = -2
            return
         endif

C     try to get the deadtime keyword value
         call ftgkye( units(1), 'DEADTIME', deadtime, comment, status )

         if (status.ne.0) then
C     default deadtime if keyword doesn't exist
            deadtime = 1.0
            status = 0
         elseif (deadtime .lt. 0.0 .or. deadtime .gt. 1.0) then
C     bad deadtime value
            status = -3
            return
         endif

         print *, 'deadtime = ', deadtime

         livetime = 0.0
      endif

C    --------------------------------------------
C      Main loop: process all the rows of data
C    --------------------------------------------
      
C     NOTE: 1st element of array is the null pixel value!
C     Loop over elements 2 to nrows+1, not 1 to nrows.
      
C     this version ignores null values

C     set the output null value to zero to ignore nulls */
      rate(1) = 0.0
      do 10 ii = 2,nrows+1
         if ( interval(ii) .gt. 0.0) then
           rate(ii) = counts(ii) / interval(ii) / deadtime
           livetime = livetime + interval(ii)
        else
C     Nonsensical negative time interval
           status = -3
           return
        endif
 10   continue

C    -------------------------------------------------------
C      Clean up procedures:  after processing all the rows  
C    -------------------------------------------------------

      if (firstrow + nrows - 1 .eq. totalrows) then
C     update the LIVETIME keyword value

         call ftukye( units(1),'LIVETIME', livetime, 3,
     &        'total integration time', status )
         print *,'livetime = ', livetime

      endif
 
      return
      end