11_EFTCAMB_main.f90

Go to the documentation of this file.

!----------------------------------------------------------------------------------------
!
! This file is part of EFTCAMB.
!
! Copyright (C) 2013-2016 by the EFTCAMB authors
!
! The EFTCAMB code is free software;
! You can use it, redistribute it, and/or modify it under the terms
! of the GNU General Public License as published by the Free Software Foundation;
! either version 3 of the License, or (at your option) any later version.
! The full text of the license can be found in the file eftcamb/LICENSE at
! the top level of the EFTCAMB distribution.
!
!----------------------------------------------------------------------------------------



!----------------------------------------------------------------------------------------


module eftcamb_main

    use precision
    use inifile
    use amlutils
    use eft_def
    use eftcamb_abstract_model
    use eftcamb_abstract_model_full
    use eftcamb_abstract_model_designer
    use eftcamb_pure_eft_std
    use eftcamb_reparametrized_horndeski
    use eftcamb_designer_fr
    use eftcamb_designer_mc_quintessence
    use eftcamb_le_horava

    implicit none

    private

    public eftcamb_version, eftcamb

    character(LEN=*), parameter :: eftcamb_version = 'V3.0 Dec16'

    !----------------------------------------------------------------------------------------
    type eftcamb

        ! EFTCAMB output root:
        character(LEN=:), allocatable :: outroot

        ! EFTCAMB model selection flags:
        integer   :: eftflag
        integer   :: pureeftmodel
        integer   :: altpareftmodel
        integer   :: designereftmodel
        integer   :: fullmappingeftmodel

        ! EFTCAMB stability flags:
        logical   :: eft_mathematical_stability
        logical   :: eft_physical_stability
        logical   :: eft_additional_priors

        ! EFTCAMB model:
        class(eftcamb_model), allocatable :: model

        ! EFTCAMB working flags:
        integer   :: eftcamb_feedback_level
        real(dl)  :: eftcamb_turn_on_time
        logical   :: eftcamb_model_is_designer

    contains

        ! utility functions:
        procedure :: eftcamb_init_from_file        => read_eftcamb_flags_from_file  
        procedure :: eftcamb_init_model_from_file  => init_eftcamb_model_from_file  
        procedure :: eftcamb_print_header          => print_eftcamb_header          
        procedure :: eftcamb_print_cosmomc_header  => print_eftcosmomc_header       
        procedure :: eftcamb_print_model_feedback  => print_eftcamb_flags           
        ! model allocation:
        procedure :: eftcamb_allocate_model            => allocate_eftcamb_model            
        procedure :: eftcamb_read_model_selection      => read_eftcamb_model_selection      
        procedure :: eftcamb_allocate_model_functions  => allocate_eftcamb_model_functions  
        procedure :: eftcamb_read_model_parameters     => read_eftcamb_model_parameters     

    end type eftcamb

    ! ---------------------------------------------------------------------------------------------

