144 lines
5.5 KiB
Fortran
144 lines
5.5 KiB
Fortran
! Fivenum
|
|
! tested with Intel ifx (IFX) 2025.2.1 20250806 on Kubuntu 25.10
|
|
! GNU Fortran (Ubuntu 15.2.0-4ubuntu4) 15.2.0 on Kubuntu 25.10
|
|
! VSI Fortran x86-64 V8.6-001 on OpenVMS x86_64 V9.2-3
|
|
! Uses non-standard intrinsic isnan(), available as extension on all 3 mentioned compilers
|
|
! U.B., January 2026
|
|
!=========================================================================================
|
|
|
|
program p_fivenum
|
|
|
|
implicit none
|
|
integer, parameter :: dp=8
|
|
|
|
real (kind=dp), dimension(11) :: x1 = [15.0, 6.0, 42.0, 41.0, 7.0, 36.0, 49.0, 40.0, 39.0, 47.0, 43.0]
|
|
real (kind=dp), dimension(6) :: x2 = [36.0, 40.0, 7.0, 39.0, 41.0, 15.0]
|
|
|
|
! With so many valid digits, its better to specify the constants as real (kind=dp) to avoid precision loss
|
|
real (kind=dp), dimension(20) :: x3 = [0.14082834_dp, 0.09748790_dp, 1.73131507_dp, 0.87636009_dp, -1.95059594_dp, &
|
|
0.73438555_dp, -0.03035726_dp, 1.46675970_dp, -0.74621349_dp, -0.72588772_dp, &
|
|
0.63905160_dp, 0.61501527_dp, -0.98983780_dp, -1.00447874_dp, -0.62759469_dp, &
|
|
0.66206163_dp, 1.04312009_dp, -0.10305385_dp, 0.75775634_dp, 0.32566578_dp]
|
|
real (kind=dp), dimension(5) :: result
|
|
|
|
if (fivenum (x1,result,size(x1))) call show (result, '(5 (X,F4.1))')
|
|
if (fivenum (x2,result,size(x2))) call show (result, '(5 (X,F4.1))')
|
|
if (fivenum (x3,result,size(x3))) call show (result, '(5 (X,F11.8))')
|
|
|
|
contains
|
|
|
|
function fivenum (x,res,n) result(OK)
|
|
|
|
integer,intent(in) :: n ! size of the...
|
|
real (kind=dp), dimension(n), intent (inout) :: x ! value array
|
|
real (kind=dp), dimension(5), intent(out) :: res ! the 5-number result
|
|
logical :: OK ! this will signal success or failure
|
|
|
|
integer :: ii ! loop index
|
|
integer:: rmid, lmid ! index to the 2 central elements of the array
|
|
! ... these values are different if n is even
|
|
|
|
!-- Check for invalid input: nan is not a number to calculate with
|
|
OK = .true. ! Assume success
|
|
do ii=1,n
|
|
if (isnan (x(ii))) then ! isNan() is non-standard extension in IFX and also in gfortran
|
|
OK = .false. ! signal fault
|
|
print *, 'Unable to deal with arrays containing NaN'
|
|
return
|
|
endif
|
|
end do
|
|
|
|
! value array must be sorted ascending
|
|
call quicksort_real (x, 1, n)
|
|
|
|
! Divide array into 4 sections
|
|
rmid = 1 + n/2 ! right middle
|
|
if (mod (n, 2) .eq. 1) then ! odd array size?
|
|
lmid = rmid ! left and right half end/begin on the same element
|
|
else
|
|
lmid = rmid - 1 ! left half ends at lmid, right half begins at rmid.
|
|
end if
|
|
|
|
! fill result values as defined
|
|
res(1) = x(1) ! min value
|
|
res(2) = median (x, 1, lmid) ! lower hinge
|
|
res(3) = median (x,1,n) ! Median of all
|
|
res(4) = median (x,rmid,n) ! upper hinge
|
|
res(5) = x(n) ! max value
|
|
end function fivenum
|
|
|
|
!==================
|
|
! Print the result
|
|
!==================
|
|
subroutine show (r,form )
|
|
|
|
real(kind=dp),dimension(5), intent(in) ::r
|
|
character (len=*), intent(in) :: form
|
|
|
|
write (*,form) r
|
|
end subroutine show
|
|
|
|
! ==============================================================================
|
|
! Calculate median of all elements of array x() between index ip1 and ip2 (incl)
|
|
! ==============================================================================
|
|
function median (x, ip1, ip2) result (med)
|
|
|
|
real (kind=dp), dimension(:), intent(in) :: x ! the entire array
|
|
integer, intent(in) :: ip1, ip2 ! end points of the part we need the median
|
|
real (kind=dp) :: med ! the calculated median
|
|
|
|
integer :: numberOfElements, midIndex ! size of the slice, index to middle of hte slice
|
|
|
|
numberOfElements = 1 + ip2-ip1
|
|
midIndex = ip1 + numberOfElements/2
|
|
|
|
if (mod (numberOfElements,2) .eq. 1) then ! Odd number of elements: take middle value
|
|
med = X(midIndex)
|
|
else ! Even number of values: average of 2 central values
|
|
med = (X(midIndex-1) + x(midIndex) ) / 2.
|
|
endif
|
|
|
|
end function median
|
|
|
|
! =========================
|
|
! sort array of real values
|
|
! =========================
|
|
recursive subroutine quicksort_real (arr, low, high)
|
|
|
|
real (kind=dp), dimension(:), intent(inout) :: arr
|
|
integer, intent(in) :: low, high
|
|
integer :: pivot_index
|
|
integer :: i, j, mid
|
|
real (kind=dp) :: pivot, temp
|
|
|
|
if (low .lt. high) then
|
|
! Assume the list is already "almost sorted", so use middle word as pivot.
|
|
mid = low + (high-low) / 2
|
|
pivot = arr(mid)
|
|
!Move pivot to the end
|
|
temp = arr(mid)
|
|
arr(mid) = arr(high)
|
|
arr(high)=temp
|
|
i = low - 1
|
|
|
|
do j = low, high - 1
|
|
if (arr(j) .le. pivot) then
|
|
i = i + 1
|
|
temp = arr(i)
|
|
arr(i) = arr(j)
|
|
arr(j) = temp
|
|
end if
|
|
end do
|
|
|
|
temp = arr(i+1)
|
|
arr(i+1) = arr(high)
|
|
arr(high) = temp
|
|
pivot_index = i + 1
|
|
|
|
call quicksort_real (arr, low, pivot_index - 1)
|
|
call quicksort_real (arr, pivot_index + 1, high)
|
|
end if
|
|
end subroutine quicksort_real
|
|
|
|
|
|
end program p_fivenum
|