python_fabm.F90 27.7 KB
Newer Older
Jorn Bruggeman's avatar
Jorn Bruggeman committed
1 2 3 4 5 6 7 8 9 10 11 12 13
#include "fabm_driver.h"
!-----------------------------------------------------------------------
!BOP
!
! !MODULE: Python interface to the Framework for Aquatic Biogeochemical Models (FABM)
!
! !INTERFACE:
   module fabm_python
!
! !DESCRIPTION:
! TODO
!
! !USES:
14
   use iso_c_binding, only: c_double, c_int, c_char, C_NULL_CHAR, c_f_pointer, c_loc, c_ptr
15 16 17

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

Jorn Bruggeman's avatar
Jorn Bruggeman committed
18 19
   use fabm
   use fabm_config
Jorn Bruggeman's avatar
Jorn Bruggeman committed
20 21
   use fabm_types, only:rk,attribute_length,type_model_list_node,type_base_model, &
                        factory,type_link,type_link_list,type_internal_variable
22
   use fabm_driver, only: type_base_driver, driver, fatal_error
23
   use fabm_properties
Jorn Bruggeman's avatar
Jorn Bruggeman committed
24
   use fabm_python_helper
25
   use fabm_c_helper
Jorn Bruggeman's avatar
Jorn Bruggeman committed
26 27 28 29 30 31

   implicit none
!
! !PUBLIC MEMBER FUNCTIONS:
   public

32
   integer,parameter :: INTERIOR_STATE_VARIABLE        = 1
33 34
   integer,parameter :: SURFACE_STATE_VARIABLE         = 2
   integer,parameter :: BOTTOM_STATE_VARIABLE          = 3
35
   integer,parameter :: INTERIOR_DIAGNOSTIC_VARIABLE   = 4
36 37 38
   integer,parameter :: HORIZONTAL_DIAGNOSTIC_VARIABLE = 5
   integer,parameter :: CONSERVED_QUANTITY             = 6

39
   class (type_model),private,pointer,save :: model => null()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
40
   character(len=1024),dimension(:),allocatable :: environment_names,environment_units
41 42
   integer :: index_column_depth
   real(c_double),pointer :: column_depth
43
   type (type_link_list),save :: coupling_link_list
44
   logical, save :: error_occurred = .false.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
45

46
   type (type_property_dictionary),save,private :: forced_parameters,forced_couplings
47 48 49

   type,extends(type_base_driver) :: type_python_driver
   contains
50 51
      procedure :: fatal_error => python_driver_fatal_error
      procedure :: log_message => python_driver_log_message
52
   end type
Jorn Bruggeman's avatar
Jorn Bruggeman committed
53 54 55 56 57
!EOP
!-----------------------------------------------------------------------

   contains

58 59 60 61 62
   subroutine get_version(length,version_string) bind(c)
!DIR$ ATTRIBUTES DLLEXPORT :: get_version
      integer(c_int),value,intent(in) :: length
      character(kind=c_char)          :: version_string(length)

63 64 65 66
      character(len=length-1) :: string

      call fabm_get_version(string)
      call copy_to_c_string(string, version_string)
67 68
   end subroutine get_version

Jorn Bruggeman's avatar
Jorn Bruggeman committed
69 70 71 72 73 74
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Initialise the model
!
! !INTERFACE:
75
   subroutine initialize(path) bind(c)
76
!DIR$ ATTRIBUTES DLLEXPORT :: initialize
77
      character(kind=c_char),target,intent(in) :: path(*)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
78 79 80 81 82 83 84 85
!
! !DESCRIPTION:
!
! !REVISION HISTORY:
!  Original author(s): Jorn Bruggeman
!
!EOP
!
86
      character(len=attribute_length),pointer :: ppath
87
      class (type_property),          pointer :: property
Jorn Bruggeman's avatar
Jorn Bruggeman committed
88 89
!-----------------------------------------------------------------------
!BOC
Jorn Bruggeman's avatar
Jorn Bruggeman committed
90 91
      ! Initialize driver object used by FABM for logging/error reporting.
      if (.not.associated(driver)) allocate(type_python_driver::driver)
92

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

Jorn Bruggeman's avatar
Jorn Bruggeman committed
96 97
      ! Remove any existing user-specified parameter values and couplings.
      ! (If the user wanted to preserve those, he would have called reinitialize)
