fabm.F90 142 KB
Newer Older
1
#include "fabm_driver.h"
2
#include "fabm_private.h"
Jorn Bruggeman's avatar
Jorn Bruggeman committed
3

Jorn Bruggeman's avatar
Jorn Bruggeman committed
4
! =============================================================================
Jorn Bruggeman's avatar
Jorn Bruggeman committed
5 6
! FABM --- Framework for Aquatic Biogeochemical Models
! -----------------------------------------------------------------------------
Jorn Bruggeman's avatar
Jorn Bruggeman committed
7 8
! This is the core module of FABM, serving as the "glue layer" between a
! physical host model (e.g., a general circulation model), and one or more
Jorn Bruggeman's avatar
Jorn Bruggeman committed
9 10
! specific biogeochemical models. A physical host model will call the
! interfaces of this module to access biogeochemistry.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
11
!
12 13
! For more information, see the documentation at http://fabm.net/wiki.
!
Jorn Bruggeman's avatar
Jorn Bruggeman committed
14 15
! To add new biogeochemical models, add source code under src/models and
! reference your institute in src/CMakeLists.txt
Jorn Bruggeman's avatar
Jorn Bruggeman committed
16
! =============================================================================
Jorn Bruggeman's avatar
Jorn Bruggeman committed
17 18 19

module fabm

20
   use fabm_parameters
21
   use fabm_types, rki => rk, fabm_standard_variables => standard_variables
22
   use fabm_expressions
23
   use fabm_driver
24
   use fabm_properties
25 26
   use fabm_builtin_models
   use fabm_coupling
27
   use fabm_job
28
   use fabm_schedule
29
   use fabm_debug
30
   use fabm_work
31
   use fabm_config
32

33
   implicit none
Jorn Bruggeman's avatar
Jorn Bruggeman committed
34

35
   private
Jorn Bruggeman's avatar
Jorn Bruggeman committed
36

37 38 39 40 41 42
   ! --------------------------------------------------------------------------
   ! Public members
   ! --------------------------------------------------------------------------

   public fabm_initialize_library
   public fabm_get_version
43
   public fabm_create_model
44
   public type_fabm_model
45 46

   ! Variable identifier types by external physical drivers.
47 48 49 50 51
   public type_fabm_variable_id
   public type_fabm_interior_variable_id
   public type_fabm_horizontal_variable_id
   public type_fabm_scalar_variable_id
   public type_fabm_variable, type_fabm_horizontal_state_variable
52 53 54

   ! Object with all supported standard variables as its members.
   ! Imported from fabm_types, and made available so hosts only need to "use fabm"
55
   public fabm_standard_variables
56

Jorn Bruggeman's avatar
Jorn Bruggeman committed
57 58
   integer, parameter :: status_none             = 0
   integer, parameter :: status_initialize_done  = 1
59
   integer, parameter, public :: status_set_domain_done  = 2
60
   integer, parameter, public :: status_start_done = 3
61

Jorn Bruggeman's avatar
Jorn Bruggeman committed
62 63 64 65 66 67
   integer, parameter, public :: data_source_none = 0
   integer, parameter, public :: data_source_host = 1
   integer, parameter, public :: data_source_fabm = 2
   integer, parameter, public :: data_source_user = 3
   integer, parameter, public :: data_source_default = data_source_host

Jorn Bruggeman's avatar
Jorn Bruggeman committed
68 69 70
   ! --------------------------------------------------------------------------
   ! Derived typed for variable identifiers
   ! --------------------------------------------------------------------------
71

72
   type type_fabm_variable_id
Jorn Bruggeman's avatar
Jorn Bruggeman committed
73
      type (type_internal_variable), pointer :: variable => null()
74 75
   end type

76
   type, extends(type_fabm_variable_id) :: type_fabm_interior_variable_id
77 78
   end type

79
   type, extends(type_fabm_variable_id) :: type_fabm_horizontal_variable_id
Jorn Bruggeman's avatar
Jorn Bruggeman committed
80 81
   end type

82
   type, extends(type_fabm_variable_id) :: type_fabm_scalar_variable_id
83 84
   end type

Jorn Bruggeman's avatar
Jorn Bruggeman committed
85 86 87
   ! --------------------------------------------------------------------------
   ! Derived types for variable metadata
   ! --------------------------------------------------------------------------
88

Jorn Bruggeman's avatar
Jorn Bruggeman committed
89
   ! Derived type for metadata of a generic variable (base type)
90
   type, abstract :: type_fabm_variable
91 92
      character(len=attribute_length) :: name          = ''
      character(len=attribute_length) :: long_name     = ''
93
      character(len=attribute_length) :: local_long_name = ''
94
      character(len=attribute_length) :: units         = ''
95
      character(len=attribute_length) :: path          = ''
96 97 98
      real(rke)                       :: minimum       = -1.e20_rke
      real(rke)                       :: maximum       =  1.e20_rke
      real(rke)                       :: missing_value = -2.e20_rke
Jorn Bruggeman's avatar
Jorn Bruggeman committed
99
      integer                         :: output        = output_instantaneous ! See output_* parameters defined in fabm_types
100 101
      type (type_property_dictionary) :: properties
      integer                         :: externalid    = 0                    ! Identifier to be used freely by host
102
      type (type_internal_variable), pointer :: target => null()
103 104
   end type

Jorn Bruggeman's avatar
Jorn Bruggeman committed
105
   ! Derived type for interior state variable metadata
106
   type, extends(type_fabm_variable) :: type_fabm_state_variable
Jorn Bruggeman's avatar
Jorn Bruggeman committed
107 108 109 110
      class (type_interior_standard_variable), pointer :: standard_variable => null()
      real(rke)                                        :: initial_value             = 0.0_rke
      logical                                          :: no_precipitation_dilution = .false.
      logical                                          :: no_river_dilution         = .false.
111
   end type
112

