SUBROUTINE ZPHA
C
C Module number: 13.4
C
C Module name: zpha
C
C Keyphrase:
C ----------
C       HRS discriminator thresholds and pulse height analysis
C
C Description:
C ------------
C       Using an HRS PHA observation, an analysis of each channel is done
C       by fitting a Gaussian with a linear baseline to the differential
C       pulse distribution.  The threshold for each diode
C       is computed as PERCENT times the location of the
C       of the peak of the gaussian.  The threshold for the corner diodes
C       are increased by CORNER units and the focus diodes by FOCUS units.
C       The radiation diode thresholds are set to PCRAD * the average
C       threshold for the 500 diodes on the main array.
C
C Fortran Name: ZPHA.FOR
C
C Keywords of accessed files and tables:
C --------------------------------------
C  INPUT        input   input PHA observation file name
C  EEFILE       input   ext. eng. data file name
C  CHFILE       input   file name containing channel numbers
C  INTPHD       output  integral phd file name
C  DIFPHD       output  differential pdh file name
C  FITPHD       output  fitted phd file name
C  TABLE        output  Theshold table file name
C  PERCENT      input   percent of peak to set threshhold
C  CORNER       input   offset threshold for corner diodes
C  FOCUS        input   offset threshold for focus diodes
C  PCRAD        input   percent of average thresh. to set rad. diode thresholds
C  T0           input   first threshold in INFILE
C  DELT         input   threshold stepsize in INFILE
C  CENTER       input   initial guess for peak centers (in threshold units)
C  SIGMA        input   initial guess for sigma of Gaussians fitted.
C  BOX          input   size of box for smoothing differential.
C
C Subroutines called:
C -------------------
C SDAS:
*       uclgs* , umsput
*       uttinn, utppti, utcdef, utrpt*, utcpt*, uthad*, uttclo, utccre
*       uttopn, utpgti, utcfnd, utrgt*, utcgt*, uthgt*, uttclo
*       uimotp, uimxtp, uimctp, uimopn, uimgid, uimclo, uhdgs* uimclo
C OTHERS:
C       zphd, zphath
C
C HISTORY:
C --------
C version         date           Author                 Description
C    1          Jan. 87         D. Lindler      Designed and coded
C    2          MAR. 88         D. Lindler      New I/O and standards
C-------------------------------------------------------------------------------
C
C     FILE I/O ACCESS MODES
C
      INTEGER   RDONLY
      PARAMETER (RDONLY = 1)
C
C     CODES FOR DATA TYPES
C
      INTEGER   TYINT
      PARAMETER (TYINT = 4)
      INTEGER   TYREAL
      PARAMETER (TYREAL = 6)
      INTEGER   TYDOUB
      PARAMETER (TYDOUB = 7)
C
C     UMSPUT DESTINATIONS -- CB, DAO, 4-SEP-87
C
      INTEGER STDOUT
      PARAMETER (STDOUT = 1)
      INTEGER STDERR
      PARAMETER (STDERR = 2)
C
C     UHDAS HEADER PARM TYPES -- CB, DAO, 5-SEP-87
C
      INTEGER GENHDR
      PARAMETER (GENHDR = 0)
C
C     THIS SECTION IS FOR PARAMETERS RELEVANT TO TABLE I/O.
C
C     THESE MAY BE SET BY UTPPTI AND/OR READ BY UTPGTI:
C
C                                       NUMBER OF ROWS TO ALLOCATE
      INTEGER   TBALLR
      PARAMETER (TBALLR = 3)
C                                       INCREASE ALLOC NUM OF ROWS
      INTEGER   TBWTYP
      PARAMETER (TBWTYP = 5)
C                                       MAXIMUM NUMBER OF COLUMNS
      INTEGER   TBMXCL
      PARAMETER (TBMXCL = 7)
C                                       TYPE = COLUMN-ORDERED TABLE
      INTEGER   TBTYPC
      PARAMETER (TBTYPC = 12)
