libsim Versione 7.1.11

◆ firsttrue()

integer function, public firsttrue ( logical, dimension(:), intent(in)  v)

Return the index ot the first true element of the input logical array v.

If no .TRUE. elements are found, it returns 0.

Parametri
[in]vlogical array to test

Definizione alla linea 923 del file array_utilities.F90.

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