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

!
! komponenttien kasittely
! 
function nomin (p)
  ! palautetaan rationaaliluvun osoittaja
  integer nomin
  type (rational), intent(in):: p
  nomin=p%nominator
end function

function denom (p)
  ! palautetaan rationaaliluvun nimittaja
  integer denom
  type (rational), intent(in):: p
  denom=p%denominator
end function

function rat (n, d)
  ! muodostetaan rationaaliluku, jonka 
  ! osoittaja=n nimittaja=d
  type (rational) rat
  integer, intent(in):: n, d
  rat%nominator=n
  rat%denominator=d
end function

!
! sijoitusoperaattori
!
subroutine intrat_subst (p, i)
  ! palautetaan kokonaisluvun i arvo rationaalilukuna
  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)
  ! palautetaan kokonaisluvun i arvo rationaalilukuna
  integer, intent(out) :: i
  type (rational), intent(in) :: p
  i = p%nominator / p%denominator
  return
end subroutine

!
! kaanteisluku
!
function inverse (p)
  ! lasketaan rationaaliluvun p kaanteisluku
  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

!
! kertolasku
!
function mul (p, q)
  ! lasketaan rationaalilukujen p ja q tulo
  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

!
! jakolasku
!
function div (p, q)
  ! lasketaan rationaalilukujen p ja q osamaara
  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

!
! yhteenlasku
!
function ratint_add (p, i)
  ! lasketaan rationaaliluvun p ja kokonaisluvun i summa
  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)
  ! lasketaan kokonaisluvun i ja rationaaliluvun q summa
  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

!
! vahennyslasku
!
function sub (p, q)
  ! lasketaan rationaalilukujen p ja q erotus
  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)
  ! supistetaan rationaaliluku q yksinkertaisimpaan 
  ! muotoon Eukleideen algoritmilla
  ! funktion arvo on supistettu rationaaliluku
  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