Testing: Fortran nearest

examples/F90/CMakeLists.txt

@@ -37,6 +37,7 @@ if( HAVE_BUILD_TOOLS )
           grib_elements
           grib_nearest
           grib_nearest_single
+          grib_nearest_four_single
           grib_precision
           grib_print_data
           grib_set_keys
@@ -90,6 +91,7 @@ else()
           grib_nearest
           grib_elements
           grib_nearest_single
+          grib_nearest_four_single
           grib_precision
           grib_print_data
           grib_set_missing

examples/F90/grib_nearest_four_single.f90

@@ -0,0 +1,31 @@
+! (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 find_nearest_4single
+   use eccodes
+   implicit none
+   integer :: infile, i
+   integer :: igrib
+   real(8) :: inlat = 5, inlon = 10
+   real(8) :: outlats(4), outlons(4)
+   real(8) :: values(4), distances(4)
+   integer(kind=kindOfInt)  :: indexes(4)
+
+   call codes_open_file(infile, '../../data/reduced_gaussian_lsm.grib1', 'r')
+   call codes_grib_new_from_file(infile, igrib)
+
+   call codes_grib_find_nearest_four_single(igrib, .true., inlat, inlon, outlats, outlons, values, distances, indexes)
+   call codes_release(igrib)
+
+   call codes_close_file(infile)
+
+   print *, '   outlats   outlons  values    distances  indexes'
+   do i = 1, 4
+      write (*, '(F10.3, F10.3, F10.5, F10.3, I8)') outlats(i), outlons(i), values(i), distances(i), indexes(i)
+   end do
+end program

examples/F90/grib_nearest_four_single.sh

@@ -0,0 +1,12 @@
+#!/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
+
+${examples_dir}/eccodes_f_grib_nearest_four_single

examples/F90/grib_set_data_force.f90

@@ -13,7 +13,8 @@ program set_data_force
    integer                         :: outfile
    integer                         :: i, igrib, iret, numberOfValues, cnt
    real                            :: d, e
-   real, dimension(:), allocatable :: values
+   real(4), dimension(:), allocatable :: values_real4
+   real(8), dimension(:), allocatable :: values_real8
    integer, parameter              :: max_strsize = 200
    character(len=max_strsize)      :: outfile_name
 
@@ -24,7 +25,8 @@ program set_data_force
 
    call codes_get_size(igrib, 'values', numberOfValues)
 
-   allocate (values(numberOfValues), stat=iret)
+   allocate (values_real4(numberOfValues), stat=iret)
+   allocate (values_real8(numberOfValues), stat=iret)
    d = 10e-8
    e = d
    cnt = 1
@@ -33,7 +35,8 @@ program set_data_force
          e = e*10
          cnt = 1
       end if
-      values(i) = d
+      values_real4(i) = d
+      values_real8(i) = d
       d = d + e
       cnt = cnt + 1
    end do
@@ -42,9 +45,11 @@ program set_data_force
    call codes_set(igrib, 'bitmapPresent', 1)
 
    ! set data values
-   call codes_set_force(igrib, 'codedValues', values)
+   call codes_set_force(igrib, 'codedValues', values_real4)
+   call codes_set_force(igrib, 'codedValues', values_real8)
    call codes_write(igrib, outfile)
    call codes_release(igrib)
-   deallocate (values)
+   deallocate (values_real4)
+   deallocate (values_real8)
 
 end program set_data_force