libsim Versione 7.2.1

◆ array

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

array of DOUBLEPRECISION

Definizione alla linea 722 del file array_utilities.F90.

722! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
723! authors:
724! Davide Cesari <dcesari@arpa.emr.it>
725! Paolo Patruno <ppatruno@arpa.emr.it>
726
727! This program is free software; you can redistribute it and/or
728! modify it under the terms of the GNU General Public License as
729! published by the Free Software Foundation; either version 2 of
730! the License, or (at your option) any later version.
731
732! This program is distributed in the hope that it will be useful,
733! but WITHOUT ANY WARRANTY; without even the implied warranty of
734! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
735! GNU General Public License for more details.
736
737! You should have received a copy of the GNU General Public License
738! along with this program. If not, see <http://www.gnu.org/licenses/>.
739
740
741
744#include "config.h"
745MODULE array_utilities
746
747IMPLICIT NONE
748
749! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
750!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
751
752#undef VOL7D_POLY_TYPE_AUTO
753
754#undef VOL7D_POLY_TYPE
755#undef VOL7D_POLY_TYPES
756#define VOL7D_POLY_TYPE INTEGER
757#define VOL7D_POLY_TYPES _i
758#define ENABLE_SORT
759#include "array_utilities_pre.F90"
760#undef ENABLE_SORT
761
762#undef VOL7D_POLY_TYPE
763#undef VOL7D_POLY_TYPES
764#define VOL7D_POLY_TYPE REAL
765#define VOL7D_POLY_TYPES _r
766#define ENABLE_SORT
767#include "array_utilities_pre.F90"
768#undef ENABLE_SORT
769
770#undef VOL7D_POLY_TYPE
771#undef VOL7D_POLY_TYPES
772#define VOL7D_POLY_TYPE DOUBLEPRECISION
773#define VOL7D_POLY_TYPES _d
774#define ENABLE_SORT
775#include "array_utilities_pre.F90"
776#undef ENABLE_SORT
777
778#define VOL7D_NO_PACK
779#undef VOL7D_POLY_TYPE
780#undef VOL7D_POLY_TYPES
781#define VOL7D_POLY_TYPE CHARACTER(len=*)
782#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
783#define VOL7D_POLY_TYPES _c
784#define ENABLE_SORT
785#include "array_utilities_pre.F90"
786#undef VOL7D_POLY_TYPE_AUTO
787#undef ENABLE_SORT
788
789
790#define ARRAYOF_ORIGEQ 1
791
792#define ARRAYOF_ORIGTYPE INTEGER
793#define ARRAYOF_TYPE arrayof_integer
794#include "arrayof_pre.F90"
795
796#undef ARRAYOF_ORIGTYPE
797#undef ARRAYOF_TYPE
798#define ARRAYOF_ORIGTYPE REAL
799#define ARRAYOF_TYPE arrayof_real
800#include "arrayof_pre.F90"
801
802#undef ARRAYOF_ORIGTYPE
803#undef ARRAYOF_TYPE
804#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
805#define ARRAYOF_TYPE arrayof_doubleprecision
806#include "arrayof_pre.F90"
807
808#undef ARRAYOF_ORIGEQ
809
810#undef ARRAYOF_ORIGTYPE
811#undef ARRAYOF_TYPE
812#define ARRAYOF_ORIGTYPE LOGICAL
813#define ARRAYOF_TYPE arrayof_logical
814#include "arrayof_pre.F90"
815
816PRIVATE
817! from arrayof
819PUBLIC insert_unique, append_unique
820
821PUBLIC sort, index, index_c, &
822 count_distinct_sorted, pack_distinct_sorted, &
823 count_distinct, pack_distinct, count_and_pack_distinct, &
824 map_distinct, map_inv_distinct, &
825 firsttrue, lasttrue, pack_distinct_c, map
826
827CONTAINS
828
829
832FUNCTION firsttrue(v) RESULT(i)
833LOGICAL,INTENT(in) :: v(:)
834INTEGER :: i
835
836DO i = 1, SIZE(v)
837 IF (v(i)) RETURN
838ENDDO
839i = 0
840
841END FUNCTION firsttrue
842
843
846FUNCTION lasttrue(v) RESULT(i)
847LOGICAL,INTENT(in) :: v(:)
848INTEGER :: i
849
850DO i = SIZE(v), 1, -1
851 IF (v(i)) RETURN
852ENDDO
853
854END FUNCTION lasttrue
855
856
857! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
858#undef VOL7D_POLY_TYPE_AUTO
859#undef VOL7D_NO_PACK
860
861#undef VOL7D_POLY_TYPE
862#undef VOL7D_POLY_TYPES
863#define VOL7D_POLY_TYPE INTEGER
864#define VOL7D_POLY_TYPES _i
865#define ENABLE_SORT
866#include "array_utilities_inc.F90"
867#undef ENABLE_SORT
868
869#undef VOL7D_POLY_TYPE
870#undef VOL7D_POLY_TYPES
871#define VOL7D_POLY_TYPE REAL
872#define VOL7D_POLY_TYPES _r
873#define ENABLE_SORT
874#include "array_utilities_inc.F90"
875#undef ENABLE_SORT
876
877#undef VOL7D_POLY_TYPE
878#undef VOL7D_POLY_TYPES
879#define VOL7D_POLY_TYPE DOUBLEPRECISION
880#define VOL7D_POLY_TYPES _d
881#define ENABLE_SORT
882#include "array_utilities_inc.F90"
883#undef ENABLE_SORT
884
885#define VOL7D_NO_PACK
886#undef VOL7D_POLY_TYPE
887#undef VOL7D_POLY_TYPES
888#define VOL7D_POLY_TYPE CHARACTER(len=*)
889#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
890#define VOL7D_POLY_TYPES _c
891#define ENABLE_SORT
892#include "array_utilities_inc.F90"
893#undef VOL7D_POLY_TYPE_AUTO
894#undef ENABLE_SORT
895
896SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
897CHARACTER(len=*),INTENT(in) :: vect(:)
898LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
899CHARACTER(len=LEN(vect)) :: pack_distinct(:)
900
901INTEGER :: count_distinct
902INTEGER :: i, j, dim
903LOGICAL :: lback
904
905dim = SIZE(pack_distinct)
906IF (PRESENT(back)) THEN
907 lback = back
908ELSE
909 lback = .false.
910ENDIF
911count_distinct = 0
912
913IF (PRESENT (mask)) THEN
914 IF (lback) THEN
915 vectm1: DO i = 1, SIZE(vect)
916 IF (.NOT.mask(i)) cycle vectm1
917! DO j = i-1, 1, -1
918! IF (vect(j) == vect(i)) CYCLE vectm1
919 DO j = count_distinct, 1, -1
920 IF (pack_distinct(j) == vect(i)) cycle vectm1
921 ENDDO
922 count_distinct = count_distinct + 1
923 IF (count_distinct > dim) EXIT
924 pack_distinct(count_distinct) = vect(i)
925 ENDDO vectm1
926 ELSE
927 vectm2: DO i = 1, SIZE(vect)
928 IF (.NOT.mask(i)) cycle vectm2
929! DO j = 1, i-1
930! IF (vect(j) == vect(i)) CYCLE vectm2
931 DO j = 1, count_distinct
932 IF (pack_distinct(j) == vect(i)) cycle vectm2
933 ENDDO
934 count_distinct = count_distinct + 1
935 IF (count_distinct > dim) EXIT
936 pack_distinct(count_distinct) = vect(i)
937 ENDDO vectm2
938 ENDIF
939ELSE
940 IF (lback) THEN
941 vect1: DO i = 1, SIZE(vect)
942! DO j = i-1, 1, -1
943! IF (vect(j) == vect(i)) CYCLE vect1
944 DO j = count_distinct, 1, -1
945 IF (pack_distinct(j) == vect(i)) cycle vect1
946 ENDDO
947 count_distinct = count_distinct + 1
948 IF (count_distinct > dim) EXIT
949 pack_distinct(count_distinct) = vect(i)
950 ENDDO vect1
951 ELSE
952 vect2: DO i = 1, SIZE(vect)
953! DO j = 1, i-1
954! IF (vect(j) == vect(i)) CYCLE vect2
955 DO j = 1, count_distinct
956 IF (pack_distinct(j) == vect(i)) cycle vect2
957 ENDDO
958 count_distinct = count_distinct + 1
959 IF (count_distinct > dim) EXIT
960 pack_distinct(count_distinct) = vect(i)
961 ENDDO vect2
962 ENDIF
963ENDIF
964
965END SUBROUTINE pack_distinct_c
966
968FUNCTION map(mask) RESULT(mapidx)
969LOGICAL,INTENT(in) :: mask(:)
970INTEGER :: mapidx(count(mask))
971
972INTEGER :: i,j
973
974j = 0
975DO i=1, SIZE(mask)
976 j = j + 1
977 IF (mask(i)) mapidx(j)=i
978ENDDO
979
980END FUNCTION map
981
982#define ARRAYOF_ORIGEQ 1
983
984#undef ARRAYOF_ORIGTYPE
985#undef ARRAYOF_TYPE
986#define ARRAYOF_ORIGTYPE INTEGER
987#define ARRAYOF_TYPE arrayof_integer
988#include "arrayof_post.F90"
989
990#undef ARRAYOF_ORIGTYPE
991#undef ARRAYOF_TYPE
992#define ARRAYOF_ORIGTYPE REAL
993#define ARRAYOF_TYPE arrayof_real
994#include "arrayof_post.F90"
995
996#undef ARRAYOF_ORIGTYPE
997#undef ARRAYOF_TYPE
998#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
999#define ARRAYOF_TYPE arrayof_doubleprecision
1000#include "arrayof_post.F90"
1001
1002#undef ARRAYOF_ORIGEQ
1003
1004#undef ARRAYOF_ORIGTYPE
1005#undef ARRAYOF_TYPE
1006#define ARRAYOF_ORIGTYPE LOGICAL
1007#define ARRAYOF_TYPE arrayof_logical
1008#include "arrayof_post.F90"
1009
1010END 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.