>> I still don't know what you mean with the word 'interp'.
Again, I thought that you were spearheading interop, so I thought a C
question would be right up your alley.
This thread is to get this program that I've been kicking around able to
deal with larger numbers. While the routines I call are sorts, my
difficulties are getting the types to match on these calls.
What I have compiles but results in a run-time that makes no sense to me:
! timing sorts
module sort3
implicit none
integer, parameter :: i13 = selected_int_kind(13)
private
public :: selection_sort
! type definition includes only an integer
type, public :: address
integer(i13) :: zip_code
end type address
contains
recursive subroutine selection_sort (array_arg)
integer, parameter :: i13 = selected_int_kind(13)
type (address), dimension(:), intent (inout) &
:: array_arg
integer(i13) :: current_size
integer(i13) :: big
current_size = size (array_arg)
if (current_size > 0) then
big = maxloc(array_arg(:)%%zip_code, dim=1)
call swap (big, current_size)
call selection_sort (array_arg(1: current_size -1))
end if
contains
subroutine swap(i,j)
integer, parameter :: i13 = selected_int_kind(13)
integer(i13), intent (in) :: i,j
type (address) :: temp
temp = array_arg(i)
array_arg(i) = array_arg(j)
array_arg(j) = temp
end subroutine swap
end subroutine selection_sort
end module sort3
! Recursive Fortran 95 quicksort routine
! sorts integer numbers into ascending numerical order
! Author: Juli Rew, SCD Consulting (juliana@
ucar.edu), 9/03
! Based on algorithm from Cormen et al., Introduction to Algorithms,
! 1997 printing
! Made F conformant by Walt Brainerd
module qsort_c_module
implicit none
public :: QsortC
private :: Partition
contains
recursive subroutine QsortC(A)
integer, parameter :: i13 = selected_int_kind(13)
integer(i13), intent(in out), dimension(:) :: A
integer (i13):: iq
if(size(A) > 1) then
call Partition(A, iq)
call QsortC(A(:iq-1))
call QsortC(A(iq:))
endif
end subroutine QsortC
subroutine Partition(A, marker)
integer, parameter :: i13 = selected_int_kind(13)
integer(i13), intent(in out), dimension(:) :: A
integer(i13), intent(out) :: marker
integer(i13) :: i, j
integer(i13) :: temp
integer(i13) :: x ! pivot point
x = A(1)
i= 0
j= size(A) + 1
do
j = j-1
do
if (A(j) <= x) exit
j = j-1
end do
i = i+1
do
if (A(i) >= x) exit
i = i+1
end do
if (i < j) then
! exchange A(i) and A(j)
temp = A(i)
A(i) = A(j)
A(j) = temp
elseif (i == j) then
marker = i+1
return
else
marker = i
return
endif
end do
end subroutine Partition
end module qsort_c_module
use qsort_c_module
use sort3
implicit none
integer, parameter :: i13 = selected_int_kind(13)
integer, parameter:: sides = 8
integer(i13), parameter:: trials = 3000000
integer(i13), parameter :: array_size = trials
integer, parameter:: bins = 50
integer, parameter:: percentile = 95
integer, dimension(sides)::A
integer(i13), dimension(trials)::C
integer, dimension(bins)::D
!! from qsort
integer(i13), dimension(trials)::F
type (address), dimension (array_size) :: data_array
integer:: b, ii, i, counter, &
tab, maxput, c1, c2, diff2, c3, c4
real:: harvest, tot, t1, t2, diff, t3, t4
! seed random num generator
CALL init_random_seed
! prime the pump
call random_number(harvest)
b = 3 + nint(10*harvest)
do i=1,b
call random_number(harvest)
print *, i, harvest
end do
! main control
! outer loop is the number of trials
C = 0
do ii=1,trials
tab = 0
A = 0
! inner loop rolls die till all values attained
do
call random_number(harvest)
b = ceiling(harvest*real(sides))
A(b) = A(b) + 1 !this is line 158
! count until all outcomes non-zero
counter = 0
do i = 1, sides
if (real(A(i)) > .5) then
counter = counter + 1
end if
end do
tab = tab + 1
if (counter == sides) then
C(ii) = tab
exit
end if
end do !inner
end do !outer
! end main control
! print *, "C is", C
! sort into bins
D=0
maxput = bins
do ii =1, trials
if (C(ii) > maxput) then
C(ii) = maxput
end if
D(C(ii))=D(C(ii)) + 1
end do
tot= sum(D)
print *, "total trials=",tot
! determine 95th percentile
tot = 0.01 *trials*real(percentile)
print *, "95th %% is", tot
counter = 0
do ii = 1, bins
counter = counter + D(ii)
if (real(counter).ge. tot) then
exit
end if
end do
print *, "95th percentile was in bin number", ii
! equate C with data_array
do i=1,array_size
data_array(i)%%zip_code=C(i)
end do
! time the sorts
call system_clock (c1)
call cpu_time (t1)
!call selection_sort (data_array(1:array_size))
call system_clock (c2)
call cpu_time (t2)
diff=t2-t1
diff2=c2-c1
print *, "system clock for selection sort was ", diff
print *, "cpu time for selection sort was ", diff2
F=C
call system_clock (c3)
call cpu_time (t3)
call QsortC(F)
call cpu_time (t4)
call system_clock (c4)
diff=t4-t3
diff2=c4-c3
print *, "system clock for qsort was ", diff
print *, "cpu time for qsort was ", diff2
! output
!print *, "quicksorted", F
!print *, "selection sorted", data_array
b = nint(tot)
print *, "b=", b
print *, data_array(b)
! end output
contains
SUBROUTINE init_random_seed()
INTEGER :: i, n, clock
INTEGER, DIMENSION(:), ALLOCATABLE :: seed
CALL RANDOM_SEED(size = n)
print *, "n=", n
ALLOCATE(seed(n))
CALL SYSTEM_CLOCK(COUNT=clock)
print *, "clock=", clock
seed = clock + 37 * (/ (i - 1, i = 1, n) /)
CALL RANDOM_SEED(PUT = seed)
print *, "seed= ", seed
DEALLOCATE(seed)
END SUBROUTINE
end program
! gfortran -o sort -fbounds-check freeformat50.f95
F:\gfortran\source>gfortran -o sort -fbounds-check freeformat50.f95
! I get nothing from gfortran with these switches ^^^^^^.
F:\gfortran\source>sort
n= 8
clock= 108897905
seed= 108897905 108897942 108897979 108898016 108898053
108898090
108898127 108898164
1 0.42305011
2 8.57861638E-02
3 0.40694624
At line 158 of file freeformat50.f95
Fortran runtime error: Array reference out of bounds for array 'a', lower
bound
of dimension 1 exceeded (0 < 1)
F:\gfortran\source>
I marked line 158 in the main control, where A represents the outcomes of
rolling an eight-sided die.
My strategy this time around has been to add the i13 kind as sparingly as
possible. Typically, the compiler complains that kinds are unlike and
dummy and actual args are not the same. So it is that I've had to add
integer, parameter :: i13 = selected_int_kind(13)
in four different places.
The call to selection sort is currently commented out as for larger
numbers, it is prohibitively slow. Grateful for any tips.
