SUBROUTINE WRITE_RSP (NCHAN, NENERG, MXELEM, MXGRPS, MXTGRP,
& RSP_MIN, matrix, energies, e_min, e_max,
& tlscpe, instrm, detnam, filter, hduclas3,
& rspfil, nk_hist, hist, nk_comm, comment,
& rspmat, ngroup, ichanb, nchang,
& ierr)
INTEGER NCHAN, NENERG, MXELEM, MXGRPS, MXTGRP
REAL RSP_MIN
REAL matrix (NCHAN, NENERG), rspmat(MXELEM)
REAL energies (0:NENERG)
REAL e_min (NCHAN), e_max (NCHAN)
INTEGER ngroup(NENERG)
INTEGER ichanb(MXTGRP)
INTEGER nchang(MXTGRP)
INTEGER nk_hist, nk_comm, ierr
CHARACTER*(*) rspfil, hist(nk_hist), comment(nk_comm)
CHARACTER*(*) tlscpe, instrm, detnam, filter, hduclas3
c routine to write a FITS format response file. response matrix is passed as
c XSPEC compressed format
c kaa 10/18/94
c Arguments :
c NCHAN i i: Number of channels in response matrix
c NENERG i i: Number of energy bins in response matrix
c MXELEM i i: Max. number of non-zero response elements
c MXGRPS i i: Max. number of groups at a given energy
c MXTGRP i i: Max. number of total groups
c RSP_MIN r i: Minimum value of response that is stored
c matrix r i: Response matrix
c energies r i: Energy bins for the response
c e_min r i: Nominal lower energy bounds for channels
c e_max r i: Nominal upper energy bounds for channels
c tlscpe c i: Telescope name
c instrm c i: Instrument name
c detnam c i: Detector name
c filter c i: Filter name
c hduclas3 c i: If =REDIST => photon redistribution matrix (only)
c =DETECTOR => convolved w/ detector effects (only)
c =FULL => convolved w/ all effects (det+optic)'
c rspfil c i: Output filename
c nk_hist i i: Number of history records
c hist c i: History records (optional)
c nk_comm i i: Number of comment records
c comment c i: Comment records (optional)
c rspmat r w: Non-zero response elements
c ngroup i w: Number of contiguous channel sets
c ichanb i w: Start channel of a group
c nchang i w: Number of channels in a group
c ierr i r: Error code (0 = OK)
c Local variables
INTEGER ounit, chatter, nelem, ntgrps
chatter = 10
c ------------------------------------------------------------
c Calculate the compressed matrix
c ------------------------------------------------------------
CALL cmprsp(NCHAN, NENERG, MXELEM, MXGRPS, MXTGRP, RSP_MIN,
& matrix, rspmat, ngroup, ichanb, nchang, nelem,
& ntgrps)
c ------------------------------------------------------------
c Open the output FITS file.
c ------------------------------------------------------------
ounit = 15
CALL ftinit(ounit, rspfil, 1, ierr)
c ------------------------------------------------------------
c Write the primary header
c ------------------------------------------------------------
CALL ftpdef(ounit, 8, 0, 0, 0, 1, ierr)
c Write the basic primary array keywords
CALL ftphpr(ounit, .TRUE., 8, 0, 0, 0, 1, .TRUE., ierr)
c Write out the additional keywords about the creation of the
c FITS file.
CALL ftpkys(ounit, 'CONTENT', 'RESPONSE',
& 'spectral response matrix', ierr)
CALL ftpkys(ounit, 'ORIGIN', 'NASA/GSFC',
& 'origin of FITS file', ierr)
c ------------------------------------------------------------
c Write the energy bounds extensions
c ------------------------------------------------------------
CALL wtebd3(ounit, chatter, nk_hist, hist, nk_comm, comment,
& '1.1.0', tlscpe, instrm, detnam, filter, 1.0,
& 'PI', 1, NCHAN, e_min, e_max, ierr)
c ------------------------------------------------------------
c Write the response matrix extensions
c ------------------------------------------------------------
CALL wtrmf4(ounit, chatter, nk_hist, hist, nk_comm, comment,
& '1.3.0', hduclas3, tlscpe, instrm, detnam, filter,
& 1.0, 'PI', 1, nelem, NCHAN, NENERG, ntgrps,
& energies(0), energies(1), ngroup, ichanb,
& nchang, .FALSE., 1, rspmat, RSP_MIN, ierr)
c ------------------------------------------------------------
c Close the output file
c ------------------------------------------------------------
CALL ftclos(ounit, ierr)
RETURN
END