Jorn Bruggeman's avatar
Jorn Bruggeman committed
113
   ! Derived type for horizontal (bottom/surface) state variable metadata
114
   type, extends(type_fabm_variable) :: type_fabm_horizontal_state_variable
Jorn Bruggeman's avatar
Jorn Bruggeman committed
115 116
      class (type_horizontal_standard_variable), pointer :: standard_variable => null()
      real(rke)                                          :: initial_value = 0.0_rke
117
   end type
118

Jorn Bruggeman's avatar
Jorn Bruggeman committed
119
   ! Derived type for interior diagnostic variable metadata
120
   type, extends(type_fabm_variable) :: type_fabm_diagnostic_variable
Jorn Bruggeman's avatar
Jorn Bruggeman committed
121 122 123
      class (type_interior_standard_variable), pointer :: standard_variable => null()
      logical                                          :: save = .false.
      integer                                          :: source
124
   end type
125

Jorn Bruggeman's avatar
Jorn Bruggeman committed
126
   ! Derived type for horizontal diagnostic variable metadata
127
   type, extends(type_fabm_variable) :: type_fabm_horizontal_diagnostic_variable
Jorn Bruggeman's avatar
Jorn Bruggeman committed
128 129 130
      class (type_horizontal_standard_variable), pointer :: standard_variable => null()
      logical                                            :: save = .false.
      integer                                            :: source
131 132
   end type

133 134
   ! Derived type for conserved quantity metadata
   type, extends(type_fabm_variable) :: type_fabm_conserved_quantity
135 136 137 138
      class (type_base_standard_variable), pointer :: standard_variable => null()
      integer                                      :: index             = -1
      integer                                      :: horizontal_index  = -1
      type (type_internal_variable),       pointer :: target_hz => null()
139 140
   end type

Jorn Bruggeman's avatar
Jorn Bruggeman committed
141
   ! --------------------------------------------------------------------------
Jorn Bruggeman's avatar
Jorn Bruggeman committed
142
   ! Derived type for a biogeochemical model as seen by the host
Jorn Bruggeman's avatar
Jorn Bruggeman committed
143
   ! --------------------------------------------------------------------------
144

145
   type type_fabm_model
Jorn Bruggeman's avatar
Jorn Bruggeman committed
146
      ! Variable metadata
147
      type (type_fabm_state_variable),                 allocatable, dimension(:) :: interior_state_variables
148 149
      type (type_fabm_horizontal_state_variable),      allocatable, dimension(:) :: surface_state_variables
      type (type_fabm_horizontal_state_variable),      allocatable, dimension(:) :: bottom_state_variables
150
      type (type_fabm_diagnostic_variable),            allocatable, dimension(:) :: interior_diagnostic_variables
151 152
      type (type_fabm_horizontal_diagnostic_variable), allocatable, dimension(:) :: horizontal_diagnostic_variables
      type (type_fabm_conserved_quantity),             allocatable, dimension(:) :: conserved_quantities
153

154 155 156 157
      ! Short names for interior state/diagnostic variables
      type (type_fabm_state_variable),                 pointer, dimension(:) :: state_variables      => null()
      type (type_fabm_diagnostic_variable),            pointer, dimension(:) :: diagnostic_variables => null()

Jorn Bruggeman's avatar
Jorn Bruggeman committed
158 159
      ! Names of variables taken as input by one or more biogeochemical models.
      ! These may be accessed by the host to enumerate potential forcing variables.
160 161 162
      character(len=attribute_length), allocatable, dimension(:) :: dependencies
      character(len=attribute_length), allocatable, dimension(:) :: dependencies_hz
      character(len=attribute_length), allocatable, dimension(:) :: dependencies_scalar
163

Jorn Bruggeman's avatar
Jorn Bruggeman committed
164
      ! Individual jobs
Jorn Bruggeman's avatar
Jorn Bruggeman committed
165 166 167
      type (type_job) :: get_interior_sources_job
      type (type_job) :: get_bottom_sources_job
      type (type_job) :: get_surface_sources_job
168
      type (type_job) :: get_vertical_movement_job
Jorn Bruggeman's avatar
Jorn Bruggeman committed
169
      type (type_job) :: get_interior_conserved_quantities_job
170
      type (type_job) :: get_horizontal_conserved_quantities_job
Jorn Bruggeman's avatar
Jorn Bruggeman committed
171 172 173
      type (type_job) :: finalize_outputs_job
      type (type_job) :: prepare_inputs_job
      type (type_job) :: check_interior_state_job
174 175
      type (type_job) :: check_bottom_state_job
      type (type_job) :: check_surface_state_job
Jorn Bruggeman's avatar
Jorn Bruggeman committed
176
      type (type_job) :: initialize_interior_state_job
177 178
      type (type_job) :: initialize_bottom_state_job
      type (type_job) :: initialize_surface_state_job
179

Jorn Bruggeman's avatar
Jorn Bruggeman committed
180 181 182
      ! Root container of biogeochemical modules
      type (type_base_model) :: root

Jorn Bruggeman's avatar
Jorn Bruggeman committed
183
      integer :: status = status_none
Jorn Bruggeman's avatar
Jorn Bruggeman committed
184
      logical :: log = .false.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
185 186 187 188 189 190 191 192

      type (type_link_list) :: links_postcoupling

      type (type_global_variable_register) :: variable_register
      type (type_job_manager)              :: job_manager
      type (type_catalog)                  :: catalog
      type (type_store)                    :: store
      type (type_schedules)                :: schedules
Jorn Bruggeman's avatar
Jorn Bruggeman committed
193
      type (type_domain)                   :: domain
194

Jorn Bruggeman's avatar
Jorn Bruggeman committed
195
      ! Memory caches for exchanging information with individual biogeochemical modules
196 197 198
      type (type_interior_cache)   :: cache_int
      type (type_horizontal_cache) :: cache_hz
      type (type_vertical_cache)   :: cache_vert
