Line data Source code
1 1 : program test_num
2 :
3 1 : use test_support
4 : use test_brent
5 : use test_newuoa
6 : use test_bobyqa
7 : use test_newton
8 : !use test_radau5_pollu, only: do_test_radau5_pollu
9 : !use test_radau5_hires, only: do_test_radau5_hires
10 : use test_int_support
11 :
12 : use test_beam
13 : use test_chemakzo
14 : use test_medakzo
15 : use test_vdpol
16 :
17 : use test_diffusion
18 : use test_simplex
19 :
20 : use test_integrate
21 :
22 : use const_def
23 : use const_lib, only: const_init
24 : use num_def
25 : use mtx_lib
26 : use mtx_def
27 : use utils_lib, only: mesa_error
28 :
29 : implicit none
30 :
31 : logical, parameter :: show_all = .false. ! false for releases
32 :
33 : integer :: i, decsol, ierr
34 : logical :: do_numerical_jacobian, m_band, j_band, quiet
35 : character(len=32) :: my_mesa_dir
36 :
37 1 : my_mesa_dir = '../..'
38 1 : call const_init(my_mesa_dir, ierr)
39 1 : if (ierr /= 0) then
40 0 : write (*, *) 'const_init failed'
41 0 : call mesa_error(__FILE__, __LINE__)
42 : end if
43 1 : call math_init()
44 :
45 1 : quiet = .false.
46 1 : m_band = .false.
47 1 : j_band = .false.
48 : do_numerical_jacobian = .false.
49 1 : decsol = lapack
50 :
51 : ! newton solver
52 1 : do_numerical_jacobian = .false.
53 :
54 1 : write (*, *) 'call do_test_newton lapack'
55 1 : call do_test_newton(do_numerical_jacobian, lapack)
56 :
57 1 : write (*, *) 'call do_test_newton block_thomas_dble'
58 1 : call do_test_newton(do_numerical_jacobian, block_thomas_dble)
59 :
60 1 : write (*, *) 'call test_find0_quadratic'
61 1 : call test_find0_quadratic
62 :
63 1 : write (*, *) 'call test_find_max_quadratic'
64 1 : call test_find_max_quadratic
65 :
66 1 : write (*, *) 'call test_qsort'
67 1 : call test_qsort
68 :
69 1 : write (*, *) 'call do_test_newuoa'
70 1 : call do_test_newuoa
71 :
72 1 : write (*, *) 'call do_test_bobyqa'
73 1 : call do_test_bobyqa
74 :
75 1 : write (*, *) 'call do_test_simplex'
76 1 : call do_test_simplex
77 :
78 1 : write (*, *) 'call do_test_brent'
79 1 : call do_test_brent
80 :
81 1 : write (*, *) 'call test_binary_search'
82 1 : call test_binary_search
83 :
84 1 : write (*, *) 'call test_root routines'
85 1 : call test_root_with_brackets
86 1 : call test_root2
87 1 : call test_root3
88 :
89 : ! explicit solvers
90 1 : call test_dopri(.false., show_all)
91 1 : call test_dopri(.true., show_all)
92 :
93 : ! test each implicit solver with dense matrix
94 : ! ijob M J test
95 : ! 1 I F vdpol
96 1 : write (*, *) 'ijob 1'
97 : decsol = lapack
98 1 : write (*, *) 'numerical jacobians'
99 1 : do_numerical_jacobian = .true.
100 8 : do i = 1, num_solvers
101 8 : call do_test_vdpol(i, decsol, do_numerical_jacobian, show_all, quiet)
102 : end do
103 :
104 1 : write (*, *) 'analytical jacobians'
105 1 : do_numerical_jacobian = .false.
106 8 : do i = 1, num_solvers
107 8 : call do_test_vdpol(i, decsol, do_numerical_jacobian, show_all, quiet)
108 : end do
109 :
110 : ! test each implicit solver with banded matrix
111 : ! ijob M J test
112 : ! 2 I B medakzo
113 1 : write (*, *) 'ijob 2'
114 : decsol = lapack
115 1 : write (*, *) 'numerical jacobians'
116 1 : do_numerical_jacobian = .true.
117 8 : do i = 1, num_solvers
118 7 : if (i <= ros3p_solver) cycle
119 8 : call do_test_medakzo(i, decsol, do_numerical_jacobian, show_all, quiet)
120 : end do
121 :
122 1 : write (*, *) 'analytical jacobians'
123 1 : do_numerical_jacobian = .false.
124 8 : do i = 1, num_solvers
125 7 : if (i <= ros3p_solver) cycle
126 8 : call do_test_medakzo(i, decsol, do_numerical_jacobian, show_all, quiet)
127 : end do
128 :
129 : ! as of dec, 2013, non-identity mass matrix causes diff results with ifort vs gfortran
130 : ! ! test each implicit solver with banded implicit ODE system and dense matrix
131 : ! ! ijob M J test
132 : ! ! 3 B F chemakzo
133 : ! write(*,*) 'ijob 3'
134 : ! decsol = lapack
135 : ! do i=1,num_solvers
136 : ! m_band = .true.
137 : ! if (i <= ros3p_solver) cycle
138 : ! call do_test_chemakzo(i,decsol,m_band,do_numerical_jacobian,show_all,quiet)
139 : ! end do
140 : !
141 : !
142 : ! ! each implicit solver with full implicit ODE system
143 : ! ! ijob M J test
144 : ! ! 5 F F chemakzo
145 : ! write(*,*) 'ijob 5'
146 : ! decsol = lapack
147 : ! do i=1,num_solvers
148 : ! m_band = .false.
149 : ! if (i <= ros3p_solver) cycle
150 : ! call do_test_chemakzo(i,decsol,m_band,do_numerical_jacobian,show_all,quiet)
151 : ! end do
152 :
153 : ! test with m1 /= 0
154 : ! ijob M J test
155 : ! 11 I F x beam
156 1 : write (*, *) 'ijob 11'
157 : decsol = lapack
158 : if (show_all) then
159 : do i = 1, num_solvers
160 : if (i <= ros3pl_solver) cycle ! beam is too hard for these
161 : call do_test_beam(i, decsol, .true., show_all, quiet)
162 : end do
163 : end if
164 :
165 : ! test solvers with tridiagonal jacobian
166 : decsol = lapack
167 1 : do_numerical_jacobian = .false.
168 1 : quiet = .false.
169 8 : do i = 1, num_solvers
170 8 : call do_test_diffusion(i, decsol, do_numerical_jacobian, show_all, quiet)
171 : end do
172 :
173 1 : write (*, *) 'call test_integrate routines'
174 1 : call run_test_integrate()
175 :
176 1 : end program test_num
|
