ECC-1580: Make codes_get_native_type available in Fortran

fortran/eccodes_f90_head.f90

@@ -24,6 +24,16 @@ module eccodes
   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"

fortran/eccodes_f90_tail.f90

@@ -1631,6 +1631,28 @@
     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
@@ -1879,7 +1901,6 @@
     character(len=*), intent(in)                  :: key
     integer(kind=kindOfInt), dimension(:), allocatable, intent(inout) :: value
     integer(kind=kindOfInt), optional, intent(out)     :: status
-
     integer(kind=kindOfInt)                            :: iret
     integer(kind=kindOfInt)                            :: nb_values
     integer(kind=kindOfInt)                            :: size_value
@@ -1933,7 +1954,6 @@
     integer(kind=kindOfLong), dimension(:), allocatable, intent(inout) :: value
     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
@@ -2007,7 +2027,6 @@
     real(kind=kindOfFloat), dimension(:), allocatable, intent(inout) :: value
     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

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

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, &

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

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

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){
 

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);