Jorn Bruggeman's avatar
Jorn Bruggeman committed
199 200

      ! Cache fill values
201
      type (type_cache_fill_values) :: cache_fill_values
Jorn Bruggeman's avatar
Jorn Bruggeman committed
202
   contains
Jorn Bruggeman's avatar
Jorn Bruggeman committed
203
      procedure :: initialize
204
      procedure :: finalize
Jorn Bruggeman's avatar
Jorn Bruggeman committed
205
      procedure :: set_domain
206 207 208 209
#if _FABM_DIMENSION_COUNT_>0
      procedure :: set_domain_start
      procedure :: set_domain_stop
#endif
210
#if defined(_FABM_DEPTH_DIMENSION_INDEX_)&&_FABM_BOTTOM_INDEX_==-1
Jorn Bruggeman's avatar
Jorn Bruggeman committed
211
      procedure :: set_bottom_index
212
#endif
213
#ifdef _HAS_MASK_
Jorn Bruggeman's avatar
Jorn Bruggeman committed
214
      procedure :: set_mask
215
#endif
Jorn Bruggeman's avatar
Jorn Bruggeman committed
216
      procedure :: start
217

Jorn Bruggeman's avatar
Jorn Bruggeman committed
218 219 220
      procedure :: initialize_interior_state
      procedure :: initialize_bottom_state
      procedure :: initialize_surface_state
221

Jorn Bruggeman's avatar
Jorn Bruggeman committed
222 223 224
      procedure :: check_interior_state
      procedure :: check_bottom_state
      procedure :: check_surface_state
225

226 227 228
      procedure :: prepare_inputs1
      procedure :: prepare_inputs2
      generic :: prepare_inputs => prepare_inputs1, prepare_inputs2
229
      procedure :: finalize_outputs
230

Jorn Bruggeman's avatar
Jorn Bruggeman committed
231 232
      procedure :: get_interior_sources_rhs
      procedure :: get_interior_sources_ppdd
Jorn Bruggeman's avatar
Jorn Bruggeman committed
233
      generic :: get_interior_sources => get_interior_sources_rhs, get_interior_sources_ppdd
Jorn Bruggeman's avatar
Jorn Bruggeman committed
234 235
      procedure :: get_bottom_sources_rhs
      procedure :: get_bottom_sources_ppdd
Jorn Bruggeman's avatar
Jorn Bruggeman committed
236
      generic :: get_bottom_sources => get_bottom_sources_rhs, get_bottom_sources_ppdd
Jorn Bruggeman's avatar
Jorn Bruggeman committed
237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268
      procedure :: get_surface_sources

      procedure :: get_vertical_movement
      procedure :: get_interior_conserved_quantities
      procedure :: get_horizontal_conserved_quantities

      procedure :: link_interior_data_by_variable
      procedure :: link_interior_data_by_id
      procedure :: link_interior_data_by_sn
      procedure :: link_interior_data_by_name
      generic :: link_interior_data => link_interior_data_by_variable, link_interior_data_by_id, link_interior_data_by_sn, link_interior_data_by_name

      procedure :: link_horizontal_data_by_variable
      procedure :: link_horizontal_data_by_id
      procedure :: link_horizontal_data_by_sn
      procedure :: link_horizontal_data_by_name
      generic :: link_horizontal_data => link_horizontal_data_by_variable, link_horizontal_data_by_id, link_horizontal_data_by_sn, link_horizontal_data_by_name

      procedure :: link_scalar_by_id
      procedure :: link_scalar_by_sn
      procedure :: link_scalar_by_name
      generic :: link_scalar => link_scalar_by_id, link_scalar_by_sn, link_scalar_by_name

      procedure :: link_interior_state_data
      procedure :: link_bottom_state_data
      procedure :: link_surface_state_data
      procedure :: link_all_interior_state_data
      procedure :: link_all_bottom_state_data
      procedure :: link_all_surface_state_data

      procedure :: require_interior_data
      procedure :: require_horizontal_data
Jorn Bruggeman's avatar
Jorn Bruggeman committed
269
      generic :: require_data => require_interior_data, require_horizontal_data
270

Jorn Bruggeman's avatar
Jorn Bruggeman committed
271 272 273
      procedure :: get_interior_data
      procedure :: get_horizontal_data
      procedure :: get_scalar_data
274
      generic :: get_data => get_interior_data, get_horizontal_data, get_scalar_data
Jorn Bruggeman's avatar
Jorn Bruggeman committed
275

Jorn Bruggeman's avatar
Jorn Bruggeman committed
276 277
      procedure :: get_interior_diagnostic_data
      procedure :: get_horizontal_diagnostic_data
278

279 280 281
      procedure :: get_interior_variable_id_by_name
      procedure :: get_interior_variable_id_sn
      generic :: get_interior_variable_id => get_interior_variable_id_by_name, get_interior_variable_id_sn
282

Jorn Bruggeman's avatar
Jorn Bruggeman committed
283 284
      procedure :: get_horizontal_variable_id_by_name
      procedure :: get_horizontal_variable_id_sn
285 286
      generic :: get_horizontal_variable_id => get_horizontal_variable_id_by_name, get_horizontal_variable_id_sn

Jorn Bruggeman's avatar
Jorn Bruggeman committed
287 288
      procedure :: get_scalar_variable_id_by_name
      procedure :: get_scalar_variable_id_sn
289
      generic :: get_scalar_variable_id => get_scalar_variable_id_by_name, get_scalar_variable_id_sn
290

Jorn Bruggeman's avatar
Jorn Bruggeman committed
291
      procedure, nopass :: is_variable_used
292
      procedure :: get_variable_name
293

Jorn Bruggeman's avatar
Jorn Bruggeman committed
294 295 296 297 298 299
      procedure :: interior_variable_needs_values
      procedure :: interior_variable_needs_values_sn
      procedure :: horizontal_variable_needs_values
      procedure :: horizontal_variable_needs_values_sn
      procedure :: scalar_variable_needs_values
      procedure :: scalar_variable_needs_values_sn
