libsim Versione 7.1.11
|
◆ sort_ana()
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.
Definizione alla linea 1281 del file vol7d_ana_class.F90. 1282! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1283! authors:
1284! Davide Cesari <dcesari@arpa.emr.it>
1285! Paolo Patruno <ppatruno@arpa.emr.it>
1286
1287! This program is free software; you can redistribute it and/or
1288! modify it under the terms of the GNU General Public License as
1289! published by the Free Software Foundation; either version 2 of
1290! the License, or (at your option) any later version.
1291
1292! This program is distributed in the hope that it will be useful,
1293! but WITHOUT ANY WARRANTY; without even the implied warranty of
1294! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1295! GNU General Public License for more details.
1296
1297! You should have received a copy of the GNU General Public License
1298! along with this program. If not, see <http://www.gnu.org/licenses/>.
1299#include "config.h"
1300
1309IMPLICIT NONE
1310
1312INTEGER,PARAMETER :: vol7d_ana_lenident=20
1313
1319 TYPE(geo_coord) :: coord
1320 CHARACTER(len=vol7d_ana_lenident) :: ident
1322
1325
1330 MODULE PROCEDURE vol7d_ana_init
1331END INTERFACE
1332
1336 MODULE PROCEDURE vol7d_ana_delete
1337END INTERFACE
1338
1342INTERFACE OPERATOR (==)
1343 MODULE PROCEDURE vol7d_ana_eq
1344END INTERFACE
1345
1349INTERFACE OPERATOR (/=)
1350 MODULE PROCEDURE vol7d_ana_ne
1351END INTERFACE
1352
1353
1358INTERFACE OPERATOR (>)
1359 MODULE PROCEDURE vol7d_ana_gt
1360END INTERFACE
1361
1366INTERFACE OPERATOR (<)
1367 MODULE PROCEDURE vol7d_ana_lt
1368END INTERFACE
1369
1374INTERFACE OPERATOR (>=)
1375 MODULE PROCEDURE vol7d_ana_ge
1376END INTERFACE
1377
1382INTERFACE OPERATOR (<=)
1383 MODULE PROCEDURE vol7d_ana_le
1384END INTERFACE
1385
1386
1389 MODULE PROCEDURE vol7d_ana_c_e
1390END INTERFACE
1391
1395 MODULE PROCEDURE vol7d_ana_read_unit, vol7d_ana_vect_read_unit
1396END INTERFACE
1397
1401 MODULE PROCEDURE vol7d_ana_write_unit, vol7d_ana_vect_write_unit
1402END INTERFACE
1403
1404#define VOL7D_POLY_TYPE TYPE(vol7d_ana)
1405#define VOL7D_POLY_TYPES _ana
1406#define ENABLE_SORT
1407#include "array_utilities_pre.F90"
1408
1411 MODULE PROCEDURE to_char_ana
1412END INTERFACE
1413
1416 MODULE PROCEDURE display_ana
1417END INTERFACE
1418
1419CONTAINS
1420
1424SUBROUTINE vol7d_ana_init(this, lon, lat, ident, ilon, ilat)
1425TYPE(vol7d_ana),INTENT(INOUT) :: this
1426REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
1427REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
1428CHARACTER(len=*),INTENT(in),OPTIONAL :: ident
1429INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
1430INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
1431
1433IF (PRESENT(ident)) THEN
1434 this%ident = ident
1435ELSE
1436 this%ident = cmiss
1437ENDIF
1438
1439END SUBROUTINE vol7d_ana_init
1440
1441
1443SUBROUTINE vol7d_ana_delete(this)
1444TYPE(vol7d_ana),INTENT(INOUT) :: this
1445
1447this%ident = cmiss
1448
1449END SUBROUTINE vol7d_ana_delete
1450
1451
1452
1453character(len=80) function to_char_ana(this)
1454
1455TYPE(vol7d_ana),INTENT(in) :: this
1456
1457to_char_ana="ANA: "//&
1460 t2c(this%ident,miss="Missing ident")
1461
1462return
1463
1464end function to_char_ana
1465
1466
1467subroutine display_ana(this)
1468
1469TYPE(vol7d_ana),INTENT(in) :: this
1470
1471print*, trim(to_char(this))
1472
1473end subroutine display_ana
1474
1475
1476ELEMENTAL FUNCTION vol7d_ana_eq(this, that) RESULT(res)
1477TYPE(vol7d_ana),INTENT(IN) :: this, that
1478LOGICAL :: res
1479
1480res = this%coord == that%coord .AND. this%ident == that%ident
1481
1482END FUNCTION vol7d_ana_eq
1483
1484
1485ELEMENTAL FUNCTION vol7d_ana_ne(this, that) RESULT(res)
1486TYPE(vol7d_ana),INTENT(IN) :: this, that
1487LOGICAL :: res
1488
1489res = .NOT.(this == that)
1490
1491END FUNCTION vol7d_ana_ne
1492
1493
1494ELEMENTAL FUNCTION vol7d_ana_gt(this, that) RESULT(res)
1495TYPE(vol7d_ana),INTENT(IN) :: this, that
1496LOGICAL :: res
1497
1498res = this%ident > that%ident
1499
1500if ( this%ident == that%ident) then
1501 res =this%coord > that%coord
1502end if
1503
1504END FUNCTION vol7d_ana_gt
1505
1506
1507ELEMENTAL FUNCTION vol7d_ana_ge(this, that) RESULT(res)
1508TYPE(vol7d_ana),INTENT(IN) :: this, that
1509LOGICAL :: res
1510
1511res = .not. this < that
1512
1513END FUNCTION vol7d_ana_ge
1514
1515
1516ELEMENTAL FUNCTION vol7d_ana_lt(this, that) RESULT(res)
1517TYPE(vol7d_ana),INTENT(IN) :: this, that
1518LOGICAL :: res
1519
1520res = this%ident < that%ident
1521
1522if ( this%ident == that%ident) then
1523 res = this%coord < that%coord
1524end if
1525
1526END FUNCTION vol7d_ana_lt
1527
1528
1529ELEMENTAL FUNCTION vol7d_ana_le(this, that) RESULT(res)
1530TYPE(vol7d_ana),INTENT(IN) :: this, that
1531LOGICAL :: res
1532
1533res = .not. (this > that)
1534
1535END FUNCTION vol7d_ana_le
1536
1537
1538
1539ELEMENTAL FUNCTION vol7d_ana_c_e(this) RESULT(c_e)
1540TYPE(vol7d_ana),INTENT(IN) :: this
1541LOGICAL :: c_e
1542c_e = this /= vol7d_ana_miss
1543END FUNCTION vol7d_ana_c_e
1544
1545
1550SUBROUTINE vol7d_ana_read_unit(this, unit)
1551TYPE(vol7d_ana),INTENT(out) :: this
1552INTEGER, INTENT(in) :: unit
1553
1554CALL vol7d_ana_vect_read_unit((/this/), unit)
1555
1556END SUBROUTINE vol7d_ana_read_unit
1557
1558
1563SUBROUTINE vol7d_ana_vect_read_unit(this, unit)
1564TYPE(vol7d_ana) :: this(:)
1565INTEGER, INTENT(in) :: unit
1566
1567CHARACTER(len=40) :: form
1568
1570INQUIRE(unit, form=form)
1571IF (form == 'FORMATTED') THEN
1572 READ(unit,'(A)')this(:)%ident
1573ELSE
1574 READ(unit)this(:)%ident
1575ENDIF
1576
1577END SUBROUTINE vol7d_ana_vect_read_unit
1578
1579
1584SUBROUTINE vol7d_ana_write_unit(this, unit)
1585TYPE(vol7d_ana),INTENT(in) :: this
1586INTEGER, INTENT(in) :: unit
1587
1588CALL vol7d_ana_vect_write_unit((/this/), unit)
1589
1590END SUBROUTINE vol7d_ana_write_unit
1591
1592
1597SUBROUTINE vol7d_ana_vect_write_unit(this, unit)
1598TYPE(vol7d_ana),INTENT(in) :: this(:)
1599INTEGER, INTENT(in) :: unit
1600
1601CHARACTER(len=40) :: form
1602
1604INQUIRE(unit, form=form)
1605IF (form == 'FORMATTED') THEN
1606 WRITE(unit,'(A)')this(:)%ident
1607ELSE
1608 WRITE(unit)this(:)%ident
1609ENDIF
1610
1611END SUBROUTINE vol7d_ana_vect_write_unit
1612
1613
1614#include "array_utilities_inc.F90"
1615
1616
Legge un oggetto vol7d_ana o un vettore di oggetti vol7d_ana da un file FORMATTED o UNFORMATTED. Definition: vol7d_ana_class.F90:307 Scrive un oggetto vol7d_ana o un vettore di oggetti vol7d_ana su un file FORMATTED o UNFORMATTED. Definition: vol7d_ana_class.F90:313 Classes for handling georeferenced sparse points in geographical corodinates. Definition: geo_coord_class.F90:222 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 dell'anagrafica di stazioni meteo e affini. Definition: vol7d_ana_class.F90:218 Definisce l'anagrafica di una stazione. Definition: vol7d_ana_class.F90:231 |