!+ Subroutine to fit a single grey term to transmission data.
!
! Method:
!	The subroutine uses Newton-Raphson iteration to set
!	the derivative of the rms error in the fit to 0.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!	Version		Date			Comment
!	1.0		12-04-95		First Version under RCS
!						(J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE EXPONENT_FIT(IERR
     &   , N_DATA, U, TRANS
     &   , N_TERM, K_EXP, W_EXP, TRANS_CALC)
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_pp.ucf'
      INCLUDE 'incl/esft_parameters.acf'
      INCLUDE 'incl/prec_machine.ucf'
      INCLUDE 'incl/precision.pcf'
      INCLUDE 'incl/precision_esft.tcf'
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , N_TERM
!             NUMBER OF TERMS IN FIT
      INTEGER	!, INTENT(OUT)
     &     N_DATA
!             NUMBER OF DATA POINTS
      REAL*8	!, INTENT(IN)
     &     U(NPD_AMOUNT+1)
!             VALUES OF AMOUNT
     &   , TRANS(NPD_AMOUNT+1)
!             TRANSMISSIONS
      REAL*8	!, INTENT(OUT)
     &     K_EXP
!             EXPONENT
     &   , W_EXP
!             WEIGHT OF TERM
     &   , TRANS_CALC(NPD_AMOUNT+1)
!             CALCULATED TRANSMISSIONS
!
!     LOCAL VARIABLES.
      INTEGER
     &     ITERATION
!             NUMBER OF ITERATIONS
     &   , I
!             LOOP VARIABLE
      REAL*8
     &     DERIVATIVE
!             RESIDUAL IN FIT
     &   , DERIVATIVE_2
!             DERIVATIVE OF RESIDUAL
     &   , SHIFT
!             CHANGE IN EXPONENT ON ITERATION
!
!     FUNCTIONS CALLED:
      REAL*8
     &     D_RMS_RESIDUAL
!             FUNCTION TO CALCULATE RESIDUAL
     &   , D2_RMS_RESIDUAL
!             FUNCTION TO CALCULATE DERIVATIVE
      EXTERNAL
     &     D_RMS_RESIDUAL, D2_RMS_RESIDUAL
!
!
!
!     SET THE NUMBER OF TERMS AND WEIGHT AND INITIALIZE K.
      N_TERM=1
      W_EXP=1.0D+00
      K_EXP=0.0D+00
      ITERATION=0
!
!     ITERATE TO IMPROVE VALUE OF K.
1     IF (ITERATION.GT.MAX_SINGLE_ITERATION) THEN
         WRITE(IU_STDOUT, '(/A)') '+++ ITERATION TO FIND EXPONENT '
     &      //'HAS NOT CONVERGED.'
         WRITE(IU_STDOUT, '(A)') 'CURRENT VALUES WILL BE USED.'
!
         WRITE(IU_MONITOR, '(/A)') '+++ ITERATION TO FIND EXPONENT '
     &      //'HAS NOT CONVERGED.'
         WRITE(IU_MONITOR, '(A)') 'CURRENT VALUES WILL BE USED.'
         IERR=I_NORMAL
         GOTO 3
      ENDIF
!
      ITERATION=ITERATION+1
!     AT THE MINIMUM THE SECOND DERIVATIVE OF THE RESIDUAL IS +VE:
!     THIS CAN BE USED AS A TEST TO PREVENT DIVERGENCE TO INFINITY
!     IF A BAD GUESS IS USED.
2     DERIVATIVE_2=D2_RMS_RESIDUAL(N_DATA, U, TRANS, W_EXP, K_EXP)
      IF (DERIVATIVE_2.LE.0.0D+00) THEN
         K_EXP=0.5D+00*K_EXP
         GOTO 2
      ENDIF
      DERIVATIVE=D_RMS_RESIDUAL(N_DATA, U, TRANS, W_EXP, K_EXP)
      SHIFT=DERIVATIVE/DERIVATIVE_2
      IF ( (ABS(DERIVATIVE).GT.TOL_ITERATION_SINGLE).AND.
     &     (ABS((K_EXP+SHIFT)-K_EXP).GT.TOL_MACHINE) ) THEN
         IF (SHIFT.LT.K_EXP) THEN
!           K_EXP IS NOT PERMITTED TO BECOME -VE.
            K_EXP=K_EXP-SHIFT
         ELSE
            K_EXP=0.5D+00*K_EXP
         ENDIF
         GOTO 1
      ENDIF
!
!     CALCULATE THE EXPECTED TRANSMISSIONS.
3     DO I=1, N_DATA
         TRANS_CALC(I)=W_EXP*EXP(-K_EXP*U(I))
      ENDDO
!
      WRITE(IU_MONITOR, '(/A/)')
     &   'THE GREY FIT OBTAINED IS:'
      WRITE(IU_MONITOR, '(3X, A6, 13X, A10, 9X, A6)')
     &   'AMOUNT', 'CALCULATED', 'ACTUAL'
      DO I=1, N_DATA
         WRITE(IU_MONITOR, '(3(3X,1PE16.9))')
     &      U(I), TRANS_CALC(I), TRANS(I)
      ENDDO
      WRITE(IU_MONITOR, '(/A, 1PE16.9, /)')
     &   'ABSOPTION COEFFICIENT = ', K_EXP

!
!
      RETURN
      END
