libsim Versione 7.2.6

◆ display_volgrid6d_var()

subroutine display_volgrid6d_var ( type(volgrid6d_var), intent(in) this)
private

Display on the screen a brief content of volgrid6d_var object.

Parametri
[in]thisvolgrid6d_var object to display

Definizione alla linea 1073 del file volgrid6d_var_class.F90.

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