C                                       NUMBER OF ROWS IN TABLE
      INTEGER   TBNROW
      PARAMETER (TBNROW = 21)
C                                       NUMBER OF COLUMNS DEFINED
      INTEGER   TBNCOL
      PARAMETER (TBNCOL = 22)
C
C ERROR PROCESSING PARAMETERS
C
        INTEGER         STATUS,ISTAT,ISTATS(20)
        CHARACTER*130   CONTXT
C
C KEYWORD PARAMETERS
C
        DOUBLE PRECISION T0,DELT,FOCUS,CORNER,PCRAD,CENTER,SIGMA,PERCNT
        INTEGER NITER
C
C OUTPUT TABLE COLUMN NAMES
C
        CHARACTER*64    TABLE
        CHARACTER*8     COLNAM(12),CUNIT(12),CFORM(12)
        INTEGER         CTYPE(12),IDOUT,COLIDS(12)
        DOUBLE PRECISION CENT(512),PEAK(512),SIG(512),A0(512),A1(512)
        DOUBLE PRECISION FWHM(512),THRESH(512)
C
C INPUT DATA ARRARY FOR 512 DIODES BY GCOUNT
C
        REAL    DATA(512,200)
        INTEGER GCOUNT
C
C DATA ARRAYS FOR INTEGRAL, DIFFERENTIAL, AND FITTED PULSE HEIGHT DISTRIBUTIONS
C
        DOUBLE PRECISION INTPHD(200,512),DIFPHD(200,512),FITPHD(200,512)
C
C ARRAY OF COUNTS FOR EACH THRESHOLD CHOOSEN
C
        REAL COUNTS(512)
C
C ARRAY OF INPUT THRESHOLD LEVELS
C
        DOUBLE PRECISION TH(200)
C
C FILE PARAMETERS
C
C
C INPUT FILE I/O
C
        CHARACTER*130 INPUT,EEFILE
C                                    --->TEMPLATES
        CHARACTER*64 NAME,EENAME,CHFILE
C                                    --->FILE NAMES
        INTEGER IDTEMP,IDTMP2
C                                    --->TEMPLATE IDS
        INTEGER IDIN,IDIN2
C                                    --->FILE IDS
        INTEGER NAXIS,DTYPE,DIMEN(8)
C                                    --->DATA DESCRIPTIONS
        REAL EE(24)
C                                    --->DATA BUFFER FOR EEFILE
C
C OUTPUT FILES
C
        CHARACTER*64 INTPH,DIFPH,FITPH
C
C DETECTOR NUMBER
C
        INTEGER DET
C
C HIGH VOLTAGE
C
        REAL HV
C
C LOOP INDEX
C
        INTEGER I
C
C EXPOSURE TIMES.
C
        INTEGER EXPO
C
C ROOT NAME OF OBSERVATION
C
        CHARACTER*9 ROOT
C
C INPUT AMP, CHANNEL, AND DIODE NUMBERS.
        INTEGER AMP(512),CHAN(512),DNUM(512),DATAITM(512)
C
C SMOOTHING BOX SIZE.
C
        INTEGER BOX
C
C DATA INITIALIZATION
C
        DATA COLNAM/'DIODE','AMP','CHAN','CENTER','PEAK',
     *       'SIGMA','BASE1','BASE2','FWHM','THRESH','COUNTS',
     *       'DATAITEM'/
        DATA CTYPE/3*TYINT,8*TYREAL,TYINT/
        DATA CFORM/'I3','I2','I2','F6.2','F8.2','F5.2','F4.1','F4.1',
     *       'F6.2','F3.0','F6.0','I2'/
        DATA CUNIT/12*' '/
