SUBROUTINE YDCPRT(NWAVE,SAMP,WAVE,WFIT,WSIG,DIFF,ORDER,A)
*
*  Module number: 14.8.2.5
*
*  Module name: YDCPRT
*
*  Keyphrase:
*  ----------
*       Print results of least squares fit
*  Description:
*  ------------
*       This routine prints the results of the least squares fit
*       to the dispersion coefficients.  A table of residuals
*       of the fit is printed, where the residual is given in diode
*       units.
*
*  FORTRAN name: ydcprt
*
*  Keywords of accessed files and tables:
*  --------------------------------------
*       none
*  Subroutines Called:
*  -------------------
*  SDAS:
*       umsput
*
*  History:
*  --------
*  Version      Date        Author          Description
*       1       Jan 88  D. Lindler      Designed and coded
*-------------------------------------------------------------------------------
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)
      INTEGER USRLOG
      PARAMETER (USRLOG = 4)
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
C
C PARAMETERS (ALL INPUT)
C
        INTEGER NWAVE
C                                    ---> number of wavelengths
        DOUBLE PRECISION SAMP(NWAVE)
C                                    ---> sample positions
        DOUBLE PRECISION WAVE(NWAVE)
C                                    ---> reference wavelengths
        DOUBLE PRECISION WFIT(NWAVE)
C                                    ---> fitted wavelengths
        DOUBLE PRECISION WSIG
C                                    ---> sigma of differences
        DOUBLE PRECISION DIFF(1)
C                                    ---> residuals of fit (diodes)
        INTEGER ORDER
C                                    ---> order of fiT
        DOUBLE PRECISION A(1)
C                                    ---> coefficients of fit
C
C LOCAL VARIABLES
C
        INTEGER I
        CHARACTER*1 BAD,BLANK,FLAG
C                                    ---> index
C                                    ---> flag for bad line to be deleted
C                                    ---> flag for good line
        CHARACTER*130   MESS
        INTEGER STATUS
C
C  DATA DECLARATIONS
C
        DATA     BAD/'*'/
        DATA     BLANK/' '/
C
C WRITE HEADINGS
C
        WRITE(MESS,199)
199     FORMAT(' -------Results of least squares fit')
        CALL UMSPUT(MESS,STDOUT,0,STATUS)
        CALL UMSPUT(' ',STDOUT,0,STATUS)
        WRITE(MESS,299)
299     FORMAT('        Reference      Fitted       Residual (diodes)')
        CALL UMSPUT(MESS,STDOUT,0,STATUS)
        WRITE(MESS,399)
399     FORMAT('       wavelength    wavelength')
        CALL UMSPUT(MESS,STDOUT,0,STATUS)
C
C LOOP ON SPECTRAL LINES
C
        DO 10 I=1,NWAVE
                FLAG=BLANK
                IF(SAMP(I).EQ.0.0) FLAG=BAD
                WRITE(MESS,499)WAVE(I),WFIT(I),DIFF(I),FLAG
499             FORMAT(3F15.4,1X,A1)
                CALL UMSPUT(MESS,STDOUT,0,STATUS)
10      CONTINUE
C
C WRITE OTHER INFO
C
        CALL UMSPUT(' ',STDOUT,0,STATUS)
        WRITE(MESS,599)
599     FORMAT(' Coefficients of fit')
        CALL UMSPUT(MESS,STDOUT,0,STATUS)
        DO 600 I=1,6
                WRITE(MESS,699)A(I)
699             FORMAT(D20.10)
                CALL UMSPUT(MESS,STDOUT,0,STATUS)
600     CONTINUE
        WRITE(MESS,799)WSIG
799     FORMAT(' RMS of residuals (diodes)',F9.3)
        CALL UMSPUT(MESS,STDOUT,0,STATUS)
        RETURN
        END