TST: Add R283 tests and modular functions for tests in Fortran and C.

test/common.f90

@@ -0,0 +1,37 @@
+module test__common
+    use iso_c_binding
+    implicit none
+
+contains
+
+function roundn(x, n)result(r)bind(C)
+    implicit none
+    real(c_double), intent(in), value :: x
+    integer(c_int), intent(in), value :: n
+    real(c_double) :: r
+    real(c_double) :: fac
+
+    fac = 10**n
+    r = nint(x*fac, kind=kind(x)) / fac
+
+end function
+
+function assertEqual(x1, x2, n)result(r)bind(C, name="assertEqual")
+    implicit none
+    real(c_double), intent(in), value :: x1
+    real(c_double), intent(in), value :: x2
+    integer(c_int), intent(in), value :: n
+    logical(c_bool) :: r
+
+    real(c_double) :: fac
+    real(c_double) :: ix1
+    real(c_double) :: ix2
+
+    fac = 10**n
+    ix1 = nint(x1 * fac, kind=kind(n))
+    ix2 = nint(x2 * fac, kind=kind(n))
+    r = ix1 == ix2
+
+end function
+
+end module

test/common.h

@@ -0,0 +1,6 @@
+#ifndef COMMON_H
+#define COMMON_H
+#include <stdbool.h>
+extern double roundn(double x, int n);
+extern bool assertEqual(double x1, double x2, int n);
+#endif

test/test_g704.f90

@@ -1,5 +1,6 @@
 program test_g704
     use iso_fortran_env
+    use test__common
     use iapws__g704
     implicit none
 
@@ -13,36 +14,6 @@ program test_g704
 
 contains
 
-pure elemental function roundn(x, n)result(r)
-    implicit none
-    real(real64), intent(in) :: x
-    integer(int32), intent(in) :: n
-    real(real64) :: r
-    real(real64) :: fac
-
-    fac = 10**n
-    r = nint(x*fac, kind=kind(x)) / fac
-end function
-
- function assertEqual(x1, x2, n)result(r)
-    implicit none
-    real(real64), intent(in) :: x1
-    real(real64), intent(in) :: x2
-    integer(int32), intent(in) :: n
-    logical :: r
-
-    real(real64) :: fac
-    real(real64) :: ix1
-    real(real64) :: ix2
-
-    fac = 10**n
-    ix1 = nint(x1 * fac, kind=kind(n))
-    ix2 = nint(x2 * fac, kind=kind(n))
-    r = ix1 == ix2
-
-
-end function
-
 subroutine test_ngases()
     implicit none 
 

test/test_g704_capi.c

@@ -3,30 +3,9 @@
 #include <math.h>
 #include <string.h>
 #include "iapws_g704.h"
