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 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"
752MODULE array_utilities
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
828PUBLIC sort, index, index_c, &
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
1017END 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.