! Program Example from "Essential Fortran 90 & 95" by Loren P. Meissner
! Copyright 1996. Copying for sale requires permission from the author.
! Otherwise, distribution is permitted if these three lines are included.

! Example 7.10. Encapsulated Polar data type.
  module H10M
    implicit none
    public :: Make_Polar, Amplitude, Phase, &
      operator( + ), operator( - ), operator( * ), operator( / ), operator( ** )
    private :: Add_Polar, Sub_Polar, Mult_Polar, Div_Polar, Exp_Polar, &
      Polar_To_Complex, Complex_To_Polar
    type, public :: Polar
      private
      real :: R
      real :: Theta
    end type Polar
    interface operator( + )
      module procedure Add_Polar
    end interface
    interface operator( - )
      module procedure Sub_Polar
    end interface
    interface operator( * )
      module procedure Mult_Polar
    end interface
    interface operator( / )
      module procedure Div_Polar
    end interface
    interface operator( ** )  ! Note: Second operand is real.
      module procedure Exp_Polar
    end interface
    real, parameter, public :: PI = 3.14159265
  contains
    function Make_Polar( Amplitude, Phase ) result ( Make_Polar_R )
      real, intent (in) :: Amplitude, Phase
      type (Polar) :: Make_Polar_R
  ! start function Make_Polar
      Make_Polar_R = Polar( Amplitude, Phase )
      return
    end function Make_Polar
    function Amplitude( P ) result( Amplitude_R )
      type (Polar), intent (in) :: P
      real :: Amplitude_R
  ! start function Amplitude
      Amplitude_R = P % R
      return
    end function Amplitude
    function Phase( P ) result( Phase_R )
      type (Polar), intent (in) :: P
      real :: Phase_R
  ! start function Phase
      Phase_R = P % Theta
      return
    end function Phase
! The remaining module procedures are private.
    function Add_Polar( P1, P2 ) result( Add_Polar_R )
      type (Polar), intent (in) :: P1, P2
      type (Polar) :: Add_Polar_R
  ! start function Add_Polar
  ! Convert to complex, add, and convert back.
      Add_Polar_R = Complex_To_Polar( Polar_To_Complex( P1 ) + Polar_To_Complex( P2 ) )
      return
    end function Add_Polar
    function Sub_Polar( P1, P2 ) result( Sub_Polar_R )
      type (Polar), intent (in) :: P1, P2
      type (Polar) :: Sub_Polar_R
  ! start function Sub_Polar
  ! Add P1 to -1 times P2.
      Sub_Polar_R = Add_Polar( P1, Mult_Polar( Polar( 1.0, PI ), P2 ) )
      return
    end function Sub_Polar
    function Mult_Polar( P1, P2 ) result( Mult_Polar_R )
      type (Polar), intent (in) :: P1, P2
      type (Polar) :: Mult_Polar_R
  ! start function Mult_Polar
  ! Multiply amplitudes and add phases.
      Mult_Polar_R = Polar( P1 % R * P2 % R, P1 % Theta + P2 % Theta )
      return
    end function Mult_Polar
    function Div_Polar( P1, P2 ) result( Div_Polar_R )
      type (Polar), intent (in) :: P1, P2
      type (Polar) :: Div_Polar_R
  ! start function Div_Polar
  ! Divide amplitudes and subtract phases.
      if (P2 % R /= 0.0) then
        Div_Polar_R = Polar( P1 % R / P2 % R, P1 % Theta - P2 % Theta )
      else
        Div_Polar_R = Polar( huge( 1.0 ), P1 % Theta - P2 % Theta )
      end if
      return
    end function Div_Polar
    function Exp_Polar( P1, R2 ) result( Exp_Polar_R )
      type (Polar), intent (in) :: P1
      real, intent (in) :: R2  ! Note: Second argument is real.
      type (Polar) :: Exp_Polar_R
  ! start function Exp_Polar
  ! Exponentiate amplitude and multiply phase.
      Exp_Polar_R = Polar( (P1 % R) ** R2, (P1 % Theta) * R2 )
      return
    end function Exp_Polar
    function Polar_To_Complex( P ) result( PTC_R )
  ! Convert polar to complex.
      type (Polar), intent (in) :: P
      complex :: PTC_R
  ! start function Polar_To_Complex
      PTC_R = cmplx( P % R * cos( P % Theta ), P % R * sin( P % Theta ) )
      return
    end function Polar_To_Complex
    function Complex_To_Polar( Z ) result( CTP_R )
  ! Convert complex to polar.
      complex, intent (in) :: Z
      type (Polar) :: CTP_R
  ! start function Complex_To_Polar
      CTP_R = Polar( abs (Z), atan2 (aimag( Z ), real( Z ) ) )
      return
    end function Complex_To_Polar
  end module H10M

