From 23854304362a69c605a61a14d5932085d161c412 Mon Sep 17 00:00:00 2001
From: Shahram Najm <masn@ecmwf.int>
Date: Fri, 5 Jan 2024 18:57:22 +0000
Subject: [PATCH] Testing: Fortran nearest

---
 examples/F90/CMakeLists.txt               |  2 ++
 examples/F90/grib_nearest_four_single.f90 | 31 +++++++++++++++++++++++
 examples/F90/grib_nearest_four_single.sh  | 12 +++++++++
 examples/F90/grib_set_data_force.f90      | 15 +++++++----
 4 files changed, 55 insertions(+), 5 deletions(-)
 create mode 100644 examples/F90/grib_nearest_four_single.f90
 create mode 100755 examples/F90/grib_nearest_four_single.sh

diff --git a/examples/F90/CMakeLists.txt b/examples/F90/CMakeLists.txt
index 880a47f37..738ccec6e 100644
--- a/examples/F90/CMakeLists.txt
+++ b/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
diff --git a/examples/F90/grib_nearest_four_single.f90 b/examples/F90/grib_nearest_four_single.f90
new file mode 100644
index 000000000..674745bfd
--- /dev/null
+++ b/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
diff --git a/examples/F90/grib_nearest_four_single.sh b/examples/F90/grib_nearest_four_single.sh
new file mode 100755
index 000000000..22b07624f
--- /dev/null
+++ b/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
diff --git a/examples/F90/grib_set_data_force.f90 b/examples/F90/grib_set_data_force.f90
index a5a3db2fc..d8762e649 100644
--- a/examples/F90/grib_set_data_force.f90
+++ b/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