core
/
eccodes
mirror of https://github.com/ecmwf/eccodes.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

ECC-1580: Make codes_get_native_type available in Fortran

This commit is contained in:
Shahram Najm 2023-05-04 22:19:47 +01:00 committed by shahramn
parent 352cdf49ed
commit 276cc91604
8 changed files with 130 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
fortran/eccodes_f90_head.f90
View File

@ -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"

97
fortran/eccodes_f90_tail.f90
View File

@ -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

1
fortran/eccodes_visibility.h
View File

@ -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

1
fortran/grib_api_externals.h
View File

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

1
fortran/grib_api_visibility.h
View File

@ -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

29
fortran/grib_f90_tail.f90
View File

@ -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

20
fortran/grib_fortran.c
View File

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

5
fortran/grib_fortran_prototypes.h
View File

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