!+ Subroutine to calculate gradient of residuals in transmission.
!
! Method:
!	Straightforward.
!
! 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 RESIDUAL_GRADIENT(N_SET, LENGTH_SET
     &   , U_SET, TRANS_SET, WEIGHT_POINT
     &   , I_TYPE_RESIDUAL, SCALING
     &   , N_TERM, W_ESFT, K_ESFT
     &   , I_SCALE_FUNCTION, SCALE_VECTOR, P_ARRAY, T_ARRAY
     &   , GRADIENT)
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_pp.ucf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/offset_residual_trans.acf'
      INCLUDE 'incl/type_residual.pcf'
      INCLUDE 'incl/scale_fnc.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(IN)
     &     N_SET
!             NUMBER OF SETS
     &   , N_TERM
!             NUMBER OF TERMS OF FIT
     &   , LENGTH_SET(NPD_SET_SCALE)
!             LENGTHS OF SETS
     &   , I_SCALE_FUNCTION
!             TYPE OF SCALING FUNCTION
     &   , I_TYPE_RESIDUAL
!             TYPE OF RESIDUAL USED
      REAL*8	!, INTENT(OUT)
     &     GRADIENT(NPD_SCALE_VARIABLE)
!             GRADIENT OF RESIDUAL
      REAL*8	!, INTENT(IN)
     &     U_SET(NPD_AMOUNT, NPD_SET_SCALE)
!             AMOUNTS OF ABSORBERS
     &   , TRANS_SET(NPD_AMOUNT, NPD_SET_SCALE)
!             TRANSMISSIVITIES
     &   , SCALING(NPD_AMOUNT, NPD_SET_SCALE)
!             SCALINGS REQUIRED
     &   , WEIGHT_POINT(NPD_SET_SCALE, NPD_AMOUNT)
!             WEIGHTS FOR TRANSMISSIVITIES
     &   , W_ESFT(NPD_ESFT_TERM)
!             ESFT WIEGHTS
     &   , K_ESFT(NPD_ESFT_TERM)
!             ESFT EXPONENTS
     &   , SCALE_VECTOR(NPD_SCALE_VARIABLE)
!             PARAMETERS FOR SCALING
     &   , P_ARRAY(NPD_SET_SCALE)
!             PRESSURE ARRAY
     &   , T_ARRAY(NPD_SET_SCALE)
!             TEMPERATURE ARRAY
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
      REAL*8
     &     TRANS_FIT
!             FITTED TRANSMITTANCE
     &   , D_RESIDUAL_BY_D_SCALE(NPD_SET_SCALE)
!             DERIVATIVE OF RESIDUAL WRT SCALE
     &   , SUB_TERM
!             SUB-TERM OF TRANSMITTANCE
     &   , DERIVATIVE_TERM
!             TERM ENTERING DERIVATIVE
     &   , SS
!             TEMPORARY VARIABLE
!
!     FUNCTIONS CALLED:
      REAL*8
     &     FUNC_SCALE
!             SCALING FUNCTION
     &   , FUNC_SCALE_DERIVATIVE
!             DERIVATIVE OF SCALING FUNCTION
      EXTERNAL
     &     FUNC_SCALE, FUNC_SCALE_DERIVATIVE
!
!
      INCLUDE 'incl/scale_fnc.dcf'
!
!
!
      IF (I_TYPE_RESIDUAL.EQ.IP_SCALE_TRANS_RESIDUAL) THEN
         DO I=1, N_SET
            D_RESIDUAL_BY_D_SCALE(I)=0.0D+00
            DO J=1, LENGTH_SET(I)
               DERIVATIVE_TERM=0.0D+00
               TRANS_FIT=0.0D+00
               DO K=1, N_TERM
                  SUB_TERM=W_ESFT(K)*EXP(-K_ESFT(K)*U_SET(J, I)
     &               *FUNC_SCALE(P_ARRAY(I), T_ARRAY(I)
     &               , I_SCALE_FUNCTION, SCALE_VECTOR))
                  TRANS_FIT=TRANS_FIT+SUB_TERM
                  DERIVATIVE_TERM=DERIVATIVE_TERM
     &               -K_ESFT(K)*U_SET(J, I)*SUB_TERM
               ENDDO
               D_RESIDUAL_BY_D_SCALE(I)=D_RESIDUAL_BY_D_SCALE(I)
     &            -2.0D+00*WEIGHT_POINT(I, J)
     &            *(TRANS_SET(J, I)-TRANS_FIT)*DERIVATIVE_TERM
            ENDDO
         ENDDO
      ELSE IF (I_TYPE_RESIDUAL.EQ.IP_SCALE_FULL_SCL_RES) THEN
         DO I=1, N_SET
            D_RESIDUAL_BY_D_SCALE(I)=0.0D+00
            DO J=1, LENGTH_SET(I)
               SS=FUNC_SCALE(P_ARRAY(I), T_ARRAY(I)
     &            , I_SCALE_FUNCTION, SCALE_VECTOR)
               D_RESIDUAL_BY_D_SCALE(I)=D_RESIDUAL_BY_D_SCALE(I)
     &            +2.0D+00*WEIGHT_POINT(I, J)*(LOG((OFFSET_RESIDUAL
     &            +SS)/(OFFSET_RESIDUAL+SCALING(J, I))))*(1.0D+00
     &            /(1.0D+00+SS))
            ENDDO
         ENDDO
      ELSE IF (I_TYPE_RESIDUAL.EQ.IP_SCALE_MEAN_SCL_RES) THEN
         DO I=1, N_SET
            SS=FUNC_SCALE(P_ARRAY(I), T_ARRAY(I)
     &         , I_SCALE_FUNCTION, SCALE_VECTOR)
            D_RESIDUAL_BY_D_SCALE(I)
     &         =2.0D+00*(((OFFSET_RESIDUAL+SS)
     &         /(OFFSET_RESIDUAL+SCALING(1, I)))-1.0D+00)
     &         *(1.0D+00/(1.0D+00+SCALING(1, I)))
     &         +2.0D+00*(SS-SCALING(1, I))
         ENDDO
      ENDIF
!
!     FIND THE GRADIENT FOR THE PRESSURE AND TEMPERATURE.
      DO I=1, N_SCALE_VARIABLE(I_SCALE_FUNCTION)
         GRADIENT(I)=0.0D+00
         DO J=1, N_SET
            GRADIENT(I)=GRADIENT(I)+D_RESIDUAL_BY_D_SCALE(J)
     &         *FUNC_SCALE_DERIVATIVE(I, P_ARRAY(J), T_ARRAY(J)
     &         , I_SCALE_FUNCTION, SCALE_VECTOR)
         ENDDO
      ENDDO
!
!
      RETURN
      END
