libsim Versione 7.2.0

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

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