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