Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #24432

Re: Fortran proves Forth a stone-age toy

Show all headers | View raw

WJ wrote:

> 
> This version sometimes runs in 0.187500000 seconds.
> 

Final version.


! GFortran (gcc version 4.8.0 20130302)
! Compile with
! gfortran -O3 -march=native fannkuch.f95

program fannkuch
  implicit none
  integer, parameter :: N = 10
  integer :: perm(N), permp(N), counts(N), tmp, i
  integer :: maxflips = 0, prn_count = 0, r = N
  real :: t1, t2

  call cpu_time( t1 )

  ! --- Initialize 2 vectors.
  counts = 0
  permp = (/  (i, i=1,N)  /)

  do
    if (prn_count < 30) then
      call inc( prn_count, 1 )
      call print_vector( permp )
    end if
    do i = 2, r
      counts(i) = i
    end do
    r = 1
    if ( permp(1) /= 1  .and.  permp(N) /= N  ) then
      perm = permp
      maxflips = max( maxflips, flipping( perm ) )
    end if
    do
      if (N == r) then
        print "('Pfannkuchen(', I0, ') = ', I0)", N, maxflips
        call cpu_time( t2 )
        print *, t2 - t1
        stop
      end if
      i = r + 1

      ! ---  Shift left.
      tmp = permp(1)
      permp(1:i-1) = permp(2:i)
      permp(i) = tmp

      call inc( counts(i), -1 )
      if (counts(i) > 0)  exit
      call inc(r, 1)
    end do
  end do

  contains

  integer function flipping( perm )
    implicit none
    integer, intent(inout) :: perm(N)
    integer :: k, tmp, flips
    flips = 0
    k = perm(1)
    do while (k > 1)
      ! --- Reverse part.
      if (k > 3) call reverse_some( perm, k - 1 )
      call inc(flips, 1)
      tmp = perm(k)
      perm(k) = k
      k = tmp
    end do
    flipping = flips
  end function

  subroutine print_vector( v )
    integer :: v(N)
    write (*, "(99I0)"), v
  end subroutine

  subroutine reverse_some( vector, top )
    implicit none
    integer, intent(inout) :: vector(N)
    integer, intent(in) :: top
    integer :: i, j, tmp
    i = 2
    j = top
    do while (i < j)
      tmp = vector( i )
      vector( i ) = vector( j )
      vector( j ) = tmp
      call inc(j, -1)
      call inc(i, 1)
    end do
  end subroutine

  subroutine inc( n, i )
    integer, intent(inout) :: n
    integer, intent(in) :: i
    n = n + i
  end subroutine


end program

Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar

Thread

Fortran proves Forth a stone-age toy "WJ" <w_a_x_man@yahoo.com> - 2013-07-09 07:14 +0000
  Re: Fortran proves Forth a stone-age toy m.a.m.hendrix@tue.nl - 2013-07-09 01:03 -0700
  Re: Fortran proves Forth a stone-age toy "Ed" <invalid@invalid.com> - 2013-07-09 19:32 +1000
  Re: Fortran proves Forth a stone-age toy "WJ" <w_a_x_man@yahoo.com> - 2013-07-09 22:26 +0000
    Re: Fortran proves Forth a stone-age toy "WJ" <w_a_x_man@yahoo.com> - 2013-07-11 00:01 +0000
      Re: Fortran proves Forth a stone-age toy "WJ" <w_a_x_man@yahoo.com> - 2013-07-12 12:10 +0000
  Re: Fortran proves Forth a stone-age toy hughaguilar96@yahoo.com - 2013-07-10 11:10 -0700
    Re: Fortran proves Forth a stone-age toy "Rod Pemberton" <do_not_have@notemailnotq.cpm> - 2013-07-12 03:14 -0400
      Re: Fortran proves Forth a stone-age toy Richard Owlett <rowlett@pcnetinc.com> - 2013-07-12 05:14 -0500

csiph-web