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

GRIB-334: Fortran interface lacks support for byte arrays

This commit is contained in:
Shahram Najm 2013-04-10 17:53:17 +01:00
parent abeb369252
commit 5c281acd46
9 changed files with 255 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
examples/F90/Makefile.am
View File

@ -3,12 +3,12 @@ AM_CFLAGS = @WARN_PEDANTIC@ @WERROR@ @FORCE_32_CFLAGS@
TESTS = copy_message.sh get.sh get_data.sh get_pl.sh get_pv.sh keys_iterator.sh \
nearest.sh precision.sh multi_write.sh multi.sh print_data.sh set.sh set_bitmap.sh set_missing.sh \
set_pv.sh samples.sh count_messages.sh read_message.sh index.sh
set_pv.sh samples.sh count_messages.sh read_message.sh index.sh get_set_uuid.sh
noinst_PROGRAMS = index copy_message get get_data get_pl get_pv keys_iterator \
multi_write multi nearest precision print_data set set_bitmap set_missing \
set_pv samples count_messages read_message read_from_file new_from_file \
copy_namespace
copy_namespace get_set_uuid
index_SOURCES=index.f90
copy_message_SOURCES=copy_message.f90
@ -32,6 +32,7 @@ read_message_SOURCES=read_message.f90
read_from_file_SOURCES=read_from_file.f90
new_from_file_SOURCES=new_from_file.f90
copy_namespace_SOURCES=copy_namespace.f90
get_set_uuid_SOURCES=get_set_uuid.f90
INCLUDES = -I$(top_builddir)/src

100
examples/F90/get_set_uuid.f90 Normal file
View File

@ -0,0 +1,100 @@
! Copyright 2013 ECMWF.
!
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
!
! In applying this licence, ECMWF does not waive the privileges and immunities granted to it by
! virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
!
!
! Description: get/set byte array in a grib2 message, using the uuid as example.
!
! Original authors: Harald Anlauf, Doerte Liermann (DWD), Luis Kornblueh (MPIfM).
!
program get_set_uuid
use grib_api
implicit none
integer :: infile, outfile
integer :: igrib, ogrib
integer :: count1, i, iret, nvg, ffs, length
character(len=1) :: uuid_in (16) ! Array of 16 bytes for uuid on input.
character(len=1) :: uuid_out(16) ! Array of 16 bytes for uuid on output.
character(len=32) :: uuid_string ! Human-readable uuid.
character(len=32) :: uuid_string_expected ! Expected UUID of input
call grib_open_file (infile, '../../data/test_uuid.grib2','r')
call grib_open_file (outfile, 'out_uuid.grib2','w')
! Load first grib message from file
! igrib is the grib id to be used in subsequent calls
call grib_new_from_file (infile, igrib, iret)
uuid_string_expected = '08b1e836bc6911e1951fb51b5624ad8d'
count1 = 0
do while (iret/=GRIB_END_OF_FILE)
count1 = count1 + 1
print *, "### Record:", count1
call grib_get(igrib,'typeOfFirstFixedSurface',ffs)
print *, 'typeOfFirstFixedSurface =', ffs
if (ffs /= 150) then
print *, "Unexpected typeOfFirstFixedSurface (must be 150)."
stop
end if
call grib_get (igrib,'numberOfVGridUsed',nvg)
print *, 'numberOfVGridUsed =',nvg
! call grib_get (igrib,'uuidOfVGrid',uuid_in) ! Assuming length is ok.
call grib_get (igrib,'uuidOfVGrid',uuid_in,length=length)
if (length /= 16) then
print *, "Sorry, bad length of byte_array:", length, ". Expected: 16"
stop
end if
! Convert byte array to hexadecimal string for printing
do i = 1, size (uuid_in)
uuid_string(2*i-1:2*i) = byte2hex(uuid_in(i))
end do
print *, "uuidOfVGrid (on input) = ", uuid_string
if (uuid_string .ne. uuid_string_expected) then
print *, "Sorry, bad value of byte_array. Expected: ", uuid_string_expected
stop
end if
call grib_clone (igrib,ogrib)
! On output we write a modified uuid (here the input is simply reversed)
uuid_out(1:16) = uuid_in(16:1:-1)
call grib_set (ogrib,'uuidOfVGrid',uuid_out)
call grib_write (ogrib,outfile)
call grib_release (igrib)
call grib_release (ogrib)
call grib_new_from_file (infile, igrib, iret)
end do
call grib_close_file (infile)
call grib_close_file (outfile)
contains
! Convert single byte to 'hexadecimal' string
pure function byte2hex (c) result (hex)
character(len=1), intent(in) :: c
character(len=2) :: hex
integer :: x
x = iachar (c)
hex(1:1) = nibble ( x / 16)
hex(2:2) = nibble (iand (x, 15))
end function byte2hex
! Convert 'nibble' to 'hexadecimal'
pure function nibble (x)
integer, intent(in) :: x
character :: nibble
select case (x)
case (0:9)
nibble = achar (iachar ('0') + x)
case default
nibble = achar (iachar ('a') - 10 + x)
end select
end function nibble
end program get_set_uuid

