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

bufr_dump -Efortran and codes_set_string_array fortran ECC-292 ECC-295

This commit is contained in:
Enrico Fucile 2016-07-08 13:54:08 +01:00
parent 88081880ad
commit c43391c43a
11 changed files with 743 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
fortran/eccodes_f90_tail.f90
View File

@ -818,7 +818,7 @@ subroutine codes_get_string_array ( gribid, key, value, status )
if (present(status)) then
status = iret
else
call grib_check(iret,'grib_get',key)
call grib_check(iret,'codes_get',key)
endif
end if
@ -833,11 +833,46 @@ subroutine codes_get_string_array ( gribid, key, value, status )
if (present(status)) then
status = iret
else
call grib_check(iret,'grib_get',key)
call grib_check(iret,'codes_get',key)
endif
end subroutine codes_get_string_array
subroutine codes_set_string_array ( gribid, key, value, status )
integer(kind=kindOfInt), intent(in) :: gribid
character(len=*), intent(in) :: key
character(len=*), dimension(:),allocatable, intent(in) :: value
integer(kind=kindOfInt),optional, intent(out) :: status
character :: cvalue(size(value)*len(value(0)))
character :: svalue(len(value(0)))
integer(kind=kindOfInt) :: iret
integer(kind=kindOfInt) :: nb_values
integer(kind=kindOfInt) :: slen
integer(kind=kindOfInt) :: i,s,j,l
nb_values=size(value)
slen=len(value(0))
j=1
do i=1,nb_values
cvalue(j:j+slen-1)=transfer(value(i),svalue)
j=j+slen
enddo
iret=grib_f_set_string_array ( gribid, key, cvalue , nb_values, slen )
if (iret /= 0) then
call grib_f_write_on_fail(gribid)
endif
if (present(status)) then
status = iret
else
call grib_check(iret,'codes_set',key)
endif
end subroutine codes_set_string_array
! Note: This function supports the allocatable array attribute
! -------------------------------------------------------------
subroutine codes_get_int_array ( gribid, key, value, status )

2
fortran/grib_api_externals.h
View File

@ -57,7 +57,7 @@ integer, external :: grib_f_set_int, grib_f_set_int_array, &
grib_f_set_real4, grib_f_set_real4_array, &
grib_f_set_real8, grib_f_set_real8_array, &
grib_f_set_force_real4_array, grib_f_set_force_real8_array, &
grib_f_set_string, grib_f_set_missing, &
grib_f_set_string, grib_f_set_string_array, grib_f_set_missing, &
grib_f_gribex_mode_on,grib_f_gribex_mode_off, &
grib_f_find_nearest_single,grib_f_find_nearest_four_single,grib_f_find_nearest_multiple
integer, external :: grib_f_get_message_size, grib_f_copy_message, grib_f_count_in_file

57
fortran/grib_fortran.c
View File

