libsim Versione 7.2.4
|
◆ firsttrue()
Return the index ot the first true element of the input logical array v. If no
Definizione alla linea 917 del file array_utilities.F90. 918! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
919! authors:
920! Davide Cesari <dcesari@arpa.emr.it>
921! Paolo Patruno <ppatruno@arpa.emr.it>
922
923! This program is free software; you can redistribute it and/or
924! modify it under the terms of the GNU General Public License as
925! published by the Free Software Foundation; either version 2 of
926! the License, or (at your option) any later version.
927
928! This program is distributed in the hope that it will be useful,
929! but WITHOUT ANY WARRANTY; without even the implied warranty of
930! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
931! GNU General Public License for more details.
932
933! You should have received a copy of the GNU General Public License
934! along with this program. If not, see <http://www.gnu.org/licenses/>.
935
936
937
940#include "config.h"
942
943IMPLICIT NONE
944
945! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
946!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
947
948#undef VOL7D_POLY_TYPE_AUTO
949
950#undef VOL7D_POLY_TYPE
951#undef VOL7D_POLY_TYPES
952#define VOL7D_POLY_TYPE INTEGER
953#define VOL7D_POLY_TYPES _i
954#define ENABLE_SORT
955#include "array_utilities_pre.F90"
956#undef ENABLE_SORT
957
958#undef VOL7D_POLY_TYPE
959#undef VOL7D_POLY_TYPES
960#define VOL7D_POLY_TYPE REAL
961#define VOL7D_POLY_TYPES _r
962#define ENABLE_SORT
963#include "array_utilities_pre.F90"
964#undef ENABLE_SORT
965
966#undef VOL7D_POLY_TYPE
967#undef VOL7D_POLY_TYPES
968#define VOL7D_POLY_TYPE DOUBLEPRECISION
969#define VOL7D_POLY_TYPES _d
970#define ENABLE_SORT
971#include "array_utilities_pre.F90"
972#undef ENABLE_SORT
973
974#define VOL7D_NO_PACK
975#undef VOL7D_POLY_TYPE
976#undef VOL7D_POLY_TYPES
977#define VOL7D_POLY_TYPE CHARACTER(len=*)
978#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
979#define VOL7D_POLY_TYPES _c
980#define ENABLE_SORT
981#include "array_utilities_pre.F90"
982#undef VOL7D_POLY_TYPE_AUTO
983#undef ENABLE_SORT
984
985
986#define ARRAYOF_ORIGEQ 1
987
988#define ARRAYOF_ORIGTYPE INTEGER
989#define ARRAYOF_TYPE arrayof_integer
990#include "arrayof_pre.F90"
991
992#undef ARRAYOF_ORIGTYPE
993#undef ARRAYOF_TYPE
994#define ARRAYOF_ORIGTYPE REAL
995#define ARRAYOF_TYPE arrayof_real
996#include "arrayof_pre.F90"
997
998#undef ARRAYOF_ORIGTYPE
999#undef ARRAYOF_TYPE
1000#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1001#define ARRAYOF_TYPE arrayof_doubleprecision
1002#include "arrayof_pre.F90"
1003
1004#undef ARRAYOF_ORIGEQ
1005
1006#undef ARRAYOF_ORIGTYPE
1007#undef ARRAYOF_TYPE
1008#define ARRAYOF_ORIGTYPE LOGICAL
1009#define ARRAYOF_TYPE arrayof_logical
1010#include "arrayof_pre.F90"
1011
1012PRIVATE
1013! from arrayof
1015PUBLIC insert_unique, append_unique
1016
1018 count_distinct_sorted, pack_distinct_sorted, &
1019 count_distinct, pack_distinct, count_and_pack_distinct, &
1020 map_distinct, map_inv_distinct, &
1021 firsttrue, lasttrue, pack_distinct_c, map
1022
1023CONTAINS
1024
1025
1028FUNCTION firsttrue(v) RESULT(i)
1029LOGICAL,INTENT(in) :: v(:)
1030INTEGER :: i
1031
1032DO i = 1, SIZE(v)
1033 IF (v(i)) RETURN
1034ENDDO
1035i = 0
1036
1037END FUNCTION firsttrue
1038
1039
1042FUNCTION lasttrue(v) RESULT(i)
1043LOGICAL,INTENT(in) :: v(:)
1044INTEGER :: i
1045
1046DO i = SIZE(v), 1, -1
1047 IF (v(i)) RETURN
1048ENDDO
1049
1050END FUNCTION lasttrue
1051
1052
1053! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
1054#undef VOL7D_POLY_TYPE_AUTO
1055#undef VOL7D_NO_PACK
1056
1057#undef VOL7D_POLY_TYPE
1058#undef VOL7D_POLY_TYPES
1059#define VOL7D_POLY_TYPE INTEGER
1060#define VOL7D_POLY_TYPES _i
1061#define ENABLE_SORT
1062#include "array_utilities_inc.F90"
1063#undef ENABLE_SORT
1064
1065#undef VOL7D_POLY_TYPE
1066#undef VOL7D_POLY_TYPES
1067#define VOL7D_POLY_TYPE REAL
1068#define VOL7D_POLY_TYPES _r
1069#define ENABLE_SORT
1070#include "array_utilities_inc.F90"
1071#undef ENABLE_SORT
1072
1073#undef VOL7D_POLY_TYPE
1074#undef VOL7D_POLY_TYPES
1075#define VOL7D_POLY_TYPE DOUBLEPRECISION
1076#define VOL7D_POLY_TYPES _d
1077#define ENABLE_SORT
1078#include "array_utilities_inc.F90"
1079#undef ENABLE_SORT
1080
1081#define VOL7D_NO_PACK
1082#undef VOL7D_POLY_TYPE
1083#undef VOL7D_POLY_TYPES
1084#define VOL7D_POLY_TYPE CHARACTER(len=*)
1085#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1086#define VOL7D_POLY_TYPES _c
1087#define ENABLE_SORT
1088#include "array_utilities_inc.F90"
1089#undef VOL7D_POLY_TYPE_AUTO
1090#undef ENABLE_SORT
1091
1092SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
1093CHARACTER(len=*),INTENT(in) :: vect(:)
1094LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
1095CHARACTER(len=LEN(vect)) :: pack_distinct(:)
1096
1097INTEGER :: count_distinct
1098INTEGER :: i, j, dim
1099LOGICAL :: lback
1100
1101dim = SIZE(pack_distinct)
1102IF (PRESENT(back)) THEN
1103 lback = back
1104ELSE
1105 lback = .false.
1106ENDIF
1107count_distinct = 0
1108
1109IF (PRESENT (mask)) THEN
1110 IF (lback) THEN
1111 vectm1: DO i = 1, SIZE(vect)
1112 IF (.NOT.mask(i)) cycle vectm1
1113! DO j = i-1, 1, -1
1114! IF (vect(j) == vect(i)) CYCLE vectm1
1115 DO j = count_distinct, 1, -1
1116 IF (pack_distinct(j) == vect(i)) cycle vectm1
1117 ENDDO
1118 count_distinct = count_distinct + 1
1119 IF (count_distinct > dim) EXIT
1120 pack_distinct(count_distinct) = vect(i)
1121 ENDDO vectm1
1122 ELSE
1123 vectm2: DO i = 1, SIZE(vect)
1124 IF (.NOT.mask(i)) cycle vectm2
1125! DO j = 1, i-1
1126! IF (vect(j) == vect(i)) CYCLE vectm2
1127 DO j = 1, count_distinct
1128 IF (pack_distinct(j) == vect(i)) cycle vectm2
1129 ENDDO
1130 count_distinct = count_distinct + 1
1131 IF (count_distinct > dim) EXIT
1132 pack_distinct(count_distinct) = vect(i)
1133 ENDDO vectm2
1134 ENDIF
1135ELSE
1136 IF (lback) THEN
1137 vect1: DO i = 1, SIZE(vect)
1138! DO j = i-1, 1, -1
1139! IF (vect(j) == vect(i)) CYCLE vect1
1140 DO j = count_distinct, 1, -1
1141 IF (pack_distinct(j) == vect(i)) cycle vect1
1142 ENDDO
1143 count_distinct = count_distinct + 1
1144 IF (count_distinct > dim) EXIT
1145 pack_distinct(count_distinct) = vect(i)
1146 ENDDO vect1
1147 ELSE
1148 vect2: DO i = 1, SIZE(vect)
1149! DO j = 1, i-1
1150! IF (vect(j) == vect(i)) CYCLE vect2
1151 DO j = 1, count_distinct
1152 IF (pack_distinct(j) == vect(i)) cycle vect2
1153 ENDDO
1154 count_distinct = count_distinct + 1
1155 IF (count_distinct > dim) EXIT
1156 pack_distinct(count_distinct) = vect(i)
1157 ENDDO vect2
1158 ENDIF
1159ENDIF
1160
1161END SUBROUTINE pack_distinct_c
1162
1164FUNCTION map(mask) RESULT(mapidx)
1165LOGICAL,INTENT(in) :: mask(:)
1166INTEGER :: mapidx(count(mask))
1167
1168INTEGER :: i,j
1169
1170j = 0
1171DO i=1, SIZE(mask)
1172 j = j + 1
1173 IF (mask(i)) mapidx(j)=i
1174ENDDO
1175
1176END FUNCTION map
1177
1178#define ARRAYOF_ORIGEQ 1
1179
1180#undef ARRAYOF_ORIGTYPE
1181#undef ARRAYOF_TYPE
1182#define ARRAYOF_ORIGTYPE INTEGER
1183#define ARRAYOF_TYPE arrayof_integer
1184#include "arrayof_post.F90"
1185
1186#undef ARRAYOF_ORIGTYPE
1187#undef ARRAYOF_TYPE
1188#define ARRAYOF_ORIGTYPE REAL
1189#define ARRAYOF_TYPE arrayof_real
1190#include "arrayof_post.F90"
1191
1192#undef ARRAYOF_ORIGTYPE
1193#undef ARRAYOF_TYPE
1194#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1195#define ARRAYOF_TYPE arrayof_doubleprecision
1196#include "arrayof_post.F90"
1197
1198#undef ARRAYOF_ORIGEQ
1199
1200#undef ARRAYOF_ORIGTYPE
1201#undef ARRAYOF_TYPE
1202#define ARRAYOF_ORIGTYPE LOGICAL
1203#define ARRAYOF_TYPE arrayof_logical
1204#include "arrayof_post.F90"
1205
Quick method to append an element to the array. Definition array_utilities.F90:508 Method for inserting elements of the array at a desired position. Definition array_utilities.F90:499 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition array_utilities.F90:531 Method for removing elements of the array at a desired position. Definition array_utilities.F90:514 This module defines usefull general purpose function and subroutine. Definition array_utilities.F90:212 |