view libcruft/fsqp/small.f @ 2329:30c606bec7a8

[project @ 1996-07-19 01:29:05 by jwe] Initial revision
author jwe
date Fri, 19 Jul 1996 01:29:55 +0000
parents
children
line wrap: on
line source

c
      double precision function small()
c     implicit real*8(a-h,o-z)
      double precision one, two, z
c
      one=1.d0
      two=2.d0
      small=one
10    small=small/two
      call fool(small,one,z)
      if(z.gt.one) goto 10
      small=small*two*two
c
c The simpler sequence commented out below fails on some machines that use
c extra-length registers for internal computation.  This was pointed out
c to us by Roque Donizete de Oliveira (Michigan) who suggested to sequence
c used now.
c
c     small=1.d0
c100  if ((small+1.d0).eq.1.d0) goto 110
c     small=small/2.d0
c     goto 100
c110  small=small*4.d0
      return
      end