ECC-1580: Make codes_get_native_type available in Fortran

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
+  real(8),    parameter, public :: CODES_MISSING_DOUBLE = -1.D+100
-  integer(4), parameter, public :: CODES_MISSING_LONG = 2147483647
+  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"

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
+    integer(kind=kindOfInt), intent(in)     :: msgid
-    character(len=*), intent(in)                  :: key
+    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
+    integer(kind=kindOfInt), intent(in)            :: msgid
-    character(len=*), intent(in)                  :: key
+    character(len=*), intent(in)                   :: key
-    integer(kind=kindOfInt), intent(out)    :: is_missing
+    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
+    integer(kind=kindOfInt), intent(in)            :: msgid
-    character(len=*), intent(in)                  :: key
+    character(len=*), intent(in)                   :: key
-    integer(kind=kindOfInt), intent(out)    :: is_defined
+    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
+    character(len=*), intent(in)                    :: key
-    real(kind=kindOfFloat), intent(out)            :: value
+    real(kind=kindOfFloat), intent(out)             :: value
-    integer(kind=kindOfInt), optional, intent(out)            :: status
+    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
+    integer(kind=kindOfInt), intent(in)             :: msgid
-    character(len=*), intent(in)      :: key
+    character(len=*), intent(in)                    :: key
-    real(kind=kindOfDouble), intent(out)     :: value
+    real(kind=kindOfDouble), intent(out)            :: value
-    integer(kind=kindOfInt), optional, intent(out)     :: status
+    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
+    integer(kind=kindOfInt), intent(in)            :: msgid
-    character(len=*), intent(in)  :: key
+    character(len=*), intent(in)                   :: key
-    character(len=*), intent(out) :: value
+    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
+    integer(kind=kindOfInt), intent(in)                        :: msgid
-    character(len=*), intent(in)                        :: key
+    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)             :: msgid1
-    integer(kind=kindOfInt), intent(in)  :: msgid2
+    integer(kind=kindOfInt), intent(in)             :: msgid2
-    integer(kind=kindOfInt), optional, intent(out)      :: status
+    integer(kind=kindOfInt), optional, intent(out)  :: status
-    integer(kind=kindOfInt)                            :: iret
+    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
+    integer(kind=kindOfInt), intent(in)                     :: msgid
-    character(len=*), intent(in)   :: key
+    character(len=*), intent(in)                            :: key
-    character(len=*), dimension(:), allocatable, intent(in)   :: value
+    character(len=*), dimension(:), allocatable, intent(in) :: value
-    integer(kind=kindOfInt), optional, intent(out)  :: status
+    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

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