EFTCAMB  Reference documentation for version 3.0
04p8_taylor_expansion_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 taylor_parametrization_1d
40 
41  ! ---------------------------------------------------------------------------------------------
43  type, extends ( parametrized_function_1d ) :: taylor_parametrization_1d
44 
45  real(dl) :: w0
46  real(dl) :: wa
47  real(dl) :: w2
48  real(dl) :: w3
49 
50  contains
51 
52  ! utility functions:
53  procedure :: set_param_number => taylorparametrized1dsetparamnumber
54  procedure :: init_parameters => taylorparametrized1dinitparams
55  procedure :: parameter_value => taylorparametrized1dparametervalues
56  procedure :: feedback => taylorparametrized1dfeedback
57 
58  ! evaluation procedures:
59  procedure :: value => taylorparametrized1dvalue
60  procedure :: first_derivative => taylorparametrized1dfirstderivative
61  procedure :: second_derivative => taylorparametrized1dsecondderivative
62  procedure :: third_derivative => taylorparametrized1dthirdderivative
63  procedure :: integral => taylorparametrized1dintegral
64 
65  end type taylor_parametrization_1d
66 
67 contains
68 
69  ! ---------------------------------------------------------------------------------------------
70  ! Implementation of the Taylor expansion parametrization.
71  ! ---------------------------------------------------------------------------------------------
72 
73  ! ---------------------------------------------------------------------------------------------
75  subroutine taylorparametrized1dsetparamnumber( self )
76 
77  implicit none
78 
79  class(taylor_parametrization_1d) :: self
80 
81  ! initialize the number of parameters:
82  self%parameter_number = 4
83 
84  end subroutine taylorparametrized1dsetparamnumber
85 
86  ! ---------------------------------------------------------------------------------------------
88  subroutine taylorparametrized1dinitparams( self, array )
89 
90  implicit none
91 
92  class(taylor_parametrization_1d) :: self
93  real(dl), dimension(self%parameter_number), intent(in) :: array
94 
95  self%w0 = array(1)
96  self%wa = array(2)
97  self%w2 = array(3)
98  self%w3 = array(4)
99 
100  end subroutine taylorparametrized1dinitparams
101 
102  ! ---------------------------------------------------------------------------------------------
104  subroutine taylorparametrized1dparametervalues( self, i, value )
105 
106  implicit none
107 
108  class(taylor_parametrization_1d) :: self
109  integer , intent(in) :: i
110  real(dl) , intent(out) :: value
111 
112  select case (i)
113  case(1)
114  value = self%w0
115  case(2)
116  value = self%wa
117  case(3)
118  value = self%w2
119  case(4)
120  value = self%w3
121  case default
122  write(*,*) 'Illegal index for parameter_names.'
123  write(*,*) 'Maximum value is:', self%parameter_number
124  call mpistop('EFTCAMB error')
125  end select
126 
127  end subroutine taylorparametrized1dparametervalues
128 
129  ! ---------------------------------------------------------------------------------------------
131  subroutine taylorparametrized1dfeedback( self, print_params )
132 
133  implicit none
134 
135  class(taylor_parametrization_1d) :: self
136  logical, optional :: print_params
138 
139  integer :: i
140  real(dl) :: param_value
141  character(len=EFT_names_max_length) :: param_name
142  logical :: print_params_temp
143 
144  if ( present(print_params) ) then
145  print_params_temp = print_params
146  else
147  print_params_temp = .true.
148  end if
149 
150  write(*,*) 'Taylor expansion parametrization: ', self%name
151  if ( print_params_temp ) then
152  do i=1, self%parameter_number
153  call self%parameter_names( i, param_name )
154  call self%parameter_value( i, param_value )
155  write(*,'(a23,a,F12.6)') param_name, '=', param_value
156  end do
157  end if
158 
159  end subroutine taylorparametrized1dfeedback
160 
161  ! ---------------------------------------------------------------------------------------------
163  function taylorparametrized1dvalue( self, x, eft_cache )
164 
165  implicit none
166 
167  class(taylor_parametrization_1d) :: self
168  real(dl), intent(in) :: x
169  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
170  real(dl) :: taylorparametrized1dvalue
171 
172  taylorparametrized1dvalue = self%w0 +self%wa*x +0.5_dl*self%w2*x**2 +self%w3/6._dl*x**3
173 
174  end function taylorparametrized1dvalue
175 
176  ! ---------------------------------------------------------------------------------------------
178  function taylorparametrized1dfirstderivative( self, x, eft_cache )
179 
180  implicit none
181 
182  class(taylor_parametrization_1d) :: self
183  real(dl), intent(in) :: x
184  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
185  real(dl) :: taylorparametrized1dfirstderivative
186 
187  taylorparametrized1dfirstderivative = self%wa +self%w2*x +0.5_dl*self%w3*x**2
188 
189 
190  end function taylorparametrized1dfirstderivative
191 
192  ! ---------------------------------------------------------------------------------------------
194  function taylorparametrized1dsecondderivative( self, x, eft_cache )
195 
196  implicit none
197 
198  class(taylor_parametrization_1d) :: self
199  real(dl), intent(in) :: x
200  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
201  real(dl) :: taylorparametrized1dsecondderivative
202 
203  taylorparametrized1dsecondderivative = self%w2 +self%w3*x
204 
205  end function taylorparametrized1dsecondderivative
206 
207  ! ---------------------------------------------------------------------------------------------
209  function taylorparametrized1dthirdderivative( self, x, eft_cache )
210 
211  implicit none
212 
213  class(taylor_parametrization_1d) :: self
214  real(dl), intent(in) :: x
215  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
216  real(dl) :: taylorparametrized1dthirdderivative
217 
218  taylorparametrized1dthirdderivative = self%w3
219 
220  end function taylorparametrized1dthirdderivative
221 
222  ! ---------------------------------------------------------------------------------------------
224  function taylorparametrized1dintegral( self, x, eft_cache )
225 
226  implicit none
227 
228  class(taylor_parametrization_1d) :: self
229  real(dl), intent(in) :: x
230  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
231  real(dl) :: taylorparametrized1dintegral
232 
233  taylorparametrized1dintegral = x**(-1._dl -3._dl*self%w0)*exp(-1._dl/12._dl*(x -1._dl)*(9._dl*(1._dl+x)*self%w2 +2._dl*(1._dl +x +x**2)*self%w3 +36._dl*self%wa))
234 
235  end function taylorparametrized1dintegral
236 
237  ! ---------------------------------------------------------------------------------------------
238 
240 
241 !----------------------------------------------------------------------------------------
This module contains the definition of the Taylor expansion parametrization, around a=0...
This module contains the definition of the EFTCAMB caches. These are used to store parameters that ca...
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...