SUBROUTINE rdsfg2(iunit, ispec, maxhst, header, nhist, hist, & backfl, corrfl, respfl, ancrfl, ftel, finst, & fchtyp, fnbin, fnchan, ftime, & fcorn, igcard, xfltky, chan0, contxt, & filestat) INCLUDE '../../inc/xspec.inc' INTEGER maxhst INTEGER igcard CHARACTER header*(*), hist(maxhst)*(*) CHARACTER backfl*(*), corrfl*(*), respfl*(*), ancrfl*(*) CHARACTER ftel*20, finst*20, fchtyp*3 CHARACTER*80 xfltky(MAXFLT) CHARACTER contxt*(*) INTEGER nhist, filestat, fnbin, fnchan, chan0, iunit, ispec REAL ftime, fcorn c Wrap-up for operations to read the info from the specified c OGIP FITS spectral data file. File has been opened and positioned c at the correct extension. c iunit i i: I/O channel for file c ispec i i: spectrum number c maxhst i i: max number of history record c header c*(*) r: header record c nhist i r: number of history records (< MAXHST) c hist c*(*) r: history records c backfl c*(*) r: background filename c corrfl c*(*) r: correction filename c respfl c*(*) r: response filename c ancrfl c*(*) r: ancillary response filename c ftel c*20 r: telescope c finst c*20 r: instrument c fchtyp c*3 r: channel type c fnchan i r: ungrouped channels c fnbin i r: channels after grouping c ftime r r: exposure time c fcorn r r: default correction file norm c gcard c r: grouping card c xfltky c r: contents of the XFLTxxxx keywords c chan0 i r: the first channel for this detector (0 or 1) c filestat i r: error flag c 0 : success c !=0: FITSIO error number INTEGER i, llchan, hlchan, index, istat INTEGER icol, ijunk CHARACTER*45 comment, tel, instr, chtyp CHARACTER*8 xfkstr LOGICAL qanyf, qgotch INTEGER lenact EXTERNAL lenact c Currently no header or history info read header = ' ' nhist = 0 c Find out whether we have a CHANNEL column and if so which one. CALL ftgcno(iunit, .FALSE., 'CHANNEL', icol, filestat) qgotch = .TRUE. IF ( filestat .NE. 0 .OR. icol .EQ. 0 ) qgotch = .FALSE. filestat = 0 c Get the associated filenames CALL ftgkys(iunit, 'BACKFILE', backfl, comment, filestat) IF (filestat .EQ. 202) THEN filestat = 0 CALL ftgcno(iunit, .FALSE., 'BACKFILE', index, filestat) IF ( filestat .EQ. 0 ) THEN CALL ftgcvs(iunit, index, ispec, 1, 1, ' ', backfl, qanyf, & filestat) ENDIF ENDIF contxt = 'RDSFG2: Failed to get BACKFILE value' IF (filestat .NE. 0) GOTO 100 IF (backfl .EQ. ' ') backfl = 'none' CALL ftgkys(iunit, 'CORRFILE', corrfl, comment, filestat) IF (filestat .EQ. 202) THEN filestat = 0 CALL ftgcno(iunit, .FALSE., 'CORRFILE', index, filestat) IF ( filestat .EQ. 0 ) THEN CALL ftgcvs(iunit, index, ispec, 1, 1, ' ', corrfl, qanyf, & filestat) ENDIF ENDIF contxt = 'RDSFG2: Failed to get CORRFILE value' IF (filestat .NE. 0) GOTO 100 IF (corrfl .EQ. ' ') corrfl = 'none' CALL ftgkys(iunit, 'RESPFILE', respfl, comment, filestat) IF (filestat .EQ. 202) THEN filestat = 0 CALL ftgcno(iunit, .FALSE., 'RESPFILE', index, filestat) IF ( filestat .EQ. 0 ) THEN CALL ftgcvs(iunit, index, ispec, 1, 1, ' ', respfl, qanyf, & filestat) ENDIF ENDIF contxt = 'RDSFG2: Failed to get RESPFILE value' IF (filestat .NE. 0) GOTO 100 IF (respfl .EQ. ' ') respfl = 'none' CALL ftgkys(iunit, 'ANCRFILE', ancrfl, comment, filestat) IF (filestat .EQ. 202) THEN filestat = 0 CALL ftgcno(iunit, .FALSE., 'ANCRFILE', index, filestat) IF ( filestat .EQ. 0 ) THEN CALL ftgcvs(iunit, index, ispec, 1, 1, ' ', ancrfl, qanyf, & filestat) ENDIF ENDIF contxt = 'RDSFG2: Failed to get ANCRFILE value' IF (filestat .NE. 0) GOTO 100 IF (respfl .EQ. ' ') ancrfl = 'none' c Read the FITS records to load the file info c extract the telescope and instrument and set the detid CALL ftgkys(iunit, 'TELESCOP', tel, comment, filestat) contxt = 'RDSFG2: Failed to read TELESCOP keyword' IF (filestat .NE. 0) GOTO 100 ftel = tel(:lenact(tel)) CALL ftgkys(iunit, 'INSTRUME', instr, comment, filestat) contxt = 'RDSFG2: Failed to read INSTRUME keyword' IF (filestat .NE. 0) GOTO 100 finst = instr(:lenact(instr)) c extract the channel type CALL ftgkys(iunit, 'CHANTYPE', chtyp, comment, filestat) contxt = 'RDSFG1: Failed to read CHANTYPE keyword' IF (filestat .NE. 0) THEN CALL xwrite(contxt, 15) CALL xwrite(' ... assuming PHA', 15) fchtyp = 'PHA' filestat = 0 ELSE fchtyp = chtyp(:lenact(chtyp)) ENDIF c extract the exposure time CALL ftgkye(iunit, 'EXPOSURE', ftime, comment, filestat) IF (filestat .EQ. 202) THEN filestat = 0 CALL ftgcno(iunit, .FALSE., 'EXPOSURE', index, filestat) IF ( filestat .EQ. 0 ) THEN CALL ftgcve(iunit, index, ispec, 1, 1, 0., ftime, qanyf, & filestat) ENDIF ENDIF contxt = 'RDSFG2: Failed to get EXPOSURE value' IF (filestat .NE. 0) GOTO 100 c extract the correction scale factor CALL ftgkye(iunit, 'CORRSCAL', fcorn, comment, filestat) IF (filestat .EQ. 202) THEN filestat = 0 CALL ftgcno(iunit, .FALSE., 'CORRSCAL', index, filestat) IF ( filestat .EQ. 0 ) THEN CALL ftgcve(iunit, index, ispec, 1, 1, 0., fcorn, qanyf, & filestat) ENDIF ENDIF contxt = 'RDSFG2: Failed to get CORRSCAL value' IF (filestat .NE. 0) GOTO 100 c get the number of channels. If there is a channel column then we can c use that. if the TLMIN1 and TLMAX1 keywords are set then these give c the number of channels otherwise use the number elements of the vector c (type-II). If TLMIN/MAX1 are set then check that they are consistent c with the size of the CHANNEL column. IF ( qgotch ) THEN CALL ftgdes(iunit, icol, ispec, fnchan, ijunk, filestat) IF ( filestat .NE. 0 ) THEN filestat = 0 CALL ftgtdm(iunit, icol, 1, ijunk, fnchan, filestat) contxt = 'RDSFG2: Failed to find size of CHANNEL column' IF (filestat .NE. 0) GOTO 100 ENDIF CALL ftgkyj(iunit, 'TLMIN1', llchan, comment, filestat) CALL ftgkyj(iunit, 'TLMAX1', hlchan, comment, filestat) IF (filestat .NE. 0) THEN filestat = 0 ELSE IF ( fnchan .GT. (hlchan-llchan+1) ) THEN contxt = 'RDSFG2: file error : size > TLMAX1-TLMIN1+1' filestat = -1 GOTO 100 ELSE fnchan = hlchan - llchan + 1 ENDIF ENDIF c Check whether this file starts with channel 0 or channel 1. CALL ftgkyj(iunit, 'TLMIN1', chan0, comment, filestat) IF ( filestat .NE. 0 ) THEN filestat = 0 CALL ftgcvj(iunit, icol, ispec, 1, 1, 0, chan0, qanyf, & filestat) ENDIF IF ( filestat .NE. 0 ) THEN filestat = 0 chan0 = 1 ENDIF ELSE c if we don't have a CHANNEL column then look for COUNTS or RATE and use c the size of that vector CALL ftgcno(iunit, .FALSE., 'COUNTS', icol, filestat) IF ( filestat .NE. 0 .OR. icol .EQ. 0 ) THEN CALL ftgcno(iunit, .FALSE., 'RATE', icol, filestat) contxt = 'RDSFG2: Failed to find COUNTS or RATE column' IF ( filestat .NE. 0 ) GOTO 100 ENDIF CALL ftgdes(iunit, icol, ispec, fnchan, ijunk, filestat) IF ( filestat .NE. 0 ) THEN filestat = 0 CALL ftgtdm(iunit, icol, 1, ijunk, fnchan, filestat) contxt = & 'RDSFG2: Failed to find size of COUNTS or RATE column' IF (filestat .NE. 0) GOTO 100 ENDIF c since we don't have any way of finding out assume that the first channel c is 1 and that all channels are included in the spectrum. llchan = 1 hlchan = fnchan chan0 = 1 ENDIF c get the grouping and quality information. CALL udmget(fnchan, 2, igcard, istat) IF( istat .NE. 0 ) CALL xwrite( & ' WARNING: Memory allocation failed in RDSFG2.', 2) DO i = 1, fnchan memc(igcard+i-1) = '+' ENDDO c check for QUALITY and GROUPING keywords or fields and set the grouping c card. filestat = 0 CALL rdgrpc(iunit, ispec, fnchan, memc(igcard), fnbin, filestat) contxt = 'RDSFG2: Failure in RDGRPC' IF (filestat .NE. 0) GOTO 100 c Get the contents of any XFLTxxxx keywords DO i = 1, MAXFLT WRITE(xfkstr,'(''XFLT'',i4.4)') i CALL ftgkys(iunit, xfkstr, xfltky(i), comment, filestat) IF (filestat .EQ. 202) THEN filestat = 0 CALL ftgcno(iunit, .FALSE., xfkstr, index, filestat) IF ( filestat .EQ. 0 ) THEN CALL ftgcvs(iunit, index, ispec, 1, 1, ' ', xfltky(i), & qanyf, filestat) ENDIF ENDIF IF ( filestat .NE. 0 ) xfltky(i) = ' ' filestat = 0 ENDDO c Check for any FITSIO errors 100 CONTINUE IF ( filestat .NE. 0 ) THEN CALL xwrite(contxt, 5) WRITE(contxt,'(a,i4)') 'Error status = ', filestat ENDIF RETURN END