diff --git a/fortran/eccodes_f90_head.f90 b/fortran/eccodes_f90_head.f90 index 2373e288c..cd162e0e8 100644 --- a/fortran/eccodes_f90_head.f90 +++ b/fortran/eccodes_f90_head.f90 @@ -17,13 +17,23 @@ module eccodes include "eccodes_visibility.h" include "eccodes_settings.h" - real(8), parameter, public :: CODES_MISSING_DOUBLE = -1.D+100 - integer(4), parameter, public :: CODES_MISSING_LONG = 2147483647 + real(8), parameter, public :: CODES_MISSING_DOUBLE = -1.D+100 + integer(4), parameter, public :: CODES_MISSING_LONG = 2147483647 - integer, parameter, public :: CODES_PRODUCT_ANY = 0 + integer, parameter, public :: CODES_PRODUCT_ANY = 0 integer, parameter, public :: CODES_PRODUCT_GRIB = 1 integer, parameter, public :: CODES_PRODUCT_BUFR = 2 + ! Key types + integer, parameter, public :: CODES_TYPE_UNDEFINED = 0 + integer, parameter, public :: CODES_TYPE_LONG = 1 + integer, parameter, public :: CODES_TYPE_DOUBLE = 2 + integer, parameter, public :: CODES_TYPE_STRING = 3 + integer, parameter, public :: CODES_TYPE_BYTES = 4 + integer, parameter, public :: CODES_TYPE_SECTION = 5 + integer, parameter, public :: CODES_TYPE_LABEL = 6 + integer, parameter, public :: CODES_TYPE_MISSING = 7 + !> Create a new message in memory from an integer or character array containting the coded message. !> !> The message can be accessed through its ID and it will be available\n @@ -100,7 +110,7 @@ module eccodes !> !> \b Examples: \ref grib_nearest.f90 "grib_nearest.f90" !> - !> @param[in] gribid id of the grib loaded in memory + !> @param[in] gribid ID of the GRIB loaded in memory !> @param[in] is_lsm .true. if the nearest land point is required otherwise .false. !> @param[in] inlat latitude of the point in degrees !> @param[in] inlon longitudes of the point in degrees @@ -129,7 +139,7 @@ module eccodes !> !> \b Examples: \ref grib_get_data.f90 "grib_get_data.f90" !> - !> @param[in] gribid id of the grib loaded in memory + !> @param[in] gribid ID of the GRIB loaded in memory !> @param[out] lats latitudes array with dimension "size" !> @param[out] lons longitudes array with dimension "size" !> @param[out] values data values array with dimension "size" diff --git a/fortran/eccodes_f90_tail.f90 b/fortran/eccodes_f90_tail.f90 index a4672d204..7dfdd952a 100644 --- a/fortran/eccodes_f90_tail.f90 +++ b/fortran/eccodes_f90_tail.f90 @@ -1618,19 +1618,41 @@ !> exit with an error message.\n Otherwise the error message can be !> gathered with @ref codes_get_error_string. !> - !> @param msgid id of the message loaded in memory + !> @param msgid id of the message loaded in memory !> @param key key name !> @param value the integer(4) value !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_get_int(msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key integer(kind=kindOfInt), intent(out) :: value integer(kind=kindOfInt), optional, intent(out) :: status call grib_get_int(msgid, key, value, status) end subroutine codes_get_int + + !> Get the native type of a key from a message. + !> + !> In case of error, if the status parameter (optional) is not given, the program will + !> exit with an error message.\n Otherwise the error message can be + !> gathered with @ref grib_get_error_string. + !> + !> @param msgid id of the message loaded in memory + !> @param key key name + !> @param value the type as an integer(4) value + !> @param status GRIB_SUCCESS if OK, integer value on error + subroutine codes_get_native_type(msgid, key, value, status) + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + + call grib_get_native_type(msgid, key, value, status) + end subroutine codes_get_native_type + + !> Get the integer value of a key from a message. !> !> In case of error, if the status parameter (optional) is not given, the program will @@ -1661,9 +1683,9 @@ !> @param is_missing 0->not missing, 1->missing !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_is_missing(msgid, key, is_missing, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(out) :: is_missing + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(out) :: is_missing integer(kind=kindOfInt), optional, intent(out) :: status call grib_is_missing(msgid, key, is_missing, status) @@ -1680,9 +1702,9 @@ !> @param is_defined 0->not defined, 1->defined !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_is_defined(msgid, key, is_defined, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - integer(kind=kindOfInt), intent(out) :: is_defined + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(out) :: is_defined integer(kind=kindOfInt), optional, intent(out) :: status call grib_is_defined(msgid, key, is_defined, status) @@ -1700,9 +1722,9 @@ !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_get_real4(msgid, key, value, status) integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind=kindOfFloat), intent(out) :: value - integer(kind=kindOfInt), optional, intent(out) :: status + character(len=*), intent(in) :: key + real(kind=kindOfFloat), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status call grib_get_real4(msgid, key, value, status) end subroutine codes_get_real4 @@ -1718,10 +1740,10 @@ !> @param value the real(8) value !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_get_real8(msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - real(kind=kindOfDouble), intent(out) :: value - integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + real(kind=kindOfDouble), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status call grib_get_real8(msgid, key, value, status) end subroutine codes_get_real8 @@ -1737,9 +1759,9 @@ !> @param value the character value !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_get_string(msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - character(len=*), intent(out) :: value + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + character(len=*), intent(out) :: value integer(kind=kindOfInt), optional, intent(out) :: status call grib_get_string(msgid, key, value, status) @@ -1757,10 +1779,10 @@ !> @param value string array value !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_get_string_array(msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key character(len=*), dimension(:), allocatable, intent(inout) :: value - integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status character :: cvalue(size(value)*len(value(0))) integer(kind=kindOfInt) :: iret @@ -1802,10 +1824,10 @@ !> @param msgid2 id of the message to which the data are copied !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_bufr_copy_data(msgid1, msgid2, status) - integer(kind=kindOfInt), intent(in) :: msgid1 - integer(kind=kindOfInt), intent(in) :: msgid2 - integer(kind=kindOfInt), optional, intent(out) :: status - integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt), intent(in) :: msgid1 + integer(kind=kindOfInt), intent(in) :: msgid2 + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret iret = codes_f_bufr_copy_data(msgid1, msgid2) @@ -1829,10 +1851,10 @@ !> @param value string array value !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_set_string_array(msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key - character(len=*), dimension(:), allocatable, intent(in) :: value - integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt), intent(in) :: msgid + character(len=*), intent(in) :: key + character(len=*), dimension(:), allocatable, intent(in) :: value + integer(kind=kindOfInt), optional, intent(out) :: status character :: cvalue(size(value)*len(value(0))) character :: svalue(len(value(0))) @@ -1875,11 +1897,10 @@ !> @param value integer(4) array value !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_get_int_array(msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid + integer(kind=kindOfInt), intent(in) :: msgid character(len=*), intent(in) :: key integer(kind=kindOfInt), dimension(:), allocatable, intent(inout) :: value - integer(kind=kindOfInt), optional, intent(out) :: status - + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values integer(kind=kindOfInt) :: size_value @@ -1928,12 +1949,11 @@ !> @param value integer(4) array value !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_get_long_array(msgid, key, value, status) - integer(kind=kindOfInt), intent(in) :: msgid + integer(kind=kindOfInt), intent(in) :: msgid character(len=*), intent(in) :: key integer(kind=kindOfLong), dimension(:), allocatable, intent(inout) :: value - integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values integer(kind=kindOfInt) :: size_value integer(kind=kindOfInt) :: i @@ -2003,11 +2023,10 @@ !> @param status CODES_SUCCESS if OK, integer value on error subroutine codes_get_real4_array(msgid, key, value, status) integer(kind=kindOfInt), intent(in) :: msgid - character(len=*), intent(in) :: key + character(len=*), intent(in) :: key real(kind=kindOfFloat), dimension(:), allocatable, intent(inout) :: value - integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - integer(kind=kindOfInt) :: nb_values integer(kind=kindOfInt) :: size_value integer(kind=kindOfInt) :: i diff --git a/fortran/eccodes_visibility.h b/fortran/eccodes_visibility.h index ad3cf2fbd..0c26a53f7 100644 --- a/fortran/eccodes_visibility.h +++ b/fortran/eccodes_visibility.h @@ -26,6 +26,7 @@ public :: codes_new_from_message, & public :: codes_release public :: codes_dump public :: codes_get_error_string +public :: codes_get_native_type public :: codes_get_api_version public :: codes_get_size public :: codes_get_message_size, codes_copy_message diff --git a/fortran/grib_api_externals.h b/fortran/grib_api_externals.h index 1cafa17c9..d66a89376 100644 --- a/fortran/grib_api_externals.h +++ b/fortran/grib_api_externals.h @@ -36,6 +36,7 @@ integer, external :: grib_f_new_from_message, & integer, external :: grib_f_release integer, external :: grib_f_dump, grib_f_print integer, external :: grib_f_get_error_string +integer, external :: grib_f_get_native_type integer, external :: grib_f_get_size_int,grib_f_get_size_long integer, external :: grib_f_get_data_real4,grib_f_get_data_real8 integer, external :: grib_f_get_int, grib_f_get_long,grib_f_get_int_array, & diff --git a/fortran/grib_api_visibility.h b/fortran/grib_api_visibility.h index ad34358ad..bf3e90654 100644 --- a/fortran/grib_api_visibility.h +++ b/fortran/grib_api_visibility.h @@ -16,6 +16,7 @@ public :: grib_new_from_message, & public :: grib_release public :: grib_dump public :: grib_get_error_string +public :: grib_get_native_type public :: grib_get_size public :: grib_get_message_size, grib_copy_message public :: grib_write, grib_multi_append diff --git a/fortran/grib_f90_tail.f90 b/fortran/grib_f90_tail.f90 index afc5628a9..f4424565b 100644 --- a/fortran/grib_f90_tail.f90 +++ b/fortran/grib_f90_tail.f90 @@ -1896,6 +1896,35 @@ end if end subroutine grib_get_long + + !> Get the native type of a key from a message. + !> + !> In case of error, if the status parameter (optional) is not given, the program will + !> exit with an error message.\n Otherwise the error message can be + !> gathered with @ref grib_get_error_string. + !> + !> @param gribid id of the message loaded in memory + !> @param key key name + !> @param value the type as an integer(4) value + !> @param status GRIB_SUCCESS if OK, integer value on error + subroutine grib_get_native_type(gribid, key, value, status) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + integer(kind=kindOfInt), intent(out) :: value + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + + iret = grib_f_get_native_type(gribid, key, value) + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + end if + if (present(status)) then + status = iret + else + call grib_check(iret, 'get_native_type', key) + end if + end subroutine grib_get_native_type + !> Check if the value of a key is MISSING. !> !> In case of error, if the status parameter (optional) is not given, the program will diff --git a/fortran/grib_fortran.c b/fortran/grib_fortran.c index f4160d341..976eaa2ce 100644 --- a/fortran/grib_fortran.c +++ b/fortran/grib_fortran.c @@ -2305,6 +2305,7 @@ int grib_f_get_int__(int* gid, char* key, int* val, int len){ int grib_f_get_int(int* gid, char* key, int* val, int len){ return grib_f_get_int_( gid, key, val, len); } + int grib_f_get_long_(int* gid, char* key, long* val, int len){ grib_handle *h = get_handle(*gid); int err = GRIB_SUCCESS; @@ -2321,6 +2322,25 @@ int grib_f_get_long(int* gid, char* key, long* val, int len){ return grib_f_get_long_( gid, key, val, len); } +/*****************************************************************************/ +int grib_f_get_native_type_(int* gid, char* key, int* val, int len){ + grib_handle *h = get_handle(*gid); + int type_val = 0; + int err = GRIB_SUCCESS; + char buf[1024]; + + if(!h) return GRIB_INVALID_GRIB; + err = grib_get_native_type(h, cast_char(buf,key,len), &type_val); + *val = type_val; + return err; +} +int grib_f_get_native_type__(int* gid, char* key, int* val, int len){ + return grib_f_get_native_type_( gid, key, val, len); +} +int grib_f_get_native_type(int* gid, char* key, int* val, int len){ + return grib_f_get_native_type_( gid, key, val, len); +} + /*****************************************************************************/ int grib_f_get_int_array_(int* gid, char* key, int *val, int* size, int len){ diff --git a/fortran/grib_fortran_prototypes.h b/fortran/grib_fortran_prototypes.h index a6acd5b27..a8e399924 100644 --- a/fortran/grib_fortran_prototypes.h +++ b/fortran/grib_fortran_prototypes.h @@ -228,6 +228,11 @@ int grib_f_get_int(int *gid, char *key, int *val, int len); int grib_f_get_long_(int *gid, char *key, long *val, int len); int grib_f_get_long__(int *gid, char *key, long *val, int len); int grib_f_get_long(int *gid, char *key, long *val, int len); + +int grib_f_get_native_type_(int* gid, char* key, int* val, int len); +int grib_f_get_native_type__(int* gid, char* key, int* val, int len); +int grib_f_get_native_type(int* gid, char* key, int* val, int len); + int grib_f_get_int_array_(int *gid, char *key, int *val, int *size, int len); int grib_f_get_int_array__(int *gid, char *key, int *val, int *size, int len); int grib_f_get_int_array(int *gid, char *key, int *val, int *size, int len);