@ -153,6 +153,16 @@ static char* cast_char(char* buf, char* fortstr,int len)
return buf;
}
static char* cast_char_no_cut(char* buf, char* fortstr,int len)
{
char *p,*end;
if (len == 0 || fortstr == NULL) return NULL;
memcpy(buf,fortstr,len);
buf[len]='\0';
return buf;
}
static void czstr_to_fortran(char* str,int len)
{
char *p,*end;
@ -2729,10 +2739,10 @@ int grib_f_get_string_array_(int* gid, char* key, char* val,int* nvals,int* slen
for (i=0;i<lsize;i++) {
strcpy(p,cval[i]);
czstr_to_fortran(p,*slen);
grib_context_free(h->context,cval[i]);
p+= *slen;
}
grib_context_free(h->context,cval);
/*remember to deallocate each string*/
return err;
}
@ -2744,6 +2754,45 @@ int grib_f_get_string_array(int* gid, char* key, char* val,int* nvals,int* slen,
return grib_f_get_string_array_( gid, key, val, nvals, slen, len);
}
/*****************************************************************************/
int grib_f_set_string_array_(int* gid, char* key, char* val,int* nvals,int* slen,int len)
{
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;
grib_context* c=h->context;
if(!h) return GRIB_INVALID_GRIB;
cval=(char**)grib_context_malloc_clear(h->context,sizeof(char*)*lsize);
for (i=0;i<lsize;i++) {
cval[i]=grib_context_malloc_clear(c,sizeof(char)* (*slen+1));
cast_char_no_cut(cval[i],p,*slen);
p+= *slen;
}
err = grib_set_string_array(h, cast_char(buf,key,len), cval, lsize);
if (err) return err;
for (i=0;i<lsize;i++) {
grib_context_free(c,cval[i]);
}
grib_context_free(c,cval);
return err;
}
int grib_f_set_string_array__(int* gid, char* key, char* val,int* nvals,int* slen, int len){
return grib_f_set_string_array_( gid, key, val,nvals,slen,len);
}
int grib_f_set_string_array(int* gid, char* key, char* val,int* nvals,int* slen, int len){
return grib_f_set_string_array_( gid, key, val, nvals, slen, len);
}
/*****************************************************************************/
int grib_f_get_string_(int* gid, char* key, char* val,int len, int len2){
@ -2774,13 +2823,13 @@ int grib_f_set_string_(int* gid, char* key, char* val, int len, int len2){
grib_handle *h = get_handle(*gid);
char buf[1024];
char buf2[1024];
char buf[1024]={0,};
char buf2[1024]={0,};
size_t lsize = len2;
if(!h) return GRIB_INVALID_GRIB;
return grib_set_string(h, cast_char(buf,key,len), cast_char(buf2,val,len2), &lsize);
return grib_set_string(h, cast_char(buf,key,len), cast_char_no_cut(buf2,val,len2), &lsize);
}

1
src/CMakeLists.txt
View File

@ -273,6 +273,7 @@ list( APPEND grib_api_srcs
grib_dumper_class_default.c
grib_dumper_class_keys.c
grib_dumper_class_filter.c
grib_dumper_class_fortran.c
grib_dumper_class_json.c
grib_dumper_class_xml.c
grib_dumper_class_c_code.c

1
src/grib_dumper_class.h
View File

@ -5,6 +5,7 @@ extern grib_dumper_class* grib_dumper_class_debug;
extern grib_dumper_class* grib_dumper_class_default;
extern grib_dumper_class* grib_dumper_class_file;
extern grib_dumper_class* grib_dumper_class_filter;
extern grib_dumper_class* grib_dumper_class_fortran;
extern grib_dumper_class* grib_dumper_class_json;
extern grib_dumper_class* grib_dumper_class_keys;
extern grib_dumper_class* grib_dumper_class_serialize;

633
src/grib_dumper_class_fortran.c Normal file
View File

@ -0,0 +1,633 @@
/*
* 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 "grib_api_internal.h"
#include <ctype.h>
/*
This is used by make_class.pl
START_CLASS_DEF
CLASS = dumper
IMPLEMENTS = dump_long;dump_bits
IMPLEMENTS = dump_double;dump_string;dump_string_array
IMPLEMENTS = dump_bytes;dump_values
IMPLEMENTS = dump_label;dump_section
IMPLEMENTS = init;destroy
IMPLEMENTS = header;footer
MEMBERS = long section_offset
MEMBERS = long begin
MEMBERS = long empty
MEMBERS = long end
MEMBERS = long isLeaf
MEMBERS = long isAttribute
MEMBERS = grib_string_list* keys
END_CLASS_DEF
*/
/* START_CLASS_IMP */
/*
Don't edit anything between START_CLASS_IMP and END_CLASS_IMP
Instead edit values between START_CLASS_DEF and END_CLASS_DEF
or edit "dumper.class" and rerun ./make_class.pl
*/
static void init_class (grib_dumper_class*);
static int init (grib_dumper* d);
static int destroy (grib_dumper*);
static void dump_long (grib_dumper* d, grib_accessor* a,const char* comment);
static void dump_bits (grib_dumper* d, grib_accessor* a,const char* comment);
static void dump_double (grib_dumper* d, grib_accessor* a,const char* comment);
static void dump_string (grib_dumper* d, grib_accessor* a,const char* comment);
static void dump_string_array (grib_dumper* d, grib_accessor* a,const char* comment);
static void dump_bytes (grib_dumper* d, grib_accessor* a,const char* comment);
static void dump_values (grib_dumper* d, grib_accessor* a);
static void dump_label (grib_dumper* d, grib_accessor* a,const char* comment);
static void dump_section (grib_dumper* d, grib_accessor* a,grib_block_of_accessors* block);
static void header (grib_dumper*,grib_handle*);
static void footer (grib_dumper*,grib_handle*);
typedef struct grib_dumper_fortran {
grib_dumper dumper;
/* Members defined in fortran */
long section_offset;
long begin;
long empty;
long end;
long isLeaf;
long isAttribute;
grib_string_list* keys;
} grib_dumper_fortran;
static grib_dumper_class _grib_dumper_class_fortran = {
0, /* super */
"fortran", /* name */
sizeof(grib_dumper_fortran), /* size */
0, /* inited */
&init_class, /* init_class */
&init, /* init */
&destroy, /* free mem */
&dump_long, /* dump long */
&dump_double, /* dump double */
&dump_string, /* dump string */
&dump_string_array, /* dump string array */
&dump_label, /* dump labels */
&dump_bytes, /* dump bytes */
&dump_bits, /* dump bits */
&dump_section, /* dump section */
&dump_values, /* dump values */
&header, /* header */
&footer, /* footer */
};
grib_dumper_class* grib_dumper_class_fortran = &_grib_dumper_class_fortran;
/* END_CLASS_IMP */
static void dump_attributes(grib_dumper* d,grib_accessor* a);
GRIB_INLINE static int grib_inline_strcmp(const char* a,const char* b)
{
if (*a != *b) return 1;
while((*a!=0 && *b!=0) && *(a) == *(b) ) {a++;b++;}
return (*a==0 && *b==0) ? 0 : 1;
}
typedef struct string_count string_count;
struct string_count {
char* value;
int count;
string_count* next;
};
static int get_key_rank(grib_handle* h,grib_string_list* keys,const char* key)
{
grib_string_list* next=keys;
grib_string_list* prev=keys;
int ret=0;
size_t size=0;
grib_context* c=h->context;
while (next && next->value && grib_inline_strcmp(next->value,key)) {
prev=next;
next=next->next;
}
if (!next) {
prev->next=(grib_string_list*)grib_context_malloc_clear(c,sizeof(grib_string_list));
next=prev->next;
}
if (!next->value) {
next->value=strdup(key);
next->count=0;
}
next->count++;
ret=next->count;
if (ret==1) {
char* s=grib_context_malloc_clear(c,strlen(key)+5);
sprintf(s,"#2#%s",key);
if (grib_get_size(h,s,&size)==GRIB_NOT_FOUND) ret=0;
}
return ret;
}
static int depth=0;
static void init_class (grib_dumper_class* c){}
static int init(grib_dumper* d)
{
grib_dumper_fortran *self = (grib_dumper_fortran*)d;
grib_context* c=d->handle->context;
self->section_offset=0;
self->empty=1;
self->isLeaf=0;
self->isAttribute=0;
self->keys=grib_context_malloc_clear(c,sizeof(grib_string_list));
return GRIB_SUCCESS;
}
static int destroy(grib_dumper* d)
{
grib_dumper_fortran *self = (grib_dumper_fortran*)d;
grib_string_list* next=self->keys;
grib_string_list* cur=self->keys;
grib_context* c=d->handle->context;
while(next) {
cur=next;
next=next->next;
grib_context_free(c,cur->value);
grib_context_free(c,cur);
}
return GRIB_SUCCESS;
}
static char* dval_to_string(grib_context* c,double v) {
char* sval=grib_context_malloc_clear(c,sizeof(char)*40);
char* p;
sprintf(sval,"%.18e",v);
p=sval;
while (*p !=0 ) {
if (*p == 'e') *p='d';
p++;
}
return sval;
}
static void dump_values(grib_dumper* d,grib_accessor* a)
{
grib_dumper_fortran *self = (grib_dumper_fortran*)d;
double value; size_t size = 1;
double *values=NULL;
int err = 0;
int i,r,icount;
int cols=2;
long count=0;
char* sval;
grib_context* c=a->context;
grib_handle* h=grib_handle_of_accessor(a);
grib_value_count(a,&count);
size=count;
if ( (a->flags & GRIB_ACCESSOR_FLAG_DUMP) == 0 || (a->flags & GRIB_ACCESSOR_FLAG_READ_ONLY) !=0)
return;
if (size>1) {
values=(double*)grib_context_malloc_clear(c,sizeof(double)*size);
err=grib_unpack_double(a,values,&size);
} else {
err=grib_unpack_double(a,&value,&size);
}
self->begin=0;
self->empty=0;
if (size>1) {
fprintf(self->dumper.out," if(allocated(rvalues)) deallocate(rvalues)\n");
fprintf(self->dumper.out," allocate(rvalues(%d))\n",size);
fprintf(self->dumper.out," rvalues=(/");
icount=0;
for (i=0; i<size-1; ++i) {
if (icount>cols || i==0) {fprintf(self->dumper.out," &\n ");icount=0;}
sval=dval_to_string(c,values[i]);
fprintf(self->dumper.out,"%s, ", sval);
grib_context_free(c,sval);
icount++;
}
if (icount>cols || i==0) {fprintf(self->dumper.out," &\n ");icount=0;}
sval=dval_to_string(c,values[i]);
fprintf(self->dumper.out,"%s", sval);
grib_context_free(c,sval);
depth-=2;
fprintf(self->dumper.out,"/)\n");
grib_context_free(c,values);
if ((r=get_key_rank(h,self->keys,a->name))!=0)
fprintf(self->dumper.out," call codes_set(ibufr,'#%d#%s',rvalues)\n",r,a->name);
else
fprintf(self->dumper.out," call codes_set(ibufr,'%s',rvalues)\n",a->name);
} else {
r=get_key_rank(h,self->keys,a->name);
if( !grib_is_missing_double(a,value) ) {
sval=dval_to_string(c,value);
if (r!=0)
fprintf(self->dumper.out," call codes_set(ibufr,'#%d#%s',%s)\n",r,a->name,sval);
else
fprintf(self->dumper.out," call codes_set(ibufr,'%s',%s)\n",a->name,sval);
grib_context_free(c,sval);
}
}
if (self->isLeaf==0) {
dump_attributes(d,a);
depth-=2;
}
(void)err; /* TODO */
}
static void dump_long(grib_dumper* d,grib_accessor* a,const char* comment)
{
grib_dumper_fortran *self = (grib_dumper_fortran*)d;
long value; size_t size = 1;
long *values=NULL;
int err = 0;
int i,r,icount;
int cols=4;
long count=0;
grib_handle* h=grib_handle_of_accessor(a);
grib_value_count(a,&count);
size=count;
if ( (a->flags & GRIB_ACCESSOR_FLAG_DUMP) == 0 || (a->flags & GRIB_ACCESSOR_FLAG_READ_ONLY) != 0)
return;
if (size>1) {
values=(long*)grib_context_malloc_clear(a->context,sizeof(long)*size);
err=grib_unpack_long(a,values,&size);
} else {
err=grib_unpack_long(a,&value,&size);
}
self->begin=0;
self->empty=0;
if (size>1) {
fprintf(self->dumper.out," if(allocated(ivalues)) deallocate(ivalues)\n");
fprintf(self->dumper.out," allocate(ivalues(%d))\n",size);
fprintf(self->dumper.out," ivalues=(/");
icount=0;
for (i=0;i<size-1;i++) {
if (icount>cols || i==0) {fprintf(self->dumper.out," &\n ");icount=0;}
fprintf(self->dumper.out,"%ld, ",values[i]);
icount++;
}
if (icount>cols || i==0) {fprintf(self->dumper.out," &\n ");icount=0;}
fprintf(self->dumper.out,"%ld ",values[i]);
depth-=2;
fprintf(self->dumper.out,"/)\n");
grib_context_free(a->context,values);
if ((r=get_key_rank(h,self->keys,a->name))!=0)
fprintf(self->dumper.out," call codes_set(ibufr,'#%d#%s',ivalues)\n",r,a->name);
else
fprintf(self->dumper.out," call codes_set(ibufr,'%s',ivalues)\n",a->name);
} else {
r=get_key_rank(h,self->keys,a->name);
if( !grib_is_missing_long(a,value) ) {
if (r!=0)
fprintf(self->dumper.out," call codes_set(ibufr,'#%d#%s',",r,a->name);
else
fprintf(self->dumper.out," call codes_set(ibufr,'%s',",a->name);
fprintf(self->dumper.out,"%ld)\n",value);
}
}
if (self->isLeaf==0) {
dump_attributes(d,a);
depth-=2;
}
(void)err; /* TODO */
}
static void dump_bits(grib_dumper* d,grib_accessor* a,const char* comment)
{
}
static void dump_double(grib_dumper* d,grib_accessor* a,const char* comment)
{
grib_dumper_fortran *self = (grib_dumper_fortran*)d;
double value; size_t size = 1;
int r;
char* sval;
grib_handle* h=grib_handle_of_accessor(a);
grib_context* c=h->context;
grib_unpack_double(a,&value,&size);
if ( (a->flags & GRIB_ACCESSOR_FLAG_DUMP) == 0 || (a->flags & GRIB_ACCESSOR_FLAG_READ_ONLY) != 0)
return;
self->begin=0;
self->empty=0;
r=get_key_rank(h,self->keys,a->name);
if( !grib_is_missing_double(a,value) ) {
sval=dval_to_string(c,value);
if (r!=0)
fprintf(self->dumper.out," call codes_set(ibufr,'#%d#%s',%s)\n",r,a->name,sval);
else
fprintf(self->dumper.out," call codes_set(ibufr,'%s',%s)\n",a->name,sval);
grib_context_free(c,sval);
}
if (self->isLeaf==0) {
dump_attributes(d,a);
}
}
static void dump_string_array(grib_dumper* d,grib_accessor* a,const char* comment)
{
grib_dumper_fortran *self = (grib_dumper_fortran*)d;
char **values;
size_t size = 0,i=0;
grib_context* c=NULL;
int err = 0;
long count=0;
int r;
grib_handle* h=grib_handle_of_accessor(a);
c=a->context;
if ( (a->flags & GRIB_ACCESSOR_FLAG_DUMP) == 0 || (a->flags & GRIB_ACCESSOR_FLAG_READ_ONLY) != 0)
return;
grib_value_count(a,&count);
size=count;
if (size==1) {
dump_string(d,a,comment);
return;
}
fprintf(self->dumper.out," if(allocated(svalues)) deallocate(svalues)\n");
fprintf(self->dumper.out," allocate(svalues(%d))\n",size);
fprintf(self->dumper.out," svalues=(/");
self->begin=0;
self->empty=0;
values=(char**)grib_context_malloc_clear(c,size*sizeof(char*));
if (!values) {
grib_context_log(c,GRIB_LOG_FATAL,"unable to allocate %d bytes",(int)size);
return;
}
err = grib_unpack_string_array(a,values,&size);
for (i=0;i<size-1;i++) {
fprintf(self->dumper.out," \"%s\", &\n",values[i]);
}
fprintf(self->dumper.out," \"%s\" /)\n",values[i]);
if (self->isLeaf==0) {
if ((r=get_key_rank(h,self->keys,a->name))!=0)
fprintf(self->dumper.out," call codes_set_string_array(ibufr,'#%d#%s',svalues)\n",r,a->name);
else
fprintf(self->dumper.out," call codes_set_string_array(ibufr,'%s',svalues)\n",a->name);
}
if (self->isLeaf==0) {
dump_attributes(d,a);
depth-=2;
}
grib_context_free(c,values);
(void)err; /* TODO */
}
static void dump_string(grib_dumper* d,grib_accessor* a,const char* comment)
{
grib_dumper_fortran *self = (grib_dumper_fortran*)d;
char *value=NULL;
char *p = NULL;
size_t size = 0;
grib_context* c=NULL;
int r;
int err = _grib_get_string_length(a,&size);
grib_handle* h=grib_handle_of_accessor(a);
c=a->context;
if (size==0) return;
if ( (a->flags & GRIB_ACCESSOR_FLAG_DUMP) == 0 || (a->flags & GRIB_ACCESSOR_FLAG_READ_ONLY) != 0)
return;
value=(char*)grib_context_malloc_clear(c,size);
if (!value) {
grib_context_log(c,GRIB_LOG_FATAL,"unable to allocate %d bytes",(int)size);
return;
}
else self->begin=0;
self->empty=0;
err = grib_unpack_string(a,value,&size);
p=value;
r=get_key_rank(h,self->keys,a->name);
if (grib_is_missing_string(a,(unsigned char *)value,size))
return;
while(*p) { if(!isprint(*p)) *p = '.'; p++; }
if (self->isLeaf==0) {
depth+=2;
if (r!=0)
fprintf(self->dumper.out," call codes_set(ibufr,'#%d#%s',",r,a->name);
else
fprintf(self->dumper.out," call codes_set(ibufr,'%s',",a->name);
}
fprintf(self->dumper.out,"\'%s\')\n",value);
if (self->isLeaf==0) {
dump_attributes(d,a);
depth-=2;
}
grib_context_free(c,value);
(void)err; /* TODO */
}
static void dump_bytes(grib_dumper* d,grib_accessor* a,const char* comment)
{
}
static void dump_label(grib_dumper* d,grib_accessor* a,const char* comment)
{
}
static void _dump_long_array(grib_handle* h,FILE* f,const char* key,const char* print_key) {
long* val;
size_t size=0,i;
int cols=9,icount=0;
if (grib_get_size(h,key,&size)==GRIB_NOT_FOUND) return;
fprintf(f," if(allocated(ivalues)) deallocate(ivalues)\n");
fprintf(f," allocate(ivalues(%d))\n",size);
fprintf(f," ivalues=(/ ",print_key);
val=grib_context_malloc_clear(h->context,sizeof(long)*size);
grib_get_long_array(h,key,val,&size);
for (i=0;i<size-1;i++) {
if (icount>cols || i==0) {fprintf(f," &\n ");icount=0;}
fprintf(f,"%ld, ",val[i]);
icount++;
}
if (icount>cols) {fprintf(f," &\n ");}
fprintf(f,"%ld /)\n",val[size-1]);
grib_context_free(h->context,val);
fprintf(f," call codes_set(ibufr,'%s',ivalues)\n",print_key);
}
static void dump_section(grib_dumper* d,grib_accessor* a,grib_block_of_accessors* block)
{
grib_dumper_fortran *self = (grib_dumper_fortran*)d;
if (!grib_inline_strcmp(a->name,"BUFR") ||
!grib_inline_strcmp(a->name,"GRIB") ||
!grib_inline_strcmp(a->name,"META")
) {
grib_handle* h=grib_handle_of_accessor(a);
depth=2;
self->begin=1;
self->empty=1;
depth+=2;
_dump_long_array(h,self->dumper.out,"dataPresentIndicator","inputDataPresentIndicator");
_dump_long_array(h,self->dumper.out,"delayedDescriptorReplicationFactor","inputDelayedDescriptorReplicationFactor");
_dump_long_array(h,self->dumper.out,"shortDelayedDescriptorReplicationFactor","inputShortDelayedDescriptorReplicationFactor");
_dump_long_array(h,self->dumper.out,"extendedDelayedDescriptorReplicationFactor","inputExtendedDelayedDescriptorReplicationFactor");
grib_dump_accessors_block(d,block);
depth-=2;
} else if (!grib_inline_strcmp(a->name,"groupNumber")) {
if ( (a->flags & GRIB_ACCESSOR_FLAG_DUMP) == 0)
return;
self->begin=1;
self->empty=1;
depth+=2;
grib_dump_accessors_block(d,block);
depth-=2;
} else {
grib_dump_accessors_block(d,block);
}
}
static void dump_attributes(grib_dumper* d,grib_accessor* a)
{
int i=0;
grib_dumper_fortran *self = (grib_dumper_fortran*)d;
/* FILE* out=self->dumper.out; */
unsigned long flags;
while (a->attributes[i] && i < MAX_ACCESSOR_ATTRIBUTES) {
self->isAttribute=1;
if ( (d->option_flags & GRIB_DUMP_FLAG_ALL_ATTRIBUTES ) == 0
&& (a->attributes[i]->flags & GRIB_ACCESSOR_FLAG_DUMP)== 0 )
{
i++;
continue;
}
self->isLeaf=a->attributes[i]->attributes[0]==NULL ? 1 : 0;
/* fprintf(self->dumper.out,","); */
/* fprintf(self->dumper.out,"\n%-*s",depth," "); */
/* fprintf(out,"\"%s\" : ",a->attributes[i]->name); */
flags=a->attributes[i]->flags;
a->attributes[i]->flags |= GRIB_ACCESSOR_FLAG_DUMP;
/* switch (grib_accessor_get_native_type(a->attributes[i])) { */
/* case GRIB_TYPE_LONG: */
/* dump_long(d,a->attributes[i],0); */
/* break; */
/* case GRIB_TYPE_DOUBLE: */
/* dump_values(d,a->attributes[i]); */
/* break; */
/* case GRIB_TYPE_STRING: */
/* dump_string_array(d,a->attributes[i],0); */
/* break; */
/* } */
a->attributes[i]->flags=flags;
i++;
}
self->isLeaf=0;
self->isAttribute=0;
}
static void header(grib_dumper* d,grib_handle* h) {
grib_dumper_fortran *self = (grib_dumper_fortran*)d;
fprintf(self->dumper.out,"! This program has been automatically generated with bufr_dump -Efortran\n");
fprintf(self->dumper.out,"program bufr_create_message\n");
fprintf(self->dumper.out," use eccodes\n");
fprintf(self->dumper.out," implicit none\n");
fprintf(self->dumper.out," integer :: iret\n");
fprintf(self->dumper.out," integer :: infile,outfile\n");
fprintf(self->dumper.out," integer :: ibufr\n");
fprintf(self->dumper.out," integer :: count=0\n");
fprintf(self->dumper.out," integer(kind=4), dimension(:), allocatable :: ivalues\n");
fprintf(self->dumper.out," integer :: strsize\n");
fprintf(self->dumper.out," integer, parameter :: max_strsize = 100\n");
fprintf(self->dumper.out," character(len=max_strsize) , dimension(:),allocatable :: svalues\n");
fprintf(self->dumper.out," real(kind=8), dimension(:), allocatable :: rvalues\n");
fprintf(self->dumper.out,"\n\n call codes_open_file(infile,'infile.bufr','r')\n");
fprintf(self->dumper.out," call codes_bufr_new_from_file(infile,ibufr,iret)\n");
fprintf(self->dumper.out," if (iret/=CODES_SUCCESS) then\n");
fprintf(self->dumper.out," print *,'ERROR reading BUFR from input file'\n");
fprintf(self->dumper.out," stop 1\n");
fprintf(self->dumper.out," endif\n");
}
static void footer(grib_dumper* d,grib_handle* h) {
grib_dumper_fortran *self = (grib_dumper_fortran*)d;
fprintf(self->dumper.out," call codes_set(ibufr,'pack',1)\n");
fprintf(self->dumper.out," call codes_open_file(outfile,'outfile.bufr','w')\n");
fprintf(self->dumper.out," call codes_write(ibufr,outfile)\n");
fprintf(self->dumper.out," call codes_close_file(outfile)\n");
fprintf(self->dumper.out," call codes_close_file(infile)\n");
fprintf(self->dumper.out," call codes_release(ibufr)\n");
fprintf(self->dumper.out," if(allocated(ivalues)) deallocate(ivalues)\n");
fprintf(self->dumper.out," if(allocated(rvalues)) deallocate(rvalues)\n");
fprintf(self->dumper.out," if(allocated(svalues)) deallocate(svalues)\n");
fprintf(self->dumper.out,"end program bufr_create_message\n");
}

1
src/grib_dumper_factory.h
View File

@ -3,6 +3,7 @@
{ "debug", &grib_dumper_class_debug, },
{ "default", &grib_dumper_class_default, },
{ "filter", &grib_dumper_class_filter, },
{ "fortran", &grib_dumper_class_fortran, },
{ "json", &grib_dumper_class_json, },
{ "keys", &grib_dumper_class_keys, },
{ "serialize", &grib_dumper_class_serialize, },

10
src/grib_value.c
View File

@ -787,7 +787,15 @@ static int _grib_set_long_array(grib_handle* h, const char* name, const long* va
{
size_t encoded = 0;
grib_accessor* a = grib_find_accessor(h, name);
int err = a ?_grib_set_long_array_internal(h,a,val,length,&encoded,check) : GRIB_NOT_FOUND ;
int err =0;
if (!a) return GRIB_NOT_FOUND ;
if (name[0]=='/' || name[0]=='#' ) {
if(check && (a->flags & GRIB_ACCESSOR_FLAG_READ_ONLY))
return GRIB_READ_ONLY;
err=grib_pack_long(a, val, &length);
encoded=length;
} else err=_grib_set_long_array_internal(h,a,val,length,&encoded,check);
if(err == GRIB_SUCCESS && length > encoded)
err = GRIB_ARRAY_TOO_SMALL;

2
tools/bufr_dump.c
View File

@ -21,7 +21,7 @@ grib_option grib_options[]={
"\n\t\tOptions: s->structure, f->flat (only data), a->all attributes"
"\n\t\tDefault mode is structure.\n",
1,1,"s"},
{"E:","filter/Fortran/python","\n\t\tEncoding dump. Provides instructions to create the input message."
{"E:","filter/fortran/python","\n\t\tEncoding dump. Provides instructions to create the input message."
"\n\t\tOptions: filter -> filter instructions file to encode input BUFR"
"\n\t\t fortran -> fortran program to encode the input BUFR"
"\n\t\t python -> python script to encode the input BUFR"