From 26a7a59e69d3e71d38239e097c77fea4e2187b87 Mon Sep 17 00:00:00 2001 From: Enrico Fucile Date: Thu, 16 Jun 2016 11:47:16 +0100 Subject: [PATCH] Added new fortran function codes_get_string_array and example/F90/bufr_get_string_array.f90 ECC-269 --- data/bufr/bufr_ref_files.txt | 1 + examples/F90/CMakeLists.txt | 1 + examples/F90/bufr_get_string_array.f90 | 58 +++++++++++++++++++++++ examples/F90/bufr_get_string_array.sh | 39 +++++++++++++++ fortran/eccodes_f90_int.f90 | 2 +- fortran/eccodes_f90_long_int.f90 | 2 +- fortran/eccodes_f90_tail.f90 | 51 ++++++++++++++++++-- fortran/grib_api_externals.h | 3 +- fortran/grib_fortran.c | 48 +++++++++++++++++++ src/grib_accessor_class_bufr_data_array.c | 1 + 10 files changed, 198 insertions(+), 8 deletions(-) create mode 100644 examples/F90/bufr_get_string_array.f90 create mode 100755 examples/F90/bufr_get_string_array.sh diff --git a/data/bufr/bufr_ref_files.txt b/data/bufr/bufr_ref_files.txt index 8b0e7f75e..cac029f12 100644 --- a/data/bufr/bufr_ref_files.txt +++ b/data/bufr/bufr_ref_files.txt @@ -384,3 +384,4 @@ uegabe.bufr.num.ref syno.bufr.out.ref airep.bufr.out.ref new_replication.bufr.ref +get_string_array.ref diff --git a/examples/F90/CMakeLists.txt b/examples/F90/CMakeLists.txt index 2bcaf3486..29ba0beb1 100644 --- a/examples/F90/CMakeLists.txt +++ b/examples/F90/CMakeLists.txt @@ -36,6 +36,7 @@ list( APPEND tests bufr_clone bufr_expanded bufr_get_keys + bufr_get_string_array bufr_keys_iterator bufr_read_header bufr_read_scatterometer diff --git a/examples/F90/bufr_get_string_array.f90 b/examples/F90/bufr_get_string_array.f90 new file mode 100644 index 000000000..6b42c997e --- /dev/null +++ b/examples/F90/bufr_get_string_array.f90 @@ -0,0 +1,58 @@ +! +!Copyright 2005-2016 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. +! +! +! FOTRAN 90 Implementation: bufr_get_string_array +! +! Description: how to get an array of strings from a BUFR message. + +program bufr_get_string_array +use eccodes +implicit none +integer :: ifile +integer :: iret,i,n +integer :: ibufr +integer :: strsize +integer, parameter :: max_strsize = 20 +character(len=max_strsize) , dimension(:),allocatable :: stationOrSiteName + + call codes_open_file(ifile,'../../data/bufr/pgps_110.bufr','r') + + call codes_bufr_new_from_file(ifile,ibufr,iret) + + + ! unpack the data values + call codes_set(ibufr,'unpack',1) + call codes_get(ibufr,'stationOrSiteName->width',strsize) + strsize=strsize/8 + if (strsize > max_strsize) then + print *,'stationOrSiteName array dimension is ',max_strsize,' and should be ',strsize + call exit(1) + end if + + call codes_get_size(ibufr,'stationOrSiteName',n) + allocate(stationOrSiteName(n)) + ! passing an array of strings stationOrSiteName which must be allocated beforehand + call codes_get_string_array(ibufr,'stationOrSiteName',stationOrSiteName) + do i=1,n + write(*,'(A)')trim(stationOrSiteName(i)) + end do + + !remember to deallocate what was allocated by codes_get_string_array + deallocate(stationOrSiteName) + + ! release the bufr message + call codes_release(ibufr) + + ! close file + call codes_close_file(ifile) + + +end program bufr_get_string_array + diff --git a/examples/F90/bufr_get_string_array.sh b/examples/F90/bufr_get_string_array.sh new file mode 100755 index 000000000..0f65ee45d --- /dev/null +++ b/examples/F90/bufr_get_string_array.sh @@ -0,0 +1,39 @@ +#!/bin/sh +# Copyright 2005-2016 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 +set -x +#Define a common label for all the tmp files +label="bufr_get_string_array_test_f" + +#Prepare tmp file +fTmp=${label}.tmp.txt +rm -f $fTmp | true + +#----------------------------------------------------- +# Test get string array from a BUFR +#---------------------------------------------------- + +fRef=${data_dir}/bufr/get_string_array.ref + +REDIRECT=/dev/null + +#Write the values into a file and compare with reference +${examples_dir}/eccodes_f_bufr_get_string_array $f > $fTmp + +#We compare output to the reference by ignoring the whitespaces +diff -w $fRef $fTmp + +#cat $fRes + +#Clean up +rm -f ${fTmp} | true + + + diff --git a/fortran/eccodes_f90_int.f90 b/fortran/eccodes_f90_int.f90 index 2a63abfc8..4c2a28500 100644 --- a/fortran/eccodes_f90_int.f90 +++ b/fortran/eccodes_f90_int.f90 @@ -96,8 +96,8 @@ codes_get_real4, & codes_get_real8, & codes_get_string, & + codes_get_string_array, & codes_get_int_array, & - codes_get_byte_array, & codes_get_real4_array, & codes_get_real8_array end interface codes_get diff --git a/fortran/eccodes_f90_long_int.f90 b/fortran/eccodes_f90_long_int.f90 index 4c8fdd440..6e737c806 100644 --- a/fortran/eccodes_f90_long_int.f90 +++ b/fortran/eccodes_f90_long_int.f90 @@ -100,8 +100,8 @@ codes_get_real4, & codes_get_real8, & codes_get_string, & + codes_get_string_array, & codes_get_int_array, & - codes_get_byte_array, & codes_get_real4_array, & codes_get_real8_array end interface codes_get diff --git a/fortran/eccodes_f90_tail.f90 b/fortran/eccodes_f90_tail.f90 index cceea7a93..e4efde2ce 100644 --- a/fortran/eccodes_f90_tail.f90 +++ b/fortran/eccodes_f90_tail.f90 @@ -828,6 +828,49 @@ subroutine codes_get_string ( gribid, key, value, status ) call grib_get_string ( gribid, key, value, status ) end subroutine codes_get_string +subroutine codes_get_string_array ( gribid, key, value, status ) + integer(kind=kindOfInt), intent(in) :: gribid + character(len=*), intent(in) :: key + character(len=*), dimension(:),allocatable,intent(inout) :: value + character :: cvalue(size(value)*len(value(0))) + integer(kind=kindOfInt),optional, intent(out) :: status + + integer(kind=kindOfInt) :: iret + integer(kind=kindOfInt) :: nb_values + integer(kind=kindOfInt) :: slen + integer(kind=kindOfInt) :: size_value + integer(kind=kindOfInt) :: i,s,j + + + if (allocated(value) .eqv. .false.) then + iret=CODES_NULL_POINTER + if (present(status)) then + status = iret + else + call grib_check(iret,'grib_get',key) + endif + end if + + nb_values=size(value) + slen=len(value(0)) + iret=grib_f_get_string_array ( gribid, key, cvalue , nb_values, slen ) + value=transfer(cvalue,value) + if (iret==0 .and. nb_values==1 .and. size_value/=1) then + do i=2,size_value + value(i)=value(1) + enddo + endif + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + endif + if (present(status)) then + status = iret + else + call grib_check(iret,'grib_get',key) + endif + +end subroutine codes_get_string_array + ! Note: This function supports the allocatable array attribute ! ------------------------------------------------------------- subroutine codes_get_int_array ( gribid, key, value, status ) @@ -861,9 +904,9 @@ subroutine codes_get_int_array ( gribid, key, value, status ) value(i)=value(1) enddo endif - if (iret /= 0) then - call grib_f_write_on_fail(gribid) - endif + if (iret /= 0) then + call grib_f_write_on_fail(gribid) + endif if (present(status)) then status = iret else @@ -926,7 +969,6 @@ subroutine codes_get_byte_array ( gribid, key, value, length, status ) integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values - character :: bytes(size(value)) call grib_get_byte_array ( gribid, key, value, length, status ) end subroutine codes_get_byte_array @@ -1144,7 +1186,6 @@ subroutine codes_set_byte_array ( gribid, key, value, length, status ) integer(kind=kindOfInt), optional, intent(out) :: status integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: nb_values - character :: bytes(size(value)) call grib_set_byte_array ( gribid, key, value, length, status ) end subroutine codes_set_byte_array diff --git a/fortran/grib_api_externals.h b/fortran/grib_api_externals.h index 2bbd91478..7e764553e 100644 --- a/fortran/grib_api_externals.h +++ b/fortran/grib_api_externals.h @@ -32,7 +32,8 @@ integer, external :: grib_f_get_int, grib_f_get_long,grib_f_get_int_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, & - grib_f_get_string,grib_f_is_missing,grib_f_is_defined + grib_f_get_string,grib_f_get_string_array, & + grib_f_is_missing,grib_f_is_defined integer, external :: grib_f_new_from_index, & grib_f_index_new_from_file, & grib_f_index_add_file, & diff --git a/fortran/grib_fortran.c b/fortran/grib_fortran.c index 99d0c2089..ddcb0f40e 100644 --- a/fortran/grib_fortran.c +++ b/fortran/grib_fortran.c @@ -162,6 +162,16 @@ static void czstr_to_fortran(char* str,int len) *p=' '; } +static void czstr_to_fortran_replace0(char* str,int len) +{ + char *p,*end; + p=str; end=str+len-1; + while (p != end) { + if (*p=='\0') *p=' '; + p++; + } +} + static void fort_char_clean(char* str,int len) { char *p,*end; @@ -2697,6 +2707,44 @@ int grib_f_set_real8_array(int* gid, char* key, double *val, int* size, int len) return grib_f_set_real8_array_( gid, key, val, size, len); } +/*****************************************************************************/ +int grib_f_get_string_array_(int* gid, char* key, unsigned char* val,int* nvals,int* slen,int len,int len2){ + + grib_handle *h = get_handle(*gid); + int err = GRIB_SUCCESS; + size_t i; + char buf[1024]; + size_t lsize = *nvals; + char** cval=0; + char* p=val; + + if(!h) return GRIB_INVALID_GRIB; + + + cval=(char**)grib_context_malloc_clear(h->context,sizeof(char*)*lsize); + err = grib_get_string_array(h, cast_char(buf,key,len), cval, &lsize); + if (err) return err; + + if (strlen(cval[0])>*slen) err=GRIB_ARRAY_TOO_SMALL; + + for (i=0;icontext,cval); + /*remember to deallocate each string*/ + + return err; +} + +int grib_f_get_string_array__(int* gid, char* key, unsigned char* val,int* nvals,int* slen, int len,int len2){ + return grib_f_get_string_array_( gid, key, val,nvals,slen,len,len2); +} +int grib_f_get_string_array(int* gid, char* key, unsigned char* val,int* nvals,int* slen, int len,int len2){ + return grib_f_get_string_array_( gid, key, val, nvals, slen, len,len2); +} + /*****************************************************************************/ int grib_f_get_string_(int* gid, char* key, char* val,int len, int len2){ diff --git a/src/grib_accessor_class_bufr_data_array.c b/src/grib_accessor_class_bufr_data_array.c index 1e1660382..b20b13a24 100644 --- a/src/grib_accessor_class_bufr_data_array.c +++ b/src/grib_accessor_class_bufr_data_array.c @@ -490,6 +490,7 @@ static grib_darray* decode_double_array(grib_context* c,unsigned char* data,long } else { dval=localReference*modifiedFactor; } + grib_context_log(c, GRIB_LOG_DEBUG," modifiedWidth=%ld lval=%ld dval=%g", modifiedWidth,lval,dval); grib_darray_push(c,ret,dval); }