fabm.F90 141 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
   public type_fabm_variable_id
   public type_fabm_interior_variable_id
   public type_fabm_horizontal_variable_id
   public type_fabm_scalar_variable_id
51 52
   public type_fabm_variable, type_fabm_interior_state_variable, type_fabm_horizontal_state_variable, &
      type_fabm_interior_diagnostic_variable, type_fabm_horizontal_diagnostic_variable
53 54 55

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

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

Jorn Bruggeman's avatar
Jorn Bruggeman committed
63 64 65 66 67 68
   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
69 70 71
   ! --------------------------------------------------------------------------
   ! Derived typed for variable identifiers
   ! --------------------------------------------------------------------------
72

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

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

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

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

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

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

Jorn Bruggeman's avatar
Jorn Bruggeman committed
106
   ! Derived type for interior state variable metadata
107
   type, extends(type_fabm_variable) :: type_fabm_interior_state_variable
Jorn Bruggeman's avatar
Jorn Bruggeman committed
108 109 110 111
      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.
112
   end type
113

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

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

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

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

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

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

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

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

Jorn Bruggeman's avatar
Jorn Bruggeman committed
177 178 179
      ! Root container of biogeochemical modules
      type (type_base_model) :: root

Jorn Bruggeman's avatar
Jorn Bruggeman committed
180
      integer :: status = status_none
Jorn Bruggeman's avatar
Jorn Bruggeman committed
181
      logical :: log = .false.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
182 183 184 185 186 187 188 189

      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
190
      type (type_domain)                   :: domain
191

Jorn Bruggeman's avatar
Jorn Bruggeman committed
192
      ! Memory caches for exchanging information with individual biogeochemical modules
193 194 195
      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
196 197

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

Jorn Bruggeman's avatar
Jorn Bruggeman committed
215 216 217
      procedure :: initialize_interior_state
      procedure :: initialize_bottom_state
      procedure :: initialize_surface_state
218

Jorn Bruggeman's avatar
Jorn Bruggeman committed
219 220 221
      procedure :: check_interior_state
      procedure :: check_bottom_state
      procedure :: check_surface_state
222

223 224 225
      procedure :: prepare_inputs1
      procedure :: prepare_inputs2
      generic :: prepare_inputs => prepare_inputs1, prepare_inputs2
226
      procedure :: finalize_outputs
227

Jorn Bruggeman's avatar
Jorn Bruggeman committed
228 229
      procedure :: get_interior_sources_rhs
      procedure :: get_interior_sources_ppdd
Jorn Bruggeman's avatar
Jorn Bruggeman committed
230
      generic :: get_interior_sources => get_interior_sources_rhs, get_interior_sources_ppdd
Jorn Bruggeman's avatar
Jorn Bruggeman committed
231 232
      procedure :: get_bottom_sources_rhs
      procedure :: get_bottom_sources_ppdd
Jorn Bruggeman's avatar
Jorn Bruggeman committed
233
      generic :: get_bottom_sources => get_bottom_sources_rhs, get_bottom_sources_ppdd
Jorn Bruggeman's avatar
Jorn Bruggeman committed
234 235 236 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
      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
266
      generic :: require_data => require_interior_data, require_horizontal_data
267

Jorn Bruggeman's avatar
Jorn Bruggeman committed
268 269 270
      procedure :: get_interior_data
      procedure :: get_horizontal_data
      procedure :: get_scalar_data
271
      generic :: get_data => get_interior_data, get_horizontal_data, get_scalar_data
Jorn Bruggeman's avatar
Jorn Bruggeman committed
272

Jorn Bruggeman's avatar
Jorn Bruggeman committed
273 274
      procedure :: get_interior_diagnostic_data
      procedure :: get_horizontal_diagnostic_data
275

276 277 278
      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
279

Jorn Bruggeman's avatar
Jorn Bruggeman committed
280 281
      procedure :: get_horizontal_variable_id_by_name
      procedure :: get_horizontal_variable_id_sn
