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