libsim Versione 7.2.0

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

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