300
      generic :: variable_needs_values => interior_variable_needs_values, interior_variable_needs_values_sn, &
301 302
                                          horizontal_variable_needs_values, horizontal_variable_needs_values_sn, &
                                          scalar_variable_needs_values, scalar_variable_needs_values_sn
303

Jorn Bruggeman's avatar
Jorn Bruggeman committed
304
      procedure :: process_job
Jorn Bruggeman's avatar
Jorn Bruggeman committed
305 306
      generic :: process => process_job
#if _FABM_DIMENSION_COUNT_ > 1 || (_FABM_DIMENSION_COUNT_ == 1 && !defined(_FABM_DEPTH_DIMENSION_INDEX_))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
307
      procedure :: process_job_everywhere
Jorn Bruggeman's avatar
Jorn Bruggeman committed
308 309 310
      generic :: process => process_job_everywhere
#endif

311
   end type type_fabm_model
312

Jorn Bruggeman's avatar
Jorn Bruggeman committed
313
contains
314

Jorn Bruggeman's avatar
Jorn Bruggeman committed
315 316 317 318
   ! --------------------------------------------------------------------------
   ! fabm_initialize_library: initialize FABM library
   ! --------------------------------------------------------------------------
   ! This will be called automatically when creating new models.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
319
   ! For instance, from fabm_create_model.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
320
   ! --------------------------------------------------------------------------
321
   subroutine fabm_initialize_library()
322 323
      use fabm_library, only: fabm_model_factory

324
      ! Do nothing if already initialized.
325
      if (associated(factory)) return
326 327

      ! If needed, create default object for communication (e.g., logging, error reporting) with host.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
328
      if (.not. associated(driver)) allocate(driver)
329 330 331 332 333

      ! Create all standard variable objects.
      call initialize_standard_variables()

      ! Create the model factory.
334
      factory => fabm_model_factory
335
      call factory%initialize()
336 337
   end subroutine fabm_initialize_library

Jorn Bruggeman's avatar
Jorn Bruggeman committed
338 339 340
   ! --------------------------------------------------------------------------
   ! fabm_get_version: get FABM version string
   ! --------------------------------------------------------------------------
341 342 343 344 345
   subroutine fabm_get_version(string)
      use fabm_version

      character(len=*), intent(out) :: string

Jorn Bruggeman's avatar
Jorn Bruggeman committed
346
      type (type_version), pointer :: version
347

Jorn Bruggeman's avatar
Jorn Bruggeman committed
348
      call fabm_initialize_library()
Jorn Bruggeman's avatar
Jorn Bruggeman committed
349
      string = git_commit_id // ' (' // git_branch_name // ' branch)'
350 351
      version => first_module_version
      do while (associated(version))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
352
         string = trim(string) // ', ' // trim(version%module_name) // ': ' // trim(version%version_string)
353 354 355 356
         version => version%next
      end do
   end subroutine fabm_get_version

357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372
   ! --------------------------------------------------------------------------
   ! fabm_create_model: create a model from a yaml-based configuration file
   ! --------------------------------------------------------------------------
   function fabm_create_model(path, initialize, parameters, unit) result(model)
      character(len=*),                optional, intent(in) :: path
      logical,                         optional, intent(in) :: initialize
      type (type_property_dictionary), optional, intent(in) :: parameters
      integer,                         optional, intent(in) :: unit
      class (type_fabm_model), pointer                      :: model

      logical :: initialize_

      ! Make sure the library is initialized.
      call fabm_initialize_library()

      allocate(model)
373
      call fabm_configure_model(model%root, model%schedules, model%log, path, parameters=parameters, unit=unit)
374 375 376 377 378 379 380

      ! Initialize model tree
      initialize_ = .true.
      if (present(initialize)) initialize_ = initialize
      if (initialize_) call model%initialize()
   end function

Jorn Bruggeman's avatar
Jorn Bruggeman committed
381 382 383 384 385 386 387 388
   ! --------------------------------------------------------------------------
   ! initialize: initialize a model object
   ! --------------------------------------------------------------------------
   ! This freezes the tree of biogeochemical modules; afterwards no new modules
   ! can be added. This routine will be called automatically when reading
   ! a model configuration from fabm.yaml, unless explicitly deactivated.
   ! --------------------------------------------------------------------------
   subroutine initialize(self)
389
      class (type_fabm_model), target, intent(inout) :: self
Jorn Bruggeman's avatar
Jorn Bruggeman committed
390 391 392 393 394

      class (type_property), pointer :: property => null()
      integer                        :: islash
      integer                        :: ivar

Jorn Bruggeman's avatar
Jorn Bruggeman committed
395 396
      if (self%status >= status_initialize_done) &
         call fatal_error('initialize', 'initialize has already been called on this model object.')
397

398
      ! Create zero fields.
399 400
      call self%root%add_interior_variable('zero', act_as_state_variable=.true., source=source_constant, missing_value=0.0_rki, output=output_none)
      call self%root%add_horizontal_variable('zero_hz', act_as_state_variable=.true., source=source_constant, missing_value=0.0_rki, output=output_none)
401

402 403 404 405
      ! Filter out expressions that FABM can handle itself.
      ! The remainder, if any, must be handled by the host model.
      call filter_expressions(self)

Jorn Bruggeman's avatar
Jorn Bruggeman committed
406
      ! This will resolve all FABM dependencies and generate final authoritative lists of variables of different types.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
407 408
      call freeze_model_info(self%root)

409 410 411 412
      ! Raise error for unused coupling commands.
      property => self%root%couplings%first
      do while (associated(property))
         if (.not.self%root%couplings%retrieved%contains(trim(property%name))) then
