libsim Versione 7.1.11

◆ pack_distinct_timerange()

type(vol7d_timerange) function, dimension(dim) pack_distinct_timerange ( type(vol7d_timerange), dimension(:), intent(in)  vect,
integer, intent(in)  dim,
logical, dimension(:), intent(in), optional  mask,
logical, intent(in), optional  back 
)

compatta gli elementi distinti di vect in un array

Definizione alla linea 889 del file vol7d_timerange_class.F90.

891! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
892! authors:
893! Davide Cesari <dcesari@arpa.emr.it>
894! Paolo Patruno <ppatruno@arpa.emr.it>
895
896! This program is free software; you can redistribute it and/or
897! modify it under the terms of the GNU General Public License as
898! published by the Free Software Foundation; either version 2 of
899! the License, or (at your option) any later version.
900
901! This program is distributed in the hope that it will be useful,
902! but WITHOUT ANY WARRANTY; without even the implied warranty of
903! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
904! GNU General Public License for more details.
905
906! You should have received a copy of the GNU General Public License
907! along with this program. If not, see <http://www.gnu.org/licenses/>.
908#include "config.h"
909
918USE kinds
921IMPLICIT NONE
922
928 INTEGER :: timerange
929 INTEGER :: p1
930 INTEGER :: p2
931END TYPE vol7d_timerange
932
934TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
935 vol7d_timerange(imiss,imiss,imiss)
936
940INTERFACE init
941 MODULE PROCEDURE vol7d_timerange_init
942END INTERFACE
943
946INTERFACE delete
947 MODULE PROCEDURE vol7d_timerange_delete
948END INTERFACE
949
953INTERFACE OPERATOR (==)
954 MODULE PROCEDURE vol7d_timerange_eq
955END INTERFACE
956
960INTERFACE OPERATOR (/=)
961 MODULE PROCEDURE vol7d_timerange_ne
962END INTERFACE
963
967INTERFACE OPERATOR (>)
968 MODULE PROCEDURE vol7d_timerange_gt
969END INTERFACE
970
974INTERFACE OPERATOR (<)
975 MODULE PROCEDURE vol7d_timerange_lt
976END INTERFACE
977
981INTERFACE OPERATOR (>=)
982 MODULE PROCEDURE vol7d_timerange_ge
983END INTERFACE
984
988INTERFACE OPERATOR (<=)
989 MODULE PROCEDURE vol7d_timerange_le
990END INTERFACE
991
994INTERFACE OPERATOR (.almosteq.)
995 MODULE PROCEDURE vol7d_timerange_almost_eq
996END INTERFACE
997
998
999! da documentare in inglese assieme al resto
1001INTERFACE c_e
1002 MODULE PROCEDURE vol7d_timerange_c_e
1003END INTERFACE
1004
1005#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
1006#define VOL7D_POLY_TYPES _timerange
1007#define ENABLE_SORT
1008#include "array_utilities_pre.F90"
1009
1011INTERFACE display
1012 MODULE PROCEDURE display_timerange
1013END INTERFACE
1014
1016INTERFACE to_char
1017 MODULE PROCEDURE to_char_timerange
1018END INTERFACE
1019
1020#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
1021#define ARRAYOF_TYPE arrayof_vol7d_timerange
1022#define ARRAYOF_ORIGEQ 1
1023#include "arrayof_pre.F90"
1024
1025
1026type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
1027 vol7d_timerange(254,0,imiss),&
1028 vol7d_timerange(3,0,3600)/)
1029
1030
1031! from arrayof
1032PUBLIC insert, append, remove, packarray
1033PUBLIC insert_unique, append_unique
1034PUBLIC almost_equal_timeranges
1035
1036CONTAINS
1037
1038
1044FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1045INTEGER,INTENT(IN),OPTIONAL :: timerange
1046INTEGER,INTENT(IN),OPTIONAL :: p1
1047INTEGER,INTENT(IN),OPTIONAL :: p2
1048
1049TYPE(vol7d_timerange) :: this
1050
1051CALL init(this, timerange, p1, p2)
1052
1053END FUNCTION vol7d_timerange_new
1054
1055
1059SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1060TYPE(vol7d_timerange),INTENT(INOUT) :: this
1061INTEGER,INTENT(IN),OPTIONAL :: timerange
1062INTEGER,INTENT(IN),OPTIONAL :: p1
1063INTEGER,INTENT(IN),OPTIONAL :: p2
1064
1065IF (PRESENT(timerange)) THEN
1066 this%timerange = timerange
1067ELSE
1068 this%timerange = imiss
1069 this%p1 = imiss
1070 this%p2 = imiss
1071 RETURN
1072ENDIF
1073!!$IF (timerange == 1) THEN ! p1 sempre 0
1074!!$ this%p1 = 0
1075!!$ this%p2 = imiss
1076!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
1077!!$ IF (PRESENT(p1)) THEN
1078!!$ this%p1 = p1
1079!!$ ELSE
1080!!$ this%p1 = 0
1081!!$ ENDIF
1082!!$ this%p2 = imiss
1083!!$ELSE ! tutti gli altri
1084 IF (PRESENT(p1)) THEN
1085 this%p1 = p1
1086 ELSE
1087 this%p1 = imiss
1088 ENDIF
1089 IF (PRESENT(p2)) THEN
1090 this%p2 = p2
1091 ELSE
1092 this%p2 = imiss
1093 ENDIF
1094!!$END IF
1095
1096END SUBROUTINE vol7d_timerange_init
1097
1098
1100SUBROUTINE vol7d_timerange_delete(this)
1101TYPE(vol7d_timerange),INTENT(INOUT) :: this
1102
1103this%timerange = imiss
1104this%p1 = imiss
1105this%p2 = imiss
1106
1107END SUBROUTINE vol7d_timerange_delete
1108
1109
1110SUBROUTINE display_timerange(this)
1111TYPE(vol7d_timerange),INTENT(in) :: this
1112
1113print*,to_char_timerange(this)
1114
1115END SUBROUTINE display_timerange
1116
1117
1118FUNCTION to_char_timerange(this)
1119#ifdef HAVE_DBALLE
1120USE dballef
1121#endif
1122TYPE(vol7d_timerange),INTENT(in) :: this
1123CHARACTER(len=80) :: to_char_timerange
1124
1125#ifdef HAVE_DBALLE
1126INTEGER :: handle, ier
1127
1128handle = 0
1129ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1130ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
1131ier = idba_fatto(handle)
1132
1133to_char_timerange="Timerange: "//to_char_timerange
1134
1135#else
1136
1137to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
1138 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
1139
1140#endif
1141
1142END FUNCTION to_char_timerange
1143
1144
1145ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
1146TYPE(vol7d_timerange),INTENT(IN) :: this, that
1147LOGICAL :: res
1148
1149
1150res = &
1151 this%timerange == that%timerange .AND. &
1152 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1153 this%timerange == 254)
1154
1155END FUNCTION vol7d_timerange_eq
1156
1157
1158ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1159TYPE(vol7d_timerange),INTENT(IN) :: this, that
1160LOGICAL :: res
1161
1162IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1163 this%p1 == that%p1 .AND. &
1164 this%p2 == that%p2) THEN
1165 res = .true.
1166ELSE
1167 res = .false.
1168ENDIF
1169
1170END FUNCTION vol7d_timerange_almost_eq
1171
1172
1173ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1174TYPE(vol7d_timerange),INTENT(IN) :: this, that
1175LOGICAL :: res
1176
1177res = .NOT.(this == that)
1178
1179END FUNCTION vol7d_timerange_ne
1180
1181
1182ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1183TYPE(vol7d_timerange),INTENT(IN) :: this, that
1184LOGICAL :: res
1185
1186IF (this%timerange > that%timerange .OR. &
1187 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1188 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1189 this%p2 > that%p2)) THEN
1190 res = .true.
1191ELSE
1192 res = .false.
1193ENDIF
1194
1195END FUNCTION vol7d_timerange_gt
1196
1197
1198ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1199TYPE(vol7d_timerange),INTENT(IN) :: this, that
1200LOGICAL :: res
1201
1202IF (this%timerange < that%timerange .OR. &
1203 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1204 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1205 this%p2 < that%p2)) THEN
1206 res = .true.
1207ELSE
1208 res = .false.
1209ENDIF
1210
1211END FUNCTION vol7d_timerange_lt
1212
1213
1214ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1215TYPE(vol7d_timerange),INTENT(IN) :: this, that
1216LOGICAL :: res
1217
1218IF (this == that) THEN
1219 res = .true.
1220ELSE IF (this > that) THEN
1221 res = .true.
1222ELSE
1223 res = .false.
1224ENDIF
1225
1226END FUNCTION vol7d_timerange_ge
1227
1228
1229ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1230TYPE(vol7d_timerange),INTENT(IN) :: this, that
1231LOGICAL :: res
1232
1233IF (this == that) THEN
1234 res = .true.
1235ELSE IF (this < that) THEN
1236 res = .true.
1237ELSE
1238 res = .false.
1239ENDIF
1240
1241END FUNCTION vol7d_timerange_le
1242
1243
1244ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1245TYPE(vol7d_timerange),INTENT(IN) :: this
1246LOGICAL :: c_e
1247c_e = this /= vol7d_timerange_miss
1248END FUNCTION vol7d_timerange_c_e
1249
1250
1251#include "array_utilities_inc.F90"
1252
1253#include "arrayof_post.F90"
1254
1255
1256END 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:251
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.