libsim Versione 7.1.11
|
◆ arraysize
current logical size of the array; it may be different from the physical size Definizione alla linea 729 del file array_utilities.F90. 729! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
730! authors:
731! Davide Cesari <dcesari@arpa.emr.it>
732! Paolo Patruno <ppatruno@arpa.emr.it>
733
734! This program is free software; you can redistribute it and/or
735! modify it under the terms of the GNU General Public License as
736! published by the Free Software Foundation; either version 2 of
737! the License, or (at your option) any later version.
738
739! This program is distributed in the hope that it will be useful,
740! but WITHOUT ANY WARRANTY; without even the implied warranty of
741! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
742! GNU General Public License for more details.
743
744! You should have received a copy of the GNU General Public License
745! along with this program. If not, see <http://www.gnu.org/licenses/>.
746
747
748
751#include "config.h"
753
754IMPLICIT NONE
755
756! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
757!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
758
759#undef VOL7D_POLY_TYPE_AUTO
760
761#undef VOL7D_POLY_TYPE
762#undef VOL7D_POLY_TYPES
763#define VOL7D_POLY_TYPE INTEGER
764#define VOL7D_POLY_TYPES _i
765#define ENABLE_SORT
766#include "array_utilities_pre.F90"
767#undef ENABLE_SORT
768
769#undef VOL7D_POLY_TYPE
770#undef VOL7D_POLY_TYPES
771#define VOL7D_POLY_TYPE REAL
772#define VOL7D_POLY_TYPES _r
773#define ENABLE_SORT
774#include "array_utilities_pre.F90"
775#undef ENABLE_SORT
776
777#undef VOL7D_POLY_TYPE
778#undef VOL7D_POLY_TYPES
779#define VOL7D_POLY_TYPE DOUBLEPRECISION
780#define VOL7D_POLY_TYPES _d
781#define ENABLE_SORT
782#include "array_utilities_pre.F90"
783#undef ENABLE_SORT
784
785#define VOL7D_NO_PACK
786#undef VOL7D_POLY_TYPE
787#undef VOL7D_POLY_TYPES
788#define VOL7D_POLY_TYPE CHARACTER(len=*)
789#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
790#define VOL7D_POLY_TYPES _c
791#define ENABLE_SORT
792#include "array_utilities_pre.F90"
793#undef VOL7D_POLY_TYPE_AUTO
794#undef ENABLE_SORT
795
796
797#define ARRAYOF_ORIGEQ 1
798
799#define ARRAYOF_ORIGTYPE INTEGER
800#define ARRAYOF_TYPE arrayof_integer
801#include "arrayof_pre.F90"
802
803#undef ARRAYOF_ORIGTYPE
804#undef ARRAYOF_TYPE
805#define ARRAYOF_ORIGTYPE REAL
806#define ARRAYOF_TYPE arrayof_real
807#include "arrayof_pre.F90"
808
809#undef ARRAYOF_ORIGTYPE
810#undef ARRAYOF_TYPE
811#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
812#define ARRAYOF_TYPE arrayof_doubleprecision
813#include "arrayof_pre.F90"
814
815#undef ARRAYOF_ORIGEQ
816
817#undef ARRAYOF_ORIGTYPE
818#undef ARRAYOF_TYPE
819#define ARRAYOF_ORIGTYPE LOGICAL
820#define ARRAYOF_TYPE arrayof_logical
821#include "arrayof_pre.F90"
822
823PRIVATE
824! from arrayof
826PUBLIC insert_unique, append_unique
827
829 count_distinct_sorted, pack_distinct_sorted, &
830 count_distinct, pack_distinct, count_and_pack_distinct, &
831 map_distinct, map_inv_distinct, &
832 firsttrue, lasttrue, pack_distinct_c, map
833
834CONTAINS
835
836
839FUNCTION firsttrue(v) RESULT(i)
840LOGICAL,INTENT(in) :: v(:)
841INTEGER :: i
842
843DO i = 1, SIZE(v)
844 IF (v(i)) RETURN
845ENDDO
846i = 0
847
848END FUNCTION firsttrue
849
850
853FUNCTION lasttrue(v) RESULT(i)
854LOGICAL,INTENT(in) :: v(:)
855INTEGER :: i
856
857DO i = SIZE(v), 1, -1
858 IF (v(i)) RETURN
859ENDDO
860
861END FUNCTION lasttrue
862
863
864! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
865#undef VOL7D_POLY_TYPE_AUTO
866#undef VOL7D_NO_PACK
867
868#undef VOL7D_POLY_TYPE
869#undef VOL7D_POLY_TYPES
870#define VOL7D_POLY_TYPE INTEGER
871#define VOL7D_POLY_TYPES _i
872#define ENABLE_SORT
873#include "array_utilities_inc.F90"
874#undef ENABLE_SORT
875
876#undef VOL7D_POLY_TYPE
877#undef VOL7D_POLY_TYPES
878#define VOL7D_POLY_TYPE REAL
879#define VOL7D_POLY_TYPES _r
880#define ENABLE_SORT
881#include "array_utilities_inc.F90"
882#undef ENABLE_SORT
883
884#undef VOL7D_POLY_TYPE
885#undef VOL7D_POLY_TYPES
886#define VOL7D_POLY_TYPE DOUBLEPRECISION
887#define VOL7D_POLY_TYPES _d
888#define ENABLE_SORT
889#include "array_utilities_inc.F90"
890#undef ENABLE_SORT
891
892#define VOL7D_NO_PACK
893#undef VOL7D_POLY_TYPE
894#undef VOL7D_POLY_TYPES
895#define VOL7D_POLY_TYPE CHARACTER(len=*)
896#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
897#define VOL7D_POLY_TYPES _c
898#define ENABLE_SORT
899#include "array_utilities_inc.F90"
900#undef VOL7D_POLY_TYPE_AUTO
901#undef ENABLE_SORT
902
903SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
904CHARACTER(len=*),INTENT(in) :: vect(:)
905LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
906CHARACTER(len=LEN(vect)) :: pack_distinct(:)
907
908INTEGER :: count_distinct
909INTEGER :: i, j, dim
910LOGICAL :: lback
911
912dim = SIZE(pack_distinct)
913IF (PRESENT(back)) THEN
914 lback = back
915ELSE
916 lback = .false.
917ENDIF
918count_distinct = 0
919
920IF (PRESENT (mask)) THEN
921 IF (lback) THEN
922 vectm1: DO i = 1, SIZE(vect)
923 IF (.NOT.mask(i)) cycle vectm1
924! DO j = i-1, 1, -1
925! IF (vect(j) == vect(i)) CYCLE vectm1
926 DO j = count_distinct, 1, -1
927 IF (pack_distinct(j) == vect(i)) cycle vectm1
928 ENDDO
929 count_distinct = count_distinct + 1
930 IF (count_distinct > dim) EXIT
931 pack_distinct(count_distinct) = vect(i)
932 ENDDO vectm1
933 ELSE
934 vectm2: DO i = 1, SIZE(vect)
935 IF (.NOT.mask(i)) cycle vectm2
936! DO j = 1, i-1
937! IF (vect(j) == vect(i)) CYCLE vectm2
938 DO j = 1, count_distinct
939 IF (pack_distinct(j) == vect(i)) cycle vectm2
940 ENDDO
941 count_distinct = count_distinct + 1
942 IF (count_distinct > dim) EXIT
943 pack_distinct(count_distinct) = vect(i)
944 ENDDO vectm2
945 ENDIF
946ELSE
947 IF (lback) THEN
948 vect1: DO i = 1, SIZE(vect)
949! DO j = i-1, 1, -1
950! IF (vect(j) == vect(i)) CYCLE vect1
951 DO j = count_distinct, 1, -1
952 IF (pack_distinct(j) == vect(i)) cycle vect1
953 ENDDO
954 count_distinct = count_distinct + 1
955 IF (count_distinct > dim) EXIT
956 pack_distinct(count_distinct) = vect(i)
957 ENDDO vect1
958 ELSE
959 vect2: DO i = 1, SIZE(vect)
960! DO j = 1, i-1
961! IF (vect(j) == vect(i)) CYCLE vect2
962 DO j = 1, count_distinct
963 IF (pack_distinct(j) == vect(i)) cycle vect2
964 ENDDO
965 count_distinct = count_distinct + 1
966 IF (count_distinct > dim) EXIT
967 pack_distinct(count_distinct) = vect(i)
968 ENDDO vect2
969 ENDIF
970ENDIF
971
972END SUBROUTINE pack_distinct_c
973
975FUNCTION map(mask) RESULT(mapidx)
976LOGICAL,INTENT(in) :: mask(:)
977INTEGER :: mapidx(count(mask))
978
979INTEGER :: i,j
980
981j = 0
982DO i=1, SIZE(mask)
983 j = j + 1
984 IF (mask(i)) mapidx(j)=i
985ENDDO
986
987END FUNCTION map
988
989#define ARRAYOF_ORIGEQ 1
990
991#undef ARRAYOF_ORIGTYPE
992#undef ARRAYOF_TYPE
993#define ARRAYOF_ORIGTYPE INTEGER
994#define ARRAYOF_TYPE arrayof_integer
995#include "arrayof_post.F90"
996
997#undef ARRAYOF_ORIGTYPE
998#undef ARRAYOF_TYPE
999#define ARRAYOF_ORIGTYPE REAL
1000#define ARRAYOF_TYPE arrayof_real
1001#include "arrayof_post.F90"
1002
1003#undef ARRAYOF_ORIGTYPE
1004#undef ARRAYOF_TYPE
1005#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
1006#define ARRAYOF_TYPE arrayof_doubleprecision
1007#include "arrayof_post.F90"
1008
1009#undef ARRAYOF_ORIGEQ
1010
1011#undef ARRAYOF_ORIGTYPE
1012#undef ARRAYOF_TYPE
1013#define ARRAYOF_ORIGTYPE LOGICAL
1014#define ARRAYOF_TYPE arrayof_logical
1015#include "arrayof_post.F90"
1016
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 |