python_fabm.F90 27.9 KB
Newer Older
Jorn Bruggeman's avatar
Jorn Bruggeman committed
1
#include "fabm_driver.h"
2 3 4

module fabm_python

5
   use iso_c_binding, only: c_double, c_int, c_char, C_NULL_CHAR, c_f_pointer, c_loc, c_ptr, c_null_ptr
6 7 8

   !DIR$ ATTRIBUTES DLLEXPORT :: STATE_VARIABLE,DIAGNOSTIC_VARIABLE,CONSERVED_QUANTITY

9
   use fabm, only: type_fabm_model, type_external_variable, fabm_get_version
Jorn Bruggeman's avatar
Jorn Bruggeman committed
10
   use fabm_config
11
   use fabm_types, only:rk => rke,attribute_length,type_model_list_node,type_base_model, &
Jorn Bruggeman's avatar
Jorn Bruggeman committed
12
                        factory,type_link,type_link_list,type_internal_variable
13
   use fabm_driver, only: type_base_driver, driver, fatal_error
14
   use fabm_properties
Jorn Bruggeman's avatar
Jorn Bruggeman committed
15
   use fabm_python_helper
16
   use fabm_c_helper
Jorn Bruggeman's avatar
Jorn Bruggeman committed
17 18

   implicit none
19

Jorn Bruggeman's avatar
Jorn Bruggeman committed
20 21
   public

22 23 24 25 26 27
   integer, parameter :: INTERIOR_STATE_VARIABLE        = 1
   integer, parameter :: SURFACE_STATE_VARIABLE         = 2
   integer, parameter :: BOTTOM_STATE_VARIABLE          = 3
   integer, parameter :: INTERIOR_DIAGNOSTIC_VARIABLE   = 4
   integer, parameter :: HORIZONTAL_DIAGNOSTIC_VARIABLE = 5
   integer, parameter :: CONSERVED_QUANTITY             = 6
28

29
   class (type_fabm_model), private, pointer, save :: model => null()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
30
   character(len=1024),dimension(:),allocatable :: environment_names,environment_units
31 32
   integer :: index_column_depth
   real(c_double),pointer :: column_depth
33
   type (type_link_list),save :: coupling_link_list
34
   logical, save :: error_occurred = .false.
35
   character(len=:), allocatable, save :: error_message
Jorn Bruggeman's avatar
Jorn Bruggeman committed
36

37
   type (type_property_dictionary),save,private :: forced_parameters,forced_couplings
38 39 40

   type,extends(type_base_driver) :: type_python_driver
   contains
41 42
      procedure :: fatal_error => python_driver_fatal_error
      procedure :: log_message => python_driver_log_message
43
   end type
Jorn Bruggeman's avatar
Jorn Bruggeman committed
44

45
contains
Jorn Bruggeman's avatar
Jorn Bruggeman committed
46

47
   subroutine get_version(length, version_string) bind(c)
48
!DIR$ ATTRIBUTES DLLEXPORT :: get_version
49 50
      integer(c_int), value, intent(in) :: length
      character(kind=c_char)            :: version_string(length)
51

52
      character(len=length-1) :: string
53

54 55
      call fabm_get_version(string)
      call copy_to_c_string(string, version_string)
56 57
   end subroutine get_version

58
   subroutine initialize(path) bind(c)
59
!DIR$ ATTRIBUTES DLLEXPORT :: initialize
60
      character(kind=c_char),target,intent(in) :: path(*)
61

62
      character(len=attribute_length),pointer :: ppath
63
      class (type_property),          pointer :: property
64

Jorn Bruggeman's avatar
Jorn Bruggeman committed
65
      ! Initialize driver object used by FABM for logging/error reporting.
66
      if (.not. associated(driver)) allocate(type_python_driver::driver)
67

Jorn Bruggeman's avatar
Jorn Bruggeman committed
68
      ! If the model object already exists, delete it to start from scratch.
69
      if (associated(model)) call finalize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
70

Jorn Bruggeman's avatar
Jorn Bruggeman committed
71 72
      ! Remove any existing user-specified parameter values and couplings.
      ! (If the user wanted to preserve those, he would have called reinitialize)
