libsim Versione 7.2.0

◆ count_distinct_sorted_timerange()

integer function count_distinct_sorted_timerange ( type(vol7d_timerange), dimension(:), intent(in)  vect,
logical, dimension(:), intent(in), optional  mask 
)

conta gli elementi distinti in un sorted array

Definizione alla linea 739 del file vol7d_timerange_class.F90.

740! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
741! authors:
742! Davide Cesari <dcesari@arpa.emr.it>
743! Paolo Patruno <ppatruno@arpa.emr.it>
744
745! This program is free software; you can redistribute it and/or
746! modify it under the terms of the GNU General Public License as
747! published by the Free Software Foundation; either version 2 of
748! the License, or (at your option) any later version.
749
750! This program is distributed in the hope that it will be useful,
751! but WITHOUT ANY WARRANTY; without even the implied warranty of
752! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
753! GNU General Public License for more details.
754
755! You should have received a copy of the GNU General Public License
756! along with this program. If not, see <http://www.gnu.org/licenses/>.
757#include "config.h"
758
767USE kinds
770IMPLICIT NONE
771
777 INTEGER :: timerange
778 INTEGER :: p1
779 INTEGER :: p2
780END TYPE vol7d_timerange
781
783TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
784 vol7d_timerange(imiss,imiss,imiss)
785
789INTERFACE init
790 MODULE PROCEDURE vol7d_timerange_init
791END INTERFACE
792
795INTERFACE delete
796 MODULE PROCEDURE vol7d_timerange_delete
797END INTERFACE
798
802INTERFACE OPERATOR (==)
803 MODULE PROCEDURE vol7d_timerange_eq
804END INTERFACE
805
809INTERFACE OPERATOR (/=)
810 MODULE PROCEDURE vol7d_timerange_ne
811END INTERFACE
812
816INTERFACE OPERATOR (>)
817 MODULE PROCEDURE vol7d_timerange_gt
818END INTERFACE
819
823INTERFACE OPERATOR (<)
824 MODULE PROCEDURE vol7d_timerange_lt
825END INTERFACE
826
830INTERFACE OPERATOR (>=)
831 MODULE PROCEDURE vol7d_timerange_ge
832END INTERFACE
833
837INTERFACE OPERATOR (<=)
838 MODULE PROCEDURE vol7d_timerange_le
839END INTERFACE
840
843INTERFACE OPERATOR (.almosteq.)
844 MODULE PROCEDURE vol7d_timerange_almost_eq
845END INTERFACE
846
847
848! da documentare in inglese assieme al resto
850INTERFACE c_e
851 MODULE PROCEDURE vol7d_timerange_c_e
852END INTERFACE
853
854#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
855#define VOL7D_POLY_TYPES _timerange
856#define ENABLE_SORT
857#include "array_utilities_pre.F90"
858
860INTERFACE display
861 MODULE PROCEDURE display_timerange
862END INTERFACE
863
865INTERFACE to_char
866 MODULE PROCEDURE to_char_timerange
867END INTERFACE
868
869#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
870#define ARRAYOF_TYPE arrayof_vol7d_timerange
871#define ARRAYOF_ORIGEQ 1
872#include "arrayof_pre.F90"
873
874
875type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
876 vol7d_timerange(254,0,imiss),&
877 vol7d_timerange(3,0,3600)/)
878
879
880! from arrayof
882PUBLIC insert_unique, append_unique
883PUBLIC almost_equal_timeranges
884
885CONTAINS
886
887
893FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
894INTEGER,INTENT(IN),OPTIONAL :: timerange
895INTEGER,INTENT(IN),OPTIONAL :: p1
896INTEGER,INTENT(IN),OPTIONAL :: p2
897
898TYPE(vol7d_timerange) :: this
899
900CALL init(this, timerange, p1, p2)
901
902END FUNCTION vol7d_timerange_new
903
904
908SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
909TYPE(vol7d_timerange),INTENT(INOUT) :: this
910INTEGER,INTENT(IN),OPTIONAL :: timerange
911INTEGER,INTENT(IN),OPTIONAL :: p1
912INTEGER,INTENT(IN),OPTIONAL :: p2
913
914IF (PRESENT(timerange)) THEN
915 this%timerange = timerange
916ELSE
917 this%timerange = imiss
918 this%p1 = imiss
919 this%p2 = imiss
920 RETURN
921ENDIF
922!!$IF (timerange == 1) THEN ! p1 sempre 0
923!!$ this%p1 = 0
924!!$ this%p2 = imiss
925!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
926!!$ IF (PRESENT(p1)) THEN
927!!$ this%p1 = p1
928!!$ ELSE
929!!$ this%p1 = 0
930!!$ ENDIF
931!!$ this%p2 = imiss
932!!$ELSE ! tutti gli altri
933 IF (PRESENT(p1)) THEN
934 this%p1 = p1
935 ELSE
936 this%p1 = imiss
937 ENDIF
938 IF (PRESENT(p2)) THEN
939 this%p2 = p2
940 ELSE
941 this%p2 = imiss
942 ENDIF
943!!$END IF
944
945END SUBROUTINE vol7d_timerange_init
946
947
949SUBROUTINE vol7d_timerange_delete(this)
950TYPE(vol7d_timerange),INTENT(INOUT) :: this
951
952this%timerange = imiss
953this%p1 = imiss
954this%p2 = imiss
955
956END SUBROUTINE vol7d_timerange_delete
957
958
959SUBROUTINE display_timerange(this)
960TYPE(vol7d_timerange),INTENT(in) :: this
961
962print*,to_char_timerange(this)
963
964END SUBROUTINE display_timerange
965
966
967FUNCTION to_char_timerange(this)
968#ifdef HAVE_DBALLE
969USE dballef
970#endif
971TYPE(vol7d_timerange),INTENT(in) :: this
972CHARACTER(len=80) :: to_char_timerange
973
974#ifdef HAVE_DBALLE
975INTEGER :: handle, ier
976
977handle = 0
978ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
979ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
980ier = idba_fatto(handle)
981
982to_char_timerange="Timerange: "//to_char_timerange
983
984#else
985
986to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
987 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
988
989#endif
990
991END FUNCTION to_char_timerange
992
993
994ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
995TYPE(vol7d_timerange),INTENT(IN) :: this, that
996LOGICAL :: res
997
998
999res = &
1000 this%timerange == that%timerange .AND. &
1001 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1002 this%timerange == 254)
1003
1004END FUNCTION vol7d_timerange_eq
1005
1006
1007ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1008TYPE(vol7d_timerange),INTENT(IN) :: this, that
1009LOGICAL :: res
1010
1011IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1012 this%p1 == that%p1 .AND. &
1013 this%p2 == that%p2) THEN
1014 res = .true.
1015ELSE
1016 res = .false.
1017ENDIF
1018
1019END FUNCTION vol7d_timerange_almost_eq
1020
1021
1022ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1023TYPE(vol7d_timerange),INTENT(IN) :: this, that
1024LOGICAL :: res
1025
1026res = .NOT.(this == that)
1027
1028END FUNCTION vol7d_timerange_ne
1029
1030
1031ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1032TYPE(vol7d_timerange),INTENT(IN) :: this, that
1033LOGICAL :: res
1034
1035IF (this%timerange > that%timerange .OR. &
1036 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1037 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1038 this%p2 > that%p2)) THEN
1039 res = .true.
1040ELSE
1041 res = .false.
1042ENDIF
1043
1044END FUNCTION vol7d_timerange_gt
1045
1046
1047ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1048TYPE(vol7d_timerange),INTENT(IN) :: this, that
1049LOGICAL :: res
1050
1051IF (this%timerange < that%timerange .OR. &
1052 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1053 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1054 this%p2 < that%p2)) THEN
1055 res = .true.
1056ELSE
1057 res = .false.
1058ENDIF
1059
1060END FUNCTION vol7d_timerange_lt
1061
1062
1063ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1064TYPE(vol7d_timerange),INTENT(IN) :: this, that
1065LOGICAL :: res
1066
1067IF (this == that) THEN
1068 res = .true.
1069ELSE IF (this > that) THEN
1070 res = .true.
1071ELSE
1072 res = .false.
1073ENDIF
1074
1075END FUNCTION vol7d_timerange_ge
1076
1077
1078ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1079TYPE(vol7d_timerange),INTENT(IN) :: this, that
1080LOGICAL :: res
1081
1082IF (this == that) THEN
1083 res = .true.
1084ELSE IF (this < that) THEN
1085 res = .true.
1086ELSE
1087 res = .false.
1088ENDIF
1089
1090END FUNCTION vol7d_timerange_le
1091
1092
1093ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1094TYPE(vol7d_timerange),INTENT(IN) :: this
1095LOGICAL :: c_e
1096c_e = this /= vol7d_timerange_miss
1097END FUNCTION vol7d_timerange_c_e
1098
1099
1100#include "array_utilities_inc.F90"
1101
1102#include "arrayof_post.F90"
1103
1104
1105END MODULE vol7d_timerange_class
Quick method to append an element to the array.
Distruttore per la classe vol7d_timerange.
Costruttore per la classe vol7d_timerange.
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.
Represent timerange object in a pretty string.
Utilities for CHARACTER variables.
Definition of constants to be used for declaring variables of a desired type.
Definition: kinds.F90:245
Definitions of constants and functions for working with missing values.
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini.
Definisce l'intervallo temporale di un'osservazione meteo.

Generated with Doxygen.