libsim Versione 7.1.11

◆ array

real, dimension(:), pointer array =>NULL()

array of REAL

Definizione alla linea 612 del file array_utilities.F90.

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