Add custom error handling option

.github/workflows/mac.yml

@@ -30,10 +30,12 @@ jobs:
       - uses: actions/checkout@v3
 
       - uses: actions/setup-python@v5
-      - run: pip install -r python/requirements.txt
+      - run: pip install -r python/requirements.txt --user
 
       - name: Run Cmake 
-        run: cmake -S . -B build -D CMAKE_BUILD_TYPE=${{ matrix.build_type }} -D MUSICA_ENABLE_PYTHON_LIBRARY=ON
+        run: |
+          PYTHON_PATH=$(which python)
+          cmake -S . -B build -D CMAKE_CXX_FLAGS=-Wl,-ld_classic -D CMAKE_BUILD_TYPE=${{ matrix.build_type }} -D MUSICA_ENABLE_PYTHON_LIBRARY=ON -D Python3_EXECUTABLE=${PYTHON_PATH}
 
       - name: Build
         run: cmake --build build --parallel
@@ -58,7 +60,7 @@ jobs:
         run: brew install netcdf netcdf-fortran
 
       - name: Run Cmake 
-        run: cmake -S . -B build -D CMAKE_BUILD_TYPE=${{ matrix.build_type }} -D MUSICA_BUILD_FORTRAN_INTERFACE=ON
+        run: cmake -S . -B build -D CMAKE_CXX_FLAGS=-Wl,-ld_classic -D CMAKE_BUILD_TYPE=${{ matrix.build_type }} -D MUSICA_BUILD_FORTRAN_INTERFACE=ON
 
       - name: Build
         run: cmake --build build --parallel

cmake/dependencies.cmake

@@ -33,7 +33,7 @@ endif()
 if (MUSICA_ENABLE_MICM)
   FetchContent_Declare(micm
       GIT_REPOSITORY https://github.com/NCAR/micm.git
-      GIT_TAG v3.5.0-release-candidate
+      GIT_TAG 2a5cd4e11a6973974f3c584dfa9841d70e0a42d5
   )
   FetchContent_MakeAvailable(micm)
 endif()

fortran/micm_core.F90

@@ -1,6 +1,7 @@
 module micm_core
-
-   use iso_c_binding, only: c_ptr, c_char, c_int, c_bool, c_double, c_null_char, c_size_t, c_f_pointer
+   use iso_c_binding, only: c_ptr, c_char, c_int, c_bool, c_double, c_null_char, &
+                            c_size_t, c_f_pointer, c_funptr, c_null_ptr, c_associated
+   use musica_util, only: error_t_c, is_success
    implicit none
 
    public :: micm_t, mapping_t
@@ -13,20 +14,24 @@ module micm_core
    end type mapping_t
 
    interface
-      function create_micm_c(config_path, error_code) bind(C, name="create_micm")
+      function create_micm_c(config_path, error) bind(C, name="create_micm")
+         use musica_util, only: error_t_c
          import c_ptr, c_int, c_char
-         character(kind=c_char), intent(in) :: config_path(*)
-         integer(kind=c_int), intent(out)   :: error_code
-         type(c_ptr)                        :: create_micm_c
+         character(kind=c_char), intent(in)    :: config_path(*)
+         type(error_t_c),        intent(inout) :: error
+         type(c_ptr)                           :: create_micm_c
       end function create_micm_c
 
-      subroutine delete_micm_c(micm) bind(C, name="delete_micm")
+      subroutine delete_micm_c(micm, error) bind(C, name="delete_micm")
+         use musica_util, only: error_t_c
          import c_ptr
-         type(c_ptr), intent(in) :: micm
+         type(c_ptr), value, intent(in)    :: micm
+         type(error_t_c),    intent(inout) :: error
       end subroutine delete_micm_c
 
       subroutine micm_solve_c(micm, time_step, temperature, pressure, num_concentrations, concentrations, &
-                              num_user_defined_reaction_rates, user_defined_reaction_rates) bind(C, name="micm_solve")
+                              num_user_defined_reaction_rates, user_defined_reaction_rates, error) bind(C, name="micm_solve")
+         use musica_util, only: error_t_c
          import c_ptr, c_double, c_int
          type(c_ptr), value, intent(in)         :: micm
          real(kind=c_double), value, intent(in) :: time_step
