      subroutine dogleg(n,f,J,D,delta,redssq,p))
      double precision delta,redssq
c     **********
c
c     Subroutine dogleg
c
c     This subroutine computes an approximate solution to the problem
c
c          min { || f+J*w|| : ||D*w|| <= delta }
c
c     The subroutine returns the solution p and the reduction redssq
c     in the sum of squares.
c
c     **********

c     Compute an approximate solution s of Jw = -f

      call solve(f,J,s)

c     Test whether the truncated Newton direction is acceptable.

      qnorm = dnrm2(n,D*s)
      if (qnorm <= delta) return

c     The truncated Newton direction is not acceptable.
c     Next, calculate the scaled gradient direction.

      g = J'*f
      do j = 1, n
         w1(j) = g(j)/D(j)
      end

c     Calculate the norm of the scaled gradient and test for
c     the special case in which the scaled gradient is zero.

      fnorm = dnrm2(n,f)
      gnorm = dnrm2(n,w1)
      sgnorm = zero
      alpha = delta/qnorm
      if (gnorm != zero) then

c        Calculate the point along the scaled gradient
c        at which the quadratic is minimized.

         do j = 1, n
            w1(j) = (w1(j)/gnorm)/D(j)
         end
         w2 = J*w1
         Jgnorm = dnrm2(n,w2)
         sgnorm = (gnorm/Jgnorm)/Jgnorm

c        Test whether the scaled gradient direction is acceptable.

         alpha = zero
         if (sgnorm <= delta) then

c           The scaled gradient direction is not acceptable.
c           Finally, calculate the point along the dogleg
c           at which the quadratic is minimized.

            temp = (fnorm/gnorm)*(fnorm/qnorm)*(sgnorm/delta)
            temp = temp - (delta/qnorm)*(sgnorm/delta)**2
     *           + sqrt((temp-(delta/qnorm))**2+
     *                  (one-(delta/qnorm)**2)*(one-(sgnorm/delta)**2))
            alpha = ((delta/qnorm)*(one - (sgnorm/delta)**2))/temp
            end if
         end if

c     Form appropriate convex combination of the truncated Newton
c     direction and the scaled gradient direction.

      temp = (one - alpha)*min(sgnorm,delta)
      do j = 1, n
         p(j) = temp*w1(j) + alpha*s(j)
      end

c     Compute the scaled reduction in the sum of squares.

      redssq = (one - (one - alpha)**2) +
     *         (one - alpha)**2*(((sgnorm*gnorm)/fnorm)/fnorm)
      return

c     Last card of subroutine dogleg.

      end
