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