libsim Versione 7.2.6

◆ 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
1073!> Classe per la gestione delle variabili osservate da stazioni meteo e affini.
1074!! Questo modulo definisce una classe per rappresentare variabili meteorologiche
1075!! osservate, o attributi, aventi diversi tipi numerici o carattere.
1076!! \ingroup vol7d
1077MODULE vol7d_var_class
1078USE kinds
1081IMPLICIT NONE
1082
1083!> Definisce una variabile meteorologica osservata o un suo attributo.
1084!! I membri \a r, \a d, \a i, \a b, \a c servono, internamente a vol7d,
1085!! per associare le variabili agli attributi, e indicano
1086!! a quale variabile, nel descrittore delle variabili, coincide
1087!! la variabile corrente nel descrittore delle "variabili aventi attributo".
1088!! I membri di \a vol7d_var sono pubblici e quindi liberamente
1089!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
1090!! il costruttore ::init.
1091TYPE vol7d_var
1092 CHARACTER(len=10) :: btable=cmiss !< codice della variabile secondo la tabella B del WMO.
1093 CHARACTER(len=65) :: description=cmiss !< descrizione testuale della variabile (opzionale)
1094 CHARACTER(len=24) :: unit=cmiss !< descrizione testuale dell'unità di misura (opzionale)
1095 INTEGER :: scalefactor=imiss !< numero di decimali nella rappresentazione intera o character (opzionale)
1096
1097 INTEGER :: r=imiss !< indice della variabile nel volume degli attributi reali
1098 INTEGER :: d=imiss !< indice della variabile nel volume degli attributi double precision
1099 INTEGER :: i=imiss !< indice della variabile nel volume degli attributi integer
1100 INTEGER :: b=imiss !< indice della variabile nel volume degli attributi byte
1101 INTEGER :: c=imiss !< indice della variabile nel volume degli attributi character
1102 INTEGER :: gribhint(4)=imiss !< hint for conversion from/to grib when btable is not found
1103END TYPE vol7d_var
1104
1105!> Valore mancante per vol7d_var.
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
1110!> Costruttore per la classe vol7d_var.
1111!! Deve essere richiamato
1112!! per tutti gli oggetti di questo tipo definiti in un programma.
1113INTERFACE init
1114 MODULE PROCEDURE vol7d_var_init
1115END INTERFACE
1116
1117!> Distruttore per la classe vol7d_var.
1118!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1119INTERFACE delete
1120 MODULE PROCEDURE vol7d_var_delete
1121END INTERFACE
1122
1123!> Operatore logico di uguaglianza tra oggetti della classe vol7d_var.
1124!! Funziona anche per
1125!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
1126!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
1127!! di 1 dimensione e scalari).
1128INTERFACE OPERATOR (==)
1129 MODULE PROCEDURE vol7d_var_eq
1130END INTERFACE
1131
1132!> Operatore logico di disuguaglianza tra oggetti della classe vol7d_var.
1133!! Funziona anche per
1134!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
1135!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
1136!! di 1 dimensione e scalari).
1137INTERFACE OPERATOR (/=)
1138 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
1139END INTERFACE
1140
1141!> to be documented
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
1150!> \brief display on the screen a brief content of object
1151INTERFACE display
1152 MODULE PROCEDURE display_var, display_var_vect
1153END INTERFACE
1154
1155
1156TYPE vol7d_var_features
1157 TYPE(vol7d_var) :: var !< the variable (only btable is relevant)
1158 REAL :: posdef !< if not missing, minimum physically reasonable value for the variable
1159 INTEGER :: vartype !< type of variable, one of the var_* constants
1160END TYPE vol7d_var_features
1161
1162TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
1163
1164! constants for vol7d_vartype
1165INTEGER,PARAMETER :: var_ord=0 !< unclassified variable (vol7d_vartype function)
1166INTEGER,PARAMETER :: var_dir360=1 !< direction in degrees (vol7d_vartype function)
1167INTEGER,PARAMETER :: var_press=2 !< pressure in Pa (vol7d_vartype function)
1168INTEGER,PARAMETER :: var_ucomp=3 !< u component of a vector field (vol7d_vartype function)
1169INTEGER,PARAMETER :: var_vcomp=4 !< v component of a vector field (vol7d_vartype function)
1170INTEGER,PARAMETER :: var_wcomp=5 !< w component of a vector field (vol7d_vartype function)
1171
1172
1173CONTAINS
1174
1175!> Inizializza un oggetto \a vol7d_var con i parametri opzionali forniti.
1176!! Se non viene passato nessun parametro opzionale l'oggetto è
1177!! inizializzato a valore mancante.
1178!! I membri \a r, \a d, \a i, \a b, \a c non possono essere assegnati
1179!! tramite costruttore, ma solo direttamente.
1180elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
1181TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da inizializzare
1182CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
1183CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
1184CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
1185INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
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 !< codice della variabile
1223CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
1224CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
1225INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
1226
1227TYPE(vol7d_var) :: this
1228
1229CALL init(this, btable, description, unit, scalefactor)
1230
1231END FUNCTION vol7d_var_new
1232
1233
1234!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1235elemental SUBROUTINE vol7d_var_delete(this)
1236TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da distruggre
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
1278!> \brief display on the screen a brief content of vol7d_var object
1279subroutine display_var(this)
1280
1281TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to display
1282
1283print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
1284 " scale factor",this%scalefactor
1285
1286end subroutine display_var
1287
1288
1289!> \brief display on the screen a brief content of vector of vol7d_var object
1290subroutine display_var_vect(this)
1291
1292TYPE(vol7d_var),INTENT(in) :: this(:) !< vol7d_var vector object to display
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
1308!> Initialise the global table of variable features.
1309!! This subroutine reads the table of variable features from an
1310!! external file and stores it in a global array. It has to be called
1311!! once at the beginning of the program. At the moment it gives access
1312!! to the information about type of variable and positive
1313!! definitness. The table is based on the unique bufr-like variable
1314!! table. The table is contained in the csv file `vargrib.csv`.
1315!! It is not harmful to call this subroutine multiple times.
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
1352!> Deallocate the global table of variable features.
1353!! This subroutine deallocates the table of variable features
1354!! allocated in the `vol7d_var_features_init` subroutine.
1355SUBROUTINE vol7d_var_features_delete()
1356IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
1357END SUBROUTINE vol7d_var_features_delete
1358
1359
1360!> Return the physical type of the variable.
1361!! Returns a rough classification of the variable depending on the
1362!! physical parameter it represents. The result is one of the
1363!! constants vartype_* defined in the module. To be extended.
1364!! In order for this to work, the subroutine \a
1365!! vol7d_var_features_init has to be preliminary called.
1366ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
1367TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
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
1386!> Apply a positive definite flag to a variable.
1387!! This subroutine resets the value of a variable depending on its
1388!! positive definite flag defined in the associated \a c_func object.
1389!! The \a c_func object can be obtained for example by the \a convert
1390!! (interfaced to vargrib2varbufr_convert) function. The value is
1391!! reset to the maximum between the value itsel and and 0 (or the
1392!! value set in \a c_func%posdef. These values are set from the
1393!! vargrib2bufr.csv file.
1394!! In order for this to work, the subroutine \a
1395!! vol7d_var_features_init has to be preliminary called.
1396ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
1397TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be reset
1398REAL,INTENT(inout) :: val !< value to be reset, it is reset in place
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
1414!> Return the physical type of the variable.
1415!! Returns a rough classification of the variable depending on the
1416!! physical parameter it represents. The result is one of the
1417!! constants vartype_* defined in the module. To be extended.
1418ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1419TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
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.