@@ -36,56 +41,69 @@ subroutine micm_solve_c(micm, time_step, temperature, pressure, num_concentratio
          real(kind=c_double), intent(inout)     :: concentrations(num_concentrations)
          integer(kind=c_int), value, intent(in) :: num_user_defined_reaction_rates
          real(kind=c_double), intent(inout)     :: user_defined_reaction_rates(num_user_defined_reaction_rates)
+         type(error_t_c), intent(inout)         :: error
       end subroutine micm_solve_c
 
-      function get_species_property_string_c(micm, species_name, property_name) bind(c, name="get_species_property_string")
-         use musica_util, only: string_t_c
+      function get_species_property_string_c(micm, species_name, property_name, error) bind(c, name="get_species_property_string")
+         use musica_util, only: error_t_c, string_t_c
          import :: c_ptr, c_char
-         type(c_ptr), value :: micm
+         type(c_ptr), value, intent(in) :: micm
          character(len=1, kind=c_char), intent(in) :: species_name(*), property_name(*)
+         type(error_t_c), intent(inout) :: error
          type(string_t_c) :: get_species_property_string_c
       end function get_species_property_string_c
 
-      function get_species_property_double_c(micm, species_name, property_name) bind(c, name="get_species_property_double")
+      function get_species_property_double_c(micm, species_name, property_name, error) bind(c, name="get_species_property_double")
+         use musica_util, only: error_t_c
          import :: c_ptr, c_char, c_double
-         type(c_ptr), value :: micm
+         type(c_ptr), value, intent(in) :: micm
          character(len=1, kind=c_char), intent(in) :: species_name(*), property_name(*)
+         type(error_t_c), intent(inout) :: error
          real(kind=c_double) :: get_species_property_double_c
       end function get_species_property_double_c
 
-      function get_species_property_int_c(micm, species_name, property_name) bind(c, name="get_species_property_int")
+      function get_species_property_int_c(micm, species_name, property_name, error) bind(c, name="get_species_property_int")
+         use musica_util, only: error_t_c
          import :: c_ptr, c_char, c_int
-         type(c_ptr), value :: micm
+         type(c_ptr), value, intent(in) :: micm
          character(len=1, kind=c_char), intent(in) :: species_name(*), property_name(*)
+         type(error_t_c), intent(inout) :: error
          integer(kind=c_int) :: get_species_property_int_c
       end function get_species_property_int_c
 
-      function get_species_property_bool_c(micm, species_name, property_name) bind(c, name="get_species_property_bool")
+      function get_species_property_bool_c(micm, species_name, property_name, error) bind(c, name="get_species_property_bool")
+         use musica_util, only: error_t_c
          import :: c_ptr, c_char, c_bool
-         type(c_ptr), value :: micm
+         type(c_ptr), value, intent(in) :: micm
          character(len=1, kind=c_char), intent(in) :: species_name(*), property_name(*)
+         type(error_t_c), intent(inout) :: error
          logical(kind=c_bool) :: get_species_property_bool_c
       end function get_species_property_bool_c      
 
-      function get_species_ordering(micm, array_size) bind(c, name="get_species_ordering")
+      function get_species_ordering(micm, array_size, error) bind(c, name="get_species_ordering")
+         use musica_util, only: error_t_c
          import :: c_ptr, c_size_t
-         type(c_ptr), value :: micm
+         type(c_ptr), value, intent(in) :: micm
          integer(kind=c_size_t), intent(out) :: array_size
+         type(error_t_c), intent(inout) :: error
          type(c_ptr)                         :: get_species_ordering
       end function get_species_ordering
 
-      type(c_ptr) function get_user_defined_reaction_rates_ordering(micm, array_size) &
+      type(c_ptr) function get_user_defined_reaction_rates_ordering(micm, array_size, error) &
          bind(c, name="get_user_defined_reaction_rates_ordering")
+         use musica_util, only: error_t_c
          import :: c_ptr, c_size_t
-         type(c_ptr), value :: micm
+         type(c_ptr), value, intent(in) :: micm
          integer(kind=c_size_t), intent(out) :: array_size
+         type(error_t_c), intent(inout) :: error
       end function get_user_defined_reaction_rates_ordering
    end interface
 
    type :: micm_t
-      type(mapping_t), pointer   :: species_ordering(:), user_defined_reaction_rates(:)
+      type(mapping_t), pointer :: species_ordering(:) => null()
+      type(mapping_t), pointer :: user_defined_reaction_rates(:) => null()
       integer(kind=c_size_t) :: species_ordering_length, user_defined_reaction_rates_length
-      type(c_ptr), private   :: ptr
+      type(c_ptr), private   :: ptr = c_null_ptr
    contains
       ! Solve the chemical system
       procedure :: solve
@@ -104,12 +122,12 @@ end function get_user_defined_reaction_rates_ordering
 
 contains
 
-   function constructor(config_path, errcode)  result( this )
-      type(micm_t), pointer         :: this
-      character(len=*), intent(in)  :: config_path
-      integer, intent(out)          :: errcode
-      character(len=1, kind=c_char) :: c_config_path(len_trim(config_path)+1)
-      integer                       :: n, i
+   function constructor(config_path, error)  result( this )
+      type(micm_t), pointer          :: this
+      character(len=*), intent(in)   :: config_path
+      type(error_t_c), intent(inout) :: error
+      character(len=1, kind=c_char)  :: c_config_path(len_trim(config_path)+1)
+      integer                        :: n, i
       type(c_ptr) :: mappings_ptr
 
       allocate( this )
@@ -120,73 +138,90 @@ function constructor(config_path, errcode)  result( this )
       end do
       c_config_path(n+1) = c_null_char
 
-      this%ptr = create_micm_c(c_config_path, errcode)
-
-      if (errcode /= 0) then
+      this%ptr = create_micm_c(c_config_path, error)
+      if (.not. is_success(error)) then
+         deallocate(this)
+         nullify(this)
          return
       end if
 
-      mappings_ptr = get_species_ordering(this%ptr, this%species_ordering_length)
+      mappings_ptr = get_species_ordering(this%ptr, this%species_ordering_length, error)
       call c_f_pointer(mappings_ptr, this%species_ordering, [this%species_ordering_length])
+      if (.not. is_success(error)) then
+         deallocate(this)
+         nullify(this)
+         return
+      end if
 
-
-      mappings_ptr = get_user_defined_reaction_rates_ordering(this%ptr, this%user_defined_reaction_rates_length)
+      mappings_ptr = get_user_defined_reaction_rates_ordering(this%ptr, this%user_defined_reaction_rates_length, error)
       call c_f_pointer(mappings_ptr, this%user_defined_reaction_rates, [this%user_defined_reaction_rates_length])
+      if (.not. is_success(error)) then
+         deallocate(this)
+         nullify(this)
+         return
+      end if
    end function constructor
 
    subroutine solve(this, time_step, temperature, pressure, num_concentrations, concentrations, &
-                     num_user_defined_reaction_rates, user_defined_reaction_rates)
-      class(micm_t)                 :: this
-      real(c_double), intent(in)    :: time_step
-      real(c_double), intent(in)    :: temperature
-      real(c_double), intent(in)    :: pressure
-      integer(c_int), intent(in)    :: num_concentrations
-      real(c_double), intent(inout) :: concentrations(*)
-      integer(c_int), intent(in)    :: num_user_defined_reaction_rates
-      real(c_double), intent(inout) :: user_defined_reaction_rates(*)
+                     num_user_defined_reaction_rates, user_defined_reaction_rates, error)
+      class(micm_t)                  :: this
+      real(c_double),  intent(in)    :: time_step
+      real(c_double),  intent(in)    :: temperature
+      real(c_double),  intent(in)    :: pressure
+      integer(c_int),  intent(in)    :: num_concentrations
+      real(c_double),  intent(inout) :: concentrations(*)
+      integer(c_int),  intent(in)    :: num_user_defined_reaction_rates
+      real(c_double),  intent(inout) :: user_defined_reaction_rates(*)
+      type(error_t_c), intent(inout) :: error
       call micm_solve_c(this%ptr, time_step, temperature, pressure, num_concentrations, concentrations, &
-                        num_user_defined_reaction_rates, user_defined_reaction_rates)
+                        num_user_defined_reaction_rates, user_defined_reaction_rates, error)
    end subroutine solve
 
