Added utilty module for converting to/from C strings. Added some procedures to interface with C routines that accept/return strings.

2 files changed, 136 insertions, 5 deletions

diff --git a/src/clp.f90 b/src/clp.f90
index 1e29aae..b6c90bb 100644
--- a/src/clp.f90
+++ b/src/clp.f90
@@ -1,10 +1,13 @@
 module clp
     use iso_c_binding
     implicit none
+    
         interface
-            function Clp_Version() bind(C,name="Clp_Version")
+        
+            ! Version Routines
+            function Clp_Version_C() bind(C,name="Clp_Version")
                 use iso_c_binding
-                    type(c_ptr) :: Clp_Version
+                    type(c_ptr) :: Clp_Version_C
             end function
             function Clp_VersionMajor() bind(C,name="Clp_VersionMajor")
                 use iso_c_binding
@@ -18,6 +21,8 @@ module clp
                 use iso_c_binding
                     integer(c_int) :: Clp_VersionRelease
             end function
+
+            ! Model management
             function Clp_newModel() bind(C,name="Clp_newModel")
                 use iso_c_binding
                     type(c_ptr) :: Clp_newModel
@@ -26,6 +31,8 @@ module clp
                 use iso_c_binding
                     type(c_ptr), value :: model
             end subroutine
+            
+            ! Solver management
             function ClpSolve_new() bind(C,name="ClpSolve_new")
                 use iso_c_binding
                     type(c_ptr) :: ClpSolve_new
@@ -34,6 +41,8 @@ module clp
                 use iso_c_binding
                     type(c_ptr), value :: solve
             end subroutine
+            
+            
             subroutine Clp_loadProblem(model,numcols,numrows,start, &
                 index,value,collb,colub,obj,rowlb,rowub) bind(C,name="Clp_loadProblem")
                 use iso_c_binding
@@ -58,14 +67,16 @@ module clp
                     type(c_ptr), value :: column
                     real(c_double) :: element(*)
             end subroutine
-            function Clp_readMps(model,filename,keepNames,ignoreErrors) bind(C,name="Clp_readMps")
+            
+            function Clp_readMps_C(model,filename,keepNames,ignoreErrors) bind(C,name="Clp_readMps")
                 use iso_c_binding
                     type(c_ptr), value :: model
-                    character(c_char) :: filename(*)
+                    type(c_ptr), value :: filename
                     integer(c_int), value ::keepNames
                     integer(c_int), value ::ignoreErrors
-                    integer(c_int) :: Clp_readMps
+                    integer(c_int) :: Clp_readMps_C
             end function
+
             subroutine Clp_copyInIntegerInformation(model,information) bind(C,name="Clp_copyInIntegerInformation")
                 use iso_c_binding
                     type(c_ptr), value :: model
@@ -916,4 +927,39 @@ module clp
                     integer(c_int), value ::value
             end subroutine
     end interface
+
+contains
+
+    subroutine Clp_Version(s)
+    use clp_interface_utils, only: populate_fortran_string
+    implicit none
+
+        character(len=*), intent(out)::s
+
+        call populate_fortran_string(Clp_Version_C(), s)
+
+    end subroutine Clp_Version
+
+    function Clp_readMps(model,filename,keepNames,ignoreErrors)
+    use clp_interface_utils
+    use iso_c_binding
+    implicit none
+
+        type(c_ptr)::model
+        character(len=*)::filename
+
+        integer, intent(in)::keepNames
+        integer, intent(in)::ignoreErrors
+        integer::Clp_readMps
+        type(c_ptr)::c_filename
+
+        c_filename = allocate_and_populate_c_string(filename)
+
+        Clp_readMps = Clp_readMps_C(model, c_filename, keepNames, ignoreErrors)
+
+        call c_free(c_filename)
+
+    end function Clp_readMps
+
+
 end module clp
diff --git a/src/clp_interface_utils.f90 b/src/clp_interface_utils.f90
new file mode 100644
index 0000000..a6c22c7
--- /dev/null
+++ b/src/clp_interface_utils.f90
@@ -0,0 +1,85 @@
+module clp_interface_utils
+implicit none
+
+    interface
+    
+        function c_string_length(cstr) bind(c, name="strlen")
+        use iso_c_binding
+        implicit none        
+            type(c_ptr), value::cstr
+            integer(kind=c_size_t)::c_string_length
+        end function c_string_length
+        
+        function c_allocate(b) bind(c, name="malloc")
+        use iso_c_binding
+        implicit none
+            integer(kind=c_size_t), value::b
+            type(c_ptr)::c_allocate
+        end function c_allocate
+
+        subroutine c_free(p) bind(c, name="free")
+        use iso_c_binding, only: c_ptr
+        implicit none
+            type(c_ptr), value::p
+        end subroutine c_free
+
+    end interface
+
+contains
+
+    subroutine populate_fortran_string(cstr, fstr)
+    use iso_c_binding
+    implicit none
+
+        type(c_ptr), intent(in)::cstr
+        character(len=*), intent(out)::fstr
+
+        character(kind=c_char), dimension(:), pointer::cstr_fpointer
+        integer::i, n
+
+        ! Clear the return string
+        fstr = " "
+
+        if(c_associated(cstr)) then
+
+            ! Obtain a Fortran pointer
+            call c_f_pointer(cstr, cstr_fpointer, (/ 1 /))
+
+            ! Calculate the max number of characters to copy
+            n = min(int(c_string_length(cstr), 4), len(fstr))
+
+            ! Copy...
+            do i = 1, n
+                fstr(i:i) = cstr_fpointer(i)
+            end do
+
+        end if
+
+    end subroutine populate_fortran_string
+
+    function allocate_and_populate_c_string(fstr) result(c_str_ptr)
+    use iso_c_binding
+    implicit none
+
+        type(c_ptr)::c_str_ptr
+        character(len=*), intent(in)::fstr
+
+        character(kind=c_char), dimension(:), pointer::cstr
+
+        integer::i, n
+
+        n = len_trim(fstr)
+        c_str_ptr = c_allocate(int(n+1, kind=c_size_t))
+        if(c_associated(c_str_ptr)) then
+            call c_f_pointer(c_str_ptr, cstr, (/ 1 /))
+
+            cstr = c_null_char
+            do i=1, n
+                cstr(i) = fstr(i:i)
+            end do
+
+        end if
+
+    end function allocate_and_populate_c_string
+
+end module clp_interface_utils