diff --git a/afivo/examples/advection.f90 b/afivo/examples/advection.f90 index ab309fbc..e73736f7 100644 --- a/afivo/examples/advection.f90 +++ b/afivo/examples/advection.f90 @@ -237,6 +237,7 @@ subroutine forward_euler(tree, dt, dt_stiff, dt_lim, time, s_deriv, n_prev, & integer, intent(in) :: s_out integer, intent(in) :: i_step, n_steps integer :: lvl, i, id + real(dp) :: all_dt(1) select case (flux_method) case ("generic") @@ -245,8 +246,9 @@ subroutine forward_euler(tree, dt, dt_stiff, dt_lim, time, s_deriv, n_prev, & flux_dummy_conversion, flux_dummy_conversion, af_limiter_koren_t) case ("upwind") call flux_upwind_tree(tree, 1, [i_phi], s_deriv, [i_flux], & - dt_lim, flux_upwind, flux_direction, & + 1, all_dt, flux_upwind, flux_direction, & flux_dummy_line_modify, af_limiter_koren_t) + dt_lim = all_dt(1) case ("custom") ! Ensure ghost cells near refinement boundaries can be properly filled call af_restrict_ref_boundary(tree, [i_phi+s_deriv]) @@ -271,8 +273,8 @@ subroutine forward_euler(tree, dt, dt_stiff, dt_lim, time, s_deriv, n_prev, & error stop "Unknown flux_method, choices: generic, upwind, custom" end select - call flux_update_densities(tree, dt, 1, [i_phi], [i_flux], & - s_deriv, n_prev, s_prev, w_prev, s_out, flux_dummy_source) + call flux_update_densities(tree, dt, 1, [i_phi], 1, [i_phi], [i_flux], & + s_deriv, n_prev, s_prev, w_prev, s_out, flux_dummy_source, 0, all_dt) end subroutine forward_euler @@ -332,7 +334,8 @@ subroutine get_flux(n_values, n_var, flux_dim, u, flux, box, line_ix, s_deriv) flux = u * velocity(flux_dim) end subroutine get_flux - subroutine flux_upwind(nf, n_var, flux_dim, u, flux, cfl_sum, box, line_ix, s_deriv) + subroutine flux_upwind(nf, n_var, flux_dim, u, flux, cfl_sum, & + n_other_dt, other_dt, box, line_ix, s_deriv) integer, intent(in) :: nf !< Number of cell faces integer, intent(in) :: n_var !< Number of variables integer, intent(in) :: flux_dim !< In which dimension fluxes are computed @@ -340,6 +343,8 @@ subroutine flux_upwind(nf, n_var, flux_dim, u, flux, cfl_sum, box, line_ix, s_de real(dp), intent(out) :: flux(nf, n_var) !< Computed fluxes !> Terms per cell-center to be added to CFL sum, see flux_upwind_box real(dp), intent(out) :: cfl_sum(nf-1) + integer, intent(in) :: n_other_dt !< Number of non-cfl time step restrictions + real(dp), intent(inout) :: other_dt(n_other_dt) !< Non-cfl time step restrictions type(box_t), intent(in) :: box !< Current box integer, intent(in) :: line_ix(NDIM-1) !< Index of line for dim /= flux_dim integer, intent(in) :: s_deriv !< State to compute derivatives from @@ -351,15 +356,16 @@ subroutine flux_upwind(nf, n_var, flux_dim, u, flux, cfl_sum, box, line_ix, s_de cfl_sum = tmp end subroutine flux_upwind - subroutine flux_direction(box, line_ix, s_deriv, flux_dim, direction_positive) + subroutine flux_direction(box, line_ix, s_deriv, n_var, flux_dim, direction_positive) type(box_t), intent(in) :: box !< Current box integer, intent(in) :: line_ix(NDIM-1) !< Index of line for dim /= flux_dim integer, intent(in) :: s_deriv !< State to compute derivatives from + integer, intent(in) :: n_var !< Number of variables integer, intent(in) :: flux_dim !< In which dimension fluxes are computed !> True means positive flow (to the "right"), false to the left - logical, intent(out) :: direction_positive(box%n_cell+1) + logical, intent(out) :: direction_positive(box%n_cell+1, n_var) - direction_positive(:) = (velocity(flux_dim) > 0) + direction_positive(:, 1) = (velocity(flux_dim) > 0) end subroutine flux_direction end program diff --git a/afivo/examples/compressible_flow_wall.f90 b/afivo/examples/compressible_flow_wall.f90 index 6b1e3ff3..28c44c2b 100644 --- a/afivo/examples/compressible_flow_wall.f90 +++ b/afivo/examples/compressible_flow_wall.f90 @@ -122,14 +122,26 @@ subroutine forward_euler(tree, dt, dt_stiff, dt_lim, time, s_deriv, n_prev, & real(dp), intent(in) :: w_prev(n_prev) !< Weights of previous states integer, intent(in) :: s_out integer, intent(in) :: i_step, n_steps + real(dp) :: dummy_dt(0) call flux_generic_tree(tree, n_vars, variables, s_deriv, fluxes, dt_lim, & max_wavespeed, get_fluxes, flux_dummy_modify, line_modify, & to_primitive, to_conservative, af_limiter_vanleer_t) - call flux_update_densities(tree, dt, n_vars, variables, fluxes, & - s_deriv, n_prev, s_prev, w_prev, s_out, flux_dummy_source, i_lsf) + call flux_update_densities(tree, dt, n_vars, variables, n_vars, variables, fluxes, & + s_deriv, n_prev, s_prev, w_prev, s_out, flux_dummy_source, 0, dummy_dt, & + set_box_mask) end subroutine forward_euler + !> Set a mask to true where the solution should be updated + subroutine set_box_mask(box, mask) + type(box_t), intent(in) :: box + logical, intent(out) :: mask(DTIMES(box%n_cell)) + integer :: nc + + nc = box%n_cell + mask = (box%cc(DTIMES(1:nc), i_lsf) > 0.0_dp) + end subroutine set_box_mask + subroutine set_init_conds(box) type(box_t), intent(inout) :: box integer :: IJK, nc @@ -234,18 +246,18 @@ subroutine line_modify(n_cc, n_var, cc_line, flux_dim, box, line_ix, s_deriv) integer, intent(in) :: line_ix(NDIM-1) !< Index of line for dim /= flux_dim integer, intent(in) :: s_deriv !< State to compute derivatives from - real(dp) :: lsf(0:box%n_cell+2, 1) + real(dp) :: lsf(0:box%n_cell+1) integer :: i ! Get level set function along the line of the flux computation - call flux_get_line_cc(box, [i_lsf], flux_dim, line_ix, lsf) + call flux_get_line_1cc(box, i_lsf, flux_dim, line_ix, lsf) if (all(lsf > 0)) return ! no boundary do i = 0, box%n_cell - if (lsf(i, 1) * lsf(i+1, 1) <= 0) then + if (lsf(i) * lsf(i+1) <= 0) then ! There is an interface - if (lsf(i, 1) > 0) then + if (lsf(i) > 0) then cc_line(i+1, :) = cc_line(i, :) cc_line(i+2, :) = cc_line(i-1, :) cc_line(i+1, i_mom(flux_dim)) = -cc_line(i, i_mom(flux_dim)) @@ -377,4 +389,4 @@ real(dp) function get_lsf(rr) end function get_lsf -end program compressible_flow_wall +end program diff --git a/afivo/examples/euler_gas_dynamics.f90 b/afivo/examples/euler_gas_dynamics.f90 index dc23d7be..98365943 100644 --- a/afivo/examples/euler_gas_dynamics.f90 +++ b/afivo/examples/euler_gas_dynamics.f90 @@ -176,12 +176,13 @@ subroutine forward_euler(tree, dt, dt_stiff, dt_lim, time, s_deriv, n_prev, & real(dp), intent(in) :: w_prev(n_prev) !< Weights of previous states integer, intent(in) :: s_out integer, intent(in) :: i_step, n_steps + real(dp) :: dummy_dt(0) call flux_generic_tree(tree, n_vars, variables, s_deriv, fluxes, dt_lim, & max_wavespeed, get_fluxes, flux_dummy_modify, flux_dummy_line_modify, & to_primitive, to_conservative, af_limiter_vanleer_t) - call flux_update_densities(tree, dt, n_vars, variables, fluxes, & - s_deriv, n_prev, s_prev, w_prev, s_out, flux_dummy_source) + call flux_update_densities(tree, dt, n_vars, variables, n_vars, variables, fluxes, & + s_deriv, n_prev, s_prev, w_prev, s_out, flux_dummy_source, 0, dummy_dt) end subroutine forward_euler !> [forward_euler_gasd] diff --git a/afivo/examples/incompressible_flow.f90 b/afivo/examples/incompressible_flow.f90 index aada588e..c78973a6 100644 --- a/afivo/examples/incompressible_flow.f90 +++ b/afivo/examples/incompressible_flow.f90 @@ -146,26 +146,30 @@ subroutine forward_euler(tree, dt, dt_stiff, dt_lim, time, s_deriv, n_prev, & real(dp), intent(in) :: w_prev(n_prev) !< Weights of previous states integer, intent(in) :: s_out integer, intent(in) :: i_step, n_steps - real(dp) :: tmp + real(dp) :: dummy_dt(0) call flux_generic_tree(tree, n_vars, flow_variables, s_deriv, fluxes, dt_lim, & max_wavespeed, get_flux_lr, flux_add_diffusion, flux_dummy_line_modify, & flux_dummy_conversion, flux_dummy_conversion, af_limiter_vanleer_t) - call flux_update_densities(tree, dt, n_vars, flow_variables, fluxes, & - s_deriv, n_prev, s_prev, w_prev, s_out, source_term) + call flux_update_densities(tree, dt, n_vars, flow_variables, n_vars, & + flow_variables, fluxes, s_deriv, n_prev, s_prev, w_prev, s_out, & + source_term, 0, dummy_dt) call remove_velocity_divergence(tree, flow_variables+s_out, dt) end subroutine forward_euler - subroutine source_term(box, dt, n_vars, i_cc, s_deriv, s_out) + subroutine source_term(box, dt, n_vars, i_cc, s_deriv, s_out, n_dt, dt_lim, mask) type(box_t), intent(inout) :: box real(dp), intent(in) :: dt integer, intent(in) :: n_vars integer, intent(in) :: i_cc(n_vars) integer, intent(in) :: s_deriv integer, intent(in) :: s_out + integer, intent(in) :: n_dt + real(dp), intent(inout) :: dt_lim(n_dt) + logical, intent(in) :: mask(DTIMES(box%n_cell)) integer :: nc nc = box%n_cell diff --git a/afivo/src/m_af_flux_schemes.f90 b/afivo/src/m_af_flux_schemes.f90 index cd05855c..c8ca4ac0 100644 --- a/afivo/src/m_af_flux_schemes.f90 +++ b/afivo/src/m_af_flux_schemes.f90 @@ -36,7 +36,8 @@ subroutine subr_flux(nf, n_var, flux_dim, u, flux, box, line_ix, s_deriv) integer, intent(in) :: s_deriv !< State to compute derivatives from end subroutine subr_flux - subroutine subr_flux_upwind(nf, n_var, flux_dim, u, flux, cfl_sum, box, line_ix, s_deriv) + subroutine subr_flux_upwind(nf, n_var, flux_dim, u, flux, cfl_sum, & + n_other_dt, other_dt, box, line_ix, s_deriv) import integer, intent(in) :: nf !< Number of cell faces integer, intent(in) :: n_var !< Number of variables @@ -45,9 +46,11 @@ subroutine subr_flux_upwind(nf, n_var, flux_dim, u, flux, cfl_sum, box, line_ix, real(dp), intent(out) :: flux(nf, n_var) !< Computed fluxes !> Terms per cell-center to be added to CFL sum, see flux_upwind_box real(dp), intent(out) :: cfl_sum(nf-1) + integer, intent(in) :: n_other_dt !< Number of non-cfl time step restrictions + real(dp), intent(inout) :: other_dt(n_other_dt) !< Non-cfl time step restrictions type(box_t), intent(in) :: box !< Current box integer, intent(in) :: line_ix(NDIM-1) !< Index of line for dim /= flux_dim - integer, intent(in) :: s_deriv !< State to compute derivatives from + integer, intent(in) :: s_deriv !< State to compute derivatives from end subroutine subr_flux_upwind subroutine subr_flux_modify(nf, n_var, flux_dim, flux, box, line_ix, s_deriv) @@ -61,14 +64,15 @@ subroutine subr_flux_modify(nf, n_var, flux_dim, flux, box, line_ix, s_deriv) integer, intent(in) :: s_deriv !< State to compute derivatives from end subroutine subr_flux_modify - subroutine subr_flux_dir(box, line_ix, s_deriv, flux_dim, direction_positive) + subroutine subr_flux_dir(box, line_ix, s_deriv, n_var, flux_dim, direction_positive) import type(box_t), intent(in) :: box !< Current box integer, intent(in) :: line_ix(NDIM-1) !< Index of line for dim /= flux_dim integer, intent(in) :: s_deriv !< State to compute derivatives from + integer, intent(in) :: n_var !< Number of variables integer, intent(in) :: flux_dim !< In which dimension fluxes are computed !> True means positive flow (to the "right"), false to the left - logical, intent(out) :: direction_positive(box%n_cell+1) + logical, intent(out) :: direction_positive(box%n_cell+1, n_var) end subroutine subr_flux_dir subroutine subr_line_modify(n_cc, n_var, cc_line, flux_dim, box, line_ix, s_deriv) @@ -82,15 +86,27 @@ subroutine subr_line_modify(n_cc, n_var, cc_line, flux_dim, box, line_ix, s_deri integer, intent(in) :: s_deriv !< State to compute derivatives from end subroutine subr_line_modify - subroutine subr_source(box, dt, n_vars, i_cc, s_deriv, s_out) + subroutine subr_source(box, dt, n_vars, i_cc, s_deriv, s_out, n_dt, dt_lim, mask) import type(box_t), intent(inout) :: box - real(dp), intent(in) :: dt - integer, intent(in) :: n_vars - integer, intent(in) :: i_cc(n_vars) - integer, intent(in) :: s_deriv - integer, intent(in) :: s_out + real(dp), intent(in) :: dt !< Time step + integer, intent(in) :: n_vars !< Number of cell-centered variables + integer, intent(in) :: i_cc(n_vars) !< Indices of all cell-centered variables + integer, intent(in) :: s_deriv !< State to compute derivatives from + integer, intent(in) :: s_out !< State to update + !> Number of time steps restrictions + integer, intent(in) :: n_dt + !> Maximal allowed time steps + real(dp), intent(inout) :: dt_lim(n_dt) + !> Mask where to update solution + logical, intent(in) :: mask(DTIMES(box%n_cell)) end subroutine subr_source + + subroutine subr_box_mask(box, mask) + import + type(box_t), intent(in) :: box + logical, intent(out) :: mask(DTIMES(box%n_cell)) + end subroutine subr_box_mask end interface public :: flux_diff_1d, flux_diff_2d, flux_diff_3d @@ -104,7 +120,8 @@ end subroutine subr_source public :: flux_dummy_source public :: flux_dummy_modify public :: flux_dummy_line_modify - public :: flux_get_line_cc, flux_get_line_fc + public :: flux_get_line_cc, flux_get_line_1cc + public :: flux_get_line_fc, flux_get_line_1fc contains @@ -271,21 +288,17 @@ subroutine reconstruct_upwind_1d(nc, ngc, n_vars, cc, u_f, limiter, direction_po real(dp), intent(inout) :: u_f(1:nc+1, n_vars) integer, intent(in) :: limiter !< Which limiter to use !> True means positive flow (to the "right"), false to the left - logical, intent(in) :: direction_positive(nc+1) - real(dp) :: slope(n_vars) - integer :: n + logical, intent(in) :: direction_positive(nc+1, n_vars) associate (a=>cc(1:nc+2, :) - cc(0:nc+1, :), & b=>cc(0:nc+1, :) - cc(-1:nc, :)) - do n = 1, nc+1 - if (direction_positive(n)) then - slope = af_limiter_apply(a(n, :), b(n, :), limiter) - u_f(n, :) = cc(n-1, :) + 0.5_dp * slope - else - slope = af_limiter_apply(b(n+1, :), a(n+1, :), limiter) - u_f(n, :) = cc(n, :) - 0.5_dp * slope - end if - end do + where (direction_positive) + u_f = cc(0:nc, :) + 0.5_dp * & + af_limiter_apply(a(1:nc+1, :), b(1:nc+1, :), limiter) + elsewhere + u_f = cc(1:nc+1, :) - 0.5_dp * & + af_limiter_apply(b(2:nc+2, :), a(2:nc+2, :), limiter) + end where end associate end subroutine reconstruct_upwind_1d @@ -304,13 +317,15 @@ subroutine flux_kurganovTadmor_1d(n_values, n_vars, flux_l, flux_r, & flux = 0.5_dp * (flux_l + flux_r - spread(wmax, 2, n_vars) * (u_r - u_l)) end subroutine flux_kurganovTadmor_1d - subroutine flux_update_densities(tree, dt, n_vars, i_cc, i_flux, & - s_deriv, n_prev, s_prev, w_prev, s_out, add_source_box, i_lsf) + subroutine flux_update_densities(tree, dt, n_vars, i_cc, n_vars_flux, i_cc_flux, i_flux, & + s_deriv, n_prev, s_prev, w_prev, s_out, add_source_box, n_dt, dt_lim, get_mask) type(af_t), intent(inout) :: tree real(dp), intent(in) :: dt !< Time step - integer, intent(in) :: n_vars !< Number of variables - integer, intent(in) :: i_cc(n_vars) !< Cell-centered variables - integer, intent(in) :: i_flux(n_vars) !< Flux variables + integer, intent(in) :: n_vars !< Number of cell-centered variables + integer, intent(in) :: i_cc(n_vars) !< All cell-centered indices + integer, intent(in) :: n_vars_flux !< Number of variables with fluxes + integer, intent(in) :: i_cc_flux(n_vars_flux) !< Cell-centered indices of flux variables + integer, intent(in) :: i_flux(n_vars_flux) !< Indices of fluxes integer, intent(in) :: s_deriv !< State to compute derivatives from integer, intent(in) :: n_prev !< Number of previous states integer, intent(in) :: s_prev(n_prev) !< Previous states @@ -318,16 +333,26 @@ subroutine flux_update_densities(tree, dt, n_vars, i_cc, i_flux, & integer, intent(in) :: s_out !< Output time state !> Method to include source terms procedure(subr_source) :: add_source_box - !> If present, only update in region where level set function is positive - integer, intent(in), optional :: i_lsf + !> Number of time steps restrictions + integer, intent(in) :: n_dt + !> Maximal allowed time steps + real(dp), intent(out) :: dt_lim(n_dt) + !> If present, only update where the mask is true + procedure(subr_box_mask), optional :: get_mask integer :: lvl, n, id, IJK, nc, i_var, iv - real(dp) :: dt_dr(NDIM) + logical :: mask(DTIMES(tree%n_cell)) + real(dp) :: dt_dr(NDIM), my_dt(n_dt) real(dp) :: rfac(2, tree%n_cell) nc = tree%n_cell rfac = 0.0_dp ! Prevent warnings in 3D - !$omp parallel private(lvl, n, id, IJK, dt_dr, rfac, iv) + dt_lim = 1e100_dp + + !$omp parallel private(lvl, n, id, IJK, dt_dr, i_var, rfac, iv, mask, my_dt) & + !$omp &reduction(min:dt_lim) + my_dt = 1e100_dp + do lvl = 1, tree%highest_lvl !$omp do do n = 1, size(tree%lvls(lvl)%leaves) @@ -335,6 +360,12 @@ subroutine flux_update_densities(tree, dt, n_vars, i_cc, i_flux, & dt_dr = dt/tree%boxes(id)%dr associate(cc => tree%boxes(id)%cc, fc => tree%boxes(id)%fc) + if (present(get_mask)) then + call get_mask(tree%boxes(id), mask) + else + mask = .true. + end if + do i_var = 1, n_vars iv = i_cc(i_var) do KJI_DO(1, nc) @@ -343,93 +374,54 @@ subroutine flux_update_densities(tree, dt, n_vars, i_cc, i_flux, & end do; CLOSE_DO end do - call add_source_box(tree%boxes(id), dt, n_vars, i_cc, s_deriv, s_out) + call add_source_box(tree%boxes(id), dt, n_vars, i_cc, s_deriv, & + s_out, n_dt, my_dt, mask) + dt_lim = min(dt_lim, my_dt) + #if NDIM == 1 - if (present(i_lsf)) then - do KJI_DO(1, nc) - if (cc(IJK, i_lsf) > 0) then - cc(i, i_cc+s_out) = cc(i, i_cc+s_out) + & - dt_dr(1) * & - (fc(i, 1, i_flux) - fc(i+1, 1, i_flux)) - end if - end do; CLOSE_DO - else - do KJI_DO(1, nc) - cc(i, i_cc+s_out) = cc(i, i_cc+s_out) + & + do KJI_DO(1, nc) + if (mask(IJK)) then + cc(i, i_cc_flux+s_out) = cc(i, i_cc_flux+s_out) + & dt_dr(1) * & (fc(i, 1, i_flux) - fc(i+1, 1, i_flux)) - end do; CLOSE_DO - end if -#elif NDIM == 2 - if (present(i_lsf)) then - if (tree%coord_t == af_cyl) then - call af_cyl_flux_factors(tree%boxes(id), rfac) - do KJI_DO(1, nc) - if (cc(IJK, i_lsf) > 0) then - cc(i, j, i_cc+s_out) = cc(i, j, i_cc+s_out) + & - dt_dr(1) * (& - rfac(1, i) * fc(i, j, 1, i_flux) - & - rfac(2, i) * fc(i+1, j, 1, i_flux)) & - + dt_dr(2) * & - (fc(i, j, 2, i_flux) - fc(i, j+1, 2, i_flux)) - end if - end do; CLOSE_DO - else - do KJI_DO(1, nc) - if (cc(IJK, i_lsf) > 0) then - cc(i, j, i_cc+s_out) = cc(i, j, i_cc+s_out) + & - dt_dr(1) * & - (fc(i, j, 1, i_flux) - fc(i+1, j, 1, i_flux)) & - + dt_dr(2) * & - (fc(i, j, 2, i_flux) - fc(i, j+1, 2, i_flux)) - end if - end do; CLOSE_DO end if - else - if (tree%coord_t == af_cyl) then - call af_cyl_flux_factors(tree%boxes(id), rfac) - do KJI_DO(1, nc) - cc(i, j, i_cc+s_out) = cc(i, j, i_cc+s_out) + & + end do; CLOSE_DO +#elif NDIM == 2 + if (tree%coord_t == af_cyl) then + call af_cyl_flux_factors(tree%boxes(id), rfac) + do KJI_DO(1, nc) + if (mask(IJK)) then + cc(i, j, i_cc_flux+s_out) = cc(i, j, i_cc_flux+s_out) + & dt_dr(1) * (& rfac(1, i) * fc(i, j, 1, i_flux) - & rfac(2, i) * fc(i+1, j, 1, i_flux)) & + dt_dr(2) * & (fc(i, j, 2, i_flux) - fc(i, j+1, 2, i_flux)) - end do; CLOSE_DO - else - do KJI_DO(1, nc) - cc(i, j, i_cc+s_out) = cc(i, j, i_cc+s_out) + & + end if + end do; CLOSE_DO + else + do KJI_DO(1, nc) + if (mask(IJK)) then + cc(i, j, i_cc_flux+s_out) = cc(i, j, i_cc_flux+s_out) + & dt_dr(1) * & (fc(i, j, 1, i_flux) - fc(i+1, j, 1, i_flux)) & + dt_dr(2) * & (fc(i, j, 2, i_flux) - fc(i, j+1, 2, i_flux)) - end do; CLOSE_DO - end if - end if -#elif NDIM == 3 - if (present(i_lsf)) then - do KJI_DO(1, nc) - if (cc(IJK, i_lsf) > 0) then - cc(i, j, k, i_cc+s_out) = cc(i, j, k, i_cc+s_out) + & - dt_dr(1) * & - (fc(i, j, k, 1, i_flux) - fc(i+1, j, k, 1, i_flux)) + & - dt_dr(2) * & - (fc(i, j, k, 2, i_flux) - fc(i, j+1, k, 2, i_flux)) + & - dt_dr(3) * & - (fc(i, j, k, 3, i_flux) - fc(i, j, k+1, 3, i_flux)) end if end do; CLOSE_DO - else - do KJI_DO(1, nc) - cc(i, j, k, i_cc+s_out) = cc(i, j, k, i_cc+s_out) + & + end if +#elif NDIM == 3 + do KJI_DO(1, nc) + if (mask(IJK)) then + cc(i, j, k, i_cc_flux+s_out) = cc(i, j, k, i_cc_flux+s_out) + & dt_dr(1) * & (fc(i, j, k, 1, i_flux) - fc(i+1, j, k, 1, i_flux)) + & dt_dr(2) * & (fc(i, j, k, 2, i_flux) - fc(i, j+1, k, 2, i_flux)) + & dt_dr(3) * & (fc(i, j, k, 3, i_flux) - fc(i, j, k+1, 3, i_flux)) - end do; CLOSE_DO - end if + end if + end do; CLOSE_DO #endif end associate end do @@ -465,20 +457,25 @@ subroutine flux_generic_tree(tree, n_vars, i_cc, s_deriv, i_flux, dt_lim, & procedure(subr_prim_cons) :: to_conservative !> Type of slope limiter to use for flux calculation integer, intent(in) :: limiter + real(dp) :: my_dt integer :: lvl, i ! Ensure ghost cells near refinement boundaries can be properly filled call af_restrict_ref_boundary(tree, i_cc+s_deriv) - !$omp parallel private(lvl, i) reduction(min:dt_lim) + dt_lim = 1e100_dp + my_dt = 1e100_dp + + !$omp parallel private(lvl, i, my_dt) reduction(min:dt_lim) do lvl = 1, tree%highest_lvl !$omp do do i = 1, size(tree%lvls(lvl)%leaves) call flux_generic_box(tree, tree%lvls(lvl)%leaves(i), tree%n_cell, & - n_vars, i_cc, s_deriv, i_flux, dt_lim, max_wavespeed, & + n_vars, i_cc, s_deriv, i_flux, my_dt, max_wavespeed, & flux_from_primitives, flux_modify, line_modify, & to_primitive, to_conservative, limiter) + dt_lim = min(dt_lim, my_dt) end do !$omp end do end do @@ -656,12 +653,12 @@ subroutine flux_generic_box(tree, id, nc, n_vars, i_cc, s_deriv, i_flux, dt_lim, end do ! Determine maximal time step - dt_lim = 1/maxval(cfl_sum) + dt_lim = 1/max(maxval(cfl_sum), 1e-100_dp) end subroutine flux_generic_box !> Compute upwind fluxes - subroutine flux_upwind_tree(tree, n_vars, i_cc, s_deriv, i_flux, dt_lim, & + subroutine flux_upwind_tree(tree, n_vars, i_cc, s_deriv, i_flux, n_dt, dt_lim, & flux_upwind, flux_direction, line_modify, limiter) use m_af_restrict use m_af_core @@ -670,8 +667,10 @@ subroutine flux_upwind_tree(tree, n_vars, i_cc, s_deriv, i_flux, dt_lim, & integer, intent(in) :: i_cc(n_vars) !< Cell-centered variables integer, intent(in) :: s_deriv !< State to compute derivatives from integer, intent(in) :: i_flux(n_vars) !< Flux variables - !> Maximal time step, assuming a CFL number of 1.0 - real(dp), intent(out) :: dt_lim + !> Number of time steps restrictions (first is CFL) + integer, intent(in) :: n_dt + !> Maximal allowed time steps, assuming a CFL number of 1.0 + real(dp), intent(out) :: dt_lim(n_dt) !> Method to compute fluxes procedure(subr_flux_upwind) :: flux_upwind !> Method to get direction of flux (positive or negative) @@ -680,19 +679,23 @@ subroutine flux_upwind_tree(tree, n_vars, i_cc, s_deriv, i_flux, dt_lim, & procedure(subr_line_modify) :: line_modify !> Type of slope limiter to use for flux calculation integer, intent(in) :: limiter - - integer :: lvl, i + integer :: lvl, i + real(dp) :: my_dt(n_dt) ! Ensure ghost cells near refinement boundaries can be properly filled call af_restrict_ref_boundary(tree, i_cc+s_deriv) - !$omp parallel private(lvl, i) reduction(min:dt_lim) + dt_lim = 1e100_dp + my_dt = 1e100_dp + + !$omp parallel private(lvl, i, my_dt) reduction(min:dt_lim) do lvl = 1, tree%highest_lvl !$omp do do i = 1, size(tree%lvls(lvl)%leaves) call flux_upwind_box(tree, tree%lvls(lvl)%leaves(i), tree%n_cell, & - n_vars, i_cc, s_deriv, i_flux, dt_lim, flux_upwind, & + n_vars, i_cc, s_deriv, i_flux, n_dt, my_dt, flux_upwind, & flux_direction, line_modify, limiter) + dt_lim = min(dt_lim, my_dt) end do !$omp end do end do @@ -705,7 +708,7 @@ end subroutine flux_upwind_tree !> Compute generic finite volume flux subroutine flux_upwind_box(tree, id, nc, n_vars, i_cc, s_deriv, i_flux, & - dt_lim, flux_upwind, flux_direction, line_modify, limiter) + n_dt, dt_lim, flux_upwind, flux_direction, line_modify, limiter) use m_af_types use m_af_ghostcell type(af_t), intent(inout) :: tree @@ -715,7 +718,9 @@ subroutine flux_upwind_box(tree, id, nc, n_vars, i_cc, s_deriv, i_flux, & integer, intent(in) :: i_cc(n_vars) !< Cell-centered variables integer, intent(in) :: s_deriv !< State to compute derivatives from integer, intent(in) :: i_flux(n_vars) !< Flux variables - real(dp), intent(inout) :: dt_lim !< Time step restriction + !> Number of time steps restrictions (first is CFL) + integer, intent(in) :: n_dt + real(dp), intent(inout) :: dt_lim(n_dt) !< Time step restrictions !> Method to compute fluxes procedure(subr_flux_upwind) :: flux_upwind !> Method to get direction of flux (positive or negative) @@ -730,7 +735,8 @@ subroutine flux_upwind_box(tree, id, nc, n_vars, i_cc, s_deriv, i_flux, & real(dp) :: flux(nc+1, n_vars) real(dp) :: u_l(nc+1, n_vars) real(dp) :: cfl_sum(DTIMES(nc)), cfl_sum_line(nc) - logical :: direction_positive(nc+1) + real(dp) :: other_dt(n_dt-1) + logical :: direction_positive(nc+1, n_vars) integer :: flux_dim, line_ix(NDIM-1) #if NDIM > 1 integer :: i @@ -746,6 +752,8 @@ subroutine flux_upwind_box(tree, id, nc, n_vars, i_cc, s_deriv, i_flux, & ! write dt * (vx/dx + vy/dy) < 1. This sum will then contain (vx/dx + ! vy/dy). cfl_sum = 0.0_dp + dt_lim(2:) = 1e100_dp + other_dt = 1e100_dp associate (fc => tree%boxes(id)%fc) do flux_dim = 1, NDIM @@ -781,7 +789,7 @@ subroutine flux_upwind_box(tree, id, nc, n_vars, i_cc, s_deriv, i_flux, & line_ix = [i, j] #endif call flux_direction(tree%boxes(id), line_ix, s_deriv, & - flux_dim, direction_positive) + n_vars, flux_dim, direction_positive) ! Optionally modify data, e.g. to take into account a boundary call line_modify(nc+4, n_vars, cc_line, flux_dim, & @@ -791,8 +799,9 @@ subroutine flux_upwind_box(tree, id, nc, n_vars, i_cc, s_deriv, i_flux, & call reconstruct_upwind_1d(nc, 2, n_vars, cc_line, u_l, & limiter, direction_positive) - call flux_upwind(nc+1, n_vars, flux_dim, u_l, flux, & - cfl_sum_line, tree%boxes(id), line_ix, s_deriv) + call flux_upwind(nc+1, n_vars, flux_dim, u_l, flux, cfl_sum_line, & + n_dt-1, other_dt, tree%boxes(id), line_ix, s_deriv) + dt_lim(2:) = min(dt_lim(2:), other_dt) ! Store the computed fluxes select case (flux_dim) @@ -828,8 +837,8 @@ subroutine flux_upwind_box(tree, id, nc, n_vars, i_cc, s_deriv, i_flux, & end do end associate - ! Determine maximal time step - dt_lim = 1/maxval(cfl_sum) + ! Determine maximal CFL time step + dt_lim(1) = 1/maxval(cfl_sum) end subroutine flux_upwind_box @@ -858,11 +867,41 @@ subroutine flux_get_line_cc(box, ivs, flux_dim, line_ix, cc_line) case (2) cc_line = box%cc(line_ix(1), :, line_ix(2), ivs) case (3) - cc_line = box%cc(:, line_ix(1), line_ix(2), ivs) + cc_line = box%cc(line_ix(1), line_ix(2), :, ivs) #endif end select end subroutine flux_get_line_cc + !> Extract cell-centered data along a line in a box, including a single layer + !> of ghost cells. This is convenient to get extra variables in a flux + !> computation. + subroutine flux_get_line_1cc(box, iv, flux_dim, line_ix, cc_line) + type(box_t), intent(in) :: box + integer, intent(in) :: iv !< Index of the variable + integer, intent(in) :: flux_dim !< Dimension of flux computation + integer, intent(in) :: line_ix(NDIM-1) !< Index of line + real(dp), intent(inout) :: cc_line(box%n_cell+2) + + select case (flux_dim) +#if NDIM == 1 + case (1) + cc_line = box%cc(:, iv) +#elif NDIM == 2 + case (1) + cc_line = box%cc(:, line_ix(1), iv) + case (2) + cc_line = box%cc(line_ix(1), :, iv) +#elif NDIM == 3 + case (1) + cc_line = box%cc(:, line_ix(1), line_ix(2), iv) + case (2) + cc_line = box%cc(line_ix(1), :, line_ix(2), iv) + case (3) + cc_line = box%cc(line_ix(1), line_ix(2), :, iv) +#endif + end select + end subroutine flux_get_line_1cc + !> Extract face-centered data along a line in a box. This is convenient to get !> extra variables in a flux computation. subroutine flux_get_line_fc(box, ivs, flux_dim, line_ix, fc_line) @@ -887,11 +926,40 @@ subroutine flux_get_line_fc(box, ivs, flux_dim, line_ix, fc_line) case (2) fc_line = box%fc(line_ix(1), :, line_ix(2), flux_dim, ivs) case (3) - fc_line = box%fc(:, line_ix(1), line_ix(2), flux_dim, ivs) + fc_line = box%fc(line_ix(1), line_ix(2), :, flux_dim, ivs) #endif end select end subroutine flux_get_line_fc + !> Extract face-centered data along a line in a box. This is convenient to get + !> extra variables in a flux computation. + subroutine flux_get_line_1fc(box, iv, flux_dim, line_ix, fc_line) + type(box_t), intent(in) :: box + integer, intent(in) :: iv !< Index of the variable + integer, intent(in) :: flux_dim !< Dimension of flux computation + integer, intent(in) :: line_ix(NDIM-1) !< Index of line + real(dp), intent(inout) :: fc_line(box%n_cell+1) + + select case (flux_dim) +#if NDIM == 1 + case (1) + fc_line = box%fc(:, flux_dim, iv) +#elif NDIM == 2 + case (1) + fc_line = box%fc(:, line_ix(1), flux_dim, iv) + case (2) + fc_line = box%fc(line_ix(1), :, flux_dim, iv) +#elif NDIM == 3 + case (1) + fc_line = box%fc(:, line_ix(1), line_ix(2), flux_dim, iv) + case (2) + fc_line = box%fc(line_ix(1), :, line_ix(2), flux_dim, iv) + case (3) + fc_line = box%fc(line_ix(1), line_ix(2), :, flux_dim, iv) +#endif + end select + end subroutine flux_get_line_1fc + !> Compute flux according to Koren limiter subroutine flux_koren_3d(cc, v, nc, ngc) !> Number of cells @@ -1008,13 +1076,16 @@ subroutine flux_dummy_conversion(n_values, n_vars, u) real(dp), intent(inout) :: u(n_values, n_vars) end subroutine flux_dummy_conversion - subroutine flux_dummy_source(box, dt, n_vars, i_cc, s_deriv, s_out) + subroutine flux_dummy_source(box, dt, n_vars, i_cc, s_deriv, s_out, n_dt, dt_lim, mask) type(box_t), intent(inout) :: box real(dp), intent(in) :: dt integer, intent(in) :: n_vars integer, intent(in) :: i_cc(n_vars) integer, intent(in) :: s_deriv integer, intent(in) :: s_out + integer, intent(in) :: n_dt + real(dp), intent(inout) :: dt_lim(n_dt) + logical, intent(in) :: mask(DTIMES(box%n_cell)) end subroutine flux_dummy_source subroutine flux_dummy_modify(nf, n_var, flux_dim, flux, box, line_ix, s_deriv) diff --git a/programs/dielectric_2d/tests/test_dielectric_neg_2d_rtest.log b/programs/dielectric_2d/tests/test_dielectric_neg_2d_rtest.log index 23262068..20c238e3 100644 --- a/programs/dielectric_2d/tests/test_dielectric_neg_2d_rtest.log +++ b/programs/dielectric_2d/tests/test_dielectric_neg_2d_rtest.log @@ -8,5 +8,5 @@ it time dt sum(e) sum(M_plus) sum(M_min) sum(e^2) sum(M_plus^2) sum(M_min^2) max 6 0.30000000E-008 0.90000000E-011 0.10904634E+017 0.12274251E+017 0.13696174E+016 0.42883197E+035 0.54145220E+035 0.63039435E+033 0.47501538E+019 0.52311120E+019 0.65807496E+018 7 0.35000000E-008 0.90000000E-011 0.11175288E+017 0.12696036E+017 0.15207474E+016 0.43295178E+035 0.55244570E+035 0.72948775E+033 0.50532995E+019 0.52311120E+019 0.74537228E+018 8 0.40000000E-008 0.90000000E-011 0.11579592E+017 0.13310140E+017 0.16968272E+016 0.45511607E+035 0.58016287E+035 0.85274260E+033 0.10598566E+020 0.76540523E+019 0.83223077E+018 -9 0.45000000E-008 0.71185236E-011 0.11382504E+017 0.13508545E+017 0.18593728E+016 0.43435293E+035 0.58921659E+035 0.98977697E+033 0.82126958E+019 0.86928001E+019 0.91889681E+018 -10 0.50000000E-008 0.70121536E-011 0.11215886E+017 0.13578032E+017 0.19894685E+016 0.42435346E+035 0.59067984E+035 0.11148485E+034 0.79867312E+019 0.86928001E+019 0.10026826E+019 +9 0.45000000E-008 0.70781805E-011 0.11382505E+017 0.13508542E+017 0.18593713E+016 0.43435291E+035 0.58921632E+035 0.98977552E+033 0.82126849E+019 0.86927981E+019 0.91889599E+018 +10 0.50000000E-008 0.69712640E-011 0.11215886E+017 0.13578028E+017 0.19894667E+016 0.42435339E+035 0.59067952E+035 0.11148466E+034 0.79867450E+019 0.86927981E+019 0.10026815E+019 diff --git a/programs/fixed_current_2d/channel_2d.cfg b/programs/fixed_current_2d/channel_2d.cfg new file mode 100644 index 00000000..44e134ce --- /dev/null +++ b/programs/fixed_current_2d/channel_2d.cfg @@ -0,0 +1,201 @@ + ############################################## + ### Configuration file ### + ############################################## + + # The desired endtime in seconds of the simulation: + end_time = 5e-6 + + # The number of grid cells per coordinate in a box: + box_size = 8 + + # The length of the (square) domain: +domain_len = 13.3e-3 13.3e-3 + + # Whether the domain is periodic (per dimension): + periodic = F F + +[gas] + # Gas component names: + components = 'N2' 'O2' + + # Whether the gas dynamics are simulated: + dynamics = T + # Joule heating efficiency (between 0.0 and 1.0): + heating_efficiency = 1.0000 + #slow_heating_efficiency = 0.0000E+00 + #tau_vt = 2e-5 + + # Gas component fractions: + fractions = 8.0000E-01 2.0000E-01 + + # Gas mean molecular weight (kg), for gas dynamics: + molecular_weight = 4.7824E-26 + + # The gas pressure (bar): + pressure = 1.0 + + # The gas temperature (Kelvin): + temperature = 3.0000E+02 + + # The gas pressure in bar (used for photoionization): + gas%pressure = 0.1000E+01 + +# How the electric field or voltage is specified: +field_given_by = 'voltage 2.4e4' + + # The background ion and electron density in 1/m^3: +background_density = 1.7700E+09 + +[datfile] + # Write binary output files every N outputs: + per_outputs = 50 + + # Write binary output files (to resume later): + write = T + +# Whether to compute the deposited power density: +compute_power_density = T + +user_current_control = T +user_current = 0.1 +user_relaxation_time = 5e-9 +# Initial density of the seed: +seed_density = 1e19 + +# Type of seed: neutral (0), ions (1) or electrons (-1): +seed_charge_type = 0 + +# Fall-off type for seed (sigmoid, gaussian, smoothstep, step, laser): +seed_falloff = gaussian + +# The relative start position of the initial seed: +seed_rel_r0 = 0.5 0.0 + +# The relative end position of the initial seed: +seed_rel_r1 = 0.5 1.0 + +# Seed width (m): +seed_width = 1.5e-3 + +[input_data] + # Input file with transport (and reaction) data: + #file = '../../transport_data/varyO2_transportData/BG_20O2.txt' + file = '../../transport_data/air_chemistry_v3.txt' + + # List of ion mobilities (m^2/Vs) at 1 bar, 300 K: + ion_mobilities = 2.2000E-04 2.2000E-04 2.2000E-04 2.2000E-04 2.2000E-04 2.2000E-04 2.2000E-04 + + # List of ions that are considered mobile: + mobile_ions = 'N2_plus' 'O2_plus' 'N4_plus' 'O4_plus' 'O2_min' 'O_min' 'O3_min' + + # Use old style transport data (alpha, eta, mu, D vs V/m): + old_style = F + +[table_data] + # Input interpolation method (linear, cubic_spline): + #input_interpolation = 'linear' + input_interpolation = 'linear' + + # Maximal field (in Td) for the rate coeff. lookup table: + max_townsend = 1.0000E+03 + + # Minimal field (in Td) for the rate coeff. lookup table: + min_townsend = 1.0000E+00 + + # Size of the lookup table for reaction rates: + size = 1000 + + # x-spacing for lookup table (linear, quadratic): + #xspacing = 'linear' + xspacing = 'quadratic' + +# Memory limit (GB): +memory_limit_GB = 16.0000E+00 + +[output] + # Output the conductivity of the plasma: + conductivity = T + + # The timestep for writing output (s): + dt = 5e-9 + + # To reduce output when the voltage is off: + dt_factor_pulse_off = 100 + + # Show the electron energy in eV from the local field approximation: + electron_energy = F + + # Name for the output files (e.g. output/my_sim): + name = ./retest/channel_2d + + # Print status every this many seconds: + status_delay = 1.0000E+01 + +# Whether the domain is periodic (per dimension): +periodic = F F + +[photoi] + # Whether photoionization is enabled: + enabled = T + + # Whether photoionization is enabled in gas: + enabled_ingas = T + + # Photoionization efficiency factor, typically around 0.05-0.1: + eta = 5.0000E-02 + + # Which photoionization method to use (helmholtz, montecarlo): + method = 'helmholtz' + + # Update photoionization every N time step: + per_steps = 4 + + # How to compute the photoi. source (Zheleznyak, from_species): + source_type = 'Zheleznyak' + +[photoi_helmh] + # Can be Luque (default), Bourdon-2, Bourdon-3 or custom: + author = 'Bourdon-3' + + # Maximum residual relative to max(|rhs|): + max_rel_residual = 1.0000E-02 + +# Density prolongation method (limit, linear, linear_cons, sparse): +prolong_density = 'limit' + +# Refine if alpha*dx is larger than this value: +refine_adx = 1.0000E+00 + +# For refinement, use alpha(f * E)/f, where f is this factor: +refine_adx_fac = 1.0000E+00 + +# The refinement buffer width in cells (around flagged cells): +refine_buffer_width = 4 + +# Refine if the curvature in phi is larger than this value: +refine_cphi = 1.0000E+99 + +# Refine until dx is smaller than this factor times the seed width: +refine_init_fac = 2.5000E-01 + +# Refine around initial conditions up to this time: +refine_init_time = 1.0000E-08 + +# The grid spacing will always be smaller than this value: +refine_max_dx = 4.0000E-03 + +# Minimum electron density for adding grid refinement: +refine_min_dens = -1.0000E+99 + +# The grid spacing will always be larger than this value: +refine_min_dx = 1.0000E-07 + +# Seed for random numbers; if all zero, generate randomly: +rng_seed = 8123 91234 12399 293434 + +# Write silo output: +silo_write = T + +# Boundary condition for the plasma species: +species_boundary_condition = 'neumann_zero' + diff --git a/programs/fixed_current_2d/channel_cyl.cfg b/programs/fixed_current_2d/channel_cyl.cfg new file mode 100644 index 00000000..5f41adb9 --- /dev/null +++ b/programs/fixed_current_2d/channel_cyl.cfg @@ -0,0 +1,279 @@ + ############################################## + ### Configuration file ### + ############################################## + +# background_density = 1.0000E+11 +background_density = 1.7700E+09 + +output%electron_current = T +# The number of grid cells per coordinate in a box: +box_size = 8 + +# Whether cylindrical coordinates are used (only in 2D): +cylindrical = T + +[datfile] + # Write binary output files every N outputs: + per_outputs = 50 + + # Write binary output files (to resume later): + write = T + +user_current_control = True +user_current = 0.1 +user_relaxation_time = 5e-9 +# Initial density of the seed: +seed_density = 1e19 + +# Type of seed: neutral (0), ions (1) or electrons (-1): +seed_charge_type = 0 + +# Fall-off type for seed (sigmoid, gaussian, smoothstep, step, laser): +seed_falloff = gaussian + +# The relative start position of the initial seed: +seed_rel_r0 = 0.0 0.0 + +# The relative end position of the initial seed: +seed_rel_r1 = 0.0 1.0 + +# Seed width (m): +seed_width = 1.5e-3 + +# Only derefine if grid spacing if smaller than this value: +#derefine_dx = 1.0000E-04 +derefine_dx = 1.0000E-05 + +use_electrode = F + +# The length of the domain (m): +#domain_len = 1.0000E-01 1.0000E-01 +domain_len = 13.3e-3 13.3e-3 + +# Small density for the chemistry time step: +dt_chemistry_nmin = 1.0000E+15 + +# The maximum timestep (s): +dt_max = 1.0000E-10 + +# The minimum timestep (s): +dt_min = 1.0000E-15 + +# Safety factor for the time step: +dt_safety_factor = 9.0000E-01 + +# Streamer length at which the simulation will end.: +end_streamer_length = 1.5000E-02 + +# Type of boundary condition to use (homogeneous, ...): +field_bc_type = 'homogeneous' + +# How the electric field or voltage is specified: +field_given_by = 'voltage 2.4e4' + +# The desired endtime (s) of the simulation: +end_time = 5e-6 + + +[fixes] + # Enable flux limiting, but prevent field from exceeding this value: + #drt_max_field = 1e6 + + # Use source factor to prevent unphysical effects due to diffusion: + source_factor = 'flux' + + # Whether to write the source factor to the output: + write_source_factor = F + +[gas] + # Gas component names: + components = 'N2' 'O2' + + # Whether the gas dynamics are simulated: + dynamics = T + # Joule heating efficiency (between 0.0 and 1.0): + heating_efficiency = 1.0000 + #slow_heating_efficiency = 0.0000E+00 + #tau_vt = 2e-5 + + # Gas component fractions: + fractions = 8.0000E-01 2.0000E-01 + + # Gas mean molecular weight (kg), for gas dynamics: + molecular_weight = 4.7824E-26 + + # The gas pressure (bar): + pressure = 1.0 + + # The gas temperature (Kelvin): + temperature = 3.0000E+02 + + +# Number of simulation steps to wait before initializing "the starting position of the streamer: +initial_streamer_pos_steps_wait = 5 + +[input_data] + # Input file with transport (and reaction) data: + #file = '../../transport_data/varyO2_transportData/BG_20O2.txt' + file = '../../transport_data/air_chemistry_v3.txt' + + # List of ion mobilities (m^2/Vs) at 1 bar, 300 K: + ion_mobilities = 2.2000E-04 2.2000E-04 2.2000E-04 2.2000E-04 2.2000E-04 2.2000E-04 2.2000E-04 + + # List of ions that are considered mobile: + mobile_ions = 'N2_plus' 'O2_plus' 'N4_plus' 'O4_plus' 'O2_min' 'O_min' 'O3_min' + + # Use old style transport data (alpha, eta, mu, D vs V/m): + old_style = F + +[table_data] + # Input interpolation method (linear, cubic_spline): + #input_interpolation = 'linear' + input_interpolation = 'linear' + + # Maximal field (in Td) for the rate coeff. lookup table: + max_townsend = 1.0000E+03 + + # Minimal field (in Td) for the rate coeff. lookup table: + min_townsend = 1.0000E+00 + + # Size of the lookup table for reaction rates: + size = 1000 + + # x-spacing for lookup table (linear, quadratic): + #xspacing = 'linear' + xspacing = 'quadratic' + +# Memory limit (GB): +memory_limit_GB = 16.0000E+00 + +[output] + # Output the conductivity of the plasma: + conductivity = T + + # The timestep for writing output (s): + dt = 1e-9 + + # To reduce output when the voltage is off: + dt_factor_pulse_off = 100 + + # Show the electron energy in eV from the local field approximation: + electron_energy = F + + # Name for the output files (e.g. output/my_sim): + name = ./retest/channel_cyl + + # Print status every this many seconds: + status_delay = 1.0000E+01 + +# Whether the domain is periodic (per dimension): +periodic = F F + +[photoi] + # Whether photoionization is enabled: + enabled = T + + # Whether photoionization is enabled in gas: + enabled_ingas = T + + # Photoionization efficiency factor, typically around 0.05-0.1: + eta = 5.0000E-02 + + # Which photoionization method to use (helmholtz, montecarlo): + method = 'helmholtz' + + # Update photoionization every N time step: + per_steps = 4 + + # How to compute the photoi. source (Zheleznyak, from_species): + source_type = 'Zheleznyak' + +[photoi_helmh] + # Can be Luque (default), Bourdon-2, Bourdon-3 or custom: + author = 'Bourdon-3' + + # Maximum residual relative to max(|rhs|): + max_rel_residual = 1.0000E-02 + +# Density prolongation method (limit, linear, linear_cons, sparse): +prolong_density = 'limit' + +# Refine if alpha*dx is larger than this value: +refine_adx = 1.0000E+00 + +# For refinement, use alpha(f * E)/f, where f is this factor: +refine_adx_fac = 1.0000E+00 + +# The refinement buffer width in cells (around flagged cells): +refine_buffer_width = 4 + +# Refine if the curvature in phi is larger than this value: +refine_cphi = 1.0000E+99 + + +# Refine until dx is smaller than this factor times the seed width: +refine_init_fac = 2.5000E-01 + +# Refine around initial conditions up to this time: +refine_init_time = 1.0000E-08 + +# Refine regions at most up to this grid spacing: +refine_limits_dr = 1.0000E+99 + +# Maximum coordinate of the refinement limits: +refine_limits_rmax = 0.0000E+00 0.0000E+00 + +# Minimum coordinate of the refinement limits: +refine_limits_rmin = 0.0000E+00 0.0000E+00 + +# The grid spacing will always be smaller than this value: +#refine_max_dx = 1.0000E-04 +refine_max_dx = 2e-3 + +# Minimum electron density for adding grid refinement: + +refine_min_dens = -1.0000E+99 + +# The grid spacing will always be larger than this value: +refine_min_dx = 1.0000E-07 + +# The number of steps after which the mesh is updated: +refine_per_steps = 2 + +# Refine regions up to this grid spacing: + #refine_regions_dr = 50e-6 + refine_regions_dr = 100e-6 + +# # Maximum coordinate of the refinement regions: + refine_regions_rmax = 2e-3 14e-3 + +# # Minimum coordinate of the refinement regions: + refine_regions_rmin = 0.0000E+00 0.0000E+00 + +# Refine regions up to this simulation time: +refine_regions_tstop = 1.0000E+99 + + +# Seed for random numbers; if all zero, generate randomly: +rng_seed = 8123 91234 12399 293434 + +[silo] + # Write silo output files every N outputs: + per_outputs = 1 + +# Write silo output: +silo_write = T + +# Boundary condition for the plasma species: +species_boundary_condition = 'neumann_zero' + + +# Time integrator (use arbitrary value to see options): +time_integrator = 'heuns_method' + + +# The size of the coarse grid: +coarse_grid_size = -1 -1 + +# Whether to compute the deposited power density: +compute_power_density = T diff --git a/programs/fixed_current_2d/m_user.f90 b/programs/fixed_current_2d/m_user.f90 index 86d6aeeb..605f99ae 100644 --- a/programs/fixed_current_2d/m_user.f90 +++ b/programs/fixed_current_2d/m_user.f90 @@ -9,6 +9,7 @@ module m_user real(dp) :: desired_current = 0.1_dp real(dp) :: relaxation_time = 5e-9_dp + logical :: current_control = .false. ! Public methods public :: user_initialize @@ -20,6 +21,15 @@ subroutine user_initialize(cfg, tree) type(af_t), intent(inout) :: tree user_field_amplitude => my_field_amplitude + call CFG_add_get(cfg, "user_current_control", current_control, & + "Whether to use current control") + if (current_control) then + user_field_amplitude => my_field_amplitude + end if + call CFG_add_get(cfg, "user_current", desired_current, & + "Supplying the desired current") + call CFG_add_get(cfg, "user_relaxation_time", relaxation_time, & + "Supplying the relaxation time for current control") user_log_variables => add_log_variables end subroutine user_initialize @@ -31,6 +41,7 @@ real(dp) function my_field_amplitude(tree, time) real(dp), intent(in) :: time real(dp) :: resistance, goal_voltage, voltage_change, dt + real(dp) :: total_current integer, save :: counter = 0 real(dp), save :: prev_time = 0 @@ -43,6 +54,10 @@ real(dp) function my_field_amplitude(tree, time) else ! Estimate resistance resistance = current_voltage/ST_global_current + else ! Estimate resistance + + total_current = ST_global_displ_current + ST_global_JdotE_current + resistance = -current_voltage/total_current goal_voltage = desired_current * resistance voltage_change = (goal_voltage - current_voltage) * dt / relaxation_time @@ -50,7 +65,7 @@ real(dp) function my_field_amplitude(tree, time) counter = counter + 1 if (modulo(counter, 100) == 0) then - print *, time, ST_global_current, my_field_amplitude, resistance + print *, "time, current, field, resistance", time, total_current, my_field_amplitude, resistance end if end if @@ -67,10 +82,13 @@ subroutine add_log_variables(tree, n_vars, var_names, var_values) n_vars = 2 - var_names(1) = 'current' - var_values(1) = ST_global_current + var_names(1) = 'displ_current' + var_values(1) = ST_global_displ_current var_names(2) = 'power_deposited' call af_tree_sum_cc(tree, i_power_density, var_values(2)) + n_vars = n_vars+1 + var_names(3) = 'JdotE_current' + var_values(3) = ST_global_JdotE_current !var_names(3) = 'Je_x' !call af_tree_sum_cc(tree, af_find_cc_variable(tree,"Je_1"), var_values(3)) !var_names(4) = 'Je_y' diff --git a/programs/fixed_current_2d/streamer_cyl_rod_cone_electrode.cfg b/programs/fixed_current_2d/streamer_cyl_rod_cone_electrode.cfg index 0d6dc04c..71e3370f 100644 --- a/programs/fixed_current_2d/streamer_cyl_rod_cone_electrode.cfg +++ b/programs/fixed_current_2d/streamer_cyl_rod_cone_electrode.cfg @@ -34,7 +34,7 @@ field_electrode_type = rod_cone_top cylindrical = T # The desired endtime in seconds of the simulation: - end_time = 8e-9 + end_time = 50e-9 # The name of the simulation: output%name = output/streamer_cyl_electrode @@ -48,8 +48,7 @@ field_electrode_type = rod_cone_top # The gas pressure in bar (used for photoionization): gas%pressure = 0.1000E+01 - # The applied electric field: - field_amplitude = -.2000E+07 + field_given_by = voltage 27e3 # The background ion and electron density in 1/m^3: background_density = 0.1000E+15 diff --git a/programs/heating_2d/hema_benchmark.cfg b/programs/heating_2d/hema_benchmark.cfg index cad6585a..b8f04670 100644 --- a/programs/heating_2d/hema_benchmark.cfg +++ b/programs/heating_2d/hema_benchmark.cfg @@ -16,12 +16,12 @@ # # Fallof type for seed, see m_geom.f90: # seed_falloff = gaussian - gradient_type = sphere - shock_width = 0.05 - density_ratio = 0.5 - sphere_center = 0.0 0.5 - sphere_radius = 0.1 - density_ratio_inside_sphere = T + # gradient_type = sphere + # shock_width = 0.05 + # density_ratio = 0.5 + # sphere_center = 0.0 0.5 + # sphere_radius = 0.1 + # density_ratio_inside_sphere = T #restart_from_file = 'evenMoreResults/case_1bar_1_000020.dat' # The background ion and electron density (1/m3): @@ -129,7 +129,11 @@ field_tip_radius = 6.6500E-06 # Whether the gas dynamics are simulated: dynamics = T +<<<<<<< HEAD heating_efficiency = 0.3 +======= + fast_heating_efficiency = 1.0 +>>>>>>> new_flux # Gas component fractions: fractions = 8.0000E-01 2.0000E-01 diff --git a/programs/heating_2d/hema_benchmark_hotspot.cfg b/programs/heating_2d/hema_benchmark_hotspot.cfg index 5bbb3f7b..b23c128b 100644 --- a/programs/heating_2d/hema_benchmark_hotspot.cfg +++ b/programs/heating_2d/hema_benchmark_hotspot.cfg @@ -11,13 +11,9 @@ #density_ratio = 0.5 #line_coeff = -0.6 0 1.0 - # # Initial density of the seed: - # seed_density = 1e14 - - # # Type of seed: neutral (0), ions (1) or electrons (-1) - # seed_charge_type = 0 - - # # The relative start position of the initial seed: + # Initial density of the seed: + # seed_density = 1e20 + # The relative start position of the initial seed: # seed_rel_r0 = 0. 0.50 # # The relative end position of the initial seed: @@ -202,7 +198,7 @@ memory_limit_GB = 16.0000E+00 dt = 5.0000E-10 # To reduce output when the voltage is off: - dt_factor_pulse_off = 1 + dt_factor_pulse_off = 100 # Show the electron energy in eV from the local field approximation: electron_energy = T diff --git a/programs/standard_1d/tests/test_1d_chemistry_rtest.log b/programs/standard_1d/tests/test_1d_chemistry_rtest.log index bb6ebff2..efc42a26 100644 --- a/programs/standard_1d/tests/test_1d_chemistry_rtest.log +++ b/programs/standard_1d/tests/test_1d_chemistry_rtest.log @@ -4,39 +4,39 @@ it time dt sum(e) sum(N2_star_J) sum(O2_star_J) sum(N2_star_v1) sum(N2_star_v2) 2 0.50000000E-009 0.64789956E-010 0.19623372E+015 0.31234687E+016 0.19310428E+013 0.41834655E+016 0.22316349E+016 0.15145736E+016 0.10107129E+016 0.82879185E+015 0.67846176E+015 0.35718184E+015 0.16581964E+015 0.37018873E+015 0.16537833E+015 0.89995407E+014 0.51238441E+014 0.51019785E+015 0.11392940E+016 0.74885900E+015 0.51555557E+015 0.42808221E+014 0.20748658E+015 0.79252264E+014 0.13790829E+015 0.40759794E+015 0.40464532E+015 0.27937938E+016 0.93881862E+015 0.16505157E+015 0.13605456E+014 0.84100688E+014 0.98526550E+012 0.11114003E+014 0.37742547E+011 0.11302856E+008 0.29339201E+013 0.26180508E+002 0.43161695E+003 0.12999032E+002 0.82157820E+011 0.43398883E+001 0.73567216E+010 0.29645114E-008 0.73415128E-002 0.10241300E+015 0.15922943E+005 0.34338452E+007 0.32112227E-007 0.10109614E+001 0.17564270E+006 0.11113631E+004 0.65038606E+013 0.17173469E+013 0.19438180E+005 0.80002143E-014 0.11581143E-029 0.42705053E-023 0.63673195E+030 0.16062650E+033 0.61394765E+026 0.28814750E+033 0.81995377E+032 0.37767998E+032 0.16818931E+032 0.11309240E+032 0.75786649E+031 0.21004878E+031 0.45270255E+030 0.22562281E+031 0.45029146E+030 0.13334498E+030 0.43224283E+029 0.42860244E+031 0.21387116E+032 0.92328488E+031 0.43782583E+031 0.30171925E+029 0.70878749E+030 0.10340187E+030 0.31312520E+030 0.27351876E+031 0.26957282E+031 0.12850537E+033 0.14513641E+032 0.44898173E+030 0.30574380E+028 0.11617944E+030 0.15980383E+026 0.20337465E+028 0.23487866E+023 0.21064694E+016 0.14189168E+027 0.11781190E+005 0.31841740E+007 0.28906975E+004 0.11127941E+024 0.32389081E+003 0.89228985E+021 0.15312471E-015 0.92165515E-003 0.17228251E+030 0.43314842E+010 0.19430031E+015 0.17972604E-013 0.17539057E+002 0.52747171E+012 0.21119876E+008 0.69706573E+027 0.48512706E+026 0.64584669E+010 0.11148881E-026 0.23860466E-058 0.32158762E-045 0.33400065E+016 0.53164945E+017 0.32868862E+014 0.71207218E+017 0.37984950E+017 0.25779762E+017 0.17203465E+017 0.14106955E+017 0.11548157E+017 0.60796163E+016 0.28224247E+016 0.63009400E+016 0.28148850E+016 0.15317994E+016 0.87212239E+015 0.86839838E+016 0.19391424E+017 0.12746063E+017 0.87749955E+016 0.72861818E+015 0.35316084E+016 0.13489469E+016 0.23473215E+016 0.69374705E+016 0.68872146E+016 0.47552682E+017 0.15979328E+017 0.28093226E+016 0.23159480E+015 0.14314295E+016 0.16770172E+014 0.18917061E+015 0.64242290E+012 0.19244287E+009 0.49937691E+014 0.46273775E+003 0.75821319E+004 0.22847131E+003 0.13984148E+013 0.76743230E+002 0.12521974E+012 0.52912488E-007 0.12887036E+000 0.17431198E+016 0.27989030E+006 0.58457035E+008 0.57363611E-006 0.17836470E+002 0.30878946E+007 0.19544908E+005 0.11069853E+015 0.29229985E+014 0.34146447E+006 0.14269844E-012 0.21028289E-028 0.76976553E-022 3 0.75000000E-009 0.64789872E-010 0.35792685E+015 0.68086546E+016 0.42109777E+013 0.91189759E+016 0.48646857E+016 0.33016105E+016 0.22031764E+016 0.18065711E+016 0.14788238E+016 0.77850485E+015 0.36140433E+015 0.80653492E+015 0.36030924E+015 0.19606403E+015 0.11162798E+015 0.12126702E+016 0.22206818E+016 0.16263244E+016 0.10308555E+016 0.92033739E+014 0.45232244E+015 0.19179942E+015 0.30035440E+015 0.88705965E+015 0.87849897E+015 0.65908709E+016 0.19632035E+016 0.43971566E+015 0.24217302E+014 0.16956904E+015 0.23339498E+013 0.23961772E+014 0.12045758E+012 0.32852377E+008 0.85064666E+013 0.17619881E+003 0.29557339E+004 0.10811404E+003 0.24907080E+012 0.30504939E+002 0.23190346E+011 0.63424194E-007 0.92312036E-001 0.16866800E+015 0.74744904E+005 0.94396507E+007 0.58461539E-006 0.69972174E+001 0.80510571E+006 0.46118280E+004 0.18180852E+014 0.36105911E+013 0.13000951E+006 0.21474443E-012 0.23464844E-027 0.26869161E-021 0.21172452E+031 0.75947747E+033 0.29051577E+027 0.13623335E+034 0.38770587E+033 0.17858491E+033 0.79522612E+032 0.53468919E+032 0.35828024E+032 0.99291331E+031 0.21398059E+031 0.10656710E+032 0.21268035E+031 0.62975422E+030 0.20413681E+030 0.24087022E+032 0.81018560E+032 0.43331347E+032 0.17441964E+032 0.13878373E+030 0.33517351E+031 0.60230129E+030 0.14779076E+031 0.12889885E+032 0.12642782E+032 0.71138338E+033 0.63186960E+032 0.31706722E+031 0.96871445E+028 0.46885776E+030 0.89180576E+026 0.94079324E+028 0.23811309E+024 0.17713029E+017 0.11868076E+028 0.53616780E+006 0.14927704E+009 0.20007968E+006 0.10177396E+025 0.16088907E+005 0.88236109E+022 0.70250315E-013 0.14573032E+000 0.46438155E+030 0.95526351E+011 0.14595553E+016 0.59725143E-011 0.84429834E+003 0.11066521E+014 0.36302677E+009 0.54142184E+028 0.21289619E+027 0.28880031E+012 0.80497472E-024 0.98451755E-054 0.12779066E-041 0.60915027E+016 0.11588750E+018 0.71675323E+014 0.15521024E+018 0.82800045E+017 0.56195546E+017 0.37499403E+017 0.30748883E+017 0.25170361E+017 0.13250523E+017 0.61512597E+016 0.13727236E+017 0.61324654E+016 0.33370008E+016 0.18999030E+016 0.20639547E+017 0.37793797E+017 0.27679064E+017 0.17543919E+017 0.15663284E+016 0.76985519E+016 0.32644643E+016 0.51120375E+016 0.15096619E+017 0.14950916E+017 0.11217623E+018 0.33412595E+017 0.74840093E+016 0.41207740E+015 0.28859467E+016 0.39724401E+014 0.40783199E+015 0.20502950E+013 0.55954318E+009 0.14478002E+015 0.31427007E+004 0.52144908E+005 0.19097042E+004 0.42393503E+013 0.54467209E+003 0.39471781E+012 0.11393814E-005 0.16266967E+001 0.28705393E+016 0.13203514E+007 0.16073525E+009 0.10519906E-004 0.12457005E+003 0.14215863E+008 0.81446601E+005 0.30944069E+015 0.61451074E+014 0.22932962E+007 0.38536923E-011 0.42987038E-026 0.48809468E-020 4 0.10000000E-008 0.64789849E-010 0.65112186E+015 0.13526207E+017 0.83714299E+013 0.18114860E+017 0.96645824E+016 0.65593538E+016 0.43768247E+016 0.35887520E+016 0.29374552E+016 0.15462566E+016 0.71777317E+015 0.16007807E+016 0.71511896E+015 0.38910422E+015 0.22153396E+015 0.25156356E+016 0.41185444E+016 0.32157459E+016 0.19352574E+016 0.18076777E+015 0.89821233E+015 0.40606947E+015 0.59598939E+015 0.17570654E+016 0.17370167E+016 0.13665928E+017 0.37861339E+016 0.96678909E+015 0.43750343E+014 0.31879913E+015 0.48895313E+013 0.47206413E+014 0.30060417E+012 0.77810304E+008 0.19921717E+014 0.85587271E+003 0.14452729E+005 0.58686101E+003 0.60046758E+012 0.15257308E+003 0.57818228E+011 0.75482306E-006 0.65515090E+000 0.29301128E+015 0.29551062E+006 0.21191564E+008 0.62691607E-005 0.34832694E+002 0.31190678E+007 0.16772499E+005 0.40833083E+014 0.68818367E+013 0.61578791E+006 0.29316893E-011 0.16408726E-025 0.76030319E-020 0.70024789E+031 0.29826695E+034 0.11425571E+028 0.53495942E+034 0.15227212E+034 0.70141801E+033 0.31229926E+033 0.20996057E+033 0.14066644E+033 0.38976981E+032 0.83988008E+031 0.41771723E+032 0.83363284E+031 0.24680114E+031 0.80001075E+030 0.10308011E+033 0.27811036E+033 0.16858597E+033 0.61300305E+032 0.53287671E+030 0.13151278E+032 0.26835638E+031 0.57903066E+031 0.50317645E+032 0.49180510E+032 0.30411196E+034 0.23407274E+033 0.15239100E+032 0.31597035E+029 0.16464647E+031 0.38906646E+027 0.36342202E+029 0.14740722E+025 0.98835989E+017 0.64697303E+028 0.12710573E+008 0.35678334E+010 0.58996770E+007 0.58796764E+025 0.40468608E+006 0.54517320E+023 0.99803937E-011 0.73412166E+001 0.13972183E+031 0.14942856E+013 0.73027227E+016 0.68909321E-009 0.21029613E+005 0.16587050E+015 0.47919543E+010 0.27104033E+029 0.76809705E+027 0.64753881E+013 0.15046738E-021 0.48471865E-050 0.10284461E-038 0.11078757E+017 0.23020635E+018 0.14248419E+015 0.30830036E+018 0.16448470E+018 0.11163595E+018 0.74490347E+017 0.61077670E+017 0.49992792E+017 0.26315690E+017 0.12215694E+017 0.27241963E+017 0.12169826E+017 0.66216929E+016 0.37700172E+016 0.42810634E+017 0.70078322E+017 0.54720792E+017 0.32928185E+017 0.30758967E+016 0.15285788E+017 0.69106899E+016 0.10142507E+017 0.29896443E+017 0.29555250E+017 0.23256499E+018 0.64426633E+017 0.16453148E+017 0.74410739E+015 0.54247615E+016 0.83212618E+014 0.80336458E+015 0.51163298E+013 0.13261833E+010 0.33903216E+015 0.15411309E+005 0.25624804E+006 0.10428374E+005 0.10219777E+014 0.27521602E+004 0.98406363E+012 0.13666597E-004 0.11603064E+002 0.49854125E+016 0.52460661E+007 0.36099931E+009 0.11377442E-003 0.62621059E+003 0.55315646E+008 0.29730510E+006 0.69493731E+015 0.11710960E+015 0.10912752E+008 0.53013310E-010 0.30390671E-024 0.13943545E-018 -5 0.12500000E-008 0.64789681E-010 0.11786946E+016 0.25731983E+017 0.15945592E+014 0.34457649E+017 0.18386742E+017 0.12479443E+017 0.83262152E+016 0.68264228E+016 0.55867656E+016 0.29404135E+016 0.13647921E+016 0.30401579E+016 0.13581014E+016 0.73885091E+015 0.42065860E+015 0.48897813E+016 0.75024127E+016 0.60819048E+016 0.35434694E+016 0.34025508E+015 0.17066244E+016 0.80288034E+015 0.11317131E+016 0.33248064E+016 0.32826483E+016 0.26603326E+017 0.70468602E+016 0.19410377E+016 0.78442203E+014 0.58388508E+015 0.96167924E+013 0.89205971E+014 0.66044350E+012 0.16791546E+009 0.41891174E+014 0.35245935E+004 0.59515027E+005 0.25735861E+004 0.12878942E+013 0.64040117E+003 0.12746163E+012 0.66746966E-005 0.34510366E+001 0.51980732E+015 0.10648993E+007 0.43516201E+008 0.51827973E-004 0.14558766E+003 0.11203294E+008 0.57875165E+005 0.82835446E+014 0.12674932E+014 0.24614460E+007 0.28342103E-010 0.66974961E-024 0.14318970E-018 0.22930003E+032 0.10747658E+035 0.41276347E+028 0.19272324E+035 0.54875596E+034 0.25279081E+034 0.11252829E+034 0.75639575E+033 0.50661466E+033 0.14033553E+033 0.30232856E+032 0.14999908E+033 0.29933649E+032 0.88593695E+031 0.28717629E+031 0.38744285E+033 0.92152144E+033 0.60041161E+033 0.20508890E+033 0.18801055E+031 0.47266840E+032 0.10430153E+032 0.20786392E+032 0.17933906E+033 0.17484901E+033 0.11463428E+035 0.80823281E+033 0.61076596E+032 0.10147173E+030 0.54963186E+031 0.14963980E+028 0.12924775E+030 0.70689964E+025 0.45799554E+018 0.28422041E+029 0.21640127E+009 0.60470064E+011 0.11353213E+009 0.26873073E+026 0.71624780E+007 0.26319024E+024 0.78284352E-009 0.20370971E+003 0.43918497E+031 0.19408671E+014 0.30576615E+017 0.47249195E-007 0.36895565E+006 0.21381624E+016 0.56969053E+011 0.11066320E+030 0.25917106E+028 0.10338181E+015 0.14107558E-019 0.81351622E-047 0.36677737E-036 0.20046272E+017 0.43786118E+018 0.27136737E+015 0.58633284E+018 0.31287466E+018 0.21235477E+018 0.14168046E+018 0.11615868E+018 0.95063311E+017 0.50032790E+017 0.23222454E+017 0.51723387E+017 0.23105851E+017 0.12570148E+017 0.71567062E+016 0.83191497E+017 0.12759682E+018 0.10345575E+018 0.60262397E+017 0.57873107E+016 0.29035782E+017 0.13660871E+017 0.19254293E+017 0.56545773E+017 0.55828473E+017 0.45261443E+018 0.11986814E+018 0.33025861E+017 0.13348603E+016 0.99316124E+016 0.16362789E+015 0.15177303E+016 0.11239763E+014 0.28656758E+010 0.71275808E+015 0.64027106E+005 0.10604780E+007 0.46015666E+005 0.21916877E+014 0.11661978E+005 0.21691629E+013 0.12184019E-003 0.61468311E+002 0.88392979E+016 0.18982308E+008 0.74188544E+009 0.94859420E-003 0.26414847E+004 0.19943966E+009 0.10287150E+007 0.14095415E+016 0.21562082E+015 0.43814017E+008 0.51675560E-009 0.12550468E-022 0.26527311E-017 -6 0.15000000E-008 0.64789381E-010 0.21148651E+016 0.47779560E+017 0.29674316E+014 0.63969246E+017 0.34144239E+017 0.23175554E+017 0.15459694E+017 0.12672932E+017 0.10368979E+017 0.54559741E+016 0.25318919E+016 0.56279553E+016 0.25140156E+016 0.13673487E+016 0.77848402E+015 0.91655492E+016 0.13499650E+017 0.11202049E+017 0.63861043E+016 0.62412217E+015 0.31607080E+016 0.15252047E+016 0.20948445E+016 0.61143967E+016 0.60311198E+016 0.49957154E+017 0.12847254E+017 0.37089365E+016 0.13833731E+015 0.10539166E+016 0.18219220E+014 0.16462395E+015 0.13471957E+013 0.34913267E+009 0.82749497E+014 0.13164634E+005 0.22174575E+006 0.99939249E+004 0.25821679E+013 0.24189445E+004 0.26117331E+012 0.49770106E-004 0.15235970E+002 0.92353298E+015 0.36155373E+007 0.85957089E+008 0.36970274E-003 0.54614709E+003 0.38450026E+008 0.19335701E+006 0.15922073E+015 0.22962051E+014 0.89457914E+007 0.22429293E-009 0.20058038E-022 0.21304167E-017 0.73741220E+032 0.36919586E+035 0.14244168E+029 0.66176856E+035 0.18854371E+035 0.86863990E+034 0.38652058E+034 0.25972734E+034 0.17386974E+034 0.48137632E+033 0.10366243E+033 0.51207565E+033 0.10218021E+033 0.30225768E+032 0.97975601E+031 0.13550682E+034 0.29795828E+034 0.20291602E+034 0.66491709E+033 0.63026179E+031 0.16150277E+033 0.37441319E+032 0.70949823E+032 0.60399669E+033 0.58780046E+033 0.40232492E+035 0.26790906E+034 0.22183417E+033 0.31510414E+030 0.17843908E+032 0.53427967E+028 0.43865424E+030 0.29219770E+026 0.19730784E+019 0.11019305E+030 0.30272449E+010 0.83881611E+012 0.17126493E+010 0.10733422E+027 0.10252762E+009 0.10975441E+025 0.43639157E-007 0.39700889E+004 0.13848715E+032 0.22360935E+015 0.11862576E+018 0.24103135E-005 0.52076794E+007 0.25166730E+017 0.63505912E+012 0.40586821E+030 0.84731166E+028 0.13640696E+016 0.88603394E-018 0.73465732E-044 0.81589399E-034 0.35962611E+017 0.81272029E+018 0.50487688E+015 0.10880807E+019 0.58079273E+018 0.39421784E+018 0.26296511E+018 0.21555930E+018 0.17636560E+018 0.92797861E+017 0.43062726E+017 0.95698684E+017 0.42748536E+017 0.23249849E+017 0.13237022E+017 0.15585323E+018 0.22938128E+018 0.19041448E+018 0.10850011E+018 0.10606805E+017 0.53746391E+017 0.25939737E+017 0.35621147E+017 0.10389480E+018 0.10247850E+018 0.84949680E+018 0.21836996E+018 0.63077216E+017 0.23597468E+016 0.17912270E+017 0.30985837E+015 0.27994114E+016 0.22922635E+014 0.59728236E+010 0.14073354E+016 0.24094461E+006 0.39686461E+007 0.17971685E+006 0.43931283E+014 0.44409039E+005 0.44437355E+013 0.91543607E-003 0.27295962E+003 0.15687178E+017 0.64626594E+008 0.14674088E+010 0.68178118E-002 0.99868876E+004 0.68642635E+009 0.34427419E+007 0.27083850E+016 0.39035689E+015 0.15981723E+009 0.41223811E-008 0.38016017E-021 0.39851890E-016 -7 0.17500000E-008 0.64788851E-010 0.37349413E+016 0.87183698E+017 0.54360056E+014 0.11668567E+018 0.62314296E+017 0.42299924E+017 0.28207621E+017 0.23116413E+017 0.18905505E+017 0.99432299E+016 0.46126429E+016 0.10214520E+017 0.45624911E+016 0.24803438E+016 0.14121402E+016 0.16750832E+017 0.23903646E+017 0.20187219E+017 0.11302356E+017 0.11194400E+016 0.57395902E+016 0.28185183E+016 0.38019045E+016 0.10966741E+017 0.10808910E+017 0.91455283E+017 0.22993365E+017 0.68650569E+016 0.23676505E+015 0.18735169E+016 0.33614466E+014 0.29829414E+015 0.26213814E+013 0.72811277E+009 0.15683125E+015 0.45953970E+005 0.77274080E+006 0.35907656E+005 0.49599595E+013 0.84827078E+004 0.51031667E+012 0.33254076E-003 0.60027869E+002 0.16199098E+016 0.11659401E+008 0.16781331E+009 0.23927293E-002 0.18915325E+004 0.12706455E+009 0.62550464E+006 0.29617071E+015 0.40998238E+014 0.30540429E+008 0.15607076E-008 0.49296700E-021 0.27215634E-016 0.22962694E+033 0.12252945E+036 0.47656632E+029 0.21947664E+036 0.62597078E+035 0.28844452E+035 0.12826250E+035 0.86137801E+034 0.57611312E+034 0.15935430E+034 0.34291887E+033 0.16808989E+034 0.33535589E+033 0.99106633E+032 0.32124330E+032 0.45073374E+034 0.93252768E+034 0.65660668E+034 0.20782781E+034 0.20203522E+032 0.53069333E+033 0.12724915E+033 0.23287767E+033 0.19349725E+034 0.18802793E+034 0.13425212E+036 0.85588793E+034 0.75641265E+033 0.92074264E+030 0.56212252E+032 0.18100208E+029 0.14357015E+031 0.10993211E+027 0.85752843E+019 0.39338545E+030 0.36940591E+011 0.10174270E+014 0.22106059E+011 0.39363738E+027 0.12631331E+010 0.41628176E+025 0.19514157E-005 0.61598869E+005 0.42530703E+032 0.23217333E+016 0.45051433E+018 0.10110756E-003 0.62555622E+008 0.27453095E+018 0.66349592E+013 0.13953723E+031 0.26925900E+029 0.15874287E+017 0.42987153E-016 0.44618931E-041 0.13364179E-031 0.63585895E+017 0.14818622E+019 0.92438231E+015 0.19832292E+019 0.10591787E+019 0.71899473E+018 0.47944166E+018 0.39289406E+018 0.32130758E+018 0.16898070E+018 0.78386605E+017 0.17350738E+018 0.77499359E+017 0.42129302E+017 0.23985549E+017 0.28454218E+018 0.40543946E+018 0.34267404E+018 0.19166921E+018 0.18994767E+017 0.97498825E+017 0.47895078E+017 0.64580678E+017 0.18602398E+018 0.18334196E+018 0.15535793E+019 0.39026531E+018 0.11664961E+018 0.40740230E+016 0.31793124E+017 0.57119430E+015 0.50673140E+016 0.44584950E+014 0.12510330E+011 0.26650389E+016 0.84601149E+006 0.13876601E+008 0.64879430E+006 0.84343747E+014 0.15672894E+006 0.86791170E+013 0.61555797E-002 0.10812852E+004 0.27457228E+017 0.20863331E+009 0.28707210E+010 0.44391127E-001 0.34796746E+005 0.22720828E+010 0.11142490E+008 0.50344588E+016 0.69605556E+015 0.54695264E+009 0.28887356E-007 0.94378939E-020 0.51339852E-015 -8 0.20000000E-008 0.64787970E-010 0.64162926E+016 0.15629291E+018 0.98105271E+014 0.20905943E+018 0.11174390E+018 0.75865251E+017 0.50561881E+017 0.41415948E+017 0.33846009E+017 0.17787215E+017 0.82465322E+016 0.18142898E+017 0.81027581E+016 0.44014124E+016 0.25058217E+016 0.29877602E+017 0.41226143E+017 0.35460030E+017 0.19449653E+017 0.19530524E+016 0.10202207E+017 0.50823556E+016 0.67528986E+016 0.19075374E+017 0.18785988E+017 0.16338253E+018 0.40169859E+017 0.12371927E+017 0.38423766E+015 0.32538025E+016 0.60527775E+014 0.52961533E+015 0.49326189E+013 0.15872006E+010 0.28755402E+015 0.15127102E+006 0.25477043E+007 0.12165246E+006 0.92353067E+013 0.27871550E+005 0.96340459E+012 0.20420437E-002 0.21818526E+003 0.27604411E+016 0.35338764E+008 0.32856794E+009 0.14286411E-001 0.60747835E+004 0.40219636E+009 0.19363880E+007 0.53721749E+015 0.71701159E+014 0.98848852E+008 0.98675067E-008 0.10455117E-019 0.30944204E-015 0.67593131E+033 0.39250174E+036 0.15477338E+030 0.70221859E+036 0.20064416E+036 0.92485298E+035 0.41077479E+035 0.27559251E+035 0.18403811E+035 0.50823913E+034 0.10923551E+034 0.52831660E+034 0.10537552E+034 0.31089658E+033 0.10076999E+033 0.14279435E+035 0.27661228E+035 0.20176949E+035 0.61350831E+034 0.61237587E+032 0.16705149E+034 0.41182850E+033 0.73195801E+033 0.58254766E+034 0.56522238E+034 0.42659042E+036 0.26036723E+035 0.24453845E+034 0.24151704E+031 0.16891314E+033 0.58410992E+029 0.45105980E+031 0.38692934E+027 0.40898141E+020 0.13145345E+031 0.40030178E+012 0.11038088E+015 0.25351635E+012 0.13570005E+028 0.13639424E+011 0.14743664E+026 0.73617467E-004 0.81303754E+006 0.12309517E+033 0.21260803E+017 0.17246248E+019 0.36047014E-002 0.64490517E+009 0.27447846E+019 0.63413199E+014 0.45650433E+031 0.82065968E+029 0.16592013E+018 0.17198151E-014 0.20142665E-038 0.17313040E-029 0.10974629E+018 0.26527173E+019 0.16664941E+016 0.35480536E+019 0.18966706E+019 0.12877137E+019 0.85816153E+018 0.70289004E+018 0.57436303E+018 0.30181779E+018 0.13991878E+018 0.30757939E+018 0.13736503E+018 0.74609022E+017 0.42476475E+017 0.50654898E+018 0.69784690E+018 0.60038887E+018 0.32868443E+018 0.33042907E+017 0.17297339E+018 0.86227962E+017 0.11448360E+018 0.32252934E+018 0.31761939E+018 0.27701976E+019 0.67997472E+018 0.20987275E+018 0.67630925E+016 0.55057296E+017 0.10268458E+016 0.89798723E+016 0.83829853E+014 0.27472906E+011 0.48788760E+016 0.27961170E+007 0.45839678E+008 0.22055842E+007 0.15689910E+015 0.51722173E+006 0.16371812E+014 0.37976963E-001 0.39481822E+004 0.46600597E+017 0.63162325E+009 0.56356317E+010 0.26613299E+000 0.11217126E+006 0.71922405E+010 0.34454374E+008 0.91199856E+016 0.12143035E+016 0.17719424E+010 0.18364717E-006 0.20180761E-018 0.58758955E-014 -9 0.22500000E-008 0.64786611E-010 0.10522341E+017 0.27361320E+018 0.17362080E+015 0.36564171E+018 0.19572101E+018 0.13291261E+018 0.88500101E+017 0.72434471E+017 0.59121813E+017 0.31030741E+017 0.14372412E+017 0.31279609E+017 0.13966597E+017 0.75763783E+016 0.43132696E+016 0.51670323E+017 0.68059921E+017 0.60043625E+017 0.31967783E+017 0.32712292E+016 0.17609515E+017 0.89068546E+016 0.11642948E+017 0.31721760E+017 0.31208786E+017 0.28304260E+018 0.67630248E+017 0.21631189E+017 0.56852463E+015 0.54389941E+016 0.10584956E+015 0.91383003E+015 0.90218173E+013 0.38087182E+010 0.50972608E+015 0.46637920E+006 0.79123952E+007 0.38952317E+006 0.16725041E+014 0.85163469E+005 0.17660452E+013 0.11535418E-001 0.74242004E+003 0.44659151E+016 0.97820015E+008 0.64604507E+009 0.78140319E-001 0.17799235E+005 0.11984925E+010 0.56023696E+007 0.94911809E+015 0.12123622E+015 0.30103088E+009 0.57071031E-007 0.19299704E-018 0.31414206E-014 0.18094463E+034 0.11981656E+037 0.48310811E+030 0.21394489E+037 0.61311946E+036 0.28275903E+036 0.12534889E+036 0.83961458E+035 0.55926362E+035 0.15404041E+035 0.33041179E+034 0.15628596E+035 0.31157757E+034 0.91671281E+033 0.29711292E+033 0.42490609E+035 0.75037636E+035 0.57530325E+035 0.16488081E+035 0.17077373E+033 0.49532432E+034 0.12582507E+034 0.21654760E+034 0.15999570E+035 0.15492912E+035 0.12735880E+037 0.73442879E+035 0.74369259E+034 0.52514307E+031 0.46932227E+033 0.17767759E+030 0.13369895E+032 0.12869569E+028 0.23780768E+021 0.41040641E+031 0.37989548E+013 0.10613189E+016 0.25941837E+013 0.44258302E+028 0.12713684E+012 0.49242524E+026 0.23466539E-002 0.93979572E+007 0.32028238E+033 0.16197229E+018 0.66669756E+019 0.10765597E+000 0.55204142E+010 0.24280971E+020 0.52833075E+015 0.14169902E+032 0.23344868E+030 0.15332607E+019 0.57494275E-013 0.68741507E-036 0.17846960E-027 0.18218992E+018 0.46318104E+019 0.29432900E+016 0.61889238E+019 0.33134441E+019 0.22502088E+019 0.14981225E+019 0.12260371E+019 0.10005414E+019 0.52505630E+018 0.24315711E+018 0.52843471E+018 0.23594329E+018 0.12796755E+018 0.72852264E+017 0.87303138E+018 0.11536654E+019 0.10119959E+019 0.53867376E+018 0.55055963E+017 0.29753624E+018 0.15068871E+018 0.19669673E+018 0.53327160E+018 0.52459208E+018 0.47829688E+019 0.11393145E+019 0.36585174E+018 0.10549450E+017 0.91556950E+017 0.17904503E+016 0.15441794E+017 0.15310651E+015 0.66688532E+011 0.86245493E+016 0.86376086E+007 0.14237822E+009 0.70744173E+007 0.28366253E+015 0.15837642E+007 0.29967929E+014 0.21509321E+000 0.13478155E+005 0.74905983E+017 0.17408941E+010 0.11107637E+011 0.14582296E+001 0.32898622E+006 0.21387237E+011 0.99329918E+008 0.16074444E+017 0.20440238E+016 0.53905431E+010 0.10658971E-005 0.37469134E-017 0.59909289E-013 -10 0.25000000E-008 0.64784809E-010 0.16033833E+017 0.46231296E+018 0.29815309E+015 0.61692234E+018 0.33095057E+018 0.22483175E+018 0.14949472E+018 0.12221021E+018 0.99561846E+017 0.52154195E+017 0.24119893E+017 0.51618314E+017 0.23039895E+017 0.12471637E+017 0.70998250E+016 0.85531805E+017 0.10487668E+018 0.96289005E+017 0.48886637E+017 0.51538489E+016 0.29110706E+017 0.15019510E+017 0.19215004E+017 0.49320034E+017 0.48447866E+017 0.46959022E+018 0.10760409E+018 0.36303309E+017 0.71948449E+015 0.85605698E+016 0.17774281E+015 0.15111433E+016 0.16014291E+014 0.10677344E+011 0.86664463E+015 0.13190546E+007 0.22742359E+008 0.11659262E+007 0.29368703E+014 0.23682405E+006 0.31391251E+013 0.58833574E-001 0.23663816E+004 0.66313154E+016 0.23577975E+009 0.12525227E+010 0.38121864E+000 0.45822324E+005 0.32627183E+010 0.14604325E+008 0.16202340E+016 0.19426043E+015 0.84426361E+009 0.29777670E-006 0.30254471E-017 0.27816307E-013 0.41684603E+034 0.34010517E+037 0.14177040E+031 0.60550299E+037 0.17430597E+037 0.80449635E+036 0.35561228E+036 0.23761208E+036 0.15766203E+036 0.43251689E+035 0.92488071E+034 0.42260661E+035 0.84191562E+034 0.24661896E+034 0.79923031E+033 0.11560449E+036 0.17676196E+036 0.14670230E+036 0.38221908E+035 0.41996806E+033 0.13442010E+035 0.35536869E+034 0.58566020E+034 0.38264326E+035 0.36939481E+035 0.34803205E+037 0.18446038E+036 0.20806038E+035 0.83307446E+031 0.11520222E+034 0.49742925E+030 0.36318314E+032 0.40306071E+028 0.18991762E+022 0.11772624E+032 0.30281467E+014 0.87247536E+016 0.23163933E+014 0.13564605E+029 0.97941419E+012 0.15458727E+027 0.60860898E-001 0.95216903E+008 0.69882535E+033 0.93195925E+018 0.25036921E+020 0.25522239E+001 0.36356600E+011 0.17882158E+021 0.35628215E+016 0.41028815E+032 0.59455789E+030 0.11992719E+020 0.15613083E-011 0.16878752E-033 0.13965591E-025 0.28590349E+018 0.77904758E+019 0.50356505E+016 0.10393693E+020 0.55774710E+019 0.37892679E+019 0.25190524E+019 0.20589465E+019 0.16769280E+019 0.87819293E+018 0.40605337E+018 0.86687876E+018 0.38691254E+018 0.20937288E+018 0.11919048E+018 0.14367951E+019 0.17953853E+019 0.16103589E+019 0.82720144E+018 0.85967031E+017 0.48900676E+018 0.25289168E+018 0.32270186E+018 0.82087732E+018 0.80618978E+018 0.78903332E+019 0.17978587E+019 0.61087636E+018 0.15374829E+017 0.14281445E+018 0.29913364E+016 0.25388038E+017 0.27109216E+015 0.18983371E+012 0.14594852E+017 0.24422611E+008 0.40832720E+009 0.21169463E+008 0.49665649E+015 0.44025428E+007 0.53132894E+014 0.10973161E+001 0.43024085E+005 0.11150826E+018 0.41584446E+010 0.21540407E+011 0.71076366E+001 0.84467741E+006 0.57928960E+011 0.25711256E+009 0.27329329E+017 0.32496691E+016 0.15064013E+011 0.55679449E-005 0.58923593E-016 0.53142148E-012 -11 0.27500000E-008 0.64782958E-010 0.22234696E+017 0.74245472E+018 0.49070930E+015 0.98891103E+018 0.53209334E+018 0.36166164E+018 0.23995944E+018 0.19580798E+018 0.15906308E+018 0.83078582E+017 0.38333864E+017 0.80101948E+017 0.35735283E+017 0.19282284E+017 0.10974931E+017 0.13333935E+018 0.14661182E+018 0.14341343E+018 0.67658933E+017 0.74837668E+016 0.45289944E+017 0.24033693E+017 0.29812367E+017 0.70327652E+017 0.68922661E+017 0.73432971E+018 0.15820576E+018 0.57603621E+017 0.78052592E+015 0.12421060E+017 0.28225520E+015 0.23521168E+016 0.27397686E+014 0.36099265E+011 0.13960947E+016 0.33262893E+007 0.58962888E+008 0.31952998E+007 0.49606796E+014 0.58141298E+006 0.53753500E+013 0.26221076E+000 0.69927905E+004 0.87454073E+016 0.47271194E+009 0.23096739E+010 0.15970190E+001 0.99522816E+005 0.78085445E+010 0.32871213E+008 0.26391604E+016 0.28831498E+015 0.21181984E+010 0.13615588E-005 0.38352588E-016 0.20591237E-012 0.79304965E+034 0.86966009E+037 0.38127113E+031 0.15424019E+038 0.44674380E+037 0.20640581E+037 0.90835204E+036 0.60467452E+036 0.39885396E+036 0.10875819E+036 0.23147312E+035 0.10069872E+036 0.20040013E+035 0.58318850E+034 0.18892332E+034 0.27805970E+036 0.34125152E+036 0.32132883E+036 0.72235032E+035 0.87322418E+033 0.32197733E+035 0.90134016E+034 0.13949549E+035 0.76585952E+035 0.73588659E+035 0.84221748E+037 0.39392344E+036 0.51883738E+035 0.97580824E+031 0.23916537E+034 0.12417091E+031 0.87107810E+032 0.11714416E+029 0.22110028E+023 0.30245688E+032 0.19143011E+015 0.58216696E+017 0.17306120E+015 0.38418543E+029 0.58649219E+013 0.44993729E+027 0.12026720E+001 0.82800551E+009 0.11957215E+034 0.36899638E+019 0.84762959E+020 0.44500565E+002 0.16978472E+012 0.10141581E+022 0.17835229E+017 0.10794935E+033 0.12932089E+031 0.74865285E+020 0.32489804E-010 0.27033233E-031 0.76193877E-024 0.41112199E+018 0.12420083E+020 0.82401789E+016 0.16538066E+020 0.89026589E+019 0.60515821E+019 0.40138135E+019 0.32743493E+019 0.26586823E+019 0.13879800E+019 0.64020408E+018 0.13326122E+019 0.59445841E+018 0.32059422E+018 0.18246749E+018 0.22196041E+019 0.25765221E+019 0.23697035E+019 0.11666543E+019 0.12311890E+018 0.75377361E+018 0.40162936E+018 0.49595742E+018 0.11531231E+019 0.11296366E+019 0.12229154E+020 0.26165194E+019 0.96142521E+018 0.18693698E+017 0.20437871E+018 0.47122432E+016 0.39152842E+017 0.46186505E+015 0.65172794E+012 0.23337739E+017 0.61424729E+008 0.10534336E+010 0.57865268E+008 0.83496746E+015 0.10774867E+008 0.90607137E+014 0.48787866E+001 0.12705122E+006 0.15009121E+018 0.82201259E+010 0.39571359E+011 0.29658921E+002 0.18236225E+007 0.13737805E+012 0.57189523E+009 0.44226771E+017 0.47631343E+016 0.37543558E+011 0.25419066E-004 0.74708529E-015 0.39294334E-011 -12 0.30000000E-008 0.64781445E-010 0.28166096E+017 0.11247208E+019 0.77063819E+015 0.14950526E+019 0.80737610E+018 0.54909208E+018 0.36314944E+018 0.29553758E+018 0.23905430E+018 0.12432432E+018 0.57170983E+017 0.11581326E+018 0.51631119E+017 0.27735281E+017 0.15777362E+017 0.19373602E+018 0.18370906E+018 0.19674819E+018 0.83774740E+017 0.99548378E+016 0.65708565E+017 0.36149933E+017 0.43058119E+017 0.91948088E+017 0.89818405E+017 0.10717106E+019 0.21271108E+018 0.85414309E+017 0.69684248E+015 0.16545448E+017 0.41960001E+015 0.34135795E+016 0.44776870E+014 0.14103469E+012 0.21162030E+016 0.73880007E+007 0.13568186E+009 0.78606083E+007 0.79868083E+014 0.12414751E+007 0.87965975E+013 0.99166790E+000 0.18897650E+005 0.10309247E+017 0.79630067E+009 0.39496925E+010 0.56105556E+001 0.18361238E+006 0.16144846E+011 0.63127700E+008 0.40631901E+016 0.39346433E+015 0.46748686E+010 0.53135858E-005 0.37492868E-015 0.12285813E-011 0.12565775E+035 0.19731284E+038 0.93175160E+031 0.34850745E+038 0.10170336E+038 0.47045780E+037 0.20567142E+037 0.13615619E+037 0.89022732E+036 0.24060854E+036 0.50851856E+035 0.20752504E+036 0.41240483E+035 0.11891258E+035 0.38476877E+034 0.57883478E+036 0.52750833E+036 0.59453395E+036 0.10882578E+036 0.15165756E+034 0.66828539E+035 0.20137616E+035 0.28684949E+035 0.12825485E+036 0.12243127E+036 0.17688804E+038 0.70047950E+036 0.11259431E+036 0.80211553E+031 0.41655843E+034 0.27070579E+031 0.18098508E+033 0.31017239E+029 0.34221370E+024 0.68619267E+032 0.93683621E+015 0.30524099E+018 0.10395424E+016 0.98669693E+029 0.26499619E+014 0.11941016E+028 0.17078204E+002 0.60120872E+010 0.16283450E+034 0.10267527E+020 0.24570545E+021 0.54448482E+003 0.57034602E+012 0.42770840E+022 0.64731530E+017 0.25309614E+033 0.23674809E+031 0.36058539E+021 0.49153147E-009 0.25693709E-029 0.26952272E-022 0.53130523E+018 0.18630777E+020 0.12843795E+017 0.24755878E+020 0.13377862E+020 0.90991913E+019 0.60145172E+019 0.48924270E+019 0.39544184E+019 0.20550011E+019 0.94442962E+018 0.19020231E+019 0.84783526E+018 0.45505411E+018 0.25883567E+018 0.31842645E+019 0.33611381E+019 0.31973789E+019 0.15046295E+019 0.16069512E+018 0.10798487E+019 0.59781955E+018 0.70703626E+018 0.14778013E+019 0.14425565E+019 0.17628285E+020 0.35042368E+019 0.14091503E+019 0.21453480E+017 0.26721324E+018 0.69267973E+016 0.56106979E+017 0.75016888E+015 0.25734086E+013 0.35022792E+017 0.13582615E+009 0.24064214E+010 0.14165929E+009 0.13351177E+016 0.22883426E+008 0.14737572E+015 0.18364810E+002 0.34235873E+006 0.18542934E+018 0.13591545E+011 0.67132332E+011 0.10354176E+003 0.33344179E+007 0.28048235E+012 0.10812232E+010 0.67474681E+017 0.63902431E+016 0.82082682E+011 0.98814295E-004 0.72869455E-014 0.23365871E-010 -13 0.32500000E-008 0.64780660E-010 0.32721685E+017 0.16018184E+019 0.11488063E+016 0.21252437E+019 0.11521765E+019 0.78416345E+018 0.51639754E+018 0.41880477E+018 0.33688536E+018 0.17424395E+018 0.79777837E+017 0.15593179E+018 0.69454211E+017 0.37099068E+017 0.21083562E+017 0.26181281E+018 0.20593945E+018 0.24891226E+018 0.92640229E+017 0.12155910E+017 0.88822783E+017 0.50981077E+017 0.57838330E+017 0.11066407E+018 0.10763163E+018 0.14573625E+019 0.26141798E+018 0.11782918E+018 0.54413622E+015 0.20248726E+017 0.58169887E+015 0.46141370E+016 0.69483319E+014 0.57003836E+012 0.30132545E+016 0.14419962E+008 0.27578284E+009 0.17231649E+008 0.12192539E+015 0.22989100E+007 0.13679119E+014 0.31458540E+001 0.46285449E+005 0.10756515E+017 0.11208676E+010 0.61561638E+010 0.16396655E+002 0.28145543E+006 0.28715240E+011 0.10371548E+009 0.58895883E+016 0.49276872E+015 0.90375785E+010 0.17507926E-004 0.27659871E-014 0.58247415E-011 0.16729397E+035 0.39460833E+038 0.20474641E+032 0.69431761E+038 0.20424464E+038 0.94621874E+037 0.41000879E+037 0.26949919E+037 0.17419350E+037 0.46549511E+036 0.97497320E+035 0.36960340E+036 0.73313385E+035 0.20893064E+035 0.67467579E+034 0.10386635E+037 0.65173376E+036 0.93156585E+036 0.13047095E+036 0.22096849E+034 0.11999708E+036 0.39432712E+035 0.50839177E+035 0.18116750E+036 0.17142935E+036 0.32141664E+038 0.10365599E+037 0.21072794E+036 0.55876157E+031 0.60966765E+034 0.51142093E+031 0.32510809E+033 0.73891172E+029 0.56237681E+025 0.13701456E+033 0.35329052E+016 0.12455341E+019 0.49479360E+016 0.22734124E+030 0.89806073E+014 0.28559966E+028 0.17030811E+003 0.35798050E+011 0.17333937E+034 0.19821985E+020 0.58885415E+021 0.46007585E+004 0.13161025E+013 0.13294546E+023 0.17120070E+018 0.52463024E+033 0.36332911E+031 0.13286543E+022 0.52919041E-008 0.13887526E-027 0.60106298E-021 0.64611551E+018 0.26206033E+020 0.18968318E+017 0.34754307E+020 0.18857760E+020 0.12836496E+020 0.84457577E+019 0.68446661E+019 0.54994008E+019 0.28410778E+019 0.12995772E+019 0.25194036E+019 0.11219450E+019 0.59850292E+018 0.34006208E+018 0.42338232E+019 0.39783225E+019 0.39601373E+019 0.17276840E+019 0.19228343E+018 0.14364377E+019 0.83196805E+018 0.93405767E+018 0.17347642E+019 0.16852058E+019 0.23597687E+020 0.43366147E+019 0.19146629E+019 0.24732711E+017 0.31930938E+018 0.94645306E+016 0.74625841E+017 0.11544418E+016 0.10438441E+014 0.49247092E+017 0.26349436E+009 0.48449280E+010 0.30843139E+009 0.20198832E+016 0.42051159E+008 0.22732426E+015 0.57876831E+002 0.83449894E+006 0.20346461E+018 0.18660946E+011 0.10335869E+012 0.30007080E+003 0.50462983E+007 0.49061781E+012 0.17409963E+010 0.96676927E+017 0.78259829E+016 0.15678154E+012 0.32372556E-003 0.53542357E-013 0.11021429E-009 -14 0.35000000E-008 0.64780540E-010 0.35742436E+017 0.21541909E+019 0.16311688E+016 0.28540869E+019 0.15530100E+019 0.10579354E+019 0.69289687E+018 0.55960271E+018 0.44707673E+018 0.22970906E+018 0.10462212E+018 0.19698356E+018 0.87640717E+017 0.46500956E+017 0.26387600E+017 0.33105961E+018 0.20926398E+018 0.29384926E+018 0.92892245E+017 0.13839302E+017 0.11264288E+018 0.67680827E+017 0.72753891E+017 0.12514941E+018 0.12107111E+018 0.18580032E+019 0.29678654E+018 0.15184940E+018 0.38093462E+015 0.23103718E+017 0.75594189E+015 0.58464028E+016 0.10221010E+015 0.21154109E+013 0.40525245E+016 0.25071749E+008 0.49978565E+009 0.33749609E+008 0.17635934E+015 0.37401949E+007 0.20183904E+014 0.84164427E+001 0.10259040E+006 0.10252380E+017 0.13847829E+010 0.88197633E+010 0.40369947E+002 0.37273380E+006 0.44585183E+011 0.14923319E+009 0.80567233E+016 0.57326947E+015 0.15486105E+011 0.48945028E-004 0.15482128E-013 0.22117803E-010 0.19690659E+035 0.70208182E+038 0.40753141E+032 0.12318009E+039 0.36509470E+038 0.16946032E+038 0.72603857E+037 0.47311059E+037 0.30149870E+037 0.79469888E+036 0.16464798E+036 0.57777169E+036 0.11433772E+036 0.32134391E+035 0.10344697E+035 0.16266625E+037 0.66372870E+036 0.12665858E+037 0.12890597E+036 0.27889067E+034 0.18907851E+036 0.68247795E+035 0.78765756E+035 0.22523115E+036 0.21083178E+036 0.51180647E+038 0.13048140E+037 0.34308151E+036 0.39010632E+031 0.77295677E+034 0.84641887E+031 0.51164335E+033 0.15787122E+030 0.77315570E+026 0.24356345E+033 0.10556760E+017 0.40325519E+019 0.18765499E+017 0.46931143E+030 0.23444040E+015 0.61383233E+028 0.12060862E+004 0.17430332E+012 0.15474017E+034 0.29365172E+020 0.11884173E+022 0.27547870E+005 0.22593372E+013 0.31383800E+023 0.34610558E+018 0.96638037E+033 0.47937273E+031 0.38372758E+022 0.40958558E-007 0.43168218E-026 0.85890372E-020 0.74301224E+018 0.34739927E+020 0.26648751E+017 0.46006721E+020 0.25059357E+020 0.17074705E+020 0.11168161E+020 0.90102381E+019 0.71860126E+019 0.36858885E+019 0.16764626E+019 0.31225079E+019 0.13888070E+019 0.73545862E+018 0.41718425E+018 0.52507880E+019 0.44467713E+019 0.45642484E+019 0.19057716E+019 0.21582839E+018 0.17876641E+019 0.10873577E+019 0.11520606E+019 0.19065754E+019 0.18408810E+019 0.29530479E+020 0.49152665E+019 0.24225510E+019 0.26152147E+017 0.35639968E+018 0.12090308E+017 0.92775263E+017 0.16808325E+016 0.38631757E+014 0.65280184E+017 0.45493637E+009 0.86837955E+010 0.59908474E+009 0.28898298E+016 0.67792110E+008 0.33211344E+015 0.15359993E+003 0.18378289E+007 0.21566561E+018 0.22396101E+011 0.14586673E+012 0.73150082E+003 0.65805698E+007 0.74654868E+012 0.24519703E+010 0.13044694E+018 0.88954544E+016 0.26489363E+012 0.89854624E-003 0.29808917E-012 0.41584696E-009 -15 0.37500000E-008 0.64780855E-010 0.37585472E+017 0.27573926E+019 0.22206887E+016 0.36507003E+019 0.19926383E+019 0.13586319E+019 0.88406141E+018 0.71058249E+018 0.56314897E+018 0.28716693E+018 0.13001600E+018 0.23619640E+018 0.10494816E+018 0.55270252E+017 0.31297912E+017 0.39589844E+018 0.19660864E+018 0.32880628E+018 0.86385054E+017 0.14965498E+017 0.13547633E+018 0.85264947E+017 0.86658945E+017 0.13578436E+018 0.13055655E+018 0.22444915E+019 0.31607608E+018 0.18459784E+018 0.26813502E+015 0.24999185E+017 0.93119220E+015 0.70156495E+016 0.14294112E+015 0.67287706E+013 0.51947976E+016 0.39631122E+008 0.82153096E+009 0.59749638E+008 0.24255537E+015 0.54553471E+007 0.28343019E+014 0.19353589E+002 0.20709549E+006 0.91985624E+016 0.15687130E+010 0.11795752E+011 0.85743756E+002 0.44259485E+006 0.61957843E+011 0.19396360E+009 0.10471935E+017 0.62949222E+015 0.23985069E+011 0.11818534E-003 0.67591510E-013 0.69008385E-010 0.21486875E+035 0.11295728E+039 0.74496415E+032 0.19791049E+039 0.59031507E+038 0.27450426E+038 0.11602679E+038 0.74858878E+037 0.46913983E+037 0.12172871E+037 0.24910231E+036 0.81184222E+036 0.16021637E+036 0.44334394E+035 0.14209231E+035 0.22726337E+037 0.58483847E+036 0.15432137E+037 0.11074001E+036 0.31683937E+034 0.26732203E+036 0.10614761E+036 0.10914351E+036 0.25728022E+036 0.23785674E+036 0.72993687E+038 0.14426896E+037 0.49570053E+036 0.33061763E+031 0.87930262E+034 0.12558484E+032 0.72045292E+033 0.30435632E+030 0.77665072E+027 0.39277728E+033 0.26049184E+017 0.10727876E+020 0.58070509E+017 0.87440718E+030 0.49103927E+015 0.11929441E+029 0.63025807E+004 0.70317458E+012 0.12423995E+034 0.36495998E+020 0.20860511E+022 0.12261947E+006 0.31121585E+013 0.59189703E+023 0.56959694E+018 0.16042197E+034 0.56199724E+031 0.90397338E+022 0.23629028E-006 0.81583952E-025 0.82803661E-019 0.81223249E+018 0.43766232E+020 0.35874900E+017 0.57923811E+020 0.31651717E+020 0.21587102E+020 0.14019548E+020 0.11251919E+020 0.88952551E+019 0.45250699E+019 0.20448062E+019 0.36650443E+019 0.16277157E+019 0.85488804E+018 0.48376692E+018 0.61418777E+019 0.47051892E+019 0.50041485E+019 0.19948407E+019 0.22769497E+018 0.21049180E+019 0.13459349E+019 0.13419610E+019 0.20063872E+019 0.19293669E+019 0.34932333E+020 0.53248768E+019 0.28835581E+019 0.26419746E+017 0.37973044E+018 0.14612676E+017 0.10894828E+018 0.23230036E+016 0.12208136E+015 0.82376010E+017 0.71368500E+009 0.14104853E+011 0.10506080E+010 0.39249530E+016 0.97850933E+008 0.46110632E+015 0.35007832E+003 0.36825188E+007 0.21887248E+018 0.24596401E+011 0.19187537E+012 0.15370759E+004 0.76855331E+007 0.10139458E+013 0.31316396E+010 0.16697443E+018 0.95937921E+016 0.40405076E+012 0.21525062E-002 0.12936724E-011 0.12885011E-008 -16 0.40000000E-008 0.64781360E-010 0.38733805E+017 0.33893427E+019 0.29183569E+016 0.44878427E+019 0.24552265E+019 0.16753468E+019 0.10821124E+019 0.86519253E+018 0.67952216E+018 0.34367218E+018 0.15460402E+018 0.27215172E+018 0.12074633E+018 0.63085097E+017 0.35625669E+017 0.45304694E+018 0.17461990E+018 0.35400878E+018 0.76330933E+017 0.15630217E+017 0.15632690E+018 0.10289420E+018 0.98931505E+017 0.14368826E+018 0.13723853E+018 0.25989588E+019 0.32083050E+018 0.21418772E+018 0.20730217E+015 0.26051385E+017 0.11021950E+016 0.80613936E+016 0.19112490E+015 0.18031280E+014 0.64090433E+016 0.58158112E+008 0.12483935E+010 0.97065985E+008 0.31902510E+015 0.73008004E+007 0.38102991E+014 0.39184338E+002 0.38503715E+006 0.79899495E+016 0.16893371E+010 0.14965877E+011 0.16137937E+003 0.48841056E+006 0.79146230E+011 0.23447375E+009 0.13041933E+017 0.66286244E+015 0.34286820E+011 0.25220322E-003 0.23887237E-012 0.18266126E-009 0.22516434E+035 0.16736421E+039 0.12681172E+033 0.29332649E+039 0.87902660E+038 0.40941940E+038 0.17040207E+038 0.10873887E+038 0.66875914E+037 0.17057558E+037 0.34442310E+036 0.10516483E+037 0.20690411E+036 0.56307301E+035 0.17943036E+035 0.29018114E+037 0.47274910E+036 0.17378829E+037 0.87991679E+035 0.33536511E+034 0.34727156E+036 0.15124338E+036 0.13865884E+036 0.27938113E+036 0.25481790E+036 0.95479676E+038 0.14487912E+037 0.65111993E+036 0.31786708E+031 0.92661036E+034 0.17182411E+032 0.92838188E+033 0.53564887E+030 0.55179570E+028 0.58624049E+033 0.55371247E+017 0.24374442E+020 0.15117120E+018 0.14878877E+031 0.86469431E+015 0.21222766E+029 0.25514845E+005 0.24045254E+013 0.96055523E+033 0.40956127E+020 0.32918587E+022 0.42831443E+006 0.36989112E+013 0.94156619E+023 0.80979609E+018 0.24418079E+034 0.60493211E+031 0.18123242E+023 0.10641261E-005 0.10100383E-023 0.57435008E-018 0.85888868E+018 0.52894046E+020 0.46609322E+017 0.70023296E+020 0.38352583E+020 0.26178840E+020 0.16863552E+020 0.13456207E+020 0.10532330E+020 0.53094638E+019 0.23823029E+019 0.41278255E+019 0.18302042E+019 0.95265545E+018 0.53738451E+018 0.68602876E+019 0.49264090E+019 0.52499143E+019 0.20524753E+019 0.23387161E+018 0.23738279E+019 0.15935115E+019 0.14952072E+019 0.20580942E+019 0.19686089E+019 0.39540197E+020 0.55782437E+019 0.32690529E+019 0.26120264E+017 0.38747409E+018 0.16959489E+017 0.12264326E+018 0.30659146E+016 0.32410726E+015 0.99973334E+017 0.10392780E+010 0.21172483E+011 0.16894313E+010 0.50916707E+016 0.12949917E+009 0.61233892E+015 0.70212119E+003 0.67920286E+007 0.22526821E+018 0.25668820E+011 0.23925036E+012 0.28605272E+004 0.83401883E+007 0.12636423E+013 0.37258299E+010 0.20455141E+018 0.99269896E+016 0.56840073E+012 0.45548251E-002 0.45429321E-011 0.33859708E-008 -17 0.42500000E-008 0.64781909E-010 0.39564376E+017 0.40322517E+019 0.37251317E+016 0.53439559E+019 0.29277694E+019 0.19989414E+019 0.12805567E+019 0.10181069E+019 0.79185672E+018 0.39705306E+018 0.17743365E+018 0.30448457E+018 0.13487790E+018 0.69884970E+017 0.39334895E+017 0.50142795E+018 0.14956444E+018 0.37113506E+018 0.65504184E+017 0.15965831E+017 0.17477951E+018 0.11996644E+018 0.10937323E+018 0.14993497E+018 0.14221114E+018 0.29143522E+019 0.31454956E+018 0.23987596E+018 0.17699557E+015 0.26460027E+017 0.12691541E+016 0.89519854E+016 0.24593627E+015 0.41191291E+014 0.76751500E+016 0.80637503E+008 0.17837897E+010 0.14685496E+009 0.40382125E+015 0.91474862E+007 0.49388496E+014 0.71520378E+002 0.66777838E+006 0.68711834E+016 0.17724379E+010 0.18248504E+011 0.27584939E+003 0.51586798E+006 0.95090411E+011 0.26967702E+009 0.15689679E+017 0.67809486E+015 0.46069991E+011 0.48640842E-003 0.70929000E-012 0.42302043E-009 0.23161117E+035 0.23206293E+039 0.20358500E+033 0.40753135E+039 0.12247611E+039 0.57112400E+038 0.23364879E+038 0.14735305E+038 0.88791521E+037 0.22243221E+037 0.44292423E+036 0.12830339E+037 0.25158999E+036 0.67285382E+035 0.21291719E+035 0.34609553E+037 0.37181989E+036 0.18540609E+037 0.68665697E+035 0.33946101E+034 0.42296601E+036 0.20092142E+036 0.16496605E+036 0.29502248E+036 0.26530397E+036 0.11698074E+039 0.13601188E+037 0.79563686E+036 0.30889780E+031 0.92731665E+034 0.22241388E+032 0.11155837E+034 0.87225122E+030 0.28429130E+029 0.82405661E+033 0.10504295E+018 0.48951690E+020 0.34109282E+018 0.23423775E+031 0.13332061E+016 0.35070557E+029 0.83914307E+005 0.71516477E+013 0.75553997E+033 0.43631728E+020 0.47952618E+022 0.12336581E+007 0.40264078E+013 0.13233923E+024 0.10414376E+019 0.34647788E+034 0.61414212E+031 0.32083805E+023 0.39136015E-005 0.88266889E-023 0.30493618E-017 0.88590869E+018 0.61821572E+020 0.58819736E+017 0.81938628E+020 0.44939557E+020 0.30693021E+020 0.19590764E+020 0.15534737E+020 0.12027089E+020 0.60048951E+019 0.26743204E+019 0.45094097E+019 0.19957611E+019 0.10289955E+019 0.57817545E+018 0.73980317E+019 0.50857539E+019 0.53537875E+019 0.21074191E+019 0.23621688E+018 0.25900351E+019 0.18205360E+019 0.16104949E+019 0.20819820E+019 0.19766820E+019 0.43282282E+020 0.56925335E+019 0.35713945E+019 0.28166309E+017 0.38531741E+018 0.19152172E+017 0.13313016E+018 0.38909779E+016 0.73224084E+015 0.11773703E+018 0.14298451E+010 0.29881893E+011 0.25285226E+010 0.63505807E+016 0.16034395E+009 0.78364308E+015 0.12692927E+004 0.11684581E+008 0.22698956E+018 0.26108719E+011 0.28660752E+012 0.48344613E+004 0.86615479E+007 0.14895036E+013 0.42367643E+010 0.24186691E+018 0.99086738E+016 0.75137801E+012 0.87104750E-002 0.13405079E-010 0.77860869E-008 -18 0.45000000E-008 0.64782422E-010 0.40302346E+017 0.46720511E+019 0.46411521E+016 0.62020188E+019 0.33995489E+019 0.23217220E+019 0.14740328E+019 0.11651239E+019 0.89695224E+018 0.44584723E+018 0.19791687E+018 0.33348197E+018 0.14747624E+018 0.75766289E+017 0.42481716E+017 0.54148667E+018 0.12577876E+018 0.38224955E+018 0.55656217E+017 0.16090735E+017 0.19081249E+018 0.13611596E+018 0.11806282E+018 0.15528340E+018 0.14624492E+018 0.31912371E+019 0.30108229E+018 0.26175548E+018 0.16135059E+015 0.26419980E+017 0.14354471E+016 0.96773322E+016 0.30648945E+015 0.82008300E+014 0.89815681E+016 0.10705804E+009 0.24293753E+010 0.20958910E+009 0.49486841E+015 0.10908486E+008 0.62145589E+014 0.12010426E+003 0.10933378E+007 0.59389236E+016 0.18370881E+010 0.21587691E+011 0.43698848E+003 0.53254932E+006 0.10935576E+012 0.29985882E+009 0.18358542E+017 0.68034963E+015 0.59028421E+011 0.86435962E-003 0.18282399E-011 0.87990126E-009 0.23650964E+035 0.30496982E+039 0.31133423E+033 0.53746403E+039 0.16166915E+039 0.75432113E+038 0.30282070E+038 0.18865701E+038 0.11125560E+038 0.27365587E+037 0.53736751E+036 0.14991271E+037 0.29293050E+036 0.76954741E+035 0.24154611E+035 0.39257973E+037 0.29961920E+036 0.19086133E+037 0.55248332E+035 0.33463674E+034 0.49074074E+036 0.25255402E+036 0.18692448E+036 0.30706321E+036 0.27218644E+036 0.13655640E+039 0.12227715E+037 0.92211531E+036 0.30185769E+031 0.89731392E+034 0.27787637E+032 0.12687653E+034 0.13312901E+031 0.11108622E+030 0.11058910E+034 0.18268355E+018 0.89309956E+020 0.68450617E+018 0.34533924E+031 0.18603449E+016 0.54592030E+029 0.23357478E+006 0.18953496E+014 0.62282885E+033 0.45400452E+020 0.65730906E+022 0.30516554E+007 0.41893634E+013 0.17029656E+024 0.12514347E+019 0.46479400E+034 0.59989805E+031 0.51631719E+023 0.12218936E-004 0.58126296E-022 0.13061241E-016 0.91070059E+018 0.70326239E+020 0.72460145E+017 0.93399379E+020 0.51240048E+020 0.35005035E+020 0.22116823E+020 0.17423217E+020 0.13332937E+020 0.65914483E+019 0.29134193E+019 0.48198304E+019 0.21289759E+019 0.10868531E+019 0.60786307E+018 0.77736296E+019 0.51483812E+019 0.54031661E+019 0.21257020E+019 0.23633647E+018 0.27562907E+019 0.20221548E+019 0.16913907E+019 0.20919467E+019 0.19694315E+019 0.46221822E+020 0.57627400E+019 0.37971214E+019 0.28961515E+017 0.38329191E+018 0.21265518E+017 0.14019426E+018 0.47794473E+016 0.14401706E+016 0.13548567E+018 0.18837432E+010 0.40203028E+011 0.35683173E+010 0.76620232E+016 0.18888560E+009 0.97347354E+015 0.21107855E+004 0.18978643E+008 0.22566305E+018 0.26266684E+011 0.33305877E+012 0.75722091E+004 0.87984286E+007 0.16903315E+013 0.46258970E+010 0.27801692E+018 0.98547688E+016 0.94698339E+012 0.15348166E-001 0.34334811E-010 0.16082219E-007 -19 0.47500000E-008 0.64782876E-010 0.41056001E+017 0.52974792E+019 0.56637000E+016 0.70480930E+019 0.38614358E+019 0.26370411E+019 0.16582358E+019 0.13030983E+019 0.99270162E+018 0.48926743E+018 0.21580631E+018 0.35979649E+018 0.15883720E+018 0.80910416E+017 0.45172278E+017 0.57450385E+018 0.10566142E+018 0.38926937E+018 0.47602645E+017 0.16094044E+017 0.20466535E+018 0.15118238E+018 0.12525007E+018 0.16019102E+018 0.14980354E+018 0.34346158E+019 0.28384834E+018 0.28036742E+018 0.15672058E+015 0.26087208E+017 0.16048140E+016 0.10245080E+017 0.37197498E+015 0.14568474E+015 0.10322116E+017 0.13742959E+009 0.31864238E+010 0.28517782E+009 0.59019691E+015 0.12549129E+008 0.76361255E+014 0.18866621E+003 0.17071010E+007 0.52000415E+016 0.18932305E+010 0.24943495E+011 0.65182450E+003 0.54380270E+006 0.12191975E+012 0.32582524E+009 0.21009911E+017 0.67391206E+015 0.72908913E+011 0.14375115E-002 0.42016529E-011 0.16787592E-008 0.24104944E+035 0.38355023E+039 0.45670098E+033 0.67923375E+039 0.20407289E+039 0.95203565E+038 0.37453016E+038 0.23048364E+038 0.13294931E+038 0.32122415E+037 0.62234645E+036 0.16993885E+037 0.33084536E+036 0.85367838E+035 0.26553752E+035 0.42960817E+037 0.25549698E+036 0.19213758E+037 0.47066520E+035 0.32522804E+034 0.54927487E+036 0.30401805E+036 0.20446590E+036 0.31732405E+036 0.27726692E+036 0.15393098E+039 0.10745809E+037 0.10291307E+037 0.30678347E+031 0.85018311E+034 0.33950355E+032 0.13826374E+034 0.19262132E+031 0.34523218E+030 0.14314527E+034 0.29699733E+018 0.15114212E+021 0.12480945E+019 0.48189806E+031 0.24141474E+016 0.81023512E+029 0.56886457E+006 0.45680883E+014 0.54029578E+033 0.46757306E+020 0.85943112E+022 0.66928727E+007 0.42690880E+013 0.20588005E+024 0.14360643E+019 0.59616714E+034 0.57172935E+031 0.77205874E+023 0.33417005E-004 0.30432850E-021 0.47074131E-016 0.92893591E+018 0.78230574E+020 0.87426692E+017 0.10418261E+021 0.57107216E+020 0.39007472E+020 0.24375377E+020 0.19075181E+020 0.14421650E+020 0.70604093E+019 0.30977536E+019 0.50735607E+019 0.22364111E+019 0.11301840E+019 0.62877618E+018 0.80172327E+019 0.51278412E+019 0.54030624E+019 0.21125387E+019 0.23623996E+018 0.28789863E+019 0.21969846E+019 0.17437729E+019 0.20957027E+019 0.19556092E+019 0.48485586E+020 0.58319570E+019 0.39598333E+019 0.28921242E+017 0.37910140E+018 0.23367330E+017 0.14423881E+018 0.57153437E+016 0.25252272E+016 0.15313101E+018 0.23992443E+010 0.52104352E+011 0.47991033E+010 0.89921265E+016 0.21456015E+009 0.11810609E+016 0.32837170E+004 0.29406738E+008 0.22260688E+018 0.26319008E+011 0.37802142E+012 0.11169802E+005 0.88571279E+007 0.18526363E+013 0.49172736E+010 0.31243415E+018 0.97693608E+016 0.11506253E+013 0.25314699E-001 0.78431296E-010 0.30478702E-007 -20 0.50000000E-008 0.64783266E-010 0.41868108E+017 0.58998960E+019 0.67872944E+016 0.78711083E+019 0.43062419E+019 0.29394779E+019 0.18300734E+019 0.14299662E+019 0.10780873E+019 0.52714394E+018 0.23115147E+018 0.38420472E+018 0.16931197E+018 0.85521678E+017 0.47526968E+017 0.60204050E+018 0.90049327E+017 0.39369645E+018 0.41481119E+017 0.16034528E+017 0.21672113E+018 0.16515679E+018 0.13125852E+018 0.16490905E+018 0.15314132E+018 0.36512253E+019 0.26544224E+018 0.29640620E+018 0.15554455E+015 0.25575632E+017 0.17788120E+016 0.10675373E+017 0.44172558E+015 0.23581465E+015 0.11693741E+017 0.17177714E+009 0.40561134E+010 0.37313753E+009 0.68808060E+015 0.14076010E+008 0.92048332E+014 0.28088307E+003 0.25623069E+007 0.46376924E+016 0.19462786E+010 0.28289468E+011 0.92669623E+003 0.55276555E+006 0.13296585E+012 0.34846173E+009 0.23619095E+017 0.66202847E+015 0.87519609E+011 0.22650732E-002 0.87950594E-011 0.29862984E-008 0.24577874E+035 0.46511294E+039 0.64595633E+033 0.82854177E+039 0.24814776E+039 0.11564897E+039 0.44545636E+038 0.27085612E+038 0.15284425E+038 0.36316163E+037 0.69495861E+036 0.18872436E+037 0.36604024E+036 0.92781778E+035 0.28579254E+035 0.45855504E+037 0.23157434E+036 0.19089944E+037 0.42493670E+035 0.31401907E+034 0.59904048E+036 0.35389966E+036 0.21820692E+036 0.32680097E+036 0.28152115E+036 0.16926685E+039 0.93877359E+036 0.11187432E+037 0.31240419E+031 0.79561716E+034 0.40810636E+032 0.14588733E+034 0.26673623E+031 0.89003219E+030 0.18006355E+034 0.45774806E+018 0.24095009E+021 0.21037565E+019 0.64225075E+031 0.29770480E+016 0.11573856E+030 0.12445020E+007 0.10175554E+015 0.49230145E+033 0.47956788E+020 0.10825032E+023 0.13335796E+008 0.43138175E+013 0.23814182E+024 0.15966807E+019 0.73762701E+034 0.53682549E+031 0.10904061E+024 0.82046629E-004 0.13219877E-020 0.14751300E-015 0.93899978E+018 0.85420624E+020 0.10358410E+018 0.11413835E+021 0.62441991E+020 0.42623929E+020 0.26327334E+020 0.20467578E+020 0.15287264E+020 0.74152159E+019 0.32311791E+019 0.52871420E+019 0.23255401E+019 0.11632728E+019 0.64344290E+018 0.81634804E+019 0.51501229E+019 0.53928619E+019 0.21133603E+019 0.23580200E+018 0.29670422E+019 0.23463488E+019 0.17746988E+019 0.20970800E+019 0.19392487E+019 0.50220207E+020 0.58497648E+019 0.40743645E+019 0.27742810E+017 0.37573260E+018 0.25484936E+017 0.14633609E+018 0.66857566E+016 0.40319205E+016 0.17063803E+018 0.29754932E+010 0.65545915E+011 0.62042115E+010 0.10323545E+017 0.23762845E+009 0.14060987E+016 0.48419875E+004 0.43816009E+008 0.22712199E+018 0.26343459E+011 0.42113692E+012 0.15707939E+005 0.88885952E+007 0.19785579E+013 0.51337849E+010 0.34480985E+018 0.96809735E+016 0.13588559E+013 0.39567550E-001 0.16322297E-009 0.53871292E-007 -21 0.52500000E-008 0.64783623E-010 0.42732448E+017 0.64736873E+019 0.80036711E+016 0.86630438E+019 0.47288103E+019 0.32249214E+019 0.19875961E+019 0.15447137E+019 0.11531006E+019 0.55983739E+018 0.24424099E+018 0.40745897E+018 0.17924065E+018 0.89792618E+017 0.49659963E+017 0.62559654E+018 0.78769604E+017 0.39658387E+018 0.37054000E+017 0.15946045E+017 0.22742297E+018 0.17812948E+018 0.13642570E+018 0.16954121E+018 0.15636342E+018 0.38478632E+019 0.24759779E+018 0.31053793E+018 0.15404090E+015 0.24961993E+017 0.19588886E+016 0.10995779E+017 0.51523342E+015 0.35393641E+015 0.13094978E+017 0.21012749E+009 0.50397235E+010 0.47277578E+009 0.78710658E+015 0.15522427E+008 0.10923465E+015 0.40039756E+003 0.37199668E+007 0.42157633E+016 0.19981680E+010 0.31607950E+011 0.12673960E+004 0.56088846E+006 0.14274856E+012 0.36855667E+009 0.26171349E+017 0.64696453E+015 0.10272323E+012 0.34138984E-002 0.17051315E-010 0.50158508E-008 0.25069523E+035 0.54718064E+039 0.88444492E+033 0.98116992E+039 0.29240552E+039 0.13599802E+039 0.51271592E+038 0.30822624E+038 0.17031964E+038 0.39868441E+037 0.75482116E+036 0.20679128E+037 0.39957056E+036 0.99528349E+035 0.30345138E+035 0.48131377E+037 0.21976270E+036 0.18832571E+037 0.40055582E+035 0.30253389E+034 0.64162467E+036 0.40147548E+036 0.22909150E+036 0.33593766E+036 0.28538002E+036 0.18294161E+039 0.82570669E+036 0.11944190E+037 0.31118748E+031 0.73978709E+034 0.48469161E+032 0.15038461E+034 0.35629309E+031 0.19714860E+031 0.22134852E+034 0.67568007E+018 0.36603251E+021 0.33243312E+019 0.82372130E+031 0.35480096E+016 0.16026174E+030 0.24962280E+007 0.21209215E+015 0.46520653E+033 0.49099281E+020 0.13231793E+023 0.24593050E+008 0.43463898E+013 0.26693160E+024 0.17366761E+019 0.88643403E+034 0.49996568E+031 0.14723943E+024 0.18433510E-003 0.49268377E-020 0.41217495E-015 0.94244108E+018 0.91826118E+020 0.12074020E+018 0.12315727E+021 0.67174431E+020 0.45796878E+020 0.27950595E+020 0.21593119E+020 0.15939008E+020 0.76670688E+019 0.33209502E+019 0.54749784E+019 0.24028805E+019 0.11897937E+019 0.65405001E+018 0.82456039E+019 0.52374087E+019 0.53887616E+019 0.21468240E+019 0.23513818E+018 0.30294810E+019 0.24730604E+019 0.17908098E+019 0.20976277E+019 0.19220960E+019 0.51566254E+020 0.58417257E+019 0.41539586E+019 0.26909693E+017 0.37392617E+018 0.27640827E+017 0.14703010E+018 0.76809619E+016 0.59665242E+016 0.18799430E+018 0.36110483E+010 0.80502664E+011 0.77643496E+010 0.11654519E+017 0.25876376E+009 0.16485902E+016 0.68363330E+004 0.63168659E+008 0.22880081E+018 0.26353058E+011 0.46220601E+012 0.21254011E+005 0.89019795E+007 0.20749048E+013 0.52941714E+010 0.37500404E+018 0.96094480E+016 0.15693340E+013 0.59163631E-001 0.31461455E-009 0.89915515E-007 -22 0.55000000E-008 0.64783944E-010 0.43628756E+017 0.70163172E+019 0.93033619E+016 0.94193418E+019 0.51262682E+019 0.34910579E+019 0.21302309E+019 0.16474411E+019 0.12186542E+019 0.58811924E+018 0.25551530E+018 0.43017281E+018 0.18890170E+018 0.93877274E+017 0.51662942E+017 0.64642486E+018 0.71097191E+017 0.39859809E+018 0.33951603E+017 0.15846204E+017 0.23718958E+018 0.19023875E+018 0.14104509E+018 0.17412512E+018 0.15950831E+018 0.40303590E+019 0.23128240E+018 0.32331353E+018 0.15166452E+015 0.24296474E+017 0.21445952E+016 0.11234621E+017 0.59213747E+015 0.49966300E+015 0.14525008E+017 0.25249998E+009 0.61387148E+010 0.58335142E+009 0.88619297E+015 0.16929223E+008 0.12795313E+015 0.55087029E+003 0.52483479E+007 0.38984658E+016 0.20493377E+010 0.34887842E+011 0.16793187E+004 0.56871486E+006 0.15151933E+012 0.38673293E+009 0.28658588E+017 0.63020770E+015 0.11842588E+012 0.49584582E-002 0.31023460E-010 0.80328072E-008 0.25565060E+035 0.62779910E+039 0.11763812E+034 0.11335351E+040 0.33560936E+039 0.15561437E+039 0.57433116E+038 0.34169349E+038 0.18521674E+038 0.42811763E+037 0.80352796E+036 0.22466218E+037 0.43248842E+036 0.10591486E+036 0.31955619E+035 0.49971467E+037 0.21424604E+036 0.18515015E+037 0.38757118E+035 0.29149026E+034 0.67900936E+036 0.44654822E+036 0.23806878E+036 0.34490205E+036 0.28900572E+036 0.19537762E+039 0.73707800E+036 0.12596932E+037 0.30382851E+031 0.68626813E+034 0.56939329E+032 0.15256560E+034 0.46199134E+031 0.38611237E+031 0.26701322E+034 0.96240039E+018 0.53448506E+021 0.49809490E+019 0.10231185E+032 0.41365824E+016 0.21626616E+030 0.46644845E+007 0.41756558E+015 0.44899326E+033 0.50213730E+020 0.15783603E+023 0.42574989E+008 0.43755144E+013 0.29252570E+024 0.18598654E+019 0.10401883E+035 0.46400804E+031 0.19183588E+024 0.38465519E-003 0.16173009E-019 0.10471832E-014 0.93976672E+018 0.97433344E+020 0.13868880E+018 0.13119481E+021 0.71277394E+020 0.48503090E+020 0.29248539E+020 0.22464637E+020 0.16402077E+020 0.78339458E+019 0.33766890E+019 0.56482635E+019 0.24735195E+019 0.12125520E+019 0.66227940E+018 0.82790021E+019 0.52701781E+019 0.53699165E+019 0.21586480E+019 0.23569333E+018 0.30744569E+019 0.25805316E+019 0.17976871E+019 0.20979539E+019 0.19048097E+019 0.52637048E+020 0.58327008E+019 0.42092093E+019 0.28724014E+017 0.37129982E+018 0.29820568E+017 0.14699422E+018 0.86942998E+016 0.82998246E+016 0.20519647E+018 0.43042258E+010 0.96948371E+011 0.94604617E+010 0.12987054E+017 0.27874489E+009 0.19085352E+016 0.93174171E+004 0.88523145E+008 0.22796653E+018 0.26357082E+011 0.50114729E+012 0.27867705E+005 0.89108536E+007 0.21479857E+013 0.54128560E+010 0.40298560E+018 0.95613413E+016 0.17804844E+013 0.85268617E-001 0.56923062E-009 0.14313090E-006 -23 0.57500000E-008 0.64784232E-010 0.44545593E+017 0.75277405E+019 0.10677567E+017 0.10138343E+020 0.54976977E+019 0.37371405E+019 0.22585671E+019 0.17391233E+019 0.12762284E+019 0.61294559E+018 0.26545414E+018 0.45278386E+018 0.19849270E+018 0.97883535E+017 0.53600483E+017 0.66547147E+018 0.66148856E+017 0.40013558E+018 0.31827228E+017 0.15744452E+017 0.24636199E+018 0.20163213E+018 0.14533824E+018 0.17869257E+018 0.16260828E+018 0.42031954E+019 0.21690533E+018 0.33514973E+018 0.15121307E+015 0.23614623E+017 0.23354470E+016 0.11416262E+017 0.67219468E+015 0.67116554E+015 0.15983319E+017 0.29890373E+009 0.73545856E+010 0.70417761E+009 0.98457116E+015 0.18334810E+008 0.14822948E+015 0.73602526E+003 0.72220764E+007 0.36607250E+016 0.21000801E+010 0.38123146E+011 0.21675783E+004 0.57643558E+006 0.15949693E+012 0.40346825E+009 0.31077170E+017 0.61276740E+015 0.13456553E+012 0.69807948E-002 0.53523065E-010 0.12359890E-007 0.26052421E+035 0.70562242E+039 0.15250242E+034 0.12828797E+040 0.37684903E+039 0.17404022E+039 0.62931868E+038 0.37098969E+038 0.19773175E+038 0.45247116E+037 0.84363693E+036 0.24275713E+037 0.46562817E+036 0.11217390E+036 0.33488902E+035 0.51523440E+037 0.21172679E+036 0.18178453E+037 0.38070619E+035 0.28119620E+034 0.71301015E+036 0.48923283E+036 0.24590014E+036 0.35380044E+036 0.29250278E+036 0.20694273E+039 0.67015165E+036 0.13175329E+037 0.30136096E+031 0.63702706E+034 0.66224664E+032 0.15317805E+034 0.58448077E+031 0.68423324E+031 0.31707358E+034 0.13302560E+019 0.75517600E+021 0.71420123E+019 0.12371776E+032 0.47574720E+016 0.28553764E+030 0.82214629E+007 0.78220116E+015 0.43925181E+033 0.51309976E+020 0.18452994E+023 0.69951754E+008 0.44039597E+013 0.31537380E+024 0.19697248E+019 0.11968609E+035 0.43052786E+031 0.24283478E+024 0.75425618E-003 0.47742362E-019 0.24562653E-014 0.94280298E+018 0.10228409E+021 0.15725853E+018 0.13827410E+021 0.74767608E+020 0.50753685E+020 0.30248518E+020 0.23112552E+020 0.16712340E+020 0.79369529E+019 0.34083891E+019 0.58152217E+019 0.25411657E+019 0.12335570E+019 0.66932250E+018 0.82822170E+019 0.52529449E+019 0.53748313E+019 0.21514713E+019 0.23549731E+018 0.31085631E+019 0.26720968E+019 0.17995770E+019 0.20981330E+019 0.18876059E+019 0.53517698E+020 0.58742548E+019 0.42479235E+019 0.29383978E+017 0.37105000E+018 0.32015928E+017 0.14708416E+018 0.97213738E+016 0.10981561E+017 0.22224409E+018 0.50537950E+010 0.11485072E+012 0.11275063E+011 0.14312022E+017 0.29831189E+009 0.21857531E+016 0.12334431E+005 0.12101589E+009 0.22507035E+018 0.26359025E+011 0.53795572E+012 0.35603279E+005 0.89175771E+007 0.22031136E+013 0.55006547E+010 0.42879171E+018 0.95174574E+016 0.19913448E+013 0.11914220E+000 0.97676616E-009 0.21895242E-006 -24 0.60000000E-008 0.64784503E-010 0.45468701E+017 0.80097813E+019 0.12118502E+017 0.10820701E+020 0.58438355E+019 0.39636726E+019 0.23740261E+019 0.18212878E+019 0.13275784E+019 0.63529090E+018 0.27450190E+018 0.47557351E+018 0.20814204E+018 0.10187945E+018 0.55513643E+017 0.68339608E+018 0.63099142E+017 0.40141143E+018 0.30391852E+017 0.15644699E+017 0.25519006E+018 0.21244520E+018 0.14945611E+018 0.18325119E+018 0.16567133E+018 0.43695718E+019 0.20452020E+018 0.34634652E+018 0.15231181E+015 0.22938969E+017 0.25310311E+016 0.11559456E+017 0.75524849E+015 0.86574765E+015 0.17469544E+017 0.34933943E+009 0.86889954E+010 0.83466353E+009 0.10817575E+016 0.19768611E+008 0.17008499E+015 0.95967956E+003 0.97211612E+007 0.34817616E+016 0.21505928E+010 0.41311604E+011 0.27371118E+004 0.58416950E+006 0.16686219E+012 0.41912756E+009 0.33426454E+017 0.59531456E+015 0.15110262E+012 0.95704980E-002 0.88285031E-010 0.18382443E-007 0.26522704E+035 0.77990727E+039 0.19328141E+034 0.14273485E+040 0.41557661E+039 0.19100717E+039 0.67757579E+038 0.39634387E+038 0.20828556E+038 0.47304537E+037 0.87786709E+036 0.26137246E+037 0.49958008E+036 0.11845954E+036 0.34996341E+035 0.52893480E+037 0.21060450E+036 0.17844147E+037 0.37712363E+035 0.27173912E+034 0.74503650E+036 0.52978734E+036 0.25311591E+036 0.36266921E+036 0.29590753E+036 0.21791724E+039 0.62077141E+036 0.13701981E+037 0.30667630E+031 0.59295029E+034 0.76325079E+032 0.15280660E+034 0.72440173E+031 0.11176663E+032 0.37154600E+034 0.17922238E+019 0.10377660E+022 0.98730837E+019 0.14629155E+032 0.54254768E+016 0.36997198E+030 0.13801777E+008 0.14022316E+016 0.43280015E+033 0.52401123E+020 0.21216491E+023 0.11001625E+009 0.44328354E+013 0.33595846E+024 0.20692099E+019 0.13547863E+035 0.40031565E+031 0.30023535E+024 0.14027033E-002 0.12884263E-018 0.53835469E-014 0.94972377E+018 0.10644043E+021 0.17629427E+018 0.14444385E+021 0.77682472E+020 0.52575781E+020 0.30987869E+020 0.23572931E+020 0.16906893E+020 0.79956811E+019 0.34248006E+019 0.59804893E+019 0.26079444E+019 0.12539262E+019 0.67586936E+018 0.82676336E+019 0.51909382E+019 0.53724662E+019 0.21279042E+019 0.23519106E+018 0.31363783E+019 0.27507121E+019 0.17989056E+019 0.20982463E+019 0.18705425E+019 0.54269218E+020 0.58900733E+019 0.42755874E+019 0.29315936E+017 0.37071819E+018 0.34218084E+017 0.14682248E+018 0.10759350E+017 0.13946604E+017 0.23913802E+018 0.58578690E+010 0.13419240E+012 0.13195422E+011 0.15628144E+017 0.31796480E+009 0.24801152E+016 0.15936731E+005 0.16183312E+009 0.22330655E+018 0.26360238E+011 0.57268112E+012 0.44509500E+005 0.89240047E+007 0.22445489E+013 0.55656004E+010 0.45250274E+018 0.94976467E+016 0.22013408E+013 0.16213599E+000 0.16026750E-008 0.32377479E-006 -25 0.62500000E-008 0.64784738E-010 0.46394219E+017 0.84654458E+019 0.13620374E+017 0.11468599E+020 0.61664906E+019 0.41721550E+019 0.24785634E+019 0.18957334E+019 0.13744235E+019 0.65599707E+018 0.28300868E+018 0.49869415E+018 0.21791760E+018 0.10590081E+018 0.57424070E+017 0.70062339E+018 0.61279531E+017 0.40253281E+018 0.29429723E+017 0.15548679E+017 0.26383153E+018 0.22278995E+018 0.15348616E+018 0.18781300E+018 0.16870980E+018 0.45316036E+019 0.19398158E+018 0.35711128E+018 0.15331689E+015 0.22285042E+017 0.27310494E+016 0.11676907E+017 0.84120084E+015 0.10803387E+016 0.18983373E+017 0.40380265E+009 0.10143730E+011 0.97431498E+009 0.11775276E+016 0.21248530E+008 0.19353654E+015 0.12257573E+004 0.12830115E+008 0.33514467E+016 0.22012275E+010 0.44453448E+011 0.33927711E+004 0.59196587E+006 0.17375879E+012 0.43398255E+009 0.35707722E+017 0.57830345E+015 0.16801223E+012 0.12824707E-001 0.14014962E-009 0.26553810E-007 0.26975627E+035 0.85040565E+039 0.24018509E+034 0.15658679E+040 0.45154910E+039 0.20642553E+039 0.71967243E+038 0.41830788E+038 0.21737381E+038 0.49107433E+037 0.90848862E+036 0.28068668E+037 0.53468658E+036 0.12485698E+036 0.36505811E+035 0.54151174E+037 0.21006143E+036 0.17521448E+037 0.37527786E+035 0.26310453E+034 0.77600743E+036 0.56849568E+036 0.26002746E+036 0.37153629E+036 0.29924886E+036 0.22849404E+039 0.58474563E+036 0.14193134E+037 0.31224341E+031 0.55426158E+034 0.87241560E+032 0.15184728E+034 0.88240287E+031 0.17078939E+032 0.43044614E+034 0.23618346E+019 0.13927142E+022 0.13237009E+020 0.16979154E+032 0.61521387E+016 0.47156385E+030 0.22236831E+008 0.24171141E+016 0.42975972E+033 0.53491885E+020 0.24054519E+023 0.16675055E+009 0.44624258E+013 0.35472834E+024 0.21607232E+019 0.15126342E+035 0.37363859E+031 0.36404127E+024 0.24924878E-002 0.32209409E-018 0.11132322E-013 0.95276528E+018 0.10998192E+021 0.19567621E+018 0.14977612E+021 0.80076001E+020 0.54013157E+020 0.31511987E+020 0.23885190E+020 0.17020457E+020 0.80263551E+019 0.34324098E+019 0.61463548E+019 0.26748699E+019 0.12742040E+019 0.68225522E+018 0.82429626E+019 0.51839649E+019 0.53715354E+019 0.21218194E+019 0.23464086E+018 0.31606115E+019 0.28187606E+019 0.17971437E+019 0.20983343E+019 0.18632385E+019 0.54927279E+020 0.58832848E+019 0.42958646E+019 0.28136298E+017 0.37016450E+018 0.36420633E+017 0.14690655E+018 0.11806401E+017 0.17129865E+017 0.25587940E+018 0.67143114E+010 0.15495503E+012 0.15215866E+011 0.16934628E+017 0.33798793E+009 0.27913323E+016 0.20173250E+005 0.21222010E+009 0.22716387E+018 0.26361199E+011 0.60540792E+012 0.54630000E+005 0.89308045E+007 0.22756162E+013 0.56136407E+010 0.47423122E+018 0.95026723E+016 0.24101413E+013 0.21568356E+000 0.25309435E-008 0.46505957E-006 -26 0.65000000E-008 0.64784966E-010 0.47313343E+017 0.88981759E+019 0.15179650E+017 0.12085020E+020 0.64679667E+019 0.43646169E+019 0.25743212E+019 0.19642752E+019 0.14182616E+019 0.67571902E+018 0.29122208E+018 0.52222642E+018 0.22785360E+018 0.10996535E+018 0.59342610E+017 0.71741396E+018 0.60214829E+017 0.40355071E+018 0.28781346E+017 0.15456364E+017 0.27237915E+018 0.23275593E+018 0.15747570E+018 0.19237101E+018 0.17171695E+018 0.46906631E+019 0.18507253E+018 0.36758526E+018 0.15284704E+015 0.21661540E+017 0.29355238E+016 0.11776875E+017 0.92999114E+015 0.13118688E+016 0.20524553E+017 0.46228775E+009 0.11720702E+011 0.11227121E+010 0.12718891E+016 0.22786629E+008 0.21859932E+015 0.15382908E+004 0.16637252E+008 0.32560056E+016 0.22519097E+010 0.47550274E+011 0.41393985E+004 0.59981248E+006 0.18030018E+012 0.44824525E+009 0.37923568E+017 0.56202077E+015 0.18527860E+012 0.16848120E-001 0.21526194E-009 0.37400780E-007 0.27408733E+035 0.91719042E+039 0.29343584E+034 0.16979527E+040 0.48473564E+039 0.22033378E+039 0.75655822E+038 0.43757545E+038 0.22546295E+038 0.50755318E+037 0.93713184E+036 0.30080306E+037 0.57113263E+036 0.13140819E+036 0.38030714E+035 0.55339146E+037 0.20974443E+036 0.17213829E+037 0.37417052E+035 0.25522563E+034 0.80645568E+036 0.60561983E+036 0.26679665E+036 0.38039182E+036 0.30251815E+036 0.23879897E+039 0.55856435E+036 0.14660079E+037 0.31139993E+031 0.52077784E+034 0.98994091E+032 0.15054946E+034 0.10591450E+032 0.24705128E+032 0.49378857E+034 0.30531218E+019 0.18312947E+022 0.17293784E+020 0.19405198E+032 0.69476552E+016 0.59240935E+030 0.34592783E+008 0.40225710E+016 0.42861985E+033 0.54583743E+020 0.26951185E+023 0.24489748E+009 0.44927587E+013 0.37206960E+024 0.22461619E+019 0.16693722E+035 0.35046194E+031 0.43426295E+024 0.42572920E-002 0.75386725E-018 0.21888405E-013 0.95168842E+018 0.11299012E+021 0.21533005E+018 0.15435187E+021 0.82007446E+020 0.55116223E+020 0.31866956E+020 0.24086772E+020 0.17081776E+020 0.80409414E+019 0.34357236E+019 0.63137176E+019 0.27423185E+019 0.12945965E+019 0.68861498E+018 0.82127364E+019 0.52609892E+019 0.53652527E+019 0.21531883E+019 0.23510742E+018 0.31827243E+019 0.28781072E+019 0.17951904E+019 0.20984122E+019 0.18640356E+019 0.55517203E+020 0.58622988E+019 0.43110031E+019 0.26570057E+017 0.36941593E+018 0.38623392E+017 0.14690205E+018 0.12861326E+017 0.20467160E+017 0.27246950E+018 0.76208775E+010 0.17712620E+012 0.17335999E+011 0.18231029E+017 0.35855245E+009 0.31190757E+016 0.25094235E+005 0.27342321E+009 0.22915731E+018 0.26362074E+011 0.63624256E+012 0.66009461E+005 0.89381931E+007 0.23039286E+013 0.56491761E+010 0.49409149E+018 0.95004554E+016 0.26175615E+013 0.28132511E+000 0.38677150E-008 0.65143534E-006 -27 0.67500000E-008 0.64785183E-010 0.48221085E+017 0.93111492E+019 0.16793924E+017 0.12672945E+020 0.67506543E+019 0.45432227E+019 0.26632967E+019 0.20284834E+019 0.14602113E+019 0.69488721E+018 0.29928687E+018 0.54620011E+018 0.23796349E+018 0.11407931E+018 0.61273303E+017 0.73391974E+018 0.59596652E+017 0.40449156E+018 0.28340458E+017 0.15367529E+017 0.28087761E+018 0.24241255E+018 0.16144523E+018 0.19691923E+018 0.17468708E+018 0.48476177E+019 0.17756497E+018 0.37786179E+018 0.15124258E+015 0.21072901E+017 0.31442880E+016 0.11864262E+017 0.10215821E+016 0.15574839E+016 0.22092785E+017 0.52479063E+009 0.13421923E+011 0.12794864E+010 0.13650534E+016 0.24383236E+008 0.24528828E+015 0.19014183E+004 0.21234197E+008 0.31841223E+016 0.23024269E+010 0.50604612E+011 0.49818882E+004 0.60768172E+006 0.18657268E+012 0.46206474E+009 0.40077293E+017 0.54660880E+015 0.20289128E+012 0.21753026E-001 0.32128922E-009 0.51529167E-007 0.27820702E+035 0.98048788E+039 0.35325461E+034 0.18234744E+040 0.51524644E+039 0.23285102E+039 0.78929422E+038 0.45482015E+038 0.23292003E+038 0.52315905E+037 0.96477669E+036 0.32177562E+037 0.60901650E+036 0.13813081E+036 0.39576513E+035 0.56482622E+037 0.20955133E+036 0.16922795E+037 0.37336331E+035 0.24803775E+034 0.83664761E+036 0.64138634E+036 0.27349660E+036 0.38922114E+036 0.30570206E+036 0.24891342E+039 0.53959273E+036 0.15110504E+037 0.30519277E+031 0.49207804E+034 0.11158791E+033 0.14906210E+034 0.12552999E+032 0.34150556E+032 0.56158667E+034 0.38806001E+019 0.23656102E+022 0.22100268E+020 0.21899422E+032 0.78155003E+016 0.73470931E+030 0.52212126E+008 0.64857201E+016 0.42762146E+033 0.55671015E+020 0.29893937E+023 0.35003905E+009 0.45238002E+013 0.38830110E+024 0.23270136E+019 0.18242234E+035 0.33054439E+031 0.51091629E+024 0.70244222E-002 0.16663272E-017 0.41183929E-013 0.94612229E+018 0.11554459E+021 0.23523039E+018 0.15825769E+021 0.83538745E+020 0.55937480E+020 0.32095040E+020 0.24209658E+020 0.17112138E+020 0.80476810E+019 0.34373149E+019 0.64831105E+019 0.28105202E+019 0.13151742E+019 0.69498565E+018 0.81795131E+019 0.52873076E+019 0.53627335E+019 0.21630805E+019 0.23541669E+018 0.32033923E+019 0.29302559E+019 0.17931007E+019 0.20984858E+019 0.18620762E+019 0.56054311E+020 0.58455711E+019 0.43226369E+019 0.28630215E+017 0.36907091E+018 0.40825677E+017 0.14691829E+018 0.13923313E+017 0.23905127E+017 0.28890964E+018 0.85765876E+010 0.20068759E+012 0.19552328E+011 0.19517120E+017 0.37963059E+009 0.34629931E+016 0.30750436E+005 0.34672820E+009 0.22820045E+018 0.26362920E+011 0.66530950E+012 0.78695328E+005 0.89461832E+007 0.23285089E+013 0.56754616E+010 0.51220865E+018 0.95003629E+016 0.28235016E+013 0.36067309E+000 0.57442269E-008 0.89268006E-006 -28 0.70000000E-008 0.64785378E-010 0.49121143E+017 0.97073577E+019 0.18461644E+017 0.13235248E+020 0.70169466E+019 0.47102299E+019 0.27473058E+019 0.20896801E+019 0.15010608E+019 0.71376515E+018 0.30728045E+018 0.57063211E+018 0.24824988E+018 0.11824350E+018 0.63216894E+017 0.75023062E+018 0.59245050E+017 0.40537779E+018 0.28044792E+017 0.15282762E+017 0.28934667E+018 0.25181504E+018 0.16540255E+018 0.20146738E+018 0.17763018E+018 0.50030425E+019 0.17125417E+018 0.38800434E+018 0.15059417E+015 0.20522990E+017 0.33572521E+016 0.11942062E+017 0.11159507E+016 0.18146668E+016 0.23687811E+017 0.59131133E+009 0.15249408E+011 0.14443032E+010 0.14573881E+016 0.26034791E+008 0.27361581E+015 0.23193789E+004 0.26715537E+008 0.31300992E+016 0.23528436E+010 0.53619962E+011 0.59252295E+004 0.61558294E+006 0.19264219E+012 0.47555460E+009 0.42172643E+017 0.53216670E+015 0.22084306E+012 0.27659311E-001 0.46765533E-009 0.69629324E-007 0.28212723E+035 0.10406252E+040 0.41986437E+034 0.19425285E+040 0.54328131E+039 0.24415142E+039 0.81893338E+038 0.47064133E+038 0.24000871E+038 0.53831059E+037 0.99195094E+036 0.34364575E+037 0.64838231E+036 0.14502925E+036 0.41144358E+035 0.57596345E+037 0.20946163E+036 0.16648961E+037 0.37292438E+035 0.24150264E+034 0.86670018E+036 0.67599252E+036 0.28015577E+036 0.39805083E+036 0.30882808E+036 0.25889116E+039 0.52587127E+036 0.15549651E+037 0.30014940E+031 0.46771523E+034 0.12503145E+033 0.14747429E+034 0.14715482E+032 0.45456052E+032 0.63385264E+034 0.48592747E+019 0.30085695E+022 0.27709829E+020 0.24462430E+032 0.87564985E+016 0.90074974E+030 0.76758842E+008 0.10162326E+017 0.42690515E+033 0.56753874E+020 0.32873194E+023 0.48868194E+009 0.45556056E+013 0.40367885E+024 0.24044026E+019 0.19766260E+035 0.31358314E+031 0.59402086E+024 0.11241923E-001 0.35032535E-017 0.74545301E-013 0.94478209E+018 0.11771639E+021 0.25533264E+018 0.16157030E+021 0.84728976E+020 0.56529559E+020 0.32234098E+020 0.24281096E+020 0.17126712E+020 0.80514925E+019 0.34388575E+019 0.66546188E+019 0.28794236E+019 0.13359356E+019 0.70138504E+018 0.81447046E+019 0.52688070E+019 0.53688312E+019 0.21562327E+019 0.23550597E+018 0.32229519E+019 0.29763413E+019 0.17909931E+019 0.20985570E+019 0.18614722E+019 0.56547401E+020 0.58800798E+019 0.43318568E+019 0.29310093E+017 0.36956172E+018 0.43024778E+017 0.14678541E+018 0.14991787E+017 0.27420853E+017 0.30520118E+018 0.95793565E+010 0.22562403E+012 0.21851370E+011 0.20792809E+017 0.40110656E+009 0.38227483E+016 0.37192265E+005 0.43340811E+009 0.22566551E+018 0.26363752E+011 0.69273491E+012 0.92730917E+005 0.89653904E+007 0.23468824E+013 0.56949049E+010 0.52871071E+018 0.94768633E+016 0.30279094E+013 0.45543592E+000 0.83209330E-008 0.11998516E-005 -29 0.72500000E-008 0.64785559E-010 0.50012092E+017 0.10089378E+020 0.20182071E+017 0.13774488E+020 0.72691490E+019 0.48678526E+019 0.28278768E+019 0.21489049E+019 0.15413179E+019 0.73250105E+018 0.31524119E+018 0.59554603E+018 0.25871582E+018 0.12245689E+018 0.65172423E+017 0.76639664E+018 0.59040524E+017 0.40621657E+018 0.27844166E+017 0.15201755E+017 0.29779438E+018 0.26100853E+018 0.16935066E+018 0.20601306E+018 0.18054413E+018 0.51573217E+019 0.16595228E+018 0.39805536E+018 0.15192441E+015 0.20012226E+017 0.35747269E+016 0.12012263E+017 0.12130832E+016 0.20812816E+016 0.25309366E+017 0.66185458E+009 0.17205238E+011 0.16168522E+010 0.15493529E+016 0.27737238E+008 0.30359544E+015 0.27965086E+004 0.33178596E+008 0.30872707E+016 0.24030942E+010 0.56600218E+011 0.69745374E+004 0.62353173E+006 0.19855886E+012 0.48879800E+009 0.44213564E+017 0.51871939E+015 0.23912858E+012 0.34694466E-001 0.66579280E-009 0.92481681E-007 0.28584944E+035 0.10979447E+040 0.49350999E+034 0.20553236E+040 0.56909494E+039 0.25443735E+039 0.84640618E+038 0.48552508E+038 0.24690038E+038 0.55324413E+037 0.10189169E+037 0.36646767E+037 0.68928085E+036 0.15210373E+036 0.42733202E+035 0.58688651E+037 0.20943059E+036 0.16391927E+037 0.37269197E+035 0.23556075E+034 0.89666120E+036 0.70961274E+036 0.28678609E+036 0.40687450E+036 0.31189090E+036 0.26876856E+039 0.51593892E+036 0.15981063E+037 0.30628643E+031 0.44715805E+034 0.13936757E+033 0.14584323E+034 0.17085777E+032 0.58618179E+032 0.71059767E+034 0.60046191E+019 0.37739229E+022 0.34172098E+020 0.27101662E+032 0.97705333E+016 0.10929211E+031 0.11026720E+009 0.15516238E+017 0.42540712E+033 0.57835374E+020 0.35881925E+023 0.66835057E+009 0.45883217E+013 0.41840417E+024 0.24791949E+019 0.21261951E+035 0.29924054E+031 0.68359805E+024 0.17510910E-001 0.70468029E-017 0.13037829E-012 0.95075082E+018 0.11956191E+021 0.27562834E+018 0.16435250E+021 0.85630002E+020 0.56939608E+020 0.32316026E+020 0.24320290E+020 0.17135881E+020 0.80536042E+019 0.34397453E+019 0.68286327E+019 0.29490599E+019 0.13568336E+019 0.70777296E+018 0.81090830E+019 0.52097432E+019 0.53718404E+019 0.21342149E+019 0.23508629E+018 0.32415455E+019 0.30173223E+019 0.17888143E+019 0.20986268E+019 0.18620373E+019 0.57004194E+020 0.58943936E+019 0.43393892E+019 0.29467203E+017 0.37023013E+018 0.45228256E+017 0.14681344E+018 0.16066326E+017 0.30950820E+017 0.32134545E+018 0.10627666E+011 0.25192185E+012 0.24227465E+011 0.22058081E+017 0.42287094E+009 0.41981909E+016 0.44469338E+005 0.53474588E+009 0.22235180E+018 0.26364572E+011 0.71863885E+012 0.10816297E+006 0.89912358E+007 0.23606029E+013 0.57092870E+010 0.54372335E+018 0.94842629E+016 0.32307600E+013 0.56738267E+000 0.11790443E-007 0.15852888E-005 -30 0.75000000E-008 0.64785711E-010 0.50899181E+017 0.10459350E+020 0.21954656E+017 0.14292931E+020 0.75094504E+019 0.50181298E+019 0.29061924E+019 0.22069070E+019 0.15812743E+019 0.75116840E+018 0.32318568E+018 0.62097318E+018 0.26936275E+018 0.12671701E+018 0.67138140E+017 0.78244691E+018 0.58923577E+017 0.40701800E+018 0.27711923E+017 0.15124903E+017 0.30622289E+018 0.27003021E+018 0.17329056E+018 0.21056725E+018 0.18344011E+018 0.53107292E+019 0.16150401E+018 0.40804330E+018 0.15308621E+015 0.19541392E+017 0.37972277E+016 0.12076230E+017 0.13129715E+016 0.23555746E+016 0.26957211E+017 0.73642875E+009 0.19291627E+011 0.17968411E+010 0.16414226E+016 0.29484350E+008 0.33524478E+015 0.33372408E+004 0.40723397E+008 0.30583975E+016 0.24535705E+010 0.59549804E+011 0.81350791E+004 0.63156114E+006 0.20436019E+012 0.50185656E+009 0.46204027E+017 0.50629200E+015 0.25774354E+012 0.42993637E-001 0.92941404E-009 0.12096262E-006 0.28944337E+035 0.11527621E+040 0.57443251E+034 0.21621304E+040 0.59297064E+039 0.26391209E+039 0.87244800E+038 0.49982563E+038 0.25369294E+038 0.56807522E+037 0.10457852E+037 0.39030884E+037 0.73175368E+036 0.15935007E+036 0.44340753E+035 0.59764363E+037 0.20942088E+036 0.16151142E+037 0.37270466E+035 0.23017133E+034 0.92653962E+036 0.74240153E+036 0.29339182E+036 0.41571639E+036 0.31491578E+036 0.27857146E+039 0.50873471E+036 0.16407120E+037 0.31187938E+031 0.42992771E+034 0.15466311E+033 0.14420542E+034 0.19670821E+032 0.73600973E+032 0.79183181E+034 0.73325780E+019 0.46763166E+022 0.41532803E+020 0.29828630E+032 0.10855076E+017 0.13137473E+031 0.15519456E+009 0.23141173E+017 0.42539341E+033 0.58919697E+020 0.38915232E+023 0.89768963E+009 0.46220038E+013 0.43263363E+024 0.25520369E+019 0.22726876E+035 0.28718905E+031 0.77966978E+024 0.26623735E-001 0.13629098E-016 0.22115459E-012 0.95401032E+018 0.12112983E+021 0.29609728E+018 0.16666274E+021 0.86291424E+020 0.57213868E+020 0.32359269E+020 0.24339510E+020 0.17142231E+020 0.80560059E+019 0.34402557E+019 0.70056157E+019 0.30193966E+019 0.13778036E+019 0.71411264E+018 0.80730702E+019 0.51704810E+019 0.53686549E+019 0.21160298E+019 0.23462176E+018 0.32591656E+019 0.30539969E+019 0.17866027E+019 0.20986953E+019 0.18617497E+019 0.57430369E+020 0.58900428E+019 0.43457187E+019 0.28426269E+017 0.36953127E+018 0.47445616E+017 0.14687460E+018 0.17146615E+017 0.34464184E+017 0.33734381E+018 0.11719907E+011 0.27958665E+012 0.26708887E+011 0.23312963E+017 0.44478180E+009 0.45890069E+016 0.52631525E+005 0.65202624E+009 0.22686913E+018 0.26365371E+011 0.74314584E+012 0.12503695E+006 0.90181077E+007 0.23708405E+013 0.57199255E+010 0.55736757E+018 0.94849267E+016 0.34320430E+013 0.69836582E+000 0.16382281E-007 0.20627207E-005 -31 0.77500000E-008 0.64785857E-010 0.51777222E+017 0.10819185E+020 0.23779003E+017 0.14792816E+020 0.77400101E+019 0.51629358E+019 0.29831504E+019 0.22642222E+019 0.16211030E+019 0.76981093E+018 0.33112524E+018 0.64695646E+018 0.28019369E+018 0.13102157E+018 0.69112261E+017 0.79839849E+018 0.58851587E+017 0.40778258E+018 0.27618606E+017 0.15051440E+017 0.31463401E+018 0.27891196E+018 0.17722461E+018 0.21511949E+018 0.18630793E+018 0.54634753E+019 0.15777450E+018 0.41798779E+018 0.15286324E+015 0.19108451E+017 0.40252811E+016 0.12135160E+017 0.14156118E+016 0.26361335E+016 0.28631135E+017 0.81504540E+009 0.21510933E+011 0.19839932E+010 0.17340235E+016 0.31269302E+008 0.36858634E+015 0.39461082E+004 0.49452731E+008 0.30379434E+016 0.25041203E+010 0.62472816E+011 0.94122963E+004 0.63964548E+006 0.21007605E+012 0.51478428E+009 0.48147989E+017 0.49486243E+015 0.27668436E+012 0.52699707E-001 0.12748028E-008 0.15605069E-006 0.29291614E+035 0.12053890E+040 0.66287775E+034 0.22633264E+040 0.61521869E+039 0.27277217E+039 0.89761771E+038 0.51379316E+038 0.26044111E+038 0.58286396E+037 0.10726143E+037 0.41525248E+037 0.77584278E+036 0.16676162E+036 0.45963800E+035 0.60826100E+037 0.20937631E+036 0.15925352E+037 0.37263060E+035 0.22526545E+034 0.95632823E+036 0.77449628E+036 0.29997611E+036 0.42455419E+036 0.31788154E+036 0.28831848E+039 0.50345615E+036 0.16829432E+037 0.31187534E+031 0.41553361E+034 0.17099464E+033 0.14258685E+034 0.22477601E+032 0.90346178E+032 0.87756416E+034 0.88595394E+019 0.57313403E+022 0.49833701E+020 0.32655995E+032 0.12006119E+017 0.15659070E+031 0.21447847E+009 0.33785017E+017 0.42582659E+033 0.60007592E+020 0.41969984E+023 0.11865766E+010 0.46566002E+013 0.44648740E+024 0.26234218E+019 0.24159728E+035 0.27711948E+031 0.88225758E+024 0.39608616E-001 0.25451209E-016 0.36497679E-012 0.95298594E+018 0.12246193E+021 0.31672865E+018 0.16855591E+021 0.86759790E+020 0.57390270E+020 0.32380355E+020 0.24351414E+020 0.17145894E+020 0.80576641E+019 0.34405744E+019 0.71862232E+019 0.30904338E+019 0.13987781E+019 0.72035733E+018 0.80368973E+019 0.52557901E+019 0.53635113E+019 0.21508323E+019 0.23494942E+018 0.32757986E+019 0.30870344E+019 0.17843769E+019 0.20987626E+019 0.18634452E+019 0.57830254E+020 0.58677861E+019 0.43511693E+019 0.26378918E+017 0.36921695E+018 0.49686402E+017 0.14692132E+018 0.18232827E+017 0.37937448E+017 0.35320025E+018 0.12854652E+011 0.30860374E+012 0.29282803E+011 0.24557495E+017 0.46669228E+009 0.49951389E+016 0.61728798E+005 0.78656426E+009 0.22911195E+018 0.26366141E+011 0.76637647E+012 0.14340119E+006 0.90595597E+007 0.23784741E+013 0.57277947E+010 0.56975824E+018 0.94934654E+016 0.36317729E+013 0.85031408E+000 0.22366962E-007 0.26473200E-005 -32 0.80000000E-008 0.64785996E-010 0.52644175E+017 0.11170191E+020 0.25654220E+017 0.15275781E+020 0.79626553E+019 0.53037704E+019 0.30593191E+019 0.23211586E+019 0.16608685E+019 0.78843974E+018 0.33906154E+018 0.67355167E+018 0.29121061E+018 0.13536524E+018 0.71091109E+017 0.81426047E+018 0.58807659E+017 0.40851386E+018 0.27550596E+017 0.14981111E+017 0.32302328E+018 0.28767976E+018 0.18115335E+018 0.21966695E+018 0.18914498E+018 0.56157116E+019 0.15465219E+018 0.42790045E+018 0.15148118E+015 0.18711175E+017 0.42598494E+016 0.12189841E+017 0.15210026E+016 0.29218378E+016 0.30330875E+017 0.89771716E+009 0.23865708E+011 0.21780456E+010 0.18274907E+016 0.33082524E+008 0.40364950E+015 0.46277472E+004 0.59472309E+008 0.30228416E+016 0.25546208E+010 0.65373265E+011 0.10811822E+005 0.64775970E+006 0.21572784E+012 0.52761276E+009 0.50049200E+017 0.48437340E+015 0.29594764E+012 0.63963402E-001 0.17211274E-008 0.19883321E-006 0.29625512E+035 0.12560519E+040 0.75904893E+034 0.23592213E+040 0.63612634E+039 0.28118375E+039 0.92228418E+038 0.52757941E+038 0.26716830E+038 0.59763114E+037 0.10994208E+037 0.44141205E+037 0.82159499E+036 0.17432539E+036 0.47597102E+035 0.61875529E+037 0.20934056E+036 0.15713970E+037 0.37247300E+035 0.22079835E+034 0.98599679E+036 0.80601759E+036 0.30654191E+036 0.43337966E+036 0.32078108E+036 0.29802435E+039 0.49960754E+036 0.17249043E+037 0.30686032E+031 0.40352935E+034 0.18849286E+033 0.14100537E+034 0.25513150E+032 0.10878175E+033 0.96780273E+034 0.10602262E+020 0.69556091E+022 0.59112594E+020 0.35595181E+032 0.13215957E+017 0.18522742E+031 0.29159819E+009 0.48376850E+017 0.42615488E+033 0.61093463E+020 0.45044512E+023 0.15462444E+010 0.46920431E+013 0.46005810E+024 0.26937335E+019 0.25560076E+035 0.26872157E+031 0.99138205E+024 0.57781395E-001 0.46053202E-016 0.58761324E-012 0.94795060E+018 0.12358921E+021 0.33749895E+018 0.17007582E+021 0.87085572E+020 0.57494173E+020 0.32397675E+020 0.24362991E+020 0.17148040E+020 0.80588405E+019 0.34407966E+019 0.73714246E+019 0.31621742E+019 0.14196424E+019 0.72643256E+018 0.80006914E+019 0.52887141E+019 0.53602214E+019 0.21634288E+019 0.23539940E+018 0.32913738E+019 0.31169954E+019 0.17821474E+019 0.20988286E+019 0.18603732E+019 0.58207262E+020 0.58402670E+019 0.43559585E+019 0.28427600E+017 0.36879235E+018 0.51969403E+017 0.14687822E+018 0.19324331E+017 0.41353247E+017 0.36891349E+018 0.14030507E+011 0.33897124E+012 0.31931498E+011 0.25791731E+017 0.48839798E+009 0.54166480E+016 0.71811166E+005 0.93967309E+009 0.22846812E+018 0.26366878E+011 0.78844602E+012 0.16330581E+006 0.91235842E+007 0.23845181E+013 0.57336155E+010 0.58100325E+018 0.94980848E+016 0.38299755E+013 0.10252308E+001 0.30060531E-007 0.33560518E-005 -33 0.82500000E-008 0.64786117E-010 0.53499629E+017 0.11513480E+020 0.27578422E+017 0.15743454E+020 0.81791106E+019 0.54418801E+019 0.31350621E+019 0.23778994E+019 0.17005991E+019 0.80705918E+018 0.34699511E+018 0.70083040E+018 0.30241101E+018 0.13973965E+018 0.73069965E+017 0.83003989E+018 0.58783910E+017 0.40921719E+018 0.27501838E+017 0.14913985E+017 0.33138463E+018 0.29635554E+018 0.18507692E+018 0.22421185E+018 0.19195371E+018 0.57675625E+019 0.15204409E+018 0.43778990E+018 0.15018128E+015 0.18347846E+017 0.45022383E+016 0.12240895E+017 0.16291443E+016 0.32118094E+016 0.32056201E+017 0.98445568E+009 0.26358797E+011 0.23787482E+010 0.19220564E+016 0.34910360E+008 0.44047437E+015 0.53869048E+004 0.70891033E+008 0.30107144E+016 0.26050241E+010 0.68255154E+011 0.12339499E+005 0.65589392E+006 0.22133194E+012 0.54036929E+009 0.51911240E+017 0.47477539E+015 0.31553030E+012 0.76943465E-001 0.22907787E-008 0.25051369E-006 0.29944526E+035 0.13049509E+040 0.86306062E+034 0.24501827E+040 0.65597486E+039 0.28928635E+039 0.94668105E+038 0.54127316E+038 0.27388436E+038 0.61238441E+037 0.11262097E+037 0.46893215E+037 0.86902797E+036 0.18201824E+036 0.49233605E+035 0.62913771E+037 0.20933925E+036 0.15516393E+037 0.37236470E+035 0.21673919E+034 0.10155015E+037 0.83707140E+036 0.31308986E+036 0.44220241E+036 0.32362490E+036 0.30770066E+039 0.49681437E+036 0.17666683E+037 0.29863661E+031 0.39355986E+034 0.20734186E+033 0.13947255E+034 0.28784541E+032 0.12882842E+033 0.10625546E+035 0.12577809E+020 0.83669042E+022 0.69403411E+020 0.38655042E+032 0.14471437E+017 0.21759911E+031 0.39064146E+009 0.68057116E+017 0.42620177E+033 0.62176006E+020 0.48138348E+023 0.19894173E+010 0.47283014E+013 0.47341642E+024 0.27632439E+019 0.26928153E+035 0.26173845E+031 0.11070626E+025 0.82805272E-001 0.80993110E-016 0.92511463E-012 0.94368703E+018 0.12453819E+021 0.35836225E+018 0.17126516E+021 0.87293426E+020 0.57550222E+020 0.32411162E+020 0.24373590E+020 0.17149319E+020 0.80597343E+019 0.34409625E+019 0.75624821E+019 0.32345241E+019 0.14402252E+019 0.73224829E+018 0.79667132E+019 0.52758099E+019 0.53677117E+019 0.21588597E+019 0.23553317E+018 0.33058001E+019 0.31443526E+019 0.17799176E+019 0.20988932E+019 0.18616238E+019 0.58564128E+020 0.58766853E+019 0.43602340E+019 0.29150250E+017 0.36955115E+018 0.54319373E+017 0.14675230E+018 0.20420941E+017 0.44699152E+017 0.38448481E+018 0.15246079E+011 0.37070052E+012 0.34650700E+011 0.27015724E+017 0.50961616E+009 0.58537592E+016 0.82930736E+005 0.11126608E+010 0.22632521E+018 0.26367579E+011 0.80946364E+012 0.18480429E+006 0.91891963E+007 0.23895773E+013 0.57379212E+010 0.59120318E+018 0.94682794E+016 0.40266173E+013 0.12252485E+001 0.39832313E-007 0.42072124E-005 -34 0.85000000E-008 0.64786230E-010 0.54342024E+017 0.11849890E+020 0.29547156E+017 0.16197298E+020 0.83909265E+019 0.55782332E+019 0.32105799E+019 0.24345347E+019 0.17403009E+019 0.82566808E+018 0.35492472E+018 0.72888344E+018 0.31378241E+018 0.14412941E+018 0.75041255E+017 0.84573820E+018 0.58764586E+017 0.40989113E+018 0.27465406E+017 0.14849848E+017 0.33970712E+018 0.30495725E+018 0.18899404E+018 0.22875463E+018 0.19473487E+018 0.59191069E+019 0.14986277E+018 0.44766095E+018 0.15166889E+015 0.18015895E+017 0.47544878E+016 0.12288722E+017 0.17400385E+016 0.35053655E+016 0.33806835E+017 0.10752688E+010 0.28993483E+011 0.25858633E+010 0.20178618E+016 0.36733870E+008 0.47911729E+015 0.62284493E+004 0.83821423E+008 0.29984475E+016 0.26552099E+010 0.71122289E+011 0.14001401E+005 0.66405858E+006 0.22689963E+012 0.55306664E+009 0.53737419E+017 0.46598957E+015 0.33542930E+012 0.91806916E-001 0.30097385E-008 0.31242036E-006 0.30244886E+035 0.13522491E+040 0.97480512E+034 0.25365953E+040 0.67502883E+039 0.29719154E+039 0.97094430E+038 0.55492239E+038 0.28059408E+038 0.62712864E+037 0.11529863E+037 0.49800353E+037 0.91810213E+036 0.18979776E+036 0.50862533E+035 0.63941403E+037 0.20934434E+036 0.15331745E+037 0.37230617E+035 0.21304949E+034 0.10447790E+037 0.86775012E+036 0.31961982E+036 0.45101849E+036 0.32641012E+036 0.31735621E+039 0.49477316E+036 0.18082827E+037 0.30561745E+031 0.38527663E+034 0.22783299E+033 0.13799602E+034 0.32298885E+032 0.15040442E+033 0.11618258E+035 0.14803426E+020 0.99843965E+022 0.80736342E+020 0.41841662E+032 0.15752053E+017 0.25405871E+031 0.51637736E+009 0.94211497E+017 0.42494461E+033 0.63255549E+020 0.51251998E+023 0.25304609E+010 0.47654976E+013 0.48661537E+024 0.28321592E+019 0.28264682E+035 0.25592917E+031 0.12293174E+025 0.11675947E+000 0.13881078E-015 0.14271486E-011 0.95046771E+018 0.12532997E+021 0.37922047E+018 0.17216277E+021 0.87415923E+020 0.57599012E+020 0.32427739E+020 0.24381106E+020 0.17150156E+020 0.80604517E+019 0.34410933E+019 0.77610351E+019 0.33072144E+019 0.14602363E+019 0.73767060E+018 0.79680310E+019 0.52232745E+019 0.53720133E+019 0.21391693E+019 0.23512700E+018 0.33189368E+019 0.31695043E+019 0.17776889E+019 0.20989561E+019 0.18619815E+019 0.58903096E+020 0.58940099E+019 0.43640964E+019 0.29543589E+017 0.37017882E+018 0.56775210E+017 0.14678645E+018 0.21522496E+017 0.47966612E+017 0.39991549E+018 0.16499909E+011 0.40380112E+012 0.37436232E+011 0.28229536E+017 0.52996937E+009 0.63070513E+016 0.95139756E+005 0.13068693E+010 0.22250844E+018 0.26368244E+011 0.82953188E+012 0.20795894E+006 0.92561819E+007 0.23933449E+013 0.57411060E+010 0.60045121E+018 0.94801307E+016 0.42217043E+013 0.14525179E+001 0.52105219E-007 0.52209214E-005 -35 0.87500000E-008 0.64786323E-010 0.55173535E+017 0.12180092E+020 0.31550768E+017 0.16638751E+020 0.85994486E+019 0.57135330E+019 0.32859850E+019 0.24911158E+019 0.17799845E+019 0.84426951E+018 0.36285130E+018 0.75781068E+018 0.32528976E+018 0.14851040E+018 0.76995178E+017 0.86135881E+018 0.58755636E+017 0.41054294E+018 0.27443620E+017 0.14789196E+017 0.34798044E+018 0.31350049E+018 0.19290479E+018 0.23330650E+018 0.19749985E+018 0.60704257E+019 0.14804552E+018 0.45751819E+018 0.15288102E+015 0.17714469E+017 0.50197245E+016 0.12333762E+017 0.18536873E+016 0.38019773E+016 0.35582578E+017 0.11701572E+010 0.31773697E+011 0.27991649E+010 0.21149820E+016 0.38527716E+008 0.51965856E+015 0.71573878E+004 0.98380264E+008 0.29921450E+016 0.27056296E+010 0.73978770E+011 0.15803860E+005 0.67229117E+006 0.23243975E+012 0.56572050E+009 0.55530860E+017 0.45799634E+015 0.35564173E+012 0.10872946E+000 0.39079859E-008 0.38601660E-006 0.30531374E+035 0.13980660E+040 0.10936825E+035 0.26188501E+040 0.69351421E+039 0.30497751E+039 0.99513974E+038 0.56854832E+038 0.28729916E+038 0.64186494E+037 0.11797502E+037 0.52883945E+037 0.96860595E+036 0.19759037E+036 0.52468669E+035 0.64958778E+037 0.20935731E+036 0.15159301E+037 0.37242997E+035 0.20970944E+034 0.10737508E+037 0.89813404E+036 0.32613044E+036 0.45985493E+036 0.32916457E+036 0.32699797E+039 0.49326798E+036 0.18497801E+037 0.31105222E+031 0.37844190E+034 0.25042453E+033 0.13657976E+034 0.36063324E+032 0.17342852E+033 0.12656214E+035 0.17296354E+020 0.11828985E+023 0.93138003E+020 0.45158878E+032 0.17028005E+017 0.29501592E+031 0.67433678E+009 0.12850952E+018 0.42507644E+033 0.64338486E+020 0.54386718E+023 0.31855528E+010 0.48036797E+013 0.49969480E+024 0.29006209E+019 0.29570734E+035 0.25112108E+031 0.13581627E+025 0.16221817E+000 0.23237591E-015 0.21612262E-011 0.95427067E+018 0.12598078E+021 0.39986808E+018 0.17282241E+021 0.87479746E+020 0.57642680E+020 0.32439816E+020 0.24386469E+020 0.17151524E+020 0.80610513E+019 0.34412003E+019 0.79687609E+019 0.33794414E+019 0.14791847E+019 0.74251163E+018 0.79672396E+019 0.51512243E+019 0.53685716E+019 0.21082145E+019 0.23473393E+018 0.33306126E+019 0.31927878E+019 0.17754622E+019 0.20990174E+019 0.18619328E+019 0.59226038E+020 0.58932356E+019 0.43676158E+019 0.28679054E+017 0.36950134E+018 0.59400007E+017 0.14685299E+018 0.22628854E+017 0.51150064E+017 0.41520678E+018 0.17790902E+011 0.43829957E+012 0.40284014E+011 0.29439676E+017 0.54895834E+009 0.67775696E+016 0.10848875E+006 0.15237018E+010 0.22641275E+018 0.26368873E+011 0.84874659E+012 0.23282323E+006 0.93604012E+007 0.23961495E+013 0.57434619E+010 0.60883326E+018 0.94812549E+016 0.44152433E+013 0.17092876E+001 0.67364423E-007 0.64193079E-005 -36 0.90000000E-008 0.64786411E-010 0.55983395E+017 0.12504637E+020 0.33568695E+017 0.17069322E+020 0.88058704E+019 0.58482925E+019 0.33613551E+019 0.25476861E+019 0.18196714E+019 0.86287351E+018 0.37077911E+018 0.78768489E+018 0.33684887E+018 0.15284105E+018 0.78918519E+017 0.87690259E+018 0.58744076E+017 0.41116744E+018 0.27423488E+017 0.14731127E+017 0.35619498E+018 0.32199912E+018 0.19681053E+018 0.23785543E+018 0.20023686E+018 0.62215824E+019 0.14653064E+018 0.46736458E+018 0.15290963E+015 0.17440151E+017 0.53030585E+016 0.12376508E+017 0.19700938E+016 0.41012359E+016 0.37383212E+017 0.12691091E+010 0.34704429E+011 0.30184385E+010 0.22134528E+016 0.40256757E+008 0.56221821E+015 0.81788924E+004 0.11468963E+009 0.29878321E+016 0.27560812E+010 0.76827986E+011 0.17753509E+005 0.68056140E+006 0.23795990E+012 0.57834604E+009 0.57294479E+017 0.45073022E+015 0.37616479E+012 0.12789615E+000 0.50199559E-008 0.47291459E-006 0.30798894E+035 0.14425009E+040 0.12180337E+035 0.26973945E+040 0.71163269E+039 0.31270088E+039 0.10193090E+039 0.58216663E+038 0.29400400E+038 0.65660201E+037 0.12065162E+037 0.56162429E+037 0.10199663E+037 0.20526638E+036 0.54031157E+035 0.65965932E+037 0.20933324E+036 0.14997761E+037 0.37242108E+035 0.20666480E+034 0.11023383E+037 0.92829402E+036 0.33262284E+036 0.46868432E+036 0.33186201E+036 0.33663117E+039 0.49211211E+036 0.18911819E+037 0.31223803E+031 0.37278627E+034 0.27588759E+033 0.13522793E+034 0.40085031E+032 0.19782209E+033 0.13739457E+035 0.20073514E+020 0.13923938E+023 0.10663162E+021 0.48609051E+032 0.18255866E+017 0.34097210E+031 0.87090312E+009 0.17294958E+018 0.42531159E+033 0.65423958E+020 0.57544327E+023 0.39728796E+010 0.48427696E+013 0.51268392E+024 0.29687431E+019 0.30847615E+035 0.24715240E+031 0.14936135E+025 0.22234153E+000 0.38075034E-015 0.32180511E-011 0.95344570E+018 0.12650516E+021 0.41987386E+018 0.17326406E+021 0.87582512E+020 0.57672485E+020 0.32448857E+020 0.24390407E+020 0.17154101E+020 0.80615668E+019 0.34412902E+019 0.81867200E+019 0.34493799E+019 0.14962231E+019 0.74651762E+018 0.79665251E+019 0.52457173E+019 0.53644070E+019 0.21465651E+019 0.23486412E+018 0.33406508E+019 0.32145380E+019 0.17732376E+019 0.20991144E+019 0.18632364E+019 0.59534528E+020 0.58726947E+019 0.43708416E+019 0.26797802E+017 0.36941595E+018 0.62294923E+017 0.14693501E+018 0.23739884E+017 0.54246220E+017 0.43035993E+018 0.19117381E+011 0.47424379E+012 0.43190066E+011 0.30653419E+017 0.56588803E+009 0.72671512E+016 0.12303145E+006 0.17645939E+010 0.22882747E+018 0.26369468E+011 0.86719688E+012 0.25945942E+006 0.94793569E+007 0.23982365E+013 0.57452045E+010 0.61642825E+018 0.94958956E+016 0.46072417E+013 0.19979162E+001 0.86165561E-007 0.78266143E-005 -37 0.92500000E-008 0.64786502E-010 0.56764306E+017 0.12823862E+020 0.35561685E+017 0.17490603E+020 0.90110531E+019 0.59827702E+019 0.34366947E+019 0.26042405E+019 0.18593527E+019 0.88147565E+018 0.37870633E+018 0.81842140E+018 0.34827352E+018 0.15705645E+018 0.80795811E+017 0.89237068E+018 0.58736066E+017 0.41176842E+018 0.27406397E+017 0.14675683E+017 0.36434125E+018 0.33046446E+018 0.20071129E+018 0.24240327E+018 0.20294795E+018 0.63726281E+019 0.14527348E+018 0.47720134E+018 0.15174786E+015 0.17190880E+017 0.56124883E+016 0.12417224E+017 0.20892611E+016 0.44028235E+016 0.39208500E+017 0.13720923E+010 0.37792346E+011 0.32434800E+010 0.23132881E+016 0.41878302E+008 0.60697934E+015 0.92983444E+004 0.13287856E+009 0.29858393E+016 0.28065835E+010 0.79673248E+011 0.19857351E+005 0.68886081E+006 0.24346499E+012 0.59094906E+009 0.59030901E+017 0.44413102E+015 0.39699562E+012 0.14950241E+000 0.63850783E-008 0.57489454E-006 0.31040197E+035 0.14856240E+040 0.13442478E+035 0.27727563E+040 0.72953727E+039 0.32039278E+039 0.10434604E+039 0.59577800E+038 0.30070707E+038 0.67133604E+037 0.12332774E+037 0.59629623E+037 0.10708578E+037 0.21262294E+036 0.55526174E+035 0.66963234E+037 0.20931428E+036 0.14846803E+037 0.37236634E+035 0.20389575E+034 0.11304780E+037 0.95829273E+036 0.33909847E+036 0.47751069E+036 0.33450738E+036 0.34626113E+039 0.49126108E+036 0.19325026E+037 0.30825330E+031 0.36811086E+034 0.30549398E+033 0.13394196E+034 0.44371204E+032 0.22351008E+033 0.14868020E+035 0.23150982E+020 0.16295929E+023 0.12123717E+021 0.52193716E+032 0.19380647E+017 0.39257737E+031 0.11134185E+010 0.22991372E+018 0.42596299E+033 0.66509044E+020 0.60727105E+023 0.49128769E+010 0.48827279E+013 0.52560535E+024 0.30366184E+019 0.32096774E+035 0.24387505E+031 0.16356829E+025 0.30098199E+000 0.61173815E-015 0.47183264E-011 0.94921497E+018 0.12692207E+021 0.43841039E+018 0.17352261E+021 0.87667557E+020 0.57692844E+020 0.32455908E+020 0.24393433E+020 0.17156404E+020 0.80620182E+019 0.34413668E+019 0.84120046E+019 0.35130483E+019 0.15100751E+019 0.74941382E+018 0.79662902E+019 0.52871345E+019 0.53587458E+019 0.21628140E+019 0.23537590E+018 0.33489497E+019 0.32349968E+019 0.17710153E+019 0.20992269E+019 0.18603654E+019 0.59829907E+020 0.58398894E+019 0.43738344E+019 0.28148036E+017 0.36887516E+018 0.65617481E+017 0.14687184E+018 0.24855469E+017 0.57253478E+017 0.44537620E+018 0.20477123E+011 0.51171513E+012 0.46150513E+011 0.31859020E+017 0.57994300E+009 0.77788757E+016 0.13882515E+006 0.20310679E+010 0.22862971E+018 0.26370027E+011 0.88496535E+012 0.28793707E+006 0.95995609E+007 0.23997889E+013 0.57464934E+010 0.62330849E+018 0.94978740E+016 0.47977072E+013 0.23209080E+001 0.10914259E-006 0.94694142E-005 -38 0.95000000E-008 0.64786588E-010 0.57501423E+017 0.13138239E+020 0.37463360E+017 0.17904789E+020 0.92156314E+019 0.61171172E+019 0.35120175E+019 0.26607864E+019 0.18990319E+019 0.90007758E+018 0.38663370E+018 0.84945959E+018 0.35921642E+018 0.16107536E+018 0.82615807E+017 0.90776458E+018 0.58731414E+017 0.41234694E+018 0.27390194E+017 0.14622597E+017 0.37242103E+018 0.33890661E+018 0.20460759E+018 0.24694607E+018 0.20562942E+018 0.65236093E+019 0.14423441E+018 0.48702980E+018 0.15008742E+015 0.16964292E+017 0.59603314E+016 0.12456181E+017 0.22111929E+016 0.47064900E+016 0.41058223E+017 0.14790414E+010 0.41046745E+011 0.34740948E+010 0.24144920E+016 0.43350054E+008 0.65422377E+015 0.10521404E+005 0.15308575E+009 0.29832441E+016 0.28569701E+010 0.82517555E+011 0.22122870E+005 0.69716180E+006 0.24895941E+012 0.60353860E+009 0.60742557E+017 0.43813896E+015 0.41813149E+012 0.17375580E+000 0.80484382E-008 0.69393300E-006 0.31242386E+035 0.15275373E+040 0.14657267E+035 0.28456750E+040 0.74733752E+039 0.32807008E+039 0.10676012E+039 0.60938502E+038 0.30740898E+038 0.68606818E+037 0.12600361E+037 0.63195671E+037 0.11187181E+037 0.21940152E+036 0.56935776E+035 0.67950866E+037 0.20930899E+036 0.14705719E+037 0.37225615E+035 0.20137441E+034 0.11581742E+037 0.98818580E+036 0.34555771E+036 0.48632804E+036 0.33709557E+036 0.35589183E+039 0.49063543E+036 0.19737531E+037 0.29879115E+031 0.36424921E+034 0.34134549E+033 0.13272182E+034 0.48929069E+032 0.25042144E+033 0.16041928E+035 0.26543167E+020 0.18976760E+023 0.13697160E+021 0.55914014E+032 0.20345774E+017 0.45072497E+031 0.14103131E+010 0.30223747E+018 0.42615098E+033 0.67591435E+020 0.63937671E+023 0.60285342E+010 0.49234678E+013 0.53847629E+024 0.31043115E+019 0.33319725E+035 0.24117054E+031 0.17843824E+025 0.40281056E+000 0.96535902E-015 0.68215231E-011 0.94203248E+018 0.12723413E+021 0.45410652E+018 0.17377272E+021 0.87731056E+020 0.57706773E+020 0.32461588E+020 0.24395835E+020 0.17158514E+020 0.80624255E+019 0.34414346E+019 0.86309388E+019 0.35631778E+019 0.15192165E+019 0.75106864E+018 0.79637668E+019 0.52817454E+019 0.53667049E+019 0.21613015E+019 0.23548351E+018 0.33560340E+019 0.32543322E+019 0.17687951E+019 0.20993359E+019 0.18619890E+019 0.60113325E+020 0.58719424E+019 0.43766696E+019 0.29080355E+017 0.36956378E+018 0.69615565E+017 0.14676413E+018 0.25975496E+017 0.60171444E+017 0.46025680E+018 0.21867441E+011 0.55084705E+012 0.49235616E+011 0.33056512E+017 0.59041422E+009 0.83178937E+016 0.15592814E+006 0.23247975E+010 0.22698756E+018 0.26370552E+011 0.90212830E+012 0.31833363E+006 0.97206833E+007 0.24009435E+013 0.57474469E+010 0.62954006E+018 0.94695907E+016 0.49866475E+013 0.26808653E+001 0.13701556E-006 0.11377311E-004 -39 0.97500000E-008 0.64786685E-010 0.58182183E+017 0.13448628E+020 0.39202829E+017 0.18314473E+020 0.94198938E+019 0.62513621E+019 0.35873044E+019 0.27173062E+019 0.19386933E+019 0.91867122E+018 0.39455761E+018 0.87944390E+018 0.36929718E+018 0.16486167E+018 0.84384268E+017 0.92308368E+018 0.58725941E+017 0.41290348E+018 0.27377191E+017 0.14571945E+017 0.38045143E+018 0.34733326E+018 0.20849777E+018 0.25148779E+018 0.20828550E+018 0.66745476E+019 0.14337532E+018 0.49684985E+018 0.15146355E+015 0.16758433E+017 0.63606627E+016 0.12493391E+017 0.23358929E+016 0.50120366E+016 0.42932111E+017 0.15898448E+010 0.44480473E+011 0.37100977E+010 0.25170642E+016 0.44659717E+008 0.70436641E+015 0.11854114E+005 0.17546369E+009 0.29781570E+016 0.29071308E+010 0.85363729E+011 0.24558191E+005 0.70547760E+006 0.25444486E+012 0.61611090E+009 0.62431568E+017 0.43267966E+015 0.43956955E+012 0.20087865E+000 0.10061621E-007 0.83224502E-006 0.31388847E+035 0.15684621E+040 0.15747836E+035 0.29170648E+040 0.76509017E+039 0.33573894E+039 0.10917300E+039 0.62298600E+038 0.31410829E+038 0.70079503E+037 0.12867859E+037 0.66622105E+037 0.11606596E+037 0.22548345E+036 0.58268862E+035 0.68929066E+037 0.20932744E+036 0.14574104E+037 0.37223314E+035 0.19908577E+034 0.11855555E+037 0.10180208E+037 0.35200018E+036 0.49514168E+036 0.33963284E+036 0.36552677E+039 0.49019297E+036 0.20149399E+037 0.30501109E+031 0.36105021E+034 0.38625758E+033 0.13156546E+034 0.53765875E+032 0.27848922E+033 0.17261196E+035 0.30261746E+020 0.22005565E+023 0.15384892E+021 0.59770901E+032 0.21129951E+017 0.51667196E+031 0.17712695E+010 0.39330371E+018 0.42504439E+033 0.68669452E+020 0.67178927E+023 0.73457961E+010 0.49651204E+013 0.55130967E+024 0.31718707E+019 0.34517991E+035 0.23892169E+031 0.19397221E+025 0.53347082E+000 0.14985758E-014 0.97373987E-011 0.94959801E+018 0.12746327E+021 0.46570458E+018 0.17394932E+021 0.87778471E+020 0.57716247E+020 0.32466291E+020 0.24397797E+020 0.17160465E+020 0.80627965E+019 0.34414951E+019 0.88140274E+019 0.35931254E+019 0.15244187E+019 0.75209961E+018 0.79678004E+019 0.52342125E+019 0.53711668E+019 0.21429518E+019 0.23519771E+018 0.33630465E+019 0.32727132E+019 0.17665771E+019 0.20994413E+019 0.18612514E+019 0.60385771E+020 0.58939936E+019 0.43792884E+019 0.29581968E+017 0.36994836E+018 0.74546956E+017 0.14675029E+018 0.27099862E+017 0.63000589E+017 0.47500296E+018 0.23284600E+011 0.59184146E+012 0.52411279E+011 0.34245929E+017 0.59810932E+009 0.88920240E+016 0.17440558E+006 0.26476828E+010 0.22301195E+018 0.26372069E+011 0.91875605E+012 0.35073235E+006 0.98428930E+007 0.24018018E+013 0.57481521E+010 0.63518374E+018 0.94711188E+016 0.51740706E+013 0.30806137E+001 0.17060831E-006 0.13583668E-004 -40 0.10000000E-007 0.64786786E-010 0.58798158E+017 0.13756468E+020 0.40765981E+017 0.18721959E+020 0.96240107E+019 0.63855561E+019 0.36625743E+019 0.27738138E+019 0.19783460E+019 0.93726050E+018 0.40247953E+018 0.90692489E+018 0.37856072E+018 0.16849325E+018 0.86124567E+017 0.93832976E+018 0.58725401E+017 0.41344313E+018 0.27371162E+017 0.14524115E+017 0.38846207E+018 0.35575127E+018 0.21238194E+018 0.25603758E+018 0.21092552E+018 0.68254768E+019 0.14267091E+018 0.50666328E+018 0.15268669E+015 0.16572723E+017 0.68255905E+016 0.12529022E+017 0.24633647E+016 0.53193060E+016 0.44829983E+017 0.17043415E+010 0.48109769E+011 0.39513109E+010 0.26210013E+016 0.45842710E+008 0.75794667E+015 0.13303018E+005 0.20018369E+009 0.29765598E+016 0.29575004E+010 0.88214913E+011 0.27172262E+005 0.71384661E+006 0.25992361E+012 0.62867290E+009 0.64099963E+017 0.42774424E+015 0.46130715E+012 0.23111129E+000 0.12483776E-007 0.99233923E-006 0.31478823E+035 0.16087481E+040 0.16687880E+035 0.29877019E+040 0.78281907E+039 0.34340257E+039 0.11158502E+039 0.63658261E+038 0.32080567E+038 0.71551767E+037 0.13135280E+037 0.69635348E+037 0.11968336E+037 0.23109852E+036 0.59560057E+035 0.69897886E+037 0.20935440E+036 0.14451299E+037 0.37238079E+035 0.19701907E+034 0.12128121E+037 0.10478363E+037 0.35842404E+036 0.50397472E+036 0.34214294E+036 0.37516826E+039 0.48986106E+036 0.20560695E+037 0.31015658E+031 0.35843915E+034 0.44342339E+033 0.13046974E+034 0.58888892E+032 0.30765079E+033 0.18525833E+035 0.34314905E+020 0.25430240E+023 0.17188041E+021 0.63765247E+032 0.21770555E+017 0.59211391E+031 0.22074288E+010 0.50716777E+018 0.42510008E+033 0.69751498E+020 0.70453950E+023 0.88940702E+010 0.50077302E+013 0.56411505E+024 0.32393213E+019 0.35693123E+035 0.23707437E+031 0.21017104E+025 0.69976756E+000 0.22917293E-014 0.13741289E-010 0.95409165E+018 0.12764050E+021 0.47337526E+018 0.17409743E+021 0.87814310E+020 0.57722854E+020 0.32470244E+020 0.24399419E+020 0.17162275E+020 0.80631351E+019 0.34415491E+019 0.89340801E+019 0.36123795E+019 0.15285499E+019 0.75355301E+018 0.79657109E+019 0.51518840E+019 0.53691442E+019 0.21118306E+019 0.23491566E+018 0.33695908E+019 0.32902820E+019 0.17643611E+019 0.20995431E+019 0.18627236E+019 0.60649715E+020 0.58939558E+019 0.43817077E+019 0.28892365E+017 0.36951486E+018 0.80614013E+017 0.14683837E+018 0.28228467E+017 0.65742041E+017 0.48961589E+018 0.24724069E+011 0.63497475E+012 0.55645767E+011 0.35427301E+017 0.60607603E+009 0.95109591E+016 0.19433057E+006 0.30019460E+010 0.22589075E+018 0.26374311E+011 0.93491328E+012 0.38523272E+006 0.10031107E+008 0.24024398E+013 0.57486738E+010 0.64030568E+018 0.94784559E+016 0.53599844E+013 0.35232404E+001 0.21086579E-006 0.16126636E-004 +5 0.12500000E-008 0.64789679E-010 0.11786946E+016 0.25731983E+017 0.15945592E+014 0.34457649E+017 0.18386742E+017 0.12479443E+017 0.83262152E+016 0.68264228E+016 0.55867656E+016 0.29404135E+016 0.13647921E+016 0.30401579E+016 0.13581014E+016 0.73885091E+015 0.42065860E+015 0.48897813E+016 0.75024127E+016 0.60819048E+016 0.35434694E+016 0.34025508E+015 0.17066244E+016 0.80288034E+015 0.11317131E+016 0.33248064E+016 0.32826483E+016 0.26603326E+017 0.70468602E+016 0.19410377E+016 0.78442203E+014 0.58388508E+015 0.96167924E+013 0.89205971E+014 0.66044350E+012 0.16791546E+009 0.41891174E+014 0.35245935E+004 0.59515027E+005 0.25735861E+004 0.12878942E+013 0.64040117E+003 0.12746163E+012 0.66746966E-005 0.34510366E+001 0.51980732E+015 0.10648993E+007 0.43516201E+008 0.51827973E-004 0.14558766E+003 0.11203294E+008 0.57875165E+005 0.82835446E+014 0.12674932E+014 0.24614460E+007 0.28342103E-010 0.66974961E-024 0.14318970E-018 0.22930003E+032 0.10747658E+035 0.41276347E+028 0.19272324E+035 0.54875596E+034 0.25279081E+034 0.11252829E+034 0.75639575E+033 0.50661466E+033 0.14033553E+033 0.30232856E+032 0.14999908E+033 0.29933649E+032 0.88593695E+031 0.28717629E+031 0.38744285E+033 0.92152144E+033 0.60041161E+033 0.20508890E+033 0.18801055E+031 0.47266840E+032 0.10430153E+032 0.20786392E+032 0.17933906E+033 0.17484901E+033 0.11463428E+035 0.80823281E+033 0.61076596E+032 0.10147173E+030 0.54963186E+031 0.14963980E+028 0.12924775E+030 0.70689964E+025 0.45799554E+018 0.28422041E+029 0.21640127E+009 0.60470064E+011 0.11353213E+009 0.26873073E+026 0.71624780E+007 0.26319024E+024 0.78284352E-009 0.20370971E+003 0.43918497E+031 0.19408671E+014 0.30576615E+017 0.47249195E-007 0.36895565E+006 0.21381624E+016 0.56969053E+011 0.11066320E+030 0.25917106E+028 0.10338181E+015 0.14107558E-019 0.81351622E-047 0.36677737E-036 0.20046272E+017 0.43786118E+018 0.27136737E+015 0.58633284E+018 0.31287466E+018 0.21235477E+018 0.14168046E+018 0.11615868E+018 0.95063311E+017 0.50032790E+017 0.23222454E+017 0.51723387E+017 0.23105851E+017 0.12570148E+017 0.71567062E+016 0.83191497E+017 0.12759682E+018 0.10345575E+018 0.60262397E+017 0.57873107E+016 0.29035782E+017 0.13660871E+017 0.19254293E+017 0.56545773E+017 0.55828473E+017 0.45261443E+018 0.11986814E+018 0.33025861E+017 0.13348603E+016 0.99316124E+016 0.16362789E+015 0.15177303E+016 0.11239763E+014 0.28656758E+010 0.71275808E+015 0.64027106E+005 0.10604780E+007 0.46015666E+005 0.21916877E+014 0.11661978E+005 0.21691629E+013 0.12184019E-003 0.61468311E+002 0.88392979E+016 0.18982308E+008 0.74188544E+009 0.94859420E-003 0.26414847E+004 0.19943966E+009 0.10287150E+007 0.14095415E+016 0.21562082E+015 0.43814017E+008 0.51675560E-009 0.12550468E-022 0.26527311E-017 +6 0.15000000E-008 0.64789373E-010 0.21148652E+016 0.47779561E+017 0.29674316E+014 0.63969246E+017 0.34144239E+017 0.23175554E+017 0.15459694E+017 0.12672932E+017 0.10368979E+017 0.54559741E+016 0.25318919E+016 0.56279553E+016 0.25140156E+016 0.13673487E+016 0.77848402E+015 0.91655492E+016 0.13499650E+017 0.11202049E+017 0.63861043E+016 0.62412217E+015 0.31607080E+016 0.15252047E+016 0.20948445E+016 0.61143967E+016 0.60311198E+016 0.49957154E+017 0.12847254E+017 0.37089365E+016 0.13833731E+015 0.10539166E+016 0.18219220E+014 0.16462395E+015 0.13471957E+013 0.34913267E+009 0.82749497E+014 0.13164634E+005 0.22174575E+006 0.99939249E+004 0.25821679E+013 0.24189445E+004 0.26117331E+012 0.49770106E-004 0.15235970E+002 0.92353298E+015 0.36155373E+007 0.85957089E+008 0.36970274E-003 0.54614709E+003 0.38450026E+008 0.19335701E+006 0.15922073E+015 0.22962051E+014 0.89457914E+007 0.22429293E-009 0.20058038E-022 0.21304167E-017 0.73741220E+032 0.36919586E+035 0.14244168E+029 0.66176856E+035 0.18854371E+035 0.86863990E+034 0.38652058E+034 0.25972734E+034 0.17386974E+034 0.48137632E+033 0.10366243E+033 0.51207565E+033 0.10218021E+033 0.30225768E+032 0.97975601E+031 0.13550682E+034 0.29795828E+034 0.20291602E+034 0.66491709E+033 0.63026179E+031 0.16150277E+033 0.37441319E+032 0.70949823E+032 0.60399669E+033 0.58780046E+033 0.40232492E+035 0.26790906E+034 0.22183417E+033 0.31510414E+030 0.17843908E+032 0.53427967E+028 0.43865424E+030 0.29219770E+026 0.19730784E+019 0.11019305E+030 0.30272449E+010 0.83881611E+012 0.17126493E+010 0.10733422E+027 0.10252762E+009 0.10975441E+025 0.43639157E-007 0.39700889E+004 0.13848715E+032 0.22360935E+015 0.11862576E+018 0.24103135E-005 0.52076794E+007 0.25166730E+017 0.63505912E+012 0.40586821E+030 0.84731166E+028 0.13640696E+016 0.88603394E-018 0.73465732E-044 0.81589399E-034 0.35962611E+017 0.81272029E+018 0.50487688E+015 0.10880807E+019 0.58079273E+018 0.39421784E+018 0.26296511E+018 0.21555930E+018 0.17636560E+018 0.92797861E+017 0.43062726E+017 0.95698684E+017 0.42748536E+017 0.23249849E+017 0.13237022E+017 0.15585323E+018 0.22938128E+018 0.19041448E+018 0.10850011E+018 0.10606805E+017 0.53746391E+017 0.25939737E+017 0.35621147E+017 0.10389480E+018 0.10247850E+018 0.84949680E+018 0.21836996E+018 0.63077216E+017 0.23597468E+016 0.17912270E+017 0.30985837E+015 0.27994114E+016 0.22922635E+014 0.59728236E+010 0.14073354E+016 0.24094461E+006 0.39686461E+007 0.17971685E+006 0.43931283E+014 0.44409039E+005 0.44437355E+013 0.91543607E-003 0.27295962E+003 0.15687178E+017 0.64626594E+008 0.14674088E+010 0.68178118E-002 0.99868876E+004 0.68642635E+009 0.34427419E+007 0.27083850E+016 0.39035689E+015 0.15981723E+009 0.41223811E-008 0.38016017E-021 0.39851890E-016 +7 0.17500000E-008 0.64788844E-010 0.37349413E+016 0.87183698E+017 0.54360056E+014 0.11668567E+018 0.62314296E+017 0.42299924E+017 0.28207621E+017 0.23116413E+017 0.18905505E+017 0.99432299E+016 0.46126429E+016 0.10214520E+017 0.45624911E+016 0.24803438E+016 0.14121402E+016 0.16750832E+017 0.23903646E+017 0.20187219E+017 0.11302356E+017 0.11194400E+016 0.57395902E+016 0.28185183E+016 0.38019045E+016 0.10966741E+017 0.10808910E+017 0.91455283E+017 0.22993365E+017 0.68650569E+016 0.23676505E+015 0.18735169E+016 0.33614466E+014 0.29829414E+015 0.26213814E+013 0.72811277E+009 0.15683125E+015 0.45953970E+005 0.77274080E+006 0.35907656E+005 0.49599595E+013 0.84827078E+004 0.51031667E+012 0.33254076E-003 0.60027869E+002 0.16199098E+016 0.11659401E+008 0.16781331E+009 0.23927293E-002 0.18915325E+004 0.12706455E+009 0.62550464E+006 0.29617071E+015 0.40998238E+014 0.30540430E+008 0.15607076E-008 0.49296700E-021 0.27215634E-016 0.22962694E+033 0.12252945E+036 0.47656632E+029 0.21947664E+036 0.62597078E+035 0.28844452E+035 0.12826250E+035 0.86137801E+034 0.57611312E+034 0.15935430E+034 0.34291887E+033 0.16808989E+034 0.33535589E+033 0.99106633E+032 0.32124330E+032 0.45073374E+034 0.93252768E+034 0.65660668E+034 0.20782781E+034 0.20203522E+032 0.53069333E+033 0.12724915E+033 0.23287767E+033 0.19349725E+034 0.18802793E+034 0.13425212E+036 0.85588793E+034 0.75641266E+033 0.92074264E+030 0.56212252E+032 0.18100208E+029 0.14357015E+031 0.10993211E+027 0.85752843E+019 0.39338545E+030 0.36940591E+011 0.10174270E+014 0.22106059E+011 0.39363738E+027 0.12631331E+010 0.41628176E+025 0.19514157E-005 0.61598869E+005 0.42530703E+032 0.23217333E+016 0.45051433E+018 0.10110756E-003 0.62555622E+008 0.27453095E+018 0.66349592E+013 0.13953723E+031 0.26925900E+029 0.15874287E+017 0.42987153E-016 0.44618930E-041 0.13364179E-031 0.63585895E+017 0.14818622E+019 0.92438231E+015 0.19832292E+019 0.10591787E+019 0.71899473E+018 0.47944166E+018 0.39289406E+018 0.32130758E+018 0.16898070E+018 0.78386605E+017 0.17350738E+018 0.77499359E+017 0.42129302E+017 0.23985549E+017 0.28454218E+018 0.40543946E+018 0.34267404E+018 0.19166921E+018 0.18994767E+017 0.97498825E+017 0.47895078E+017 0.64580678E+017 0.18602398E+018 0.18334196E+018 0.15535793E+019 0.39026531E+018 0.11664961E+018 0.40740230E+016 0.31793124E+017 0.57119430E+015 0.50673140E+016 0.44584950E+014 0.12510330E+011 0.26650389E+016 0.84601149E+006 0.13876601E+008 0.64879430E+006 0.84343747E+014 0.15672894E+006 0.86791170E+013 0.61555797E-002 0.10812852E+004 0.27457228E+017 0.20863331E+009 0.28707210E+010 0.44391127E-001 0.34796746E+005 0.22720828E+010 0.11142490E+008 0.50344588E+016 0.69605556E+015 0.54695264E+009 0.28887356E-007 0.94378939E-020 0.51339852E-015 +8 0.20000000E-008 0.64787964E-010 0.64162926E+016 0.15629291E+018 0.98105271E+014 0.20905943E+018 0.11174390E+018 0.75865251E+017 0.50561881E+017 0.41415948E+017 0.33846009E+017 0.17787215E+017 0.82465322E+016 0.18142898E+017 0.81027581E+016 0.44014124E+016 0.25058217E+016 0.29877602E+017 0.41226143E+017 0.35460030E+017 0.19449653E+017 0.19530525E+016 0.10202207E+017 0.50823556E+016 0.67528986E+016 0.19075374E+017 0.18785988E+017 0.16338253E+018 0.40169859E+017 0.12371927E+017 0.38423766E+015 0.32538025E+016 0.60527775E+014 0.52961533E+015 0.49326189E+013 0.15872006E+010 0.28755402E+015 0.15127102E+006 0.25477043E+007 0.12165246E+006 0.92353067E+013 0.27871550E+005 0.96340459E+012 0.20420437E-002 0.21818526E+003 0.27604411E+016 0.35338764E+008 0.32856794E+009 0.14286411E-001 0.60747835E+004 0.40219636E+009 0.19363880E+007 0.53721749E+015 0.71701159E+014 0.98848852E+008 0.98675067E-008 0.10455117E-019 0.30944204E-015 0.67593131E+033 0.39250174E+036 0.15477338E+030 0.70221859E+036 0.20064416E+036 0.92485298E+035 0.41077479E+035 0.27559251E+035 0.18403811E+035 0.50823913E+034 0.10923551E+034 0.52831660E+034 0.10537552E+034 0.31089658E+033 0.10076999E+033 0.14279435E+035 0.27661228E+035 0.20176949E+035 0.61350831E+034 0.61237587E+032 0.16705149E+034 0.41182850E+033 0.73195801E+033 0.58254766E+034 0.56522238E+034 0.42659042E+036 0.26036723E+035 0.24453845E+034 0.24151704E+031 0.16891314E+033 0.58410992E+029 0.45105980E+031 0.38692934E+027 0.40898141E+020 0.13145345E+031 0.40030178E+012 0.11038088E+015 0.25351635E+012 0.13570005E+028 0.13639424E+011 0.14743664E+026 0.73617467E-004 0.81303754E+006 0.12309517E+033 0.21260803E+017 0.17246249E+019 0.36047014E-002 0.64490518E+009 0.27447846E+019 0.63413199E+014 0.45650433E+031 0.82065968E+029 0.16592013E+018 0.17198151E-014 0.20142665E-038 0.17313040E-029 0.10974629E+018 0.26527173E+019 0.16664941E+016 0.35480536E+019 0.18966706E+019 0.12877137E+019 0.85816153E+018 0.70289004E+018 0.57436303E+018 0.30181779E+018 0.13991878E+018 0.30757939E+018 0.13736503E+018 0.74609022E+017 0.42476475E+017 0.50654898E+018 0.69784690E+018 0.60038887E+018 0.32868443E+018 0.33042907E+017 0.17297339E+018 0.86227962E+017 0.11448360E+018 0.32252934E+018 0.31761939E+018 0.27701976E+019 0.67997472E+018 0.20987275E+018 0.67630925E+016 0.55057296E+017 0.10268458E+016 0.89798723E+016 0.83829853E+014 0.27472906E+011 0.48788760E+016 0.27961170E+007 0.45839678E+008 0.22055842E+007 0.15689910E+015 0.51722173E+006 0.16371812E+014 0.37976963E-001 0.39481822E+004 0.46600597E+017 0.63162325E+009 0.56356317E+010 0.26613299E+000 0.11217126E+006 0.71922405E+010 0.34454374E+008 0.91199856E+016 0.12143035E+016 0.17719424E+010 0.18364717E-006 0.20180761E-018 0.58758955E-014 +9 0.22500000E-008 0.64786607E-010 0.10522341E+017 0.27361320E+018 0.17362080E+015 0.36564171E+018 0.19572101E+018 0.13291261E+018 0.88500101E+017 0.72434471E+017 0.59121813E+017 0.31030741E+017 0.14372412E+017 0.31279609E+017 0.13966597E+017 0.75763783E+016 0.43132696E+016 0.51670323E+017 0.68059921E+017 0.60043625E+017 0.31967783E+017 0.32712292E+016 0.17609515E+017 0.89068546E+016 0.11642948E+017 0.31721761E+017 0.31208786E+017 0.28304260E+018 0.67630248E+017 0.21631189E+017 0.56852463E+015 0.54389941E+016 0.10584956E+015 0.91383003E+015 0.90218173E+013 0.38087182E+010 0.50972608E+015 0.46637921E+006 0.79123952E+007 0.38952317E+006 0.16725041E+014 0.85163469E+005 0.17660452E+013 0.11535418E-001 0.74242004E+003 0.44659151E+016 0.97820015E+008 0.64604507E+009 0.78140319E-001 0.17799235E+005 0.11984925E+010 0.56023696E+007 0.94911809E+015 0.12123622E+015 0.30103088E+009 0.57071032E-007 0.19299704E-018 0.31414206E-014 0.18094463E+034 0.11981656E+037 0.48310811E+030 0.21394489E+037 0.61311946E+036 0.28275903E+036 0.12534889E+036 0.83961458E+035 0.55926362E+035 0.15404041E+035 0.33041179E+034 0.15628596E+035 0.31157757E+034 0.91671281E+033 0.29711292E+033 0.42490609E+035 0.75037636E+035 0.57530325E+035 0.16488081E+035 0.17077373E+033 0.49532432E+034 0.12582507E+034 0.21654760E+034 0.15999570E+035 0.15492912E+035 0.12735880E+037 0.73442879E+035 0.74369259E+034 0.52514306E+031 0.46932227E+033 0.17767759E+030 0.13369895E+032 0.12869569E+028 0.23780768E+021 0.41040641E+031 0.37989548E+013 0.10613189E+016 0.25941837E+013 0.44258302E+028 0.12713684E+012 0.49242524E+026 0.23466539E-002 0.93979572E+007 0.32028238E+033 0.16197229E+018 0.66669756E+019 0.10765597E+000 0.55204142E+010 0.24280971E+020 0.52833075E+015 0.14169902E+032 0.23344868E+030 0.15332607E+019 0.57494275E-013 0.68741507E-036 0.17846960E-027 0.18218992E+018 0.46318104E+019 0.29432900E+016 0.61889238E+019 0.33134441E+019 0.22502088E+019 0.14981225E+019 0.12260371E+019 0.10005414E+019 0.52505630E+018 0.24315711E+018 0.52843471E+018 0.23594329E+018 0.12796755E+018 0.72852264E+017 0.87303138E+018 0.11536654E+019 0.10119959E+019 0.53867376E+018 0.55055963E+017 0.29753624E+018 0.15068871E+018 0.19669673E+018 0.53327160E+018 0.52459208E+018 0.47829688E+019 0.11393145E+019 0.36585174E+018 0.10549450E+017 0.91556950E+017 0.17904503E+016 0.15441794E+017 0.15310651E+015 0.66688532E+011 0.86245493E+016 0.86376086E+007 0.14237822E+009 0.70744173E+007 0.28366253E+015 0.15837642E+007 0.29967929E+014 0.21509321E+000 0.13478155E+005 0.74905983E+017 0.17408941E+010 0.11107637E+011 0.14582296E+001 0.32898622E+006 0.21387238E+011 0.99329918E+008 0.16074444E+017 0.20440238E+016 0.53905431E+010 0.10658971E-005 0.37469134E-017 0.59909289E-013 +10 0.25000000E-008 0.64784807E-010 0.16033833E+017 0.46231296E+018 0.29815309E+015 0.61692234E+018 0.33095057E+018 0.22483175E+018 0.14949472E+018 0.12221021E+018 0.99561846E+017 0.52154195E+017 0.24119893E+017 0.51618314E+017 0.23039895E+017 0.12471637E+017 0.70998250E+016 0.85531805E+017 0.10487668E+018 0.96289005E+017 0.48886637E+017 0.51538489E+016 0.29110706E+017 0.15019510E+017 0.19215004E+017 0.49320034E+017 0.48447866E+017 0.46959022E+018 0.10760409E+018 0.36303309E+017 0.71948449E+015 0.85605698E+016 0.17774281E+015 0.15111433E+016 0.16014291E+014 0.10677344E+011 0.86664463E+015 0.13190546E+007 0.22742359E+008 0.11659262E+007 0.29368703E+014 0.23682405E+006 0.31391251E+013 0.58833574E-001 0.23663816E+004 0.66313154E+016 0.23577975E+009 0.12525227E+010 0.38121864E+000 0.45822324E+005 0.32627183E+010 0.14604325E+008 0.16202340E+016 0.19426043E+015 0.84426361E+009 0.29777670E-006 0.30254471E-017 0.27816307E-013 0.41684603E+034 0.34010518E+037 0.14177040E+031 0.60550299E+037 0.17430597E+037 0.80449635E+036 0.35561228E+036 0.23761208E+036 0.15766203E+036 0.43251689E+035 0.92488071E+034 0.42260661E+035 0.84191562E+034 0.24661896E+034 0.79923031E+033 0.11560449E+036 0.17676196E+036 0.14670230E+036 0.38221908E+035 0.41996806E+033 0.13442010E+035 0.35536869E+034 0.58566020E+034 0.38264326E+035 0.36939481E+035 0.34803205E+037 0.18446038E+036 0.20806038E+035 0.83307446E+031 0.11520222E+034 0.49742925E+030 0.36318314E+032 0.40306071E+028 0.18991762E+022 0.11772624E+032 0.30281467E+014 0.87247536E+016 0.23163933E+014 0.13564605E+029 0.97941419E+012 0.15458727E+027 0.60860898E-001 0.95216903E+008 0.69882535E+033 0.93195925E+018 0.25036921E+020 0.25522239E+001 0.36356601E+011 0.17882158E+021 0.35628215E+016 0.41028815E+032 0.59455789E+030 0.11992719E+020 0.15613083E-011 0.16878752E-033 0.13965591E-025 0.28590349E+018 0.77904758E+019 0.50356505E+016 0.10393693E+020 0.55774710E+019 0.37892679E+019 0.25190524E+019 0.20589465E+019 0.16769280E+019 0.87819293E+018 0.40605337E+018 0.86687876E+018 0.38691254E+018 0.20937288E+018 0.11919048E+018 0.14367951E+019 0.17953853E+019 0.16103589E+019 0.82720144E+018 0.85967031E+017 0.48900676E+018 0.25289168E+018 0.32270186E+018 0.82087732E+018 0.80618978E+018 0.78903332E+019 0.17978587E+019 0.61087636E+018 0.15374829E+017 0.14281445E+018 0.29913364E+016 0.25388038E+017 0.27109216E+015 0.18983371E+012 0.14594852E+017 0.24422611E+008 0.40832721E+009 0.21169463E+008 0.49665649E+015 0.44025428E+007 0.53132894E+014 0.10973161E+001 0.43024085E+005 0.11150826E+018 0.41584446E+010 0.21540407E+011 0.71076366E+001 0.84467741E+006 0.57928960E+011 0.25711256E+009 0.27329329E+017 0.32496691E+016 0.15064013E+011 0.55679449E-005 0.58923593E-016 0.53142148E-012 +11 0.27500000E-008 0.64782958E-010 0.22234696E+017 0.74245472E+018 0.49070930E+015 0.98891103E+018 0.53209334E+018 0.36166164E+018 0.23995944E+018 0.19580798E+018 0.15906308E+018 0.83078582E+017 0.38333864E+017 0.80101948E+017 0.35735283E+017 0.19282284E+017 0.10974931E+017 0.13333935E+018 0.14661182E+018 0.14341343E+018 0.67658933E+017 0.74837668E+016 0.45289944E+017 0.24033693E+017 0.29812367E+017 0.70327652E+017 0.68922661E+017 0.73432971E+018 0.15820576E+018 0.57603621E+017 0.78052592E+015 0.12421060E+017 0.28225520E+015 0.23521168E+016 0.27397686E+014 0.36099265E+011 0.13960947E+016 0.33262893E+007 0.58962888E+008 0.31952998E+007 0.49606796E+014 0.58141298E+006 0.53753500E+013 0.26221076E+000 0.69927905E+004 0.87454073E+016 0.47271194E+009 0.23096739E+010 0.15970190E+001 0.99522816E+005 0.78085445E+010 0.32871213E+008 0.26391604E+016 0.28831498E+015 0.21181984E+010 0.13615588E-005 0.38352588E-016 0.20591237E-012 0.79304965E+034 0.86966009E+037 0.38127113E+031 0.15424019E+038 0.44674380E+037 0.20640581E+037 0.90835205E+036 0.60467452E+036 0.39885396E+036 0.10875819E+036 0.23147312E+035 0.10069872E+036 0.20040013E+035 0.58318850E+034 0.18892332E+034 0.27805970E+036 0.34125152E+036 0.32132883E+036 0.72235032E+035 0.87322418E+033 0.32197733E+035 0.90134016E+034 0.13949549E+035 0.76585952E+035 0.73588659E+035 0.84221748E+037 0.39392344E+036 0.51883738E+035 0.97580823E+031 0.23916537E+034 0.12417091E+031 0.87107810E+032 0.11714416E+029 0.22110028E+023 0.30245688E+032 0.19143011E+015 0.58216696E+017 0.17306120E+015 0.38418543E+029 0.58649219E+013 0.44993729E+027 0.12026720E+001 0.82800551E+009 0.11957215E+034 0.36899638E+019 0.84762959E+020 0.44500565E+002 0.16978472E+012 0.10141581E+022 0.17835229E+017 0.10794935E+033 0.12932089E+031 0.74865285E+020 0.32489804E-010 0.27033233E-031 0.76193878E-024 0.41112199E+018 0.12420083E+020 0.82401789E+016 0.16538066E+020 0.89026589E+019 0.60515821E+019 0.40138135E+019 0.32743493E+019 0.26586823E+019 0.13879800E+019 0.64020408E+018 0.13326122E+019 0.59445841E+018 0.32059422E+018 0.18246749E+018 0.22196041E+019 0.25765221E+019 0.23697035E+019 0.11666543E+019 0.12311890E+018 0.75377361E+018 0.40162936E+018 0.49595742E+018 0.11531231E+019 0.11296366E+019 0.12229154E+020 0.26165194E+019 0.96142521E+018 0.18693698E+017 0.20437871E+018 0.47122432E+016 0.39152842E+017 0.46186505E+015 0.65172794E+012 0.23337739E+017 0.61424729E+008 0.10534336E+010 0.57865268E+008 0.83496746E+015 0.10774867E+008 0.90607137E+014 0.48787866E+001 0.12705122E+006 0.15009121E+018 0.82201259E+010 0.39571359E+011 0.29658921E+002 0.18236225E+007 0.13737805E+012 0.57189524E+009 0.44226771E+017 0.47631343E+016 0.37543558E+011 0.25419066E-004 0.74708529E-015 0.39294334E-011 +12 0.30000000E-008 0.64781436E-010 0.28166096E+017 0.11247208E+019 0.77063819E+015 0.14950526E+019 0.80737610E+018 0.54909208E+018 0.36314944E+018 0.29553758E+018 0.23905430E+018 0.12432432E+018 0.57170983E+017 0.11581326E+018 0.51631119E+017 0.27735281E+017 0.15777362E+017 0.19373602E+018 0.18370906E+018 0.19674819E+018 0.83774740E+017 0.99548378E+016 0.65708565E+017 0.36149933E+017 0.43058119E+017 0.91948088E+017 0.89818405E+017 0.10717106E+019 0.21271108E+018 0.85414309E+017 0.69684248E+015 0.16545448E+017 0.41960001E+015 0.34135795E+016 0.44776870E+014 0.14103469E+012 0.21162030E+016 0.73880007E+007 0.13568186E+009 0.78606083E+007 0.79868083E+014 0.12414751E+007 0.87965975E+013 0.99166790E+000 0.18897650E+005 0.10309247E+017 0.79630067E+009 0.39496925E+010 0.56105556E+001 0.18361238E+006 0.16144846E+011 0.63127700E+008 0.40631901E+016 0.39346433E+015 0.46748686E+010 0.53135858E-005 0.37492868E-015 0.12285813E-011 0.12565775E+035 0.19731284E+038 0.93175160E+031 0.34850745E+038 0.10170336E+038 0.47045780E+037 0.20567142E+037 0.13615619E+037 0.89022732E+036 0.24060854E+036 0.50851856E+035 0.20752504E+036 0.41240483E+035 0.11891258E+035 0.38476877E+034 0.57883478E+036 0.52750833E+036 0.59453395E+036 0.10882578E+036 0.15165756E+034 0.66828539E+035 0.20137616E+035 0.28684949E+035 0.12825485E+036 0.12243127E+036 0.17688804E+038 0.70047950E+036 0.11259431E+036 0.80211553E+031 0.41655843E+034 0.27070579E+031 0.18098508E+033 0.31017239E+029 0.34221370E+024 0.68619267E+032 0.93683621E+015 0.30524099E+018 0.10395424E+016 0.98669693E+029 0.26499619E+014 0.11941016E+028 0.17078204E+002 0.60120872E+010 0.16283450E+034 0.10267527E+020 0.24570545E+021 0.54448482E+003 0.57034603E+012 0.42770840E+022 0.64731530E+017 0.25309614E+033 0.23674809E+031 0.36058539E+021 0.49153147E-009 0.25693709E-029 0.26952272E-022 0.53130523E+018 0.18630777E+020 0.12843795E+017 0.24755878E+020 0.13377862E+020 0.90991913E+019 0.60145172E+019 0.48924270E+019 0.39544184E+019 0.20550011E+019 0.94442962E+018 0.19020231E+019 0.84783526E+018 0.45505411E+018 0.25883567E+018 0.31842645E+019 0.33611381E+019 0.31973789E+019 0.15046295E+019 0.16069512E+018 0.10798487E+019 0.59781955E+018 0.70703626E+018 0.14778013E+019 0.14425565E+019 0.17628285E+020 0.35042368E+019 0.14091503E+019 0.21453480E+017 0.26721324E+018 0.69267973E+016 0.56106979E+017 0.75016888E+015 0.25734086E+013 0.35022792E+017 0.13582615E+009 0.24064214E+010 0.14165929E+009 0.13351177E+016 0.22883426E+008 0.14737572E+015 0.18364810E+002 0.34235873E+006 0.18542934E+018 0.13591545E+011 0.67132333E+011 0.10354176E+003 0.33344179E+007 0.28048235E+012 0.10812232E+010 0.67474681E+017 0.63902431E+016 0.82082682E+011 0.98814295E-004 0.72869455E-014 0.23365871E-010 +13 0.32500000E-008 0.64780640E-010 0.32721685E+017 0.16018184E+019 0.11488063E+016 0.21252437E+019 0.11521765E+019 0.78416345E+018 0.51639754E+018 0.41880477E+018 0.33688536E+018 0.17424395E+018 0.79777837E+017 0.15593179E+018 0.69454212E+017 0.37099068E+017 0.21083562E+017 0.26181281E+018 0.20593945E+018 0.24891226E+018 0.92640229E+017 0.12155910E+017 0.88822783E+017 0.50981077E+017 0.57838330E+017 0.11066407E+018 0.10763163E+018 0.14573625E+019 0.26141798E+018 0.11782918E+018 0.54413622E+015 0.20248726E+017 0.58169887E+015 0.46141370E+016 0.69483319E+014 0.57003836E+012 0.30132545E+016 0.14419962E+008 0.27578284E+009 0.17231649E+008 0.12192539E+015 0.22989100E+007 0.13679119E+014 0.31458540E+001 0.46285449E+005 0.10756515E+017 0.11208676E+010 0.61561638E+010 0.16396655E+002 0.28145543E+006 0.28715240E+011 0.10371548E+009 0.58895883E+016 0.49276872E+015 0.90375785E+010 0.17507926E-004 0.27659871E-014 0.58247415E-011 0.16729397E+035 0.39460833E+038 0.20474641E+032 0.69431761E+038 0.20424464E+038 0.94621874E+037 0.41000879E+037 0.26949919E+037 0.17419350E+037 0.46549511E+036 0.97497320E+035 0.36960340E+036 0.73313385E+035 0.20893064E+035 0.67467579E+034 0.10386635E+037 0.65173376E+036 0.93156585E+036 0.13047095E+036 0.22096849E+034 0.11999708E+036 0.39432712E+035 0.50839177E+035 0.18116750E+036 0.17142935E+036 0.32141664E+038 0.10365599E+037 0.21072794E+036 0.55876155E+031 0.60966765E+034 0.51142093E+031 0.32510809E+033 0.73891172E+029 0.56237681E+025 0.13701456E+033 0.35329052E+016 0.12455341E+019 0.49479360E+016 0.22734124E+030 0.89806073E+014 0.28559966E+028 0.17030811E+003 0.35798050E+011 0.17333937E+034 0.19821985E+020 0.58885415E+021 0.46007585E+004 0.13161025E+013 0.13294546E+023 0.17120070E+018 0.52463024E+033 0.36332911E+031 0.13286543E+022 0.52919041E-008 0.13887526E-027 0.60106298E-021 0.64611551E+018 0.26206033E+020 0.18968318E+017 0.34754307E+020 0.18857760E+020 0.12836496E+020 0.84457577E+019 0.68446661E+019 0.54994008E+019 0.28410778E+019 0.12995772E+019 0.25194036E+019 0.11219450E+019 0.59850292E+018 0.34006208E+018 0.42338232E+019 0.39783225E+019 0.39601373E+019 0.17276840E+019 0.19228343E+018 0.14364377E+019 0.83196805E+018 0.93405767E+018 0.17347642E+019 0.16852058E+019 0.23597687E+020 0.43366147E+019 0.19146629E+019 0.24732710E+017 0.31930938E+018 0.94645306E+016 0.74625841E+017 0.11544418E+016 0.10438441E+014 0.49247092E+017 0.26349436E+009 0.48449280E+010 0.30843139E+009 0.20198832E+016 0.42051159E+008 0.22732426E+015 0.57876831E+002 0.83449894E+006 0.20346461E+018 0.18660946E+011 0.10335869E+012 0.30007080E+003 0.50462983E+007 0.49061781E+012 0.17409963E+010 0.96676927E+017 0.78259829E+016 0.15678154E+012 0.32372556E-003 0.53542357E-013 0.11021429E-009 +14 0.35000000E-008 0.64780514E-010 0.35742436E+017 0.21541909E+019 0.16311688E+016 0.28540869E+019 0.15530100E+019 0.10579354E+019 0.69289687E+018 0.55960271E+018 0.44707673E+018 0.22970906E+018 0.10462212E+018 0.19698356E+018 0.87640717E+017 0.46500956E+017 0.26387600E+017 0.33105961E+018 0.20926398E+018 0.29384926E+018 0.92892245E+017 0.13839302E+017 0.11264288E+018 0.67680827E+017 0.72753891E+017 0.12514941E+018 0.12107111E+018 0.18580032E+019 0.29678654E+018 0.15184940E+018 0.38093462E+015 0.23103718E+017 0.75594189E+015 0.58464028E+016 0.10221010E+015 0.21154109E+013 0.40525245E+016 0.25071749E+008 0.49978565E+009 0.33749609E+008 0.17635934E+015 0.37401949E+007 0.20183904E+014 0.84164427E+001 0.10259040E+006 0.10252380E+017 0.13847829E+010 0.88197633E+010 0.40369947E+002 0.37273380E+006 0.44585183E+011 0.14923319E+009 0.80567233E+016 0.57326947E+015 0.15486105E+011 0.48945028E-004 0.15482128E-013 0.22117803E-010 0.19690659E+035 0.70208182E+038 0.40753141E+032 0.12318009E+039 0.36509470E+038 0.16946032E+038 0.72603857E+037 0.47311059E+037 0.30149870E+037 0.79469888E+036 0.16464798E+036 0.57777169E+036 0.11433772E+036 0.32134391E+035 0.10344697E+035 0.16266625E+037 0.66372870E+036 0.12665858E+037 0.12890597E+036 0.27889067E+034 0.18907851E+036 0.68247795E+035 0.78765756E+035 0.22523115E+036 0.21083178E+036 0.51180647E+038 0.13048140E+037 0.34308151E+036 0.39010631E+031 0.77295677E+034 0.84641887E+031 0.51164335E+033 0.15787122E+030 0.77315570E+026 0.24356345E+033 0.10556760E+017 0.40325519E+019 0.18765499E+017 0.46931143E+030 0.23444040E+015 0.61383233E+028 0.12060862E+004 0.17430332E+012 0.15474017E+034 0.29365172E+020 0.11884173E+022 0.27547871E+005 0.22593372E+013 0.31383800E+023 0.34610558E+018 0.96638037E+033 0.47937273E+031 0.38372758E+022 0.40958559E-007 0.43168218E-026 0.85890372E-020 0.74301223E+018 0.34739927E+020 0.26648751E+017 0.46006721E+020 0.25059357E+020 0.17074705E+020 0.11168161E+020 0.90102381E+019 0.71860126E+019 0.36858885E+019 0.16764626E+019 0.31225079E+019 0.13888070E+019 0.73545862E+018 0.41718425E+018 0.52507880E+019 0.44467713E+019 0.45642484E+019 0.19057716E+019 0.21582839E+018 0.17876641E+019 0.10873577E+019 0.11520606E+019 0.19065754E+019 0.18408810E+019 0.29530479E+020 0.49152665E+019 0.24225510E+019 0.26152147E+017 0.35639968E+018 0.12090308E+017 0.92775263E+017 0.16808325E+016 0.38631757E+014 0.65280184E+017 0.45493637E+009 0.86837955E+010 0.59908474E+009 0.28898298E+016 0.67792110E+008 0.33211344E+015 0.15359993E+003 0.18378289E+007 0.21566561E+018 0.22396101E+011 0.14586673E+012 0.73150082E+003 0.65805699E+007 0.74654868E+012 0.24519703E+010 0.13044694E+018 0.88954544E+016 0.26489363E+012 0.89854624E-003 0.29808917E-012 0.41584696E-009 +15 0.37500000E-008 0.64780828E-010 0.37585472E+017 0.27573926E+019 0.22206887E+016 0.36507003E+019 0.19926383E+019 0.13586319E+019 0.88406141E+018 0.71058249E+018 0.56314897E+018 0.28716693E+018 0.13001600E+018 0.23619640E+018 0.10494816E+018 0.55270252E+017 0.31297912E+017 0.39589844E+018 0.19660864E+018 0.32880628E+018 0.86385054E+017 0.14965498E+017 0.13547633E+018 0.85264947E+017 0.86658945E+017 0.13578436E+018 0.13055655E+018 0.22444915E+019 0.31607608E+018 0.18459784E+018 0.26813502E+015 0.24999185E+017 0.93119220E+015 0.70156495E+016 0.14294112E+015 0.67287706E+013 0.51947976E+016 0.39631122E+008 0.82153096E+009 0.59749638E+008 0.24255537E+015 0.54553471E+007 0.28343019E+014 0.19353589E+002 0.20709549E+006 0.91985624E+016 0.15687130E+010 0.11795752E+011 0.85743756E+002 0.44259485E+006 0.61957843E+011 0.19396360E+009 0.10471935E+017 0.62949222E+015 0.23985069E+011 0.11818534E-003 0.67591510E-013 0.69008385E-010 0.21486875E+035 0.11295728E+039 0.74496415E+032 0.19791049E+039 0.59031507E+038 0.27450426E+038 0.11602679E+038 0.74858878E+037 0.46913983E+037 0.12172871E+037 0.24910231E+036 0.81184222E+036 0.16021637E+036 0.44334394E+035 0.14209231E+035 0.22726337E+037 0.58483847E+036 0.15432137E+037 0.11074001E+036 0.31683937E+034 0.26732203E+036 0.10614761E+036 0.10914351E+036 0.25728022E+036 0.23785674E+036 0.72993687E+038 0.14426896E+037 0.49570053E+036 0.33061762E+031 0.87930262E+034 0.12558484E+032 0.72045292E+033 0.30435632E+030 0.77665072E+027 0.39277728E+033 0.26049184E+017 0.10727876E+020 0.58070509E+017 0.87440718E+030 0.49103927E+015 0.11929441E+029 0.63025807E+004 0.70317458E+012 0.12423995E+034 0.36495998E+020 0.20860511E+022 0.12261948E+006 0.31121585E+013 0.59189703E+023 0.56959694E+018 0.16042197E+034 0.56199724E+031 0.90397338E+022 0.23629028E-006 0.81583953E-025 0.82803661E-019 0.81223250E+018 0.43766232E+020 0.35874900E+017 0.57923811E+020 0.31651717E+020 0.21587102E+020 0.14019548E+020 0.11251919E+020 0.88952551E+019 0.45250699E+019 0.20448062E+019 0.36650443E+019 0.16277157E+019 0.85488804E+018 0.48376692E+018 0.61418777E+019 0.47051892E+019 0.50041485E+019 0.19948407E+019 0.22769497E+018 0.21049180E+019 0.13459349E+019 0.13419610E+019 0.20063872E+019 0.19293669E+019 0.34932333E+020 0.53248768E+019 0.28835581E+019 0.26419745E+017 0.37973044E+018 0.14612676E+017 0.10894828E+018 0.23230036E+016 0.12208136E+015 0.82376010E+017 0.71368500E+009 0.14104853E+011 0.10506080E+010 0.39249530E+016 0.97850933E+008 0.46110632E+015 0.35007832E+003 0.36825188E+007 0.21887248E+018 0.24596401E+011 0.19187537E+012 0.15370759E+004 0.76855331E+007 0.10139458E+013 0.31316396E+010 0.16697443E+018 0.95937921E+016 0.40405076E+012 0.21525062E-002 0.12936724E-011 0.12885011E-008 +16 0.40000000E-008 0.64781336E-010 0.38733805E+017 0.33893427E+019 0.29183569E+016 0.44878427E+019 0.24552265E+019 0.16753468E+019 0.10821124E+019 0.86519253E+018 0.67952216E+018 0.34367218E+018 0.15460402E+018 0.27215172E+018 0.12074633E+018 0.63085097E+017 0.35625669E+017 0.45304694E+018 0.17461990E+018 0.35400878E+018 0.76330933E+017 0.15630217E+017 0.15632690E+018 0.10289420E+018 0.98931506E+017 0.14368826E+018 0.13723853E+018 0.25989588E+019 0.32083050E+018 0.21418772E+018 0.20730216E+015 0.26051385E+017 0.11021950E+016 0.80613937E+016 0.19112490E+015 0.18031280E+014 0.64090433E+016 0.58158112E+008 0.12483935E+010 0.97065985E+008 0.31902510E+015 0.73008004E+007 0.38102991E+014 0.39184338E+002 0.38503715E+006 0.79899495E+016 0.16893371E+010 0.14965877E+011 0.16137937E+003 0.48841056E+006 0.79146230E+011 0.23447375E+009 0.13041933E+017 0.66286244E+015 0.34286820E+011 0.25220322E-003 0.23887237E-012 0.18266126E-009 0.22516434E+035 0.16736421E+039 0.12681172E+033 0.29332649E+039 0.87902660E+038 0.40941940E+038 0.17040207E+038 0.10873887E+038 0.66875914E+037 0.17057558E+037 0.34442310E+036 0.10516483E+037 0.20690411E+036 0.56307301E+035 0.17943036E+035 0.29018114E+037 0.47274910E+036 0.17378829E+037 0.87991679E+035 0.33536511E+034 0.34727156E+036 0.15124338E+036 0.13865884E+036 0.27938113E+036 0.25481790E+036 0.95479677E+038 0.14487912E+037 0.65111993E+036 0.31786706E+031 0.92661037E+034 0.17182411E+032 0.92838188E+033 0.53564887E+030 0.55179570E+028 0.58624049E+033 0.55371247E+017 0.24374442E+020 0.15117120E+018 0.14878877E+031 0.86469431E+015 0.21222766E+029 0.25514845E+005 0.24045254E+013 0.96055523E+033 0.40956127E+020 0.32918587E+022 0.42831443E+006 0.36989112E+013 0.94156619E+023 0.80979609E+018 0.24418079E+034 0.60493211E+031 0.18123242E+023 0.10641261E-005 0.10100383E-023 0.57435008E-018 0.85888868E+018 0.52894046E+020 0.46609322E+017 0.70023296E+020 0.38352583E+020 0.26178840E+020 0.16863552E+020 0.13456207E+020 0.10532330E+020 0.53094638E+019 0.23823029E+019 0.41278255E+019 0.18302042E+019 0.95265545E+018 0.53738451E+018 0.68602876E+019 0.49264090E+019 0.52499143E+019 0.20524753E+019 0.23387161E+018 0.23738279E+019 0.15935115E+019 0.14952072E+019 0.20580942E+019 0.19686089E+019 0.39540197E+020 0.55782437E+019 0.32690529E+019 0.26120262E+017 0.38747409E+018 0.16959489E+017 0.12264326E+018 0.30659146E+016 0.32410726E+015 0.99973334E+017 0.10392780E+010 0.21172483E+011 0.16894313E+010 0.50916707E+016 0.12949917E+009 0.61233892E+015 0.70212119E+003 0.67920286E+007 0.22526821E+018 0.25668820E+011 0.23925036E+012 0.28605272E+004 0.83401883E+007 0.12636423E+013 0.37258298E+010 0.20455141E+018 0.99269896E+016 0.56840073E+012 0.45548251E-002 0.45429321E-011 0.33859708E-008 +17 0.42500000E-008 0.64781889E-010 0.39564376E+017 0.40322517E+019 0.37251317E+016 0.53439559E+019 0.29277694E+019 0.19989414E+019 0.12805567E+019 0.10181069E+019 0.79185672E+018 0.39705306E+018 0.17743365E+018 0.30448457E+018 0.13487790E+018 0.69884970E+017 0.39334895E+017 0.50142795E+018 0.14956444E+018 0.37113506E+018 0.65504184E+017 0.15965831E+017 0.17477951E+018 0.11996644E+018 0.10937323E+018 0.14993497E+018 0.14221114E+018 0.29143522E+019 0.31454956E+018 0.23987596E+018 0.17699556E+015 0.26460027E+017 0.12691541E+016 0.89519854E+016 0.24593627E+015 0.41191291E+014 0.76751500E+016 0.80637503E+008 0.17837897E+010 0.14685496E+009 0.40382125E+015 0.91474862E+007 0.49388496E+014 0.71520378E+002 0.66777838E+006 0.68711834E+016 0.17724379E+010 0.18248505E+011 0.27584939E+003 0.51586798E+006 0.95090411E+011 0.26967702E+009 0.15689679E+017 0.67809486E+015 0.46069991E+011 0.48640842E-003 0.70929000E-012 0.42302043E-009 0.23161117E+035 0.23206293E+039 0.20358500E+033 0.40753135E+039 0.12247611E+039 0.57112400E+038 0.23364879E+038 0.14735305E+038 0.88791522E+037 0.22243221E+037 0.44292424E+036 0.12830339E+037 0.25158999E+036 0.67285382E+035 0.21291719E+035 0.34609553E+037 0.37181989E+036 0.18540609E+037 0.68665697E+035 0.33946101E+034 0.42296601E+036 0.20092142E+036 0.16496605E+036 0.29502248E+036 0.26530397E+036 0.11698074E+039 0.13601188E+037 0.79563686E+036 0.30889777E+031 0.92731665E+034 0.22241388E+032 0.11155837E+034 0.87225122E+030 0.28429130E+029 0.82405661E+033 0.10504295E+018 0.48951690E+020 0.34109282E+018 0.23423775E+031 0.13332061E+016 0.35070557E+029 0.83914307E+005 0.71516477E+013 0.75553998E+033 0.43631728E+020 0.47952618E+022 0.12336581E+007 0.40264079E+013 0.13233923E+024 0.10414376E+019 0.34647788E+034 0.61414212E+031 0.32083805E+023 0.39136015E-005 0.88266889E-023 0.30493618E-017 0.88590868E+018 0.61821572E+020 0.58819736E+017 0.81938628E+020 0.44939557E+020 0.30693021E+020 0.19590764E+020 0.15534737E+020 0.12027089E+020 0.60048951E+019 0.26743204E+019 0.45094097E+019 0.19957611E+019 0.10289955E+019 0.57817545E+018 0.73980317E+019 0.50857539E+019 0.53537874E+019 0.21074191E+019 0.23621688E+018 0.25900351E+019 0.18205360E+019 0.16104949E+019 0.20819820E+019 0.19766820E+019 0.43282282E+020 0.56925335E+019 0.35713945E+019 0.28166307E+017 0.38531741E+018 0.19152172E+017 0.13313016E+018 0.38909779E+016 0.73224084E+015 0.11773703E+018 0.14298451E+010 0.29881893E+011 0.25285226E+010 0.63505807E+016 0.16034395E+009 0.78364308E+015 0.12692927E+004 0.11684581E+008 0.22698956E+018 0.26108719E+011 0.28660752E+012 0.48344613E+004 0.86615479E+007 0.14895036E+013 0.42367643E+010 0.24186691E+018 0.99086738E+016 0.75137801E+012 0.87104750E-002 0.13405079E-010 0.77860870E-008 +18 0.45000000E-008 0.64782407E-010 0.40302346E+017 0.46720512E+019 0.46411521E+016 0.62020188E+019 0.33995489E+019 0.23217220E+019 0.14740328E+019 0.11651239E+019 0.89695224E+018 0.44584723E+018 0.19791687E+018 0.33348197E+018 0.14747624E+018 0.75766289E+017 0.42481716E+017 0.54148667E+018 0.12577876E+018 0.38224955E+018 0.55656217E+017 0.16090735E+017 0.19081249E+018 0.13611596E+018 0.11806282E+018 0.15528340E+018 0.14624492E+018 0.31912371E+019 0.30108229E+018 0.26175548E+018 0.16135059E+015 0.26419980E+017 0.14354471E+016 0.96773322E+016 0.30648945E+015 0.82008300E+014 0.89815681E+016 0.10705804E+009 0.24293753E+010 0.20958910E+009 0.49486841E+015 0.10908486E+008 0.62145589E+014 0.12010426E+003 0.10933378E+007 0.59389236E+016 0.18370881E+010 0.21587691E+011 0.43698848E+003 0.53254932E+006 0.10935576E+012 0.29985882E+009 0.18358542E+017 0.68034963E+015 0.59028421E+011 0.86435962E-003 0.18282399E-011 0.87990126E-009 0.23650964E+035 0.30496982E+039 0.31133423E+033 0.53746403E+039 0.16166915E+039 0.75432113E+038 0.30282070E+038 0.18865701E+038 0.11125560E+038 0.27365587E+037 0.53736751E+036 0.14991271E+037 0.29293051E+036 0.76954741E+035 0.24154611E+035 0.39257973E+037 0.29961920E+036 0.19086133E+037 0.55248332E+035 0.33463674E+034 0.49074074E+036 0.25255402E+036 0.18692448E+036 0.30706321E+036 0.27218645E+036 0.13655640E+039 0.12227716E+037 0.92211531E+036 0.30185767E+031 0.89731392E+034 0.27787637E+032 0.12687653E+034 0.13312901E+031 0.11108622E+030 0.11058910E+034 0.18268355E+018 0.89309956E+020 0.68450617E+018 0.34533924E+031 0.18603449E+016 0.54592030E+029 0.23357478E+006 0.18953496E+014 0.62282886E+033 0.45400452E+020 0.65730907E+022 0.30516554E+007 0.41893634E+013 0.17029656E+024 0.12514347E+019 0.46479400E+034 0.59989805E+031 0.51631719E+023 0.12218936E-004 0.58126296E-022 0.13061241E-016 0.91070060E+018 0.70326239E+020 0.72460145E+017 0.93399379E+020 0.51240048E+020 0.35005035E+020 0.22116823E+020 0.17423217E+020 0.13332937E+020 0.65914483E+019 0.29134193E+019 0.48198304E+019 0.21289759E+019 0.10868531E+019 0.60786307E+018 0.77736296E+019 0.51483812E+019 0.54031661E+019 0.21257020E+019 0.23633647E+018 0.27562907E+019 0.20221548E+019 0.16913907E+019 0.20919467E+019 0.19694315E+019 0.46221822E+020 0.57627400E+019 0.37971214E+019 0.28961513E+017 0.38329191E+018 0.21265518E+017 0.14019426E+018 0.47794473E+016 0.14401706E+016 0.13548567E+018 0.18837432E+010 0.40203028E+011 0.35683173E+010 0.76620232E+016 0.18888560E+009 0.97347354E+015 0.21107855E+004 0.18978643E+008 0.22566305E+018 0.26266684E+011 0.33305877E+012 0.75722091E+004 0.87984286E+007 0.16903315E+013 0.46258970E+010 0.27801692E+018 0.98547688E+016 0.94698339E+012 0.15348166E-001 0.34334811E-010 0.16082219E-007 +19 0.47500000E-008 0.64782866E-010 0.41056001E+017 0.52974792E+019 0.56637000E+016 0.70480930E+019 0.38614358E+019 0.26370411E+019 0.16582358E+019 0.13030983E+019 0.99270162E+018 0.48926743E+018 0.21580631E+018 0.35979649E+018 0.15883720E+018 0.80910416E+017 0.45172278E+017 0.57450385E+018 0.10566142E+018 0.38926937E+018 0.47602645E+017 0.16094044E+017 0.20466535E+018 0.15118238E+018 0.12525007E+018 0.16019102E+018 0.14980354E+018 0.34346158E+019 0.28384834E+018 0.28036742E+018 0.15672058E+015 0.26087208E+017 0.16048140E+016 0.10245080E+017 0.37197498E+015 0.14568474E+015 0.10322116E+017 0.13742959E+009 0.31864238E+010 0.28517782E+009 0.59019691E+015 0.12549129E+008 0.76361255E+014 0.18866621E+003 0.17071010E+007 0.52000415E+016 0.18932305E+010 0.24943495E+011 0.65182450E+003 0.54380270E+006 0.12191975E+012 0.32582524E+009 0.21009911E+017 0.67391206E+015 0.72908913E+011 0.14375115E-002 0.42016529E-011 0.16787592E-008 0.24104944E+035 0.38355023E+039 0.45670098E+033 0.67923375E+039 0.20407289E+039 0.95203565E+038 0.37453016E+038 0.23048364E+038 0.13294931E+038 0.32122415E+037 0.62234645E+036 0.16993885E+037 0.33084536E+036 0.85367838E+035 0.26553753E+035 0.42960817E+037 0.25549698E+036 0.19213758E+037 0.47066520E+035 0.32522804E+034 0.54927487E+036 0.30401805E+036 0.20446590E+036 0.31732406E+036 0.27726692E+036 0.15393098E+039 0.10745809E+037 0.10291307E+037 0.30678346E+031 0.85018311E+034 0.33950355E+032 0.13826374E+034 0.19262132E+031 0.34523218E+030 0.14314527E+034 0.29699733E+018 0.15114212E+021 0.12480945E+019 0.48189806E+031 0.24141474E+016 0.81023512E+029 0.56886457E+006 0.45680883E+014 0.54029578E+033 0.46757306E+020 0.85943112E+022 0.66928727E+007 0.42690880E+013 0.20588005E+024 0.14360643E+019 0.59616714E+034 0.57172935E+031 0.77205874E+023 0.33417005E-004 0.30432850E-021 0.47074131E-016 0.92893591E+018 0.78230574E+020 0.87426692E+017 0.10418261E+021 0.57107216E+020 0.39007472E+020 0.24375377E+020 0.19075181E+020 0.14421650E+020 0.70604093E+019 0.30977536E+019 0.50735607E+019 0.22364111E+019 0.11301840E+019 0.62877618E+018 0.80172327E+019 0.51278412E+019 0.54030624E+019 0.21125387E+019 0.23623996E+018 0.28789863E+019 0.21969846E+019 0.17437729E+019 0.20957027E+019 0.19556092E+019 0.48485586E+020 0.58319571E+019 0.39598333E+019 0.28921242E+017 0.37910140E+018 0.23367330E+017 0.14423881E+018 0.57153437E+016 0.25252272E+016 0.15313101E+018 0.23992443E+010 0.52104352E+011 0.47991033E+010 0.89921265E+016 0.21456015E+009 0.11810609E+016 0.32837170E+004 0.29406738E+008 0.22260688E+018 0.26319009E+011 0.37802142E+012 0.11169802E+005 0.88571279E+007 0.18526363E+013 0.49172736E+010 0.31243415E+018 0.97693609E+016 0.11506253E+013 0.25314699E-001 0.78431296E-010 0.30478702E-007 +20 0.50000000E-008 0.64783261E-010 0.41868108E+017 0.58998960E+019 0.67872944E+016 0.78711083E+019 0.43062419E+019 0.29394779E+019 0.18300734E+019 0.14299662E+019 0.10780873E+019 0.52714394E+018 0.23115147E+018 0.38420472E+018 0.16931197E+018 0.85521678E+017 0.47526968E+017 0.60204050E+018 0.90049328E+017 0.39369645E+018 0.41481119E+017 0.16034528E+017 0.21672114E+018 0.16515679E+018 0.13125852E+018 0.16490905E+018 0.15314132E+018 0.36512253E+019 0.26544224E+018 0.29640620E+018 0.15554455E+015 0.25575632E+017 0.17788120E+016 0.10675373E+017 0.44172558E+015 0.23581465E+015 0.11693741E+017 0.17177714E+009 0.40561134E+010 0.37313753E+009 0.68808060E+015 0.14076010E+008 0.92048332E+014 0.28088307E+003 0.25623069E+007 0.46376924E+016 0.19462786E+010 0.28289468E+011 0.92669623E+003 0.55276555E+006 0.13296585E+012 0.34846173E+009 0.23619095E+017 0.66202847E+015 0.87519609E+011 0.22650732E-002 0.87950594E-011 0.29862985E-008 0.24577874E+035 0.46511295E+039 0.64595633E+033 0.82854177E+039 0.24814776E+039 0.11564897E+039 0.44545637E+038 0.27085612E+038 0.15284425E+038 0.36316163E+037 0.69495861E+036 0.18872436E+037 0.36604024E+036 0.92781779E+035 0.28579254E+035 0.45855505E+037 0.23157434E+036 0.19089944E+037 0.42493671E+035 0.31401907E+034 0.59904048E+036 0.35389966E+036 0.21820692E+036 0.32680097E+036 0.28152115E+036 0.16926685E+039 0.93877359E+036 0.11187432E+037 0.31240418E+031 0.79561717E+034 0.40810636E+032 0.14588733E+034 0.26673623E+031 0.89003219E+030 0.18006355E+034 0.45774806E+018 0.24095009E+021 0.21037565E+019 0.64225075E+031 0.29770480E+016 0.11573856E+030 0.12445020E+007 0.10175554E+015 0.49230145E+033 0.47956788E+020 0.10825032E+023 0.13335796E+008 0.43138176E+013 0.23814182E+024 0.15966808E+019 0.73762701E+034 0.53682549E+031 0.10904061E+024 0.82046629E-004 0.13219877E-020 0.14751300E-015 0.93899978E+018 0.85420624E+020 0.10358410E+018 0.11413835E+021 0.62441991E+020 0.42623929E+020 0.26327334E+020 0.20467578E+020 0.15287264E+020 0.74152159E+019 0.32311791E+019 0.52871420E+019 0.23255401E+019 0.11632728E+019 0.64344290E+018 0.81634804E+019 0.51501229E+019 0.53928619E+019 0.21133603E+019 0.23580200E+018 0.29670422E+019 0.23463488E+019 0.17746988E+019 0.20970800E+019 0.19392487E+019 0.50220207E+020 0.58497649E+019 0.40743645E+019 0.27742810E+017 0.37573260E+018 0.25484936E+017 0.14633609E+018 0.66857566E+016 0.40319205E+016 0.17063803E+018 0.29754932E+010 0.65545915E+011 0.62042115E+010 0.10323545E+017 0.23762845E+009 0.14060987E+016 0.48419875E+004 0.43816009E+008 0.22712199E+018 0.26343459E+011 0.42113692E+012 0.15707939E+005 0.88885952E+007 0.19785579E+013 0.51337849E+010 0.34480985E+018 0.96809735E+016 0.13588559E+013 0.39567550E-001 0.16322297E-009 0.53871292E-007 +21 0.52500000E-008 0.64783622E-010 0.42732448E+017 0.64736873E+019 0.80036711E+016 0.86630438E+019 0.47288103E+019 0.32249214E+019 0.19875961E+019 0.15447137E+019 0.11531006E+019 0.55983739E+018 0.24424099E+018 0.40745897E+018 0.17924065E+018 0.89792618E+017 0.49659963E+017 0.62559654E+018 0.78769604E+017 0.39658387E+018 0.37054000E+017 0.15946045E+017 0.22742297E+018 0.17812948E+018 0.13642570E+018 0.16954121E+018 0.15636342E+018 0.38478633E+019 0.24759779E+018 0.31053793E+018 0.15404089E+015 0.24961993E+017 0.19588886E+016 0.10995779E+017 0.51523342E+015 0.35393641E+015 0.13094978E+017 0.21012749E+009 0.50397235E+010 0.47277578E+009 0.78710658E+015 0.15522427E+008 0.10923465E+015 0.40039756E+003 0.37199668E+007 0.42157633E+016 0.19981680E+010 0.31607950E+011 0.12673960E+004 0.56088846E+006 0.14274856E+012 0.36855667E+009 0.26171349E+017 0.64696453E+015 0.10272323E+012 0.34138984E-002 0.17051315E-010 0.50158508E-008 0.25069523E+035 0.54718064E+039 0.88444492E+033 0.98116992E+039 0.29240552E+039 0.13599802E+039 0.51271592E+038 0.30822624E+038 0.17031964E+038 0.39868441E+037 0.75482116E+036 0.20679128E+037 0.39957056E+036 0.99528349E+035 0.30345138E+035 0.48131377E+037 0.21976270E+036 0.18832571E+037 0.40055582E+035 0.30253389E+034 0.64162468E+036 0.40147548E+036 0.22909150E+036 0.33593766E+036 0.28538002E+036 0.18294161E+039 0.82570669E+036 0.11944190E+037 0.31118747E+031 0.73978709E+034 0.48469161E+032 0.15038461E+034 0.35629309E+031 0.19714860E+031 0.22134852E+034 0.67568008E+018 0.36603251E+021 0.33243312E+019 0.82372130E+031 0.35480096E+016 0.16026174E+030 0.24962280E+007 0.21209215E+015 0.46520654E+033 0.49099281E+020 0.13231793E+023 0.24593050E+008 0.43463898E+013 0.26693160E+024 0.17366761E+019 0.88643403E+034 0.49996568E+031 0.14723943E+024 0.18433510E-003 0.49268377E-020 0.41217495E-015 0.94244108E+018 0.91826118E+020 0.12074020E+018 0.12315727E+021 0.67174431E+020 0.45796878E+020 0.27950595E+020 0.21593119E+020 0.15939008E+020 0.76670688E+019 0.33209502E+019 0.54749784E+019 0.24028805E+019 0.11897937E+019 0.65405001E+018 0.82456039E+019 0.52374087E+019 0.53887616E+019 0.21468240E+019 0.23513819E+018 0.30294810E+019 0.24730604E+019 0.17908098E+019 0.20976277E+019 0.19220960E+019 0.51566254E+020 0.58417257E+019 0.41539586E+019 0.26909693E+017 0.37392617E+018 0.27640827E+017 0.14703010E+018 0.76809619E+016 0.59665242E+016 0.18799430E+018 0.36110483E+010 0.80502664E+011 0.77643496E+010 0.11654519E+017 0.25876376E+009 0.16485902E+016 0.68363330E+004 0.63168659E+008 0.22880081E+018 0.26353058E+011 0.46220601E+012 0.21254011E+005 0.89019795E+007 0.20749048E+013 0.52941714E+010 0.37500404E+018 0.96094481E+016 0.15693340E+013 0.59163631E-001 0.31461455E-009 0.89915516E-007 +22 0.55000000E-008 0.64783944E-010 0.43628756E+017 0.70163172E+019 0.93033619E+016 0.94193418E+019 0.51262682E+019 0.34910579E+019 0.21302309E+019 0.16474411E+019 0.12186542E+019 0.58811924E+018 0.25551530E+018 0.43017281E+018 0.18890170E+018 0.93877274E+017 0.51662942E+017 0.64642486E+018 0.71097192E+017 0.39859809E+018 0.33951603E+017 0.15846204E+017 0.23718958E+018 0.19023875E+018 0.14104509E+018 0.17412512E+018 0.15950831E+018 0.40303590E+019 0.23128240E+018 0.32331353E+018 0.15166452E+015 0.24296474E+017 0.21445952E+016 0.11234621E+017 0.59213747E+015 0.49966300E+015 0.14525008E+017 0.25249998E+009 0.61387148E+010 0.58335142E+009 0.88619297E+015 0.16929223E+008 0.12795313E+015 0.55087029E+003 0.52483479E+007 0.38984658E+016 0.20493377E+010 0.34887842E+011 0.16793187E+004 0.56871486E+006 0.15151933E+012 0.38673293E+009 0.28658588E+017 0.63020770E+015 0.11842588E+012 0.49584582E-002 0.31023460E-010 0.80328072E-008 0.25565060E+035 0.62779910E+039 0.11763812E+034 0.11335351E+040 0.33560936E+039 0.15561437E+039 0.57433116E+038 0.34169350E+038 0.18521674E+038 0.42811763E+037 0.80352796E+036 0.22466218E+037 0.43248842E+036 0.10591486E+036 0.31955619E+035 0.49971467E+037 0.21424604E+036 0.18515015E+037 0.38757118E+035 0.29149026E+034 0.67900937E+036 0.44654822E+036 0.23806878E+036 0.34490205E+036 0.28900572E+036 0.19537762E+039 0.73707800E+036 0.12596932E+037 0.30382850E+031 0.68626813E+034 0.56939329E+032 0.15256560E+034 0.46199134E+031 0.38611237E+031 0.26701322E+034 0.96240039E+018 0.53448506E+021 0.49809490E+019 0.10231185E+032 0.41365825E+016 0.21626616E+030 0.46644845E+007 0.41756558E+015 0.44899326E+033 0.50213730E+020 0.15783603E+023 0.42574989E+008 0.43755144E+013 0.29252570E+024 0.18598654E+019 0.10401883E+035 0.46400804E+031 0.19183588E+024 0.38465519E-003 0.16173009E-019 0.10471832E-014 0.93976671E+018 0.97433345E+020 0.13868880E+018 0.13119481E+021 0.71277394E+020 0.48503090E+020 0.29248539E+020 0.22464637E+020 0.16402077E+020 0.78339458E+019 0.33766890E+019 0.56482635E+019 0.24735195E+019 0.12125520E+019 0.66227940E+018 0.82790021E+019 0.52701781E+019 0.53699165E+019 0.21586480E+019 0.23569333E+018 0.30744569E+019 0.25805316E+019 0.17976871E+019 0.20979539E+019 0.19048097E+019 0.52637048E+020 0.58327008E+019 0.42092093E+019 0.28724014E+017 0.37129982E+018 0.29820568E+017 0.14699422E+018 0.86942998E+016 0.82998247E+016 0.20519647E+018 0.43042258E+010 0.96948371E+011 0.94604617E+010 0.12987054E+017 0.27874489E+009 0.19085352E+016 0.93174171E+004 0.88523145E+008 0.22796653E+018 0.26357082E+011 0.50114729E+012 0.27867705E+005 0.89108536E+007 0.21479857E+013 0.54128560E+010 0.40298560E+018 0.95613413E+016 0.17804844E+013 0.85268618E-001 0.56923062E-009 0.14313090E-006 +23 0.57500000E-008 0.64784232E-010 0.44545593E+017 0.75277405E+019 0.10677567E+017 0.10138343E+020 0.54976977E+019 0.37371405E+019 0.22585671E+019 0.17391233E+019 0.12762284E+019 0.61294559E+018 0.26545414E+018 0.45278386E+018 0.19849270E+018 0.97883535E+017 0.53600483E+017 0.66547147E+018 0.66148856E+017 0.40013558E+018 0.31827228E+017 0.15744452E+017 0.24636199E+018 0.20163213E+018 0.14533824E+018 0.17869257E+018 0.16260828E+018 0.42031954E+019 0.21690533E+018 0.33514973E+018 0.15121307E+015 0.23614623E+017 0.23354470E+016 0.11416262E+017 0.67219468E+015 0.67116554E+015 0.15983319E+017 0.29890373E+009 0.73545856E+010 0.70417762E+009 0.98457116E+015 0.18334810E+008 0.14822948E+015 0.73602526E+003 0.72220764E+007 0.36607250E+016 0.21000801E+010 0.38123146E+011 0.21675783E+004 0.57643558E+006 0.15949693E+012 0.40346825E+009 0.31077170E+017 0.61276740E+015 0.13456553E+012 0.69807948E-002 0.53523065E-010 0.12359890E-007 0.26052421E+035 0.70562242E+039 0.15250242E+034 0.12828797E+040 0.37684903E+039 0.17404022E+039 0.62931868E+038 0.37098969E+038 0.19773175E+038 0.45247116E+037 0.84363693E+036 0.24275713E+037 0.46562817E+036 0.11217390E+036 0.33488902E+035 0.51523440E+037 0.21172679E+036 0.18178453E+037 0.38070619E+035 0.28119620E+034 0.71301015E+036 0.48923283E+036 0.24590014E+036 0.35380044E+036 0.29250278E+036 0.20694273E+039 0.67015165E+036 0.13175329E+037 0.30136096E+031 0.63702706E+034 0.66224664E+032 0.15317805E+034 0.58448077E+031 0.68423325E+031 0.31707358E+034 0.13302560E+019 0.75517600E+021 0.71420123E+019 0.12371776E+032 0.47574720E+016 0.28553764E+030 0.82214629E+007 0.78220116E+015 0.43925181E+033 0.51309976E+020 0.18452994E+023 0.69951754E+008 0.44039598E+013 0.31537380E+024 0.19697248E+019 0.11968609E+035 0.43052786E+031 0.24283478E+024 0.75425618E-003 0.47742362E-019 0.24562653E-014 0.94280298E+018 0.10228409E+021 0.15725853E+018 0.13827410E+021 0.74767608E+020 0.50753685E+020 0.30248518E+020 0.23112552E+020 0.16712340E+020 0.79369529E+019 0.34083891E+019 0.58152217E+019 0.25411657E+019 0.12335570E+019 0.66932250E+018 0.82822170E+019 0.52529449E+019 0.53748313E+019 0.21514713E+019 0.23549731E+018 0.31085631E+019 0.26720968E+019 0.17995770E+019 0.20981330E+019 0.18876059E+019 0.53517698E+020 0.58742548E+019 0.42479235E+019 0.29383978E+017 0.37105000E+018 0.32015928E+017 0.14708416E+018 0.97213738E+016 0.10981561E+017 0.22224409E+018 0.50537950E+010 0.11485072E+012 0.11275063E+011 0.14312022E+017 0.29831189E+009 0.21857531E+016 0.12334431E+005 0.12101589E+009 0.22507035E+018 0.26359025E+011 0.53795572E+012 0.35603279E+005 0.89175772E+007 0.22031136E+013 0.55006547E+010 0.42879171E+018 0.95174575E+016 0.19913448E+013 0.11914220E+000 0.97676617E-009 0.21895242E-006 +24 0.60000000E-008 0.64784503E-010 0.45468701E+017 0.80097813E+019 0.12118502E+017 0.10820701E+020 0.58438355E+019 0.39636726E+019 0.23740261E+019 0.18212878E+019 0.13275784E+019 0.63529091E+018 0.27450190E+018 0.47557351E+018 0.20814205E+018 0.10187945E+018 0.55513643E+017 0.68339608E+018 0.63099142E+017 0.40141143E+018 0.30391852E+017 0.15644699E+017 0.25519006E+018 0.21244520E+018 0.14945611E+018 0.18325119E+018 0.16567133E+018 0.43695718E+019 0.20452020E+018 0.34634652E+018 0.15231181E+015 0.22938969E+017 0.25310311E+016 0.11559456E+017 0.75524849E+015 0.86574765E+015 0.17469544E+017 0.34933943E+009 0.86889954E+010 0.83466353E+009 0.10817575E+016 0.19768611E+008 0.17008499E+015 0.95967957E+003 0.97211612E+007 0.34817616E+016 0.21505928E+010 0.41311604E+011 0.27371118E+004 0.58416951E+006 0.16686219E+012 0.41912756E+009 0.33426454E+017 0.59531456E+015 0.15110262E+012 0.95704980E-002 0.88285031E-010 0.18382443E-007 0.26522704E+035 0.77990727E+039 0.19328141E+034 0.14273485E+040 0.41557661E+039 0.19100717E+039 0.67757579E+038 0.39634387E+038 0.20828556E+038 0.47304537E+037 0.87786709E+036 0.26137246E+037 0.49958008E+036 0.11845954E+036 0.34996341E+035 0.52893480E+037 0.21060450E+036 0.17844147E+037 0.37712363E+035 0.27173913E+034 0.74503650E+036 0.52978734E+036 0.25311591E+036 0.36266921E+036 0.29590753E+036 0.21791724E+039 0.62077141E+036 0.13701981E+037 0.30667630E+031 0.59295030E+034 0.76325079E+032 0.15280660E+034 0.72440173E+031 0.11176663E+032 0.37154600E+034 0.17922238E+019 0.10377660E+022 0.98730837E+019 0.14629155E+032 0.54254768E+016 0.36997198E+030 0.13801777E+008 0.14022316E+016 0.43280015E+033 0.52401123E+020 0.21216491E+023 0.11001625E+009 0.44328355E+013 0.33595846E+024 0.20692099E+019 0.13547863E+035 0.40031565E+031 0.30023535E+024 0.14027033E-002 0.12884263E-018 0.53835470E-014 0.94972377E+018 0.10644043E+021 0.17629427E+018 0.14444385E+021 0.77682472E+020 0.52575781E+020 0.30987869E+020 0.23572931E+020 0.16906893E+020 0.79956811E+019 0.34248006E+019 0.59804893E+019 0.26079444E+019 0.12539262E+019 0.67586936E+018 0.82676336E+019 0.51909382E+019 0.53724662E+019 0.21279042E+019 0.23519106E+018 0.31363783E+019 0.27507121E+019 0.17989056E+019 0.20982463E+019 0.18705425E+019 0.54269218E+020 0.58900733E+019 0.42755875E+019 0.29315936E+017 0.37071819E+018 0.34218084E+017 0.14682248E+018 0.10759350E+017 0.13946604E+017 0.23913802E+018 0.58578690E+010 0.13419240E+012 0.13195422E+011 0.15628144E+017 0.31796480E+009 0.24801152E+016 0.15936731E+005 0.16183312E+009 0.22330655E+018 0.26360238E+011 0.57268112E+012 0.44509500E+005 0.89240047E+007 0.22445489E+013 0.55656004E+010 0.45250274E+018 0.94976467E+016 0.22013408E+013 0.16213599E+000 0.16026750E-008 0.32377479E-006 +25 0.62500000E-008 0.64784737E-010 0.46394219E+017 0.84654458E+019 0.13620374E+017 0.11468599E+020 0.61664906E+019 0.41721550E+019 0.24785634E+019 0.18957334E+019 0.13744235E+019 0.65599707E+018 0.28300868E+018 0.49869415E+018 0.21791760E+018 0.10590081E+018 0.57424070E+017 0.70062339E+018 0.61279531E+017 0.40253281E+018 0.29429723E+017 0.15548679E+017 0.26383153E+018 0.22278995E+018 0.15348616E+018 0.18781300E+018 0.16870980E+018 0.45316036E+019 0.19398158E+018 0.35711128E+018 0.15331689E+015 0.22285042E+017 0.27310494E+016 0.11676907E+017 0.84120084E+015 0.10803387E+016 0.18983373E+017 0.40380265E+009 0.10143730E+011 0.97431498E+009 0.11775276E+016 0.21248530E+008 0.19353654E+015 0.12257573E+004 0.12830115E+008 0.33514467E+016 0.22012275E+010 0.44453448E+011 0.33927711E+004 0.59196587E+006 0.17375879E+012 0.43398255E+009 0.35707722E+017 0.57830345E+015 0.16801223E+012 0.12824707E-001 0.14014962E-009 0.26553810E-007 0.26975627E+035 0.85040565E+039 0.24018509E+034 0.15658679E+040 0.45154910E+039 0.20642553E+039 0.71967243E+038 0.41830788E+038 0.21737381E+038 0.49107433E+037 0.90848862E+036 0.28068668E+037 0.53468658E+036 0.12485698E+036 0.36505811E+035 0.54151174E+037 0.21006143E+036 0.17521448E+037 0.37527786E+035 0.26310453E+034 0.77600743E+036 0.56849568E+036 0.26002746E+036 0.37153630E+036 0.29924886E+036 0.22849404E+039 0.58474563E+036 0.14193134E+037 0.31224341E+031 0.55426158E+034 0.87241561E+032 0.15184728E+034 0.88240287E+031 0.17078939E+032 0.43044614E+034 0.23618346E+019 0.13927142E+022 0.13237009E+020 0.16979154E+032 0.61521387E+016 0.47156386E+030 0.22236832E+008 0.24171141E+016 0.42975972E+033 0.53491885E+020 0.24054519E+023 0.16675055E+009 0.44624258E+013 0.35472834E+024 0.21607232E+019 0.15126342E+035 0.37363859E+031 0.36404127E+024 0.24924878E-002 0.32209409E-018 0.11132322E-013 0.95276528E+018 0.10998192E+021 0.19567621E+018 0.14977612E+021 0.80076001E+020 0.54013158E+020 0.31511987E+020 0.23885190E+020 0.17020457E+020 0.80263551E+019 0.34324098E+019 0.61463548E+019 0.26748699E+019 0.12742040E+019 0.68225522E+018 0.82429626E+019 0.51839649E+019 0.53715354E+019 0.21218194E+019 0.23464086E+018 0.31606115E+019 0.28187606E+019 0.17971436E+019 0.20983343E+019 0.18632385E+019 0.54927279E+020 0.58832848E+019 0.42958646E+019 0.28136298E+017 0.37016450E+018 0.36420633E+017 0.14690655E+018 0.11806401E+017 0.17129865E+017 0.25587940E+018 0.67143115E+010 0.15495503E+012 0.15215866E+011 0.16934628E+017 0.33798793E+009 0.27913323E+016 0.20173250E+005 0.21222010E+009 0.22716387E+018 0.26361199E+011 0.60540792E+012 0.54630000E+005 0.89308045E+007 0.22756162E+013 0.56136407E+010 0.47423122E+018 0.95026723E+016 0.24101413E+013 0.21568356E+000 0.25309435E-008 0.46505957E-006 +26 0.65000000E-008 0.64784965E-010 0.47313343E+017 0.88981759E+019 0.15179650E+017 0.12085020E+020 0.64679667E+019 0.43646169E+019 0.25743212E+019 0.19642752E+019 0.14182616E+019 0.67571902E+018 0.29122208E+018 0.52222643E+018 0.22785360E+018 0.10996535E+018 0.59342610E+017 0.71741397E+018 0.60214829E+017 0.40355071E+018 0.28781346E+017 0.15456364E+017 0.27237915E+018 0.23275593E+018 0.15747570E+018 0.19237101E+018 0.17171695E+018 0.46906631E+019 0.18507253E+018 0.36758526E+018 0.15284704E+015 0.21661540E+017 0.29355238E+016 0.11776875E+017 0.92999114E+015 0.13118688E+016 0.20524553E+017 0.46228775E+009 0.11720702E+011 0.11227121E+010 0.12718891E+016 0.22786629E+008 0.21859932E+015 0.15382908E+004 0.16637252E+008 0.32560056E+016 0.22519097E+010 0.47550274E+011 0.41393985E+004 0.59981248E+006 0.18030018E+012 0.44824525E+009 0.37923568E+017 0.56202077E+015 0.18527860E+012 0.16848120E-001 0.21526194E-009 0.37400780E-007 0.27408733E+035 0.91719042E+039 0.29343584E+034 0.16979527E+040 0.48473564E+039 0.22033378E+039 0.75655822E+038 0.43757545E+038 0.22546295E+038 0.50755318E+037 0.93713184E+036 0.30080306E+037 0.57113263E+036 0.13140819E+036 0.38030714E+035 0.55339146E+037 0.20974443E+036 0.17213829E+037 0.37417052E+035 0.25522563E+034 0.80645568E+036 0.60561983E+036 0.26679665E+036 0.38039182E+036 0.30251815E+036 0.23879897E+039 0.55856436E+036 0.14660079E+037 0.31139993E+031 0.52077784E+034 0.98994091E+032 0.15054946E+034 0.10591450E+032 0.24705128E+032 0.49378857E+034 0.30531218E+019 0.18312947E+022 0.17293784E+020 0.19405198E+032 0.69476552E+016 0.59240936E+030 0.34592783E+008 0.40225710E+016 0.42861985E+033 0.54583743E+020 0.26951185E+023 0.24489748E+009 0.44927588E+013 0.37206960E+024 0.22461619E+019 0.16693722E+035 0.35046194E+031 0.43426295E+024 0.42572920E-002 0.75386725E-018 0.21888405E-013 0.95168842E+018 0.11299012E+021 0.21533005E+018 0.15435187E+021 0.82007446E+020 0.55116223E+020 0.31866956E+020 0.24086772E+020 0.17081776E+020 0.80409414E+019 0.34357236E+019 0.63137176E+019 0.27423185E+019 0.12945965E+019 0.68861498E+018 0.82127364E+019 0.52609892E+019 0.53652527E+019 0.21531883E+019 0.23510742E+018 0.31827243E+019 0.28781072E+019 0.17951904E+019 0.20984122E+019 0.18640356E+019 0.55517203E+020 0.58622988E+019 0.43110031E+019 0.26570057E+017 0.36941593E+018 0.38623392E+017 0.14690205E+018 0.12861326E+017 0.20467160E+017 0.27246950E+018 0.76208775E+010 0.17712620E+012 0.17335999E+011 0.18231029E+017 0.35855245E+009 0.31190757E+016 0.25094235E+005 0.27342321E+009 0.22915731E+018 0.26362074E+011 0.63624257E+012 0.66009462E+005 0.89381931E+007 0.23039286E+013 0.56491761E+010 0.49409149E+018 0.95004554E+016 0.26175615E+013 0.28132511E+000 0.38677150E-008 0.65143534E-006 +27 0.67500000E-008 0.64785181E-010 0.48221085E+017 0.93111492E+019 0.16793924E+017 0.12672945E+020 0.67506543E+019 0.45432227E+019 0.26632967E+019 0.20284834E+019 0.14602113E+019 0.69488721E+018 0.29928687E+018 0.54620011E+018 0.23796349E+018 0.11407931E+018 0.61273303E+017 0.73391974E+018 0.59596652E+017 0.40449156E+018 0.28340458E+017 0.15367529E+017 0.28087761E+018 0.24241255E+018 0.16144523E+018 0.19691923E+018 0.17468708E+018 0.48476177E+019 0.17756497E+018 0.37786179E+018 0.15124258E+015 0.21072901E+017 0.31442880E+016 0.11864262E+017 0.10215821E+016 0.15574839E+016 0.22092785E+017 0.52479063E+009 0.13421923E+011 0.12794864E+010 0.13650534E+016 0.24383236E+008 0.24528828E+015 0.19014183E+004 0.21234197E+008 0.31841223E+016 0.23024269E+010 0.50604612E+011 0.49818882E+004 0.60768172E+006 0.18657269E+012 0.46206474E+009 0.40077293E+017 0.54660880E+015 0.20289128E+012 0.21753026E-001 0.32128922E-009 0.51529167E-007 0.27820702E+035 0.98048788E+039 0.35325461E+034 0.18234744E+040 0.51524644E+039 0.23285102E+039 0.78929422E+038 0.45482015E+038 0.23292003E+038 0.52315905E+037 0.96477669E+036 0.32177562E+037 0.60901650E+036 0.13813081E+036 0.39576513E+035 0.56482622E+037 0.20955133E+036 0.16922795E+037 0.37336331E+035 0.24803775E+034 0.83664761E+036 0.64138634E+036 0.27349660E+036 0.38922114E+036 0.30570206E+036 0.24891342E+039 0.53959273E+036 0.15110504E+037 0.30519277E+031 0.49207805E+034 0.11158791E+033 0.14906210E+034 0.12552999E+032 0.34150556E+032 0.56158667E+034 0.38806001E+019 0.23656102E+022 0.22100268E+020 0.21899422E+032 0.78155003E+016 0.73470931E+030 0.52212127E+008 0.64857201E+016 0.42762146E+033 0.55671015E+020 0.29893937E+023 0.35003905E+009 0.45238002E+013 0.38830110E+024 0.23270136E+019 0.18242234E+035 0.33054439E+031 0.51091629E+024 0.70244223E-002 0.16663272E-017 0.41183929E-013 0.94612229E+018 0.11554459E+021 0.23523039E+018 0.15825769E+021 0.83538745E+020 0.55937480E+020 0.32095040E+020 0.24209658E+020 0.17112138E+020 0.80476810E+019 0.34373149E+019 0.64831105E+019 0.28105202E+019 0.13151742E+019 0.69498565E+018 0.81795131E+019 0.52873076E+019 0.53627335E+019 0.21630805E+019 0.23541669E+018 0.32033923E+019 0.29302559E+019 0.17931007E+019 0.20984858E+019 0.18620762E+019 0.56054311E+020 0.58455711E+019 0.43226369E+019 0.28630215E+017 0.36907091E+018 0.40825677E+017 0.14691829E+018 0.13923313E+017 0.23905127E+017 0.28890964E+018 0.85765876E+010 0.20068759E+012 0.19552328E+011 0.19517120E+017 0.37963059E+009 0.34629931E+016 0.30750436E+005 0.34672820E+009 0.22820045E+018 0.26362920E+011 0.66530950E+012 0.78695328E+005 0.89461832E+007 0.23285089E+013 0.56754616E+010 0.51220865E+018 0.95003629E+016 0.28235016E+013 0.36067309E+000 0.57442269E-008 0.89268006E-006 +28 0.70000000E-008 0.64785377E-010 0.49121143E+017 0.97073578E+019 0.18461644E+017 0.13235248E+020 0.70169466E+019 0.47102299E+019 0.27473058E+019 0.20896801E+019 0.15010608E+019 0.71376515E+018 0.30728045E+018 0.57063211E+018 0.24824988E+018 0.11824350E+018 0.63216894E+017 0.75023062E+018 0.59245050E+017 0.40537779E+018 0.28044792E+017 0.15282762E+017 0.28934667E+018 0.25181504E+018 0.16540255E+018 0.20146738E+018 0.17763018E+018 0.50030425E+019 0.17125417E+018 0.38800434E+018 0.15059417E+015 0.20522990E+017 0.33572521E+016 0.11942062E+017 0.11159507E+016 0.18146668E+016 0.23687811E+017 0.59131133E+009 0.15249408E+011 0.14443032E+010 0.14573881E+016 0.26034791E+008 0.27361581E+015 0.23193789E+004 0.26715537E+008 0.31300992E+016 0.23528436E+010 0.53619962E+011 0.59252295E+004 0.61558294E+006 0.19264219E+012 0.47555460E+009 0.42172643E+017 0.53216670E+015 0.22084306E+012 0.27659311E-001 0.46765533E-009 0.69629324E-007 0.28212723E+035 0.10406252E+040 0.41986437E+034 0.19425285E+040 0.54328132E+039 0.24415142E+039 0.81893338E+038 0.47064133E+038 0.24000871E+038 0.53831059E+037 0.99195094E+036 0.34364575E+037 0.64838231E+036 0.14502925E+036 0.41144358E+035 0.57596345E+037 0.20946163E+036 0.16648961E+037 0.37292438E+035 0.24150264E+034 0.86670018E+036 0.67599252E+036 0.28015578E+036 0.39805084E+036 0.30882808E+036 0.25889116E+039 0.52587127E+036 0.15549651E+037 0.30014940E+031 0.46771523E+034 0.12503145E+033 0.14747429E+034 0.14715482E+032 0.45456052E+032 0.63385264E+034 0.48592747E+019 0.30085695E+022 0.27709829E+020 0.24462430E+032 0.87564985E+016 0.90074974E+030 0.76758842E+008 0.10162326E+017 0.42690515E+033 0.56753874E+020 0.32873194E+023 0.48868194E+009 0.45556056E+013 0.40367886E+024 0.24044026E+019 0.19766260E+035 0.31358314E+031 0.59402086E+024 0.11241923E-001 0.35032535E-017 0.74545301E-013 0.94478209E+018 0.11771639E+021 0.25533264E+018 0.16157030E+021 0.84728976E+020 0.56529559E+020 0.32234098E+020 0.24281096E+020 0.17126712E+020 0.80514925E+019 0.34388575E+019 0.66546188E+019 0.28794236E+019 0.13359356E+019 0.70138504E+018 0.81447046E+019 0.52688070E+019 0.53688312E+019 0.21562327E+019 0.23550597E+018 0.32229519E+019 0.29763413E+019 0.17909931E+019 0.20985570E+019 0.18614722E+019 0.56547401E+020 0.58800798E+019 0.43318568E+019 0.29310093E+017 0.36956172E+018 0.43024778E+017 0.14678541E+018 0.14991787E+017 0.27420853E+017 0.30520118E+018 0.95793565E+010 0.22562403E+012 0.21851370E+011 0.20792809E+017 0.40110656E+009 0.38227483E+016 0.37192265E+005 0.43340811E+009 0.22566551E+018 0.26363752E+011 0.69273491E+012 0.92730917E+005 0.89653905E+007 0.23468824E+013 0.56949049E+010 0.52871071E+018 0.94768633E+016 0.30279094E+013 0.45543592E+000 0.83209331E-008 0.11998516E-005 +29 0.72500000E-008 0.64785557E-010 0.50012092E+017 0.10089378E+020 0.20182071E+017 0.13774488E+020 0.72691490E+019 0.48678526E+019 0.28278768E+019 0.21489049E+019 0.15413179E+019 0.73250105E+018 0.31524119E+018 0.59554603E+018 0.25871582E+018 0.12245689E+018 0.65172423E+017 0.76639664E+018 0.59040524E+017 0.40621657E+018 0.27844166E+017 0.15201755E+017 0.29779438E+018 0.26100853E+018 0.16935066E+018 0.20601306E+018 0.18054413E+018 0.51573217E+019 0.16595228E+018 0.39805536E+018 0.15192441E+015 0.20012226E+017 0.35747269E+016 0.12012263E+017 0.12130832E+016 0.20812816E+016 0.25309366E+017 0.66185458E+009 0.17205238E+011 0.16168522E+010 0.15493529E+016 0.27737238E+008 0.30359544E+015 0.27965086E+004 0.33178596E+008 0.30872707E+016 0.24030942E+010 0.56600218E+011 0.69745374E+004 0.62353174E+006 0.19855886E+012 0.48879800E+009 0.44213564E+017 0.51871939E+015 0.23912858E+012 0.34694466E-001 0.66579280E-009 0.92481682E-007 0.28584944E+035 0.10979447E+040 0.49350999E+034 0.20553236E+040 0.56909494E+039 0.25443735E+039 0.84640618E+038 0.48552508E+038 0.24690038E+038 0.55324413E+037 0.10189169E+037 0.36646767E+037 0.68928085E+036 0.15210373E+036 0.42733202E+035 0.58688651E+037 0.20943059E+036 0.16391927E+037 0.37269197E+035 0.23556075E+034 0.89666120E+036 0.70961274E+036 0.28678609E+036 0.40687450E+036 0.31189091E+036 0.26876856E+039 0.51593892E+036 0.15981063E+037 0.30628643E+031 0.44715805E+034 0.13936757E+033 0.14584323E+034 0.17085777E+032 0.58618179E+032 0.71059767E+034 0.60046191E+019 0.37739229E+022 0.34172098E+020 0.27101662E+032 0.97705333E+016 0.10929211E+031 0.11026720E+009 0.15516239E+017 0.42540712E+033 0.57835374E+020 0.35881925E+023 0.66835057E+009 0.45883217E+013 0.41840417E+024 0.24791949E+019 0.21261952E+035 0.29924054E+031 0.68359805E+024 0.17510910E-001 0.70468029E-017 0.13037829E-012 0.95075083E+018 0.11956191E+021 0.27562834E+018 0.16435250E+021 0.85630002E+020 0.56939608E+020 0.32316026E+020 0.24320290E+020 0.17135881E+020 0.80536042E+019 0.34397453E+019 0.68286327E+019 0.29490599E+019 0.13568336E+019 0.70777296E+018 0.81090830E+019 0.52097432E+019 0.53718404E+019 0.21342149E+019 0.23508629E+018 0.32415455E+019 0.30173223E+019 0.17888143E+019 0.20986268E+019 0.18620373E+019 0.57004194E+020 0.58943936E+019 0.43393893E+019 0.29467203E+017 0.37023013E+018 0.45228256E+017 0.14681344E+018 0.16066326E+017 0.30950820E+017 0.32134545E+018 0.10627666E+011 0.25192185E+012 0.24227465E+011 0.22058081E+017 0.42287094E+009 0.41981909E+016 0.44469338E+005 0.53474588E+009 0.22235180E+018 0.26364572E+011 0.71863885E+012 0.10816297E+006 0.89912358E+007 0.23606030E+013 0.57092870E+010 0.54372335E+018 0.94842629E+016 0.32307600E+013 0.56738267E+000 0.11790443E-007 0.15852888E-005 +30 0.75000000E-008 0.64785709E-010 0.50899182E+017 0.10459350E+020 0.21954656E+017 0.14292931E+020 0.75094504E+019 0.50181298E+019 0.29061924E+019 0.22069071E+019 0.15812743E+019 0.75116840E+018 0.32318568E+018 0.62097318E+018 0.26936275E+018 0.12671701E+018 0.67138140E+017 0.78244691E+018 0.58923577E+017 0.40701800E+018 0.27711923E+017 0.15124903E+017 0.30622289E+018 0.27003021E+018 0.17329056E+018 0.21056725E+018 0.18344011E+018 0.53107292E+019 0.16150401E+018 0.40804330E+018 0.15308621E+015 0.19541392E+017 0.37972277E+016 0.12076230E+017 0.13129715E+016 0.23555746E+016 0.26957211E+017 0.73642875E+009 0.19291627E+011 0.17968411E+010 0.16414226E+016 0.29484350E+008 0.33524478E+015 0.33372408E+004 0.40723397E+008 0.30583975E+016 0.24535705E+010 0.59549804E+011 0.81350791E+004 0.63156114E+006 0.20436019E+012 0.50185656E+009 0.46204027E+017 0.50629200E+015 0.25774354E+012 0.42993637E-001 0.92941404E-009 0.12096262E-006 0.28944337E+035 0.11527621E+040 0.57443251E+034 0.21621304E+040 0.59297064E+039 0.26391209E+039 0.87244800E+038 0.49982563E+038 0.25369294E+038 0.56807523E+037 0.10457852E+037 0.39030884E+037 0.73175368E+036 0.15935007E+036 0.44340753E+035 0.59764363E+037 0.20942088E+036 0.16151142E+037 0.37270466E+035 0.23017133E+034 0.92653962E+036 0.74240153E+036 0.29339182E+036 0.41571639E+036 0.31491578E+036 0.27857146E+039 0.50873471E+036 0.16407120E+037 0.31187938E+031 0.42992771E+034 0.15466311E+033 0.14420542E+034 0.19670821E+032 0.73600973E+032 0.79183181E+034 0.73325780E+019 0.46763166E+022 0.41532803E+020 0.29828630E+032 0.10855076E+017 0.13137473E+031 0.15519456E+009 0.23141173E+017 0.42539341E+033 0.58919697E+020 0.38915232E+023 0.89768963E+009 0.46220039E+013 0.43263364E+024 0.25520369E+019 0.22726876E+035 0.28718905E+031 0.77966978E+024 0.26623735E-001 0.13629098E-016 0.22115459E-012 0.95401032E+018 0.12112983E+021 0.29609728E+018 0.16666274E+021 0.86291424E+020 0.57213868E+020 0.32359269E+020 0.24339510E+020 0.17142231E+020 0.80560059E+019 0.34402557E+019 0.70056157E+019 0.30193966E+019 0.13778036E+019 0.71411264E+018 0.80730702E+019 0.51704811E+019 0.53686549E+019 0.21160298E+019 0.23462176E+018 0.32591656E+019 0.30539969E+019 0.17866027E+019 0.20986953E+019 0.18617497E+019 0.57430369E+020 0.58900428E+019 0.43457187E+019 0.28426269E+017 0.36953127E+018 0.47445616E+017 0.14687460E+018 0.17146615E+017 0.34464184E+017 0.33734381E+018 0.11719907E+011 0.27958665E+012 0.26708887E+011 0.23312963E+017 0.44478180E+009 0.45890069E+016 0.52631526E+005 0.65202624E+009 0.22686913E+018 0.26365371E+011 0.74314584E+012 0.12503695E+006 0.90181077E+007 0.23708405E+013 0.57199255E+010 0.55736757E+018 0.94849267E+016 0.34320430E+013 0.69836582E+000 0.16382281E-007 0.20627207E-005 +31 0.77500000E-008 0.64785855E-010 0.51777222E+017 0.10819185E+020 0.23779003E+017 0.14792816E+020 0.77400101E+019 0.51629358E+019 0.29831504E+019 0.22642222E+019 0.16211030E+019 0.76981093E+018 0.33112524E+018 0.64695646E+018 0.28019370E+018 0.13102157E+018 0.69112261E+017 0.79839849E+018 0.58851587E+017 0.40778258E+018 0.27618606E+017 0.15051440E+017 0.31463401E+018 0.27891196E+018 0.17722461E+018 0.21511949E+018 0.18630793E+018 0.54634753E+019 0.15777450E+018 0.41798779E+018 0.15286324E+015 0.19108452E+017 0.40252811E+016 0.12135160E+017 0.14156118E+016 0.26361335E+016 0.28631135E+017 0.81504541E+009 0.21510933E+011 0.19839932E+010 0.17340235E+016 0.31269302E+008 0.36858634E+015 0.39461082E+004 0.49452731E+008 0.30379434E+016 0.25041203E+010 0.62472816E+011 0.94122963E+004 0.63964548E+006 0.21007605E+012 0.51478428E+009 0.48147989E+017 0.49486243E+015 0.27668436E+012 0.52699707E-001 0.12748028E-008 0.15605069E-006 0.29291614E+035 0.12053890E+040 0.66287775E+034 0.22633264E+040 0.61521869E+039 0.27277217E+039 0.89761771E+038 0.51379316E+038 0.26044111E+038 0.58286396E+037 0.10726143E+037 0.41525248E+037 0.77584278E+036 0.16676162E+036 0.45963800E+035 0.60826100E+037 0.20937631E+036 0.15925352E+037 0.37263060E+035 0.22526545E+034 0.95632823E+036 0.77449628E+036 0.29997611E+036 0.42455419E+036 0.31788154E+036 0.28831848E+039 0.50345615E+036 0.16829432E+037 0.31187533E+031 0.41553361E+034 0.17099464E+033 0.14258685E+034 0.22477601E+032 0.90346178E+032 0.87756416E+034 0.88595394E+019 0.57313404E+022 0.49833701E+020 0.32655995E+032 0.12006119E+017 0.15659070E+031 0.21447847E+009 0.33785017E+017 0.42582659E+033 0.60007592E+020 0.41969984E+023 0.11865766E+010 0.46566003E+013 0.44648740E+024 0.26234218E+019 0.24159728E+035 0.27711948E+031 0.88225758E+024 0.39608616E-001 0.25451210E-016 0.36497679E-012 0.95298594E+018 0.12246193E+021 0.31672865E+018 0.16855591E+021 0.86759790E+020 0.57390270E+020 0.32380355E+020 0.24351414E+020 0.17145894E+020 0.80576641E+019 0.34405744E+019 0.71862232E+019 0.30904338E+019 0.13987781E+019 0.72035733E+018 0.80368973E+019 0.52557901E+019 0.53635113E+019 0.21508323E+019 0.23494942E+018 0.32757986E+019 0.30870344E+019 0.17843769E+019 0.20987626E+019 0.18634452E+019 0.57830254E+020 0.58677861E+019 0.43511693E+019 0.26378918E+017 0.36921695E+018 0.49686402E+017 0.14692132E+018 0.18232827E+017 0.37937448E+017 0.35320025E+018 0.12854652E+011 0.30860374E+012 0.29282803E+011 0.24557495E+017 0.46669228E+009 0.49951389E+016 0.61728798E+005 0.78656426E+009 0.22911195E+018 0.26366141E+011 0.76637647E+012 0.14340119E+006 0.90595597E+007 0.23784741E+013 0.57277947E+010 0.56975824E+018 0.94934654E+016 0.36317729E+013 0.85031408E+000 0.22366962E-007 0.26473200E-005 +32 0.80000000E-008 0.64785994E-010 0.52644175E+017 0.11170192E+020 0.25654220E+017 0.15275781E+020 0.79626553E+019 0.53037704E+019 0.30593191E+019 0.23211586E+019 0.16608685E+019 0.78843974E+018 0.33906154E+018 0.67355167E+018 0.29121061E+018 0.13536524E+018 0.71091109E+017 0.81426047E+018 0.58807659E+017 0.40851386E+018 0.27550596E+017 0.14981111E+017 0.32302329E+018 0.28767976E+018 0.18115335E+018 0.21966695E+018 0.18914498E+018 0.56157116E+019 0.15465219E+018 0.42790045E+018 0.15148118E+015 0.18711175E+017 0.42598494E+016 0.12189841E+017 0.15210026E+016 0.29218378E+016 0.30330875E+017 0.89771716E+009 0.23865708E+011 0.21780456E+010 0.18274907E+016 0.33082524E+008 0.40364950E+015 0.46277472E+004 0.59472309E+008 0.30228416E+016 0.25546208E+010 0.65373265E+011 0.10811822E+005 0.64775970E+006 0.21572784E+012 0.52761276E+009 0.50049200E+017 0.48437340E+015 0.29594764E+012 0.63963402E-001 0.17211274E-008 0.19883321E-006 0.29625512E+035 0.12560519E+040 0.75904893E+034 0.23592213E+040 0.63612634E+039 0.28118375E+039 0.92228419E+038 0.52757942E+038 0.26716830E+038 0.59763114E+037 0.10994208E+037 0.44141205E+037 0.82159499E+036 0.17432539E+036 0.47597103E+035 0.61875529E+037 0.20934056E+036 0.15713970E+037 0.37247300E+035 0.22079835E+034 0.98599679E+036 0.80601759E+036 0.30654191E+036 0.43337966E+036 0.32078108E+036 0.29802435E+039 0.49960754E+036 0.17249043E+037 0.30686032E+031 0.40352935E+034 0.18849286E+033 0.14100537E+034 0.25513150E+032 0.10878175E+033 0.96780273E+034 0.10602262E+020 0.69556091E+022 0.59112594E+020 0.35595181E+032 0.13215957E+017 0.18522742E+031 0.29159819E+009 0.48376850E+017 0.42615488E+033 0.61093463E+020 0.45044512E+023 0.15462444E+010 0.46920432E+013 0.46005810E+024 0.26937335E+019 0.25560076E+035 0.26872157E+031 0.99138205E+024 0.57781395E-001 0.46053202E-016 0.58761325E-012 0.94795060E+018 0.12358921E+021 0.33749895E+018 0.17007582E+021 0.87085572E+020 0.57494173E+020 0.32397675E+020 0.24362991E+020 0.17148040E+020 0.80588405E+019 0.34407966E+019 0.73714246E+019 0.31621742E+019 0.14196424E+019 0.72643256E+018 0.80006914E+019 0.52887141E+019 0.53602214E+019 0.21634288E+019 0.23539940E+018 0.32913738E+019 0.31169954E+019 0.17821474E+019 0.20988286E+019 0.18603732E+019 0.58207262E+020 0.58402670E+019 0.43559585E+019 0.28427600E+017 0.36879235E+018 0.51969403E+017 0.14687822E+018 0.19324331E+017 0.41353247E+017 0.36891349E+018 0.14030507E+011 0.33897124E+012 0.31931498E+011 0.25791731E+017 0.48839798E+009 0.54166480E+016 0.71811167E+005 0.93967309E+009 0.22846812E+018 0.26366878E+011 0.78844602E+012 0.16330581E+006 0.91235842E+007 0.23845181E+013 0.57336155E+010 0.58100325E+018 0.94980848E+016 0.38299755E+013 0.10252308E+001 0.30060531E-007 0.33560518E-005 +33 0.82500000E-008 0.64786115E-010 0.53499629E+017 0.11513480E+020 0.27578422E+017 0.15743454E+020 0.81791106E+019 0.54418801E+019 0.31350621E+019 0.23778994E+019 0.17005991E+019 0.80705918E+018 0.34699511E+018 0.70083040E+018 0.30241101E+018 0.13973965E+018 0.73069965E+017 0.83003989E+018 0.58783910E+017 0.40921719E+018 0.27501838E+017 0.14913985E+017 0.33138463E+018 0.29635554E+018 0.18507692E+018 0.22421185E+018 0.19195371E+018 0.57675625E+019 0.15204409E+018 0.43778990E+018 0.15018128E+015 0.18347846E+017 0.45022383E+016 0.12240895E+017 0.16291443E+016 0.32118094E+016 0.32056201E+017 0.98445568E+009 0.26358797E+011 0.23787482E+010 0.19220564E+016 0.34910360E+008 0.44047437E+015 0.53869048E+004 0.70891033E+008 0.30107144E+016 0.26050241E+010 0.68255154E+011 0.12339499E+005 0.65589392E+006 0.22133194E+012 0.54036929E+009 0.51911240E+017 0.47477539E+015 0.31553030E+012 0.76943465E-001 0.22907787E-008 0.25051369E-006 0.29944526E+035 0.13049509E+040 0.86306062E+034 0.24501827E+040 0.65597486E+039 0.28928635E+039 0.94668105E+038 0.54127316E+038 0.27388437E+038 0.61238441E+037 0.11262097E+037 0.46893215E+037 0.86902797E+036 0.18201825E+036 0.49233605E+035 0.62913771E+037 0.20933925E+036 0.15516393E+037 0.37236470E+035 0.21673919E+034 0.10155015E+037 0.83707140E+036 0.31308986E+036 0.44220241E+036 0.32362490E+036 0.30770066E+039 0.49681437E+036 0.17666683E+037 0.29863661E+031 0.39355986E+034 0.20734186E+033 0.13947255E+034 0.28784541E+032 0.12882842E+033 0.10625546E+035 0.12577809E+020 0.83669042E+022 0.69403411E+020 0.38655042E+032 0.14471437E+017 0.21759911E+031 0.39064146E+009 0.68057116E+017 0.42620177E+033 0.62176006E+020 0.48138348E+023 0.19894173E+010 0.47283014E+013 0.47341643E+024 0.27632439E+019 0.26928153E+035 0.26173845E+031 0.11070626E+025 0.82805272E-001 0.80993110E-016 0.92511463E-012 0.94368703E+018 0.12453819E+021 0.35836225E+018 0.17126516E+021 0.87293426E+020 0.57550222E+020 0.32411162E+020 0.24373590E+020 0.17149319E+020 0.80597343E+019 0.34409625E+019 0.75624821E+019 0.32345241E+019 0.14402252E+019 0.73224829E+018 0.79667132E+019 0.52758098E+019 0.53677117E+019 0.21588597E+019 0.23553317E+018 0.33058001E+019 0.31443526E+019 0.17799176E+019 0.20988932E+019 0.18616238E+019 0.58564128E+020 0.58766853E+019 0.43602340E+019 0.29150250E+017 0.36955115E+018 0.54319373E+017 0.14675230E+018 0.20420941E+017 0.44699152E+017 0.38448481E+018 0.15246079E+011 0.37070052E+012 0.34650700E+011 0.27015724E+017 0.50961616E+009 0.58537592E+016 0.82930736E+005 0.11126608E+010 0.22632521E+018 0.26367579E+011 0.80946364E+012 0.18480429E+006 0.91891963E+007 0.23895773E+013 0.57379212E+010 0.59120318E+018 0.94682794E+016 0.40266173E+013 0.12252485E+001 0.39832313E-007 0.42072124E-005 +34 0.85000000E-008 0.64786228E-010 0.54342024E+017 0.11849890E+020 0.29547156E+017 0.16197298E+020 0.83909265E+019 0.55782332E+019 0.32105799E+019 0.24345347E+019 0.17403009E+019 0.82566808E+018 0.35492472E+018 0.72888344E+018 0.31378241E+018 0.14412941E+018 0.75041255E+017 0.84573821E+018 0.58764586E+017 0.40989113E+018 0.27465406E+017 0.14849848E+017 0.33970712E+018 0.30495725E+018 0.18899404E+018 0.22875463E+018 0.19473487E+018 0.59191070E+019 0.14986277E+018 0.44766095E+018 0.15166889E+015 0.18015895E+017 0.47544878E+016 0.12288722E+017 0.17400385E+016 0.35053655E+016 0.33806835E+017 0.10752688E+010 0.28993483E+011 0.25858633E+010 0.20178618E+016 0.36733870E+008 0.47911730E+015 0.62284493E+004 0.83821423E+008 0.29984475E+016 0.26552099E+010 0.71122289E+011 0.14001401E+005 0.66405858E+006 0.22689963E+012 0.55306664E+009 0.53737419E+017 0.46598957E+015 0.33542930E+012 0.91806917E-001 0.30097386E-008 0.31242036E-006 0.30244886E+035 0.13522491E+040 0.97480512E+034 0.25365953E+040 0.67502883E+039 0.29719154E+039 0.97094430E+038 0.55492239E+038 0.28059408E+038 0.62712864E+037 0.11529863E+037 0.49800354E+037 0.91810213E+036 0.18979776E+036 0.50862533E+035 0.63941403E+037 0.20934435E+036 0.15331745E+037 0.37230617E+035 0.21304949E+034 0.10447790E+037 0.86775012E+036 0.31961982E+036 0.45101849E+036 0.32641012E+036 0.31735621E+039 0.49477316E+036 0.18082827E+037 0.30561745E+031 0.38527663E+034 0.22783299E+033 0.13799602E+034 0.32298885E+032 0.15040442E+033 0.11618258E+035 0.14803426E+020 0.99843965E+022 0.80736342E+020 0.41841662E+032 0.15752053E+017 0.25405871E+031 0.51637737E+009 0.94211498E+017 0.42494461E+033 0.63255550E+020 0.51251999E+023 0.25304609E+010 0.47654977E+013 0.48661537E+024 0.28321592E+019 0.28264682E+035 0.25592917E+031 0.12293174E+025 0.11675947E+000 0.13881078E-015 0.14271486E-011 0.95046771E+018 0.12532997E+021 0.37922048E+018 0.17216277E+021 0.87415923E+020 0.57599012E+020 0.32427739E+020 0.24381106E+020 0.17150156E+020 0.80604517E+019 0.34410933E+019 0.77610352E+019 0.33072144E+019 0.14602363E+019 0.73767060E+018 0.79680310E+019 0.52232744E+019 0.53720133E+019 0.21391693E+019 0.23512700E+018 0.33189368E+019 0.31695043E+019 0.17776889E+019 0.20989561E+019 0.18619815E+019 0.58903096E+020 0.58940099E+019 0.43640964E+019 0.29543589E+017 0.37017882E+018 0.56775210E+017 0.14678645E+018 0.21522496E+017 0.47966612E+017 0.39991549E+018 0.16499909E+011 0.40380112E+012 0.37436232E+011 0.28229536E+017 0.52996937E+009 0.63070513E+016 0.95139756E+005 0.13068693E+010 0.22250844E+018 0.26368244E+011 0.82953188E+012 0.20795894E+006 0.92561819E+007 0.23933449E+013 0.57411060E+010 0.60045121E+018 0.94801307E+016 0.42217043E+013 0.14525179E+001 0.52105219E-007 0.52209214E-005 +35 0.87500000E-008 0.64786320E-010 0.55173535E+017 0.12180092E+020 0.31550768E+017 0.16638751E+020 0.85994486E+019 0.57135330E+019 0.32859850E+019 0.24911158E+019 0.17799845E+019 0.84426951E+018 0.36285130E+018 0.75781068E+018 0.32528976E+018 0.14851040E+018 0.76995178E+017 0.86135881E+018 0.58755636E+017 0.41054294E+018 0.27443620E+017 0.14789196E+017 0.34798044E+018 0.31350049E+018 0.19290479E+018 0.23330650E+018 0.19749985E+018 0.60704257E+019 0.14804552E+018 0.45751819E+018 0.15288102E+015 0.17714469E+017 0.50197245E+016 0.12333762E+017 0.18536873E+016 0.38019773E+016 0.35582578E+017 0.11701572E+010 0.31773697E+011 0.27991649E+010 0.21149820E+016 0.38527716E+008 0.51965856E+015 0.71573878E+004 0.98380264E+008 0.29921450E+016 0.27056296E+010 0.73978770E+011 0.15803860E+005 0.67229117E+006 0.23243975E+012 0.56572051E+009 0.55530860E+017 0.45799634E+015 0.35564173E+012 0.10872946E+000 0.39079859E-008 0.38601660E-006 0.30531374E+035 0.13980660E+040 0.10936825E+035 0.26188501E+040 0.69351421E+039 0.30497751E+039 0.99513974E+038 0.56854832E+038 0.28729916E+038 0.64186494E+037 0.11797502E+037 0.52883945E+037 0.96860595E+036 0.19759037E+036 0.52468669E+035 0.64958778E+037 0.20935731E+036 0.15159301E+037 0.37242997E+035 0.20970944E+034 0.10737508E+037 0.89813404E+036 0.32613044E+036 0.45985493E+036 0.32916457E+036 0.32699797E+039 0.49326798E+036 0.18497801E+037 0.31105222E+031 0.37844190E+034 0.25042453E+033 0.13657976E+034 0.36063324E+032 0.17342852E+033 0.12656214E+035 0.17296354E+020 0.11828985E+023 0.93138003E+020 0.45158878E+032 0.17028005E+017 0.29501592E+031 0.67433678E+009 0.12850952E+018 0.42507644E+033 0.64338486E+020 0.54386718E+023 0.31855528E+010 0.48036798E+013 0.49969480E+024 0.29006209E+019 0.29570734E+035 0.25112108E+031 0.13581627E+025 0.16221817E+000 0.23237591E-015 0.21612262E-011 0.95427067E+018 0.12598078E+021 0.39986808E+018 0.17282241E+021 0.87479746E+020 0.57642680E+020 0.32439816E+020 0.24386469E+020 0.17151524E+020 0.80610513E+019 0.34412003E+019 0.79687609E+019 0.33794414E+019 0.14791847E+019 0.74251163E+018 0.79672396E+019 0.51512243E+019 0.53685716E+019 0.21082145E+019 0.23473393E+018 0.33306126E+019 0.31927878E+019 0.17754622E+019 0.20990174E+019 0.18619328E+019 0.59226038E+020 0.58932356E+019 0.43676158E+019 0.28679053E+017 0.36950134E+018 0.59400007E+017 0.14685299E+018 0.22628854E+017 0.51150064E+017 0.41520678E+018 0.17790902E+011 0.43829957E+012 0.40284014E+011 0.29439676E+017 0.54895834E+009 0.67775696E+016 0.10848875E+006 0.15237018E+010 0.22641275E+018 0.26368873E+011 0.84874659E+012 0.23282323E+006 0.93604013E+007 0.23961495E+013 0.57434619E+010 0.60883326E+018 0.94812549E+016 0.44152433E+013 0.17092876E+001 0.67364423E-007 0.64193079E-005 +36 0.90000000E-008 0.64786408E-010 0.55983395E+017 0.12504637E+020 0.33568695E+017 0.17069322E+020 0.88058704E+019 0.58482925E+019 0.33613551E+019 0.25476861E+019 0.18196714E+019 0.86287351E+018 0.37077911E+018 0.78768489E+018 0.33684887E+018 0.15284105E+018 0.78918519E+017 0.87690259E+018 0.58744076E+017 0.41116744E+018 0.27423488E+017 0.14731127E+017 0.35619498E+018 0.32199912E+018 0.19681053E+018 0.23785543E+018 0.20023686E+018 0.62215824E+019 0.14653064E+018 0.46736458E+018 0.15290963E+015 0.17440151E+017 0.53030585E+016 0.12376508E+017 0.19700938E+016 0.41012359E+016 0.37383212E+017 0.12691091E+010 0.34704429E+011 0.30184385E+010 0.22134528E+016 0.40256757E+008 0.56221822E+015 0.81788924E+004 0.11468963E+009 0.29878321E+016 0.27560812E+010 0.76827986E+011 0.17753509E+005 0.68056140E+006 0.23795990E+012 0.57834604E+009 0.57294479E+017 0.45073022E+015 0.37616479E+012 0.12789615E+000 0.50199559E-008 0.47291459E-006 0.30798894E+035 0.14425009E+040 0.12180337E+035 0.26973945E+040 0.71163269E+039 0.31270088E+039 0.10193090E+039 0.58216663E+038 0.29400400E+038 0.65660201E+037 0.12065162E+037 0.56162429E+037 0.10199663E+037 0.20526638E+036 0.54031157E+035 0.65965932E+037 0.20933324E+036 0.14997761E+037 0.37242108E+035 0.20666480E+034 0.11023383E+037 0.92829402E+036 0.33262284E+036 0.46868432E+036 0.33186201E+036 0.33663117E+039 0.49211211E+036 0.18911819E+037 0.31223803E+031 0.37278627E+034 0.27588759E+033 0.13522793E+034 0.40085031E+032 0.19782209E+033 0.13739457E+035 0.20073514E+020 0.13923938E+023 0.10663162E+021 0.48609051E+032 0.18255866E+017 0.34097210E+031 0.87090312E+009 0.17294958E+018 0.42531159E+033 0.65423958E+020 0.57544327E+023 0.39728796E+010 0.48427696E+013 0.51268393E+024 0.29687431E+019 0.30847615E+035 0.24715240E+031 0.14936135E+025 0.22234153E+000 0.38075034E-015 0.32180511E-011 0.95344570E+018 0.12650516E+021 0.41987386E+018 0.17326406E+021 0.87582512E+020 0.57672485E+020 0.32448857E+020 0.24390407E+020 0.17154101E+020 0.80615668E+019 0.34412902E+019 0.81867200E+019 0.34493799E+019 0.14962231E+019 0.74651762E+018 0.79665251E+019 0.52457173E+019 0.53644070E+019 0.21465651E+019 0.23486412E+018 0.33406508E+019 0.32145380E+019 0.17732376E+019 0.20991144E+019 0.18632364E+019 0.59534528E+020 0.58726947E+019 0.43708416E+019 0.26797802E+017 0.36941595E+018 0.62294923E+017 0.14693501E+018 0.23739884E+017 0.54246221E+017 0.43035994E+018 0.19117381E+011 0.47424379E+012 0.43190066E+011 0.30653419E+017 0.56588803E+009 0.72671512E+016 0.12303145E+006 0.17645939E+010 0.22882747E+018 0.26369468E+011 0.86719688E+012 0.25945942E+006 0.94793569E+007 0.23982365E+013 0.57452045E+010 0.61642825E+018 0.94958956E+016 0.46072417E+013 0.19979162E+001 0.86165561E-007 0.78266143E-005 +37 0.92500000E-008 0.64786499E-010 0.56764306E+017 0.12823862E+020 0.35561685E+017 0.17490603E+020 0.90110531E+019 0.59827702E+019 0.34366947E+019 0.26042405E+019 0.18593527E+019 0.88147565E+018 0.37870633E+018 0.81842140E+018 0.34827352E+018 0.15705645E+018 0.80795811E+017 0.89237068E+018 0.58736066E+017 0.41176842E+018 0.27406397E+017 0.14675683E+017 0.36434125E+018 0.33046446E+018 0.20071129E+018 0.24240327E+018 0.20294795E+018 0.63726281E+019 0.14527348E+018 0.47720134E+018 0.15174786E+015 0.17190880E+017 0.56124883E+016 0.12417224E+017 0.20892611E+016 0.44028235E+016 0.39208500E+017 0.13720923E+010 0.37792346E+011 0.32434800E+010 0.23132881E+016 0.41878302E+008 0.60697934E+015 0.92983445E+004 0.13287856E+009 0.29858393E+016 0.28065835E+010 0.79673248E+011 0.19857351E+005 0.68886082E+006 0.24346499E+012 0.59094906E+009 0.59030901E+017 0.44413102E+015 0.39699562E+012 0.14950241E+000 0.63850784E-008 0.57489454E-006 0.31040197E+035 0.14856240E+040 0.13442478E+035 0.27727563E+040 0.72953727E+039 0.32039278E+039 0.10434604E+039 0.59577800E+038 0.30070707E+038 0.67133604E+037 0.12332774E+037 0.59629623E+037 0.10708578E+037 0.21262294E+036 0.55526174E+035 0.66963234E+037 0.20931428E+036 0.14846803E+037 0.37236634E+035 0.20389575E+034 0.11304780E+037 0.95829273E+036 0.33909847E+036 0.47751069E+036 0.33450738E+036 0.34626113E+039 0.49126108E+036 0.19325026E+037 0.30825330E+031 0.36811086E+034 0.30549398E+033 0.13394196E+034 0.44371204E+032 0.22351008E+033 0.14868020E+035 0.23150982E+020 0.16295929E+023 0.12123717E+021 0.52193716E+032 0.19380647E+017 0.39257737E+031 0.11134185E+010 0.22991372E+018 0.42596299E+033 0.66509044E+020 0.60727105E+023 0.49128769E+010 0.48827279E+013 0.52560535E+024 0.30366184E+019 0.32096774E+035 0.24387505E+031 0.16356829E+025 0.30098199E+000 0.61173815E-015 0.47183264E-011 0.94921497E+018 0.12692207E+021 0.43841039E+018 0.17352261E+021 0.87667557E+020 0.57692844E+020 0.32455908E+020 0.24393433E+020 0.17156404E+020 0.80620182E+019 0.34413668E+019 0.84120046E+019 0.35130483E+019 0.15100751E+019 0.74941382E+018 0.79662902E+019 0.52871345E+019 0.53587458E+019 0.21628140E+019 0.23537590E+018 0.33489497E+019 0.32349968E+019 0.17710153E+019 0.20992269E+019 0.18603654E+019 0.59829907E+020 0.58398894E+019 0.43738344E+019 0.28148036E+017 0.36887516E+018 0.65617481E+017 0.14687184E+018 0.24855469E+017 0.57253478E+017 0.44537620E+018 0.20477123E+011 0.51171513E+012 0.46150513E+011 0.31859020E+017 0.57994300E+009 0.77788757E+016 0.13882515E+006 0.20310679E+010 0.22862971E+018 0.26370027E+011 0.88496535E+012 0.28793707E+006 0.95995609E+007 0.23997889E+013 0.57464934E+010 0.62330849E+018 0.94978740E+016 0.47977072E+013 0.23209080E+001 0.10914259E-006 0.94694142E-005 +38 0.95000000E-008 0.64786585E-010 0.57501423E+017 0.13138239E+020 0.37463360E+017 0.17904789E+020 0.92156314E+019 0.61171172E+019 0.35120175E+019 0.26607864E+019 0.18990319E+019 0.90007758E+018 0.38663370E+018 0.84945959E+018 0.35921642E+018 0.16107536E+018 0.82615807E+017 0.90776458E+018 0.58731414E+017 0.41234694E+018 0.27390194E+017 0.14622597E+017 0.37242103E+018 0.33890661E+018 0.20460759E+018 0.24694607E+018 0.20562942E+018 0.65236093E+019 0.14423441E+018 0.48702980E+018 0.15008742E+015 0.16964292E+017 0.59603314E+016 0.12456181E+017 0.22111929E+016 0.47064900E+016 0.41058223E+017 0.14790414E+010 0.41046745E+011 0.34740948E+010 0.24144920E+016 0.43350054E+008 0.65422378E+015 0.10521404E+005 0.15308575E+009 0.29832441E+016 0.28569701E+010 0.82517555E+011 0.22122870E+005 0.69716180E+006 0.24895941E+012 0.60353860E+009 0.60742557E+017 0.43813896E+015 0.41813149E+012 0.17375580E+000 0.80484382E-008 0.69393300E-006 0.31242386E+035 0.15275373E+040 0.14657267E+035 0.28456750E+040 0.74733752E+039 0.32807008E+039 0.10676012E+039 0.60938502E+038 0.30740898E+038 0.68606818E+037 0.12600361E+037 0.63195671E+037 0.11187181E+037 0.21940152E+036 0.56935776E+035 0.67950866E+037 0.20930899E+036 0.14705719E+037 0.37225615E+035 0.20137441E+034 0.11581742E+037 0.98818580E+036 0.34555771E+036 0.48632804E+036 0.33709558E+036 0.35589183E+039 0.49063543E+036 0.19737531E+037 0.29879115E+031 0.36424921E+034 0.34134549E+033 0.13272182E+034 0.48929069E+032 0.25042144E+033 0.16041928E+035 0.26543167E+020 0.18976760E+023 0.13697160E+021 0.55914014E+032 0.20345774E+017 0.45072498E+031 0.14103131E+010 0.30223747E+018 0.42615098E+033 0.67591435E+020 0.63937671E+023 0.60285342E+010 0.49234678E+013 0.53847630E+024 0.31043115E+019 0.33319725E+035 0.24117054E+031 0.17843824E+025 0.40281056E+000 0.96535903E-015 0.68215231E-011 0.94203248E+018 0.12723413E+021 0.45410652E+018 0.17377272E+021 0.87731056E+020 0.57706773E+020 0.32461588E+020 0.24395835E+020 0.17158514E+020 0.80624255E+019 0.34414346E+019 0.86309388E+019 0.35631779E+019 0.15192165E+019 0.75106864E+018 0.79637668E+019 0.52817454E+019 0.53667049E+019 0.21613015E+019 0.23548351E+018 0.33560340E+019 0.32543322E+019 0.17687951E+019 0.20993359E+019 0.18619890E+019 0.60113325E+020 0.58719424E+019 0.43766696E+019 0.29080355E+017 0.36956378E+018 0.69615565E+017 0.14676413E+018 0.25975496E+017 0.60171444E+017 0.46025680E+018 0.21867441E+011 0.55084705E+012 0.49235616E+011 0.33056512E+017 0.59041422E+009 0.83178937E+016 0.15592814E+006 0.23247975E+010 0.22698756E+018 0.26370552E+011 0.90212830E+012 0.31833363E+006 0.97206833E+007 0.24009435E+013 0.57474469E+010 0.62954006E+018 0.94695907E+016 0.49866475E+013 0.26808653E+001 0.13701557E-006 0.11377311E-004 +39 0.97500000E-008 0.64786682E-010 0.58182183E+017 0.13448628E+020 0.39202829E+017 0.18314473E+020 0.94198939E+019 0.62513621E+019 0.35873044E+019 0.27173062E+019 0.19386933E+019 0.91867122E+018 0.39455761E+018 0.87944390E+018 0.36929718E+018 0.16486167E+018 0.84384268E+017 0.92308368E+018 0.58725941E+017 0.41290348E+018 0.27377191E+017 0.14571945E+017 0.38045143E+018 0.34733326E+018 0.20849777E+018 0.25148779E+018 0.20828550E+018 0.66745476E+019 0.14337532E+018 0.49684985E+018 0.15146355E+015 0.16758433E+017 0.63606627E+016 0.12493391E+017 0.23358929E+016 0.50120366E+016 0.42932111E+017 0.15898448E+010 0.44480473E+011 0.37100977E+010 0.25170642E+016 0.44659717E+008 0.70436641E+015 0.11854114E+005 0.17546369E+009 0.29781571E+016 0.29071308E+010 0.85363729E+011 0.24558191E+005 0.70547760E+006 0.25444486E+012 0.61611090E+009 0.62431568E+017 0.43267966E+015 0.43956956E+012 0.20087865E+000 0.10061621E-007 0.83224502E-006 0.31388847E+035 0.15684621E+040 0.15747836E+035 0.29170648E+040 0.76509017E+039 0.33573894E+039 0.10917300E+039 0.62298600E+038 0.31410829E+038 0.70079503E+037 0.12867859E+037 0.66622105E+037 0.11606597E+037 0.22548345E+036 0.58268862E+035 0.68929066E+037 0.20932744E+036 0.14574104E+037 0.37223314E+035 0.19908577E+034 0.11855555E+037 0.10180208E+037 0.35200018E+036 0.49514168E+036 0.33963284E+036 0.36552677E+039 0.49019297E+036 0.20149399E+037 0.30501109E+031 0.36105021E+034 0.38625759E+033 0.13156546E+034 0.53765875E+032 0.27848922E+033 0.17261196E+035 0.30261746E+020 0.22005565E+023 0.15384892E+021 0.59770901E+032 0.21129951E+017 0.51667196E+031 0.17712695E+010 0.39330371E+018 0.42504439E+033 0.68669453E+020 0.67178927E+023 0.73457962E+010 0.49651204E+013 0.55130967E+024 0.31718707E+019 0.34517991E+035 0.23892169E+031 0.19397221E+025 0.53347082E+000 0.14985758E-014 0.97373988E-011 0.94959801E+018 0.12746327E+021 0.46570458E+018 0.17394932E+021 0.87778471E+020 0.57716247E+020 0.32466291E+020 0.24397797E+020 0.17160465E+020 0.80627965E+019 0.34414951E+019 0.88140274E+019 0.35931254E+019 0.15244187E+019 0.75209961E+018 0.79678004E+019 0.52342125E+019 0.53711668E+019 0.21429518E+019 0.23519771E+018 0.33630465E+019 0.32727132E+019 0.17665771E+019 0.20994413E+019 0.18612514E+019 0.60385771E+020 0.58939936E+019 0.43792884E+019 0.29581968E+017 0.36994836E+018 0.74546956E+017 0.14675029E+018 0.27099862E+017 0.63000589E+017 0.47500296E+018 0.23284600E+011 0.59184146E+012 0.52411279E+011 0.34245929E+017 0.59810932E+009 0.88920240E+016 0.17440558E+006 0.26476828E+010 0.22301195E+018 0.26372069E+011 0.91875606E+012 0.35073235E+006 0.98428930E+007 0.24018018E+013 0.57481521E+010 0.63518374E+018 0.94711188E+016 0.51740706E+013 0.30806137E+001 0.17060831E-006 0.13583668E-004 +40 0.10000000E-007 0.64786782E-010 0.58798158E+017 0.13756468E+020 0.40765981E+017 0.18721959E+020 0.96240107E+019 0.63855561E+019 0.36625743E+019 0.27738138E+019 0.19783460E+019 0.93726050E+018 0.40247953E+018 0.90692489E+018 0.37856072E+018 0.16849325E+018 0.86124567E+017 0.93832977E+018 0.58725402E+017 0.41344313E+018 0.27371162E+017 0.14524115E+017 0.38846207E+018 0.35575127E+018 0.21238194E+018 0.25603758E+018 0.21092552E+018 0.68254768E+019 0.14267091E+018 0.50666328E+018 0.15268669E+015 0.16572723E+017 0.68255905E+016 0.12529022E+017 0.24633647E+016 0.53193060E+016 0.44829983E+017 0.17043415E+010 0.48109769E+011 0.39513109E+010 0.26210013E+016 0.45842710E+008 0.75794667E+015 0.13303018E+005 0.20018369E+009 0.29765598E+016 0.29575004E+010 0.88214913E+011 0.27172262E+005 0.71384662E+006 0.25992361E+012 0.62867290E+009 0.64099963E+017 0.42774424E+015 0.46130715E+012 0.23111129E+000 0.12483776E-007 0.99233923E-006 0.31478823E+035 0.16087481E+040 0.16687880E+035 0.29877019E+040 0.78281907E+039 0.34340257E+039 0.11158503E+039 0.63658261E+038 0.32080567E+038 0.71551767E+037 0.13135280E+037 0.69635348E+037 0.11968336E+037 0.23109852E+036 0.59560057E+035 0.69897886E+037 0.20935440E+036 0.14451299E+037 0.37238079E+035 0.19701907E+034 0.12128121E+037 0.10478363E+037 0.35842404E+036 0.50397472E+036 0.34214294E+036 0.37516826E+039 0.48986106E+036 0.20560695E+037 0.31015658E+031 0.35843915E+034 0.44342339E+033 0.13046974E+034 0.58888892E+032 0.30765079E+033 0.18525833E+035 0.34314905E+020 0.25430240E+023 0.17188041E+021 0.63765247E+032 0.21770555E+017 0.59211391E+031 0.22074288E+010 0.50716777E+018 0.42510008E+033 0.69751499E+020 0.70453951E+023 0.88940702E+010 0.50077302E+013 0.56411505E+024 0.32393213E+019 0.35693123E+035 0.23707437E+031 0.21017104E+025 0.69976756E+000 0.22917293E-014 0.13741289E-010 0.95409165E+018 0.12764050E+021 0.47337526E+018 0.17409743E+021 0.87814310E+020 0.57722854E+020 0.32470244E+020 0.24399419E+020 0.17162275E+020 0.80631351E+019 0.34415491E+019 0.89340801E+019 0.36123795E+019 0.15285499E+019 0.75355301E+018 0.79657109E+019 0.51518840E+019 0.53691442E+019 0.21118306E+019 0.23491566E+018 0.33695908E+019 0.32902820E+019 0.17643611E+019 0.20995431E+019 0.18627236E+019 0.60649715E+020 0.58939558E+019 0.43817077E+019 0.28892365E+017 0.36951486E+018 0.80614013E+017 0.14683837E+018 0.28228467E+017 0.65742041E+017 0.48961589E+018 0.24724069E+011 0.63497475E+012 0.55645767E+011 0.35427301E+017 0.60607603E+009 0.95109591E+016 0.19433057E+006 0.30019460E+010 0.22589075E+018 0.26374311E+011 0.93491328E+012 0.38523272E+006 0.10031107E+008 0.24024398E+013 0.57486738E+010 0.64030568E+018 0.94784559E+016 0.53599844E+013 0.35232404E+001 0.21086579E-006 0.16126636E-004 diff --git a/programs/standard_1d/tests/test_1d_rtest.log b/programs/standard_1d/tests/test_1d_rtest.log index 94ff6714..b34479af 100644 --- a/programs/standard_1d/tests/test_1d_rtest.log +++ b/programs/standard_1d/tests/test_1d_rtest.log @@ -1,42 +1,42 @@ it time dt sum(e) sum(M_plus) sum(M_min) sum(e^2) sum(M_plus^2) sum(M_min^2) max(e) max(M_plus) max(M_min) 0 0.00000000E+000 0.10000000E-013 0.58750319E+014 0.58750319E+014 0.00000000E+000 0.57143331E+029 0.57143331E+029 0.00000000E+000 0.10000000E+016 0.10000000E+016 0.00000000E+000 1 0.25000000E-009 0.22357783E-010 0.24605321E+016 0.24960886E+016 0.35556419E+014 0.10020813E+033 0.10294216E+033 0.20897887E+029 0.41874992E+017 0.42480153E+017 0.60517102E+015 -2 0.50000000E-009 0.22357083E-010 0.81768519E+017 0.83124946E+017 0.13564272E+016 0.10997679E+036 0.11337360E+036 0.30290417E+032 0.13834583E+019 0.14058536E+019 0.23013635E+017 +2 0.50000000E-009 0.22357083E-010 0.81768519E+017 0.83124947E+017 0.13564272E+016 0.10997679E+036 0.11337360E+036 0.30290417E+032 0.13834583E+019 0.14058536E+019 0.23013635E+017 3 0.75000000E-009 0.22355625E-010 0.33933991E+018 0.35264765E+018 0.13307744E+017 0.18109818E+037 0.19348238E+037 0.28176525E+034 0.61009449E+019 0.56022946E+019 0.21791853E+018 -4 0.10000000E-008 0.22356845E-010 0.36203246E+018 0.38340708E+018 0.21374616E+017 0.19890523E+037 0.21692667E+037 0.68928792E+034 0.80422383E+019 0.58002475E+019 0.32876642E+018 -5 0.12500000E-008 0.22357441E-010 0.37701803E+018 0.40048270E+018 0.23464664E+017 0.20678393E+037 0.22570068E+037 0.79145238E+034 0.80771559E+019 0.58345150E+019 0.34404305E+018 -6 0.15000000E-008 0.22344894E-010 0.39120200E+018 0.41733824E+018 0.26136240E+017 0.21302421E+037 0.23425518E+037 0.93968357E+034 0.80326764E+019 0.58384408E+019 0.36951146E+018 -7 0.17500000E-008 0.22344722E-010 0.40673954E+018 0.43417590E+018 0.27436365E+017 0.22042060E+037 0.24279513E+037 0.99049558E+034 0.80656301E+019 0.58393323E+019 0.38765320E+018 -8 0.20000000E-008 0.22351656E-010 0.42233874E+018 0.45101018E+018 0.28671439E+017 0.22779279E+037 0.25133315E+037 0.10364777E+035 0.81291235E+019 0.58396897E+019 0.39279409E+018 -9 0.22500000E-008 0.22356594E-010 0.43794455E+018 0.46784706E+018 0.29902507E+017 0.23513877E+037 0.25987257E+037 0.10821877E+035 0.81474860E+019 0.58399377E+019 0.39688740E+018 -10 0.25000000E-008 0.22357709E-010 0.45354133E+018 0.48468197E+018 0.31140643E+017 0.24249769E+037 0.26841136E+037 0.11284534E+035 0.80780501E+019 0.58401578E+019 0.41468741E+018 -11 0.27500000E-008 0.22344893E-010 0.46914434E+018 0.50151800E+018 0.32373656E+017 0.24983958E+037 0.27694931E+037 0.11743836E+035 0.80363719E+019 0.58403687E+019 0.43259285E+018 -12 0.30000000E-008 0.22345059E-010 0.48474216E+018 0.51835325E+018 0.33611089E+017 0.25715459E+037 0.28548702E+037 0.12206640E+035 0.80671710E+019 0.58405760E+019 0.45049062E+018 -13 0.32500000E-008 0.22351621E-010 0.50033789E+018 0.53518653E+018 0.34848639E+017 0.26446750E+037 0.29402405E+037 0.12669870E+035 0.81313039E+019 0.58407815E+019 0.46833978E+018 -14 0.35000000E-008 0.22356800E-010 0.51594022E+018 0.55202432E+018 0.36084102E+017 0.27179508E+037 0.30256494E+037 0.13131834E+035 0.81475081E+019 0.58409858E+019 0.48612658E+018 -15 0.37500000E-008 0.22357712E-010 0.53153522E+018 0.56885905E+018 0.37323838E+017 0.27914669E+037 0.31110328E+037 0.13597314E+035 0.80746373E+019 0.58411892E+019 0.50384486E+018 -16 0.40000000E-008 0.22344880E-010 0.54713655E+018 0.58569519E+018 0.38558639E+017 0.28648269E+037 0.31964170E+037 0.14059536E+035 0.80389902E+019 0.58413918E+019 0.52149391E+018 -17 0.42500000E-008 0.22345402E-010 0.56273108E+018 0.60253090E+018 0.39799818E+017 0.29379572E+037 0.32817996E+037 0.14526653E+035 0.80690461E+019 0.58415936E+019 0.53907269E+018 -18 0.45000000E-008 0.22352006E-010 0.57832565E+018 0.61936294E+018 0.41037297E+017 0.30110609E+037 0.33671614E+037 0.14991462E+035 0.81337912E+019 0.58417947E+019 0.55658125E+018 -19 0.47500000E-008 0.22357010E-010 0.59392355E+018 0.63620104E+018 0.42277490E+017 0.30843133E+037 0.34525752E+037 0.15458438E+035 0.81473601E+019 0.58419950E+019 0.57402025E+018 -20 0.50000000E-008 0.22357725E-010 0.60951585E+018 0.65303540E+018 0.43519554E+017 0.31578255E+037 0.35379554E+037 0.15927202E+035 0.80712701E+019 0.58421945E+019 0.59138936E+018 -21 0.52500000E-008 0.22344819E-010 0.62511389E+018 0.66987163E+018 0.44757738E+017 0.32311352E+037 0.36233474E+037 0.16393432E+035 0.80419739E+019 0.58423933E+019 0.60868957E+018 -22 0.55000000E-008 0.22345799E-010 0.64070464E+018 0.68670736E+018 0.46002716E+017 0.33042503E+037 0.37087324E+037 0.16864845E+035 0.80710395E+019 0.58425913E+019 0.62592032E+018 -23 0.57500000E-008 0.22352351E-010 0.65629654E+018 0.70353810E+018 0.47241555E+017 0.33773249E+037 0.37940891E+037 0.17332184E+035 0.81374740E+019 0.58427886E+019 0.64308235E+018 -24 0.60000000E-008 0.22357222E-010 0.67189027E+018 0.72037675E+018 0.48486480E+017 0.34505497E+037 0.38795065E+037 0.17804074E+035 0.81468674E+019 0.58429851E+019 0.66017583E+018 -25 0.62500000E-008 0.22357742E-010 0.68748295E+018 0.73721113E+018 0.49728188E+017 0.35240833E+037 0.39648843E+037 0.18274057E+035 0.80677424E+019 0.58431809E+019 0.67720098E+018 -26 0.65000000E-008 0.22344738E-010 0.70307327E+018 0.75404520E+018 0.50971934E+017 0.35973061E+037 0.40502692E+037 0.18745851E+035 0.80458347E+019 0.58433759E+019 0.69415836E+018 -27 0.67500000E-008 0.22346222E-010 0.71866188E+018 0.77088122E+018 0.52219347E+017 0.36704124E+037 0.41356542E+037 0.19220511E+035 0.80724443E+019 0.58435702E+019 0.71104778E+018 -28 0.70000000E-008 0.22352707E-010 0.73424921E+018 0.78770978E+018 0.53460566E+017 0.37434466E+037 0.42210030E+037 0.19691061E+035 0.81412057E+019 0.58437638E+019 0.72786987E+018 -29 0.72500000E-008 0.22357483E-010 0.74983910E+018 0.80454832E+018 0.54709219E+017 0.38166561E+037 0.43064199E+037 0.20167108E+035 0.81466249E+019 0.58439567E+019 0.74462462E+018 -30 0.75000000E-008 0.22357747E-010 0.76543227E+018 0.82138347E+018 0.55951191E+017 0.38901990E+037 0.43917939E+037 0.20638690E+035 0.80620905E+019 0.58441488E+019 0.76131247E+018 -31 0.77500000E-008 0.22344640E-010 0.78101595E+018 0.83821568E+018 0.57199736E+017 0.39633477E+037 0.44771767E+037 0.21115373E+035 0.80504746E+019 0.58443401E+019 0.77793356E+018 -32 0.80000000E-008 0.22346537E-010 0.79660682E+018 0.85505211E+018 0.58445293E+017 0.40364730E+037 0.45625567E+037 0.21590075E+035 0.80745354E+019 0.58445308E+019 0.79448808E+018 -33 0.82500000E-008 0.22353067E-010 0.81218680E+018 0.87187678E+018 0.59689980E+017 0.41094288E+037 0.46478794E+037 0.22064598E+035 0.81429293E+019 0.58447207E+019 0.81097664E+018 -34 0.85000000E-008 0.22357747E-010 0.82777781E+018 0.88871553E+018 0.60937717E+017 0.41826946E+037 0.47333029E+037 0.22541349E+035 0.81468201E+019 0.58449100E+019 0.82739899E+018 -35 0.87500000E-008 0.22357749E-010 0.84336852E+018 0.90554961E+018 0.62181090E+017 0.42562220E+037 0.48186608E+037 0.23015318E+035 0.80556146E+019 0.58450985E+019 0.84375595E+018 -36 0.90000000E-008 0.22344554E-010 0.85894777E+018 0.92237928E+018 0.63431509E+017 0.43292937E+037 0.49040308E+037 0.23494738E+035 0.80522615E+019 0.58452863E+019 0.86004732E+018 -37 0.92500000E-008 0.22347129E-010 0.87454047E+018 0.93921723E+018 0.64676768E+017 0.44024669E+037 0.49894193E+037 0.23970526E+035 0.80784461E+019 0.58454733E+019 0.87627354E+018 -38 0.95000000E-008 0.22353456E-010 0.89011009E+018 0.95603687E+018 0.65926782E+017 0.44753109E+037 0.50747101E+037 0.24450301E+035 0.81449627E+019 0.58456597E+019 0.89243502E+018 -39 0.97500000E-008 0.22357755E-010 0.90569854E+018 0.97287464E+018 0.67176098E+017 0.45485706E+037 0.51601222E+037 0.24929507E+035 0.81420591E+019 0.58458454E+019 0.90853161E+018 -40 0.10000000E-007 0.22357752E-010 0.92128312E+018 0.98970804E+018 0.68424923E+017 0.46220723E+037 0.52454714E+037 0.25408736E+035 0.80489050E+019 0.58460303E+019 0.92456414E+018 +4 0.10000000E-008 0.22346798E-010 0.36203256E+018 0.38340718E+018 0.21374620E+017 0.19890522E+037 0.21692666E+037 0.68928812E+034 0.80422202E+019 0.58002475E+019 0.32876644E+018 +5 0.12500000E-008 0.22357158E-010 0.37701937E+018 0.40048405E+018 0.23464681E+017 0.20678531E+037 0.22570129E+037 0.79145191E+034 0.80766681E+019 0.58345150E+019 0.34404257E+018 +6 0.15000000E-008 0.22314628E-010 0.39120498E+018 0.41734134E+018 0.26136357E+017 0.21302622E+037 0.23425723E+037 0.93968831E+034 0.80329757E+019 0.58384407E+019 0.36950829E+018 +7 0.17500000E-008 0.22316425E-010 0.40674527E+018 0.43418182E+018 0.27436544E+017 0.22042551E+037 0.24279928E+037 0.99050108E+034 0.80657714E+019 0.58393322E+019 0.38765281E+018 +8 0.20000000E-008 0.22335325E-010 0.42234655E+018 0.45101826E+018 0.28671704E+017 0.22779856E+037 0.25133898E+037 0.10364867E+035 0.81296734E+019 0.58396896E+019 0.39279354E+018 +9 0.22500000E-008 0.22346635E-010 0.43795505E+018 0.46785791E+018 0.29902861E+017 0.23514729E+037 0.25988074E+037 0.10821999E+035 0.81479031E+019 0.58399376E+019 0.39688774E+018 +10 0.25000000E-008 0.22357157E-010 0.45355410E+018 0.48469517E+018 0.31141072E+017 0.24250810E+037 0.26842138E+037 0.11284685E+035 0.80784250E+019 0.58401577E+019 0.41468778E+018 +11 0.27500000E-008 0.22314741E-010 0.46915885E+018 0.50153298E+018 0.32374138E+017 0.24985069E+037 0.27696084E+037 0.11744008E+035 0.80360463E+019 0.58403686E+019 0.43259323E+018 +12 0.30000000E-008 0.22317054E-010 0.48475922E+018 0.51837085E+018 0.33611635E+017 0.25716792E+037 0.28550052E+037 0.12206827E+035 0.80669181E+019 0.58405759E+019 0.45049101E+018 +13 0.32500000E-008 0.22335461E-010 0.50035720E+018 0.53520647E+018 0.34849270E+017 0.26448217E+037 0.29403933E+037 0.12670090E+035 0.81313126E+019 0.58407813E+019 0.46834019E+018 +14 0.35000000E-008 0.22346999E-010 0.51596194E+018 0.55204674E+018 0.36084809E+017 0.27181162E+037 0.30258219E+037 0.13132077E+035 0.81478707E+019 0.58409857E+019 0.48612700E+018 +15 0.37500000E-008 0.22357402E-010 0.53155921E+018 0.56888385E+018 0.37324639E+017 0.27916488E+037 0.31112246E+037 0.13597599E+035 0.80758897E+019 0.58411891E+019 0.50384530E+018 +16 0.40000000E-008 0.22314797E-010 0.54716225E+018 0.58572175E+018 0.38559502E+017 0.28650214E+037 0.31966225E+037 0.14059845E+035 0.80379733E+019 0.58413917E+019 0.52149435E+018 +17 0.42500000E-008 0.22317708E-010 0.56275922E+018 0.60255996E+018 0.39800747E+017 0.29381679E+037 0.32820232E+037 0.14526978E+035 0.80682977E+019 0.58415935E+019 0.53907314E+018 +18 0.45000000E-008 0.22336091E-010 0.57835652E+018 0.61939483E+018 0.41038314E+017 0.30112940E+037 0.33674059E+037 0.14991811E+035 0.81331969E+019 0.58417946E+019 0.55658172E+018 +19 0.47500000E-008 0.22347387E-010 0.59395647E+018 0.63623505E+018 0.42278581E+017 0.30845612E+037 0.34528384E+037 0.15458816E+035 0.81479300E+019 0.58419949E+019 0.57402072E+018 +20 0.50000000E-008 0.22356112E-010 0.60955109E+018 0.65307181E+018 0.43520713E+017 0.31580826E+037 0.35382371E+037 0.15927601E+035 0.80733178E+019 0.58421944E+019 0.59138984E+018 +21 0.52500000E-008 0.22314832E-010 0.62515119E+018 0.66991017E+018 0.44758988E+017 0.32314138E+037 0.36236440E+037 0.16393868E+035 0.80401798E+019 0.58423932E+019 0.60869005E+018 +22 0.55000000E-008 0.22318470E-010 0.64074454E+018 0.68674858E+018 0.46004034E+017 0.33045439E+037 0.37090486E+037 0.16865293E+035 0.80699203E+019 0.58425912E+019 0.62592081E+018 +23 0.57500000E-008 0.22336698E-010 0.65633988E+018 0.70358286E+018 0.47242987E+017 0.33776472E+037 0.37944299E+037 0.17332664E+035 0.81359599E+019 0.58427885E+019 0.64308285E+018 +24 0.60000000E-008 0.22347786E-010 0.67193557E+018 0.72042358E+018 0.48488006E+017 0.34508820E+037 0.38798652E+037 0.17804591E+035 0.81475707E+019 0.58429850E+019 0.66017634E+018 +25 0.62500000E-008 0.22353213E-010 0.68753086E+018 0.73726062E+018 0.49729768E+017 0.35244239E+037 0.39652648E+037 0.18274585E+035 0.80708793E+019 0.58431808E+019 0.67720150E+018 +26 0.65000000E-008 0.22314836E-010 0.70312403E+018 0.75409766E+018 0.50973634E+017 0.35976781E+037 0.40506682E+037 0.18746423E+035 0.80426905E+019 0.58433758E+019 0.69415889E+018 +27 0.67500000E-008 0.22319279E-010 0.71871508E+018 0.77093628E+018 0.52221201E+017 0.36707993E+037 0.41360740E+037 0.19221152E+035 0.80712543E+019 0.58435701E+019 0.71104833E+018 +28 0.70000000E-008 0.22337353E-010 0.73430679E+018 0.78776934E+018 0.53462544E+017 0.37438685E+037 0.42214514E+037 0.19691731E+035 0.81387610E+019 0.58437637E+019 0.72787043E+018 +29 0.72500000E-008 0.22348256E-010 0.74989921E+018 0.80461052E+018 0.54711314E+017 0.38170843E+037 0.43068898E+037 0.20167820E+035 0.81471723E+019 0.58439565E+019 0.74462519E+018 +30 0.75000000E-008 0.22350306E-010 0.76549458E+018 0.82144797E+018 0.55953382E+017 0.38906457E+037 0.43922909E+037 0.20639451E+035 0.80675485E+019 0.58441486E+019 0.76131304E+018 +31 0.77500000E-008 0.22314848E-010 0.78108136E+018 0.83828346E+018 0.57202103E+017 0.39638225E+037 0.44776884E+037 0.21116226E+035 0.80460713E+019 0.58443400E+019 0.77793417E+018 +32 0.80000000E-008 0.22320034E-010 0.79667464E+018 0.85512240E+018 0.58447765E+017 0.40369614E+037 0.45630916E+037 0.21590965E+035 0.80724809E+019 0.58445307E+019 0.79448869E+018 +33 0.82500000E-008 0.22338047E-010 0.81226013E+018 0.87195266E+018 0.59692533E+017 0.41099795E+037 0.46484557E+037 0.22065469E+035 0.81413874E+019 0.58447206E+019 0.81097725E+018 +34 0.85000000E-008 0.22348778E-010 0.82785330E+018 0.88879393E+018 0.60940629E+017 0.41832255E+037 0.47338955E+037 0.22542455E+035 0.81471563E+019 0.58449099E+019 0.82739967E+018 +35 0.87500000E-008 0.22347148E-010 0.84344703E+018 0.90563117E+018 0.62184139E+017 0.42567734E+037 0.48192862E+037 0.23016481E+035 0.80625306E+019 0.58450984E+019 0.84375662E+018 +36 0.90000000E-008 0.22314850E-010 0.85903074E+018 0.92246542E+018 0.63434679E+017 0.43299161E+037 0.49046846E+037 0.23495928E+035 0.80499783E+019 0.58452861E+019 0.86004799E+018 +37 0.92500000E-008 0.22321131E-010 0.87462456E+018 0.93930456E+018 0.64680007E+017 0.44030719E+037 0.49900865E+037 0.23971767E+035 0.80747460E+019 0.58454732E+019 0.87627421E+018 +38 0.95000000E-008 0.22338786E-010 0.89020154E+018 0.95613172E+018 0.65930185E+017 0.44759909E+037 0.50754280E+037 0.24451551E+035 0.81429047E+019 0.58456596E+019 0.89243570E+018 +39 0.97500000E-008 0.22349157E-010 0.90579369E+018 0.97297339E+018 0.67179699E+017 0.45492551E+037 0.51608725E+037 0.24930846E+035 0.81473399E+019 0.58458453E+019 0.90853230E+018 +40 0.10000000E-007 0.22343535E-010 0.92138133E+018 0.98980996E+018 0.68428631E+017 0.46227621E+037 0.52462542E+037 0.25410129E+035 0.80572950E+019 0.58460302E+019 0.92456484E+018 diff --git a/programs/standard_2d/cyl_multipulse.cfg b/programs/standard_2d/cyl_multipulse.cfg deleted file mode 100644 index 60e2762d..00000000 --- a/programs/standard_2d/cyl_multipulse.cfg +++ /dev/null @@ -1,64 +0,0 @@ - ############################################## - ### Configuration file ### - ############################################## - # fixes%drt_max_field = 1e6 - - # Add electrode with the following settings - use_electrode = T - - # Ensure grid spacing around electrode is less than this value: - refine_electrode_dx = 5.0000E-05 - - # Whether the electrode is grounded or at the applied voltage: - field_electrode_grounded = F - - # Electrode relative start position (for standard rod electrode): - field_rod_r0 = 0.0 0.925 - - # Electrode relative end position (for standard rod electrode): - field_rod_r1 = 0.0 1.0 - - # Electrode radius (in m, for standard rod electrode): - field_rod_radius = 1.0000E-03 - - cylindrical = T - - # The desired endtime in seconds of the simulation: - end_time = 150e-9 - - # The name of the simulation: - output%name = output/cyl_multipulse - - # The length of the (square) domain: - domain_len = 32e-3 32e-3 - - # Whether the domain is periodic (per dimension): - periodic = F F - - # The gas pressure in bar (used for photoionization): - gas%pressure = 0.1000E+01 - - # The applied electric field: - field_given_by = field -.2000E+07 - - field_rise_time = 2e-9 - field_pulse_width = 5e-9 - field_pulse_period = 40e-9 - field_num_pulses = 2 - - # The background ion and electron density in 1/m^3: - background_density = 1e+11 - - # The timestep for writing output: - output%dt = 0.500E-09 - - # The maximum timestep: - dt_max = 0.1000E-09 - - [photoi] - # Whether photoionization is enabled: - enabled = t - - # Input file with transport data: - input_data%file = ../../transport_data/td_air_siglo_swarm.txt - input_data%old_style = t diff --git a/programs/standard_2d/streamer_2d_electrode.cfg b/programs/standard_2d/streamer_2d_electrode.cfg index 238a3b71..73e456b7 100644 --- a/programs/standard_2d/streamer_2d_electrode.cfg +++ b/programs/standard_2d/streamer_2d_electrode.cfg @@ -2,26 +2,30 @@ ### Configuration file ### ############################################## +[datfile] + # Write binary output files every N outputs: + per_outputs = 10 + + # Write binary output files (to resume later): + write = T # Add electrode with the following settings use_electrode = T # Ensure grid spacing around electrode is less than this value: refine_electrode_dx = 5.0000E-05 + electrode_derefine_factor = 2 # Whether the electrode is grounded or at the applied voltage: - field_electrode_grounded = T + field_electrode_grounded = f # Electrode relative start position (for standard rod electrode): - field_rod_r0 = 5.0000E-01 0.0000E+00 + field_rod_r0 = 5.0000E-01 0.90 # Electrode relative end position (for standard rod electrode): - field_rod_r1 = 5.0000E-01 1.5000E-01 + field_rod_r1 = 5.0000E-01 1.0 # Electrode radius (in m, for standard rod electrode): - field_rod_radius = 1.0000E-03 - - # The desired endtime in seconds of the simulation: - end_time = 17.5e-9 + field_rod_radius = 5.0000E-04 # The name of the simulation: output%name = output/streamer_2d_electrode @@ -35,29 +39,66 @@ # Whether the domain is periodic (per dimension): periodic = F F - gas%components = N2 O2 - gas%fractions = 0.8 0.2 +[fixes] + # Enable flux limiting, but prevent field from exceeding this value: + drt_max_field = 1.0000+100 + + # Use source factor to prevent unphysical effects due to diffusion: + source_factor = 'none' + + # Minimal density for including electron sources: + source_min_density = -1.0000E+10 + + # Whether to write the source factor to the output: + write_source_factor = F + +[gas] + # Gas component names: + components = 'N2' 'O2' + + # Whether the gas dynamics are simulated: + dynamics = f + heating_efficiency = 0.3 + + # Gas component fractions: + fractions = 8.000E-01 2.0000E-01 + + # Gas mean molecular weight (kg), for gas dynamics: + molecular_weight = 4.7824E-26 + + # The gas pressure (bar): + pressure = 1.0 + + # The desired endtime in seconds of the simulation: + end_time = 2060.0e-9 + + # Specifying the pulse parameters + field_rise_time = 2.5e-9 + + field_pulse_width = 15.0e-9 + + field_num_pulses = 3 - # The gas pressure in bar (used for photoionization): - gas%pressure = 0.1000E+01 + field_pulse_period = 1020e-9 - # The applied electric field: - field_amplitude = 0.2500E+07 + # How the electric field or voltage is specified: + field_given_by = "voltage 70e3" # The background ion and electron density in 1/m^3: background_density = 0.1000E+15 # The timestep for writing output: - output%dt = 0.200E-09 + output%dt = 0.500E-09 # The maximum timestep: dt_max = 0.1000E-09 [photoi] # Whether photoionization is enabled: - enabled = f + enabled = t + species = "O2_plus" # Input file with transport data: - input_data%file = ../../transport_data/td_air_siglo_swarm.txt - input_data%old_style = t + input_data%file = ../../transport_data/air_chemistry_v3.txt + input_data%old_style = f diff --git a/programs/standard_2d/tests/test_2d_neg_electrode_photoi_rtest.log b/programs/standard_2d/tests/test_2d_neg_electrode_photoi_rtest.log index 8b9ce935..ff28062c 100644 --- a/programs/standard_2d/tests/test_2d_neg_electrode_photoi_rtest.log +++ b/programs/standard_2d/tests/test_2d_neg_electrode_photoi_rtest.log @@ -1,12 +1,12 @@ it time dt sum(e) sum(M_plus) sum(M_min) sum(e^2) sum(M_plus^2) sum(M_min^2) max(e) max(M_plus) max(M_min) 0 0.00000000E+000 0.10000000E-013 0.98909080E+011 0.98909080E+011 0.00000000E+000 0.98909080E+022 0.98909080E+022 0.00000000E+000 0.10000000E+012 0.10000000E+012 0.00000000E+000 -1 0.20000000E-009 0.65658637E-011 0.10065770E+012 0.10258765E+012 0.21635190E+010 0.22010001E+023 0.19810487E+023 0.59880444E+019 0.19266350E+014 0.17525920E+014 0.16177503E+012 -2 0.40000000E-009 0.65659886E-011 0.27403830E+012 0.24773854E+012 0.57855837E+010 0.28245459E+027 0.21227849E+027 0.18603136E+023 0.36983436E+016 0.34138719E+016 0.31215748E+014 -3 0.60000000E-009 0.65803407E-011 0.25800352E+014 0.21194436E+014 0.21316193E+012 0.79610706E+031 0.59829930E+031 0.52509073E+027 0.68046471E+018 0.63137113E+018 0.58704430E+016 -4 0.80000000E-009 0.70544799E-011 0.11226387E+016 0.90819930E+015 0.15503732E+014 0.86984464E+034 0.63076346E+034 0.22184331E+031 0.13560222E+020 0.13415523E+020 0.28953955E+018 -5 0.10000000E-008 0.72952562E-011 0.32516891E+016 0.27241483E+016 0.91261690E+014 0.30295720E+035 0.23357997E+035 0.32528661E+032 0.13491106E+020 0.13283993E+020 0.56336448E+018 -6 0.12000000E-008 0.71671482E-011 0.52040597E+016 0.45582727E+016 0.19128410E+015 0.48066284E+035 0.40008722E+035 0.80794944E+032 0.15423326E+020 0.12931512E+020 0.63025675E+018 -7 0.14000000E-008 0.72368927E-011 0.73899916E+016 0.66989879E+016 0.30125534E+015 0.67412843E+035 0.60001295E+035 0.13173494E+033 0.14981959E+020 0.12961364E+020 0.66691022E+018 -8 0.16000000E-008 0.74714669E-011 0.96970416E+016 0.89999569E+016 0.42950496E+015 0.87268003E+035 0.81504844E+035 0.19163597E+033 0.14532882E+020 0.13055845E+020 0.70065907E+018 -9 0.18000000E-008 0.97071614E-011 0.12128766E+017 0.11455784E+017 0.57600116E+015 0.10759561E+036 0.10413444E+036 0.26243903E+033 0.14076902E+020 0.13050128E+020 0.73251184E+018 -10 0.20000000E-008 0.16502481E-010 0.14614176E+017 0.13991483E+017 0.73928767E+015 0.12788617E+036 0.12702494E+036 0.34396632E+033 0.13702605E+020 0.13050588E+020 0.76236991E+018 +1 0.20000000E-009 0.62614951E-011 0.10073605E+012 0.10264278E+012 0.21638686E+010 0.23326798E+023 0.20778841E+023 0.60408361E+019 0.23018870E+014 0.21782080E+014 0.18998538E+012 +2 0.40000000E-009 0.62616301E-011 0.28925142E+012 0.25900941E+012 0.58985629E+010 0.32944285E+027 0.24229808E+027 0.21658915E+023 0.49429220E+016 0.41952181E+016 0.41136385E+014 +3 0.60000000E-009 0.62782267E-011 0.29593338E+014 0.24067080E+014 0.24214480E+012 0.10041869E+032 0.73495049E+031 0.66163277E+027 0.10189549E+019 0.87152579E+018 0.86388795E+016 +4 0.80000000E-009 0.68773704E-011 0.12249446E+016 0.98100795E+015 0.17426811E+014 0.10177144E+035 0.72112779E+034 0.27291670E+031 0.23933638E+020 0.23203082E+020 0.49072880E+018 +5 0.10000000E-008 0.74303643E-011 0.33077885E+016 0.27700869E+016 0.94409678E+014 0.31107973E+035 0.23991613E+035 0.34631607E+032 0.19857619E+020 0.19857619E+020 0.95741740E+018 +6 0.12000000E-008 0.75078038E-011 0.52870711E+016 0.46404524E+016 0.19162628E+015 0.48755788E+035 0.40665565E+035 0.81427417E+032 0.17691847E+020 0.19365334E+020 0.10344058E+019 +7 0.14000000E-008 0.75907378E-011 0.74008751E+016 0.67097187E+016 0.30236839E+015 0.66468901E+035 0.59046431E+035 0.13267247E+033 0.17419950E+020 0.19365683E+020 0.10766356E+019 +8 0.16000000E-008 0.89079520E-011 0.96852447E+016 0.89879977E+016 0.43002723E+015 0.84643124E+035 0.78890249E+035 0.19082652E+033 0.14671465E+020 0.15793093E+020 0.94431053E+018 +9 0.18000000E-008 0.16720464E-010 0.12070192E+017 0.11396749E+017 0.57570872E+015 0.10281706E+036 0.99295347E+035 0.25929854E+033 0.14632447E+020 0.15793243E+020 0.97564897E+018 +10 0.20000000E-008 0.16842757E-010 0.14494002E+017 0.13870145E+017 0.73787169E+015 0.12060384E+036 0.11958077E+036 0.33754375E+033 0.14605432E+020 0.15793344E+020 0.10062269E+019 diff --git a/programs/standard_2d/tests/test_2d_neg_electrode_rtest.log b/programs/standard_2d/tests/test_2d_neg_electrode_rtest.log index 2b96adde..9f0d2852 100644 --- a/programs/standard_2d/tests/test_2d_neg_electrode_rtest.log +++ b/programs/standard_2d/tests/test_2d_neg_electrode_rtest.log @@ -1,12 +1,12 @@ it time dt sum(e) sum(M_plus) sum(M_min) sum(e^2) sum(M_plus^2) sum(M_min^2) max(e) max(M_plus) max(M_min) 0 0.00000000E+000 0.10000000E-013 0.98909080E+014 0.98909080E+014 0.00000000E+000 0.98909080E+028 0.98909080E+028 0.00000000E+000 0.10000000E+015 0.10000000E+015 0.00000000E+000 -1 0.20000000E-009 0.65669434E-011 0.10064891E+015 0.10257916E+015 0.21634268E+013 0.21952809E+029 0.19763563E+029 0.59839704E+025 0.19217821E+017 0.17481130E+017 0.16149110E+015 -2 0.40000000E-009 0.66879250E-011 0.25652460E+015 0.23310061E+015 0.57144847E+013 0.21124767E+033 0.15817093E+033 0.16161264E+029 0.29884037E+019 0.28416476E+019 0.28118963E+017 -3 0.60000000E-009 0.75692753E-011 0.22852649E+016 0.18908864E+016 0.47309096E+014 0.18291251E+035 0.13428892E+035 0.88580956E+031 0.13108084E+020 0.13105553E+020 0.40997990E+018 -4 0.80000000E-009 0.79454423E-011 0.46297410E+016 0.39965593E+016 0.15173414E+015 0.37420646E+035 0.30174616E+035 0.50754601E+032 0.12770417E+020 0.12770417E+020 0.54923303E+018 -5 0.10000000E-008 0.16915733E-010 0.69289078E+016 0.62225364E+016 0.28079527E+015 0.54067748E+035 0.47377208E+035 0.10671016E+033 0.11725157E+020 0.11745225E+020 0.59468971E+018 -6 0.12000000E-008 0.16975800E-010 0.91395308E+016 0.84233355E+016 0.42723675E+015 0.69237178E+035 0.63952844E+035 0.17195860E+033 0.11556102E+020 0.11745250E+020 0.62755815E+018 -7 0.14000000E-008 0.17085290E-010 0.11360392E+017 0.10669198E+017 0.58592541E+015 0.84020374E+035 0.80596528E+035 0.24389071E+033 0.11481301E+020 0.11745266E+020 0.65599350E+018 -8 0.16000000E-008 0.17167932E-010 0.13578201E+017 0.12938939E+017 0.75585757E+015 0.98342904E+035 0.97006481E+035 0.32215666E+033 0.11435262E+020 0.11745274E+020 0.68248028E+018 -9 0.18000000E-008 0.17268533E-010 0.15805051E+017 0.15239929E+017 0.93656804E+015 0.11240881E+036 0.11330862E+036 0.40684569E+033 0.11398668E+020 0.11745278E+020 0.70614252E+018 -10 0.20000000E-008 0.17340900E-010 0.18044479E+017 0.17571826E+017 0.11280157E+016 0.12632414E+036 0.12957390E+036 0.49831409E+033 0.11368617E+020 0.11745280E+020 0.72846560E+018 +1 0.20000000E-009 0.62626265E-011 0.10072698E+015 0.10263403E+015 0.21637755E+013 0.23262297E+029 0.20726207E+029 0.60365473E+025 0.22971527E+017 0.21742365E+017 0.18972405E+015 +2 0.40000000E-009 0.63927510E-011 0.26895632E+015 0.24219186E+015 0.58157701E+013 0.24378311E+033 0.17864553E+033 0.18672034E+029 0.41006400E+019 0.36334280E+019 0.37492606E+017 +3 0.60000000E-009 0.75222969E-011 0.23086062E+016 0.18976491E+016 0.49111066E+014 0.18610482E+035 0.13437161E+035 0.96208530E+031 0.19555069E+020 0.19060685E+020 0.61448082E+018 +4 0.80000000E-009 0.79363090E-011 0.46517324E+016 0.40154003E+016 0.15282485E+015 0.37496330E+035 0.30156249E+035 0.51106124E+032 0.15706661E+020 0.15894930E+020 0.77844320E+018 +5 0.10000000E-008 0.16634565E-010 0.69491631E+016 0.62428086E+016 0.28152798E+015 0.53925914E+035 0.47188823E+035 0.10649777E+033 0.14689008E+020 0.15894989E+020 0.81459970E+018 +6 0.12000000E-008 0.16805447E-010 0.91569711E+016 0.84412851E+016 0.42774733E+015 0.68793182E+035 0.63486611E+035 0.17122787E+033 0.12678545E+020 0.13161613E+020 0.72189171E+018 +7 0.14000000E-008 0.17001236E-010 0.11372236E+017 0.10681364E+017 0.58624899E+015 0.83130202E+035 0.79675727E+035 0.24245423E+033 0.12611998E+020 0.13161614E+020 0.74671183E+018 +8 0.16000000E-008 0.17137364E-010 0.13579605E+017 0.12940312E+017 0.75601708E+015 0.96881643E+035 0.95494647E+035 0.31984373E+033 0.12573400E+020 0.13161614E+020 0.77102462E+018 +9 0.18000000E-008 0.17276249E-010 0.15789602E+017 0.15224043E+017 0.93649876E+015 0.11024265E+036 0.11105736E+036 0.40341999E+033 0.12538046E+020 0.13161614E+020 0.79489614E+018 +10 0.20000000E-008 0.17373493E-010 0.18006649E+017 0.17533240E+017 0.11276944E+016 0.12335525E+036 0.12647479E+036 0.49351146E+033 0.12508851E+020 0.13161614E+020 0.81860363E+018 diff --git a/programs/standard_2d/tests/test_2d_photoi_chem_rtest.log b/programs/standard_2d/tests/test_2d_photoi_chem_rtest.log index c2552b95..798e6d14 100644 --- a/programs/standard_2d/tests/test_2d_photoi_chem_rtest.log +++ b/programs/standard_2d/tests/test_2d_photoi_chem_rtest.log @@ -1,9 +1,9 @@ it time dt sum(e) sum(N2_plus) sum(O2_plus) sum(O2_min) sum(O_min) sum(O3_min) sum(N4_plus) sum(O4_plus) sum(e^2) sum(N2_plus^2) sum(O2_plus^2) sum(O2_min^2) sum(O_min^2) sum(O3_min^2) sum(N4_plus^2) sum(O4_plus^2) max(e) max(N2_plus) max(O2_plus) max(O2_min) max(O_min) max(O3_min) max(N4_plus) max(O4_plus) 0 0.00000000E+000 0.10000000E-013 0.10000000E+012 0.10323405E+016 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.10000000E+023 0.92078383E+033 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.10000000E+012 0.10000001E+019 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 -1 0.10000000E-008 0.18596814E-010 0.12010481E+012 0.33294194E+010 0.60434704E+015 0.64513231E+009 0.98829224E+010 0.43158692E+008 0.32561830E+015 0.10240239E+015 0.28981355E+025 0.68459849E+023 0.31555490E+033 0.37679690E+019 0.29352219E+022 0.20051038E+016 0.91604979E+032 0.90599371E+031 0.30739301E+015 0.48618378E+014 0.58550445E+018 0.29608184E+012 0.91155578E+013 0.86541711E+008 0.31554860E+018 0.99197238E+017 -2 0.20000000E-008 0.18600496E-010 0.29454539E+013 0.31248511E+012 0.65169358E+015 0.71344762E+010 0.14825283E+012 0.16860259E+009 0.98779847E+014 0.28455540E+015 0.77353416E+029 0.88955236E+027 0.36701831E+033 0.27453272E+024 0.15152415E+027 0.30514722E+017 0.84600455E+031 0.69958967E+032 0.55749209E+017 0.57822901E+016 0.65096591E+018 0.99068903E+014 0.24081800E+016 0.81409516E+009 0.11922103E+018 0.27678622E+018 -3 0.30000000E-008 0.18560436E-010 0.68424079E+014 0.45426909E+013 0.58351520E+015 0.25193039E+012 0.46360144E+013 0.39036948E+009 0.60743968E+014 0.45675076E+015 0.41328735E+032 0.15417065E+030 0.30562035E+033 0.54297896E+027 0.19315620E+030 0.56945592E+019 0.10574380E+032 0.18053550E+033 0.11101975E+019 0.67303825E+017 0.10801766E+019 0.43096669E+016 0.81252648E+017 0.58284922E+012 0.52794933E+018 0.49316176E+018 -4 0.40000000E-008 0.17546055E-010 0.34087521E+015 0.13224250E+014 0.63218429E+015 0.21837696E+013 0.35201017E+014 0.10119201E+011 0.14255820E+015 0.62254348E+015 0.68444958E+033 0.22398181E+031 0.57771218E+033 0.30573378E+029 0.80009971E+031 0.13366952E+025 0.13875539E+033 0.34372160E+033 0.40707616E+019 0.46568954E+018 0.32793999E+019 0.25290739E+017 0.39807567E+018 0.25724187E+015 0.27815482E+019 0.10035256E+019 -5 0.50000000E-008 0.66880944E-011 0.11157169E+016 0.41712707E+014 0.97213110E+015 0.77046650E+013 0.11033025E+015 0.60712906E+012 0.41652408E+015 0.83623108E+015 0.84188794E+034 0.74009950E+032 0.31482267E+034 0.27697184E+030 0.51844366E+032 0.42060940E+028 0.24557133E+034 0.68635937E+033 0.21640977E+020 0.43973068E+019 0.10771300E+020 0.72510861E+017 0.77243116E+018 0.14814092E+017 0.15681842E+020 0.22379547E+019 -6 0.60000000E-008 0.60235363E-011 0.32127414E+016 0.97473654E+014 0.20314230E+016 0.25572992E+014 0.20970686E+015 0.53611354E+013 0.11237426E+016 0.12329831E+016 0.64788222E+035 0.47050544E+033 0.19361583E+035 0.28856531E+031 0.12154596E+033 0.20655967E+030 0.14803354E+035 0.18488994E+034 0.45051559E+020 0.11306764E+020 0.22030792E+020 0.26105189E+018 0.97941677E+018 0.74193792E+017 0.29678069E+020 0.49077265E+019 -7 0.70000000E-008 0.59652931E-011 0.68977368E+016 0.14317908E+015 0.40886284E+016 0.73414841E+014 0.33248647E+015 0.17327595E+014 0.20570522E+016 0.20643457E+016 0.19068329E+036 0.74072339E+033 0.63489550E+035 0.20349872E+032 0.21031536E+033 0.13163089E+031 0.29627723E+035 0.68868550E+034 0.48644774E+020 0.12009402E+020 0.30409718E+020 0.59209015E+018 0.11695602E+019 0.14121527E+018 0.30502758E+020 0.97588907E+019 +1 0.10000000E-008 0.18467886E-010 0.12010618E+012 0.33296061E+010 0.60434736E+015 0.64513461E+009 0.98829807E+010 0.43158690E+008 0.32561805E+015 0.10240233E+015 0.28985439E+025 0.68468198E+023 0.31555523E+033 0.37686321E+019 0.29357288E+022 0.20051035E+016 0.91604838E+032 0.90599254E+031 0.30742706E+015 0.48623627E+014 0.58550475E+018 0.29609268E+012 0.91169711E+013 0.86541869E+008 0.31554835E+018 0.99197174E+017 +2 0.20000000E-008 0.18471773E-010 0.29456807E+013 0.31251039E+012 0.65169388E+015 0.71351003E+010 0.14826609E+012 0.16860262E+009 0.98779794E+014 0.28455537E+015 0.77365212E+029 0.88968354E+027 0.36701867E+033 0.27458905E+024 0.15155250E+027 0.30514738E+017 0.84600401E+031 0.69958953E+032 0.55755935E+017 0.57829601E+016 0.65096738E+018 0.99077789E+014 0.24083549E+016 0.81430973E+009 0.11922247E+018 0.27678630E+018 +3 0.30000000E-008 0.18427054E-010 0.68432401E+014 0.45432862E+013 0.58351914E+015 0.25195974E+012 0.46365746E+013 0.39037483E+009 0.60747963E+014 0.45675115E+015 0.41336607E+032 0.15420223E+030 0.30562625E+033 0.54308871E+027 0.19319500E+030 0.56966192E+019 0.10576319E+032 0.18053584E+033 0.11102791E+019 0.67309464E+017 0.10802271E+019 0.43100697E+016 0.81260578E+017 0.58294767E+012 0.52799566E+018 0.49316672E+018 +4 0.40000000E-008 0.17350159E-010 0.34094661E+015 0.13226636E+014 0.63222343E+015 0.21841089E+013 0.35207388E+014 0.10121322E+011 0.14258943E+015 0.62254883E+015 0.68470531E+033 0.22409133E+031 0.57783006E+033 0.30580448E+029 0.80032272E+031 0.13371509E+025 0.13882103E+033 0.34372902E+033 0.40713728E+019 0.46571556E+018 0.32798133E+019 0.25292593E+017 0.39811267E+018 0.25727111E+015 0.27820541E+019 0.10035633E+019 +5 0.50000000E-008 0.66164805E-011 0.11157667E+016 0.41711463E+014 0.97217400E+015 0.77056207E+013 0.11033695E+015 0.60741894E+012 0.41652063E+015 0.83625059E+015 0.84207690E+034 0.74047683E+032 0.31488707E+034 0.27703609E+030 0.51848821E+032 0.42097654E+028 0.24563794E+034 0.68640462E+033 0.21649470E+020 0.44005865E+019 0.10776190E+020 0.72519406E+017 0.77240627E+018 0.14819194E+017 0.15687495E+020 0.22380856E+019 +6 0.60000000E-008 0.59388540E-011 0.32131861E+016 0.97503522E+014 0.20315862E+016 0.25575431E+014 0.20970094E+015 0.53617829E+013 0.11239541E+016 0.12330203E+016 0.64827973E+035 0.47098461E+033 0.19370473E+035 0.28867064E+031 0.12154295E+033 0.20660544E+030 0.14814175E+035 0.18491850E+034 0.45070910E+020 0.11314943E+020 0.22036402E+020 0.26114314E+018 0.97935543E+018 0.74191469E+017 0.29693217E+020 0.49093536E+019 +7 0.70000000E-008 0.58961659E-011 0.68991268E+016 0.14320356E+015 0.40893724E+016 0.73426902E+014 0.33249263E+015 0.17327712E+014 0.20575307E+016 0.20645071E+016 0.19078536E+036 0.74098732E+033 0.63524435E+035 0.20361037E+032 0.21032410E+033 0.13163605E+031 0.29640688E+035 0.68893389E+034 0.48650906E+020 0.12007039E+020 0.30421566E+020 0.59238367E+018 0.11695150E+019 0.14123659E+018 0.30511502E+020 0.97627805E+019 diff --git a/programs/standard_2d/tests/test_2d_photoi_rtest.log b/programs/standard_2d/tests/test_2d_photoi_rtest.log index 1a7a08f4..78fb713d 100644 --- a/programs/standard_2d/tests/test_2d_photoi_rtest.log +++ b/programs/standard_2d/tests/test_2d_photoi_rtest.log @@ -1,9 +1,9 @@ it time dt sum(e) sum(M_plus) sum(M_min) sum(e^2) sum(M_plus^2) sum(M_min^2) max(e) max(M_plus) max(M_min) 0 0.00000000E+000 0.10000000E-013 0.10000000E+012 0.10323405E+016 0.00000000E+000 0.10000000E+023 0.92078383E+033 0.00000000E+000 0.10000000E+012 0.10000001E+019 0.00000000E+000 -1 0.10000000E-008 0.19014190E-010 0.11533161E+012 0.10323668E+016 0.11101218E+011 0.18265414E+025 0.92081059E+033 0.21752557E+022 0.24079808E+015 0.10002321E+019 0.76325477E+013 -2 0.20000000E-008 0.19016900E-010 0.21277209E+013 0.10344889E+016 0.12083888E+012 0.38653851E+029 0.92483296E+033 0.86557812E+026 0.39531963E+017 0.10376000E+019 0.18252608E+016 -3 0.30000000E-008 0.18999052E-010 0.48847343E+014 0.10845853E+016 0.34977266E+013 0.21788450E+032 0.10453024E+034 0.11008925E+030 0.84025209E+018 0.18597896E+019 0.62828816E+017 -4 0.40000000E-008 0.18303885E-010 0.26048487E+015 0.13218196E+016 0.29094577E+014 0.42197432E+033 0.20333418E+034 0.58825471E+031 0.29663147E+019 0.53359871E+019 0.36440926E+018 -5 0.50000000E-008 0.71558814E-011 0.82009829E+015 0.19534706E+016 0.10113231E+015 0.42243571E+034 0.87679797E+034 0.48968172E+032 0.14769052E+020 0.20805946E+020 0.81913011E+018 -6 0.60000000E-008 0.63231829E-011 0.23927711E+016 0.36409317E+016 0.21592065E+015 0.39675961E+035 0.51380462E+035 0.14897047E+033 0.39944197E+020 0.43344490E+020 0.11213441E+019 -7 0.70000000E-008 0.61561366E-011 0.54585726E+016 0.68733493E+016 0.38253690E+015 0.14064735E+036 0.16185536E+036 0.32481159E+033 0.47272761E+020 0.48355981E+020 0.13843279E+019 +1 0.10000000E-008 0.18882526E-010 0.11533309E+012 0.10323668E+016 0.11101283E+011 0.18268846E+025 0.92081060E+033 0.21757328E+022 0.24078462E+015 0.10002321E+019 0.76337264E+013 +2 0.20000000E-008 0.18885403E-010 0.21278379E+013 0.10344890E+016 0.12084578E+012 0.38657770E+029 0.92483320E+033 0.86569227E+026 0.39529435E+017 0.10376012E+019 0.18253694E+016 +3 0.30000000E-008 0.18866985E-010 0.48848645E+014 0.10845867E+016 0.34978587E+013 0.21789457E+032 0.10453064E+034 0.11009696E+030 0.84026444E+018 0.18598106E+019 0.62829612E+017 +4 0.40000000E-008 0.18117735E-010 0.26049015E+015 0.13218255E+016 0.29095245E+014 0.42198771E+033 0.20333730E+034 0.58827687E+031 0.29663120E+019 0.53360726E+019 0.36441427E+018 +5 0.50000000E-008 0.70859736E-011 0.82021212E+015 0.19535925E+016 0.10114036E+015 0.42264688E+034 0.87707419E+034 0.48975482E+032 0.14784151E+020 0.20820425E+020 0.81916012E+018 +6 0.60000000E-008 0.62339088E-011 0.23931579E+016 0.36413327E+016 0.21593489E+015 0.39697986E+035 0.51405357E+035 0.14899390E+033 0.39965801E+020 0.43357195E+020 0.11213843E+019 +7 0.70000000E-008 0.60767418E-011 0.54595845E+016 0.68743905E+016 0.38256618E+015 0.14071125E+036 0.16192364E+036 0.32487010E+033 0.47282686E+020 0.48363050E+020 0.13846446E+019 diff --git a/programs/standard_2d/tests/test_2d_pos_electrode_photoi_rtest.log b/programs/standard_2d/tests/test_2d_pos_electrode_photoi_rtest.log index f4fe2602..cdd81b3e 100644 --- a/programs/standard_2d/tests/test_2d_pos_electrode_photoi_rtest.log +++ b/programs/standard_2d/tests/test_2d_pos_electrode_photoi_rtest.log @@ -1,12 +1,12 @@ it time dt sum(e) sum(M_plus) sum(M_min) sum(e^2) sum(M_plus^2) sum(M_min^2) max(e) max(M_plus) max(M_min) 0 0.00000000E+000 0.10000000E-013 0.98909080E+011 0.98909080E+011 0.00000000E+000 0.98909080E+022 0.98909080E+022 0.00000000E+000 0.10000000E+012 0.10000000E+012 0.00000000E+000 -1 0.20000000E-009 0.65658631E-011 0.99780780E+011 0.10206130E+012 0.21573363E+010 0.12330925E+023 0.13447237E+023 0.53513527E+019 0.75220307E+013 0.86095220E+013 0.78993993E+011 -2 0.40000000E-009 0.65658773E-011 0.11338790E+012 0.12208835E+012 0.45178745E+010 0.14093903E+025 0.23810881E+025 0.25272913E+021 0.29384605E+015 0.39942987E+015 0.37073366E+013 -3 0.60000000E-009 0.65661010E-011 0.28513015E+012 0.38183961E+012 0.93431300E+010 0.42856171E+027 0.93015121E+027 0.82938716E+023 0.64557015E+016 0.10320153E+017 0.95845790E+014 -4 0.80000000E-009 0.65685117E-011 0.20023056E+013 0.32746521E+013 0.39653346E+011 0.64200437E+029 0.17340873E+030 0.15137149E+026 0.89350209E+017 0.16524641E+018 0.15426786E+016 -5 0.10000000E-008 0.65878253E-011 0.15146904E+014 0.27727164E+014 0.27869916E+012 0.49095964E+031 0.16025967E+032 0.14897356E+028 0.82086039E+018 0.17065794E+019 0.16826514E+017 -6 0.12000000E-008 0.66969976E-011 0.79414075E+014 0.15674242E+015 0.17528644E+013 0.12723079E+033 0.47645724E+033 0.67897166E+029 0.35984624E+019 0.79147765E+019 0.10825291E+018 -7 0.14000000E-008 0.68277809E-011 0.23799454E+015 0.46689293E+015 0.73964558E+013 0.79937985E+033 0.28134490E+034 0.99343573E+030 0.64296402E+019 0.11881932E+020 0.31573791E+018 -8 0.16000000E-008 0.71064730E-011 0.51785163E+015 0.91391003E+015 0.20273240E+014 0.25630622E+034 0.68625867E+034 0.51017692E+031 0.87406196E+019 0.12090873E+020 0.46749267E+018 -9 0.18000000E-008 0.73764392E-011 0.97572405E+015 0.15160637E+016 0.41090439E+014 0.64915532E+034 0.13036187E+035 0.13724334E+032 0.10165946E+020 0.13510278E+020 0.53072943E+018 -10 0.20000000E-008 0.72082966E-011 0.16509136E+016 0.23182748E+016 0.70310599E+014 0.13694423E+035 0.22600082E+035 0.27562116E+032 0.12981548E+020 0.16385574E+020 0.59223976E+018 +1 0.20000000E-009 0.62614944E-011 0.99784929E+011 0.10206551E+012 0.21573410E+010 0.12369964E+023 0.13487284E+023 0.53517381E+019 0.75325776E+013 0.86190684E+013 0.79081532E+011 +2 0.40000000E-009 0.62615088E-011 0.11334058E+012 0.12204529E+012 0.45180020E+010 0.13894629E+025 0.23632907E+025 0.25313269E+021 0.29412736E+015 0.39993096E+015 0.37119736E+013 +3 0.60000000E-009 0.62617364E-011 0.28427866E+012 0.38107447E+012 0.93451797E+010 0.42113209E+027 0.92376484E+027 0.83091581E+023 0.64614873E+016 0.10332211E+017 0.95957751E+014 +4 0.80000000E-009 0.62642042E-011 0.19938437E+013 0.32672400E+013 0.39676495E+011 0.63117377E+029 0.17252629E+030 0.15163712E+026 0.89425028E+017 0.16542072E+018 0.15443123E+016 +5 0.10000000E-008 0.62840222E-011 0.15080610E+014 0.27671157E+014 0.27890659E+012 0.48347520E+031 0.15970007E+032 0.14922701E+028 0.82146276E+018 0.17080831E+019 0.16842168E+017 +6 0.12000000E-008 0.64038400E-011 0.79273722E+014 0.15664882E+015 0.17541133E+013 0.12639574E+033 0.47602164E+033 0.67993562E+029 0.36001929E+019 0.79182538E+019 0.10832322E+018 +7 0.14000000E-008 0.66164476E-011 0.23811474E+015 0.46709252E+015 0.74006615E+013 0.79998570E+033 0.28152294E+034 0.99441135E+030 0.64309919E+019 0.11882996E+020 0.31583989E+018 +8 0.16000000E-008 0.68959635E-011 0.51154688E+015 0.90883982E+015 0.20336126E+014 0.25386856E+034 0.68559972E+034 0.51247338E+031 0.87414585E+019 0.12091536E+020 0.46752741E+018 +9 0.18000000E-008 0.73541606E-011 0.97626660E+015 0.15166925E+016 0.41104927E+014 0.64973573E+034 0.13043524E+035 0.13729974E+032 0.10166001E+020 0.13511077E+020 0.53071308E+018 +10 0.20000000E-008 0.71820295E-011 0.16514984E+016 0.23189585E+016 0.70334864E+014 0.13700695E+035 0.22608273E+035 0.27573531E+032 0.12984215E+020 0.16387707E+020 0.59230568E+018 diff --git a/programs/standard_2d/tests/test_2d_pos_electrode_rtest.log b/programs/standard_2d/tests/test_2d_pos_electrode_rtest.log index 8c511443..b2cca2c1 100644 --- a/programs/standard_2d/tests/test_2d_pos_electrode_rtest.log +++ b/programs/standard_2d/tests/test_2d_pos_electrode_rtest.log @@ -1,12 +1,12 @@ it time dt sum(e) sum(M_plus) sum(M_min) sum(e^2) sum(M_plus^2) sum(M_min^2) max(e) max(M_plus) max(M_min) 0 0.00000000E+000 0.10000000E-013 0.98909080E+014 0.98909080E+014 0.00000000E+000 0.98909080E+028 0.98909080E+028 0.00000000E+000 0.10000000E+015 0.10000000E+015 0.00000000E+000 -1 0.20000000E-009 0.65663397E-011 0.99773967E+014 0.10205418E+015 0.21572551E+013 0.12316342E+029 0.13429674E+029 0.53493265E+025 0.75027189E+016 0.85886520E+016 0.78843768E+014 -2 0.40000000E-009 0.65804537E-011 0.11316783E+015 0.12180410E+015 0.45158474E+013 0.13552277E+031 0.22884357E+031 0.24788933E+027 0.28531118E+018 0.38756935E+018 0.36484011E+016 -3 0.60000000E-009 0.67554804E-011 0.25144149E+015 0.32907542E+015 0.91063609E+013 0.22838464E+033 0.48260510E+033 0.62105421E+029 0.38429550E+019 0.59817862E+019 0.73593437E+017 -4 0.80000000E-009 0.72699054E-011 0.73004860E+015 0.10585140E+016 0.25732401E+014 0.26169570E+034 0.56141568E+034 0.23492722E+031 0.82963970E+019 0.11538234E+020 0.33073175E+018 -5 0.10000000E-008 0.76702792E-011 0.15086649E+016 0.21067004E+016 0.63038258E+014 0.81172941E+034 0.14535059E+035 0.13958473E+032 0.97437622E+019 0.11597669E+020 0.49546497E+018 -6 0.12000000E-008 0.78332440E-011 0.24572593E+016 0.32760377E+016 0.11691441E+015 0.15967877E+035 0.25132605E+035 0.36046158E+032 0.10516634E+020 0.12070142E+020 0.55868559E+018 -7 0.14000000E-008 0.83621039E-011 0.36252712E+016 0.46327928E+016 0.18223747E+015 0.26798200E+035 0.38406781E+035 0.66457744E+032 0.11314543E+020 0.13171145E+020 0.60454997E+018 -8 0.16000000E-008 0.91951258E-011 0.49395750E+016 0.61252648E+016 0.25581957E+015 0.40108571E+035 0.54178347E+035 0.10331280E+033 0.12464927E+020 0.14319732E+020 0.64053376E+018 -9 0.18000000E-008 0.74294651E-011 0.63512675E+016 0.77118819E+016 0.33950485E+015 0.55536201E+035 0.72258142E+035 0.14795038E+033 0.13684552E+020 0.15515480E+020 0.67132388E+018 -10 0.20000000E-008 0.73362364E-011 0.79211854E+016 0.94555788E+016 0.43093445E+015 0.73782970E+035 0.93314100E+035 0.19937780E+033 0.14870047E+020 0.16669244E+020 0.69888643E+018 +1 0.20000000E-009 0.62619735E-011 0.99778052E+014 0.10205832E+015 0.21572596E+013 0.12354962E+029 0.13469262E+029 0.53496959E+025 0.75128753E+016 0.85979024E+016 0.78929713E+014 +2 0.40000000E-009 0.62761904E-011 0.11312143E+015 0.12176160E+015 0.45159605E+013 0.13364330E+031 0.22715363E+031 0.24825624E+027 0.28556427E+018 0.38802274E+018 0.36527226E+016 +3 0.60000000E-009 0.64855276E-011 0.25106962E+015 0.32874674E+015 0.91078539E+013 0.22635240E+033 0.48089490E+033 0.62194407E+029 0.38451191E+019 0.59852769E+019 0.73651950E+017 +4 0.80000000E-009 0.70610507E-011 0.73029218E+015 0.10588441E+016 0.25737940E+014 0.26188730E+034 0.56173164E+034 0.23508390E+031 0.82967066E+019 0.11539715E+020 0.33081791E+018 +5 0.10000000E-008 0.76504698E-011 0.15086094E+016 0.21067007E+016 0.63048123E+014 0.81164019E+034 0.14535083E+035 0.13963704E+032 0.97461130E+019 0.11598193E+020 0.49566363E+018 +6 0.12000000E-008 0.77872879E-011 0.24573973E+016 0.32762535E+016 0.11692300E+015 0.15969482E+035 0.25135598E+035 0.36051812E+032 0.10515875E+020 0.12071925E+020 0.55872965E+018 +7 0.14000000E-008 0.83397721E-011 0.36251823E+016 0.46327695E+016 0.18224914E+015 0.26797780E+035 0.38407377E+035 0.66465769E+032 0.11315521E+020 0.13171969E+020 0.60452455E+018 +8 0.16000000E-008 0.91520603E-011 0.49399269E+016 0.61256215E+016 0.25582877E+015 0.40114492E+035 0.54184601E+035 0.10331980E+033 0.12465945E+020 0.14320754E+020 0.64051645E+018 +9 0.18000000E-008 0.74022380E-011 0.63514376E+016 0.77120678E+016 0.33951585E+015 0.55540654E+035 0.72263199E+035 0.14795962E+033 0.13685538E+020 0.15516941E+020 0.67134067E+018 +10 0.20000000E-008 0.73089424E-011 0.79213693E+016 0.94557777E+016 0.43094490E+015 0.73788162E+035 0.93320060E+035 0.19938845E+033 0.14871807E+020 0.16671915E+020 0.69887225E+018 diff --git a/programs/standard_2d/tests/test_2d_rtest.log b/programs/standard_2d/tests/test_2d_rtest.log index d556083d..e0e9e597 100644 --- a/programs/standard_2d/tests/test_2d_rtest.log +++ b/programs/standard_2d/tests/test_2d_rtest.log @@ -1,9 +1,9 @@ it time dt sum(e) sum(M_plus) sum(M_min) sum(e^2) sum(M_plus^2) sum(M_min^2) max(e) max(M_plus) max(M_min) 0 0.00000000E+000 0.10000000E-013 0.10000000E+015 0.11322405E+016 0.00000000E+000 0.10000000E+029 0.92100008E+033 0.00000000E+000 0.10000000E+015 0.10001000E+019 0.00000000E+000 -1 0.10000000E-008 0.19065589E-010 0.11477885E+015 0.11580338E+016 0.11089021E+014 0.16811477E+031 0.94846745E+033 0.20821710E+028 0.22724934E+018 0.12191397E+019 0.73861281E+016 -2 0.20000000E-008 0.18874438E-010 0.57909944E+015 0.16699877E+016 0.58804293E+014 0.10216965E+034 0.29479906E+034 0.70835341E+031 0.38168670E+019 0.62308463E+019 0.34562971E+018 -3 0.30000000E-008 0.17405825E-010 0.14721598E+016 0.26968885E+016 0.19273333E+015 0.59426323E+034 0.10590227E+035 0.71974502E+032 0.10792559E+020 0.13729408E+020 0.74124657E+018 -4 0.40000000E-008 0.73103557E-011 0.28831752E+016 0.42823349E+016 0.36725927E+015 0.21254311E+035 0.29936637E+035 0.19185481E+033 0.18024679E+020 0.20710029E+020 0.91889490E+018 -5 0.50000000E-008 0.69134566E-011 0.50733402E+016 0.66760580E+016 0.57091811E+015 0.56999577E+035 0.71600861E+035 0.35859392E+033 0.25067599E+020 0.27080987E+020 0.10758364E+019 -6 0.60000000E-008 0.67112872E-011 0.81738099E+016 0.10017890E+017 0.81238648E+015 0.11946683E+036 0.14194757E+036 0.58594254E+033 0.28947882E+020 0.30295750E+020 0.12317861E+019 -7 0.70000000E-008 0.66284198E-011 0.12142298E+017 0.14279505E+017 0.11056255E+016 0.20499392E+036 0.23765532E+036 0.89935038E+033 0.30268231E+020 0.31303849E+020 0.14455809E+019 +1 0.10000000E-008 0.18939160E-010 0.11478026E+015 0.11580353E+016 0.11089083E+014 0.16814510E+031 0.94847045E+033 0.20826142E+028 0.22724454E+018 0.12191472E+019 0.73872685E+016 +2 0.20000000E-008 0.18694332E-010 0.57911176E+015 0.16700016E+016 0.58805841E+014 0.10217393E+034 0.29480771E+034 0.70840335E+031 0.38173679E+019 0.62308516E+019 0.34563464E+018 +3 0.30000000E-008 0.17131798E-010 0.14721688E+016 0.26969016E+016 0.19273749E+015 0.59426843E+034 0.10590273E+035 0.71977489E+032 0.10793276E+020 0.13728744E+020 0.74124793E+018 +4 0.40000000E-008 0.72497824E-011 0.28833241E+016 0.42824983E+016 0.36727374E+015 0.21258435E+035 0.29941601E+035 0.19187087E+033 0.18037216E+020 0.20725620E+020 0.91890588E+018 +5 0.50000000E-008 0.68521393E-011 0.50738358E+016 0.66765701E+016 0.57093465E+015 0.57021976E+035 0.71625956E+035 0.35862551E+033 0.25078168E+020 0.27091523E+020 0.10758597E+019 +6 0.60000000E-008 0.66542902E-011 0.81748661E+016 0.10018970E+017 0.81241106E+015 0.11951487E+036 0.14199985E+036 0.58599976E+033 0.28952672E+020 0.30298346E+020 0.12319150E+019 +7 0.70000000E-008 0.65736711E-011 0.12143910E+017 0.14281166E+017 0.11056749E+016 0.20506585E+036 0.23773333E+036 0.89946528E+033 0.30271041E+020 0.31306897E+020 0.14461372E+019 diff --git a/programs/standard_2d/tests/test_cyl_2pulse_rtest.log b/programs/standard_2d/tests/test_cyl_2pulse_rtest.log index 3f5d0de7..d64d3124 100644 --- a/programs/standard_2d/tests/test_cyl_2pulse_rtest.log +++ b/programs/standard_2d/tests/test_cyl_2pulse_rtest.log @@ -1,12 +1,12 @@ it time dt sum(e) sum(N2_plus) sum(O2_plus) sum(O2_min) sum(O_min) sum(O3_min) sum(N4_plus) sum(O4_plus) sum(e^2) sum(N2_plus^2) sum(O2_plus^2) sum(O2_min^2) sum(O_min^2) sum(O3_min^2) sum(N4_plus^2) sum(O4_plus^2) max(e) max(N2_plus) max(O2_plus) max(O2_min) max(O_min) max(O3_min) max(N4_plus) max(O4_plus) 0 0.00000000E+000 0.10000000E-013 0.99556065E+011 0.99556065E+011 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.99556065E+022 0.99556065E+022 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.10000000E+012 0.10000000E+012 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 -1 0.10000000E-008 0.67983747E-011 0.10042772E+012 0.18486490E+010 0.60536671E+011 0.96528618E+009 0.22987873E+010 0.21411828E+008 0.34534228E+011 0.99719381E+010 0.25599732E+024 0.11612284E+024 0.78730476E+023 0.10484901E+019 0.12232266E+021 0.46750347E+015 0.21000602E+024 0.16440110E+021 0.30926617E+015 0.29489843E+015 0.20232398E+015 0.19867312E+012 0.70971718E+013 0.38682174E+008 0.34514760E+015 0.52472901E+013 -2 0.20000000E-008 0.68039559E-011 0.24071223E+012 0.96100769E+011 0.30105426E+012 0.21959319E+010 0.13109028E+011 0.14748553E+009 0.31767225E+012 0.45047790E+011 0.12680732E+028 0.77891631E+027 0.40040993E+028 0.13437331E+023 0.30991468E+025 0.22170086E+017 0.74517150E+028 0.18481789E+026 0.31497873E+017 0.31462184E+017 0.72860969E+017 0.12189444E+015 0.19216562E+016 0.22559422E+009 0.10211665E+018 0.47203857E+016 -3 0.30000000E-008 0.68527410E-011 0.94142579E+012 0.56139908E+012 0.26866213E+013 0.95929701E+010 0.75093991E+011 0.37900080E+009 0.25949079E+013 0.36767654E+012 0.53726154E+029 0.32251181E+029 0.65235332E+030 0.38647837E+025 0.34452483E+027 0.14636608E+018 0.67360313E+030 0.90711538E+028 0.21751241E+018 0.21616487E+018 0.10021328E+019 0.23264825E+016 0.22380304E+017 0.53128242E+009 0.10242667E+019 0.11650471E+018 -4 0.40000000E-008 0.38600452E-010 0.52015043E+012 0.21061098E+012 0.51370245E+013 0.19458878E+011 0.12522562E+012 0.24249924E+010 0.24727062E+013 0.12120468E+013 0.53290208E+028 0.27666890E+028 0.10345250E+031 0.89218424E+025 0.45512663E+027 0.73210407E+023 0.25641892E+030 0.50963807E+029 0.24048966E+017 0.23830769E+017 0.37584471E+018 0.10780133E+016 0.76910424E+016 0.10140991E+015 0.19216124E+018 0.82335666E+017 -5 0.50036118E-008 0.38600453E-010 0.44118747E+012 0.17594763E+012 0.33886229E+013 0.25925660E+011 0.75902809E+011 0.12330715E+011 0.46711580E+012 0.17610959E+013 0.11311073E+028 0.59870253E+027 0.17976214E+030 0.36849508E+025 0.62225327E+026 0.14176878E+025 0.36098263E+028 0.44560603E+029 0.47817959E+016 0.47817959E+016 0.83572892E+017 0.34909602E+015 0.16261226E+016 0.24576371E+015 0.11784687E+017 0.40760723E+017 -6 0.60000000E-008 0.10000000E-013 0.33523933E+012 0.91241062E+011 0.21294725E+013 0.33410165E+011 0.53077284E+011 0.17204524E+011 0.10903966E+012 0.19865428E+013 0.84797511E+027 0.31841791E+027 0.85396545E+029 0.56427236E+025 0.33661002E+026 0.31850907E+025 0.22201953E+027 0.69144315E+029 0.62609989E+016 0.56975705E+016 0.70239099E+017 0.57541816E+015 0.14320029E+016 0.44079954E+015 0.35411306E+016 0.62337985E+017 -7 0.70000000E-008 0.72338139E-011 0.11584517E+013 0.73793141E+012 0.35344065E+013 0.40593275E+011 0.11296746E+012 0.17459671E+011 0.28211975E+013 0.24983696E+013 0.14575263E+030 0.95906371E+029 0.60809924E+030 0.11490218E+026 0.60316379E+027 0.33685348E+025 0.11925242E+031 0.11755583E+030 0.58428768E+018 0.58428768E+018 0.11932211E+019 0.18617080E+016 0.41549490E+017 0.45840737E+015 0.19387968E+019 0.93933949E+017 -8 0.80000000E-008 0.77145373E-011 0.62185836E+013 0.34758548E+013 0.17813002E+014 0.90737928E+011 0.52045205E+012 0.17786930E+011 0.15204540E+014 0.49539650E+013 0.23787598E+031 0.10788266E+031 0.24325692E+032 0.26066277E+027 0.19398661E+029 0.33683223E+025 0.17750862E+032 0.73880768E+030 0.11724920E+019 0.11617906E+019 0.51555499E+019 0.19157011E+017 0.16033171E+018 0.45840097E+015 0.32648417E+019 0.92242002E+018 -9 0.90000000E-008 0.77053596E-011 0.22299424E+014 0.88151674E+013 0.60964647E+014 0.29738572E+012 0.21641286E+013 0.18508127E+011 0.39699783E+014 0.15233303E+014 0.32637489E+032 0.10572520E+032 0.18494996E+033 0.40232370E+028 0.30799852E+030 0.35716583E+025 0.63866449E+032 0.10829211E+032 0.44487148E+019 0.44472855E+019 0.72955338E+019 0.39861761E+017 0.41005276E+018 0.94675969E+015 0.40003350E+019 0.23228974E+019 -10 0.10000000E-007 0.38600439E-010 0.13985472E+015 0.64074598E+014 0.92165784E+014 0.58519520E+012 0.39019396E+013 0.99281743E+011 0.43389181E+014 0.30563121E+014 0.92181537E+033 0.41468999E+033 0.27593222E+033 0.13892755E+029 0.71706794E+030 0.42438542E+027 0.71973354E+032 0.27829704E+032 0.12930534E+020 0.12705339E+020 0.85486811E+019 0.77892899E+017 0.53063698E+018 0.14558928E+017 0.33171751E+019 0.23792937E+019 +1 0.10000000E-008 0.64676005E-011 0.10043357E+012 0.18569477E+010 0.60533004E+011 0.96525486E+009 0.22988141E+010 0.21414641E+008 0.34531021E+011 0.99714647E+010 0.25891164E+024 0.11897478E+024 0.78782701E+023 0.10485125E+019 0.12239933E+021 0.46762521E+015 0.21013539E+024 0.16444873E+021 0.30942621E+015 0.30202892E+015 0.20245129E+015 0.19889550E+012 0.71013314E+013 0.36629258E+008 0.34534689E+015 0.52531275E+013 +2 0.20000000E-008 0.64784315E-011 0.24046120E+012 0.95829583E+011 0.30112449E+012 0.21960210E+010 0.13111461E+011 0.14749071E+009 0.31777499E+012 0.45050816E+011 0.12612378E+028 0.77157121E+027 0.40071531E+028 0.13446739E+023 0.31016102E+025 0.22171663E+017 0.74576895E+028 0.18494584E+026 0.31519471E+017 0.31225008E+017 0.72896064E+017 0.12195139E+015 0.19226157E+016 0.21563217E+009 0.10216656E+018 0.47225856E+016 +3 0.30000000E-008 0.65866091E-011 0.94294137E+012 0.56259714E+012 0.26883829E+013 0.95971257E+010 0.75143944E+011 0.37900832E+009 0.25969170E+013 0.36784376E+012 0.53942097E+029 0.32419053E+029 0.65329943E+030 0.38698825E+025 0.34509377E+027 0.14637209E+018 0.67470893E+030 0.90819058E+028 0.21775917E+018 0.21676907E+018 0.10028974E+019 0.23281703E+016 0.22400214E+017 0.51226085E+009 0.10251304E+019 0.11658094E+018 +4 0.40000000E-008 0.38600452E-010 0.52661407E+012 0.21374340E+012 0.51432826E+013 0.19434502E+011 0.12544643E+012 0.24278673E+010 0.24775485E+013 0.12130935E+013 0.55084184E+028 0.28621081E+028 0.10372897E+031 0.88627945E+025 0.45720325E+027 0.73535711E+023 0.25758191E+030 0.51063061E+029 0.24480645E+017 0.24281202E+017 0.37642066E+018 0.10710458E+016 0.77134585E+016 0.10166762E+015 0.19273890E+018 0.82422279E+017 +5 0.50036118E-008 0.38600453E-010 0.44636507E+012 0.17854383E+012 0.33929561E+013 0.26024645E+011 0.76002453E+011 0.12345954E+011 0.46799311E+012 0.17628727E+013 0.11652695E+028 0.61672979E+027 0.18024404E+030 0.37264699E+025 0.62414293E+026 0.14220379E+025 0.36241062E+028 0.44658650E+029 0.48534935E+016 0.48534935E+016 0.83695664E+017 0.35077761E+015 0.16287585E+016 0.24617279E+015 0.11803846E+017 0.40815287E+017 +6 0.60000000E-008 0.10000000E-013 0.34390168E+012 0.95133815E+011 0.21324022E+013 0.33618934E+011 0.53144546E+011 0.17225387E+011 0.10930687E+012 0.19887316E+013 0.89412963E+027 0.33993364E+027 0.85635599E+029 0.57603277E+025 0.33764169E+026 0.31949150E+025 0.22299998E+027 0.69310727E+029 0.63743539E+016 0.57831714E+016 0.70343380E+017 0.58088758E+015 0.14343260E+016 0.44152474E+015 0.35468876E+016 0.62424441E+017 +7 0.70000000E-008 0.70298876E-011 0.11639416E+013 0.74171085E+012 0.35515829E+013 0.40815405E+011 0.11358979E+012 0.17480174E+011 0.28405162E+013 0.25022112E+013 0.14819135E+030 0.97504919E+029 0.62030861E+030 0.11694440E+026 0.61720809E+027 0.33789292E+025 0.12192523E+031 0.11792561E+030 0.58966159E+018 0.58966159E+018 0.12079573E+019 0.18891374E+016 0.42137228E+017 0.45916098E+015 0.19615297E+019 0.94243200E+017 +8 0.80000000E-008 0.76928883E-011 0.62443367E+013 0.34886790E+013 0.17877115E+014 0.91156449E+011 0.52256801E+012 0.17807456E+011 0.15248860E+014 0.49681662E+013 0.24005133E+031 0.10888874E+031 0.24535241E+032 0.26399550E+027 0.19594979E+029 0.33787152E+025 0.17840475E+032 0.74636665E+030 0.11777268E+019 0.11694545E+019 0.51775095E+019 0.19297272E+017 0.16131991E+018 0.45915456E+015 0.32654847E+019 0.92925025E+018 +9 0.90000000E-008 0.76882758E-011 0.22388511E+014 0.88209615E+013 0.61121197E+014 0.29840073E+012 0.21726063E+013 0.18538884E+011 0.39790249E+014 0.15277345E+014 0.32953642E+032 0.10607917E+032 0.18569889E+033 0.40497689E+028 0.31047845E+030 0.35948004E+025 0.64085361E+032 0.10902111E+032 0.44698106E+019 0.44650115E+019 0.73028226E+019 0.40001648E+017 0.41132049E+018 0.97407662E+015 0.40214625E+019 0.23324823E+019 +10 0.10000000E-007 0.38600438E-010 0.14345608E+015 0.67526771E+014 0.92264876E+014 0.58587084E+012 0.39330184E+013 0.98641083E+011 0.42777755E+014 0.30654694E+014 0.95098990E+033 0.43603975E+033 0.27669097E+033 0.13913152E+029 0.73147617E+030 0.41772711E+027 0.68169211E+032 0.28014199E+032 0.12867494E+020 0.12748447E+020 0.85867993E+019 0.78303601E+017 0.53785485E+018 0.14577246E+017 0.33235065E+019 0.23930920E+019 diff --git a/programs/standard_2d/tests/test_cyl_chem_rtest.log b/programs/standard_2d/tests/test_cyl_chem_rtest.log index 2e9138b7..e2993d28 100644 --- a/programs/standard_2d/tests/test_cyl_chem_rtest.log +++ b/programs/standard_2d/tests/test_cyl_chem_rtest.log @@ -1,8 +1,8 @@ it time dt sum(e) sum(N2_plus) sum(O2_plus) sum(O2_min) sum(O_min) sum(O3_min) sum(N4_plus) sum(O4_plus) sum(e^2) sum(N2_plus^2) sum(O2_plus^2) sum(O2_min^2) sum(O_min^2) sum(O3_min^2) sum(N4_plus^2) sum(O4_plus^2) max(e) max(N2_plus) max(O2_plus) max(O2_min) max(O_min) max(O3_min) max(N4_plus) max(O4_plus) 0 0.00000000E+000 0.10000000E-013 0.10000000E+015 0.21875682E+015 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.10000000E+029 0.47620152E+033 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.10000000E+015 0.50001000E+019 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 -1 0.25000000E-009 0.23533620E-011 0.12639251E+015 0.13508440E+014 0.53316427E+014 0.17416843E+012 0.14592530E+013 0.40757333E+010 0.17841865E+015 0.15412180E+013 0.14022050E+033 0.30077809E+032 0.39255524E+032 0.54670734E+024 0.46973480E+028 0.16621909E+020 0.34857363E+033 0.24803160E+029 0.16051200E+020 0.71058817E+019 0.45186413E+019 0.98166968E+015 0.95773324E+017 0.60579013E+010 0.82902945E+019 0.57549140E+017 -2 0.50000000E-009 0.20811888E-011 0.44870145E+015 0.32294669E+014 0.20483857E+015 0.58742549E+012 0.11135937E+014 0.22047879E+011 0.33153592E+015 0.10529101E+014 0.83220379E+034 0.22370205E+033 0.12911293E+034 0.52131488E+028 0.48409502E+031 0.12657924E+026 0.38125808E+034 0.26446095E+031 0.76547190E+020 0.35133747E+020 0.21577658E+020 0.57832111E+017 0.85453712E+018 0.49713076E+016 0.49494912E+020 0.86810305E+018 -3 0.75000000E-009 0.19853862E-011 0.64451503E+015 0.26970610E+014 0.34353342E+015 0.15744303E+013 0.19601020E+014 0.13366701E+012 0.38436858E+015 0.29700959E+014 0.20043563E+035 0.42505098E+033 0.37536385E+034 0.79872133E+029 0.11563561E+032 0.91503675E+027 0.70631813E+034 0.23453730E+032 0.11330882E+021 0.51235950E+020 0.36446630E+020 0.22295796E+018 0.12111172E+019 0.23146351E+017 0.73928067E+020 0.25434005E+019 -4 0.10000000E-008 0.19252647E-011 0.85316788E+015 0.29634797E+014 0.48528479E+015 0.31649381E+013 0.24559819E+014 0.40293940E+012 0.42653188E+015 0.58591616E+014 0.36557484E+035 0.60113404E+033 0.77435869E+034 0.38373533E+030 0.14805560E+032 0.68374775E+028 0.10898831E+035 0.93306667E+032 0.13223779E+021 0.61806501E+020 0.49524983E+020 0.44451179E+018 0.13181896E+019 0.43619293E+017 0.87074498E+020 0.52030253E+019 -5 0.12500000E-008 0.18937336E-011 0.10834865E+016 0.32576302E+014 0.63402960E+015 0.53809910E+013 0.28144735E+014 0.81602781E+012 0.47241501E+015 0.97552986E+014 0.57205801E+035 0.75249216E+033 0.13462567E+035 0.11455752E+031 0.16345379E+032 0.24275510E+029 0.14945987E+035 0.26013750E+033 0.14319259E+021 0.67660830E+020 0.60898309E+020 0.69215788E+018 0.13330729E+019 0.64622962E+017 0.95350222E+020 0.86485795E+019 -6 0.15000000E-008 0.73739747E-012 0.13326679E+016 0.35033659E+014 0.79012398E+015 0.82671939E+013 0.31213221E+014 0.13459164E+013 0.52003144E+015 0.14704862E+015 0.80937919E+035 0.85338483E+033 0.20894727E+035 0.26607565E+031 0.17236280E+032 0.59024420E+029 0.18690553E+035 0.58920346E+033 0.15073040E+021 0.72720393E+020 0.70957459E+020 0.95749653E+018 0.13169416E+019 0.85779857E+017 0.10059429E+021 0.12639592E+020 +1 0.25000000E-009 0.23473133E-011 0.12639374E+015 0.13508949E+014 0.53316720E+014 0.17416853E+012 0.14592618E+013 0.40757333E+010 0.17841908E+015 0.15412205E+013 0.14023468E+033 0.30080411E+032 0.39256802E+032 0.54677833E+024 0.46979494E+028 0.16621909E+020 0.34857791E+033 0.24803356E+029 0.16052083E+020 0.71059352E+019 0.45187912E+019 0.98175302E+015 0.95780136E+017 0.60579063E+010 0.82905781E+019 0.57551459E+017 +2 0.50000000E-009 0.20748032E-011 0.44870226E+015 0.32294619E+014 0.20483903E+015 0.58742760E+012 0.11135989E+014 0.22047927E+011 0.33153634E+015 0.10529138E+014 0.83220853E+034 0.22370529E+033 0.12911377E+034 0.52132423E+028 0.48410022E+031 0.12658246E+026 0.38125977E+034 0.26446416E+031 0.76545680E+020 0.35121436E+020 0.21577917E+020 0.57833345E+017 0.85453544E+018 0.49713304E+016 0.49497018E+020 0.86811611E+018 +3 0.75000000E-009 0.19782721E-011 0.64451548E+015 0.26970634E+014 0.34353384E+015 0.15744336E+013 0.19601080E+014 0.13366738E+012 0.38436859E+015 0.29701026E+014 0.20043608E+035 0.42505705E+033 0.37536511E+034 0.79872715E+029 0.11563638E+032 0.91504682E+027 0.70631829E+034 0.23453890E+032 0.11333304E+021 0.51249863E+020 0.36442712E+020 0.22296667E+018 0.12111164E+019 0.23146470E+017 0.73930205E+020 0.25433320E+019 +4 0.10000000E-008 0.19179235E-011 0.85316914E+015 0.29635138E+014 0.48528535E+015 0.31649425E+013 0.24559872E+014 0.40294070E+012 0.42653221E+015 0.58591711E+014 0.36557752E+035 0.60115792E+033 0.77436156E+034 0.38373657E+030 0.14805640E+032 0.68375348E+028 0.10898900E+035 0.93307107E+032 0.13222349E+021 0.61828391E+020 0.49526200E+020 0.44450369E+018 0.13181886E+019 0.43619025E+017 0.87071812E+020 0.52027380E+019 +5 0.12500000E-008 0.18863056E-011 0.10834888E+016 0.32576698E+014 0.63403047E+015 0.53809987E+013 0.28144767E+014 0.81603073E+012 0.47241591E+015 0.97553125E+014 0.57206549E+035 0.75253471E+033 0.13462654E+035 0.11455787E+031 0.16345463E+032 0.24275686E+029 0.14946218E+035 0.26013858E+033 0.14321535E+021 0.67660041E+020 0.60902564E+020 0.69215732E+018 0.13330711E+019 0.64622618E+017 0.95352355E+020 0.86486062E+019 +6 0.15000000E-008 0.73612673E-012 0.13326732E+016 0.35034226E+014 0.79012581E+015 0.82672054E+013 0.31213247E+014 0.13459183E+013 0.52003419E+015 0.14704885E+015 0.80939863E+035 0.85346062E+033 0.20894978E+035 0.26607680E+031 0.17236365E+032 0.59024738E+029 0.18691181E+035 0.58920632E+033 0.15075572E+021 0.72737444E+020 0.70960679E+020 0.95751123E+018 0.13169405E+019 0.85779087E+017 0.10060928E+021 0.12639616E+020 diff --git a/programs/standard_2d/tests/test_cyl_ion_motion_rtest.log b/programs/standard_2d/tests/test_cyl_ion_motion_rtest.log index b740f8f7..ebeffaaa 100644 --- a/programs/standard_2d/tests/test_cyl_ion_motion_rtest.log +++ b/programs/standard_2d/tests/test_cyl_ion_motion_rtest.log @@ -1,12 +1,12 @@ it time dt sum(e) sum(N2_plus) sum(O2_plus) sum(O2_min) sum(O_min) sum(O3_min) sum(N4_plus) sum(O4_plus) sum(e^2) sum(N2_plus^2) sum(O2_plus^2) sum(O2_min^2) sum(O_min^2) sum(O3_min^2) sum(N4_plus^2) sum(O4_plus^2) max(e) max(N2_plus) max(O2_plus) max(O2_min) max(O_min) max(O3_min) max(N4_plus) max(O4_plus) 0 0.00000000E+000 0.10000000E-013 0.12885834E+016 0.12885834E+016 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.47682537E+035 0.47682537E+035 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.50000100E+020 0.50000100E+020 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 -1 0.10000000E-008 0.38015144E-011 0.12444477E+016 0.16624614E+012 0.75924186E+015 0.42343079E+014 0.88927840E+013 0.30937198E+012 0.40905590E+015 0.12752896E+015 0.43764743E+035 0.45099458E+028 0.16291274E+035 0.65393809E+032 0.47856308E+030 0.17858547E+028 0.47261953E+034 0.45981204E+033 0.48264817E+020 0.67442881E+017 0.29295504E+020 0.21005969E+019 0.36766904E+018 0.20050831E+017 0.15779762E+020 0.49180626E+019 -2 0.20000000E-008 0.40317288E-011 0.11757910E+016 0.82777008E+011 0.82045933E+015 0.10427358E+015 0.15292434E+014 0.81456071E+012 0.12375861E+015 0.35187088E+015 0.38478056E+035 0.44622472E+027 0.18818588E+035 0.39493990E+033 0.79829195E+030 0.82136775E+028 0.42160247E+033 0.34599357E+034 0.45337861E+020 0.14262578E+017 0.31519617E+020 0.48264570E+019 0.38226553E+018 0.54571341E+017 0.47172349E+019 0.13498539E+020 -3 0.30000000E-008 0.43214723E-011 0.11055356E+016 0.56185183E+011 0.69588740E+015 0.16233978E+015 0.21087375E+014 0.14824959E+013 0.37874742E+014 0.55662692E+015 0.33517695E+035 0.10356473E+027 0.13397378E+035 0.95361134E+033 0.10100652E+031 0.19678272E+029 0.37630821E+032 0.85658629E+034 0.42296427E+020 0.54771667E+016 0.26616242E+020 0.73601427E+019 0.36661410E+018 0.91449218E+017 0.14098086E+019 0.21234776E+020 -4 0.40000000E-008 0.46514804E-011 0.10360365E+016 0.43948066E+011 0.55016129E+015 0.21637461E+015 0.26364503E+014 0.22957430E+013 0.11972717E+014 0.71889339E+015 0.28971867E+035 0.37259783E+026 0.82818054E+034 0.16884992E+034 0.11516679E+031 0.36310714E+029 0.33678171E+031 0.14140194E+035 0.39294877E+020 0.29759706E+016 0.20940853E+020 0.97030931E+019 0.35638321E+018 0.12693212E+018 0.42123728E+018 0.27272416E+020 -5 0.50000000E-008 0.50227001E-011 0.96872776E+015 0.36717946E+011 0.42435606E+015 0.26643590E+015 0.31191632E+014 0.32373732E+013 0.41109158E+013 0.84108896E+015 0.24895618E+035 0.16387415E+026 0.48671953E+034 0.25524538E+034 0.12482305E+031 0.57799965E+029 0.30608670E+030 0.19158989E+035 0.36390304E+020 0.16348983E+016 0.16063190E+020 0.11860920E+020 0.33759978E+018 0.15889369E+018 0.12583333E+018 0.31730599E+020 -6 0.60000000E-008 0.54361251E-011 0.90448033E+015 0.31993865E+011 0.32444240E+015 0.31268062E+015 0.35618508E+014 0.42929881E+013 0.16852382E+013 0.93091281E+015 0.21301651E+035 0.82874307E+025 0.28054497E+034 0.35051957E+034 0.13150308E+031 0.83581159E+029 0.30347246E+029 0.23234476E+035 0.33622658E+020 0.10444775E+016 0.12201915E+020 0.13841625E+020 0.31436851E+018 0.18699752E+018 0.37581555E+017 0.34925084E+020 -7 0.70000000E-008 0.58930910E-011 0.84378066E+015 0.28753243E+011 0.24739035E+015 0.35531450E+015 0.39683615E+014 0.54503690E+013 0.90937218E+012 0.99590066E+015 0.18171971E+035 0.47570650E+025 0.16046189E+034 0.45132999E+034 0.13608007E+031 0.11298759E+030 0.44672186E+028 0.26329263E+035 0.31015496E+020 0.65130484E+015 0.92326007E+019 0.15655443E+020 0.29009217E+018 0.21172044E+018 0.11997666E+017 0.37159206E+020 -8 0.80000000E-008 0.63953831E-011 0.78684387E+015 0.26289979E+011 0.18863071E+015 0.39456093E+015 0.43418569E+014 0.66989259E+013 0.64058764E+012 0.10422247E+016 0.15470719E+035 0.28709721E+025 0.91487473E+033 0.55496661E+034 0.13909456E+031 0.14531834E+030 0.14875875E+028 0.28555751E+035 0.28579658E+020 0.42151365E+015 0.69744228E+019 0.17313410E+020 0.26612272E+018 0.23352989E+018 0.84996658E+016 0.38678943E+020 -9 0.90000000E-008 0.69452231E-011 0.73370121E+015 0.24325240E+011 0.14401520E+015 0.43064913E+015 0.46851614E+014 0.80293603E+013 0.53113328E+012 0.10746606E+016 0.13153846E+035 0.18178350E+025 0.52089887E+033 0.65927677E+034 0.14095431E+031 0.17993016E+030 0.83584683E+027 0.30071641E+035 0.26317218E+020 0.30142186E+015 0.52647019E+019 0.18826723E+020 0.25065558E+018 0.25278004E+018 0.61309460E+016 0.39673161E+020 -10 0.10000000E-007 0.75452499E-011 0.68427696E+015 0.22715978E+011 0.11019473E+015 0.46380009E+015 0.50007094E+014 0.94335820E+013 0.47484537E+012 0.10968254E+016 0.11175357E+035 0.12131459E+025 0.29638825E+033 0.76257297E+034 0.14194807E+031 0.21627911E+030 0.54966428E+027 0.31032539E+035 0.24224574E+020 0.22382194E+015 0.39726320E+019 0.20206452E+020 0.23917859E+018 0.26985099E+018 0.43746957E+016 0.40283867E+020 +1 0.10000000E-008 0.37910138E-011 0.12444477E+016 0.16624644E+012 0.75924187E+015 0.42343096E+014 0.88927764E+013 0.30937095E+012 0.40905589E+015 0.12752895E+015 0.43764742E+035 0.45099608E+028 0.16291275E+035 0.65393863E+032 0.47856223E+030 0.17858400E+028 0.47261951E+034 0.45981202E+033 0.48264816E+020 0.67442598E+017 0.29295506E+020 0.21005986E+019 0.36766898E+018 0.20050827E+017 0.15779763E+020 0.49180624E+019 +2 0.20000000E-008 0.40033527E-011 0.11757910E+016 0.82777088E+011 0.82045934E+015 0.10427360E+015 0.15292427E+014 0.81455882E+012 0.12375861E+015 0.35187088E+015 0.38478056E+035 0.44622817E+027 0.18818588E+035 0.39494003E+033 0.79829118E+030 0.82136241E+028 0.42160242E+033 0.34599356E+034 0.45337857E+020 0.14262634E+017 0.31519619E+020 0.48264585E+019 0.38226557E+018 0.54571348E+017 0.47172348E+019 0.13498539E+020 +3 0.30000000E-008 0.42699936E-011 0.11055356E+016 0.56185155E+011 0.69588740E+015 0.16233980E+015 0.21087369E+014 0.14824933E+013 0.37874737E+014 0.55662692E+015 0.33517695E+035 0.10356462E+027 0.13397378E+035 0.95361154E+033 0.10100645E+031 0.19678165E+029 0.37630809E+032 0.85658629E+034 0.42296425E+020 0.54771670E+016 0.26616243E+020 0.73601440E+019 0.36661401E+018 0.91449222E+017 0.14098085E+019 0.21234776E+020 +4 0.40000000E-008 0.45718394E-011 0.10360365E+016 0.43948060E+011 0.55016130E+015 0.21637462E+015 0.26364498E+014 0.22957396E+013 0.11972713E+014 0.71889339E+015 0.28971866E+035 0.37259856E+026 0.82818054E+034 0.16884995E+034 0.11516676E+031 0.36310542E+029 0.33678149E+031 0.14140194E+035 0.39294876E+020 0.29759841E+016 0.20940854E+020 0.97030954E+019 0.35638331E+018 0.12693212E+018 0.42123716E+018 0.27272416E+020 +5 0.50000000E-008 0.49086510E-011 0.96872775E+015 0.36717952E+011 0.42435606E+015 0.26643592E+015 0.31191627E+014 0.32373693E+013 0.41109140E+013 0.84108897E+015 0.24895617E+035 0.16387456E+026 0.48671953E+034 0.25524541E+034 0.12482301E+031 0.57799733E+029 0.30608635E+030 0.19158989E+035 0.36390302E+020 0.16349039E+016 0.16063191E+020 0.11860922E+020 0.33759990E+018 0.15889371E+018 0.12583326E+018 0.31730598E+020 +6 0.60000000E-008 0.52801075E-011 0.90448032E+015 0.31993860E+011 0.32444240E+015 0.31268064E+015 0.35618504E+014 0.42929839E+013 0.16852373E+013 0.93091282E+015 0.21301651E+035 0.82874356E+025 0.28054497E+034 0.35051961E+034 0.13150304E+031 0.83580867E+029 0.30347195E+029 0.23234476E+035 0.33622657E+020 0.10444810E+016 0.12201916E+020 0.13841627E+020 0.31436862E+018 0.18699754E+018 0.37581519E+017 0.34925084E+020 +7 0.70000000E-008 0.56860745E-011 0.84378066E+015 0.28753238E+011 0.24739035E+015 0.35531451E+015 0.39683610E+014 0.54503644E+013 0.90937168E+012 0.99590066E+015 0.18171970E+035 0.47570672E+025 0.16046188E+034 0.45133003E+034 0.13608002E+031 0.11298724E+030 0.44672114E+028 0.26329263E+035 0.31015495E+020 0.65130593E+015 0.92326009E+019 0.15655443E+020 0.29009228E+018 0.21172047E+018 0.11997676E+017 0.37159206E+020 +8 0.80000000E-008 0.61266812E-011 0.78684387E+015 0.26289976E+011 0.18863070E+015 0.39456095E+015 0.43418564E+014 0.66989211E+013 0.64058737E+012 0.10422247E+016 0.15470719E+035 0.28709760E+025 0.91487467E+033 0.55496665E+034 0.13909449E+031 0.14531793E+030 0.14875868E+028 0.28555751E+035 0.28579657E+020 0.42151370E+015 0.69744228E+019 0.17313411E+020 0.26612283E+018 0.23352993E+018 0.84996762E+016 0.38678942E+020 +9 0.90000000E-008 0.66022786E-011 0.73370121E+015 0.24325240E+011 0.14401520E+015 0.43064914E+015 0.46851608E+014 0.80293553E+013 0.53113316E+012 0.10746606E+016 0.13153845E+035 0.18178379E+025 0.52089882E+033 0.65927682E+034 0.14095424E+031 0.17992971E+030 0.83584708E+027 0.30071641E+035 0.26317218E+020 0.30142281E+015 0.52647018E+019 0.18826723E+020 0.25065577E+018 0.25278008E+018 0.61309483E+016 0.39673160E+020 +10 0.10000000E-007 0.71133827E-011 0.68427696E+015 0.22715985E+011 0.11019472E+015 0.46380011E+015 0.50007089E+014 0.94335768E+013 0.47484532E+012 0.10968254E+016 0.11175357E+035 0.12131486E+025 0.29638821E+033 0.76257302E+034 0.14194800E+031 0.21627861E+030 0.54966471E+027 0.31032539E+035 0.24224573E+020 0.22382245E+015 0.39726318E+019 0.20206452E+020 0.23917863E+018 0.26985140E+018 0.43747003E+016 0.40283866E+020 diff --git a/programs/standard_2d/tests/test_cyl_ion_motion_v2.cfg b/programs/standard_2d/tests/test_cyl_ion_motion_v2.cfg new file mode 100644 index 00000000..2ef339b5 --- /dev/null +++ b/programs/standard_2d/tests/test_cyl_ion_motion_v2.cfg @@ -0,0 +1,70 @@ + ############################################## + ### Configuration file ### + ############################################## + memory_limit_GB = 1.0 + output%regression_test = t + cylindrical = T + + # The desired endtime in seconds of the simulation: + end_time = 10e-9 + + # The name of the simulation: + output%name = output/test_cyl_ion_motion_v2 + +# The size of the coarse grid: + coarse_grid_size = 8 8 + + # The length of the (square) domain: + domain_len = 16e-3 16e-3 + + # Whether the domain is periodic (per dimension): + periodic = F F + + # The gas pressure in bar (used for photoionization): + gas%pressure = 0.1000E+01 + + # The applied electric field: + field_amplitude = -.2500E+07 + + # The background ion and electron density in 1/m^3: + background_density = 0 + + # Initial density of the seed: + seed_density = 1e11 + + # Type of seed: neutral (0), ions (1) or electrons (-1) + seed_charge_type = 0 + + # The relative start position of the initial seed: + seed_rel_r0 = 0.0000E+00 0.52E+00 + + # The relative end position of the initial seed: + seed_rel_r1 = 0.0000E+00 0.48E+00 + + # Seed width: + seed_width = 2.000E-04 + + # Fallof type for seed, see m_geom.f90: + seed_falloff = smoothstep + + # The timestep for writing output: + output%dt = 1.0E-09 + + # The maximum timestep: + dt_max = 0.1000E-09 + + [photoi] + # Whether photoionization is enabled: + enabled = f + + # Input file with transport data: + input_data%file = air_chemistry_v1.txt + input_data%old_style = f + + input_data%mobile_ions = N2_plus N4_plus O2_plus O4_plus O2_min O_min + + # Use artificial mobilities to actually get some significant ion motion + input_data%ion_mobilities = 1e-2 1e-2 1e-2 1e-2 1e-2 1e-2 + + # Limit maximal time step + dt_max = 4e-11 diff --git a/programs/standard_2d/tests/test_cyl_ion_motion_v2_rtest.log b/programs/standard_2d/tests/test_cyl_ion_motion_v2_rtest.log new file mode 100644 index 00000000..cb6ed22b --- /dev/null +++ b/programs/standard_2d/tests/test_cyl_ion_motion_v2_rtest.log @@ -0,0 +1,12 @@ +it time dt sum(e) sum(N2_plus) sum(O2_plus) sum(O2_min) sum(O_min) sum(O3_min) sum(N4_plus) sum(O4_plus) sum(e^2) sum(N2_plus^2) sum(O2_plus^2) sum(O2_min^2) sum(O_min^2) sum(O3_min^2) sum(N4_plus^2) sum(O4_plus^2) max(e) max(N2_plus) max(O2_plus) max(O2_min) max(O_min) max(O3_min) max(N4_plus) max(O4_plus) +0 0.00000000E+000 0.10000000E-013 0.23771668E+007 0.23771668E+007 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.19072916E+018 0.19072916E+018 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.10000000E+012 0.10000000E+012 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 +1 0.10000000E-008 0.36000000E-010 0.22810873E+007 0.21863814E+004 0.14796854E+007 0.13924871E+005 0.21312395E+006 0.10951165E+004 0.77934523E+006 0.24801423E+006 0.17331882E+018 0.15925684E+012 0.73622820E+017 0.64588583E+013 0.15126201E+016 0.40057640E+011 0.20438718E+017 0.20723458E+016 0.95958236E+011 0.91974254E+008 0.62245755E+011 0.58577593E+009 0.89654604E+010 0.46068139E+008 0.32784625E+011 0.10433186E+011 +2 0.20000000E-008 0.36000000E-010 0.21930583E+007 0.21018184E+004 0.16680948E+007 0.29554929E+005 0.40920155E+006 0.42627341E+004 0.26205231E+006 0.70382858E+006 0.15818814E+018 0.14532845E+012 0.92221717E+017 0.28435592E+014 0.54452462E+016 0.59502734E+012 0.22379727E+016 0.16598049E+017 0.92255128E+011 0.88416950E+008 0.70171549E+011 0.12432838E+010 0.17213834E+011 0.17931995E+009 0.11023724E+011 0.29607875E+011 +3 0.30000000E-008 0.36000000E-010 0.21124855E+007 0.20244298E+004 0.14996928E+007 0.46690241E+005 0.58963203E+006 0.93372652E+004 0.10621243E+006 0.11502154E+007 0.14493976E+018 0.13313971E+012 0.72305251E+017 0.68980181E+014 0.10973061E+017 0.27832896E+013 0.33087567E+015 0.43891568E+017 0.88865679E+011 0.85161443E+008 0.63087403E+011 0.19641130E+010 0.24803982E+011 0.39278968E+009 0.44680258E+010 0.48385976E+011 +4 0.40000000E-008 0.36000000E-010 0.20388195E+007 0.19536714E+004 0.12767565E+007 0.65149072E+005 0.75570567E+006 0.16166746E+005 0.58597876E+005 0.15385329E+007 0.13311444E+018 0.12227002E+012 0.49821065E+017 0.13017644E+015 0.17431831E+017 0.81075902E+013 0.90346912E+014 0.77389883E+017 0.85766769E+011 0.82184843E+008 0.53709165E+011 0.27406184E+010 0.31790182E+011 0.68008468E+009 0.24650298E+010 0.64721286E+011 +5 0.50000000E-008 0.36000000E-010 0.19715522E+007 0.18890556E+004 0.10772020E+007 0.84766398E+005 0.90861213E+006 0.24611773E+005 0.43445911E+005 0.18670055E+007 0.12252246E+018 0.11252983E+012 0.32958765E+017 0.21324390E+015 0.24310200E+017 0.18218421E+014 0.50118860E+014 0.11176540E+018 0.82937007E+011 0.79466617E+008 0.45314527E+011 0.35658580E+010 0.38222477E+011 0.10353407E+010 0.18276334E+010 0.78539105E+011 +6 0.60000000E-008 0.36000000E-010 0.19102137E+007 0.18301311E+004 0.91486247E+006 0.10539254E+006 0.10494482E+007 0.34544523E+005 0.38084949E+005 0.21448214E+007 0.11310674E+018 0.10387071E+012 0.21587717E+017 0.31861039E+015 0.31225316E+017 0.34740244E+014 0.40197320E+014 0.14396082E+018 0.80356598E+011 0.76987763E+008 0.38485406E+011 0.44335348E+010 0.44147003E+011 0.14531806E+010 0.16021133E+010 0.90225951E+011 +7 0.70000000E-008 0.36000000E-010 0.18543695E+007 0.17764810E+004 0.78669729E+006 0.12689189E+006 0.11792249E+007 0.45847852E+005 0.35726702E+005 0.23821338E+007 0.10470914E+018 0.96149189E+011 0.14208724E+017 0.44598663E+015 0.37897605E+017 0.59147878E+014 0.36036808E+014 0.17250258E+018 0.78007213E+011 0.74730686E+008 0.33063482E+011 0.53379437E+010 0.49606283E+011 0.19286763E+010 0.15010815E+010 0.10020727E+012 +8 0.80000000E-008 0.36000000E-010 0.18036180E+007 0.17277194E+004 0.68635538E+006 0.14914176E+006 0.12988742E+007 0.58414454E+005 0.34334988E+005 0.25876303E+007 0.97170887E+017 0.89219850E+011 0.95331699E+016 0.59444171E+015 0.44128149E+017 0.92682379E+014 0.33234936E+014 0.19687866E+018 0.75871885E+011 0.72679095E+008 0.27860750E+011 0.62739226E+010 0.54639506E+011 0.24573073E+010 0.14375210E+010 0.10870877E+012 +9 0.90000000E-008 0.36000000E-010 0.17575874E+007 0.16834897E+004 0.60781009E+006 0.17203129E+006 0.14092547E+007 0.72146092E+005 0.33295676E+005 0.27682303E+007 0.90356795E+017 0.82957918E+011 0.66405836E+016 0.76249304E+015 0.49781487E+017 0.13630058E+015 0.30883101E+014 0.21718062E+018 0.73934861E+011 0.70817872E+008 0.22061080E+011 0.72367682E+010 0.59282461E+011 0.30339218E+010 0.13983188E+010 0.11553375E+012 +10 0.10000000E-007 0.36000000E-010 0.17159344E+007 0.16434620E+004 0.54612666E+006 0.19546050E+006 0.15111579E+007 0.86952890E+005 0.32420434E+005 0.29293152E+007 0.84157897E+017 0.77262636E+011 0.48763850E+016 0.94823419E+015 0.54774568E+017 0.19066002E+015 0.28777140E+014 0.23386033E+018 0.72179903E+011 0.69131625E+008 0.17094335E+011 0.82201268E+010 0.63548916E+011 0.36453582E+010 0.13627872E+010 0.12081662E+012 diff --git a/programs/standard_2d/tests/test_cyl_photoi_chem_rtest.log b/programs/standard_2d/tests/test_cyl_photoi_chem_rtest.log index a33d4924..11cdfff5 100644 --- a/programs/standard_2d/tests/test_cyl_photoi_chem_rtest.log +++ b/programs/standard_2d/tests/test_cyl_photoi_chem_rtest.log @@ -1,8 +1,8 @@ it time dt sum(e) sum(N2_plus) sum(O2_plus) sum(O2_min) sum(O_min) sum(O3_min) sum(N4_plus) sum(O4_plus) sum(e^2) sum(N2_plus^2) sum(O2_plus^2) sum(O2_min^2) sum(O_min^2) sum(O3_min^2) sum(N4_plus^2) sum(O4_plus^2) max(e) max(N2_plus) max(O2_plus) max(O2_min) max(O_min) max(O3_min) max(N4_plus) max(O4_plus) 0 0.00000000E+000 0.10000000E-013 0.10000000E+015 0.21875682E+015 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.10000000E+029 0.47620152E+033 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.10000000E+015 0.50001000E+019 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 0.00000000E+000 -1 0.25000000E-009 0.23536111E-011 0.12659845E+015 0.13587455E+014 0.53395774E+014 0.17418195E+012 0.14603970E+013 0.40757448E+010 0.17846677E+015 0.15418271E+013 0.14161865E+033 0.30344165E+032 0.39441764E+032 0.55183390E+024 0.47447737E+028 0.16621996E+020 0.34893482E+033 0.24829446E+029 0.16104927E+020 0.71252915E+019 0.45354406E+019 0.98568369E+015 0.96154210E+017 0.61211148E+010 0.83065970E+019 0.57683799E+017 -2 0.50000000E-009 0.21258247E-011 0.46188830E+015 0.35378708E+014 0.20894403E+015 0.59051661E+012 0.11357992E+014 0.21734304E+011 0.33766173E+015 0.10625442E+014 0.87243303E+034 0.24817519E+033 0.13279913E+034 0.52187927E+028 0.49926772E+031 0.11170678E+026 0.39249425E+034 0.26805902E+031 0.76042705E+020 0.33805616E+020 0.21325822E+020 0.57254289E+017 0.86335529E+018 0.46888887E+016 0.48828007E+020 0.87084555E+018 -3 0.75000000E-009 0.20905445E-011 0.68196057E+015 0.29450002E+014 0.35827503E+015 0.16013983E+013 0.20916783E+014 0.12905302E+012 0.40518451E+015 0.30447649E+014 0.20493115E+035 0.37159601E+033 0.38673670E+034 0.79434155E+029 0.12852522E+032 0.81285286E+027 0.71235969E+034 0.24067468E+032 0.99265642E+020 0.42135047E+020 0.34988142E+020 0.21655281E+018 0.12547566E+019 0.22261406E+017 0.65452863E+020 0.25385741E+019 -4 0.10000000E-008 0.20652543E-011 0.89880942E+015 0.29922158E+014 0.50920128E+015 0.32369528E+013 0.27070576E+014 0.39806717E+012 0.44842810E+015 0.60710926E+014 0.34316979E+035 0.43515132E+033 0.76922606E+034 0.37165948E+030 0.17382886E+032 0.63491366E+028 0.97921030E+034 0.95686322E+032 0.10739757E+021 0.46075141E+020 0.45961768E+020 0.42033265E+018 0.14062661E+019 0.42428325E+017 0.71342630E+020 0.51241264E+019 -5 0.12500000E-008 0.20512381E-011 0.11233195E+016 0.31012757E+014 0.66240255E+015 0.54910837E+013 0.31611161E+014 0.82865107E+012 0.48504299E+015 0.10153773E+015 0.49389007E+035 0.47675838E+033 0.12664038E+035 0.10679779E+031 0.19738696E+032 0.23536691E+029 0.11898192E+035 0.26287745E+033 0.11082491E+021 0.47546490E+020 0.54129065E+020 0.64055109E+018 0.14443857E+019 0.63466752E+017 0.73975831E+020 0.83749186E+019 -6 0.15000000E-008 0.20479047E-011 0.13548488E+016 0.31924881E+014 0.81667063E+015 0.83712852E+013 0.35471843E+014 0.13992401E+013 0.51722987E+015 0.15300957E+015 0.65141627E+035 0.49704381E+033 0.18511503E+035 0.23763828E+031 0.21102735E+032 0.59335392E+029 0.13456493E+035 0.58100900E+033 0.11127739E+021 0.47481615E+020 0.60471618E+020 0.87166662E+018 0.14289108E+019 0.84837706E+017 0.74339123E+020 0.12047735E+020 +1 0.25000000E-009 0.23475868E-011 0.12659992E+015 0.13588014E+014 0.53396227E+014 0.17418206E+012 0.14604065E+013 0.40757448E+010 0.17846724E+015 0.15418300E+013 0.14163422E+033 0.30346955E+032 0.39443351E+032 0.55190916E+024 0.47454130E+028 0.16621996E+020 0.34893937E+033 0.24829660E+029 0.16105871E+020 0.71253666E+019 0.45356271E+019 0.98576822E+015 0.96161139E+017 0.61211514E+010 0.83069090E+019 0.57686134E+017 +2 0.50000000E-009 0.21196648E-011 0.46188593E+015 0.35378002E+014 0.20894358E+015 0.59051842E+012 0.11357993E+014 0.21734521E+011 0.33766050E+015 0.10625464E+014 0.87242693E+034 0.24817609E+033 0.13279909E+034 0.52189083E+028 0.49926967E+031 0.11171596E+026 0.39249217E+034 0.26806191E+031 0.76044964E+020 0.33817652E+020 0.21326352E+020 0.57257261E+017 0.86335877E+018 0.46892162E+016 0.48824072E+020 0.87087098E+018 +3 0.75000000E-009 0.20841097E-011 0.68196485E+015 0.29450672E+014 0.35827604E+015 0.16013969E+013 0.20916862E+014 0.12905111E+012 0.40518716E+015 0.30447678E+014 0.20493549E+035 0.37161086E+033 0.38674062E+034 0.79433937E+029 0.12852667E+032 0.81281327E+027 0.71237574E+034 0.24067585E+032 0.99295649E+020 0.42132605E+020 0.34990571E+020 0.21656515E+018 0.12547667E+019 0.22260589E+017 0.65474475E+020 0.25385532E+019 +4 0.10000000E-008 0.20578449E-011 0.89882519E+015 0.29925273E+014 0.50920604E+015 0.32369531E+013 0.27070914E+014 0.39805970E+012 0.44843615E+015 0.60711102E+014 0.34318115E+035 0.43520042E+033 0.76923894E+034 0.37165958E+030 0.17383387E+032 0.63488707E+028 0.97924168E+034 0.95687013E+032 0.10741114E+021 0.46069938E+020 0.45966962E+020 0.42036699E+018 0.14062875E+019 0.42428167E+017 0.71346047E+020 0.51244681E+019 +5 0.12500000E-008 0.20436910E-011 0.11233460E+016 0.31012424E+014 0.66241380E+015 0.54910986E+013 0.31611957E+014 0.82863351E+012 0.48505852E+015 0.10153850E+015 0.49390801E+035 0.47676830E+033 0.12664368E+035 0.10679719E+031 0.19739850E+032 0.23535350E+029 0.11898690E+035 0.26288047E+033 0.11081608E+021 0.47562408E+020 0.54140561E+020 0.64060720E+018 0.14444249E+019 0.63466546E+017 0.73966916E+020 0.83756061E+019 +6 0.15000000E-008 0.20407521E-011 0.13548767E+016 0.31926541E+014 0.81668487E+015 0.83713550E+013 0.35472425E+014 0.13992359E+013 0.51724084E+015 0.15301121E+015 0.65144579E+035 0.49715662E+033 0.18512095E+035 0.23763835E+031 0.21103929E+032 0.59333407E+029 0.13457192E+035 0.58101855E+033 0.11129731E+021 0.47466187E+020 0.60489810E+020 0.87174472E+018 0.14289548E+019 0.84838049E+017 0.74336580E+020 0.12048840E+020 diff --git a/programs/standard_2d/tests/test_cyl_rtest.log b/programs/standard_2d/tests/test_cyl_rtest.log index e0da84af..735f4ee4 100644 --- a/programs/standard_2d/tests/test_cyl_rtest.log +++ b/programs/standard_2d/tests/test_cyl_rtest.log @@ -1,8 +1,8 @@ it time dt sum(e) sum(M_plus) sum(M_min) sum(e^2) sum(M_plus^2) sum(M_min^2) max(e) max(M_plus) max(M_min) 0 0.00000000E+000 0.10000000E-013 0.10000000E+015 0.21875777E+015 0.00000000E+000 0.10000000E+029 0.47620419E+033 0.00000000E+000 0.10000000E+015 0.50001000E+019 0.00000000E+000 -1 0.25000000E-009 0.56765892E-011 0.11854461E+015 0.23907016E+015 0.17697658E+013 0.70880333E+032 0.69624151E+033 0.24182116E+028 0.11925748E+020 0.16060851E+020 0.68715751E+017 -2 0.50000000E-009 0.22118565E-011 0.42475142E+015 0.55510249E+015 0.11598926E+014 0.73124614E+034 0.10285583E+035 0.47915031E+031 0.69830457E+020 0.83292999E+020 0.90750764E+018 -3 0.75000000E-009 0.21119342E-011 0.60716219E+015 0.74784795E+015 0.21935431E+014 0.17604061E+035 0.21638974E+035 0.14112552E+032 0.10985361E+021 0.11570513E+021 0.13102721E+019 -4 0.10000000E-008 0.20427825E-011 0.79977548E+015 0.94795203E+015 0.29427973E+014 0.32452353E+035 0.37196393E+035 0.21529339E+032 0.13111373E+021 0.13520918E+021 0.15337773E+019 -5 0.12500000E-008 0.82970439E-012 0.10140346E+016 0.11687907E+016 0.36009341E+014 0.51549405E+035 0.57094403E+035 0.28268857E+032 0.14404073E+021 0.14699580E+021 0.16516959E+019 -6 0.15000000E-008 0.79757522E-012 0.12484611E+016 0.14098576E+016 0.42651570E+014 0.74201697E+035 0.80672542E+035 0.35790335E+032 0.15337509E+021 0.15559544E+021 0.17827284E+019 +1 0.25000000E-009 0.56454993E-011 0.11854980E+015 0.23907539E+015 0.17698014E+013 0.70929773E+032 0.69633362E+033 0.24201523E+028 0.11931788E+020 0.16065801E+020 0.68750745E+017 +2 0.50000000E-009 0.22048700E-011 0.42475518E+015 0.55510649E+015 0.11599155E+014 0.73127465E+034 0.10285935E+035 0.47917477E+031 0.69830182E+020 0.83301623E+020 0.90750241E+018 +3 0.75000000E-009 0.21046050E-011 0.60716773E+015 0.74785361E+015 0.21935549E+014 0.17604859E+035 0.21639810E+035 0.14112761E+032 0.10984818E+021 0.11572680E+021 0.13102764E+019 +4 0.10000000E-008 0.20339687E-011 0.79978424E+015 0.94796092E+015 0.29428105E+014 0.32455062E+035 0.37198367E+035 0.21529759E+032 0.13110475E+021 0.13524044E+021 0.15337865E+019 +5 0.12500000E-008 0.82785124E-012 0.10140488E+016 0.11688051E+016 0.36009492E+014 0.51552174E+035 0.57097243E+035 0.28269288E+032 0.14405401E+021 0.14717429E+021 0.16517000E+019 +6 0.15000000E-008 0.79603000E-012 0.12484814E+016 0.14098781E+016 0.42651775E+014 0.74207110E+035 0.80678145E+035 0.35790980E+032 0.15350678E+021 0.15573891E+021 0.17827994E+019 diff --git a/programs/standard_3d/tests/test_3d_chem_rtest.log b/programs/standard_3d/tests/test_3d_chem_rtest.log index 7fb6a52d..00564506 100644 --- a/programs/standard_3d/tests/test_3d_chem_rtest.log +++ b/programs/standard_3d/tests/test_3d_chem_rtest.log @@ -11,7 +11,7 @@ it time dt sum(e) sum(N2_plus) sum(O2_plus) sum(O2_min) sum(O_min) sum(O3_min) s 9 0.18000000E-008 0.38126697E-010 0.37096807E+016 0.23329686E+013 0.25164581E+016 0.58113153E+014 0.16150990E+015 0.12569304E+014 0.48062900E+015 0.94245298E+015 0.13333814E+035 0.26996689E+029 0.61046806E+034 0.35050758E+031 0.17639916E+032 0.16854736E+030 0.21079996E+033 0.87533837E+033 0.48298219E+019 0.24430090E+017 0.32211049E+019 0.81683307E+017 0.28524951E+018 0.17559644E+017 0.59326363E+018 0.12214963E+019 10 0.20000000E-008 0.38126697E-010 0.37134524E+016 0.24110292E+013 0.24893266E+016 0.65934739E+014 0.16717034E+015 0.14913709E+014 0.38731487E+015 0.10824187E+016 0.13262235E+035 0.26623681E+029 0.59169624E+034 0.44957366E+031 0.18355341E+032 0.23434299E+030 0.13217805E+033 0.11504867E+034 0.48195262E+019 0.26816658E+017 0.31693591E+019 0.92953833E+017 0.29970049E+018 0.20790114E+017 0.46587682E+018 0.14000941E+019 11 0.22000000E-008 0.38126697E-010 0.37170962E+016 0.24216006E+013 0.24444985E+016 0.74009547E+014 0.17304684E+015 0.17297764E+014 0.31421509E+015 0.12203152E+016 0.13186965E+035 0.24710701E+029 0.56460663E+034 0.56475944E+031 0.19144364E+032 0.31151237E+030 0.83668427E+032 0.14565722E+034 0.48091938E+019 0.21959353E+017 0.30939010E+019 0.10506590E+018 0.31275024E+018 0.24897918E+017 0.36584193E+018 0.15750450E+019 -12 0.24000000E-008 0.37182841E-010 0.37202336E+016 0.24130526E+013 0.23869926E+016 0.82407812E+014 0.17913963E+015 0.19708794E+014 0.25678551E+015 0.13552987E+016 0.13116818E+035 0.23087654E+029 0.53240545E+034 0.69910554E+031 0.20023304E+032 0.39989996E+030 0.53665731E+032 0.17895808E+034 0.47987917E+019 0.24557717E+017 0.30017178E+019 0.11857996E+018 0.32368052E+018 0.29218179E+017 0.28990002E+018 0.17452270E+019 -13 0.26000000E-008 0.36652356E-010 0.37226569E+016 0.23770201E+013 0.23206851E+016 0.91191266E+014 0.18545281E+015 0.22133375E+014 0.21159875E+015 0.14867735E+016 0.13036732E+035 0.21005246E+029 0.49715319E+034 0.85558115E+031 0.20968068E+032 0.49864237E+030 0.35033040E+032 0.21440730E+034 0.47881198E+019 0.20465044E+017 0.28981927E+019 0.13397619E+018 0.33297057E+018 0.33596178E+017 0.28942918E+018 0.19098623E+019 -14 0.28000000E-008 0.36223668E-010 0.37241489E+016 0.23439094E+013 0.22485360E+016 0.10046988E+015 0.19198124E+015 0.24562888E+014 0.17594997E+015 0.16143331E+016 0.12955629E+035 0.19458938E+029 0.46089981E+034 0.10403302E+032 0.22004586E+032 0.60748308E+030 0.23411037E+032 0.25168392E+034 0.47774037E+019 0.22297905E+017 0.27874546E+019 0.15231245E+018 0.34100619E+018 0.37951366E+017 0.29439041E+018 0.20684377E+019 -15 0.30000000E-008 0.35836881E-010 0.37245941E+016 0.23125835E+013 0.21728454E+016 0.11041085E+015 0.19870204E+015 0.26993638E+014 0.14782599E+015 0.17377167E+016 0.12865655E+035 0.17827348E+029 0.42459735E+034 0.12613235E+032 0.23110403E+032 0.72541981E+030 0.16119217E+032 0.29021897E+034 0.47664880E+019 0.19224918E+017 0.26726543E+019 0.17464499E+018 0.34886692E+018 0.42346095E+017 0.29568708E+018 0.22206424E+019 +12 0.24000000E-008 0.36571313E-010 0.37202335E+016 0.24130327E+013 0.23869931E+016 0.82407799E+014 0.17913963E+015 0.19708793E+014 0.25678504E+015 0.13552986E+016 0.13116819E+035 0.23088680E+029 0.53240569E+034 0.69910523E+031 0.20023302E+032 0.39989995E+030 0.53665522E+032 0.17895806E+034 0.47987918E+019 0.24559655E+017 0.30017185E+019 0.11858015E+018 0.32368054E+018 0.29218181E+017 0.28989541E+018 0.17452269E+019 +13 0.26000000E-008 0.36047160E-010 0.37226567E+016 0.23769494E+013 0.23206860E+016 0.91191228E+014 0.18545280E+015 0.22133373E+014 0.21159781E+015 0.14867733E+016 0.13036733E+035 0.21004441E+029 0.49715363E+034 0.85558013E+031 0.20968062E+032 0.49864237E+030 0.35032701E+032 0.21440727E+034 0.47881199E+019 0.20468098E+017 0.28981940E+019 0.13397610E+018 0.33297057E+018 0.33596181E+017 0.28942671E+018 0.19098621E+019 +14 0.28000000E-008 0.35617738E-010 0.37241486E+016 0.23439060E+013 0.22485370E+016 0.10047006E+015 0.19198117E+015 0.24562900E+014 0.17594888E+015 0.16143329E+016 0.12955671E+035 0.19459546E+029 0.46090029E+034 0.10403311E+032 0.22004558E+032 0.60748346E+030 0.23410713E+032 0.25168389E+034 0.47774037E+019 0.22299367E+017 0.27874561E+019 0.15230144E+018 0.34100616E+018 0.37951346E+017 0.29438567E+018 0.20684376E+019 +15 0.30000000E-008 0.35236806E-010 0.37245940E+016 0.23126280E+013 0.21728465E+016 0.11041098E+015 0.19870189E+015 0.26993658E+014 0.14782493E+015 0.17377166E+016 0.12865702E+035 0.17829173E+029 0.42459780E+034 0.12613229E+032 0.23110353E+032 0.72542064E+030 0.16118965E+032 0.29021895E+034 0.47664883E+019 0.19226190E+017 0.26726558E+019 0.17464162E+018 0.34886679E+018 0.42346083E+017 0.29568991E+018 0.22206423E+019 diff --git a/programs/standard_3d/tests/test_3d_photoi_chem_rtest.log b/programs/standard_3d/tests/test_3d_photoi_chem_rtest.log index fcc21a59..841ebfeb 100644 --- a/programs/standard_3d/tests/test_3d_photoi_chem_rtest.log +++ b/programs/standard_3d/tests/test_3d_photoi_chem_rtest.log @@ -11,7 +11,7 @@ it time dt sum(e) sum(N2_plus) sum(O2_plus) sum(O2_min) sum(O_min) sum(O3_min) s 9 0.18000000E-008 0.38126697E-010 0.37099528E+016 0.23346759E+013 0.25166727E+016 0.58115014E+014 0.16152496E+015 0.12569465E+014 0.48064274E+015 0.94251212E+015 0.13334525E+035 0.27013794E+029 0.61050073E+034 0.35051990E+031 0.17641651E+032 0.16854888E+030 0.21080264E+033 0.87539145E+033 0.48299262E+019 0.24448643E+017 0.32211625E+019 0.81684085E+017 0.28527799E+018 0.17559706E+017 0.59326360E+018 0.12215285E+019 10 0.20000000E-008 0.38126697E-010 0.37137696E+016 0.24131940E+013 0.24895731E+016 0.65936941E+014 0.16719026E+015 0.14913894E+014 0.38733376E+015 0.10824907E+016 0.13262993E+035 0.26643118E+029 0.59172986E+034 0.44958818E+031 0.18357897E+032 0.23434426E+030 0.13218168E+033 0.11505553E+034 0.48196348E+019 0.26818720E+017 0.31694141E+019 0.92953975E+017 0.29972044E+018 0.20790048E+017 0.46587679E+018 0.14001294E+019 11 0.22000000E-008 0.38126697E-010 0.37174621E+016 0.24242952E+013 0.24447786E+016 0.74012032E+014 0.17307259E+015 0.17297976E+014 0.31423988E+015 0.12204019E+016 0.13187774E+035 0.24732538E+029 0.56464133E+034 0.56477414E+031 0.19148004E+032 0.31151299E+030 0.83673001E+032 0.14566582E+034 0.48093063E+019 0.21948185E+017 0.30939534E+019 0.10506490E+018 0.31277346E+018 0.24897498E+017 0.36584191E+018 0.15750834E+019 -12 0.24000000E-008 0.37184102E-010 0.37206540E+016 0.24167980E+013 0.23873085E+016 0.82410390E+014 0.17917219E+015 0.19709044E+014 0.25681835E+015 0.13554020E+016 0.13117676E+035 0.23119748E+029 0.53244152E+034 0.69911457E+031 0.20028327E+032 0.39989950E+030 0.53671782E+032 0.17896864E+034 0.47989087E+019 0.24562358E+017 0.30017678E+019 0.11857507E+018 0.32370800E+018 0.29217190E+017 0.29036525E+018 0.17452682E+019 -13 0.26000000E-008 0.36653880E-010 0.37231404E+016 0.23823070E+013 0.23210400E+016 0.91193487E+014 0.18549337E+015 0.22133674E+014 0.21164306E+015 0.14868956E+016 0.13037643E+035 0.21053776E+029 0.49719124E+034 0.85557009E+031 0.20974843E+032 0.49864037E+030 0.35041380E+032 0.21442005E+034 0.47882399E+019 0.20453841E+017 0.28982404E+019 0.13396259E+018 0.33300317E+018 0.33594442E+017 0.29055305E+018 0.19099062E+019 -14 0.28000000E-008 0.36225597E-010 0.37247094E+016 0.23515038E+013 0.22489353E+016 0.10047065E+015 0.19203125E+015 0.24563256E+014 0.17601148E+015 0.16144763E+016 0.12956608E+035 0.19535396E+029 0.46094095E+034 0.10402612E+032 0.22013597E+032 0.60747903E+030 0.23423215E+032 0.25169914E+034 0.47775267E+019 0.22308038E+017 0.27875002E+019 0.15227461E+018 0.34104489E+018 0.37948683E+017 0.29664788E+018 0.20684842E+019 -15 0.30000000E-008 0.35839362E-010 0.37252519E+016 0.23234218E+013 0.21732976E+016 0.11040764E+015 0.19876337E+015 0.26994095E+014 0.14791226E+015 0.17378837E+016 0.12866731E+035 0.17955292E+029 0.42464327E+034 0.12611000E+032 0.23122302E+032 0.72541306E+030 0.16137262E+032 0.29023700E+034 0.47666154E+019 0.19217220E+017 0.26726977E+019 0.17458458E+018 0.34932174E+018 0.42342659E+017 0.29992198E+018 0.22206914E+019 +12 0.24000000E-008 0.36572315E-010 0.37206540E+016 0.24167783E+013 0.23873090E+016 0.82410377E+014 0.17917219E+015 0.19709043E+014 0.25681787E+015 0.13554020E+016 0.13117677E+035 0.23120762E+029 0.53244176E+034 0.69911426E+031 0.20028326E+032 0.39989949E+030 0.53671572E+032 0.17896862E+034 0.47989087E+019 0.24564282E+017 0.30017685E+019 0.11857525E+018 0.32370802E+018 0.29217192E+017 0.29036068E+018 0.17452681E+019 +13 0.26000000E-008 0.36048373E-010 0.37231402E+016 0.23822360E+013 0.23210408E+016 0.91193450E+014 0.18549337E+015 0.22133672E+014 0.21164212E+015 0.14868955E+016 0.13037644E+035 0.21053026E+029 0.49719167E+034 0.85556908E+031 0.20974837E+032 0.49864037E+030 0.35041040E+032 0.21442002E+034 0.47882400E+019 0.20456898E+017 0.28982417E+019 0.13396243E+018 0.33300318E+018 0.33594445E+017 0.29055077E+018 0.19099060E+019 +14 0.28000000E-008 0.35619243E-010 0.37247091E+016 0.23515010E+013 0.22489364E+016 0.10047082E+015 0.19203119E+015 0.24563267E+014 0.17601039E+015 0.16144762E+016 0.12956650E+035 0.19536033E+029 0.46094143E+034 0.10402622E+032 0.22013569E+032 0.60747941E+030 0.23422890E+032 0.25169910E+034 0.47775266E+019 0.22309584E+017 0.27875017E+019 0.15226411E+018 0.34104486E+018 0.37948663E+017 0.29664375E+018 0.20684841E+019 +15 0.30000000E-008 0.35239424E-010 0.37252518E+016 0.23234708E+013 0.21732987E+016 0.11040776E+015 0.19876322E+015 0.26994116E+014 0.14791119E+015 0.17378836E+016 0.12866778E+035 0.17957253E+029 0.42464372E+034 0.12610995E+032 0.23122251E+032 0.72541389E+030 0.16137008E+032 0.29023698E+034 0.47666156E+019 0.19218478E+017 0.26726992E+019 0.17458134E+018 0.34932171E+018 0.42342647E+017 0.29992539E+018 0.22206913E+019 diff --git a/programs/standard_3d/tests/test_3d_rtest.log b/programs/standard_3d/tests/test_3d_rtest.log index 565d665d..f85b5fae 100644 --- a/programs/standard_3d/tests/test_3d_rtest.log +++ b/programs/standard_3d/tests/test_3d_rtest.log @@ -11,7 +11,7 @@ it time dt sum(e) sum(M_plus) sum(M_min) sum(e^2) sum(M_plus^2) sum(M_min^2) max 9 0.18000000E-008 0.45000000E-010 0.36887507E+016 0.39458468E+016 0.25709604E+015 0.13222668E+035 0.14978933E+035 0.47652819E+032 0.48168195E+019 0.50455105E+019 0.33091931E+018 10 0.20000000E-008 0.45000000E-010 0.36917900E+016 0.39653505E+016 0.27356056E+015 0.13154583E+035 0.14994070E+035 0.52459323E+032 0.48073578E+019 0.50455105E+019 0.35082662E+018 11 0.22000000E-008 0.45000000E-010 0.36947598E+016 0.39852891E+016 0.29052933E+015 0.13082904E+035 0.15009198E+035 0.57585993E+032 0.47977011E+019 0.50455105E+019 0.36894590E+018 -12 0.24000000E-008 0.38021957E-010 0.36972721E+016 0.40053427E+016 0.30807061E+015 0.13015344E+035 0.15028048E+035 0.63104847E+032 0.47876460E+019 0.50455105E+019 0.38752650E+018 -13 0.26000000E-008 0.37470284E-010 0.36990750E+016 0.40253179E+016 0.32624288E+015 0.12939148E+035 0.15042467E+035 0.69032669E+032 0.47768931E+019 0.50455105E+019 0.40455261E+018 -14 0.28000000E-008 0.37004329E-010 0.36999434E+016 0.40450920E+016 0.34514867E+015 0.12857087E+035 0.15056394E+035 0.75483385E+032 0.47658389E+019 0.50455105E+019 0.42035925E+018 -15 0.30000000E-008 0.36625842E-010 0.36996941E+016 0.40646282E+016 0.36493415E+015 0.12775314E+035 0.15074797E+035 0.82609475E+032 0.47551487E+019 0.50455105E+019 0.43517641E+018 +12 0.24000000E-008 0.37414600E-010 0.36972721E+016 0.40053427E+016 0.30807061E+015 0.13015344E+035 0.15028048E+035 0.63104847E+032 0.47876461E+019 0.50455105E+019 0.38752650E+018 +13 0.26000000E-008 0.36868531E-010 0.36990749E+016 0.40253177E+016 0.32624286E+015 0.12939149E+035 0.15042467E+035 0.69032656E+032 0.47768933E+019 0.50455105E+019 0.40455263E+018 +14 0.28000000E-008 0.36402748E-010 0.36999432E+016 0.40450918E+016 0.34514861E+015 0.12857088E+035 0.15056393E+035 0.75483341E+032 0.47658384E+019 0.50455105E+019 0.42035924E+018 +15 0.30000000E-008 0.36011018E-010 0.36996939E+016 0.40646280E+016 0.36493407E+015 0.12775325E+035 0.15074797E+035 0.82609412E+032 0.47551481E+019 0.50455105E+019 0.43517636E+018 diff --git a/src/definitions.make b/src/definitions.make index 5ddbd39e..5c808666 100644 --- a/src/definitions.make +++ b/src/definitions.make @@ -1,9 +1,9 @@ OBJS := m_units_constants.o m_config.o m_lookup_table.o m_random.o \ m_photoi_mc.o m_streamer.o m_geometry.o m_transport_data.o m_field.o \ m_init_cond.o m_photoi_helmh.o m_photoi.o m_chemistry.o m_types.o \ - m_gas.o m_refine.o m_fluid_lfa.o m_dt.o m_user_methods.o m_table_data.o \ + m_gas.o m_refine.o m_fluid.o m_dt.o m_user_methods.o m_table_data.o \ m_output.o m_analysis.o m_coupling.o m_spline_interp.o \ - m_dielectric.o + m_dielectric.o m_model.o # Hide some incorrect warnings m_photoi_helmh.o: FFLAGS += -Wno-unused-function @@ -21,6 +21,7 @@ m_chemistry.o: m_config.mod m_chemistry.o: m_dt.mod m_chemistry.o: m_gas.mod m_chemistry.o: m_lookup_table.mod +m_chemistry.o: m_model.mod m_chemistry.o: m_table_data.mod m_chemistry.o: m_transport_data.mod m_chemistry.o: m_types.mod @@ -45,16 +46,17 @@ m_field.o: m_table_data.mod m_field.o: m_types.mod m_field.o: m_units_constants.mod m_field.o: m_user_methods.mod -m_fluid_lfa.o: m_chemistry.mod -m_fluid_lfa.o: m_dielectric.mod -m_fluid_lfa.o: m_dt.mod -m_fluid_lfa.o: m_field.mod -m_fluid_lfa.o: m_gas.mod -m_fluid_lfa.o: m_lookup_table.mod -m_fluid_lfa.o: m_photoi.mod -m_fluid_lfa.o: m_streamer.mod -m_fluid_lfa.o: m_transport_data.mod -m_fluid_lfa.o: m_units_constants.mod +m_fluid.o: m_chemistry.mod +m_fluid.o: m_dielectric.mod +m_fluid.o: m_dt.mod +m_fluid.o: m_field.mod +m_fluid.o: m_gas.mod +m_fluid.o: m_lookup_table.mod +m_fluid.o: m_model.mod +m_fluid.o: m_photoi.mod +m_fluid.o: m_streamer.mod +m_fluid.o: m_transport_data.mod +m_fluid.o: m_units_constants.mod m_gas.o: m_config.mod m_gas.o: m_dt.mod m_gas.o: m_types.mod @@ -67,6 +69,8 @@ m_init_cond.o: m_geometry.mod m_init_cond.o: m_streamer.mod m_init_cond.o: m_types.mod m_init_cond.o: m_user_methods.mod +m_model.o: m_config.mod +m_model.o: m_types.mod m_output.o: m_analysis.mod m_output.o: m_chemistry.mod m_output.o: m_config.mod @@ -93,6 +97,7 @@ m_photoi_mc.o: m_lookup_table.mod m_photoi_mc.o: m_random.mod m_photoi_mc.o: m_streamer.mod m_photoi_mc.o: m_units_constants.mod +m_photoi.o: m_chemistry.mod m_photoi.o: m_config.mod m_photoi.o: m_gas.mod m_photoi.o: m_lookup_table.mod @@ -112,8 +117,10 @@ m_refine.o: m_transport_data.mod m_refine.o: m_user_methods.mod m_streamer.o: m_chemistry.mod m_streamer.o: m_config.mod +m_streamer.o: m_dt.mod m_streamer.o: m_gas.mod m_streamer.o: m_lookup_table.mod +m_streamer.o: m_model.mod m_streamer.o: m_random.mod m_streamer.o: m_transport_data.mod m_streamer.o: m_types.mod @@ -125,6 +132,7 @@ m_table_data.o: m_types.mod m_transport_data.o: m_config.mod m_transport_data.o: m_gas.mod m_transport_data.o: m_lookup_table.mod +m_transport_data.o: m_model.mod m_transport_data.o: m_spline_interp.mod m_transport_data.o: m_table_data.mod m_transport_data.o: m_types.mod @@ -139,6 +147,7 @@ streamer.o: m_field.mod streamer.o: m_fluid_lfa.mod streamer.o: m_gas.mod streamer.o: m_init_cond.mod +streamer.o: m_model.mod streamer.o: m_output.mod streamer.o: m_photoi.mod streamer.o: m_refine.mod @@ -146,5 +155,6 @@ streamer.o: m_streamer.mod streamer.o: m_table_data.mod streamer.o: m_transport_data.mod streamer.o: m_types.mod +streamer.o: m_units_constants.mod streamer.o: m_user_methods.mod streamer.o: m_user.mod diff --git a/src/m_chemistry.f90 b/src/m_chemistry.f90 index 2e8b8c59..6022d3a7 100644 --- a/src/m_chemistry.f90 +++ b/src/m_chemistry.f90 @@ -5,6 +5,7 @@ module m_chemistry use m_af_all use m_lookup_table use m_table_data + use m_model implicit none private @@ -53,6 +54,9 @@ module m_chemistry integer, allocatable :: multiplicity_out(:) end type tiny_react_t + !> Reaction with a field-dependent reaction rate + integer, parameter :: rate_tabulated_energy = 0 + !> Reaction with a field-dependent reaction rate integer, parameter :: rate_tabulated_field = 1 @@ -143,8 +147,11 @@ module m_chemistry !> A copy of the list of reactions for performance reasons type(tiny_react_t) :: tiny_react(max_num_reactions) - !> Lookup table with reaction rates - type(LT_t) :: chemtbl + !> Lookup table with reaction rates versus field + type(LT_t) :: chemtbl_fld + + !> Lookup table with reaction rates versus electron energy + type(LT_t) :: chemtbl_ee !> List with indices of charged species integer, allocatable, protected :: charged_species_itree(:) @@ -176,7 +183,7 @@ subroutine chemistry_initialize(tree, cfg) use m_dt type(af_t), intent(inout) :: tree type(CFG_t), intent(inout) :: cfg - integer :: n, i, i_elec + integer :: n, i, j, i_elec, rtype character(len=string_len) :: reaction_file character(len=comp_len) :: tmp_name logical :: read_success @@ -213,7 +220,7 @@ subroutine chemistry_initialize(tree, cfg) reactions(1)%y_data = td_tbl%rows_cols(:, td_alpha) * & td_tbl%rows_cols(:, td_mobility) * reactions(1)%x_data * & Townsend_to_SI * gas_number_density - reactions(1)%description = "e + M > e + e + M+" + reactions(1)%description = "e + M -> e + e + M+" ! Attachment reaction reactions(2)%ix_in = [1] @@ -226,12 +233,18 @@ subroutine chemistry_initialize(tree, cfg) reactions(2)%y_data = td_tbl%rows_cols(:, td_eta) * & td_tbl%rows_cols(:, td_mobility) * reactions(2)%x_data * & Townsend_to_SI * gas_number_density - reactions(2)%description = "e + M > M-" + reactions(2)%description = "e + M -> M-" else error stop "Varying gas density not yet supported" end if end if + ! In case of energy equation, add an extra species + if (model_has_energy_equation) then + n_species = n_species + 1 + species_list(n_species) = "e_energy" + end if + ! Convert names to simple ascii do n = 1, n_species tmp_name = species_list(n) @@ -239,27 +252,6 @@ subroutine chemistry_initialize(tree, cfg) species_charge(n)) end do - ! Store reactions of the tabulated field type - i = count(reactions(1:n_reactions)%rate_type == rate_tabulated_field) - chemtbl = LT_create(table_min_townsend, table_max_townsend, & - table_size, i, table_xspacing) - - i = 0 - do n = 1, n_reactions - if (reactions(n)%rate_type == rate_tabulated_field) then - i = i + 1 - reactions(n)%lookup_table_index = i - if (td_bulk_scale_reactions) then - call table_set_column(chemtbl, i, reactions(n)%x_data, & - reactions(n)%y_data * & - LT_get_col(td_tbl, td_bulk_scaling, reactions(n)%x_data)) - else - call table_set_column(chemtbl, i, reactions(n)%x_data, & - reactions(n)%y_data) - end if - end if - end do - ! Also store in more memory-efficient structure do n = 1, n_reactions tiny_react(n)%ix_in = reactions(n)%ix_in @@ -318,6 +310,57 @@ subroutine chemistry_initialize(tree, cfg) end if end do + ! Create lookup tables for tabulated reaction data. First determine number + ! of reactions. In case of an energy equation, ionization and attachment + ! reactions are converted to use the electron energy instead of the field. + i = 0 + j = count(reactions(1:n_reactions)%rate_type == rate_tabulated_energy) + do n = 1, n_reactions + if (reactions(n)%rate_type == rate_tabulated_field) then + rtype = reactions(n)%reaction_type + if (model_has_energy_equation .and. (rtype == ionization_reaction & + .or. rtype == attachment_reaction)) then + j = j + 1 + else + i = i + 1 + end if + end if + end do + + chemtbl_fld = LT_create(td_tbl%x(1), td_tbl%x(td_tbl%n_points), & + table_size, i, table_xspacing) + chemtbl_ee = LT_create(0.0_dp, td_max_eV, & + table_size, j, table_xspacing) + + i = 0 + j = 0 + do n = 1, n_reactions + if (reactions(n)%rate_type == rate_tabulated_field) then + rtype = reactions(n)%reaction_type + + if (model_has_energy_equation .and. (rtype == ionization_reaction & + .or. rtype == attachment_reaction)) then + reactions(n)%rate_type = rate_tabulated_energy + j = j + 1 + reactions(n)%lookup_table_index = j + ! Convert field to energy + call table_set_column(chemtbl_ee, j, & + LT_get_col(td_tbl, td_energy_eV, reactions(n)%x_data), & + reactions(n)%y_data) + else + i = i + 1 + reactions(n)%lookup_table_index = i + call table_set_column(chemtbl_fld, i, reactions(n)%x_data, & + reactions(n)%y_data) + end if + else if (reactions(n)%rate_type == rate_tabulated_energy) then + j = j + 1 + reactions(n)%lookup_table_index = j + call table_set_column(chemtbl_ee, j, reactions(n)%x_data, & + reactions(n)%y_data) + end if + end do + print *, "--- List of reactions ---" do n = 1, n_reactions write(*, "(I4,' (',I0,') ',A15,A)") n, reactions(n)%n_species_in, & @@ -346,7 +389,7 @@ subroutine chemistry_write_summary(fname) use m_gas use m_transport_data character(len=*), intent(in) :: fname - real(dp), allocatable :: fields(:) + real(dp), allocatable :: fields(:), energies(:) real(dp), allocatable :: rates(:, :) real(dp), allocatable :: eta(:), alpha(:), src(:), loss(:) real(dp), allocatable :: v(:), mu(:), diff(:) @@ -360,13 +403,20 @@ subroutine chemistry_write_summary(fname) if (n_fields < 3) error stop "Not enough data for linear extrapolation" allocate(fields(n_fields)) - fields = td_tbl%x - + allocate(energies(n_fields)) allocate(rates(n_fields, n_reactions)) allocate(eta(n_fields), alpha(n_fields), src(n_fields), loss(n_fields)) - call get_rates(fields, rates, n_fields) - loss(:) = 0.0_dp + fields = td_tbl%x + + if (model_has_energy_equation) then + energies = LT_get_col(td_tbl, td_energy_eV, td_tbl%x) + call get_rates(fields, rates, n_fields, energies) + else + call get_rates(fields, rates, n_fields) + end if + + loss(:) = 0.0_dp src(:) = 0.0_dp do n = 1, n_reactions @@ -433,15 +483,22 @@ subroutine chemistry_get_breakdown_field(field_td, min_growth_rate) real(dp), intent(in) :: min_growth_rate integer :: n, n_fields + real(dp), allocatable :: energies(:) real(dp), allocatable :: fields(:), rates(:, :), src(:), loss(:) n_fields = td_tbl%n_points allocate(fields(n_fields)) - fields = td_tbl%x - + allocate(energies(n_fields)) allocate(rates(n_fields, n_reactions)) allocate(src(n_fields), loss(n_fields)) - call get_rates(fields, rates, n_fields) + + fields = td_tbl%x + if (model_has_energy_equation) then + energies = LT_get_col(td_tbl, td_energy_eV, td_tbl%x) + call get_rates(fields, rates, n_fields, energies) + else + call get_rates(fields, rates, n_fields) + end if loss(:) = 0.0_dp src(:) = 0.0_dp @@ -465,13 +522,14 @@ end subroutine chemistry_get_breakdown_field !> Compute reaction rates !> !> @todo These reactions do not take into account a variable gas_temperature - subroutine get_rates(fields, rates, n_cells) + subroutine get_rates(fields, rates, n_cells, energy_eV) use m_units_constants use m_gas use m_transport_data integer, intent(in) :: n_cells !< Number of cells real(dp), intent(in) :: fields(n_cells) !< The field (in Td) in the cells real(dp), intent(out) :: rates(n_cells, n_reactions) !< The reaction rates + real(dp), intent(in), optional :: energy_eV(n_cells) !< Electron energy in eV integer :: n, n_coeff real(dp) :: c0, c(rate_max_num_coeff) real(dp) :: Te(n_cells) !> Electron Temperature in Kelvin @@ -493,8 +551,12 @@ subroutine get_rates(fields, rates, n_cells) c(1:n_coeff) = reactions(n)%rate_data(1:n_coeff) select case (reactions(n)%rate_type) + case (rate_tabulated_energy) + if (.not. present(energy_eV)) error stop "energy_eV required" + rates(:, n) = c0 * LT_get_col(chemtbl_ee, & + reactions(n)%lookup_table_index, energy_eV) case (rate_tabulated_field) - rates(:, n) = c0 * LT_get_col(chemtbl, & + rates(:, n) = c0 * LT_get_col(chemtbl_fld, & reactions(n)%lookup_table_index, fields) case (rate_analytic_constant) rates(:, n) = c0 * c(1) @@ -506,6 +568,8 @@ subroutine get_rates(fields, rates, n_cells) rates(:, n) = c0 * c(1) * exp(-(fields/c(2))**2) case (rate_analytic_k1) if (.not. Te_available) then + ! Note that we could use energy_eV if present, but this energy is + ! not guaranteed to be well-behaved Te = electron_eV_to_K * LT_get_col(td_tbl, td_energy_eV, fields) end if rates(:, n) = c0 * c(1) * (300 / Te)**c(2) @@ -538,11 +602,13 @@ subroutine get_rates(fields, rates, n_cells) case (rate_analytic_k14) rates(:, n) = c0 * c(1) * exp(-(fields / c(2))**c(3)) case (rate_analytic_k15) - ! Note that this reaction depends on Ti, ionic temperature, which according to Galimberti(1979), - ! Ti = T_gas + fields/c(3), with c(3) = 0.18 Td/Kelvin, UC_boltzmann_const is in J/Kelvin, - ! c(2) is given in Joule in the input file - rates(:, n) = c0 * c(1) * exp(-(c(2) / (UC_boltzmann_const * (gas_temperature + fields/c(3))))**c(4)) - end select + ! Note that this reaction depends on Ti, ionic temperature. + ! According to Galimberti(1979): Ti = T_gas + fields/c(3), + ! with c(3) = 0.18 Td/Kelvin, UC_boltzmann_const is in J/Kelvin, c(2) + ! is given in Joule in the input file + rates(:, n) = c0 * c(1) * exp(-(c(2) / (UC_boltzmann_const * & + (gas_temperature + fields/c(3))))**c(4)) + end select end do end subroutine get_rates diff --git a/src/m_dt.f90 b/src/m_dt.f90 index db3c10b4..fd3bd6c8 100644 --- a/src/m_dt.f90 +++ b/src/m_dt.f90 @@ -10,19 +10,19 @@ module m_dt integer, parameter, public :: dt_num_cond = 4 ! Array of time step restrictions per thread - real(dp), allocatable, public :: dt_matrix(:, :) + real(dp), public :: dt_limits(dt_num_cond) ! Index of CFL condition integer, parameter, public :: dt_ix_cfl = 1 - ! Index of diffusion time step condition - integer, parameter, public :: dt_ix_diff = 2 - ! Index of dielectric relaxation time step condition - integer, parameter, public :: dt_ix_drt = 3 + integer, parameter, public :: dt_ix_drt = 2 ! Index of reaction rate time step condition - integer, parameter, public :: dt_ix_rates = 4 + integer, parameter, public :: dt_ix_rates = 3 + + ! Index of other time step restrictions + integer, parameter, public :: dt_ix_other = 4 ! Safety factor for the time step real(dp), public, protected :: dt_safety_factor = 0.9_dp @@ -52,9 +52,7 @@ module m_dt !> Initialize the time step module subroutine dt_initialize(cfg) use m_config - use omp_lib type(CFG_t), intent(inout) :: cfg - integer :: n_threads real(dp) :: default_cfl_number = 0.5_dp character(len=name_len) :: integrator @@ -93,11 +91,6 @@ subroutine dt_initialize(cfg) ! Set CFL number automatically if not set if (dt_cfl_number <= undefined_real) dt_cfl_number = default_cfl_number - n_threads = af_get_max_threads() - ! Prevent cache invalidation issues by enlarging the array - allocate(dt_matrix(dt_num_cond+32, n_threads)) - dt_matrix(:, :) = 0.0_dp - end subroutine dt_initialize end module m_dt diff --git a/src/m_field.f90 b/src/m_field.f90 index f361d669..c9999585 100644 --- a/src/m_field.f90 +++ b/src/m_field.f90 @@ -79,6 +79,7 @@ module m_field public :: field_bc_homogeneous public :: field_from_potential + public :: field_compute_energy contains @@ -579,4 +580,49 @@ function conical_rod_top_lsf(r) result(lsf) end if end function conical_rod_top_lsf + !> Compute total field energy in Joule, defined as the volume integral over + !> 1/2 * epsilon * E^2 + subroutine field_compute_energy(tree, field_energy) + type(af_t), intent(in) :: tree + real(dp), intent(out) :: field_energy + + call af_reduction(tree, field_energy_box, reduce_sum, 0.0_dp, field_energy) + end subroutine field_compute_energy + + !> Get the electrostatic field energy in a box + real(dp) function field_energy_box(box) + use m_units_constants + type(box_t), intent(in) :: box +#if NDIM == 2 + integer :: i + real(dp), parameter :: twopi = 2 * acos(-1.0_dp) +#endif + real(dp) :: w(DTIMES(box%n_cell)) + integer :: nc + + nc = box%n_cell + + if (ST_use_dielectric) then + w = 0.5_dp * UC_eps0 * box%cc(DTIMES(1:nc), i_eps) * product(box%dr) + else + w = 0.5_dp * UC_eps0 * product(box%dr) + end if + +#if NDIM == 2 + if (box%coord_t == af_cyl) then + ! Weight by 2 * pi * r + do i = 1, nc + w(i, :) = w(i, :) * twopi * af_cyl_radius_cc(box, i) + end do + end if +#endif + + field_energy_box = sum(w * box%cc(DTIMES(1:nc), i_electric_fld)**2) + end function field_energy_box + + real(dp) function reduce_sum(a, b) + real(dp), intent(in) :: a, b + reduce_sum = a + b + end function reduce_sum + end module m_field diff --git a/src/m_fluid.f90 b/src/m_fluid.f90 new file mode 100644 index 00000000..e021f2a5 --- /dev/null +++ b/src/m_fluid.f90 @@ -0,0 +1,716 @@ +#include "../afivo/src/cpp_macros.h" +!> Fluid model module +module m_fluid_lfa + use m_af_all + use m_streamer + use m_model + + implicit none + private + + logical, private :: last_step + + ! Public methods + public :: forward_euler + +contains + + !> Advance fluid model using forward Euler step. If the equation is written as + !> y' = f(y), the result is: y(s_out) = y(s_prev) + f(y(s_dt)), where the + !> s_... refer to temporal states. + subroutine forward_euler(tree, dt, dt_stiff, dt_lim, time, s_deriv, n_prev, & + s_prev, w_prev, s_out, i_step, n_steps) + use m_chemistry + use m_field + use m_dt + use m_transport_data + use m_dielectric + type(af_t), intent(inout) :: tree + real(dp), intent(in) :: dt !< Time step + real(dp), intent(in) :: dt_stiff !< Time step for stiff terms (IMEX) + real(dp), intent(inout) :: dt_lim !< Computed time step limit + real(dp), intent(in) :: time !< Current time + integer, intent(in) :: s_deriv !< State to compute derivatives from + integer, intent(in) :: n_prev !< Number of previous states + integer, intent(in) :: s_prev(n_prev) !< Previous states + real(dp), intent(in) :: w_prev(n_prev) !< Weights of previous states + integer, intent(in) :: s_out !< Output state + integer, intent(in) :: i_step !< Step of the integrator + integer, intent(in) :: n_steps !< Total number of steps + integer :: ix, id_out + + ! Set current rates to zero; they are summed below + ST_current_rates = 0 + ST_current_JdotE = 0 + + last_step = (i_step == n_steps) + + ! Since field_compute is called after performing time integration, we don't + ! have to call it again for the first sub-step of the next iteration + if (i_step > 1) call field_compute(tree, mg, s_deriv, time, .true.) + + call flux_upwind_tree(tree, flux_num_species, flux_species, s_deriv, & + flux_variables, 2, dt_limits(1:2), flux_upwind, flux_direction, & + flux_dummy_line_modify, af_limiter_koren_t) + + if (transport_data_ions%n_mobile_ions > 0 .and. & + ion_se_yield > 0.0_dp) then + ! Handle secondary electron emission from ions + call af_loop_box(tree, handle_ion_se_flux, .true.) + end if + + call flux_update_densities(tree, dt, size(all_densities), & + all_densities, flux_num_species, & + flux_species, flux_variables, s_deriv, n_prev, s_prev, & + w_prev, s_out, add_source_terms, 2, dt_limits(3:4), set_box_mask) + + if (ST_use_dielectric) then + ! Update surface charge and handle photon emission + ! @todo For parallelization, think about corner cells with two surfaces + do ix = 1, diel%max_ix + if (diel%surfaces(ix)%in_use) then + id_out = diel%surfaces(ix)%id_out + + ! Convert fluxes onto dielectric to surface charge, and handle + ! secondary emission + call dielectric_update_surface_charge(tree%boxes(id_out), & + diel%surfaces(ix), dt, n_prev, s_prev, w_prev, s_out) + + ! Add secondary emission from photons hitting the surface + call dielectric_photon_emission(tree%boxes(id_out), & + diel%surfaces(ix), dt, s_out) + end if + end do + end if + + ! Set time step limit + dt_limits(1) = dt_limits(1) * dt_cfl_number + dt_lim = min(dt_max, minval(dt_limits)) + end subroutine forward_euler + + !> Compute flux for the fluid model + subroutine flux_upwind(nf, n_var, flux_dim, u, flux, cfl_sum, & + n_other_dt, other_dt, box, line_ix, s_deriv) + use m_af_flux_schemes + use m_units_constants + use m_gas + use m_lookup_table + use m_transport_data + integer, intent(in) :: nf !< Number of cell faces + integer, intent(in) :: n_var !< Number of variables + integer, intent(in) :: flux_dim !< In which dimension fluxes are computed + real(dp), intent(in) :: u(nf, n_var) !< Face values + real(dp), intent(out) :: flux(nf, n_var) !< Computed fluxes + !> Terms per cell-center to be added to CFL sum, see flux_upwind_box + real(dp), intent(out) :: cfl_sum(nf-1) + integer, intent(in) :: n_other_dt !< Number of non-cfl time step restrictions + real(dp), intent(inout) :: other_dt(n_other_dt) !< Non-cfl time step restrictions + type(box_t), intent(in) :: box !< Current box + integer, intent(in) :: line_ix(NDIM-1) !< Index of line for dim /= flux_dim + integer, intent(in) :: s_deriv !< State to compute derivatives from + + real(dp), parameter :: five_third = 5/3.0_dp + + real(dp) :: E_cc(0:nf) !< Cell-centered field strengths + real(dp) :: E_x(nf) !< Face-centered field components + real(dp) :: N_gas(0:nf) !< Gas number density at cell centers + real(dp) :: ne_cc(0:nf) !< Electron density at cell centers + real(dp) :: en_cc(0:nf) !< Electron energy density at cell centers + real(dp) :: v(nf) !< Velocity at cell faces + real(dp) :: dc(nf) !< Diffusion coefficient at cell faces + real(dp) :: tmp_fc(nf), N_inv(nf) + real(dp) :: mu(nf), sigma(nf), inv_dx, cfl_factor + integer :: n, nc, flux_ix + + nc = box%n_cell + inv_dx = 1/box%dr(flux_dim) + + ! Inside dielectrics, set the flux to zero + if (ST_use_dielectric) then + if (box%cc(DTIMES(1), i_eps) > 1.0_dp) then + flux = 0.0_dp + return + end if + end if + + if (gas_constant_density) then + N_inv = 1/gas_number_density + else + ! Compute gas number density at cell faces + call flux_get_line_1cc(box, i_gas_dens, flux_dim, line_ix, N_gas) + do n = 1, nc+1 + N_inv(n) = 2 / (N_gas(n-1) + N_gas(n)) + end do + end if + + call flux_get_line_1fc(box, electric_fld, flux_dim, line_ix, E_x) + call flux_get_line_1cc(box, i_electron+s_deriv, flux_dim, line_ix, ne_cc) + + if (model_has_energy_equation) then + call flux_get_line_1cc(box, i_electron_energy+s_deriv, & + flux_dim, line_ix, en_cc) + + ! Get mean electron energies at cell faces + tmp_fc = mean_electron_energy(u(:, 2), u(:, 1)) + mu = LT_get_col(td_ee_tbl, td_ee_mobility, tmp_fc) * N_inv + dc = LT_get_col(td_ee_tbl, td_ee_diffusion, tmp_fc) * N_inv + else + call flux_get_line_1cc(box, i_electric_fld, flux_dim, line_ix, E_cc) + + ! Compute field strength at cell faces, which is used to compute the + ! mobility and diffusion coefficient at the interface + tmp_fc = 0.5_dp * (E_cc(0:nc) + E_cc(1:nc+1)) * SI_to_Townsend * N_inv + mu = LT_get_col(td_tbl, td_mobility, tmp_fc) * N_inv + dc = LT_get_col(td_tbl, td_diffusion, tmp_fc) * N_inv + end if + + ! Compute velocity, -mu accounts for negative electron charge + v = -mu * E_x + + ! Combine advective and diffusive flux + flux(:, 1) = v * u(:, 1) - dc * inv_dx * (ne_cc(1:nc+1) - ne_cc(0:nc)) + + ! Electron conductivity + sigma = mu * u(:, 1) + + if (model_has_energy_equation) then + flux(:, 2) = five_third * (v * u(:, 2) - & + dc * inv_dx * (en_cc(1:nc+1) - en_cc(0:nc))) + cfl_factor = five_third + else + cfl_factor = 1.0_dp + end if + + ! Used to determine electron CFL time step + cfl_sum = cfl_factor * max(abs(v(2:)), abs(v(:nf-1))) * inv_dx + & + 2 * max(dc(2:), dc(:nf-1)) * inv_dx**2 + + ! Ion fluxes (note: ions are slow, so their CFL condition is ignored) + do n = 1, transport_data_ions%n_mobile_ions + flux_ix = flux_num_electron_vars + n + mu = transport_data_ions%mobilities(n) * N_inv + v = flux_species_charge_sign(flux_ix) * mu * E_x + flux(:, flux_ix) = v * u(:, flux_ix) + sigma = sigma + mu * u(:, flux_ix) + end do + + ! Dielectric relaxation time + other_dt(1) = UC_eps0 / (UC_elem_charge * max(maxval(sigma), 1e-100_dp)) + end subroutine flux_upwind + + !> Determine the direction of fluxes + subroutine flux_direction(box, line_ix, s_deriv, n_var, flux_dim, direction_positive) + type(box_t), intent(in) :: box !< Current box + integer, intent(in) :: line_ix(NDIM-1) !< Index of line for dim /= flux_dim + integer, intent(in) :: s_deriv !< State to compute derivatives from + integer, intent(in) :: flux_dim !< In which dimension fluxes are computed + integer, intent(in) :: n_var !< Number of variables + !> True means positive flow (to the "right"), false to the left + logical, intent(out) :: direction_positive(box%n_cell+1, n_var) + real(dp) :: E_x(box%n_cell+1) + integer :: n + + call flux_get_line_1fc(box, electric_fld, flux_dim, line_ix, E_x) + do n = 1, n_var + direction_positive(:, n) = (flux_species_charge_sign(n) * E_x > 0) + end do + end subroutine flux_direction + + !> Get average of cell-centered quantity at a cell face + pure function cc_average_at_cell_face(box, IJK, idim, iv) result(avg) + type(box_t), intent(in) :: box + integer, intent(in) :: IJK !< Face index + integer, intent(in) :: idim !< Direction of the cell face + integer, intent(in) :: iv !< Index of cell-centered variable + real(dp) :: avg + +#if NDIM == 1 + avg = 0.5_dp * (box%cc(i-1, iv) + box%cc(i, iv)) +#elif NDIM == 2 + select case (idim) + case (1) + avg = 0.5_dp * (box%cc(i-1, j, iv) + box%cc(i, j, iv)) + case default + avg = 0.5_dp * (box%cc(i, j-1, iv) + box%cc(i, j, iv)) + end select +#elif NDIM == 3 + select case (idim) + case (1) + avg = 0.5_dp * (box%cc(i-1, j, k, iv) + box%cc(i, j, k, iv)) + case (2) + avg = 0.5_dp * (box%cc(i, j-1, k, iv) + box%cc(i, j, k, iv)) + case default + avg = 0.5_dp * (box%cc(i, j, k-1, iv) + box%cc(i, j, k, iv)) + end select +#endif + end function cc_average_at_cell_face + + !> Get inner product of face-centered variables + pure function fc_inner_product(box, IJK, flux_a, flux_b) result(inprod) + type(box_t), intent(in) :: box + integer, intent(in) :: IJK !< Face index + integer, intent(in) :: flux_a !< Index of first face-centered variable + integer, intent(in) :: flux_b !< Index of second face-centered variable + real(dp) :: inprod + + inprod = 0.5_dp * sum(box%fc(IJK, :, flux_a) * box%fc(IJK, :, flux_b)) +#if NDIM == 1 + inprod = inprod + 0.5_dp * (& + box%fc(i+1, 1, flux_a) * box%fc(i+1, 1, flux_b)) +#elif NDIM == 2 + inprod = inprod + 0.5_dp * (& + box%fc(i+1, j, 1, flux_a) * box%fc(i+1, j, 1, flux_b) + & + box%fc(i, j+1, 2, flux_a) * box%fc(i, j+1, 2, flux_b)) +#elif NDIM == 3 + inprod = inprod + 0.5_dp * (& + box%fc(i+1, j, k, 1, flux_a) * box%fc(i+1, j, k, 1, flux_b) + & + box%fc(i, j+1, k, 2, flux_a) * box%fc(i, j+1, k, 2, flux_b) + & + box%fc(i, j, k+1, 3, flux_a) * box%fc(i, j, k+1, 3, flux_b)) +#endif + end function fc_inner_product + + !> Get inverse gas density at a cell face, between cell-centered index i-1 and + !> i along dimension idim + pure real(dp) function get_N_inv_face(box, IJK, idim) + use m_gas + type(box_t), intent(in) :: box + integer, intent(in) :: IJK + integer, intent(in) :: idim !< Direction of flux through cell face + + if (gas_constant_density) then + get_N_inv_face = gas_inverse_number_density + else + get_N_inv_face = 1 / cc_average_at_cell_face(box, IJK, idim, i_gas_dens) + end if + end function get_N_inv_face + + !> Add chemistry and photoionization source terms + subroutine add_source_terms(box, dt, n_vars, i_cc, s_deriv, s_out, n_dt, dt_lim, mask) + use omp_lib + use m_units_constants + use m_gas + use m_chemistry + use m_photoi + use m_dt + use m_lookup_table + use m_transport_data + type(box_t), intent(inout) :: box + real(dp), intent(in) :: dt + integer, intent(in) :: n_vars + integer, intent(in) :: i_cc(n_vars) + integer, intent(in) :: s_deriv + integer, intent(in) :: s_out + integer, intent(in) :: n_dt + real(dp), intent(inout) :: dt_lim(n_dt) + logical, intent(in) :: mask(DTIMES(box%n_cell)) + + real(dp) :: tmp, gain, loss_rate + real(dp) :: rates(box%n_cell**NDIM, n_reactions) + real(dp) :: derivs(box%n_cell**NDIM, n_species) + real(dp) :: dens(box%n_cell**NDIM, n_species) + real(dp) :: fields(box%n_cell**NDIM), box_rates(n_reactions) + real(dp) :: source_factor(box%n_cell**NDIM) + real(dp) :: mean_energies(box%n_cell**NDIM) + integer :: IJK, ix, nc, n_cells, n, iv + integer :: tid + real(dp), parameter :: eps = 1e-100_dp + + nc = box%n_cell + n_cells = box%n_cell**NDIM + + ! Skip this routine if there are no cells to update + if (.not. any(mask)) return + + if (gas_constant_density) then + ! Compute field in Townsends + tmp = 1 / gas_number_density + fields = SI_to_Townsend * tmp * & + pack(box%cc(DTIMES(1:nc), i_electric_fld), .true.) + else + do n = 1, n_gas_species + dens(:, n) = gas_fractions(n) * & + pack(box%cc(DTIMES(1:nc), i_gas_dens), .true.) + end do + + fields(:) = SI_to_Townsend * pack( & + box%cc(DTIMES(1:nc), i_electric_fld) / & + box%cc(DTIMES(1:nc), i_gas_dens), .true.) + end if + + dens(:, n_gas_species+1:n_species) = reshape(box%cc(DTIMES(1:nc), & + species_itree(n_gas_species+1:n_species)+s_deriv), [n_cells, n_plasma_species]) + + ! It is assumed that species densities should be non-negative. When + ! computing the effect of chemical reactions, this can also help with + ! stability, see e.g. http://dx.doi.org/10.1088/1749-4699/6/1/015001 + dens = max(dens, 0.0_dp) + + if (model_has_energy_equation) then + mean_energies = pack(mean_electron_energy(& + box%cc(DTIMES(1:nc), i_electron_energy+s_out), & + box%cc(DTIMES(1:nc), i_electron+s_out)), .true.) + call get_rates(fields, rates, n_cells, mean_energies) + else + mean_energies = 0.0_dp + call get_rates(fields, rates, n_cells) + end if + + if (ST_source_factor /= source_factor_none) then + if (ST_source_factor /= source_factor_none) then + call compute_source_factor(box, nc, dens(:, ix_electron), & + fields, s_deriv, source_factor) + else + source_factor(:) = 1.0_dp + end if + + if (ST_source_min_electrons_per_cell > 0) then + ! Prevent ionization in cells with a low number of electrons. Note + ! that that the radius is not taken into account for axisymmetric + ! cases, as this would lead to artifacts. + where (dens(:, ix_electron) * minval(box%dr)**3 < & + ST_source_min_electrons_per_cell) + source_factor = 0.0_dp + end where + end if + + if (i_srcfac > 0) then + ! Write source factor to variable + box%cc(DTIMES(1:nc), i_srcfac) = & + reshape(source_factor, [DTIMES(nc)]) + end if + + do n = 1, n_reactions + if (reactions(n)%reaction_type == ionization_reaction) then + rates(:, n) = rates(:, n) * source_factor + end if + end do + end if + + ! Note that this routine updates its rates argument + call get_derivatives(dens, rates, derivs, n_cells) + + if (last_step) then + tid = omp_get_thread_num() + 1 + + ! Update chemistry time step. Note that 'dens' is already non-negative. + if (dt_chemistry_nmin > 0) then + ! The time step is restricted by both the production and destruction + ! rate of species + tmp = minval((dens + dt_chemistry_nmin) / max(abs(derivs), eps)) + else + ! Prevent negative values due to too much removal of a species + tmp = minval(max(dens, eps) / max(-derivs, eps)) + end if + + dt_lim(1) = tmp + + ! Keep track of chemical production at last time integration step + call chemical_rates_box(box, nc, rates, box_rates) + + !> Integrate rates over space and time into global storage + ST_current_rates(1:n_reactions, tid) = & + ST_current_rates(1:n_reactions, tid) + box_rates + + ! Keep track of J.E + call sum_global_JdotE(box, tid) + end if + + ix = 0 + do KJI_DO(1,nc) + ix = ix + 1 + if (.not. mask(IJK)) cycle + + if (photoi_enabled) then + derivs(ix, ix_electron) = derivs(ix, ix_electron) + & + box%cc(IJK, i_photo) + derivs(ix, photoi_species_index) = & + derivs(ix, photoi_species_index) + box%cc(IJK, i_photo) + end if + + if (model_has_energy_equation) then + gain = -fc_inner_product(box, IJK, flux_elec, electric_fld) + loss_rate = LT_get_col(td_ee_tbl, td_ee_loss, mean_energies(ix)) + box%cc(IJK, i_electron_energy+s_out) = box%cc(IJK, i_electron_energy+s_out) & + + dt * (gain - loss_rate * box%cc(IJK, i_electron+s_out)) + end if + + do n = n_gas_species+1, n_species + iv = species_itree(n) + box%cc(IJK, iv+s_out) = box%cc(IJK, iv+s_out) + dt * derivs(ix, n) + end do + end do; CLOSE_DO + + tmp = maxval(mean_energies) + if (tmp > 0) then + ! Set time step restriction for energy loss + dt_lim(2) = tmp/LT_get_col(td_ee_tbl, td_ee_loss, tmp) + end if + + end subroutine add_source_terms + + !> Set a mask to true in the gas phase, where the solution should be updated + subroutine set_box_mask(box, mask) + type(box_t), intent(in) :: box + logical, intent(out) :: mask(DTIMES(box%n_cell)) + integer :: n, nc, IJK + real(dp) :: coords(box%n_cell, NDIM), r(NDIM) + real(dp), parameter :: eps = 1e-10_dp + + nc = box%n_cell + mask = .true. + + ! Do no update chemistry inside electrode + if (ST_use_electrode) then + where (box%cc(DTIMES(1:nc), i_lsf) <= 0.0_dp) + mask = .false. + end where + end if + + ! Inside a dielectric, do not update the species densities + if (ST_use_dielectric) then + where (abs(box%cc(DTIMES(1:nc), i_eps) - 1) > eps) + mask = .false. + end where + end if + + ! Optionally limit chemistry to a particular region + if (ST_plasma_region_enabled) then + ! Compute box coordinates + do n = 1, NDIM + coords(:, n) = box%r_min(n) + box%dr(n) * [(i-0.5_dp, i=1,nc)] + end do + + do KJI_DO(1,nc) + r(1) = coords(i, 1) +#if NDIM > 1 + r(2) = coords(j, 2) +#endif +#if NDIM > 2 + r(3) = coords(k, 3) +#endif + if (any(r < ST_plasma_region_rmin) .or. & + any(r > ST_plasma_region_rmax)) then + mask(IJK) = .false. + end if + end do; CLOSE_DO + end if + + end subroutine set_box_mask + + !> Get mean electron energy + pure elemental real(dp) function mean_electron_energy(n_energy, n_e) + real(dp), intent(in) :: n_energy, n_e + mean_electron_energy = n_energy / max(n_e, 1.0_dp) + end function mean_electron_energy + + !> Compute adjustment factor for electron source terms. Used to reduce them in + !> certain regimes. + subroutine compute_source_factor(box, nc, elec_dens, fields, s_dt, source_factor) + use m_gas + use m_transport_data + use m_lookup_table + type(box_t), intent(inout) :: box + integer, intent(in) :: nc + real(dp), intent(in) :: elec_dens(nc**NDIM) + real(dp), intent(in) :: fields(nc**NDIM) + integer, intent(in) :: s_dt + real(dp), intent(out) :: source_factor(nc**NDIM) + real(dp) :: mobilities(nc**NDIM) + real(dp) :: N_inv(nc**NDIM) + real(dp) :: inv_dr(NDIM) + real(dp), parameter :: small_flux = 1.0e-9_dp ! A small flux + integer :: ix, IJK + + inv_dr = 1/box%dr + + if (gas_constant_density) then + N_inv = 1 / gas_number_density + else + N_inv = pack(1 / box%cc(DTIMES(1:nc), i_gas_dens), .true.) + end if + + mobilities = LT_get_col(td_tbl, td_mobility, fields) * N_inv + + select case (ST_source_factor) + case (source_factor_flux) + ix = 0 + do KJI_DO(1,nc) + ix = ix + 1 + + ! Compute norm of flux at cell center +#if NDIM == 1 + source_factor(ix) = 0.5_dp * norm2([ & + box%fc(i, 1, flux_elec) + box%fc(i+1, 1, flux_elec)]) +#elif NDIM == 2 + source_factor(ix) = 0.5_dp * norm2([ & + box%fc(i, j, 1, flux_elec) + box%fc(i+1, j, 1, flux_elec), & + box%fc(i, j, 2, flux_elec) + box%fc(i, j+1, 2, flux_elec)]) +#elif NDIM == 3 + source_factor(ix) = 0.5_dp * norm2([ & + box%fc(i, j, k, 1, flux_elec) + box%fc(i+1, j, k, 1, flux_elec), & + box%fc(i, j, k, 2, flux_elec) + box%fc(i, j+1, k, 2, flux_elec), & + box%fc(i, j, k, 3, flux_elec) + box%fc(i, j, k+1, 3, flux_elec)]) +#endif + end do; CLOSE_DO + + ! Compute source factor as |flux|/(n_e * mu * E) + source_factor = (source_factor + small_flux) / (small_flux + & + elec_dens * mobilities * & + pack(box%cc(DTIMES(1:nc), i_electric_fld), .true.)) + case default + error stop "This type of source factor not implemented" + end select + + source_factor = min(1.0_dp, source_factor) + source_factor = max(0.0_dp, source_factor) + end subroutine compute_source_factor + + !> Handle secondary emission from positive ions at the domain walls + subroutine handle_ion_se_flux(box) + use m_transport_data + type(box_t), intent(inout) :: box + integer :: nc, nb, n, ion_flux, flux_ix + + nc = box%n_cell + + ! Return if there is no physical boundary + if (all(box%neighbors >= af_no_box)) return + + do nb = 1, af_num_neighbors + ! Check for physical boundary + if (box%neighbors(nb) < af_no_box) then + + ! Loop over positive ion species + do n = 1, transport_data_ions%n_mobile_ions + flux_ix = flux_num_electron_vars + n + if (flux_species_charge(flux_ix) > 0.0_dp) then + ion_flux = flux_variables(flux_ix) + select case (nb) +#if NDIM == 1 + case (af_neighb_lowx) + box%fc(1, 1, flux_elec) = box%fc(1, 1, flux_elec) - & + ion_se_yield * min(0.0_dp, box%fc(1, 1, ion_flux)) + case (af_neighb_highx) + box%fc(nc+1, 1, flux_elec) = box%fc(nc+1, 1, flux_elec) - & + ion_se_yield * max(0.0_dp, box%fc(1, 1, ion_flux)) +#elif NDIM == 2 + case (af_neighb_lowx) + box%fc(1, 1:nc, 1, flux_elec) = & + box%fc(1, 1:nc, 1, flux_elec) - ion_se_yield * & + min(0.0_dp, box%fc(1, 1:nc, 1, ion_flux)) + case (af_neighb_highx) + box%fc(nc+1, 1:nc, 1, flux_elec) = & + box%fc(nc+1, 1:nc, 1, flux_elec) - ion_se_yield * & + max(0.0_dp, box%fc(nc+1, 1:nc, 1, ion_flux)) + case (af_neighb_lowy) + box%fc(1:nc, 1, 2, flux_elec) = & + box%fc(1:nc, 1, 2, flux_elec) - ion_se_yield * & + min(0.0_dp, box%fc(1:nc, 1, 2, ion_flux)) + case (af_neighb_highy) + box%fc(1:nc, nc+1, 2, flux_elec) = & + box%fc(1:nc, nc+1, 2, flux_elec) - ion_se_yield * & + max(0.0_dp, box%fc(1:nc, nc+1, 2, ion_flux)) +#elif NDIM == 3 + case (af_neighb_lowx) + box%fc(1, 1:nc, 1:nc, 1, flux_elec) = & + box%fc(1, 1:nc, 1:nc, 1, flux_elec) - ion_se_yield * & + min(0.0_dp, box%fc(1, 1:nc, 1:nc, 1, ion_flux)) + case (af_neighb_highx) + box%fc(nc+1, 1:nc, 1:nc, 1, flux_elec) = & + box%fc(nc+1, 1:nc, 1:nc, 1, flux_elec) - ion_se_yield * & + max(0.0_dp, box%fc(nc+1, 1:nc, 1:nc, 1, ion_flux)) + case (af_neighb_lowy) + box%fc(1:nc, 1:nc, 1, 2, flux_elec) = & + box%fc(1:nc, 1:nc, 1, 2, flux_elec) - ion_se_yield * & + min(0.0_dp, box%fc(1:nc, 1:nc, 1, 2, ion_flux)) + case (af_neighb_highy) + box%fc(1:nc, nc+1, 1:nc, 2, flux_elec) = & + box%fc(1:nc, nc+1, 1:nc, 2, flux_elec) - ion_se_yield * & + max(0.0_dp, box%fc(1:nc, nc+1, 1:nc, 2, ion_flux)) + case (af_neighb_lowz) + box%fc(1:nc, 1:nc, 1, 3, flux_elec) = & + box%fc(1:nc, 1:nc, 1, 3, flux_elec) - ion_se_yield * & + min(0.0_dp, box%fc(1:nc, 1:nc, 1, 3, ion_flux)) + case (af_neighb_highz) + box%fc(1:nc, 1:nc, nc+1, 3, flux_elec) = & + box%fc(1:nc, 1:nc, nc+1, 3, flux_elec) - ion_se_yield * & + max(0.0_dp, box%fc(1:nc, 1:nc, nc+1, 3, ion_flux)) +#endif + + end select + end if + end do + end if + end do + + end subroutine handle_ion_se_flux + + !> Volume integrate chemical reaction rates + subroutine chemical_rates_box(box, nc, rates, box_rates) + use m_chemistry + type(box_t), intent(in) :: box + integer, intent(in) :: nc + real(dp), intent(in) :: rates(nc**NDIM, n_reactions) + real(dp), intent(out) :: box_rates(n_reactions) +#if NDIM == 2 + integer :: i, n + real(dp) :: w(nc), tmp(nc, nc) +#endif + + if (box%coord_t == af_xyz) then + box_rates = sum(rates, dim=1) * product(box%dr) +#if NDIM == 2 + else if (box%coord_t == af_cyl) then + box_rates(:) = 0 + + ! Get volume versus radius + do i = 1, nc + w(i) = af_cyl_volume_cc(box, i) + end do + + do n = 1, n_reactions + tmp = reshape(rates(:, n), [nc, nc]) + do i = 1, nc + tmp(i, :) = w(i) * tmp(i, :) + end do + box_rates(n) = box_rates(n) + sum(tmp) + end do +#endif + else + error stop "Unknown box coordinates" + end if + end subroutine chemical_rates_box + + !> Integrate J.E over space into global storage + subroutine sum_global_JdotE(box, tid) + use m_units_constants + type(box_t), intent(in) :: box + integer, intent(in) :: tid !< Thread id + integer :: IJK, nc + real(dp) :: JdotE, tmp + real(dp) :: volume(box%n_cell) + + JdotE = 0.0_dp + + volume = product(box%dr) + +#if NDIM == 2 + if (box%coord_t == af_cyl) then + ! Cylindrical case + do i = 1, box%n_cell + volume(i) = af_cyl_volume_cc(box, i) + end do + end if +#endif + + nc = box%n_cell + do KJI_DO(1, nc) + tmp = fc_inner_product(box, IJK, flux_elec, electric_fld) + JdotE = JdotE + tmp * volume(i) + end do; CLOSE_DO + + ST_current_JdotE(1, tid) = ST_current_JdotE(1, tid) + & + JdotE * UC_elec_charge + end subroutine sum_global_JdotE + +end module m_fluid_lfa diff --git a/src/m_fluid_lfa.f90 b/src/m_fluid_lfa.f90 deleted file mode 100644 index 45453ab5..00000000 --- a/src/m_fluid_lfa.f90 +++ /dev/null @@ -1,1046 +0,0 @@ -#include "../afivo/src/cpp_macros.h" -!> Fluid model module -module m_fluid_lfa - use m_af_all - use m_streamer - - implicit none - private - - ! Public methods - public :: forward_euler - public :: fluxes_elec - public :: update_solution - -contains - - !> Advance fluid model using forward Euler step. If the equation is written as - !> y' = f(y), the result is: y(s_out) = y(s_prev) + f(y(s_dt)), where the - !> s_... refer to temporal states. - subroutine forward_euler(tree, dt, dt_stiff, dt_lim, time, s_deriv, n_prev, & - s_prev, w_prev, s_out, i_step, n_steps) - use m_chemistry - use m_field - use m_dt - use m_transport_data - use m_dielectric - type(af_t), intent(inout) :: tree - real(dp), intent(in) :: dt !< Time step - real(dp), intent(in) :: dt_stiff !< Time step for stiff terms (IMEX) - real(dp), intent(inout) :: dt_lim !< Computed time step limit - real(dp), intent(in) :: time !< Current time - integer, intent(in) :: s_deriv !< State to compute derivatives from - integer, intent(in) :: n_prev !< Number of previous states - integer, intent(in) :: s_prev(n_prev) !< Previous states - real(dp), intent(in) :: w_prev(n_prev) !< Weights of previous states - integer, intent(in) :: s_out !< Output state - integer, intent(in) :: i_step !< Step of the integrator - integer, intent(in) :: n_steps !< Total number of steps - integer :: lvl, i, id, p_id, nc, ix, id_out - logical :: last_step - - nc = tree%n_cell - - ! Set current rates to zero; they are summed below - ST_current_rates = 0 - ST_current_JdotE = 0 - - last_step = (i_step == n_steps) - - ! Use a shared array to determine maximum time step - dt_matrix(1:dt_num_cond, :) = dt_max - - ! So that ghost cells can be computed properly near refinement boundaries - call af_restrict_ref_boundary(tree, flux_species+s_deriv) - - ! Since field_compute is called after performing time integration, we don't - ! have to call it again for the first sub-step of the next iteration - if (i_step > 1) call field_compute(tree, mg, s_deriv, time, .true.) - - ! First calculate fluxes - !$omp parallel private(lvl, i, id) - do lvl = 1, tree%highest_lvl - !$omp do - do i = 1, size(tree%lvls(lvl)%leaves) - id = tree%lvls(lvl)%leaves(i) - call fluxes_elec(tree, id, nc, dt, s_deriv, last_step) - - if (transport_data_ions%n_mobile_ions > 0) then - call fluxes_ions(tree, id, nc, dt, s_deriv, last_step) - end if - end do - !$omp end do - end do - !$omp end parallel - - call af_consistent_fluxes(tree, flux_variables) - - if (transport_data_ions%n_mobile_ions > 0 .and. & - ion_se_yield > 0.0_dp) then - ! Handle secondary electron emission from ions - call af_loop_box(tree, handle_ion_se_flux, .true.) - end if - - ! Update the solution - !$omp parallel private(lvl, i, id, p_id) - do lvl = 1, tree%highest_lvl - !$omp do - do i = 1, size(tree%lvls(lvl)%leaves) - id = tree%lvls(lvl)%leaves(i) - call update_solution(tree%boxes(id), nc, dt, s_deriv, & - n_prev, s_prev, w_prev, s_out, last_step) - - end do - !$omp end do - end do - !$omp end parallel - - if (ST_use_dielectric) then - ! Update surface charge and handle photon emission - ! @todo For parallelization, think about corner cells with two surfaces - do ix = 1, diel%max_ix - if (diel%surfaces(ix)%in_use) then - id_out = diel%surfaces(ix)%id_out - - ! Convert fluxes onto dielectric to surface charge, and handle - ! secondary emission - call dielectric_update_surface_charge(tree%boxes(id_out), & - diel%surfaces(ix), dt, n_prev, s_prev, w_prev, s_out) - - ! Add secondary emission from photons hitting the surface - call dielectric_photon_emission(tree%boxes(id_out), & - diel%surfaces(ix), dt, s_out) - end if - end do - end if - - if (last_step) then - dt_lim = minval(dt_matrix(1:dt_num_cond, :)) - end if - end subroutine forward_euler - - !> Get velocity and diffusion coefficient for electron flux - subroutine compute_flux_coeff_1d(nc, E_cc, E_x, ne, N_gas, dt, dx, v, dc, fmax) - use m_gas - use m_units_constants - use m_lookup_table - use m_transport_data - integer, intent(in) :: nc - real(dp), intent(in) :: E_cc(0:nc+1) !< Cell-centered field strengths - real(dp), intent(in) :: E_x(nc+1) !< Face-centered field components - real(dp), intent(in) :: ne(0:nc+1) !< Electron densities - real(dp), intent(in) :: N_gas(0:nc+1) !< Gas number density at cell centers - real(dp), intent(in) :: dt !< Current time step - real(dp), intent(in) :: dx !< Grid spacing - real(dp), intent(out) :: v(nc+1) !< Velocity at cell faces - real(dp), intent(out) :: dc(nc+1) !< Diffusion coefficient at cell faces - real(dp), intent(inout) :: fmax(nc+1) !< Maximum allowed flux - - real(dp), parameter :: nsmall = 1.0_dp ! A small density - integer :: n - real(dp) :: E_face(nc+1), Td(nc+1), N_inv(nc+1) - real(dp) :: mu(nc+1), tmp, drt_fac, inv_dx - - if (gas_constant_density) then - N_inv = 1/gas_number_density - else - ! Compute gas number density at cell faces - do n = 1, nc+1 - N_inv(n) = 2 / (N_gas(n-1) + N_gas(n)) - end do - end if - - ! Compute field strength at cell faces, which is used to compute the - ! mobility and diffusion coefficient at the interface - do n = 1, nc+1 - E_face(n) = 0.5_dp * (E_cc(n-1) + E_cc(n)) - Td(n) = E_face(n) * SI_to_Townsend * N_inv(n) - end do - - mu = LT_get_col(td_tbl, td_mobility, Td) * N_inv - dc = LT_get_col(td_tbl, td_diffusion, Td) * N_inv - - ! Compute velocity, -mu accounts for negative electron charge - v = -mu * E_x - - if (ST_drt_limit_flux) then - !> Compute maximal flux if the dielectric relaxation time is not taken - !> into account, see https://doi.org/10.1088/1361-6595/ab6757 - drt_fac = UC_eps0 / max(1e-100_dp, UC_elem_charge * dt) - inv_dx = 1/dx - - do n = 1, nc+1 - tmp = abs(ne(n-1) - ne(n)) / max(ne(n-1), ne(n), nsmall) - tmp = max(E_face(n), tmp * inv_dx * dc(n) / mu(n)) - fmax(n) = drt_fac * tmp - end do - end if - end subroutine compute_flux_coeff_1d - - !> Compute the electron fluxes due to drift and diffusion - subroutine fluxes_elec(tree, id, nc, dt, s_in, last_step) - use m_af_flux_schemes - use m_units_constants - use omp_lib - use m_gas - use m_dt - use m_lookup_table - use m_transport_data - type(af_t), intent(inout) :: tree - integer, intent(in) :: id - integer, intent(in) :: nc !< Number of cells per dimension - real(dp), intent(in) :: dt - integer, intent(in) :: s_in !< Input time state - logical, intent(in) :: last_step - real(dp) :: dr(NDIM), inv_dr(NDIM), Td - ! Velocities at cell faces - real(dp) :: v(DTIMES(1:nc+1), NDIM) - ! Diffusion coefficients at cell faces - real(dp) :: dc(DTIMES(1:nc+1), NDIM) - ! Maximal fluxes at cell faces - real(dp) :: fmax(DTIMES(1:nc+1), NDIM) - ! Cell-centered densities - real(dp) :: cc(DTIMES(-1:nc+2), 1) - - real(dp) :: mu, max_mu_ion, N_inv - real(dp) :: dt_cfl, dt_drt, dt_dif - real(dp) :: vmean(NDIM), N_gas(0:nc+1) - real(dp) :: v_x(nc+1), dc_x(nc+1), fmax_x(nc+1) - real(dp) :: E_cc(0:nc+1), E_fc(nc+1), ne(0:nc+1) - real(dp), parameter :: eps = 1e-100_dp - integer :: IJK, tid, dir -#if NDIM == 2 - integer :: m -#elif NDIM == 3 - integer :: m, n -#endif - - ! Inside the dielectric, set the flux to zero. We later determine the - ! boundary flux onto dielectrics - if (ST_use_dielectric) then - if (tree%boxes(id)%cc(DTIMES(1), i_eps) > 1.0_dp) then - tree%boxes(id)%fc(DTIMES(:), :, flux_elec) = 0.0_dp - return - end if - end if - - dr = tree%boxes(id)%dr - inv_dr = 1/tree%boxes(id)%dr - v = 0.0_dp - dc = 0.0_dp - fmax = 0.0_dp - - ! Fill cc with interior data plus two layers of ghost cells - call af_gc2_box(tree, id, [i_electron+s_in], cc) - - associate(box => tree%boxes(id)) -#if NDIM == 1 - dir = 1 ! x-component - if (.not. gas_constant_density) N_gas = box%cc(0:nc+1, i_gas_dens) - - E_cc = box%cc(0:nc+1, i_electric_fld) - E_fc = box%fc(:, dir, electric_fld) - ne = cc(0:nc+1, 1) - call compute_flux_coeff_1d(nc, E_cc, E_fc, ne, N_gas, dt, dr(dir), & - v_x, dc_x, fmax_x) - v(:, dir) = v_x - dc(:, dir) = dc_x - fmax(:, dir) = fmax_x -#elif NDIM == 2 - do m = 1, nc - dir = 1 ! x-component - if (.not. gas_constant_density) N_gas = box%cc(0:nc+1, m, i_gas_dens) - - ! Avoid allocating array temporaries, but explicitly copy - E_cc = box%cc(0:nc+1, m, i_electric_fld) - E_fc = box%fc(:, m, dir, electric_fld) - ne = cc(0:nc+1, m, 1) - call compute_flux_coeff_1d(nc, E_cc, E_fc, ne, N_gas, dt, dr(dir), & - v_x, dc_x, fmax_x) - v(:, m, dir) = v_x - dc(:, m, dir) = dc_x - fmax(:, m, dir) = fmax_x - - dir = 2 ! y-component - if (.not. gas_constant_density) N_gas = box%cc(m, 0:nc+1, i_gas_dens) - - E_cc = box%cc(m, 0:nc+1, i_electric_fld) - E_fc = box%fc(m, :, dir, electric_fld) - ne = cc(m, 0:nc+1, 1) - call compute_flux_coeff_1d(nc, E_cc, E_fc, ne, N_gas, dt, dr(dir), & - v_x, dc_x, fmax_x) - v(m, :, dir) = v_x - dc(m, :, dir) = dc_x - fmax(m, :, dir) = fmax_x - end do -#elif NDIM == 3 - do n = 1, nc - do m = 1, nc - dir = 1 ! x-component - if (.not. gas_constant_density) N_gas = box%cc(0:nc+1, m, n, i_gas_dens) - - E_cc = box%cc(0:nc+1, m, n, i_electric_fld) - E_fc = box%fc(:, m, n, dir, electric_fld) - ne = cc(0:nc+1, m, n, 1) - call compute_flux_coeff_1d(nc, E_cc, E_fc, ne, N_gas, dt, dr(dir), & - v_x, dc_x, fmax_x) - v(:, m, n, dir) = v_x - dc(:, m, n, dir) = dc_x - fmax(:, m, n, dir) = fmax_x - - dir = 2 ! y-component - if (.not. gas_constant_density) N_gas = box%cc(m, 0:nc+1, n, i_gas_dens) - - E_cc = box%cc(m, 0:nc+1, n, i_electric_fld) - E_fc = box%fc(m, :, n, dir, electric_fld) - ne = cc(m, 0:nc+1, n, 1) - call compute_flux_coeff_1d(nc, E_cc, E_fc, ne, N_gas, dt, dr(dir), & - v_x, dc_x, fmax_x) - v(m, :, n, dir) = v_x - dc(m, :, n, dir) = dc_x - fmax(m, :, n, dir) = fmax_x - - dir = 3 ! z-component - if (.not. gas_constant_density) N_gas = box%cc(m, n, 0:nc+1, i_gas_dens) - - E_cc = box%cc(m, n, 0:nc+1, i_electric_fld) - E_fc = box%fc(m, n, :, dir, electric_fld) - ne = cc(m, n, 0:nc+1, 1) - call compute_flux_coeff_1d(nc, E_cc, E_fc, ne, N_gas, dt, dr(dir), & - v_x, dc_x, fmax_x) - v(m, n, :, dir) = v_x - dc(m, n, :, dir) = dc_x - fmax(m, n, :, dir) = fmax_x - end do - end do -#endif - end associate - - if (last_step) then - tid = omp_get_thread_num() + 1 - dt_cfl = dt_max - dt_drt = dt_matrix(dt_ix_cfl, tid) - - do KJI_DO(1,nc) -#if NDIM == 1 - vmean = 0.5_dp * (v(IJK, :) + [v(i+1, 1)]) -#elif NDIM == 2 - vmean = 0.5_dp * (v(IJK, :) + & - [v(i+1, j, 1), v(i, j+1, 2)]) -#elif NDIM == 3 - vmean = 0.5_dp * (v(IJK, :) + & - [v(i+1, j, k, 1), v(i, j+1, k, 2), v(i, j, k+1, 3)]) -#endif - ! CFL condition - dt_cfl = 1.0_dp/sum(max(abs(vmean), eps) * inv_dr) - - ! Diffusion condition - dt_dif = minval(tree%boxes(id)%dr)**2 / & - max(2 * NDIM * maxval(dc(IJK, :)), eps) - - ! Take combined CFL-diffusion condition - dt_cfl = dt_cfl_number/(1/dt_cfl + 1/dt_dif) - - if (gas_constant_density) then - N_inv = 1 / gas_number_density - else - N_inv = 1 / tree%boxes(id)%cc(IJK, i_gas_dens) - end if - - ! Ion mobility - if (size(transport_data_ions%mobilities) > 0) then - ! This should be an over-estimate - max_mu_ion = maxval(abs(transport_data_ions%mobilities)) * N_inv - else - max_mu_ion = 0.0_dp - end if - - ! Electron mobility - Td = tree%boxes(id)%cc(IJK, i_electric_fld) * SI_to_Townsend * N_inv - mu = LT_get_col(td_tbl, td_mobility, Td) * N_inv - - ! Take sum of electron and ion mobility, in the future we should - ! probably apply a weighted sum (weighted with species densities) - mu = mu + max_mu_ion - - ! Dielectric relaxation time - dt_drt = UC_eps0 / max(UC_elem_charge * mu * cc(IJK, 1), eps) - - if (ST_drt_limit_flux) then - ! By limiting the flux, we reduce the conductivity of the cell. If - ! the current through the cell is fixed, this ensures that the - ! field in the cell will not exceed ST_drt_max_field - dt_drt = dt_drt * max(1.0_dp, ST_drt_max_field / & - max(1e-10_dp, tree%boxes(id)%cc(IJK, i_electric_fld))) - end if - - dt_matrix(dt_ix_drt, tid) = min(dt_matrix(dt_ix_drt, tid), dt_drt) - dt_matrix(dt_ix_cfl, tid) = min(dt_matrix(dt_ix_cfl, tid), dt_cfl) - dt_matrix(dt_ix_diff, tid) = min(dt_matrix(dt_ix_diff, tid), dt_dif) - end do; CLOSE_DO - end if - -#if NDIM == 1 - call flux_koren_1d(cc, v, nc, 2) - call flux_diff_1d(cc, dc, inv_dr(1), nc, 2) -#elif NDIM == 2 - call flux_koren_2d(cc, v, nc, 2) - call flux_diff_2d(cc, dc, inv_dr, nc, 2) -#elif NDIM == 3 - call flux_koren_3d(cc, v, nc, 2) - call flux_diff_3d(cc, dc, inv_dr, nc, 2) -#endif - - tree%boxes(id)%fc(DTIMES(:), :, flux_elec) = v + dc - - if (ST_source_factor == source_factor_original_flux) then - ! Store approximation of E . [-D grad(n_e)] in temporary variable - associate (box => tree%boxes(id)) - do KJI_DO(1, nc) -#if NDIM == 1 - box%cc(IJK, i_srcfac) = 0.5_dp * (& - box%fc(i, 1, electric_fld) * dc(i, 1) + & - box%fc(i+1, 1, electric_fld) * dc(i+1, 1)) -#elif NDIM == 2 - box%cc(IJK, i_srcfac) = 0.5_dp * (& - box%fc(i, j, 1, electric_fld) * dc(i, j, 1) + & - box%fc(i+1, j, 1, electric_fld) * dc(i+1, j, 1) + & - box%fc(i, j, 2, electric_fld) * dc(i, j, 2) + & - box%fc(i, j+1, 2, electric_fld) * dc(i, j+1, 2)) -#elif NDIM == 3 - box%cc(IJK, i_srcfac) = 0.5_dp * (& - box%fc(i, j, k, 1, electric_fld) * dc(i, j, k, 1) + & - box%fc(i+1, j, k, 1, electric_fld) * dc(i+1, j, k, 1) + & - box%fc(i, j, k, 2, electric_fld) * dc(i, j, k, 2) + & - box%fc(i, j+1, k, 2, electric_fld) * dc(i, j+1, k, 2) + & - box%fc(i, j, k, 3, electric_fld) * dc(i, j, k, 3) + & - box%fc(i, j, k+1, 3, electric_fld) * dc(i, j, k+1, 3)) -#endif - end do; CLOSE_DO - end associate - end if - - if (ST_drt_limit_flux) then - where (abs(tree%boxes(id)%fc(DTIMES(:), :, flux_elec)) > fmax) - tree%boxes(id)%fc(DTIMES(:), :, flux_elec) = & - sign(fmax, tree%boxes(id)%fc(DTIMES(:), :, flux_elec)) - end where - end if - - end subroutine fluxes_elec - - subroutine fluxes_ions(tree, id, nc, dt, s_in, last_step) - use m_af_flux_schemes - use m_gas - use m_transport_data - type(af_t), intent(inout) :: tree - integer, intent(in) :: id - integer, intent(in) :: nc !< Number of cells per dimension - real(dp), intent(in) :: dt - integer, intent(in) :: s_in !< Input time state - logical, intent(in) :: last_step - real(dp) :: inv_dr(NDIM) - ! Velocities at cell faces - real(dp) :: v(DTIMES(1:nc+1), NDIM) - ! Cell-centered densities - real(dp) :: cc(DTIMES(-1:nc+2), & - transport_data_ions%n_mobile_ions) - real(dp) :: mu - integer :: n, i_ion, i_flux, ix -#if NDIM > 1 - integer :: m -#endif -#if NDIM == 3 - integer :: l -#endif - - inv_dr = 1/tree%boxes(id)%dr - - call af_gc2_box(tree, id, [flux_species(2:)+s_in], cc) - - do ix = 1, transport_data_ions%n_mobile_ions - i_ion = flux_species(ix+1) - i_flux = flux_variables(ix+1) - ! Account for ion charge in mobility - mu = transport_data_ions%mobilities(ix) * flux_species_charge(ix+1) - - associate (box => tree%boxes(id), fc => tree%boxes(id)%fc, & - cc => tree%boxes(id)%cc) -#if NDIM == 1 - do n = 1, nc+1 - v(n, 1) = get_ion_velocity(box, n, 1, mu) - end do -#elif NDIM == 2 - do n = 1, nc+1 - do m = 1, nc - v(n, m, 1) = get_ion_velocity(box, n, m, 1, mu) - v(m, n, 2) = get_ion_velocity(box, m, n, 2, mu) - end do - end do -#elif NDIM == 3 - do n = 1, nc+1 - do m = 1, nc - do l = 1, nc - v(n, m, l, 1) = get_ion_velocity(box, n, m, l, 1, mu) - v(m, n, l, 2) = get_ion_velocity(box, m, n, l, 2, mu) - v(m, l, n, 3) = get_ion_velocity(box, m, l, n, 3, mu) - end do - end do - end do -#endif - end associate - -#if NDIM == 1 - call flux_koren_1d(cc(DTIMES(:), ix), v, nc, 2) -#elif NDIM == 2 - call flux_koren_2d(cc(DTIMES(:), ix), v, nc, 2) -#elif NDIM == 3 - call flux_koren_3d(cc(DTIMES(:), ix), v, nc, 2) -#endif - - tree%boxes(id)%fc(DTIMES(:), :, i_flux) = v - end do - - end subroutine fluxes_ions - - real(dp) function get_ion_velocity(box, IJK, dim, mu) result(v) - type(box_t), intent(in) :: box - integer, intent(in) :: IJK !< Flux index - integer, intent(in) :: dim !< Flux dimension - real(dp), intent(in) :: mu !< Original mobility - real(dp) :: field_face - - field_face = box%fc(IJK, dim, electric_fld) - v = mu * field_face * get_N_inv_face(box, IJK, dim) - end function get_ion_velocity - - !> Get average of cell-centered quantity at a cell face - pure function cc_average_at_cell_face(box, IJK, idim, iv) result(avg) - type(box_t), intent(in) :: box - integer, intent(in) :: IJK !< Face index - integer, intent(in) :: idim !< Direction of the cell face - integer, intent(in) :: iv !< Index of cell-centered variable - real(dp) :: avg - -#if NDIM == 1 - avg = 0.5_dp * (box%cc(i-1, iv) + box%cc(i, iv)) -#elif NDIM == 2 - select case (idim) - case (1) - avg = 0.5_dp * (box%cc(i-1, j, iv) + box%cc(i, j, iv)) - case default - avg = 0.5_dp * (box%cc(i, j-1, iv) + box%cc(i, j, iv)) - end select -#elif NDIM == 3 - select case (idim) - case (1) - avg = 0.5_dp * (box%cc(i-1, j, k, iv) + box%cc(i, j, k, iv)) - case (2) - avg = 0.5_dp * (box%cc(i, j-1, k, iv) + box%cc(i, j, k, iv)) - case default - avg = 0.5_dp * (box%cc(i, j, k-1, iv) + box%cc(i, j, k, iv)) - end select -#endif - end function cc_average_at_cell_face - - !> Get inverse gas density at a cell face, between cell-centered index i-1 and - !> i along dimension idim - pure real(dp) function get_N_inv_face(box, IJK, idim) - use m_gas - type(box_t), intent(in) :: box - integer, intent(in) :: IJK - integer, intent(in) :: idim !< Direction of flux through cell face - - if (gas_constant_density) then - get_N_inv_face = gas_inverse_number_density - else - get_N_inv_face = 1 / cc_average_at_cell_face(box, IJK, idim, i_gas_dens) - end if - end function get_N_inv_face - - !> Advance solution in a box over dt based on the fluxes and reactions, using - !> a forward Euler update - subroutine update_solution(box, nc, dt, s_dt, n_prev, s_prev, w_prev, & - s_out, last_step) - use omp_lib - use m_units_constants - use m_gas - use m_chemistry - use m_photoi - use m_dt - use m_lookup_table - use m_transport_data - type(box_t), intent(inout) :: box - integer, intent(in) :: nc !< Box size - real(dp), intent(in) :: dt !< Time step - integer, intent(in) :: s_dt !< Time state to compute derivatives from - integer, intent(in) :: n_prev !< Number of previous states - integer, intent(in) :: s_prev(n_prev) !< Time state to add derivatives to - real(dp), intent(in) :: w_prev(n_prev) !< Weights of previous states - integer, intent(in) :: s_out !< Output time state - logical, intent(in) :: last_step !< Whether to set new time step - real(dp) :: inv_dr(NDIM) - real(dp) :: tmp - real(dp) :: rates(nc**NDIM, n_reactions) - real(dp) :: derivs(nc**NDIM, n_species) - real(dp) :: dens(nc**NDIM, n_species) - real(dp) :: fields(nc**NDIM), box_rates(n_reactions) - real(dp) :: source_factor(nc**NDIM) - real(dp) :: coords(nc, NDIM), r(NDIM) -#if NDIM == 2 - real(dp) :: rfac(2, box%n_cell) -#endif - integer :: IJK, ix, n_cells, n, iv, i_flux - integer :: tid - real(dp), parameter :: eps = 1e-100_dp - logical :: update_mask(nc**NDIM) - - n_cells = box%n_cell**NDIM - inv_dr = 1/box%dr - - ! Only update species densities where this mask is true - update_mask = .true. - - ! Do no update chemistry inside electrode - if (ST_use_electrode) then - ix = 0 - do KJI_DO(1,nc) - ix = ix + 1 - if (box%cc(IJK, i_lsf) <= 0.0_dp) update_mask(ix) = .false. - end do; CLOSE_DO - end if - - ! Optionally limit chemistry to a particular region - if (ST_plasma_region_enabled) then - ! Compute box coordinates - do n = 1, NDIM - coords(:, n) = box%r_min(n) + box%dr(n) * [(i-0.5_dp, i=1,nc)] - end do - - ix = 0 - do KJI_DO(1,nc) - ix = ix + 1 - r(1) = coords(i, 1) -#if NDIM > 1 - r(2) = coords(j, 2) -#endif -#if NDIM > 2 - r(3) = coords(k, 3) -#endif - if (any(r < ST_plasma_region_rmin) .or. & - any(r > ST_plasma_region_rmax)) then - update_mask(ix) = .false. - end if - end do; CLOSE_DO - end if - - ! Inside the dielectric, do not update the species densities - if (ST_use_dielectric) then - ix = 0 - do KJI_DO(1,nc) - ix = ix + 1 - if (abs(box%cc(IJK, i_eps) - 1) > eps) update_mask(ix) = .false. - end do; CLOSE_DO - end if - - ! Skip this routine if there are no cells to update - if (.not. any(update_mask)) return - - if (gas_constant_density) then - ! Compute field in Townsends - tmp = 1 / gas_number_density - fields = SI_to_Townsend * tmp * & - pack(box%cc(DTIMES(1:nc), i_electric_fld), .true.) - else - do n = 1, n_gas_species - dens(:, n) = gas_fractions(n) * & - pack(box%cc(DTIMES(1:nc), i_gas_dens), .true.) - end do - - fields(:) = SI_to_Townsend * pack( & - box%cc(DTIMES(1:nc), i_electric_fld) / & - box%cc(DTIMES(1:nc), i_gas_dens), .true.) - end if - - dens(:, n_gas_species+1:n_species) = reshape(box%cc(DTIMES(1:nc), & - species_itree(n_gas_species+1:n_species)+s_dt), [n_cells, n_plasma_species]) - - ! It is assumed that species densities should be non-negative. When - ! computing the effect of chemical reactions, this can also help with - ! stability, see e.g. http://dx.doi.org/10.1088/1749-4699/6/1/015001 - dens = max(dens, 0.0_dp) - - call get_rates(fields, rates, n_cells) - - if (ST_source_factor /= source_factor_none) then - if (ST_source_factor /= source_factor_none) then - call compute_source_factor(box, nc, dens(:, ix_electron), & - fields, s_dt, source_factor) - else - source_factor(:) = 1.0_dp - end if - - if (i_srcfac > 0) then - ! Write source factor to variable - box%cc(DTIMES(1:nc), i_srcfac) = & - reshape(source_factor, [DTIMES(nc)]) - end if - - do n = 1, n_reactions - if (reactions(n)%reaction_type == ionization_reaction) then - rates(:, n) = rates(:, n) * source_factor - end if - end do - end if - - ! Note that this routine updates its rates argument - call get_derivatives(dens, rates, derivs, n_cells) - - ! Inside electrode/dielectrics, rates and derivatives are zero. Setting this - ! here is redundant, but the last_step code below otherwise becomes more - ! complicated. - do n = 1, n_reactions - where (.not. update_mask) rates(:, n) = 0 - end do - do n = 1, n_species - where (.not. update_mask) derivs(:, n) = 0 - end do - - if (last_step) then - tid = omp_get_thread_num() + 1 - - ! Update chemistry time step. Note that 'dens' is already non-negative. - if (dt_chemistry_nmin > 0) then - ! The time step is restricted by both the production and destruction - ! rate of species - tmp = minval((dens + dt_chemistry_nmin) / max(abs(derivs), eps)) - else - ! Prevent negative values due to too much removal of a species - tmp = minval(max(dens, eps) / max(-derivs, eps)) - end if - - dt_matrix(dt_ix_rates, tid) = min(dt_matrix(dt_ix_rates, tid), tmp) - - ! Keep track of chemical production at last time integration step - call chemical_rates_box(box, nc, rates, box_rates) - - !> Integrate rates over space and time into global storage - ST_current_rates(1:n_reactions, tid) = & - ST_current_rates(1:n_reactions, tid) + box_rates - - ! Keep track of J.E - call sum_global_JdotE(box, tid) - end if - -#if NDIM == 2 - if (ST_cylindrical) then - call af_cyl_flux_factors(box, rfac) - else - rfac = 1.0_dp - end if -#endif - - ix = 0 - do KJI_DO(1,nc) - ix = ix + 1 - - ! Contribution of flux -#if NDIM == 1 - derivs(ix, ix_electron) = derivs(ix, ix_electron) + & - inv_dr(1) * (box%fc(i, 1, flux_elec) - & - box%fc(i+1, 1, flux_elec)) -#elif NDIM == 2 - derivs(ix, ix_electron) = derivs(ix, ix_electron) + & - inv_dr(1) * (rfac(1, i) * box%fc(i, j, 1, flux_elec) - & - rfac(2, i) * box%fc(i+1, j, 1, flux_elec)) + & - inv_dr(2) * (box%fc(i, j, 2, flux_elec) - & - box%fc(i, j+1, 2, flux_elec)) -#elif NDIM == 3 - derivs(ix, ix_electron) = derivs(ix, ix_electron) + & - inv_dr(1) * (box%fc(i, j, k, 1, flux_elec) - & - box%fc(i+1, j, k, 1, flux_elec)) + & - inv_dr(2) * (box%fc(i, j, k, 2, flux_elec) - & - box%fc(i, j+1, k, 2, flux_elec)) + & - inv_dr(3) * (box%fc(i, j, k, 3, flux_elec) - & - box%fc(i, j, k+1, 3, flux_elec)) -#endif - - if (photoi_enabled) then - derivs(ix, ix_electron) = derivs(ix, ix_electron) + & - box%cc(IJK, i_photo) - derivs(ix, photoi_species_index) = & - derivs(ix, photoi_species_index) + box%cc(IJK, i_photo) - end if - - ! Inside electrode/dielectrics, rates and derivatives are zero - if (.not. update_mask(ix)) derivs(ix, :) = 0.0_dp - - do n = n_gas_species+1, n_species - iv = species_itree(n) - box%cc(IJK, iv+s_out) = sum(w_prev * box%cc(IJK, iv+s_prev)) + & - dt * derivs(ix, n) - end do - end do; CLOSE_DO - - ! Ion fluxes - do n = 2, size(flux_species) - iv = flux_species(n) - i_flux = flux_variables(n) - - ix = 0 - do KJI_DO(1,nc) - ix = ix + 1 -#if NDIM == 1 - tmp = inv_dr(1) * (box%fc(i, 1, i_flux) - & - box%fc(i+1, 1, i_flux)) -#elif NDIM == 2 - tmp = inv_dr(1) * (rfac(1, i) * box%fc(i, j, 1, i_flux) - & - rfac(2, i) * box%fc(i+1, j, 1, i_flux)) + & - inv_dr(2) * (box%fc(i, j, 2, i_flux) - & - box%fc(i, j+1, 2, i_flux)) -#elif NDIM == 3 - tmp = inv_dr(1) * (box%fc(i, j, k, 1, i_flux) - & - box%fc(i+1, j, k, 1, i_flux)) + & - inv_dr(2) * (box%fc(i, j, k, 2, i_flux) - & - box%fc(i, j+1, k, 2, i_flux)) + & - inv_dr(3) * (box%fc(i, j, k, 3, i_flux) - & - box%fc(i, j, k+1, 3, i_flux)) -#endif - - ! Inside electrode/dielectrics, rates and derivatives are zero - if (.not. update_mask(ix)) tmp = 0.0_dp - - box%cc(IJK, iv+s_out) = box%cc(IJK, iv+s_out) + tmp * dt - end do; CLOSE_DO - end do - - end subroutine update_solution - - !> Compute adjustment factor for electron source terms. Used to reduce them in - !> certain regimes. - subroutine compute_source_factor(box, nc, elec_dens, fields, s_dt, source_factor) - use m_gas - use m_transport_data - use m_lookup_table - type(box_t), intent(inout) :: box - integer, intent(in) :: nc - real(dp), intent(in) :: elec_dens(nc**NDIM) - real(dp), intent(in) :: fields(nc**NDIM) - integer, intent(in) :: s_dt - real(dp), intent(out) :: source_factor(nc**NDIM) - real(dp) :: mobilities(nc**NDIM) - real(dp) :: N_inv(nc**NDIM) - real(dp) :: inv_dr(NDIM) - real(dp), parameter :: small_flux = 1.0e-9_dp ! A small flux - integer :: ix, IJK - - inv_dr = 1/box%dr - - if (gas_constant_density) then - N_inv = 1 / gas_number_density - else - N_inv = pack(1 / box%cc(DTIMES(1:nc), i_gas_dens), .true.) - end if - - mobilities = LT_get_col(td_tbl, td_mobility, fields) * N_inv - - select case (ST_source_factor) - case (source_factor_flux) - ix = 0 - do KJI_DO(1,nc) - ix = ix + 1 - - ! Compute norm of flux at cell center -#if NDIM == 1 - source_factor(ix) = 0.5_dp * norm2([ & - box%fc(i, 1, flux_elec) + box%fc(i+1, 1, flux_elec)]) -#elif NDIM == 2 - source_factor(ix) = 0.5_dp * norm2([ & - box%fc(i, j, 1, flux_elec) + box%fc(i+1, j, 1, flux_elec), & - box%fc(i, j, 2, flux_elec) + box%fc(i, j+1, 2, flux_elec)]) -#elif NDIM == 3 - source_factor(ix) = 0.5_dp * norm2([ & - box%fc(i, j, k, 1, flux_elec) + box%fc(i+1, j, k, 1, flux_elec), & - box%fc(i, j, k, 2, flux_elec) + box%fc(i, j+1, k, 2, flux_elec), & - box%fc(i, j, k, 3, flux_elec) + box%fc(i, j, k+1, 3, flux_elec)]) -#endif - end do; CLOSE_DO - - ! Compute source factor as |flux|/(n_e * mu * E) - source_factor = (source_factor + small_flux) / (small_flux + & - elec_dens * mobilities * & - pack(box%cc(DTIMES(1:nc), i_electric_fld), .true.)) - case (source_factor_original_flux) - ! Compute source factor as 1 - (E_hat . F_diff)/F_drift - source_factor = 1 - pack(box%cc(DTIMES(1:nc), i_srcfac), .true.) / & - (small_flux + elec_dens * mobilities * & - pack(box%cc(DTIMES(1:nc), i_electric_fld)**2, .true.)) - case default - error stop - end select - - source_factor = min(1.0_dp, source_factor) - source_factor = max(0.0_dp, source_factor) - end subroutine compute_source_factor - - !> Handle secondary emission from positive ions - subroutine handle_ion_se_flux(box) - use m_transport_data - type(box_t), intent(inout) :: box - integer :: nc, nb, n, ion_flux - - nc = box%n_cell - - ! Return if there is no physical boundary - if (all(box%neighbors >= af_no_box)) return - - do nb = 1, af_num_neighbors - ! Check for physical boundary - if (box%neighbors(nb) < af_no_box) then - ! Loop over positive ion species - do n = 1, transport_data_ions%n_mobile_ions - if (flux_species_charge(n+1) > 0.0_dp) then - ion_flux = flux_variables(n+1) - select case (nb) -#if NDIM == 1 - case (af_neighb_lowx) - box%fc(1, 1, flux_elec) = box%fc(1, 1, flux_elec) - & - ion_se_yield * min(0.0_dp, box%fc(1, 1, ion_flux)) - case (af_neighb_highx) - box%fc(nc+1, 1, flux_elec) = box%fc(nc+1, 1, flux_elec) - & - ion_se_yield * max(0.0_dp, box%fc(1, 1, ion_flux)) -#elif NDIM == 2 - case (af_neighb_lowx) - box%fc(1, 1:nc, 1, flux_elec) = & - box%fc(1, 1:nc, 1, flux_elec) - ion_se_yield * & - min(0.0_dp, box%fc(1, 1:nc, 1, ion_flux)) - case (af_neighb_highx) - box%fc(nc+1, 1:nc, 1, flux_elec) = & - box%fc(nc+1, 1:nc, 1, flux_elec) - ion_se_yield * & - max(0.0_dp, box%fc(nc+1, 1:nc, 1, ion_flux)) - case (af_neighb_lowy) - box%fc(1:nc, 1, 2, flux_elec) = & - box%fc(1:nc, 1, 2, flux_elec) - ion_se_yield * & - min(0.0_dp, box%fc(1:nc, 1, 2, ion_flux)) - case (af_neighb_highy) - box%fc(1:nc, nc+1, 2, flux_elec) = & - box%fc(1:nc, nc+1, 2, flux_elec) - ion_se_yield * & - max(0.0_dp, box%fc(1:nc, nc+1, 2, ion_flux)) -#elif NDIM == 3 - case (af_neighb_lowx) - box%fc(1, 1:nc, 1:nc, 1, flux_elec) = & - box%fc(1, 1:nc, 1:nc, 1, flux_elec) - ion_se_yield * & - min(0.0_dp, box%fc(1, 1:nc, 1:nc, 1, ion_flux)) - case (af_neighb_highx) - box%fc(nc+1, 1:nc, 1:nc, 1, flux_elec) = & - box%fc(nc+1, 1:nc, 1:nc, 1, flux_elec) - ion_se_yield * & - max(0.0_dp, box%fc(nc+1, 1:nc, 1:nc, 1, ion_flux)) - case (af_neighb_lowy) - box%fc(1:nc, 1:nc, 1, 2, flux_elec) = & - box%fc(1:nc, 1:nc, 1, 2, flux_elec) - ion_se_yield * & - min(0.0_dp, box%fc(1:nc, 1:nc, 1, 2, ion_flux)) - case (af_neighb_highy) - box%fc(1:nc, nc+1, 1:nc, 2, flux_elec) = & - box%fc(1:nc, nc+1, 1:nc, 2, flux_elec) - ion_se_yield * & - max(0.0_dp, box%fc(1:nc, nc+1, 1:nc, 2, ion_flux)) - case (af_neighb_lowz) - box%fc(1:nc, 1:nc, 1, 3, flux_elec) = & - box%fc(1:nc, 1:nc, 1, 3, flux_elec) - ion_se_yield * & - min(0.0_dp, box%fc(1:nc, 1:nc, 1, 3, ion_flux)) - case (af_neighb_highz) - box%fc(1:nc, 1:nc, nc+1, 3, flux_elec) = & - box%fc(1:nc, 1:nc, nc+1, 3, flux_elec) - ion_se_yield * & - max(0.0_dp, box%fc(1:nc, 1:nc, nc+1, 3, ion_flux)) -#endif - - end select - end if - end do - end if - end do - - end subroutine handle_ion_se_flux - - !> Volume integrate chemical reaction rates - subroutine chemical_rates_box(box, nc, rates, box_rates) - use m_chemistry - type(box_t), intent(in) :: box - integer, intent(in) :: nc - real(dp), intent(in) :: rates(nc**NDIM, n_reactions) - real(dp), intent(out) :: box_rates(n_reactions) -#if NDIM == 2 - integer :: i, n - real(dp) :: w(nc), tmp(nc, nc) -#endif - - if (box%coord_t == af_xyz) then - box_rates = sum(rates, dim=1) * product(box%dr) -#if NDIM == 2 - else if (box%coord_t == af_cyl) then - box_rates(:) = 0 - - ! Get volume versus radius - do i = 1, nc - w(i) = af_cyl_volume_cc(box, i) - end do - - do n = 1, n_reactions - tmp = reshape(rates(:, n), [nc, nc]) - do i = 1, nc - tmp(i, :) = w(i) * tmp(i, :) - end do - box_rates(n) = box_rates(n) + sum(tmp) - end do -#endif - else - error stop "Unknown box coordinates" - end if - end subroutine chemical_rates_box - - !> Integrate J.E over space into global storage - subroutine sum_global_JdotE(box, tid) - use m_units_constants - type(box_t), intent(in) :: box - integer, intent(in) :: tid !< Thread id - integer :: IJK, nc - real(dp) :: JdotE, tmp - real(dp) :: volume(box%n_cell) - - JdotE = 0.0_dp - - volume = product(box%dr) - -#if NDIM == 2 - if (box%coord_t == af_cyl) then - ! Cylindrical case - do i = 1, box%n_cell - volume(i) = af_cyl_volume_cc(box, i) - end do - end if -#endif - - nc = box%n_cell - do KJI_DO(1, nc) - ! Compute inner product flux * field over the cell faces - tmp = 0.5_dp * sum(box%fc(IJK, :, flux_elec) * box%fc(IJK, :, electric_fld)) -#if NDIM == 1 - tmp = tmp + 0.5_dp * (& - box%fc(i+1, 1, flux_elec) * box%fc(i+1, 1, electric_fld)) -#elif NDIM == 2 - tmp = tmp + 0.5_dp * (& - box%fc(i+1, j, 1, flux_elec) * box%fc(i+1, j, 1, electric_fld) + & - box%fc(i, j+1, 2, flux_elec) * box%fc(i, j+1, 2, electric_fld)) -#elif NDIM == 3 - tmp = tmp + 0.5_dp * (& - box%fc(i+1, j, k, 1, flux_elec) * box%fc(i+1, j, k, 1, electric_fld) + & - box%fc(i, j+1, k, 2, flux_elec) * box%fc(i, j+1, k, 2, electric_fld) + & - box%fc(i, j, k+1, 3, flux_elec) * box%fc(i, j, k+1, 3, electric_fld)) -#endif - JdotE = JdotE + tmp * volume(i) - end do; CLOSE_DO - - ST_current_JdotE(1, tid) = ST_current_JdotE(1, tid) + & - JdotE * UC_elec_charge - end subroutine sum_global_JdotE - -end module m_fluid_lfa diff --git a/src/m_gas.f90 b/src/m_gas.f90 index fe8d3629..4327c289 100644 --- a/src/m_gas.f90 +++ b/src/m_gas.f90 @@ -209,29 +209,36 @@ subroutine gas_forward_euler(tree, dt, dt_stiff, dt_lim, time, s_deriv, n_prev, integer, intent(in) :: s_out !< Output state integer, intent(in) :: i_step !< Step of the integrator integer, intent(in) :: n_steps !< Total number of steps + real(dp) :: dt_dummy(0) call flux_generic_tree(tree, n_vars_euler, gas_vars, s_deriv, & gas_fluxes, dt_lim, max_wavespeed, get_fluxes, & flux_dummy_modify, flux_dummy_line_modify, to_primitive, & to_conservative, af_limiter_vanleer_t) if (tree%coord_t == af_cyl) then - call flux_update_densities(tree, dt, n_vars_euler, gas_vars, gas_fluxes, & - s_deriv, n_prev, s_prev, w_prev, s_out, add_geometric_source) + call flux_update_densities(tree, dt, n_vars_euler, gas_vars, n_vars_euler, & + gas_vars, gas_fluxes, s_deriv, n_prev, s_prev, w_prev, s_out, & + add_geometric_source, 0, dt_dummy) else - call flux_update_densities(tree, dt, n_vars_euler, gas_vars, gas_fluxes, & - s_deriv, n_prev, s_prev, w_prev, s_out, flux_dummy_source) + call flux_update_densities(tree, dt, n_vars_euler, gas_vars, n_vars_euler, & + gas_vars, gas_fluxes, s_deriv, n_prev, s_prev, w_prev, s_out, & + flux_dummy_source, 0, dt_dummy) end if end subroutine gas_forward_euler !> Add geometric source term for axisymmetric simulations - subroutine add_geometric_source(box, dt, n_vars, i_cc, s_deriv, s_out) + subroutine add_geometric_source(box, dt, n_vars, i_cc, s_deriv, s_out, & + n_dt, dt_lim, mask) type(box_t), intent(inout) :: box real(dp), intent(in) :: dt integer, intent(in) :: n_vars integer, intent(in) :: i_cc(n_vars) integer, intent(in) :: s_deriv integer, intent(in) :: s_out + logical, intent(in) :: mask(DTIMES(box%n_cell)) + integer, intent(in) :: n_dt + real(dp), intent(inout) :: dt_lim(n_dt) #if NDIM == 2 real(dp) :: pressure(DTIMES(box%n_cell)) @@ -243,9 +250,11 @@ subroutine add_geometric_source(box, dt, n_vars, i_cc, s_deriv, s_out) do i = 1, nc inv_radius = 1/af_cyl_radius_cc(box, i) - box%cc(i, 1:nc, i_cc(i_mom(1))+s_out) = & - box%cc(i, 1:nc, i_cc(i_mom(1))+s_out) + dt * & - pressure(i, :) * inv_radius + where (mask(i, :)) + box%cc(i, 1:nc, i_cc(i_mom(1))+s_out) = & + box%cc(i, 1:nc, i_cc(i_mom(1))+s_out) + dt * & + pressure(i, :) * inv_radius + end where end do #endif end subroutine add_geometric_source diff --git a/src/m_init_cond.f90 b/src/m_init_cond.f90 index 38cc6223..7a50d323 100644 --- a/src/m_init_cond.f90 +++ b/src/m_init_cond.f90 @@ -218,6 +218,7 @@ subroutine init_cond_set_box(box) use m_geometry use m_gas use m_user_methods + use m_streamer type(box_t), intent(inout) :: box integer :: IJK, n, nc real(dp) :: rr(NDIM) @@ -282,7 +283,7 @@ subroutine init_cond_set_box(box) if (ST_use_electrode) then if (box%cc(IJK, i_lsf) <= 0) then - box%cc(IJK, species_itree(n_gas_species+1:n_species)) = 0.0_dp + box%cc(IJK, all_densities) = 0.0_dp end if end if end do; CLOSE_DO diff --git a/src/m_model.f90 b/src/m_model.f90 new file mode 100644 index 00000000..0993988d --- /dev/null +++ b/src/m_model.f90 @@ -0,0 +1,48 @@ +!> Module to set the type of model +module m_model + use m_af_all + use m_types + + implicit none + private + + !> Fluid model with local field approximation + integer, parameter :: model_lfa = 1 + + !> Fluid model with local energy approximation and energy fluxes that are + !> "5/3" times the electron flux + integer, parameter :: model_ee53 = 2 + + !> Which type of model is used + integer, public, protected :: model_type = model_lfa + + !> Whether the model has an energy equation + logical, public, protected :: model_has_energy_equation = .false. + + public :: model_initialize + +contains + + !> Initialize the module + subroutine model_initialize(cfg) + use m_config + type(CFG_t), intent(inout) :: cfg + character(len=name_len) :: model_name + + model_name = "lfa" + call CFG_add_get(cfg, "model%type", model_name, & + "Which type of model is used") + + select case (model_name) + case ("lfa") + model_type = model_lfa + case ("ee53") + model_type = model_ee53 + model_has_energy_equation = .true. + case default + error stop "Unknown model (choices: lfa, ee53)" + end select + + end subroutine model_initialize + +end module m_model diff --git a/src/m_output.f90 b/src/m_output.f90 index 1ff11413..b5d86af6 100644 --- a/src/m_output.f90 +++ b/src/m_output.f90 @@ -335,8 +335,8 @@ end subroutine write_sim_data call field_set_rhs(tree, 0) ! Ensure valid ghost cells for density-based variables - call af_restrict_tree(tree, species_itree(n_gas_species+1:n_species)) - call af_gc_tree(tree, species_itree(n_gas_species+1:n_species)) + call af_restrict_tree(tree, all_densities) + call af_gc_tree(tree, all_densities) call af_restrict_tree(tree, [i_rhs]) call af_gc_tree(tree, [i_rhs]) @@ -584,17 +584,20 @@ subroutine output_log(tree, filename, out_cnt, wc_time) open(newunit=my_unit, file=trim(filename), action="write") #if NDIM == 1 write(my_unit, "(A)", advance="no") "it time dt v sum(n_e) sum(n_i) & - &sum(charge) sum(J.E) max(E) x max(n_e) x voltage ne_zmin ne_zmax & + &sum(charge) sum(J.E) max(E) x max(n_e) x voltage current_J.E & + ¤t_displ ne_zmin ne_zmax & &max(Etip) x wc_time n_cells min(dx) dt_cfl dt_diff dt_drt dt_chem & &highest(lvl)" #elif NDIM == 2 write(my_unit, "(A)", advance="no") "it time dt v sum(n_e) sum(n_i) & - &sum(charge) sum(J.E) max(E) x y max(n_e) x y max(E_r) x y min(E_r) voltage & + &sum(charge) sum(J.E) max(E) x y max(n_e) x y max(E_r) x y min(E_r) & + &voltage current_J.E current_displ & &ne_zmin ne_zmax max(Etip) x y wc_time n_cells min(dx) & &dt_cfl dt_diff dt_drt dt_chem highest(lvl)" #elif NDIM == 3 write(my_unit, "(A)", advance="no") "it time dt v sum(n_e) sum(n_i) & &sum(charge) sum(J.E) max(E) x y z max(n_e) x y z voltage & + ¤t_J.E current_displ & &ne_zmin ne_zmax max(Etip) x y z wc_time n_cells min(dx) & &dt_cfl dt_diff dt_drt dt_chem highest(lvl)" #endif @@ -611,11 +614,11 @@ subroutine output_log(tree, filename, out_cnt, wc_time) end if #if NDIM == 1 - n_reals = 17 + n_reals = 19 #elif NDIM == 2 - n_reals = 24 + n_reals = 26 #elif NDIM == 3 - n_reals = 23 + n_reals = 25 #endif if (associated(user_log_variables)) then @@ -634,28 +637,31 @@ subroutine output_log(tree, filename, out_cnt, wc_time) write(my_unit, fmt) out_cnt, global_time, dt, velocity, sum_elec, & sum_pos_ion, sum_elem_charge, ST_global_JdotE, & max_field, af_r_loc(tree, loc_field), max_elec, & - af_r_loc(tree, loc_elec), current_voltage, ne_zminmax, & + af_r_loc(tree, loc_elec), current_voltage, ST_global_JdotE_current, & + ST_global_displ_current, ne_zminmax, & max_field_tip, r_tip, & wc_time, af_num_cells_used(tree), & - af_min_dr(tree), minval(dt_matrix(1:dt_num_cond, :), dim=2), & + af_min_dr(tree), dt_limits, & tree%highest_lvl, var_values(1:n_user_vars) #elif NDIM == 2 write(my_unit, fmt) out_cnt, global_time, dt, velocity, sum_elec, & sum_pos_ion, sum_elem_charge, ST_global_JdotE, & max_field, af_r_loc(tree, loc_field), max_elec, & af_r_loc(tree, loc_elec), max_Er, af_r_loc(tree, loc_Er), min_Er, & - current_voltage, ne_zminmax, max_field_tip, r_tip, & + current_voltage, ST_global_JdotE_current, & + ST_global_displ_current, ne_zminmax, max_field_tip, r_tip, & wc_time, af_num_cells_used(tree), af_min_dr(tree), & - minval(dt_matrix(1:dt_num_cond, :), dim=2), tree%highest_lvl, & + dt_limits, tree%highest_lvl, & var_values(1:n_user_vars) #elif NDIM == 3 write(my_unit, fmt) out_cnt, global_time, dt, velocity, sum_elec, & sum_pos_ion, sum_elem_charge, ST_global_JdotE, & max_field, af_r_loc(tree, loc_field), max_elec, & - af_r_loc(tree, loc_elec), current_voltage, ne_zminmax, & + af_r_loc(tree, loc_elec), current_voltage, ST_global_JdotE_current, & + ST_global_displ_current, ne_zminmax, & max_field_tip, r_tip, & wc_time, af_num_cells_used(tree), & - af_min_dr(tree), minval(dt_matrix(1:dt_num_cond, :), dim=2), & + af_min_dr(tree), dt_limits, & tree%highest_lvl, var_values(1:n_user_vars) #endif close(my_unit) @@ -856,8 +862,7 @@ subroutine output_status(tree, time, wc_time, it, dt) ! This line prints the different time step restrictions write(*, "(A,4E10.3,A)") " dt: ", & - minval(dt_matrix(1:dt_num_cond, :), dim=2), & - " (cfl diff drt chem)" + dt_limits, " (cfl drt chem other)" end subroutine output_status subroutine output_fld_maxima(tree, filename) diff --git a/src/m_streamer.f90 b/src/m_streamer.f90 index 12688593..218b6879 100644 --- a/src/m_streamer.f90 +++ b/src/m_streamer.f90 @@ -20,6 +20,8 @@ module m_streamer integer, public, protected :: i_electron = -1 !> Index of electron density (in species list) integer, public, protected :: ix_electron = -1 + !> Index of electron energy density + integer, public, protected :: i_electron_energy = -1 !> Index of first positive ion species integer, public, protected :: i_1pos_ion = -1 !> Index of first positive ion (in species list) @@ -37,6 +39,9 @@ module m_streamer !> Index can be set to include an electrode integer, public, protected :: i_lsf = -1 + !> Index of all densities that evolve in time + integer, public, protected, allocatable :: all_densities(:) + !> Include deposited power density in output logical, public, protected :: compute_power_density = .false. !> Index of deposited power density @@ -49,14 +54,23 @@ module m_streamer !> Index of electron flux integer, public, protected :: flux_elec = -1 + !> Index of electron energy flux + integer, public, protected :: flux_energy = -1 !> Index of electric field vector integer, public, protected :: electric_fld = -1 + + !> Number of flux variables + integer, public, protected :: flux_num_species = -1 + !> Number of electron flux variables + integer, public, protected :: flux_num_electron_vars = -1 !> List of all flux variables (face-centered index) integer, public, protected, allocatable :: flux_variables(:) !> List of all flux species (cell-centered index) integer, public, protected, allocatable :: flux_species(:) !> List of the charges of the flux species integer, public, protected, allocatable :: flux_species_charge(:) + !> List of the signs of the charges of the flux species (+- 1) + integer, public, protected, allocatable :: flux_species_charge_sign(:) !> List of positive ion fluxes (useful for secondary emission) integer, public, protected, allocatable :: flux_pos_ion(:) @@ -95,6 +109,9 @@ module m_streamer integer, public, parameter :: source_factor_flux = 1 integer, public, parameter :: source_factor_original_flux = 2 + !> Minimum number of electrons per cell to include source terms + real(dp), public, protected :: ST_source_min_electrons_per_cell = -1e100_dp + !> End time of the simulation real(dp), public, protected :: ST_end_time = 10e-9_dp @@ -152,8 +169,14 @@ module m_streamer !> Current sum of J.E per thread real(dp), public, allocatable :: ST_current_JdotE(:, :) - !> Current estimated electric current - real(dp), public :: ST_global_current + !> Per how many iterations the electric current is computed + integer, public, protected :: current_update_per_steps = 10 + + !> Electric current through electrodes due to J.E + real(dp), public :: ST_global_JdotE_current + + !> Electric current through electrodes due to displacement current + real(dp), public :: ST_global_displ_current !> Global sum of J.E real(dp), public :: ST_global_JdotE @@ -175,6 +198,8 @@ subroutine ST_initialize(tree, cfg, ndim) use m_units_constants use m_gas use m_transport_data + use m_dt + use m_model type(af_t), intent(inout) :: tree type(CFG_t), intent(inout) :: cfg !< The configuration for the simulation integer, intent(in) :: ndim !< Number of dimensions @@ -186,6 +211,7 @@ subroutine ST_initialize(tree, cfg, ndim) [8123, 91234, 12399, 293434] integer(int64) :: rng_int8_seed(2) real(dp) :: tmp + integer :: flux_ix logical :: write_source_factor = .false. ! Set index of electrons @@ -208,27 +234,49 @@ subroutine ST_initialize(tree, cfg, ndim) write_binary=.false.) call af_add_fc_variable(tree, "field", ix=electric_fld) - allocate(flux_species(1+transport_data_ions%n_mobile_ions)) - allocate(flux_species_charge(1+transport_data_ions%n_mobile_ions)) - allocate(flux_variables(1+transport_data_ions%n_mobile_ions)) - flux_species(1) = i_electron - flux_species_charge(1) = -1 - flux_variables(1) = flux_elec + all_densities = species_itree(n_gas_species+1:n_species) + + if (model_has_energy_equation) then + i_electron_energy = af_find_cc_variable(tree, "e_energy") + call af_add_fc_variable(tree, "flux_energy", ix=flux_energy, & + write_binary=.false.) + flux_num_electron_vars = 2 + else + flux_num_electron_vars = 1 + end if + + flux_num_species = flux_num_electron_vars+transport_data_ions%n_mobile_ions + allocate(flux_species(flux_num_species)) + allocate(flux_species_charge(flux_num_species)) + allocate(flux_species_charge_sign(flux_num_species)) + allocate(flux_variables(flux_num_species)) + + flux_species(1) = i_electron + flux_species_charge(1) = -1 + flux_species_charge_sign(1) = -1 + flux_variables(1) = flux_elec + + if (model_has_energy_equation) then + flux_species(2) = i_electron_energy + flux_species_charge(2) = 0 + flux_species_charge_sign(2) = -1 ! Used to determine upwind direction + flux_variables(2) = flux_energy + end if do n = 1, transport_data_ions%n_mobile_ions - flux_species(1+n) = af_find_cc_variable(tree, & + flux_ix = flux_num_electron_vars + n + flux_species(flux_ix) = af_find_cc_variable(tree, & trim(transport_data_ions%names(n))) ! Get index in chemistry list and determine charge ix_chemistry = species_index(trim(transport_data_ions%names(n))) - flux_species_charge(1+n) = species_charge(ix_chemistry) + flux_species_charge(flux_ix) = species_charge(ix_chemistry) + flux_species_charge_sign(flux_ix) = sign(1, species_charge(ix_chemistry)) call af_add_fc_variable(tree, trim(transport_data_ions%names(n)), & - ix=flux_variables(1+n), write_binary=.false.) + ix=flux_variables(flux_ix), write_binary=.false.) end do - if (i_1pos_ion == -1) error stop "No positive ion species (1+) found" - ! Create a list of positive ion fluxes for secondary emission n = count(flux_species_charge > 0) allocate(flux_pos_ion(n)) @@ -241,6 +289,7 @@ subroutine ST_initialize(tree, cfg, ndim) end if end do + ! Add one copy so that the old value can be restored call af_add_cc_variable(tree, "phi", ix=i_phi, n_copies=2) call af_add_cc_variable(tree, "electric_fld", ix=i_electric_fld) call af_add_cc_variable(tree, "rhs", ix=i_rhs) @@ -336,6 +385,10 @@ subroutine ST_initialize(tree, cfg, ndim) ST_multigrid_max_rel_residual, & "Stop multigrid when residual is smaller than this factor times max(|rhs|)") + call CFG_add_get(cfg, "current_update_per_steps", & + current_update_per_steps, & + "Per how many iterations the electric current is computed") + prolong_method = "limit" call CFG_add_get(cfg, "prolong_density", prolong_method, & "Density prolongation method (limit, linear, linear_cons, sparse)") @@ -356,27 +409,26 @@ subroutine ST_initialize(tree, cfg, ndim) call CFG_add_get(cfg, "fixes%drt_max_field", ST_drt_max_field, & "Enable flux limiting, but prevent field from exceeding this value") - if (ST_drt_max_field < 1e100_dp) ST_drt_limit_flux = .true. + if (ST_drt_max_field < 1e100_dp) then + error stop "fixes%drt_max_field not yet implemented" + ST_drt_limit_flux = .true. + end if call CFG_add_get(cfg, "fixes%source_factor", source_factor, & "Use source factor to prevent unphysical effects due to diffusion") call CFG_add_get(cfg, "fixes%write_source_factor", write_source_factor, & "Whether to write the source factor to the output") + call CFG_add_get(cfg, "fixes%source_min_electrons_per_cell", & + ST_source_min_electrons_per_cell, & + "Minimum number of electrons per cell to include source terms") select case (source_factor) case ("none") ST_source_factor = source_factor_none case ("flux") ST_source_factor = source_factor_flux - case ("original_flux") - ST_source_factor = source_factor_original_flux - if (.not. write_source_factor) then - print *, "source factor scheme original_flux requires ", & - "fixes%write_source_factor = T" - error stop - end if case default - print *, "Options fixes%source_factor: none, flux, original_flux" + print *, "Options fixes%source_factor: none, flux" error stop "Unknown fixes%source_factor" end select diff --git a/src/m_table_data.f90 b/src/m_table_data.f90 index d45389ec..33a65830 100644 --- a/src/m_table_data.f90 +++ b/src/m_table_data.f90 @@ -47,7 +47,7 @@ subroutine table_data_initialize(cfg) call CFG_add_get(cfg, "table_data%min_townsend", table_min_townsend, & "Minimal field (in Td) for the rate coeff. lookup table") call CFG_add_get(cfg, "table_data%max_townsend", table_max_townsend, & - "Maximal field (in Td) for the rate coeff. lookup table") + "Maximal field (Td) for lookup tables, < 0 means automatic") method = "linear" call CFG_add_get(cfg, "table_data%input_interpolation", method, & @@ -95,6 +95,13 @@ subroutine table_set_column(tbl, i_col, x, y) ! Perform cubic spline interpolation call spline_set_coeffs(x, y, size(x), spl) y_table = spline_evaluate(tbl%x, spl) + + if (minval(y) >= 0.0_dp) then + ! If original data is non-negative, ensure interpolated data is also + ! non-negative (important for e.g. rate coefficients) + y_table = max(0.0_dp, y_table) + end if + call LT_set_col_data(tbl, i_col, y_table) case default error stop "invalid input_interpolation" diff --git a/src/m_transport_data.f90 b/src/m_transport_data.f90 index 07a188d3..508f20e6 100644 --- a/src/m_transport_data.f90 +++ b/src/m_transport_data.f90 @@ -14,17 +14,34 @@ module m_transport_data integer, parameter, public :: td_diffusion = 2 !< Electron diffusion constant integer, parameter, public :: td_alpha = 3 !< Ionization coefficient integer, parameter, public :: td_eta = 4 !< Attachment coefficient + !> Electron energy in eV (used with chemistry) integer, protected, public :: td_energy_eV = -1 - !> Scale factor for bulk mobilities - integer, protected, public :: td_bulk_scaling = -1 ! Table with transport data vs electric field type(LT_t), public, protected :: td_tbl + ! Table with transport data vs electron energy + type(LT_t), public, protected :: td_ee_tbl + + !> Electron mobility as a function of energy + integer, protected, public :: td_ee_mobility = 1 + + !> Electron diffusion coefficient as a function of energy + integer, protected, public :: td_ee_diffusion = 2 + + !> Electron energy loss + integer, protected, public :: td_ee_loss = 3 + + !> Field as a function of energy + integer, protected, public :: td_ee_field = 4 + !> Whether old style transport data is used (alpha, eta, mu, D vs V/m) logical, public, protected :: td_old_style = .false. + !> Maximal energy (eV) in input data (automatically updated) + real(dp), public, protected :: td_max_eV = 20.0_dp + ! @todo move this to separate ion module type ion_transport_t integer :: n_mobile_ions ! Number of mobile ions @@ -37,12 +54,6 @@ module m_transport_data !> Secondary electron emission yield for positive ions real(dp), public, protected :: ion_se_yield = 0.0_dp - !> Whether to use bulk transport coefficients (mu, D) - logical, public, protected :: td_bulk_transport = .false. - - !> Whether to scale reactions proportional to mu_bulk/mu - logical, public, protected :: td_bulk_scale_reactions = .false. - public :: transport_data_initialize contains @@ -53,11 +64,12 @@ subroutine transport_data_initialize(cfg) use m_table_data use m_gas use m_units_constants + use m_model type(CFG_t), intent(inout) :: cfg character(len=string_len) :: td_file = undefined_str - real(dp), allocatable :: x_data(:), y_data(:) - real(dp), allocatable :: x_data2(:), y_data2(:) - real(dp) :: dummy_real(0) + real(dp), allocatable :: xx(:), yy(:) + real(dp), allocatable :: energy_eV(:), field_Td(:) + real(dp) :: dummy_real(0), max_Td, max_eV character(len=10) :: dummy_string(0) integer :: n @@ -68,102 +80,107 @@ subroutine transport_data_initialize(cfg) call CFG_add_get(cfg, "input_data%old_style", td_old_style, & "Use old style transport data (alpha, eta, mu, D vs V/m)") - call CFG_add_get(cfg, "input_data%bulk_transport", td_bulk_transport, & - "Whether to use bulk transport coefficients (mu, D)") - call CFG_add_get(cfg, "input_data%bulk_scale_reactions", td_bulk_scale_reactions, & - "Whether to scale reactions proportional to mu_bulk/mu") - - if (td_bulk_scale_reactions .and. .not. td_bulk_transport) & - error stop "Cannot have bulk_scale_reactions without bulk_transport" - ! Fill table with data if (td_old_style) then if (.not. gas_constant_density) & error stop "Old style transport used with varying gas density" - if (td_bulk_transport .and. .not. td_bulk_scale_reactions) & - error stop "Old style bulk data requires bulk_scale_reactions = T" + if (model_has_energy_equation) & + error stop "Old style transport used with energy equation" - ! Create a lookup table for the model coefficients - td_tbl = LT_create(table_min_townsend, table_max_townsend, table_size, & - 4, table_xspacing) + call table_from_file(td_file, "efield[V/m]_vs_mu[m2/Vs]", xx, yy) + xx = xx * SI_to_Townsend / gas_number_density + yy = yy * gas_number_density - if (td_bulk_transport) then - call table_from_file(td_file, "efield[V/m]_vs_mu_bulk[m2/Vs]", x_data, y_data) + ! Create a lookup table for the model coefficients + if (table_max_townsend < 0) then + max_Td = xx(size(xx)) else - call table_from_file(td_file, "efield[V/m]_vs_mu[m2/Vs]", x_data, y_data) + max_Td = table_max_townsend end if - x_data = x_data * SI_to_Townsend / gas_number_density - y_data = y_data * gas_number_density - call table_set_column(td_tbl, td_mobility, x_data, y_data) - if (td_bulk_transport) then - call table_from_file(td_file, "efield[V/m]_vs_dif_bulk[m2/s]", & - x_data, y_data) - else - call table_from_file(td_file, "efield[V/m]_vs_dif[m2/s]", & - x_data, y_data) - end if - x_data = x_data * SI_to_Townsend / gas_number_density - y_data = y_data * gas_number_density - call table_set_column(td_tbl, td_diffusion, x_data, y_data) + td_tbl = LT_create(table_min_townsend, max_Td, table_size, & + 4, table_xspacing) + + call table_set_column(td_tbl, td_mobility, xx, yy) + + call table_from_file(td_file, "efield[V/m]_vs_dif[m2/s]", xx, yy) + xx = xx * SI_to_Townsend / gas_number_density + yy = yy * gas_number_density + call table_set_column(td_tbl, td_diffusion, xx, yy) call table_from_file(td_file, "efield[V/m]_vs_alpha[1/m]", & - x_data, y_data) - x_data = x_data * SI_to_Townsend / gas_number_density - y_data = y_data / gas_number_density - call table_set_column(td_tbl, td_alpha, x_data, y_data) + xx, yy) + xx = xx * SI_to_Townsend / gas_number_density + yy = yy / gas_number_density + call table_set_column(td_tbl, td_alpha, xx, yy) call table_from_file(td_file, "efield[V/m]_vs_eta[1/m]", & - x_data, y_data) - x_data = x_data * SI_to_Townsend / gas_number_density - y_data = y_data / gas_number_density - call table_set_column(td_tbl, td_eta, x_data, y_data) + xx, yy) + xx = xx * SI_to_Townsend / gas_number_density + yy = yy / gas_number_density + call table_set_column(td_tbl, td_eta, xx, yy) else + call table_from_file(td_file, "Mobility *N (1/m/V/s)", xx, yy) + ! Create a lookup table for the model coefficients - if (td_bulk_scale_reactions) then - td_tbl = LT_create(table_min_townsend, table_max_townsend, & - table_size, 6, table_xspacing) - - ! Store scale factor for reactions - td_bulk_scaling = 6 - call table_from_file(td_file, "Bulk mobility *N (1/m/V/s)", x_data, y_data) - call table_from_file(td_file, "Mobility *N (1/m/V/s)", x_data2, y_data2) - if (maxval(abs(x_data - x_data2)) > 0) & - error stop "Mobility and Bulk mobility not given at same E/N" - call table_set_column(td_tbl, td_bulk_scaling, x_data, y_data/y_data2) + if (table_max_townsend < 0) then + max_Td = xx(size(xx)) else - td_tbl = LT_create(table_min_townsend, table_max_townsend, & - table_size, 5, table_xspacing) + max_Td = table_max_townsend end if - if (td_bulk_transport) then - call table_from_file(td_file, "Bulk mobility *N (1/m/V/s)", x_data, y_data) - else - call table_from_file(td_file, "Mobility *N (1/m/V/s)", x_data, y_data) - end if - call table_set_column(td_tbl, td_mobility, x_data, y_data) + td_tbl = LT_create(table_min_townsend, max_Td, & + table_size, 5, table_xspacing) - if (td_bulk_transport) then - call table_from_file(td_file, "Bulk diffusion coef. *N (1/m/s)", & - x_data, y_data) - else - call table_from_file(td_file, "Diffusion coefficient *N (1/m/s)", & - x_data, y_data) - end if - call table_set_column(td_tbl, td_diffusion, x_data, y_data) + call table_set_column(td_tbl, td_mobility, xx, yy) + + call table_from_file(td_file, "Diffusion coefficient *N (1/m/s)", & + xx, yy) + call table_set_column(td_tbl, td_diffusion, xx, yy) call table_from_file(td_file, "Townsend ioniz. coef. alpha/N (m2)", & - x_data, y_data) - call table_set_column(td_tbl, td_alpha, x_data, y_data) + xx, yy) + call table_set_column(td_tbl, td_alpha, xx, yy) call table_from_file(td_file, "Townsend attach. coef. eta/N (m2)", & - x_data, y_data) - call table_set_column(td_tbl, td_eta, x_data, y_data) + xx, yy) + call table_set_column(td_tbl, td_eta, xx, yy) td_energy_eV = 5 call table_from_file(td_file, "Mean energy (eV)", & - x_data, y_data) - call table_set_column(td_tbl, td_energy_eV, x_data, y_data) + xx, yy) + call table_set_column(td_tbl, td_energy_eV, xx, yy) + td_max_eV = yy(size(yy)) + end if + + if (model_has_energy_equation) then + call table_from_file(td_file, "Mean energy (eV)", field_Td, energy_eV) + max_eV = energy_eV(size(energy_eV)) + td_ee_tbl = LT_create(0.0_dp, max_eV, table_size, 4, table_xspacing) + + call table_from_file(td_file, "Mobility *N (1/m/V/s)", xx, yy) + if (.not. same_data(xx, field_Td)) & + error stop "Same reduced field table required in all input data" + + ! Mobility as a function of energy + call table_set_column(td_ee_tbl, td_ee_mobility, energy_eV, yy) + + ! Energy loss is mu E^2 as a function of energy. Prepend a zero, since at + ! zero energy there can be no energy loss. + yy = yy * xx**2 * Townsend_to_SI**2 * gas_number_density + call table_set_column(td_ee_tbl, td_ee_loss, & + [0.0_dp, energy_eV], [0.0_dp, yy]) + + call table_from_file(td_file, "Diffusion coefficient *N (1/m/s)", xx, yy) + if (.not. same_data(xx, field_Td)) & + error stop "Same reduced field table required in all input data" + + ! Also prepend a zero, since at zero energy there can be no diffusion + call table_set_column(td_ee_tbl, td_ee_diffusion, & + [0.0_dp, energy_eV], [0.0_dp, yy]) + + call table_set_column(td_ee_tbl, td_ee_field, & + [0.0_dp, energy_eV], [0.0_dp, xx]) end if call CFG_add(cfg, "input_data%mobile_ions", dummy_string, & @@ -182,7 +199,7 @@ subroutine transport_data_initialize(cfg) transport_data_ions%mobilities) if (any(transport_data_ions%mobilities < 0)) & - error stop "Ion mobilities should be given as positive numbers" + error stop "Ion mobilities should be given as positive numbers" ! Scale ion mobilities with gas number density at 300 K and 1 bar transport_data_ions%mobilities = transport_data_ions%mobilities * & @@ -193,4 +210,15 @@ subroutine transport_data_initialize(cfg) end subroutine transport_data_initialize + !> Check whether data is the same + pure logical function same_data(x1, x2) + real(dp), intent(in) :: x1(:), x2(:) + + if (size(x1) == size(x2)) then + same_data = minval(abs(x1-x2)) < tiny_real + else + same_data = .false. + end if + end function same_data + end module m_transport_data diff --git a/src/m_types.f90 b/src/m_types.f90 index 75060140..10437740 100644 --- a/src/m_types.f90 +++ b/src/m_types.f90 @@ -15,6 +15,9 @@ module m_types !> Huge number real(dp), parameter :: huge_real = 1e100_dp + !> Small number + real(dp), parameter :: tiny_real = 1/huge_real + !> Default length of strings integer, parameter :: string_len = 200 diff --git a/src/streamer.f90 b/src/streamer.f90 index 93271e04..067f95cd 100644 --- a/src/streamer.f90 +++ b/src/streamer.f90 @@ -19,6 +19,7 @@ program streamer use m_output use m_dielectric use m_units_constants + use m_model implicit none @@ -42,6 +43,8 @@ program streamer real(dp) :: pos_Emax(NDIM), pos_Emax_t0(NDIM) real(dp) :: breakdown_field_Td, current_output_dt real(dp) :: time_until_next_pulse + real(dp) :: field_energy, field_energy_prev + real(dp) :: tmp, field_energy_prev_time logical :: step_accepted, start_of_new_pulse !> The configuration for the simulation @@ -69,8 +72,8 @@ program streamer breakdown_field_Td*Townsend_to_SI*gas_number_density ! Specify default methods for all the variables - do i = n_gas_species+1, n_species - call af_set_cc_methods(tree, species_itree(i), & + do i = 1, size(all_densities) + call af_set_cc_methods(tree, all_densities(i), & bc_species, af_gc_interp_lim, ST_prolongation_method) end do @@ -161,6 +164,9 @@ program streamer time_last_print = -1e10_dp time_last_output = time + call field_compute_energy(tree, field_energy_prev) + field_energy_prev_time = time + do it = it + 1 if (time >= ST_end_time) exit @@ -237,8 +243,7 @@ program streamer do while (.not. step_accepted) call copy_current_state() - call af_advance(tree, dt, dt_lim, time, & - species_itree(n_gas_species+1:n_species), & + call af_advance(tree, dt, dt_lim, time, all_densities, & time_integrator, forward_euler) ! Check if dt was small enough for the new state @@ -264,9 +269,28 @@ program streamer ST_global_JdotE = ST_global_JdotE + & sum(ST_current_JdotE(1, :)) * dt - ! Estimate electric current according to Sato's equation V*I = sum(J.E). - ! TODO: only consider background electric field when computing sum(J.E) - ST_global_current = sum(ST_current_JdotE(1, :)) / current_voltage + ! Estimate electric current according to Sato's equation V*I = sum(J.E), + ! where J includes both the conduction current and the displacement + ! current, see 10.1088/0022-3727/32/5/005. + ! The latter is computed through the field energy, which contains + ! some noise, so the current is only updated every N iterations. + if (mod(it, current_update_per_steps) == 0) then + call field_compute_energy(tree, field_energy) + + ! Time derivative of field energy + tmp = (field_energy - field_energy_prev)/(time - field_energy_prev_time) + field_energy_prev = field_energy + field_energy_prev_time = time + + ! Add J.E term + if (abs(current_voltage) > 0.0_dp) then + ST_global_JdotE_current = sum(ST_current_JdotE(1, :)) / current_voltage + ST_global_displ_current = tmp/current_voltage + else + ST_global_JdotE_current = 0.0_dp + ST_global_displ_current = 0.0_dp + end if + end if ! Make sure field is available for latest time state call field_compute(tree, mg, 0, time, .true.) @@ -322,8 +346,8 @@ program streamer if (mod(it, refine_per_steps) == 0) then ! Restrict species, for the ghost cells near refinement boundaries - call af_restrict_tree(tree, species_itree(n_gas_species+1:n_species)) - call af_gc_tree(tree, species_itree(n_gas_species+1:n_species)) + call af_restrict_tree(tree, all_densities) + call af_gc_tree(tree, all_densities) if (gas_dynamics) then call af_restrict_tree(tree, gas_vars) @@ -368,6 +392,7 @@ subroutine initialize_modules(cfg, tree, mg, restart) type(mg_t), intent(inout) :: mg logical, intent(in) :: restart + call model_initialize(cfg) call user_initialize(cfg, tree) call dt_initialize(cfg) global_dt = dt_min @@ -510,7 +535,7 @@ subroutine electrode_species_bc(box) do KJI_DO(1, nc) if (box%cc(IJK, i_lsf) < 0) then ! Set all species densities to zero - box%cc(IJK, species_itree(n_gas_species+1:n_species)) = 0.0_dp + box%cc(IJK, all_densities) = 0.0_dp #if NDIM == 1 lsf_nb = [box%cc(i-1, i_lsf), & @@ -564,8 +589,7 @@ subroutine copy_current_state() integer :: n_states n_states = af_advance_num_steps(time_integrator) - call af_tree_copy_ccs(tree, species_itree(n_gas_species+1:n_species), & - species_itree(n_gas_species+1:n_species) + n_states) + call af_tree_copy_ccs(tree, all_densities, all_densities+n_states) ! Copy potential call af_tree_copy_cc(tree, i_phi, i_phi+1) @@ -581,8 +605,7 @@ subroutine restore_previous_state() n_states = af_advance_num_steps(time_integrator) - call af_tree_copy_ccs(tree, species_itree(n_gas_species+1:n_species) + n_states, & - species_itree(n_gas_species+1:n_species)) + call af_tree_copy_ccs(tree, all_densities+n_states, all_densities) ! Copy potential and compute field again call af_tree_copy_cc(tree, i_phi+1, i_phi) diff --git a/tools/plot_transport_data_summary.py b/tools/plot_transport_data_summary.py index c07335aa..f7b4a231 100755 --- a/tools/plot_transport_data_summary.py +++ b/tools/plot_transport_data_summary.py @@ -10,20 +10,26 @@ p = argparse.ArgumentParser( formatter_class=argparse.ArgumentDefaultsHelpFormatter) -p.add_argument("summary_file", type=str, help="File _summary.txt") +p.add_argument("summary_file", type=str, nargs='+', + help="File _summary.txt") p.add_argument("-SI_field", action='store_true', help="Use electric field in V/m rather than Td") args = p.parse_args() -tdata = pd.read_csv(args.summary_file, delim_whitespace=True) +all_data = [pd.read_csv(f, delim_whitespace=True) for f in args.summary_file] if args.SI_field: - tdata.set_index('E[V/m]', inplace=True) - tdata.drop(columns='E/N[Td]', inplace=True) + for x in all_data: + x.set_index('E[V/m]', inplace=True) + x.drop(columns='E/N[Td]', inplace=True) else: - tdata.set_index('E/N[Td]', inplace=True) - tdata.drop(columns='E[V/m]', inplace=True) + for x in all_data: + x.set_index('E/N[Td]', inplace=True) + x.drop(columns='E[V/m]', inplace=True) -tdata.plot(subplots=True, layout=(-1, 2), sharex=True, figsize=(10, 10)) +ax = all_data[0].plot(subplots=True, layout=(-1, 2), + sharex=True, figsize=(10, 10)) +for x in all_data[1:]: + x.plot(subplots=True, layout=(-1, 2), sharex=True, figsize=(10, 10), ax=ax) plt.show()