-   function get_species_property_string(this, species_name, property_name) result(value)
+   function get_species_property_string(this, species_name, property_name, error) result(value)
       use musica_util,                 only: to_f_string, to_c_string
-      class(micm_t)                 :: this
-      character(len=*), intent(in)  :: species_name, property_name
-      character(len=:), allocatable :: value
+      class(micm_t)                  :: this
+      character(len=*), intent(in)   :: species_name, property_name
+      type(error_t_c), intent(inout) :: error
+      character(len=:), allocatable  :: value
       value = to_f_string(get_species_property_string_c(this%ptr,  &
-                to_c_string(species_name), to_c_string(property_name)))
+                to_c_string(species_name), to_c_string(property_name), error))
    end function get_species_property_string
 
-   function get_species_property_double(this, species_name, property_name) result(value)
+   function get_species_property_double(this, species_name, property_name, error) result(value)
       use musica_util,                 only: to_c_string
-      class(micm_t)                 :: this
-      character(len=*), intent(in)  :: species_name, property_name
-      real(c_double)                :: value
+      class(micm_t)                  :: this
+      character(len=*), intent(in)   :: species_name, property_name
+      type(error_t_c), intent(inout) :: error
+      real(c_double)                 :: value
       value = get_species_property_double_c(this%ptr, &
-                to_c_string(species_name), to_c_string(property_name))
+                to_c_string(species_name), to_c_string(property_name), error)
    end function get_species_property_double
 