282 283
      generic :: get_horizontal_variable_id => get_horizontal_variable_id_by_name, get_horizontal_variable_id_sn

Jorn Bruggeman's avatar
Jorn Bruggeman committed
284 285
      procedure :: get_scalar_variable_id_by_name
      procedure :: get_scalar_variable_id_sn
286
      generic :: get_scalar_variable_id => get_scalar_variable_id_by_name, get_scalar_variable_id_sn
287

Jorn Bruggeman's avatar
Jorn Bruggeman committed
288
      procedure, nopass :: is_variable_used
289
      procedure :: get_variable_name
290

Jorn Bruggeman's avatar
Jorn Bruggeman committed
291 292 293 294 295 296
      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
297
      generic :: variable_needs_values => interior_variable_needs_values, interior_variable_needs_values_sn, &
298 299
                                          horizontal_variable_needs_values, horizontal_variable_needs_values_sn, &
                                          scalar_variable_needs_values, scalar_variable_needs_values_sn
300

Jorn Bruggeman's avatar
Jorn Bruggeman committed
301
      procedure :: process_job
Jorn Bruggeman's avatar
Jorn Bruggeman committed
302 303
      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
304
      procedure :: process_job_everywhere
Jorn Bruggeman's avatar
Jorn Bruggeman committed
305 306 307
      generic :: process => process_job_everywhere
#endif

308
   end type type_fabm_model
309

Jorn Bruggeman's avatar
Jorn Bruggeman committed
310
contains
311

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

321
      ! Do nothing if already initialized.
322
      if (associated(factory)) return
323 324

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

      ! Create all standard variable objects.
      call initialize_standard_variables()

      ! Create the model factory.
331
      factory => fabm_model_factory
332
      call factory%initialize()
333 334
   end subroutine fabm_initialize_library

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

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

Jorn Bruggeman's avatar
Jorn Bruggeman committed
343
      type (type_version), pointer :: version
344

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

354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369
   ! --------------------------------------------------------------------------
   ! 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)
370
      call fabm_configure_model(model%root, model%schedules, model%log, path, parameters=parameters, unit=unit)
371 372 373 374 375 376 377

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

Jorn Bruggeman's avatar
Jorn Bruggeman committed
378 379 380 381 382 383 384 385
   ! --------------------------------------------------------------------------
   ! 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)
386
      class (type_fabm_model), target, intent(inout) :: self
Jorn Bruggeman's avatar
Jorn Bruggeman committed
387 388 389 390 391

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

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

395
      ! Create zero fields.
396 397
      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)
398

399 400 401 402
      ! 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
403
      ! This will resolve all FABM dependencies and generate final authoritative lists of variables of different types.
Jorn Bruggeman's avatar
Jorn Bruggeman committed
404 405
      call freeze_model_info(self%root)

406 407 408 409
      ! 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
410 411
            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.')
412 413 414 415
         end if
         property => property%next
      end do

Jorn Bruggeman's avatar
Jorn Bruggeman committed
416
      ! Build final authoritative arrays with variable metadata.
417 418
      call classify_variables(self)

419 420 421
      ! Create catalog for storing pointers to data per variable.
      call create_catalog(self)

422 423
      ! 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
424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446
      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)
447
      call require_flux_computation(self%get_vertical_movement_job, self%links_postcoupling, domain_interior + 999)
448

Jorn Bruggeman's avatar
Jorn Bruggeman committed
449
      call require_call_all_with_state(self%initialize_interior_state_job, self%root%links, domain_interior, source_initialize_state)
450 451
      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
452
      call require_call_all_with_state(self%check_interior_state_job, self%root%links, domain_interior, source_check_state)
453 454 455 456
      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)
457

458 459
      do ivar = 1, size(self%interior_state_variables)
         call self%check_interior_state_job%read_cache_loads%add(self%interior_state_variables(ivar)%target)
460 461 462 463 464 465 466 467
      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

468
      do ivar = 1, size(self%conserved_quantities)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
469
         call self%get_interior_conserved_quantities_job%request_variable(self%conserved_quantities(ivar)%target)
