libsim Versione 7.2.6

◆ sort_level()

subroutine sort_level ( type(vol7d_level), 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 1339 del file vol7d_level_class.F90.

1340! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1341! authors:
1342! Davide Cesari <dcesari@arpa.emr.it>
1343! Paolo Patruno <ppatruno@arpa.emr.it>
1344
1345! This program is free software; you can redistribute it and/or
1346! modify it under the terms of the GNU General Public License as
1347! published by the Free Software Foundation; either version 2 of
1348! the License, or (at your option) any later version.
1349
1350! This program is distributed in the hope that it will be useful,
1351! but WITHOUT ANY WARRANTY; without even the implied warranty of
1352! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1353! GNU General Public License for more details.
1354
1355! You should have received a copy of the GNU General Public License
1356! along with this program. If not, see <http://www.gnu.org/licenses/>.
1357#include "config.h"
1358
1359!> Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
1360!! Questo modulo definisce una classe per rappresentare la localizzazione
1361!! verticale di un'osservazione meteorologica, prendendo in prestito
1362!! concetti dal formato grib.
1363!! \ingroup vol7d
1364MODULE vol7d_level_class
1365USE kinds
1368IMPLICIT NONE
1369
1370!> Definisce il livello verticale di un'osservazione.
1371!! I membri di \a vol7d_level sono pubblici e quindi liberamente
1372!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
1373!! il costruttore ::init.
1374TYPE vol7d_level
1375 INTEGER :: level1 !< tipo di livello o strato verticale (vedi tabella 4.5 formato grib2 WMO http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf)
1376 INTEGER :: l1 !< valore numerico del primo livello, se previsto da \a level1
1377 INTEGER :: level2 !< tipo di livello o strato verticale (vedi tabella 4.5 formato grib2 WMO http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf)
1378 INTEGER :: l2 !< valore numerico del secondo livello, se previsto da \a level2
1379END TYPE vol7d_level
1380
1381!> Valore mancante per vol7d_level.
1382TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
1383
1384!> Costruttore per la classe vol7d_level.
1385!! Deve essere richiamato
1386!! per tutti gli oggetti di questo tipo definiti in un programma.
1387INTERFACE init
1388 MODULE PROCEDURE vol7d_level_init
1389END INTERFACE
1390
1391!> Distruttore per la classe vol7d_level.
1392!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1393INTERFACE delete
1394 MODULE PROCEDURE vol7d_level_delete
1395END INTERFACE
1396
1397!> Logical equality operator for objects of \a vol7d_level class.
1398!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1399!! of any shape.
1400INTERFACE OPERATOR (==)
1401 MODULE PROCEDURE vol7d_level_eq
1402END INTERFACE
1403
1404!> Logical inequality operator for objects of \a vol7d_level class.
1405!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1406!! of any shape.
1407INTERFACE OPERATOR (/=)
1408 MODULE PROCEDURE vol7d_level_ne
1409END INTERFACE
1410
1411!> Logical greater-than operator for objects of \a vol7d_level class.
1412!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1413!! of any shape.
1414!! Comparison is performed first on \a level, then, then on \l1, then
1415!! on \l2 if defined.
1416INTERFACE OPERATOR (>)
1417 MODULE PROCEDURE vol7d_level_gt
1418END INTERFACE
1419
1420!> Logical less-than operator for objects of \a vol7d_level class.
1421!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1422!! of any shape.
1423!! Comparison is performed first on \a level, then, then on \l1, then
1424!! on \l2 if defined.
1425INTERFACE OPERATOR (<)
1426 MODULE PROCEDURE vol7d_level_lt
1427END INTERFACE
1428
1429!> Logical greater-equal operator for objects of \a vol7d_level class.
1430!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1431!! of any shape.
1432!! Comparison is performed first on \a level, then, then on \l1, then
1433!! on \l2 if defined.
1434INTERFACE OPERATOR (>=)
1435 MODULE PROCEDURE vol7d_level_ge
1436END INTERFACE
1437
1438!> Logical less-equal operator for objects of \a vol7d_level class.
1439!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
1440!! of any shape.
1441!! Comparison is performed first on \a level, then, then on \l1, then
1442!! on \l2 if defined.
1443INTERFACE OPERATOR (<=)
1444 MODULE PROCEDURE vol7d_level_le
1445END INTERFACE
1446
1447!> Logical almost equality operators for objects of the class \a
1448!! vol7d_level
1449!! If one component is missing it is not used in comparison
1450INTERFACE OPERATOR (.almosteq.)
1451 MODULE PROCEDURE vol7d_level_almost_eq
1452END INTERFACE
1453
1454
1455! da documentare in inglese assieme al resto
1456!> to be documented
1457INTERFACE c_e
1458 MODULE PROCEDURE vol7d_level_c_e
1459END INTERFACE
1460
1461#define VOL7D_POLY_TYPE TYPE(vol7d_level)
1462#define VOL7D_POLY_TYPES _level
1463#define ENABLE_SORT
1464#include "array_utilities_pre.F90"
1465
1466!>Print object
1467INTERFACE display
1468 MODULE PROCEDURE display_level
1469END INTERFACE
1470
1471!>Represent level object in a pretty string
1472INTERFACE to_char
1473 MODULE PROCEDURE to_char_level
1474END INTERFACE
1475
1476!> Convert a level type to a physical variable
1477INTERFACE vol7d_level_to_var
1478 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1479END INTERFACE vol7d_level_to_var
1480
1481!> Return the conversion factor for multiplying the level value when converting to variable
1483 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1484END INTERFACE vol7d_level_to_var_factor
1485
1486!> Return the scale value (base 10 log of conversion factor) for multiplying the level value when converting to variable
1488 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1489END INTERFACE vol7d_level_to_var_log10
1490
1491type(vol7d_level) :: almost_equal_levels(3)=(/&
1492 vol7d_level( 1,imiss,imiss,imiss),&
1493 vol7d_level(103,imiss,imiss,imiss),&
1494 vol7d_level(106,imiss,imiss,imiss)/)
1495
1496! levels requiring conversion from internal to physical representation
1497INTEGER, PARAMETER :: &
1498 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
1499 thermo_level(3) = (/20,107,235/), & ! 10**-1
1500 sigma_level(2) = (/104,111/) ! 10**-4
1501
1502TYPE level_var
1503 INTEGER :: level
1504 CHARACTER(len=10) :: btable
1505END TYPE level_var
1506
1507! Conversion table from GRIB2 vertical level codes to corresponding
1508! BUFR B table variables
1509TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
1510 level_var(20, 'B12101'), & ! isothermal (K)
1511 level_var(100, 'B10004'), & ! isobaric (Pa)
1512 level_var(102, 'B10007'), & ! height over sea level (m)
1513 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
1514 level_var(107, 'B12192'), & ! isentropical (K)
1515 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
1516 level_var(161, 'B22195') /) ! depth below sea surface
1517
1518PRIVATE level_var, level_var_converter
1519
1520CONTAINS
1521
1522!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
1523!! Questa è la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
1524!! rispetto alla versione \c SUBROUTINE \c init.
1525!! Se non viene passato nessun parametro opzionale l'oggetto è
1526!! inizializzato a valore mancante.
1527FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
1528INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
1529INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
1530INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
1531INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
1532
1533TYPE(vol7d_level) :: this !< object to initialize
1534
1535CALL init(this, level1, l1, level2, l2)
1536
1537END FUNCTION vol7d_level_new
1538
1539
1540!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
1541!! Se non viene passato nessun parametro opzionale l'oggetto è
1542!! inizializzato a valore mancante.
1543SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
1544TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da inizializzare
1545INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
1546INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
1547INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
1548INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
1549
1550this%level1 = imiss
1551this%l1 = imiss
1552this%level2 = imiss
1553this%l2 = imiss
1554
1555IF (PRESENT(level1)) THEN
1556 this%level1 = level1
1557ELSE
1558 RETURN
1559END IF
1560
1561IF (PRESENT(l1)) this%l1 = l1
1562
1563IF (PRESENT(level2)) THEN
1564 this%level2 = level2
1565ELSE
1566 RETURN
1567END IF
1568
1569IF (PRESENT(l2)) this%l2 = l2
1570
1571END SUBROUTINE vol7d_level_init
1572
1573
1574!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1575SUBROUTINE vol7d_level_delete(this)
1576TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da distruggre
1577
1578this%level1 = imiss
1579this%l1 = imiss
1580this%level2 = imiss
1581this%l2 = imiss
1582
1583END SUBROUTINE vol7d_level_delete
1584
1585
1586SUBROUTINE display_level(this)
1587TYPE(vol7d_level),INTENT(in) :: this
1588
1589print*,trim(to_char(this))
1590
1591END SUBROUTINE display_level
1592
1593
1594FUNCTION to_char_level(this)
1595#ifdef HAVE_DBALLE
1596USE dballef
1597#endif
1598TYPE(vol7d_level),INTENT(in) :: this
1599CHARACTER(len=255) :: to_char_level
1600
1601#ifdef HAVE_DBALLE
1602INTEGER :: handle, ier
1603
1604handle = 0
1605ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1606ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
1607ier = idba_fatto(handle)
1608
1609to_char_level="LEVEL: "//to_char_level
1610
1611#else
1612
1613to_char_level="LEVEL: "//&
1614 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
1615 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
1616
1617#endif
1618
1619END FUNCTION to_char_level
1620
1621
1622ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
1623TYPE(vol7d_level),INTENT(IN) :: this, that
1624LOGICAL :: res
1625
1626res = &
1627 this%level1 == that%level1 .AND. &
1628 this%level2 == that%level2 .AND. &
1629 this%l1 == that%l1 .AND. this%l2 == that%l2
1630
1631END FUNCTION vol7d_level_eq
1632
1633
1634ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1635TYPE(vol7d_level),INTENT(IN) :: this, that
1636LOGICAL :: res
1637
1638res = .NOT.(this == that)
1639
1640END FUNCTION vol7d_level_ne
1641
1642
1643ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1644TYPE(vol7d_level),INTENT(IN) :: this, that
1645LOGICAL :: res
1646
1647IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1648 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1649 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1650 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
1651 res = .true.
1652ELSE
1653 res = .false.
1654ENDIF
1655
1656END FUNCTION vol7d_level_almost_eq
1657
1658
1659ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1660TYPE(vol7d_level),INTENT(IN) :: this, that
1661LOGICAL :: res
1662
1663IF (&
1664 this%level1 > that%level1 .OR. &
1665 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1666 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1667 (&
1668 this%level2 > that%level2 .OR. &
1669 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1670 ))) THEN
1671 res = .true.
1672ELSE
1673 res = .false.
1674ENDIF
1675
1676END FUNCTION vol7d_level_gt
1677
1678
1679ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1680TYPE(vol7d_level),INTENT(IN) :: this, that
1681LOGICAL :: res
1682
1683IF (&
1684 this%level1 < that%level1 .OR. &
1685 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1686 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1687 (&
1688 this%level2 < that%level2 .OR. &
1689 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1690 ))) THEN
1691 res = .true.
1692ELSE
1693 res = .false.
1694ENDIF
1695
1696END FUNCTION vol7d_level_lt
1697
1698
1699ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1700TYPE(vol7d_level),INTENT(IN) :: this, that
1701LOGICAL :: res
1702
1703IF (this == that) THEN
1704 res = .true.
1705ELSE IF (this > that) THEN
1706 res = .true.
1707ELSE
1708 res = .false.
1709ENDIF
1710
1711END FUNCTION vol7d_level_ge
1712
1713
1714ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1715TYPE(vol7d_level),INTENT(IN) :: this, that
1716LOGICAL :: res
1717
1718IF (this == that) THEN
1719 res = .true.
1720ELSE IF (this < that) THEN
1721 res = .true.
1722ELSE
1723 res = .false.
1724ENDIF
1725
1726END FUNCTION vol7d_level_le
1727
1728
1729ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1730TYPE(vol7d_level),INTENT(IN) :: this
1731LOGICAL :: c_e
1732c_e = this /= vol7d_level_miss
1733END FUNCTION vol7d_level_c_e
1734
1735
1736#include "array_utilities_inc.F90"
1737
1738
1739FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1740TYPE(vol7d_level),INTENT(in) :: level
1741CHARACTER(len=10) :: btable
1742
1743btable = vol7d_level_to_var_int(level%level1)
1744
1745END FUNCTION vol7d_level_to_var_lev
1746
1747FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1748INTEGER,INTENT(in) :: level
1749CHARACTER(len=10) :: btable
1750
1751INTEGER :: i
1752
1753DO i = 1, SIZE(level_var_converter)
1754 IF (level_var_converter(i)%level == level) THEN
1755 btable = level_var_converter(i)%btable
1756 RETURN
1757 ENDIF
1758ENDDO
1759
1760btable = cmiss
1761
1762END FUNCTION vol7d_level_to_var_int
1763
1764
1765FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1766TYPE(vol7d_level),INTENT(in) :: level
1767REAL :: factor
1768
1769factor = vol7d_level_to_var_factor_int(level%level1)
1770
1771END FUNCTION vol7d_level_to_var_factor_lev
1772
1773FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1774INTEGER,INTENT(in) :: level
1775REAL :: factor
1776
1777factor = 1.
1778IF (any(level == height_level)) THEN
1779 factor = 1.e-3
1780ELSE IF (any(level == thermo_level)) THEN
1781 factor = 1.e-1
1782ELSE IF (any(level == sigma_level)) THEN
1783 factor = 1.e-4
1784ENDIF
1785
1786END FUNCTION vol7d_level_to_var_factor_int
1787
1788
1789FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1790TYPE(vol7d_level),INTENT(in) :: level
1791REAL :: log10
1792
1793log10 = vol7d_level_to_var_log10_int(level%level1)
1794
1795END FUNCTION vol7d_level_to_var_log10_lev
1796
1797FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1798INTEGER,INTENT(in) :: level
1799REAL :: log10
1800
1801log10 = 0.
1802IF (any(level == height_level)) THEN
1803 log10 = -3.
1804ELSE IF (any(level == thermo_level)) THEN
1805 log10 = -1.
1806ELSE IF (any(level == sigma_level)) THEN
1807 log10 = -4.
1808ENDIF
1809
1810END FUNCTION vol7d_level_to_var_log10_int
1811
1812END MODULE vol7d_level_class
Distruttore per la classe vol7d_level.
Costruttore per la classe vol7d_level.
Represent level object in a pretty string.
Return the conversion factor for multiplying the level value when converting to variable.
Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver...
Convert a level type to a physical variable.
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 dei livelli verticali in osservazioni meteo e affini.
Definisce il livello verticale di un'osservazione.

Generated with Doxygen.