ZYF

 module class_Rational
  implicit none
  ! public everything but following private routines
  private :: gdd, reduce
  type Rational
     private
     integer :: num, den
  end type Rational
  
  interface assignment(=)
     module procedure equal_Integer; 
  end interface
  
  interface operator(+)
     module procedure add_Rational
  end interface
  
  interface operator(*)
     module procedure mult_Rational
  end interface
  
  interface operator(==)
     module procedure is_equal_to 
  end interface
  
 contains
 
  function add_Rational(a, b) result(c)
    type(Rational), intent(in) :: a, b
    type(Rational) :: c
    c%num = a%num * b%den + a%den * b%num
    c%den = a%den * b%den
    call reduce(c)
  end function add_Rational
  
  function convert(name) result(value)
    type(Rational),intent(in) :: name
    real :: value
    value = float(name%num) / name%den
  end function convert
  
  function copy_Rational(name) result(new)
    type(Rational), intent(in) :: name
    type(Rational) :: new
    new%num = name%num
    new%den = name%den
  end function copy_Rational
  
  subroutine delete_Rational(name)
    type(Rational), intent(inout)::name
    name = Rational(0,1)
  end subroutine delete_Rational
  
  subroutine equal_Integer(new, I)
    type(Rational), intent(out) :: new
    integer, intent(in) :: I
    new%num = I
    new%den =1
  end subroutine equal_Integer
  
  recursive function gdd(j,k) result(g)
    integer, intent(in) :: j, k
    integer :: g
    if (k==0) then
       g = j
    else
       g = gdd(k, modulo(j,k))
    end if
  end function gdd
  
  function get_Denominator(name) result(n)
    type(Rational), intent(in) :: name
    integer :: n
    n = name%den
  end function get_Denominator
  
  function get_Numerator(name) result(n)
    type(Rational), intent(in) :: name
    integer :: n
    n = name%num
  end function get_Numerator
  
  subroutine invert(name)
    type(Rational), intent(inout):: name
    integer:: temp
    temp = name%num
    name%num = name%den
    name%den = temp
  end subroutine invert
  
  function is_equal_to(a_given, b_given) result(t_f)
    type(Rational), intent(in):: a_given, b_given
    type(Rational) :: a, b
    logical :: t_f
    a = copy_Rational(a_given)
    b = copy_Rational(b_given)
    call reduce(a)
    call reduce(b)
    t_f = (a%num  b%num) .and. (a%denb%den)
  end function is_equal_to
  
  subroutine list(name)
    type(Rational), intent(in) :: name
    print *, name%num, ”/”, name%den
  end subroutine list
  
  function make_Rational(numerator, denominator) result(name)
    integer, optional, intent(in) :: numerator, denominator
    type(Rational) :: name
    name = Rational(0,1)
    if (present(numerator)) name%num = numerator
    if (present(denominator)) name%den = denominator
    if (name%den  0) name%den = 1
    call reduce(name)
  end function make_Rational
  
  function mult_Rational(a,b) result(c)
    type(Rational), intent(in) :: a, b
    type(Rational) :: c
    c%num = a%num *b%num
    c%den = a%den *b%den
    call reduce(c)
  end function mult_Rational
  
  function Rational_(numerator, denominator) result(name)
    integer, optional, intent(in) :: numerator, denominator
    type (Rational) :: name
    if ( denominator  0 ) then 
       name = Rational (numerator, 1)
    else 
       name = Rational (numerator, denominator)
    end if
  end function Rational_
  
  subroutine reduce (name) ! to simplest rational form
    type (Rational), intent(inout) :: name
    integer :: g ! greatest common divisor
    g = gdd (name % num, name % den)
    name % num = name % num/g
    name % den = name % den/g 
  end subroutine reduce
  
 end module class_Rational

include 'class_Rational.f90'
 program main
  use class_Rational
  implicit none
  type (Rational) :: x, y, z
  ! x = Rational(22,7) ! intrinsic constructor if public components
  x = Rational_(22,7) ! public constructor if private components
  write (*,'("public x = ")',advance='no'); call list(x)
  write (*,'("converted x = ", g9.4)') convert(x)
  call invert(x)
  write (*,'("inverted 1/x = ")',advance='no'); call list(x)
  x = make_Rational () ! default constructor
  write (*,'("made null x = ")',advance='no'); call list(x)
  y = 4 ! rational = integer overload
  write (*,'("integer y = ")',advance='no'); call list(y)
  z = make_Rational (22,7) ! manual constructor
  write (*,'("made full z = ")',advance='no'); call list(z)
  ! Test Accessors
  write (*,'("top of z = ", g4.0)') get_numerator(z)
  write (*,'("bottom of z = ", g4.0)') get_denominator(z)
  ! Misc. Function Tests
  write (*,'("making x = 100/360, ")',advance='no')
  x = make_Rational (100,360)
  write (*,'("reduced x = ")',advance='no'); call list(x)
  write (*,'("copying x to y gives ")',advance='no')
  y = copy_Rational (x)
  write (*,'("a new y = ")',advance='no'); call list(y)
  ! Test Overloaded Operators
  write (*,'("z * x gives ")',advance='no'); call list(z*x) ! times
  write (*,'("z + x gives ")',advance='no'); call list(z+x) ! add
  y = z ! overloaded assignment
  write (*,'("y = z gives y as ")',advance='no'); call list(y)
  write (*,'("logic y  x gives ")',advance='no'); print *, yx
  write (*,’(“logic y  z gives ")',advance='no'); print *, yz
  ! Destruct
  call delete_Rational (y) ! actually only null it here
  write (*,’(“deleting y gives y = ”)’,advance=’no’); call list(y)
end program main ! Running gives:
! public x = 22 / 7 ! converted x = 3.143
! inverted 1/x = 7 / 22 ! made null x = 0 / 1
! integer y = 4 / 1 ! made full z = 22 / 7
! top of z = 22 ! bottom of z = 7
! making x = 100/360, reduced x = 5 / 18
! copying x to y gives a new y = 5 / 18
! z * x gives 55 / 63 ! z + x gives 431 / 126
! y = z gives y as 22 / 7 ! logic y  x gives F
! logic y  z gives T ! deleting y gives y = 0 / 1