!+ Subroutine to remove terms with negative weights from an ESFT fit.
!
! Method:
!	Each term of the fit is examined to see if its weight is 
!	negative. Terms with negative weights are removed. If there
!	are such terms a flag is set to rederive the fit.
!
! 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 REMOVE_NEGATIVE(N_DATA, N_TERM
     &   , A, K, A_OLD
     &   , L_RESOLVE
     &   , ITERATION
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_pp.ucf'
!
!     DUMMY ARGUMENTS
      INTEGER 	!, INTENT(IN)
     &     N_TERM                           
!             NUMBER OF TERMS
     &   , N_DATA                           
!             NUMBER OF DATA POINTS
     &   , ITERATION                        
!             NUMBER OF ITERATION
      LOGICAL 	!, INTENT(OUT)
     &     L_RESOLVE                        
!             FLAG TO RESOLVE EQUATIONS
       REAL*8	!, INTENT(INOUT)
     &     A(NPD_ESFT_TERM)                   
!             ESFT WEIGHTS
     &   , K(NPD_ESFT_TERM)                   
!             ESFT EXPONENTS
       REAL*8	!, INTENT(IN)
     &     A_OLD(NPD_ESFT_TERM)               
!             OLD ESFT WEIGHTS
!
!     LOCAL VARIABLES.
      INTEGER
     &     I                                
!             LOOP VARIABLE
     &   , NNEW                             
!             NUMBER OF NEW TERMS
     &   , I_REMOVE                         
!             INDEX FOR REMOVAL
      REAL*8
     &     ANEW(NPD_ESFT_TERM)                
!             NEW ESFT WEIGHTS
     &   , KNEW(NPD_ESFT_TERM)                
!             NEW ESFT EXPONENTS
     &   , BETA                             
!             FRACTIONAL CHANGE TO BE MADE
     &   , BETA_TEMP                        
!             TEMPORARY VALUE OF ABOVE
!
!
!     L_RESOLVE IS INITIAILIZED AS .FALSE., BUT IS RESET TO .TRUE.
!     IF A NEGATIVE VALUE OF A IS ENCOUNTERED.
      L_RESOLVE=.FALSE.
!
!     IF ITERATION=1 THERE IS NO PREVIOUS SET OF A'S.
      IF (ITERATION.EQ.1) THEN
!        PASS THROUGH THE TERMS OF THE FIT, REMOVING ANY WHICH ARE LESS
!        THAN 0.
         NNEW=0
         DO I=1, N_TERM
            IF (A(I).GT.0.0D+00) THEN
               NNEW=NNEW+1
               ANEW(NNEW)=A(I)
               KNEW(NNEW)=K(I)
            ELSE
               L_RESOLVE=.TRUE.
            ENDIF
         ENDDO
!
!        REWRITE THE OLD ARRAY A WITH THE NEW VALUES.
         N_TERM=NNEW
         DO I=1,NNEW
            A(I)=ANEW(I)
            K(I)=KNEW(I)
         ENDDO
!
      ELSE
!        MOVE DOWN FROM THE OLD VALUE AS FAR AS POSSIBLE ELIMINATING
!        AT MOST ONE TERM.
         BETA=1.0D+00
         DO I=1, N_TERM
            IF (A(I).LT.0.0D+00) THEN
               L_RESOLVE=.TRUE.
               BETA_TEMP=A_OLD(I)/(A_OLD(I)-A(I))
               IF (BETA_TEMP.LT.BETA) THEN
                  BETA=BETA_TEMP
                  I_REMOVE=I
               ENDIF
            ENDIF
         ENDDO
!
         IF (L_RESOLVE) THEN
!           REMOVE I_REMOVE.
            N_TERM=N_TERM-1
            DO I=1, I_REMOVE-1
               A(I)=BETA*A(I)+(1.0D+00-BETA)*A_OLD(I)
            ENDDO
            DO I=I_REMOVE+1, N_TERM+1
               A(I-1)=BETA*A(I)+(1.0D+00-BETA)*A_OLD(I)
               A_OLD(I-1)=A_OLD(I)
               K(I-1)=K(I)
            ENDDO
         ENDIF
!
      ENDIF
!
!
      RETURN
      END
