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