Simulation Core
Вы не можете выбрать более 25 тем Темы должны начинаться с буквы или цифры, могут содержать дефисы(-) и должны содержать не более 35 символов.

DynamicIntegerArray.f90 4.5 KiB

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