ECC-269: refactoring and eliminate compiler warnings

This commit is contained in:
Shahram Najm 2016-06-16 13:57:00 +01:00
parent 73248a3260
commit 74f0f63e5f
2 changed files with 16 additions and 23 deletions

View File

@ -829,19 +829,17 @@ subroutine codes_get_string ( gribid, key, value, status )
end subroutine codes_get_string end subroutine codes_get_string
subroutine codes_get_string_array ( gribid, key, value, status ) subroutine codes_get_string_array ( gribid, key, value, status )
integer(kind=kindOfInt), intent(in) :: gribid integer(kind=kindOfInt), intent(in) :: gribid
character(len=*), intent(in) :: key character(len=*), intent(in) :: key
character(len=*), dimension(:),allocatable,intent(inout) :: value character(len=*), dimension(:),allocatable,intent(inout) :: value
character :: cvalue(size(value)*len(value(0))) integer(kind=kindOfInt),optional, intent(out) :: status
integer(kind=kindOfInt),optional, intent(out) :: status
character :: cvalue(size(value)*len(value(0)))
integer(kind=kindOfInt) :: iret integer(kind=kindOfInt) :: iret
integer(kind=kindOfInt) :: nb_values integer(kind=kindOfInt) :: nb_values
integer(kind=kindOfInt) :: slen integer(kind=kindOfInt) :: slen
integer(kind=kindOfInt) :: size_value
integer(kind=kindOfInt) :: i,s,j integer(kind=kindOfInt) :: i,s,j
if (allocated(value) .eqv. .false.) then if (allocated(value) .eqv. .false.) then
iret=CODES_NULL_POINTER iret=CODES_NULL_POINTER
if (present(status)) then if (present(status)) then
@ -855,14 +853,10 @@ subroutine codes_get_string_array ( gribid, key, value, status )
slen=len(value(0)) slen=len(value(0))
iret=grib_f_get_string_array ( gribid, key, cvalue , nb_values, slen ) iret=grib_f_get_string_array ( gribid, key, cvalue , nb_values, slen )
value=transfer(cvalue,value) value=transfer(cvalue,value)
if (iret==0 .and. nb_values==1 .and. size_value/=1) then
do i=2,size_value if (iret /= 0) then
value(i)=value(1) call grib_f_write_on_fail(gribid)
enddo
endif endif
if (iret /= 0) then
call grib_f_write_on_fail(gribid)
endif
if (present(status)) then if (present(status)) then
status = iret status = iret
else else

View File

@ -162,7 +162,7 @@ static void czstr_to_fortran(char* str,int len)
*p=' '; *p=' ';
} }
static void czstr_to_fortran_replace0(char* str,int len) /*static void czstr_to_fortran_replace0(char* str,int len)
{ {
char *p,*end; char *p,*end;
p=str; end=str+len-1; p=str; end=str+len-1;
@ -170,7 +170,7 @@ static void czstr_to_fortran_replace0(char* str,int len)
if (*p=='\0') *p=' '; if (*p=='\0') *p=' ';
p++; p++;
} }
} }*/
static void fort_char_clean(char* str,int len) static void fort_char_clean(char* str,int len)
{ {
@ -2708,8 +2708,8 @@ int grib_f_set_real8_array(int* gid, char* key, double *val, int* size, int len)
} }
/*****************************************************************************/ /*****************************************************************************/
int grib_f_get_string_array_(int* gid, char* key, unsigned char* val,int* nvals,int* slen,int len,int len2){ int grib_f_get_string_array_(int* gid, char* key, char* val,int* nvals,int* slen,int len,int len2)
{
grib_handle *h = get_handle(*gid); grib_handle *h = get_handle(*gid);
int err = GRIB_SUCCESS; int err = GRIB_SUCCESS;
size_t i; size_t i;
@ -2720,7 +2720,6 @@ int grib_f_get_string_array_(int* gid, char* key, unsigned char* val,int* nvals,
if(!h) return GRIB_INVALID_GRIB; if(!h) return GRIB_INVALID_GRIB;
cval=(char**)grib_context_malloc_clear(h->context,sizeof(char*)*lsize); cval=(char**)grib_context_malloc_clear(h->context,sizeof(char*)*lsize);
err = grib_get_string_array(h, cast_char(buf,key,len), cval, &lsize); err = grib_get_string_array(h, cast_char(buf,key,len), cval, &lsize);
if (err) return err; if (err) return err;
@ -2728,9 +2727,9 @@ int grib_f_get_string_array_(int* gid, char* key, unsigned char* val,int* nvals,
if (strlen(cval[0])>*slen) err=GRIB_ARRAY_TOO_SMALL; if (strlen(cval[0])>*slen) err=GRIB_ARRAY_TOO_SMALL;
for (i=0;i<lsize;i++) { for (i=0;i<lsize;i++) {
memcpy(p,cval[i],*slen); memcpy(p,cval[i],*slen);
czstr_to_fortran(p,*slen); czstr_to_fortran(p,*slen);
p+= *slen; p+= *slen;
} }
grib_context_free(h->context,cval); grib_context_free(h->context,cval);
/*remember to deallocate each string*/ /*remember to deallocate each string*/
@ -2738,10 +2737,10 @@ int grib_f_get_string_array_(int* gid, char* key, unsigned char* val,int* nvals,
return err; return err;
} }
int grib_f_get_string_array__(int* gid, char* key, unsigned char* val,int* nvals,int* slen, int len,int len2){ int grib_f_get_string_array__(int* gid, char* key, char* val,int* nvals,int* slen, int len,int len2){
return grib_f_get_string_array_( gid, key, val,nvals,slen,len,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){ int grib_f_get_string_array(int* gid, char* key, char* val,int* nvals,int* slen, int len,int len2){
return grib_f_get_string_array_( gid, key, val, nvals, slen, len,len2); return grib_f_get_string_array_( gid, key, val, nvals, slen, len,len2);
} }