libsim Versione 7.2.1

◆ inssor_ana()

subroutine inssor_ana ( type(vol7d_ana), 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 1400 del file vol7d_ana_class.F90.

1401! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1402! authors:
1403! Davide Cesari <dcesari@arpa.emr.it>
1404! Paolo Patruno <ppatruno@arpa.emr.it>
1405
1406! This program is free software; you can redistribute it and/or
1407! modify it under the terms of the GNU General Public License as
1408! published by the Free Software Foundation; either version 2 of
1409! the License, or (at your option) any later version.
1410
1411! This program is distributed in the hope that it will be useful,
1412! but WITHOUT ANY WARRANTY; without even the implied warranty of
1413! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1414! GNU General Public License for more details.
1415
1416! You should have received a copy of the GNU General Public License
1417! along with this program. If not, see <http://www.gnu.org/licenses/>.
1418#include "config.h"
1419
1424MODULE vol7d_ana_class
1425USE kinds
1428IMPLICIT NONE
1429
1431INTEGER,PARAMETER :: vol7d_ana_lenident=20
1432
1437TYPE vol7d_ana
1438 TYPE(geo_coord) :: coord
1439 CHARACTER(len=vol7d_ana_lenident) :: ident
1440END TYPE vol7d_ana
1441
1443TYPE(vol7d_ana),PARAMETER :: vol7d_ana_miss=vol7d_ana(geo_coord_miss,cmiss)
1444
1448INTERFACE init
1449 MODULE PROCEDURE vol7d_ana_init
1450END INTERFACE
1451
1454INTERFACE delete
1455 MODULE PROCEDURE vol7d_ana_delete
1456END INTERFACE
1457
1461INTERFACE OPERATOR (==)
1462 MODULE PROCEDURE vol7d_ana_eq
1463END INTERFACE
1464
1468INTERFACE OPERATOR (/=)
1469 MODULE PROCEDURE vol7d_ana_ne
1470END INTERFACE
1471
1472
1477INTERFACE OPERATOR (>)
1478 MODULE PROCEDURE vol7d_ana_gt
1479END INTERFACE
1480
1485INTERFACE OPERATOR (<)
1486 MODULE PROCEDURE vol7d_ana_lt
1487END INTERFACE
1488
1493INTERFACE OPERATOR (>=)
1494 MODULE PROCEDURE vol7d_ana_ge
1495END INTERFACE
1496
1501INTERFACE OPERATOR (<=)
1502 MODULE PROCEDURE vol7d_ana_le
1503END INTERFACE
1504
1505
1507INTERFACE c_e
1508 MODULE PROCEDURE vol7d_ana_c_e
1509END INTERFACE
1510
1513INTERFACE read_unit
1514 MODULE PROCEDURE vol7d_ana_read_unit, vol7d_ana_vect_read_unit
1515END INTERFACE
1516
1519INTERFACE write_unit
1520 MODULE PROCEDURE vol7d_ana_write_unit, vol7d_ana_vect_write_unit
1521END INTERFACE
1522
1523#define VOL7D_POLY_TYPE TYPE(vol7d_ana)
1524#define VOL7D_POLY_TYPES _ana
1525#define ENABLE_SORT
1526#include "array_utilities_pre.F90"
1527
1529INTERFACE to_char
1530 MODULE PROCEDURE to_char_ana
1531END INTERFACE
1532
1534INTERFACE display
1535 MODULE PROCEDURE display_ana
1536END INTERFACE
1537
1538CONTAINS
1539
1543SUBROUTINE vol7d_ana_init(this, lon, lat, ident, ilon, ilat)
1544TYPE(vol7d_ana),INTENT(INOUT) :: this
1545REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
1546REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
1547CHARACTER(len=*),INTENT(in),OPTIONAL :: ident
1548INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
1549INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
1550
1551CALL init(this%coord, lon=lon, lat=lat , ilon=ilon, ilat=ilat)
1552IF (PRESENT(ident)) THEN
1553 this%ident = ident
1554ELSE
1555 this%ident = cmiss
1556ENDIF
1557
1558END SUBROUTINE vol7d_ana_init
1559
1560
1562SUBROUTINE vol7d_ana_delete(this)
1563TYPE(vol7d_ana),INTENT(INOUT) :: this
1564
1565CALL delete(this%coord)
1566this%ident = cmiss
1567
1568END SUBROUTINE vol7d_ana_delete
1569
1570
1571
1572character(len=80) function to_char_ana(this)
1573
1574TYPE(vol7d_ana),INTENT(in) :: this
1575
1576to_char_ana="ANA: "//&
1577 to_char(getlon(this%coord),miss="Missing lon",form="(f11.5)")//&
1578 to_char(getlat(this%coord),miss="Missing lat",form="(f11.5)")//&
1579 t2c(this%ident,miss="Missing ident")
1580
1581return
1582
1583end function to_char_ana
1584
1585
1586subroutine display_ana(this)
1587
1588TYPE(vol7d_ana),INTENT(in) :: this
1589
1590print*, trim(to_char(this))
1591
1592end subroutine display_ana
1593
1594
1595ELEMENTAL FUNCTION vol7d_ana_eq(this, that) RESULT(res)
1596TYPE(vol7d_ana),INTENT(IN) :: this, that
1597LOGICAL :: res
1598
1599res = this%coord == that%coord .AND. this%ident == that%ident
1600
1601END FUNCTION vol7d_ana_eq
1602
1603
1604ELEMENTAL FUNCTION vol7d_ana_ne(this, that) RESULT(res)
1605TYPE(vol7d_ana),INTENT(IN) :: this, that
1606LOGICAL :: res
1607
1608res = .NOT.(this == that)
1609
1610END FUNCTION vol7d_ana_ne
1611
1612
1613ELEMENTAL FUNCTION vol7d_ana_gt(this, that) RESULT(res)
1614TYPE(vol7d_ana),INTENT(IN) :: this, that
1615LOGICAL :: res
1616
1617res = this%ident > that%ident
1618
1619if ( this%ident == that%ident) then
1620 res =this%coord > that%coord
1621end if
1622
1623END FUNCTION vol7d_ana_gt
1624
1625
1626ELEMENTAL FUNCTION vol7d_ana_ge(this, that) RESULT(res)
1627TYPE(vol7d_ana),INTENT(IN) :: this, that
1628LOGICAL :: res
1629
1630res = .not. this < that
1631
1632END FUNCTION vol7d_ana_ge
1633
1634
1635ELEMENTAL FUNCTION vol7d_ana_lt(this, that) RESULT(res)
1636TYPE(vol7d_ana),INTENT(IN) :: this, that
1637LOGICAL :: res
1638
1639res = this%ident < that%ident
1640
1641if ( this%ident == that%ident) then
1642 res = this%coord < that%coord
1643end if
1644
1645END FUNCTION vol7d_ana_lt
1646
1647
1648ELEMENTAL FUNCTION vol7d_ana_le(this, that) RESULT(res)
1649TYPE(vol7d_ana),INTENT(IN) :: this, that
1650LOGICAL :: res
1651
1652res = .not. (this > that)
1653
1654END FUNCTION vol7d_ana_le
1655
1656
1657
1658ELEMENTAL FUNCTION vol7d_ana_c_e(this) RESULT(c_e)
1659TYPE(vol7d_ana),INTENT(IN) :: this
1660LOGICAL :: c_e
1661c_e = this /= vol7d_ana_miss
1662END FUNCTION vol7d_ana_c_e
1663
1664
1669SUBROUTINE vol7d_ana_read_unit(this, unit)
1670TYPE(vol7d_ana),INTENT(out) :: this
1671INTEGER, INTENT(in) :: unit
1672
1673CALL vol7d_ana_vect_read_unit((/this/), unit)
1674
1675END SUBROUTINE vol7d_ana_read_unit
1676
1677
1682SUBROUTINE vol7d_ana_vect_read_unit(this, unit)
1683TYPE(vol7d_ana) :: this(:)
1684INTEGER, INTENT(in) :: unit
1685
1686CHARACTER(len=40) :: form
1687
1688CALL read_unit(this%coord, unit)
1689INQUIRE(unit, form=form)
1690IF (form == 'FORMATTED') THEN
1691 READ(unit,'(A)')this(:)%ident
1692ELSE
1693 READ(unit)this(:)%ident
1694ENDIF
1695
1696END SUBROUTINE vol7d_ana_vect_read_unit
1697
1698
1703SUBROUTINE vol7d_ana_write_unit(this, unit)
1704TYPE(vol7d_ana),INTENT(in) :: this
1705INTEGER, INTENT(in) :: unit
1706
1707CALL vol7d_ana_vect_write_unit((/this/), unit)
1708
1709END SUBROUTINE vol7d_ana_write_unit
1710
1711
1716SUBROUTINE vol7d_ana_vect_write_unit(this, unit)
1717TYPE(vol7d_ana),INTENT(in) :: this(:)
1718INTEGER, INTENT(in) :: unit
1719
1720CHARACTER(len=40) :: form
1721
1722CALL write_unit(this%coord, unit)
1723INQUIRE(unit, form=form)
1724IF (form == 'FORMATTED') THEN
1725 WRITE(unit,'(A)')this(:)%ident
1726ELSE
1727 WRITE(unit)this(:)%ident
1728ENDIF
1729
1730END SUBROUTINE vol7d_ana_vect_write_unit
1731
1732
1733#include "array_utilities_inc.F90"
1734
1735
1736END MODULE vol7d_ana_class
check for missing value
Distruttore per la classe vol7d_ana.
Costruttore per la classe vol7d_ana.
Legge un oggetto vol7d_ana o un vettore di oggetti vol7d_ana da un file FORMATTED o UNFORMATTED.
Represent ana object in a pretty string.
Scrive un oggetto vol7d_ana o un vettore di oggetti vol7d_ana su un file FORMATTED o UNFORMATTED.
Classes for handling georeferenced sparse points in geographical corodinates.
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 dell'anagrafica di stazioni meteo e affini.
Definisce l'anagrafica di una stazione.

Generated with Doxygen.