libsim Versione 7.2.1

◆ 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 1128 del file vol7d_timerange_class.F90.

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