27
examples/F90/get_set_uuid.sh Executable file
View File

@ -0,0 +1,27 @@
#!/bin/sh
# Copyright 2005-2012 ECMWF.
#
# This software is licensed under the terms of the Apache Licence Version 2.0
# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
#
# In applying this licence, ECMWF does not waive the privileges and immunities granted to it by
# virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
. ./include.sh
uuid=`${tools_dir}/grib_get -w count=1 -p uuidOfVGrid:s ${data_dir}/test_uuid.grib2`
[ "$uuid" = "08b1e836bc6911e1951fb51b5624ad8d" ]
# This reads the file in data/test_uuid.grib2 and creates test_uuid.grib2
${examples_dir}get_set_uuid > /dev/null
# Check output was written
output=out_uuid.grib2
[ -f "$output" ]
uuid=`${tools_dir}/grib_get -w count=1 -p uuidOfVGrid:s $output`
[ "$uuid" = "8dad24561bb51f95e11169bc36e8b108" ]
rm -f $output

2
fortran/grib_api_externals.h
View File

@ -27,6 +27,7 @@ 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, &
grib_f_get_long_array,grib_f_get_real4,&
grib_f_get_real4_array, &
grib_f_get_byte_array,&
grib_f_get_real8, grib_f_get_real8_array, &
grib_f_get_real4_element, grib_f_get_real8_element, &
grib_f_get_real4_elements, grib_f_get_real8_elements, &
@ -50,6 +51,7 @@ integer, external :: grib_f_new_from_index, &
integer, external :: grib_f_set_int, grib_f_set_int_array, &
grib_f_set_long, grib_f_set_long_array, &
grib_f_set_byte_array, &
grib_f_set_real4, grib_f_set_real4_array, &
grib_f_set_real8, grib_f_set_real8_array, &
grib_f_set_string, grib_f_set_missing, &

74
fortran/grib_f90.f90.tail
View File

@ -1738,6 +1738,44 @@
endif
end subroutine grib_get_long_array
!> Get the array of bytes (character) for a key from a grib 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 grib loaded in memory
!> @param key key name
!> @param value character(len=1) array of byte values
!> @param length (optional) output: number of values retrieved
!> @param status (optional) GRIB_SUCCESS if OK, integer value on error
subroutine grib_get_byte_array ( gribid, key, value, length, status )
integer(kind=kindOfInt), intent(in) :: gribid
character(len=*), intent(in) :: key
character(len=1), dimension(:), intent(out) :: value
integer(kind=kindOfInt), optional, intent(out) :: length
integer(kind=kindOfInt), optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
integer(kind=kindOfInt) :: nb_values
character :: bytes(size(value))
nb_values = size (value)
bytes = ACHAR(0)
iret = grib_f_get_byte_array ( gribid, key, bytes, nb_values )
value = transfer (bytes, value)
if (iret /= 0) then
call grib_f_write_on_fail(gribid)
endif
if (present(length)) then
length = nb_values
end if
if (present(status)) then
status = iret
else
call grib_check(iret,'grib_get',key)
endif
end subroutine grib_get_byte_array
!> Get the real(4) array of values for a key from a grib message.
!>
!> In case of error, if the status parameter (optional) is not given, the program will
@ -2095,6 +2133,42 @@
end subroutine grib_set_long_array
!> Set the array of bytes (character) for a key in a grib 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 grib loaded in memory
!> @param key key name
!> @param value character(len=1) array of byte values
!> @param length (optional) output: number of values written
!> @param status (optional) GRIB_SUCCESS if OK, integer value on error
subroutine grib_set_byte_array ( gribid, key, value, length, status )
integer(kind=kindOfInt), intent(in) :: gribid
character(len=*), intent(in) :: key
character(len=1), dimension(:), intent(in) :: value
integer(kind=kindOfInt), optional, intent(out) :: length
integer(kind=kindOfInt), optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
integer(kind=kindOfInt) :: nb_values
character :: bytes(size(value))
nb_values = size (value)
bytes = transfer (value, bytes)
iret = grib_f_set_byte_array ( gribid, key, bytes, nb_values )
if (iret /= 0) then
call grib_f_write_on_fail(gribid)
endif
if (present(length)) then
length = nb_values
end if
if (present(status)) then
status = iret
else
call grib_check(iret,'grib_set',key)
endif
end subroutine grib_set_byte_array
!> Set the real(4) values for an array key in a grib message.
!>

2
fortran/grib_f90_int.f90
View File

@ -97,6 +97,7 @@
grib_get_real8, &
grib_get_string, &
grib_get_int_array, &
grib_get_byte_array, &
grib_get_real4_array, &
grib_get_real8_array
end interface grib_get
@ -218,6 +219,7 @@
grib_set_real8, &
grib_set_string, &
grib_set_int_array, &
grib_set_byte_array, &
grib_set_real4_array, &
grib_set_real8_array
end interface grib_set

