From 3f8ee854c4889e06387dc76b9b35cd3b87c0f13f Mon Sep 17 00:00:00 2001
From: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
Date: Wed, 28 Sep 2022 11:29:59 +0200
Subject: [PATCH] Simplified VFC probes in Fortran

---
 tools/qmckl_probes.c     | 38 ------------------------
 tools/qmckl_probes_f.f90 | 64 ++++++++++++++++++++++++++++++----------
 2 files changed, 48 insertions(+), 54 deletions(-)

diff --git a/tools/qmckl_probes.c b/tools/qmckl_probes.c
index 7ac31c2..42b7632 100644
--- a/tools/qmckl_probes.c
+++ b/tools/qmckl_probes.c
@@ -101,41 +101,3 @@ void __attribute__((destructor)) qmckl_dump_probes(){
 }
 #endif
 
-
-// Fortran wrappers
-
-bool qmckl_probe_f(
-    char * testName,
-    char * varName,
-    double * value
-) {
-    return qmckl_probe(testName, varName, *value);
-}
-
-
-bool qmckl_probe_check_f(
-    char * testName,
-    char * varName,
-    double * value,
-    double * expectedValue,
-    double * accuracyTarget
-) {
-    return qmckl_probe_check(
-        testName, varName,
-        *value, *expectedValue, *accuracyTarget
-    );
-}
-
-
-bool qmckl_probe_check_relative_f(
-    char * testName,
-    char * varName,
-    double * value,
-    double * expectedValue,
-    double * accuracyTarget
-) {
-    return qmckl_probe_check_relative(
-        testName, varName,
-        *value, *expectedValue, *accuracyTarget
-    );
-}
diff --git a/tools/qmckl_probes_f.f90 b/tools/qmckl_probes_f.f90
index 700f961..c405253 100644
--- a/tools/qmckl_probes_f.f90
+++ b/tools/qmckl_probes_f.f90
@@ -1,8 +1,8 @@
 module qmckl_probes_f
     interface
-        logical(c_bool) function qmckl_probe &
+        logical(c_bool) function qmckl_probe_c &
              (testName, varName, val) &
-             bind(C, name="qmckl_probe_f")
+             bind(C, name="qmckl_probe")
 
             use, intrinsic :: iso_c_binding
             import
@@ -11,12 +11,12 @@ module qmckl_probes_f
             character(C_CHAR), dimension(*) :: testName
             character(C_CHAR), dimension(*) :: varName
 
-            real(C_DOUBLE) :: val
-        end function qmckl_probe
+            real(C_DOUBLE), value :: val
+        end function qmckl_probe_c
 
-        logical(c_bool) function qmckl_probe_check &
+        logical(c_bool) function qmckl_probe_check_c &
              (testName, varName, val, expectedValue, accuracyTarget) &
-             bind(C, name="qmckl_probe_check_f")
+             bind(C, name="qmckl_probe_check")
 
             use, intrinsic :: iso_c_binding
             import
@@ -25,14 +25,14 @@ module qmckl_probes_f
             character(C_CHAR), dimension(*) :: testName
             character(C_CHAR), dimension(*) :: varName
 
-            real(C_DOUBLE) :: val
-            real(C_DOUBLE) :: expectedValue
-            real(C_DOUBLE) :: accuracyTarget
-        end function qmckl_probe_check
+            real(C_DOUBLE), value :: val
+            real(C_DOUBLE), value :: expectedValue
+            real(C_DOUBLE), value :: accuracyTarget
+        end function qmckl_probe_check_c
 
-        logical(c_bool) function qmckl_probe_check_relative &
+        logical(c_bool) function qmckl_probe_check_relative_c &
              (testName, varName, val, expectedValue, accuracyTarget) &
-             bind(C, name="qmckl_probe_check_relative_f")
+             bind(C, name="qmckl_probe_check_relative")
 
             use, intrinsic :: iso_c_binding
             import
@@ -41,9 +41,41 @@ module qmckl_probes_f
             character(C_CHAR), dimension(*) :: testName
             character(C_CHAR), dimension(*) :: varName
 
-            real(C_DOUBLE) :: val
-            real(C_DOUBLE) :: expectedValue
-            real(C_DOUBLE) :: accuracyTarget
-        end function qmckl_probe_check_relative
+            real(C_DOUBLE), value :: val
+            real(C_DOUBLE), value :: expectedValue
+            real(C_DOUBLE), value :: accuracyTarget
+        end function qmckl_probe_check_relative_c
     end interface
+
+    logical function qmckl_probe (testName, varName, val)
+        implicit none
+        character, dimension(*) :: testName
+        character, dimension(*) :: varName
+        double precision        :: val
+        return qmckl_probe_c(testName//C_NULL_CHAR, varName//C_NULL_CHAR, val)
+    end function qmckl_probe
+
+    logical function qmckl_probe_check
+         (testName, varName, val, expectedValue, accuracyTarget)
+        implicit none
+        character, dimension(*) :: testName
+        character, dimension(*) :: varName
+        double precision        :: val
+        double precision        :: expectedValue
+        double precision        :: accuracyTarget
+        return qmckl_probe_check_c(testName//C_NULL_CHAR, varName//C_NULL_CHAR, &
+            val, expectedValue, accuracyTarget)
+    end function qmckl_probe_check
+
+    logical function qmckl_probe_check_relative &
+         (testName, varName, val, expectedValue, accuracyTarget)
+        implicit none
+        character, dimension(*) :: testName
+        character, dimension(*) :: varName
+        double precision        :: val
+        double precision        :: expectedValue
+        double precision        :: accuracyTarget
+        return qmckl_probe_check_relative_c(testName//C_NULL_CHAR, varName//C_NULL_CHAR, &
+            val, expectedValue, accuracyTarget)
+    end function qmckl_probe_check_relative
 end module qmckl_probes_f