libsim Versione 7.1.11

◆ sort_timerange()

subroutine sort_timerange ( type(vol7d_timerange), dimension (:), intent(inout)  xdont)

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.

Parametri
[in,out]xdontvector to sort inline

Definizione alla linea 1419 del file vol7d_timerange_class.F90.

1420! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1421! authors:
1422! Davide Cesari <dcesari@arpa.emr.it>
1423! Paolo Patruno <ppatruno@arpa.emr.it>
1424
1425! This program is free software; you can redistribute it and/or
1426! modify it under the terms of the GNU General Public License as
1427! published by the Free Software Foundation; either version 2 of
1428! the License, or (at your option) any later version.
1429
1430! This program is distributed in the hope that it will be useful,
1431! but WITHOUT ANY WARRANTY; without even the implied warranty of
1432! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1433! GNU General Public License for more details.
1434
1435! You should have received a copy of the GNU General Public License
1436! along with this program. If not, see <http://www.gnu.org/licenses/>.
1437#include "config.h"
1438
1447USE kinds
1450IMPLICIT NONE
1451
1456TYPE vol7d_timerange
1457 INTEGER :: timerange
1458 INTEGER :: p1
1459 INTEGER :: p2
1460END TYPE vol7d_timerange
1461
1463TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
1464 vol7d_timerange(imiss,imiss,imiss)
1465
1469INTERFACE init
1470 MODULE PROCEDURE vol7d_timerange_init
1471END INTERFACE
1472
1475INTERFACE delete
1476 MODULE PROCEDURE vol7d_timerange_delete
1477END INTERFACE
1478
1482INTERFACE OPERATOR (==)
1483 MODULE PROCEDURE vol7d_timerange_eq
1484END INTERFACE
1485
1489INTERFACE OPERATOR (/=)
1490 MODULE PROCEDURE vol7d_timerange_ne
1491END INTERFACE
1492
1496INTERFACE OPERATOR (>)
1497 MODULE PROCEDURE vol7d_timerange_gt
1498END INTERFACE
1499
1503INTERFACE OPERATOR (<)
1504 MODULE PROCEDURE vol7d_timerange_lt
1505END INTERFACE
1506
1510INTERFACE OPERATOR (>=)
1511 MODULE PROCEDURE vol7d_timerange_ge
1512END INTERFACE
1513
1517INTERFACE OPERATOR (<=)
1518 MODULE PROCEDURE vol7d_timerange_le
1519END INTERFACE
1520
1523INTERFACE OPERATOR (.almosteq.)
1524 MODULE PROCEDURE vol7d_timerange_almost_eq
1525END INTERFACE
1526
1527
1528! da documentare in inglese assieme al resto
1530INTERFACE c_e
1531 MODULE PROCEDURE vol7d_timerange_c_e
1532END INTERFACE
1533
1534#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
1535#define VOL7D_POLY_TYPES _timerange
1536#define ENABLE_SORT
1537#include "array_utilities_pre.F90"
1538
1540INTERFACE display
1541 MODULE PROCEDURE display_timerange
1542END INTERFACE
1543
1545INTERFACE to_char
1546 MODULE PROCEDURE to_char_timerange
1547END INTERFACE
1548
1549#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
1550#define ARRAYOF_TYPE arrayof_vol7d_timerange
1551#define ARRAYOF_ORIGEQ 1
1552#include "arrayof_pre.F90"
1553
1554
1555type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
1556 vol7d_timerange(254,0,imiss),&
1557 vol7d_timerange(3,0,3600)/)
1558
1559
1560! from arrayof
1561PUBLIC insert, append, remove, packarray
1562PUBLIC insert_unique, append_unique
1563PUBLIC almost_equal_timeranges
1564
1565CONTAINS
1566
1567
1573FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1574INTEGER,INTENT(IN),OPTIONAL :: timerange
1575INTEGER,INTENT(IN),OPTIONAL :: p1
1576INTEGER,INTENT(IN),OPTIONAL :: p2
1577
1578TYPE(vol7d_timerange) :: this
1579
1580CALL init(this, timerange, p1, p2)
1581
1582END FUNCTION vol7d_timerange_new
1583
1584
1588SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1589TYPE(vol7d_timerange),INTENT(INOUT) :: this
1590INTEGER,INTENT(IN),OPTIONAL :: timerange
1591INTEGER,INTENT(IN),OPTIONAL :: p1
1592INTEGER,INTENT(IN),OPTIONAL :: p2
1593
1594IF (PRESENT(timerange)) THEN
1595 this%timerange = timerange
1596ELSE
1597 this%timerange = imiss
1598 this%p1 = imiss
1599 this%p2 = imiss
1600 RETURN
1601ENDIF
1602!!$IF (timerange == 1) THEN ! p1 sempre 0
1603!!$ this%p1 = 0
1604!!$ this%p2 = imiss
1605!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
1606!!$ IF (PRESENT(p1)) THEN
1607!!$ this%p1 = p1
1608!!$ ELSE
1609!!$ this%p1 = 0
1610!!$ ENDIF
1611!!$ this%p2 = imiss
1612!!$ELSE ! tutti gli altri
1613 IF (PRESENT(p1)) THEN
1614 this%p1 = p1
1615 ELSE
1616 this%p1 = imiss
1617 ENDIF
1618 IF (PRESENT(p2)) THEN
1619 this%p2 = p2
1620 ELSE
1621 this%p2 = imiss
1622 ENDIF
1623!!$END IF
1624
1625END SUBROUTINE vol7d_timerange_init
1626
1627
1629SUBROUTINE vol7d_timerange_delete(this)
1630TYPE(vol7d_timerange),INTENT(INOUT) :: this
1631
1632this%timerange = imiss
1633this%p1 = imiss
1634this%p2 = imiss
1635
1636END SUBROUTINE vol7d_timerange_delete
1637
1638
1639SUBROUTINE display_timerange(this)
1640TYPE(vol7d_timerange),INTENT(in) :: this
1641
1642print*,to_char_timerange(this)
1643
1644END SUBROUTINE display_timerange
1645
1646
1647FUNCTION to_char_timerange(this)
1648#ifdef HAVE_DBALLE
1649USE dballef
1650#endif
1651TYPE(vol7d_timerange),INTENT(in) :: this
1652CHARACTER(len=80) :: to_char_timerange
1653
1654#ifdef HAVE_DBALLE
1655INTEGER :: handle, ier
1656
1657handle = 0
1658ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1659ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
1660ier = idba_fatto(handle)
1661
1662to_char_timerange="Timerange: "//to_char_timerange
1663
1664#else
1665
1666to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
1667 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
1668
1669#endif
1670
1671END FUNCTION to_char_timerange
1672
1673
1674ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
1675TYPE(vol7d_timerange),INTENT(IN) :: this, that
1676LOGICAL :: res
1677
1678
1679res = &
1680 this%timerange == that%timerange .AND. &
1681 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1682 this%timerange == 254)
1683
1684END FUNCTION vol7d_timerange_eq
1685
1686
1687ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1688TYPE(vol7d_timerange),INTENT(IN) :: this, that
1689LOGICAL :: res
1690
1691IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1692 this%p1 == that%p1 .AND. &
1693 this%p2 == that%p2) THEN
1694 res = .true.
1695ELSE
1696 res = .false.
1697ENDIF
1698
1699END FUNCTION vol7d_timerange_almost_eq
1700
1701
1702ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1703TYPE(vol7d_timerange),INTENT(IN) :: this, that
1704LOGICAL :: res
1705
1706res = .NOT.(this == that)
1707
1708END FUNCTION vol7d_timerange_ne
1709
1710
1711ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1712TYPE(vol7d_timerange),INTENT(IN) :: this, that
1713LOGICAL :: res
1714
1715IF (this%timerange > that%timerange .OR. &
1716 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1717 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1718 this%p2 > that%p2)) THEN
1719 res = .true.
1720ELSE
1721 res = .false.
1722ENDIF
1723
1724END FUNCTION vol7d_timerange_gt
1725
1726
1727ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1728TYPE(vol7d_timerange),INTENT(IN) :: this, that
1729LOGICAL :: res
1730
1731IF (this%timerange < that%timerange .OR. &
1732 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1733 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1734 this%p2 < that%p2)) THEN
1735 res = .true.
1736ELSE
1737 res = .false.
1738ENDIF
1739
1740END FUNCTION vol7d_timerange_lt
1741
1742
1743ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1744TYPE(vol7d_timerange),INTENT(IN) :: this, that
1745LOGICAL :: res
1746
1747IF (this == that) THEN
1748 res = .true.
1749ELSE IF (this > that) THEN
1750 res = .true.
1751ELSE
1752 res = .false.
1753ENDIF
1754
1755END FUNCTION vol7d_timerange_ge
1756
1757
1758ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1759TYPE(vol7d_timerange),INTENT(IN) :: this, that
1760LOGICAL :: res
1761
1762IF (this == that) THEN
1763 res = .true.
1764ELSE IF (this < that) THEN
1765 res = .true.
1766ELSE
1767 res = .false.
1768ENDIF
1769
1770END FUNCTION vol7d_timerange_le
1771
1772
1773ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1774TYPE(vol7d_timerange),INTENT(IN) :: this
1775LOGICAL :: c_e
1776c_e = this /= vol7d_timerange_miss
1777END FUNCTION vol7d_timerange_c_e
1778
1779
1780#include "array_utilities_inc.F90"
1781
1782#include "arrayof_post.F90"
1783
1784
1785END 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.