libsim Versione 7.1.11
|
◆ arraysize
current logical size of the array; it may be different from the physical size 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"
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
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
Quick method to append an element to the array. Definition: array_utilities.F90:514 Destructor for finalizing an array object. Definition: array_utilities.F90:527 Method for inserting elements of the array at a desired position. Definition: array_utilities.F90:505 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: array_utilities.F90:537 Method for removing elements of the array at a desired position. Definition: array_utilities.F90:520 This module defines usefull general purpose function and subroutine. Definition: array_utilities.F90:218 |