libsim Versione 7.2.1

◆ index_var()

integer function index_var ( type(vol7d_var), dimension(:), intent(in) vect,
type(vol7d_var), intent(in) search,
logical, dimension(:), intent(in), optional mask,
logical, intent(in), optional back,
integer, intent(in), optional cache )

Cerca l'indice del primo o ultimo elemento di vect uguale a search.

Definizione alla linea 1052 del file vol7d_var_class.F90.

1054! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1055! authors:
1056! Davide Cesari <dcesari@arpa.emr.it>
1057! Paolo Patruno <ppatruno@arpa.emr.it>
1058
1059! This program is free software; you can redistribute it and/or
1060! modify it under the terms of the GNU General Public License as
1061! published by the Free Software Foundation; either version 2 of
1062! the License, or (at your option) any later version.
1063
1064! This program is distributed in the hope that it will be useful,
1065! but WITHOUT ANY WARRANTY; without even the implied warranty of
1066! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1067! GNU General Public License for more details.
1068
1069! You should have received a copy of the GNU General Public License
1070! along with this program. If not, see <http://www.gnu.org/licenses/>.
1071#include "config.h"
1072
1077MODULE vol7d_var_class
1078USE kinds
1081IMPLICIT NONE
1082
1091TYPE vol7d_var
1092 CHARACTER(len=10) :: btable=cmiss
1093 CHARACTER(len=65) :: description=cmiss
1094 CHARACTER(len=24) :: unit=cmiss
1095 INTEGER :: scalefactor=imiss
1096
1097 INTEGER :: r=imiss
1098 INTEGER :: d=imiss
1099 INTEGER :: i=imiss
1100 INTEGER :: b=imiss
1101 INTEGER :: c=imiss
1102 INTEGER :: gribhint(4)=imiss
1103END TYPE vol7d_var
1104
1106TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
1107 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
1108 (/imiss,imiss,imiss,imiss/))
1109
1113INTERFACE init
1114 MODULE PROCEDURE vol7d_var_init
1115END INTERFACE
1116
1119INTERFACE delete
1120 MODULE PROCEDURE vol7d_var_delete
1121END INTERFACE
1122
1128INTERFACE OPERATOR (==)
1129 MODULE PROCEDURE vol7d_var_eq
1130END INTERFACE
1131
1137INTERFACE OPERATOR (/=)
1138 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
1139END INTERFACE
1140
1142INTERFACE c_e
1143 MODULE PROCEDURE vol7d_var_c_e
1144END INTERFACE
1145
1146#define VOL7D_POLY_TYPE TYPE(vol7d_var)
1147#define VOL7D_POLY_TYPES _var
1148#include "array_utilities_pre.F90"
1149
1151INTERFACE display
1152 MODULE PROCEDURE display_var, display_var_vect
1153END INTERFACE
1154
1155
1156TYPE vol7d_var_features
1157 TYPE(vol7d_var) :: var
1158 REAL :: posdef
1159 INTEGER :: vartype
1160END TYPE vol7d_var_features
1161
1162TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
1163
1164! constants for vol7d_vartype
1165INTEGER,PARAMETER :: var_ord=0
1166INTEGER,PARAMETER :: var_dir360=1
1167INTEGER,PARAMETER :: var_press=2
1168INTEGER,PARAMETER :: var_ucomp=3
1169INTEGER,PARAMETER :: var_vcomp=4
1170INTEGER,PARAMETER :: var_wcomp=5
1171
1172
1173CONTAINS
1174
1180elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
1181TYPE(vol7d_var),INTENT(INOUT) :: this
1182CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
1183CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1184CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1185INTEGER,INTENT(in),OPTIONAL :: scalefactor
1186
1187IF (PRESENT(btable)) THEN
1188 this%btable = btable
1189ELSE
1190 this%btable = cmiss
1191 this%description = cmiss
1192 this%unit = cmiss
1193 this%scalefactor = imiss
1194 RETURN
1195ENDIF
1196IF (PRESENT(description)) THEN
1197 this%description = description
1198ELSE
1199 this%description = cmiss
1200ENDIF
1201IF (PRESENT(unit)) THEN
1202 this%unit = unit
1203ELSE
1204 this%unit = cmiss
1205ENDIF
1206if (present(scalefactor)) then
1207 this%scalefactor = scalefactor
1208else
1209 this%scalefactor = imiss
1210endif
1211
1212this%r = -1
1213this%d = -1
1214this%i = -1
1215this%b = -1
1216this%c = -1
1217
1218END SUBROUTINE vol7d_var_init
1219
1220
1221ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
1222CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
1223CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1224CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1225INTEGER,INTENT(in),OPTIONAL :: scalefactor
1226
1227TYPE(vol7d_var) :: this
1228
1229CALL init(this, btable, description, unit, scalefactor)
1230
1231END FUNCTION vol7d_var_new
1232
1233
1235elemental SUBROUTINE vol7d_var_delete(this)
1236TYPE(vol7d_var),INTENT(INOUT) :: this
1237
1238this%btable = cmiss
1239this%description = cmiss
1240this%unit = cmiss
1241this%scalefactor = imiss
1242
1243END SUBROUTINE vol7d_var_delete
1244
1245
1246ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
1247TYPE(vol7d_var),INTENT(IN) :: this, that
1248LOGICAL :: res
1249
1250res = this%btable == that%btable
1251
1252END FUNCTION vol7d_var_eq
1253
1254
1255ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
1256TYPE(vol7d_var),INTENT(IN) :: this, that
1257LOGICAL :: res
1258
1259res = .NOT.(this == that)
1260
1261END FUNCTION vol7d_var_ne
1262
1263
1264FUNCTION vol7d_var_nesv(this, that) RESULT(res)
1265TYPE(vol7d_var),INTENT(IN) :: this, that(:)
1266LOGICAL :: res(SIZE(that))
1267
1268INTEGER :: i
1269
1270DO i = 1, SIZE(that)
1271 res(i) = .NOT.(this == that(i))
1272ENDDO
1273
1274END FUNCTION vol7d_var_nesv
1275
1276
1277
1279subroutine display_var(this)
1280
1281TYPE(vol7d_var),INTENT(in) :: this
1282
1283print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
1284 " scale factor",this%scalefactor
1285
1286end subroutine display_var
1287
1288
1290subroutine display_var_vect(this)
1291
1292TYPE(vol7d_var),INTENT(in) :: this(:)
1293integer :: i
1294
1295do i=1,size(this)
1296 call display_var(this(i))
1297end do
1298
1299end subroutine display_var_vect
1300
1301FUNCTION vol7d_var_c_e(this) RESULT(c_e)
1302TYPE(vol7d_var),INTENT(IN) :: this
1303LOGICAL :: c_e
1304c_e = this /= vol7d_var_miss
1305END FUNCTION vol7d_var_c_e
1306
1307
1316SUBROUTINE vol7d_var_features_init()
1317INTEGER :: un, i, n
1318TYPE(csv_record) :: csv
1319CHARACTER(len=1024) :: line
1320
1321IF (ALLOCATED(var_features)) RETURN
1322
1323un = open_package_file('varbufr.csv', filetype_data)
1324n=0
1325DO WHILE(.true.)
1326 READ(un,*,END=100)
1327 n = n + 1
1328ENDDO
1329
1330100 CONTINUE
1331
1332rewind(un)
1333ALLOCATE(var_features(n))
1334
1335DO i = 1, n
1336 READ(un,'(A)',END=200)line
1337 CALL init(csv, line)
1338 CALL csv_record_getfield(csv, var_features(i)%var%btable)
1339 CALL csv_record_getfield(csv)
1340 CALL csv_record_getfield(csv)
1341 CALL csv_record_getfield(csv, var_features(i)%posdef)
1342 CALL csv_record_getfield(csv, var_features(i)%vartype)
1343 CALL delete(csv)
1344ENDDO
1345
1346200 CONTINUE
1347CLOSE(un)
1348
1349END SUBROUTINE vol7d_var_features_init
1350
1351
1355SUBROUTINE vol7d_var_features_delete()
1356IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
1357END SUBROUTINE vol7d_var_features_delete
1358
1359
1366ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
1367TYPE(vol7d_var),INTENT(in) :: this
1368INTEGER :: vartype
1369
1370INTEGER :: i
1371
1372vartype = imiss
1373
1374IF (ALLOCATED(var_features)) THEN
1375 DO i = 1, SIZE(var_features)
1376 IF (this == var_features(i)%var) THEN
1377 vartype = var_features(i)%vartype
1378 RETURN
1379 ENDIF
1380 ENDDO
1381ENDIF
1382
1383END FUNCTION vol7d_var_features_vartype
1384
1385
1396ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
1397TYPE(vol7d_var),INTENT(in) :: this
1398REAL,INTENT(inout) :: val
1399
1400INTEGER :: i
1401
1402IF (ALLOCATED(var_features)) THEN
1403 DO i = 1, SIZE(var_features)
1404 IF (this == var_features(i)%var) THEN
1405 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
1406 RETURN
1407 ENDIF
1408 ENDDO
1409ENDIF
1410
1411END SUBROUTINE vol7d_var_features_posdef_apply
1412
1413
1418ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1419TYPE(vol7d_var),INTENT(in) :: this
1420
1421INTEGER :: vartype
1422
1423vartype = var_ord
1424SELECT CASE(this%btable)
1425CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
1426 vartype = var_dir360
1427CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
1428 vartype = var_press
1429CASE('B11003', 'B11200') ! u-component
1430 vartype = var_ucomp
1431CASE('B11004', 'B11201') ! v-component
1432 vartype = var_vcomp
1433CASE('B11005', 'B11006') ! w-component
1434 vartype = var_wcomp
1435END SELECT
1436
1437END FUNCTION vol7d_vartype
1438
1439
1440#include "array_utilities_inc.F90"
1441
1442
1443END MODULE vol7d_var_class
Distruttore per la classe vol7d_var.
display on the screen a brief content of object
Costruttore per la classe vol7d_var.
Utilities for managing files.
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.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Definisce una variabile meteorologica osservata o un suo attributo.

Generated with Doxygen.