libsim Versione 7.2.6

◆ index_var6d()

integer function index_var6d ( type(volgrid6d_var), dimension(:), intent(in) vect,
type(volgrid6d_var), intent(in) search,
logical, dimension(:), intent(in), optional mask,
logical, intent(in), optional back,
integer, intent(in), optional cache )
private

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

Definizione alla linea 996 del file volgrid6d_var_class.F90.

998! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
999! authors:
1000! Davide Cesari <dcesari@arpa.emr.it>
1001! Paolo Patruno <ppatruno@arpa.emr.it>
1002
1003! This program is free software; you can redistribute it and/or
1004! modify it under the terms of the GNU General Public License as
1005! published by the Free Software Foundation; either version 2 of
1006! the License, or (at your option) any later version.
1007
1008! This program is distributed in the hope that it will be useful,
1009! but WITHOUT ANY WARRANTY; without even the implied warranty of
1010! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1011! GNU General Public License for more details.
1012
1013! You should have received a copy of the GNU General Public License
1014! along with this program. If not, see <http://www.gnu.org/licenses/>.
1015#include "config.h"
1016
1017!> Class for managing physical variables in a grib 1/2 fashion.
1018!! This module defines a class which can represent Earth-science
1019!! related physical variables, following the classification scheme
1020!! adopted by WMO for grib1 and grib2 parameter definition. It also
1021!! defines some methods for mapping \a volgrid6d_var variables and
1022!! converting the corresponding fields to a matching \a vol7d_var
1023!! object defined in \a vol7d_var_class module, which, unlike the
1024!! variables defined here, defines univocally a physical quantity.
1025!!
1026!! \ingroup volgrid6d
1028USE kinds
1030USE err_handling
1033USE grid_id_class
1034
1035IMPLICIT NONE
1036
1037!> Definition of a physical variable in grib coding style.
1038!! \a volgrid6d_var members are public, thus they can be freely
1039!! altered, but it is advisable to set them through the
1040!! volgrid6d_var_class::init constructor.
1041TYPE volgrid6d_var
1042 integer :: centre !< centre
1043 integer :: category !< grib2: category / grib1: grib table version number
1044 integer :: number !< parameter number
1045 integer :: discipline !< grib2: discipline / grib1: 255
1046 CHARACTER(len=65) :: description !< optional textual description of the variable
1047 CHARACTER(len=24) :: unit !< optional textual description of the variable's unit
1048END TYPE volgrid6d_var
1049
1050TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
1051 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss) !< missing value volgrid6d_var.
1052
1053TYPE(vol7d_var),PARAMETER :: vol7d_var_horstag(2) = (/ &
1054 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1055 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0) &
1056 /)
1057
1058TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
1059 vol7d_var('B11003', '', '', 0, 0, 0, 0, 0, 0), &
1060 vol7d_var('B11004', '', '', 0, 0, 0, 0, 0, 0), &
1061 vol7d_var('B11200', '', '', 0, 0, 0, 0, 0, 0), &
1062 vol7d_var('B11201', '', '', 0, 0, 0, 0, 0, 0) &
1063/)
1064!/), (/2,2/)) ! bug in gfortran
1065
1066!> Class defining a real conversion function between units. It is
1067!! used to numerically convert a value expressed as a \a volgrid6d_var
1068!! variable in a value expressed as a \a vol7d_var variable and
1069!! vice-versa. At the moment only a linear conversion is
1070!! supported. Objects of this class are returned only by the \a
1071!! vargrib2varbufr \a varbufr2vargrib, and \a convert methods and are
1072!! used in the \a convert and \a compute methods defined in this
1073!! MODULE.
1074TYPE conv_func
1075 PRIVATE
1076 REAL :: a, b
1077END TYPE conv_func
1078
1079TYPE(conv_func), PARAMETER :: conv_func_miss=conv_func(rmiss,rmiss)
1080TYPE(conv_func), PARAMETER :: conv_func_identity=conv_func(1.0,0.0)
1081
1082TYPE vg6d_v7d_var_conv
1083 TYPE(volgrid6d_var) :: vg6d_var
1084 TYPE(vol7d_var) :: v7d_var
1085 TYPE(conv_func) :: c_func
1086! aggiungere informazioni ad es. su rotazione del vento
1087END TYPE vg6d_v7d_var_conv
1088
1089TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
1090 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
1091
1092TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
1093
1094!> Initialize a \a volgrid6d_var object with the optional arguments provided.
1095!! If an argument is not provided, the corresponding object member and
1096!! those depending on it will be set to missing. For grib1-style
1097!! variables, the \a discipline argument must be omitted, it will be
1098!! set to 255 (grib missing value).
1099!!
1100!! \param this TYPE(volgrid6d_var),INTENT(INOUT) object to be initialized
1101!! \param centre INTEGER,INTENT(in),OPTIONAL centre
1102!! \param category INTEGER,INTENT(in),OPTIONAL grib2: category / grib1: grib table version number
1103!! \param number INTEGER,INTENT(in),OPTIONAL parameter number
1104!! \param discipline INTEGER,INTENT(in),OPTIONAL grib2: discipline / grib1: 255
1105!! \param description CHARACTER(len=*),INTENT(in),OPTIONAL optional textual description of the variable
1106!! \param unit CHARACTER(len=*),INTENT(in),OPTIONAL optional textual description of the variable's unit
1107INTERFACE init
1108 MODULE PROCEDURE volgrid6d_var_init
1109END INTERFACE
1110
1111!> Destructor for the corresponding object, it assigns it to a missing value.
1112!! \param this TYPE(volgrid6d_var) object to be destroyed
1113INTERFACE delete
1114 MODULE PROCEDURE volgrid6d_var_delete
1115END INTERFACE
1116
1117INTERFACE c_e
1118 MODULE PROCEDURE volgrid6d_var_c_e
1119END INTERFACE
1120
1121
1122!> Logical equality operators for objects of the classes \a
1123!! volgrid6d_var and \a conv_func.
1124!! They are all defined as \c ELEMENTAL thus work also on arrays of
1125!! any shape.
1126INTERFACE OPERATOR (==)
1127 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
1128END INTERFACE
1129
1130!> Logical inequality operators for objects of the classes \a
1131!! volgrid6d_var and \a conv_func.
1132!! They are all defined as \c ELEMENTAL thus work also on arrays of
1133!! any shape.
1134INTERFACE OPERATOR (/=)
1135 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
1136END INTERFACE
1137
1138#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
1139#define VOL7D_POLY_TYPES _var6d
1140#include "array_utilities_pre.F90"
1141
1142!> Display on the screen a brief content of object
1143INTERFACE display
1144 MODULE PROCEDURE display_volgrid6d_var
1145END INTERFACE
1146
1147!> Compose two conversions into a single one.
1148!! Unlike scalar multiplication (and like matrix multiplication) here
1149!! a*b /= b*a. By convention, the second factor is applied first in
1150!! the result.
1151INTERFACE OPERATOR (*)
1152 MODULE PROCEDURE conv_func_mult
1153END INTERFACE OPERATOR (*)
1154
1155!> Apply the conversion function \a this to \a values.
1156!! function version
1157INTERFACE compute
1158 MODULE PROCEDURE conv_func_compute
1159END INTERFACE
1160
1161!> Apply the conversion function \a this to \a values.
1162!! subroutine version
1163INTERFACE convert
1164 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
1165 conv_func_convert
1166END INTERFACE
1167
1168PRIVATE
1169PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
1170 c_e, volgrid6d_var_normalize, &
1171 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
1172 count_distinct, pack_distinct, count_and_pack_distinct, &
1173 map_distinct, map_inv_distinct, &
1174 index, display, &
1175 vargrib2varbufr, varbufr2vargrib, &
1176 conv_func, conv_func_miss, compute, convert, &
1177 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
1178
1179
1180CONTAINS
1181
1182
1183ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
1184 discipline, description, unit) RESULT(this)
1185integer,INTENT(in),OPTIONAL :: centre !< centre
1186integer,INTENT(in),OPTIONAL :: category !< grib2: category / grib1: grib table version number
1187integer,INTENT(in),OPTIONAL :: number !< parameter number
1188integer,INTENT(in),OPTIONAL :: discipline !< grib2: discipline
1189CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< textual description of the variable
1190CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< textual description of the variable's unit
1191
1192TYPE(volgrid6d_var) :: this !< object to be initialised
1193
1194CALL init(this, centre, category, number, discipline, description, unit)
1195
1196END FUNCTION volgrid6d_var_new
1197
1198
1199! documented in the interface
1200ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
1201TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
1202INTEGER,INTENT(in),OPTIONAL :: centre ! centre
1203INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
1204INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
1205INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
1206CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
1207CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
1208
1209IF (PRESENT(centre)) THEN
1210 this%centre = centre
1211ELSE
1212 this%centre = imiss
1213 this%category = imiss
1214 this%number = imiss
1215 this%discipline = imiss
1216 RETURN
1217ENDIF
1218
1219IF (PRESENT(category)) THEN
1220 this%category = category
1221ELSE
1222 this%category = imiss
1223 this%number = imiss
1224 this%discipline = imiss
1225 RETURN
1226ENDIF
1227
1228
1229IF (PRESENT(number)) THEN
1230 this%number = number
1231ELSE
1232 this%number = imiss
1233 this%discipline = imiss
1234 RETURN
1235ENDIF
1236
1237! se sono arrivato fino a qui ho impostato centre, category e number
1238!per il grib 1 manca discipline e imposto 255 (missing del grib2)
1239
1240IF (PRESENT(discipline)) THEN
1241 this%discipline = discipline
1242ELSE
1243 this%discipline = 255
1244ENDIF
1245
1246IF (PRESENT(description)) THEN
1247 this%description = description
1248ELSE
1249 this%description = cmiss
1250ENDIF
1251
1252IF (PRESENT(unit)) THEN
1253 this%unit = unit
1254ELSE
1255 this%unit = cmiss
1256ENDIF
1257
1258
1259
1260END SUBROUTINE volgrid6d_var_init
1261
1262
1263! documented in the interface
1264SUBROUTINE volgrid6d_var_delete(this)
1265TYPE(volgrid6d_var),INTENT(INOUT) :: this
1266
1267this%centre = imiss
1268this%category = imiss
1269this%number = imiss
1270this%discipline = imiss
1271this%description = cmiss
1272this%unit = cmiss
1273
1274END SUBROUTINE volgrid6d_var_delete
1275
1276
1277ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
1278TYPE(volgrid6d_var),INTENT(IN) :: this
1279LOGICAL :: c_e
1280c_e = this /= volgrid6d_var_miss
1281END FUNCTION volgrid6d_var_c_e
1282
1283
1284ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
1285TYPE(volgrid6d_var),INTENT(IN) :: this, that
1286LOGICAL :: res
1287
1288IF (this%discipline == that%discipline) THEN
1289
1290 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
1291 res = ((this%category == that%category) .OR. &
1292 (this%category >= 1 .AND. this%category <=3 .AND. &
1293 that%category >= 1 .AND. that%category <=3)) .AND. &
1294 this%number == that%number
1295
1296 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
1297 (this%number >= 128 .AND. this%number <= 254)) THEN
1298 res = res .AND. this%centre == that%centre ! local definition, centre matters
1299 ENDIF
1300
1301 ELSE ! grib2
1302 res = this%category == that%category .AND. &
1303 this%number == that%number
1304
1305 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
1306 (this%category >= 192 .AND. this%category <= 254) .OR. &
1307 (this%number >= 192 .AND. this%number <= 254)) THEN
1308 res = res .AND. this%centre == that%centre ! local definition, centre matters
1309 ENDIF
1310 ENDIF
1311
1312ELSE ! different edition or different discipline
1313 res = .false.
1314ENDIF
1315
1316END FUNCTION volgrid6d_var_eq
1317
1318
1319ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
1320TYPE(volgrid6d_var),INTENT(IN) :: this, that
1321LOGICAL :: res
1322
1323res = .NOT.(this == that)
1324
1325END FUNCTION volgrid6d_var_ne
1326
1327
1328#include "array_utilities_inc.F90"
1329
1330
1331!> Display on the screen a brief content of \a volgrid6d_var object.
1332SUBROUTINE display_volgrid6d_var(this)
1333TYPE(volgrid6d_var),INTENT(in) :: this !< volgrid6d_var object to display
1334
1335print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
1336
1337END SUBROUTINE display_volgrid6d_var
1338
1339
1340!> Convert a \a volgrid6d_var array object into a physically equivalent
1341!! \a vol7d_var array object. This method converts a grib-like array
1342!! of physical variables \a vargrib, to an array of unique, physically
1343!! based, bufr-like variables \a varbufr. The output array must have
1344!! enough room for the converted variables. The method additionally
1345!! allocates a \a conv_func array object of the same size, which can
1346!! successively be used to convert the numerical values of the fields
1347!! associated to \a vargrib to the corresponding fields in the \a
1348!! bufr-like representation. \a c_func will have to be deallocated by
1349!! the calling procedure. If a conversion is not successful, the
1350!! corresponding output variable is set to \a vol7d_var_miss and the
1351!! conversion function to \a conv_func_miss.
1352SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
1353TYPE(volgrid6d_var),INTENT(in) :: vargrib(:) !< array of input grib-like variables
1354TYPE(vol7d_var),INTENT(out) :: varbufr(:) !< array of output bufr-like variables
1355TYPE(conv_func),POINTER :: c_func(:) !< pointer to an array of the corresponding \a conv_func objects, allocated in the method
1356
1357INTEGER :: i, n, stallo
1358
1359n = min(SIZE(varbufr), SIZE(vargrib))
1360ALLOCATE(c_func(n),stat=stallo)
1361IF (stallo /= 0) THEN
1362 call l4f_log(l4f_fatal,"allocating memory")
1363 call raise_fatal_error()
1364ENDIF
1365
1366DO i = 1, n
1367 varbufr(i) = convert(vargrib(i), c_func(i))
1368ENDDO
1369
1370END SUBROUTINE vargrib2varbufr
1371
1372
1373!> Convert a \a volgrid6d_var object into a physically equivalent
1374!! \a vol7d_var object. This method returns a physically based,
1375!! bufr-like representation of type \a vol7d_var of the grib-like
1376!! input physical variable \a vargrib. The method optionally returns
1377!! a \a conv_func object which can successively be used to convert the
1378!! numerical values of the field associated to \a vargrib to the
1379!! corresponding fields in the bufr-like representation. If the
1380!! conversion is not successful, the output variable is
1381!! set to \a vol7d_var_miss and the conversion function to \a
1382!! conv_func_miss.
1383FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
1384TYPE(volgrid6d_var),INTENT(in) :: vargrib !< input grib-like variable
1385TYPE(conv_func),INTENT(out),OPTIONAL :: c_func !< corresponding \a conv_func object
1386TYPE(vol7d_var) :: convert
1387
1388INTEGER :: i
1389
1390IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1391
1392DO i = 1, SIZE(conv_fwd)
1393 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
1394 convert = conv_fwd(i)%v7d_var
1395 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
1396 RETURN
1397 ENDIF
1398ENDDO
1399! not found
1400convert = vol7d_var_miss
1401IF (PRESENT(c_func)) c_func = conv_func_miss
1402
1403! set hint for backwards conversion
1404convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
1405 vargrib%discipline/)
1406
1407CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
1408 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
1409 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
1410 ' not found in table')
1411
1412END FUNCTION vargrib2varbufr_convert
1413
1414
1415!> Convert a \a vol7d_var array object into a physically equivalent
1416!! \a volgrid6d_var array object. This method converts a bufr-like
1417!! array of physical variables \a vargrib, to an array of grib-like
1418!! variables \a varbufr. Unlike the opposite method \a
1419!! vargrib2varbufr, in this case the conversion is not uniqe and at
1420!! the moment the first matching grib-like variable is chosen, without
1421!! any control over the choice process. The output array must have
1422!! enough room for the converted variables. The method additionally
1423!! allocates a \a conv_func array object of the same size, which can
1424!! successively be used to convert the numerical values of the fields
1425!! associated to \a varbufr to the corresponding fields in the \a
1426!! grib-like representation. \a c_func will have to be deallocated by
1427!! the calling procedure. If a conversion is not successful, the
1428!! corresponding output variable is set to \a volgrid6d_var_miss and
1429!! the conversion function to \a conv_func_miss.
1430SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
1431TYPE(vol7d_var),INTENT(in) :: varbufr(:) !< array of input bufr-like variables
1432TYPE(volgrid6d_var),INTENT(out) :: vargrib(:) !< array of output grib-like variables
1433TYPE(conv_func),POINTER :: c_func(:) !< pointer to an array of the corresponding \a conv_func objects, allocated in the method
1434TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template !< a template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion
1435
1436INTEGER :: i, n, stallo
1437
1438n = min(SIZE(varbufr), SIZE(vargrib))
1439ALLOCATE(c_func(n),stat=stallo)
1440IF (stallo /= 0) THEN
1441 CALL l4f_log(l4f_fatal,"allocating memory")
1442 CALL raise_fatal_error()
1443ENDIF
1444
1445DO i = 1, n
1446 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
1447ENDDO
1448
1449END SUBROUTINE varbufr2vargrib
1450
1451
1452!> Convert a \a vol7d_var object into a physically equivalent
1453!! \a volgrid6d_var object. This method returns a grib-like
1454!! representation of type \a volgrid6d_var of the bufr-like input
1455!! physical variable \a varbufr. Unlike the opposite \a convert
1456!! method, in this case the conversion is not uniqe and at the moment
1457!! the first matching grib-like variable is chosen, without any
1458!! control over the choice process. The method optionally returns a
1459!! \a conv_func object which can successively be used to convert the
1460!! numerical values of the field associated to \a varbufr to the
1461!! corresponding fields in the grib-like representation. If the
1462!! conversion is not successful, the output variable is set to \a
1463!! volgrid6d_var_miss and the conversion function to \a
1464!! conv_func_miss.
1465FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
1466TYPE(vol7d_var),INTENT(in) :: varbufr !< input bufr-like variable
1467TYPE(conv_func),INTENT(out),OPTIONAL :: c_func !< corresponding \a conv_func object
1468TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template !< a template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion
1469TYPE(volgrid6d_var) :: convert
1470
1471INTEGER :: i
1472#ifdef HAVE_LIBGRIBAPI
1473INTEGER :: gaid, editionnumber, category, centre
1474#endif
1475
1476IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
1477
1478#ifdef HAVE_LIBGRIBAPI
1479editionnumber=255; category=255; centre=255
1480#endif
1481IF (PRESENT(grid_id_template)) THEN
1482#ifdef HAVE_LIBGRIBAPI
1483 gaid = grid_id_get_gaid(grid_id_template)
1484 IF (c_e(gaid)) THEN
1485 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1486 IF (editionnumber == 1) THEN
1487 CALL grib_get(gaid,'gribTablesVersionNo',category)
1488 ENDIF
1489 CALL grib_get(gaid,'centre',centre)
1490 ENDIF
1491#endif
1492ENDIF
1493
1494DO i = 1, SIZE(conv_bwd)
1495 IF (varbufr == conv_bwd(i)%v7d_var) THEN
1496#ifdef HAVE_LIBGRIBAPI
1497 IF (editionnumber /= 255) THEN ! further check required (gaid present)
1498 IF (editionnumber == 1) THEN
1499 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
1500 ELSE IF (editionnumber == 2) THEN
1501 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
1502 ENDIF
1503 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
1504 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
1505 ENDIF
1506#endif
1507 convert = conv_bwd(i)%vg6d_var
1508 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
1509 RETURN
1510 ENDIF
1511ENDDO
1512! not found
1513convert = volgrid6d_var_miss
1514IF (PRESENT(c_func)) c_func = conv_func_miss
1515
1516! if hint available use it as a fallback
1517IF (any(varbufr%gribhint /= imiss)) THEN
1518 convert%centre = varbufr%gribhint(1)
1519 convert%category = varbufr%gribhint(2)
1520 convert%number = varbufr%gribhint(3)
1521 convert%discipline = varbufr%gribhint(4)
1522ENDIF
1523
1524CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
1525 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
1526 ' not found in table')
1527
1528END FUNCTION varbufr2vargrib_convert
1529
1530
1531!> Normalize a variable definition converting it to the
1532!! format (grib edition) specified in the (grib) template provided.
1533!! This allows a basic grib1 <-> grib2 conversion provided that
1534!! entries for both grib editions of the related variable are present
1535!! in the static file \a vargrib2ufr.csv. If the \a c_func variable
1536!! returned is not missing (i.e. /= conv_func_miss) the field value
1537!! should be converted as well using the conv_func::compute method .
1538SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
1539TYPE(volgrid6d_var),INTENT(inout) :: this !< variable to normalize
1540TYPE(conv_func),INTENT(out) :: c_func !< \a conv_func object to convert data
1541TYPE(grid_id),INTENT(in) :: grid_id_template !< a template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion
1542
1543LOGICAL :: eqed, eqcentre
1544INTEGER :: gaid, editionnumber, centre
1545TYPE(volgrid6d_var) :: tmpgrib
1546TYPE(vol7d_var) :: tmpbufr
1547TYPE(conv_func) tmpc_func1, tmpc_func2
1548
1549eqed = .true.
1550eqcentre = .true.
1551c_func = conv_func_miss
1552
1553#ifdef HAVE_LIBGRIBAPI
1554gaid = grid_id_get_gaid(grid_id_template)
1555IF (c_e(gaid)) THEN
1556 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
1557 CALL grib_get(gaid, 'centre', centre)
1558 eqed = editionnumber == 1 .EQV. this%discipline == 255
1559 eqcentre = centre == this%centre
1560ENDIF
1561#endif
1562
1563IF (eqed .AND. eqcentre) RETURN ! nothing to do
1564
1565tmpbufr = convert(this, tmpc_func1)
1566tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
1567
1568IF (tmpgrib /= volgrid6d_var_miss) THEN
1569! conversion back and forth successful, set also conversion function
1570 this = tmpgrib
1571 c_func = tmpc_func1 * tmpc_func2
1572! set to missing in common case to avoid useless computation
1573 IF (c_func == conv_func_identity) c_func = conv_func_miss
1574ELSE IF (.NOT.eqed) THEN
1575! conversion back and forth unsuccessful and grib edition incompatible, set to miss
1576 this = tmpgrib
1577ENDIF
1578
1579END SUBROUTINE volgrid6d_var_normalize
1580
1581
1582! Private subroutine for reading forward and backward conversion tables
1583! todo: better error handling
1584SUBROUTINE vg6d_v7d_var_conv_setup()
1585INTEGER :: un, i, n, stallo
1586
1587! forward, grib to bufr
1588un = open_package_file('vargrib2bufr.csv', filetype_data)
1589n=0
1590DO WHILE(.true.)
1591 READ(un,*,END=100)
1592 n = n + 1
1593ENDDO
1594
1595100 CONTINUE
1596
1597rewind(un)
1598ALLOCATE(conv_fwd(n),stat=stallo)
1599IF (stallo /= 0) THEN
1600 CALL l4f_log(l4f_fatal,"allocating memory")
1601 CALL raise_fatal_error()
1602ENDIF
1603
1604conv_fwd(:) = vg6d_v7d_var_conv_miss
1605CALL import_var_conv(un, conv_fwd)
1606CLOSE(un)
1607
1608! backward, bufr to grib
1609un = open_package_file('vargrib2bufr.csv', filetype_data)
1610! use the same file for now
1611!un = open_package_file('varbufr2grib.csv', filetype_data)
1612n=0
1613DO WHILE(.true.)
1614 READ(un,*,END=300)
1615 n = n + 1
1616ENDDO
1617
1618300 CONTINUE
1619
1620rewind(un)
1621ALLOCATE(conv_bwd(n),stat=stallo)
1622IF (stallo /= 0) THEN
1623 CALL l4f_log(l4f_fatal,"allocating memory")
1624 CALL raise_fatal_error()
1625end if
1626
1627conv_bwd(:) = vg6d_v7d_var_conv_miss
1628CALL import_var_conv(un, conv_bwd)
1629DO i = 1, n
1630 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
1631 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
1632ENDDO
1633CLOSE(un)
1634
1635CONTAINS
1636
1637SUBROUTINE import_var_conv(un, conv_type)
1638INTEGER, INTENT(in) :: un
1639TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
1640
1641INTEGER :: i
1642TYPE(csv_record) :: csv
1643CHARACTER(len=1024) :: line
1644CHARACTER(len=10) :: btable
1645INTEGER :: centre, category, number, discipline
1646
1647DO i = 1, SIZE(conv_type)
1648 READ(un,'(A)',END=200)line
1649 CALL init(csv, line)
1650 CALL csv_record_getfield(csv, btable)
1651 CALL csv_record_getfield(csv) ! skip fields for description and unit,
1652 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
1653 CALL init(conv_type(i)%v7d_var, btable=btable)
1654
1655 CALL csv_record_getfield(csv, centre)
1656 CALL csv_record_getfield(csv, category)
1657 CALL csv_record_getfield(csv, number)
1658 CALL csv_record_getfield(csv, discipline)
1659 CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
1660 number=number, discipline=discipline) ! controllare l'ordine
1661
1662 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
1663 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
1664 CALL delete(csv)
1665ENDDO
1666
1667200 CONTINUE
1668
1669END SUBROUTINE import_var_conv
1670
1671END SUBROUTINE vg6d_v7d_var_conv_setup
1672
1673
1674ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
1675TYPE(conv_func),INTENT(IN) :: this, that
1676LOGICAL :: res
1677
1678res = this%a == that%a .AND. this%b == that%b
1679
1680END FUNCTION conv_func_eq
1681
1682
1683ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
1684TYPE(conv_func),INTENT(IN) :: this, that
1685LOGICAL :: res
1686
1687res = .NOT.(this == that)
1688
1689END FUNCTION conv_func_ne
1690
1691
1692FUNCTION conv_func_mult(this, that) RESULT(mult)
1693TYPE(conv_func),INTENT(in) :: this
1694TYPE(conv_func),INTENT(in) :: that
1695
1696TYPE(conv_func) :: mult
1697
1698IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
1699 mult = conv_func_miss
1700ELSE
1701 mult%a = this%a*that%a
1702 mult%b = this%a*that%b+this%b
1703ENDIF
1704
1705END FUNCTION conv_func_mult
1706
1707!> Apply the conversion function \a this to \a values.
1708!! The numerical conversion (only linear at the moment) defined by the
1709!! \a conv_func object \a this is applied to the \a values argument;
1710!! the converted result is stored in place; missing values remain
1711!! missing; if the conversion function is undefined (\a
1712!! conv_func_miss) the values are unchanged. The method is \c
1713!! ELEMENTAL, thus \a values can be also an array of any shape.
1714ELEMENTAL SUBROUTINE conv_func_compute(this, values)
1715TYPE(conv_func),INTENT(in) :: this !< object defining the conversion function
1716REAL,INTENT(inout) :: values !< value to be converted in place
1717
1718IF (this /= conv_func_miss) THEN
1719 IF (c_e(values)) values = values*this%a + this%b
1720ELSE
1721 values=rmiss
1722ENDIF
1723
1724END SUBROUTINE conv_func_compute
1725
1726
1727!> Return a copy of \a values converted by applying the conversion
1728!! function \a this. The numerical conversion (only linear at the
1729!! moment) defined by the \a conv_func object \a this is applied to
1730!! the \a values argument and the converted result is returned;
1731!! missing values remain missing; if the conversion function is
1732!! undefined (\a conv_func_miss) the values are unchanged. The method
1733!! is \c ELEMENTAL, thus \a values can be also an array of any shape.
1734ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
1735TYPE(conv_func),intent(in) :: this !< object defining the conversion function
1736REAL,INTENT(in) :: values !< input value to be converted
1737REAL :: convert
1738
1739convert = values
1740CALL compute(this, convert)
1741
1742END FUNCTION conv_func_convert
1743
1744
1745!> Locate variables which are horizontal components of a vector field.
1746!! This method scans the \a volgrid6d_var array provided and locates
1747!! pairs of variables which are x and y component of the same vector
1748!! field. On exit, the arrays \x xind(:) and \a yind(:) are allocated
1749!! to a size equal to the number of vector fields detected and their
1750!! corresponding elements will point to x and y components of the same
1751!! vector field. If inconsistencies are found, e.g. only one component
1752!! is detected for a field, or more than one input variable define
1753!! the same component, then \a xind and \a xind are nullified, thus an
1754!! error condition can be tested as \c .NOT.ASSOCIATED(xind). If no
1755!! vector fields are found then \a xind and \a xind are allocated to
1756!! zero size. If \a xind and \a yind are \c ASSOCIATED() after return,
1757!! they should be \c DEALLOCATEd by the calling procedure.
1758SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
1759TYPE(volgrid6d_var),INTENT(in) :: this(:) !< array of volgrid6d_var objects (grib variable) to test
1760INTEGER,POINTER :: xind(:), yind(:) !< output arrays of indices pointing to matching horizontal components, allocated by this method
1761
1762TYPE(vol7d_var) :: varbufr(SIZE(this))
1763TYPE(conv_func),POINTER :: c_func(:)
1764INTEGER :: i, nv, counts(SIZE(vol7d_var_horcomp))
1765
1766NULLIFY(xind, yind)
1767counts(:) = 0
1768
1769CALL vargrib2varbufr(this, varbufr, c_func)
1770
1771DO i = 1, SIZE(vol7d_var_horcomp)
1772 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
1773ENDDO
1774
1775IF (any(counts(1::2) > 1)) THEN
1776 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
1777 DEALLOCATE(c_func)
1778 RETURN
1779ENDIF
1780IF (any(counts(2::2) > 1)) THEN
1781 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
1782 DEALLOCATE(c_func)
1783 RETURN
1784ENDIF
1785
1786! check that variables are paired and count pairs
1787nv = 0
1788DO i = 1, SIZE(vol7d_var_horcomp), 2
1789 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
1790 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
1791 ' present but the corresponding x-component '// &
1792 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
1793 RETURN
1794 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
1795 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
1796 ' present but the corresponding y-component '// &
1797 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
1798 RETURN
1799 ENDIF
1800 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
1801ENDDO
1802
1803! repeat the loop storing indices
1804ALLOCATE(xind(nv), yind(nv))
1805nv = 0
1806DO i = 1, SIZE(vol7d_var_horcomp), 2
1807 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
1808 nv = nv + 1
1809 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
1810 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
1811 ENDIF
1812ENDDO
1813DEALLOCATE(c_func)
1814
1815END SUBROUTINE volgrid6d_var_hor_comp_index
1816
1817
1818!> Tests whether a variable is the horizontal component of a vector field.
1819!! Returns \a .TRUE. if the corresponding variable is recognized as an
1820!! horizontal component of a vector field; if it is the case the
1821!! variable may need rotation in case of coordinate change.
1822FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
1823TYPE(volgrid6d_var),INTENT(in) :: this !< volgrid6d_var object (grib variable) to test
1824LOGICAL :: is_hor_comp
1825
1826TYPE(vol7d_var) :: varbufr
1827
1828varbufr = convert(this)
1829is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
1830
1831END FUNCTION volgrid6d_var_is_hor_comp
1832
1833! before unstaggering??
1834
1835!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
1836!
1837!call init(varu,btable="B11003")
1838!call init(varv,btable="B11004")
1839!
1840! test about presence of u and v in standard table
1841!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
1842! call l4f_category_log(this%category,L4F_FATAL, &
1843! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
1844! CALL raise_error()
1845! RETURN
1846!end if
1847!
1848!if (associated(this%var))then
1849! nvar=size(this%var)
1850! allocate(varbufr(nvar),stat=stallo)
1851! if (stallo /=0)then
1852! call l4f_log(L4F_FATAL,"allocating memory")
1853! call raise_fatal_error("allocating memory")
1854! end if
1855!
1856! CALL vargrib2varbufr(this%var, varbufr)
1857!ELSE
1858! CALL l4f_category_log(this%category, L4F_ERROR, &
1859! "trying to destagger an incomplete volgrid6d object")
1860! CALL raise_error()
1861! RETURN
1862!end if
1863!
1864!nvaru=COUNT(varbufr==varu)
1865!nvarv=COUNT(varbufr==varv)
1866!
1867!if (nvaru > 1 )then
1868! call l4f_category_log(this%category,L4F_WARN, &
1869! ">1 variables refer to u wind component, destaggering will not be done ")
1870! DEALLOCATE(varbufr)
1871! RETURN
1872!endif
1873!
1874!if (nvarv > 1 )then
1875! call l4f_category_log(this%category,L4F_WARN, &
1876! ">1 variables refer to v wind component, destaggering will not be done ")
1877! DEALLOCATE(varbufr)
1878! RETURN
1879!endif
1880!
1881!if (nvaru == 0 .and. nvarv == 0) then
1882! call l4f_category_log(this%category,L4F_WARN, &
1883! "no u or v wind component found in volume, nothing to do")
1884! DEALLOCATE(varbufr)
1885! RETURN
1886!endif
1887!
1888!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
1889! call l4f_category_log(this%category,L4F_WARN, &
1890! "there are variables different from u and v wind component in C grid")
1891!endif
1892
1893
1894END MODULE volgrid6d_var_class
Index method.
Apply the conversion function this to values.
Apply the conversion function this to values.
Destructor for the corresponding object, it assigns it to a missing value.
Display on the screen a brief content of object.
Initialize a volgrid6d_var object with the optional arguments provided.
Gestione degli errori.
Utilities for managing files.
This module defines an abstract interface to different drivers for access to files containing gridded...
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.
Class for managing physical variables in a grib 1/2 fashion.
Definisce una variabile meteorologica osservata o un suo attributo.
Class defining a real conversion function between units.
Definition of a physical variable in grib coding style.

Generated with Doxygen.