libsim Versione 7.1.11

◆ 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 1406 del file vol7d_ana_class.F90.

1407! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1408! authors:
1409! Davide Cesari <dcesari@arpa.emr.it>
1410! Paolo Patruno <ppatruno@arpa.emr.it>
1411
1412! This program is free software; you can redistribute it and/or
1413! modify it under the terms of the GNU General Public License as
1414! published by the Free Software Foundation; either version 2 of
1415! the License, or (at your option) any later version.
1416
1417! This program is distributed in the hope that it will be useful,
1418! but WITHOUT ANY WARRANTY; without even the implied warranty of
1419! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1420! GNU General Public License for more details.
1421
1422! You should have received a copy of the GNU General Public License
1423! along with this program. If not, see <http://www.gnu.org/licenses/>.
1424#include "config.h"
1425
1430MODULE vol7d_ana_class
1431USE kinds
1434IMPLICIT NONE
1435
1437INTEGER,PARAMETER :: vol7d_ana_lenident=20
1438
1443TYPE vol7d_ana
1444 TYPE(geo_coord) :: coord
1445 CHARACTER(len=vol7d_ana_lenident) :: ident
1446END TYPE vol7d_ana
1447
1449TYPE(vol7d_ana),PARAMETER :: vol7d_ana_miss=vol7d_ana(geo_coord_miss,cmiss)
1450
1454INTERFACE init
1455 MODULE PROCEDURE vol7d_ana_init
1456END INTERFACE
1457
1460INTERFACE delete
1461 MODULE PROCEDURE vol7d_ana_delete
1462END INTERFACE
1463
1467INTERFACE OPERATOR (==)
1468 MODULE PROCEDURE vol7d_ana_eq
1469END INTERFACE
1470
1474INTERFACE OPERATOR (/=)
1475 MODULE PROCEDURE vol7d_ana_ne
1476END INTERFACE
1477
1478
1483INTERFACE OPERATOR (>)
1484 MODULE PROCEDURE vol7d_ana_gt
1485END INTERFACE
1486
1491INTERFACE OPERATOR (<)
1492 MODULE PROCEDURE vol7d_ana_lt
1493END INTERFACE
1494
1499INTERFACE OPERATOR (>=)
1500 MODULE PROCEDURE vol7d_ana_ge
1501END INTERFACE
1502
1507INTERFACE OPERATOR (<=)
1508 MODULE PROCEDURE vol7d_ana_le
1509END INTERFACE
1510
1511
1513INTERFACE c_e
1514 MODULE PROCEDURE vol7d_ana_c_e
1515END INTERFACE
1516
1519INTERFACE read_unit
1520 MODULE PROCEDURE vol7d_ana_read_unit, vol7d_ana_vect_read_unit
1521END INTERFACE
1522
1525INTERFACE write_unit
1526 MODULE PROCEDURE vol7d_ana_write_unit, vol7d_ana_vect_write_unit
1527END INTERFACE
1528
1529#define VOL7D_POLY_TYPE TYPE(vol7d_ana)
1530#define VOL7D_POLY_TYPES _ana
1531#define ENABLE_SORT
1532#include "array_utilities_pre.F90"
1533
1535INTERFACE to_char
1536 MODULE PROCEDURE to_char_ana
1537END INTERFACE
1538
1540INTERFACE display
1541 MODULE PROCEDURE display_ana
1542END INTERFACE
1543
1544CONTAINS
1545
1549SUBROUTINE vol7d_ana_init(this, lon, lat, ident, ilon, ilat)
1550TYPE(vol7d_ana),INTENT(INOUT) :: this
1551REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
1552REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
1553CHARACTER(len=*),INTENT(in),OPTIONAL :: ident
1554INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
1555INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
1556
1557CALL init(this%coord, lon=lon, lat=lat , ilon=ilon, ilat=ilat)
1558IF (PRESENT(ident)) THEN
1559 this%ident = ident
1560ELSE
1561 this%ident = cmiss
1562ENDIF
1563
1564END SUBROUTINE vol7d_ana_init
1565
1566
1568SUBROUTINE vol7d_ana_delete(this)
1569TYPE(vol7d_ana),INTENT(INOUT) :: this
1570
1571CALL delete(this%coord)
1572this%ident = cmiss
1573
1574END SUBROUTINE vol7d_ana_delete
1575
1576
1577
1578character(len=80) function to_char_ana(this)
1579
1580TYPE(vol7d_ana),INTENT(in) :: this
1581
1582to_char_ana="ANA: "//&
1583 to_char(getlon(this%coord),miss="Missing lon",form="(f11.5)")//&
1584 to_char(getlat(this%coord),miss="Missing lat",form="(f11.5)")//&
1585 t2c(this%ident,miss="Missing ident")
1586
1587return
1588
1589end function to_char_ana
1590
1591
1592subroutine display_ana(this)
1593
1594TYPE(vol7d_ana),INTENT(in) :: this
1595
1596print*, trim(to_char(this))
1597
1598end subroutine display_ana
1599
1600
1601ELEMENTAL FUNCTION vol7d_ana_eq(this, that) RESULT(res)
1602TYPE(vol7d_ana),INTENT(IN) :: this, that
1603LOGICAL :: res
1604
1605res = this%coord == that%coord .AND. this%ident == that%ident
1606
1607END FUNCTION vol7d_ana_eq
1608
1609
1610ELEMENTAL FUNCTION vol7d_ana_ne(this, that) RESULT(res)
1611TYPE(vol7d_ana),INTENT(IN) :: this, that
1612LOGICAL :: res
1613
1614res = .NOT.(this == that)
1615
1616END FUNCTION vol7d_ana_ne
1617
1618
1619ELEMENTAL FUNCTION vol7d_ana_gt(this, that) RESULT(res)
1620TYPE(vol7d_ana),INTENT(IN) :: this, that
1621LOGICAL :: res
1622
1623res = this%ident > that%ident
1624
1625if ( this%ident == that%ident) then
1626 res =this%coord > that%coord
1627end if
1628
1629END FUNCTION vol7d_ana_gt
1630
1631
1632ELEMENTAL FUNCTION vol7d_ana_ge(this, that) RESULT(res)
1633TYPE(vol7d_ana),INTENT(IN) :: this, that
1634LOGICAL :: res
1635
1636res = .not. this < that
1637
1638END FUNCTION vol7d_ana_ge
1639
1640
1641ELEMENTAL FUNCTION vol7d_ana_lt(this, that) RESULT(res)
1642TYPE(vol7d_ana),INTENT(IN) :: this, that
1643LOGICAL :: res
1644
1645res = this%ident < that%ident
1646
1647if ( this%ident == that%ident) then
1648 res = this%coord < that%coord
1649end if
1650
1651END FUNCTION vol7d_ana_lt
1652
1653
1654ELEMENTAL FUNCTION vol7d_ana_le(this, that) RESULT(res)
1655TYPE(vol7d_ana),INTENT(IN) :: this, that
1656LOGICAL :: res
1657
1658res = .not. (this > that)
1659
1660END FUNCTION vol7d_ana_le
1661
1662
1663
1664ELEMENTAL FUNCTION vol7d_ana_c_e(this) RESULT(c_e)
1665TYPE(vol7d_ana),INTENT(IN) :: this
1666LOGICAL :: c_e
1667c_e = this /= vol7d_ana_miss
1668END FUNCTION vol7d_ana_c_e
1669
1670
1675SUBROUTINE vol7d_ana_read_unit(this, unit)
1676TYPE(vol7d_ana),INTENT(out) :: this
1677INTEGER, INTENT(in) :: unit
1678
1679CALL vol7d_ana_vect_read_unit((/this/), unit)
1680
1681END SUBROUTINE vol7d_ana_read_unit
1682
1683
1688SUBROUTINE vol7d_ana_vect_read_unit(this, unit)
1689TYPE(vol7d_ana) :: this(:)
1690INTEGER, INTENT(in) :: unit
1691
1692CHARACTER(len=40) :: form
1693
1694CALL read_unit(this%coord, unit)
1695INQUIRE(unit, form=form)
1696IF (form == 'FORMATTED') THEN
1697 READ(unit,'(A)')this(:)%ident
1698ELSE
1699 READ(unit)this(:)%ident
1700ENDIF
1701
1702END SUBROUTINE vol7d_ana_vect_read_unit
1703
1704
1709SUBROUTINE vol7d_ana_write_unit(this, unit)
1710TYPE(vol7d_ana),INTENT(in) :: this
1711INTEGER, INTENT(in) :: unit
1712
1713CALL vol7d_ana_vect_write_unit((/this/), unit)
1714
1715END SUBROUTINE vol7d_ana_write_unit
1716
1717
1722SUBROUTINE vol7d_ana_vect_write_unit(this, unit)
1723TYPE(vol7d_ana),INTENT(in) :: this(:)
1724INTEGER, INTENT(in) :: unit
1725
1726CHARACTER(len=40) :: form
1727
1728CALL write_unit(this%coord, unit)
1729INQUIRE(unit, form=form)
1730IF (form == 'FORMATTED') THEN
1731 WRITE(unit,'(A)')this(:)%ident
1732ELSE
1733 WRITE(unit)this(:)%ident
1734ENDIF
1735
1736END SUBROUTINE vol7d_ana_vect_write_unit
1737
1738
1739#include "array_utilities_inc.F90"
1740
1741
1742END 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:251
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.