libsim Versione 7.1.11

◆ arraysize

integer arraysize =0

current logical size of the array; it may be different from the physical size SIZE(thisarray), and it should be used instead of SIZE() intrinsic function in order to evaluate the number of elements assigned to array

Definizione alla linea 613 del file array_utilities.F90.

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