Mercurial > octave
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