-   function get_species_property_int(this, species_name, property_name) result(value)
+   function get_species_property_int(this, species_name, property_name, error) result(value)
       use musica_util,                 only: to_c_string
-      class(micm_t)                 :: this
-      character(len=*), intent(in)  :: species_name, property_name
-      integer(c_int)                :: value
+      class(micm_t)                  :: this
+      character(len=*), intent(in)   :: species_name, property_name
+      type(error_t_c), intent(inout) :: error
+      integer(c_int)                 :: value
       value = get_species_property_int_c(this%ptr, &
-                to_c_string(species_name), to_c_string(property_name))
+                to_c_string(species_name), to_c_string(property_name), error)
    end function get_species_property_int
 
-   function get_species_property_bool(this, species_name, property_name) result(value)
+   function get_species_property_bool(this, species_name, property_name, error) result(value)
       use musica_util,                 only: to_c_string
-      class(micm_t)                 :: this
-      character(len=*), intent(in)  :: species_name, property_name
-      logical                      :: value
+      class(micm_t)                  :: this
+      character(len=*), intent(in)   :: species_name, property_name
+      type(error_t_c), intent(inout) :: error
+      logical                        :: value
       value = get_species_property_bool_c(this%ptr, &
-                to_c_string(species_name), to_c_string(property_name))
+                to_c_string(species_name), to_c_string(property_name), error)
    end function get_species_property_bool
 
    subroutine finalize(this)
       type(micm_t), intent(inout) :: this
-      call delete_micm_c(this%ptr)
+      type(error_t_c)             :: error
+      call delete_micm_c(this%ptr, error)
+      this%ptr = c_null_ptr
    end subroutine finalize
 
 end module micm_core