diff --git a/src/ALL_fortran.cpp b/src/ALL_fortran.cpp index da1575205c9f82fd967953ae6a615cc198d3b030..f3c179cc548965f8a01d058cb045fe0add3095e1 100644 --- a/src/ALL_fortran.cpp +++ b/src/ALL_fortran.cpp @@ -226,6 +226,29 @@ void all_get_dimension_c(ALL_t *all_obj, int *dim) { ALL_catch } +void all_get_length_of_work_c(ALL_t *all_obj, int *length) { + ALL_try + std::vector<double> work; + all_obj->getWork(work); + *length = work.size(); + ALL_catch +} + +void all_get_work_c(ALL_t *all_obj, double *work) { + ALL_try + *work = all_obj->getWork(); + ALL_catch +} + +void all_get_work_array_c(ALL_t *all_obj, double *work, int length) { + ALL_try + std::vector<double> all_work; + all_obj->getWork(all_work); + assert((int)all_work.size() == length); + memcpy(work,&all_work[0],length*sizeof(*work)); + ALL_catch +} + #ifdef ALL_VTK_OUTPUT // print VTK outlines void all_print_vtk_outlines_c(ALL_t * all_obj known_unused, int known_unused step) { diff --git a/src/ALL_module.F90 b/src/ALL_module.F90 index 94f7eb84968368737821b206bc6481a9f5833429..0092c46520878a72dea0fa0b0e3b10710ac14436 100644 --- a/src/ALL_module.F90 +++ b/src/ALL_module.F90 @@ -165,6 +165,22 @@ module ALL_module type(c_ptr), value :: obj integer(c_int) :: dim end subroutine + subroutine all_get_length_of_work_c(obj, length) bind(C) + use iso_c_binding + type(c_ptr), value :: obj + integer(c_int) :: length + end subroutine + subroutine all_get_work_c(obj, work) bind(C) + use iso_c_binding + type(c_ptr), value :: obj + real(c_double) :: work + end subroutine + subroutine all_get_work_array_c(obj, work, length) bind(C) + use iso_c_binding + type(c_ptr), value :: obj + integer(c_int), value :: length + real(c_double), dimension(length) :: work + end subroutine #ifdef ALL_VTK_OUTPUT subroutine all_print_vtk_outlines_c(obj, step) bind(C) use iso_c_binding @@ -219,6 +235,9 @@ module ALL_module procedure :: get_vertices_alloc => ALL_get_vertices_alloc procedure :: get_prev_vertices => ALL_get_prev_vertices procedure :: get_dimension => ALL_get_dimension + procedure :: get_length_of_work => ALL_get_length_of_work + procedure :: get_work => ALL_get_work + procedure :: get_work_array => ALL_get_work_array #ifdef ALL_VTK_OUTPUT procedure :: print_vtk_outlines => ALL_print_vtk_outlines procedure :: print_vtk_vertices => ALL_print_vtk_vertices @@ -246,6 +265,9 @@ module ALL_module public :: ALL_get_vertices_alloc public :: ALL_get_prev_vertices public :: ALL_get_dimension + public :: ALL_get_length_of_work + public :: ALL_get_work + public :: ALL_get_work_array #ifdef ALL_VTK_OUTPUT public :: ALL_print_vtk_outlines public :: ALL_print_vtk_vertices @@ -434,6 +456,30 @@ contains integer(c_int), intent(out) :: dim call all_get_dimension_c(this%object,dim) end subroutine + !> Retrieve length of work array + subroutine ALL_get_length_of_work(this, length) + class(ALL_t), intent(in) :: this + integer(c_int), intent(out) :: length + call all_get_length_of_work_c(this%object, length) + end subroutine + !> Retrieve first element of work array + subroutine ALL_get_work(this, work) + class(ALL_t), intent(in) :: this + real(c_double), intent(out) :: work + call all_get_work_c(this%object, work) + end subroutine + !> Retrieve work array, which must already be the correct size + subroutine ALL_get_work_array(this, work) + class(ALL_t), intent(in) :: this + real(c_double), dimension(:), intent(out) :: work + integer :: length + call ALL_get_length_of_work(this, length) + if(size(work) /= length) then + write(error_unit,'(a)') "ALL_get_work_array: work has wrong length!" + stop + endif + call all_get_work_array_c(this%object, work, size(work)) + end subroutine #ifdef ALL_VTK_OUTPUT !> Print VTK outlines (must be enabled in build step) subroutine ALL_print_vtk_outlines(this, step)