73 74 75
      call forced_parameters%finalize()
      call forced_couplings%finalize()

Jorn Bruggeman's avatar
Jorn Bruggeman committed
76
      ! Build FABM model tree (configuration will be read from file specified as argument).
77
      allocate(model)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
78
      call c_f_pointer(c_loc(path), ppath)
79
      model => fabm_create_model(path=ppath(:index(ppath, C_NULL_CHAR) - 1), parameters=forced_parameters)
80

81
      ! Get a list of all parameters that had an explicit value specified.
82 83
      property => model%root%parameters%first
      do while (associated(property))
84
         if (.not.model%root%parameters%missing%contains(property%name)) &
85 86 87
            call forced_parameters%set_property(property)
         property => property%next
      end do
Jorn Bruggeman's avatar
Jorn Bruggeman committed
88

89 90 91 92 93 94 95 96
      ! Get a list of all active couplings.
      property => model%root%couplings%first
      do while (associated(property))
         if (.not.model%root%couplings%missing%contains(property%name)) &
            call forced_couplings%set_property(property)
         property => property%next
      end do

Jorn Bruggeman's avatar
Jorn Bruggeman committed
97
      ! Send information on spatial domain to FABM (this also allocates memory for diagnostics)
98
      call model%set_domain(1._rk)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
99

100
      ! Retrieve arrays to hold values for environmental variables and corresponding metadata.
101
      call get_environment_metadata(model, environment_names, environment_units, index_column_depth)
102
      column_depth => null()
103

104
      call get_couplings(model, coupling_link_list)
105 106
   end subroutine initialize

107
   subroutine reinitialize()
108
      type (type_fabm_model),      pointer :: newmodel
109 110 111 112
      type (type_model_list_node), pointer :: node
      class (type_base_model),     pointer :: childmodel
      class (type_property),       pointer :: property,next

Jorn Bruggeman's avatar
Jorn Bruggeman committed
113
      ! Create new model object.
114 115 116 117
      allocate(newmodel)

      ! Transfer forced parameters to root of the model.
      call newmodel%root%parameters%update(forced_parameters)
118
      call newmodel%root%couplings%update(forced_couplings)
119 120 121 122

      ! Re-create original models
      node => model%root%children%first
      do while (associated(node))
123
         if (node%model%user_created) then
124
            call factory%create(node%model%type_name, childmodel)
125
            childmodel%user_created = .true.
126
            call newmodel%root%add_child(childmodel, node%model%name, node%model%long_name, configunit=-1)
127 128 129 130 131 132 133 134 135
         end if
         node => node%next
      end do

      ! Clean up old model
      call finalize()
      model => newmodel

      ! Initialize new model
136
      call model%initialize()
137 138 139 140

      ! Removed unused forced parameters from root model.
      property => model%root%parameters%first
      do while (associated(property))
141
         if (.not. model%root%parameters%retrieved%contains(property%name)) then
142 143 144 145 146 147 148 149 150
            next => property%next
            call model%root%parameters%delete(property%name)
            property => next
         else
            property => property%next
         end if
      end do

      ! Send information on spatial domain to FABM (this also allocates memory for diagnostics)
151
      call model%set_domain(1._rk)
152 153

      ! Retrieve arrays to hold values for environmental variables and corresponding metadata.
154
      call get_environment_metadata(model, environment_names, environment_units, index_column_depth)
155
      column_depth => null()
156

157
      call get_couplings(model, coupling_link_list)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
158
   end subroutine reinitialize
159

160
   subroutine check_ready() bind(c)
161
      !DIR$ ATTRIBUTES DLLEXPORT :: check_ready
162
      call model%start()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
163
   end subroutine check_ready
164

165 166 167 168 169
   integer(c_int) function get_error_state() bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: get_error_state
      get_error_state = logical2int(error_occurred)
   end function get_error_state

170 171 172 173 174 175 176
   subroutine get_error(length, message) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: get_error
      integer(c_int),        intent(in), value             :: length
      character(kind=c_char),intent(out),dimension(length) :: message
      call copy_to_c_string(error_message, message)
   end subroutine get_error

177
   integer(c_int) function model_count() bind(c)
