Quelle  golden.cob

       identification division.
       program-id. golden.
      *  aus D.Nowottny p. 95
      * Mathematik am Computer
       author. "JD".
       date-written. 24.9.2006.
       date-compiled.
       data division.
       working-storage section.
         77 delta   pic 9(4)V9(8).
         77 as      pic 9(4)V9(8).
         77 bs      pic 9(4)V9(8).
         77 bss     pic 9(4)V9(8).
         77 fa      pic 9(4)V9(8).
         77 fb      pic 9(4)V9(8).
         77 fas     pic 9(4)V9(8).
         77 fbs     pic 9(4)V9(8).
         77 r       pic 9(4)V9(8).
       linkage section.
         77 a       pic 9(4)V9(8).
         77 b       pic 9(4)V9(8).
         77 f       pic x(8).
         77 x       pic 9(4)V9(8).
       procedure division using f a b x.
      *  Suche einen lokalen Minimums in [a,b]
         compute delta  = 1e-8
         compute r      = (function sqrt(5)-1)/2
         compute as     = a+(1-r)*(b-a)
         compute bs     = a+r*(b-a)
         compute fa     = function f(a)
         compute fb     = function f(b)
         compute fas    = function f(as)
         compute fbs    = function f(bs)
         perform until b-a<=delta
           if fas<=fbs then
             move bs  to b
             move fbs to fb
             move as  to bs
             move fas to fbs
             compute as  = a+(1-r)*(b-a)
             compute fas = function f(as)
           else
             move as  to a
             move fas to fa
             move bs  to as
             move fbs to fas
             compute bs  = a+r*(b-a)
             compute fas = function f(bss)
           end-if
         end-perform
         compute x = (a+b)/2
      *  (ein) Minimum ist in x
        end-program golden.