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.

DynamicLogicalArray.i90 4.6 KiB

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