C
C-----------------------------------------------------------------------------
C
C
C GET KEYWORD PARAMETERS
C
        CALL UCLGST('input',INPUT,ISTATS(1))
        CALL UCLGST('eefile',EEFILE,ISTATS(2))
        CALL UCLGST('chfile',CHFILE,ISTATS(3))
        CALL UCLGST('intphd',INTPH,ISTATS(4))
        CALL UCLGST('difphd',DIFPH,ISTATS(5))
        CALL UCLGST('fitphd',FITPH,ISTATS(6))
        CALL UCLGST('table',TABLE,ISTATS(7))
        CALL UCLGSD('percent',PERCNT,ISTATS(8))
        CALL UCLGSD('corner',CORNER,ISTATS(9))
        CALL UCLGSD('focus',FOCUS,ISTATS(10))
        CALL UCLGSD('pcrad',PCRAD,ISTATS(11))
        CALL UCLGSD('t0',T0,ISTATS(12))
        CALL UCLGSD('delt',DELT,ISTATS(13))
        CALL UCLGSD('center',CENTER,ISTATS(14))
        CALL UCLGSD('sigma',SIGMA,ISTATS(15))
        CALL UCLGSI('niter',NITER,ISTATS(16))
        CALL UCLGSI('box',BOX,ISTATS(17))
        DO 5 I=1,17
                IF(ISTATS(I).NE.0)THEN
                        CONTXT='Error getting CL parameter'
                        GO TO 999
                ENDIF
5       CONTINUE
C---------------------------------------------------------------------------
C    READ INPUT OBSERVATIONS AND EXTRACTED ENG. DATA FILES
C
        GCOUNT=0
