libsim  Versione7.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"
24 MODULE array_utilities
25 
26 IMPLICIT 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 
95 PRIVATE
96 ! from arrayof
98 PUBLIC insert_unique, append_unique
99 
100 PUBLIC 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 
106 CONTAINS
107 
108 
111 FUNCTION firsttrue(v) RESULT(i)
112 LOGICAL,INTENT(in) :: v(:)
113 INTEGER :: i
114 
115 DO i = 1, SIZE(v)
116  IF (v(i)) RETURN
117 ENDDO
118 i = 0
119 
120 END FUNCTION firsttrue
121 
122 
125 FUNCTION lasttrue(v) RESULT(i)
126 LOGICAL,INTENT(in) :: v(:)
127 INTEGER :: i
128 
129 DO i = SIZE(v), 1, -1
130  IF (v(i)) RETURN
131 ENDDO
132 
133 END 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 
175 SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
176 CHARACTER(len=*),INTENT(in) :: vect(:)
177 LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
178 CHARACTER(len=LEN(vect)) :: pack_distinct(:)
179 
180 INTEGER :: count_distinct
181 INTEGER :: i, j, dim
182 LOGICAL :: lback
183 
184 dim = SIZE(pack_distinct)
185 IF (PRESENT(back)) THEN
186  lback = back
187 ELSE
188  lback = .false.
189 ENDIF
190 count_distinct = 0
191 
192 IF (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
218 ELSE
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
242 ENDIF
243 
244 END SUBROUTINE pack_distinct_c
245 
247 FUNCTION map(mask) RESULT(mapidx)
248 LOGICAL,INTENT(in) :: mask(:)
249 INTEGER :: mapidx(count(mask))
250 
251 INTEGER :: i,j
252 
253 j = 0
254 DO i=1, SIZE(mask)
255  j = j + 1
256  IF (mask(i)) mapidx(j)=i
257 ENDDO
258 
259 END 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"
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 
289 END MODULE array_utilities
Method for removing elements of the array at a desired position.
Quick method to append an element to the array.
Index method.
This module defines usefull general purpose function and subroutine.
Destructor for finalizing an array object.
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...

Generated with Doxygen.