saddle-FF-adifor.f

      subroutine gradient_outer(x, g)
      include 'saddle-FF-adifor.inc'
      double precision x(nouter), g(nouter), g_x(nouter, nouter), y
      integer k, l
      do k = 1, nouter
         do l = 1, nouter
            g_x(k, l) = 0d0
         enddo
         g_x(k, k) = 1d0
      enddo
      call h_outer(x, g_x, y, g)
      end

      program main
      include 'saddle-FF-adifor.inc'
      double precision x1_start(nouter), x2_start(ninner)
      double precision x1_star(nouter), x2_star(ninner), r
      double precision x1c(nouter), g_x1c(ninner, nouter)
      common /closure/ x1c
      common /g_closure/ g_x1c
      integer i, k
      external outer, gradient_outer, inner, gradient_inner
      do i = 1, 1000
         x1_start(1) = 1d0
         x1_start(2) = 1d0
         x2_start(1) = 1d0
         x2_start(2) = 1d0
         call multivariate_argmin
     +        (nouter, outer, gradient_outer, x1_start, x1_star, r)
         x1c(1) = x1_star(1)
         x1c(2) = x1_star(2)
         do k = 1, ninner
            g_x1c(k, 1) = 0d0
            g_x1c(k, 2) = 0d0
         enddo
         call multivariate_argmin
     +        (ninner, inner, gradient_inner, x2_start, x2_star, r)
         print *, x1_star(1), x1_star(2), x2_star(1), x2_star(2)
      enddo
      end

Generated by GNU enscript 1.6.4.