libsim Versione 7.1.11

◆ map_inv_distinct_timerange()

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

map inv distinct

Definizione alla linea 1134 del file vol7d_timerange_class.F90.

1136! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1137! authors:
1138! Davide Cesari <dcesari@arpa.emr.it>
1139! Paolo Patruno <ppatruno@arpa.emr.it>
1140
1141! This program is free software; you can redistribute it and/or
1142! modify it under the terms of the GNU General Public License as
1143! published by the Free Software Foundation; either version 2 of
1144! the License, or (at your option) any later version.
1145
1146! This program is distributed in the hope that it will be useful,
1147! but WITHOUT ANY WARRANTY; without even the implied warranty of
1148! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1149! GNU General Public License for more details.
1150
1151! You should have received a copy of the GNU General Public License
1152! along with this program. If not, see <http://www.gnu.org/licenses/>.
1153#include "config.h"
1154
1163USE kinds
1166IMPLICIT NONE
1167
1172TYPE vol7d_timerange
1173 INTEGER :: timerange
1174 INTEGER :: p1
1175 INTEGER :: p2
1176END TYPE vol7d_timerange
1177
1179TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
1180 vol7d_timerange(imiss,imiss,imiss)
1181
1185INTERFACE init
1186 MODULE PROCEDURE vol7d_timerange_init
1187END INTERFACE
1188
1191INTERFACE delete
1192 MODULE PROCEDURE vol7d_timerange_delete
1193END INTERFACE
1194
1198INTERFACE OPERATOR (==)
1199 MODULE PROCEDURE vol7d_timerange_eq
1200END INTERFACE
1201
1205INTERFACE OPERATOR (/=)
1206 MODULE PROCEDURE vol7d_timerange_ne
1207END INTERFACE
1208
1212INTERFACE OPERATOR (>)
1213 MODULE PROCEDURE vol7d_timerange_gt
1214END INTERFACE
1215
1219INTERFACE OPERATOR (<)
1220 MODULE PROCEDURE vol7d_timerange_lt
1221END INTERFACE
1222
1226INTERFACE OPERATOR (>=)
1227 MODULE PROCEDURE vol7d_timerange_ge
1228END INTERFACE
1229
1233INTERFACE OPERATOR (<=)
1234 MODULE PROCEDURE vol7d_timerange_le
1235END INTERFACE
1236
1239INTERFACE OPERATOR (.almosteq.)
1240 MODULE PROCEDURE vol7d_timerange_almost_eq
1241END INTERFACE
1242
1243
1244! da documentare in inglese assieme al resto
1246INTERFACE c_e
1247 MODULE PROCEDURE vol7d_timerange_c_e
1248END INTERFACE
1249
1250#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
1251#define VOL7D_POLY_TYPES _timerange
1252#define ENABLE_SORT
1253#include "array_utilities_pre.F90"
1254
1256INTERFACE display
1257 MODULE PROCEDURE display_timerange
1258END INTERFACE
1259
1261INTERFACE to_char
1262 MODULE PROCEDURE to_char_timerange
1263END INTERFACE
1264
1265#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
1266#define ARRAYOF_TYPE arrayof_vol7d_timerange
1267#define ARRAYOF_ORIGEQ 1
1268#include "arrayof_pre.F90"
1269
1270
1271type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
1272 vol7d_timerange(254,0,imiss),&
1273 vol7d_timerange(3,0,3600)/)
1274
1275
1276! from arrayof
1277PUBLIC insert, append, remove, packarray
1278PUBLIC insert_unique, append_unique
1279PUBLIC almost_equal_timeranges
1280
1281CONTAINS
1282
1283
1289FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1290INTEGER,INTENT(IN),OPTIONAL :: timerange
1291INTEGER,INTENT(IN),OPTIONAL :: p1
1292INTEGER,INTENT(IN),OPTIONAL :: p2
1293
1294TYPE(vol7d_timerange) :: this
1295
1296CALL init(this, timerange, p1, p2)
1297
1298END FUNCTION vol7d_timerange_new
1299
1300
1304SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1305TYPE(vol7d_timerange),INTENT(INOUT) :: this
1306INTEGER,INTENT(IN),OPTIONAL :: timerange
1307INTEGER,INTENT(IN),OPTIONAL :: p1
1308INTEGER,INTENT(IN),OPTIONAL :: p2
1309
1310IF (PRESENT(timerange)) THEN
1311 this%timerange = timerange
1312ELSE
1313 this%timerange = imiss
1314 this%p1 = imiss
1315 this%p2 = imiss
1316 RETURN
1317ENDIF
1318!!$IF (timerange == 1) THEN ! p1 sempre 0
1319!!$ this%p1 = 0
1320!!$ this%p2 = imiss
1321!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
1322!!$ IF (PRESENT(p1)) THEN
1323!!$ this%p1 = p1
1324!!$ ELSE
1325!!$ this%p1 = 0
1326!!$ ENDIF
1327!!$ this%p2 = imiss
1328!!$ELSE ! tutti gli altri
1329 IF (PRESENT(p1)) THEN
1330 this%p1 = p1
1331 ELSE
1332 this%p1 = imiss
1333 ENDIF
1334 IF (PRESENT(p2)) THEN
1335 this%p2 = p2
1336 ELSE
1337 this%p2 = imiss
1338 ENDIF
1339!!$END IF
1340
1341END SUBROUTINE vol7d_timerange_init
1342
1343
1345SUBROUTINE vol7d_timerange_delete(this)
1346TYPE(vol7d_timerange),INTENT(INOUT) :: this
1347
1348this%timerange = imiss
1349this%p1 = imiss
1350this%p2 = imiss
1351
1352END SUBROUTINE vol7d_timerange_delete
1353
1354
1355SUBROUTINE display_timerange(this)
1356TYPE(vol7d_timerange),INTENT(in) :: this
1357
1358print*,to_char_timerange(this)
1359
1360END SUBROUTINE display_timerange
1361
1362
1363FUNCTION to_char_timerange(this)
1364#ifdef HAVE_DBALLE
1365USE dballef
1366#endif
1367TYPE(vol7d_timerange),INTENT(in) :: this
1368CHARACTER(len=80) :: to_char_timerange
1369
1370#ifdef HAVE_DBALLE
1371INTEGER :: handle, ier
1372
1373handle = 0
1374ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1375ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
1376ier = idba_fatto(handle)
1377
1378to_char_timerange="Timerange: "//to_char_timerange
1379
1380#else
1381
1382to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
1383 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
1384
1385#endif
1386
1387END FUNCTION to_char_timerange
1388
1389
1390ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
1391TYPE(vol7d_timerange),INTENT(IN) :: this, that
1392LOGICAL :: res
1393
1394
1395res = &
1396 this%timerange == that%timerange .AND. &
1397 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1398 this%timerange == 254)
1399
1400END FUNCTION vol7d_timerange_eq
1401
1402
1403ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1404TYPE(vol7d_timerange),INTENT(IN) :: this, that
1405LOGICAL :: res
1406
1407IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1408 this%p1 == that%p1 .AND. &
1409 this%p2 == that%p2) THEN
1410 res = .true.
1411ELSE
1412 res = .false.
1413ENDIF
1414
1415END FUNCTION vol7d_timerange_almost_eq
1416
1417
1418ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1419TYPE(vol7d_timerange),INTENT(IN) :: this, that
1420LOGICAL :: res
1421
1422res = .NOT.(this == that)
1423
1424END FUNCTION vol7d_timerange_ne
1425
1426
1427ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1428TYPE(vol7d_timerange),INTENT(IN) :: this, that
1429LOGICAL :: res
1430
1431IF (this%timerange > that%timerange .OR. &
1432 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1433 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1434 this%p2 > that%p2)) THEN
1435 res = .true.
1436ELSE
1437 res = .false.
1438ENDIF
1439
1440END FUNCTION vol7d_timerange_gt
1441
1442
1443ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1444TYPE(vol7d_timerange),INTENT(IN) :: this, that
1445LOGICAL :: res
1446
1447IF (this%timerange < that%timerange .OR. &
1448 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1449 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1450 this%p2 < that%p2)) THEN
1451 res = .true.
1452ELSE
1453 res = .false.
1454ENDIF
1455
1456END FUNCTION vol7d_timerange_lt
1457
1458
1459ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1460TYPE(vol7d_timerange),INTENT(IN) :: this, that
1461LOGICAL :: res
1462
1463IF (this == that) THEN
1464 res = .true.
1465ELSE IF (this > that) THEN
1466 res = .true.
1467ELSE
1468 res = .false.
1469ENDIF
1470
1471END FUNCTION vol7d_timerange_ge
1472
1473
1474ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1475TYPE(vol7d_timerange),INTENT(IN) :: this, that
1476LOGICAL :: res
1477
1478IF (this == that) THEN
1479 res = .true.
1480ELSE IF (this < that) THEN
1481 res = .true.
1482ELSE
1483 res = .false.
1484ENDIF
1485
1486END FUNCTION vol7d_timerange_le
1487
1488
1489ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1490TYPE(vol7d_timerange),INTENT(IN) :: this
1491LOGICAL :: c_e
1492c_e = this /= vol7d_timerange_miss
1493END FUNCTION vol7d_timerange_c_e
1494
1495
1496#include "array_utilities_inc.F90"
1497
1498#include "arrayof_post.F90"
1499
1500
1501END 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.