vector.f90

MODULE vector
    IMPLICIT NONE
    PUBLIC :: VEC, VEC_INIT, VEC_SET, VEC_PUSH_BACK, VEC_POP_BACK, VEC_SWAP, VEC_ENLARGE, VEC_DEALLOCATE

    TYPE :: VEC_ELEM
        CLASS(*), ALLOCATABLE :: VALUE
    END TYPE VEC_ELEM

    TYPE :: VEC
        TYPE(VEC_ELEM), ALLOCATABLE :: DATA(:)
        INTEGER :: SIZE, CAPACITY
    END TYPE VEC

CONTAINS
    SUBROUTINE VEC_INIT(V)
        CLASS(VEC), INTENT(INOUT) :: V

        V%SIZE = 0
        V%CAPACITY = 0
        ALLOCATE (V%DATA(0))

    END SUBROUTINE VEC_INIT

    SUBROUTINE VEC_SET(V, INDEX, VALUE)
        CLASS(VEC), INTENT(INOUT) :: V
        INTEGER, INTENT(IN) :: INDEX
        CLASS(*), INTENT(IN) :: VALUE

        IF (ALLOCATED(V%DATA(INDEX)%VALUE)) THEN
            DEALLOCATE (V%DATA(INDEX)%VALUE)
        END IF
        ALLOCATE (V%DATA(INDEX)%VALUE, SOURCE=VALUE)

    END SUBROUTINE VEC_SET

    SUBROUTINE VEC_PUSH_BACK(V, VALUE)
        CLASS(VEC), INTENT(INOUT) :: V
        CLASS(*), INTENT(IN) :: VALUE

        IF (V%SIZE == V%CAPACITY) THEN
            CALL VEC_ENLARGE(V, MAX(SHIFTL(V%CAPACITY, 1), 1))
        END IF

        V%SIZE = V%SIZE + 1
        CALL VEC_SET(V, V%SIZE, VALUE)

    END SUBROUTINE VEC_PUSH_BACK

    SUBROUTINE VEC_POP_BACK(V)
        CLASS(VEC), INTENT(INOUT) :: V

        DEALLOCATE (V%DATA(V%SIZE)%VALUE)
        V%SIZE = V%SIZE - 1

    END SUBROUTINE VEC_POP_BACK

    SUBROUTINE VEC_SWAP(V, I, J)
        CLASS(VEC), INTENT(INOUT) :: V
        INTEGER, INTENT(IN) :: I, J

        CLASS(*), ALLOCATABLE :: TEMP

        ALLOCATE (TEMP, SOURCE=V%DATA(I)%VALUE)
        CALL VEC_SET(V, I, V%DATA(J)%VALUE)
        CALL VEC_SET(V, J, TEMP)

    END SUBROUTINE VEC_SWAP

    SUBROUTINE VEC_ENLARGE(V, CAPACITY)
        CLASS(VEC), INTENT(INOUT) :: V
        INTEGER, INTENT(IN) :: CAPACITY

        TYPE(VEC_ELEM), ALLOCATABLE :: TEMP(:)

        ALLOCATE (TEMP(V%SIZE), SOURCE=V%DATA(:V%SIZE))

        DEALLOCATE (V%DATA)

        V%CAPACITY = CAPACITY
        ALLOCATE (V%DATA(V%CAPACITY))

        V%DATA(:V%SIZE) = TEMP

    END SUBROUTINE VEC_ENLARGE

    SUBROUTINE VEC_DEALLOCATE(V)
        CLASS(VEC), INTENT(INOUT) :: V

        INTEGER :: I

        DO I = 1, V%SIZE
            DEALLOCATE (V%DATA(I)%VALUE)
        END DO

        DEALLOCATE (V%DATA)

    END SUBROUTINE VEC_DEALLOCATE

END MODULE vector