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