EFTCAMB  Reference documentation for version 3.0
10p1_Horava.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 inifile
31  use amlutils
32  use eftcamb_cache
33  use eft_def
35 
36  implicit none
37 
38  private
39 
40  public eftcamb_horava
41 
42  !----------------------------------------------------------------------------------------
44  type, extends ( eftcamb_designer_model ) :: eftcamb_horava
45 
46  ! the model selection flag:
47  logical :: horavasolarsystem
49 
50  ! the model parameters:
51  real(dl) :: horava_eta
52  real(dl) :: horava_xi
53  real(dl) :: horava_lambda
54 
55  contains
56 
57  ! initialization of the model:
58  procedure :: read_model_selection => eftcambhoravareadmodelselectionfromfile
59  procedure :: allocate_model_selection => eftcambhoravaallocatemodelselection
60  procedure :: init_model_parameters => eftcambhoravainitmodelparameters
61  procedure :: init_model_parameters_from_file => eftcambhoravainitmodelparametersfromfile
62  ! utility functions:
63  procedure :: compute_param_number => eftcambhoravacomputeparametersnumber
64  procedure :: feedback => eftcambhoravafeedback
65  procedure :: parameter_names => eftcambhoravaparameternames
66  procedure :: parameter_names_latex => eftcambhoravaparameternameslatex
67  procedure :: parameter_values => eftcambhoravaparametervalues
68  ! CAMB related procedures:
69  procedure :: compute_background_eft_functions => eftcambhoravabackgroundeftfunctions
70  procedure :: compute_secondorder_eft_functions => eftcambhoravasecondordereftfunctions
71  procedure :: compute_dtauda => eftcambhoravacomputedtauda
72  procedure :: compute_adotoa => eftcambhoravacomputeadotoa
73  procedure :: compute_h_derivs => eftcambhoravacomputehubbleder
74  procedure :: compute_pi_factors => eftcambhoravacomputepifactors
75  ! stability procedures:
76  procedure :: additional_model_stability => eftcambhoravaadditionalmodelstability
77 
78  end type eftcamb_horava
79 
80  ! ---------------------------------------------------------------------------------------------
81 
82 contains
83 
84  ! ---------------------------------------------------------------------------------------------
86  subroutine eftcambhoravareadmodelselectionfromfile( self, Ini )
87 
88  implicit none
89 
90  class(eftcamb_horava) :: self
91  type(tinifile) :: ini
92 
93  ! read model selection flags:
94  self%HoravaSolarSystem = ini_read_logical_file( ini, 'HoravaSolarSystem', .false. )
95 
96  end subroutine eftcambhoravareadmodelselectionfromfile
97 
98  ! ---------------------------------------------------------------------------------------------
100  subroutine eftcambhoravaallocatemodelselection( self )
101 
102  implicit none
103 
104  class(eftcamb_horava) :: self
105 
106  end subroutine eftcambhoravaallocatemodelselection
107 
108  ! ---------------------------------------------------------------------------------------------
110  subroutine eftcambhoravainitmodelparameters( self, array )
111 
112  implicit none
113 
114  class(eftcamb_horava) :: self
115  real(dl), dimension(self%parameter_number), intent(in) :: array
116 
117  real(dl), allocatable, dimension(:) :: temp
118  integer :: num_params_function, num_params_temp, i
119 
120  if ( self%HoravaSolarSystem ) then
121  self%Horava_eta = array(1)
122  self%Horava_lambda = array(2)
123  self%Horava_xi = 0.5_dl*self%Horava_eta
124  else
125  self%Horava_eta = array(1)
126  self%Horava_lambda = array(2)
127  self%Horava_xi = array(3)
128  end if
129 
130  end subroutine eftcambhoravainitmodelparameters
131 
132  ! ---------------------------------------------------------------------------------------------
134  subroutine eftcambhoravainitmodelparametersfromfile( self, Ini )
135 
136  implicit none
137 
138  class(eftcamb_horava) :: self
139  type(tinifile) :: ini
140 
141  self%Horava_eta = ini_read_double_file( ini, 'Horava_eta' , 0._dl )
142  self%Horava_lambda = ini_read_double_file( ini, 'Horava_lambda', 0._dl )
143  if ( self%HoravaSolarSystem ) then
144  self%Horava_xi = 0.5_dl*self%Horava_eta
145  else
146  self%Horava_xi = ini_read_double_file( ini, 'Horava_xi' , 0._dl )
147  end if
148 
149  end subroutine eftcambhoravainitmodelparametersfromfile
150 
151  ! ---------------------------------------------------------------------------------------------
153  subroutine eftcambhoravacomputeparametersnumber( self )
154 
155  implicit none
156 
157  class(eftcamb_horava) :: self
158 
159  if ( self%HoravaSolarSystem ) then
160  self%parameter_number = 2
161  else
162  self%parameter_number = 3
163  end if
164 
165  end subroutine eftcambhoravacomputeparametersnumber
166 
167  ! ---------------------------------------------------------------------------------------------
169  subroutine eftcambhoravafeedback( self, print_params )
170 
171  implicit none
172 
173  class(eftcamb_horava) :: self
174  logical, optional :: print_params
176 
177  logical :: print_params_temp
178 
179  ! print general model informations:
180  write(*,*)
181  write(*,'(a,a)') ' Model = ', self%name
182  write(*,'(a,I3)') ' Number of params =' , self%parameter_number
183 
184  if ( self%HoravaSolarSystem ) then
185  write(*,'(a)') ' Horava with solar system constraints'
186  end if
187 
188  ! print the values of the parameters:
189  if ( present(print_params) ) then
190  print_params_temp = print_params
191  else
192  print_params_temp = .true.
193  end if
194 
195  if ( print_params_temp ) then
196  write(*,*)
197  write(*,'(a23,a,F12.6)') ' Horava_eta ', '=', self%Horava_eta
198  write(*,'(a23,a,F12.6)') ' Horava_lambda ', '=', self%Horava_lambda
199  if ( .not. self%HoravaSolarSystem ) then
200  write(*,'(a23,a,F12.6)') ' Horava_xi ', '=', self%Horava_xi
201  end if
202  end if
203 
204  end subroutine eftcambhoravafeedback
205 
206  ! ---------------------------------------------------------------------------------------------
208  subroutine eftcambhoravaparameternames( self, i, name )
209 
210  implicit none
211 
212  class(eftcamb_horava) :: self
213  integer , intent(in) :: i
214  character(*), intent(out) :: name
215 
216  ! check the input index:
217  if ( i>self%parameter_number ) then
218  write(*,*) 'Illegal index for parameter_names.'
219  write(*,*) 'Maximum value is:', self%parameter_number
220  call mpistop('EFTCAMB error')
221  end if
222  ! return the appropriate name:
223  if ( i==1 ) then
224  name = 'Horava_eta'
225  return
226  end if
227  if ( i==2 ) then
228  name = 'Horava_lambda'
229  return
230  end if
231  if ( i==3 .and. self%HoravaSolarSystem ) then
232  name = 'Horava_xi'
233  return
234  end if
235 
236  end subroutine eftcambhoravaparameternames
237 
238  ! ---------------------------------------------------------------------------------------------
240  subroutine eftcambhoravaparameternameslatex( self, i, latexname )
241 
242  implicit none
243 
244  class(eftcamb_horava) :: self
245  integer , intent(in) :: i
246  character(*), intent(out) :: latexname
247 
248  ! check the input index:
249  if ( i>self%parameter_number ) then
250  write(*,*) 'Illegal index for parameter_names_latex.'
251  write(*,*) 'Maximum value is:', self%parameter_number
252  call mpistop('EFTCAMB error')
253  end if
254  ! return the appropriate name:
255  if ( i==1 ) then
256  latexname = '\eta_{\rm Ho\v rava}'
257  return
258  end if
259  if ( i==2 ) then
260  latexname = '\lambda_{\rm Ho\v rava}'
261  return
262  end if
263  if ( i==3 .and. self%HoravaSolarSystem ) then
264  latexname = '\xi_{\rm Ho\v rava}'
265  return
266  end if
267 
268  end subroutine eftcambhoravaparameternameslatex
269 
270  ! ---------------------------------------------------------------------------------------------
272  subroutine eftcambhoravaparametervalues( self, i, value )
273 
274  implicit none
275 
276  class(eftcamb_horava) :: self
277  integer , intent(in) :: i
278  real(dl), intent(out) :: value
279 
280  ! check the input index:
281  if ( i>self%parameter_number ) then
282  write(*,*) 'Illegal index for parameter_value.'
283  write(*,*) 'Maximum value is:', self%parameter_number
284  call mpistop('EFTCAMB error')
285  end if
286  ! return the appropriate name:
287  if ( i==1 ) then
288  value = self%Horava_eta
289  return
290  end if
291  if ( i==2 ) then
292  value = self%Horava_lambda
293  return
294  end if
295  if ( i==3 .and. self%HoravaSolarSystem ) then
296  value = self%Horava_xi
297  return
298  end if
299 
300  end subroutine eftcambhoravaparametervalues
301 
302  ! ---------------------------------------------------------------------------------------------
304  subroutine eftcambhoravabackgroundeftfunctions( self, a, eft_par_cache, eft_cache )
305 
306  implicit none
307 
308  class(eftcamb_horava) :: self
309  real(dl), intent(in) :: a
310  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
311  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
312 
313  ! compute the EFT functions:
314  eft_cache%EFTOmegaV = self%Horava_eta/( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )
315  eft_cache%EFTOmegaP = 0._dl
316  eft_cache%EFTOmegaPP = 0._dl
317  eft_cache%EFTOmegaPPP = 0._dl
318  eft_cache%EFTc = -( 2._dl*self%Horava_xi -3._dl*self%Horava_lambda )*( eft_cache%Hdot -eft_cache%adotoa**2 )/( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )
319  eft_cache%EFTLambda = -eft_cache%grhov_t + 2._dl*( 3._dl*self%Horava_lambda - 2._dl*self%Horava_xi)*&
320  &( 0.5_dl*eft_cache%adotoa**2 + eft_cache%Hdot)/( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )
321  eft_cache%EFTcdot = ( 3._dl*self%Horava_lambda - 2._dl*self%Horava_xi )*&
322  &( eft_cache%Hdotdot -4._dl*eft_cache%adotoa*eft_cache%Hdot + 2._dl*eft_cache%adotoa**3 )/( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )
323  eft_cache%EFTLambdadot = +2._dl*( 3._dl*self%Horava_lambda -2._dl*self%Horava_xi)*&
324  &( eft_cache%Hdotdot -eft_cache%adotoa*eft_cache%Hdot -eft_cache%adotoa**3 )/( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )
325 
326  end subroutine eftcambhoravabackgroundeftfunctions
327 
328  ! ---------------------------------------------------------------------------------------------
330  subroutine eftcambhoravasecondordereftfunctions( self, a, eft_par_cache, eft_cache )
331 
332  implicit none
333 
334  class(eftcamb_horava) :: self
335  real(dl), intent(in) :: a
336  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
337  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
338 
339  ! compute the EFT functions:
340  eft_cache%EFTGamma1V = 0._dl
341  eft_cache%EFTGamma1P = 0._dl
342  eft_cache%EFTGamma2V = 0._dl
343  eft_cache%EFTGamma2P = 0._dl
344  eft_cache%EFTGamma3V = 2._dl*(self%Horava_lambda -self%Horava_xi)/( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )
345  eft_cache%EFTGamma3P = 0._dl
346  eft_cache%EFTGamma4V = 2._dl*self%Horava_xi/( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )
347  eft_cache%EFTGamma4P = 0._dl
348  eft_cache%EFTGamma4PP = 0._dl
349  eft_cache%EFTGamma5V = 0._dl
350  eft_cache%EFTGamma5P = 0._dl
351  eft_cache%EFTGamma6V = self%Horava_eta/4._dl/( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )
352  eft_cache%EFTGamma6P = 0._dl
353 
354  end subroutine eftcambhoravasecondordereftfunctions
355 
356  ! ---------------------------------------------------------------------------------------------
359  function eftcambhoravacomputedtauda( self, a, eft_par_cache, eft_cache )
360 
361  implicit none
362 
363  class(eftcamb_horava) :: self
364  real(dl), intent(in) :: a
365  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
366  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
367 
368  real(dl) :: eftcambhoravacomputedtauda
369 
370  real(dl) :: temp
371 
372  temp = eft_cache%grhoa2 +a**4*( eft_par_cache%grhov &
373  & +3._dl*eft_par_cache%h0_Mpc**2*( (self%Horava_eta +3._dl*self%Horava_lambda-2._dl*self%Horava_xi)/(2._dl*self%Horava_xi+2._dl-self%Horava_eta)))
374  eftcambhoravacomputedtauda = sqrt(3/temp)/sqrt(( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )/(3._dl*self%Horava_lambda +2._dl))
375 
376  end function eftcambhoravacomputedtauda
377 
378  ! ---------------------------------------------------------------------------------------------
380  subroutine eftcambhoravacomputeadotoa( self, a, eft_par_cache, eft_cache )
381 
382  implicit none
383 
384  class(eftcamb_horava) :: self
385  real(dl), intent(in) :: a
386  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
387  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
388 
389  eft_cache%grhov_t = ( eft_par_cache%grhov &
390  & +3._dl*eft_par_cache%h0_Mpc**2*((self%Horava_eta +3._dl*self%Horava_lambda -2._dl*self%Horava_xi)/(2._dl*self%Horava_xi +2._dl -self%Horava_eta)))*a**2
391  eft_cache%adotoa = sqrt( ( eft_cache%grhom_t +eft_cache%grhov_t )/3._dl )
392  eft_cache%adotoa = eft_cache%adotoa*sqrt(( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )/(3._dl*self%Horava_lambda +2._dl))
393 
394  end subroutine eftcambhoravacomputeadotoa
395 
396  ! ---------------------------------------------------------------------------------------------
398  subroutine eftcambhoravacomputehubbleder( self, a, eft_par_cache, eft_cache )
399 
400  implicit none
401 
402  class(eftcamb_horava) :: self
403  real(dl), intent(in) :: a
404  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
405  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
406 
407  eft_cache%gpiv_t = -eft_cache%grhov_t
408  eft_cache%Hdot = -0.5_dl*( eft_cache%adotoa**2 +eft_cache%gpresm_t +eft_cache%gpiv_t )
409  eft_cache%Hdotdot = eft_cache%adotoa*( ( eft_cache%grhob_t +eft_cache%grhoc_t)/6._dl +2._dl*( eft_cache%grhor_t +eft_cache%grhog_t)/3._dl ) &
410  & +2._dl*eft_cache%adotoa*eft_cache%grhov_t/3._dl &
411  & +eft_cache%adotoa*eft_cache%grhonu_tot/6._dl -0.5_dl*eft_cache%adotoa*eft_cache%gpinu_tot -0.5_dl*eft_cache%gpinudot_tot
412 
413  eft_cache%Hdot = eft_cache%Hdot*sqrt(( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )/(3._dl*self%Horava_lambda +2._dl))
414  eft_cache%Hdotdot = eft_cache%Hdotdot*sqrt(( 2._dl +2._dl*self%Horava_xi -self%Horava_eta )/(3._dl*self%Horava_lambda +2._dl))
415 
416  end subroutine eftcambhoravacomputehubbleder
417 
418  ! ---------------------------------------------------------------------------------------------
420  subroutine eftcambhoravacomputepifactors( self, a, eft_par_cache, eft_cache )
421 
422  implicit none
423 
424  class(eftcamb_horava) :: self
425  real(dl), intent(in) :: a
426  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
427  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
428 
429  eft_cache%EFTpiA1 = 0._dl
430  eft_cache%EFTpiA2 = 0.5_dl*self%Horava_eta
431  eft_cache%EFTpiB1 = 0._dl
432  eft_cache%EFTpiB2 = eft_cache%adotoa*self%Horava_eta
433  eft_cache%EFTpiC = 0._dl
434  eft_cache%EFTpiD1 = 0.5_dl*( 3._dl*self%Horava_lambda -2._dl*self%Horava_xi)*( eft_cache%adotoa**2 -eft_cache%Hdot ) + 0.5_dl*self%Horava_eta*( eft_cache%adotoa**2 +eft_cache%Hdot )
435  eft_cache%EFTpiD2 = 0.5_dl*self%Horava_lambda*(1._dl+self%Horava_xi)
436  eft_cache%EFTpiE = 0.5_dl*eft_cache%k**2*self%Horava_lambda*( 1._dl +self%Horava_xi )*eft_cache%k*eft_cache%z + 0.5_dl*eft_cache%k*self%Horava_xi*eft_cache%dgq
437 
438  end subroutine eftcambhoravacomputepifactors
439 
440  ! ---------------------------------------------------------------------------------------------
442  function eftcambhoravaadditionalmodelstability( self, a, eft_par_cache, eft_cache )
443 
444  implicit none
445 
446  class(eftcamb_horava) :: self
447  real(dl), intent(in) :: a
448  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
449  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
450 
451  logical :: eftcambhoravaadditionalmodelstability
452 
453  eftcambhoravaadditionalmodelstability = .true.
454 
455  if ( self%Horava_lambda > -2._dl/3._dl .and. self%Horava_lambda < 0._dl ) then
456  eftcambhoravaadditionalmodelstability = .false.
457  end if
458  if ( self%Horava_eta < 0._dl .or. self%Horava_eta > 2._dl*self%Horava_xi +2._dl ) then
459  eftcambhoravaadditionalmodelstability = .false.
460  end if
461 
462  end function eftcambhoravaadditionalmodelstability
463 
464  ! ---------------------------------------------------------------------------------------------
465 
466 end module eftcamb_le_horava
This module contains the definition of the EFTCAMB caches. These are used to store parameters that ca...
This module contains the definition of low energy (LE) Horava gravity. Please refer to the numerical ...
Definition: 10p1_Horava.f90:27
This module contains the abstract definition of all the places where EFTCAMB interacts with CAMB in c...
This module contains the definitions of all the EFTCAMB compile time flags.
Definition: 01_EFT_def.f90:25