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