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

616! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
617! authors:
618! Davide Cesari <dcesari@arpa.emr.it>
619! Paolo Patruno <ppatruno@arpa.emr.it>
620
621! This program is free software; you can redistribute it and/or
622! modify it under the terms of the GNU General Public License as
623! published by the Free Software Foundation; either version 2 of
624! the License, or (at your option) any later version.
625
626! This program is distributed in the hope that it will be useful,
627! but WITHOUT ANY WARRANTY; without even the implied warranty of
628! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
629! GNU General Public License for more details.
630
631! You should have received a copy of the GNU General Public License
632! along with this program. If not, see <http://www.gnu.org/licenses/>.
633
634
635
638#include "config.h"
639MODULE array_utilities
640
641IMPLICIT NONE
642
643! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
644!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
645
646#undef VOL7D_POLY_TYPE_AUTO
647
648#undef VOL7D_POLY_TYPE
649#undef VOL7D_POLY_TYPES
650#define VOL7D_POLY_TYPE INTEGER
651#define VOL7D_POLY_TYPES _i
652#define ENABLE_SORT
653#include "array_utilities_pre.F90"
654#undef ENABLE_SORT
655
656#undef VOL7D_POLY_TYPE
657#undef VOL7D_POLY_TYPES
658#define VOL7D_POLY_TYPE REAL
659#define VOL7D_POLY_TYPES _r
660#define ENABLE_SORT
661#include "array_utilities_pre.F90"
662#undef ENABLE_SORT
663
664#undef VOL7D_POLY_TYPE
665#undef VOL7D_POLY_TYPES
666#define VOL7D_POLY_TYPE DOUBLEPRECISION
667#define VOL7D_POLY_TYPES _d
668#define ENABLE_SORT
669#include "array_utilities_pre.F90"
670#undef ENABLE_SORT
671
672#define VOL7D_NO_PACK
673#undef VOL7D_POLY_TYPE
674#undef VOL7D_POLY_TYPES
675#define VOL7D_POLY_TYPE CHARACTER(len=*)
676#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
677#define VOL7D_POLY_TYPES _c
678#define ENABLE_SORT
679#include "array_utilities_pre.F90"
680#undef VOL7D_POLY_TYPE_AUTO
681#undef ENABLE_SORT
682
683
684#define ARRAYOF_ORIGEQ 1
685
686#define ARRAYOF_ORIGTYPE INTEGER
687#define ARRAYOF_TYPE arrayof_integer
688#include "arrayof_pre.F90"
689
690#undef ARRAYOF_ORIGTYPE
691#undef ARRAYOF_TYPE
692#define ARRAYOF_ORIGTYPE REAL
693#define ARRAYOF_TYPE arrayof_real
694#include "arrayof_pre.F90"
695
696#undef ARRAYOF_ORIGTYPE
697#undef ARRAYOF_TYPE
698#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
699#define ARRAYOF_TYPE arrayof_doubleprecision
700#include "arrayof_pre.F90"
701
702#undef ARRAYOF_ORIGEQ
703
704#undef ARRAYOF_ORIGTYPE
705#undef ARRAYOF_TYPE
706#define ARRAYOF_ORIGTYPE LOGICAL
707#define ARRAYOF_TYPE arrayof_logical
708#include "arrayof_pre.F90"
709
710PRIVATE
711! from arrayof
713PUBLIC insert_unique, append_unique
714
715PUBLIC sort, index, index_c, &
716 count_distinct_sorted, pack_distinct_sorted, &
717 count_distinct, pack_distinct, count_and_pack_distinct, &
718 map_distinct, map_inv_distinct, &
719 firsttrue, lasttrue, pack_distinct_c, map
720
721CONTAINS
722
723
726FUNCTION firsttrue(v) RESULT(i)
727LOGICAL,INTENT(in) :: v(:)
728INTEGER :: i
729
730DO i = 1, SIZE(v)
731 IF (v(i)) RETURN
732ENDDO
733i = 0
734
735END FUNCTION firsttrue
736
737
740FUNCTION lasttrue(v) RESULT(i)
741LOGICAL,INTENT(in) :: v(:)
742INTEGER :: i
743
744DO i = SIZE(v), 1, -1
745 IF (v(i)) RETURN
746ENDDO
747
748END FUNCTION lasttrue
749
750
751! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
752#undef VOL7D_POLY_TYPE_AUTO
753#undef VOL7D_NO_PACK
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_inc.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_inc.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_inc.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_inc.F90"
787#undef VOL7D_POLY_TYPE_AUTO
788#undef ENABLE_SORT
789
790SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
791CHARACTER(len=*),INTENT(in) :: vect(:)
792LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
793CHARACTER(len=LEN(vect)) :: pack_distinct(:)
794
795INTEGER :: count_distinct
796INTEGER :: i, j, dim
797LOGICAL :: lback
798
799dim = SIZE(pack_distinct)
800IF (PRESENT(back)) THEN
801 lback = back
802ELSE
803 lback = .false.
804ENDIF
805count_distinct = 0
806
807IF (PRESENT (mask)) THEN
808 IF (lback) THEN
809 vectm1: DO i = 1, SIZE(vect)
810 IF (.NOT.mask(i)) cycle vectm1
811! DO j = i-1, 1, -1
812! IF (vect(j) == vect(i)) CYCLE vectm1
813 DO j = count_distinct, 1, -1
814 IF (pack_distinct(j) == vect(i)) cycle vectm1
815 ENDDO
816 count_distinct = count_distinct + 1
817 IF (count_distinct > dim) EXIT
818 pack_distinct(count_distinct) = vect(i)
819 ENDDO vectm1
820 ELSE
821 vectm2: DO i = 1, SIZE(vect)
822 IF (.NOT.mask(i)) cycle vectm2
823! DO j = 1, i-1
824! IF (vect(j) == vect(i)) CYCLE vectm2
825 DO j = 1, count_distinct
826 IF (pack_distinct(j) == vect(i)) cycle vectm2
827 ENDDO
828 count_distinct = count_distinct + 1
829 IF (count_distinct > dim) EXIT
830 pack_distinct(count_distinct) = vect(i)
831 ENDDO vectm2
832 ENDIF
833ELSE
834 IF (lback) THEN
835 vect1: DO i = 1, SIZE(vect)
836! DO j = i-1, 1, -1
837! IF (vect(j) == vect(i)) CYCLE vect1
838 DO j = count_distinct, 1, -1
839 IF (pack_distinct(j) == vect(i)) cycle vect1
840 ENDDO
841 count_distinct = count_distinct + 1
842 IF (count_distinct > dim) EXIT
843 pack_distinct(count_distinct) = vect(i)
844 ENDDO vect1
845 ELSE
846 vect2: DO i = 1, SIZE(vect)
847! DO j = 1, i-1
848! IF (vect(j) == vect(i)) CYCLE vect2
849 DO j = 1, count_distinct
850 IF (pack_distinct(j) == vect(i)) cycle vect2
851 ENDDO
852 count_distinct = count_distinct + 1
853 IF (count_distinct > dim) EXIT
854 pack_distinct(count_distinct) = vect(i)
855 ENDDO vect2
856 ENDIF
857ENDIF
858
859END SUBROUTINE pack_distinct_c
860
862FUNCTION map(mask) RESULT(mapidx)
863LOGICAL,INTENT(in) :: mask(:)
864INTEGER :: mapidx(count(mask))
865
866INTEGER :: i,j
867
868j = 0
869DO i=1, SIZE(mask)
870 j = j + 1
871 IF (mask(i)) mapidx(j)=i
872ENDDO
873
874END FUNCTION map
875
876#define ARRAYOF_ORIGEQ 1
877
878#undef ARRAYOF_ORIGTYPE
879#undef ARRAYOF_TYPE
880#define ARRAYOF_ORIGTYPE INTEGER
881#define ARRAYOF_TYPE arrayof_integer
882#include "arrayof_post.F90"
883
884#undef ARRAYOF_ORIGTYPE
885#undef ARRAYOF_TYPE
886#define ARRAYOF_ORIGTYPE REAL
887#define ARRAYOF_TYPE arrayof_real
888#include "arrayof_post.F90"
889
890#undef ARRAYOF_ORIGTYPE
891#undef ARRAYOF_TYPE
892#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
893#define ARRAYOF_TYPE arrayof_doubleprecision
894#include "arrayof_post.F90"
895
896#undef ARRAYOF_ORIGEQ
897
898#undef ARRAYOF_ORIGTYPE
899#undef ARRAYOF_TYPE
900#define ARRAYOF_ORIGTYPE LOGICAL
901#define ARRAYOF_TYPE arrayof_logical
902#include "arrayof_post.F90"
903
904END 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.