module ratpack

type rational
  private
  integer :: nominator, denominator
end type rational

interface operator (+)
  module procedure ratint_add, intrat_add, add
end interface

interface operator (.inv.)
  module procedure inverse
end interface

interface assignment (=)
  module procedure intrat_subst, ratint_subst
end interface

contains

!
! handling of components
! 
function nomin (p)
  ! return the nominator of a rational number
  integer nomin
  type (rational), intent(in):: p
  nomin=p%nominator
end function

function denom (p)
  ! return the denominator of a rational number
  integer denom
  type (rational), intent(in):: p
  denom=p%denominator
end function

function rat (n, d)
  ! return a rational number with
  ! nominator=n and denominator=d
  type (rational) rat
  integer, intent(in):: n, d
  rat%nominator=n
  rat%denominator=d
end function

!
! assignment operator
!
subroutine intrat_subst (p, i)
  ! return integer i as a rational number
  integer, intent(in) :: i
  type (rational), intent(out) :: p
  type (rational) :: r
  r%nominator = i
  r%denominator = 1
  p = simplify (r)
  return
end subroutine

subroutine ratint_subst (i, p)
  ! assign rational number p to the integer i
  integer, intent(out) :: i
  type (rational), intent(in) :: p
  i = p%nominator / p%denominator
  return
end subroutine

!
! inverse value
!
function inverse (p)
  ! inverse of the rational number p
  type (rational) inverse
  type (rational), intent(in):: p
  integer a,b
  type (rational) r
  a=p%nominator; b=p%denominator
  r%nominator = b
  r%denominator = a
  inverse = simplify (r)
end function

!
! multiplication
!
function mul (p, q)
  ! product of rational numbers p and q
  type (rational) mul
  type (rational), intent(in):: p, q
  integer a,b,c,d
  type (rational) r
  a=p%nominator; b=p%denominator
  c=q%nominator; d=q%denominator
  r%nominator = a*c
  r%denominator = b*d
  mul = simplify (r)
end function

!
! division
!
function div (p, q)
  ! quotient of rational numbers p and q 
  type (rational) div
  type (rational), intent(in):: p, q
  integer a,b,c,d
  type (rational) r
  a=p%nominator; b=p%denominator
  c=q%nominator; d=q%denominator
  r%nominator = a*d
  r%denominator = b*c
  div = simplify (r)
end function

!
! addition
!
function ratint_add (p, i)
  ! sum of a rational number p and integer i 
  type (rational) :: ratint_add
  type (rational), intent(in):: p
  integer, intent(in) :: i
  integer a,b,c,d
  type (rational) :: r
  a=p%nominator; b=p%denominator
  c=i; d=1
  r%nominator = a*d + b*c
  r%denominator = b*d
  ratint_add = simplify (r)
end function

function intrat_add (i, q)
  ! sum of an integer i and rational number q 
  type (rational) :: intrat_add
  integer, intent(in) :: i
  type (rational), intent(in):: q
  integer a,b,c,d
  type (rational) :: r
  a=i; b=1
  c=q%nominator; d=q%denominator
  r%nominator = a*d + b*c
  r%denominator = b*d
  intrat_add = simplify (r)
end function


function add (p, q)
  ! lasketaan rationaalilukujen p ja q summa
  type (rational) :: add
  type (rational), intent(in):: p, q
  integer a,b,c,d
  type (rational) :: r
  a=p%nominator; b=p%denominator
  c=q%nominator; d=q%denominator
  r%nominator = a*d + b*c
  r%denominator = b*d
  add = simplify (r)
end function

!
! subtraction
!
function sub (p, q)
  ! difference of rational numbers p and q
  type (rational) sub
  type (rational), intent(in):: p, q
  integer a,b,c,d
  type (rational) r
  a=p%nominator; b=p%denominator
  c=q%nominator; d=q%denominator
  r%nominator = a*d - b*c
  r%denominator = b*d
  sub = simplify (r)
end function


function simplify (q)
  ! reduce the rational number q to its simplest form
  ! by applying the Euclidean algorithm
  ! the value of the function is the reduced rational number
  type (rational) simplify
  type (rational), intent(in):: q
  integer  a, b
  a=q%nominator
  b=q%denominator
  do
    if (a < b) then
       c=a; a=b; b=c; 
    end if
    do while (a >= b) 
      a = a-b 
    end do
    if (a == 0) exit
  end do
  simplify%nominator = q%nominator/b
  simplify%denominator = q%denominator/b
end function

end module