*-----------------------------------------------------------------------
* Fit Misra's dental adsorption data
*-----------------------------------------------------------------------
      PROGRAM DENTAL
       IMPLICIT NONE
       INTEGER N
       PARAMETER (N = 14)
       DOUBLE PRECISION X(N), Y(N), W1(N)
       DOUBLE PRECISION B, C, B1, B2, RELERR, T, TXX, TXY

       INTEGER J, IERR
       DOUBLE PRECISION ZERO, ONE
       PARAMETER (ZERO = 0.D0, ONE = 1.D0)

*-----------------------------------------------------------------------
* NIST/ITL StRD
* Dataset Name:  Misra1a           (Misra1a.dat)
*
* Description:   These data are the result of a NIST study regarding
*                dental research in monomolecular adsorption.  The
*                response variable is volume, and the predictor
*                variable is pressure.
*
* Reference:     Misra, D., NIST (1978).
*                Dental Research Monomolecular Adsorption Study.
*
* Data:          1 Response Variable  (y = volume)
*                1 Predictor Variable (x = pressure)
*                14 Observations
*                Lower Level of Difficulty
*                Observed Data
*
* Model:         Exponential Class
*                2 Parameters (b1 and b2)
*
*                y = b1*(1-exp[-b2*x])  +  e
*
*           Starting values                  Certified Values
*
*         Start 1     Start 2           Parameter     Standard Deviation
*   b1 =   500         250           2.3894212918E+02  2.7070075241E+00
*   b2 =     0.0001      0.0005      5.5015643181E-04  7.2668688436E-06
*
* Residual Sum of Squares:                    1.2455138894E-01
* Residual Standard Deviation:                1.0187876330E-01
* Degrees of Freedom:                                12
* Number of Observations:                            14
*-----------------------------------------------------------------------
       DATA Y( 1), X( 1) /      10.07E0,      77.6E0 /
       DATA Y( 2), X( 2) /      14.73E0,     114.9E0 /
       DATA Y( 3), X( 3) /      17.94E0,     141.1E0 /
       DATA Y( 4), X( 4) /      23.93E0,     190.8E0 /
       DATA Y( 5), X( 5) /      29.61E0,     239.9E0 /
       DATA Y( 6), X( 6) /      35.18E0,     289.0E0 /
       DATA Y( 7), X( 7) /      40.02E0,     332.8E0 /
       DATA Y( 8), X( 8) /      44.82E0,     378.4E0 /
       DATA Y( 9), X( 9) /      50.76E0,     434.8E0 /
       DATA Y(10), X(10) /      55.05E0,     477.3E0 /
       DATA Y(11), X(11) /      61.01E0,     536.8E0 /
       DATA Y(12), X(12) /      66.40E0,     593.1E0 /
       DATA Y(13), X(13) /      75.47E0,     689.1E0 /
       DATA Y(14), X(14) /      81.78E0,     760.0E0 /

       DATA B1, B2 / 2.3894212918E+02, 5.5015643181E-04 /

*-----------------------------------------------------------------------
*             Determine exponent.
*-----------------------------------------------------------------------
       CALL RATEST (X, Y, N, C, W1, IERR)
       PRINT *, 'ratest returns #', IERR, ' found c: ', C

*-----------------------------------------------------------------------
*             Fit model
*                 z = b (1 - e^(-c x))
*-----------------------------------------------------------------------
       TXX = ZERO
       TXY = ZERO
       DO J = 1, N
         T = ONE - EXP(C * X(J))    ! c is returned as a negative number
         TXX = TXX + T * T
         TXY = TXY + T * Y(J)
       END DO
       B = TXY / TXX

       RELERR = (B - B1) / B1
       PRINT *, ' estimated b: ', B, ' certified b: ', B1,
     $            ' relative error: ', RELERR

       RELERR = (C + B2) / B2
       PRINT *, ' estimated c: ', -C, ' certified c: ', B2,
     $            ' relative error: ', RELERR
       PRINT*, 'program complete'
      END  ! of dental