TREX
/
qmckl
mirror of https://github.com/TREX-CoE/qmckl.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Simplified VFC probes in Fortran

This commit is contained in:
Anthony Scemama 2022-09-28 11:29:59 +02:00
parent f2875ed133
commit 3f8ee854c4
2 changed files with 48 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
tools/qmckl_probes.c
View File

@ -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
);
}

64
tools/qmckl_probes_f.f90
View File

@ -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