98 99 100
      call forced_parameters%finalize()
      call forced_couplings%finalize()

Jorn Bruggeman's avatar
Jorn Bruggeman committed
101
      ! Build FABM model tree (configuration will be read from file specified as argument).
102
      allocate(model)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
103
      call c_f_pointer(c_loc(path), ppath)
104 105
      call fabm_create_model_from_yaml_file(model,path=ppath(:index(ppath,C_NULL_CHAR)-1),parameters=forced_parameters)

106
      ! Get a list of all parameters that had an explicit value specified.
107 108
      property => model%root%parameters%first
      do while (associated(property))
109
         if (.not.model%root%parameters%missing%contains(property%name)) &
110 111 112
            call forced_parameters%set_property(property)
         property => property%next
      end do
Jorn Bruggeman's avatar
Jorn Bruggeman committed
113

114 115 116 117 118 119 120 121
      ! 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
122 123 124
      ! Send information on spatial domain to FABM (this also allocates memory for diagnostics)
      call fabm_set_domain(model)

125
      ! Retrieve arrays to hold values for environmental variables and corresponding metadata.
126 127
      call get_environment_metadata(model,environment_names,environment_units,index_column_depth)
      column_depth => null()
128

129
      call get_couplings(model,coupling_link_list)
130 131 132
   end subroutine initialize
!EOC

133 134 135 136 137 138
   subroutine reinitialize()
      type (type_model),           pointer :: newmodel
      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
139
      ! Create new model object.
140 141 142 143
      allocate(newmodel)

      ! Transfer forced parameters to root of the model.
      call newmodel%root%parameters%update(forced_parameters)
144
      call newmodel%root%couplings%update(forced_couplings)
145 146 147 148

      ! Re-create original models
      node => model%root%children%first
      do while (associated(node))
149
         if (node%model%user_created) then
150
            call factory%create(node%model%type_name,childmodel)
151
            childmodel%user_created = .true.
152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
            call newmodel%root%add_child(childmodel,node%model%name,node%model%long_name,configunit=-1)
         end if
         node => node%next
      end do

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

      ! Initialize new model
      call fabm_initialize(model)

      ! Removed unused forced parameters from root model.
      property => model%root%parameters%first
      do while (associated(property))
167
         if (.not. model%root%parameters%retrieved%contains(property%name)) then
168 169 170 171 172 173 174 175 176 177 178 179
            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)
      call fabm_set_domain(model)

      ! Retrieve arrays to hold values for environmental variables and corresponding metadata.
180 181
      call get_environment_metadata(model,environment_names,environment_units,index_column_depth)
      column_depth => null()
182 183

      call get_couplings(model,coupling_link_list)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
184
   end subroutine reinitialize
185

186
   subroutine check_ready() bind(c)
187 188
      !DIR$ ATTRIBUTES DLLEXPORT :: check_ready
      call fabm_check_ready(model)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
189
   end subroutine check_ready
190

191 192 193 194 195
   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

196
   integer(c_int) function model_count() bind(c)
197 198 199 200 201 202 203 204 205
      !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
206
      end do
Jorn Bruggeman's avatar
Jorn Bruggeman committed
207
   end function model_count
208

209
   subroutine get_counts(nstate_interior,nstate_surface,nstate_bottom,ndiagnostic_interior,ndiagnostic_horizontal,nconserved, &
210
      ndependencies,nparameters,ncouplings) bind(c)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
211
      !DIR$ ATTRIBUTES DLLEXPORT :: get_counts
212 213
      integer(c_int),intent(out) :: nstate_interior,nstate_surface,nstate_bottom
      integer(c_int),intent(out) :: ndiagnostic_interior,ndiagnostic_horizontal
214
      integer(c_int),intent(out) :: nconserved,ndependencies,nparameters,ncouplings
215
      nstate_interior = size(model%state_variables)
216 217
      nstate_surface = size(model%surface_state_variables)
      nstate_bottom = size(model%bottom_state_variables)
218
      ndiagnostic_interior = size(model%diagnostic_variables)
219 220 221 222
      ndiagnostic_horizontal = size(model%horizontal_diagnostic_variables)
      nconserved = size(model%conserved_quantities)
      ndependencies = size(environment_names)
      nparameters = model%root%parameters%size()
223
      ncouplings = coupling_link_list%count()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
