libsim Versione 7.1.11

◆ arraysize

integer arraysize =0

current logical size of the array; it may be different from the physical size SIZE(thisarray), and it should be used instead of SIZE() intrinsic function in order to evaluate the number of elements assigned to array

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"
870MODULE array_utilities
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
946PUBLIC sort, index, index_c, &
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
1135END 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.