!------------------------------------------------------------------------------
!
!  Module name:
!
!    money_module
!
!  Purpose:
!
!    This module demonstrates the power of modules as a way to define 
!    a derived type money and all associated operators and assignment 
!    overloading.
!
!------------------------------------------------------------------------------

MODULE money_module

  ! Specifications:

  TYPE money
    INTEGER :: pounds, pence
  END TYPE money

  ! Interfaces:

  INTERFACE OPERATOR (+)        ! overloading operator + 
    MODULE PROCEDURE addmoney
  END INTERFACE
 
  INTERFACE OPERATOR (-)        ! overloading operator - 
    MODULE PROCEDURE negatemoney, subtractmoney
  END INTERFACE

  INTERFACE OPERATOR (.VAT.)    ! defining new operator .VAT.
    MODULE PROCEDURE calcvat
  END INTERFACE

  INTERFACE ASSIGNMENT (=)      ! overloading assignment by excluding pence
    MODULE PROCEDURE realtomoney
  END INTERFACE

  REAL :: vatrate = 0.175       ! global data

CONTAINS

  ! Module procedures:

  FUNCTION addmoney(a, b)

    TYPE (money) :: addmoney
    TYPE (money),INTENT(IN) :: a, b
    INTEGER :: carry, temppence

    temppence = a%pence + b%pence
    carry = 0

    IF (temppence>100) THEN
      temppence = temppence - 100
      carry = 1
    END IF
    addmoney%pounds = a%pounds + b%pounds + carry
    addmoney%pence = temppence

  END FUNCTION addmoney
 
  FUNCTION negatemoney(a)

    TYPE (money) :: negatemoney
    TYPE (money),INTENT(IN) :: a

    negatemoney%pounds = -a%pounds
    negatemoney%pence = -a%pence

  END FUNCTION negatemoney
 
  FUNCTION subtractmoney(a,b)

    TYPE (money) :: subtractmoney
    TYPE (money),INTENT(IN) :: a,b
    INTEGER :: temppound, temppence
   
    temppence = a%pence - b%pence
    temppound = a%pounds - b%pounds
    
      IF ((temppence<0).AND.(temppound>0)) THEN
        temppence = 100 + temppence
        temppound = temppound - 1
      ELSE IF ((temppence>0).AND.(temppound<0)) THEN
        temppence = temppence - 100
        temppound = temppound + 1
      END IF
   
    subtractmoney%pence = temppence
    subtractmoney%pounds = temppound
   
  END FUNCTION subtractmoney

  FUNCTION calcvat(x) RESULT (vat)

    TYPE (money), INTENT (IN) :: x
    TYPE (money) :: vat
    INTEGER :: taxpence

    taxpence = ceiling (vatrate * (x%pounds * 100 + x%pence))
    vat%pounds = taxpence / 100
    vat%pence = taxpence - 100 * vat%pounds

  END FUNCTION calcvat

  SUBROUTINE realtomoney(m, r)  ! excluding pence

    TYPE (money), INTENT(OUT) :: m
    REAL, INTENT(IN) :: r

    m%pounds = r                ! real to integer coercion is already available
    m%pence = floor((r - m%pounds) * 100) 

  END SUBROUTINE realtomoney

END MODULE money_module