224
   end subroutine get_counts
225

226
   subroutine get_variable_metadata(category,index,length,name,units,long_name,path) bind(c)
227
      !DIR$ ATTRIBUTES DLLEXPORT :: get_variable_metadata
228
      integer(c_int),        intent(in), value             :: category,index,length
229
      character(kind=c_char),intent(out),dimension(length) :: name,units,long_name,path
230 231 232 233 234

      class (type_external_variable),pointer :: variable

      ! Get a pointer to the target variable
      select case (category)
235
      case (INTERIOR_STATE_VARIABLE)
236 237 238 239 240
         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)
241
      case (INTERIOR_DIAGNOSTIC_VARIABLE)
242 243 244 245 246 247
         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
248 249 250 251
      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
252
   end subroutine get_variable_metadata
Jorn Bruggeman's avatar
Jorn Bruggeman committed
253

Jorn Bruggeman's avatar
Jorn Bruggeman committed
254 255 256 257
   function get_variable(category,index) bind(c) result(pvariable)
      !DIR$ ATTRIBUTES DLLEXPORT :: get_variable
      integer(c_int),intent(in), value :: category,index
      type (c_ptr)                     :: pvariable
258 259 260 261 262

      type (type_internal_variable),pointer :: variable

      ! Get a pointer to the target variable
      select case (category)
263
      case (INTERIOR_STATE_VARIABLE)
264 265 266 267 268
         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
269
      case (INTERIOR_DIAGNOSTIC_VARIABLE)
270 271 272 273 274 275 276
         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
277
   end function get_variable
278

279
   subroutine get_parameter_metadata(index,length,name,units,long_name,typecode,has_default) bind(c)
280
      !DIR$ ATTRIBUTES DLLEXPORT :: get_parameter_metadata
281
      integer(c_int),        intent(in), value             :: index,length
282
      character(kind=c_char),intent(out),dimension(length) :: name,units,long_name
283
      integer(c_int),        intent(out)                   :: typecode,has_default
284 285 286 287 288 289 290 291 292 293

      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
294 295
      end do

296 297 298 299
      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)
      typecode = property%typecode()
300
      has_default = logical2int(property%has_default)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
301
   end subroutine get_parameter_metadata
Jorn Bruggeman's avatar
Jorn Bruggeman committed
302

303 304
   subroutine get_dependency_metadata(index,length,name,units) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: get_dependency_metadata
Jorn Bruggeman's avatar
Jorn Bruggeman committed
305
      integer(c_int),        intent(in), value             :: index,length
306
      character(kind=c_char),intent(out),dimension(length) :: name,units
Jorn Bruggeman's avatar
Jorn Bruggeman committed
307

308 309
      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
310
   end subroutine get_dependency_metadata
311

312 313 314 315 316 317 318
   subroutine get_coupling(index,slave,master) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: get_coupling
      integer(c_int),        intent(in), value :: index
      type (c_ptr),          intent(out)       :: slave,master

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

320 321 322 323 324 325
      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
326
   end subroutine get_coupling
327

Jorn Bruggeman's avatar
Jorn Bruggeman committed
328 329
   function variable_get_suitable_masters(pvariable) result(plist) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: variable_get_suitable_masters
330 331
      type (c_ptr), intent(in), value :: pvariable
      type (c_ptr)                    :: plist
332

333
      type (type_internal_variable),pointer :: variable
334
      type (type_link_list),        pointer :: list
335 336 337 338

      call c_f_pointer(pvariable, variable)
      list => get_suitable_masters(model,variable)
      plist = c_loc(list)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
339
   end function variable_get_suitable_masters
340

341
   subroutine get_model_metadata(name,length,long_name,user_created) bind(c)
342
      !DIR$ ATTRIBUTES DLLEXPORT :: get_model_metadata
343 344 345
      character(kind=c_char),intent(in), target :: name(*)
      integer(c_int),        intent(in), value  :: length
      character(kind=c_char),intent(out)        :: long_name(length)
346
      integer(c_int),        intent(out)        :: user_created
347

348 349
      character(len=attribute_length),pointer   :: pname
      class (type_base_model),        pointer   :: found_model
350 351 352

      call c_f_pointer(c_loc(name), pname)
      found_model => model%root%find_model(pname(:index(pname,C_NULL_CHAR)-1))
