libsim Versione 7.1.11

◆ overalloc

double precision overalloc =2.0D0

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 732 del file array_utilities.F90.

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