libsim Versione 7.1.11

◆ count_distinct_i()

integer function count_distinct_i ( integer, dimension(:), intent(in)  vect,
logical, dimension(:), intent(in), optional  mask,
logical, intent(in), optional  back 
)
private

conta gli elementi distinti in vect

Definizione alla linea 1016 del file array_utilities.F90.

1017! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1018! authors:
1019! Davide Cesari <dcesari@arpa.emr.it>
1020! Paolo Patruno <ppatruno@arpa.emr.it>
1021
1022! This program is free software; you can redistribute it and/or
1023! modify it under the terms of the GNU General Public License as
1024! published by the Free Software Foundation; either version 2 of
1025! the License, or (at your option) any later version.
1026
1027! This program is distributed in the hope that it will be useful,
1028! but WITHOUT ANY WARRANTY; without even the implied warranty of
1029! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1030! GNU General Public License for more details.
1031
1032! You should have received a copy of the GNU General Public License
1033! along with this program. If not, see <http://www.gnu.org/licenses/>.
1034
1035
1036
1039#include "config.h"
1040MODULE array_utilities
1041
1042IMPLICIT NONE
1043
1044! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
1045!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
1046
1047#undef VOL7D_POLY_TYPE_AUTO
1048
1049#undef VOL7D_POLY_TYPE
1050#undef VOL7D_POLY_TYPES
1051#define VOL7D_POLY_TYPE INTEGER
1052#define VOL7D_POLY_TYPES _i
1053#define ENABLE_SORT
1054#include "array_utilities_pre.F90"
1055#undef ENABLE_SORT
1056
1057#undef VOL7D_POLY_TYPE
1058#undef VOL7D_POLY_TYPES
1059#define VOL7D_POLY_TYPE REAL
1060#define VOL7D_POLY_TYPES _r
1061#define ENABLE_SORT
1062#include "array_utilities_pre.F90"
1063#undef ENABLE_SORT
1064
1065#undef VOL7D_POLY_TYPE
1066#undef VOL7D_POLY_TYPES
1067#define VOL7D_POLY_TYPE DOUBLEPRECISION
1068#define VOL7D_POLY_TYPES _d
1069#define ENABLE_SORT
1070#include "array_utilities_pre.F90"
1071#undef ENABLE_SORT
1072
1073#define VOL7D_NO_PACK
1074#undef VOL7D_POLY_TYPE
1075#undef VOL7D_POLY_TYPES
1076#define VOL7D_POLY_TYPE CHARACTER(len=*)
1077#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1078#define VOL7D_POLY_TYPES _c
1079#define ENABLE_SORT
1080#include "array_utilities_pre.F90"
1081#undef VOL7D_POLY_TYPE_AUTO
1082#undef ENABLE_SORT
1083
1084
1085#define ARRAYOF_ORIGEQ 1
1086
1087#define ARRAYOF_ORIGTYPE INTEGER
1088#define ARRAYOF_TYPE arrayof_integer
1089#include "arrayof_pre.F90"
1090
1091#undef ARRAYOF_ORIGTYPE
1092#undef ARRAYOF_TYPE
1093#define ARRAYOF_ORIGTYPE REAL
1094#define ARRAYOF_TYPE arrayof_real
1095#include "arrayof_pre.F90"
1096
1097#undef ARRAYOF_ORIGTYPE
1098#undef ARRAYOF_TYPE
1099#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1100#define ARRAYOF_TYPE arrayof_doubleprecision
1101#include "arrayof_pre.F90"
1102
1103#undef ARRAYOF_ORIGEQ
1104
1105#undef ARRAYOF_ORIGTYPE
1106#undef ARRAYOF_TYPE
1107#define ARRAYOF_ORIGTYPE LOGICAL
1108#define ARRAYOF_TYPE arrayof_logical
1109#include "arrayof_pre.F90"
1110
1111PRIVATE
1112! from arrayof
1114PUBLIC insert_unique, append_unique
1115
1116PUBLIC sort, index, index_c, &
1117 count_distinct_sorted, pack_distinct_sorted, &
1118 count_distinct, pack_distinct, count_and_pack_distinct, &
1119 map_distinct, map_inv_distinct, &
1120 firsttrue, lasttrue, pack_distinct_c, map
1121
1122CONTAINS
1123
1124
1127FUNCTION firsttrue(v) RESULT(i)
1128LOGICAL,INTENT(in) :: v(:)
1129INTEGER :: i
1130
1131DO i = 1, SIZE(v)
1132 IF (v(i)) RETURN
1133ENDDO
1134i = 0
1135
1136END FUNCTION firsttrue
1137
1138
1141FUNCTION lasttrue(v) RESULT(i)
1142LOGICAL,INTENT(in) :: v(:)
1143INTEGER :: i
1144
1145DO i = SIZE(v), 1, -1
1146 IF (v(i)) RETURN
1147ENDDO
1148
1149END FUNCTION lasttrue
1150
1151
1152! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
1153#undef VOL7D_POLY_TYPE_AUTO
1154#undef VOL7D_NO_PACK
1155
1156#undef VOL7D_POLY_TYPE
1157#undef VOL7D_POLY_TYPES
1158#define VOL7D_POLY_TYPE INTEGER
1159#define VOL7D_POLY_TYPES _i
1160#define ENABLE_SORT
1161#include "array_utilities_inc.F90"
1162#undef ENABLE_SORT
1163
1164#undef VOL7D_POLY_TYPE
1165#undef VOL7D_POLY_TYPES
1166#define VOL7D_POLY_TYPE REAL
1167#define VOL7D_POLY_TYPES _r
1168#define ENABLE_SORT
1169#include "array_utilities_inc.F90"
1170#undef ENABLE_SORT
1171
1172#undef VOL7D_POLY_TYPE
1173#undef VOL7D_POLY_TYPES
1174#define VOL7D_POLY_TYPE DOUBLEPRECISION
1175#define VOL7D_POLY_TYPES _d
1176#define ENABLE_SORT
1177#include "array_utilities_inc.F90"
1178#undef ENABLE_SORT
1179
1180#define VOL7D_NO_PACK
1181#undef VOL7D_POLY_TYPE
1182#undef VOL7D_POLY_TYPES
1183#define VOL7D_POLY_TYPE CHARACTER(len=*)
1184#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1185#define VOL7D_POLY_TYPES _c
1186#define ENABLE_SORT
1187#include "array_utilities_inc.F90"
1188#undef VOL7D_POLY_TYPE_AUTO
1189#undef ENABLE_SORT
1190
1191SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
1192CHARACTER(len=*),INTENT(in) :: vect(:)
1193LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
1194CHARACTER(len=LEN(vect)) :: pack_distinct(:)
1195
1196INTEGER :: count_distinct
1197INTEGER :: i, j, dim
1198LOGICAL :: lback
1199
1200dim = SIZE(pack_distinct)
1201IF (PRESENT(back)) THEN
1202 lback = back
1203ELSE
1204 lback = .false.
1205ENDIF
1206count_distinct = 0
1207
1208IF (PRESENT (mask)) THEN
1209 IF (lback) THEN
1210 vectm1: DO i = 1, SIZE(vect)
1211 IF (.NOT.mask(i)) cycle vectm1
1212! DO j = i-1, 1, -1
1213! IF (vect(j) == vect(i)) CYCLE vectm1
1214 DO j = count_distinct, 1, -1
1215 IF (pack_distinct(j) == vect(i)) cycle vectm1
1216 ENDDO
1217 count_distinct = count_distinct + 1
1218 IF (count_distinct > dim) EXIT
1219 pack_distinct(count_distinct) = vect(i)
1220 ENDDO vectm1
1221 ELSE
1222 vectm2: DO i = 1, SIZE(vect)
1223 IF (.NOT.mask(i)) cycle vectm2
1224! DO j = 1, i-1
1225! IF (vect(j) == vect(i)) CYCLE vectm2
1226 DO j = 1, count_distinct
1227 IF (pack_distinct(j) == vect(i)) cycle vectm2
1228 ENDDO
1229 count_distinct = count_distinct + 1
1230 IF (count_distinct > dim) EXIT
1231 pack_distinct(count_distinct) = vect(i)
1232 ENDDO vectm2
1233 ENDIF
1234ELSE
1235 IF (lback) THEN
1236 vect1: DO i = 1, SIZE(vect)
1237! DO j = i-1, 1, -1
1238! IF (vect(j) == vect(i)) CYCLE vect1
1239 DO j = count_distinct, 1, -1
1240 IF (pack_distinct(j) == vect(i)) cycle vect1
1241 ENDDO
1242 count_distinct = count_distinct + 1
1243 IF (count_distinct > dim) EXIT
1244 pack_distinct(count_distinct) = vect(i)
1245 ENDDO vect1
1246 ELSE
1247 vect2: DO i = 1, SIZE(vect)
1248! DO j = 1, i-1
1249! IF (vect(j) == vect(i)) CYCLE vect2
1250 DO j = 1, count_distinct
1251 IF (pack_distinct(j) == vect(i)) cycle vect2
1252 ENDDO
1253 count_distinct = count_distinct + 1
1254 IF (count_distinct > dim) EXIT
1255 pack_distinct(count_distinct) = vect(i)
1256 ENDDO vect2
1257 ENDIF
1258ENDIF
1259
1260END SUBROUTINE pack_distinct_c
1261
1263FUNCTION map(mask) RESULT(mapidx)
1264LOGICAL,INTENT(in) :: mask(:)
1265INTEGER :: mapidx(count(mask))
1266
1267INTEGER :: i,j
1268
1269j = 0
1270DO i=1, SIZE(mask)
1271 j = j + 1
1272 IF (mask(i)) mapidx(j)=i
1273ENDDO
1274
1275END FUNCTION map
1276
1277#define ARRAYOF_ORIGEQ 1
1278
1279#undef ARRAYOF_ORIGTYPE
1280#undef ARRAYOF_TYPE
1281#define ARRAYOF_ORIGTYPE INTEGER
1282#define ARRAYOF_TYPE arrayof_integer
1283#include "arrayof_post.F90"
1284
1285#undef ARRAYOF_ORIGTYPE
1286#undef ARRAYOF_TYPE
1287#define ARRAYOF_ORIGTYPE REAL
1288#define ARRAYOF_TYPE arrayof_real
1289#include "arrayof_post.F90"
1290
1291#undef ARRAYOF_ORIGTYPE
1292#undef ARRAYOF_TYPE
1293#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1294#define ARRAYOF_TYPE arrayof_doubleprecision
1295#include "arrayof_post.F90"
1296
1297#undef ARRAYOF_ORIGEQ
1298
1299#undef ARRAYOF_ORIGTYPE
1300#undef ARRAYOF_TYPE
1301#define ARRAYOF_ORIGTYPE LOGICAL
1302#define ARRAYOF_TYPE arrayof_logical
1303#include "arrayof_post.F90"
1304
1305END 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.