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

Testing: F90 Increase coverage

This commit is contained in:
Shahram Najm 2023-12-30 14:17:26 +00:00
parent f765050284
commit abd4d80d2a
5 changed files with 89 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
examples/F90/CMakeLists.txt
View File

@ -14,6 +14,7 @@ if( HAVE_BUILD_TOOLS )
codes_f90_misc
grib_set_pv
grib_set_data
grib_set_data_force
bufr_ecc-1284
bufr_ecc-1019
get_native_type
@ -70,6 +71,7 @@ else()
list( APPEND tests_sanity
grib_set_pv
grib_set_data
grib_set_data_force
codes_set_paths
codes_f90_misc
get_native_type

50
examples/F90/grib_set_data_force.f90 Normal file
View File

@ -0,0 +1,50 @@
! (C) Copyright 2005- 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.
!
!
program set_data_force
use eccodes
implicit none
integer :: outfile
integer :: i, igrib, iret, numberOfValues, cnt
real :: d, e
real, dimension(:), allocatable :: values
integer, parameter :: max_strsize = 200
character(len=max_strsize) :: outfile_name
call getarg(1, outfile_name)
call codes_open_file(outfile, outfile_name, 'w')
call codes_grib_new_from_samples(igrib, 'regular_ll_pl_grib1')
call codes_get_size(igrib, 'values', numberOfValues)
allocate (values(numberOfValues), stat=iret)
d = 10e-8
e = d
cnt = 1
do i = 1, numberOfValues
if (cnt > 100) then
e = e*10
cnt = 1
end if
values(i) = d
d = d + e
cnt = cnt + 1
end do
call codes_set(igrib, 'bitsPerValue', 16)
call codes_set(igrib, 'bitmapPresent', 1)
! set data values
call codes_set_force(igrib, 'codedValues', values)
call codes_write(igrib, outfile)
call codes_release(igrib)
deallocate (values)
end program set_data_force

16
examples/F90/grib_set_data_force.sh Executable file
View File

@ -0,0 +1,16 @@
#!/bin/sh
# (C) Copyright 2005- 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.ctest.sh
OUT=temp.f_grib_set_data_force.out.grib
${examples_dir}/eccodes_f_grib_set_data_force $OUT
rm -f $OUT

31
fortran/grib_f90_tail.f90
View File

@ -2665,12 +2665,12 @@
!> @param value real(8) array value
!> @param status GRIB_SUCCESS if OK, integer value on error
subroutine grib_set_force_real8_array(gribid, key, value, status)
integer(kind=kindOfInt), intent(in) :: gribid
character(len=*), intent(in) :: key
real(kind=kindOfDouble), dimension(:), intent(in) :: value
integer(kind=kindOfInt), optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
integer(kind=kindOfInt) :: nb_values
integer(kind=kindOfInt), intent(in) :: gribid
character(len=*), intent(in) :: key
real(kind=kindOfDouble), dimension(:), intent(in) :: value
integer(kind=kindOfInt), optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
integer(kind=kindOfInt) :: nb_values
nb_values = size(value)
iret = grib_f_set_force_real8_array(gribid, key, value, nb_values)
@ -2696,10 +2696,10 @@
!> @param status GRIB_SUCCESS if OK, integer value on error
subroutine grib_set_string(gribid, key, value, status)
integer(kind=kindOfInt), intent(in) :: gribid
character(len=*), intent(in) :: key
character(len=*), intent(in) :: value
character(len=*), intent(in) :: key
character(len=*), intent(in) :: value
integer(kind=kindOfInt), optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
integer(kind=kindOfInt) :: iret
iret = grib_f_set_string(gribid, key, value)
if (iret /= 0) then
@ -2722,8 +2722,8 @@
!> @param nbytes size in bytes of the message
!> @param status GRIB_SUCCESS if OK, integer value on error
subroutine grib_get_message_size_int(gribid, nbytes, status)
integer(kind=kindOfInt), intent(in) :: gribid
integer(kind=kindOfInt), intent(out) :: nbytes
integer(kind=kindOfInt), intent(in) :: gribid
integer(kind=kindOfInt), intent(out) :: nbytes
integer(kind=kindOfInt), optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
integer(kind=kindOfSize_t) :: ibytes
@ -2753,10 +2753,10 @@
!> @param nbytes size in bytes of the message
!> @param status GRIB_SUCCESS if OK, integer value on error
subroutine grib_get_message_size_size_t(gribid, nbytes, status)
integer(kind=kindOfInt), intent(in) :: gribid
integer(kind=kindOfInt), intent(in) :: gribid
integer(kind=kindOfSize_t), intent(out) :: nbytes
integer(kind=kindOfInt), optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
integer(kind=kindOfInt) :: iret
iret = grib_f_get_message_size(gribid, nbytes)
if (iret /= 0) then
@ -2779,7 +2779,7 @@
!> @param message array containing the coded message to be copied
!> @param status GRIB_SUCCESS if OK, integer value on error
subroutine grib_copy_message(gribid, message, status)
integer(kind=kindOfInt), intent(in) :: gribid
integer(kind=kindOfInt), intent(in) :: gribid
character(len=1), dimension(:), intent(out) :: message
integer(kind=kindOfInt), optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
@ -2810,7 +2810,6 @@
integer(kind=kindOfInt), intent(in) :: gribid
integer(kind=kindOfInt), intent(in) :: ifile
integer(kind=kindOfInt), optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
iret = grib_f_write(gribid, ifile)
@ -2834,7 +2833,7 @@
integer(kind=kindOfInt), intent(in) :: multigribid
integer(kind=kindOfInt), intent(in) :: ifile
integer(kind=kindOfInt), optional, intent(out) :: status
integer(kind=kindOfInt) :: iret
integer(kind=kindOfInt) :: iret
iret = grib_f_multi_write(multigribid, ifile)
if (present(status)) then

11
fortran/grib_fortran.c
View File

@ -2182,9 +2182,6 @@ int grib_f_set_missing_(int* gid, char* key,int len){
return grib_set_missing(h, cast_char(buf,key,len));
}
int grib_f_set_missing(int* gid, char* key, int len){
return grib_f_set_missing_( gid, key, len);
}
int grib_f_is_missing_(int* gid, char* key,int* isMissing,int len){
int err=0;
@ -2273,6 +2270,7 @@ int grib_f_get_real4_(int* gid, char* key, float* val, int len){
return err;
}
/*****************************************************************************/
int grib_f_get_real4_array_(int* gid, char* key, float* val, int* size, int len)
{
/* See ECC-1579:
@ -2325,6 +2323,7 @@ int grib_f_set_force_real4_array_(int* gid, char* key, float* val, int* size, in
char buf[1024];
size_t lsize = *size;
double* val8 = NULL;
size_t numElements = lsize;
if(!h) return GRIB_INVALID_GRIB;
@ -2335,7 +2334,7 @@ int grib_f_set_force_real4_array_(int* gid, char* key, float* val, int* size, in
if(!val8) return GRIB_OUT_OF_MEMORY;
for(lsize=0;lsize<*size;lsize++)
for (lsize = 0; lsize < numElements; lsize++)
val8[lsize] = val[lsize];
err = grib_set_force_double_array(h, cast_char(buf,key,len), val8, lsize);
@ -2445,6 +2444,7 @@ int grib_f_get_real8_(int* gid, char* key, double* val, int len)
return grib_get_double(h, cast_char(buf,key,len), val);
}
/*****************************************************************************/
int grib_f_get_real8_element_(int* gid, char* key,int* index, double* val, int len){
grib_handle *h = get_handle(*gid);
@ -2540,6 +2540,7 @@ int grib_f_get_real8_array_(int* gid, char* key, double*val, int* size, int len)
}
}
/*****************************************************************************/
int grib_f_set_force_real8_array_(int* gid, char* key, double*val, int* size, int len){
grib_handle *h = get_handle(*gid);
@ -2781,7 +2782,7 @@ int grib_f_write_(int* gid, int* fid) {
grib_get_message(h,&mess,&mess_len);
if(fwrite(mess,1, mess_len,f) != mess_len) {
perror("grib_write");
perror("write");
return GRIB_IO_PROBLEM;
}