libsim Versione 7.2.6

◆ vargrib2varbufr()

subroutine, public vargrib2varbufr ( type(volgrid6d_var), dimension(:), intent(in) vargrib,
type(vol7d_var), dimension(:), intent(out) varbufr,
type(conv_func), dimension(:), pointer c_func )

Convert a volgrid6d_var array object into a physically equivalent vol7d_var array object.

This method converts a grib-like array of physical variables vargrib, to an array of unique, physically based, bufr-like variables varbufr. The output array must have enough room for the converted variables. The method additionally allocates a conv_func array object of the same size, which can successively be used to convert the numerical values of the fields associated to vargrib to the corresponding fields in the bufr-like representation. c_func will have to be deallocated by the calling procedure. If a conversion is not successful, the corresponding output variable is set to vol7d_var_miss and the conversion function to conv_func_miss.

Parametri
[in]vargribarray of input grib-like variables
[out]varbufrarray of output bufr-like variables
c_funcpointer to an array of the corresponding conv_func objects, allocated in the method

Definizione alla linea 1093 del file volgrid6d_var_class.F90.

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