Continued fraction/Arithmetic/G(matrix ng, continued fraction n): Difference between revisions
Continued fraction/Arithmetic/G(matrix ng, continued fraction n) (view source)
Revision as of 01:59, 24 February 2023
, 1 year ago→{{header|Fortran}}
Line 2,971:
{{trans|ATS}}
{{trans|C}}
Unlike the ATS and C implementations upon which this Fortran code is based, there is no garbage collector. The memory management is tricky, and if you find bugs in it, please feel free to fix them.
(Fortran standards allow garbage collection, but the NAG compiler is the only Fortran compiler I know of that offers garbage collection as an option. I am using GNU Fortran.)
I have been liberal in the use of '''recursive''' declarations and '''block''' constructs. In this program they can only help, not hurt.
<syntaxhighlight lang="fortran">
Line 3,058:
contains
recursive subroutine cf_generator_make (gen, proc, env)
type(cf_generator_t), intent(out), pointer :: gen
interface
Line 3,084:
end subroutine cf_generator_t_refcount_decr
recursive subroutine cf_generator_t_finalize (gen)
type(cf_generator_t), intent(inout) :: gen
deallocate (gen%env)
Line 3,099:
end subroutine cf_memo_t_refcount_decr
recursive subroutine cf_memo_t_finalize (memo)
type(cf_memo_t), intent(inout) :: memo
deallocate (memo%storage)
end subroutine cf_memo_t_finalize
recursive subroutine cf_make (cf, gen)
type(cf_t), pointer, intent(out) :: cf
type(cf_generator_t), pointer, intent(inout) :: gen
Line 3,122:
end subroutine cf_make
recursive subroutine cf_t_finalize (cf)
type(cf_t), intent(inout) :: cf
Line 3,132:
end subroutine cf_t_finalize
recursive subroutine cf_generator_make_from_cf (gen, cf)
!
! TAKE NOTE: deallocating gen DOES NOT deallocate cf. (Most likely
Line 3,151:
end subroutine cf_generator_make_from_cf
recursive subroutine cf_generator_from_cf_proc (env, term_exists, term)
class(*), intent(inout) :: env
logical, intent(out) :: term_exists
Line 3,163:
end subroutine cf_generator_from_cf_proc
recursive subroutine cf_get_more_terms (cf, needed)
class(cf_t), intent(inout) :: cf
integer, intent(in) :: needed
Line 3,193:
end subroutine cf_get_more_terms
recursive subroutine cf_update (cf, needed)
class(cf_t), intent(inout) :: cf
integer, intent(in) :: needed
integer, pointer :: storage1(:)
if (cf%terminated .or. needed <= cf%m) then
Line 3,208 ⟶ 3,207:
cf%n = 2 * needed
allocate (storage1(0:cf%n - 1))
storage1(0:cf%m - 1) = cf%memo%storage(0:cf%m - 1)
deallocate (cf%memo%storage)
cf%memo%storage => storage1
Line 3,215 ⟶ 3,214:
end subroutine cf_update
recursive subroutine cf_get_at (cf, i, term_exists, term)
class(cf_t), intent(inout) :: cf
integer, intent(in) :: i
Line 3,226 ⟶ 3,225:
end subroutine cf_get_at
recursive function cf2string_max_terms (cf, max_terms) result (s)
class(cf_t), intent(inout) :: cf
integer, intent(in) :: max_terms
Line 3,277 ⟶ 3,276:
end function cf2string_max_terms
recursive function cf2string_default_max_terms (cf) result (s)
class(cf_t), intent(inout) :: cf
character(len = :), allocatable :: s
Line 3,305 ⟶ 3,304:
contains
recursive subroutine r2cf_generator_make (gen, n, d)
type(cf_generator_t), pointer, intent(out) :: gen
integer, intent(in) :: n, d
Line 3,320 ⟶ 3,319:
end subroutine r2cf_generator_make
recursive subroutine r2cf_generator_proc (env, term_exists, term)
class(*), intent(inout) :: env
logical, intent(out) :: term_exists
Line 3,345 ⟶ 3,344:
end subroutine r2cf_generator_proc
recursive subroutine r2cf_make (cf, n, d)
type(cf_t), pointer, intent(out) :: cf
integer, intent(in) :: n, d
Line 3,378 ⟶ 3,377:
contains
recursive subroutine sqrt2_generator_make (gen)
type(cf_generator_t), pointer, intent(out) :: gen
Line 3,391 ⟶ 3,390:
end subroutine sqrt2_generator_make
recursive subroutine sqrt2_generator_proc (env, term_exists, term)
class(*), intent(inout) :: env
logical, intent(out) :: term_exists
Line 3,404 ⟶ 3,403:
end subroutine sqrt2_generator_proc
recursive subroutine sqrt2_make (cf)
type(cf_t), pointer, intent(out) :: cf
Line 3,436 ⟶ 3,435:
contains
recursive subroutine hfunc_generator_make (gen, a1, a, b1, b, source_gen)
type(cf_generator_t), pointer, intent(out) :: gen
integer, intent(in) :: a1, a, b1, b
Line 3,455 ⟶ 3,454:
end subroutine hfunc_generator_make
recursive subroutine hfunc_generator_proc (env, term_exists, term)
class(*), intent(inout) :: env
logical, intent(out) :: term_exists
Line 3,465 ⟶ 3,464:
select type (env)
class is (hfunc_generator_env_t)
done = .false.
do while (.not. done)
Line 3,489 ⟶ 3,487:
env%b1 = a1 - (b1 * q)
env%b = a - (b * q)
done = .true.
end block
end
end
▲ done = .true.
▲ end if
end do
Line 3,521 ⟶ 3,519:
end subroutine hfunc_generator_proc
recursive subroutine hfunc_make (cf, a1, a, b1, b, source_cf)
type(cf_t), pointer, intent(out) :: cf
integer, intent(in) :: a1, a, b1, b
Line 3,558 ⟶ 3,556:
type(cf_t), pointer :: cf_one_way
type(cf_t), pointer :: cf_another_way
type(cf_t), pointer :: cf_half_of_1_div_sqrt2
type(cf_t), pointer :: cf_a_third_way
call r2cf_make (cf_13_11, 13, 11)
Line 3,570 ⟶ 3,571:
call hfunc_make (cf_one_way, 1, 2, 0, 4, cf_sqrt2)
call hfunc_make (cf_another_way, 1, 1, 0, 2, cf_1_div_sqrt2)
call hfunc_make (cf_half_of_1_div_sqrt2, 1, 0, 0, 2, cf_1_div_sqrt2)
call hfunc_make (cf_a_third_way, 2, 1, 0, 2, cf_half_of_1_div_sqrt2)
write (*, '("13/11 => ", A)') cf2string (cf_13_11)
Line 3,582 ⟶ 3,586:
write (*, '("(2 + sqrt(2))/4 => ", A)') cf2string (cf_one_way)
write (*, '("(1 + 1/sqrt(2))/2 => ", A)') cf2string (cf_another_way)
write (*, '("(1/sqrt(2))/2 + 1/2 => ", A)') cf2string (cf_a_third_way)
deallocate (cf_13_11)
Line 3,593 ⟶ 3,598:
deallocate (cf_one_way)
deallocate (cf_another_way)
deallocate (cf_half_of_1_div_sqrt2)
deallocate (cf_a_third_way)
end program univariate_continued_fraction_task
Line 3,600 ⟶ 3,607:
{{out}}
<pre>$ gfortran -fbounds-check -Wall -Wextra -g -std=f2018 univariate_continued_fraction_task.f90 && ./a.out
13/11 => [1;5,2]
22/7 => [3;7]
Line 3,610 ⟶ 3,617:
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1 + 1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1/sqrt(2))/2 + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|Go}}==
| |||