Data update
This commit is contained in:
Ingy döt Net
parent
4bb20c9b71
commit
cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions
185
Task/Fusc-sequence/Fortran/fusc-sequence.f
Normal file
185
Task/Fusc-sequence/Fortran/fusc-sequence.f
Normal file
|
|
@ -0,0 +1,185 @@
|
|||
!
|
||||
! Fusc sequence
|
||||
! tested with Intel ifx (IFX) 2025.2.1 20250806 on Kubuntu 25.04
|
||||
! GNU Fortran (Ubuntu 14.2.0-19ubuntu2) 14.2.0 on Kubuntu 25.04
|
||||
! VSI Fortran x86-64 V8.6-001 on OpenVMS x86_64 V9.2-3
|
||||
! No Non-standard features used, should compile on any fairly recent Fortran.
|
||||
! U.B., September 2025
|
||||
|
||||
program FuscNumbers
|
||||
|
||||
implicit none
|
||||
|
||||
integer, parameter :: kInt = 4
|
||||
integer, parameter :: maxdigs = 6
|
||||
integer, parameter :: strLen = 20
|
||||
|
||||
integer (kind=kInt), allocatable :: fuscMem(:)
|
||||
|
||||
integer :: capacity, content ! usage of above container
|
||||
|
||||
integer (kind=kInt) :: w,c,t
|
||||
integer (kind=kINt) :: i, f
|
||||
integer :: d=0, n=61, digs=1
|
||||
|
||||
character (len=strLen) :: sNum(2) ! for formatted output of integer numbers
|
||||
|
||||
content = 0
|
||||
capacity = 1024
|
||||
call resize (fuscMem, capacity)
|
||||
|
||||
call push (0)
|
||||
call push (1)
|
||||
|
||||
w = -1
|
||||
c = 0
|
||||
n = 61
|
||||
write ( *, '("First " , i0, " numbers in the fusc sequence:" )') n
|
||||
|
||||
i = 0
|
||||
do while (i .lt. 61)
|
||||
f = fusc(i)
|
||||
if (mod (i, 20) .ne. 0) then
|
||||
write (*, '(i2, x)', advance='no' ) f
|
||||
else
|
||||
write (*, '(i2,x)') f
|
||||
endif
|
||||
i = i + 1
|
||||
end do
|
||||
|
||||
write (*, '(/"Fusc numbers with more digits than any previous (1 to 6 digits):")')
|
||||
write (*, '( " Index Value")')
|
||||
i = 0
|
||||
do while (digs <= maxdigs)
|
||||
f = fusc (i)
|
||||
if (f .ge. d) then
|
||||
! show all numbers with commas (if appropriate).
|
||||
snum(1) = GroupedDigits(i, 10)
|
||||
snum(2) = GroupedDigits(f,10)
|
||||
if (digs .gt.1) then
|
||||
write (*,'(i2, " digits: ", A10,x,A )' ) digs, snum(1), snum(2)
|
||||
else
|
||||
write (*,'(i2, " digit : ", A10,x,A )' ) digs, snum(1), snum(2)
|
||||
endif
|
||||
if (d .eq. 0) then
|
||||
d = 10
|
||||
else
|
||||
d = d * 10
|
||||
endif
|
||||
digs = digs + 1
|
||||
if (digs .gt. 6) exit
|
||||
end if
|
||||
i = i + 1
|
||||
end do
|
||||
|
||||
|
||||
contains
|
||||
|
||||
function fusc (n) result (ret)
|
||||
integer (kind=kint), intent(in) :: n
|
||||
integer (kind=kInt) ret
|
||||
|
||||
|
||||
if (n .lt. content) then
|
||||
ret = fuscMem (1+n)
|
||||
else
|
||||
if (iand (n,1_kint) .eq. 0) then ! Even n has bit 0 = zero
|
||||
ret = fuscMem(1+n/2)
|
||||
call push (ret) ! Store for future use.
|
||||
else ! Else its odd.
|
||||
ret = fuscMem(1+(n-1)/2) + fuscMem(1+(n+2)/2)
|
||||
call push (ret)
|
||||
end if
|
||||
end if
|
||||
|
||||
end function fusc
|
||||
|
||||
! ---------------------
|
||||
! memoize another value
|
||||
! ---------------------
|
||||
subroutine push (k)
|
||||
integer (kind=kint), intent (in) :: k
|
||||
|
||||
content = content+1
|
||||
|
||||
! If we would exceed capacity of array 'Words', we need to increment capacity
|
||||
if (content .gt. capacity) then
|
||||
capacity = 2*capacity
|
||||
call resize (fuscMem, capacity)
|
||||
end if
|
||||
fuscMem(content) = k
|
||||
end subroutine push
|
||||
|
||||
|
||||
! ----------------------------------------------
|
||||
! Increase allocated size of dynamic array 'var'
|
||||
! ----------------------------------------------
|
||||
subroutine resize(var, newSize)
|
||||
integer (kind=kint), allocatable, intent(inout) :: var(:) ! The array to be increased
|
||||
integer, intent(in) :: newSize ! The new size of var
|
||||
integer (kind=kint), allocatable :: tmp(:) ! Temporary storage
|
||||
integer :: oldSize ! Current array size
|
||||
integer :: ii ! Loop index
|
||||
|
||||
! Copy allocated values to temporary, then allocate var with
|
||||
! new size and copy back saved values.
|
||||
! Could be done with move_alloc but this would not be portable to OpenVMS Fortran
|
||||
|
||||
if (allocated(var)) then
|
||||
oldSize = size(var)
|
||||
else
|
||||
oldSize = 0
|
||||
end if
|
||||
|
||||
if (newSize .gt. oldSize) then ! only increment
|
||||
if (oldSize .gt.0) then
|
||||
allocate(tmp (oldSize))
|
||||
tmp(:oldSize) = var(:oldSize)
|
||||
deallocate (var)
|
||||
end if
|
||||
allocate(var(newSize))
|
||||
if (allocated(tmp) .and. allocated (var) ) then
|
||||
oldSize = min(size(tmp, 1), size(var, 1))
|
||||
var(:oldSize) = tmp(:oldSize)
|
||||
deallocate (tmp)
|
||||
end if
|
||||
end if
|
||||
end subroutine resize
|
||||
|
||||
|
||||
! ----------------------------------------------------------------
|
||||
! Fortran does not have a way to use locales for output.
|
||||
! Manual insert of separating commas such as 1,345,678 for 1345678
|
||||
! ----------------------------------------------------------------
|
||||
function GroupedDigits (n, width) result (outStr)
|
||||
integer(kind=kint), intent (in) :: n
|
||||
integer :: width
|
||||
character (len=width) :: outStr
|
||||
character (len=2*strLen) :: workStr
|
||||
integer :: ii, jj, cnt, trueLen
|
||||
|
||||
|
||||
! Write n into a string, then copy the digits to a second string,
|
||||
! inserting separater after every 3 digits.
|
||||
write (workStr, '(i0)') n
|
||||
! Adjust left, then cutoff trailing blanks
|
||||
workstr = adjustl (workstr)
|
||||
trueLen = len_trim (workStr)
|
||||
|
||||
outStr = ' '
|
||||
jj = width
|
||||
cnt = 0
|
||||
do ii=trueLen, 1, -1 ! Copy backwards for correct grouping.
|
||||
outStr (jj:jj) = workStr (ii:ii)
|
||||
jj = jj -1
|
||||
cnt = cnt + 1
|
||||
! Insert comma after 3 digits, but only if more digits follow.
|
||||
if (mod (cnt, 3) .eq. 0 .and. ii .gt. 1 .and. workStr(ii-1:ii-1) .ne. ' ') then
|
||||
outStr (jj:jj) = ','
|
||||
jj = jj - 1
|
||||
endif
|
||||
end do
|
||||
|
||||
end function GroupedDigits
|
||||
|
||||
end program FuscNumbers
|
||||
Loading…
Add table
Add a link
Reference in a new issue