EFTCAMB  Reference documentation for version 3.0
06_abstract_EFTCAMB_model.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 
20 
21 
22 !----------------------------------------------------------------------------------------
26 
28 
30 
31  use precision
32  use inifile
33  use eftcamb_cache
34 
35  implicit none
36 
37  private
38 
39  public eftcamb_model
40 
41  !----------------------------------------------------------------------------------------
45  type, abstract :: eftcamb_model
46 
47  integer :: parameter_number
48  character(len=:), allocatable :: name
49  character(len=:), allocatable :: name_latex
50 
51  contains
52 
53  ! initialization of the model:
54  procedure :: init => eftcambmodelinitialize
55  procedure(eftcambmodelreadmodelselectionfromfile ), deferred :: read_model_selection
56  procedure(eftcambmodelallocatemodelselection ), deferred :: allocate_model_selection
57  procedure(eftcambmodelinitmodelparameters ), deferred :: init_model_parameters
58  procedure(eftcambmodelinitmodelparametersfromfile ), deferred :: init_model_parameters_from_file
59 
60  ! utility functions:
61  procedure(eftcambmodelcomputeparametersnumber ), deferred :: compute_param_number
62  procedure(eftcambmodelfeedback ), deferred :: feedback
63  procedure(eftcambmodelparameternames ), deferred :: parameter_names
64  procedure(eftcambmodelparameternameslatex ), deferred :: parameter_names_latex
65  procedure(eftcambmodelparametervalues ), deferred :: parameter_values
66 
67  ! background initialization functions:
68  procedure :: initialize_background => eftcambmodelinitbackground
69 
70  ! CAMB related procedures:
71  procedure(eftcambmodelbackgroundeftfunctions ), deferred :: compute_background_eft_functions
72  procedure(eftcambmodelsecondordereftfunctions), deferred :: compute_secondorder_eft_functions
73  procedure(eftcambmodelcomputedtauda ), deferred :: compute_dtauda
74  procedure(eftcambmodelcomputeadotoa ), deferred :: compute_adotoa
75  procedure(eftcambmodelcomputehubbleder ), deferred :: compute_h_derivs
76 
77  procedure :: compute_rhoqpq => eftcambmodelcomputerhoqpq
78  procedure :: compute_einstein_factors => eftcambmodelcomputeeinsteinfactors
79  procedure :: compute_pi_factors => eftcambmodelcomputepifactors
80  procedure :: compute_tensor_factors => eftcambmodelcomputetensorfactors
81  procedure :: compute_stability_factors => eftcambmodelcomputestabilityfactors
82 
83  ! stability procedures:
84  procedure :: additional_model_stability => eftcambmodeladditionalmodelstability
85 
86  end type eftcamb_model
87 
88  ! ---------------------------------------------------------------------------------------------
89  ! EFTCAMB abstract interfaces: these are all the model procedures that the user HAS to override
90  ! when writing its own model.
91  ! ---------------------------------------------------------------------------------------------
92 
93  abstract interface
94 
95  ! ---------------------------------------------------------------------------------------------
97  subroutine eftcambmodelcomputeparametersnumber( self )
98  import eftcamb_model
99  implicit none
100  class(eftcamb_model) :: self
101  end subroutine eftcambmodelcomputeparametersnumber
102 
103  ! ---------------------------------------------------------------------------------------------
105  subroutine eftcambmodelreadmodelselectionfromfile( self, Ini )
106  use inifile
107  import eftcamb_model
108  implicit none
109  class(eftcamb_model) :: self
110  type(tinifile) :: ini
111  end subroutine eftcambmodelreadmodelselectionfromfile
112 
113  ! ---------------------------------------------------------------------------------------------
115  subroutine eftcambmodelallocatemodelselection( self )
116  import eftcamb_model
117  implicit none
118  class(eftcamb_model) :: self
119  end subroutine eftcambmodelallocatemodelselection
120 
121  ! ---------------------------------------------------------------------------------------------
123  subroutine eftcambmodelinitmodelparameters( self, array )
124  use precision
125  import eftcamb_model
126  implicit none
127  class(eftcamb_model) :: self
128  real(dl), dimension(self%parameter_number), intent(in) :: array
129  end subroutine eftcambmodelinitmodelparameters
130 
131  ! ---------------------------------------------------------------------------------------------
133  subroutine eftcambmodelinitmodelparametersfromfile( self, Ini )
134  use inifile
135  import eftcamb_model
136  implicit none
137  class(eftcamb_model) :: self
138  type(tinifile) :: ini
139  end subroutine eftcambmodelinitmodelparametersfromfile
140 
141  ! ---------------------------------------------------------------------------------------------
143  subroutine eftcambmodelfeedback( self, print_params )
144  import eftcamb_model
145  implicit none
146  class(eftcamb_model) :: self
147  logical, optional :: print_params
149  end subroutine eftcambmodelfeedback
150 
151  ! ---------------------------------------------------------------------------------------------
153  subroutine eftcambmodelparameternames( self, i, name )
154  import eftcamb_model
155  implicit none
156  class(eftcamb_model) :: self
157  integer , intent(in) :: i
158  character(*), intent(out) :: name
159  end subroutine eftcambmodelparameternames
160 
161  ! ---------------------------------------------------------------------------------------------
163  subroutine eftcambmodelparameternameslatex( self, i, latexname )
164  import eftcamb_model
165  implicit none
166  class(eftcamb_model) :: self
167  integer , intent(in) :: i
168  character(*), intent(out) :: latexname
169  end subroutine eftcambmodelparameternameslatex
170 
171  ! ---------------------------------------------------------------------------------------------
173  subroutine eftcambmodelparametervalues( self, i, value )
174  use precision
175  import eftcamb_model
176  implicit none
177  class(eftcamb_model) :: self
178  integer , intent(in) :: i
179  real(dl), intent(out) :: value
180  end subroutine eftcambmodelparametervalues
181 
182  ! ---------------------------------------------------------------------------------------------
184  subroutine eftcambmodelbackgroundeftfunctions( self, a, eft_par_cache, eft_cache )
185  use precision
186  use eftcamb_cache
187  import eftcamb_model
188  implicit none
189  class(eftcamb_model) :: self
190  real(dl), intent(in) :: a
191  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
192  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
193  end subroutine eftcambmodelbackgroundeftfunctions
194 
195  ! ---------------------------------------------------------------------------------------------
197  subroutine eftcambmodelsecondordereftfunctions( self, a, eft_par_cache, eft_cache )
198  use precision
199  use eftcamb_cache
200  import eftcamb_model
201  implicit none
202  class(eftcamb_model) :: self
203  real(dl), intent(in) :: a
204  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
205  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
206  end subroutine eftcambmodelsecondordereftfunctions
207 
208  ! ---------------------------------------------------------------------------------------------
210  function eftcambmodelcomputedtauda( self, a, eft_par_cache, eft_cache )
211  use precision
212  use eftcamb_cache
213  import eftcamb_model
214  implicit none
215  class(eftcamb_model) :: self
216  real(dl), intent(in) :: a
217  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
218  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
219  real(dl) :: eftcambmodelcomputedtauda
220  end function eftcambmodelcomputedtauda
221 
222  ! ---------------------------------------------------------------------------------------------
224  subroutine eftcambmodelcomputeadotoa( self, a, eft_par_cache, eft_cache )
225  use precision
226  use eftcamb_cache
227  import eftcamb_model
228  implicit none
229  class(eftcamb_model) :: self
230  real(dl), intent(in) :: a
231  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
232  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
233  end subroutine eftcambmodelcomputeadotoa
234 
235  ! ---------------------------------------------------------------------------------------------
237  subroutine eftcambmodelcomputehubbleder( self, a, eft_par_cache, eft_cache )
238  use precision
239  use eftcamb_cache
240  import eftcamb_model
241  implicit none
242  class(eftcamb_model) :: self
243  real(dl), intent(in) :: a
244  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
245  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
246  end subroutine eftcambmodelcomputehubbleder
247 
248  ! ---------------------------------------------------------------------------------------------
249 
250  end interface
251 
252 contains
253 
254  ! ---------------------------------------------------------------------------------------------
255  ! EFTCAMB abstract model implementation: the following are all the procedures that can be
256  ! be safely implemented for the abstract class and are not harmful if not overritten.
257  ! ---------------------------------------------------------------------------------------------
258 
259  ! ---------------------------------------------------------------------------------------------
261  subroutine eftcambmodelinitialize( self, name, latexname )
263  implicit none
264 
265  class(eftcamb_model) :: self
266  character(*), intent(in) :: name
267  character(*), intent(in) :: latexname
268 
269  self%name = trim(name)
270  self%name_latex = trim(latexname)
271 
272  end subroutine eftcambmodelinitialize
273 
274  ! ---------------------------------------------------------------------------------------------
276  subroutine eftcambmodelinitbackground( self, params_cache, feedback_level, success )
277 
278  implicit none
279 
280  class(eftcamb_model) :: self
281  type(eftcamb_parameter_cache), intent(in) :: params_cache
282  integer , intent(in) :: feedback_level
283  logical , intent(out) :: success
284 
285  success = .true.
286 
287  end subroutine eftcambmodelinitbackground
288 
289  ! ---------------------------------------------------------------------------------------------
291  subroutine eftcambmodelcomputerhoqpq( self, a, eft_par_cache, eft_cache )
292 
293  implicit none
294 
295  class(eftcamb_model) :: self
296  real(dl), intent(in) :: a
297  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
298  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
299 
300  real(dl) :: a2, adotoa2, aomegaP
301 
302  ! precompute some parts:
303  a2 = a*a
304  adotoa2 = eft_cache%adotoa**2
305  aomegap = a*eft_cache%EFTOmegaP
306 
307  ! do the computations:
308  eft_cache%grhoq = 2._dl*eft_cache%EFTc -eft_cache%EFTLambda -3._dl*adotoa2*aomegap
309  eft_cache%gpresq = eft_cache%EFTLambda + a2*adotoa2*eft_cache%EFTOmegaPP +aomegap*(eft_cache%Hdot+2._dl*adotoa2)
310  eft_cache%grhodotq = 3._dl*eft_cache%adotoa*(-eft_cache%grhoq-eft_cache%gpresq+adotoa2*aomegap )
311  eft_cache%gpresdotq = eft_cache%EFTLambdadot &
312  & +adotoa2*eft_cache%adotoa*(a*a2*eft_cache%EFTOmegaPPP-2._dl*aomegap+2._dl*a2*eft_cache%EFTOmegaPP) &
313  & +aomegap*eft_cache%Hdotdot &
314  & +3._dl*eft_cache%adotoa*eft_cache%Hdot*( aomegap+a2*eft_cache%EFTOmegaPP )
315 
316  end subroutine eftcambmodelcomputerhoqpq
317 
318  ! ---------------------------------------------------------------------------------------------
321  subroutine eftcambmodelcomputeeinsteinfactors( self, a, eft_par_cache, eft_cache )
322 
323  implicit none
324 
325  class(eftcamb_model) :: self
326  real(dl), intent(in) :: a
327  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
328  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
329 
330  real(dl) :: one_plus_omega, adotoa2, aomegaP, k2, a2, hdot_m_adotoa2, pidot_p_H_pi
331 
332  ! precompute some common parts:
333  one_plus_omega = 1._dl+eft_cache%EFTOmegaV
334  adotoa2 = eft_cache%adotoa**2
335  hdot_m_adotoa2 = eft_cache%Hdot-adotoa2
336  aomegap = a*eft_cache%EFTOmegaP
337  k2 = eft_cache%k**2
338  a2 = a**2
339  pidot_p_h_pi = eft_cache%pidot+eft_cache%adotoa*eft_cache%pi
340 
341  ! compute the coefficients:
342  eft_cache%EFTeomF = 1.5_dl/(eft_cache%k*one_plus_omega)*( (eft_cache%grhoq+eft_cache%gpresq)*eft_cache%pi &
343  & + (aomegap*eft_cache%adotoa+a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)*pidot_p_h_pi &
344  & + eft_cache%pi*( k2*(eft_cache%EFTGamma3V+eft_cache%EFTGamma4V) -(3._dl*eft_cache%EFTGamma3V+eft_cache%EFTGamma4V)*hdot_m_adotoa2 ) )
345  eft_cache%EFTeomG = +1._dl +0.5/one_plus_omega*( aomegap &
346  & +a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V/eft_cache%adotoa +3._dl*eft_cache%EFTGamma3V +eft_cache%EFTGamma4V )
347  eft_cache%EFTeomL = +0.5_dl/one_plus_omega*( (2._dl*eft_cache%EFTc*pidot_p_h_pi +eft_cache%grhodotq*eft_cache%pi)/eft_cache%adotoa &
348  & -3._dl*aomegap*( (3._dl*adotoa2-eft_cache%Hdot+k2/3._dl)*eft_cache%pi +eft_cache%adotoa*eft_cache%pidot) &
349  & +4._dl*a2*eft_par_cache%h0_mpc**2*eft_cache%EFTGamma1V/eft_cache%adotoa*pidot_p_h_pi &
350  & +3._dl*a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V*( (eft_cache%Hdot-2._dl*adotoa2-k2/3._dl)*eft_cache%pi/eft_cache%adotoa -eft_cache%pidot ) & ! Gamma2
351  & -eft_cache%pi*( k2-3._dl*hdot_m_adotoa2)*(3._dl*eft_cache%EFTGamma3V+eft_cache%EFTGamma4V) +8._dl*eft_cache%EFTGamma6V*k2*pidot_p_h_pi/eft_cache%adotoa )
352  eft_cache%EFTeomM = eft_cache%gpresdotq*eft_cache%pi +(eft_cache%grhoq+eft_cache%gpresq+a2*adotoa2*eft_cache%EFTOmegaPP)*pidot_p_h_pi &
353  & +aomegap*eft_cache%adotoa*( eft_cache%pidotdot +(eft_cache%Hdot+4._dl*adotoa2)*eft_cache%pidot/eft_cache%adotoa +2._dl*(eft_cache%Hdot+3._dl*adotoa2+k2/3._dl)*eft_cache%pi ) &
354  & +a*eft_par_cache%h0_mpc*( eft_cache%EFTGamma2V*eft_cache%pidotdot &
355  & +(4._dl*eft_cache%EFTGamma2V +a*eft_cache%EFTGamma2P)*eft_cache%adotoa*eft_cache%pidot +(3._dl*adotoa2*eft_cache%EFTGamma2V &
356  & +eft_cache%Hdot*eft_cache%EFTGamma2V +a*adotoa2*eft_cache%EFTGamma2P)*eft_cache%pi) &
357  & -(hdot_m_adotoa2-k2/3._dl)*( (3._dl*eft_cache%EFTGamma3V+eft_cache%EFTGamma4V)*eft_cache%pidot &
358  & +2._dl*eft_cache%adotoa*(+3._dl*eft_cache%EFTGamma3V+eft_cache%EFTGamma4V+1.5_dl*a*eft_cache%EFTGamma3P+0.5_dl*a*eft_cache%EFTGamma4P)*eft_cache%pi ) &
359  & -(3._dl*eft_cache%EFTGamma3V+eft_cache%EFTGamma4V)*(eft_cache%Hdotdot-2._dl*eft_cache%adotoa*eft_cache%Hdot)*eft_cache%pi&
360  & -4._dl*eft_cache%EFTGamma5V*k2*pidot_p_h_pi/3._dl
361  eft_cache%EFTeomN = eft_cache%k/one_plus_omega*( eft_cache%adotoa*eft_cache%pi*(-aomegap+2._dl*eft_cache%EFTGamma4V+a*eft_cache%EFTGamma4P) &
362  & +eft_cache%EFTGamma4V*eft_cache%pidot +2._dl*eft_cache%EFTGamma5V*pidot_p_h_pi )
363  eft_cache%EFTeomNdot = eft_cache%k/one_plus_omega*( -eft_cache%Hdot*aomegap*eft_cache%pi &
364  & -eft_cache%adotoa*aomegap*eft_cache%pidot &
365  & -adotoa2*(aomegap+a2*eft_cache%EFTOmegaPP-aomegap**2/one_plus_omega)*eft_cache%pi &
366  & +eft_cache%EFTGamma4V*eft_cache%pidotdot +a*eft_cache%adotoa*eft_cache%pidot*&
367  &( +eft_cache%EFTGamma4P -eft_cache%EFTGamma4V*eft_cache%EFTOmegaP/one_plus_omega)&
368  & +2._dl*(eft_cache%EFTGamma4V +0.5_dl*a*eft_cache%EFTGamma4P)*( eft_cache%Hdot*eft_cache%pi +eft_cache%adotoa*eft_cache%pidot)&
369  & +2._dl*a*adotoa2*eft_cache%pi*(+0.5_dl*a*eft_cache%EFTGamma4PP +1.5_dl*eft_cache%EFTGamma4P&
370  & -eft_cache%EFTOmegaP/one_plus_omega*(eft_cache%EFTGamma4V +0.5_dl*a*eft_cache%EFTGamma4P))&
371  & +2._dl*eft_cache%EFTGamma5V*( eft_cache%pidotdot+eft_cache%adotoa*eft_cache%pidot+eft_cache%Hdot*eft_cache%pi)&
372  & +2._dl*eft_cache%adotoa*pidot_p_h_pi*( +a*eft_cache%EFTGamma5P-eft_cache%EFTGamma5V*aomegap/one_plus_omega) )
373  eft_cache%EFTeomU = 1._dl +(+1.5_dl*eft_cache%EFTGamma3V+0.5_dl*eft_cache%EFTGamma4V)/one_plus_omega
374  eft_cache%EFTeomV = +0.5_dl/one_plus_omega*( aomegap -2._dl*eft_cache%EFTGamma4V -a*eft_cache%EFTGamma4P )
375  eft_cache%EFTeomVdot = 0.5_dl*eft_cache%adotoa/one_plus_omega*( aomegap-3._dl*a*eft_cache%EFTGamma4P &
376  & +a2*(eft_cache%EFTOmegaPP-eft_cache%EFTGamma4PP) +aomegap/one_plus_omega*(-aomegap+2._dl*eft_cache%EFTGamma4V+a*eft_cache%EFTGamma4P))
377  eft_cache%EFTeomX = 1._dl -eft_cache%EFTGamma4V/one_plus_omega
378  eft_cache%EFTeomXdot = -a*eft_cache%adotoa/one_plus_omega*( +eft_cache%EFTGamma4P &
379  & -eft_cache%EFTGamma4V*eft_cache%EFTOmegaP/one_plus_omega)
380  eft_cache%EFTeomY = +0.5_dl/one_plus_omega*( aomegap &
381  & +3._dl*eft_cache%EFTGamma3V+eft_cache%EFTGamma4V &
382  & +0.5_dl*a*(3._dl*eft_cache%EFTGamma3P+eft_cache%EFTGamma4P) )
383 
384  end subroutine eftcambmodelcomputeeinsteinfactors
385 
386  ! ---------------------------------------------------------------------------------------------
388  subroutine eftcambmodelcomputepifactors( self, a, eft_par_cache, eft_cache )
389 
390  implicit none
391 
392  class(eftcamb_model) :: self
393  real(dl), intent(in) :: a
394  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
395  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
396 
397  real(dl) :: one_plus_omega, adotoa2, aomegaP, k2, a2, hdot_m_adotoa2, adotoa02
398 
399  ! precompute some common parts:
400  k2 = eft_cache%k**2
401  a2 = a**2
402  one_plus_omega = 1._dl+eft_cache%EFTOmegaV
403  adotoa2 = eft_cache%adotoa**2
404  adotoa02 = eft_par_cache%h0_mpc**2
405  hdot_m_adotoa2 = eft_cache%Hdot-adotoa2
406  aomegap = a*eft_cache%EFTOmegaP
407 
408  ! compute the coefficients:
409  eft_cache%EFTpiA1 = eft_cache%EFTc +2._dl*a2*adotoa02*eft_cache%EFTGamma1V +1.5_dl*a2*( eft_cache%adotoa*eft_cache%EFTOmegaP +eft_par_cache%h0_mpc*eft_cache%EFTGamma2V )**2&
410  &/(2._dl*one_plus_omega +eft_cache%EFTGamma3V +eft_cache%EFTGamma4V)
411  !
412  eft_cache%EFTpiA2 = +4._dl*eft_cache%EFTGamma6V
413  !
414  eft_cache%EFTpiB1 = eft_cache%EFTcdot +4._dl*eft_cache%adotoa*eft_cache%EFTc +8._dl*a2*eft_cache%adotoa*adotoa02*(eft_cache%EFTGamma1V +0.25_dl*a*eft_cache%EFTGamma1P)&
415  & -a*(eft_cache%adotoa*eft_cache%EFTOmegaP +eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/( 4._dl*one_plus_omega +6._dl*eft_cache%EFTGamma3V +2._dl*eft_cache%EFTGamma4V)*&
416  &(-3._dl*( eft_cache%grhoq +eft_cache%gpresq ) -3._dl*adotoa2*aomegap*(4._dl+eft_cache%Hdot/adotoa2) -3._dl*a2*adotoa2*eft_cache%EFTOmegaPP&
417  & -3._dl*a*eft_cache%adotoa*eft_par_cache%h0_mpc*(4._dl*eft_cache%EFTGamma2V +a*eft_cache%EFTGamma2P) -( 9._dl*eft_cache%EFTGamma3V -3._dl*eft_cache%EFTGamma4V)*hdot_m_adotoa2 )&
418  & +1._dl/(one_plus_omega+2._dl*eft_cache%EFTGamma5V)*( eft_cache%adotoa*aomegap +2._dl*eft_cache%adotoa*(eft_cache%EFTGamma5V + a*eft_cache%EFTGamma5P)&
419  & -one_plus_omega*(eft_cache%adotoa*aomegap +a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/( 2._dl*one_plus_omega +3._dl*eft_cache%EFTGamma3V +eft_cache%EFTGamma4V))*&
420  &(-eft_cache%EFTc +1.5_dl*a*adotoa2*eft_cache%EFTOmegaP -2._dl*a2*eft_par_cache%h0_mpc*eft_cache%EFTGamma1V +1.5_dl*a*eft_cache%adotoa*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)
421  !
422  eft_cache%EFTpiB2 = +4._dl*eft_cache%adotoa*(2._dl*eft_cache%EFTGamma6V +a*eft_cache%EFTGamma6P) +a*(eft_cache%EFTGamma4V&
423  & +2._dl*eft_cache%EFTGamma5V)/(2._dl*(1._dl+eft_cache%EFTOmegaV)-2._dl*eft_cache%EFTGamma4V)*(eft_cache%adotoa*eft_cache%EFTOmegaP +eft_par_cache%h0_mpc*eft_cache%EFTGamma2V) &
424  & -a*(eft_cache%adotoa*eft_cache%EFTOmegaP +eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/( 4._dl*one_plus_omega +6._dl*eft_cache%EFTGamma3V +2._dl*eft_cache%EFTGamma4V)*&
425  &( +(3._dl*eft_cache%EFTGamma3V -eft_cache%EFTGamma4V +4._dl*eft_cache%EFTGamma5V ))&
426  & +1._dl/(1._dl+eft_cache%EFTOmegaV +2._dl*eft_cache%EFTGamma5V)*( a*eft_cache%adotoa*eft_cache%EFTOmegaP +2._dl*eft_cache%adotoa*(eft_cache%EFTGamma5V + a*eft_cache%EFTGamma5P)&
427  & -(1._dl+eft_cache%EFTOmegaV)*(a*eft_cache%adotoa*eft_cache%EFTOmegaP +a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/( 2._dl*one_plus_omega +3._dl*eft_cache%EFTGamma3V +eft_cache%EFTGamma4V))*&
428  &( -4._dl*eft_cache%EFTGamma6V )
429  !
430  eft_cache%EFTpiC = +eft_cache%adotoa*eft_cache%EFTcdot + ( 6._dl*adotoa2 -2._dl*eft_cache%Hdot)*eft_cache%EFTc +1.5_dl*a*eft_cache%adotoa*eft_cache%EFTOmegaP*( eft_cache%Hdotdot -2._dl*eft_cache%adotoa**3) &
431  & +6._dl*(a*eft_cache%adotoa*eft_par_cache%h0_mpc)**2*eft_cache%EFTGamma1V +2._dl*a2*eft_cache%Hdot*adotoa02*eft_cache%EFTGamma1V &
432  & +2._dl*a**3*adotoa2*adotoa02*eft_cache%EFTGamma1P +1.5_dl*hdot_m_adotoa2**2*(eft_cache%EFTGamma4V +3._dl*eft_cache%EFTGamma3V )&
433  & +4.5_dl*eft_cache%adotoa*eft_par_cache%h0_mpc*a*hdot_m_adotoa2*( eft_cache%EFTGamma2V +a*eft_cache%EFTGamma2P/3._dl )&
434  & +0.5_dl*a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V*( 3._dl*eft_cache%Hdotdot -12._dl*eft_cache%Hdot*eft_cache%adotoa +6._dl*eft_cache%adotoa**3) &
435  & -a*( eft_cache%adotoa*eft_cache%EFTOmegaP +eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/(4._dl*(1._dl+eft_cache%EFTOmegaV)+6._dl*eft_cache%EFTGamma3V +2._dl*eft_cache%EFTGamma4V)*&
436  &(-3._dl*eft_cache%gpresdotq -3._dl*eft_cache%adotoa*( eft_cache%grhoq +eft_cache%gpresq) -3._dl*a*eft_cache%adotoa**3*( a*eft_cache%EFTOmegaPP +6._dl*eft_cache%EFTOmegaP) &
437  & -6._dl*a*eft_cache%adotoa*eft_cache%Hdot*eft_cache%EFTOmegaP +3._dl*(eft_cache%Hdotdot -2._dl*eft_cache%adotoa*eft_cache%Hdot)*(eft_cache%EFTGamma4V +3._dl*eft_cache%EFTGamma3V)&
438  & +6._dl*eft_cache%adotoa*hdot_m_adotoa2*( 3._dl*eft_cache%EFTGamma3V +1.5_dl*a*eft_cache%EFTGamma3P +eft_cache%EFTGamma4V + 0.5_dl*a*eft_cache%EFTGamma4P)&
439  & -3._dl*a*eft_par_cache%h0_mpc*(3._dl*adotoa2*eft_cache%EFTGamma2V +eft_cache%Hdot*eft_cache%EFTGamma2V +a*adotoa2*eft_cache%EFTGamma2P))&
440  & +1._dl/(1._dl +eft_cache%EFTOmegaV +2._dl*eft_cache%EFTGamma5V)*( a*eft_cache%adotoa*eft_cache%EFTOmegaP +2._dl*eft_cache%adotoa*(eft_cache%EFTGamma5V +a*eft_cache%EFTGamma5P)&
441  & -(1._dl+eft_cache%EFTOmegaV)*( a*eft_cache%adotoa*eft_cache%EFTOmegaP+a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/(2._dl*(1._dl+eft_cache%EFTOmegaV)+3._dl*eft_cache%EFTGamma3V +eft_cache%EFTGamma4V))*&
442  &(-0.5*eft_cache%grhodotq -eft_cache%adotoa*eft_cache%EFTc +1.5_dl*a*eft_cache%adotoa*eft_cache%EFTOmegaP*(3._dl*adotoa2 -eft_cache%Hdot) -2._dl*a2*eft_cache%adotoa*adotoa02*eft_cache%EFTGamma1V&
443  & -1.5_dl*a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V*(eft_cache%Hdot-2._dl*adotoa2) -3._dl*eft_cache%adotoa*hdot_m_adotoa2*(1.5_dl*eft_cache%EFTGamma3V +0.5_dl*eft_cache%EFTGamma4V))
444  !
445  eft_cache%EFTpiD1 = eft_cache%EFTc -0.5_dl*a*eft_cache%adotoa*eft_par_cache%h0_mpc*(eft_cache%EFTGamma2V +a*eft_cache%EFTGamma2P) -hdot_m_adotoa2*(3._dl*eft_cache%EFTGamma3V +eft_cache%EFTGamma4V)&
446  & +4._dl*( eft_cache%Hdot*eft_cache%EFTGamma6V + adotoa2*eft_cache%EFTGamma6V + a*adotoa2*eft_cache%EFTGamma6P)&
447  & +2._dl*( eft_cache%Hdot*eft_cache%EFTGamma5V +a*adotoa2*eft_cache%EFTGamma5P)&
448  & -a*(eft_cache%adotoa*eft_cache%EFTOmegaP +eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/(4._dl*(1._dl+eft_cache%EFTOmegaV)+6._dl*eft_cache%EFTGamma3V +2._dl*eft_cache%EFTGamma4V)*&
449  &(-2._dl*a*eft_cache%adotoa*eft_cache%EFTOmegaP +4._dl*eft_cache%adotoa*eft_cache%EFTGamma5V -2._dl*eft_cache%adotoa*(3._dl*eft_cache%EFTGamma3V +1.5_dl*a*eft_cache%EFTGamma3P &
450  & +eft_cache%EFTGamma4V +0.5_dl*a*eft_cache%EFTGamma4P))&
451  & +1._dl/(1._dl+eft_cache%EFTOmegaV+2._dl*eft_cache%EFTGamma5V)*(a*eft_cache%adotoa*eft_cache%EFTOmegaP+2._dl*eft_cache%adotoa*(eft_cache%EFTGamma5V +a*eft_cache%EFTGamma5P)&
452  & -(1._dl+eft_cache%EFTOmegaV)*(a*eft_cache%adotoa*eft_cache%EFTOmegaP +a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/(2._dl*(1._dl+eft_cache%EFTOmegaV)+3._dl*eft_cache%EFTGamma3V +eft_cache%EFTGamma4V))*&
453  &(+0.5_dl*a*eft_cache%adotoa*eft_cache%EFTOmegaP -2._dl*eft_cache%adotoa*eft_cache%EFTGamma5V +0.5_dl*a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V +1.5_dl*eft_cache%adotoa*eft_cache%EFTGamma3V&
454  & +0.5_dl*eft_cache%adotoa*eft_cache%EFTGamma4V -4._dl*eft_cache%adotoa*eft_cache%EFTGamma6V)&
455  & +(eft_cache%EFTGamma4V +2._dl*eft_cache%EFTGamma5V)/(2._dl*(1._dl+eft_cache%EFTOmegaV) -2._dl*eft_cache%EFTGamma4V)*(eft_cache%grhoq +eft_cache%gpresq +a*adotoa2*eft_cache%EFTOmegaP&
456  & -eft_cache%EFTGamma4V*hdot_m_adotoa2 +a*eft_cache%adotoa*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V -3._dl*eft_cache%EFTGamma3V*hdot_m_adotoa2)
457  !
458  eft_cache%EFTpiD2 = +(+0.5_dl*eft_cache%EFTGamma3V +0.5_dl*eft_cache%EFTGamma4V &
459  & +(eft_cache%EFTGamma4V +2._dl*eft_cache%EFTGamma5V)/(2._dl*(1._dl+eft_cache%EFTOmegaV) -2._dl*eft_cache%EFTGamma4V)*(eft_cache%EFTGamma3V +eft_cache%EFTGamma4V))
460  !
461  eft_cache%EFTpiE = (eft_cache%EFTc -1.5_dl*a*adotoa2*eft_cache%EFTOmegaP -0.5_dl*a*eft_cache%adotoa*eft_par_cache%h0_mpc*(2._dl*eft_cache%EFTGamma2V +a*eft_cache%EFTGamma2P)&
462  & +0.5_dl*eft_cache%EFTGamma3V*(k2 -3._dl*eft_cache%Hdot +3._dl*adotoa2) +0.5_dl*eft_cache%EFTGamma4V*(k2 -eft_cache%Hdot +adotoa2)&
463  & -a*(eft_cache%adotoa*eft_cache%EFTOmegaP +eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/( 4._dl*(1._dl+eft_cache%EFTOmegaV) +6._dl*eft_cache%EFTGamma3V +2._dl*eft_cache%EFTGamma4V)*&
464  &(-2._dl*eft_cache%adotoa*(a*eft_cache%EFTOmegaP +2._dl*(1._dl+eft_cache%EFTOmegaV)) -2._dl*eft_cache%adotoa*(3._dl*eft_cache%EFTGamma3V +1.5_dl*a*eft_cache%EFTGamma3P&
465  & +eft_cache%EFTGamma4V +0.5_dl*a*eft_cache%EFTGamma4P))&
466  & +1._dl/(1._dl+eft_cache%EFTOmegaV+2._dl*eft_cache%EFTGamma5V)*(a*eft_cache%adotoa*eft_cache%EFTOmegaP+2._dl*eft_cache%adotoa*(eft_cache%EFTGamma5V +a*eft_cache%EFTGamma5P)&
467  & -(1._dl+eft_cache%EFTOmegaV)*(a*eft_cache%adotoa*eft_cache%EFTOmegaP+a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/(2._dl*(1._dl+eft_cache%EFTOmegaV)+3._dl*eft_cache%EFTGamma3V +eft_cache%EFTGamma4V))*&
468  &( +eft_cache%adotoa*(1._dl +eft_cache%EFTOmegaV +0.5_dl*a*eft_cache%EFTOmegaP) +0.5_dl*a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V +1.5_dl*eft_cache%adotoa*eft_cache%EFTGamma3V +0.5_dl*eft_cache%adotoa*eft_cache%EFTGamma4V)&
469  & +(eft_cache%EFTGamma4V +2._dl*eft_cache%EFTGamma5V)/(2._dl*(1._dl +eft_cache%EFTOmegaV) -2._dl*eft_cache%EFTGamma4V)*k2*(eft_cache%EFTGamma4V +eft_cache%EFTGamma3V))*eft_cache%k*eft_cache%z&
470  & +1._dl*a*(eft_cache%adotoa*eft_cache%EFTOmegaP +eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/(4._dl*(1._dl+eft_cache%EFTOmegaV)+6._dl*eft_cache%EFTGamma3V +2._dl*eft_cache%EFTGamma4V)*&
471  &(eft_cache%grhog_t*eft_cache%clxg +eft_cache%grhor_t*eft_cache%clxr +3._dl*eft_cache%dgpnu ) +(eft_cache%EFTGamma4V +2._dl*eft_cache%EFTGamma5V)/(2._dl*(1._dl+eft_cache%EFTOmegaV) -2._dl*eft_cache%EFTGamma4V)*eft_cache%k*eft_cache%dgq&
472  & -0.5_dl/(1._dl+eft_cache%EFTOmegaV +2._dl*eft_cache%EFTGamma5V)*(a*eft_cache%adotoa*eft_cache%EFTOmegaP+2._dl*eft_cache%adotoa*(eft_cache%EFTGamma5V +a*eft_cache%EFTGamma5P)&
473  & -(1._dl+eft_cache%EFTOmegaV)*(a*eft_cache%adotoa*eft_cache%EFTOmegaP+a*eft_par_cache%h0_mpc*eft_cache%EFTGamma2V)/(2._dl*(1._dl+eft_cache%EFTOmegaV)+3._dl*eft_cache%EFTGamma3V +eft_cache%EFTGamma4V))*eft_cache%dgrho
474 
475  end subroutine eftcambmodelcomputepifactors
476 
477  ! ---------------------------------------------------------------------------------------------
479  subroutine eftcambmodelcomputetensorfactors( self, a, eft_par_cache, eft_cache )
480 
481  implicit none
482 
483  class(eftcamb_model) :: self
484  real(dl), intent(in) :: a
485  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
486  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
487 
488  real(dl) :: one_plus_omega
489 
490  ! precompute some common parts:
491  one_plus_omega = 1._dl+eft_cache%EFTOmegaV
492 
493  ! compute the coefficients:
494  eft_cache%EFTAT = one_plus_omega -eft_cache%EFTGamma4V
495  eft_cache%EFTBT = 2._dl*eft_cache%adotoa*( one_plus_omega -eft_cache%EFTGamma4V +0.5_dl*a*eft_cache%EFTOmegaP -0.5_dl*a*eft_cache%EFTGamma4P )
496  eft_cache%EFTDT = one_plus_omega
497 
498  end subroutine eftcambmodelcomputetensorfactors
499 
500  ! ---------------------------------------------------------------------------------------------
502  subroutine eftcambmodelcomputestabilityfactors( self, a, eft_par_cache, eft_cache )
503 
504  implicit none
505 
506  class(eftcamb_model) :: self
507  real(dl), intent(in) :: a
508  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
509  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
510 
511  eft_cache%EFT_kinetic = 9._dl*( 1._dl +eft_cache%EFTOmegaV -eft_cache%EFTGamma4V )*( 4._dl*eft_cache%EFTc*( 1._dl +eft_cache%EFTOmegaV -eft_cache%EFTGamma4V ) &
512  & +3._dl*eft_cache%adotoa**2*eft_cache%EFTOmegaP**2*a**2 + a**2*eft_par_cache%h0_Mpc*( eft_par_cache%h0_Mpc*( 3._dl*eft_cache%EFTGamma2V**2 +8._dl*eft_cache%EFTGamma1V* &
513  &( 1._dl +eft_cache%EFTOmegaV -eft_cache%EFTGamma4V ) +6._dl*eft_cache%adotoa*eft_cache%EFTGamma2V*eft_cache%EFTOmegaP ) ) )
514  !
515  eft_cache%EFT_gradient = 9._dl*(8._dl*a*eft_cache%adotoa**2*eft_cache%EFTGamma5P - 16._dl*eft_cache%adotoa**2*eft_cache%EFTGamma5V**2 + 16._dl*eft_cache%EFTc*eft_cache%EFTGamma5V**2 &
516  &- 2._dl*a**2*eft_cache%adotoa**2*eft_cache%EFTGamma4P*eft_cache%EFTOmegaP + 4._dl*a**2*eft_cache%adotoa**2*eft_cache%EFTGamma5P*eft_cache%EFTOmegaP -&
517  &4._dl*a*eft_cache%adotoa**2*eft_cache%EFTGamma5V*eft_cache%EFTOmegaP - 4._dl*a**2*eft_cache%adotoa**2*eft_cache%EFTGamma4P*eft_cache%EFTGamma5V*eft_cache%EFTOmegaP &
518  &- 8._dl*a*eft_cache%adotoa**2*eft_cache%EFTGamma5V**2*eft_cache%EFTOmegaP + 3._dl*a**2*eft_cache%adotoa**2*eft_cache%EFTOmegaP**2 +&
519  &4._dl*a**2*eft_cache%adotoa**2*eft_cache%EFTGamma5V*eft_cache%EFTOmegaP**2 + 16._dl*a*eft_cache%adotoa**2*eft_cache%EFTGamma5P*eft_cache%EFTOmegaV &
520  &+ 16._dl*eft_cache%EFTc*eft_cache%EFTGamma5V*eft_cache%EFTOmegaV - 16._dl*eft_cache%adotoa**2*eft_cache%EFTGamma5V**2*eft_cache%EFTOmegaV -&
521  &2._dl*a**2*eft_cache%adotoa**2*eft_cache%EFTGamma4P*eft_cache%EFTOmegaP*eft_cache%EFTOmegaV + 4._dl*a**2*eft_cache%adotoa**2*eft_cache%EFTGamma5P*eft_cache%EFTOmegaP*eft_cache%EFTOmegaV &
522  &- 4._dl*a*eft_cache%adotoa**2*eft_cache%EFTGamma5V*eft_cache%EFTOmegaP*eft_cache%EFTOmegaV +3._dl*a**2*eft_cache%adotoa**2*eft_cache%EFTOmegaP**2*eft_cache%EFTOmegaV &
523  &+ 8._dl*a*eft_cache%adotoa**2*eft_cache%EFTGamma5P*eft_cache%EFTOmegaV**2 - a**2*eft_cache%EFTGamma2V**2*eft_par_cache%h0_mpc**2*(1 + eft_cache%EFTOmegaV) +&
524  &4._dl*a**2*eft_cache%adotoa**2*eft_cache%EFTGamma5V*eft_cache%EFTOmegaPP*(1._dl + 2._dl*eft_cache%EFTGamma5V + eft_cache%EFTOmegaV) + 4._dl*eft_cache%EFTc*(4._dl*eft_cache%EFTGamma5V &
525  &+ (1._dl + eft_cache%EFTOmegaV)**2) -2._dl*a*eft_cache%adotoa*eft_par_cache%h0_Mpc*(a*eft_cache%EFTGamma2P*(1._dl - eft_cache%EFTGamma4V + eft_cache%EFTOmegaV)*(1._dl + 2._dl*eft_cache%EFTGamma5V + eft_cache%EFTOmegaV) +&
526  &eft_cache%EFTGamma2V*(eft_cache%EFTGamma4V*(-1._dl + 2._dl*a*eft_cache%EFTGamma5P + 2._dl*eft_cache%EFTGamma5V + a*eft_cache%EFTOmegaP - eft_cache%EFTOmegaV) +&
527  &(1._dl + eft_cache%EFTOmegaV)*(1._dl + a*(eft_cache%EFTGamma4P - 2._dl*eft_cache%EFTGamma5P - eft_cache%EFTOmegaP) + eft_cache%EFTOmegaV) - 2._dl*eft_cache%EFTGamma5V*(1._dl - a*eft_cache%EFTGamma4P &
528  &+ a*eft_cache%EFTOmegaP + eft_cache%EFTOmegaV))) +8._dl*eft_cache%EFTGamma5V*eft_cache%Hdot + 16._dl*eft_cache%EFTGamma5V**2*eft_cache%Hdot + 4._dl*a*eft_cache%EFTGamma5V*eft_cache%EFTOmegaP*eft_cache%Hdot &
529  &+ 8._dl*a*eft_cache%EFTGamma5V**2*eft_cache%EFTOmegaP*eft_cache%Hdot + 16._dl*eft_cache%EFTGamma5V*eft_cache%EFTOmegaV*eft_cache%Hdot +&
530  &16._dl*eft_cache%EFTGamma5V**2*eft_cache%EFTOmegaV*eft_cache%Hdot + 4._dl*a*eft_cache%EFTGamma5V*eft_cache%EFTOmegaP*eft_cache%EFTOmegaV*eft_cache%Hdot + 8._dl*eft_cache%EFTGamma5V*eft_cache%EFTOmegaV**2*eft_cache%Hdot +&
531  &4._dl*eft_cache%EFTGamma4V**2*(eft_cache%adotoa**2*(1._dl + 2._dl*a*eft_cache%EFTGamma5P + 4._dl*eft_cache%EFTGamma5V + a*eft_cache%EFTOmegaP + eft_cache%EFTOmegaV) - (1._dl + 2._dl*eft_cache%EFTGamma5V + eft_cache%EFTOmegaV)*eft_cache%Hdot) +&
532  &2._dl*eft_cache%EFTGamma4V*(eft_cache%adotoa**2*(-(a**2*eft_cache%EFTOmegaP**2) + a**2*eft_cache%EFTOmegaPP*(1._dl + 2._dl*eft_cache%EFTGamma5V + eft_cache%EFTOmegaV) -&
533  &4._dl*(1._dl + eft_cache%EFTOmegaV)*(1._dl + 2._dl*a*eft_cache%EFTGamma5P + 4._dl*eft_cache%EFTGamma5V + eft_cache%EFTOmegaV) - a*eft_cache%EFTOmegaP*(3._dl + 2._dl*a*eft_cache%EFTGamma5P &
534  &+ 2._dl*eft_cache%EFTGamma5V + 3._dl*eft_cache%EFTOmegaV)) +(1._dl + 2._dl*eft_cache%EFTGamma5V + eft_cache%EFTOmegaV)*(4._dl + a*eft_cache%EFTOmegaP + 4._dl*eft_cache%EFTOmegaV)*eft_cache%Hdot))
535 
536  end subroutine eftcambmodelcomputestabilityfactors
537 
538  ! ---------------------------------------------------------------------------------------------
540  function eftcambmodeladditionalmodelstability( self, a, eft_par_cache, eft_cache )
541 
542  implicit none
543 
544  class(eftcamb_model) :: self
545  real(dl), intent(in) :: a
546  type(eftcamb_parameter_cache), intent(inout) :: eft_par_cache
547  type(eftcamb_timestep_cache ), intent(inout) :: eft_cache
548 
549  logical :: EFTCAMBModelAdditionalModelStability
550 
551  eftcambmodeladditionalmodelstability = .true.
552 
553  end function eftcambmodeladditionalmodelstability
554 
555  ! ---------------------------------------------------------------------------------------------
556 
557 end module eftcamb_abstract_model
558 
559 !----------------------------------------------------------------------------------------
This module contains the definition of the EFTCAMB caches. These are used to store parameters that ca...
This module contains the abstract definition of all the places where EFTCAMB interacts with CAMB...
subroutine eftcambmodelinitialize(self, name, latexname)
Subroutine that initializes the name and latex name of the model.