470
         call self%get_horizontal_conserved_quantities_job%request_variable(self%conserved_quantities(ivar)%target_hz)
471 472
         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)
473 474
      end do

Jorn Bruggeman's avatar
Jorn Bruggeman committed
475 476
      self%status = status_initialize_done
   end subroutine initialize
477

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

Jorn Bruggeman's avatar
Jorn Bruggeman committed
485
      ! TODO: this should deallocate the memory of all biogeochemical models
Jorn Bruggeman's avatar
Jorn Bruggeman committed
486
   end subroutine finalize
Jorn Bruggeman's avatar
Jorn Bruggeman committed
487

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

      class (type_expression), pointer :: expression

Jorn Bruggeman's avatar
Jorn Bruggeman committed
498 499 500
      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
501

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

Jorn Bruggeman's avatar
Jorn Bruggeman committed
511 512 513 514 515 516
      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
517 518
               expression%period = expression%period / seconds_per_time_unit
               allocate(expression%history(_PREARG_LOCATION_ expression%n + 3))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
519 520
               expression%history = 0.0_rke
               call self%link_interior_data(expression%output_name, &
Jorn Bruggeman's avatar
Jorn Bruggeman committed
521
                                            expression%history(_PREARG_LOCATION_DIMENSIONS_ expression%n + 3))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
522 523
            class is (type_horizontal_temporal_mean)
               expression%in = expression%link%target%catalog_index
Jorn Bruggeman's avatar
Jorn Bruggeman committed
524 525
               expression%period = expression%period / seconds_per_time_unit
               allocate(expression%history(_PREARG_HORIZONTAL_LOCATION_ expression%n + 3))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
526 527
               expression%history = 0.0_rke
               call self%link_horizontal_data(expression%output_name, &
Jorn Bruggeman's avatar
Jorn Bruggeman committed
528
                                              expression%history(_PREARG_HORIZONTAL_LOCATION_DIMENSIONS_ expression%n + 3))
Jorn Bruggeman's avatar
Jorn Bruggeman committed
529 530 531 532
            end select
            expression => expression%next
         end do
      end if
Jorn Bruggeman's avatar
Jorn Bruggeman committed
533
   end subroutine set_domain
Jorn Bruggeman's avatar
Jorn Bruggeman committed
534

535 536 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
#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
564
#ifdef _HAS_MASK_
Jorn Bruggeman's avatar
Jorn Bruggeman committed
565 566 567 568 569 570
   ! --------------------------------------------------------------------------
   ! 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
571
#  ifdef _FABM_HORIZONTAL_MASK_
Jorn Bruggeman's avatar
Jorn Bruggeman committed
572
   subroutine set_mask(self, mask_hz)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
573
#  else
Jorn Bruggeman's avatar
Jorn Bruggeman committed
574
   subroutine set_mask(self, mask, mask_hz)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
575
#  endif
Jorn Bruggeman's avatar
Jorn Bruggeman committed
576
      class (type_fabm_model), target, intent(inout)                      :: self
Jorn Bruggeman's avatar
Jorn Bruggeman committed
577
#  ifndef _FABM_HORIZONTAL_MASK_
Jorn Bruggeman's avatar
Jorn Bruggeman committed
578
      _FABM_MASK_TYPE_, target, intent(in) _ATTRIBUTES_GLOBAL_            :: mask
Jorn Bruggeman's avatar
Jorn Bruggeman committed
579
#  endif
Jorn Bruggeman's avatar
Jorn Bruggeman committed
580
      _FABM_MASK_TYPE_, target, intent(in) _ATTRIBUTES_GLOBAL_HORIZONTAL_ :: mask_hz
581

582
      integer :: i
583

Jorn Bruggeman's avatar
Jorn Bruggeman committed
584 585
      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
586 587 588

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

#  if !defined(NDEBUG)&&_HORIZONTAL_DIMENSION_COUNT_>0
598 599
      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
600
            call fatal_error('set_mask', 'shape of provided horizontal mask does not match domain extents provided to set_domain.')
