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

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

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

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
+

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

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

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

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
+  if (iret /= 0) then
-	  call grib_f_write_on_fail(gribid)
+    call grib_f_write_on_fail(gribid)
-	endif
+  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 

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

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;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){
 

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