testit Program

Functions

function promote(value1, value2, value3)

Arguments

Type IntentOptional Attributes Name
class(*), intent(in) :: value1
class(*), intent(in) :: value2
class(*), intent(in) :: value3

Return Value doubleprecision, allocatable


Source Code

program testit
   use M_overload__extend
   implicit none
   ! make sure normal stuff still works
   write(*,*)'##CONVENTIONAL'
   write(*,*)'INTEGER         ', dble(10)
   write(*,*)'INTEGER ARRAY   ', dble([10,20])
   write(*,*)'REAL            ', dble(10.20)
   write(*,*)'DOUBLEPRECISION ', dble(100.20d0)
   ! extensions
   write(*,*)'##EXTENSIONS'
   write(*,*)'CHARACTER       ', dble('100.30')
   write(*,*)'CHARACTER ARRAY ', dble([character(len=10) :: '100.30','400.500'])
   ! call a function with a metamorphic argument
   write(*,*)'METAMORPHIC     ', promote(1,1.0,1.0d0)
   write(*,*)'METAMORPHIC     ', promote('3',(2.0,0.0),.true.)
   write(*,*)'METAMORPHIC     ', promote('3','3','3')
   write(*,*)'METAMORPHIC     ', promote(.true.,.false.,.true.)
   write(*,*)'METAMORPHIC     ', promote((3.0,4.0),0.0,0)
   ! settle this once and for all
   write(*,*)'LOGICAL TRUE    ', dble(.true.)
   write(*,*)'LOGICAL FALSE   ', dble(.false.)
   write(*,*)'LOGICAL ARRAY   ', dble([.false., .true., .false., .true.])
contains
   function promote(value1,value2,value3)
      class(*),intent(in) :: value1
      class(*),intent(in) :: value2
      class(*),intent(in) :: value3
      doubleprecision,allocatable :: promote
      promote=sum([dble(value1),dble(value2),dble(value3)])
   end function promote

end program testit