diff --git a/fortran/grib_api_externals.h b/fortran/grib_api_externals.h index 496143c1b..69648162f 100644 --- a/fortran/grib_api_externals.h +++ b/fortran/grib_api_externals.h @@ -21,7 +21,9 @@ 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_samples, & + grib_f_new_from_message_no_copy, & + 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, & @@ -76,7 +78,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..c9a059c43 100644 --- a/fortran/grib_f90_head.f90 +++ b/fortran/grib_f90_head.f90 @@ -41,6 +41,25 @@ 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_int4 + 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..91e1351b6 100644 --- a/fortran/grib_f90_tail.f90 +++ b/fortran/grib_f90_tail.f90 @@ -1370,6 +1370,67 @@ 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 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 @@ -2797,6 +2858,36 @@ 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_PTR, 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(:) + 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 (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..eedf991bb 100644 --- a/fortran/grib_fortran.cc +++ b/fortran/grib_fortran.cc @@ -895,6 +895,21 @@ 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; + int iret = 0; + grib_handle *h = get_handle(*gid); + if (!h) return GRIB_INVALID_GRIB; + iret = grib_get_message(h,&message,mess_len); + if(iret != 0){ + return iret; + } + *mess = message; + return GRIB_SUCCESS; +} + /*****************************************************************************/ int grib_f_read_file_(int* fid, void* buffer, size_t* nbytes) @@ -1357,6 +1372,7 @@ 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) @@ -1364,7 +1380,26 @@ 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) +{ + 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; +} + /*****************************************************************************/ +int grib_f_new_from_message_no_copy_int_(int* gid, int* buffer, size_t* 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 8fb2f240f..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); @@ -91,6 +92,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 +297,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);