353
      if (.not.associated(found_model)) call fatal_error('get_model_metadata', &
Jorn Bruggeman's avatar
Jorn Bruggeman committed
354
         'model "'//pname(:index(pname,C_NULL_CHAR)-1)//'" not found.')
355
      call copy_to_c_string(found_model%long_name,long_name)
356
      user_created = logical2int(found_model%user_created)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
357
   end subroutine get_model_metadata
358

359 360 361 362 363
   subroutine link_dependency_data(index,value) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: link_dependency_data
      integer(c_int),intent(in),value  :: index
      real(c_double),intent(in),target :: value

364
      call fabm_link_interior_data(model,environment_names(index),value)
365 366
      call fabm_link_horizontal_data(model,environment_names(index),value)
      call fabm_link_scalar_data(model,environment_names(index),value)
367
      if (index==index_column_depth) column_depth => value
Jorn Bruggeman's avatar
Jorn Bruggeman committed
368
   end subroutine link_dependency_data
369

370 371
   subroutine link_interior_state_data(index,value) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: link_interior_state_data
372 373
      integer(c_int),intent(in),   value  :: index
      real(c_double),intent(inout),target :: value
Jorn Bruggeman's avatar
Jorn Bruggeman committed
374

375
      value = model%state_variables(index)%initial_value
376 377
      call fabm_link_interior_state_data(model,index,value)
   end subroutine link_interior_state_data
Jorn Bruggeman's avatar
Jorn Bruggeman committed
378

379 380 381 382
   subroutine link_surface_state_data(index,value) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: link_surface_state_data
      integer(c_int),intent(in),   value  :: index
      real(c_double),intent(inout),target :: value
Jorn Bruggeman's avatar
Jorn Bruggeman committed
383

384 385
      value = model%surface_state_variables(index)%initial_value
      call fabm_link_surface_state_data(model,index,value)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
386
   end subroutine link_surface_state_data
Knut's avatar
Knut committed
387

388 389 390 391 392 393 394
   subroutine link_bottom_state_data(index,value) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: link_bottom_state_data
      integer(c_int),intent(in),   value  :: index
      real(c_double),intent(inout),target :: value

      value = model%bottom_state_variables(index)%initial_value
      call fabm_link_bottom_state_data(model,index,value)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
395
   end subroutine link_bottom_state_data
396

397
   subroutine get_rates(rates_, do_surface, do_bottom) bind(c)
398
      !DIR$ ATTRIBUTES DLLEXPORT :: get_rates
399
      real(c_double),target,intent(in) :: rates_(*)
400
      integer(c_int),value, intent(in) :: do_surface, do_bottom
401

402
      real(c_double),pointer :: rates(:)
403
      real(rk)               :: ext
404

405
      call c_f_pointer(c_loc(rates_),rates, &
406
        (/size(model%state_variables)+size(model%surface_state_variables)+size(model%bottom_state_variables)/))
407 408 409 410 411 412 413 414 415

      call fabm_get_light_extinction(model, ext)
      call fabm_get_light(model)

      rates = 0.0_rk
      if (int2logical(do_surface)) call fabm_do_surface(model, rates(1:size(model%state_variables)), &
         rates(size(model%state_variables)+1:size(model%state_variables)+size(model%surface_state_variables)))
      if (int2logical(do_bottom)) call fabm_do_bottom(model, rates(1:size(model%state_variables)), &
         rates(size(model%state_variables)+size(model%surface_state_variables)+1:))
416
      if (int2logical(do_surface) .or. int2logical(do_bottom)) then
417
         if (.not.associated(column_depth)) call fatal_error('get_rates', &
418 419
            'Value for environmental dependency '//trim(environment_names(index_column_depth))// &
            ' must be provided if get_rates is called with the do_surface and/or do_bottom flags.')
420
         rates(1:size(model%state_variables)) = rates(1:size(model%state_variables))/column_depth
421
      end if
422
      call fabm_do(model, rates(1:size(model%state_variables)))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
423 424

      ! Compute rate of change in conserved quantities
425
      !call fabm_state_to_conserved_quantities(model,pelagic_rates,conserved_rates)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
426 427

      ! Normalize rate of change in conserved quantities to sum of absolute rates of change.
428 429
      !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
430
   end subroutine get_rates
431

432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461
   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_)
      call fabm_check_state(model, repair, interior_valid)
      call fabm_check_surface_state(model, repair, surface_valid)
      call fabm_check_bottom_state(model, repair, bottom_valid)
      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)
      real(rk)               :: rates(ny)
      real(rk)               :: ext
      logical                :: surface, bottom

      if (ny /= size(model%state_variables)+size(model%surface_state_variables)+size(model%bottom_state_variables)) &
