EFTCAMB  Reference documentation for version 3.0
05_abstract_parametrizations_2D.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 
21 
22 
23 !----------------------------------------------------------------------------------------
27 
29 
31 
32  use precision
33  use amlutils
34  use inifile
35  use eft_def
37  use eftcamb_cache
38 
39  implicit none
40 
41  private
42 
43  public parametrized_function_2d
44 
45  !----------------------------------------------------------------------------------------
49  type, abstract :: parametrized_function_2d
50 
51  integer :: parameter_number
52  character(len=:), allocatable :: name
53  character(len=:), allocatable :: name_latex
54  type(string) , allocatable, dimension(:) :: param_names
55  type(string) , allocatable, dimension(:) :: param_names_latex
56 
57  contains
58 
59  ! initialization procedures:
60  procedure( parametrizedfunction2dsetparamnumber ), deferred :: set_param_number
61  procedure :: param_number => parametrizedfunction2dparamnumber
62  procedure :: set_name => parametrizedfunction2dsetname
63  procedure :: set_param_names => parametrizedfunction2dsetparamnames
64  procedure :: init_from_file => parametrizedfunction2dinitfromfile
65  procedure( parametrizedfunction2dinitparams ), deferred :: init_parameters
66  ! utility functions:
67  procedure :: feedback => parametrizedfunction2dfeedback
68  procedure :: parameter_names => parametrizedfunction2dparameternames
69  procedure :: parameter_names_latex => parametrizedfunction2dparameternameslatex
70  procedure( parametrizedfunction2dparametervalues ), deferred :: parameter_value
71  ! evaluation procedures:
72  procedure( parametrizedfunction2dvalue ), deferred :: value
73  procedure( parametrizedfunction2dfirstderivativex ), deferred :: first_derivative_x
74  procedure( parametrizedfunction2dfirstderivativey ), deferred :: first_derivative_y
75  procedure( parametrizedfunction2dsecondderivativex ), deferred :: second_derivative_x
76  procedure( parametrizedfunction2dsecondderivativey ), deferred :: second_derivative_y
77  procedure( parametrizedfunction2dsecondderivativexy ), deferred :: second_derivative_xy
78 
79  end type parametrized_function_2d
80 
81  ! ---------------------------------------------------------------------------------------------
82  ! parametrized_function_2D abstract interfaces: these are all the function procedures
83  ! that the user HAS to override when writing its own parametrized 2D function.
84  ! ---------------------------------------------------------------------------------------------
85 
86  abstract interface
87 
88  ! ---------------------------------------------------------------------------------------------
90  subroutine parametrizedfunction2dsetparamnumber( self )
91  use precision
92  import parametrized_function_2d
93  implicit none
94  class(parametrized_function_2d) :: self
95  end subroutine parametrizedfunction2dsetparamnumber
96 
97  ! ---------------------------------------------------------------------------------------------
99  subroutine parametrizedfunction2dinitparams( self, array )
100  use precision
101  import parametrized_function_2d
102  implicit none
103  class(parametrized_function_2d) :: self
104  real(dl), dimension(self%parameter_number), intent(in) :: array
105  end subroutine parametrizedfunction2dinitparams
106 
107  ! ---------------------------------------------------------------------------------------------
109  subroutine parametrizedfunction2dparametervalues( self, i, value )
110  use precision
111  import parametrized_function_2d
112  implicit none
113  class(parametrized_function_2d) :: self
114  integer , intent(in) :: i
115  real(dl), intent(out) :: value
116  end subroutine parametrizedfunction2dparametervalues
117 
118  ! ---------------------------------------------------------------------------------------------
121  function parametrizedfunction2dvalue( self, x, y, eft_cache )
122  use precision
123  use eftcamb_cache
124  import parametrized_function_2d
125  implicit none
126  class(parametrized_function_2d) :: self
127  real(dl), intent(in) :: x
128  real(dl), intent(in) :: y
129  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
130  real(dl) :: parametrizedfunction2dvalue
131  end function parametrizedfunction2dvalue
132 
133  ! ---------------------------------------------------------------------------------------------
137  function parametrizedfunction2dfirstderivativex( self, x, y, eft_cache )
138  use precision
139  use eftcamb_cache
140  import parametrized_function_2d
141  implicit none
142  class(parametrized_function_2d) :: self
143  real(dl), intent(in) :: x
144  real(dl), intent(in) :: y
145  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
146  real(dl) :: parametrizedfunction2dfirstderivativex
147  end function parametrizedfunction2dfirstderivativex
148 
149  ! ---------------------------------------------------------------------------------------------
153  function parametrizedfunction2dfirstderivativey( self, x, y, eft_cache )
154  use precision
155  use eftcamb_cache
156  import parametrized_function_2d
157  implicit none
158  class(parametrized_function_2d) :: self
159  real(dl), intent(in) :: x
160  real(dl), intent(in) :: y
161  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
162  real(dl) :: parametrizedfunction2dfirstderivativey
163  end function parametrizedfunction2dfirstderivativey
164 
165  ! ---------------------------------------------------------------------------------------------
169  function parametrizedfunction2dsecondderivativex( self, x, y, eft_cache )
170  use precision
171  use eftcamb_cache
172  import parametrized_function_2d
173  implicit none
174  class(parametrized_function_2d) :: self
175  real(dl), intent(in) :: x
176  real(dl), intent(in) :: y
177  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
178  real(dl) :: parametrizedfunction2dsecondderivativex
179  end function parametrizedfunction2dsecondderivativex
180 
181  ! ---------------------------------------------------------------------------------------------
185  function parametrizedfunction2dsecondderivativey( self, x, y, eft_cache )
186  use precision
187  use eftcamb_cache
188  import parametrized_function_2d
189  implicit none
190  class(parametrized_function_2d) :: self
191  real(dl), intent(in) :: x
192  real(dl), intent(in) :: y
193  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
194  real(dl) :: parametrizedfunction2dsecondderivativey
195  end function parametrizedfunction2dsecondderivativey
196 
197  ! ---------------------------------------------------------------------------------------------
201  function parametrizedfunction2dsecondderivativexy( self, x, y, eft_cache )
202  use precision
203  use eftcamb_cache
204  import parametrized_function_2d
205  implicit none
206  class(parametrized_function_2d) :: self
207  real(dl), intent(in) :: x
208  real(dl), intent(in) :: y
209  type(eftcamb_timestep_cache), intent(in), optional :: eft_cache
210  real(dl) :: parametrizedfunction2dsecondderivativexy
211  end function parametrizedfunction2dsecondderivativexy
212 
213  ! ---------------------------------------------------------------------------------------------
214 
215  end interface
216 
217  ! ---------------------------------------------------------------------------------------------
218 
219 contains
220 
221  ! ---------------------------------------------------------------------------------------------
223  function parametrizedfunction2dparamnumber( self )
225  implicit none
226 
227  class(parametrized_function_2d) :: self
228  integer :: ParametrizedFunction2DParamNumber
229 
230  parametrizedfunction2dparamnumber = self%parameter_number
231 
233 
234  ! ---------------------------------------------------------------------------------------------
236  subroutine parametrizedfunction2dsetname( self, name, latexname )
237 
238  implicit none
239 
240  class(parametrized_function_2d) :: self
241  character(*), intent(in) :: name
242  character(*), intent(in), optional :: latexname
243 
244  ! ensure that the number of parameters is properly associated:
245  call self%set_param_number()
246 
247  ! store the name of the function:
248  self%name = trim( name )
249  ! store the latex name of the function:
250  if ( present(latexname) ) then
251  self%name_latex = trim( latexname )
252  else
253  self%name_latex = trim( name )
254  end if
255 
256  end subroutine parametrizedfunction2dsetname
257 
258  ! ---------------------------------------------------------------------------------------------
261  subroutine parametrizedfunction2dsetparamnames( self, param_names, param_names_latex )
262 
263  implicit none
264 
265  class(parametrized_function_2d) :: self
266  character(*), intent(in), dimension(:) :: param_names
267  character(*), intent(in), dimension(:), optional :: param_names_latex
268 
269  integer :: num_params, ind
270 
271  ! ensure that the number of parameters is properly associated:
272  call self%set_param_number()
273 
274  ! check the number of parameters:
275  num_params = self%param_number()
276  if ( num_params /= size(param_names) ) then
277  write(*,*) 'In parametrized_function_1D:', self%name
278  write(*,*) 'Length of param_names and number of parameters do not coincide.'
279  write(*,*) 'Parameter number:', num_params
280  write(*,*) 'Size of the param_names array:', size(param_names)
281  call mpistop('EFTCAMB error')
282  end if
283  if ( present(param_names_latex) ) then
284  ! check length:
285  if ( num_params /= size(param_names_latex) ) then
286  write(*,*) 'In parametrized_function_1D:', self%name
287  write(*,*) 'Length of param_names_latex and number of parameters do not coincide.'
288  write(*,*) 'Parameter number:', self%parameter_number
289  write(*,*) 'Size of the param_names array:', size(param_names_latex)
290  call mpistop('EFTCAMB error')
291  end if
292  end if
293 
294  ! allocate self%param_names and self%param_names_latex:
295  if ( allocated(self%param_names) ) deallocate(self%param_names)
296  allocate( self%param_names(num_params) )
297  if ( allocated(self%param_names_latex) ) deallocate(self%param_names_latex)
298  allocate( self%param_names_latex(num_params) )
299 
300  ! store the parameter names and latex param names:
301  do ind=1, num_params
302  self%param_names(ind)%string = param_names(ind)
303  if ( present(param_names_latex) ) then
304  self%param_names_latex(ind)%string = param_names_latex(ind)
305  else
306  self%param_names_latex(ind)%string = param_names(ind)
307  end if
308  end do
309 
310  end subroutine parametrizedfunction2dsetparamnames
311 
312  ! ---------------------------------------------------------------------------------------------
314  subroutine parametrizedfunction2dinitfromfile( self, Ini )
315 
316  implicit none
317 
318  class(parametrized_function_2d) :: self
319  type(tinifile) :: Ini
320 
321  character(len=EFT_names_max_length) :: param_name
322  real(dl), dimension( self%parameter_number ) :: parameters
323 
324  integer :: i
325 
326  ! ensure that the number of parameters is properly associated:
327  call self%set_param_number()
328 
329  ! read the parameters and store them in a vector:
330  do i=1, self%parameter_number
331  call self%parameter_names( i, param_name )
332  parameters(i) = ini_read_double_file( ini, trim(param_name), 0._dl )
333  end do
334  ! initialize the function parameters from the vector:
335  call self%init_parameters( parameters )
336 
337  end subroutine parametrizedfunction2dinitfromfile
338 
339  ! ---------------------------------------------------------------------------------------------
341  subroutine parametrizedfunction2dfeedback( self, print_params )
342 
343  implicit none
344 
345  class(parametrized_function_2d) :: self
346  logical, optional :: print_params
348 
349  integer :: i
350  real(dl) :: param_value
351  character(len=EFT_names_max_length) :: param_name
352 
353  if ( .not. present(print_params) ) print_params = .true.
354 
355  if ( self%parameter_number>0 ) then
356  write(*,*) 'Parametrized function 2D: ', self%name
357  if ( print_params ) then
358  do i=1, self%parameter_number
359  call self%parameter_names( i, param_name )
360  call self%parameter_value( i, param_value )
361  write(*,'(a23,a,F12.6)') param_name, '=', param_value
362  end do
363  end if
364  end if
365 
366  end subroutine parametrizedfunction2dfeedback
367 
368  ! ---------------------------------------------------------------------------------------------
370  subroutine parametrizedfunction2dparameternames( self, i, name )
371 
372  implicit none
373 
374  class(parametrized_function_2d) :: self
375  integer , intent(in) :: i
376  character(*), intent(out) :: name
377 
378  ! check the input index:
379  if ( i>self%parameter_number ) then
380  write(*,*) 'In parametrized_function_2D:', self%name
381  write(*,*) 'Illegal index for parameter_names.'
382  write(*,*) 'Maximum value is:', self%parameter_number
383  call mpistop('EFTCAMB error')
384  end if
385  ! return the parameter name:
386  if ( allocated(self%param_names) ) then
387  name = self%param_names(i)%string
388  else
389  name = trim(self%name)//integer_to_string(i-1)
390  end if
391 
392  end subroutine parametrizedfunction2dparameternames
393 
394  ! ---------------------------------------------------------------------------------------------
396  subroutine parametrizedfunction2dparameternameslatex( self, i, latexname )
397 
398  implicit none
399 
400  class(parametrized_function_2d) :: self
401  integer , intent(in) :: i
402  character(*), intent(out) :: latexname
403 
404  ! check the input index:
405  if ( i>self%parameter_number ) then
406  write(*,*) 'In parametrized_function_2D:', self%name
407  write(*,*) 'Illegal index for parameter_names.'
408  write(*,*) 'Maximum value is:', self%parameter_number
409  call mpistop('EFTCAMB error')
410  end if
411  ! return the parameter name:
412  if ( allocated(self%param_names_latex) ) then
413  latexname = self%param_names_latex(i)%string
414  else
415  latexname = trim(self%name)//'_'//integer_to_string(i-1)
416  end if
417 
418  end subroutine parametrizedfunction2dparameternameslatex
419 
420  !----------------------------------------------------------------------------------------
421 
423 
424 !----------------------------------------------------------------------------------------
This module contains the definition of the EFTCAMB caches. These are used to store parameters that ca...
This module contains the abstract class for generic parametrizations for 2D functions that are used b...
This module contains various generic algorithms that are useful to EFTCAMB.
integer function parametrizedfunction2dparamnumber(self)
Function that returns the number of parameters of the parametrized function.
character(10) function, public integer_to_string(number)
This function converts an integer to a string. Usefull for numbered files output. ...
This module contains the definitions of all the EFTCAMB compile time flags.
Definition: 01_EFT_def.f90:25