SUBROUTINE ZPPF1(Y,X,N,NITER,TAU,STATUS)
*
* Module Number: 13.6.1
*
* Module Name: ZPPF1
*
* Keyphrase:
* ----------
*       Compute HRS paired pulse coefficients
*
* Description:
* ------------
*       The paired pulse equation is given by:
*
*               y = (1-exp(-tx)/t
*       where
*               x is the true count rate
*               y is the observed count rate
*               t is a time coef.
*
*       This routine computes the value of t using the
*       Levenberg-Marquardt non-linear least squares method
*       from NUMERCIAL RECIPES.
*
*
* Fortran Name: ZPPF1
*
* Keywords of accessed files and tables:
* --------------------------------------
*       NONE
*
*
* Subroutines Called:
* -------------------
* CDBS:
*       MRQMIN
* SDAS:
*       umsput
*
* History:
* --------
* version         date            Author          Description
*    1          4/20/87         D. Lindler      Designed and coded
*    2          JAN 88          D. Lindler      New SDAS I/O and standards
*    3          SEPT 88         D. Lindler      New formula
*-------------------------------------------------------------------------
*
* Input parameters
*
*       Y       - vector of observed count rates (real*8)
*       X       - vector of expected count rates (real*8)
*       N       - number of points in X and Y   (integer)
*       NITER   - number of least squares iterations
*
* Input/Output parameters
*
*       TAU     - time constant (on input is is the initial guess) Real*8
*
* Output parameters
*
*       STATUS  - error status (integer)
*
C
C     UMSPUT DESTINATIONS -- CB, DAO, 4-SEP-87
C
      INTEGER STDOUT
      PARAMETER (STDOUT = 1)
      INTEGER STDERR
      PARAMETER (STDERR = 2)
C
C     END IRAF77.INC
        DOUBLE PRECISION X(1),Y(1),TAU
        INTEGER N,NITER
        INTEGER STATUS
C
C LOCAL VARIABLES
C
        DOUBLE PRECISION SIGMAS(50000),COVAR,ALPHA,CHISQ,ALAMDA
        INTEGER I,ISTAT
        CHARACTER*130   CONTXT
        EXTERNAL ZDTFNC
C
C------------------------------------------------------------------------
C
C INITIALIZE LEAST SQUARES ROUTINE
C
        DO 10 I=1,N
10              SIGMAS(I)=1.0
        CONTXT='Error in non-linear least squares fit'
        ALAMDA=-1.0
        CALL MRQMIN(X,Y,SIGMAS,N,TAU,1,1,1,COVAR,ALPHA,1,CHISQ,
     *          ZDTFNC,ALAMDA,ISTAT)
        IF(ISTAT.NE.0)GO TO 999
C
C ITERATE NITER TIMES
C
        DO 20 I=1,NITER
           CALL MRQMIN(X,Y,SIGMAS,N,TAU,1,1,1,COVAR,ALPHA,1,CHISQ,
     *          ZDTFNC,ALAMDA,ISTAT)
           IF(ISTAT.NE.0)GO TO 999
20      CONTINUE
C
C CLEAN UP
C
        ALAMDA=0.0
        CALL MRQMIN(X,Y,SIGMAS,N,TAU,1,1,1,COVAR,ALPHA,1,CHISQ,
     *          ZDTFNC,ALAMDA,ISTAT)
        IF(ISTAT.NE.0)GO TO 999
C
C DONE
C
        STATUS=0
        GO TO 1000
999     STATUS=1
        CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT)
1000    RETURN
        END