Filetype PDF | Posted on 03 Feb 2023 | 3 years ago
Authentication
digital resources
274x Filetype PDF File size 0.38 MB Source: personalpages.manchester.ac.uk
EXAMPLE PROGRAMS F Revision 29/05/2019
Recursion Examples
Highest Common Factor, HCF (aka Greatest Common Divisor, GCD)
recursive integer function hcf( a, b ) result( answer )
implicit none
integer, intent(in) :: a, b
if ( b == 0 ) then
answer = a ! Base case
else
answer = hcf( b, modulo( a, b ) ) ! Recursion
end if
end function hcf
program test
implicit none
integer a, b
integer, external :: hcf
print *, "Input a, b:"
read *, a, b
print *, "HCF is ", hcf( a, b ) ! Main call
end program test
Convert To Binary
module BinaryModule
implicit none
contains
recursive function binary( n ) result( answer )
character(len=:), allocatable :: answer ! Note: variable length
integer, intent(in) :: n
character :: digit(0:1) = [ '0', '1' ] ! Note: lower bound 0
if ( n <= 1 ) then
answer = digit( n ) ! Base case
else
answer = binary ( n / 2 ) // digit( modulo( n, 2 ) ) ! Recursion
end if ! note: automatic reallocation
end function binary
end module BinaryModule
program main
use BinaryModule
implicit none
integer n
write( *, "( i2, 1x, a )" ) ( n, binary( n ), n = 0, 32 ) ! Main call
end program main
Fortran Examples Part F David Apsley
Binary Search
module BinarySearchModule
implicit none
contains
recursive integer function binarySearch( A, value, low, high ) result( answer )
integer, intent(in) :: A(:)
integer, intent(in) :: value
integer, intent(in) :: low, high
integer middle
if ( low > high ) then
answer = -1 ! Base case (not found)
else
middle = ( low + high ) / 2
if ( A(middle) == value ) then
answer = middle ! Base case (found)
else if ( A(middle) < value ) then
answer = binarySearch( A, value, middle + 1, high ) ! Recursion (upper)
else
answer = binarySearch( A, value, low, middle - 1 ) ! Recursion (lower)
end if
end if
end function binarySearch
end module BinarySearchModule
program main
use BinarySearchModule
implicit none
integer pos
integer value
integer, allocatable :: A(:)
A = [ 1, 2, 6, 7, 8, 20, 32, 33 ]
write( *, "( 'Array is ', *( i0, 1x ) )" ) A
write( *, "( a )", advance = "no" ) "Enter a value: "
read( *, * ) value
pos = binarySearch( A, value, 1, size( A ) ) ! Search full range
if ( pos > 0 ) then
write( *, "( a, i0, a, i0 )" ) "Found ", value, " at position ", pos
else
write( *, * ) "Couldn't find value"
end if
end program main
Fortran Examples Part F David Apsley
Sum of Digits
recursive integer function sumDigits( n ) result( answer )
implicit none
integer, intent(in) :: n
if ( n < 10 ) then
answer = n ! Base case (single digit)
else
answer = sumDigits( n / 10 ) + modulo( n, 10 ) ! Recursion
end if
end function sumDigits
program test
implicit none
integer, external :: sumDigits
integer n
print *, "Input a number:"
read *, n
print *, "Sum of digits is ", sumDigits( n )
end program test
Reverse a Word
recursive subroutine reverse( text, L, R )
implicit none
character(len=*), intent(inout) :: text
integer, intent(in) :: L, R
character c
if ( L < R ) then
c = text(L:L); text(L:L) = text(R:R); text(R:R) = c ! Swap ends
call reverse( text, L + 1, R - 1 ) ! Recursive call
end if
end subroutine reverse
program main
implicit none
character(len=100) text
character(len=*), parameter :: fmt = "( a )"
write( *, fmt, advance="no" ) "Enter some text: "
read( *, fmt ) text
call reverse( text, 1, len_trim( text ) )
write( *, fmt ) "Reversed text: " // text
end program main
Fortran Examples Part F David Apsley
Sieve of Eratosthenes to find primes
program main
implicit none
logical, allocatable :: isPrime(:)
integer N
integer i, imax
write( *, * ) "Input N: "
read( *, * ) N
allocate( isPrime(2:N) ); isPrime = .true.
imax = sqrt( N + 1.0 )
do i = 2, imax
if ( isPrime(i) ) isPrime(i+i:N:i) = .false.
end do
write( *, * ) "Prime numbers are: "
do i = 2, N
if ( isPrime(i) ) write( *, "( 1x, i0 )", advance = "no" ) i
end do
end program main
Input N: 100
Prime numbers are:
2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97
Fortran Examples Part F David Apsley
no reviews yet
Please Login to review.
