libsim Versione 7.2.0

◆ 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 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
629#include "config.h"
630MODULE array_utilities
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
706PUBLIC sort, index, index_c, &
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
717FUNCTION firsttrue(v) RESULT(i)
718LOGICAL,INTENT(in) :: v(:)
719INTEGER :: i
720
721DO i = 1, SIZE(v)
722 IF (v(i)) RETURN
723ENDDO
724i = 0
725
726END FUNCTION firsttrue
727
728
731FUNCTION lasttrue(v) RESULT(i)
732LOGICAL,INTENT(in) :: v(:)
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
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
895END 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.