A Fortran program that reads real numbers from a text file, calculates statistical measures (mean value and dispersion), and sorts the data using quicksort algorithm. The program demonstrates dynamic memory allocation, file I/O operations, recursive sorting algorithms, and statistical calculations. Includes multiple quicksort implementations (QSort, QSort2, QSort3) showing different approaches to the same problem.
program ReadNsort
real, allocatable :: values(:)
real :: t
integer :: n, len = 0
character(20) :: infile /'test.txt'/, outfile /'out.txt'/
open(unit=1, file=infile)
print *, 'Opening file ', infile, '..'
print *, 'Scaning file...'
do
read(unit=1, fmt=*, end=1) t
len = len + 1
enddo
1 continue
2 format(F7.5)
print *, 'Size is ', len, ' records...'
allocate (values(len))
rewind 1
print *, 'Reading file...'
read (1,*) (values(n), n=1,len)
print *, 'Done!..'
close (1)
call Dispersion(values, t)
print *, 'Dispersion is:', t
call MeanVal(values, t)
print *, 'Mean value is:', t
print *, 'Sorting with QSort...'
call QSort3(values)
print *, 'Done!..'
print *, 'Now writing ', outfile, '..'
open(unit=1, file=outfile)
write (unit=1, fmt=2) (values(n), n=1,len)
print *, 'Done!..'
!open(unit=3, file=infile)
!do n=1,1000000
!call random_number(t)
!write (unit=1, fmt=2) t
!enddo
!close (1)
close (1)
contains
subroutine MeanVal(values, mean)
real :: mean
real :: values(:)
integer :: n
mean = 0
do n = lbound(values,1), ubound(values,1)
mean = mean + values(n)
enddo
mean = mean / n
end subroutine
subroutine Dispersion(values, disp)
real :: disp, mean
real :: values(:)
integer :: n
disp = 0
call MeanVal(values, mean)
do n = lbound(values,1), ubound(values,1)
disp = values(n)*values(n)
enddo
disp = (n*disp - mean*mean)/(n*(n-1))
end subroutine
recursive subroutine QSort(values, lb, ub)
real, intent(inout) :: values(:)
integer :: median, lb, ub, ucntr, lcntr
median = (ub + lb)/2
ucntr = ub
lcntr = lb
do
if (values(lcntr) > values(median) .and. median > lcntr) then
call cycler(values(lcntr), values(median - 1), values(median))
median = median - 1
else if (values(lcntr) <= values(median) .and. median > lcntr) then
lcntr = lcntr + 1
endif
if (values(ucntr) <= values(median) .and. median < ucntr) then
call cycler(values(ucntr), values(median + 1), values(median))
median = median + 1
else if (values(ucntr) >= values(median) .and. median < ucntr) then
ucntr = ucntr - 1
endif
if (lcntr >= ucntr) exit
enddo
if (median - lb > 4) call QSort(values, lb, median)
if (ub - median > 4) call QSort(values, median, ub)
end subroutine
recursive subroutine QSort2(values)
real :: values(:)
real :: median
integer :: lb, ub, ucntr, lcntr
ub = ubound(values,1)
lb = lbound(values,1)
median = .5
ucntr = ub
lcntr = lb
do
if (values(lcntr) > median) then
call cycler(values(lcntr), values((lcntr + ucntr)/2), values((lcntr + ucntr)/2))
else
lcntr = lcntr + 1
endif
if (values(ucntr) <= median) then
call cycler(values(ucntr), values((lcntr + ucntr)/2), values((lcntr + ucntr)/2))
else
ucntr = ucntr - 1
endif
if (lcntr >= ucntr) exit
enddo
if (lcntr - lb > 1) call QSort2(values(lb:lcntr))
if (ub - ucntr > 1) call QSort2(values(ucntr:ub))
end subroutine
recursive subroutine QSort3(values)
real, intent(inout) :: values(:)
integer :: median, lb, ub, ucntr, lcntr
ub = ubound(values,1)
lb = lbound(values,1)
median = (ub + lb)/2
ucntr = ub
lcntr = lb
do
if (values(lcntr) > values(median) .and. median > lcntr) then
call cycler(values(lcntr), values(median - 1), values(median))
median = median - 1
else if (values(lcntr) <= values(median) .and. median > lcntr) then
lcntr = lcntr + 1
endif
if (values(ucntr) < values(median) .and. median < ucntr) then
call cycler(values(ucntr), values(median + 1), values(median))
median = median + 1
else if (values(ucntr) >= values(median) .and. median < ucntr) then
ucntr = ucntr - 1
endif
if (lcntr >= ucntr) exit
enddo
if (median - lb > 6) call QSort3(values(lb:median))
if (ub - median > 6) call QSort3(values(median:ub))
end subroutine
subroutine cycler(a, b, c)
real a,b,c,t
t = a; a = b; b = c; c = t
end subroutine
end