libsim Versione 7.2.6

◆ pack_distinct_sorted_i()

integer function, dimension(dim) pack_distinct_sorted_i ( integer, dimension(:), intent(in) vect,
integer, intent(in) dim,
logical, dimension(:), intent(in), optional mask )
private

compatta gli elementi distinti di vect in un sorted array

Definizione alla linea 1087 del file array_utilities.F90.

1089! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1090! authors:
1091! Davide Cesari <dcesari@arpa.emr.it>
1092! Paolo Patruno <ppatruno@arpa.emr.it>
1093
1094! This program is free software; you can redistribute it and/or
1095! modify it under the terms of the GNU General Public License as
1096! published by the Free Software Foundation; either version 2 of
1097! the License, or (at your option) any later version.
1098
1099! This program is distributed in the hope that it will be useful,
1100! but WITHOUT ANY WARRANTY; without even the implied warranty of
1101! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1102! GNU General Public License for more details.
1103
1104! You should have received a copy of the GNU General Public License
1105! along with this program. If not, see <http://www.gnu.org/licenses/>.
1106
1107
1108
1109!> This module defines usefull general purpose function and subroutine
1110!!\ingroup base
1111#include "config.h"
1112MODULE array_utilities
1113
1114IMPLICIT NONE
1115
1116! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
1117!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
1118
1119#undef VOL7D_POLY_TYPE_AUTO
1120
1121#undef VOL7D_POLY_TYPE
1122#undef VOL7D_POLY_TYPES
1123#define VOL7D_POLY_TYPE INTEGER
1124#define VOL7D_POLY_TYPES _i
1125#define ENABLE_SORT
1126#include "array_utilities_pre.F90"
1127#undef ENABLE_SORT
1128
1129#undef VOL7D_POLY_TYPE
1130#undef VOL7D_POLY_TYPES
1131#define VOL7D_POLY_TYPE REAL
1132#define VOL7D_POLY_TYPES _r
1133#define ENABLE_SORT
1134#include "array_utilities_pre.F90"
1135#undef ENABLE_SORT
1136
1137#undef VOL7D_POLY_TYPE
1138#undef VOL7D_POLY_TYPES
1139#define VOL7D_POLY_TYPE DOUBLEPRECISION
1140#define VOL7D_POLY_TYPES _d
1141#define ENABLE_SORT
1142#include "array_utilities_pre.F90"
1143#undef ENABLE_SORT
1144
1145#define VOL7D_NO_PACK
1146#undef VOL7D_POLY_TYPE
1147#undef VOL7D_POLY_TYPES
1148#define VOL7D_POLY_TYPE CHARACTER(len=*)
1149#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1150#define VOL7D_POLY_TYPES _c
1151#define ENABLE_SORT
1152#include "array_utilities_pre.F90"
1153#undef VOL7D_POLY_TYPE_AUTO
1154#undef ENABLE_SORT
1155
1156
1157#define ARRAYOF_ORIGEQ 1
1158
1159#define ARRAYOF_ORIGTYPE INTEGER
1160#define ARRAYOF_TYPE arrayof_integer
1161#include "arrayof_pre.F90"
1162
1163#undef ARRAYOF_ORIGTYPE
1164#undef ARRAYOF_TYPE
1165#define ARRAYOF_ORIGTYPE REAL
1166#define ARRAYOF_TYPE arrayof_real
1167#include "arrayof_pre.F90"
1168
1169#undef ARRAYOF_ORIGTYPE
1170#undef ARRAYOF_TYPE
1171#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1172#define ARRAYOF_TYPE arrayof_doubleprecision
1173#include "arrayof_pre.F90"
1174
1175#undef ARRAYOF_ORIGEQ
1176
1177#undef ARRAYOF_ORIGTYPE
1178#undef ARRAYOF_TYPE
1179#define ARRAYOF_ORIGTYPE LOGICAL
1180#define ARRAYOF_TYPE arrayof_logical
1181#include "arrayof_pre.F90"
1182
1183PRIVATE
1184! from arrayof
1186PUBLIC insert_unique, append_unique
1187
1188PUBLIC sort, index, index_c, &
1189 count_distinct_sorted, pack_distinct_sorted, &
1190 count_distinct, pack_distinct, count_and_pack_distinct, &
1191 map_distinct, map_inv_distinct, &
1192 firsttrue, lasttrue, pack_distinct_c, map
1193
1194CONTAINS
1195
1196
1197!> Return the index ot the first true element of the input logical array \a v.
1198!! If no \c .TRUE. elements are found, it returns 0.
1199FUNCTION firsttrue(v) RESULT(i)
1200LOGICAL,INTENT(in) :: v(:) !< logical array to test
1201INTEGER :: i
1202
1203DO i = 1, SIZE(v)
1204 IF (v(i)) RETURN
1205ENDDO
1206i = 0
1207
1208END FUNCTION firsttrue
1209
1210
1211!> Return the index ot the last true element of the input logical array \a v.
1212!! If no \c .TRUE. elements are found, it returns 0.
1213FUNCTION lasttrue(v) RESULT(i)
1214LOGICAL,INTENT(in) :: v(:) !< logical array to test
1215INTEGER :: i
1216
1217DO i = SIZE(v), 1, -1
1218 IF (v(i)) RETURN
1219ENDDO
1220
1221END FUNCTION lasttrue
1222
1223
1224! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
1225#undef VOL7D_POLY_TYPE_AUTO
1226#undef VOL7D_NO_PACK
1227
1228#undef VOL7D_POLY_TYPE
1229#undef VOL7D_POLY_TYPES
1230#define VOL7D_POLY_TYPE INTEGER
1231#define VOL7D_POLY_TYPES _i
1232#define ENABLE_SORT
1233#include "array_utilities_inc.F90"
1234#undef ENABLE_SORT
1235
1236#undef VOL7D_POLY_TYPE
1237#undef VOL7D_POLY_TYPES
1238#define VOL7D_POLY_TYPE REAL
1239#define VOL7D_POLY_TYPES _r
1240#define ENABLE_SORT
1241#include "array_utilities_inc.F90"
1242#undef ENABLE_SORT
1243
1244#undef VOL7D_POLY_TYPE
1245#undef VOL7D_POLY_TYPES
1246#define VOL7D_POLY_TYPE DOUBLEPRECISION
1247#define VOL7D_POLY_TYPES _d
1248#define ENABLE_SORT
1249#include "array_utilities_inc.F90"
1250#undef ENABLE_SORT
1251
1252#define VOL7D_NO_PACK
1253#undef VOL7D_POLY_TYPE
1254#undef VOL7D_POLY_TYPES
1255#define VOL7D_POLY_TYPE CHARACTER(len=*)
1256#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1257#define VOL7D_POLY_TYPES _c
1258#define ENABLE_SORT
1259#include "array_utilities_inc.F90"
1260#undef VOL7D_POLY_TYPE_AUTO
1261#undef ENABLE_SORT
1262
1263SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
1264CHARACTER(len=*),INTENT(in) :: vect(:)
1265LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
1266CHARACTER(len=LEN(vect)) :: pack_distinct(:)
1267
1268INTEGER :: count_distinct
1269INTEGER :: i, j, dim
1270LOGICAL :: lback
1271
1272dim = SIZE(pack_distinct)
1273IF (PRESENT(back)) THEN
1274 lback = back
1275ELSE
1276 lback = .false.
1277ENDIF
1278count_distinct = 0
1279
1280IF (PRESENT (mask)) THEN
1281 IF (lback) THEN
1282 vectm1: DO i = 1, SIZE(vect)
1283 IF (.NOT.mask(i)) cycle vectm1
1284! DO j = i-1, 1, -1
1285! IF (vect(j) == vect(i)) CYCLE vectm1
1286 DO j = count_distinct, 1, -1
1287 IF (pack_distinct(j) == vect(i)) cycle vectm1
1288 ENDDO
1289 count_distinct = count_distinct + 1
1290 IF (count_distinct > dim) EXIT
1291 pack_distinct(count_distinct) = vect(i)
1292 ENDDO vectm1
1293 ELSE
1294 vectm2: DO i = 1, SIZE(vect)
1295 IF (.NOT.mask(i)) cycle vectm2
1296! DO j = 1, i-1
1297! IF (vect(j) == vect(i)) CYCLE vectm2
1298 DO j = 1, count_distinct
1299 IF (pack_distinct(j) == vect(i)) cycle vectm2
1300 ENDDO
1301 count_distinct = count_distinct + 1
1302 IF (count_distinct > dim) EXIT
1303 pack_distinct(count_distinct) = vect(i)
1304 ENDDO vectm2
1305 ENDIF
1306ELSE
1307 IF (lback) THEN
1308 vect1: DO i = 1, SIZE(vect)
1309! DO j = i-1, 1, -1
1310! IF (vect(j) == vect(i)) CYCLE vect1
1311 DO j = count_distinct, 1, -1
1312 IF (pack_distinct(j) == vect(i)) cycle vect1
1313 ENDDO
1314 count_distinct = count_distinct + 1
1315 IF (count_distinct > dim) EXIT
1316 pack_distinct(count_distinct) = vect(i)
1317 ENDDO vect1
1318 ELSE
1319 vect2: DO i = 1, SIZE(vect)
1320! DO j = 1, i-1
1321! IF (vect(j) == vect(i)) CYCLE vect2
1322 DO j = 1, count_distinct
1323 IF (pack_distinct(j) == vect(i)) cycle vect2
1324 ENDDO
1325 count_distinct = count_distinct + 1
1326 IF (count_distinct > dim) EXIT
1327 pack_distinct(count_distinct) = vect(i)
1328 ENDDO vect2
1329 ENDIF
1330ENDIF
1331
1332END SUBROUTINE pack_distinct_c
1333
1334!> Return the index of the array only where the mask is true
1335FUNCTION map(mask) RESULT(mapidx)
1336LOGICAL,INTENT(in) :: mask(:)
1337INTEGER :: mapidx(count(mask))
1338
1339INTEGER :: i,j
1340
1341j = 0
1342DO i=1, SIZE(mask)
1343 j = j + 1
1344 IF (mask(i)) mapidx(j)=i
1345ENDDO
1346
1347END FUNCTION map
1348
1349#define ARRAYOF_ORIGEQ 1
1350
1351#undef ARRAYOF_ORIGTYPE
1352#undef ARRAYOF_TYPE
1353#define ARRAYOF_ORIGTYPE INTEGER
1354#define ARRAYOF_TYPE arrayof_integer
1355#include "arrayof_post.F90"
1356
1357#undef ARRAYOF_ORIGTYPE
1358#undef ARRAYOF_TYPE
1359#define ARRAYOF_ORIGTYPE REAL
1360#define ARRAYOF_TYPE arrayof_real
1361#include "arrayof_post.F90"
1362
1363#undef ARRAYOF_ORIGTYPE
1364#undef ARRAYOF_TYPE
1365#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1366#define ARRAYOF_TYPE arrayof_doubleprecision
1367#include "arrayof_post.F90"
1368
1369#undef ARRAYOF_ORIGEQ
1370
1371#undef ARRAYOF_ORIGTYPE
1372#undef ARRAYOF_TYPE
1373#define ARRAYOF_ORIGTYPE LOGICAL
1374#define ARRAYOF_TYPE arrayof_logical
1375#include "arrayof_post.F90"
1376
1377END 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.