libsim Versione 7.1.11
|
◆ inssor_level()
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 1470 del file vol7d_level_class.F90. 1471! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1472! authors:
1473! Davide Cesari <dcesari@arpa.emr.it>
1474! Paolo Patruno <ppatruno@arpa.emr.it>
1475
1476! This program is free software; you can redistribute it and/or
1477! modify it under the terms of the GNU General Public License as
1478! published by the Free Software Foundation; either version 2 of
1479! the License, or (at your option) any later version.
1480
1481! This program is distributed in the hope that it will be useful,
1482! but WITHOUT ANY WARRANTY; without even the implied warranty of
1483! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1484! GNU General Public License for more details.
1485
1486! You should have received a copy of the GNU General Public License
1487! along with this program. If not, see <http://www.gnu.org/licenses/>.
1488#include "config.h"
1489
1499IMPLICIT NONE
1500
1506 INTEGER :: level1
1507 INTEGER :: l1
1508 INTEGER :: level2
1509 INTEGER :: l2
1511
1514
1519 MODULE PROCEDURE vol7d_level_init
1520END INTERFACE
1521
1525 MODULE PROCEDURE vol7d_level_delete
1526END INTERFACE
1527
1531INTERFACE OPERATOR (==)
1532 MODULE PROCEDURE vol7d_level_eq
1533END INTERFACE
1534
1538INTERFACE OPERATOR (/=)
1539 MODULE PROCEDURE vol7d_level_ne
1540END INTERFACE
1541
1547INTERFACE OPERATOR (>)
1548 MODULE PROCEDURE vol7d_level_gt
1549END INTERFACE
1550
1556INTERFACE OPERATOR (<)
1557 MODULE PROCEDURE vol7d_level_lt
1558END INTERFACE
1559
1565INTERFACE OPERATOR (>=)
1566 MODULE PROCEDURE vol7d_level_ge
1567END INTERFACE
1568
1574INTERFACE OPERATOR (<=)
1575 MODULE PROCEDURE vol7d_level_le
1576END INTERFACE
1577
1581INTERFACE OPERATOR (.almosteq.)
1582 MODULE PROCEDURE vol7d_level_almost_eq
1583END INTERFACE
1584
1585
1586! da documentare in inglese assieme al resto
1589 MODULE PROCEDURE vol7d_level_c_e
1590END INTERFACE
1591
1592#define VOL7D_POLY_TYPE TYPE(vol7d_level)
1593#define VOL7D_POLY_TYPES _level
1594#define ENABLE_SORT
1595#include "array_utilities_pre.F90"
1596
1599 MODULE PROCEDURE display_level
1600END INTERFACE
1601
1604 MODULE PROCEDURE to_char_level
1605END INTERFACE
1606
1609 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
1611
1614 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
1616
1619 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
1621
1622type(vol7d_level) :: almost_equal_levels(3)=(/&
1623 vol7d_level( 1,imiss,imiss,imiss),&
1624 vol7d_level(103,imiss,imiss,imiss),&
1625 vol7d_level(106,imiss,imiss,imiss)/)
1626
1627! levels requiring conversion from internal to physical representation
1628INTEGER, PARAMETER :: &
1629 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
1630 thermo_level(3) = (/20,107,235/), & ! 10**-1
1631 sigma_level(2) = (/104,111/) ! 10**-4
1632
1633TYPE level_var
1634 INTEGER :: level
1635 CHARACTER(len=10) :: btable
1636END TYPE level_var
1637
1638! Conversion table from GRIB2 vertical level codes to corresponding
1639! BUFR B table variables
1640TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
1641 level_var(20, 'B12101'), & ! isothermal (K)
1642 level_var(100, 'B10004'), & ! isobaric (Pa)
1643 level_var(102, 'B10007'), & ! height over sea level (m)
1644 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
1645 level_var(107, 'B12192'), & ! isentropical (K)
1646 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
1647 level_var(161, 'B22195') /) ! depth below sea surface
1648
1649PRIVATE level_var, level_var_converter
1650
1651CONTAINS
1652
1658FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
1659INTEGER,INTENT(IN),OPTIONAL :: level1
1660INTEGER,INTENT(IN),OPTIONAL :: l1
1661INTEGER,INTENT(IN),OPTIONAL :: level2
1662INTEGER,INTENT(IN),OPTIONAL :: l2
1663
1664TYPE(vol7d_level) :: this
1665
1667
1668END FUNCTION vol7d_level_new
1669
1670
1674SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
1675TYPE(vol7d_level),INTENT(INOUT) :: this
1676INTEGER,INTENT(IN),OPTIONAL :: level1
1677INTEGER,INTENT(IN),OPTIONAL :: l1
1678INTEGER,INTENT(IN),OPTIONAL :: level2
1679INTEGER,INTENT(IN),OPTIONAL :: l2
1680
1681this%level1 = imiss
1682this%l1 = imiss
1683this%level2 = imiss
1684this%l2 = imiss
1685
1686IF (PRESENT(level1)) THEN
1687 this%level1 = level1
1688ELSE
1689 RETURN
1690END IF
1691
1692IF (PRESENT(l1)) this%l1 = l1
1693
1694IF (PRESENT(level2)) THEN
1695 this%level2 = level2
1696ELSE
1697 RETURN
1698END IF
1699
1700IF (PRESENT(l2)) this%l2 = l2
1701
1702END SUBROUTINE vol7d_level_init
1703
1704
1706SUBROUTINE vol7d_level_delete(this)
1707TYPE(vol7d_level),INTENT(INOUT) :: this
1708
1709this%level1 = imiss
1710this%l1 = imiss
1711this%level2 = imiss
1712this%l2 = imiss
1713
1714END SUBROUTINE vol7d_level_delete
1715
1716
1717SUBROUTINE display_level(this)
1718TYPE(vol7d_level),INTENT(in) :: this
1719
1720print*,trim(to_char(this))
1721
1722END SUBROUTINE display_level
1723
1724
1725FUNCTION to_char_level(this)
1726#ifdef HAVE_DBALLE
1727USE dballef
1728#endif
1729TYPE(vol7d_level),INTENT(in) :: this
1730CHARACTER(len=255) :: to_char_level
1731
1732#ifdef HAVE_DBALLE
1733INTEGER :: handle, ier
1734
1735handle = 0
1736ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1737ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
1738ier = idba_fatto(handle)
1739
1740to_char_level="LEVEL: "//to_char_level
1741
1742#else
1743
1744to_char_level="LEVEL: "//&
1747
1748#endif
1749
1750END FUNCTION to_char_level
1751
1752
1753ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
1754TYPE(vol7d_level),INTENT(IN) :: this, that
1755LOGICAL :: res
1756
1757res = &
1758 this%level1 == that%level1 .AND. &
1759 this%level2 == that%level2 .AND. &
1760 this%l1 == that%l1 .AND. this%l2 == that%l2
1761
1762END FUNCTION vol7d_level_eq
1763
1764
1765ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1766TYPE(vol7d_level),INTENT(IN) :: this, that
1767LOGICAL :: res
1768
1769res = .NOT.(this == that)
1770
1771END FUNCTION vol7d_level_ne
1772
1773
1774ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1775TYPE(vol7d_level),INTENT(IN) :: this, that
1776LOGICAL :: res
1777
1782 res = .true.
1783ELSE
1784 res = .false.
1785ENDIF
1786
1787END FUNCTION vol7d_level_almost_eq
1788
1789
1790ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1791TYPE(vol7d_level),INTENT(IN) :: this, that
1792LOGICAL :: res
1793
1794IF (&
1795 this%level1 > that%level1 .OR. &
1796 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1797 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1798 (&
1799 this%level2 > that%level2 .OR. &
1800 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1801 ))) THEN
1802 res = .true.
1803ELSE
1804 res = .false.
1805ENDIF
1806
1807END FUNCTION vol7d_level_gt
1808
1809
1810ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1811TYPE(vol7d_level),INTENT(IN) :: this, that
1812LOGICAL :: res
1813
1814IF (&
1815 this%level1 < that%level1 .OR. &
1816 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1817 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1818 (&
1819 this%level2 < that%level2 .OR. &
1820 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1821 ))) THEN
1822 res = .true.
1823ELSE
1824 res = .false.
1825ENDIF
1826
1827END FUNCTION vol7d_level_lt
1828
1829
1830ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1831TYPE(vol7d_level),INTENT(IN) :: this, that
1832LOGICAL :: res
1833
1834IF (this == that) THEN
1835 res = .true.
1836ELSE IF (this > that) THEN
1837 res = .true.
1838ELSE
1839 res = .false.
1840ENDIF
1841
1842END FUNCTION vol7d_level_ge
1843
1844
1845ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1846TYPE(vol7d_level),INTENT(IN) :: this, that
1847LOGICAL :: res
1848
1849IF (this == that) THEN
1850 res = .true.
1851ELSE IF (this < that) THEN
1852 res = .true.
1853ELSE
1854 res = .false.
1855ENDIF
1856
1857END FUNCTION vol7d_level_le
1858
1859
1860ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1861TYPE(vol7d_level),INTENT(IN) :: this
1862LOGICAL :: c_e
1863c_e = this /= vol7d_level_miss
1864END FUNCTION vol7d_level_c_e
1865
1866
1867#include "array_utilities_inc.F90"
1868
1869
1870FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1871TYPE(vol7d_level),INTENT(in) :: level
1872CHARACTER(len=10) :: btable
1873
1874btable = vol7d_level_to_var_int(level%level1)
1875
1876END FUNCTION vol7d_level_to_var_lev
1877
1878FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1879INTEGER,INTENT(in) :: level
1880CHARACTER(len=10) :: btable
1881
1882INTEGER :: i
1883
1884DO i = 1, SIZE(level_var_converter)
1885 IF (level_var_converter(i)%level == level) THEN
1886 btable = level_var_converter(i)%btable
1887 RETURN
1888 ENDIF
1889ENDDO
1890
1891btable = cmiss
1892
1893END FUNCTION vol7d_level_to_var_int
1894
1895
1896FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1897TYPE(vol7d_level),INTENT(in) :: level
1898REAL :: factor
1899
1900factor = vol7d_level_to_var_factor_int(level%level1)
1901
1902END FUNCTION vol7d_level_to_var_factor_lev
1903
1904FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1905INTEGER,INTENT(in) :: level
1906REAL :: factor
1907
1908factor = 1.
1909IF (any(level == height_level)) THEN
1910 factor = 1.e-3
1911ELSE IF (any(level == thermo_level)) THEN
1912 factor = 1.e-1
1913ELSE IF (any(level == sigma_level)) THEN
1914 factor = 1.e-4
1915ENDIF
1916
1917END FUNCTION vol7d_level_to_var_factor_int
1918
1919
1920FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1921TYPE(vol7d_level),INTENT(in) :: level
1922REAL :: log10
1923
1924log10 = vol7d_level_to_var_log10_int(level%level1)
1925
1926END FUNCTION vol7d_level_to_var_log10_lev
1927
1928FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1929INTEGER,INTENT(in) :: level
1930REAL :: log10
1931
1932log10 = 0.
1933IF (any(level == height_level)) THEN
1934 log10 = -3.
1935ELSE IF (any(level == thermo_level)) THEN
1936 log10 = -1.
1937ELSE IF (any(level == sigma_level)) THEN
1938 log10 = -4.
1939ENDIF
1940
1941END FUNCTION vol7d_level_to_var_log10_int
1942
Distruttore per la classe vol7d_level. Definition: vol7d_level_class.F90:248 Represent level object in a pretty string. Definition: vol7d_level_class.F90:382 Return the conversion factor for multiplying the level value when converting to variable. Definition: vol7d_level_class.F90:392 Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver... Definition: vol7d_level_class.F90:397 Convert a level type to a physical variable. Definition: vol7d_level_class.F90:387 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. Definition: missing_values.f90:50 Classe per la gestione dei livelli verticali in osservazioni meteo e affini. Definition: vol7d_level_class.F90:219 Definisce il livello verticale di un'osservazione. Definition: vol7d_level_class.F90:229 |