2#define ARRAYOF_TYPE arrayof_/**/ARRAYOF_ORIGTYPE
8SUBROUTINE arrayof_type/**/_insert_array(this, content, nelem, pos)
9TYPE(ARRAYOF_TYPE) :: this
10arrayof_origtype,
INTENT(in),
OPTIONAL :: content(:)
11INTEGER,
INTENT(in),
OPTIONAL :: nelem
12INTEGER,
INTENT(in),
OPTIONAL :: pos
16IF (
PRESENT(content))
THEN
18ELSE IF (
PRESENT(nelem))
THEN
26 p = max(1, min(pos, this%arraysize+1))
28 p = this%arraysize + 1
30this%arraysize = this%arraysize + n
35CALL arrayof_type/**/_alloc(this)
36DO i = this%arraysize, p+n, -1
37 this%array(i) = this%array(i-n)
39IF (
PRESENT(content))
THEN
40 this%array(p:p+n-1) = content(:)
43END SUBROUTINE ARRAYOF_TYPE/**/_insert_array
48SUBROUTINE arrayof_type/**/_insert(this, content, pos)
49TYPE(ARRAYOF_TYPE) :: this
50arrayof_origtype,
INTENT(in) :: content
51INTEGER,
INTENT(in),
OPTIONAL :: pos
53CALL insert(this, (/content/), pos=pos)
55END SUBROUTINE ARRAYOF_TYPE/**/_insert
61FUNCTION arrayof_type/**/_append(this, content)
RESULT(pos)
62TYPE(ARRAYOF_TYPE) :: this
63arrayof_origtype,
INTENT(in) :: content
66this%arraysize = this%arraysize + 1
68CALL arrayof_type/**/_alloc(this)
69this%array(this%arraysize) = content
71END FUNCTION ARRAYOF_TYPE/**/_append
78SUBROUTINE arrayof_type/**/_insert_unique(this, content, pos)
79TYPE(ARRAYOF_TYPE) :: this
80arrayof_origtype,
INTENT(in) :: content
81INTEGER,
INTENT(in),
OPTIONAL :: pos
85DO i = 1, this%arraysize
86 IF (this%array(i) == content)
RETURN
89CALL insert(this, (/content/), pos=pos)
91END SUBROUTINE ARRAYOF_TYPE/**/_insert_unique
98FUNCTION arrayof_type/**/_append_unique(this, content)
RESULT(pos)
99TYPE(ARRAYOF_TYPE) :: this
100arrayof_origtype,
INTENT(in) :: content
103DO pos = 1, this%arraysize
104 IF (this%array(pos) == content)
RETURN
107this%arraysize = this%arraysize + 1
109CALL arrayof_type/**/_alloc(this)
110this%array(this%arraysize) = content
112END FUNCTION ARRAYOF_TYPE/**/_append_unique
120FUNCTION arrayof_type/**/_insert_sorted(this, content, incr, back)
RESULT(pos)
121TYPE(ARRAYOF_TYPE) :: this
122arrayof_origtype,
INTENT(in) :: content
123LOGICAL,
INTENT(in) :: incr
124LOGICAL,
INTENT(in) :: back
130 DO pos = this%arraysize+1, 2, -1
131 IF (this%array(pos-1) < content)
EXIT
134 DO pos = 1, this%arraysize
135 IF (this%array(pos) > content)
EXIT
140 DO pos = this%arraysize+1, 2, -1
141 IF (this%array(pos-1) > content)
EXIT
144 DO pos = 1, this%arraysize
145 IF (this%array(pos) < content)
EXIT
150CALL insert(this, (/content/), pos=pos)
152END FUNCTION ARRAYOF_TYPE/**/_insert_sorted
159SUBROUTINE arrayof_type/**/_remove(this, nelem, pos &
160#ifdef ARRAYOF_ORIGDESTRUCTOR
164TYPE(ARRAYOF_TYPE) :: this
165INTEGER,
INTENT(in),
OPTIONAL :: nelem
166INTEGER,
INTENT(in),
OPTIONAL :: pos
167#ifdef ARRAYOF_ORIGDESTRUCTOR
172LOGICAL,
INTENT(in),
OPTIONAL :: nodestroy
176#ifdef ARRAYOF_ORIGDESTRUCTOR
180IF (this%arraysize <= 0)
RETURN
181IF (
PRESENT(nelem))
THEN
188IF (
PRESENT(pos))
THEN
189 p = max(1, min(pos, this%arraysize-n+1))
191 p = this%arraysize - n + 1
198#ifdef ARRAYOF_ORIGDESTRUCTOR
200IF (
PRESENT(nodestroy))
THEN
201 destroy = .NOT.nodestroy
205 arrayof_origdestructor(this%array(i))
210this%arraysize = this%arraysize - n
211DO i = p, this%arraysize
212 this%array(i) = this%array(i+n)
214CALL arrayof_type/**/_alloc(this)
216END SUBROUTINE ARRAYOF_TYPE/**/_remove
222SUBROUTINE arrayof_type/**/_delete(this, &
223#ifdef ARRAYOF_ORIGDESTRUCTOR
227TYPE(ARRAYOF_TYPE) :: this
228#ifdef ARRAYOF_ORIGDESTRUCTOR
233LOGICAL,
INTENT(in),
OPTIONAL :: nodestroy
241LOGICAL,
INTENT(in),
OPTIONAL :: nodealloc
243TYPE(ARRAYOF_TYPE) :: empty
245#ifdef ARRAYOF_ORIGDESTRUCTOR
254IF (
ASSOCIATED(this%array))
THEN
256#ifdef ARRAYOF_ORIGDESTRUCTOR
258 IF (
PRESENT(nodestroy))
THEN
259 destroy = .NOT.nodestroy
262 DO i = 1, this%arraysize
263 arrayof_origdestructor(this%array(i))
269 IF (
PRESENT(nodealloc))
THEN
270 dealloc = .NOT.nodealloc
273 DEALLOCATE(this%array)
279END SUBROUTINE ARRAYOF_TYPE/**/_delete
288SUBROUTINE arrayof_type/**/_packarray(this)
289TYPE(ARRAYOF_TYPE) :: this
291DOUBLE PRECISION :: tmpoveralloc
296tmpoveralloc = this%overalloc
297this%overalloc = 1.0d0
298CALL arrayof_type/**/_alloc(this)
299this%overalloc = tmpoveralloc
301END SUBROUTINE ARRAYOF_TYPE/**/_packarray
304SUBROUTINE arrayof_type/**/_alloc(this)
305TYPE(ARRAYOF_TYPE) :: this
307arrayof_origtype,
POINTER :: tmpptr(:)
308INTEGER :: newsize, copysize
310newsize = max(int(this%arraysize*this%overalloc), this%arraysize)
312IF (
ASSOCIATED(this%array))
THEN
314 IF (
SIZE(this%array) >= this%arraysize .AND.
SIZE(this%array) <= newsize)
RETURN
316 IF (
SIZE(this%array) > newsize) newsize = this%arraysize
321 ALLOCATE(this%array(newsize))
322 copysize = min(this%arraysize,
SIZE(tmpptr))
323 this%array(1:copysize) = tmpptr(1:copysize)
329 ALLOCATE(this%array(newsize))
332END SUBROUTINE ARRAYOF_TYPE/**/_alloc