libsim Versione 7.1.11

◆ index_sorted_timerange()

recursive integer function index_sorted_timerange ( type(vol7d_timerange), dimension(:), intent(in)  vect,
type(vol7d_timerange), intent(in)  search 
)

Cerca l'indice del primo o ultimo elemento di vect uguale a search.

Definizione alla linea 1297 del file vol7d_timerange_class.F90.

1299! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1300! authors:
1301! Davide Cesari <dcesari@arpa.emr.it>
1302! Paolo Patruno <ppatruno@arpa.emr.it>
1303
1304! This program is free software; you can redistribute it and/or
1305! modify it under the terms of the GNU General Public License as
1306! published by the Free Software Foundation; either version 2 of
1307! the License, or (at your option) any later version.
1308
1309! This program is distributed in the hope that it will be useful,
1310! but WITHOUT ANY WARRANTY; without even the implied warranty of
1311! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1312! GNU General Public License for more details.
1313
1314! You should have received a copy of the GNU General Public License
1315! along with this program. If not, see <http://www.gnu.org/licenses/>.
1316#include "config.h"
1317
1326USE kinds
1329IMPLICIT NONE
1330
1335TYPE vol7d_timerange
1336 INTEGER :: timerange
1337 INTEGER :: p1
1338 INTEGER :: p2
1339END TYPE vol7d_timerange
1340
1342TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
1343 vol7d_timerange(imiss,imiss,imiss)
1344
1348INTERFACE init
1349 MODULE PROCEDURE vol7d_timerange_init
1350END INTERFACE
1351
1354INTERFACE delete
1355 MODULE PROCEDURE vol7d_timerange_delete
1356END INTERFACE
1357
1361INTERFACE OPERATOR (==)
1362 MODULE PROCEDURE vol7d_timerange_eq
1363END INTERFACE
1364
1368INTERFACE OPERATOR (/=)
1369 MODULE PROCEDURE vol7d_timerange_ne
1370END INTERFACE
1371
1375INTERFACE OPERATOR (>)
1376 MODULE PROCEDURE vol7d_timerange_gt
1377END INTERFACE
1378
1382INTERFACE OPERATOR (<)
1383 MODULE PROCEDURE vol7d_timerange_lt
1384END INTERFACE
1385
1389INTERFACE OPERATOR (>=)
1390 MODULE PROCEDURE vol7d_timerange_ge
1391END INTERFACE
1392
1396INTERFACE OPERATOR (<=)
1397 MODULE PROCEDURE vol7d_timerange_le
1398END INTERFACE
1399
1402INTERFACE OPERATOR (.almosteq.)
1403 MODULE PROCEDURE vol7d_timerange_almost_eq
1404END INTERFACE
1405
1406
1407! da documentare in inglese assieme al resto
1409INTERFACE c_e
1410 MODULE PROCEDURE vol7d_timerange_c_e
1411END INTERFACE
1412
1413#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
1414#define VOL7D_POLY_TYPES _timerange
1415#define ENABLE_SORT
1416#include "array_utilities_pre.F90"
1417
1419INTERFACE display
1420 MODULE PROCEDURE display_timerange
1421END INTERFACE
1422
1424INTERFACE to_char
1425 MODULE PROCEDURE to_char_timerange
1426END INTERFACE
1427
1428#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
1429#define ARRAYOF_TYPE arrayof_vol7d_timerange
1430#define ARRAYOF_ORIGEQ 1
1431#include "arrayof_pre.F90"
1432
1433
1434type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
1435 vol7d_timerange(254,0,imiss),&
1436 vol7d_timerange(3,0,3600)/)
1437
1438
1439! from arrayof
1440PUBLIC insert, append, remove, packarray
1441PUBLIC insert_unique, append_unique
1442PUBLIC almost_equal_timeranges
1443
1444CONTAINS
1445
1446
1452FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1453INTEGER,INTENT(IN),OPTIONAL :: timerange
1454INTEGER,INTENT(IN),OPTIONAL :: p1
1455INTEGER,INTENT(IN),OPTIONAL :: p2
1456
1457TYPE(vol7d_timerange) :: this
1458
1459CALL init(this, timerange, p1, p2)
1460
1461END FUNCTION vol7d_timerange_new
1462
1463
1467SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1468TYPE(vol7d_timerange),INTENT(INOUT) :: this
1469INTEGER,INTENT(IN),OPTIONAL :: timerange
1470INTEGER,INTENT(IN),OPTIONAL :: p1
1471INTEGER,INTENT(IN),OPTIONAL :: p2
1472
1473IF (PRESENT(timerange)) THEN
1474 this%timerange = timerange
1475ELSE
1476 this%timerange = imiss
1477 this%p1 = imiss
1478 this%p2 = imiss
1479 RETURN
1480ENDIF
1481!!$IF (timerange == 1) THEN ! p1 sempre 0
1482!!$ this%p1 = 0
1483!!$ this%p2 = imiss
1484!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
1485!!$ IF (PRESENT(p1)) THEN
1486!!$ this%p1 = p1
1487!!$ ELSE
1488!!$ this%p1 = 0
1489!!$ ENDIF
1490!!$ this%p2 = imiss
1491!!$ELSE ! tutti gli altri
1492 IF (PRESENT(p1)) THEN
1493 this%p1 = p1
1494 ELSE
1495 this%p1 = imiss
1496 ENDIF
1497 IF (PRESENT(p2)) THEN
1498 this%p2 = p2
1499 ELSE
1500 this%p2 = imiss
1501 ENDIF
1502!!$END IF
1503
1504END SUBROUTINE vol7d_timerange_init
1505
1506
1508SUBROUTINE vol7d_timerange_delete(this)
1509TYPE(vol7d_timerange),INTENT(INOUT) :: this
1510
1511this%timerange = imiss
1512this%p1 = imiss
1513this%p2 = imiss
1514
1515END SUBROUTINE vol7d_timerange_delete
1516
1517
1518SUBROUTINE display_timerange(this)
1519TYPE(vol7d_timerange),INTENT(in) :: this
1520
1521print*,to_char_timerange(this)
1522
1523END SUBROUTINE display_timerange
1524
1525
1526FUNCTION to_char_timerange(this)
1527#ifdef HAVE_DBALLE
1528USE dballef
1529#endif
1530TYPE(vol7d_timerange),INTENT(in) :: this
1531CHARACTER(len=80) :: to_char_timerange
1532
1533#ifdef HAVE_DBALLE
1534INTEGER :: handle, ier
1535
1536handle = 0
1537ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1538ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
1539ier = idba_fatto(handle)
1540
1541to_char_timerange="Timerange: "//to_char_timerange
1542
1543#else
1544
1545to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
1546 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
1547
1548#endif
1549
1550END FUNCTION to_char_timerange
1551
1552
1553ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
1554TYPE(vol7d_timerange),INTENT(IN) :: this, that
1555LOGICAL :: res
1556
1557
1558res = &
1559 this%timerange == that%timerange .AND. &
1560 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1561 this%timerange == 254)
1562
1563END FUNCTION vol7d_timerange_eq
1564
1565
1566ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1567TYPE(vol7d_timerange),INTENT(IN) :: this, that
1568LOGICAL :: res
1569
1570IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1571 this%p1 == that%p1 .AND. &
1572 this%p2 == that%p2) THEN
1573 res = .true.
1574ELSE
1575 res = .false.
1576ENDIF
1577
1578END FUNCTION vol7d_timerange_almost_eq
1579
1580
1581ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1582TYPE(vol7d_timerange),INTENT(IN) :: this, that
1583LOGICAL :: res
1584
1585res = .NOT.(this == that)
1586
1587END FUNCTION vol7d_timerange_ne
1588
1589
1590ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1591TYPE(vol7d_timerange),INTENT(IN) :: this, that
1592LOGICAL :: res
1593
1594IF (this%timerange > that%timerange .OR. &
1595 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1596 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1597 this%p2 > that%p2)) THEN
1598 res = .true.
1599ELSE
1600 res = .false.
1601ENDIF
1602
1603END FUNCTION vol7d_timerange_gt
1604
1605
1606ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1607TYPE(vol7d_timerange),INTENT(IN) :: this, that
1608LOGICAL :: res
1609
1610IF (this%timerange < that%timerange .OR. &
1611 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1612 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1613 this%p2 < that%p2)) THEN
1614 res = .true.
1615ELSE
1616 res = .false.
1617ENDIF
1618
1619END FUNCTION vol7d_timerange_lt
1620
1621
1622ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1623TYPE(vol7d_timerange),INTENT(IN) :: this, that
1624LOGICAL :: res
1625
1626IF (this == that) THEN
1627 res = .true.
1628ELSE IF (this > that) THEN
1629 res = .true.
1630ELSE
1631 res = .false.
1632ENDIF
1633
1634END FUNCTION vol7d_timerange_ge
1635
1636
1637ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1638TYPE(vol7d_timerange),INTENT(IN) :: this, that
1639LOGICAL :: res
1640
1641IF (this == that) THEN
1642 res = .true.
1643ELSE IF (this < that) THEN
1644 res = .true.
1645ELSE
1646 res = .false.
1647ENDIF
1648
1649END FUNCTION vol7d_timerange_le
1650
1651
1652ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1653TYPE(vol7d_timerange),INTENT(IN) :: this
1654LOGICAL :: c_e
1655c_e = this /= vol7d_timerange_miss
1656END FUNCTION vol7d_timerange_c_e
1657
1658
1659#include "array_utilities_inc.F90"
1660
1661#include "arrayof_post.F90"
1662
1663
1664END 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.