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.

CPath.f90 6.4 KiB

1 year ago
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231
  1. module CPath
  2. use CLog5
  3. implicit none
  4. public
  5. type, public :: Path
  6. integer, allocatable :: Valves(:)
  7. logical :: IsClosed
  8. contains
  9. procedure :: Display => Display
  10. procedure :: DisplayWrite => DisplayWrite
  11. procedure :: First => First
  12. procedure :: Last => Last
  13. procedure :: Length => Length
  14. procedure :: Get => Get
  15. procedure :: Add => Add
  16. procedure :: Remove => Remove
  17. procedure :: Purge => Purge
  18. procedure :: Copy => Copy
  19. procedure :: MakeNull => MakeNull
  20. procedure :: IsNull => IsNull
  21. procedure :: Equal => Equal
  22. procedure :: Find => Find
  23. end type Path
  24. contains
  25. subroutine DisplayWrite(this)
  26. implicit none
  27. class(Path), intent(in) :: this
  28. character(len=512) :: temp
  29. integer :: i
  30. if(allocated(this%valves)) then
  31. write(temp, '(a1,i0,a3,i0,a4,9999(g0))') '(', this%First(), '<=>', this%Last(), ') : ', (this%Valves(i), ", ",i=1,size(this%Valves))
  32. write(*,*) temp
  33. end if
  34. end subroutine
  35. subroutine Display(this)
  36. implicit none
  37. class(Path), intent(in) :: this
  38. character(len=512) :: temp
  39. integer :: i
  40. if(allocated(this%valves)) then
  41. write(temp, '(a1,i0,a3,i0,a4,9999(g0))') '(', this%First(), '<=>', this%Last(), ') : ', (this%Valves(i), ", ",i=1,size(this%Valves))
  42. call Log_5(temp)
  43. end if
  44. end subroutine
  45. integer function First(this)
  46. implicit none
  47. class(Path), intent(in) :: this
  48. if(allocated(this%Valves) .and. size(this%Valves) > 0) then
  49. First = this%Valves(1)
  50. return
  51. end if
  52. First = 0
  53. end function
  54. integer function Last(this)
  55. implicit none
  56. class(Path), intent(in) :: this
  57. if(allocated(this%Valves) .and. size(this%Valves) > 0) then
  58. Last = this%Valves(size(this%Valves))
  59. return
  60. end if
  61. Last = 0
  62. end function
  63. integer function Length(this)
  64. implicit none
  65. class(Path), intent(in) :: this
  66. if(allocated(this%Valves)) then
  67. Length = size(this%Valves)
  68. return
  69. end if
  70. Length = 0
  71. end function
  72. integer function Get(this, index)
  73. implicit none
  74. class(Path), intent(in) :: this
  75. integer, intent(in) :: index
  76. if(allocated(this%Valves)) then
  77. if(index < 1 .or. index > size(this%Valves)) then
  78. Get = -1
  79. return
  80. endif
  81. Get = this%Valves(index)
  82. return
  83. end if
  84. get = -1
  85. end function
  86. subroutine Add(this, value)
  87. implicit none
  88. class(Path), intent(inout) :: this
  89. integer, allocatable :: tempArr(:)
  90. integer, intent(in) :: value
  91. integer :: i, isize
  92. if(allocated(this%Valves)) then
  93. isize = size(this%Valves)
  94. allocate(tempArr(isize+1))
  95. do i=1,isize
  96. tempArr(i) = this%Valves(i)
  97. end do
  98. tempArr(isize+1) = value
  99. deallocate(this%Valves)
  100. call move_alloc(tempArr, this%Valves)
  101. else
  102. allocate(this%Valves(1))
  103. this%Valves(1) = value
  104. end if
  105. end subroutine
  106. subroutine Remove(this, index)
  107. implicit none
  108. class(Path), intent(inout) :: this
  109. integer, intent(in) :: index
  110. integer, allocatable :: tempArr(:)
  111. integer :: i
  112. logical :: found
  113. if(index <= 0 .or. index > size(this%Valves)) return
  114. if(.not.allocated(this%Valves))return
  115. allocate(tempArr(size(this%Valves)-1))
  116. found = .false.
  117. do i=1, size(this%Valves)
  118. if(i==index) then
  119. found = .true.
  120. cycle
  121. end if
  122. if(found) then
  123. tempArr(i-1) = this%Valves(i)
  124. else
  125. tempArr(i) = this%Valves(i)
  126. endif
  127. end do
  128. deallocate(this%valves)
  129. call move_alloc(tempArr, this%valves)
  130. end subroutine
  131. subroutine Purge(this, min, max)
  132. implicit none
  133. class(Path), intent(inout) :: this
  134. integer, intent(in) :: min
  135. integer, intent(in) :: max
  136. integer :: i
  137. i = 1
  138. do
  139. !
  140. if(this%Valves(i) >= min .and. this%Valves(i) <= max) then
  141. call this%Remove(i)
  142. else
  143. i = i + 1
  144. endif
  145. if(i > this%Length()) exit
  146. enddo
  147. end subroutine
  148. subroutine Copy(this, from)
  149. implicit none
  150. class(Path), intent(inout) :: this
  151. class(Path), intent(in) :: from
  152. if(allocated(from%Valves)) then
  153. if(allocated(this%Valves)) deallocate(this%Valves)
  154. allocate(this%Valves(size(from%Valves)))
  155. this%Valves(:) = from%Valves(:)
  156. end if
  157. end subroutine
  158. subroutine MakeNull(this)
  159. implicit none
  160. class(Path), intent(inout) :: this
  161. if(allocated(this%Valves)) deallocate(this%Valves)
  162. end subroutine
  163. logical function IsNull(this)
  164. implicit none
  165. class(Path), intent(in) :: this
  166. IsNull = .not.allocated(this%Valves)
  167. return
  168. end function
  169. logical function Equal(this, otherPath)
  170. implicit none
  171. class(Path), intent(inout) :: this
  172. class(Path), intent(in) :: otherPath
  173. integer :: i, sizeThis, sizeOtherPath
  174. sizeThis = size(this%Valves)
  175. sizeOtherPath = size(otherPath%Valves)
  176. if(sizeThis /= sizeOtherPath) then
  177. Equal = .false.
  178. return
  179. end if
  180. do i = 1, sizeThis
  181. if(this%Valves(i) /= otherPath%Valves(i)) then
  182. Equal = .false.
  183. return
  184. end if
  185. end do
  186. Equal = .true.
  187. return
  188. end function
  189. logical function Find(this, value)
  190. implicit none
  191. class(Path), intent(in) :: this
  192. integer, intent(in) :: value
  193. if(allocated(this%Valves)) then
  194. Find = any(this%Valves == value)
  195. return
  196. end if
  197. Find = .false.
  198. end function
  199. end module CPath