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