libsim Versione 7.1.11

◆ inssor_timerange()

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

Sorts into increasing order (Insertion sort) Sorts XDONT into increasing order (Insertion sort) This subroutine uses insertion sort.

It does not use any work array and is faster when XDONT is of very small size (< 20), or already almost sorted, so it is used in a final pass when the partial quicksorting has left a sequence of small subsets and that sorting is only necessary within each subset to complete the process. Michel Olagnon - Apr. 2000

Definizione alla linea 1544 del file vol7d_timerange_class.F90.

1545! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1546! authors:
1547! Davide Cesari <dcesari@arpa.emr.it>
1548! Paolo Patruno <ppatruno@arpa.emr.it>
1549
1550! This program is free software; you can redistribute it and/or
1551! modify it under the terms of the GNU General Public License as
1552! published by the Free Software Foundation; either version 2 of
1553! the License, or (at your option) any later version.
1554
1555! This program is distributed in the hope that it will be useful,
1556! but WITHOUT ANY WARRANTY; without even the implied warranty of
1557! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1558! GNU General Public License for more details.
1559
1560! You should have received a copy of the GNU General Public License
1561! along with this program. If not, see <http://www.gnu.org/licenses/>.
1562#include "config.h"
1563
1572USE kinds
1575IMPLICIT NONE
1576
1581TYPE vol7d_timerange
1582 INTEGER :: timerange
1583 INTEGER :: p1
1584 INTEGER :: p2
1585END TYPE vol7d_timerange
1586
1588TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
1589 vol7d_timerange(imiss,imiss,imiss)
1590
1594INTERFACE init
1595 MODULE PROCEDURE vol7d_timerange_init
1596END INTERFACE
1597
1600INTERFACE delete
1601 MODULE PROCEDURE vol7d_timerange_delete
1602END INTERFACE
1603
1607INTERFACE OPERATOR (==)
1608 MODULE PROCEDURE vol7d_timerange_eq
1609END INTERFACE
1610
1614INTERFACE OPERATOR (/=)
1615 MODULE PROCEDURE vol7d_timerange_ne
1616END INTERFACE
1617
1621INTERFACE OPERATOR (>)
1622 MODULE PROCEDURE vol7d_timerange_gt
1623END INTERFACE
1624
1628INTERFACE OPERATOR (<)
1629 MODULE PROCEDURE vol7d_timerange_lt
1630END INTERFACE
1631
1635INTERFACE OPERATOR (>=)
1636 MODULE PROCEDURE vol7d_timerange_ge
1637END INTERFACE
1638
1642INTERFACE OPERATOR (<=)
1643 MODULE PROCEDURE vol7d_timerange_le
1644END INTERFACE
1645
1648INTERFACE OPERATOR (.almosteq.)
1649 MODULE PROCEDURE vol7d_timerange_almost_eq
1650END INTERFACE
1651
1652
1653! da documentare in inglese assieme al resto
1655INTERFACE c_e
1656 MODULE PROCEDURE vol7d_timerange_c_e
1657END INTERFACE
1658
1659#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
1660#define VOL7D_POLY_TYPES _timerange
1661#define ENABLE_SORT
1662#include "array_utilities_pre.F90"
1663
1665INTERFACE display
1666 MODULE PROCEDURE display_timerange
1667END INTERFACE
1668
1670INTERFACE to_char
1671 MODULE PROCEDURE to_char_timerange
1672END INTERFACE
1673
1674#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
1675#define ARRAYOF_TYPE arrayof_vol7d_timerange
1676#define ARRAYOF_ORIGEQ 1
1677#include "arrayof_pre.F90"
1678
1679
1680type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
1681 vol7d_timerange(254,0,imiss),&
1682 vol7d_timerange(3,0,3600)/)
1683
1684
1685! from arrayof
1686PUBLIC insert, append, remove, packarray
1687PUBLIC insert_unique, append_unique
1688PUBLIC almost_equal_timeranges
1689
1690CONTAINS
1691
1692
1698FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1699INTEGER,INTENT(IN),OPTIONAL :: timerange
1700INTEGER,INTENT(IN),OPTIONAL :: p1
1701INTEGER,INTENT(IN),OPTIONAL :: p2
1702
1703TYPE(vol7d_timerange) :: this
1704
1705CALL init(this, timerange, p1, p2)
1706
1707END FUNCTION vol7d_timerange_new
1708
1709
1713SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1714TYPE(vol7d_timerange),INTENT(INOUT) :: this
1715INTEGER,INTENT(IN),OPTIONAL :: timerange
1716INTEGER,INTENT(IN),OPTIONAL :: p1
1717INTEGER,INTENT(IN),OPTIONAL :: p2
1718
1719IF (PRESENT(timerange)) THEN
1720 this%timerange = timerange
1721ELSE
1722 this%timerange = imiss
1723 this%p1 = imiss
1724 this%p2 = imiss
1725 RETURN
1726ENDIF
1727!!$IF (timerange == 1) THEN ! p1 sempre 0
1728!!$ this%p1 = 0
1729!!$ this%p2 = imiss
1730!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
1731!!$ IF (PRESENT(p1)) THEN
1732!!$ this%p1 = p1
1733!!$ ELSE
1734!!$ this%p1 = 0
1735!!$ ENDIF
1736!!$ this%p2 = imiss
1737!!$ELSE ! tutti gli altri
1738 IF (PRESENT(p1)) THEN
1739 this%p1 = p1
1740 ELSE
1741 this%p1 = imiss
1742 ENDIF
1743 IF (PRESENT(p2)) THEN
1744 this%p2 = p2
1745 ELSE
1746 this%p2 = imiss
1747 ENDIF
1748!!$END IF
1749
1750END SUBROUTINE vol7d_timerange_init
1751
1752
1754SUBROUTINE vol7d_timerange_delete(this)
1755TYPE(vol7d_timerange),INTENT(INOUT) :: this
1756
1757this%timerange = imiss
1758this%p1 = imiss
1759this%p2 = imiss
1760
1761END SUBROUTINE vol7d_timerange_delete
1762
1763
1764SUBROUTINE display_timerange(this)
1765TYPE(vol7d_timerange),INTENT(in) :: this
1766
1767print*,to_char_timerange(this)
1768
1769END SUBROUTINE display_timerange
1770
1771
1772FUNCTION to_char_timerange(this)
1773#ifdef HAVE_DBALLE
1774USE dballef
1775#endif
1776TYPE(vol7d_timerange),INTENT(in) :: this
1777CHARACTER(len=80) :: to_char_timerange
1778
1779#ifdef HAVE_DBALLE
1780INTEGER :: handle, ier
1781
1782handle = 0
1783ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1784ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
1785ier = idba_fatto(handle)
1786
1787to_char_timerange="Timerange: "//to_char_timerange
1788
1789#else
1790
1791to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
1792 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
1793
1794#endif
1795
1796END FUNCTION to_char_timerange
1797
1798
1799ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
1800TYPE(vol7d_timerange),INTENT(IN) :: this, that
1801LOGICAL :: res
1802
1803
1804res = &
1805 this%timerange == that%timerange .AND. &
1806 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1807 this%timerange == 254)
1808
1809END FUNCTION vol7d_timerange_eq
1810
1811
1812ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1813TYPE(vol7d_timerange),INTENT(IN) :: this, that
1814LOGICAL :: res
1815
1816IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1817 this%p1 == that%p1 .AND. &
1818 this%p2 == that%p2) THEN
1819 res = .true.
1820ELSE
1821 res = .false.
1822ENDIF
1823
1824END FUNCTION vol7d_timerange_almost_eq
1825
1826
1827ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1828TYPE(vol7d_timerange),INTENT(IN) :: this, that
1829LOGICAL :: res
1830
1831res = .NOT.(this == that)
1832
1833END FUNCTION vol7d_timerange_ne
1834
1835
1836ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1837TYPE(vol7d_timerange),INTENT(IN) :: this, that
1838LOGICAL :: res
1839
1840IF (this%timerange > that%timerange .OR. &
1841 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1842 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1843 this%p2 > that%p2)) THEN
1844 res = .true.
1845ELSE
1846 res = .false.
1847ENDIF
1848
1849END FUNCTION vol7d_timerange_gt
1850
1851
1852ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1853TYPE(vol7d_timerange),INTENT(IN) :: this, that
1854LOGICAL :: res
1855
1856IF (this%timerange < that%timerange .OR. &
1857 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1858 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1859 this%p2 < that%p2)) THEN
1860 res = .true.
1861ELSE
1862 res = .false.
1863ENDIF
1864
1865END FUNCTION vol7d_timerange_lt
1866
1867
1868ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1869TYPE(vol7d_timerange),INTENT(IN) :: this, that
1870LOGICAL :: res
1871
1872IF (this == that) THEN
1873 res = .true.
1874ELSE IF (this > that) THEN
1875 res = .true.
1876ELSE
1877 res = .false.
1878ENDIF
1879
1880END FUNCTION vol7d_timerange_ge
1881
1882
1883ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1884TYPE(vol7d_timerange),INTENT(IN) :: this, that
1885LOGICAL :: res
1886
1887IF (this == that) THEN
1888 res = .true.
1889ELSE IF (this < that) THEN
1890 res = .true.
1891ELSE
1892 res = .false.
1893ENDIF
1894
1895END FUNCTION vol7d_timerange_le
1896
1897
1898ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1899TYPE(vol7d_timerange),INTENT(IN) :: this
1900LOGICAL :: c_e
1901c_e = this /= vol7d_timerange_miss
1902END FUNCTION vol7d_timerange_c_e
1903
1904
1905#include "array_utilities_inc.F90"
1906
1907#include "arrayof_post.F90"
1908
1909
1910END 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.