+#include "common.h"
 
 
-static double roundn(double x, int n){
-    double fac;
-    double rounded_x;
-    fac = pow(10, n);
-    rounded_x = round(x*fac)/fac;
-    return rounded_x;
-}
-
-static int assertEqual(double x1, double x2, int n){
-    int r;
-
-    double fac;
-    double ix1, ix2;
-
-    fac = pow(10, n);
-    ix1 = round(x1 * fac);
-    ix2 = round(x2 * fac);
-
-    r = ix1 == ix2;
-
-    return r;
-}
 
 void test_ngases(void){
 

test/test_r283.f90

@@ -1,44 +1,19 @@
 program test_r283
     use iso_fortran_env
+    use test__common
     use iapws__r283
     implicit none
 
     print "(A)", "***** TESTING FORTRAN CODE FOR R283 *****"
     call test_Tc_H2O()
     call test_Tc_D2O()
+    call test_pc_H2O()
+    call test_pc_D2O()
+    call test_rhoc_H2O()
+    call test_rhoc_D2O()
 
 contains
 
-pure elemental function roundn(x, n)result(r)
-    implicit none
-    real(real64), intent(in) :: x
-    integer(int32), intent(in) :: n
-    real(real64) :: r
-    real(real64) :: fac
-
-    fac = 10**n
-    r = nint(x*fac, kind=kind(x)) / fac
-end function
-
- function assertEqual(x1, x2, n)result(r)
-    implicit none
-    real(real64), intent(in) :: x1
-    real(real64), intent(in) :: x2
-    integer(int32), intent(in) :: n
-    logical :: r
-
-    real(real64) :: fac
-    real(real64) :: ix1
-    real(real64) :: ix2
-
-    fac = 10**n
-    ix1 = nint(x1 * fac, kind=kind(n))
-    ix2 = nint(x2 * fac, kind=kind(n))
-    r = ix1 == ix2
-
-
-end function
-
 subroutine test_Tc_H2O()
     implicit none 
 
@@ -67,7 +42,7 @@ subroutine test_Tc_D2O()
     real(real64) :: expected
     real(real64) :: diff
 
-    write(*, "(4X, A)", advance="no") "Tc in H2O..."
+    write(*, "(4X, A)", advance="no") "Tc in D2O..."
 
     expected = 643.847d0
     value = iapws_r283_Tc_D2O 
@@ -81,4 +56,88 @@ subroutine test_Tc_D2O()
     endif
 end subroutine
 
+subroutine test_pc_H2O()
+    implicit none 
+
+    real(real64) :: value
+    real(real64) :: expected
+    real(real64) :: diff
+
+    write(*, "(4X, A)", advance="no") "pc in H2O..."
+
+    expected = 22.064d0
+    value = iapws_r283_pc_H2O 
+    diff = value - expected;
+    if(diff /= 0)then
+        write(*, "(A)", advance="yes") "Failed"
+        write(*, "(4X, ES23.16, A1, ES23.16, A1, ES23.16)", advance="yes") value, "/", expected, "/", diff
+        stop 1
+    else
+        write(*, "(A)", advance="yes") "OK"
+    endif
+end subroutine
+
+subroutine test_pc_D2O()
+    implicit none 
+
+    real(real64) :: value
+    real(real64) :: expected
+    real(real64) :: diff
+
+    write(*, "(4X, A)", advance="no") "pc in D2O..."
+
+    expected = 21.671d0
+    value = iapws_r283_pc_D2O 
+    diff = value - expected;
+    if(diff /= 0)then
+        write(*, "(A)", advance="yes") "Failed"
+        write(*, "(4X, ES23.16, A1, ES23.16, A1, ES23.16)", advance="yes") value, "/", expected, "/", diff
+        stop 1
+    else
+        write(*, "(A)", advance="yes") "OK"
+    endif
+end subroutine
+
+subroutine test_rhoc_H2O()
+    implicit none 
+
+    real(real64) :: value
+    real(real64) :: expected
+    real(real64) :: diff
+
+    write(*, "(4X, A)", advance="no") "rhoc in H2O..."
+
+    expected = 322.0d0
+    value = iapws_r283_rhoc_H2O
+    diff = value - expected;
+    if(diff /= 0)then
+        write(*, "(A)", advance="yes") "Failed"
+        write(*, "(4X, ES23.16, A1, ES23.16, A1, ES23.16)", advance="yes") value, "/", expected, "/", diff
+        stop 1
+    else
+        write(*, "(A)", advance="yes") "OK"
+    endif
+end subroutine
+
+subroutine test_rhoc_D2O()
+    implicit none 
+
+    real(real64) :: value
+    real(real64) :: expected
+    real(real64) :: diff
+
+    write(*, "(4X, A)", advance="no") "rhoc in D2O..."
+
+    expected = 356.0d0
+    value = iapws_r283_rhoc_D2O
+    diff = value - expected;
+    if(diff /= 0)then
+        write(*, "(A)", advance="yes") "Failed"
+        write(*, "(4X, ES23.16, A1, ES23.16, A1, ES23.16)", advance="yes") value, "/", expected, "/", diff
+        stop 1
+    else
+        write(*, "(A)", advance="yes") "OK"
+    endif
+end subroutine
+
 end program