C
C OPEN TEMPLATES
C
        CALL UIMOTP(INPUT,IDTEMP,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error opening input filename template '//INPUT
                GO TO 999
        ENDIF
        CALL UIMOTP(EEFILE,IDTMP2,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error opening eefile template '//EEFILE
                GO TO 999
        ENDIF
C
C GET NEXT FILE NAMES
C
20      CALL UIMXTP(IDTEMP,NAME,ISTAT)
        IF(ISTAT.LT.0)GO TO 100
        IF(ISTAT.NE.0)THEN
                CONTXT='Error getting filename from template '//INPUT
                GO TO 999
        ENDIF
        CALL UIMXTP(IDTMP2,EENAME,ISTAT)
        IF(ISTAT.LT.0)THEN
                CONTXT='Insufficent  EEFILES specified'
                GO TO 999
        ENDIF
        IF(ISTAT.NE.0)THEN
                CONTXT='Error getting filename from template '//EEFILE
                GO TO 999
        ENDIF
C
C OPEN INPUT FILES
C
        CALL UIMOPN(NAME,RDONLY,IDIN,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error opening input file '//NAME
                GO TO 999
        ENDIF
        CALL UIMOPN(EENAME,RDONLY,IDIN2,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error opening eefile '//EENAME
                GO TO 999
        ENDIF
C
C READ IMAGE INFO
C
        CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error reading input file '//NAME
                GO TO 999
        ENDIF
C
C CHECK FOR VALID DATA
C
        IF((NAXIS.NE.1).OR.(DIMEN(1).NE.500))THEN
                CONTXT='Input data must vector with 500 points'
                GO TO 999
        ENDIF
C
C READ EEFILE INFO
C
        CALL UIMGID(IDIN2,DTYPE,NAXIS,DIMEN,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error reading eefile '//EENAME
                GO TO 999
        ENDIF
C
C CHECK FOR VALID DATA
C
        IF((NAXIS.NE.1).OR.(DIMEN(1).NE.24))THEN
                CONTXT='EEFILEs must be 24 point vectors'
                GO TO 999
        ENDIF
C
C READ DATA
C
        GCOUNT=GCOUNT+1
        IF(GCOUNT.GT.200)THEN
                CONTXT='MAX of 200 input data bins allowed'
                GO TO 999
        ENDIF
C
C MAIN DIODE ARRAY STARTS AT POSITION 7
C
        CALL UIGL1R(IDIN,DATA(7,GCOUNT),ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error reading input file '//NAME
                GO TO 999
        ENDIF
        CALL UIGL1R(IDIN2,EE,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error reading input file '//EENAME
                GO TO 999
        ENDIF
C
C PLACE SPECAIL DIODES INTO DATA ARRAY
C
        DO 50 I=1,6
                DATA(I,GCOUNT)=EE(I)
                DATA(I+506,GCOUNT)=EE(I+6)
50      CONTINUE
C
C GET EXPOSURE TIME IF IT IS FIRST GROUP
C
        IF(GCOUNT.EQ.1)THEN
           EXPO=EE(21)
           CALL ZGETBT(EXPO,8,15,EXPO)
           EXPO = EXPO * 0.05
        ENDIF
C
C GET DETECTOR NUMBER IF IT IS FIRST GROUP
C
        IF(GCOUNT.EQ.1)THEN
            CALL UHDGSI(IDIN,'DETECTOR',DET,ISTAT)
            IF(ISTAT.NE.0)THEN
                CONTXT='Error getting DETECTOR number from '//NAME
                GO TO 999
            ENDIF
        ENDIF
C
C GET HIGH VOLTAGE
C
        IF(GCOUNT.EQ.1)THEN
           IF(DET.EQ.1)THEN
              CALL UHDGSR(IDIN,'ZPCV1',HV,ISTAT)
              IF(HV.LE.0.)HV=21.66667
           ENDIF
           IF(DET.EQ.2)THEN
              CALL UHDGSR(IDIN,'ZPCV2',HV,ISTAT)
              IF(HV.LE.0.)HV=21.97059
           ENDIF
           IF(ISTAT.NE.0)THEN
              CONTXT='Error getting high voltage from '//NAME
              GO TO 999
           ENDIF
        ENDIF
C
C GET ROOTNAME IF IT IS FIRST GROUP
C
        IF(GCOUNT.EQ.1)THEN
           CALL UHDGST(IDIN,'ROOTNAME',ROOT,ISTAT)
            IF(ISTAT.NE.0)THEN
                CONTXT='Error getting ROOTNAME from '//NAME
                GO TO 999
            ENDIF
        ENDIF
C
C CLOSE IMAGES
C
        CALL UIMCLO(IDIN,ISTAT)
        CALL UIMCLO(IDIN2,ISTAT)
C
C GO GET NEXT IMAGE
C
        GO TO 20
100     CONTINUE
C
C DONE READING INPUT DATA ------------------------------------------------
C
        IF(GCOUNT.LT.10)THEN
                CONTXT='Insufficient input data files specified'
                GO TO 999
        ENDIF
C
C---------------------------------------------------------------------------
C   READ INPUT CHANNEL VECTOR
C
        CALL UTTOPN(CHFILE,RDONLY,IDIN,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error opening input chfile '//CHFILE
                GO TO 999
        ENDIF
        CALL UTPGTI(IDIN,TBNROW,DIMEN(1),ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error getting rows from file '//NAME
                GO TO 999
        ENDIF
        CALL UTPGTI(IDIN,TBNCOL,DIMEN(2),ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error getting columns from file '//NAME
                GO TO 999
        ENDIF
C
C CHECK FOR VALID DATA
C
        IF((DIMEN(1).NE.512).OR.(DIMEN(2).NE.4))THEN
                CONTXT='Input chfile must have 512 points and 4 columns'
                GO TO 999
        ENDIF
        CALL UTCNUM(IDIN,1,DIMEN(2),ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error finding column 1 from file '//NAME
                GO TO 999
        ENDIF
        CALL UTCGTI(IDIN,DIMEN(2),1,DIMEN(1),AMP,DNUM,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error reading column 1 from file '//NAME
                GO TO 999
        ENDIF
        CALL UTCNUM(IDIN,2,DIMEN(2),ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error finding column 2 from file '//NAME
                GO TO 999
        ENDIF
        CALL UTCGTI(IDIN,DIMEN(2),1,DIMEN(1),CHAN,DNUM,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error reading column 2 from file '//NAME
                GO TO 999
        ENDIF
        CALL UTCNUM(IDIN,4,DIMEN(2),ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error finding column 4 from file '//NAME
                GO TO 999
        ENDIF
        CALL UTCGTI(IDIN,DIMEN(2),1,DIMEN(1),DATAITM,DNUM,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error reading column 4 from file '//NAME
                GO TO 999
        ENDIF
C
C CLOSE THE AMP/CHANNEL TABLE
C
        CALL UTTCLO(IDIN,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error reading closing file '//NAME
                GO TO 999
        ENDIF
C
C FILL THE DIODE NUMBER ARRAY.
        DO 25 I = 1, 512
           DNUM(I) = I
 25     CONTINUE
C
C WE ARE NOW READY TO DO SOME REAL WORK -----------------------------------
C
C
C COMPUTE THRESHOLD ARRAY
C
        DO 30 I=1,GCOUNT
                TH(I)=T0+(I-0.5)*DELT
30      CONTINUE
C
C COMPUTE INTEGRAL AND DIFFERENTRIAL PHD
C AND PERFORM FITS
C
        CALL ZPHD(DATA,GCOUNT,TH,CENTER,SIGMA,NITER,BOX,
     *          INTPHD,DIFPHD,
     *          FITPHD,CENT,SIG,PEAK,A0,A1,STATUS)
        IF(STATUS.NE.0)THEN
                CONTXT='ERROR FITTING PULSE HEIGHT DIST.'
                GO TO 999
        ENDIF
C
C COMPUTE THRESHOLDS AND FULL WIDTH/HAX MAX OF PEAK
C
        CALL ZPHATH(CENT,SIG,PERCNT,PCRAD,CORNER,FOCUS,THRESH,FWHM,
     *                   STATUS)
        IF(STATUS.NE.0)THEN
                CONTXT='ERROR PRINTING RESULTS'
                GO TO 999
        ENDIF
C
C SET COUNTS FOR EACH THRESHOLD CHOOSEN
C
        CALL ZPHAC(GCOUNT,INTPHD,THRESH,T0,DELT,COUNTS)
C
C WRITE INTEGRAL PHA ---------------------------------------------------------
C
        DIMEN(1)=GCOUNT
        DIMEN(2)=512
        CALL UIMCRE(INTPH,TYREAL,2,DIMEN,IDOUT,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error opening output file '//INTPH
                GO TO 999
        ENDIF
        CALL UIPS2D(IDOUT,1,GCOUNT,1,512,INTPHD,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UHDASI(IDOUT,'DETECTOR',DET,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UHDASR(IDOUT,'HV',HV,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UHDAST(IDOUT,'ROOTNAME',ROOT,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UHDASI(IDOUT,'EXPOSURE',EXPO,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UIMCLO(IDOUT,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error closing output file '//INTPH
                GO TO 999
        ENDIF
C
C WRITE DIFFERENTIAL PHA
C
        CALL UIMCRE(DIFPH,TYREAL,2,DIMEN,IDOUT,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error opening output file '//DIFPH
                GO TO 999
        ENDIF
        CALL UIPS2D(IDOUT,1,GCOUNT,1,512,DIFPHD,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//DIFPH
                GO TO 999
        ENDIF
        CALL UHDAST(IDOUT,'ROOTNAME',ROOT,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UHDASI(IDOUT,'DETECTOR',DET,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//DIFPH
                GO TO 999
        ENDIF
        CALL UHDASR(IDOUT,'HV',HV,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UHDASI(IDOUT,'EXPOSURE',EXPO,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UIMCLO(IDOUT,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error closing output file '//DIFPH
                GO TO 999
        ENDIF
C
C WRITE FITTED PHD
C
        CALL UIMCRE(FITPH,TYREAL,2,DIMEN,IDOUT,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error opening output file '//FITPH
                GO TO 999
        ENDIF
        CALL UIPS2D(IDOUT,1,GCOUNT,1,512,FITPHD,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//FITPH
                GO TO 999
        ENDIF
        CALL UHDAST(IDOUT,'ROOTNAME',ROOT,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UHDASI(IDOUT,'DETECTOR',DET,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//FITPH
                GO TO 999
        ENDIF
        CALL UHDASR(IDOUT,'HV',HV,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UHDASI(IDOUT,'EXPOSURE',EXPO,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UIMCLO(IDOUT,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error closing output file '//FITPH
                GO TO 999
        ENDIF
C
C WRITE OUTPUT TABLE FILE ----------------------------------------------
C
C
        CALL UTTINN(TABLE,IDOUT,ISTATS(1))
        CALL UTPPTI(IDOUT,TBWTYP,TBTYPC,ISTATS(2))
        CALL UTPPTI(IDOUT,TBALLR,512,ISTATS(3))
        CALL UTPPTI(IDOUT,TBMXCL,12,ISTATS(4))
        CALL UTCDEF(IDOUT,COLNAM,CUNIT,CFORM,CTYPE,12,COLIDS,ISTATS(5))
        CALL UTTCRE(IDOUT,ISTATS(6))
        DO 200 I=1,6
                IF(ISTATS(I).NE.0)THEN
                        CONTXT='Error creating output table '//TABLE
                        GO TO 999
                ENDIF
200     CONTINUE
C
C COPY RESULTS TO TABLE
C
        CALL UTCPTI(IDOUT,COLIDS(1),1,512,DNUM,ISTATS(1))
        CALL UTCPTI(IDOUT,COLIDS(2),1,512,AMP,ISTATS(2))
        CALL UTCPTI(IDOUT,COLIDS(3),1,512,CHAN,ISTATS(3))
        CALL UTCPTD(IDOUT,COLIDS(4),1,512,CENT,ISTATS(4))
        CALL UTCPTD(IDOUT,COLIDS(5),1,512,PEAK,ISTATS(5))
        CALL UTCPTD(IDOUT,COLIDS(6),1,512,SIG,ISTATS(6))
        CALL UTCPTD(IDOUT,COLIDS(7),1,512,A0,ISTATS(7))
        CALL UTCPTD(IDOUT,COLIDS(8),1,512,A1,ISTATS(8))
        CALL UTCPTD(IDOUT,COLIDS(9),1,512,FWHM,ISTATS(9))
        CALL UTCPTD(IDOUT,COLIDS(10),1,512,THRESH,ISTATS(10))
        CALL UTCPTR(IDOUT,COLIDS(11),1,512,COUNTS,ISTATS(11))
        CALL UTCPTI(IDOUT,COLIDS(12),1,512,DATAITM,ISTATS(12))
        DO 210 I=1,12
                IF(ISTATS(I).NE.0)THEN
                        CONTXT='Error writing to output table'
                        GO TO 999
                ENDIF
210     CONTINUE
        CALL UTHADT(IDOUT,'ROOTNAME',ROOT,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output table header '//INTPH
                GO TO 999
        ENDIF
        CALL UTHADI(IDOUT,'DETECTOR',DET,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output table header'
                GO TO 999
        ENDIF
        CALL UTHADR(IDOUT,'HV',HV,' ',GENHDR,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output file '//INTPH
                GO TO 999
        ENDIF
        CALL UTHADI(IDOUT,'EXPOSURE',EXPO,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error writing to output table header'
                GO TO 999
        ENDIF
        CALL UTTCLO(IDOUT,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error closing output table '//TABLE
                GO TO 999
        ENDIF
C
C DONE -------------------------------------------------------------------
C
        GO TO 1000
999     CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT)
1000    RETURN
        END