1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
! ------------------------------------------------------------------
! Programmer(s): Cody J. Balos @ LLNL
! ------------------------------------------------------------------
! SUNDIALS Copyright Start
! Copyright (c) 2002-2022, Lawrence Livermore National Security
! and Southern Methodist University.
! All rights reserved.
!
! See the top-level LICENSE and NOTICE files for details.
!
! SPDX-License-Identifier: BSD-3-Clause
! SUNDIALS Copyright End
! ------------------------------------------------------------------
! Tests the ARKButcherTable F2003 interface.
! ------------------------------------------------------------------
module test_arkode_butcher_table
contains
integer function smoke_tests() result(ret)
!======== Inclusions ==========
use, intrinsic :: iso_c_binding
use farkode_mod
!======== Declarations ========
implicit none
type(c_ptr) :: ERK, DIRK
integer(C_INT) :: ierr, q(1), p(1)
integer(C_LONG_long) :: liw(1), lrw(1)
real(C_DOUBLE) :: b(2), c(2), d(2), A(4)
!===== Setup ====
! ARKODE_HEUN_EULER_2_1_2
A = 0.d0
b = 0.d0
c = 0.d0
d = 0.d0
A(3) = 1.0d0
b(1) = 0.5d0
b(2) = 0.5d0
c(2) = 1.0d0
d(1) = 1.0d0
!===== Test =====
ERK = FARkodeButcherTable_LoadERK(ARKODE_HEUN_EULER_2_1_2)
DIRK = FARkodeButcherTable_LoadDIRK(ARKODE_SDIRK_2_1_2)
ierr = FARkodeButcherTable_CheckOrder(ERK, q, p, C_NULL_PTR)
ierr = FARkodeButcherTable_CheckARKOrder(ERK, DIRK, q, p, C_NULL_PTR)
call FARKodeButcherTable_Space(ERK, liw, lrw)
call FARKodeButcherTable_Free(ERK)
call FARKodeButcherTable_Free(DIRK)
ERK = FARkodeButcherTable_Create(2, 2, 1, c, A, b, d)
DIRK = FARkodeButcherTable_Alloc(2, 1)
call FARKodeButcherTable_Free(DIRK)
DIRK = FARkodeButcherTable_Copy(ERK)
!==== Cleanup =====
call FARKodeButcherTable_Free(ERK)
call FARKodeButcherTable_Free(DIRK)
ret = 0
end function smoke_tests
end module
program main
!======== Inclusions ==========
use, intrinsic :: iso_c_binding
use test_arkode_butcher_table
!======== Declarations ========
implicit none
integer :: fails = 0
!============== Introduction =============
print *, 'ARKodeButcherTable Fortran 2003 interface test'
fails = smoke_tests()
if (fails /= 0) then
print *, 'FAILURE: smoke tests failed'
stop 1
else
print *, 'SUCCESS: smoke tests passed'
end if
end program main
|
