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 @@ 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 @@ 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) -{ - /* 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_(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 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);