-
Notifications
You must be signed in to change notification settings - Fork 0
/
m_body.f90
2167 lines (1875 loc) · 108 KB
/
m_body.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
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
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
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
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
!> @file m_body.f90
!! The Body condition and architecture of the AHA Model.
!! @author Sergey Budaev <sergey.budaev@uib.no>
!! @author Jarl Giske <jarl.giske@uib.no>
!! @date 2016-2017
!-------------------------------------------------------------------------------
! $Id$
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!> @brief Definition the physical properties and condition of the agent
!> @section the_genome_module THE_BODY module
!> This module defines various physical properties of the agent, such as the
!! body size, body mass etc, as well as the condition and basic physiological
!! variables.
!! @note Note that the agent has the size property but is nonetheless
!! represented as a single commondata::spatial point for simplicity.
module THE_BODY
use COMMONDATA
use THE_ENVIRONMENT
use THE_HORMONES
implicit none
character (len=*), parameter, private :: MODNAME = "(THE_CONDITION)"
!> `CONDITION` defines the physical condition of the agent
type, public, extends(HORMONES) :: CONDITION
!> The age of the agent in units of the integer time steps.
integer :: age
!> Current energy reserves, initialised non-genetically, Gaussian.
real(SRP) :: energy_current
!> Maximum historical energy reserves.
real(SRP) :: energy_maximum
!> Energy reserves at birth, non-genetic, Gaussian.
real(SRP) :: energy_birth
!> current body length, initialised non-genetically, Gaussian, will grow.
real(SRP) :: body_length
!> History stack for the body length.
real(SRP), dimension(HISTORY_SIZE_AGENT_PROP) :: body_length_history
!> Body length at birth (genetically fixed), it is not used so far in the
!! calculations but is recorded and can be output.
real(SRP) :: body_length_birth
!> This is a **control unselected** (and unused) trait that is set from
!! the genome as normal but is not used in any calculations. It can be
!! used as a control marker for random genetic drift.
real(SRP) :: control_unselected
!> Current body mass, initialised calculated from length and energy
!! reserves.
real(SRP) :: body_mass
!> History stack for body mass.
real(SRP), dimension(HISTORY_SIZE_AGENT_PROP) :: body_mass_history
!> Body mass at birth, will keep record of it.
real(SRP) :: body_mass_birth
!> Maximum historically body, will keep record of it.
real(SRP) :: body_mass_maximum
!> Standard metabolitic rate, can change depending on hormones and
!! psychological state (GOS)), at birth initialised from the genome.
real(SRP) :: smr
!> Maximum stomach capacity, max. fraction of body mass available for food
!! here set from default value. But can change in future versions of the
!! model depending on the body length and the physiological state (so
!! specifically set for each agent rather than defined from global
!! parameter commondata::max_stomach_capacity_def).
!! @note In the old model the stomach content cannot surpass
!! maxstomcap=15% of agent's body mass.
real(SRP) :: maxstomcap = MAX_STOMACH_CAPACITY_DEF
!> Stomach content mass.
real(SRP) :: stomach_content_mass
! @warning The functions defining the growth is a quick and dirty
! solution.
contains
private
!> Initialise the individual body condition object based on the
!! genome values.
!! See `the_body::condition_init_genotype()`
procedure, public :: init_condition => condition_init_genotype
!> This procedure enforces selective mortality of agents at birth.
!! See `the_body::birth_mortality_enforce_init_fixed_debug()`.
procedure, public :: mortality_birth => &
birth_mortality_enforce_init_fixed_debug
!> Cleanup the history stack of the body length and mass.
!! See `the_body::condition_clean_history()`
procedure, public :: body_history_clean => condition_clean_history
!> Get current age.
!! See `the_body::condition_age_get()`
procedure, public :: get_age => condition_age_get
!> Reset the age of the agent to zero.
!! See `the_body::condition_age_reset_zero()`.
procedure, public :: age_reset => condition_age_reset_zero
!> Get current energy reserves.
!! See `the_body::condition_energy_current_get()`
procedure, public :: get_energy => condition_energy_current_get
!> Get historical maximum of energy reserves.
!! See `the_body::condition_energy_maximum_get()`
procedure, public :: get_energy_max => condition_energy_maximum_get
!> Get current body length.
!! See `the_body::condition_body_length_get()`
procedure, public :: get_length => condition_body_length_get
!> Generic interface (alias) for `get_length`.
generic, public :: length => get_length
!> Get current value of the control unselected trait.
!! See `the_body:condition_control_unsel_get:()`
procedure, public :: get_control_unselected => condition_control_unsel_get
!> Get current body mass.
!! See `the_body::condition_body_mass_get()`
procedure, public :: get_mass => condition_body_mass_get
!> Generic interface to get_mass.
generic, public :: mass => get_mass
!> Get historical record of energy reserves at birth.
!! See `the_body::condition_energy_birth_get()`.
procedure, public :: get_energ_birth => condition_energy_birth_get
!> Get historical record of body length at birth.
!! See `the_body::condition_body_length_birth_get()`
procedure, public :: get_length_birth => condition_body_length_birth_get
!> Get historical record of body mass at birth.
!! See `the_body::condition_body_mass_birth_get()`
procedure, public :: get_mass_birth => condition_body_mass_birth_get
!> Get historcal maximum for body mass.
!! See `the_body::condition_body_mass_max_get()`
procedure, public :: get_mass_max => condition_body_mass_max_get
!> Get current smr.
!! See `the_body::condition_smr_get()`
procedure, public :: get_smr => condition_smr_get
!> Get current stomach content.
!! See `the_body::condition_stomach_content_get()`
procedure, public :: get_stom_content => condition_stomach_content_get
!> Increment the age of the agent by one.
!! See `the_body::condition_age_increment()`.
procedure, public :: age_increment => condition_age_increment
!> Set body mass optionally updating the history stack.
!! See `the_body::condition_body_mass_set_update_hist()`
procedure, public :: set_mass => condition_body_mass_set_update_hist
!> Set body length optionally updating the history stack.
!! See `the_body::condition_body_length_set_update_hist()`
procedure, public :: set_length => condition_body_length_set_update_hist
!> Calculate the visibility range of this agent. Visibility depends on
!! the size of the agent, ambient illumination and agent contrast.
!! Visibility is the distance from which this agent can be seen by a
!! visual object (e.g. predator or conspecific).
!! See `the_body::condition_agent_visibility_visual_range`.
procedure, public :: visibility => condition_agent_visibility_visual_range
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! @note `food_process_cost` can be calculated several times per time step.
!> Calculate the basic processing cost of catching a food item
!! with the mass `food_gain`. Vector-based procedure.
!! See `the_body::body_mass_processing_cost_calc_v()`
procedure, public :: food_proc_cost_v => body_mass_processing_cost_calc_v
!> Calculate the basic processing cost of catching a food item
!! with the mass `food_gain`. Object-based procedure.
!! See `the_body::body_mass_processing_cost_calc_o()`
procedure, public :: food_proc_cost_o => body_mass_processing_cost_calc_o
!> Generic interface to the procedures calculating the basic
!! processing cost of catching a food item.
generic, public :: food_process_cost => food_proc_cost_v, &
food_proc_cost_o
!> Calculate the value of possible food gain as fitting into the agent's
!! stomach (or full gain if the food item fits wholly). Vector-based.
!! See `the_body::stomach_content_food_gain_fitting_v()`
procedure, public :: food_fitt_v => stomach_content_food_gain_fitting_v
!> Calculate the value of possible food gain as fitting into the agent's
!! stomach (or full gain if the food item fits wholly). Object-based.
!! See `the_body::stomach_content_food_gain_fitting_o()`
procedure, public :: food_fitt_o => stomach_content_food_gain_fitting_o
!> Generic interface to procedures that calculate the value of
!! possible food gain as fitting into the agent's stomach (or
!! full gain if the food item fits wholly).
!! See `the_body::stomach_content_food_gain_fitting_v()` and
!! `the_body::stomach_content_food_gain_fitting_o()`.
generic, public :: food_fitting => food_fitt_v, food_fitt_o
!> Calculate extra food surplus mass non fitting into the stomach of the
!! agent. Vector-based.
!! See `the_body::stomach_content_food_gain_non_fit_v()`
procedure, public :: food_surpl_v => stomach_content_food_gain_non_fit_v
!> Calculate extra food surplus mass non fitting into the stomach of the
!! agent. Object-based.
!! See `the_body::stomach_content_food_gain_non_fit_o()`
procedure, public :: food_surpl_o => stomach_content_food_gain_non_fit_o
!> Generic interface to procedures that calculate extra food surplus
!! mass non fitting into the stomach of the agent.
generic, public :: food_surplus => food_surpl_v, food_surpl_o
!> Do grow body mass based on food gain from a single food item adjusted
!! for cost etc.
!! See `the_body::body_mass_grow_do_calculate()`
procedure, public :: mass_grow => body_mass_grow_do_calculate
!> Do increment stomach contents with adjusted (fitted) value.
!! See `the_body::stomach_content_get_increment()`
procedure, public :: stomach_increment => stomach_content_get_increment
!> The fraction of the cost of the processing of the food item(s)
!! depending on the agent SMR. It is scaled in terms of the ratio of
!! the food item mass to the agent mass.
!! See `the_body::body_mass_food_processing_cost_factor_smr()`
procedure, public :: cost_factor_food_smr => &
body_mass_food_processing_cost_factor_smr
!> The cost of swimming of a specific distance in terms of body mass loss.
!! See `the_body::condition_cost_swimming_burst()`
procedure, public :: cost_swim => condition_cost_swimming_burst
!> The standard cost of swimming is a diagnostic function that shows
!! the cost, in units of the body mass, incurred if the agent passes a
!! distance equal to commondata::lifespan units of its body length.
!! See `the_body::cost_swimming_standard()`.
procedure, public :: cost_swim_std => cost_swimming_standard
!> Update the energy reserves of the agent based on its current mass and
!! length.
!! See `the_body::condition_energy_update_after_growth()`
procedure, public :: energy_update => condition_energy_update_after_growth
!> Check if the body mass is smaller than the birth body mass or
!! structural body mass.
!! See `the_body::body_mass_is_starvation_check()`
procedure, public :: starved_death => body_mass_is_starvation_check
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! @note Procedures that are calculated at the end of the time step
! of the model.
!> Calculate the cost of living for a single model step.
!! See `the_body::body_mass_calculate_cost_living_step()`
procedure, public :: living_cost => body_mass_calculate_cost_living_step
!> Adjust the body mass at the end of the model step against the
!! cost of living.
!! See `the_body::body_mass_adjust_living_cost_step()`
procedure, public :: subtract_living_cost => body_mass_adjust_living_cost_step
!> Calculate body length increment.
!! See `the_body::body_len_grow_calculate_increment_step()`
procedure, public :: len_incr => body_len_grow_calculate_increment_step
!> Do linear growth for one model step based on the above
!! increment function.
!! See `the_body::body_len_grow_do_calculate_step()`
procedure, public :: len_grow => body_len_grow_do_calculate_step
!> Do digestion. Stomach contents S(t) is emptied by a constant fraction
!! each time step. See details in the `stomach_content_mass_emptify_step`
!! function call.
!! See `the_body::stomach_content_mass_emptify_step()`
procedure, public :: stomach_empify => stomach_content_mass_emptify_step
!> Update the level of the sex steroids. Sex steroids are incremented
!! each time step of the model.
!! See `the_body::sex_steroids_update_increment()`
procedure, public :: sex_steroids_update => sex_steroids_update_increment
end type CONDITION
!> `REPRODUCTION` type defines parameters of the reproduction system.
type, public, extends(CONDITION) :: REPRODUCTION
!> Total number of reproductions during the lifespan.
integer :: n_reproductions
!> Total number of offspring reproduced during the lifespan.
integer :: n_offspring
contains
!> Init reproduction class.
!! See `the_body::reproduction_init_zero()`.
procedure, public :: init_reproduction => reproduction_init_zero
!> Determine if the agent's hormonal system is ready for reproduction
!! See `the_body::reproduction_ready_steroid_hormones_exceed()`.
procedure, public :: is_ready_reproduce => &
reproduction_ready_steroid_hormones_exceed
!> Get the number of reproductions for this agent.
!! See `the_body::reproduction_n_reproductions_get()`.
procedure, public :: get_reproductions => reproduction_n_reproductions_get
!> Set the number of reproductions for the agent.
!! See `the_body::reproduction_n_reproductions_set()`.
procedure, public :: reproductions_set => reproduction_n_reproductions_set
!> Get the number of offspring for this agent for its lifespan.
!! See `the_body::reproduction_n_offspring_get()`.
procedure, public :: get_offspring => reproduction_n_offspring_get
!> Set the number of offspring this agent had during its lifespan.
!! See `the_body::reproduction_n_offspring_set()`.
procedure, public :: offspring_set => reproduction_n_offspring_set
!> Increment the number of reproductions and offspring for the agent.
!! See `the_body::reproduction_n_increment()`.
procedure, public :: reproductions_increment => reproduction_n_increment
!> Calculate the number of offspring per a single reproduction.
!! See `the_body::reproduction_n_offspring_calc()`.
procedure, public :: offspring_number => reproduction_n_offspring_calc
!> Calculate the total mass of all offspring per single reproduction.
!! See `the_body::reproduction_mass_offspring_calc()`.
procedure, public :: offspring_mass => reproduction_mass_offspring_calc
!> Calculate the energetic cost of reproduction.
!! @note Two versions are implemented:
!! - `the_body::reproduction_cost_energy_fix()`
!! - `the_body::reproduction_cost_energy_dynamic()`
!! .
procedure, public :: reproduction_cost => reproduction_cost_energy_dynamic
!> Calculate the costs of unsuccessful reproduction. This is calculated
!! as a fraction of the normal cost of reproduction returned by the
!! function `reproduction::reproduction_cost()`.
!! See `the_body::reproduction_cost_unsuccessful_calc()`.
procedure, public :: reproduction_cost_unsuccess => &
reproduction_cost_unsuccessful_calc
end type REPRODUCTION
contains ! ........ implementation of procedures for this level ................
!> This is the function to calculate the body weight from the length and
!! the Fulton condition factor (energy reserves).
!! @param[in] k, l condition and body length.
!! @returns Body mass.
elemental function length2mass(k, l) result (body_mass)
real(SRP), intent(in) :: k, l
real(SRP) :: body_mass
!> ### Implementation details ###
!! Body mass is non-genetic, length and initial condition factor are
!! genetically determined. Body mass is calculated initially from
!! the Fulton'scondition factor formula @f[ K=\frac{M}{L^{3}} , @f]
!! i.e. @f[ M=K L^{3} . @f] The exponent can be non-cube for
!! non-isometric growth.
!! @note The "cube law" exponent (3.0 normally), might be redefined here
!! as the LINEAR_GROWTH_EXPONENT parameter constant.
real(SRP), parameter :: B = LINEAR_GROWTH_EXPONENT
body_mass = k * l**B
end function length2mass
!-----------------------------------------------------------------------------
!> Calculate the current energy reserves (Fulton condition factor) from body
!! mass and length.
!! @param[in] m, l body mass and body length.
!! @returns energy reserve available.
elemental function energy_reserve (m, l) result (k)
real(SRP), intent(in) :: m, l
real(SRP) :: k
!> @note The "cube law" exponent (3.0 normally), might be redefined here
!! as the LINEAR_GROWTH_EXPONENT parameter constant.
real(SRP), parameter :: B = LINEAR_GROWTH_EXPONENT
k = m / (l**B)
end function energy_reserve
!-----------------------------------------------------------------------------
!> Initialise the individual body condition object based on the genome values.
!! Two alleles are selected at random and input into the `gamma2gene`
!! function to get the initial hormone values rescaled to 0:1. Note that
!! the `gamma2gene` alleles defining the **shape** of the gamma function
!! and the **half-max effect** are selected randomly in this version.
!! Also, polyploid organisms are possible, in such case, two parameters
!! are also randomly defined from a larger set (e.g. from four chromosomes
!! in case of tetraploids). See implementation details and comments for
!! each of the hormones.
subroutine condition_init_genotype(this)
class(CONDITION), intent(inout) :: this
! PROCNAME is the procedure name for logging and debugging (with MODNAME).
character(len=*), parameter :: PROCNAME = "(condition_init_genotype)"
!> ### Implementation details ###
!> First, initialise all the physical condition components of the
!! agent, starting from **age**: age=0 initially.
this%age = 0
!> The **energy reserves** are set as Gaussian with the mean
!! commondata::energy_init and CV commondata::energy_gerror_cv.
this%energy_current = RNORM( ENERGY_INIT, &
cv2variance( ENERGY_GERROR_CV, &
ENERGY_INIT ) )
!> Set the birth energy reserves from the initial current value.
this%energy_birth = this%energy_current
!> Additionally, update the historical maximum energy value.
this%energy_maximum = this%energy_current
!> The **body length** is initialised as Gaussian with the mean
!! commondata::body_length_init and cv commondata::body_length_gerror_cv.
this%body_length = RNORM( BODY_LENGTH_INIT, &
cv2variance( BODY_LENGTH_GERROR_CV, &
BODY_LENGTH_INIT ) )
!> @note Body length cannot be zero or less than the minimum possible
!! size that is defined by `BODY_LENGTH_MIN`.
if (this%body_length < BODY_LENGTH_MIN) then
call LOG_DBG ( &
"WARNING: Initialised body length " // TOSTR(this%body_length) // &
" is smaller than the BODY_LENGTH_MIN in " // PROCNAME )
this%body_length = BODY_LENGTH_MIN
end if
!> Also, body length at birth cannot reach the maximum value
!! `BODY_LENGTH_MAX`, if it does occurs, erroneous parameter value
!! was set. This aberrant agent then the_genome::individual_genome::dies().
if (this%body_length >= BODY_LENGTH_MAX) then
call LOG_MSG( &
"WARNING: Initialised body length " // TOSTR(this%body_length) // &
" exceeds 1/10 BODY_LENGTH_MAX in " // PROCNAME )
this%body_length = BODY_LENGTH_MAX / 10.0_SRP
call this%dies()
end if
!> The historical body length at birth is saved as
!! the_body::condition::body_length_birth.
this%body_length_birth = this%body_length
!> A **control unselected** trait is also set from the genome. This trait
!! is not used in any calculations but serves as a control for random or
!! nonrandom genetic drift.
call this%trait_init(this%control_unselected, &
CONTROL_UNSELECTED_GENOTYPE_PHENOTYPE, &
CONTROL_UNSELECTED_INIT, &
CONTROL_UNSELECTED_GERROR_CV, "CONTROL_UNSEL")
!> The **body mass** is determined by the genetically determined energy
!! reserves and the body length (using `length2mass` function). Thus,
!! the body mass is **non-genetic**.
this%body_mass = length2mass(this%energy_current, this%body_length)
!> The historical body mass at birth and the maximum body mass ever
!! achieved are saved.
this%body_mass_birth = this%body_mass
this%body_mass_maximum = this%body_mass
!> **SMR** is set from the genome.
call this%trait_init(this%smr, &
SMR_GENOTYPE_PHENOTYPE, &
SMR_INIT, SMR_GERROR_CV, "SMR")
!> However, it must never be lower than commondata::smr_min. Very low
!! values are unrealistic and might crash model.
if ( this%smr < SMR_MIN ) this%smr = SMR_MIN
!> **Stomach contents** is initialised as a random Gaussian value, average,
!! units of the body mass with `STOMACH_CONTENT_INIT` and coefficient
!! of variation `STOMACH_CONTENT_INIT_CV`. Stomach contents also must
!! always be above zero and never exceed the `maxstomcap` factor.
this%stomach_content_mass &
= min( &
max( ZERO, RNORM(this%body_mass*STOMACH_CONTENT_INIT, &
(this%body_mass*STOMACH_CONTENT_INIT* &
STOMACH_CONTENT_INIT_CV)**2) ), &
this%body_mass*this%maxstomcap )
!> Finally, the procedure initialises the history stacks for the body mass
!! and length.
call this%body_history_clean()
!> And put the initial birth values of body length and mass into the
!! history stack.
!! @note The body length and mass history stack keeps the latest historical
!! values.
call add_to_history(this%body_length_history, this%body_length)
call add_to_history(this%body_mass_history, this%body_mass)
end subroutine condition_init_genotype
!-----------------------------------------------------------------------------
!> This procedure enforces selective mortality of agents at birth to avoid
!! strong selection for energy and length.
!! @warning This is a debug version of the mortality procedure with fixed
!! mortality pattern, final should depend on the statistical
!! properties of the first generation, mean and sd.
subroutine birth_mortality_enforce_init_fixed_debug(this)
class(CONDITION), intent(inout) :: this
! htintrpl.exe [0.2 0.3 0.6 1.0] [0 0.006 0.1 1.0]
! htintrpl.exe [0.2 0.3 0.5 0.8] [0 0.006 0.1 1.0]
real(SRP), dimension(*), parameter :: BIRTH_MORTALITY_ENERGY_ABSCISSA = &
[ 0.2_SRP, 0.3_SRP, 0.5_SRP, 0.8_SRP ]
real(SRP), dimension(*), parameter :: BIRTH_MORTALITY_ENERGY_ORDINATE = &
[ 0.0_SRP, 0.006_SRP, 0.1_SRP, 1.0_SRP ]
real(SRP) :: mortality
mortality = within( DDPINTERPOL( BIRTH_MORTALITY_ENERGY_ABSCISSA, &
BIRTH_MORTALITY_ENERGY_ORDINATE, &
this%energy_birth ), &
0.0_SRP, 1.0_SRP )
if ( RAND_R4() < mortality ) then
call this%dies()
end if
end subroutine birth_mortality_enforce_init_fixed_debug
!-----------------------------------------------------------------------------
!> Cleanup the history stack of the body length and mass.
elemental subroutine condition_clean_history(this)
class(CONDITION), intent(inout) :: this
this%body_length_history = MISSING
this%body_mass_history = MISSING
end subroutine condition_clean_history
!=============================================================================
! Accessors for the CONDITION object parameters.
!-----------------------------------------------------------------------------
!> Get current age. *Standard GET-function.*
elemental function condition_age_get(this) result(age)
class(CONDITION), intent(in) :: this
!> @return Return the agent's age
integer :: age
age = this%age
end function condition_age_get
!-----------------------------------------------------------------------------
!> Reset the age of the agent to zero.
elemental subroutine condition_age_reset_zero(this)
class(CONDITION), intent(inout) :: this
this%age = 0
end subroutine condition_age_reset_zero
!-----------------------------------------------------------------------------
!> Increment the age of the agent by one.
elemental subroutine condition_age_increment(this, increment)
class(CONDITION), intent(inout) :: this
!> @param[in] increment optional increment for increasing the age of the
!! agent, the default value is 1.
integer, optional, intent(in) :: increment
if (present(increment)) then
this%age = this%age + increment
else
this%age = this%age + 1
end if
end subroutine condition_age_increment
!-----------------------------------------------------------------------------
!> Get current energy reserves. *Standard GET-function.*
elemental function condition_energy_current_get(this) result(energy)
class(CONDITION), intent(in) :: this
!> @return Return the agent's energy reserves.
real(SRP) :: energy
energy = this%energy_current
end function condition_energy_current_get
!-----------------------------------------------------------------------------
!> Get historical maximum of energy reserves. *Standard GET-function.*
elemental function condition_energy_maximum_get(this) result(energy)
class(CONDITION), intent(in) :: this
!> @return Return the agent's maximum energy reserves.
real(SRP) :: energy
energy = this%energy_maximum
end function condition_energy_maximum_get
!-----------------------------------------------------------------------------
!> Get current body length. *Standard GET-function.*
elemental function condition_body_length_get(this) result(length)
class(CONDITION), intent(in) :: this
!> @return Return the agent's body length.
real(SRP) :: length
length = this%body_length
end function condition_body_length_get
!-----------------------------------------------------------------------------
!> Get current value of the control unselected trait. Standard GET-function.
elemental function condition_control_unsel_get(this) result(value_out)
class(CONDITION), intent(in) :: this
!> @return Return the agent's control unselected trait value.
real(SRP) :: value_out
value_out = this%control_unselected
end function condition_control_unsel_get
!-----------------------------------------------------------------------------
!> Get current body mass. *Standard GET-function.*
elemental function condition_body_mass_get(this) result(mass)
class(CONDITION), intent(in) :: this
!> @return Return the agent's body mass.
real(SRP) :: mass
mass = this%body_mass
end function condition_body_mass_get
!-----------------------------------------------------------------------------
!> Calculate the visibility range of this agent. Visibility depends on the
!! size of the agent, ambient illumination and agent contrast. Visibility is
!! the distance from which this agent can be seen by a visual object (e.g.
!! predator or conspecific). This function is a wrapper to the
!! the_environment::visual_range() function.
!! @warning The `visual_range` procedures use meter for units, this
!! auto-converts to cm.
!! @warning Cannot implement a generic function accepting also vectors of
!! this objects as only elemental object-bound array functions are
!! allowed by the standard. This function cannot be elemental, so
!! passed-object dummy argument must always be scalar.
function condition_agent_visibility_visual_range(this, object_area, &
contrast, time_step_model) result (visrange)
class(CONDITION), intent(in) :: this
!> @param[in] object_area optional area of this agent, m. If not provided
!! (normally), is obtained from the body length attribute of
!! the agent (the_body::condition::body_length).
real(SRP), optional, intent(in) :: object_area
!> @param[in] contrast is the inherent visual contrast of the agent.
!! the default contrast of all objects is defined by the
!! commondata::preycontrast_default parameter.
real(SRP), optional, intent(in) :: contrast
!> @param[in] optional time step of the model, if absent gets the current
!! time step as defined by the value of
!! `commondata::global_time_step_model_current`.
integer, optional, intent(in) :: time_step_model
!> @return The maximum distance from which this agent can be seen.
real(SRP) :: visrange
! Local copies of optionals
real(SRP) :: object_area_here, contrast_here
integer :: time_step_model_here
! Local variables
real(SRP) :: irradiance_agent_depth
!> ### Implementation details ###
!> **Checks.** Check optional object area, the default value, if this
!> parameter is absent, the body side area is calculated from the
!! the_body::condition::body_length attribute of the agent with inline
!! conversion to m. Note that the body side area of a fish object is
!! calculated from the body length using the
!! commondata::length2sidearea_fish() function.
if (present(object_area)) then
object_area_here = object_area
else
object_area_here = length2sidearea_fish( cm2m( this%body_length ) )
end if
!> Check optional `contrast` parameter. If unset, use global
!! `commondata::preycontrast_default`.
if (present(contrast)) then
contrast_here = contrast
else
contrast_here = PREYCONTRAST_DEFAULT
end if
!> Check optional time step parameter. If unset, use global
!! `commondata::global_time_step_model_current`.
if (present(time_step_model)) then
time_step_model_here = time_step_model
else
time_step_model_here = Global_Time_Step_Model_Current
end if
!> Calculate ambient illumination / irradiance at the depth of
!! this agent at the given time step using the
!! the_environment::spatial::illumination() method.
irradiance_agent_depth = this%illumination(time_step_model_here)
!> Return visual range to see this spatial object: its visibility range by
!! calling the the_environment::visual_range() function.
visrange = m2cm( visual_range ( irradiance = irradiance_agent_depth, &
prey_area = object_area_here, &
prey_contrast = contrast_here ) )
end function condition_agent_visibility_visual_range
!-----------------------------------------------------------------------------
!> Set body mass optionally updating the history stack.
subroutine condition_body_mass_set_update_hist(this, value_set, &
update_history)
class(CONDITION), intent(inout) :: this
!> @param value_set, Set the new (overwrite) value of the **body mass**.
real(SRP), intent(in) :: value_set
!> @param update_history is an optional logical flag to update the body
!! mass history stack, the default is **not to update**.
logical, optional, intent(in) :: update_history
!> ### Implementation details ###
!> If the `value_set` is smaller that the minimum body mass parameter
!! `BODY_MASS_MIN`, the body mass is set to this minimum value. This avoids
!! getting the body mass too small or negative.
!> This "set"-procedure, however, does not check if the new value is below
!! the structure mass or any other minimum value that leads to the death of
!! the agent. To check for starvation death, the method
!! `condition::starved_death()` =>
!! `the_body::body_mass_is_starvation_check()` should be explicitly
!! executed.
if ( value_set < BODY_MASS_MIN ) then
this%body_mass = BODY_MASS_MIN
else
this%body_mass = value_set
end if
!> Update the body mass history stack if the `update_history` is
!! explicitly set to TRUE. The default not to update is used because
!! body mass should normally be updated in parallel with the length, if
!! this is not the case, they will be dis-synchronised within the
!! history stack arrays.
if (present(update_history)) then
if (update_history) &
call add_to_history(this%body_mass_history, value_set)
end if
end subroutine condition_body_mass_set_update_hist
!-----------------------------------------------------------------------------
!> Set body length optionally updating the history stack.
subroutine condition_body_length_set_update_hist(this, value_set, &
update_history)
class(CONDITION), intent(inout) :: this
!> @param value_set, Set the new (overwrite) value of the **body length**.
real(SRP), intent(in) :: value_set
!> @param update_history is an optional logical flag to update the body
!! length history stack, the default is **not to update**.
logical, optional, intent(in) :: update_history
!> ### Implementation details ###
!> If the `value_set` is smaller that the minimum body length parameter
!! `BODY_LENGTH_MIN` or the maximum `BODY_LENGTH_MAX`, the length is set
!! to this minimum or maximum value respectively. This avoids setting
!! the body length outside of the normal limits. The function
!! `commondata::within()` is called to set the new value.
this%body_length = within(value_set, BODY_LENGTH_MIN, BODY_LENGTH_MAX)
!> Update the body length history stack if the `update_history` is
!! explicitly set to TRUE. The default not to update is used because
!! body length should normally be updated in parallel with the mass, if
!! this is not the case, they will be dis-synchronised within the
!! history stack arrays.
if (present(update_history)) then
if (update_history) &
call add_to_history(this%body_length_history, value_set)
end if
end subroutine condition_body_length_set_update_hist
!-----------------------------------------------------------------------------
!> Get historical record of energy reserves at birth. *Standard GET-function.*
elemental function condition_energy_birth_get(this) result(energy)
class(CONDITION), intent(in) :: this
!> @return Return the agent's body length at birth.
real(SRP) :: energy
energy = this%energy_birth
end function condition_energy_birth_get
!-----------------------------------------------------------------------------
!> Get historical record of body length at birth. *Standard GET-function.*
elemental function condition_body_length_birth_get(this) result(length)
class(CONDITION), intent(in) :: this
!> @return Return the agent's body length at birth.
real(SRP) :: length
length = this%body_length_birth
end function condition_body_length_birth_get
!-----------------------------------------------------------------------------
!> Get historical record of body mass at birth. *Standard GET-function.*
elemental function condition_body_mass_birth_get(this) result(mass)
class(CONDITION), intent(in) :: this
!> @return Return the agent's body mass at birth.
real(SRP) :: mass
mass = this%body_mass_birth
end function condition_body_mass_birth_get
!-----------------------------------------------------------------------------
!> Get historcal maximum for body mass. Standard *GET-function.*
elemental function condition_body_mass_max_get(this) result(mass)
class(CONDITION), intent(in) :: this
!> @return Return the agent's maximum body mass.
real(SRP) :: mass
mass = this%body_mass_maximum
end function condition_body_mass_max_get
!-----------------------------------------------------------------------------
!> Get current smr. Standard *GET-function.*
elemental function condition_smr_get(this) result(smr)
class(CONDITION), intent(in) :: this
!> @return Return the agent's SMR.
real(SRP) :: smr
smr = this%smr
end function condition_smr_get
!-----------------------------------------------------------------------------
!> Get current stomach content. *Standard GET-function.*
elemental function condition_stomach_content_get(this) result(stom)
class(CONDITION), intent(in) :: this
!> @return Return the agent's stomach content.
real(SRP) :: stom
stom = this%stomach_content_mass
end function condition_stomach_content_get
!=============================================================================
!> @brief Calculate the basic processing cost of catching a food item
!! with the mass `food_gain`.
!! @details There is a small cost of the food item catching, in terms of the
!! **food item mass** (proportional cost). So, if the agent does
!! an unsuccessful attempt to catch a food item, the cost still
!! applies. So we subtract it before testing if the agent actually
!! got this food item. Also, there is a fixed minimum capture cost
!! (in terms of the **agent body mass**), so if the food item is
!! very small, the actual gain can be negative (capture cost exceeds
!! the value of the item).
!! @note Note that this version accepts the the raw food mass (real value).
elemental function body_mass_processing_cost_calc_v(this, &
food_gain, distance_food) &
result (cost)
class(CONDITION), intent(in) :: this !> @param[in] this object.
real(SRP), optional, intent(in) :: food_gain !> @param[in] food gain.
!> @param[in] distance_food distance to the food item.
real(SRP), optional, intent(in) :: distance_food
reaL(SRP) :: cost !> @return processing cost.
! Local copy of optionals.
real(SRP) :: food_gain_here, distance_food_here
! Check optional parameter, set default values.
if(present(food_gain)) then
food_gain_here = food_gain
else
food_gain_here = FOOD_ITEM_SIZE_DEFAULT
end if
!> ### Implementation details ###
!> First, check the optional distance towards the food item. It is used to
!! calculate the energetic cost of swimming towards the food item.
if (present(distance_food)) then
distance_food_here = distance_food
else
!> If the distance to the food item is not provided, we assume it is
!! equal to the *agent size* (so the relative distance = 1 body size).
distance_food_here = this%body_length
end if
!> The cost of the processing of the food item is a sum of two components:
!! 1. some small processing cost depending on the food item mass and
!! 2. the cost of swimming towards the food item depending on the relative
!! distance (distance in terms of the agent body length.
!! .
!! @f[ C_{p} = max(\mu \cdot \beta_{fp}, \mu \cdot C_{smr}) + C_{s} , @f]
!! where @f$ \mu @f$ is the food gain, @f$ \beta_{fp} @f$ is a factor
!! proportional to the food item mass, and @f$ C_{smr} @f$ is a food
!! processing cost factor that is proportional to the agent's SMR.
cost = max( food_gain_here * FOOD_ITEM_CAPTURE_PROP_COST, &
food_gain_here * this%cost_factor_food_smr(food_gain_here) ) &
+ this%cost_swim(distance=distance_food_here)
end function body_mass_processing_cost_calc_v
!-----------------------------------------------------------------------------
!> The cost of swimming of a specific distance in terms of the actor's
!! body mass.
!! @note Note that power needed to swim is proportional to the body
!! mass with the exponent 0.6 assuming turbulent flow (see
!! doi:10.1242/jeb.01484).
!! @param[in] distance the optional distance traversed (absolute distance
!! in real units, cm). If distance is not provided, it is
!! calculated from the latest spatial displacement of the agent
!! using the the_environment::spatial_moving::way() function.
!! @param[in] exponent an optional cost exponent parameter. Can be 0.5
!! (commondata::swimming_cost_exponent_laminar, laminar flow) or
!! 0.6 (commondata::swimming_cost_exponent_turbulent, turbulent
!! flow), the default is set to 0.6.
!! @returns The cost of swimming in terms of the body mass lost.
elemental function condition_cost_swimming_burst(this, &
distance, exponent) result (cost_swimming)
class(CONDITION), intent(in) :: this ! This object.
real(SRP), optional, intent(in) :: distance ! Distance traversed.
real(SRP), optional, intent(in) :: exponent ! Cost exponent.
real(SRP) :: cost_swimming ! Return value.
! Local copies of optionals.
real(SRP) :: dist_loc, exponent_here
!> ### Notable parameters ###
!! **SWIM_COST_EXP** is the default swimming cost body mass exponent
!! parameter for turbulent flow
!! commondata::swimming_cost_exponent_turbulent = 0.6. For laminar flow,
!! equal to commondata::swimming_cost_exponent_laminar = 0.5.
!! See doi:10.1242/jeb.01484 (https://dx.doi.org/10.1242/jeb.01484).
real(SRP), parameter :: SWIM_COST_EXP = SWIMMING_COST_EXPONENT_TURBULENT
! Check optional distance
if (present(distance)) then
dist_loc = distance
else
dist_loc = this%way()
end if
! Check optional exponent parameter.
if (present(exponent)) then
exponent_here = exponent
else
exponent_here = SWIM_COST_EXP
end if
!> ### Implementation details ###
!> The cost of swimming (for turbulent flow) is calculated as:
!! @f[ C_{s} = M^{0.6} \cdot \beta \cdot d / L , @f] where
!! @f$ M @f$ is the body mass, @f$ \beta @f$ is a parameter factor
!! defined as `commondata::swimming_speed_cost_burst`, @f$ d / L @f$ is
!! the distance in units of the agent's body length. For laminar flow,
!! the exponent should be 0.5.
!! @note An arbitrary value for the exponent can be provided as the second
!! dummy parameter to this function `exponent`.
!! @note The function the_body::cost_swimming_standard() calculates a
!! diagnostic function, the "standard" cost of swimming.
cost_swimming = this%body_mass**exponent_here * SWIMMING_SPEED_COST_BURST &
* dist_loc / this%body_length
end function condition_cost_swimming_burst
!-----------------------------------------------------------------------------
!> @brief Calculate the basic processing cost of catching a food item
!! with the mass `food_gain`.
!! @note Note that this version accepts the food object not its raw mass.
!! @param[in] food_obj food item object, of class `FOOD_ITEM`.
!! @param[in] distance_food distance to the food item.
!! @return Food processing cost.
elemental function body_mass_processing_cost_calc_o(this, &
food_obj, distance_food) &
result (cost)
class(CONDITION), intent(in) :: this ! @param[in] this object.
class(FOOD_ITEM), intent(in) :: food_obj ! @param[in] food item object.
! @param[in] distance_food distance to the food item.
real(SRP), optional, intent(in) :: distance_food
reaL(SRP) :: cost ! @returns processing cost.
! Local copy of optionals.
real(SRP) :: distance_food_here
!> ### Implementation details ###
! The swimming cost body mass exponent parameter for turbulent flow is
! equal to 0.6 (see doi:10.1242/jeb.01484).
! @note **Disabled** here as this procedure now uses the above scalar
! `food_proc_cost_v` function for calculations.
!real(SRP), parameter :: SWIM_COST_EXP = 0.6_SRP
!> First, check the optional distance towards the food item. We use it to
!! calculate the energetic cost of swimming towards the food item.
if (present(distance_food)) then
distance_food_here = distance_food
else
!> If the distance to the food item is not provided, we assume it is
!! equal to the agent body size (so the relative distance = 1 body size).
distance_food_here = this%body_length
end if
!> The cost of the processing of the food item is a sum of two components:
!! 1. some small processing cost depending on the food item mass and
!! 2. the cost of swimming towards the food item depending on the relative
!! distance (distance in terms of the agent body length.
!! .
!! @f[ C_{p} = max(\mu \cdot \beta_{fp}, \mu \cdot C_{smr}) + C_{s} , @f]
!! where @f$ \mu @f$ is the food gain, @f$ \beta_{fp} @f$ is a factor
!! proportional to the food item mass, and @f$ C_{smr} @f$ is a food
!! processing cost factor that is proportional to the agent's SMR.
!!
!! @note The calculations are done by the scalar procedure
!! body_mass_processing_cost_calc_v().
cost = this%food_proc_cost_v(food_obj%get_mass(), distance_food_here)
end function body_mass_processing_cost_calc_o
!-----------------------------------------------------------------------------
!> Calculate the value of possible food gain as fitting into the agent's
!! stomach, or the full gain if the food item wholly fits in.
!! @param[in] food_gain food gain.
!! @param[in] food_dist distance to food.
!! @returns processing cost.
!! @note Note that this version accepts the the raw food mass (real value).
!! @note The food fitting is adjusted for the food item processing cost
!! body_mass_processing_cost_calc_v() call.
elemental function stomach_content_food_gain_fitting_v(this, &
food_gain, food_dist) &
result (food_adjusted)
class(CONDITION), intent(in) :: this
real(SRP), optional, intent(in) :: food_gain ! @param[in] food gain.
real(SRP), optional, intent(in) :: food_dist ! @param[in] distance to food.
reaL(SRP) :: food_adjusted ! @returns processing cost.
real(SRP) :: food_gain_here
!> ### Implementation details ###
!> Check optional `food_gain` parameter, set default values. If food
!! gain is not provided, an average/default food item is assumed, defined
!! by `FOOD_ITEM_SIZE_DEFAULT`.