libsim Versione 7.1.11

◆ map_distinct_timerange()

integer function, dimension(size(vect)) map_distinct_timerange ( type(vol7d_timerange), dimension(:), intent(in)  vect,
logical, dimension(:), intent(in), optional  mask,
logical, intent(in), optional  back 
)

map distinct

Definizione alla linea 1038 del file vol7d_timerange_class.F90.

1039! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1040! authors:
1041! Davide Cesari <dcesari@arpa.emr.it>
1042! Paolo Patruno <ppatruno@arpa.emr.it>
1043
1044! This program is free software; you can redistribute it and/or
1045! modify it under the terms of the GNU General Public License as
1046! published by the Free Software Foundation; either version 2 of
1047! the License, or (at your option) any later version.
1048
1049! This program is distributed in the hope that it will be useful,
1050! but WITHOUT ANY WARRANTY; without even the implied warranty of
1051! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1052! GNU General Public License for more details.
1053
1054! You should have received a copy of the GNU General Public License
1055! along with this program. If not, see <http://www.gnu.org/licenses/>.
1056#include "config.h"
1057
1066USE kinds
1069IMPLICIT NONE
1070
1075TYPE vol7d_timerange
1076 INTEGER :: timerange
1077 INTEGER :: p1
1078 INTEGER :: p2
1079END TYPE vol7d_timerange
1080
1082TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
1083 vol7d_timerange(imiss,imiss,imiss)
1084
1088INTERFACE init
1089 MODULE PROCEDURE vol7d_timerange_init
1090END INTERFACE
1091
1094INTERFACE delete
1095 MODULE PROCEDURE vol7d_timerange_delete
1096END INTERFACE
1097
1101INTERFACE OPERATOR (==)
1102 MODULE PROCEDURE vol7d_timerange_eq
1103END INTERFACE
1104
1108INTERFACE OPERATOR (/=)
1109 MODULE PROCEDURE vol7d_timerange_ne
1110END INTERFACE
1111
1115INTERFACE OPERATOR (>)
1116 MODULE PROCEDURE vol7d_timerange_gt
1117END INTERFACE
1118
1122INTERFACE OPERATOR (<)
1123 MODULE PROCEDURE vol7d_timerange_lt
1124END INTERFACE
1125
1129INTERFACE OPERATOR (>=)
1130 MODULE PROCEDURE vol7d_timerange_ge
1131END INTERFACE
1132
1136INTERFACE OPERATOR (<=)
1137 MODULE PROCEDURE vol7d_timerange_le
1138END INTERFACE
1139
1142INTERFACE OPERATOR (.almosteq.)
1143 MODULE PROCEDURE vol7d_timerange_almost_eq
1144END INTERFACE
1145
1146
1147! da documentare in inglese assieme al resto
1149INTERFACE c_e
1150 MODULE PROCEDURE vol7d_timerange_c_e
1151END INTERFACE
1152
1153#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
1154#define VOL7D_POLY_TYPES _timerange
1155#define ENABLE_SORT
1156#include "array_utilities_pre.F90"
1157
1159INTERFACE display
1160 MODULE PROCEDURE display_timerange
1161END INTERFACE
1162
1164INTERFACE to_char
1165 MODULE PROCEDURE to_char_timerange
1166END INTERFACE
1167
1168#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
1169#define ARRAYOF_TYPE arrayof_vol7d_timerange
1170#define ARRAYOF_ORIGEQ 1
1171#include "arrayof_pre.F90"
1172
1173
1174type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
1175 vol7d_timerange(254,0,imiss),&
1176 vol7d_timerange(3,0,3600)/)
1177
1178
1179! from arrayof
1180PUBLIC insert, append, remove, packarray
1181PUBLIC insert_unique, append_unique
1182PUBLIC almost_equal_timeranges
1183
1184CONTAINS
1185
1186
1192FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1193INTEGER,INTENT(IN),OPTIONAL :: timerange
1194INTEGER,INTENT(IN),OPTIONAL :: p1
1195INTEGER,INTENT(IN),OPTIONAL :: p2
1196
1197TYPE(vol7d_timerange) :: this
1198
1199CALL init(this, timerange, p1, p2)
1200
1201END FUNCTION vol7d_timerange_new
1202
1203
1207SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1208TYPE(vol7d_timerange),INTENT(INOUT) :: this
1209INTEGER,INTENT(IN),OPTIONAL :: timerange
1210INTEGER,INTENT(IN),OPTIONAL :: p1
1211INTEGER,INTENT(IN),OPTIONAL :: p2
1212
1213IF (PRESENT(timerange)) THEN
1214 this%timerange = timerange
1215ELSE
1216 this%timerange = imiss
1217 this%p1 = imiss
1218 this%p2 = imiss
1219 RETURN
1220ENDIF
1221!!$IF (timerange == 1) THEN ! p1 sempre 0
1222!!$ this%p1 = 0
1223!!$ this%p2 = imiss
1224!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
1225!!$ IF (PRESENT(p1)) THEN
1226!!$ this%p1 = p1
1227!!$ ELSE
1228!!$ this%p1 = 0
1229!!$ ENDIF
1230!!$ this%p2 = imiss
1231!!$ELSE ! tutti gli altri
1232 IF (PRESENT(p1)) THEN
1233 this%p1 = p1
1234 ELSE
1235 this%p1 = imiss
1236 ENDIF
1237 IF (PRESENT(p2)) THEN
1238 this%p2 = p2
1239 ELSE
1240 this%p2 = imiss
1241 ENDIF
1242!!$END IF
1243
1244END SUBROUTINE vol7d_timerange_init
1245
1246
1248SUBROUTINE vol7d_timerange_delete(this)
1249TYPE(vol7d_timerange),INTENT(INOUT) :: this
1250
1251this%timerange = imiss
1252this%p1 = imiss
1253this%p2 = imiss
1254
1255END SUBROUTINE vol7d_timerange_delete
1256
1257
1258SUBROUTINE display_timerange(this)
1259TYPE(vol7d_timerange),INTENT(in) :: this
1260
1261print*,to_char_timerange(this)
1262
1263END SUBROUTINE display_timerange
1264
1265
1266FUNCTION to_char_timerange(this)
1267#ifdef HAVE_DBALLE
1268USE dballef
1269#endif
1270TYPE(vol7d_timerange),INTENT(in) :: this
1271CHARACTER(len=80) :: to_char_timerange
1272
1273#ifdef HAVE_DBALLE
1274INTEGER :: handle, ier
1275
1276handle = 0
1277ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1278ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
1279ier = idba_fatto(handle)
1280
1281to_char_timerange="Timerange: "//to_char_timerange
1282
1283#else
1284
1285to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
1286 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
1287
1288#endif
1289
1290END FUNCTION to_char_timerange
1291
1292
1293ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
1294TYPE(vol7d_timerange),INTENT(IN) :: this, that
1295LOGICAL :: res
1296
1297
1298res = &
1299 this%timerange == that%timerange .AND. &
1300 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1301 this%timerange == 254)
1302
1303END FUNCTION vol7d_timerange_eq
1304
1305
1306ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1307TYPE(vol7d_timerange),INTENT(IN) :: this, that
1308LOGICAL :: res
1309
1310IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1311 this%p1 == that%p1 .AND. &
1312 this%p2 == that%p2) THEN
1313 res = .true.
1314ELSE
1315 res = .false.
1316ENDIF
1317
1318END FUNCTION vol7d_timerange_almost_eq
1319
1320
1321ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1322TYPE(vol7d_timerange),INTENT(IN) :: this, that
1323LOGICAL :: res
1324
1325res = .NOT.(this == that)
1326
1327END FUNCTION vol7d_timerange_ne
1328
1329
1330ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1331TYPE(vol7d_timerange),INTENT(IN) :: this, that
1332LOGICAL :: res
1333
1334IF (this%timerange > that%timerange .OR. &
1335 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1336 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1337 this%p2 > that%p2)) THEN
1338 res = .true.
1339ELSE
1340 res = .false.
1341ENDIF
1342
1343END FUNCTION vol7d_timerange_gt
1344
1345
1346ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1347TYPE(vol7d_timerange),INTENT(IN) :: this, that
1348LOGICAL :: res
1349
1350IF (this%timerange < that%timerange .OR. &
1351 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1352 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1353 this%p2 < that%p2)) THEN
1354 res = .true.
1355ELSE
1356 res = .false.
1357ENDIF
1358
1359END FUNCTION vol7d_timerange_lt
1360
1361
1362ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1363TYPE(vol7d_timerange),INTENT(IN) :: this, that
1364LOGICAL :: res
1365
1366IF (this == that) THEN
1367 res = .true.
1368ELSE IF (this > that) THEN
1369 res = .true.
1370ELSE
1371 res = .false.
1372ENDIF
1373
1374END FUNCTION vol7d_timerange_ge
1375
1376
1377ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1378TYPE(vol7d_timerange),INTENT(IN) :: this, that
1379LOGICAL :: res
1380
1381IF (this == that) THEN
1382 res = .true.
1383ELSE IF (this < that) THEN
1384 res = .true.
1385ELSE
1386 res = .false.
1387ENDIF
1388
1389END FUNCTION vol7d_timerange_le
1390
1391
1392ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1393TYPE(vol7d_timerange),INTENT(IN) :: this
1394LOGICAL :: c_e
1395c_e = this /= vol7d_timerange_miss
1396END FUNCTION vol7d_timerange_c_e
1397
1398
1399#include "array_utilities_inc.F90"
1400
1401#include "arrayof_post.F90"
1402
1403
1404END MODULE vol7d_timerange_class
Quick method to append an element to the array.
Distruttore per la classe vol7d_timerange.
Costruttore per la classe vol7d_timerange.
Method for inserting elements of the array at a desired position.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Method for removing elements of the array at a desired position.
Represent timerange object in a pretty string.
Utilities for CHARACTER variables.
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 degli intervalli temporali di osservazioni meteo e affini.
Definisce l'intervallo temporale di un'osservazione meteo.

Generated with Doxygen.