272 lines
7.1 KiB
Fortran
272 lines
7.1 KiB
Fortran
|
|
! define scalar field distribution and potential in F(R) scalar-tensor theory
|
|
! 1: Case C of 1112.3928, V=0
|
|
! 2: shell with a2^2*phi0/(1+a2^2), f(R) = R+a2*R^2 induced V
|
|
! 3: ground state of Schrodinger-Newton system, f(R) = R+a2*R^2 induced V
|
|
! 4: a2 = oo and \phi = \phi_0*0.5*(tanh((r+r_0)/\sigma)-tanh((r-r_0)/\sigma))
|
|
! 5: shell with phi0*dexp(-(r-r0)**2/sigma), V = 0
|
|
|
|
! original way, manually define the preprocessor macro
|
|
! #define CC 2
|
|
! the new way, define according to the preprocessor macro in "macrodef.fh"
|
|
#include "macrodef.fh"
|
|
#define CC EScalar_CC
|
|
|
|
subroutine setparameters(a2,r0,phi0,sigma,l2)
|
|
implicit none
|
|
real*8,intent(out) :: a2,r0,phi0,sigma,l2
|
|
|
|
! original way: read in parameters one by one
|
|
! call seta2(a2)
|
|
! call setphi0(phi0)
|
|
|
|
! new way: read in all parameters at once
|
|
call set_escalar_parameter(a2, phi0, r0, sigma, l2)
|
|
|
|
! r0=120.d0
|
|
! sigma=8.d0
|
|
! l2=1.d4
|
|
|
|
! write(*,*)
|
|
! write(*,*) " Set_Rho_ADM.f90 a2 = ", a2
|
|
! write(*,*) " Set_Rho_ADM.f90 phi0 = ", phi0
|
|
! write(*,*) " Set_Rho_ADM.f90 r0 = ", r0
|
|
! write(*,*) " Set_Rho_ADM.f90 sigma0 = ", sigma
|
|
! write(*,*) " Set_Rho_ADM.f90 l2 = ", l2
|
|
! write(*,*)
|
|
|
|
return
|
|
|
|
end subroutine setparameters
|
|
!===================================================================
|
|
function phi(X,Y,Z) result(gont)
|
|
implicit none
|
|
|
|
double precision,intent(in)::X
|
|
double precision,intent(in)::Y
|
|
double precision,intent(in)::Z
|
|
real*8 :: gont
|
|
|
|
real*8 ::r
|
|
real*8 :: a2,r0,phi0,sigma,l2
|
|
|
|
call setparameters(a2,r0,phi0,sigma,l2)
|
|
r=dsqrt(X*X+Y*Y+Z*Z)
|
|
#if ( CC == 1)
|
|
! configuration 1
|
|
gont = phi0*dtanh((r-r0)/sigma)
|
|
#elif ( CC == 2)
|
|
! configuration 2
|
|
phi0 = a2**2*phi0/(1+a2**2)
|
|
gont = phi0*dexp(-(r-r0)**2/sigma)
|
|
#elif ( CC == 3)
|
|
gont = (0.0481646d0*dexp(-0.0581545d0*(r-1.8039d-8)*(r-1.8039d-8)/l2) &
|
|
+0.298408d0*dexp(-0.111412d0*(r+9.6741d-9)*(r+9.6741d-9)/l2)+ &
|
|
0.42755d0*dexp(-0.207156d0*(r-1.09822d-8)*(r-1.09822d-8)/l2)+ &
|
|
0.204229d0*dexp(-0.37742d0*(r+2.13778d-8)*(r+2.13778d-8)/l2)+ &
|
|
0.021649d0*dexp(-0.68406d0*(r-8.78608d-8)*(r-8.78608d-8)/l2))/l2
|
|
#elif ( CC == 4)
|
|
! configuration 4, a2 = oo
|
|
phi0 = 0.5d0*phi0
|
|
gont = phi0*(dtanh((r+r0)/sigma)-dtanh((r-r0)/sigma))
|
|
#elif ( CC == 5)
|
|
! configuration 5
|
|
gont = phi0*dexp(-(r-r0)**2/sigma)
|
|
#endif
|
|
|
|
return
|
|
|
|
end function phi
|
|
|
|
! d phi/dr
|
|
function dphi(X,Y,Z) result(gont)
|
|
implicit none
|
|
|
|
double precision,intent(in)::X
|
|
double precision,intent(in)::Y
|
|
double precision,intent(in)::Z
|
|
real*8 :: gont
|
|
|
|
real*8 ::r
|
|
real*8 :: a2,r0,phi0,sigma,l2
|
|
|
|
call setparameters(a2,r0,phi0,sigma,l2)
|
|
r=dsqrt(X*X+Y*Y+Z*Z)
|
|
#if ( CC == 1)
|
|
! configuration 1
|
|
gont = phi0/sigma*(1-(dtanh((r-r0)/sigma))**2)
|
|
#elif ( CC == 2)
|
|
! configuration 2
|
|
phi0 = a2**2*phi0/(1+a2**2)
|
|
gont = -2.d0*phi0*(r-r0)/sigma*exp(-(r-r0)**2/sigma)
|
|
#elif ( CC == 3)
|
|
gont = (-0.5601976461d-2*(r-0.18039d-7)/l2*dexp(-0.581545d-1*(r-0.18039d-7)**2/l2) &
|
|
-0.6649246419d-1*(r+0.96741d-8)/l2*dexp(-0.111412d0*(r+.96741e-8)**2/l2) &
|
|
-0.1771390956d0*(r-0.109822d-7)/l2*dexp(-0.207156d0*(r-0.109822d-7)**2/l2) &
|
|
-0.1541602184d0*(r+0.213778d-7)/l2*dexp(-0.37742d0*(r+0.213778d-7)**2/l2) &
|
|
-0.2961842988d-1*(r-0.878608d-7)/l2*dexp(-0.68406*(r-0.878608d-7)**2/l2))/l2
|
|
#elif ( CC == 4)
|
|
! configuration 4, a2 = oo
|
|
phi0 = 0.5d0*phi0
|
|
gont = phi0*((1-dtanh((r+r0)/sigma)**2)/sigma- &
|
|
(1-dtanh((r-r0)/sigma)**2)/sigma)
|
|
#elif ( CC == 5)
|
|
! configuration 5
|
|
gont = -2.d0*phi0*(r-r0)/sigma*exp(-(r-r0)**2/sigma)
|
|
#endif
|
|
|
|
return
|
|
|
|
end function dphi
|
|
!==================================================================
|
|
function potential(X,Y,Z) result(gont)
|
|
implicit none
|
|
|
|
double precision,intent(in)::X
|
|
double precision,intent(in)::Y
|
|
double precision,intent(in)::Z
|
|
real*8 :: gont
|
|
|
|
real*8 :: phi
|
|
real*8 :: PI,v
|
|
|
|
real*8 :: a2,r0,phi0,sigma,l2
|
|
|
|
#if ( CC == 1 || CC == 4 || CC == 5)
|
|
gont = 0.d0
|
|
|
|
#elif ( CC == 2 || CC == 3)
|
|
call setparameters(a2,r0,phi0,sigma,l2)
|
|
PI = dacos(-1.d0)
|
|
|
|
v = phi(X,Y,Z)
|
|
|
|
gont = dexp(-8.d0*dsqrt(PI/3)*v)*(1-dexp(4*dsqrt(PI/3)*v))**2/32/PI/a2
|
|
#endif
|
|
|
|
return
|
|
|
|
end function potential
|
|
!==================================================================
|
|
!Note this part is for evolution
|
|
!not just for initial configuration
|
|
|
|
!f(R) potential F=R+a_2R^2
|
|
subroutine frpotential(ex,Sphi,V,dVdSphi)
|
|
|
|
implicit none
|
|
|
|
integer,intent(in ):: ex(1:3)
|
|
real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sphi
|
|
real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: V,dVdSphi
|
|
|
|
real*8 :: a2,r0,phi0,sigma,l2
|
|
real*8, parameter :: Four = 4.d0, TWO = 2.d0,ONE = 1.d0,ZEO=0.d0
|
|
real*8 :: PI
|
|
|
|
PI = dacos(-ONE)
|
|
|
|
#if ( CC == 1 || CC == 4 || CC == 5)
|
|
V = ZEO
|
|
dVdSphi = ZEO
|
|
#elif ( CC == 2 || CC == 3)
|
|
call setparameters(a2,r0,phi0,sigma,l2)
|
|
V = dexp(-8.d0*dsqrt(PI/3)*Sphi)*(1-dexp(4*dsqrt(PI/3)*Sphi))**2/32/PI/a2
|
|
dVdSphi = 1.d0/a2/1.2d1*dsqrt(3.d0/PI)*dexp(-8.d0*dsqrt(PI/3.d0)*Sphi)*(-1+dexp(4*dsqrt(Pi/3)*Sphi))
|
|
#endif
|
|
|
|
return
|
|
|
|
end subroutine frpotential
|
|
!==================================================================
|
|
!f(R) potential F=R+a_2R^2
|
|
!fprim(R) = 1+2*a_2*R
|
|
subroutine frfprim(ex,RR,fprim)
|
|
|
|
implicit none
|
|
|
|
integer,intent(in ):: ex(1:3)
|
|
real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: RR
|
|
real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: fprim
|
|
|
|
real*8 :: a2,r0,phi0,sigma,l2
|
|
real*8, parameter :: ONE=1.d0, TWO = 2.d0
|
|
|
|
#if ( CC == 1 || CC == 4 || CC == 5)
|
|
fprim = ONE
|
|
#elif ( CC == 2 || CC == 3)
|
|
call setparameters(a2,r0,phi0,sigma,l2)
|
|
fprim = ONE+TWO*a2*RR
|
|
#endif
|
|
|
|
return
|
|
|
|
end subroutine frfprim
|
|
!==================================================================
|
|
subroutine set_rho_adm2(ex,rho,X,Y,Z)
|
|
|
|
implicit none
|
|
! argument variables
|
|
integer,intent(in)::ex
|
|
double precision,intent(in),dimension(ex)::X
|
|
double precision,intent(in),dimension(ex)::Y
|
|
double precision,intent(in),dimension(ex)::Z
|
|
double precision,intent(out),dimension(ex)::rho
|
|
|
|
integer :: i
|
|
real*8 :: dphi
|
|
|
|
do i=1,ex
|
|
! rho(i) = dphi(X,Y,Z)
|
|
rho(i) = dphi(X(i),Y(i),Z(i))
|
|
rho(i) = rho(i)*rho(i)
|
|
enddo
|
|
|
|
return
|
|
|
|
end subroutine set_rho_adm2
|
|
|
|
subroutine set_rho_adm1(ex,rho,X,Y,Z)
|
|
|
|
implicit none
|
|
! argument variables
|
|
integer,intent(in)::ex
|
|
double precision,intent(in),dimension(ex)::X
|
|
double precision,intent(in),dimension(ex)::Y
|
|
double precision,intent(in),dimension(ex)::Z
|
|
double precision,intent(out),dimension(ex)::rho
|
|
|
|
real*8 :: potential
|
|
integer :: i
|
|
|
|
do i=1,ex
|
|
rho(i) = potential(X(i),Y(i),Z(i))
|
|
enddo
|
|
|
|
return
|
|
|
|
end subroutine set_rho_adm1
|
|
|
|
subroutine set_rho_adm(ex,rho,X,Y,Z)
|
|
|
|
implicit none
|
|
! argument variables
|
|
integer,intent(in)::ex
|
|
double precision,intent(in),dimension(ex)::X
|
|
double precision,intent(in),dimension(ex)::Y
|
|
double precision,intent(in),dimension(ex)::Z
|
|
! in psivac, out rho_adm
|
|
double precision,intent(inout),dimension(ex)::rho
|
|
|
|
double precision,dimension(ex)::rho1,rho2
|
|
|
|
call set_rho_adm1(ex,rho1,X,Y,Z)
|
|
call set_rho_adm2(ex,rho2,X,Y,Z)
|
|
|
|
rho = rho**4
|
|
rho = rho**2*rho1+rho*rho2
|
|
|
|
return
|
|
|
|
end subroutine set_rho_adm
|