typebound test

module creative
implicit none
type,public::vector
    private
    real,allocatable::coord(:)
    integer::dim
contains
    procedure,public::construct_vector, print_vector
    procedure,private::add_vector, invert_vector, substract_vector, dot_prod, nullify_vector
    generic,public::operator(+)=>add_vector
    generic,public::operator(-)=>invert_vector, substract_vector
    generic,public::operator(*)=>dot_prod
    generic,public::operator(.nul.)=>nullify_vector
end type vector

    contains

subroutine construct_vector(a,coord_input)
real::coord_input(1:)
class(vector),intent(inout)::a
a%coord=coord_input
a%dim=size(coord_input)
end subroutine construct_vector

subroutine print_vector(a)
class(vector),intent(in)::a
print*, '(',a%coord,')','Dim=',a%dim
end subroutine print_vector

function add_vector(a,b) result(c)
class(vector),intent(in)::a,b
class(vector),allocatable::c
integer::i
if (a%dim >= b%dim) then
    allocate(c,source=a)
    do i=1,b%dim
        c%coord(i)=c%coord(i)+b%coord(i)
    enddo
else
    allocate(c,source=b)
    do i=1,a%dim
       c%coord(i)=c%coord(i)+a%coord(i)
    enddo
endif
end function add_vector

function invert_vector(a) result (b)
class(vector),intent(in)::a
class(vector),allocatable::b
allocate(b,source=a)
b%coord=-b%coord
end function invert_vector

function substract_vector(a,b) result(c)
class(vector),intent(in)::a,b
class(vector),allocatable::c
c=a+(-b)
end function substract_vector

function dot_prod(a,b) result(c)
class(vector),intent(in)::a,b
integer::i
real::c
c=0
if (a%dim /= b%dim) then
    print*, "Error:Dimensions don't match, dot product invalid"
    return
endif
do i=1,a%dim
    c=c+a%coord(i)*b%coord(i)
enddo
end function dot_prod

function nullify_vector(a) result(b)
class(vector),intent(in)::a
class(vector),allocatable::b
allocate(b,source=a)
b%coord=0
end function nullify_vector

end module creative

!!! Main program !!!

program object
use creative
implicit none
real::c
type(vector)::a,b
call construct_vector(a,(/1.2,4.1,5.9/))
call construct_vector(b,(/1.0,4.0/))
a=a-b
call print_vector(a)
c=a*b
print*, 'Dot product =', c
call print_vector(.nul.a)
pause
end program object