*+WTPHA2
subroutine wtpha2(ounit,chatter,nk_hist,hist,nk_comm,
& comment,telescop,instrume,detnam,filter,
& phaversn,hduclas2,fchan,texpos,qareasc,areascal,
& backfil,qbacksc,backscal,corrfil,
& corrscal,respfil,ancrfil,detchans,chantyp,
& channel,counts,dtype,qerror,serr,qsys,
& syserr,qqual,qualty,qgroup,grping,nchan,
& ierr)
IMPLICIT NONE
integer ounit,chatter,nk_hist, nk_comm
integer detchans, dtype, nchan, ierr
integer channel(detchans),qualty(detchans),grping(detchans)
integer fchan
real texpos,corrscal
real counts(detchans), serr(detchans), syserr(detchans)
real areascal(*), backscal(*)
character*(*) phaversn
character*(*) telescop,instrume,detnam,filter
character*(*) chantyp
character*(*) hduclas2
character*(*) hist(nk_hist), comment(nk_comm)
character*(*) backfil,corrfil,respfil,ancrfil
logical qerror,qsys,qqual,qgroup
logical qareasc,qbacksc
c
c Description
c This subroutine writes the SPECTRUM extension for a PHA file in
c one of the formats conforming to the HDUVERS='1.*.*' family.
c Currently the following formats are supported (see OGIP/92-007a)
c HDUVERS1 = '1.0.0'
c HDUVERS1 = '1.1.0'
c HDUVERS = '1.1.0'
c HDUVERS = '1.2.0'
c The requested format is checked, and if belonging to the '1.*.*' family,
c but not included above, the extension is written in the last format listed.
c !!! Note !!! the o/p file is assumed to have been opened, and wound to the
c desired location. The file is left open at the end of the
c newly written SPECTRUM extension on return and MUST be closed
c using FTCLOS or another extension written starting with FTCRHD
c in order that the mandatory END keyword is written
c In all cases, the 1.*.* family of formats consists of a BINTABLE extension,
c with the number of rows equal to the number of channels passed (this does
c not have to be the total number of detector channels the instrument is
c capable of).
c
c Passed Parameters
c OUNIT i : FORTRAN unit number of open PHA file
c CHATTER i : chattiness flag for o/p (5 quite,10 norm,>19 silly)
c NK_HIST i : No. records to be written as HISTORY records
c HIST i : Array of history record strings to be written
c NK_COMM i : No. records to be written as COMMENT records
c COMMENT i : Array of comment record strings to be written
c TELESCOP i : String giving telescope/mission
c INSTRUME i : String giving instrument/detector name
c DETNAM i : String giving specific detector name/code (if any)
c FILTER i : String giving instrument filetr in use (if any)
c PHAVERSN i : String denoting OGIP HDUVERS family
c HDUCLAS2 i : String containing HDUCLAS2 value
c FCHAN i : First legal channel number (ie 0, 1 etc)
c TEXPOS i : exposure (Live) time
c QAREASC i : true if a vector AREASCAL is passed
c AREASCAL i : area scaling factor
c BACKFIL i : associated background filename
c QBACKSC i : true if a vector BACKSCAL is passed
c BACKSCAL i : background scaling factor
c CORRFIL i : associated correction filename
c CORRSCAL i : correction scaling factor
c RESPFIL i : detector redistribution matrix file (RMF)
c ANCRFIL i : ancillary response file (ARF)
c DETCHANS i : total number of possible detector channels
c CHANTYP i : type of detector channels (PHA, PI etc)
c CHANNEL i : array of detector channel numbers
c COUNTS i : array of obs'd counts (or count rate) per chan
c DTYPE i : flag to denote counts (1) or count rates (2)
c QERROR i : flag as to whether stat errors passed down
c SERR i : array of statistical errors on COUNTS (for QERROR=T)
c QSYS i : flag as to whether systematic errors passed down
c SYSERR i : array of systematic errors on COUNTS (for QSYS=T)
c QQUAL i : flag as to whether quality array passed down
c QUALTY i : array of quality flags (for QQUAL=T)
c QGROUP i : flag as to whether grouping array passed down
c GRPING i : array of quality flags (for QGROUP=T)
c NCHAN i : No. channels actually passed down
c IERR o : Error Flag (0=OK)
c
c Format Written
c Each row consists of the following columns/contents:
c CHANNEL - (int) the channel number
c either: COUNTS - (int) the number of counts/channel
c or RATE - (real) the number of counts/channel/second
c STAT_ERR- (real) the statistical error on COUNTS or RATE
c SYS_ERR - (real) the fractional systematic error on COUNTS or RATE
c QUALITY - (int) quality flag for the data in channel
c GROUPING- (int) grouping flag for this channel
c AREASCAL- (real) area scaling for this channel
c BACKSCAL- (real) background scaling for this channel
c If all the rows would contain the same value in the STAT_ERR,SYS_ERR,
c QUALITY,GROUPING,AREASCAL, or BACKSCAL columns, then that column is
c not written and the value supplied by a header keyword instead.
c
c The following keywords are written:
c HDUCLASS='OGIP'-indicating the format conforms to OGIP standards
c HDUCLAS1='SPECTRUM' - indicating major class in the heirarchy
c HDUVERS - (passed) The phaversn to be written (must in '1.*.*' family)
c HDUCLAS2- (passed) - Whether the spectrum is srce, bkgd, or both
c HDUCLAS3- Indicating whether the data are stored as counts of count rates
c TELESCOP- The mission/satellite name'
c INSTRUME- The instrument/detector name'
c DETNAM - The sub-detector in use
c FILTER - The name of the filter in use
c EXPOSURE- The exposure time (or "live-time") in seconds
c BACKFIL - The name of the associated background file
c CORRFIL - The name of the associated correction file
c CORRSCAL- The correction file scaling factor
c RESPFILE- The name of the associated redistrib matrix file
c ANCRFILE- The name of the associated ancillary response file
c PHAVERSN='1992a' - The OGIP classification of FITS format
c DETCHANS- The total number possible detector channels
c CHANTYPE- The channel type (PHA, PI etc)
c POISSERR- Logical as the whether poissonian errors are to be assumed
c
c Called routines etc
c subroutine FCECHO : (FTOOLS) Writes to standard o/p
c subroutine FTOPEN : (FITSIO) Opens FITS file
c subroutine FTCRHD : (FITSIO) Creates header
c subroutine FTMAHD : (FITSIO) Move to specified header number
c subroutine FTMCOM : (FITSIO) Modify comment of existing keyword
c subroutine FTMRHD : (FITSIO) Move a specified number of headers
c subroutine FTGHSP : (FITSIO) Obtain the number of keywords
c subroutine FTPHIS : (FITSIO) Write history keywords
c subroutine FTBDEF : (FITSIO) Define Binary header
c subroutine FTPCLn : (FITSIO) Write FITS column of type n
c subroutine WT_FERRMSG : (CALLIB) writes FITSIO error message
c
c Authors/modification history
c kaa 3/19/01 modified from wrpha1.f v3.2.1 for HDUVERS=1.2.0
c ----------------------------------------------------------------------