libsim Versione 7.2.6

◆ 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
1558!> Classe per la gestione degli intervalli temporali di osservazioni
1559!! meteo e affini.
1560!! Questo modulo definisce una classe in grado di rappresentare
1561!! l'intervallo di tempo a cui si riferisce un'osservazione meteo,
1562!! ad es. valore istantaneo, cumulato, medio, ecc., prendendo in prestito
1563!! concetti dal formato grib.
1564!! \ingroup vol7d
1566USE kinds
1569IMPLICIT NONE
1570
1571!> Definisce l'intervallo temporale di un'osservazione meteo.
1572!! I membri di \a vol7d_timerange sono pubblici e quindi liberamente
1573!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
1574!! il costruttore ::init.
1575TYPE vol7d_timerange
1576 INTEGER :: timerange !< proprietà statistiche del dato (es. 0=media, 1=cumulazione, 2=massimo, 3=minimo, 4=differenza... 254=dato istantaneo) tratte dalla code table 4.10 del formato WMO grib edizione 2, vedi http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf
1577 INTEGER :: p1 !< termine del periodo di validità del dato, in secondi, a partire dall'istante di riferimento (0 per dati osservati o analizzati)
1578 INTEGER :: p2 !< durata del periodo di validità del dato, in secondi (0 per dati istantanei)
1579END TYPE vol7d_timerange
1580
1581!> Valore mancante per vol7d_timerange.
1582TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
1583 vol7d_timerange(imiss,imiss,imiss)
1584
1585!> Costruttore per la classe vol7d_timerange.
1586!! Deve essere richiamato
1587!! per tutti gli oggetti di questo tipo definiti in un programma.
1588INTERFACE init
1589 MODULE PROCEDURE vol7d_timerange_init
1590END INTERFACE
1591
1592!> Distruttore per la classe vol7d_timerange.
1593!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1594INTERFACE delete
1595 MODULE PROCEDURE vol7d_timerange_delete
1596END INTERFACE
1597
1598!> Logical equality operator for objects of \a vol7d_timerange class.
1599!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1600!! of any shape.
1601INTERFACE OPERATOR (==)
1602 MODULE PROCEDURE vol7d_timerange_eq
1603END INTERFACE
1604
1605!> Logical inequality operator for objects of \a vol7d_timerange class.
1606!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1607!! of any shape.
1608INTERFACE OPERATOR (/=)
1609 MODULE PROCEDURE vol7d_timerange_ne
1610END INTERFACE
1611
1612!> Logical greater-than operator for objects of \a vol7d_timerange class.
1613!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1614!! of any shape.
1615INTERFACE OPERATOR (>)
1616 MODULE PROCEDURE vol7d_timerange_gt
1617END INTERFACE
1618
1619!> Logical less-than operator for objects of \a vol7d_timerange class.
1620!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1621!! of any shape.
1622INTERFACE OPERATOR (<)
1623 MODULE PROCEDURE vol7d_timerange_lt
1624END INTERFACE
1625
1626!> Logical greater-equal operator for objects of \a vol7d_timerange class.
1627!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1628!! of any shape.
1629INTERFACE OPERATOR (>=)
1630 MODULE PROCEDURE vol7d_timerange_ge
1631END INTERFACE
1632
1633!> Logical less-equal operator for objects of \a vol7d_timerange class.
1634!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1635!! of any shape.
1636INTERFACE OPERATOR (<=)
1637 MODULE PROCEDURE vol7d_timerange_le
1638END INTERFACE
1639
1640!> Logical almost equality operator for objects of \a vol7d_timerange class.
1641!! If one component is missing it is not used in comparison.
1642INTERFACE OPERATOR (.almosteq.)
1643 MODULE PROCEDURE vol7d_timerange_almost_eq
1644END INTERFACE
1645
1646
1647! da documentare in inglese assieme al resto
1648!> to be documented
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
1658!>Print object
1659INTERFACE display
1660 MODULE PROCEDURE display_timerange
1661END INTERFACE
1662
1663!>Represent timerange object in a pretty string
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
1687!> Inizializza un oggetto \a vol7d_timerange con i parametri opzionali forniti.
1688!! Questa è la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
1689!! rispetto alla versione \c SUBROUTINE \c init.
1690!! Se non viene passato nessun parametro opzionale l'oggetto è
1691!! inizializzato a valore mancante.
1692FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1693INTEGER,INTENT(IN),OPTIONAL :: timerange !< tipo di intervallo temporale
1694INTEGER,INTENT(IN),OPTIONAL :: p1 !< valore per il primo istante temporale
1695INTEGER,INTENT(IN),OPTIONAL :: p2 !< valore per il secondo istante temporale
1696
1697TYPE(vol7d_timerange) :: this !< oggetto da inizializzare
1698
1699CALL init(this, timerange, p1, p2)
1700
1701END FUNCTION vol7d_timerange_new
1702
1703
1704!> Inizializza un oggetto \a vol7d_timerange con i parametri opzionali forniti.
1705!! Se non viene passato nessun parametro opzionale l'oggetto è
1706!! inizializzato a valore mancante.
1707SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1708TYPE(vol7d_timerange),INTENT(INOUT) :: this !< oggetto da inizializzare
1709INTEGER,INTENT(IN),OPTIONAL :: timerange !< tipo di intervallo temporale
1710INTEGER,INTENT(IN),OPTIONAL :: p1 !< valore per il primo istante temporale
1711INTEGER,INTENT(IN),OPTIONAL :: p2 !< valore per il secondo istante temporale
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
1747!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
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.