2
fortran/grib_f90_long_int.f90
View File

@ -175,6 +175,7 @@
grib_get_real8, &
grib_get_string, &
grib_get_int_array, &
grib_get_byte_array, &
grib_get_real4_array, &
grib_get_real8_array
end interface grib_get
@ -226,6 +227,7 @@
grib_set_string, &
grib_set_int_array, &
grib_set_long_array, &
grib_set_byte_array, &
grib_set_real4_array, &
grib_set_real8_array
end interface grib_set

38
fortran/grib_fortran.c
View File

@ -1761,6 +1761,26 @@ int grib_f_get_long_array__(int* gid, char* key, long *val, int* size, int len){
int grib_f_get_long_array(int* gid, char* key, long *val, int* size, int len){
return grib_f_get_long_array_( gid, key, val, size, len);
}
int grib_f_get_byte_array_(int* gid, char* key, unsigned char *val, int* size, int len){
grib_handle *h = get_handle(*gid);
int err = GRIB_SUCCESS;
char buf[1024];
size_t lsize = *size;
if(!h) return GRIB_INVALID_GRIB;
err = grib_get_bytes(h, cast_char(buf,key,len), val, &lsize);
*size = (int) lsize;
return err;
}
int grib_f_get_byte_array__(int* gid, char* key, unsigned char *val, int* size, int len){
return grib_f_get_byte_array_( gid, key, val, size, len);
}
int grib_f_get_byte_array(int* gid, char* key, unsigned char *val, int* size, int len){
return grib_f_get_byte_array_( gid, key, val, size, len);
}
int grib_f_index_get_string_(int* gid, char* key, char* val, int *eachsize,int* size, int len){
@ -1922,7 +1942,25 @@ int grib_f_set_long_array__(int* gid, char* key, long* val, int* size, int len)
int grib_f_set_long_array(int* gid, char* key, long* val, int* size, int len){
return grib_f_set_long_array_( gid, key, val, size, len);
}
int grib_f_set_byte_array_(int* gid, char* key, unsigned char* val, int* size, int len){
grib_handle *h = get_handle(*gid);
int err = GRIB_SUCCESS;
char buf[1024];
size_t lsize = *size;
if(!h) return GRIB_INVALID_GRIB;
err = grib_set_bytes(h, cast_char(buf,key,len), val, &lsize);
*size = (int) lsize;
return err;
}
int grib_f_set_byte_array__(int* gid, char* key, unsigned char* val, int* size, int len){
return grib_f_set_byte_array_( gid, key, val, size, len);
}
int grib_f_set_byte_array(int* gid, char* key, unsigned char* val, int* size, int len){
return grib_f_set_byte_array_( gid, key, val, size, len);
}
int grib_f_set_int_(int* gid, char* key, int* val, int len){
grib_handle *h = get_handle(*gid);

6
fortran/grib_fortran_prototypes.h
View File

@ -169,6 +169,9 @@ int grib_f_get_int_array(int *gid, char *key, int *val, int *size, int len);
int grib_f_get_long_array_(int *gid, char *key, long *val, int *size, int len);
int grib_f_get_long_array__(int *gid, char *key, long *val, int *size, int len);
int grib_f_get_long_array(int *gid, char *key, long *val, int *size, int len);
int grib_f_get_byte_array_(int* gid, char* key, unsigned char *val, int* size, int len);
int grib_f_get_byte_array__(int* gid, char* key, unsigned char *val, int* size, int len);
int grib_f_get_byte_array(int* gid, char* key, unsigned char *val, int* size, int len);
int grib_f_index_get_string_(int *gid, char *key, char *val, int *eachsize, int *size, int len);
int grib_f_index_get_string__(int *gid, char *key, char *val, int *eachsize, int *size, int len);
int grib_f_index_get_string(int *gid, char *key, char *val, int *eachsize, int *size, int len);
@ -187,6 +190,9 @@ int grib_f_set_int_array(int *gid, char *key, int *val, int *size, int len);
int grib_f_set_long_array_(int *gid, char *key, long *val, int *size, int len);
int grib_f_set_long_array__(int *gid, char *key, long *val, int *size, int len);
int grib_f_set_long_array(int *gid, char *key, long *val, int *size, int len);
int grib_f_set_byte_array_(int* gid, char* key, unsigned char *val, int* size, int len);
int grib_f_set_byte_array__(int* gid, char* key, unsigned char *val, int* size, int len);
int grib_f_set_byte_array(int* gid, char* key, unsigned char *val, int* size, int len);
int grib_f_set_int_(int *gid, char *key, int *val, int len);
int grib_f_set_int__(int *gid, char *key, int *val, int len);
int grib_f_set_int(int *gid, char *key, int *val, int len);