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