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