libsim Versione 7.1.11
|
◆ index_sorted_ana()
Cerca l'indice del primo o ultimo elemento di vect uguale a search. Definizione alla linea 1159 del file vol7d_ana_class.F90. 1161! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1162! authors:
1163! Davide Cesari <dcesari@arpa.emr.it>
1164! Paolo Patruno <ppatruno@arpa.emr.it>
1165
1166! This program is free software; you can redistribute it and/or
1167! modify it under the terms of the GNU General Public License as
1168! published by the Free Software Foundation; either version 2 of
1169! the License, or (at your option) any later version.
1170
1171! This program is distributed in the hope that it will be useful,
1172! but WITHOUT ANY WARRANTY; without even the implied warranty of
1173! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1174! GNU General Public License for more details.
1175
1176! You should have received a copy of the GNU General Public License
1177! along with this program. If not, see <http://www.gnu.org/licenses/>.
1178#include "config.h"
1179
1188IMPLICIT NONE
1189
1191INTEGER,PARAMETER :: vol7d_ana_lenident=20
1192
1198 TYPE(geo_coord) :: coord
1199 CHARACTER(len=vol7d_ana_lenident) :: ident
1201
1204
1209 MODULE PROCEDURE vol7d_ana_init
1210END INTERFACE
1211
1215 MODULE PROCEDURE vol7d_ana_delete
1216END INTERFACE
1217
1221INTERFACE OPERATOR (==)
1222 MODULE PROCEDURE vol7d_ana_eq
1223END INTERFACE
1224
1228INTERFACE OPERATOR (/=)
1229 MODULE PROCEDURE vol7d_ana_ne
1230END INTERFACE
1231
1232
1237INTERFACE OPERATOR (>)
1238 MODULE PROCEDURE vol7d_ana_gt
1239END INTERFACE
1240
1245INTERFACE OPERATOR (<)
1246 MODULE PROCEDURE vol7d_ana_lt
1247END INTERFACE
1248
1253INTERFACE OPERATOR (>=)
1254 MODULE PROCEDURE vol7d_ana_ge
1255END INTERFACE
1256
1261INTERFACE OPERATOR (<=)
1262 MODULE PROCEDURE vol7d_ana_le
1263END INTERFACE
1264
1265
1268 MODULE PROCEDURE vol7d_ana_c_e
1269END INTERFACE
1270
1274 MODULE PROCEDURE vol7d_ana_read_unit, vol7d_ana_vect_read_unit
1275END INTERFACE
1276
1280 MODULE PROCEDURE vol7d_ana_write_unit, vol7d_ana_vect_write_unit
1281END INTERFACE
1282
1283#define VOL7D_POLY_TYPE TYPE(vol7d_ana)
1284#define VOL7D_POLY_TYPES _ana
1285#define ENABLE_SORT
1286#include "array_utilities_pre.F90"
1287
1290 MODULE PROCEDURE to_char_ana
1291END INTERFACE
1292
1295 MODULE PROCEDURE display_ana
1296END INTERFACE
1297
1298CONTAINS
1299
1303SUBROUTINE vol7d_ana_init(this, lon, lat, ident, ilon, ilat)
1304TYPE(vol7d_ana),INTENT(INOUT) :: this
1305REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
1306REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
1307CHARACTER(len=*),INTENT(in),OPTIONAL :: ident
1308INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
1309INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
1310
1312IF (PRESENT(ident)) THEN
1313 this%ident = ident
1314ELSE
1315 this%ident = cmiss
1316ENDIF
1317
1318END SUBROUTINE vol7d_ana_init
1319
1320
1322SUBROUTINE vol7d_ana_delete(this)
1323TYPE(vol7d_ana),INTENT(INOUT) :: this
1324
1326this%ident = cmiss
1327
1328END SUBROUTINE vol7d_ana_delete
1329
1330
1331
1332character(len=80) function to_char_ana(this)
1333
1334TYPE(vol7d_ana),INTENT(in) :: this
1335
1336to_char_ana="ANA: "//&
1339 t2c(this%ident,miss="Missing ident")
1340
1341return
1342
1343end function to_char_ana
1344
1345
1346subroutine display_ana(this)
1347
1348TYPE(vol7d_ana),INTENT(in) :: this
1349
1350print*, trim(to_char(this))
1351
1352end subroutine display_ana
1353
1354
1355ELEMENTAL FUNCTION vol7d_ana_eq(this, that) RESULT(res)
1356TYPE(vol7d_ana),INTENT(IN) :: this, that
1357LOGICAL :: res
1358
1359res = this%coord == that%coord .AND. this%ident == that%ident
1360
1361END FUNCTION vol7d_ana_eq
1362
1363
1364ELEMENTAL FUNCTION vol7d_ana_ne(this, that) RESULT(res)
1365TYPE(vol7d_ana),INTENT(IN) :: this, that
1366LOGICAL :: res
1367
1368res = .NOT.(this == that)
1369
1370END FUNCTION vol7d_ana_ne
1371
1372
1373ELEMENTAL FUNCTION vol7d_ana_gt(this, that) RESULT(res)
1374TYPE(vol7d_ana),INTENT(IN) :: this, that
1375LOGICAL :: res
1376
1377res = this%ident > that%ident
1378
1379if ( this%ident == that%ident) then
1380 res =this%coord > that%coord
1381end if
1382
1383END FUNCTION vol7d_ana_gt
1384
1385
1386ELEMENTAL FUNCTION vol7d_ana_ge(this, that) RESULT(res)
1387TYPE(vol7d_ana),INTENT(IN) :: this, that
1388LOGICAL :: res
1389
1390res = .not. this < that
1391
1392END FUNCTION vol7d_ana_ge
1393
1394
1395ELEMENTAL FUNCTION vol7d_ana_lt(this, that) RESULT(res)
1396TYPE(vol7d_ana),INTENT(IN) :: this, that
1397LOGICAL :: res
1398
1399res = this%ident < that%ident
1400
1401if ( this%ident == that%ident) then
1402 res = this%coord < that%coord
1403end if
1404
1405END FUNCTION vol7d_ana_lt
1406
1407
1408ELEMENTAL FUNCTION vol7d_ana_le(this, that) RESULT(res)
1409TYPE(vol7d_ana),INTENT(IN) :: this, that
1410LOGICAL :: res
1411
1412res = .not. (this > that)
1413
1414END FUNCTION vol7d_ana_le
1415
1416
1417
1418ELEMENTAL FUNCTION vol7d_ana_c_e(this) RESULT(c_e)
1419TYPE(vol7d_ana),INTENT(IN) :: this
1420LOGICAL :: c_e
1421c_e = this /= vol7d_ana_miss
1422END FUNCTION vol7d_ana_c_e
1423
1424
1429SUBROUTINE vol7d_ana_read_unit(this, unit)
1430TYPE(vol7d_ana),INTENT(out) :: this
1431INTEGER, INTENT(in) :: unit
1432
1433CALL vol7d_ana_vect_read_unit((/this/), unit)
1434
1435END SUBROUTINE vol7d_ana_read_unit
1436
1437
1442SUBROUTINE vol7d_ana_vect_read_unit(this, unit)
1443TYPE(vol7d_ana) :: this(:)
1444INTEGER, INTENT(in) :: unit
1445
1446CHARACTER(len=40) :: form
1447
1449INQUIRE(unit, form=form)
1450IF (form == 'FORMATTED') THEN
1451 READ(unit,'(A)')this(:)%ident
1452ELSE
1453 READ(unit)this(:)%ident
1454ENDIF
1455
1456END SUBROUTINE vol7d_ana_vect_read_unit
1457
1458
1463SUBROUTINE vol7d_ana_write_unit(this, unit)
1464TYPE(vol7d_ana),INTENT(in) :: this
1465INTEGER, INTENT(in) :: unit
1466
1467CALL vol7d_ana_vect_write_unit((/this/), unit)
1468
1469END SUBROUTINE vol7d_ana_write_unit
1470
1471
1476SUBROUTINE vol7d_ana_vect_write_unit(this, unit)
1477TYPE(vol7d_ana),INTENT(in) :: this(:)
1478INTEGER, INTENT(in) :: unit
1479
1480CHARACTER(len=40) :: form
1481
1483INQUIRE(unit, form=form)
1484IF (form == 'FORMATTED') THEN
1485 WRITE(unit,'(A)')this(:)%ident
1486ELSE
1487 WRITE(unit)this(:)%ident
1488ENDIF
1489
1490END SUBROUTINE vol7d_ana_vect_write_unit
1491
1492
1493#include "array_utilities_inc.F90"
1494
1495
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 |