libsim Versione 7.2.1
array_utilities.F90
1! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2! authors:
3! Davide Cesari <dcesari@arpa.emr.it>
4! Paolo Patruno <ppatruno@arpa.emr.it>
5
6! This program is free software; you can redistribute it and/or
7! modify it under the terms of the GNU General Public License as
8! published by the Free Software Foundation; either version 2 of
9! the License, or (at your option) any later version.
10
11! This program is distributed in the hope that it will be useful,
12! but WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14! GNU General Public License for more details.
15
16! You should have received a copy of the GNU General Public License
17! along with this program. If not, see <http://www.gnu.org/licenses/>.
18
19
20
23#include "config.h"
24MODULE array_utilities
25
26IMPLICIT NONE
27
28! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
29!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
30
31#undef VOL7D_POLY_TYPE_AUTO
32
33#undef VOL7D_POLY_TYPE
34#undef VOL7D_POLY_TYPES
35#define VOL7D_POLY_TYPE INTEGER
36#define VOL7D_POLY_TYPES _i
37#define ENABLE_SORT
38#include "array_utilities_pre.F90"
39#undef ENABLE_SORT
40
41#undef VOL7D_POLY_TYPE
42#undef VOL7D_POLY_TYPES
43#define VOL7D_POLY_TYPE REAL
44#define VOL7D_POLY_TYPES _r
45#define ENABLE_SORT
46#include "array_utilities_pre.F90"
47#undef ENABLE_SORT
48
49#undef VOL7D_POLY_TYPE
50#undef VOL7D_POLY_TYPES
51#define VOL7D_POLY_TYPE DOUBLEPRECISION
52#define VOL7D_POLY_TYPES _d
53#define ENABLE_SORT
54#include "array_utilities_pre.F90"
55#undef ENABLE_SORT
56
57#define VOL7D_NO_PACK
58#undef VOL7D_POLY_TYPE
59#undef VOL7D_POLY_TYPES
60#define VOL7D_POLY_TYPE CHARACTER(len=*)
61#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
62#define VOL7D_POLY_TYPES _c
63#define ENABLE_SORT
64#include "array_utilities_pre.F90"
65#undef VOL7D_POLY_TYPE_AUTO
66#undef ENABLE_SORT
67
68
69#define ARRAYOF_ORIGEQ 1
70
71#define ARRAYOF_ORIGTYPE INTEGER
72#define ARRAYOF_TYPE arrayof_integer
73#include "arrayof_pre.F90"
74
75#undef ARRAYOF_ORIGTYPE
76#undef ARRAYOF_TYPE
77#define ARRAYOF_ORIGTYPE REAL
78#define ARRAYOF_TYPE arrayof_real
79#include "arrayof_pre.F90"
80
81#undef ARRAYOF_ORIGTYPE
82#undef ARRAYOF_TYPE
83#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
84#define ARRAYOF_TYPE arrayof_doubleprecision
85#include "arrayof_pre.F90"
86
87#undef ARRAYOF_ORIGEQ
88
89#undef ARRAYOF_ORIGTYPE
90#undef ARRAYOF_TYPE
91#define ARRAYOF_ORIGTYPE LOGICAL
92#define ARRAYOF_TYPE arrayof_logical
93#include "arrayof_pre.F90"
94
95PRIVATE
96! from arrayof
98PUBLIC insert_unique, append_unique
99
100PUBLIC sort, index, index_c, &
101 count_distinct_sorted, pack_distinct_sorted, &
102 count_distinct, pack_distinct, count_and_pack_distinct, &
103 map_distinct, map_inv_distinct, &
104 firsttrue, lasttrue, pack_distinct_c, map
105
106CONTAINS
107
108
111FUNCTION firsttrue(v) RESULT(i)
112LOGICAL,INTENT(in) :: v(:)
113INTEGER :: i
114
115DO i = 1, SIZE(v)
116 IF (v(i)) RETURN
117ENDDO
118i = 0
119
120END FUNCTION firsttrue
121
122
125FUNCTION lasttrue(v) RESULT(i)
126LOGICAL,INTENT(in) :: v(:)
127INTEGER :: i
128
129DO i = SIZE(v), 1, -1
130 IF (v(i)) RETURN
131ENDDO
132
133END FUNCTION lasttrue
134
135
136! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
137#undef VOL7D_POLY_TYPE_AUTO
138#undef VOL7D_NO_PACK
139
140#undef VOL7D_POLY_TYPE
141#undef VOL7D_POLY_TYPES
142#define VOL7D_POLY_TYPE INTEGER
143#define VOL7D_POLY_TYPES _i
144#define ENABLE_SORT
145#include "array_utilities_inc.F90"
146#undef ENABLE_SORT
147
148#undef VOL7D_POLY_TYPE
149#undef VOL7D_POLY_TYPES
150#define VOL7D_POLY_TYPE REAL
151#define VOL7D_POLY_TYPES _r
152#define ENABLE_SORT
153#include "array_utilities_inc.F90"
154#undef ENABLE_SORT
155
156#undef VOL7D_POLY_TYPE
157#undef VOL7D_POLY_TYPES
158#define VOL7D_POLY_TYPE DOUBLEPRECISION
159#define VOL7D_POLY_TYPES _d
160#define ENABLE_SORT
161#include "array_utilities_inc.F90"
162#undef ENABLE_SORT
163
164#define VOL7D_NO_PACK
165#undef VOL7D_POLY_TYPE
166#undef VOL7D_POLY_TYPES
167#define VOL7D_POLY_TYPE CHARACTER(len=*)
168#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
169#define VOL7D_POLY_TYPES _c
170#define ENABLE_SORT
171#include "array_utilities_inc.F90"
172#undef VOL7D_POLY_TYPE_AUTO
173#undef ENABLE_SORT
174
175SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
176CHARACTER(len=*),INTENT(in) :: vect(:)
177LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
178CHARACTER(len=LEN(vect)) :: pack_distinct(:)
179
180INTEGER :: count_distinct
181INTEGER :: i, j, dim
182LOGICAL :: lback
183
184dim = SIZE(pack_distinct)
185IF (PRESENT(back)) THEN
186 lback = back
187ELSE
188 lback = .false.
189ENDIF
190count_distinct = 0
191
192IF (PRESENT (mask)) THEN
193 IF (lback) THEN
194 vectm1: DO i = 1, SIZE(vect)
195 IF (.NOT.mask(i)) cycle vectm1
196! DO j = i-1, 1, -1
197! IF (vect(j) == vect(i)) CYCLE vectm1
198 DO j = count_distinct, 1, -1
199 IF (pack_distinct(j) == vect(i)) cycle vectm1
200 ENDDO
201 count_distinct = count_distinct + 1
202 IF (count_distinct > dim) EXIT
203 pack_distinct(count_distinct) = vect(i)
204 ENDDO vectm1
205 ELSE
206 vectm2: DO i = 1, SIZE(vect)
207 IF (.NOT.mask(i)) cycle vectm2
208! DO j = 1, i-1
209! IF (vect(j) == vect(i)) CYCLE vectm2
210 DO j = 1, count_distinct
211 IF (pack_distinct(j) == vect(i)) cycle vectm2
212 ENDDO
213 count_distinct = count_distinct + 1
214 IF (count_distinct > dim) EXIT
215 pack_distinct(count_distinct) = vect(i)
216 ENDDO vectm2
217 ENDIF
218ELSE
219 IF (lback) THEN
220 vect1: DO i = 1, SIZE(vect)
221! DO j = i-1, 1, -1
222! IF (vect(j) == vect(i)) CYCLE vect1
223 DO j = count_distinct, 1, -1
224 IF (pack_distinct(j) == vect(i)) cycle vect1
225 ENDDO
226 count_distinct = count_distinct + 1
227 IF (count_distinct > dim) EXIT
228 pack_distinct(count_distinct) = vect(i)
229 ENDDO vect1
230 ELSE
231 vect2: DO i = 1, SIZE(vect)
232! DO j = 1, i-1
233! IF (vect(j) == vect(i)) CYCLE vect2
234 DO j = 1, count_distinct
235 IF (pack_distinct(j) == vect(i)) cycle vect2
236 ENDDO
237 count_distinct = count_distinct + 1
238 IF (count_distinct > dim) EXIT
239 pack_distinct(count_distinct) = vect(i)
240 ENDDO vect2
241 ENDIF
242ENDIF
243
244END SUBROUTINE pack_distinct_c
245
247FUNCTION map(mask) RESULT(mapidx)
248LOGICAL,INTENT(in) :: mask(:)
249INTEGER :: mapidx(count(mask))
250
251INTEGER :: i,j
252
253j = 0
254DO i=1, SIZE(mask)
255 j = j + 1
256 IF (mask(i)) mapidx(j)=i
257ENDDO
258
259END FUNCTION map
260
261#define ARRAYOF_ORIGEQ 1
262
263#undef ARRAYOF_ORIGTYPE
264#undef ARRAYOF_TYPE
265#define ARRAYOF_ORIGTYPE INTEGER
266#define ARRAYOF_TYPE arrayof_integer
267#include "arrayof_post.F90"
268
269#undef ARRAYOF_ORIGTYPE
270#undef ARRAYOF_TYPE
271#define ARRAYOF_ORIGTYPE REAL
272#define ARRAYOF_TYPE arrayof_real
273#include "arrayof_post.F90"
274
275#undef ARRAYOF_ORIGTYPE
276#undef ARRAYOF_TYPE
277#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
278#define ARRAYOF_TYPE arrayof_doubleprecision
279#include "arrayof_post.F90"
280
281#undef ARRAYOF_ORIGEQ
282
283#undef ARRAYOF_ORIGTYPE
284#undef ARRAYOF_TYPE
285#define ARRAYOF_ORIGTYPE LOGICAL
286#define ARRAYOF_TYPE arrayof_logical
287#include "arrayof_post.F90"
288
289END MODULE array_utilities
Quick method to append an element to the array.
Destructor for finalizing an array object.
Index method with sorted array.
Method for inserting elements of the array at a desired position.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Method for removing elements of the array at a desired position.
Index method.
This module defines usefull general purpose function and subroutine.
Derived type defining a dynamically extensible array of DOUBLEPRECISION elements.
Derived type defining a dynamically extensible array of INTEGER elements.
Derived type defining a dynamically extensible array of LOGICAL elements.
Derived type defining a dynamically extensible array of REAL elements.

Generated with Doxygen.