178 179 180 181 182 183 184 185 186
      !DIR$ ATTRIBUTES DLLEXPORT :: model_count

      type (type_model_list_node), pointer :: node

      model_count = 0
      node => model%root%children%first
      do while (associated(node))
         model_count = model_count + 1
         node => node%next
Jorn Bruggeman's avatar
Jorn Bruggeman committed
187
      end do
Jorn Bruggeman's avatar
Jorn Bruggeman committed
188
   end function model_count
189

190 191
   subroutine get_counts(nstate_interior, nstate_surface, nstate_bottom, ndiagnostic_interior, ndiagnostic_horizontal,nconserved, &
      ndependencies, nparameters, ncouplings) bind(c)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
192
      !DIR$ ATTRIBUTES DLLEXPORT :: get_counts
193 194 195 196
      integer(c_int),intent(out) :: nstate_interior, nstate_surface, nstate_bottom
      integer(c_int),intent(out) :: ndiagnostic_interior, ndiagnostic_horizontal
      integer(c_int),intent(out) :: nconserved, ndependencies, nparameters, ncouplings

197
      nstate_interior = size(model%state_variables)
198 199
      nstate_surface = size(model%surface_state_variables)
      nstate_bottom = size(model%bottom_state_variables)
200
      ndiagnostic_interior = size(model%diagnostic_variables)
201 202 203 204
      ndiagnostic_horizontal = size(model%horizontal_diagnostic_variables)
      nconserved = size(model%conserved_quantities)
      ndependencies = size(environment_names)
      nparameters = model%root%parameters%size()
205
      ncouplings = coupling_link_list%count()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
206
   end subroutine get_counts
207

208
   subroutine get_variable_metadata(category, index, length, name, units, long_name, path) bind(c)
209
      !DIR$ ATTRIBUTES DLLEXPORT :: get_variable_metadata
210 211
      integer(c_int),         intent(in), value              :: category, index, length
      character(kind=c_char), intent(out), dimension(length) :: name, units, long_name, path
212 213 214 215 216

      class (type_external_variable),pointer :: variable

      ! Get a pointer to the target variable
      select case (category)
217
      case (INTERIOR_STATE_VARIABLE)
218 219 220 221 222
         variable => model%state_variables(index)
      case (SURFACE_STATE_VARIABLE)
         variable => model%surface_state_variables(index)
      case (BOTTOM_STATE_VARIABLE)
         variable => model%bottom_state_variables(index)
223
      case (INTERIOR_DIAGNOSTIC_VARIABLE)
224 225 226 227 228 229
         variable => model%diagnostic_variables(index)
      case (HORIZONTAL_DIAGNOSTIC_VARIABLE)
         variable => model%horizontal_diagnostic_variables(index)
      case (CONSERVED_QUANTITY)
         variable => model%conserved_quantities(index)
      end select
230 231 232 233
      call copy_to_c_string(variable%name,            name)
      call copy_to_c_string(variable%units,           units)
      call copy_to_c_string(variable%local_long_name, long_name)
      call copy_to_c_string(variable%path,            path)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
234
   end subroutine get_variable_metadata
Jorn Bruggeman's avatar
Jorn Bruggeman committed
235

236
   function get_variable(category, index) bind(c) result(pvariable)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
237
      !DIR$ ATTRIBUTES DLLEXPORT :: get_variable
238 239
      integer(c_int), intent(in), value :: category, index
      type (c_ptr)                      :: pvariable
240 241 242 243 244

      type (type_internal_variable),pointer :: variable

      ! Get a pointer to the target variable
      select case (category)
245
      case (INTERIOR_STATE_VARIABLE)
246 247 248 249 250
         variable => model%state_variables(index)%target
      case (SURFACE_STATE_VARIABLE)
         variable => model%surface_state_variables(index)%target
      case (BOTTOM_STATE_VARIABLE)
         variable => model%bottom_state_variables(index)%target
251
      case (INTERIOR_DIAGNOSTIC_VARIABLE)
