mirror of https://github.com/ecmwf/eccodes.git
Merge branch 'develop' of ssh://software.ecmwf.int:7999/eccodes/eccodes into develop
This commit is contained in:
Shahram Najm
commit
55427dfc18
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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");
|
||||
}
|
||||
|
|
@ -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, },
|
||||
|
|
|
|||
|
|
@ -72,9 +72,9 @@ static grib_expression_class _grib_expression_class_is_in_dict = {
|
|||
&init_class, /* init_class */
|
||||
0, /* constructor */
|
||||
0, /* destructor */
|
||||
&print,
|
||||
&compile,
|
||||
&add_dependency,
|
||||
&print,
|
||||
&compile,
|
||||
&add_dependency,
|
||||
|
||||
&native_type,
|
||||
&get_name,
|
||||
|
|
|
|||
|
|
@ -74,9 +74,9 @@ static grib_expression_class _grib_expression_class_is_in_list = {
|
|||
&init_class, /* init_class */
|
||||
0, /* constructor */
|
||||
&destroy, /* destructor */
|
||||
&print,
|
||||
&compile,
|
||||
&add_dependency,
|
||||
&print,
|
||||
&compile,
|
||||
&add_dependency,
|
||||
|
||||
&native_type,
|
||||
&get_name,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
Loading…
Reference in New Issue