libsim Versione 7.2.6

◆ 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 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
1433!> Classe per la gestione degli intervalli temporali di osservazioni
1434!! meteo e affini.
1435!! Questo modulo definisce una classe in grado di rappresentare
1436!! l'intervallo di tempo a cui si riferisce un'osservazione meteo,
1437!! ad es. valore istantaneo, cumulato, medio, ecc., prendendo in prestito
1438!! concetti dal formato grib.
1439!! \ingroup vol7d
1441USE kinds
1444IMPLICIT NONE
1445
1446!> Definisce l'intervallo temporale di un'osservazione meteo.
1447!! I membri di \a vol7d_timerange sono pubblici e quindi liberamente
1448!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
1449!! il costruttore ::init.
1450TYPE vol7d_timerange
1451 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
1452 INTEGER :: p1 !< termine del periodo di validità del dato, in secondi, a partire dall'istante di riferimento (0 per dati osservati o analizzati)
1453 INTEGER :: p2 !< durata del periodo di validità del dato, in secondi (0 per dati istantanei)
1454END TYPE vol7d_timerange
1455
1456!> Valore mancante per vol7d_timerange.
1457TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
1458 vol7d_timerange(imiss,imiss,imiss)
1459
1460!> Costruttore per la classe vol7d_timerange.
1461!! Deve essere richiamato
1462!! per tutti gli oggetti di questo tipo definiti in un programma.
1463INTERFACE init
1464 MODULE PROCEDURE vol7d_timerange_init
1465END INTERFACE
1466
1467!> Distruttore per la classe vol7d_timerange.
1468!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1469INTERFACE delete
1470 MODULE PROCEDURE vol7d_timerange_delete
1471END INTERFACE
1472
1473!> Logical equality operator for objects of \a vol7d_timerange class.
1474!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1475!! of any shape.
1476INTERFACE OPERATOR (==)
1477 MODULE PROCEDURE vol7d_timerange_eq
1478END INTERFACE
1479
1480!> Logical inequality operator for objects of \a vol7d_timerange class.
1481!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1482!! of any shape.
1483INTERFACE OPERATOR (/=)
1484 MODULE PROCEDURE vol7d_timerange_ne
1485END INTERFACE
1486
1487!> Logical greater-than operator for objects of \a vol7d_timerange class.
1488!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1489!! of any shape.
1490INTERFACE OPERATOR (>)
1491 MODULE PROCEDURE vol7d_timerange_gt
1492END INTERFACE
1493
1494!> Logical less-than operator for objects of \a vol7d_timerange class.
1495!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1496!! of any shape.
1497INTERFACE OPERATOR (<)
1498 MODULE PROCEDURE vol7d_timerange_lt
1499END INTERFACE
1500
1501!> Logical greater-equal operator for objects of \a vol7d_timerange class.
1502!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1503!! of any shape.
1504INTERFACE OPERATOR (>=)
1505 MODULE PROCEDURE vol7d_timerange_ge
1506END INTERFACE
1507
1508!> Logical less-equal operator for objects of \a vol7d_timerange class.
1509!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1510!! of any shape.
1511INTERFACE OPERATOR (<=)
1512 MODULE PROCEDURE vol7d_timerange_le
1513END INTERFACE
1514
1515!> Logical almost equality operator for objects of \a vol7d_timerange class.
1516!! If one component is missing it is not used in comparison.
1517INTERFACE OPERATOR (.almosteq.)
1518 MODULE PROCEDURE vol7d_timerange_almost_eq
1519END INTERFACE
1520
1521
1522! da documentare in inglese assieme al resto
1523!> to be documented
1524INTERFACE c_e
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
1533!>Print object
1534INTERFACE display
1535 MODULE PROCEDURE display_timerange
1536END INTERFACE
1537
1538!>Represent timerange object in a pretty string
1539INTERFACE to_char
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
1555PUBLIC insert, append, remove, packarray
1556PUBLIC insert_unique, append_unique
1557PUBLIC almost_equal_timeranges
1558
1559CONTAINS
1560
1561
1562!> Inizializza un oggetto \a vol7d_timerange con i parametri opzionali forniti.
1563!! Questa è la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
1564!! rispetto alla versione \c SUBROUTINE \c init.
1565!! Se non viene passato nessun parametro opzionale l'oggetto è
1566!! inizializzato a valore mancante.
1567FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1568INTEGER,INTENT(IN),OPTIONAL :: timerange !< tipo di intervallo temporale
1569INTEGER,INTENT(IN),OPTIONAL :: p1 !< valore per il primo istante temporale
1570INTEGER,INTENT(IN),OPTIONAL :: p2 !< valore per il secondo istante temporale
1571
1572TYPE(vol7d_timerange) :: this !< oggetto da inizializzare
1573
1574CALL init(this, timerange, p1, p2)
1575
1576END FUNCTION vol7d_timerange_new
1577
1578
1579!> Inizializza un oggetto \a vol7d_timerange con i parametri opzionali forniti.
1580!! Se non viene passato nessun parametro opzionale l'oggetto è
1581!! inizializzato a valore mancante.
1582SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1583TYPE(vol7d_timerange),INTENT(INOUT) :: this !< oggetto da inizializzare
1584INTEGER,INTENT(IN),OPTIONAL :: timerange !< tipo di intervallo temporale
1585INTEGER,INTENT(IN),OPTIONAL :: p1 !< valore per il primo istante temporale
1586INTEGER,INTENT(IN),OPTIONAL :: p2 !< valore per il secondo istante temporale
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
1622!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
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
1660to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
1661 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
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
1779END 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.