Fix codes_copy_key in Fortran

This commit is contained in:
Shahram Najm 2016-11-10 16:33:38 +00:00
parent e914d7ac9b
commit c5b2132413
4 changed files with 38 additions and 20 deletions

View File

@ -2607,21 +2607,28 @@ subroutine codes_datetime_to_julian ( year,month,day,hour,minute,second,jd, stat
endif
end subroutine codes_datetime_to_julian
!> Copy the value of a key from the source message to the destination message
!>
!> In case of error, if the status parameter (optional) is not given, the program will
!> exit with an error message.\n Otherwise the error message can be
!> gathered with @ref grib_get_error_string.
!>
!> @param msgid_src source message
!> @param msgid_dest destination message
!> @param key key whose value is to be copied
!> @param status GRIB_SUCCESS if OK, integer value on error
subroutine codes_copy_key( msgid_src, key, msgid_dest, status )
integer(kind=kindOfInt), intent(in) :: msgid_src
integer(kind=kindOfInt), intent(in) :: msgid_dest
character(LEN=*), intent(in) :: key
integer(kind=kindOfInt),optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
subroutine codes_copy_key( msgin,msgout, key,type, status )
integer(kind=kindOfInt), intent(in) :: msgin,msgout,type
character(len=*), intent(in) :: key
integer(kind=kindOfInt),optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
iret=grib_f_copy_key ( msgin,msgout, key, type, status )
if (iret /= 0) then
if (present(status)) then
status = iret
else
call grib_check(iret,'codes_copy_key',key)
endif
return
iret=grib_f_copy_key(msgid_src, key, msgid_dest)
if (present(status)) then
status = iret
else
call grib_check(iret,'codes_copy_key','('//key//')')
endif
end subroutine codes_copy_key

View File

@ -1519,7 +1519,6 @@
!> gathered with @ref grib_get_error_string.
!>
!>
!>
!> @param gribid_src source message
!> @param gribid_dest destination message
!> @param namespace namespace to be copied

View File

@ -1364,18 +1364,26 @@ int grib_f_clone(int* gidsrc,int* giddest){
}
/*****************************************************************************/
int grib_f_copy_key_(int* gidsrc,int* giddest,const char* key,int *type,int len){
char buf[512]={0,};
int grib_f_copy_key_(int* gidsrc, char* key, int* giddest, int len)
{
grib_handle *src = get_handle(*gidsrc);
grib_handle *dest = get_handle(*giddest);
if(src!=NULL && dest!=NULL){
if(src && dest) {
char buf[1024]={0,};
char* ckey = (char*)key;
return codes_copy_key(src,dest,cast_char(buf,ckey,len),*type);
const int type = GRIB_TYPE_UNDEFINED; /* will be computed */
return codes_copy_key(src, dest, cast_char(buf,ckey,len), type);
}
return GRIB_INVALID_GRIB;
}
int grib_f_copy_key__(int* gidsrc, char* name, int* giddest, int len){
return grib_f_copy_key_(gidsrc, name, giddest, len);
}
int grib_f_copy_key(int* gidsrc, char* name, int* giddest, int len){
return grib_f_copy_key_(gidsrc, name, giddest, len);
}
/*****************************************************************************/
int grib_f_util_sections_copy_(int* gidfrom,int* gidto,int* what,int *gidout){
int err=0;
@ -2798,7 +2806,6 @@ int codes_f_bufr_copy_data_(int* gid1,int* gid2)
return err;
}
int codes_f_bufr_copy_data__(int* gid1,int* gid2){
return codes_f_bufr_copy_data_(gid1, gid2);
}

View File

@ -109,6 +109,11 @@ int grib_f_util_sections_copy(int *gidfrom, int *gidto, int *what, int *gidout);
int grib_f_copy_namespace_(int *gidsrc, char *name, int *giddest, int len);
int grib_f_copy_namespace__(int *gidsrc, char *name, int *giddest, int len);
int grib_f_copy_namespace(int *gidsrc, char *name, int *giddest, int len);
int grib_f_copy_key_ (int *gidsrc, char *name, int *giddest, int len);
int grib_f_copy_key__(int *gidsrc, char *name, int *giddest, int len);
int grib_f_copy_key (int *gidsrc, char *name, int *giddest, int len);
int grib_f_count_in_file(int *fid, int *n);
int grib_f_count_in_file_(int *fid, int *n);
int grib_f_count_in_file__(int *fid, int *n);