252 253 254 255 256 257 258
         variable => model%diagnostic_variables(index)%target
      case (HORIZONTAL_DIAGNOSTIC_VARIABLE)
         variable => model%horizontal_diagnostic_variables(index)%target
      case (CONSERVED_QUANTITY)
         variable => model%conserved_quantities(index)%target
      end select
      pvariable = c_loc(variable)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
259
   end function get_variable
260

261
   subroutine get_parameter_metadata(index, length, name, units, long_name, typecode, has_default) bind(c)
262
      !DIR$ ATTRIBUTES DLLEXPORT :: get_parameter_metadata
263 264 265
      integer(c_int),         intent(in), value              :: index, length
      character(kind=c_char), intent(out), dimension(length) :: name, units, long_name
      integer(c_int),         intent(out)                    :: typecode, has_default
266 267 268 269 270 271 272 273 274 275

      integer                       :: i
      class (type_property),pointer :: property

      i = 1
      property => model%root%parameters%first
      do while (associated(property))
         if (index==i) exit
         property => property%next
         i = i + 1
Jorn Bruggeman's avatar
Jorn Bruggeman committed
276 277
      end do

278 279 280
      call copy_to_c_string(property%name, name)
      call copy_to_c_string(property%units, units)
      call copy_to_c_string(property%long_name, long_name)
281
      typecode = property%typecode()
282
      has_default = logical2int(property%has_default)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
283
   end subroutine get_parameter_metadata
Jorn Bruggeman's avatar
Jorn Bruggeman committed
284

285
   subroutine get_dependency_metadata(index, length, name, units) bind(c)
286
      !DIR$ ATTRIBUTES DLLEXPORT :: get_dependency_metadata
287 288
      integer(c_int),         intent(in), value              :: index, length
      character(kind=c_char), intent(out), dimension(length) :: name, units
Jorn Bruggeman's avatar
Jorn Bruggeman committed
289

290 291
      call copy_to_c_string(environment_names(index), name)
      call copy_to_c_string(environment_units(index), units)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
292
   end subroutine get_dependency_metadata
293

294
   subroutine get_coupling(index, slave, master) bind(c)
295
      !DIR$ ATTRIBUTES DLLEXPORT :: get_coupling
296 297
      integer(c_int), intent(in), value :: index
      type (c_ptr),   intent(out)       :: slave, master
298 299 300

      type (type_link),pointer :: link_slave
      integer                  :: i
Knut's avatar
Knut committed
301

302 303 304 305 306 307
      link_slave => coupling_link_list%first
      do i=2,index
         link_slave => link_slave%next
      end do
      slave = c_loc(link_slave%original)
      master = c_loc(link_slave%target)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
308
   end subroutine get_coupling
309

Jorn Bruggeman's avatar
Jorn Bruggeman committed
310 311
   function variable_get_suitable_masters(pvariable) result(plist) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: variable_get_suitable_masters
312 313
      type (c_ptr), intent(in), value :: pvariable
      type (c_ptr)                    :: plist
314

315
      type (type_internal_variable),pointer :: variable
316
      type (type_link_list),        pointer :: list
317 318

      call c_f_pointer(pvariable, variable)
319
      list => get_suitable_masters(model, variable)
320
      plist = c_loc(list)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
321
   end function variable_get_suitable_masters
322

323
   subroutine get_model_metadata(name, length, long_name, user_created) bind(c)
324
      !DIR$ ATTRIBUTES DLLEXPORT :: get_model_metadata
325 326 327 328
      character(kind=c_char), intent(in), target :: name(*)
      integer(c_int),         intent(in), value  :: length
      character(kind=c_char), intent(out)        :: long_name(length)
      integer(c_int),         intent(out)        :: user_created
329

330 331
      character(len=attribute_length),pointer   :: pname
      class (type_base_model),        pointer   :: found_model
332 333

      call c_f_pointer(c_loc(name), pname)
334
      found_model => model%root%find_model(pname(:index(pname, C_NULL_CHAR) - 1))
