add get_work to Fortran interface (#18)

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) {

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)