2 #define ARRAYOF_TYPE arrayof_/**/ARRAYOF_ORIGTYPE
8 SUBROUTINE arrayof_type/**/_insert_array(this, content, nelem, pos)
9 TYPE(arrayof_type
) :: this
10 arrayof_origtype,
INTENT(in),
OPTIONAL :: content(:)
11 INTEGER,
INTENT(in),
OPTIONAL :: nelem
12 INTEGER,
INTENT(in),
OPTIONAL :: pos
16 IF (present(content))
THEN
18 ELSE IF (present(nelem))
THEN
25 IF (present(pos))
THEN
26 p = max(1, min(pos, this%arraysize+1))
28 p = this%arraysize + 1
30 this%arraysize = this%arraysize + n
35 CALL arrayof_type/**/_alloc(this)
36 DO i = this%arraysize, p+n, -1
37 this%array(i) = this%array(i-n)
39 IF (present(content))
THEN
40 this%array(p:p+n-1) = content(:)
43 END SUBROUTINE ARRAYOF_TYPE/**/_insert_array
48 SUBROUTINE arrayof_type/**/_insert(this, content, pos)
49 TYPE(arrayof_type
) :: this
50 arrayof_origtype,
INTENT(in) :: content
51 INTEGER,
INTENT(in),
OPTIONAL :: pos
53 CALL
insert(this, (/content/), pos=pos)
55 END SUBROUTINE ARRAYOF_TYPE/**/_insert
61 FUNCTION arrayof_type/**/_append(this, content) RESULT(pos)
62 TYPE(arrayof_type
) :: this
63 arrayof_origtype,
INTENT(in) :: content
66 this%arraysize = this%arraysize + 1
68 CALL arrayof_type/**/_alloc(this)
69 this%array(this%arraysize) = content
71 END FUNCTION ARRAYOF_TYPE/**/_append
78 SUBROUTINE arrayof_type/**/_insert_unique(this, content, pos)
79 TYPE(arrayof_type
) :: this
80 arrayof_origtype,
INTENT(in) :: content
81 INTEGER,
INTENT(in),
OPTIONAL :: pos
85 DO i = 1, this%arraysize
86 IF (this%array(i) == content)
RETURN
89 CALL
insert(this, (/content/), pos=pos)
91 END SUBROUTINE ARRAYOF_TYPE/**/_insert_unique
98 FUNCTION arrayof_type/**/_append_unique(this, content) RESULT(pos)
99 TYPE(arrayof_type
) :: this
100 arrayof_origtype,
INTENT(in) :: content
103 DO pos = 1, this%arraysize
104 IF (this%array(pos) == content)
RETURN
107 this%arraysize = this%arraysize + 1
109 CALL arrayof_type/**/_alloc(this)
110 this%array(this%arraysize) = content
112 END FUNCTION ARRAYOF_TYPE/**/_append_unique
115 #ifdef ARRAYOF_ORIGGT
120 FUNCTION arrayof_type/**/_insert_sorted(this, content, incr, back) RESULT(pos)
121 TYPE(arrayof_type
) :: this
122 arrayof_origtype,
INTENT(in) :: content
123 LOGICAL,
INTENT(in) :: incr
124 LOGICAL,
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
150 CALL
insert(this, (/content/), pos=pos)
152 END FUNCTION ARRAYOF_TYPE/**/_insert_sorted
159 SUBROUTINE arrayof_type/**/_remove(this, nelem, pos &
160 #ifdef ARRAYOF_ORIGDESTRUCTOR
164 TYPE(arrayof_type
) :: this
165 INTEGER,
INTENT(in),
OPTIONAL :: nelem
166 INTEGER,
INTENT(in),
OPTIONAL :: pos
167 #ifdef ARRAYOF_ORIGDESTRUCTOR
168 LOGICAL,
INTENT(in),
OPTIONAL :: nodestroy
172 #ifdef ARRAYOF_ORIGDESTRUCTOR
176 IF (this%arraysize <= 0)
RETURN
177 IF (present(nelem))
THEN
184 IF (present(pos))
THEN
185 p = max(1, min(pos, this%arraysize-n+1))
187 p = this%arraysize - n + 1
194 #ifdef ARRAYOF_ORIGDESTRUCTOR
196 IF (present(nodestroy))
THEN
197 destroy = .NOT.nodestroy
201 arrayof_origdestructor(this%array(i))
206 this%arraysize = this%arraysize - n
207 DO i = p, this%arraysize
208 this%array(i) = this%array(i+n)
210 CALL arrayof_type/**/_alloc(this)
212 END SUBROUTINE ARRAYOF_TYPE/**/_remove
218 SUBROUTINE arrayof_type/**/_delete(this, &
219 #ifdef ARRAYOF_ORIGDESTRUCTOR
223 TYPE(arrayof_type
) :: this
224 #ifdef ARRAYOF_ORIGDESTRUCTOR
225 LOGICAL,
INTENT(in),
OPTIONAL :: nodestroy
227 LOGICAL,
INTENT(in),
OPTIONAL :: nodealloc
229 TYPE(arrayof_type
) :: empty
231 #ifdef ARRAYOF_ORIGDESTRUCTOR
240 IF (
ASSOCIATED(this%array))
THEN
242 #ifdef ARRAYOF_ORIGDESTRUCTOR
244 IF (present(nodestroy))
THEN
245 destroy = .NOT.nodestroy
248 DO i = 1, this%arraysize
249 arrayof_origdestructor(this%array(i))
255 IF (present(nodealloc))
THEN
256 dealloc = .NOT.nodealloc
259 DEALLOCATE(this%array)
265 END SUBROUTINE ARRAYOF_TYPE/**/_delete
274 SUBROUTINE arrayof_type/**/_packarray(this)
275 TYPE(arrayof_type
) :: this
277 DOUBLE PRECISION :: tmpoveralloc
282 tmpoveralloc = this%overalloc
283 this%overalloc = 1.0d0
284 CALL arrayof_type/**/_alloc(this)
285 this%overalloc = tmpoveralloc
287 END SUBROUTINE ARRAYOF_TYPE/**/_packarray
290 SUBROUTINE arrayof_type/**/_alloc(this)
291 TYPE(arrayof_type
) :: this
293 arrayof_origtype,
POINTER :: tmpptr(:)
294 INTEGER :: newsize, copysize
296 newsize = max(int(this%arraysize*this%overalloc), this%arraysize)
298 IF (
ASSOCIATED(this%array))
THEN
300 IF (
SIZE(this%array) >= this%arraysize .AND.
SIZE(this%array) <= newsize)
RETURN
302 IF (
SIZE(this%array) > newsize) newsize = this%arraysize
307 ALLOCATE(this%array(newsize))
308 copysize = min(this%arraysize,
SIZE(tmpptr))
309 this%array(1:copysize) = tmpptr(1:copysize)
315 ALLOCATE(this%array(newsize))
318 END SUBROUTINE ARRAYOF_TYPE/**/_alloc
Method for inserting elements of the array at a desired position.