! Created by  on 22/02/2020.
!
! ifort (IFORT) 19.1.0.166 20191121
!
! Build:
!   ifort -debug -check bounds -warn all -traceback AGd.f90 -o AGd
!
! Result:
!
! AGd.f90(109): error #6549: An arithmetic or LOGICAL type is required in this context.
!    v = 3*s + 1
!---------^
!AGd.f90(109): error #6355: This binary operation is invalid for this data type.
!    v = 3*s + 1
!---------^

module AG

    type g_auto_var(n)
        integer, len :: n
        real(8)      :: v
        real(8)      :: d(n)
    contains
        procedure, public :: set => set_gav
        procedure, public :: set_from_gav
        generic, public   :: assignment(=) => set_from_gav
        procedure, public :: gav_times_gav
        procedure, public :: gav_times_i
        generic, public   :: operator(*) => gav_times_gav, gav_times_i
        procedure, public :: gav_plus_gav
        procedure, public :: gav_plus_i
        generic, public   :: operator(+) => gav_plus_gav, gav_plus_i
    end type g_auto_var

    interface operator(*)
        module procedure i_times_gav
    end interface

    interface operator(+)
        module procedure i_plus_gav
    end interface

contains

    pure subroutine set_gav(this, v)
        class(g_auto_var(*)), intent(inout) :: this
        real(8), intent(in) :: v
        this%v = v
        this%d(1) = 1
        this%d(2:this%n) = 0
    end subroutine set_gav

    pure subroutine set_from_gav(this, v)
        class(g_auto_var(*)), intent(inout) :: this
        class(g_auto_var(*)), intent(in)    :: v
        this%v = v%v
        this%d = v%d
    end subroutine set_from_gav

    ! === times =========================================================================
    
    pure function i_times_gav(a, obj) result(r)
        integer, intent(in)              :: a
        class(g_auto_var(*)), intent(in) :: obj
        type(g_auto_var(obj%n)) :: r
        r = obj * a
    end function i_times_gav

    pure function gav_times_i(this,a) result(r)
        class(g_auto_var(*)), intent(in) :: this
        integer, intent(in)              :: a
        type(g_auto_var(this%n)) :: r
        r%v = this%v * a
        r%d = this%d * a
    end function gav_times_i

    pure function gav_times_gav(this, a) result(r)
        class(g_auto_var(*)), intent(in) :: this
        type(g_auto_var(*)), intent(in)  :: a
        type(g_auto_var(this%n)) :: r
        r%v = this%v*a%v
    end function gav_times_gav

    ! === plus  =========================================================================

    pure function i_plus_gav(a, obj) result(r)
        integer, intent(in)              :: a
        class(g_auto_var(*)), intent(in) :: obj
        type(g_auto_var(obj%n)) :: r
        r = obj + a
    end function i_plus_gav
    
    pure function gav_plus_i(this,a) result(r)
        class(g_auto_var(*)), intent(in) :: this
        integer, intent(in)              :: a
        type(g_auto_var(this%n)) :: r
        r%v = this%v + a
        r%d = this%d
    end function gav_plus_i

    pure function gav_plus_gav(this, a) result(r)
        class(g_auto_var(*)), intent(in) :: this
        type(g_auto_var(*)), intent(in)  :: a
        type(g_auto_var(this%n)) :: r
        r%v = this%v + a%v
        r%d = this%d + a%d
    end function gav_plus_gav

end module AG


program utest

    use AG, Dg => g_auto_var

    type(Dg(2)) :: s, u, v, w
    real(8)     :: t

    t = 0.5d0
    call s%set(t)
    u = 3*s
    u = s + 1
    v = 3*s + 1
    w = 1 + 3*s
    u = u + v
    w = u * v
end program utest
