SUBROUTINE ZSPRD(NAME,FWIDTH,NS,DATA,GRAT,CPOS,BINID,ISTAT)
*
*  Module number: 13.9.2.1
*
*  Module name: zsprd
*
*  Keyphrase:
*  ----------
*       Read and smooth input spectrum
*
*  Description:
*  ------------
*       This routine reads the input spectrum in the given file
*       and applys a mean filter of the specified width.  It
*       also retrieves header parameters grating, carrousel position,
*       and binid for the first substep bin.
*
*  FORTRAN name: zsprd.for
*
*  Keywords of accessed files and tables:
*  --------------------------------------
*  Name                         I/O     Description / Comments
*       name                    I       input HRS spectral file
*         (header parameters)
*               binid(1)        I       bin-id substep bin 1
*               carpos          I       carrousel position
*               grating         I       grating mode
*
*  Subroutines Called:
*  -------------------
*  CDBS:
*
*  SDAS:
*	uimopn, uiglid, uhdgst, uhdgsi, uimgid, uimclo, umsput
*  Others:
*
*
*  History:
*  --------
*  Version      Date        Author          Description
*    1       Oct. 1987   D. Lindler     Designed and coded
*    1.1     Jan 92	 S. Hulbert	New grating values
*-------------------------------------------------------------------------------
C
C INPUT PARAMETERS
C
C       NAME - FILE NAME (CHARACTER*64)
C       FWIDTH - FILTER WIDTH (INTEGER)
C
C OUTPUT PARAMETERS
C
C       NS - NUMBER OF POINTS IN SPECTRUM (INTEGER)
C       DATA - SPECTRUM (REAL*8 VECTOR) MAX SIZE=2000
C       GRAT - GRATING MODE (CHARACTER*5)
C       CPOS - CARROUSEL POSITION (INTEGER)
C       BINID - SUBSTEP BINID (INTEGER)
C       ISTAT - ERROR STATUS (INTEGER)
C
C-----------------------------------------------------------------------------
C     INCLUDE FILE FOR THE IRAF77 FORTRAN INTERFACE TO THE IRAF VOS
C
C
C     FILE I/O ACCESS MODES
C
      INTEGER   RDONLY
      PARAMETER (RDONLY = 1)
      INTEGER   RDWRIT
      PARAMETER (RDWRIT = 2)
      INTEGER   WRONLY
      PARAMETER (WRONLY = 3)
      INTEGER   APPEND
      PARAMETER (APPEND = 4)
C
C     CODES FOR DATA TYPES
C
      INTEGER   TYBOOL
      PARAMETER (TYBOOL = 1)
      INTEGER   TYCHAR
      PARAMETER (TYCHAR = 2)
      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)
      INTEGER IMSPEC
      PARAMETER (IMSPEC = 1)
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                                       LENGTH OF ROW (UNIT = SIZE OF REAL)
      INTEGER   TBRLEN
      PARAMETER (TBRLEN = 1)
C                                       INCREASE ROW LENGTH
      INTEGER   TBIRLN
      PARAMETER (TBIRLN = 2)
C                                       NUMBER OF ROWS TO ALLOCATE
      INTEGER   TBALLR
      PARAMETER (TBALLR = 3)
C                                       INCREASE ALLOC NUM OF ROWS
      INTEGER   TBIALR
      PARAMETER (TBIALR = 4)
C                                       WHICH TYPE OF TABLE? (ROW OR COLUMN)
      INTEGER   TBWTYP
      PARAMETER (TBWTYP = 5)
C                                       MAXIMUM NUMBER OF USER PARAMETERS
      INTEGER   TBMXPR
      PARAMETER (TBMXPR = 6)
C                                       MAXIMUM NUMBER OF COLUMNS
      INTEGER   TBMXCL
      PARAMETER (TBMXCL = 7)
C                                       TYPE = ROW-ORDERED TABLE
      INTEGER   TBTYPR
      PARAMETER (TBTYPR = 11)
C                                       TYPE = COLUMN-ORDERED TABLE
      INTEGER   TBTYPC
      PARAMETER (TBTYPC = 12)
C
C     THESE MAY BE READ BY UTPGTI BUT MAY NOT BE SET:
C
C                                       NUMBER OF ROWS WRITTEN TO
      INTEGER   TBNROW
      PARAMETER (TBNROW = 21)
C
C     END IRAF77.INC
        CHARACTER*64 NAME
        CHARACTER*5 GRAT
        INTEGER FWIDTH,NS,CPOS,BINID,ISTAT
        DOUBLE PRECISION DATA(1)
C
C LOCAL PARAMETERS
C
        INTEGER IDIN,NAXIS,DIMEN(7),DTYPE,I1,I2,I,J,J1,J2,HWIDTH,ISTATX
        DOUBLE PRECISION D(2000),SUM
        CHARACTER*130   CONTXT
C
C----------------------------------------------------------------------------
C
C OPEN INPUT FILE
C
        CALL UIMOPN(NAME,RDONLY,IDIN,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error opening input file'
                GO TO 999
        ENDIF
C
C GET SIZE INFO
C
        CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error getting size inforamtion of input file'
                GO TO 999
        ENDIF
C
C CHECK FOR VALID DIMENSIONS
C
        IF(NAXIS.NE.1)THEN
                CONTXT='Input spectral file must be 1-dimensional'
                GO TO 999
        ENDIF
        NS=DIMEN(1)
        IF(NS.GT.2000)THEN
            CONTXT='Only 2000 maximum points allowed in spectral file'
            GO TO 999
        ENDIF
C
C READ DATA
C
        CALL UIGL1D(IDIN,D,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error reading data from input file '//NAME
                GO TO 999
        ENDIF
C
C GET HEADER PARAMETERS
C
        CALL UHDGST(IDIN,'grating',GRAT,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error getting grating from '//NAME
                GO TO 999
        ENDIF
        CALL UHDGSI(IDIN,'binid1',BINID,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error getting binid from '//NAME
                GO TO 999
        ENDIF
        CALL UHDGSI(IDIN,'carpos',CPOS,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='Error getting CARPOS from '//NAME
                GO TO 999
        ENDIF
        CALL UIMCLO(IDIN,ISTAT)
C
C SMOOTH DATA
C
        FWIDTH=(FWIDTH/2)*2+1
        IF((FWIDTH.GT.1).AND.(FWIDTH.LT.NS))THEN
                HWIDTH=FWIDTH/2
                I1=HWIDTH+1
                I2=NS-HWIDTH
C
C LEAVE ENDPOINTS UNCHANGED
C
                DO 10 I=1,HWIDTH
                        DATA(I)=D(I)
                        DATA(NS-I+1)=D(NS-I+1)
10              CONTINUE
C
C LOOP OVER DATA POINTS
C
                DO 20 I=I1,I2
                        SUM=0.0
C
C DETERMINE POINTS TO SUM
C
                        J1=I-HWIDTH
                        J2=I+HWIDTH
C
C LOOP OVER FILTER
C
                        DO 15 J=J1,J2
                                SUM=SUM+D(J)
15                      CONTINUE
                        DATA(I)=SUM/FWIDTH
20              CONTINUE
            ELSE
                DO 30 I=1,NS
                        DATA(I)=D(I)
30              CONTINUE
        ENDIF
        ISTAT=0
        GO TO 1000
999     CALL UMSPUT(CONTXT,STDERR+STDOUT,0,ISTATX)
1000    RETURN
        END