libsim Versione 7.1.11

◆ count_distinct_sorted_i()

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

conta gli elementi distinti in un sorted array

Definizione alla linea 982 del file array_utilities.F90.

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