libsim Versione 7.1.11
|
◆ array
array of LOGICAL Definizione alla linea 846 del file array_utilities.F90. 846! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
847! authors:
848! Davide Cesari <dcesari@arpa.emr.it>
849! Paolo Patruno <ppatruno@arpa.emr.it>
850
851! This program is free software; you can redistribute it and/or
852! modify it under the terms of the GNU General Public License as
853! published by the Free Software Foundation; either version 2 of
854! the License, or (at your option) any later version.
855
856! This program is distributed in the hope that it will be useful,
857! but WITHOUT ANY WARRANTY; without even the implied warranty of
858! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
859! GNU General Public License for more details.
860
861! You should have received a copy of the GNU General Public License
862! along with this program. If not, see <http://www.gnu.org/licenses/>.
863
864
865
868#include "config.h"
870
871IMPLICIT NONE
872
873! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
874!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
875
876#undef VOL7D_POLY_TYPE_AUTO
877
878#undef VOL7D_POLY_TYPE
879#undef VOL7D_POLY_TYPES
880#define VOL7D_POLY_TYPE INTEGER
881#define VOL7D_POLY_TYPES _i
882#define ENABLE_SORT
883#include "array_utilities_pre.F90"
884#undef ENABLE_SORT
885
886#undef VOL7D_POLY_TYPE
887#undef VOL7D_POLY_TYPES
888#define VOL7D_POLY_TYPE REAL
889#define VOL7D_POLY_TYPES _r
890#define ENABLE_SORT
891#include "array_utilities_pre.F90"
892#undef ENABLE_SORT
893
894#undef VOL7D_POLY_TYPE
895#undef VOL7D_POLY_TYPES
896#define VOL7D_POLY_TYPE DOUBLEPRECISION
897#define VOL7D_POLY_TYPES _d
898#define ENABLE_SORT
899#include "array_utilities_pre.F90"
900#undef ENABLE_SORT
901
902#define VOL7D_NO_PACK
903#undef VOL7D_POLY_TYPE
904#undef VOL7D_POLY_TYPES
905#define VOL7D_POLY_TYPE CHARACTER(len=*)
906#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
907#define VOL7D_POLY_TYPES _c
908#define ENABLE_SORT
909#include "array_utilities_pre.F90"
910#undef VOL7D_POLY_TYPE_AUTO
911#undef ENABLE_SORT
912
913
914#define ARRAYOF_ORIGEQ 1
915
916#define ARRAYOF_ORIGTYPE INTEGER
917#define ARRAYOF_TYPE arrayof_integer
918#include "arrayof_pre.F90"
919
920#undef ARRAYOF_ORIGTYPE
921#undef ARRAYOF_TYPE
922#define ARRAYOF_ORIGTYPE REAL
923#define ARRAYOF_TYPE arrayof_real
924#include "arrayof_pre.F90"
925
926#undef ARRAYOF_ORIGTYPE
927#undef ARRAYOF_TYPE
928#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
929#define ARRAYOF_TYPE arrayof_doubleprecision
930#include "arrayof_pre.F90"
931
932#undef ARRAYOF_ORIGEQ
933
934#undef ARRAYOF_ORIGTYPE
935#undef ARRAYOF_TYPE
936#define ARRAYOF_ORIGTYPE LOGICAL
937#define ARRAYOF_TYPE arrayof_logical
938#include "arrayof_pre.F90"
939
940PRIVATE
941! from arrayof
943PUBLIC insert_unique, append_unique
944
946 count_distinct_sorted, pack_distinct_sorted, &
947 count_distinct, pack_distinct, count_and_pack_distinct, &
948 map_distinct, map_inv_distinct, &
949 firsttrue, lasttrue, pack_distinct_c, map
950
951CONTAINS
952
953
956FUNCTION firsttrue(v) RESULT(i)
957LOGICAL,INTENT(in) :: v(:)
958INTEGER :: i
959
960DO i = 1, SIZE(v)
961 IF (v(i)) RETURN
962ENDDO
963i = 0
964
965END FUNCTION firsttrue
966
967
970FUNCTION lasttrue(v) RESULT(i)
971LOGICAL,INTENT(in) :: v(:)
972INTEGER :: i
973
974DO i = SIZE(v), 1, -1
975 IF (v(i)) RETURN
976ENDDO
977
978END FUNCTION lasttrue
979
980
981! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
982#undef VOL7D_POLY_TYPE_AUTO
983#undef VOL7D_NO_PACK
984
985#undef VOL7D_POLY_TYPE
986#undef VOL7D_POLY_TYPES
987#define VOL7D_POLY_TYPE INTEGER
988#define VOL7D_POLY_TYPES _i
989#define ENABLE_SORT
990#include "array_utilities_inc.F90"
991#undef ENABLE_SORT
992
993#undef VOL7D_POLY_TYPE
994#undef VOL7D_POLY_TYPES
995#define VOL7D_POLY_TYPE REAL
996#define VOL7D_POLY_TYPES _r
997#define ENABLE_SORT
998#include "array_utilities_inc.F90"
999#undef ENABLE_SORT
1000
1001#undef VOL7D_POLY_TYPE
1002#undef VOL7D_POLY_TYPES
1003#define VOL7D_POLY_TYPE DOUBLEPRECISION
1004#define VOL7D_POLY_TYPES _d
1005#define ENABLE_SORT
1006#include "array_utilities_inc.F90"
1007#undef ENABLE_SORT
1008
1009#define VOL7D_NO_PACK
1010#undef VOL7D_POLY_TYPE
1011#undef VOL7D_POLY_TYPES
1012#define VOL7D_POLY_TYPE CHARACTER(len=*)
1013#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
1014#define VOL7D_POLY_TYPES _c
1015#define ENABLE_SORT
1016#include "array_utilities_inc.F90"
1017#undef VOL7D_POLY_TYPE_AUTO
1018#undef ENABLE_SORT
1019
1020SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
1021CHARACTER(len=*),INTENT(in) :: vect(:)
1022LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
1023CHARACTER(len=LEN(vect)) :: pack_distinct(:)
1024
1025INTEGER :: count_distinct
1026INTEGER :: i, j, dim
1027LOGICAL :: lback
1028
1029dim = SIZE(pack_distinct)
1030IF (PRESENT(back)) THEN
1031 lback = back
1032ELSE
1033 lback = .false.
1034ENDIF
1035count_distinct = 0
1036
1037IF (PRESENT (mask)) THEN
1038 IF (lback) THEN
1039 vectm1: DO i = 1, SIZE(vect)
1040 IF (.NOT.mask(i)) cycle vectm1
1041! DO j = i-1, 1, -1
1042! IF (vect(j) == vect(i)) CYCLE vectm1
1043 DO j = count_distinct, 1, -1
1044 IF (pack_distinct(j) == vect(i)) cycle vectm1
1045 ENDDO
1046 count_distinct = count_distinct + 1
1047 IF (count_distinct > dim) EXIT
1048 pack_distinct(count_distinct) = vect(i)
1049 ENDDO vectm1
1050 ELSE
1051 vectm2: DO i = 1, SIZE(vect)
1052 IF (.NOT.mask(i)) cycle vectm2
1053! DO j = 1, i-1
1054! IF (vect(j) == vect(i)) CYCLE vectm2
1055 DO j = 1, count_distinct
1056 IF (pack_distinct(j) == vect(i)) cycle vectm2
1057 ENDDO
1058 count_distinct = count_distinct + 1
1059 IF (count_distinct > dim) EXIT
1060 pack_distinct(count_distinct) = vect(i)
1061 ENDDO vectm2
1062 ENDIF
1063ELSE
1064 IF (lback) THEN
1065 vect1: DO i = 1, SIZE(vect)
1066! DO j = i-1, 1, -1
1067! IF (vect(j) == vect(i)) CYCLE vect1
1068 DO j = count_distinct, 1, -1
1069 IF (pack_distinct(j) == vect(i)) cycle vect1
1070 ENDDO
1071 count_distinct = count_distinct + 1
1072 IF (count_distinct > dim) EXIT
1073 pack_distinct(count_distinct) = vect(i)
1074 ENDDO vect1
1075 ELSE
1076 vect2: DO i = 1, SIZE(vect)
1077! DO j = 1, i-1
1078! IF (vect(j) == vect(i)) CYCLE vect2
1079 DO j = 1, count_distinct
1080 IF (pack_distinct(j) == vect(i)) cycle vect2
1081 ENDDO
1082 count_distinct = count_distinct + 1
1083 IF (count_distinct > dim) EXIT
1084 pack_distinct(count_distinct) = vect(i)
1085 ENDDO vect2
1086 ENDIF
1087ENDIF
1088
1089END SUBROUTINE pack_distinct_c
1090
1092FUNCTION map(mask) RESULT(mapidx)
1093LOGICAL,INTENT(in) :: mask(:)
1094INTEGER :: mapidx(count(mask))
1095
1096INTEGER :: i,j
1097
1098j = 0
1099DO i=1, SIZE(mask)
1100 j = j + 1
1101 IF (mask(i)) mapidx(j)=i
1102ENDDO
1103
1104END FUNCTION map
1105
1106#define ARRAYOF_ORIGEQ 1
1107
1108#undef ARRAYOF_ORIGTYPE
1109#undef ARRAYOF_TYPE
1110#define ARRAYOF_ORIGTYPE INTEGER
1111#define ARRAYOF_TYPE arrayof_integer
1112#include "arrayof_post.F90"
1113
1114#undef ARRAYOF_ORIGTYPE
1115#undef ARRAYOF_TYPE
1116#define ARRAYOF_ORIGTYPE REAL
1117#define ARRAYOF_TYPE arrayof_real
1118#include "arrayof_post.F90"
1119
1120#undef ARRAYOF_ORIGTYPE
1121#undef ARRAYOF_TYPE
1122#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1123#define ARRAYOF_TYPE arrayof_doubleprecision
1124#include "arrayof_post.F90"
1125
1126#undef ARRAYOF_ORIGEQ
1127
1128#undef ARRAYOF_ORIGTYPE
1129#undef ARRAYOF_TYPE
1130#define ARRAYOF_ORIGTYPE LOGICAL
1131#define ARRAYOF_TYPE arrayof_logical
1132#include "arrayof_post.F90"
1133
Quick method to append an element to the array. Definition: array_utilities.F90:514 Destructor for finalizing an array object. Definition: array_utilities.F90:527 Method for inserting elements of the array at a desired position. Definition: array_utilities.F90:505 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: array_utilities.F90:537 Method for removing elements of the array at a desired position. Definition: array_utilities.F90:520 This module defines usefull general purpose function and subroutine. Definition: array_utilities.F90:218 |