libsim Versione 7.2.4
|
◆ index_sorted_ana()
Cerca l'indice del primo o ultimo elemento di vect uguale a search. Definizione alla linea 1153 del file vol7d_ana_class.F90. 1155! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1156! authors:
1157! Davide Cesari <dcesari@arpa.emr.it>
1158! Paolo Patruno <ppatruno@arpa.emr.it>
1159
1160! This program is free software; you can redistribute it and/or
1161! modify it under the terms of the GNU General Public License as
1162! published by the Free Software Foundation; either version 2 of
1163! the License, or (at your option) any later version.
1164
1165! This program is distributed in the hope that it will be useful,
1166! but WITHOUT ANY WARRANTY; without even the implied warranty of
1167! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1168! GNU General Public License for more details.
1169
1170! You should have received a copy of the GNU General Public License
1171! along with this program. If not, see <http://www.gnu.org/licenses/>.
1172#include "config.h"
1173
1182IMPLICIT NONE
1183
1185INTEGER,PARAMETER :: vol7d_ana_lenident=20
1186
1192 TYPE(geo_coord) :: coord
1193 CHARACTER(len=vol7d_ana_lenident) :: ident
1195
1198
1203 MODULE PROCEDURE vol7d_ana_init
1204END INTERFACE
1205
1209 MODULE PROCEDURE vol7d_ana_delete
1210END INTERFACE
1211
1215INTERFACE OPERATOR (==)
1216 MODULE PROCEDURE vol7d_ana_eq
1217END INTERFACE
1218
1222INTERFACE OPERATOR (/=)
1223 MODULE PROCEDURE vol7d_ana_ne
1224END INTERFACE
1225
1226
1231INTERFACE OPERATOR (>)
1232 MODULE PROCEDURE vol7d_ana_gt
1233END INTERFACE
1234
1239INTERFACE OPERATOR (<)
1240 MODULE PROCEDURE vol7d_ana_lt
1241END INTERFACE
1242
1247INTERFACE OPERATOR (>=)
1248 MODULE PROCEDURE vol7d_ana_ge
1249END INTERFACE
1250
1255INTERFACE OPERATOR (<=)
1256 MODULE PROCEDURE vol7d_ana_le
1257END INTERFACE
1258
1259
1262 MODULE PROCEDURE vol7d_ana_c_e
1263END INTERFACE
1264
1268 MODULE PROCEDURE vol7d_ana_read_unit, vol7d_ana_vect_read_unit
1269END INTERFACE
1270
1274 MODULE PROCEDURE vol7d_ana_write_unit, vol7d_ana_vect_write_unit
1275END INTERFACE
1276
1277#define VOL7D_POLY_TYPE TYPE(vol7d_ana)
1278#define VOL7D_POLY_TYPES _ana
1279#define ENABLE_SORT
1280#include "array_utilities_pre.F90"
1281
1284 MODULE PROCEDURE to_char_ana
1285END INTERFACE
1286
1289 MODULE PROCEDURE display_ana
1290END INTERFACE
1291
1292CONTAINS
1293
1297SUBROUTINE vol7d_ana_init(this, lon, lat, ident, ilon, ilat)
1298TYPE(vol7d_ana),INTENT(INOUT) :: this
1299REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
1300REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
1301CHARACTER(len=*),INTENT(in),OPTIONAL :: ident
1302INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
1303INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
1304
1306IF (PRESENT(ident)) THEN
1307 this%ident = ident
1308ELSE
1309 this%ident = cmiss
1310ENDIF
1311
1312END SUBROUTINE vol7d_ana_init
1313
1314
1316SUBROUTINE vol7d_ana_delete(this)
1317TYPE(vol7d_ana),INTENT(INOUT) :: this
1318
1320this%ident = cmiss
1321
1322END SUBROUTINE vol7d_ana_delete
1323
1324
1325
1326character(len=80) function to_char_ana(this)
1327
1328TYPE(vol7d_ana),INTENT(in) :: this
1329
1330to_char_ana="ANA: "//&
1333 t2c(this%ident,miss="Missing ident")
1334
1335return
1336
1337end function to_char_ana
1338
1339
1340subroutine display_ana(this)
1341
1342TYPE(vol7d_ana),INTENT(in) :: this
1343
1344print*, trim(to_char(this))
1345
1346end subroutine display_ana
1347
1348
1349ELEMENTAL FUNCTION vol7d_ana_eq(this, that) RESULT(res)
1350TYPE(vol7d_ana),INTENT(IN) :: this, that
1351LOGICAL :: res
1352
1353res = this%coord == that%coord .AND. this%ident == that%ident
1354
1355END FUNCTION vol7d_ana_eq
1356
1357
1358ELEMENTAL FUNCTION vol7d_ana_ne(this, that) RESULT(res)
1359TYPE(vol7d_ana),INTENT(IN) :: this, that
1360LOGICAL :: res
1361
1362res = .NOT.(this == that)
1363
1364END FUNCTION vol7d_ana_ne
1365
1366
1367ELEMENTAL FUNCTION vol7d_ana_gt(this, that) RESULT(res)
1368TYPE(vol7d_ana),INTENT(IN) :: this, that
1369LOGICAL :: res
1370
1371res = this%ident > that%ident
1372
1373if ( this%ident == that%ident) then
1374 res =this%coord > that%coord
1375end if
1376
1377END FUNCTION vol7d_ana_gt
1378
1379
1380ELEMENTAL FUNCTION vol7d_ana_ge(this, that) RESULT(res)
1381TYPE(vol7d_ana),INTENT(IN) :: this, that
1382LOGICAL :: res
1383
1384res = .not. this < that
1385
1386END FUNCTION vol7d_ana_ge
1387
1388
1389ELEMENTAL FUNCTION vol7d_ana_lt(this, that) RESULT(res)
1390TYPE(vol7d_ana),INTENT(IN) :: this, that
1391LOGICAL :: res
1392
1393res = this%ident < that%ident
1394
1395if ( this%ident == that%ident) then
1396 res = this%coord < that%coord
1397end if
1398
1399END FUNCTION vol7d_ana_lt
1400
1401
1402ELEMENTAL FUNCTION vol7d_ana_le(this, that) RESULT(res)
1403TYPE(vol7d_ana),INTENT(IN) :: this, that
1404LOGICAL :: res
1405
1406res = .not. (this > that)
1407
1408END FUNCTION vol7d_ana_le
1409
1410
1411
1412ELEMENTAL FUNCTION vol7d_ana_c_e(this) RESULT(c_e)
1413TYPE(vol7d_ana),INTENT(IN) :: this
1414LOGICAL :: c_e
1415c_e = this /= vol7d_ana_miss
1416END FUNCTION vol7d_ana_c_e
1417
1418
1423SUBROUTINE vol7d_ana_read_unit(this, unit)
1424TYPE(vol7d_ana),INTENT(out) :: this
1425INTEGER, INTENT(in) :: unit
1426
1427CALL vol7d_ana_vect_read_unit((/this/), unit)
1428
1429END SUBROUTINE vol7d_ana_read_unit
1430
1431
1436SUBROUTINE vol7d_ana_vect_read_unit(this, unit)
1437TYPE(vol7d_ana) :: this(:)
1438INTEGER, INTENT(in) :: unit
1439
1440CHARACTER(len=40) :: form
1441
1443INQUIRE(unit, form=form)
1444IF (form == 'FORMATTED') THEN
1445 READ(unit,'(A)')this(:)%ident
1446ELSE
1447 READ(unit)this(:)%ident
1448ENDIF
1449
1450END SUBROUTINE vol7d_ana_vect_read_unit
1451
1452
1457SUBROUTINE vol7d_ana_write_unit(this, unit)
1458TYPE(vol7d_ana),INTENT(in) :: this
1459INTEGER, INTENT(in) :: unit
1460
1461CALL vol7d_ana_vect_write_unit((/this/), unit)
1462
1463END SUBROUTINE vol7d_ana_write_unit
1464
1465
1470SUBROUTINE vol7d_ana_vect_write_unit(this, unit)
1471TYPE(vol7d_ana),INTENT(in) :: this(:)
1472INTEGER, INTENT(in) :: unit
1473
1474CHARACTER(len=40) :: form
1475
1477INQUIRE(unit, form=form)
1478IF (form == 'FORMATTED') THEN
1479 WRITE(unit,'(A)')this(:)%ident
1480ELSE
1481 WRITE(unit)this(:)%ident
1482ENDIF
1483
1484END SUBROUTINE vol7d_ana_vect_write_unit
1485
1486
1487#include "array_utilities_inc.F90"
1488
1489
Legge un oggetto vol7d_ana o un vettore di oggetti vol7d_ana da un file FORMATTED o UNFORMATTED. Definition vol7d_ana_class.F90:301 Scrive un oggetto vol7d_ana o un vettore di oggetti vol7d_ana su un file FORMATTED o UNFORMATTED. Definition vol7d_ana_class.F90:307 Classes for handling georeferenced sparse points in geographical corodinates. Definition geo_coord_class.F90:216 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 dell'anagrafica di stazioni meteo e affini. Definition vol7d_ana_class.F90:212 |