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

Added new fortran function codes_get_string_array and example/F90/bufr_get_string_array.f90 ECC-269

This commit is contained in:
Enrico Fucile 2016-06-16 11:47:16 +01:00
parent 4e518ad7ed
commit 26a7a59e69
10 changed files with 198 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
data/bufr/bufr_ref_files.txt
View File

@ -384,3 +384,4 @@ uegabe.bufr.num.ref
syno.bufr.out.ref
airep.bufr.out.ref
new_replication.bufr.ref
get_string_array.ref

1
examples/F90/CMakeLists.txt
View File

@ -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

58
examples/F90/bufr_get_string_array.f90 Normal file
View File

@ -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

39
examples/F90/bufr_get_string_array.sh Executable file
View File

@ -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

2
fortran/eccodes_f90_int.f90
View File

@ -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

2
fortran/eccodes_f90_long_int.f90
View File

@ -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

51
fortran/eccodes_f90_tail.f90
View File

@ -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

3
fortran/grib_api_externals.h
View File

@ -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, &

48
fortran/grib_fortran.c
View File

@ -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;i<lsize;i++) {
memcpy(p,cval[i],*slen);
czstr_to_fortran(p,*slen);
p+= *slen;
}
grib_context_free(h->context,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){

1
src/grib_accessor_class_bufr_data_array.c
View File

@ -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);
}