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