Jorn Bruggeman's avatar
Jorn Bruggeman committed
413 414
            islash = index(property%name, '/', .true.)
            call fatal_error('initialize', 'model ' // property%name(1:islash-1) // ' does not contain variable "' // trim(property%name(islash+1:)) // '" mentioned in coupling section.')
415 416 417 418
         end if
         property => property%next
      end do

Jorn Bruggeman's avatar
Jorn Bruggeman committed
419
      ! Build final authoritative arrays with variable metadata.
420 421
      call classify_variables(self)

422 423 424
      ! Create catalog for storing pointers to data per variable.
      call create_catalog(self)

425 426
      ! Create built-in jobs, which can then be chained by the host/user by calling job%set_next.
      ! (the reason for chaining is to allow later jobs to use results of earlier ones, thus reducing the number of calls needed)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449
      call self%job_manager%create(self%prepare_inputs_job, 'prepare_inputs')
      call self%job_manager%create(self%get_interior_sources_job, 'get_interior_sources', source=source_do, previous=self%prepare_inputs_job)
      call self%job_manager%create(self%get_surface_sources_job, 'get_surface_sources', source=source_do_surface, previous=self%prepare_inputs_job)
      call self%job_manager%create(self%get_bottom_sources_job, 'get_bottom_sources', source=source_do_bottom, previous=self%prepare_inputs_job)
      call self%job_manager%create(self%get_interior_conserved_quantities_job, 'get_interior_conserved_quantities', source=source_do, previous=self%prepare_inputs_job)
      call self%job_manager%create(self%get_horizontal_conserved_quantities_job, 'get_horizontal_conserved_quantities', source=source_do_horizontal, previous=self%prepare_inputs_job)
      call self%job_manager%create(self%finalize_outputs_job, 'finalize_outputs', outsource_tasks=.true.)
      call self%get_interior_sources_job%connect(self%finalize_outputs_job)
      call self%get_surface_sources_job%connect(self%finalize_outputs_job)
      call self%get_bottom_sources_job%connect(self%finalize_outputs_job)
      !call self%get_interior_conserved_quantities_job%connect(self%finalize_outputs_job)
      !call self%get_horizontal_conserved_quantities_job%connect(self%finalize_outputs_job)
      call self%job_manager%create(self%get_vertical_movement_job, 'get_vertical_movement', source=source_get_vertical_movement, previous=self%finalize_outputs_job)
      call self%job_manager%create(self%initialize_interior_state_job, 'initialize_interior_state', source=source_initialize_state, previous=self%finalize_outputs_job)
      call self%job_manager%create(self%initialize_bottom_state_job, 'initialize_bottom_state', source=source_initialize_bottom_state, previous=self%finalize_outputs_job)
      call self%job_manager%create(self%initialize_surface_state_job, 'initialize_surface_state', source=source_initialize_surface_state, previous=self%finalize_outputs_job)
      call self%job_manager%create(self%check_interior_state_job, 'check_interior_state', source=source_check_state, previous=self%finalize_outputs_job)
      call self%job_manager%create(self%check_bottom_state_job, 'check_bottom_state', source=source_check_bottom_state, previous=self%finalize_outputs_job)
      call self%job_manager%create(self%check_surface_state_job, 'check_surface_state', source=source_check_surface_state, previous=self%finalize_outputs_job)

      call require_flux_computation(self%get_bottom_sources_job, self%links_postcoupling, domain_bottom)
      call require_flux_computation(self%get_surface_sources_job, self%links_postcoupling, domain_surface)
      call require_flux_computation(self%get_interior_sources_job, self%links_postcoupling, domain_interior)
450
      call require_flux_computation(self%get_vertical_movement_job, self%links_postcoupling, domain_interior + 999)
451

Jorn Bruggeman's avatar
Jorn Bruggeman committed
452
      call require_call_all_with_state(self%initialize_interior_state_job, self%root%links, domain_interior, source_initialize_state)
453 454
      call require_call_all_with_state(self%initialize_bottom_state_job, self%root%links, domain_bottom, source_initialize_bottom_state)
      call require_call_all_with_state(self%initialize_surface_state_job, self%root%links, domain_surface, source_initialize_surface_state)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
455
      call require_call_all_with_state(self%check_interior_state_job, self%root%links, domain_interior, source_check_state)
456 457 458 459
      call require_call_all_with_state(self%check_bottom_state_job, self%root%links, domain_bottom, source_check_bottom_state)
      call require_call_all_with_state(self%check_bottom_state_job, self%root%links, domain_interior, source_check_bottom_state)
      call require_call_all_with_state(self%check_surface_state_job, self%root%links, domain_surface, source_check_surface_state)
      call require_call_all_with_state(self%check_surface_state_job, self%root%links, domain_interior, source_check_surface_state)
460

461 462
      do ivar = 1, size(self%interior_state_variables)
         call self%check_interior_state_job%read_cache_loads%add(self%interior_state_variables(ivar)%target)
463 464 465 466 467 468 469 470
      end do
      do ivar = 1, size(self%bottom_state_variables)
         call self%check_bottom_state_job%read_cache_loads%add(self%bottom_state_variables(ivar)%target)
      end do
      do ivar = 1, size(self%surface_state_variables)
         call self%check_surface_state_job%read_cache_loads%add(self%surface_state_variables(ivar)%target)
      end do

471
      do ivar = 1, size(self%conserved_quantities)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
472
         call self%get_interior_conserved_quantities_job%request_variable(self%conserved_quantities(ivar)%target)
473
         call self%get_horizontal_conserved_quantities_job%request_variable(self%conserved_quantities(ivar)%target_hz)
474 475
         call self%conserved_quantities(ivar)%target%write_indices%append(self%conserved_quantities(ivar)%index)
         call self%conserved_quantities(ivar)%target_hz%write_indices%append(self%conserved_quantities(ivar)%horizontal_index)
476 477
      end do

Jorn Bruggeman's avatar
Jorn Bruggeman committed
478 479
      self%status = status_initialize_done
   end subroutine initialize
480

Jorn Bruggeman's avatar
Jorn Bruggeman committed
481 482 483 484
   ! --------------------------------------------------------------------------
   ! finalize: deallocate model object
   ! --------------------------------------------------------------------------
   subroutine finalize(self)
485
      class (type_fabm_model),target,intent(inout) :: self
Jorn Bruggeman's avatar
Jorn Bruggeman committed
486
      self%status = status_none
Jorn Bruggeman's avatar
Jorn Bruggeman committed
487

Jorn Bruggeman's avatar
Jorn Bruggeman committed
488
      ! TODO: this should deallocate the memory of all biogeochemical models
Jorn Bruggeman's avatar
Jorn Bruggeman committed
489
   end subroutine finalize
Jorn Bruggeman's avatar
Jorn Bruggeman committed
490

Jorn Bruggeman's avatar
Jorn Bruggeman committed
491 492 493 494
   ! --------------------------------------------------------------------------
   ! set_domain: set extents of spatial domain and optionally time step length
   ! --------------------------------------------------------------------------
   subroutine set_domain(self _POSTARG_LOCATION_, seconds_per_time_unit)
495
      class (type_fabm_model), target, intent(inout) :: self
Jorn Bruggeman's avatar
Jorn Bruggeman committed
496
      _DECLARE_ARGUMENTS_LOCATION_
497
      real(rke), optional, intent(in)    :: seconds_per_time_unit
Jorn Bruggeman's avatar
Jorn Bruggeman committed
498 499 500

      class (type_expression), pointer :: expression

Jorn Bruggeman's avatar
Jorn Bruggeman committed
501 502 503
      if (self%status < status_initialize_done) call fatal_error('set_domain', 'initialize has not yet been called on this model object.')
      if (self%status >= status_set_domain_done) call fatal_error('set_domain', 'set_domain has already been called on this model object.')
      self%status = status_set_domain_done
504

505
#if _FABM_DIMENSION_COUNT_>0
506 507 508
      self%domain%shape = (/_LOCATION_/)
      self%domain%start(:) = 1
      self%domain%stop = self%domain%shape
509
#endif
510
#if _HORIZONTAL_DIMENSION_COUNT_>0
511
      self%domain%horizontal_shape = (/_HORIZONTAL_LOCATION_/)
512 513
#endif

Jorn Bruggeman's avatar
Jorn Bruggeman committed
514 515 516 517 518 519
      if (present(seconds_per_time_unit)) then
         expression => self%root%first_expression
         do while (associated(expression))
            select type (expression)
            class is (type_interior_temporal_mean)
               expression%in = expression%link%target%catalog_index
Jorn Bruggeman's avatar
Jorn Bruggeman committed
520 521
               expression%period = expression%period / seconds_per_time_unit
               allocate(expression%history(_PREARG_LOCATION_ expression%n + 3))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
522 523
               expression%history = 0.0_rke
               call self%link_interior_data(expression%output_name, &
Jorn Bruggeman's avatar
Jorn Bruggeman committed
524
                                            expression%history(_PREARG_LOCATION_DIMENSIONS_ expression%n + 3))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
525 526
            class is (type_horizontal_temporal_mean)
               expression%in = expression%link%target%catalog_index
Jorn Bruggeman's avatar
Jorn Bruggeman committed
527 528
               expression%period = expression%period / seconds_per_time_unit
               allocate(expression%history(_PREARG_HORIZONTAL_LOCATION_ expression%n + 3))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
529 530
               expression%history = 0.0_rke
               call self%link_horizontal_data(expression%output_name, &
Jorn Bruggeman's avatar
Jorn Bruggeman committed
531
                                              expression%history(_PREARG_HORIZONTAL_LOCATION_DIMENSIONS_ expression%n + 3))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
532 533 534 535
            end select
            expression => expression%next
         end do
      end if
Jorn Bruggeman's avatar
Jorn Bruggeman committed
536
   end subroutine set_domain
Jorn Bruggeman's avatar
Jorn Bruggeman committed
537

538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566
#if _FABM_DIMENSION_COUNT_>0
   ! --------------------------------------------------------------------------
   ! set_domain_start: set start index of all spatial dimensions
   ! --------------------------------------------------------------------------
   ! This is optional; by default the start index for all dimensions is 1.
   ! --------------------------------------------------------------------------
   subroutine set_domain_start(self _POSTARG_LOCATION_)
      class (type_fabm_model), target, intent(inout) :: self
      _DECLARE_ARGUMENTS_LOCATION_
      if (self%status < status_set_domain_done) &
         call fatal_error('set_domain_start', 'set_domain has not yet been called on this model object.')
      self%domain%start(:) = (/_LOCATION_/)
   end subroutine set_domain_start

   ! --------------------------------------------------------------------------
   ! set_domain_stop: set stop index of all spatial dimensions (default=domain size)
   ! --------------------------------------------------------------------------
   ! This is optional; by default the stop index for all dimensions matches
   ! the domain size provided to set_domain.
   ! --------------------------------------------------------------------------
   subroutine set_domain_stop(self _POSTARG_LOCATION_)
      class (type_fabm_model), target, intent(inout) :: self
      _DECLARE_ARGUMENTS_LOCATION_
      if (self%status < status_set_domain_done) &
         call fatal_error('set_domain_stop', 'set_domain has not yet been called on this model object.')
      self%domain%stop(:) = (/_LOCATION_/)
   end subroutine set_domain_stop
#endif

Jorn Bruggeman's avatar
Jorn Bruggeman committed
567
#ifdef _HAS_MASK_
Jorn Bruggeman's avatar
Jorn Bruggeman committed
568 569 570 571 572 573
   ! --------------------------------------------------------------------------
   ! set_mask: provide spatial mask
   ! --------------------------------------------------------------------------
   ! As FABM will keep a pointer to the mask, it needs to remain valid for
   ! the lifetime of the model object.
   ! --------------------------------------------------------------------------
Jorn Bruggeman's avatar
Jorn Bruggeman committed
574
#  ifdef _FABM_HORIZONTAL_MASK_
Jorn Bruggeman's avatar
Jorn Bruggeman committed
575
   subroutine set_mask(self, mask_hz)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
576
#  else
Jorn Bruggeman's avatar
Jorn Bruggeman committed
577
   subroutine set_mask(self, mask, mask_hz)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
578
#  endif
Jorn Bruggeman's avatar
Jorn Bruggeman committed
579
      class (type_fabm_model), target, intent(inout)                      :: self
Jorn Bruggeman's avatar
Jorn Bruggeman committed
580
#  ifndef _FABM_HORIZONTAL_MASK_
Jorn Bruggeman's avatar
Jorn Bruggeman committed
581
      _FABM_MASK_TYPE_, target, intent(in) _ATTRIBUTES_GLOBAL_            :: mask
Jorn Bruggeman's avatar
Jorn Bruggeman committed
582
#  endif
Jorn Bruggeman's avatar
Jorn Bruggeman committed
583
      _FABM_MASK_TYPE_, target, intent(in) _ATTRIBUTES_GLOBAL_HORIZONTAL_ :: mask_hz
584

585
      integer :: i
586

Jorn Bruggeman's avatar
Jorn Bruggeman committed
587 588
      if (self%status < status_set_domain_done) &
         call fatal_error('set_mask', 'set_domain has not yet been called on this model object.')
Jorn Bruggeman's avatar
Jorn Bruggeman committed
589 590 591

#  ifndef _FABM_HORIZONTAL_MASK_
#    if !defined(NDEBUG)&&_FABM_DIMENSION_COUNT_>0
592 593
      do i = 1, size(self%domain%shape)
         if (size(mask, i) /= self%domain%shape(i)) &
Jorn Bruggeman's avatar
Jorn Bruggeman committed
594
            call fatal_error('set_mask', 'shape of provided mask does not match domain extents provided to set_domain.')
595
      end do
Jorn Bruggeman's avatar
Jorn Bruggeman committed
596
#    endif
597
      self%domain%mask => mask
Jorn Bruggeman's avatar
Jorn Bruggeman committed
598 599 600
#  endif

#  if !defined(NDEBUG)&&_HORIZONTAL_DIMENSION_COUNT_>0
601 602
      do i = 1, size(self%domain%horizontal_shape)
         if (size(mask_hz, i) /= self%domain%horizontal_shape(i)) &
Jorn Bruggeman's avatar
Jorn Bruggeman committed
603
            call fatal_error('set_mask', 'shape of provided horizontal mask does not match domain extents provided to set_domain.')
604
      end do
Jorn Bruggeman's avatar
Jorn Bruggeman committed
605
#  endif
606
      self%domain%mask_hz => mask_hz
607

Jorn Bruggeman's avatar
Jorn Bruggeman committed
608
   end subroutine set_mask
Jorn Bruggeman's avatar
Jorn Bruggeman committed
609
#endif
610

611
#if defined(_FABM_DEPTH_DIMENSION_INDEX_)&&_FABM_BOTTOM_INDEX_==-1
Jorn Bruggeman's avatar
Jorn Bruggeman committed
612
   ! --------------------------------------------------------------------------
Jorn Bruggeman's avatar
Jorn Bruggeman committed
613
   ! set_bottom_index: provide bottom indices for every horizontal point
Jorn Bruggeman's avatar
Jorn Bruggeman committed
614 615 616 617 618
   ! --------------------------------------------------------------------------
   ! As FABM will keep a pointer to the array with indices, it needs to remain
   ! valid for the lifetime of the model object.
   ! --------------------------------------------------------------------------
   subroutine set_bottom_index(self, indices)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
619 620
      class (type_fabm_model), intent(inout)                             :: self
      integer, target,         intent(in) _ATTRIBUTES_GLOBAL_HORIZONTAL_ :: indices
621 622 623

      integer :: i

Jorn Bruggeman's avatar
Jorn Bruggeman committed
624 625
      if (self%status < status_set_domain_done) &
         call fatal_error('set_bottom_index', 'set_domain has not yet been called on this model object.')
Jorn Bruggeman's avatar
Jorn Bruggeman committed
626
#    if !defined(NDEBUG)&&_HORIZONTAL_DIMENSION_COUNT_>0
627 628
      do i = 1, size(self%domain%horizontal_shape)
         if (size(indices, i) /= self%domain%horizontal_shape(i)) &
Jorn Bruggeman's avatar
Jorn Bruggeman committed
629
            call fatal_error('set_bottom_index', 'shape of provided index array does not match domain extents provided to set_domain.')
630
      end do
Jorn Bruggeman's avatar
Jorn Bruggeman committed
631
#    endif
Jorn Bruggeman's avatar
Jorn Bruggeman committed
632

633
      self%domain%bottom_indices => indices
Jorn Bruggeman's avatar
Jorn Bruggeman committed
634
   end subroutine set_bottom_index
635 636
#endif

Jorn Bruggeman's avatar
Jorn Bruggeman committed
637 638 639
   ! --------------------------------------------------------------------------
   ! start: prepare for simulation start
   ! --------------------------------------------------------------------------
Jorn Bruggeman's avatar
Jorn Bruggeman committed
640
   ! This tells FABM that the user/host have finished providing (or overriding)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
641
   ! data (link_data procedures) and have finished flagging diagnostics for
642
   ! output (by setting the "save" flag that is part of the variable metadata)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
643 644
   ! --------------------------------------------------------------------------
   subroutine start(self)
645
      class (type_fabm_model), intent(inout), target :: self
Jorn Bruggeman's avatar
Jorn Bruggeman committed
646 647 648 649 650 651 652 653

      integer                           :: ivar
      logical                           :: ready
      type (type_variable_set)          :: unfulfilled_dependencies
      type (type_variable_node),pointer :: variable_node
      type (type_link), pointer         :: link
      character(len=*), parameter       :: log_prefix = 'fabm_'
      integer                           :: log_unit, ios
654

655
      if (self%status < status_set_domain_done) then
Jorn Bruggeman's avatar
Jorn Bruggeman committed
656
         call fatal_error('start', 'set_domain has not yet been called on this model object.')
657
         return
658
      elseif (self%status >= status_start_done) then
659 660 661
         ! start has been called on this model before and it must have succeeded to have this status. We are done.
         return
      end if
Jorn Bruggeman's avatar
Jorn Bruggeman committed
662 663

      ready = .true.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
664

665
#ifdef _HAS_MASK_
666
#  ifndef _FABM_HORIZONTAL_MASK_
667
      if (.not. associated(self%domain%mask)) then
Jorn Bruggeman's avatar
Jorn Bruggeman committed
668 669 670
         call log_message('spatial mask has not been set. Make sure to call set_mask.')
         ready = .false.
      end if
671
#  endif
672
      if (.not. associated(self%domain%mask_hz)) then
Jorn Bruggeman's avatar
Jorn Bruggeman committed
673 674 675
         call log_message('horizontal spatial mask has not been set. Make sure to call set_mask.')
         ready = .false.
      end if
676 677 678
#endif

#ifdef _FABM_DEPTH_DIMENSION_INDEX_
679
#  if _FABM_BOTTOM_INDEX_==-1
680
      if (.not. associated(self%domain%bottom_indices)) then
Jorn Bruggeman's avatar
Jorn Bruggeman committed
681 682 683
         call log_message('bottom indices have not been set. Make sure to call set_bottom_index.')
         ready = .false.
      end if
684
#  endif
Jorn Bruggeman's avatar
Jorn Bruggeman committed
685 686
#endif

Jorn Bruggeman's avatar
Jorn Bruggeman committed
687
      ! Flag variables that have had data asssigned (by user, host or FABM).
688
      ! This is done only now because the user/host had till this moment to provide (or override) model fields.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
689 690 691 692 693
      call flag_variables_with_data(self%variable_register%catalog%interior, self%catalog%interior_sources)
      call flag_variables_with_data(self%variable_register%catalog%horizontal, self%catalog%horizontal_sources)
      call flag_variables_with_data(self%variable_register%catalog%scalar, self%catalog%scalar_sources)

      ! Create job that ensures all diagnostics required by the user are computed.
694
      ! This is done only now because the user/host had till this moment to change the "save" flag of each diagnostic.
695 696 697
      do ivar = 1, size(self%interior_diagnostic_variables)
         if (self%interior_diagnostic_variables(ivar)%save) then
            select case (self%interior_diagnostic_variables(ivar)%target%source)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
698
            case (source_check_state)
699
               call self%check_interior_state_job%request_variable(self%interior_diagnostic_variables(ivar)%target, store=.true.)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
700
            case (source_get_vertical_movement)
701
               call self%get_vertical_movement_job%request_variable(self%interior_diagnostic_variables(ivar)%target, store=.true.)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
702
            case default
703
               call self%finalize_outputs_job%request_variable(self%interior_diagnostic_variables(ivar)%target, store=.true.)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
704 705 706 707 708
            end select
         end if
      end do
      do ivar = 1, size(self%horizontal_diagnostic_variables)
         if (self%horizontal_diagnostic_variables(ivar)%save) &
Jorn Bruggeman's avatar
Jorn Bruggeman committed
709
            call self%finalize_outputs_job%request_variable(self%horizontal_diagnostic_variables(ivar)%target, store=.true.)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
710
      end do
711

712
      log_unit = -1
Jorn Bruggeman's avatar
Jorn Bruggeman committed
713
      if (self%log) log_unit = get_free_unit()
714

Jorn Bruggeman's avatar
Jorn Bruggeman committed
715 716 717
      ! Merge write indices when operations can be done in place
      ! This must be done after all variables are requested from the different jobs, so we know which variables
      ! will be retrieved (such variables cannot be merged)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
718
      if (self%log) then
719 720 721 722 723 724 725
         open(unit=log_unit, file=log_prefix // 'merges.log', action='write', status='replace', iostat=ios)
         if (ios /= 0) call fatal_error('start', 'Unable to open ' // log_prefix // 'merges.log')
         call merge_indices(self%root, log_unit)
         close(log_unit)
      else
         call merge_indices(self%root)
      end if
726

Jorn Bruggeman's avatar
Jorn Bruggeman committed
727
      ! Initialize all jobs. This also creates registers for the read and write caches, as well as the persistent store.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
728
      if (self%log) then
729 730 731 732
         open(unit=log_unit, file=log_prefix // 'task_order.log', action='write', status='replace', iostat=ios)
         if (ios /= 0) call fatal_error('start', 'Unable to open ' // log_prefix // 'task_order.log')
      end if
      call self%job_manager%initialize(self%variable_register, self%schedules, unfulfilled_dependencies, log_unit)
733 734 735 736 737 738 739
      if (self%log) then
         close(log_unit)
         open(unit=log_unit, file=log_prefix // 'graph.gv', action='write', status='replace', iostat=ios)
         if (ios /= 0) call fatal_error('start', 'Unable to open ' // log_prefix // 'graph.gv')
         call self%job_manager%write_graph(log_unit)
         close(log_unit)
      end if
740

Jorn Bruggeman's avatar
Jorn Bruggeman committed
741 742
      ! Create persistent store. This provides memory for all variables to be stored there.
      call create_store(self)
743

744 745
      ! Collect fill values and missing values for cache entries.
      self%cache_fill_values = get_cache_fill_values(self%variable_register)
746

747