From abd4d80d2af224fce155f2d12812580c46dc3ebc Mon Sep 17 00:00:00 2001 From: Shahram Najm Date: Sat, 30 Dec 2023 14:17:26 +0000 Subject: [PATCH] Testing: F90 Increase coverage --- examples/F90/CMakeLists.txt | 2 ++ examples/F90/grib_set_data_force.f90 | 50 ++++++++++++++++++++++++++++ examples/F90/grib_set_data_force.sh | 16 +++++++++ fortran/grib_f90_tail.f90 | 31 +++++++++-------- fortran/grib_fortran.c | 11 +++--- 5 files changed, 89 insertions(+), 21 deletions(-) create mode 100644 examples/F90/grib_set_data_force.f90 create mode 100755 examples/F90/grib_set_data_force.sh diff --git a/examples/F90/CMakeLists.txt b/examples/F90/CMakeLists.txt index cf5f42450..4ef373c4c 100644 --- a/examples/F90/CMakeLists.txt +++ b/examples/F90/CMakeLists.txt @@ -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 diff --git a/examples/F90/grib_set_data_force.f90 b/examples/F90/grib_set_data_force.f90 new file mode 100644 index 000000000..a5a3db2fc --- /dev/null +++ b/examples/F90/grib_set_data_force.f90 @@ -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 diff --git a/examples/F90/grib_set_data_force.sh b/examples/F90/grib_set_data_force.sh new file mode 100755 index 000000000..d4f357b3a --- /dev/null +++ b/examples/F90/grib_set_data_force.sh @@ -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 diff --git a/fortran/grib_f90_tail.f90 b/fortran/grib_f90_tail.f90 index 2d5c274ca..ddaad835f 100644 --- a/fortran/grib_f90_tail.f90 +++ b/fortran/grib_f90_tail.f90 @@ -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 diff --git a/fortran/grib_fortran.c b/fortran/grib_fortran.c index 9f227c166..1d1ec0d57 100644 --- a/fortran/grib_fortran.c +++ b/fortran/grib_fortran.c @@ -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; }