462
          call fatal_error('integrate', 'ny is wrong length')
463 464 465 466 467 468 469 470

      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
471
          if (.not.associated(column_depth)) call fatal_error('get_rates', &
472 473 474 475
            'Value for environmental dependency '//trim(environment_names(index_column_depth))// &
            ' 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
476 477 478
      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:))
479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502

      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

          call fabm_get_light_extinction(model, ext)
          call fabm_get_light(model)
          rates = 0.0_rk
          if (surface) call fabm_do_surface(model, rates(1:size(model%state_variables)), &
             rates(size(model%state_variables)+1:size(model%state_variables)+size(model%surface_state_variables)))
          if (bottom) call fabm_do_bottom(model, rates(1:size(model%state_variables)), &
             rates(size(model%state_variables)+size(model%surface_state_variables)+1:))
          if (surface .or. bottom) rates(1:size(model%state_variables)) = rates(1:size(model%state_variables))/column_depth
          call fabm_do(model, rates(1:size(model%state_variables)))
          y_cur = y_cur + dt*rates*86400
          t_cur = t_cur + dt
      end do
   end subroutine integrate

503 504
   subroutine get_interior_diagnostic_data(index,ptr) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: get_interior_diagnostic_data
505 506
      integer(c_int),intent(in),value :: index
      type(c_ptr),   intent(out)      :: ptr
507 508
      ptr = c_loc(fabm_get_interior_diagnostic_data(model,index))
   end subroutine get_interior_diagnostic_data
509 510 511 512 513 514

   subroutine get_horizontal_diagnostic_data(index,ptr) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: get_horizontal_diagnostic_data
      integer(c_int),intent(in),value :: index
      type(c_ptr),   intent(out)      :: ptr
      ptr = c_loc(fabm_get_horizontal_diagnostic_data(model,index))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
515
   end subroutine get_horizontal_diagnostic_data
Jorn Bruggeman's avatar
Jorn Bruggeman committed
516

517
   subroutine finalize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
518 519 520
      call fabm_finalize(model)
      if (allocated(environment_names)) deallocate(environment_names)
      if (allocated(environment_units)) deallocate(environment_units)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
521
   end subroutine finalize
Jorn Bruggeman's avatar
Jorn Bruggeman committed
522

523
   subroutine reset_parameter(index) bind(c)
524
      !DIR$ ATTRIBUTES DLLEXPORT :: reset_parameter
525 526
      integer(c_int),value,intent(in) :: index
      class (type_property),pointer   :: property
527

528 529 530
      property => model%root%parameters%get_property(index)
      if (.not.associated(property)) return
      call forced_parameters%delete(property%name)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
531 532

      ! Re-initialize the model using updated parameter values
533
      call reinitialize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
534
   end subroutine reset_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
535

536 537
   subroutine set_real_parameter(name,value) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: set_real_parameter
538 539
      character(kind=c_char),target,intent(in) :: name(*)
      real(c_double),value,         intent(in) :: value
540 541 542 543 544

      character(len=attribute_length),pointer :: pname

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

      ! Re-initialize the model using updated parameter values
547
      call reinitialize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
548
   end subroutine set_real_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
549

550
   function get_real_parameter(index,default) bind(c) result(value)
551
      !DIR$ ATTRIBUTES DLLEXPORT :: get_real_parameter
552
      integer(c_int),value,intent(in) :: index,default
553
      real(c_double)                  :: value
554 555 556 557 558
      class (type_property),pointer   :: property

      property => model%root%parameters%get_property(index)
      select type (property)
      class is (type_real_property)
559
         if (int2logical(default)) then
560 561 562 563 564
            value = property%default
         else
            value = property%value
         end if
      class default
565
         call fatal_error('get_real_parameter','not a real variable')
566
      end select
Jorn Bruggeman's avatar
Jorn Bruggeman committed
567
   end function get_real_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
568

569 570
   subroutine set_integer_parameter(name,value) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: set_integer_parameter
