libsim Versione 7.2.0

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

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