From 2010ae973f6769b86e34e1d4914a6dc8fbc4d2d7 Mon Sep 17 00:00:00 2001 From: plesskem Date: Wed, 6 Nov 2024 17:42:11 +0000 Subject: [PATCH 1/3] added get message, new from message without memcpy to fortran interface --- fortran/grib_api_externals.h | 3 +- fortran/grib_api_visibility.h | 4 +- fortran/grib_f90_head.f90 | 18 +++++++++ fortran/grib_f90_tail.f90 | 66 +++++++++++++++++++++++++++++++ fortran/grib_fortran.cc | 23 +++++++++++ fortran/grib_fortran_prototypes.h | 6 +++ 6 files changed, 117 insertions(+), 3 deletions(-) diff --git a/fortran/grib_api_externals.h b/fortran/grib_api_externals.h index 496143c1b..84b8765ef 100644 --- a/fortran/grib_api_externals.h +++ b/fortran/grib_api_externals.h @@ -21,6 +21,7 @@ integer, external :: grib_f_keys_iterator_get_name, & grib_f_keys_iterator_rewind integer, external :: grib_f_new_from_message, & grib_f_new_from_message_int, & + grib_f_new_from_message_no_copy, & grib_f_new_from_samples, & codes_bufr_f_new_from_samples, & grib_f_read_any_from_file, & @@ -76,7 +77,7 @@ integer, external :: grib_f_set_int, grib_f_set_int_array, & grib_f_gribex_mode_on,grib_f_gribex_mode_off, & codes_f_bufr_multi_element_constant_arrays_on,codes_f_bufr_multi_element_constant_arrays_off, & grib_f_find_nearest_single,grib_f_find_nearest_four_single,grib_f_find_nearest_multiple -integer, external :: grib_f_get_message_size, grib_f_copy_message, grib_f_count_in_file +integer, external :: grib_f_get_message_size, grib_f_copy_message, grib_f_get_message, grib_f_count_in_file integer, external :: grib_f_write, grib_f_multi_write, grib_f_multi_append integer, external :: grib_f_clone, grib_f_copy_namespace external :: grib_f_check , grib_f_set_debug, grib_f_set_data_quality_checks diff --git a/fortran/grib_api_visibility.h b/fortran/grib_api_visibility.h index bf3e90654..7502e18f3 100644 --- a/fortran/grib_api_visibility.h +++ b/fortran/grib_api_visibility.h @@ -10,7 +10,7 @@ public :: grib_skip_computed, & grib_skip_read_only public :: grib_keys_iterator_get_name, & grib_keys_iterator_rewind -public :: grib_new_from_message, & +public :: grib_new_from_message, grib_new_from_message_no_copy, & grib_new_from_samples, grib_new_from_file, & grib_read_from_file,grib_headers_only_new_from_file public :: grib_release @@ -18,7 +18,7 @@ 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_get_message_size, grib_get_message, grib_copy_message public :: grib_write, grib_multi_append public :: grib_check public :: grib_clone, grib_copy_namespace diff --git a/fortran/grib_f90_head.f90 b/fortran/grib_f90_head.f90 index ee3eebdab..fed1f0c22 100644 --- a/fortran/grib_f90_head.f90 +++ b/fortran/grib_f90_head.f90 @@ -41,6 +41,24 @@ module grib_api module procedure grib_new_from_message_int4 module procedure grib_new_from_message_char end interface grib_new_from_message + + + !> Create a message pointing to an character array containting the coded message. + !> + !> The message can be accessed through its gribid and it will be available\n + !> until @ref grib_release is called or (attention) the character array is deallocated! + !> + !> 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 grib loaded in memory + !> @param message array containing the coded message + !> @param status GRIB_SUCCESS if OK, integer value on error + interface grib_new_from_message_no_copy + module procedure grib_new_from_message_no_copy_char + end interface grib_new_from_message_no_copy + !> Get a value of specified index from an array key. !> diff --git a/fortran/grib_f90_tail.f90 b/fortran/grib_f90_tail.f90 index 385c93b9e..e02d9fb01 100644 --- a/fortran/grib_f90_tail.f90 +++ b/fortran/grib_f90_tail.f90 @@ -1370,6 +1370,36 @@ subroutine grib_new_from_message_char(gribid, message, status) end subroutine grib_new_from_message_char + + !> Create a message pointing to an character array containting the coded message. + !> + !> The message can be accessed through its gribid and it will be available\n + !> until @ref grib_release is called or (attention) the character array is deallocated! + !> + !> 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 grib loaded in memory + !> @param message array containing the coded message + !> @param status GRIB_SUCCESS if OK, integer value on error + + subroutine grib_new_from_message_no_copy_char(gribid, message, status) + integer(kind=kindOfInt), intent(out) :: gribid + character(len=1), dimension(:), intent(in) :: message + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: size_bytes + integer(kind=kindOfInt) :: iret + + size_bytes = size(message, dim=1) + iret = grib_f_new_from_message_no_copy(gribid, message, size_bytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'new_from_message_no_copy_char', '') + end if + + end subroutine grib_new_from_message_no_copy_char !> Create a new message in memory from an integer array containting the coded message. !> !> The message can be accessed through its gribid and it will be available\n @@ -2797,6 +2827,42 @@ subroutine grib_copy_message(gribid, message, status) end if end subroutine grib_copy_message + !> Get pointer to message and message length from the grib_handle. + !> Be careful, user has to manage deallocation via pointer or handle! + !> 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 message array containing the coded message + !> @param mess_len length of the message + !> @param status GRIB_SUCCESS if OK, integer value on error + subroutine grib_get_message(gribid, message, mess_len, status) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT,C_PTR, C_CHAR, C_F_POINTER + implicit none + integer(kind=kindOfInt), intent(in) :: gribid + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfInt) :: iret + character(len=1), pointer, intent(out) :: message(:) !data in handle is read in C with unsigned chars + type(C_PTR) :: mess_ptr + integer(kind=kindOfInt), intent(out) :: mess_len + integer(C_INT) :: nbytes=0 + + mess_len = 0 + iret = grib_f_get_message(gribid, mess_ptr, nbytes) + mess_len = nbytes + call C_F_POINTER(mess_ptr, message,(/nbytes/)) + if(.not. associated(message)) then + write(0,*) 'ERROR: Pointer was not associated' + endif + if (present(status)) then + status = iret + else + call grib_check(iret, 'get_message', '') + end if + end subroutine grib_get_message + + !> Write the coded message to a file. !> !> In case of error, if the status parameter (optional) is not given, the program will diff --git a/fortran/grib_fortran.cc b/fortran/grib_fortran.cc index 7ea9b6319..cc00764af 100644 --- a/fortran/grib_fortran.cc +++ b/fortran/grib_fortran.cc @@ -895,6 +895,17 @@ int grib_f_write_file_(int* fid, void* buffer, size_t* nbytes) return GRIB_INVALID_FILE; } } +/*****************************************************************************/ +int grib_f_get_message_(int* gid, const void** mess, size_t* mess_len) +{ + void *message = NULL; + grib_handle *h = get_handle(*gid); + if (!h) return GRIB_INVALID_GRIB; + grib_get_message(h,&message,mess_len); + *mess = message; + return GRIB_SUCCESS; +} + /*****************************************************************************/ int grib_f_read_file_(int* fid, void* buffer, size_t* nbytes) @@ -1357,6 +1368,18 @@ int grib_f_new_from_message_(int* gid, void* buffer, size_t* bufsize) *gid = -1; return GRIB_INTERNAL_ERROR; } +/*****************************************************************************/ +int grib_f_new_from_message_no_copy_(int* gid, void* buffer, size_t* bufsize) +{ + grib_handle *h = NULL; + h = grib_handle_new_from_message(0, buffer, *bufsize); + if (h){ + push_handle(h,gid); + return GRIB_SUCCESS; + } + *gid = -1; + return GRIB_INTERNAL_ERROR; +} /* See SUP-3893: Need to provide an 'int' version */ int grib_f_new_from_message_int_(int* gid, int* buffer , size_t* bufsize) diff --git a/fortran/grib_fortran_prototypes.h b/fortran/grib_fortran_prototypes.h index 8fb2f240f..93bff8606 100644 --- a/fortran/grib_fortran_prototypes.h +++ b/fortran/grib_fortran_prototypes.h @@ -91,6 +91,9 @@ int grib_f_keys_iterator_rewind(int *kiter); int grib_f_new_from_message_(int *gid, void *buffer, size_t *bufsize); int grib_f_new_from_message__(int *gid, void *buffer, size_t *bufsize); int grib_f_new_from_message(int *gid, void *buffer, size_t *bufsize); +int grib_f_new_from_message_no_copy_(int *gid, void *buffer, size_t *bufsize); +int grib_f_new_from_message_no_copy__(int *gid, void *buffer, size_t *bufsize); +int grib_f_new_from_message_no_copy(int *gid, void *buffer, size_t *bufsize); int grib_f_new_from_message_copy_(int *gid, void *buffer, size_t *bufsize); int grib_f_new_from_message_copy__(int *gid, void *buffer, size_t *bufsize); int grib_f_new_from_message_copy(int *gid, void *buffer, size_t *bufsize); @@ -293,6 +296,9 @@ int grib_f_get_message_size(int *gid, size_t *len); int grib_f_copy_message_(int *gid, void *mess, size_t *len); int grib_f_copy_message__(int *gid, void *mess, size_t *len); int grib_f_copy_message(int *gid, void *mess, size_t *len); +int grib_f_get_message(int *gid, const void **mess, size_t *len); +int grib_f_get_message_(int *gid, const void **mess, size_t *len); +int grib_f_get_message__(int *gid, const void **mess, size_t *len); void grib_f_check_(int *err, char *call, char *str, int lencall, int lenstr); void grib_f_check__(int *err, char *call, char *key, int lencall, int lenkey); void grib_f_check(int *err, char *call, char *key, int lencall, int lenkey); From 7b13509a69579377d7037ef6ebdb4c1c619b2678 Mon Sep 17 00:00:00 2001 From: plesskem Date: Thu, 7 Nov 2024 11:01:00 +0000 Subject: [PATCH 2/3] removed debugging leftovers --- fortran/grib_f90_tail.f90 | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/fortran/grib_f90_tail.f90 b/fortran/grib_f90_tail.f90 index e02d9fb01..ffea25839 100644 --- a/fortran/grib_f90_tail.f90 +++ b/fortran/grib_f90_tail.f90 @@ -2838,7 +2838,7 @@ end subroutine grib_copy_message !> @param mess_len length of the message !> @param status GRIB_SUCCESS if OK, integer value on error subroutine grib_get_message(gribid, message, mess_len, status) - USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT,C_PTR, C_CHAR, C_F_POINTER + USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_PTR, C_F_POINTER implicit none integer(kind=kindOfInt), intent(in) :: gribid integer(kind=kindOfInt), optional, intent(out) :: status @@ -2846,15 +2846,12 @@ subroutine grib_get_message(gribid, message, mess_len, status) character(len=1), pointer, intent(out) :: message(:) !data in handle is read in C with unsigned chars type(C_PTR) :: mess_ptr integer(kind=kindOfInt), intent(out) :: mess_len - integer(C_INT) :: nbytes=0 - - mess_len = 0 - iret = grib_f_get_message(gribid, mess_ptr, nbytes) - mess_len = nbytes - call C_F_POINTER(mess_ptr, message,(/nbytes/)) - if(.not. associated(message)) then - write(0,*) 'ERROR: Pointer was not associated' - endif + + iret = grib_f_get_message(gribid, mess_ptr, mess_len) + call C_F_POINTER(mess_ptr, message,(/mess_len/)) + !if(.not. associated(message)) then + ! write(0,*) 'ERROR: Pointer was not associated' + !endif if (present(status)) then status = iret else From 04e139e9f5dbaae5d9e3469deef22550fb512a0c Mon Sep 17 00:00:00 2001 From: plesskem Date: Wed, 18 Dec 2024 14:24:15 +0000 Subject: [PATCH 3/3] added new_from_message_no_copy_int4 to the fortran grib api --- fortran/grib_api_externals.h | 3 ++- fortran/grib_f90_head.f90 | 1 + fortran/grib_f90_tail.f90 | 36 +++++++++++++++++++++++++++---- fortran/grib_fortran.cc | 24 +++++++++++++++------ fortran/grib_fortran_prototypes.h | 1 + 5 files changed, 54 insertions(+), 11 deletions(-) diff --git a/fortran/grib_api_externals.h b/fortran/grib_api_externals.h index 84b8765ef..69648162f 100644 --- a/fortran/grib_api_externals.h +++ b/fortran/grib_api_externals.h @@ -22,7 +22,8 @@ integer, external :: grib_f_keys_iterator_get_name, & integer, external :: grib_f_new_from_message, & grib_f_new_from_message_int, & grib_f_new_from_message_no_copy, & - grib_f_new_from_samples, & + grib_f_new_from_message_no_copy_int, & + grib_f_new_from_samples, & codes_bufr_f_new_from_samples, & grib_f_read_any_from_file, & any_f_new_from_file, & diff --git a/fortran/grib_f90_head.f90 b/fortran/grib_f90_head.f90 index fed1f0c22..c9a059c43 100644 --- a/fortran/grib_f90_head.f90 +++ b/fortran/grib_f90_head.f90 @@ -56,6 +56,7 @@ module grib_api !> @param message array containing the coded message !> @param status GRIB_SUCCESS if OK, integer value on error interface grib_new_from_message_no_copy + module procedure grib_new_from_message_no_copy_int4 module procedure grib_new_from_message_no_copy_char end interface grib_new_from_message_no_copy diff --git a/fortran/grib_f90_tail.f90 b/fortran/grib_f90_tail.f90 index ffea25839..91e1351b6 100644 --- a/fortran/grib_f90_tail.f90 +++ b/fortran/grib_f90_tail.f90 @@ -1400,6 +1400,37 @@ subroutine grib_new_from_message_no_copy_char(gribid, message, status) end if end subroutine grib_new_from_message_no_copy_char + + !> Create a message pointing to an integer4 array containting the coded message. + !> + !> The message can be accessed through its gribid and it will be available\n + !> until @ref grib_release is called or (attention) the character array is deallocated! + !> + !> 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 grib loaded in memory + !> @param message array containing the coded message + !> @param status GRIB_SUCCESS if OK, integer value on error + + subroutine grib_new_from_message_no_copy_int4(gribid, message, status) + integer(kind=kindOfInt), intent(out) :: gribid + integer(kind=4), dimension(:), intent(in) :: message + integer(kind=kindOfInt), optional, intent(out) :: status + integer(kind=kindOfSize_t) :: size_bytes + integer(kind=kindOfInt) :: iret + + size_bytes = size(message, dim=1)*sizeOfInteger4 + iret = grib_f_new_from_message_no_copy_int(gribid, message, size_bytes) + if (present(status)) then + status = iret + else + call grib_check(iret, 'new_from_message_no_copy_int', '') + end if + + end subroutine grib_new_from_message_no_copy_int4 + !> Create a new message in memory from an integer array containting the coded message. !> !> The message can be accessed through its gribid and it will be available\n @@ -2843,15 +2874,12 @@ subroutine grib_get_message(gribid, message, mess_len, status) integer(kind=kindOfInt), intent(in) :: gribid integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret - character(len=1), pointer, intent(out) :: message(:) !data in handle is read in C with unsigned chars + character(len=1), pointer, intent(out) :: message(:) type(C_PTR) :: mess_ptr integer(kind=kindOfInt), intent(out) :: mess_len iret = grib_f_get_message(gribid, mess_ptr, mess_len) call C_F_POINTER(mess_ptr, message,(/mess_len/)) - !if(.not. associated(message)) then - ! write(0,*) 'ERROR: Pointer was not associated' - !endif if (present(status)) then status = iret else diff --git a/fortran/grib_fortran.cc b/fortran/grib_fortran.cc index cc00764af..eedf991bb 100644 --- a/fortran/grib_fortran.cc +++ b/fortran/grib_fortran.cc @@ -899,9 +899,13 @@ int grib_f_write_file_(int* fid, void* buffer, size_t* nbytes) int grib_f_get_message_(int* gid, const void** mess, size_t* mess_len) { void *message = NULL; + int iret = 0; grib_handle *h = get_handle(*gid); if (!h) return GRIB_INVALID_GRIB; - grib_get_message(h,&message,mess_len); + iret = grib_get_message(h,&message,mess_len); + if(iret != 0){ + return iret; + } *mess = message; return GRIB_SUCCESS; } @@ -1368,6 +1372,15 @@ int grib_f_new_from_message_(int* gid, void* buffer, size_t* bufsize) *gid = -1; return GRIB_INTERNAL_ERROR; } +/*****************************************************************************/ + +/* See SUP-3893: Need to provide an 'int' version */ +int grib_f_new_from_message_int_(int* gid, int* buffer , size_t* bufsize) +{ + /* Call the version with void pointer */ + return grib_f_new_from_message_(gid, (void*)buffer, bufsize); +} + /*****************************************************************************/ int grib_f_new_from_message_no_copy_(int* gid, void* buffer, size_t* bufsize) { @@ -1381,13 +1394,12 @@ int grib_f_new_from_message_no_copy_(int* gid, void* buffer, size_t* bufsize) return GRIB_INTERNAL_ERROR; } -/* See SUP-3893: Need to provide an 'int' version */ -int grib_f_new_from_message_int_(int* gid, int* buffer , size_t* bufsize) +/*****************************************************************************/ +int grib_f_new_from_message_no_copy_int_(int* gid, int* buffer, size_t* bufsize) { - /* Call the version with void pointer */ - return grib_f_new_from_message_(gid, (void*)buffer, bufsize); + return grib_f_new_from_message_no_copy_(gid, (void*)buffer, bufsize); } -/*****************************************************************************/ + #if 0 int grib_f_new_from_message_copy_(int* gid, void* buffer, size_t* bufsize) { diff --git a/fortran/grib_fortran_prototypes.h b/fortran/grib_fortran_prototypes.h index 93bff8606..a3a69e054 100644 --- a/fortran/grib_fortran_prototypes.h +++ b/fortran/grib_fortran_prototypes.h @@ -21,6 +21,7 @@ int grib_f_get_string_array_(int* gid, char* key, char* val,int* nvals,int* slen int codes_f_bufr_keys_iterator_rewind_(int* kiter); int any_f_scan_file_(int* fid, int* n); int grib_f_new_from_message_int_(int* gid, int* buffer , size_t* bufsize); +int grib_f_new_from_message_no_copy_int_(int* gid, int* buffer , size_t* bufsize); int grib_f_copy_key_(int* gidsrc, char* key, int* giddest, int len); int grib_f_set_samples_path_(char* path, int len);