contains

    ! ---------------------------------------------------------------------------------------------
    subroutine read_eftcamb_flags_from_file( self, Ini )

        implicit none

        class(eftcamb)      :: self
        type(tinifile)      :: ini

        ! read from the INI file the main EFT flag:
        self%EFTflag              = ini_read_int_file( ini, 'EFTflag'            , 0 )
        ! read the model selection flags:
        self%PureEFTmodel         = ini_read_int_file( ini, 'PureEFTmodel'       , 0 )
        self%AltParEFTmodel       = ini_read_int_file( ini, 'AltParEFTmodel'     , 0 )
        self%DesignerEFTmodel     = ini_read_int_file( ini, 'DesignerEFTmodel'   , 0 )
        self%FullMappingEFTmodel  = ini_read_int_file( ini, 'FullMappingEFTmodel', 0 )
        ! read the stability flags:
        self%EFT_mathematical_stability = ini_read_logical_file( ini, 'EFT_mathematical_stability', .true. )
        self%EFT_physical_stability     = ini_read_logical_file( ini, 'EFT_physical_stability'    , .true. )
        self%EFT_additional_priors      = ini_read_logical_file( ini, 'EFT_additional_priors'     , .true. )

        ! EFTCAMB working stuff:
        self%EFTCAMB_feedback_level     = ini_read_int_file( ini, 'feedback_level', 1 )
        self%EFTCAMB_turn_on_time       = ini_read_double_file( ini, 'EFTCAMB_turn_on_time', eftturnonpiinitial )

    end subroutine read_eftcamb_flags_from_file

    ! ---------------------------------------------------------------------------------------------
    subroutine init_eftcamb_model_from_file( self, Ini )

        implicit none

        class(eftcamb)      :: self
        type(tinifile)      :: ini

        ! allocate model:
        call self%EFTCAMB_allocate_model()
        ! read the parameters defining the model from file:
        call self%EFTCAMB_read_model_selection( ini )
        ! allocate model functions and parameters:
        call self%EFTCAMB_allocate_model_functions( )
        ! read model parameters from file:
        call self%EFTCAMB_read_model_parameters( ini )
        ! compute model number of parameters:
        call self%model%compute_param_number()

    end subroutine init_eftcamb_model_from_file

    ! ---------------------------------------------------------------------------------------------
    subroutine print_eftcamb_header( self )

        implicit none

        class(eftcamb) :: self

        ! check feedback level:
        if ( .not. self%EFTCAMB_feedback_level > 0 ) return
        ! if GR return:
        if ( self%EFTflag == 0 ) return
        ! print the header:
        write(*,'(a)') "***************************************************************"
        write(*,'(a)') "     ______________________   __  ______  "
        write(*,'(a)') "    / __/ __/_  __/ ___/ _ | /  |/  / _ ) "
        write(*,'(a)') "   / _// _/  / / / /__/ __ |/ /|_/ / _  | "
        write(*,'(a)') "  /___/_/   /_/  \___/_/ |_/_/  /_/____/  "//" "//eftcamb_version
        write(*,'(a)') "  "
        write(*,'(a)') "***************************************************************"

    end subroutine print_eftcamb_header

    ! ---------------------------------------------------------------------------------------------
    subroutine print_eftcosmomc_header( self )

        implicit none

        class(eftcamb) :: self

        ! check feedback level:
        if ( .not. self%EFTCAMB_feedback_level > 0 ) return
        ! if GR return:
        if ( self%EFTflag == 0 ) return
        ! print the header:
        write(*,'(a)') "***************************************************************"
        write(*,'(a)') "     ___________________                    __  ________"
        write(*,'(a)') "    / __/ __/_  __/ ___/__  ___ __ _  ___  /  |/  / ___/"
        write(*,'(a)') "   / _// _/  / / / /__/ _ \(_-</  ' \/ _ \/ /|_/ / /__  "
        write(*,'(a)') "  /___/_/   /_/  \___/\___/___/_/_/_/\___/_/  /_/\___/  "
        write(*,'(a)') "  "
        write(*,'(a)') "  "//eftcamb_version
        write(*,'(a)') "***************************************************************"

    end subroutine print_eftcosmomc_header

    ! ---------------------------------------------------------------------------------------------
    subroutine print_eftcamb_flags( self, print_params )

        implicit none

        class(eftcamb)      :: self
        logical, optional   :: print_params

        character(len=500)  :: temp_name
        real(dl)            :: temp_value
        integer             :: i

        ! check the allocation of the model:
        if ( .not. allocated(self%model) ) then
            write(*,*) 'EFTCAMB WARNING: trying to call EFTCAMB model feedback without allocating the model'
            call mpistop('EFTCAMB error')
        end if
        ! check feedback level:
        if ( .not. self%EFTCAMB_feedback_level > 0 ) return
        ! if GR return:
        if ( self%EFTflag == 0 ) return
        ! print feedback flag:
        write(*,*)
        write(*,'(a, I3)') ' EFTCAMB feedback level  =', self%EFTCAMB_feedback_level

        ! print stability flags:
        write(*,*)
        write(*,*) 'EFTCAMB stability flags:'

        write(*,*) ' Mathematical stability = ', self%EFT_mathematical_stability
        write(*,*) ' Physical stability     = ', self%EFT_physical_stability
        write(*,*) ' Additional priors      = ', self%EFT_additional_priors
        write(*,*)
        ! print model selection flags:
        write(*,*)              'EFTCAMB model flags:'
        write(*,"(A24,I3)")     '   EFTflag             =', self%EFTflag
        if ( self%EFTflag == 1 ) &
            write(*,"(A24,I3)") '   PureEFTmodel        =', self%PureEFTmodel
        if ( self%EFTflag == 2 ) &
            write(*,"(A24,I3)") '   AltParEFTmodel      =', self%AltParEFTmodel
        if ( self%EFTflag == 3 ) &
            write(*,"(A24,I3)") '   DesignerEFTmodel    =', self%DesignerEFTmodel
        if ( self%EFTflag == 4 ) &
            write(*,"(A24,I3)") '   FullMappingEFTmodel =', self%FullMappingEFTmodel
        ! print model informations:
        call self%model%feedback( print_params )
        ! leave one white line:
        write(*,*)

    end subroutine print_eftcamb_flags

    ! ---------------------------------------------------------------------------------------------
    subroutine allocate_eftcamb_model( self )

        implicit none

        class(eftcamb)      :: self

        ! check the allocation of the model:
        if ( allocated(self%model) ) deallocate(self%model)

        ! do the allocation:
        select case ( self%EFTflag )

            case (0)     ! GR: no need to allocate

            case (1)     ! Pure EFT:

                select case ( self%PureEFTmodel )
                    case(1)
                        allocate( eftcamb_std_pure_eft::self%model )
                        call self%model%init( 'Standard Pure EFT', 'Standard Pure EFT' )
                    case default
                        write(*,'(a,I3)') 'No model corresponding to EFTFlag =', self%EFTflag
                        write(*,'(a,I3)') 'and PureEFTmodel =', self%PureEFTmodel
                        write(*,'(a)')    'Please select an appropriate model:'
                        write(*,'(a)')    'PureEFTmodel=1  standard Pure EFT'
                        call mpistop('EFTCAMB error')
                end select

            case (2)     ! Alternative EFT:

                select case ( self%AltParEFTmodel )
                    case(1)
                        allocate( eftcamb_rph::self%model )
                        call self%model%init( 'RPH', 'RPH' )
                    case default
                        write(*,'(a,I3)') 'No model corresponding to EFTFlag =', self%EFTflag
                        write(*,'(a,I3)') 'and AltParEFTmodel =', self%AltParEFTmodel
                        write(*,'(a)')    'Please select an appropriate model:'
                        write(*,'(a)')    'AltParEFTmodel=1  reparametrized Horndeski'
                        call mpistop('EFTCAMB error')
                end select

            case (3)     ! Designer mapping EFT:

                select case ( self%DesignerEFTmodel )
                    case(1)
                        allocate( eftcamb_fr_designer::self%model )
                        call self%model%init( 'Designer f(R)', 'Designer f(R)' )
                    case(2)
                        allocate( eftcamb_des_mc_quint::self%model )
                        call self%model%init( 'Designer minimally coupled quintessence', 'Designer minimally coupled quintessence' )
                    case default
                        write(*,'(a,I3)') 'No model corresponding to EFTFlag =', self%EFTflag
                        write(*,'(a,I3)') 'and DesignerEFTmodel =', self%DesignerEFTmodel
                        write(*,'(a)')    'Please select an appropriate model:'
                        write(*,'(a)')    'DesignerEFTmodel=1  designer f(R)'
                        write(*,'(a)')    'DesignerEFTmodel=2  designer minimally coupled quintessence'
                        call mpistop('EFTCAMB error')
                end select

            case (4)     ! Full mapping EFT:

                select case ( self%FullMappingEFTmodel )
                    case(1)
                        allocate( eftcamb_horava::self%model )
                        call self%model%init( 'Horava', 'Horava' )
                    case default
                        write(*,'(a,I3)') 'No model corresponding to EFTFlag =', self%EFTflag
                        write(*,'(a,I3)') 'and FullMappingEFTmodel =', self%FullMappingEFTmodel
                        write(*,'(a)')    'Please select an appropriate model:'
                        write(*,'(a)')    'FullMappingEFTmodel=1  Horava gravity'
                        call mpistop('EFTCAMB error')
                end select

            case default ! not found:

                write(*,'(a,I3)') 'No model corresponding to EFTFlag =', self%EFTflag
                write(*,'(a)') 'Please select an appropriate model:'
                write(*,'(a)') 'EFTFlag=0  GR code'
                write(*,'(a)') 'EFTFlag=1  Pure EFT'
                write(*,'(a)') 'EFTFlag=2  EFT alternative parametrizations'
                write(*,'(a)') 'EFTFlag=3  designer mapping EFT'
                write(*,'(a)') 'EFTFlag=4  full mapping EFT'
                call mpistop('EFTCAMB error')

        end select

        ! now store the designer flag:
        select type ( model => self%model )
            class is ( eftcamb_full_model )
            self%EFTCAMB_model_is_designer = .false.
            class is ( eftcamb_designer_model )
            self%EFTCAMB_model_is_designer = .true.
        end select

    end subroutine allocate_eftcamb_model

    ! ---------------------------------------------------------------------------------------------
    subroutine read_eftcamb_model_selection( self, Ini )

        implicit none

        class(eftcamb)      :: self
        type(tinifile)      :: ini

        ! check the allocation of the model:
        if ( .not. allocated(self%model) ) then
            write(*,*) 'EFTCAMB WARNING: trying to call EFTCAMB model read_model_selection'
            write(*,*) ' without allocating the model'
            call mpistop('EFTCAMB error')
        end if

        ! call the model specific read parameters:
        call self%model%read_model_selection( ini )

    end subroutine read_eftcamb_model_selection

    ! ---------------------------------------------------------------------------------------------
    subroutine allocate_eftcamb_model_functions( self )

        implicit none

        class(eftcamb)      :: self

        ! check the allocation of the model:
        if ( .not. allocated(self%model) ) then
            write(*,*) 'EFTCAMB WARNING: trying to call EFTCAMB model allocate_model_selection'
            write(*,*) ' without allocating the model'
            call mpistop('EFTCAMB error')
        end if

        ! call the model specific read parameters:
        call self%model%allocate_model_selection( )

    end subroutine allocate_eftcamb_model_functions

    ! ---------------------------------------------------------------------------------------------
    subroutine read_eftcamb_model_parameters( self, Ini )

        implicit none

        class(eftcamb)      :: self
        type(tinifile)      :: ini

        ! check the allocation of the model:
        if ( .not. allocated(self%model) ) then
            write(*,*) 'EFTCAMB WARNING: trying to call EFTCAMB model read_model_parameters_from_file'
            write(*,*) ' without allocating the model'
            call mpistop('EFTCAMB error')
        end if

        ! call the model specific read parameters:
        call self%model%init_model_parameters_from_file( ini )

    end subroutine read_eftcamb_model_parameters

    ! ---------------------------------------------------------------------------------------------

end module eftcamb_main

!----------------------------------------------------------------------------------------