571 572
      character(kind=c_char),target,intent(in) :: name(*)
      integer(c_int),value,         intent(in) :: value
573 574 575 576 577

      character(len=attribute_length),pointer :: pname

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

      ! Re-initialize the model using updated parameter values
580
      call reinitialize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
581
   end subroutine set_integer_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
582

583
   function get_integer_parameter(index,default) bind(c) result(value)
584
      !DIR$ ATTRIBUTES DLLEXPORT :: get_integer_parameter
585
      integer(c_int),value,intent(in) :: index,default
586
      integer(c_int)                  :: value
587 588 589 590 591
      class (type_property),pointer   :: property

      property => model%root%parameters%get_property(index)
      select type (property)
      class is (type_integer_property)
592
         if (int2logical(default)) then
593 594 595 596 597
            value = property%default
         else
            value = property%value
         end if
      class default
598
         call fatal_error('get_integer_parameter','not an integer variable')
599
      end select
Jorn Bruggeman's avatar
Jorn Bruggeman committed
600
   end function get_integer_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
601

602 603
   subroutine set_logical_parameter(name,value) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: set_logical_parameter
604
      character(kind=c_char),target,    intent(in) :: name(*)
605 606 607 608 609
      integer(c_int),value,intent(in) :: value

      character(len=attribute_length),pointer :: pname

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

      ! Re-initialize the model using updated parameter values
613
      call reinitialize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
614
   end subroutine set_logical_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
615

616
   function get_logical_parameter(index,default) bind(c) result(value)
617
      !DIR$ ATTRIBUTES DLLEXPORT :: get_logical_parameter
618
      integer(c_int),value,intent(in) :: index,default
619
      integer(c_int)                  :: value
620 621 622 623 624
      class (type_property),pointer   :: property

      property => model%root%parameters%get_property(index)
      select type (property)
      class is (type_logical_property)
625 626
         if (int2logical(default)) then
            value = logical2int(property%default)
627
         else
628
            value = logical2int(property%value)
629 630
         end if
      class default
631
         call fatal_error('get_logical_parameter','not a logical variable')
632
      end select
Jorn Bruggeman's avatar
Jorn Bruggeman committed
633
   end function get_logical_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
634

635 636 637 638 639
   subroutine set_string_parameter(name,value) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: set_string_parameter
      character(kind=c_char),target,intent(in) :: name(*),value(*)

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

641 642 643
      call c_f_pointer(c_loc(name),  pname)
      call c_f_pointer(c_loc(value), pvalue)
      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
644 645

      ! Re-initialize the model using updated parameter values
646
      call reinitialize()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
647
   end subroutine set_string_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
648

649 650 651 652 653
   subroutine get_string_parameter(index,default,length,value) bind(c)
      !DIR$ ATTRIBUTES DLLEXPORT :: get_string_parameter
      integer(c_int),value,intent(in) :: index,default,length
      character(kind=c_char)          :: value(length)

654 655 656 657 658
      class (type_property),pointer   :: property

      property => model%root%parameters%get_property(index)
      select type (property)
      class is (type_string_property)
659
         if (int2logical(default)) then
660
            call copy_to_c_string(property%default, value)
661
         else
662
            call copy_to_c_string(property%value, value)
663 664
         end if
      class default
665
         call fatal_error('get_string_parameter','not a string variable')
666
      end select
Jorn Bruggeman's avatar
Jorn Bruggeman committed
667
   end subroutine get_string_parameter
Jorn Bruggeman's avatar
Jorn Bruggeman committed
668

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

673
      error_occurred = .true.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
674
      !write (*,*) trim(location)//': '//trim(message)
675
      !stop 1
Jorn Bruggeman's avatar
Jorn Bruggeman committed
676
   end subroutine python_driver_fatal_error
677

678
   subroutine python_driver_log_message(self,message)
679 680 681 682
      class (type_python_driver),intent(inout) :: self
      character(len=*),          intent(in)    :: message

      !write (*,*) trim(message)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
683
   end subroutine python_driver_log_message
684

Jorn Bruggeman's avatar
Jorn Bruggeman committed
685 686 687
   end module fabm_python

!-----------------------------------------------------------------------
688
! Copyright Bolding & Bruggeman ApS - Public License - www.gnu.org
Jorn Bruggeman's avatar
Jorn Bruggeman committed
689
!-----------------------------------------------------------------------