libsim Versione 7.2.0

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

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