EFTCAMB  Reference documentation for version 3.0
04p3_power_law_parametrizations_1D.f90
Go to the documentation of this file.
1 !----------------------------------------------------------------------------------------
2 !
3 ! This file is part of EFTCAMB.
4 !
5 ! Copyright (C) 2013-2016 by the EFTCAMB authors
6 !
7 ! The EFTCAMB code is free software;
8 ! You can use it, redistribute it, and/or modify it under the terms
9 ! of the GNU General Public License as published by the Free Software Foundation;
10 ! either version 3 of the License, or (at your option) any later version.
11 ! The full text of the license can be found in the file eftcamb/LICENSE at
12 ! the top level of the EFTCAMB distribution.
13 !
14 !----------------------------------------------------------------------------------------
15 
19 
20 
21 !----------------------------------------------------------------------------------------
24 
26 
28 
29  use precision
30  use amlutils
31  use eft_def
32  use eftcamb_cache
34 
35  implicit none
36 
37  private
38 
39  public power_law_parametrization_1d
40 
41  ! ---------------------------------------------------------------------------------------------
43  type, extends ( parametrized_function_1d ) :: power_law_parametrization_1d
44 
45  real(dl) :: coefficient
46  real(dl) :: exponent
47 
48  contains
49 
50  ! utility functions:
51  procedure :: set_param_number => powerlawparametrized1dsetparamnumber
52  procedure :: init_parameters => powerlawparametrized1dinitparams
53  procedure :: parameter_value => powerlawparametrized1dparametervalues
54  procedure :: feedback => powerlawparametrized1dfeedback
55 
56  ! evaluation procedures:
57  procedure :: value => powerlawparametrized1dvalue
58  procedure :: first_derivative => powerlawparametrized1dfirstderivative
59  procedure :: second_derivative => powerlawparametrized1dsecondderivative
60  procedure :: third_derivative => powerlawparametrized1dthirdderivative
61  procedure :: integral => powerlawparametrized1dintegral
62 
63  end type power_law_parametrization_1d
64 
65 contains
66 
67  ! ---------------------------------------------------------------------------------------------
68  ! Implementation of the power law function.
69  ! ---------------------------------------------------------------------------------------------
70 
71  ! ---------------------------------------------------------------------------------------------
73  subroutine powerlawparametrized1dsetparamnumber( self )
74 
75  implicit none
76 
77  class(power_law_parametrization_1d) :: self
78 
79  ! initialize the number of parameters:
80  self%parameter_number = 2
81 
82  end subroutine powerlawparametrized1dsetparamnumber
83 
84  ! ---------------------------------------------------------------------------------------------
86  subroutine powerlawparametrized1dinitparams( self, array )
87 
88  implicit none
89 
90  class(power_law_parametrization_1d) :: self
91  real(dl), dimension(self%parameter_number), intent(in) :: array
92 
93  self%coefficient = array(1)
94  self%exponent = array(2)
95 
96  end subroutine powerlawparametrized1dinitparams
97 
98  ! ---------------------------------------------------------------------------------------------
100  subroutine powerlawparametrized1dparametervalues( self, i, value )
101 
102  implicit none
103 
104  class(power_law_parametrization_1d) :: self
105  integer , intent(in) :: i
106  real(dl) , intent(out) :: value
107 
108  select case (i)
109  case(1)
110  value = self%coefficient
111  case(2)
112  value = self%exponent
113  case default
114  write(*,*) 'Illegal index for parameter_names.'
115  write(*,*) 'Maximum value is:', self%parameter_number
116  call mpistop('EFTCAMB error')
117  end select
118 
119  end subroutine powerlawparametrized1dparametervalues
120 
121  ! ---------------------------------------------------------------------------------------------
123  subroutine powerlawparametrized1dfeedback( self, print_params )
124 
125  implicit none
126 
127  class(power_law_parametrization_1d) :: self
128  logical, optional :: print_params
130 
131  integer :: i
132  real(dl) :: param_value
133  character(len=EFT_names_max_length) :: param_name
134  logical :: print_params_temp
135 
136  if ( present(print_params) ) then
137  print_params_temp = print_params
138  else
139  print_params_temp = .true.
140  end if
141 
142  write(*,*) 'Power Law function: ', self%name
143  if ( print_params_temp ) then
144  do i=1, self%parameter_number
145  call self%parameter_names( i, param_name )
146  call self%parameter_value( i, param_value )
147  write(*,'(a23,a,F12.6)') param_name, '=', param_value
148  end do
149  end if
150 
151  end subroutine powerlawparametrized1dfeedback
152 
153  ! ---------------------------------------------------------------------------------------------
155  function powerlawparametrized1dvalue( self, x, eft_cache )
156 
157  implicit none
158 
159  class(power_law_parametrization_1d) :: self
160  real(dl), intent(in) :: x
161  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
162  real(dl) :: powerlawparametrized1dvalue
163 
164  powerlawparametrized1dvalue = self%coefficient*x**self%exponent
165 
166  end function powerlawparametrized1dvalue
167 
168  ! ---------------------------------------------------------------------------------------------
170  function powerlawparametrized1dfirstderivative( self, x, eft_cache )
171 
172  implicit none
173 
174  class(power_law_parametrization_1d) :: self
175  real(dl), intent(in) :: x
176  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
177  real(dl) :: powerlawparametrized1dfirstderivative
178 
179  powerlawparametrized1dfirstderivative = self%coefficient*self%exponent*x**(self%exponent-1._dl)
180 
181  end function powerlawparametrized1dfirstderivative
182 
183  ! ---------------------------------------------------------------------------------------------
185  function powerlawparametrized1dsecondderivative( self, x, eft_cache )
186 
187  implicit none
188 
189  class(power_law_parametrization_1d) :: self
190  real(dl), intent(in) :: x
191  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
192  real(dl) :: powerlawparametrized1dsecondderivative
193 
194  powerlawparametrized1dsecondderivative = self%coefficient*self%exponent*(self%exponent-1._dl)*x**(self%exponent-2._dl)
195 
196  end function powerlawparametrized1dsecondderivative
197 
198  ! ---------------------------------------------------------------------------------------------
200  function powerlawparametrized1dthirdderivative( self, x, eft_cache )
201 
202  implicit none
203 
204  class(power_law_parametrization_1d) :: self
205  real(dl), intent(in) :: x
206  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
207  real(dl) :: powerlawparametrized1dthirdderivative
208 
209  powerlawparametrized1dthirdderivative = self%coefficient*self%exponent*(self%exponent-1._dl)*(self%exponent-2._dl)*x**(self%exponent-3._dl)
210 
211  end function powerlawparametrized1dthirdderivative
212 
213  ! ---------------------------------------------------------------------------------------------
215  function powerlawparametrized1dintegral( self, x, eft_cache )
216 
217  implicit none
218 
219  class(power_law_parametrization_1d) :: self
220  real(dl), intent(in) :: x
221  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
222  real(dl) :: powerlawparametrized1dintegral
223 
224  if ( self%exponent == 0. ) then
225  powerlawparametrized1dintegral = x**(-1._dl -3._dl*self%coefficient)
226  else
227  powerlawparametrized1dintegral = 1._dl/(x*exp((3._dl*(-1._dl + x**self%exponent)*self%coefficient)/self%exponent))
228  end if
229 
230  end function powerlawparametrized1dintegral
231 
232  ! ---------------------------------------------------------------------------------------------
233 
235 
236 !----------------------------------------------------------------------------------------
This module contains the definition of the EFTCAMB caches. These are used to store parameters that ca...
This module contains the definition of the power law parametrization, inheriting from parametrized_fu...
This module contains the definitions of all the EFTCAMB compile time flags.
Definition: 01_EFT_def.f90:25
This module contains the abstract class for generic parametrizations for 1D functions that are used b...