libsim Versione 7.2.4
|
◆ count_distinct_timerange()
conta gli elementi distinti in vect Definizione alla linea 773 del file vol7d_timerange_class.F90. 774! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
775! authors:
776! Davide Cesari <dcesari@arpa.emr.it>
777! Paolo Patruno <ppatruno@arpa.emr.it>
778
779! This program is free software; you can redistribute it and/or
780! modify it under the terms of the GNU General Public License as
781! published by the Free Software Foundation; either version 2 of
782! the License, or (at your option) any later version.
783
784! This program is distributed in the hope that it will be useful,
785! but WITHOUT ANY WARRANTY; without even the implied warranty of
786! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
787! GNU General Public License for more details.
788
789! You should have received a copy of the GNU General Public License
790! along with this program. If not, see <http://www.gnu.org/licenses/>.
791#include "config.h"
792
804IMPLICIT NONE
805
811 INTEGER :: timerange
812 INTEGER :: p1
813 INTEGER :: p2
815
817TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
818 vol7d_timerange(imiss,imiss,imiss)
819
824 MODULE PROCEDURE vol7d_timerange_init
825END INTERFACE
826
830 MODULE PROCEDURE vol7d_timerange_delete
831END INTERFACE
832
836INTERFACE OPERATOR (==)
837 MODULE PROCEDURE vol7d_timerange_eq
838END INTERFACE
839
843INTERFACE OPERATOR (/=)
844 MODULE PROCEDURE vol7d_timerange_ne
845END INTERFACE
846
850INTERFACE OPERATOR (>)
851 MODULE PROCEDURE vol7d_timerange_gt
852END INTERFACE
853
857INTERFACE OPERATOR (<)
858 MODULE PROCEDURE vol7d_timerange_lt
859END INTERFACE
860
864INTERFACE OPERATOR (>=)
865 MODULE PROCEDURE vol7d_timerange_ge
866END INTERFACE
867
871INTERFACE OPERATOR (<=)
872 MODULE PROCEDURE vol7d_timerange_le
873END INTERFACE
874
877INTERFACE OPERATOR (.almosteq.)
878 MODULE PROCEDURE vol7d_timerange_almost_eq
879END INTERFACE
880
881
882! da documentare in inglese assieme al resto
885 MODULE PROCEDURE vol7d_timerange_c_e
886END INTERFACE
887
888#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
889#define VOL7D_POLY_TYPES _timerange
890#define ENABLE_SORT
891#include "array_utilities_pre.F90"
892
895 MODULE PROCEDURE display_timerange
896END INTERFACE
897
900 MODULE PROCEDURE to_char_timerange
901END INTERFACE
902
903#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
904#define ARRAYOF_TYPE arrayof_vol7d_timerange
905#define ARRAYOF_ORIGEQ 1
906#include "arrayof_pre.F90"
907
908
909type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
910 vol7d_timerange(254,0,imiss),&
911 vol7d_timerange(3,0,3600)/)
912
913
914! from arrayof
916PUBLIC insert_unique, append_unique
917PUBLIC almost_equal_timeranges
918
919CONTAINS
920
921
927FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
928INTEGER,INTENT(IN),OPTIONAL :: timerange
929INTEGER,INTENT(IN),OPTIONAL :: p1
930INTEGER,INTENT(IN),OPTIONAL :: p2
931
932TYPE(vol7d_timerange) :: this
933
935
936END FUNCTION vol7d_timerange_new
937
938
942SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
943TYPE(vol7d_timerange),INTENT(INOUT) :: this
944INTEGER,INTENT(IN),OPTIONAL :: timerange
945INTEGER,INTENT(IN),OPTIONAL :: p1
946INTEGER,INTENT(IN),OPTIONAL :: p2
947
948IF (PRESENT(timerange)) THEN
949 this%timerange = timerange
950ELSE
951 this%timerange = imiss
952 this%p1 = imiss
953 this%p2 = imiss
954 RETURN
955ENDIF
956!!$IF (timerange == 1) THEN ! p1 sempre 0
957!!$ this%p1 = 0
958!!$ this%p2 = imiss
959!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
960!!$ IF (PRESENT(p1)) THEN
961!!$ this%p1 = p1
962!!$ ELSE
963!!$ this%p1 = 0
964!!$ ENDIF
965!!$ this%p2 = imiss
966!!$ELSE ! tutti gli altri
967 IF (PRESENT(p1)) THEN
968 this%p1 = p1
969 ELSE
970 this%p1 = imiss
971 ENDIF
972 IF (PRESENT(p2)) THEN
973 this%p2 = p2
974 ELSE
975 this%p2 = imiss
976 ENDIF
977!!$END IF
978
979END SUBROUTINE vol7d_timerange_init
980
981
983SUBROUTINE vol7d_timerange_delete(this)
984TYPE(vol7d_timerange),INTENT(INOUT) :: this
985
986this%timerange = imiss
987this%p1 = imiss
988this%p2 = imiss
989
990END SUBROUTINE vol7d_timerange_delete
991
992
993SUBROUTINE display_timerange(this)
994TYPE(vol7d_timerange),INTENT(in) :: this
995
996print*,to_char_timerange(this)
997
998END SUBROUTINE display_timerange
999
1000
1001FUNCTION to_char_timerange(this)
1002#ifdef HAVE_DBALLE
1003USE dballef
1004#endif
1005TYPE(vol7d_timerange),INTENT(in) :: this
1006CHARACTER(len=80) :: to_char_timerange
1007
1008#ifdef HAVE_DBALLE
1009INTEGER :: handle, ier
1010
1011handle = 0
1012ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1013ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
1014ier = idba_fatto(handle)
1015
1016to_char_timerange="Timerange: "//to_char_timerange
1017
1018#else
1019
1022
1023#endif
1024
1025END FUNCTION to_char_timerange
1026
1027
1028ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
1029TYPE(vol7d_timerange),INTENT(IN) :: this, that
1030LOGICAL :: res
1031
1032
1033res = &
1034 this%timerange == that%timerange .AND. &
1035 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1036 this%timerange == 254)
1037
1038END FUNCTION vol7d_timerange_eq
1039
1040
1041ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1042TYPE(vol7d_timerange),INTENT(IN) :: this, that
1043LOGICAL :: res
1044
1045IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1046 this%p1 == that%p1 .AND. &
1047 this%p2 == that%p2) THEN
1048 res = .true.
1049ELSE
1050 res = .false.
1051ENDIF
1052
1053END FUNCTION vol7d_timerange_almost_eq
1054
1055
1056ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1057TYPE(vol7d_timerange),INTENT(IN) :: this, that
1058LOGICAL :: res
1059
1060res = .NOT.(this == that)
1061
1062END FUNCTION vol7d_timerange_ne
1063
1064
1065ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1066TYPE(vol7d_timerange),INTENT(IN) :: this, that
1067LOGICAL :: res
1068
1069IF (this%timerange > that%timerange .OR. &
1070 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1071 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1072 this%p2 > that%p2)) THEN
1073 res = .true.
1074ELSE
1075 res = .false.
1076ENDIF
1077
1078END FUNCTION vol7d_timerange_gt
1079
1080
1081ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1082TYPE(vol7d_timerange),INTENT(IN) :: this, that
1083LOGICAL :: res
1084
1085IF (this%timerange < that%timerange .OR. &
1086 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1087 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1088 this%p2 < that%p2)) THEN
1089 res = .true.
1090ELSE
1091 res = .false.
1092ENDIF
1093
1094END FUNCTION vol7d_timerange_lt
1095
1096
1097ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1098TYPE(vol7d_timerange),INTENT(IN) :: this, that
1099LOGICAL :: res
1100
1101IF (this == that) THEN
1102 res = .true.
1103ELSE IF (this > that) THEN
1104 res = .true.
1105ELSE
1106 res = .false.
1107ENDIF
1108
1109END FUNCTION vol7d_timerange_ge
1110
1111
1112ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1113TYPE(vol7d_timerange),INTENT(IN) :: this, that
1114LOGICAL :: res
1115
1116IF (this == that) THEN
1117 res = .true.
1118ELSE IF (this < that) THEN
1119 res = .true.
1120ELSE
1121 res = .false.
1122ENDIF
1123
1124END FUNCTION vol7d_timerange_le
1125
1126
1127ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1128TYPE(vol7d_timerange),INTENT(IN) :: this
1129LOGICAL :: c_e
1130c_e = this /= vol7d_timerange_miss
1131END FUNCTION vol7d_timerange_c_e
1132
1133
1134#include "array_utilities_inc.F90"
1135
1136#include "arrayof_post.F90"
1137
1138
Quick method to append an element to the array. Definition vol7d_timerange_class.F90:425 Distruttore per la classe vol7d_timerange. Definition vol7d_timerange_class.F90:244 Costruttore per la classe vol7d_timerange. Definition vol7d_timerange_class.F90:238 Method for inserting elements of the array at a desired position. Definition vol7d_timerange_class.F90:416 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition vol7d_timerange_class.F90:448 Method for removing elements of the array at a desired position. Definition vol7d_timerange_class.F90:431 Represent timerange object in a pretty string. Definition vol7d_timerange_class.F90:369 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. Definition missing_values.f90:50 Classe per la gestione degli intervalli temporali di osservazioni meteo e affini. Definition vol7d_timerange_class.F90:215 Definisce l'intervallo temporale di un'osservazione meteo. Definition vol7d_timerange_class.F90:225 |