libsim Versione 7.1.11
|
◆ index_var()
Cerca l'indice del primo o ultimo elemento di vect uguale a search. Definizione alla linea 1058 del file vol7d_var_class.F90. 1060! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1061! authors:
1062! Davide Cesari <dcesari@arpa.emr.it>
1063! Paolo Patruno <ppatruno@arpa.emr.it>
1064
1065! This program is free software; you can redistribute it and/or
1066! modify it under the terms of the GNU General Public License as
1067! published by the Free Software Foundation; either version 2 of
1068! the License, or (at your option) any later version.
1069
1070! This program is distributed in the hope that it will be useful,
1071! but WITHOUT ANY WARRANTY; without even the implied warranty of
1072! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1073! GNU General Public License for more details.
1074
1075! You should have received a copy of the GNU General Public License
1076! along with this program. If not, see <http://www.gnu.org/licenses/>.
1077#include "config.h"
1078
1087IMPLICIT NONE
1088
1098 CHARACTER(len=10) :: btable=cmiss
1099 CHARACTER(len=65) :: description=cmiss
1100 CHARACTER(len=24) :: unit=cmiss
1101 INTEGER :: scalefactor=imiss
1102
1103 INTEGER :: r=imiss
1104 INTEGER :: d=imiss
1105 INTEGER :: i=imiss
1106 INTEGER :: b=imiss
1107 INTEGER :: c=imiss
1108 INTEGER :: gribhint(4)=imiss
1110
1112TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
1113 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
1114 (/imiss,imiss,imiss,imiss/))
1115
1120 MODULE PROCEDURE vol7d_var_init
1121END INTERFACE
1122
1126 MODULE PROCEDURE vol7d_var_delete
1127END INTERFACE
1128
1134INTERFACE OPERATOR (==)
1135 MODULE PROCEDURE vol7d_var_eq
1136END INTERFACE
1137
1143INTERFACE OPERATOR (/=)
1144 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
1145END INTERFACE
1146
1149 MODULE PROCEDURE vol7d_var_c_e
1150END INTERFACE
1151
1152#define VOL7D_POLY_TYPE TYPE(vol7d_var)
1153#define VOL7D_POLY_TYPES _var
1154#include "array_utilities_pre.F90"
1155
1158 MODULE PROCEDURE display_var, display_var_vect
1159END INTERFACE
1160
1161
1162TYPE vol7d_var_features
1163 TYPE(vol7d_var) :: var
1164 REAL :: posdef
1165 INTEGER :: vartype
1166END TYPE vol7d_var_features
1167
1168TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
1169
1170! constants for vol7d_vartype
1171INTEGER,PARAMETER :: var_ord=0
1172INTEGER,PARAMETER :: var_dir360=1
1173INTEGER,PARAMETER :: var_press=2
1174INTEGER,PARAMETER :: var_ucomp=3
1175INTEGER,PARAMETER :: var_vcomp=4
1176INTEGER,PARAMETER :: var_wcomp=5
1177
1178
1179CONTAINS
1180
1186elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
1187TYPE(vol7d_var),INTENT(INOUT) :: this
1188CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
1189CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1190CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1191INTEGER,INTENT(in),OPTIONAL :: scalefactor
1192
1193IF (PRESENT(btable)) THEN
1194 this%btable = btable
1195ELSE
1196 this%btable = cmiss
1197 this%description = cmiss
1198 this%unit = cmiss
1199 this%scalefactor = imiss
1200 RETURN
1201ENDIF
1202IF (PRESENT(description)) THEN
1203 this%description = description
1204ELSE
1205 this%description = cmiss
1206ENDIF
1207IF (PRESENT(unit)) THEN
1208 this%unit = unit
1209ELSE
1210 this%unit = cmiss
1211ENDIF
1212if (present(scalefactor)) then
1213 this%scalefactor = scalefactor
1214else
1215 this%scalefactor = imiss
1216endif
1217
1218this%r = -1
1219this%d = -1
1220this%i = -1
1221this%b = -1
1222this%c = -1
1223
1224END SUBROUTINE vol7d_var_init
1225
1226
1227ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
1228CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
1229CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1230CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1231INTEGER,INTENT(in),OPTIONAL :: scalefactor
1232
1233TYPE(vol7d_var) :: this
1234
1236
1237END FUNCTION vol7d_var_new
1238
1239
1241elemental SUBROUTINE vol7d_var_delete(this)
1242TYPE(vol7d_var),INTENT(INOUT) :: this
1243
1244this%btable = cmiss
1245this%description = cmiss
1246this%unit = cmiss
1247this%scalefactor = imiss
1248
1249END SUBROUTINE vol7d_var_delete
1250
1251
1252ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
1253TYPE(vol7d_var),INTENT(IN) :: this, that
1254LOGICAL :: res
1255
1256res = this%btable == that%btable
1257
1258END FUNCTION vol7d_var_eq
1259
1260
1261ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
1262TYPE(vol7d_var),INTENT(IN) :: this, that
1263LOGICAL :: res
1264
1265res = .NOT.(this == that)
1266
1267END FUNCTION vol7d_var_ne
1268
1269
1270FUNCTION vol7d_var_nesv(this, that) RESULT(res)
1271TYPE(vol7d_var),INTENT(IN) :: this, that(:)
1272LOGICAL :: res(SIZE(that))
1273
1274INTEGER :: i
1275
1276DO i = 1, SIZE(that)
1277 res(i) = .NOT.(this == that(i))
1278ENDDO
1279
1280END FUNCTION vol7d_var_nesv
1281
1282
1283
1285subroutine display_var(this)
1286
1287TYPE(vol7d_var),INTENT(in) :: this
1288
1289print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
1290 " scale factor",this%scalefactor
1291
1292end subroutine display_var
1293
1294
1296subroutine display_var_vect(this)
1297
1298TYPE(vol7d_var),INTENT(in) :: this(:)
1299integer :: i
1300
1301do i=1,size(this)
1302 call display_var(this(i))
1303end do
1304
1305end subroutine display_var_vect
1306
1307FUNCTION vol7d_var_c_e(this) RESULT(c_e)
1308TYPE(vol7d_var),INTENT(IN) :: this
1309LOGICAL :: c_e
1310c_e = this /= vol7d_var_miss
1311END FUNCTION vol7d_var_c_e
1312
1313
1322SUBROUTINE vol7d_var_features_init()
1323INTEGER :: un, i, n
1324TYPE(csv_record) :: csv
1325CHARACTER(len=1024) :: line
1326
1327IF (ALLOCATED(var_features)) RETURN
1328
1329un = open_package_file('varbufr.csv', filetype_data)
1330n=0
1331DO WHILE(.true.)
1332 READ(un,*,END=100)
1333 n = n + 1
1334ENDDO
1335
1336100 CONTINUE
1337
1338rewind(un)
1339ALLOCATE(var_features(n))
1340
1341DO i = 1, n
1342 READ(un,'(A)',END=200)line
1344 CALL csv_record_getfield(csv, var_features(i)%var%btable)
1345 CALL csv_record_getfield(csv)
1346 CALL csv_record_getfield(csv)
1347 CALL csv_record_getfield(csv, var_features(i)%posdef)
1348 CALL csv_record_getfield(csv, var_features(i)%vartype)
1350ENDDO
1351
1352200 CONTINUE
1353CLOSE(un)
1354
1355END SUBROUTINE vol7d_var_features_init
1356
1357
1361SUBROUTINE vol7d_var_features_delete()
1362IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
1363END SUBROUTINE vol7d_var_features_delete
1364
1365
1372ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
1373TYPE(vol7d_var),INTENT(in) :: this
1374INTEGER :: vartype
1375
1376INTEGER :: i
1377
1378vartype = imiss
1379
1380IF (ALLOCATED(var_features)) THEN
1381 DO i = 1, SIZE(var_features)
1382 IF (this == var_features(i)%var) THEN
1383 vartype = var_features(i)%vartype
1384 RETURN
1385 ENDIF
1386 ENDDO
1387ENDIF
1388
1389END FUNCTION vol7d_var_features_vartype
1390
1391
1402ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
1403TYPE(vol7d_var),INTENT(in) :: this
1404REAL,INTENT(inout) :: val
1405
1406INTEGER :: i
1407
1408IF (ALLOCATED(var_features)) THEN
1409 DO i = 1, SIZE(var_features)
1410 IF (this == var_features(i)%var) THEN
1412 RETURN
1413 ENDIF
1414 ENDDO
1415ENDIF
1416
1417END SUBROUTINE vol7d_var_features_posdef_apply
1418
1419
1424ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1425TYPE(vol7d_var),INTENT(in) :: this
1426
1427INTEGER :: vartype
1428
1429vartype = var_ord
1430SELECT CASE(this%btable)
1431CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
1432 vartype = var_dir360
1433CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
1434 vartype = var_press
1435CASE('B11003', 'B11200') ! u-component
1436 vartype = var_ucomp
1437CASE('B11004', 'B11201') ! v-component
1438 vartype = var_vcomp
1439CASE('B11005', 'B11006') ! w-component
1440 vartype = var_wcomp
1441END SELECT
1442
1443END FUNCTION vol7d_vartype
1444
1445
1446#include "array_utilities_inc.F90"
1447
1448
display on the screen a brief content of object Definition: vol7d_var_class.F90:334 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 delle variabili osservate da stazioni meteo e affini. Definition: vol7d_var_class.F90:218 Definisce una variabile meteorologica osservata o un suo attributo. Definition: vol7d_var_class.F90:232 |