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