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