libsim Versione 7.1.11
|
◆ pack_distinct_sorted_timerange()
compatta gli elementi distinti di vect in un sorted array Definizione alla linea 856 del file vol7d_timerange_class.F90. 858! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
859! authors:
860! Davide Cesari <dcesari@arpa.emr.it>
861! Paolo Patruno <ppatruno@arpa.emr.it>
862
863! This program is free software; you can redistribute it and/or
864! modify it under the terms of the GNU General Public License as
865! published by the Free Software Foundation; either version 2 of
866! the License, or (at your option) any later version.
867
868! This program is distributed in the hope that it will be useful,
869! but WITHOUT ANY WARRANTY; without even the implied warranty of
870! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
871! GNU General Public License for more details.
872
873! You should have received a copy of the GNU General Public License
874! along with this program. If not, see <http://www.gnu.org/licenses/>.
875#include "config.h"
876
888IMPLICIT NONE
889
895 INTEGER :: timerange
896 INTEGER :: p1
897 INTEGER :: p2
899
901TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
902 vol7d_timerange(imiss,imiss,imiss)
903
908 MODULE PROCEDURE vol7d_timerange_init
909END INTERFACE
910
914 MODULE PROCEDURE vol7d_timerange_delete
915END INTERFACE
916
920INTERFACE OPERATOR (==)
921 MODULE PROCEDURE vol7d_timerange_eq
922END INTERFACE
923
927INTERFACE OPERATOR (/=)
928 MODULE PROCEDURE vol7d_timerange_ne
929END INTERFACE
930
934INTERFACE OPERATOR (>)
935 MODULE PROCEDURE vol7d_timerange_gt
936END INTERFACE
937
941INTERFACE OPERATOR (<)
942 MODULE PROCEDURE vol7d_timerange_lt
943END INTERFACE
944
948INTERFACE OPERATOR (>=)
949 MODULE PROCEDURE vol7d_timerange_ge
950END INTERFACE
951
955INTERFACE OPERATOR (<=)
956 MODULE PROCEDURE vol7d_timerange_le
957END INTERFACE
958
961INTERFACE OPERATOR (.almosteq.)
962 MODULE PROCEDURE vol7d_timerange_almost_eq
963END INTERFACE
964
965
966! da documentare in inglese assieme al resto
969 MODULE PROCEDURE vol7d_timerange_c_e
970END INTERFACE
971
972#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
973#define VOL7D_POLY_TYPES _timerange
974#define ENABLE_SORT
975#include "array_utilities_pre.F90"
976
979 MODULE PROCEDURE display_timerange
980END INTERFACE
981
984 MODULE PROCEDURE to_char_timerange
985END INTERFACE
986
987#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
988#define ARRAYOF_TYPE arrayof_vol7d_timerange
989#define ARRAYOF_ORIGEQ 1
990#include "arrayof_pre.F90"
991
992
993type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
994 vol7d_timerange(254,0,imiss),&
995 vol7d_timerange(3,0,3600)/)
996
997
998! from arrayof
1000PUBLIC insert_unique, append_unique
1001PUBLIC almost_equal_timeranges
1002
1003CONTAINS
1004
1005
1011FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1012INTEGER,INTENT(IN),OPTIONAL :: timerange
1013INTEGER,INTENT(IN),OPTIONAL :: p1
1014INTEGER,INTENT(IN),OPTIONAL :: p2
1015
1016TYPE(vol7d_timerange) :: this
1017
1019
1020END FUNCTION vol7d_timerange_new
1021
1022
1026SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1027TYPE(vol7d_timerange),INTENT(INOUT) :: this
1028INTEGER,INTENT(IN),OPTIONAL :: timerange
1029INTEGER,INTENT(IN),OPTIONAL :: p1
1030INTEGER,INTENT(IN),OPTIONAL :: p2
1031
1032IF (PRESENT(timerange)) THEN
1033 this%timerange = timerange
1034ELSE
1035 this%timerange = imiss
1036 this%p1 = imiss
1037 this%p2 = imiss
1038 RETURN
1039ENDIF
1040!!$IF (timerange == 1) THEN ! p1 sempre 0
1041!!$ this%p1 = 0
1042!!$ this%p2 = imiss
1043!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
1044!!$ IF (PRESENT(p1)) THEN
1045!!$ this%p1 = p1
1046!!$ ELSE
1047!!$ this%p1 = 0
1048!!$ ENDIF
1049!!$ this%p2 = imiss
1050!!$ELSE ! tutti gli altri
1051 IF (PRESENT(p1)) THEN
1052 this%p1 = p1
1053 ELSE
1054 this%p1 = imiss
1055 ENDIF
1056 IF (PRESENT(p2)) THEN
1057 this%p2 = p2
1058 ELSE
1059 this%p2 = imiss
1060 ENDIF
1061!!$END IF
1062
1063END SUBROUTINE vol7d_timerange_init
1064
1065
1067SUBROUTINE vol7d_timerange_delete(this)
1068TYPE(vol7d_timerange),INTENT(INOUT) :: this
1069
1070this%timerange = imiss
1071this%p1 = imiss
1072this%p2 = imiss
1073
1074END SUBROUTINE vol7d_timerange_delete
1075
1076
1077SUBROUTINE display_timerange(this)
1078TYPE(vol7d_timerange),INTENT(in) :: this
1079
1080print*,to_char_timerange(this)
1081
1082END SUBROUTINE display_timerange
1083
1084
1085FUNCTION to_char_timerange(this)
1086#ifdef HAVE_DBALLE
1087USE dballef
1088#endif
1089TYPE(vol7d_timerange),INTENT(in) :: this
1090CHARACTER(len=80) :: to_char_timerange
1091
1092#ifdef HAVE_DBALLE
1093INTEGER :: handle, ier
1094
1095handle = 0
1096ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1097ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
1098ier = idba_fatto(handle)
1099
1100to_char_timerange="Timerange: "//to_char_timerange
1101
1102#else
1103
1106
1107#endif
1108
1109END FUNCTION to_char_timerange
1110
1111
1112ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
1113TYPE(vol7d_timerange),INTENT(IN) :: this, that
1114LOGICAL :: res
1115
1116
1117res = &
1118 this%timerange == that%timerange .AND. &
1119 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1120 this%timerange == 254)
1121
1122END FUNCTION vol7d_timerange_eq
1123
1124
1125ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1126TYPE(vol7d_timerange),INTENT(IN) :: this, that
1127LOGICAL :: res
1128
1129IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1130 this%p1 == that%p1 .AND. &
1131 this%p2 == that%p2) THEN
1132 res = .true.
1133ELSE
1134 res = .false.
1135ENDIF
1136
1137END FUNCTION vol7d_timerange_almost_eq
1138
1139
1140ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1141TYPE(vol7d_timerange),INTENT(IN) :: this, that
1142LOGICAL :: res
1143
1144res = .NOT.(this == that)
1145
1146END FUNCTION vol7d_timerange_ne
1147
1148
1149ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1150TYPE(vol7d_timerange),INTENT(IN) :: this, that
1151LOGICAL :: res
1152
1153IF (this%timerange > that%timerange .OR. &
1154 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1155 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1156 this%p2 > that%p2)) THEN
1157 res = .true.
1158ELSE
1159 res = .false.
1160ENDIF
1161
1162END FUNCTION vol7d_timerange_gt
1163
1164
1165ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1166TYPE(vol7d_timerange),INTENT(IN) :: this, that
1167LOGICAL :: res
1168
1169IF (this%timerange < that%timerange .OR. &
1170 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1171 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1172 this%p2 < that%p2)) THEN
1173 res = .true.
1174ELSE
1175 res = .false.
1176ENDIF
1177
1178END FUNCTION vol7d_timerange_lt
1179
1180
1181ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1182TYPE(vol7d_timerange),INTENT(IN) :: this, that
1183LOGICAL :: res
1184
1185IF (this == that) THEN
1186 res = .true.
1187ELSE IF (this > that) THEN
1188 res = .true.
1189ELSE
1190 res = .false.
1191ENDIF
1192
1193END FUNCTION vol7d_timerange_ge
1194
1195
1196ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1197TYPE(vol7d_timerange),INTENT(IN) :: this, that
1198LOGICAL :: res
1199
1200IF (this == that) THEN
1201 res = .true.
1202ELSE IF (this < that) THEN
1203 res = .true.
1204ELSE
1205 res = .false.
1206ENDIF
1207
1208END FUNCTION vol7d_timerange_le
1209
1210
1211ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1212TYPE(vol7d_timerange),INTENT(IN) :: this
1213LOGICAL :: c_e
1214c_e = this /= vol7d_timerange_miss
1215END FUNCTION vol7d_timerange_c_e
1216
1217
1218#include "array_utilities_inc.F90"
1219
1220#include "arrayof_post.F90"
1221
1222
Quick method to append an element to the array. Definition: vol7d_timerange_class.F90:431 Distruttore per la classe vol7d_timerange. Definition: vol7d_timerange_class.F90:250 Costruttore per la classe vol7d_timerange. Definition: vol7d_timerange_class.F90:244 Method for inserting elements of the array at a desired position. Definition: vol7d_timerange_class.F90:422 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: vol7d_timerange_class.F90:454 Method for removing elements of the array at a desired position. Definition: vol7d_timerange_class.F90:437 Represent timerange object in a pretty string. Definition: vol7d_timerange_class.F90:375 Definition of constants to be used for declaring variables of a desired type. Definition: kinds.F90:251 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:221 Definisce l'intervallo temporale di un'osservazione meteo. Definition: vol7d_timerange_class.F90:231 |