module shallow_water

    integer, parameter:: double = kind(0.0d0)

    type shallow
        real(double), pointer:: u(:, :), ux(:, :), uy(:, :)
        real(double), pointer:: v(:, :), vx(:, :), vy(:, :)
        real(double), pointer:: h(:, :), hx(:, :), hy(:, :)
        ! 関数結果の場合だけ真, 変数にストアされると偽.
        logical:: temporary
    end type

    interface allocate
        module procedure allocate_basic
        module procedure allocate_constant
    end interface

    interface assignment(=)
        module procedure assign
    end interface

    interface operator(+)
        module procedure add
    end interface

    interface operator(*)
        module procedure mul
    end interface

    interface size
        module procedure size_shallow
    end interface

contains

        ! 不定結合状態の変数を初期化
    subroutine nullify(shall)
        type(SHALLOW):: shall
        nullify(shall%u, shall%u, shall%v)
        nullify(shall%ux, shall%uy, shall%vx)
        nullify(shall%vy, shall%hx, shall%hy)
        shall%temporary = .FALSE.
    end subroutine

        ! 不定結合状態の変数を初期化
    subroutine allocate_basic(shall, nx, ny, temporary)
        type(SHALLOW):: shall
        integer, intent(in):: nx, ny
        logical, intent(in), optional:: temporary
    continue
        allocate(shall%u(nx, ny), shall%v(nx, ny), shall%h(nx, ny))
        nullify(shall%ux, shall%uy, shall%vx, shall%vy, shall%hx, shall%hy)
        shall%temporary = .FALSE.
        if (present(temporary)) shall%temporary = temporary
    end subroutine

    subroutine deallocate(shall)
        type(SHALLOW):: shall
        if (associated(shall%u)) deallocate(shall%u, shall%v, shall%h)
        call nullify(shall)
        shall%temporary = .FALSE.
    end subroutine

    subroutine assign(lhs, rhs)
        type(SHALLOW), intent(out):: lhs
        type(SHALLOW), intent(in):: rhs
        lhs%temporary = .FALSE.
        lhs%u => rhs%u
        lhs%v => rhs%v
        lhs%h => rhs%h
    end subroutine

    integer function size_shallow(stat, dimord) result(result)
        type(SHALLOW):: stat
        integer:: dimord
        select case(dimord)
        case(1)
            result = size(stat%h, 1)
        case(2)
            result = size(stat%h, 2)
        case default
            result = 0
        end select
    end function

    type(SHALLOW) function add(lhs, rhs) result(result)
        type(SHALLOW), intent(in):: lhs
        type(SHALLOW), intent(in):: rhs
        call allocate(result, size(lhs, 1), size(lhs, 2))
        result%temporary = .TRUE.
        result%u = lhs%u + rhs%u
        result%v = lhs%v + rhs%v
        result%h = lhs%h + rhs%h
        if (lhs%temporary) call deallocate(lhs)
        if (rhs%temporary) call deallocate(rhs)
    end function

    type(SHALLOW) function mul(lhs, rhs) result(result)
        real(DOUBLE), intent(in):: lhs
        type(SHALLOW), intent(in):: rhs
        call Allocate(result, size(rhs, 1), size(rhs, 2))
        result%temporary = .TRUE.
        result%u = lhs * rhs%u
        result%v = lhs * rhs%v
        result%h = lhs * rhs%h
        if (rhs%temporary) call deallocate(rhs)
    end function

        ! 不定結合状態の変数を初期化
    subroutine allocate_constant(stat, nx, ny, H)
        type(SHALLOW):: stat
        integer, intent(in):: nx, ny
        real(double), intent(in):: H
    continue
        call Allocate(stat, nx, ny)
        stat%u(:, :) = 0.0_double
        stat%v(:, :) = 0.0_double
        stat%h(:, :) = H
    end subroutine

end module shallow_water