libsim Versione 7.2.1

◆ map_distinct_timerange()

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

map distinct

Definizione alla linea 1032 del file vol7d_timerange_class.F90.

1033! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1034! authors:
1035! Davide Cesari <dcesari@arpa.emr.it>
1036! Paolo Patruno <ppatruno@arpa.emr.it>
1037
1038! This program is free software; you can redistribute it and/or
1039! modify it under the terms of the GNU General Public License as
1040! published by the Free Software Foundation; either version 2 of
1041! the License, or (at your option) any later version.
1042
1043! This program is distributed in the hope that it will be useful,
1044! but WITHOUT ANY WARRANTY; without even the implied warranty of
1045! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1046! GNU General Public License for more details.
1047
1048! You should have received a copy of the GNU General Public License
1049! along with this program. If not, see <http://www.gnu.org/licenses/>.
1050#include "config.h"
1051
1060USE kinds
1063IMPLICIT NONE
1064
1069TYPE vol7d_timerange
1070 INTEGER :: timerange
1071 INTEGER :: p1
1072 INTEGER :: p2
1073END TYPE vol7d_timerange
1074
1076TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
1077 vol7d_timerange(imiss,imiss,imiss)
1078
1082INTERFACE init
1083 MODULE PROCEDURE vol7d_timerange_init
1084END INTERFACE
1085
1088INTERFACE delete
1089 MODULE PROCEDURE vol7d_timerange_delete
1090END INTERFACE
1091
1095INTERFACE OPERATOR (==)
1096 MODULE PROCEDURE vol7d_timerange_eq
1097END INTERFACE
1098
1102INTERFACE OPERATOR (/=)
1103 MODULE PROCEDURE vol7d_timerange_ne
1104END INTERFACE
1105
1109INTERFACE OPERATOR (>)
1110 MODULE PROCEDURE vol7d_timerange_gt
1111END INTERFACE
1112
1116INTERFACE OPERATOR (<)
1117 MODULE PROCEDURE vol7d_timerange_lt
1118END INTERFACE
1119
1123INTERFACE OPERATOR (>=)
1124 MODULE PROCEDURE vol7d_timerange_ge
1125END INTERFACE
1126
1130INTERFACE OPERATOR (<=)
1131 MODULE PROCEDURE vol7d_timerange_le
1132END INTERFACE
1133
1136INTERFACE OPERATOR (.almosteq.)
1137 MODULE PROCEDURE vol7d_timerange_almost_eq
1138END INTERFACE
1139
1140
1141! da documentare in inglese assieme al resto
1143INTERFACE c_e
1144 MODULE PROCEDURE vol7d_timerange_c_e
1145END INTERFACE
1146
1147#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
1148#define VOL7D_POLY_TYPES _timerange
1149#define ENABLE_SORT
1150#include "array_utilities_pre.F90"
1151
1153INTERFACE display
1154 MODULE PROCEDURE display_timerange
1155END INTERFACE
1156
1158INTERFACE to_char
1159 MODULE PROCEDURE to_char_timerange
1160END INTERFACE
1161
1162#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
1163#define ARRAYOF_TYPE arrayof_vol7d_timerange
1164#define ARRAYOF_ORIGEQ 1
1165#include "arrayof_pre.F90"
1166
1167
1168type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
1169 vol7d_timerange(254,0,imiss),&
1170 vol7d_timerange(3,0,3600)/)
1171
1172
1173! from arrayof
1174PUBLIC insert, append, remove, packarray
1175PUBLIC insert_unique, append_unique
1176PUBLIC almost_equal_timeranges
1177
1178CONTAINS
1179
1180
1186FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1187INTEGER,INTENT(IN),OPTIONAL :: timerange
1188INTEGER,INTENT(IN),OPTIONAL :: p1
1189INTEGER,INTENT(IN),OPTIONAL :: p2
1190
1191TYPE(vol7d_timerange) :: this
1192
1193CALL init(this, timerange, p1, p2)
1194
1195END FUNCTION vol7d_timerange_new
1196
1197
1201SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1202TYPE(vol7d_timerange),INTENT(INOUT) :: this
1203INTEGER,INTENT(IN),OPTIONAL :: timerange
1204INTEGER,INTENT(IN),OPTIONAL :: p1
1205INTEGER,INTENT(IN),OPTIONAL :: p2
1206
1207IF (PRESENT(timerange)) THEN
1208 this%timerange = timerange
1209ELSE
1210 this%timerange = imiss
1211 this%p1 = imiss
1212 this%p2 = imiss
1213 RETURN
1214ENDIF
1215!!$IF (timerange == 1) THEN ! p1 sempre 0
1216!!$ this%p1 = 0
1217!!$ this%p2 = imiss
1218!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
1219!!$ IF (PRESENT(p1)) THEN
1220!!$ this%p1 = p1
1221!!$ ELSE
1222!!$ this%p1 = 0
1223!!$ ENDIF
1224!!$ this%p2 = imiss
1225!!$ELSE ! tutti gli altri
1226 IF (PRESENT(p1)) THEN
1227 this%p1 = p1
1228 ELSE
1229 this%p1 = imiss
1230 ENDIF
1231 IF (PRESENT(p2)) THEN
1232 this%p2 = p2
1233 ELSE
1234 this%p2 = imiss
1235 ENDIF
1236!!$END IF
1237
1238END SUBROUTINE vol7d_timerange_init
1239
1240
1242SUBROUTINE vol7d_timerange_delete(this)
1243TYPE(vol7d_timerange),INTENT(INOUT) :: this
1244
1245this%timerange = imiss
1246this%p1 = imiss
1247this%p2 = imiss
1248
1249END SUBROUTINE vol7d_timerange_delete
1250
1251
1252SUBROUTINE display_timerange(this)
1253TYPE(vol7d_timerange),INTENT(in) :: this
1254
1255print*,to_char_timerange(this)
1256
1257END SUBROUTINE display_timerange
1258
1259
1260FUNCTION to_char_timerange(this)
1261#ifdef HAVE_DBALLE
1262USE dballef
1263#endif
1264TYPE(vol7d_timerange),INTENT(in) :: this
1265CHARACTER(len=80) :: to_char_timerange
1266
1267#ifdef HAVE_DBALLE
1268INTEGER :: handle, ier
1269
1270handle = 0
1271ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1272ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
1273ier = idba_fatto(handle)
1274
1275to_char_timerange="Timerange: "//to_char_timerange
1276
1277#else
1278
1279to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
1280 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
1281
1282#endif
1283
1284END FUNCTION to_char_timerange
1285
1286
1287ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
1288TYPE(vol7d_timerange),INTENT(IN) :: this, that
1289LOGICAL :: res
1290
1291
1292res = &
1293 this%timerange == that%timerange .AND. &
1294 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1295 this%timerange == 254)
1296
1297END FUNCTION vol7d_timerange_eq
1298
1299
1300ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1301TYPE(vol7d_timerange),INTENT(IN) :: this, that
1302LOGICAL :: res
1303
1304IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1305 this%p1 == that%p1 .AND. &
1306 this%p2 == that%p2) THEN
1307 res = .true.
1308ELSE
1309 res = .false.
1310ENDIF
1311
1312END FUNCTION vol7d_timerange_almost_eq
1313
1314
1315ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1316TYPE(vol7d_timerange),INTENT(IN) :: this, that
1317LOGICAL :: res
1318
1319res = .NOT.(this == that)
1320
1321END FUNCTION vol7d_timerange_ne
1322
1323
1324ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1325TYPE(vol7d_timerange),INTENT(IN) :: this, that
1326LOGICAL :: res
1327
1328IF (this%timerange > that%timerange .OR. &
1329 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1330 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1331 this%p2 > that%p2)) THEN
1332 res = .true.
1333ELSE
1334 res = .false.
1335ENDIF
1336
1337END FUNCTION vol7d_timerange_gt
1338
1339
1340ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1341TYPE(vol7d_timerange),INTENT(IN) :: this, that
1342LOGICAL :: res
1343
1344IF (this%timerange < that%timerange .OR. &
1345 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1346 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1347 this%p2 < that%p2)) THEN
1348 res = .true.
1349ELSE
1350 res = .false.
1351ENDIF
1352
1353END FUNCTION vol7d_timerange_lt
1354
1355
1356ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1357TYPE(vol7d_timerange),INTENT(IN) :: this, that
1358LOGICAL :: res
1359
1360IF (this == that) THEN
1361 res = .true.
1362ELSE IF (this > that) THEN
1363 res = .true.
1364ELSE
1365 res = .false.
1366ENDIF
1367
1368END FUNCTION vol7d_timerange_ge
1369
1370
1371ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1372TYPE(vol7d_timerange),INTENT(IN) :: this, that
1373LOGICAL :: res
1374
1375IF (this == that) THEN
1376 res = .true.
1377ELSE IF (this < that) THEN
1378 res = .true.
1379ELSE
1380 res = .false.
1381ENDIF
1382
1383END FUNCTION vol7d_timerange_le
1384
1385
1386ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1387TYPE(vol7d_timerange),INTENT(IN) :: this
1388LOGICAL :: c_e
1389c_e = this /= vol7d_timerange_miss
1390END FUNCTION vol7d_timerange_c_e
1391
1392
1393#include "array_utilities_inc.F90"
1394
1395#include "arrayof_post.F90"
1396
1397
1398END 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.