libsim  Versione 7.1.8
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"
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 
289 END MODULE array_utilities
Quick method to append an element to the array.
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...
Method for removing elements of the array at a desired position.
Index method.
This module defines usefull general purpose function and subroutine.

Generated with Doxygen.