601
      end do
Jorn Bruggeman's avatar
Jorn Bruggeman committed
602
#  endif
603
      self%domain%mask_hz => mask_hz
604

Jorn Bruggeman's avatar
Jorn Bruggeman committed
605
   end subroutine set_mask
Jorn Bruggeman's avatar
Jorn Bruggeman committed
606
#endif
607

608
#if defined(_FABM_DEPTH_DIMENSION_INDEX_)&&_FABM_BOTTOM_INDEX_==-1
Jorn Bruggeman's avatar
Jorn Bruggeman committed
609
   ! --------------------------------------------------------------------------
Jorn Bruggeman's avatar
Jorn Bruggeman committed
610
   ! set_bottom_index: provide bottom indices for every horizontal point
Jorn Bruggeman's avatar
Jorn Bruggeman committed
611 612 613 614 615
   ! --------------------------------------------------------------------------
   ! 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
616 617
      class (type_fabm_model), intent(inout)                             :: self
      integer, target,         intent(in) _ATTRIBUTES_GLOBAL_HORIZONTAL_ :: indices
618 619 620

      integer :: i

Jorn Bruggeman's avatar
Jorn Bruggeman committed
621 622
      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
623
#    if !defined(NDEBUG)&&_HORIZONTAL_DIMENSION_COUNT_>0
624 625
      do i = 1, size(self%domain%horizontal_shape)
         if (size(indices, i) /= self%domain%horizontal_shape(i)) &
Jorn Bruggeman's avatar
Jorn Bruggeman committed
626
            call fatal_error('set_bottom_index', 'shape of provided index array does not match domain extents provided to set_domain.')
627
      end do
Jorn Bruggeman's avatar
Jorn Bruggeman committed
628
#    endif
Jorn Bruggeman's avatar
Jorn Bruggeman committed
629

630
      self%domain%bottom_indices => indices
Jorn Bruggeman's avatar
Jorn Bruggeman committed
631
   end subroutine set_bottom_index
632 633
#endif

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

      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
651

652
      if (self%status < status_set_domain_done) then
Jorn Bruggeman's avatar
Jorn Bruggeman committed
653
         call fatal_error('start', 'set_domain has not yet been called on this model object.')
654
         return
655
      elseif (self%status >= status_start_done) then
656 657 658
         ! 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
659 660

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

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

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

Jorn Bruggeman's avatar
Jorn Bruggeman committed
684
      ! Flag variables that have had data asssigned (by user, host or FABM).
685
      ! 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
686 687 688 689 690
      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.
691
      ! This is done only now because the user/host had till this moment to change the "save" flag of each diagnostic.
692 693 694
      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
695
            case (source_check_state)
696
               call self%check_interior_state_job%request_variable(self%interior_diagnostic_variables(ivar)%target, store=.true.)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
697
            case (source_get_vertical_movement)
698
               call self%get_vertical_movement_job%request_variable(self%interior_diagnostic_variables(ivar)%target, store=.true.)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
699
            case default
700
               call self%finalize_outputs_job%request_variable(self%interior_diagnostic_variables(ivar)%target, store=.true.)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
701 702 703 704 705
            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
706
            call self%finalize_outputs_job%request_variable(self%horizontal_diagnostic_variables(ivar)%target, store=.true.)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
707
      end do
708

709
      log_unit = -1
Jorn Bruggeman's avatar
Jorn Bruggeman committed
710
      if (self%log) log_unit = get_free_unit()
711

Jorn Bruggeman's avatar
Jorn Bruggeman committed
712 713 714
      ! 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
715
      if (self%log) then
716 717 718 719 720 721 722
         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
723

Jorn Bruggeman's avatar
Jorn Bruggeman committed
724
      ! 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
725
      if (self%log) then
726 727 728 729
         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)
730 731 732 733 734 735 736
      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
737

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

741 742
      ! Collect fill values and missing values for cache entries.
      self%cache_fill_values = get_cache_fill_values(self%variable_register)
743

744
      ! Create global caches for exchanging information with BGC models.