335
      if (.not.associated(found_model)) call fatal_error('get_model_metadata', &
336 337
         'model "'//pname(:index(pname, C_NULL_CHAR) - 1) // '" not found.')
      call copy_to_c_string(found_model%long_name, long_name)
338
      user_created = logical2int(found_model%user_created)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
339
   end subroutine get_model_metadata
340

341
   subroutine link_dependency_data(index, value) bind(c)
342
      !DIR$ ATTRIBUTES DLLEXPORT :: link_dependency_data
343 344
      integer(c_int), intent(in), value  :: index
      real(c_double), intent(in), target :: value
345

346 347 348 349
      call model%link_interior_data(environment_names(index), value)
      call model%link_horizontal_data(environment_names(index), value)
      call model%link_scalar(environment_names(index), value)
      if (index == index_column_depth) column_depth => value
Jorn Bruggeman's avatar
Jorn Bruggeman committed
350
   end subroutine link_dependency_data
351

352
   subroutine link_interior_state_data(index, value) bind(c)
353
      !DIR$ ATTRIBUTES DLLEXPORT :: link_interior_state_data
354 355
      integer(c_int), intent(in), value     :: index
      real(c_double), intent(inout), target :: value
Jorn Bruggeman's avatar
Jorn Bruggeman committed
356

357
      value = model%state_variables(index)%initial_value
358
      call model%link_interior_state_data(index, value)
359
   end subroutine link_interior_state_data
Jorn Bruggeman's avatar
Jorn Bruggeman committed
360

361
   subroutine link_surface_state_data(index, value) bind(c)
362
      !DIR$ ATTRIBUTES DLLEXPORT :: link_surface_state_data
363 364
      integer(c_int), intent(in), value     :: index
      real(c_double), intent(inout), target :: value
Jorn Bruggeman's avatar
Jorn Bruggeman committed
365

366
      value = model%surface_state_variables(index)%initial_value
367
      call model%link_surface_state_data(index, value)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
368
   end subroutine link_surface_state_data
Knut's avatar
Knut committed
369

370
   subroutine link_bottom_state_data(index, value) bind(c)
371
      !DIR$ ATTRIBUTES DLLEXPORT :: link_bottom_state_data
372 373
      integer(c_int), intent(in), value     :: index
      real(c_double), intent(inout), target :: value
374 375

      value = model%bottom_state_variables(index)%initial_value
376
      call model%link_bottom_state_data(index, value)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
377
   end subroutine link_bottom_state_data
378

379
   subroutine get_rates(t, dy, do_surface, do_bottom) bind(c)
380
      !DIR$ ATTRIBUTES DLLEXPORT :: get_rates
381 382 383
      real(rk), value,        intent(in) :: t
      real(c_double), target, intent(in) :: dy(*)
      integer(c_int), value,  intent(in) :: do_surface, do_bottom
384

385
      real(c_double), pointer :: dy_(:)
386

387 388
      call c_f_pointer(c_loc(dy), dy_, &
        (/size(model%state_variables) + size(model%surface_state_variables) + size(model%bottom_state_variables)/))
389

390 391 392 393 394 395 396 397 398 399
      if (t < 0) then
         call model%prepare_inputs()
      else
         call model%prepare_inputs(t)
      end if
      dy_ = 0.0_rk
      if (int2logical(do_surface)) call model%get_surface_sources(dy_(1:size(model%state_variables)), &
         dy_(size(model%state_variables)+1:size(model%state_variables) + size(model%surface_state_variables)))
      if (int2logical(do_bottom)) call model%get_bottom_sources(dy_(1:size(model%state_variables)), &
         dy_(size(model%state_variables) + size(model%surface_state_variables) + 1:))
400
      if (int2logical(do_surface) .or. int2logical(do_bottom)) then
401
         if (.not.associated(column_depth)) call fatal_error('get_rates', &
402
            'Value for environmental dependency ' // trim(environment_names(index_column_depth)) // &
403
            ' must be provided if get_rates is called with the do_surface and/or do_bottom flags.')
404
         dy_(1:size(model%state_variables)) = dy_(1:size(model%state_variables)) / column_depth
405
      end if
406
      call model%get_interior_sources(dy_(1:size(model%state_variables)))
407
      call model%finalize_outputs()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
408 409

      ! Compute rate of change in conserved quantities
410
      !call fabm_state_to_conserved_quantities(model,pelagic_rates,conserved_rates)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
411 412

      ! Normalize rate of change in conserved quantities to sum of absolute rates of change.
413 414
      !call fabm_state_to_conserved_quantities(model,abs(pelagic_rates),abs_conserved_rates)
      !where (abs_conserved_rates>0.0_rk) conserved_rates = conserved_rates/abs_conserved_rates
Jorn Bruggeman's avatar
Jorn Bruggeman committed
415
   end subroutine get_rates
416

417 418 419 420 421 422 423 424
   function check_state(repair_) bind(c) result(valid_)
      !DIR$ ATTRIBUTES DLLEXPORT :: check_state
      integer(c_int),value, intent(in) :: repair_
      integer(c_int)                   :: valid_

      logical :: repair, interior_valid, surface_valid, bottom_valid

      repair = int2logical(repair_)
425 426 427
      call model%check_interior_state(repair, interior_valid)
      call model%check_surface_state(repair, surface_valid)
      call model%check_bottom_state(repair, bottom_valid)
428 429 430 431 432 433 434 435 436 437 438 439 440 441
      valid_ = logical2int(interior_valid .and. surface_valid .and. bottom_valid)
   end function check_state

   subroutine integrate(nt, ny, t_, y_ini_, y_, dt, do_surface, do_bottom) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: integrate
      integer(c_int),value, intent(in) :: nt, ny
      real(c_double),target,intent(in) :: t_(*), y_ini_(*), y_(*)
      real(c_double),value, intent(in) :: dt
      integer(c_int),value, intent(in) :: do_surface, do_bottom

      real(c_double),pointer :: t(:), y_ini(:), y(:,:)
      integer                :: it
      real(rk)               :: t_cur
      real(rk), target       :: y_cur(ny)
442
      real(rk)               :: dy(ny)
443 444
      logical                :: surface, bottom

445
      if (ny /= size(model%state_variables) + size(model%surface_state_variables) + size(model%bottom_state_variables)) &
446
          call fatal_error('integrate', 'ny is wrong length')
447 448 449 450 451 452 453 454

      call c_f_pointer(c_loc(t_), t, (/nt/))
      call c_f_pointer(c_loc(y_ini_), y_ini, (/ny/))
      call c_f_pointer(c_loc(y_), y, (/ny, nt/))

      surface = int2logical(do_surface)
      bottom = int2logical(do_bottom)
      if (surface .or. bottom) then
455 456
          if (.not. associated(column_depth)) call fatal_error('get_rates', &
            'Value for environmental dependency ' // trim(environment_names(index_column_depth)) // &
457 458 459
            ' must be provided if integrate is called with the do_surface and/or do_bottom flags.')
      end if
      call model%link_all_interior_state_data(y_cur(1:size(model%state_variables)))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
460 461 462
      call model%link_all_surface_state_data(y_cur(size(model%state_variables) + 1: &
         size(model%state_variables) + size(model%surface_state_variables)))
      call model%link_all_bottom_state_data(y_cur(size(model%state_variables) + size(model%surface_state_variables) + 1:))
463 464 465 466 467 468 469 470 471 472

      it = 1
      t_cur = t(1)
      y_cur = y_ini
      do while (it <= nt)
          if (t_cur >= t(it)) then
              y(:, it) = y_cur
              it = it + 1
          end if

473 474 475 476 477 478 479 480 481
          call model%prepare_inputs(t_cur)
          dy = 0.0_rk
          if (surface) call model%get_surface_sources(dy(1:size(model%state_variables)), &
             dy(size(model%state_variables) + 1:size(model%state_variables) + size(model%surface_state_variables)))
          if (bottom) call model%get_bottom_sources(dy(1:size(model%state_variables)), &
             dy(size(model%state_variables) + size(model%surface_state_variables) + 1:))
          if (surface .or. bottom) dy(1:size(model%state_variables)) = dy(1:size(model%state_variables)) / column_depth
          call model%get_interior_sources(dy(1:size(model%state_variables)))
          y_cur = y_cur + dt * dy * 86400
482 483 484 485
          t_cur = t_cur + dt
      end do
   end subroutine integrate

486
   subroutine get_interior_diagnostic_data(index, ptr) bind(c)
487
      !DIR$ ATTRIBUTES DLLEXPORT :: get_interior_diagnostic_data
488 489
      integer(c_int), intent(in), value :: index
      type(c_ptr),    intent(out)       :: ptr
490 491 492 493 494
      real(rk), pointer :: pvalue

      ptr = c_null_ptr
      pvalue => model%get_interior_diagnostic_data(index)
      if (associated(pvalue)) ptr = c_loc(pvalue)
495
   end subroutine get_interior_diagnostic_data
496

497
   subroutine get_horizontal_diagnostic_data(index, ptr) bind(c)
498
      !DIR$ ATTRIBUTES DLLEXPORT :: get_horizontal_diagnostic_data
499 500
      integer(c_int), intent(in), value :: index
      type(c_ptr),    intent(out)       :: ptr
501 502 503 504 505
      real(rk), pointer :: pvalue

      ptr = c_null_ptr
      pvalue => model%get_horizontal_diagnostic_data(index)
      if (associated(pvalue)) ptr = c_loc(pvalue)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
506
   end subroutine get_horizontal_diagnostic_data
Jorn Bruggeman's avatar
Jorn Bruggeman committed
507

508
   subroutine finalize()
509
      call model%finalize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
510 511
      if (allocated(environment_names)) deallocate(environment_names)
      if (allocated(environment_units)) deallocate(environment_units)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
512
   end subroutine finalize
Jorn Bruggeman's avatar
Jorn Bruggeman committed
513

514
   subroutine reset_parameter(index) bind(c)
515
      !DIR$ ATTRIBUTES DLLEXPORT :: reset_parameter
516 517
      integer(c_int), value, intent(in) :: index
      class (type_property), pointer    :: property
518

519
      property => model%root%parameters%get_property(index)
520
      if (.not. associated(property)) return
521
      call forced_parameters%delete(property%name)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
522 523

      ! Re-initialize the model using updated parameter values
524
      call reinitialize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
525
   end subroutine reset_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
526

527
   subroutine set_real_parameter(name, value) bind(c)
528
      !DIR$ ATTRIBUTES DLLEXPORT :: set_real_parameter
529 530
      character(kind=c_char), target, intent(in) :: name(*)
      real(c_double),value,           intent(in) :: value
531 532 533 534

      character(len=attribute_length),pointer :: pname

      call c_f_pointer(c_loc(name), pname)
535
      call forced_parameters%set_real(pname(:index(pname, C_NULL_CHAR) - 1), value)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
536 537

      ! Re-initialize the model using updated parameter values
538
      call reinitialize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
539
   end subroutine set_real_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
540

541
   function get_real_parameter(index, default) bind(c) result(value)
542
      !DIR$ ATTRIBUTES DLLEXPORT :: get_real_parameter
543 544 545
      integer(c_int), value, intent(in) :: index, default
      real(c_double)                    :: value
      class (type_property), pointer    :: property
546 547 548 549

      property => model%root%parameters%get_property(index)
      select type (property)
      class is (type_real_property)
550
         if (int2logical(default)) then
551 552 553 554 555
            value = property%default
         else
            value = property%value
         end if
      class default
556
         call fatal_error('get_real_parameter', 'not a real variable')
557
      end select
Jorn Bruggeman's avatar
Jorn Bruggeman committed
558
   end function get_real_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
559

560
   subroutine set_integer_parameter(name, value) bind(c)
561
      !DIR$ ATTRIBUTES DLLEXPORT :: set_integer_parameter
562 563
      character(kind=c_char), target, intent(in) :: name(*)
      integer(c_int),value,           intent(in) :: value
564

565
      character(len=attribute_length), pointer :: pname
566 567

      call c_f_pointer(c_loc(name), pname)
568
      call forced_parameters%set_integer(pname(:index(pname, C_NULL_CHAR) - 1), value)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
569 570

      ! Re-initialize the model using updated parameter values
571
      call reinitialize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
572
   end subroutine set_integer_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
573

574
   function get_integer_parameter(index, default) bind(c) result(value)
575
      !DIR$ ATTRIBUTES DLLEXPORT :: get_integer_parameter
576 577 578
      integer(c_int), value, intent(in) :: index, default
      integer(c_int)                    :: value
      class (type_property), pointer    :: property
579 580 581 582

      property => model%root%parameters%get_property(index)
      select type (property)
      class is (type_integer_property)
583
         if (int2logical(default)) then
584 585 586 587 588
            value = property%default
         else
            value = property%value
         end if
      class default
589
         call fatal_error('get_integer_parameter', 'not an integer variable')
590
      end select
Jorn Bruggeman's avatar
Jorn Bruggeman committed
591
   end function get_integer_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
592

593
   subroutine set_logical_parameter(name, value) bind(c)
594
      !DIR$ ATTRIBUTES DLLEXPORT :: set_logical_parameter
595 596
      character(kind=c_char), target, intent(in) :: name(*)
      integer(c_int), value,          intent(in) :: value
597

598
      character(len=attribute_length), pointer :: pname
599 600

      call c_f_pointer(c_loc(name), pname)
601
      call forced_parameters%set_logical(pname(:index(pname, C_NULL_CHAR) - 1), int2logical(value))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
602 603

      ! Re-initialize the model using updated parameter values
604
      call reinitialize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
605
   end subroutine set_logical_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
606

607
   function get_logical_parameter(index, default) bind(c) result(value)
608
      !DIR$ ATTRIBUTES DLLEXPORT :: get_logical_parameter
609 610 611
      integer(c_int), value, intent(in) :: index, default
      integer(c_int)                    :: value
      class (type_property), pointer    :: property
612 613 614 615

      property => model%root%parameters%get_property(index)
      select type (property)
      class is (type_logical_property)
616 617
         if (int2logical(default)) then
            value = logical2int(property%default)
618
         else
619
            value = logical2int(property%value)
620 621
         end if
      class default
622
         call fatal_error('get_logical_parameter', 'not a logical variable')
623
      end select
Jorn Bruggeman's avatar
Jorn Bruggeman committed
624
   end function get_logical_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
625

626
   subroutine set_string_parameter(name, value) bind(c)
627
      !DIR$ ATTRIBUTES DLLEXPORT :: set_string_parameter
628
      character(kind=c_char),target,intent(in) :: name(*), value(*)
629

630
      character(len=attribute_length),pointer :: pname, pvalue
Knut's avatar
Knut committed
631

632
      call c_f_pointer(c_loc(name), pname)
633
      call c_f_pointer(c_loc(value), pvalue)
634
      call forced_parameters%set_string(pname(:index(pname, C_NULL_CHAR) - 1), pvalue(:index(pname, C_NULL_CHAR) - 1))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
635 636

      ! Re-initialize the model using updated parameter values
637
      call reinitialize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
638
   end subroutine set_string_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
639

640
   subroutine get_string_parameter(index, default, length, value) bind(c)
641
      !DIR$ ATTRIBUTES DLLEXPORT :: get_string_parameter
642 643
      integer(c_int),value, intent(in) :: index, default, length
      character(kind=c_char)           :: value(length)
644

645
      class (type_property), pointer :: property
646 647 648 649

      property => model%root%parameters%get_property(index)
      select type (property)
      class is (type_string_property)
650
         if (int2logical(default)) then
651
            call copy_to_c_string(property%default, value)
652
         else
653
            call copy_to_c_string(property%value, value)
654 655
         end if
      class default
656
         call fatal_error('get_string_parameter', 'not a string variable')
657
      end select
Jorn Bruggeman's avatar
Jorn Bruggeman committed
658
   end subroutine get_string_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
659

660 661 662
   subroutine python_driver_fatal_error(self, location, message)
      class (type_python_driver), intent(inout) :: self
      character(len=*),           intent(in)    :: location, message
663

664
      if (error_occurred) return
665
      error_occurred = .true.
666
      error_message = trim(location) // ': ' // trim(message)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
667
   end subroutine python_driver_fatal_error
668

669 670 671
   subroutine python_driver_log_message(self, message)
      class (type_python_driver), intent(inout) :: self
      character(len=*),           intent(in)    :: message
672 673

      !write (*,*) trim(message)
Jorn Bruggeman's avatar
Jorn Bruggeman committed