*+WTRMF4
SUBROUTINE WTRMF4(Ounit,Chatter,Nk_hist,Hist,Nk_comm,Comment,
& Rmfversn,Hduclas3,Telescop,Instrume,Detnam,
& Filter,Areascal,Chantype,Flchan,Numelt,
& Nchan,Nenerg,Numgrp,Energ_lo,Energ_hi,
& Ngrp,F_chan,N_chan,Qorder,Order,Fmatrix,
& Lo_thresh,Ierr)
IMPLICIT NONE
INTEGER Nenerg , Numelt, Numgrp
INTEGER Chatter , Ierr
INTEGER Ounit , Nk_hist , Nk_comm
INTEGER Nchan , Flchan
INTEGER Ngrp(Nenerg) , F_chan(Numgrp)
INTEGER N_chan(Numgrp) , Order(Numgrp)
REAL Areascal , Lo_thresh
REAL Energ_lo(Nenerg) , Energ_hi(Nenerg)
REAL Fmatrix(Numelt)
CHARACTER*(*) Chantype
CHARACTER*(*) Rmfversn
CHARACTER*(*) Telescop , Instrume , Detnam , Filter
CHARACTER*(*) Hduclas3
CHARACTER*(*) Hist(*) , Comment(*)
LOGICAL Qorder
c
c Description:
c Creates and Writes the RMF extension for an RMF file one of the formats
c conforming to the HDUVERS='1.*.*' family.
c Currently the following formats are supported (see OGIP/92-002a)
c HDUVERS2 = '1.0.0'
c HDUVERS2 = '1.1.0'
c HDUVERS2 = '1.2.0'
c HDUVERS = '1.3.0'
c but HDUVERS2 = '1.0.0' or '1.1.0' or '1.2.0' will be overridden such
c that HDUVERS = '1.3.0' is written.
c Assumes the FITS file is open and has had the Primary Header written
c !!! Note !!!! File is left open at the end
c and MUST BE CLOSED by FTCLOS
c or ANOTHER EXTENSION ADDED by FTCRHD
c in order to (automatically) write the mandatory END header keyword.
c For The matrix will be written as a VARIABLE LENGTH ARRAY if the reduction
c in storage requirements (ie total number of stroed values) exceeds a
c factor 3.0 over that obtained using a FIXED length array.
c
c Passed parameters
c OUNIT i : FORTRAN unit number of open RMF file
c CHATTER i : chattiness flag for o/p (5 quite,10 normal,>20 silly)
c NK_HIST i : No. records to be written as HISTORY records
c HIST i : Array of history strings to be written
c NK_COMM i : No. records to be written as COMMENT records
c COMMENT i : Array of comment strings to be written
c RMFVERSN i : String denoting OGIP HDUVERS family
c HDUCLAS3 i : String containing HDUCLAS3 value
c TELESCOP i : String listing telescope/mission
c INSTRUME i : String listing instrument/detector
c DETNAM i : String listing specific detector name
c FILTER i : String listing instrument filter in use
c AREASCAL i : Area scaling factor
c CHANTYPE i : Type of detector channels in use (PHA, PI)
c FLCHAN i : Lowest legal channel for this detector
c NUMELT i : No. response matrix elements
c NCHAN i : No. channels in the full array
c NENERG i : No. energy bins
c NUMGRP i : No. response groups
c ENERG_LO i : Array containing lower bound to each energy bin
c ENERG_HI i : Array containing upper bound to each energy bin
c NGRP i : Array containing no. channel subsets at each energy
c F_CHAN i : Array containing 1st chan of each subset at each energy
c N_CHAN i : Array containing no. chans within each subset
c at each energy
c QORDER i : If true order information will be written
c ORDER i : Grating order to which the response group belongs
c FMATRIX i : Array containing the full matrix
c LO_THRESH i : The lower threshold used to construct the matrix
c IERR o : Error flag (0 = OK)
c
c Called Routines:
c subroutine CRMVBLK : (CALLIB) Removes blanks from a string
c subroutine FCECHO : (FTOOLS) Writes to standard o/p device
c subroutine FTBDEF : (FITSIO) Defines the BINTABLE data structure
c subroutine FTCRHD : (FITSIO) Creates a new FITS extension file
c subroutine FTPHBN : (FITSIO) Writes the required header keywords
c subroutine FTPCOM : (FITSIO) Writes a FITS comment keyword
c subroutine FTPCLx : (FITSIO) Writes the data
c subroutine FTPHIS : (FITSIO) Writes a FITS history keyword
c subroutine FTPKYS : (FITSIO) Writes a keyword
c subroutine WT_FERRMSG : (CALLIB) Writes FITSIO error message etc
c
c Compilation & Linking
c link with FITSIO & CALLIB & FTOOLS
c
c Origin:
c Code mostly hacked from within the BBRSP program
c
c Authors/Modification History:
c Alan Smale (1992 Sept/Oct), original BBRSP version
c Ian M George (1.0.1; 1992 Dec 29), tidied-up version
c Ian M George (1.0.2; 1993 Feb 28), minor debugging of History records
c Ian M George (1.0.3; 1993 May 19), hist & comment made chara*70
c Rehana Yusaf (1.0.4; 1993 July 27), array dimensions changed from
c hard coded to using new arguments
c MAXCHAN and MAXEN
c Ian M George (1.1.0; 1993 Jul 30), cosmetics
c Ian M George (2.0.0; 1993 Sep 03), added variable length arrays
c Ian M George (2.1.0; 1993 Oct 12), added HDUCLASn stuff
c Ian M George (3.0.0: 1993 Oct 13), renamed from wt_rmf1992a & major
c overhaul of HDUCLAS/VERS stuff
c Ian M George (3.0.1: 1993 Dec 01), xtra checks before var length array
c Ian M George (3.1.0: 1994 Jan 24), added varidat for var length arrays
c Ian M George (3.2.0: 1994 Jun 27), made passed chars free form
c Ian M George (1.0.0: 1995 Nov 22), copied from wtrmf1 (v3.2.0), but
c added chantype as passed parameter
c Ian M George (1.0.0:96 Oct 04) copied from wtrmf2 (v1.0.0), to support
c HDUVERS2 = '1.2.0' (and flchan added
c as passed parameter)
c
c Banashree M Seifert (1.1.0 Oct 10,1996)
c . internal formatted write i# instead of i
c
c Banashree M Seifert (1.2.0 Nov 13, 1996)
c . introduced istart, istop
c this is needed due to the fact that when first channel
c flchan=0, then index for channel no. should start from 1
c and not from 0
c
c Banashree M Seifert (1.3.0 Nov 21, 1996)
c . format in internal writing of wrtstr changed from
c i2 to i4
c kaa (1.4.0 Dec 17, 1998)
c . uses compressed matrix and replaces HDUVERS2 with HDUVERS
c added support for version 1.3.0 of the file format with optional
c grating order information and NUMGRP & NUMELT keywords. added
c option to use variable length arrays on F_CHAN and N_CHAN columns.
c --------------------------------------------------------------------------
CHARACTER*7 VERSION
PARAMETER (VERSION='1.4.0')
*-