home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1999 mARCH / PCWK3A99.iso / Linux / DDD331 / DDD-3_1_.000 / DDD-3_1_ / ddd-3.1.1 / ddd / ftest.f < prev    next >
Text File  |  1998-01-12  |  2KB  |  79 lines
  1. CCC g77 0.5.21 `Actual Bugs':
  2. CCC   * A code-generation bug afflicts Intel x86 targets when `-O2' is
  3. CCC     specified compiling, for example, an old version of the `DNRM2'
  4. CCC     routine.  The x87 coprocessor stack is being somewhat mismanaged
  5. CCC     in cases where assigned `GOTO' and `ASSIGN' are involved.
  6. CCC
  7. CCC     Version 0.5.21 of `g77' contains an initial effort to fix the
  8. CCC     problem, but this effort is incomplete, and a more complete fix is
  9. CCC     planned for the next release.
  10.  
  11. C     Currently this test fails with (at least) `-O2 -funroll-loops' on
  12. C     i586-unknown-linux-gnulibc1.
  13.  
  14. C     (This is actually an obsolete version of dnrm2 -- consult the
  15. c     current Netlib BLAS.)
  16.  
  17.       integer i, j
  18.       double precision a(1:100)
  19.       double precision b(0:9, 2:4)
  20.       do i=1,100
  21.          a(i)=0.D0
  22.       enddo
  23.       do i=0,9
  24.          do j=2,4
  25.             b(i,j)=0.D0
  26.          enddo
  27.       enddo
  28.       if (dnrm2(100,a,1) .ne. 0.0) call exit(1)
  29.       end
  30.  
  31.       double precision function dnrm2 ( n, dx, incx)
  32.       integer i, incx, ix, j, n, next
  33.       double precision   dx(1), cutlo, cuthi, hitest, sum, xmax,zero,one
  34.       data   zero, one /0.0d0, 1.0d0/
  35.       if(n .gt. 0 .and. incx.gt.0) go to 10
  36.          dnrm2  = zero
  37.          go to 300
  38.    10 assign 30 to next
  39.       sum = zero
  40.       i = 1
  41.       ix = 1
  42.    20    go to next,(30, 50, 70, 110)
  43.    30 if( dabs(dx(i)) .gt. cutlo) go to 85
  44.       assign 50 to next
  45.       xmax = zero
  46.    50 if( dx(i) .eq. zero) go to 200
  47.       if( dabs(dx(i)) .gt. cutlo) go to 85
  48.       assign 70 to next
  49.       go to 105
  50.   100 continue
  51.       ix = j
  52.       assign 110 to next
  53.       sum = (sum / dx(i)) / dx(i)
  54.   105 xmax = dabs(dx(i))
  55.       go to 115
  56.    70 if( dabs(dx(i)) .gt. cutlo ) go to 75
  57.   110 if( dabs(dx(i)) .le. xmax ) go to 115
  58.          sum = one + sum * (xmax / dx(i))**2
  59.          xmax = dabs(dx(i))
  60.          go to 200
  61.   115 sum = sum + (dx(i)/xmax)**2
  62.       go to 200
  63.    75 sum = (sum * xmax) * xmax
  64.    85 hitest = cuthi/float( n )
  65.       do 95 j = ix,n
  66.       if(dabs(dx(i)) .ge. hitest) go to 100
  67.          sum = sum + dx(i)**2
  68.          i = i + incx
  69.    95 continue
  70.       dnrm2 = dsqrt( sum )
  71.       go to 300
  72.   200 continue
  73.       ix = ix + 1
  74.       i = i + incx
  75.       if( ix .le. n ) go to 20
  76.       dnrm2 = xmax * dsqrt(sum)
  77.   300 continue
  78.       end
  79.