Simulation Core
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

159 lines
4.7 KiB

  1. module DynamicIntegerArray
  2. implicit none
  3. public
  4. type, public :: DynamicIntegerArrayType
  5. integer, allocatable :: Array(:)
  6. contains
  7. procedure :: First => First
  8. procedure :: Last => Last
  9. procedure :: Length => Length
  10. procedure :: Add => Add
  11. procedure :: AddToFirst => AddToFirst
  12. procedure :: AddTo => AddTo
  13. procedure :: Remove => Remove
  14. procedure :: Empty => Empty
  15. end type DynamicIntegerArrayType
  16. private::First,Last,Length
  17. contains
  18. integer function First(this)
  19. implicit none
  20. class(DynamicIntegerArrayType), intent(in) :: this
  21. if(allocated(this%Array) .and. size(this%Array) > 0) then
  22. First = this%Array(1)
  23. return
  24. end if
  25. First = 0
  26. end function
  27. integer function Last(this)
  28. implicit none
  29. class(DynamicIntegerArrayType), intent(in) :: this
  30. if(allocated(this%Array) .and. size(this%Array) > 0) then
  31. Last = this%Array(size(this%Array))
  32. return
  33. end if
  34. Last = 0
  35. end function
  36. integer function Length(this)
  37. implicit none
  38. class(DynamicIntegerArrayType), intent(in) :: this
  39. if(allocated(this%Array)) then
  40. Length = size(this%Array)
  41. return
  42. end if
  43. Length = 0
  44. end function
  45. subroutine AddToFirst(this, value)
  46. implicit none
  47. class(DynamicIntegerArrayType), intent(inout) :: this
  48. integer, allocatable :: tempArr(:)
  49. integer, intent(in) :: value
  50. integer :: i, isize
  51. if(allocated(this%Array)) then
  52. isize = size(this%Array)
  53. allocate(tempArr(isize+1))
  54. tempArr(1) = value
  55. do i=2,isize+1
  56. tempArr(i) = this%Array(i-1)
  57. end do
  58. deallocate(this%Array)
  59. call move_alloc(tempArr, this%Array)
  60. else
  61. allocate(this%Array(1))
  62. this%Array(1) = value
  63. end if
  64. end subroutine
  65. subroutine AddTo(this, index, value)
  66. implicit none
  67. class(DynamicIntegerArrayType), intent(inout) :: this
  68. integer, allocatable :: tempArr(:)
  69. integer, intent(in) :: index
  70. integer, intent(in) :: value
  71. integer :: i, isize
  72. if(index <= 0) return
  73. if(index > size(this%Array)) then
  74. call this%Add(value)
  75. return
  76. endif
  77. if(allocated(this%Array)) then
  78. isize = size(this%Array)
  79. allocate(tempArr(isize+1))
  80. tempArr(:index-1) = this%Array(:index-1)
  81. tempArr(index) = value
  82. tempArr(index+1:) = this%Array(index:)
  83. deallocate(this%Array)
  84. call move_alloc(tempArr, this%Array)
  85. end if
  86. end subroutine
  87. subroutine Add(this, value)
  88. implicit none
  89. class(DynamicIntegerArrayType), intent(inout) :: this
  90. integer, allocatable :: tempArr(:)
  91. integer, intent(in) :: value
  92. integer :: i, isize
  93. if(allocated(this%Array)) then
  94. isize = size(this%Array)
  95. allocate(tempArr(isize+1))
  96. do i=1,isize
  97. tempArr(i) = this%Array(i)
  98. end do
  99. tempArr(isize+1) = value
  100. deallocate(this%Array)
  101. call move_alloc(tempArr, this%Array)
  102. else
  103. allocate(this%Array(1))
  104. this%Array(1) = value
  105. end if
  106. end subroutine
  107. subroutine Empty(this)
  108. implicit none
  109. class(DynamicIntegerArrayType), intent(inout) :: this
  110. if(allocated(this%Array)) deallocate(this%Array)
  111. end subroutine
  112. subroutine Remove(this, index)
  113. implicit none
  114. class(DynamicIntegerArrayType), intent(inout) :: this
  115. integer, intent(in) :: index
  116. integer, allocatable :: tempArr(:)
  117. integer :: i
  118. logical :: found
  119. if(index <= 0 .or. index > size(this%Array)) return
  120. if(.not.allocated(this%Array))return
  121. allocate(tempArr(size(this%Array)-1))
  122. found = .false.
  123. do i=1, size(this%Array)
  124. if(i==index) then
  125. found = .true.
  126. cycle
  127. end if
  128. if(found) then
  129. tempArr(i-1) = this%Array(i)
  130. else
  131. tempArr(i) = this%Array(i)
  132. endif
  133. end do
  134. deallocate(this%Array)
  135. call move_alloc(tempArr, this%Array)
  136. end subroutine
  137. end module DynamicIntegerArray