45 type,
abstract :: eftcamb_model
47 integer :: parameter_number
48 character(len=:),
allocatable :: name
49 character(len=:),
allocatable :: name_latex
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
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
68 procedure :: initialize_background => eftcambmodelinitbackground
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
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
84 procedure :: additional_model_stability => eftcambmodeladditionalmodelstability
86 end type eftcamb_model
97 subroutine eftcambmodelcomputeparametersnumber( self )
100 class(eftcamb_model) :: self
101 end subroutine eftcambmodelcomputeparametersnumber
105 subroutine eftcambmodelreadmodelselectionfromfile( self, Ini )
109 class(eftcamb_model) :: self
110 type(tinifile) :: ini
111 end subroutine eftcambmodelreadmodelselectionfromfile
115 subroutine eftcambmodelallocatemodelselection( self )
118 class(eftcamb_model) :: self
119 end subroutine eftcambmodelallocatemodelselection
123 subroutine eftcambmodelinitmodelparameters( self, array )
127 class(eftcamb_model) :: self
128 real(dl),
dimension(self%parameter_number),
intent(in) :: array
129 end subroutine eftcambmodelinitmodelparameters
133 subroutine eftcambmodelinitmodelparametersfromfile( self, Ini )
137 class(eftcamb_model) :: self
138 type(tinifile) :: ini
139 end subroutine eftcambmodelinitmodelparametersfromfile
143 subroutine eftcambmodelfeedback( self, print_params )
146 class(eftcamb_model) :: self
147 logical,
optional :: print_params
149 end subroutine eftcambmodelfeedback
153 subroutine eftcambmodelparameternames( self, i, name )
156 class(eftcamb_model) :: self
157 integer ,
intent(in) :: i
158 character(*),
intent(out) :: name
159 end subroutine eftcambmodelparameternames
163 subroutine eftcambmodelparameternameslatex( self, i, latexname )
166 class(eftcamb_model) :: self
167 integer ,
intent(in) :: i
168 character(*),
intent(out) :: latexname
169 end subroutine eftcambmodelparameternameslatex
173 subroutine eftcambmodelparametervalues( self, i, value )
177 class(eftcamb_model) :: self
178 integer ,
intent(in) :: i
179 real(dl),
intent(out) ::
value 180 end subroutine eftcambmodelparametervalues
184 subroutine eftcambmodelbackgroundeftfunctions( self, a, eft_par_cache, eft_cache )
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
197 subroutine eftcambmodelsecondordereftfunctions( self, a, eft_par_cache, eft_cache )
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
210 function eftcambmodelcomputedtauda( self, a, eft_par_cache, eft_cache )
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
224 subroutine eftcambmodelcomputeadotoa( self, a, eft_par_cache, eft_cache )
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
237 subroutine eftcambmodelcomputehubbleder( self, a, eft_par_cache, eft_cache )
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
265 class(eftcamb_model) :: self
266 character(*),
intent(in) :: name
267 character(*),
intent(in) :: latexname
269 self%name = trim(name)
270 self%name_latex = trim(latexname)
276 subroutine eftcambmodelinitbackground( self, params_cache, feedback_level, success )
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
287 end subroutine eftcambmodelinitbackground
291 subroutine eftcambmodelcomputerhoqpq( self, a, eft_par_cache, eft_cache )
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
300 real(dl) :: a2, adotoa2, aomegaP
304 adotoa2 = eft_cache%adotoa**2
305 aomegap = a*eft_cache%EFTOmegaP
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 )
316 end subroutine eftcambmodelcomputerhoqpq
321 subroutine eftcambmodelcomputeeinsteinfactors( self, a, eft_par_cache, eft_cache )
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
330 real(dl) :: one_plus_omega, adotoa2, aomegaP, k2, a2, hdot_m_adotoa2, pidot_p_H_pi
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
339 pidot_p_h_pi = eft_cache%pidot+eft_cache%adotoa*eft_cache%pi
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 ) &
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) )
384 end subroutine eftcambmodelcomputeeinsteinfactors
388 subroutine eftcambmodelcomputepifactors( self, a, eft_par_cache, eft_cache )
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
397 real(dl) :: one_plus_omega, adotoa2, aomegaP, k2, a2, hdot_m_adotoa2, adotoa02
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
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)
412 eft_cache%EFTpiA2 = +4._dl*eft_cache%EFTGamma6V
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)
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 )
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))
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)
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))
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
475 end subroutine eftcambmodelcomputepifactors
479 subroutine eftcambmodelcomputetensorfactors( self, a, eft_par_cache, eft_cache )
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
488 real(dl) :: one_plus_omega
491 one_plus_omega = 1._dl+eft_cache%EFTOmegaV
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
498 end subroutine eftcambmodelcomputetensorfactors
502 subroutine eftcambmodelcomputestabilityfactors( self, a, eft_par_cache, eft_cache )
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
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 ) ) )
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))
536 end subroutine eftcambmodelcomputestabilityfactors
540 function eftcambmodeladditionalmodelstability( self, a, eft_par_cache, eft_cache )
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
549 logical :: EFTCAMBModelAdditionalModelStability
551 eftcambmodeladditionalmodelstability = .true.
553 end function eftcambmodeladditionalmodelstability
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.