libsim Versione 7.2.1
|
◆ sort_timerange()
Sorts inline into ascending order - Quicksort Quicksort chooses a "pivot" in the set, and explores the array from both ends, looking for a value > pivot with the increasing index, for a value <= pivot with the decreasing index, and swapping them when it has found one of each. The array is then subdivided in 2 ([3]) subsets: { values <= pivot} {pivot} {values > pivot} One then call recursively the program to sort each subset. When the size of the subarray is small enough or the maximum level of recursion is gained, one uses an insertion sort that is faster for very small sets.
Definizione alla linea 1413 del file vol7d_timerange_class.F90. 1414! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1415! authors:
1416! Davide Cesari <dcesari@arpa.emr.it>
1417! Paolo Patruno <ppatruno@arpa.emr.it>
1418
1419! This program is free software; you can redistribute it and/or
1420! modify it under the terms of the GNU General Public License as
1421! published by the Free Software Foundation; either version 2 of
1422! the License, or (at your option) any later version.
1423
1424! This program is distributed in the hope that it will be useful,
1425! but WITHOUT ANY WARRANTY; without even the implied warranty of
1426! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1427! GNU General Public License for more details.
1428
1429! You should have received a copy of the GNU General Public License
1430! along with this program. If not, see <http://www.gnu.org/licenses/>.
1431#include "config.h"
1432
1444IMPLICIT NONE
1445
1451 INTEGER :: timerange
1452 INTEGER :: p1
1453 INTEGER :: p2
1455
1457TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
1458 vol7d_timerange(imiss,imiss,imiss)
1459
1464 MODULE PROCEDURE vol7d_timerange_init
1465END INTERFACE
1466
1470 MODULE PROCEDURE vol7d_timerange_delete
1471END INTERFACE
1472
1476INTERFACE OPERATOR (==)
1477 MODULE PROCEDURE vol7d_timerange_eq
1478END INTERFACE
1479
1483INTERFACE OPERATOR (/=)
1484 MODULE PROCEDURE vol7d_timerange_ne
1485END INTERFACE
1486
1490INTERFACE OPERATOR (>)
1491 MODULE PROCEDURE vol7d_timerange_gt
1492END INTERFACE
1493
1497INTERFACE OPERATOR (<)
1498 MODULE PROCEDURE vol7d_timerange_lt
1499END INTERFACE
1500
1504INTERFACE OPERATOR (>=)
1505 MODULE PROCEDURE vol7d_timerange_ge
1506END INTERFACE
1507
1511INTERFACE OPERATOR (<=)
1512 MODULE PROCEDURE vol7d_timerange_le
1513END INTERFACE
1514
1517INTERFACE OPERATOR (.almosteq.)
1518 MODULE PROCEDURE vol7d_timerange_almost_eq
1519END INTERFACE
1520
1521
1522! da documentare in inglese assieme al resto
1525 MODULE PROCEDURE vol7d_timerange_c_e
1526END INTERFACE
1527
1528#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
1529#define VOL7D_POLY_TYPES _timerange
1530#define ENABLE_SORT
1531#include "array_utilities_pre.F90"
1532
1535 MODULE PROCEDURE display_timerange
1536END INTERFACE
1537
1540 MODULE PROCEDURE to_char_timerange
1541END INTERFACE
1542
1543#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
1544#define ARRAYOF_TYPE arrayof_vol7d_timerange
1545#define ARRAYOF_ORIGEQ 1
1546#include "arrayof_pre.F90"
1547
1548
1549type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
1550 vol7d_timerange(254,0,imiss),&
1551 vol7d_timerange(3,0,3600)/)
1552
1553
1554! from arrayof
1556PUBLIC insert_unique, append_unique
1557PUBLIC almost_equal_timeranges
1558
1559CONTAINS
1560
1561
1567FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1568INTEGER,INTENT(IN),OPTIONAL :: timerange
1569INTEGER,INTENT(IN),OPTIONAL :: p1
1570INTEGER,INTENT(IN),OPTIONAL :: p2
1571
1572TYPE(vol7d_timerange) :: this
1573
1575
1576END FUNCTION vol7d_timerange_new
1577
1578
1582SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1583TYPE(vol7d_timerange),INTENT(INOUT) :: this
1584INTEGER,INTENT(IN),OPTIONAL :: timerange
1585INTEGER,INTENT(IN),OPTIONAL :: p1
1586INTEGER,INTENT(IN),OPTIONAL :: p2
1587
1588IF (PRESENT(timerange)) THEN
1589 this%timerange = timerange
1590ELSE
1591 this%timerange = imiss
1592 this%p1 = imiss
1593 this%p2 = imiss
1594 RETURN
1595ENDIF
1596!!$IF (timerange == 1) THEN ! p1 sempre 0
1597!!$ this%p1 = 0
1598!!$ this%p2 = imiss
1599!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
1600!!$ IF (PRESENT(p1)) THEN
1601!!$ this%p1 = p1
1602!!$ ELSE
1603!!$ this%p1 = 0
1604!!$ ENDIF
1605!!$ this%p2 = imiss
1606!!$ELSE ! tutti gli altri
1607 IF (PRESENT(p1)) THEN
1608 this%p1 = p1
1609 ELSE
1610 this%p1 = imiss
1611 ENDIF
1612 IF (PRESENT(p2)) THEN
1613 this%p2 = p2
1614 ELSE
1615 this%p2 = imiss
1616 ENDIF
1617!!$END IF
1618
1619END SUBROUTINE vol7d_timerange_init
1620
1621
1623SUBROUTINE vol7d_timerange_delete(this)
1624TYPE(vol7d_timerange),INTENT(INOUT) :: this
1625
1626this%timerange = imiss
1627this%p1 = imiss
1628this%p2 = imiss
1629
1630END SUBROUTINE vol7d_timerange_delete
1631
1632
1633SUBROUTINE display_timerange(this)
1634TYPE(vol7d_timerange),INTENT(in) :: this
1635
1636print*,to_char_timerange(this)
1637
1638END SUBROUTINE display_timerange
1639
1640
1641FUNCTION to_char_timerange(this)
1642#ifdef HAVE_DBALLE
1643USE dballef
1644#endif
1645TYPE(vol7d_timerange),INTENT(in) :: this
1646CHARACTER(len=80) :: to_char_timerange
1647
1648#ifdef HAVE_DBALLE
1649INTEGER :: handle, ier
1650
1651handle = 0
1652ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1653ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
1654ier = idba_fatto(handle)
1655
1656to_char_timerange="Timerange: "//to_char_timerange
1657
1658#else
1659
1662
1663#endif
1664
1665END FUNCTION to_char_timerange
1666
1667
1668ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
1669TYPE(vol7d_timerange),INTENT(IN) :: this, that
1670LOGICAL :: res
1671
1672
1673res = &
1674 this%timerange == that%timerange .AND. &
1675 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1676 this%timerange == 254)
1677
1678END FUNCTION vol7d_timerange_eq
1679
1680
1681ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1682TYPE(vol7d_timerange),INTENT(IN) :: this, that
1683LOGICAL :: res
1684
1685IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1686 this%p1 == that%p1 .AND. &
1687 this%p2 == that%p2) THEN
1688 res = .true.
1689ELSE
1690 res = .false.
1691ENDIF
1692
1693END FUNCTION vol7d_timerange_almost_eq
1694
1695
1696ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1697TYPE(vol7d_timerange),INTENT(IN) :: this, that
1698LOGICAL :: res
1699
1700res = .NOT.(this == that)
1701
1702END FUNCTION vol7d_timerange_ne
1703
1704
1705ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1706TYPE(vol7d_timerange),INTENT(IN) :: this, that
1707LOGICAL :: res
1708
1709IF (this%timerange > that%timerange .OR. &
1710 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1711 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1712 this%p2 > that%p2)) THEN
1713 res = .true.
1714ELSE
1715 res = .false.
1716ENDIF
1717
1718END FUNCTION vol7d_timerange_gt
1719
1720
1721ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1722TYPE(vol7d_timerange),INTENT(IN) :: this, that
1723LOGICAL :: res
1724
1725IF (this%timerange < that%timerange .OR. &
1726 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1727 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1728 this%p2 < that%p2)) THEN
1729 res = .true.
1730ELSE
1731 res = .false.
1732ENDIF
1733
1734END FUNCTION vol7d_timerange_lt
1735
1736
1737ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1738TYPE(vol7d_timerange),INTENT(IN) :: this, that
1739LOGICAL :: res
1740
1741IF (this == that) THEN
1742 res = .true.
1743ELSE IF (this > that) THEN
1744 res = .true.
1745ELSE
1746 res = .false.
1747ENDIF
1748
1749END FUNCTION vol7d_timerange_ge
1750
1751
1752ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1753TYPE(vol7d_timerange),INTENT(IN) :: this, that
1754LOGICAL :: res
1755
1756IF (this == that) THEN
1757 res = .true.
1758ELSE IF (this < that) THEN
1759 res = .true.
1760ELSE
1761 res = .false.
1762ENDIF
1763
1764END FUNCTION vol7d_timerange_le
1765
1766
1767ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1768TYPE(vol7d_timerange),INTENT(IN) :: this
1769LOGICAL :: c_e
1770c_e = this /= vol7d_timerange_miss
1771END FUNCTION vol7d_timerange_c_e
1772
1773
1774#include "array_utilities_inc.F90"
1775
1776#include "arrayof_post.F90"
1777
1778
Quick method to append an element to the array. Definition: vol7d_timerange_class.F90:425 Distruttore per la classe vol7d_timerange. Definition: vol7d_timerange_class.F90:244 Costruttore per la classe vol7d_timerange. Definition: vol7d_timerange_class.F90:238 Method for inserting elements of the array at a desired position. Definition: vol7d_timerange_class.F90:416 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: vol7d_timerange_class.F90:448 Method for removing elements of the array at a desired position. Definition: vol7d_timerange_class.F90:431 Represent timerange object in a pretty string. Definition: vol7d_timerange_class.F90:369 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. Definition: missing_values.f90:50 Classe per la gestione degli intervalli temporali di osservazioni meteo e affini. Definition: vol7d_timerange_class.F90:215 Definisce l'intervallo temporale di un'osservazione meteo. Definition: vol7d_timerange_class.F90:225 |