The AHA Model  Revision: 12809
Reference implementation 04 (HEDG02_04)
m_hormon.f90
Go to the documentation of this file.
1 !> @file m_hormon.f90
2 !! The Hormone architecture of the AHA Model.
3 !! @author Sergey Budaev <sergey.budaev@uib.no>
4 !! @author Jarl Giske <jarl.giske@uib.no>
5 !! @date 2016-2017
6 
7 !-------------------------------------------------------------------------------
8 ! $Id: m_hormon.f90 6145 2017-11-06 12:31:23Z sbu062 $
9 !-------------------------------------------------------------------------------
10 
11 !-------------------------------------------------------------------------------
12 !> @brief Definition the hormonal architecture of the agent.
13 !> @section the_hormones_module THE_HORMONES module
14 !> Define the hormonal architecture objects. Hormones affect implemented in
15 !! such a way as to affect decision making and behaviour, but change relatively
16 !! slowly across the lifespan of the agent. Their initial state is also
17 !! genetically determined.
19 
20  use commondata
21  use the_genome
22 
23  implicit none
24 
25  character (len=*), parameter, private :: modname = "(THE_HORMONES)"
26 
27  !> This type adds hormonal architecture extending the genome object
28  type, public, extends(individual_genome) :: hormones
29 
30  !> **growth** hormone increases metabolic rate and growth, has costs
31  !! changes/effects relatively slow and long-term.
32  real(srp) :: growhorm_level
33  !> **thyroid** hormone limits growth hormone, has costs
34  !! changes/effects very slow, level very stable, genetically determined.
35  real(srp) :: thyroid_level
36  !> **adrenaline** increases general arousal, increases escape
37  !! speed/performance, primes active fear response, primes aggression,
38  !! increases cognitive performance, focus attention, suppresses immune
39  !! system, changes/effects relatively short-term.
40  real(srp) :: adrenaline_level
41  !> **cortisol** (HPI axis) linked with higher stress and fear, reduces
42  !! hunger, suppresses immune system, increases blood pressure, reduce
43  !! cognitive performance, changes/effects long-term.
44  real(srp) :: cortisol_level
45 
46  !> Gonadal steroids - Sex hormones of males and females
47  !! - we implement them and their effects differently i males and females
48  !> **testosterone** - development of male sex characteristics
49  !! increases boldness and aggression, reduces immunity, changes/effects
50  !! relatively short-term
51  !! @note use *testosterone* (with *e*), not *testosteron* in the code!
52  !! @note single-hormone initialisation function is private, we don't need to
53  !! init single hormones anywhere outside of this module.
54  real(srp) :: testosterone_level
55  !> **estrogen** - development of female sex characteristics, suppresses
56  !! immunity, changes/effects relatively short-term.
57  real(srp) :: estrogen_level
58  !> The *testosterone* baseline genetically determined level.
59  real(srp) :: testosterone_baseline
60  !> The *estrogen* baseline genetically determined level.
61  real(srp) :: estrogen_baseline
62  !> History stacks for the gonadal steroids.
63  real(srp), dimension(HISTORY_SIZE_AGENT_PROP) :: testosterone_history
64  real(srp), dimension(HISTORY_SIZE_AGENT_PROP) :: estrogen_history
65 
66  contains
67  private
68  !> Initialise hormone levels based on the genome value.
69  !! See `the_hormones::hormones_init_genotype()`
70  procedure, public :: init_hormones => hormones_init_genotype
71  !> Clean the history stack of hormones.
72  !! See `the_hormones::hormones_clean_history_stack()`
73  procedure, public :: hormone_history_clean => hormones_clean_history_stack
74 
75  !> Get the value of **thyroid**.
76  !! See `the_hormones::growhorm_get_level()`
77  procedure, public :: growhorm_get => growhorm_get_level
78  !> Set the value of **thyroid**.
79  !! See `the_hormones::growhorm_set_level()`
80  procedure, public :: growhorm_set => growhorm_set_level
81 
82  !> Get the value of **thyroid**.
83  !! See `the_hormones::thyroid_get_level()`
84  procedure, public :: thyroid_get => thyroid_get_level
85  !> Set the value of **thyroid**.
86  !! See `the_hormones::thyroid_set_level()`
87  procedure, public :: thyroid_set => thyroid_set_level
88 
89  !> Get the value of **adrenaline**.
90  !! See `the_hormones::adrenaline_get_level()`
91  procedure, public :: adrenaline_get => adrenaline_get_level
92  !> Set the value of **adrenaline**.
93  !! See `the_hormones::adrenaline_set_level()`
94  procedure, public :: adrenaline_set => adrenaline_set_level
95 
96  !> Get the value of **cortisol**.
97  !! See `the_hormones::cortisol_get_level()`
98  procedure, public :: cortisol_get => cortisol_get_level
99  !> Set the value of **cortisol**.
100  !! See `the_hormones::cortisol_set_level()`
101  procedure, public :: cortisol_set => cortisol_set_level
102 
103  !> Get the value of **testosterone**.
104  !! See `the_hormones::testosterone_get_level()`
105  procedure, public :: testosterone_get => testosterone_get_level
106  !> Set the value of **testosterone**.
107  !! See `the_hormones::testosterone_set_level()`
108  procedure, public :: testosterone_set => testosterone_set_level
109 
110  !> Get the value of **estrogen**.
111  !! See `the_hormones::estrogen_get_level()`
112  procedure, public :: estrogen_get => estrogen_get_level
113  !> Set the value of **estrogen**.
114  !! See `the_hormones::estrogen_set_level()`
115  procedure, public :: estrogen_set => estrogen_set_level
116 
117  !> Get the value of testosterone baseline.
118  !! See `the_hormones::testosteron_baseline_get_level()`
119  procedure, public :: testosterone_base_get => &
121  !> Get the value of estrogen baseline.
122  !! See `the_hormones::estrogen_baseline_get_level()`
123  procedure, public :: estrogen_base_get => estrogen_baseline_get_level
124 
125  !> Calculate the reproductive factor. Reproductive factor is defined as
126  !! the current level of the_hormones::testosterone_level in males and
127  !! the_hormones::estrogen_level in females.
128  !! See `the_hormones::hormones_reproductive_factor_calc()`.
129  procedure, public :: reproductive_factor => &
131 
132  !> Update the sex steroid hormones history stack from the current level
133  !! See `the_hormones::hormones_update_history()`.
134  procedure, public :: hormones_to_history => hormones_update_history
135 
136  end type hormones
137 
138 contains ! ........ implementation of procedures for this level ................
139 
140  !> Initialise hormone levels based on the genome value. Two alleles are
141  !! selected at random and input into the `gamma2gene` function to get the
142  !! initial hormone values rescaled to 0:1. Note that the `gamma2gene`
143  !! alleles defining the **shape** of the gamma function and the **half-max
144  !! effect** are selected randomly in this version. Also, polyploid organisms
145  !! are possible, in such case, two parameters are also randomly defined from
146  !! a larger set (e.g. from four chromosomes in case of tetraploids).
147  !! See implementation details and comments for each of the hormones.
148  subroutine hormones_init_genotype(this)
149  class(hormones), intent(inout) :: this
150 
151  !> ### Implementation details ###
152  !> First, get all the initial hormone level values from the genotype.
153  call this%trait_init(this%growhorm_level, &
155  growhorm_init, growhorm_gerror_cv, "GROWHORM")
156 
157  call this%trait_init(this%thyroid_level, &
159  thyroid_init, thyroid_gerror_cv, "THYROID")
160 
161  call this%trait_init(this%adrenaline_level, &
163  adrenaline_init, adrenaline_gerror_cv, "ADRENALINE")
164 
165  call this%trait_init(this%cortisol_level, &
167  cortisol_init, cortisol_gerror_cv, "CORTISOL")
168 
169  call this%trait_init(this%testosterone_level, &
172  "TESTOSTERONE")
173 
174  call this%trait_init(this%estrogen_level, &
176  estrogen_init, estrogen_gerror_cv, "ESTROGEN")
177 
178  !> Then, initialise the baseline levels of sex steroids from the starting
179  !! genetically determined hormone levels.
180  this%testosterone_baseline = this%testosterone_level
181  this%estrogen_baseline = this%estrogen_level
182 
183  !> Clean history stack of all the hormones upon init.
184  call this%hormone_history_clean()
185 
186  !> Finally, update the hormone history stack with the first init values.
187  call add_to_history(this%testosterone_history, this%testosterone_level)
188  call add_to_history(this%estrogen_history, this%estrogen_level)
189 
190  end subroutine hormones_init_genotype
191 
192  !-----------------------------------------------------------------------------
193  !> Clean the history stack of hormones: testosterone and estrogen histories
194  !! are set to `MISSING`.
195  elemental subroutine hormones_clean_history_stack(this)
196  class(hormones), intent(inout) :: this
197 
198  this%testosterone_history = missing
199  this%estrogen_history = missing
200 
201  end subroutine hormones_clean_history_stack
202 
203  !-----------------------------------------------------------------------------
204  !> Update the sex steroid hormones history stack from the current level.
205  elemental subroutine hormones_update_history(this)
206  class(hormones), intent(inout) :: this
207 
208  !> Update the hormone history stack with the first init values.
209  call add_to_history(this%testosterone_history, this%testosterone_level)
210  call add_to_history(this%estrogen_history, this%estrogen_level)
211 
212  end subroutine hormones_update_history
213 
214  !-----------------------------------------------------------------------------
215  !> Calculate the reproductive factor. Reproductive factor is defined as
216  !! the current level of the_hormones::testosterone_level in males and
217  !! the_hormones::estrogen_level in females.
218  !! @note Because the reproductive factor is obtained by sex-specific
219  !! operations directly on the hormones, the use of this function
220  !! is mostly limited to diagnostic outputs.
221  elemental function hormones_reproductive_factor_calc(this) result (reprfact)
222  class(hormones), intent(in) :: this
223  !> @return Reproductive factor.
224  real(srp) :: reprfact
225 
226  if ( this%is_male() ) then
227  reprfact = this%testosterone_level
228  else
229  reprfact = this%estrogen_level
230  end if
231 
233 
234  !-----------------------------------------------------------------------------
235 
236  !> @name Accessor functions for all the hormones.
237  !! Get and set functions for each hormone follow. We left them as
238  !! individual hormone-specific functions duplicating code. Not ideal,
239  !! but easy to use provided hormones do not change too often.
240  !! Tiny atomic hormone get/set functions are easy to code.
241  !! @{
242 
243  !-----------------------------------------------------------------------------
244  !> Get the value of **growth hormone**.
245  elemental function growhorm_get_level (this) result (value_get)
246  class(hormones), intent(in) :: this
247 
248  !> @return value, Returns the value of the **growth hormone**.
249  real(srp) :: value_get
250 
251  value_get = this%growhorm_level
252 
253  end function growhorm_get_level
254 
255  !-----------------------------------------------------------------------------
256  !> Set the value of **growth hormone**.
257  elemental subroutine growhorm_set_level (this, value_set)
258  class(hormones), intent(inout) :: this
259 
260  !> @param value, Set the value of the **growth hormone**.
261  real(srp), intent(in) :: value_set
262 
263  this%growhorm_level = value_set
264 
265  end subroutine growhorm_set_level
266 
267  !-----------------------------------------------------------------------------
268  !> Get the value of **thyroid**.
269  elemental function thyroid_get_level (this) result (value_get)
270  class(hormones), intent(in) :: this
271 
272  !> @return value, Returns the value of the **thyroid hormone**.
273  real(srp) :: value_get
274 
275  value_get = this%thyroid_level
276 
277  end function thyroid_get_level
278 
279  !-----------------------------------------------------------------------------
280  !> Set the value of **thyroid**.
281  elemental subroutine thyroid_set_level (this, value_set)
282  class(hormones), intent(inout) :: this
283 
284  !> @param value, Set the value of the **thyroid hormone**.
285  real(srp), intent(in) :: value_set
286 
287  this%thyroid_level = value_set
288 
289  end subroutine thyroid_set_level
290 
291  !-----------------------------------------------------------------------------
292  !> Get the value of **adrenaline**.
293  elemental function adrenaline_get_level (this) result (value_get)
294  class(hormones), intent(in) :: this
295 
296  !> @return value, Returns the value of **adrenaline**.
297  real(srp) :: value_get
298 
299  value_get = this%adrenaline_level
300 
301  end function adrenaline_get_level
302 
303  !-----------------------------------------------------------------------------
304  !> Set the value of **adrenaline**.
305  elemental subroutine adrenaline_set_level (this, value_set)
306  class(hormones), intent(inout) :: this
307 
308  !> @param value, Set the value of the **adrenaline**.
309  real(srp), intent(in) :: value_set
310 
311  this%adrenaline_level = value_set
312 
313  end subroutine adrenaline_set_level
314 
315  !-----------------------------------------------------------------------------
316  !> Get the value of **cortisol**.
317  elemental function cortisol_get_level (this) result (value_get)
318  class(hormones), intent(in) :: this
319 
320  !> @return value, Returns the value of **cortisol**
321  real(srp) :: value_get
322 
323  value_get = this%cortisol_level
324 
325  end function cortisol_get_level
326 
327  !-----------------------------------------------------------------------------
328  !> Set the value of **cortisol**.
329  elemental subroutine cortisol_set_level (this, value_set)
330  class(hormones), intent(inout) :: this
331 
332  !> @param value, Set the value of the **cortisol**.
333  real(srp), intent(in) :: value_set
334 
335  this%cortisol_level = value_set
336 
337  end subroutine cortisol_set_level
338 
339  !-----------------------------------------------------------------------------
340  !> Get the value of **testosterone**.
341  elemental function testosterone_get_level (this) result (value_get)
342  class(hormones), intent(in) :: this
343 
344  !> @return value, Returns the value of **testosterone**
345  real(srp) :: value_get
346 
347  value_get = this%testosterone_level
348 
349  end function testosterone_get_level
350 
351  !-----------------------------------------------------------------------------
352  !> Set the value of **testosterone**.
353  elemental subroutine testosterone_set_level (this, value_set, update_history)
354  class(hormones), intent(inout) :: this
355 
356  !> @param value_set, Set the value of the **testosterone**.
357  real(srp), intent(in) :: value_set
358 
359  !> @param update_history is an optional logical flag to update the hormone
360  !! history stack, the default is to do update, no update only if
361  !! explicitly set to FALSE.
362  logical, optional, intent(in) :: update_history
363 
364  this%testosterone_level = value_set
365 
366  if (present(update_history)) then
367  if (.NOT. update_history) return ! Return non-updating history if FALSE.
368  end if
369  call add_to_history(this%testosterone_history, value_set)
370 
371  end subroutine testosterone_set_level
372 
373  !-----------------------------------------------------------------------------
374  !> Get the value of **estrogen**.
375  elemental function estrogen_get_level (this) result (value_get)
376  class(hormones), intent(in) :: this
377 
378  !> @return value, Returns the value of **estrogen**
379  real(srp) :: value_get
380 
381  value_get = this%estrogen_level
382 
383  end function estrogen_get_level
384 
385  !-----------------------------------------------------------------------------
386  !> Set the value of **estrogen**.
387  elemental subroutine estrogen_set_level (this, value_set, update_history)
388  class(hormones), intent(inout) :: this
389 
390  !> @param value, Set the value of the **estrogen**.
391  real(srp), intent(in) :: value_set
392 
393  !> @param update_history is an optional logical flag to update the hormone
394  !! history stack, the default is to do update, no update only if
395  !! explicitly set to FALSE.
396  logical, optional, intent(in) :: update_history
397 
398  this%estrogen_level = value_set
399 
400  if (present(update_history)) then
401  if (.NOT. update_history) return ! Return non-updating history if FALSE.
402  end if
403  call add_to_history(this%estrogen_history, value_set)
404 
405  end subroutine estrogen_set_level
406  !> @}
407 
408  !-----------------------------------------------------------------------------
409  !> Get the value of testosterone baseline.
410  elemental function testosteron_baseline_get_level (this) result (value_get)
411  class(hormones), intent(in) :: this
412 
413  !> @return value, Returns the value of **testosterone** baseline.
414  real(srp) :: value_get
415 
416  value_get = this%testosterone_baseline
417 
418  end function testosteron_baseline_get_level
419 
420  !-----------------------------------------------------------------------------
421  !> Get the value of estrogen baseline.
422  elemental function estrogen_baseline_get_level (this) result (value_get)
423  class(hormones), intent(in) :: this
424 
425  !> @return value, Returns the value of **testosterone** baseline.
426  real(srp) :: value_get
427 
428  value_get = this%estrogen_baseline
429 
430  end function estrogen_baseline_get_level
431 
432 end module the_hormones
Simple history stack function, add to the end of the stack. We need only to add components on top (en...
Definition: m_common.f90:5292
COMMONDATA – definitions of global constants and procedures.
Definition: m_common.f90:1497
character(len= *), parameter, private modname
MODNAME always refers to the name of the current module for use by the LOGGER function LOG_DBG....
Definition: m_common.f90:1591
real(srp), parameter, public adrenaline_init
Genotype to phenotype gamma2gene initialisation value for adrenaline
Definition: m_common.f90:2907
logical, dimension(max_nalleles, n_chromosomes), parameter, public thyroid_genotype_phenotype
Genotype x Phenotype matrix for thyroid.
Definition: m_common.f90:2847
logical, dimension(max_nalleles, n_chromosomes), parameter, public estrogen_genotype_phenotype
Genotype x Phenotype matrix for ESTROGEN.
Definition: m_common.f90:2987
real(srp), parameter, public testosterone_gerror_cv
Genotype to phenotype gamma2gene Gaussian error parameter. This is really the coefficient of variatio...
Definition: m_common.f90:2982
real(srp), parameter, public thyroid_gerror_cv
Genotype to phenotype gamma2gene Gaussian error parameter. This is really the coefficient of variatio...
Definition: m_common.f90:2877
integer, parameter, public srp
Definition of the standard real type precision (SRP).
Definition: m_common.f90:1551
logical, dimension(max_nalleles, n_chromosomes), parameter, public adrenaline_genotype_phenotype
Genotype x Phenotype matrix for adrenaline
Definition: m_common.f90:2882
logical, dimension(max_nalleles, n_chromosomes), parameter, public cortisol_genotype_phenotype
Genotype x Phenotype matrix for cortisol.
Definition: m_common.f90:2917
real(srp), parameter, public adrenaline_gerror_cv
Genotype to phenotype gamma2gene Gaussian error parameter. This is really the coefficient of variatio...
Definition: m_common.f90:2912
real(srp), parameter, public growhorm_init
Genotype to phenotype gamma2gene initialisation value for growth hormone
Definition: m_common.f90:2826
real(srp), parameter, public cortisol_init
Genotype to phenotype gamma2gene initialisation value for cortisol
Definition: m_common.f90:2942
real(srp), parameter, public missing
Numerical code for missing and invalid real type values.
Definition: m_common.f90:1699
logical, dimension(max_nalleles, n_chromosomes), parameter, public testosterone_genotype_phenotype
Genotype x Phenotype matrix for testosterone.
Definition: m_common.f90:2952
logical, dimension(max_nalleles, n_chromosomes), parameter, public growhorm_genotype_phenotype
Genotype x Phenotype matrix for growth hormone.
Definition: m_common.f90:2800
real(srp), parameter, public estrogen_init
Genotype to phenotype gamma2gene initialisation value for estrogen
Definition: m_common.f90:3012
real(srp), parameter, public thyroid_init
Genotype to phenotype gamma2gene initialisation value for thyroid
Definition: m_common.f90:2872
real(srp), parameter, public testosterone_init
Genotype to phenotype gamma2gene initialisation value for testosterone
Definition: m_common.f90:2977
real(srp), parameter, public growhorm_gerror_cv
Genotype to phenotype gamma2gene Gaussian error parameter. This is really the coefficient of variatio...
Definition: m_common.f90:2831
real(srp), parameter, public cortisol_gerror_cv
Genotype to phenotype gamma2gene Gaussian error parameter. This is really the coefficient of variatio...
Definition: m_common.f90:2947
real(srp), parameter, public estrogen_gerror_cv
Genotype to phenotype gamma2gene Gaussian error parameter. This is really the coefficient of variatio...
Definition: m_common.f90:3017
Definition the genetic architecture of the agent.
Definition: m_genome.f90:16
Definition the hormonal architecture of the agent.
Definition: m_hormon.f90:18
elemental real(srp) function thyroid_get_level(this)
Get the value of thyroid.
Definition: m_hormon.f90:270
elemental real(srp) function growhorm_get_level(this)
Get the value of growth hormone.
Definition: m_hormon.f90:246
subroutine hormones_init_genotype(this)
Initialise hormone levels based on the genome value. Two alleles are selected at random and input int...
Definition: m_hormon.f90:149
elemental real(srp) function estrogen_get_level(this)
Get the value of estrogen.
Definition: m_hormon.f90:376
elemental real(srp) function cortisol_get_level(this)
Get the value of cortisol.
Definition: m_hormon.f90:318
elemental real(srp) function adrenaline_get_level(this)
Get the value of adrenaline.
Definition: m_hormon.f90:294
elemental subroutine estrogen_set_level(this, value_set, update_history)
Set the value of estrogen.
Definition: m_hormon.f90:388
elemental real(srp) function estrogen_baseline_get_level(this)
Get the value of estrogen baseline.
Definition: m_hormon.f90:423
elemental real(srp) function testosteron_baseline_get_level(this)
Get the value of testosterone baseline.
Definition: m_hormon.f90:411
elemental real(srp) function testosterone_get_level(this)
Get the value of testosterone.
Definition: m_hormon.f90:342
elemental subroutine cortisol_set_level(this, value_set)
Set the value of cortisol.
Definition: m_hormon.f90:330
elemental subroutine thyroid_set_level(this, value_set)
Set the value of thyroid.
Definition: m_hormon.f90:282
elemental subroutine growhorm_set_level(this, value_set)
Set the value of growth hormone.
Definition: m_hormon.f90:258
elemental subroutine testosterone_set_level(this, value_set, update_history)
Set the value of testosterone.
Definition: m_hormon.f90:354
elemental real(srp) function hormones_reproductive_factor_calc(this)
Calculate the reproductive factor. Reproductive factor is defined as the current level of the_hormone...
Definition: m_hormon.f90:222
elemental subroutine adrenaline_set_level(this, value_set)
Set the value of adrenaline.
Definition: m_hormon.f90:306
elemental subroutine hormones_update_history(this)
Update the sex steroid hormones history stack from the current level.
Definition: m_hormon.f90:206
elemental subroutine hormones_clean_history_stack(this)
Clean the history stack of hormones: testosterone and estrogen histories are set to MISSING.
Definition: m_hormon.f90:196
This type describes parameters of the individual agent's genome The genome is an array of allocatable...
Definition: m_genome.f90:160
This type adds hormonal architecture extending the genome object.
Definition: m_hormon.f90:28