libsim Versione 7.2.1

◆ 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 1010 del file array_utilities.F90.

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