SUBROUTINE VDT
*
*  Module Number: 15.5.2
*
*  Module Name: deadtimev
*
*  Keyphrase:
*  ----------
*  calibrate the digital linearity of detectors (pair pulse correction or
*  dead time).
*
*  Description:
*  ------------
*  determine the dead time(s) by fitting digital measurements with
*  a specified relation between observed and "true" countrates.
*  The fitting is carried out with a non-linear least square algorithm.
*  Simultaneous measurements with analog data are needed and the analog data
*  are assumed to be linear across the observed countrate range.
*
*  Maximum number of input data points is 2000.
*  Input data are in single precision but are double precision during the
*  least square calculation.
*
*  FORTRAN Name: VDT.FOR
*
*  Keywords of Accessed Files and Tables:
*  --------------------------------------
*  Name                         I/O     Description / Comments
*
*  Subroutines Called:
*  -------------------
*  CDBS:
*       VDTGT, VDTINI, VDTLS, VDTPT
*  SDAS:
*       UMSPUT
*  OTHERS:
*       None
*
*  History:
*  --------
*  Version      Date        Author          Description
*     1       11-15-85     J.-C. Hsu        Design and coding
*     2       08-20-87     J.-C. Hsu        F77 standard
*     3       10-25-89     J.-C. Hsu        error propagation
*-------------------------------------------------------------------------------
*
* === local:
*                                       --size of input data arrays
        INTEGER                 SIZE
        PARAMETER               (SIZE = 2000)
*                                       --temperature
        REAL                    TEMP(SIZE),
*                                       --lower and upper limits of temperature
     :                          TMPMIN, TMPMAX,
*                                       --mean temperature
     :                          TMPAVE,
*                                       --tolerance of sigma-square convergence
*                                       --in least square calculation
     :                          TOLERN,
*                                       --fraction of coefficients modification
     :                          FRAC,
*                                       --weighting flag
     :                          WTFLAG(2),
*                                       --attributes
     :                          HIVOLT, DISCR
*                                       --epoch of the observation
        DOUBLE PRECISION        EPOCH(SIZE),
*                                       --lower and upper limit of epoch
     :                          EPMIN, EPMAX,
*                                       --mean epoch
     :                          EPAVE,
*                                       --x and y arrays in double precision
     :                          X(SIZE), Y(SIZE),
*                                       --x and y standard deviation array in double precision
     :                          XERR(SIZE), YERR(SIZE),
*                                       --covariance matrix
     :                          MATRIX(5,5),
*                                       --coefficients of the fitting polynomial
*                                       --and their errors
     :                          COEFF(5), DCOEFF(5),
*                                       --chi-squared of the fit
     :                          CHISQ
*                                       --number of input data points
        INTEGER                 NPTS,
*                                       --dimension of the covariance matrix
     :                          DIM,
*                                       --number of iteration in least square
     :                          ITER,
*                                       --number of variablesand coefficients
     :                          NVAR, NCOEFF,
*                                       --detector ID
     :                          DETID,
*                                       --loop indices
     :                          I,
*                                       --return status
     :                          STATUS, STATOK
        CHARACTER*6             CHAR6
*                                       --output table name
        CHARACTER*128           OFILE
*                                       --error message context
        CHARACTER*130           CONTXT, MESS
*=========================begin hsp.inc=========================================
*                                       --status return code
        INTEGER         OK, ERRNUM(20)
*                                       --message destination and priority
        INTEGER         DEST, PRIO
        DATA OK /0/
        DATA ERRNUM /701, 702, 703, 704, 705, 706, 707, 708, 709, 710,
     :               711, 712, 713, 714, 715, 716, 717, 718, 719, 720/
        DATA DEST, PRIO /1, 0/
*=========================end hsp.inc===========================================
*-------------------------------------------------------------------------------
*
*  (maximum) dimension of covariance matrix
*
        DIM = 5
*
*  read CL parameters and input data
*
        CALL VDTGT (    X, Y, XERR, YERR, TEMP, EPOCH, NPTS,
     :                  WTFLAG, ITER, TOLERN, FRAC,
     :                  HIVOLT, DISCR, DETID, OFILE, STATUS)
        IF (STATUS .NE. OK   .OR.   NPTS .GT. SIZE) THEN
            WRITE (CHAR6, '(I6)') SIZE
            CONTXT = 'cannot get parameters/data or have more than '
     :                // CHAR6 // 'input points'
            GO TO 999
        END IF
*
*  get initial coefficients
*
        CALL VDTINI (X, Y, NPTS,     COEFF, NCOEFF, NVAR, STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'error getting initial coefficients'
            GO TO 999
        END IF
*
*  perform the least square fitting
*
        CALL VDTLS (X, Y, XERR, YERR, NPTS, WTFLAG, FRAC,
     :                  NCOEFF, DIM, NVAR,    COEFF, TOLERN, ITER,
     :                  CHISQ, MATRIX, STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'error in least square fitting'
            GO TO 999
        END IF
*
*  calculate errors of the coefficients
*
        DO 10 I = 1, NCOEFF
            DCOEFF(I) = SQRT(MATRIX(I,I))
   10   CONTINUE
*
*  find the range of temperature and epoch, and calculate their average
*
        TMPAVE = 0.
        EPAVE = 0.D0
        TMPMIN = TEMP(1)
        TMPMAX = TEMP(1)
        EPMIN = EPOCH(1)
        EPMAX = EPOCH(1)
*
        DO 20 I = 1, NPTS
            TMPAVE = TMPAVE + TEMP(I)
            EPAVE = EPAVE + EPOCH(I)
*
            IF (TEMP(I) .LT. TMPMIN) THEN
                TMPMIN = TEMP(I)
            ELSE IF (TEMP(I) .GT. TMPMAX) THEN
                TMPMAX = TEMP(I)
            END IF
*
            IF (EPOCH(I) .LT. EPMIN) THEN
                EPMIN = EPOCH(I)
            ELSE IF (EPOCH(I) .GT. EPMAX) THEN
                EPMAX = EPOCH(I)
            END IF
   20   CONTINUE
*
        TMPAVE = TMPAVE / REAL(NPTS)
        EPAVE = EPAVE / DBLE(NPTS)
*
*  write the result to the output table
*
        CALL VDTPT (OFILE, NPTS, WTFLAG, COEFF, DCOEFF, CHISQ,
     :                  TMPMIN, TMPMAX, TMPAVE, EPMIN, EPMAX, EPAVE,
     :                  ITER, TOLERN, FRAC, HIVOLT, DISCR, DETID,
     :                  STATUS)
        IF (STATUS .NE. OK) THEN
            CONTXT = 'cannot write to output table'
            GO TO 999
        END IF
*
        STATUS = OK
        GO TO 1000
*
*  write error message
*
  999   MESS = 'VDT: ' // CONTXT
        CALL UMSPUT (MESS, DEST, PRIO,     STATOK)
*
 1000   RETURN
        END