[TEST]UPSTREAM: Pick some source changes from 48080d0a97
* Sync new folder structure
This commit is contained in:
271
AMSS_NCKU_source/Scalar/Set_Rho_ADM.f90
Normal file
271
AMSS_NCKU_source/Scalar/Set_Rho_ADM.f90
Normal file
@@ -0,0 +1,271 @@
|
||||
|
||||
! 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
|
||||
2477
AMSS_NCKU_source/Scalar/bssnEScalar_class.C
Normal file
2477
AMSS_NCKU_source/Scalar/bssnEScalar_class.C
Normal file
File diff suppressed because it is too large
Load Diff
70
AMSS_NCKU_source/Scalar/bssnEScalar_class.h
Normal file
70
AMSS_NCKU_source/Scalar/bssnEScalar_class.h
Normal file
@@ -0,0 +1,70 @@
|
||||
|
||||
#ifndef BSSNESCALAR_CLASS_H
|
||||
#define BSSNESCALAR_CLASS_H
|
||||
|
||||
#ifdef newc
|
||||
#include <iostream>
|
||||
#include <iomanip>
|
||||
#include <fstream>
|
||||
#include <cstdlib>
|
||||
#include <string>
|
||||
#include <cmath>
|
||||
using namespace std;
|
||||
#else
|
||||
#include <iostream.h>
|
||||
#include <iomanip.h>
|
||||
#include <fstream.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <math.h>
|
||||
#endif
|
||||
|
||||
#include <mpi.h>
|
||||
|
||||
#include "cgh.h"
|
||||
#include "ShellPatch.h"
|
||||
#include "misc.h"
|
||||
#include "var.h"
|
||||
#include "MyList.h"
|
||||
#include "monitor.h"
|
||||
#include "surface_integral.h"
|
||||
|
||||
#include "macrodef.h"
|
||||
|
||||
#ifdef USE_GPU
|
||||
#include "bssn_gpu_class.h"
|
||||
#else
|
||||
#include "bssn_class.h"
|
||||
#endif
|
||||
|
||||
class bssnEScalar_class : public bssn_class
|
||||
{
|
||||
public:
|
||||
bssnEScalar_class(double Couranti, double StartTimei, double TotalTimei, double DumpTimei, double d2DumpTimei, double CheckTimei, double AnasTimei,
|
||||
int Symmetryi, int checkruni, char *checkfilenamei, double numepssi, double numepsbi, double numepshi,
|
||||
int a_levi, int maxli, int decni, double maxrexi, double drexi);
|
||||
~bssnEScalar_class();
|
||||
|
||||
void Initialize();
|
||||
void Read_Ansorg();
|
||||
void Read_Pablo();
|
||||
void Compute_Psi4(int lev);
|
||||
void Step(int lev, int YN);
|
||||
void AnalysisStuff_EScalar(int lev, double dT_lev);
|
||||
void Interp_Constraint();
|
||||
void Constraint_Out();
|
||||
|
||||
protected:
|
||||
var *Sphio, *Spio;
|
||||
var *Sphi0, *Spi0;
|
||||
var *Sphi, *Spi;
|
||||
var *Sphi1, *Spi1;
|
||||
var *Sphi_rhs, *Spi_rhs;
|
||||
|
||||
var *Cons_fR;
|
||||
|
||||
monitor *MaxScalar_Monitor;
|
||||
};
|
||||
|
||||
#endif /* BSSNESCALAR_CLASS_H */
|
||||
|
||||
2311
AMSS_NCKU_source/Scalar/bssnEScalar_rhs.f90
Normal file
2311
AMSS_NCKU_source/Scalar/bssnEScalar_rhs.f90
Normal file
File diff suppressed because it is too large
Load Diff
1195
AMSS_NCKU_source/Scalar/scalar_class.C
Normal file
1195
AMSS_NCKU_source/Scalar/scalar_class.C
Normal file
File diff suppressed because it is too large
Load Diff
75
AMSS_NCKU_source/Scalar/scalar_class.h
Normal file
75
AMSS_NCKU_source/Scalar/scalar_class.h
Normal file
@@ -0,0 +1,75 @@
|
||||
|
||||
#ifndef SCALAR_CLASS_H
|
||||
#define SCALAR_CLASS_H
|
||||
|
||||
#ifdef newc
|
||||
#include <iostream>
|
||||
#include <iomanip>
|
||||
#include <fstream>
|
||||
#include <cstdlib>
|
||||
#include <string>
|
||||
#include <cmath>
|
||||
using namespace std;
|
||||
#else
|
||||
#include <iostream.h>
|
||||
#include <iomanip.h>
|
||||
#include <fstream.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <math.h>
|
||||
#endif
|
||||
|
||||
#include <mpi.h>
|
||||
|
||||
#include "cgh.h"
|
||||
#include "ShellPatch.h"
|
||||
#include "misc.h"
|
||||
#include "var.h"
|
||||
#include "MyList.h"
|
||||
#include "monitor.h"
|
||||
|
||||
class scalar_class
|
||||
{
|
||||
protected:
|
||||
int myrank;
|
||||
cgh *GH;
|
||||
ShellPatch *SH;
|
||||
double PhysTime;
|
||||
|
||||
int checkrun;
|
||||
char checkfilename[50];
|
||||
int Steps;
|
||||
double StartTime, TotalTime;
|
||||
double AnasTime, DumpTime, CheckTime;
|
||||
double LastAnas;
|
||||
double Courant;
|
||||
double numepss, numepsb;
|
||||
int Symmetry;
|
||||
int trfls, a_lev;
|
||||
|
||||
double dT;
|
||||
|
||||
var *Sphio, *Spio;
|
||||
var *Sphi0, *Spi0;
|
||||
var *Sphi, *Spi;
|
||||
var *Sphi1, *Spi1;
|
||||
var *Sphi_rhs, *Spi_rhs;
|
||||
|
||||
MyList<var> *StateList, *SynchList_pre, *SynchList_cor, *RHSList;
|
||||
MyList<var> *OldStateList, *DumpList, *CheckList;
|
||||
|
||||
monitor *ErrorMonitor;
|
||||
|
||||
public:
|
||||
scalar_class(double Couranti, double StartTimei, double TotalTimei, double DumpTimei, double CheckTimei, double AnasTimei,
|
||||
int Symmetryi, int checkruni, char *checkfilenamei, double numepssi, double numepsbi,
|
||||
int a_levi);
|
||||
~scalar_class();
|
||||
void Setup_Initial_Data();
|
||||
void Evolve(int Steps);
|
||||
void RecursiveStep(int lev);
|
||||
void Step(int lev, int YN);
|
||||
void RestrictProlong(int lev, int YN, bool BB);
|
||||
void ProlongRestrict(int lev, int YN, bool BB);
|
||||
};
|
||||
#endif /* SCALAR_CLASS_H */
|
||||
155
AMSS_NCKU_source/Scalar/scalar_rhs.f90
Normal file
155
AMSS_NCKU_source/Scalar/scalar_rhs.f90
Normal file
@@ -0,0 +1,155 @@
|
||||
|
||||
! PIN==0: standard scalar wave
|
||||
! PIN==1: \block phi = \eta(dphi,dphi)
|
||||
#define PIN 0
|
||||
|
||||
function compute_rhs_scalar(ex, T, X, Y, Z, &
|
||||
Sphi,Spi,Sphi_rhs,Spi_rhs, &
|
||||
Symmetry,Lev,eps) result(gont)
|
||||
implicit none
|
||||
|
||||
!~~~~~~> Input parameters:
|
||||
|
||||
integer,intent(in ):: ex(1:3), Symmetry,Lev
|
||||
real*8, intent(in ):: T,X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3))
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sphi,Spi
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Sphi_rhs,Spi_rhs
|
||||
real*8,intent(in) :: eps
|
||||
! gont = 0: success; gont = 1: something wrong
|
||||
integer::gont
|
||||
|
||||
!~~~~~~> Other variables:
|
||||
|
||||
real*8, dimension(ex(1),ex(2),ex(3)) :: fxx,fxy,fxz,fyy,fyz,fzz
|
||||
real*8,dimension(3) ::SSS
|
||||
real*8, parameter :: HALF = 0.5d0, ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0
|
||||
real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0
|
||||
real*8 :: tt
|
||||
|
||||
!!! sanity check
|
||||
tt = sum(Sphi)+sum(Spi)
|
||||
if(tt.ne.tt) then
|
||||
if(sum(Sphi).ne.sum(Sphi))write(*,*)"scalar_rhs.f90:compute_rhs_scalar find NaN in Sphi"
|
||||
if(sum(Spi).ne.sum(Spi))write(*,*)"scalar_rhs.f90:compute_rhs_scalar find NaN in Spi"
|
||||
gont = 1
|
||||
return
|
||||
endif
|
||||
|
||||
Sphi_rhs = Spi !rhs for phi
|
||||
|
||||
#if (PIN == 0)
|
||||
call fdderivs(ex,Sphi,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev)
|
||||
Spi_rhs = fxx + fyy + fzz
|
||||
#elif (PIN == 1)
|
||||
call fdderivs(ex,Sphi,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev)
|
||||
Spi_rhs = Spi*Spi + fxx + fyy + fzz
|
||||
call fderivs(ex,Sphi,fxx,fyy,fzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev)
|
||||
Spi_rhs = Spi_rhs - (fxx*fxx+fyy*fyy+fzz*fzz)
|
||||
#endif
|
||||
if(eps>0)then
|
||||
! usual Kreiss-Oliger dissipation
|
||||
SSS(1)=SYM
|
||||
SSS(2)=SYM
|
||||
SSS(3)=SYM
|
||||
|
||||
call kodis(ex,X,Y,Z,Sphi,Sphi_rhs,SSS,Symmetry,eps)
|
||||
call kodis(ex,X,Y,Z,Spi,Spi_rhs,SSS,Symmetry,eps)
|
||||
endif
|
||||
|
||||
gont = 0
|
||||
|
||||
return
|
||||
|
||||
end function compute_rhs_scalar
|
||||
! for shell
|
||||
function compute_rhs_scalar_ss(ex, T,crho,sigma,R,x,y,z, &
|
||||
drhodx, drhody, drhodz, &
|
||||
dsigmadx,dsigmady,dsigmadz, &
|
||||
dRdx,dRdy,dRdz, &
|
||||
drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, &
|
||||
dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, &
|
||||
dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, &
|
||||
Sphi,Spi,Sphi_rhs,Spi_rhs, &
|
||||
Symmetry,Lev,eps,sst) result(gont)
|
||||
implicit none
|
||||
|
||||
!~~~~~~> Input parameters:
|
||||
|
||||
integer,intent(in ):: ex(1:3), Symmetry,Lev,sst
|
||||
real*8, intent(in ):: T
|
||||
double precision,intent(in),dimension(ex(1))::crho
|
||||
double precision,intent(in),dimension(ex(2))::sigma
|
||||
double precision,intent(in),dimension(ex(3))::R
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sphi,Spi
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Sphi_rhs,Spi_rhs
|
||||
real*8,intent(in) :: eps
|
||||
! gont = 0: success; gont = 1: something wrong
|
||||
integer::gont
|
||||
|
||||
!~~~~~~> Other variables:
|
||||
|
||||
real*8, dimension(ex(1),ex(2),ex(3)) :: fxx,fxy,fxz,fyy,fyz,fzz
|
||||
real*8,dimension(3) ::SSS
|
||||
real*8, parameter :: HALF = 0.5d0, ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0
|
||||
real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0
|
||||
real*8 :: tt
|
||||
|
||||
!!! sanity check
|
||||
tt = sum(Sphi)+sum(Spi)
|
||||
if(tt.ne.tt) then
|
||||
if(sum(Sphi).ne.sum(Sphi))write(*,*)"scalar_rhs.f90:compute_rhs_scalar_ss find NaN in Sphi"
|
||||
if(sum(Spi).ne.sum(Spi))write(*,*)"scalar_rhs.f90:compute_rhs_scalar_ss find NaN in Spi"
|
||||
gont = 1
|
||||
return
|
||||
endif
|
||||
|
||||
Sphi_rhs = Spi !rhs for phi
|
||||
|
||||
#if (PIN == 0)
|
||||
call fdderivs_shc(ex,Sphi,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, &
|
||||
drhodx, drhody, drhodz, &
|
||||
dsigmadx,dsigmady,dsigmadz, &
|
||||
dRdx,dRdy,dRdz, &
|
||||
drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, &
|
||||
dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, &
|
||||
dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz)
|
||||
|
||||
Spi_rhs = fxx+fyy+fzz
|
||||
#elif (PIN == 1)
|
||||
call fdderivs_shc(ex,Sphi,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, &
|
||||
drhodx, drhody, drhodz, &
|
||||
dsigmadx,dsigmady,dsigmadz, &
|
||||
dRdx,dRdy,dRdz, &
|
||||
drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, &
|
||||
dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, &
|
||||
dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz)
|
||||
Spi_rhs = Spi*Spi + fxx + fyy + fzz
|
||||
call fderivs_shc(ex,Sphi,fxx,fyy,fzz,crho,sigma,R,SYM,SYM,SYM,Symmetry,Lev,sst, &
|
||||
drhodx, drhody, drhodz, &
|
||||
dsigmadx,dsigmady,dsigmadz, &
|
||||
dRdx,dRdy,dRdz)
|
||||
Spi_rhs = Spi_rhs - (fxx*fxx+fyy*fyy+fzz*fzz)
|
||||
#endif
|
||||
|
||||
if(eps>0)then
|
||||
! usual Kreiss-Oliger dissipation
|
||||
SSS(1)=SYM
|
||||
SSS(2)=SYM
|
||||
SSS(3)=SYM
|
||||
|
||||
call kodis_sh(ex,crho,sigma,R,Sphi,Sphi_rhs,SSS,Symmetry,eps,sst)
|
||||
call kodis_sh(ex,crho,sigma,R,Spi,Spi_rhs,SSS,Symmetry,eps,sst)
|
||||
endif
|
||||
|
||||
gont = 0
|
||||
|
||||
return
|
||||
|
||||
end function compute_rhs_scalar_ss
|
||||
39
AMSS_NCKU_source/Scalar/scalar_rhs.h
Normal file
39
AMSS_NCKU_source/Scalar/scalar_rhs.h
Normal file
@@ -0,0 +1,39 @@
|
||||
|
||||
#ifndef SCALAR_RHS_H
|
||||
#define SCALAR_RHS_H
|
||||
|
||||
#ifdef fortran1
|
||||
#define f_compute_rhs_scalar compute_rhs_scalar
|
||||
#define f_compute_rhs_scalar_ss compute_rhs_scalar_ss
|
||||
#endif
|
||||
#ifdef fortran2
|
||||
#define f_compute_rhs_scalar COMPUTE_RHS_SCALAR
|
||||
#define f_compute_rhs_scalar_ss COMPUTE_RHS_SCALAR_SS
|
||||
#endif
|
||||
#ifdef fortran3
|
||||
#define f_compute_rhs_scalar compute_rhs_scalar_
|
||||
#define f_compute_rhs_scalar_ss compute_rhs_scalar_ss_
|
||||
#endif
|
||||
extern "C"
|
||||
{
|
||||
int f_compute_rhs_scalar(int *, double &, double *, double *, double *, // ex,T,X,Y,Z
|
||||
double *, double *, // Sphi,Spi
|
||||
double *, double *, // Sphi_rhs,Spi_rhs
|
||||
int &, int &, double &);
|
||||
}
|
||||
|
||||
extern "C"
|
||||
{
|
||||
int f_compute_rhs_scalar_ss(int *, double &, double *, double *, double *, // ex,T,rho,sigma,R
|
||||
double *, double *, double *, // X,Y,Z
|
||||
double *, double *, double *, // drhodx,drhody,drhodz
|
||||
double *, double *, double *, // dsigmadx,dsigmady,dsigmadz
|
||||
double *, double *, double *, // dRdx,dRdy,dRdz
|
||||
double *, double *, double *, double *, double *, double *, // drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz
|
||||
double *, double *, double *, double *, double *, double *, // dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz
|
||||
double *, double *, double *, double *, double *, double *, // dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz
|
||||
double *, double *, // Sphi,Spi
|
||||
double *, double *, // Sphi_rhs,Spi_rhs
|
||||
int &, int &, double &, int &);
|
||||
}
|
||||
#endif /* SCALAR_RHS_H */
|
||||
213
AMSS_NCKU_source/Scalar/scalarwaves.C
Normal file
213
AMSS_NCKU_source/Scalar/scalarwaves.C
Normal file
@@ -0,0 +1,213 @@
|
||||
|
||||
#ifdef newc
|
||||
#include <iostream>
|
||||
#include <iomanip>
|
||||
#include <fstream>
|
||||
#include <cstdlib>
|
||||
#include <cstdio>
|
||||
#include <string>
|
||||
#include <cmath>
|
||||
using namespace std;
|
||||
#else
|
||||
#include <iostream.h>
|
||||
#include <iomanip.h>
|
||||
#include <fstream.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include <math.h>
|
||||
#endif
|
||||
|
||||
#include <mpi.h>
|
||||
|
||||
#include "misc.h"
|
||||
#include "microdef.h"
|
||||
#include "scalar_class.h"
|
||||
|
||||
//=======================================
|
||||
int main(int argc, char *argv[])
|
||||
{
|
||||
int myrank = 0, nprocs = 1;
|
||||
MPI_Init(&argc, &argv);
|
||||
MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
|
||||
MPI_Comm_rank(MPI_COMM_WORLD, &myrank);
|
||||
|
||||
int checkrun;
|
||||
char checkfilename[50];
|
||||
int Steps;
|
||||
double StartTime, TotalTime;
|
||||
double AnasTime, DumpTime, d2DumpTime, CheckTime;
|
||||
double Courant;
|
||||
double numepss, numepsb, numepsh;
|
||||
int Symmetry;
|
||||
int a_lev, maxl, decn;
|
||||
double maxrex, drex;
|
||||
// read parameter from file
|
||||
{
|
||||
const int LEN = 256;
|
||||
char pline[LEN];
|
||||
string str, sgrp, skey, sval;
|
||||
int sind;
|
||||
char pname[50];
|
||||
{
|
||||
map<string, string>::iterator iter = parameters::str_par.find("inputpar");
|
||||
if (iter != parameters::str_par.end())
|
||||
{
|
||||
strcpy(pname, (iter->second).c_str());
|
||||
}
|
||||
else
|
||||
{
|
||||
cout << "Error inputpar" << endl;
|
||||
exit(0);
|
||||
}
|
||||
}
|
||||
ifstream inf(pname, ifstream::in);
|
||||
if (!inf.good() && myrank == 0)
|
||||
{
|
||||
cout << "Can not open parameter file " << pname << endl;
|
||||
MPI_Abort(MPI_COMM_WORLD, 1);
|
||||
}
|
||||
|
||||
for (int i = 1; inf.good(); i++)
|
||||
{
|
||||
inf.getline(pline, LEN);
|
||||
str = pline;
|
||||
|
||||
int status = misc::parse_parts(str, sgrp, skey, sval, sind);
|
||||
if (status == -1)
|
||||
{
|
||||
cout << "error reading parameter file " << pname << " in line " << i << endl;
|
||||
MPI_Abort(MPI_COMM_WORLD, 1);
|
||||
}
|
||||
else if (status == 0)
|
||||
continue;
|
||||
|
||||
if (sgrp == "ABE")
|
||||
{
|
||||
if (skey == "checkrun")
|
||||
checkrun = atoi(sval.c_str());
|
||||
else if (skey == "checkfile")
|
||||
strcpy(checkfilename, sval.c_str());
|
||||
else if (skey == "Steps")
|
||||
Steps = atoi(sval.c_str());
|
||||
else if (skey == "StartTime")
|
||||
StartTime = atof(sval.c_str());
|
||||
else if (skey == "TotalTime")
|
||||
TotalTime = atof(sval.c_str());
|
||||
else if (skey == "DumpTime")
|
||||
DumpTime = atof(sval.c_str());
|
||||
else if (skey == "d2DumpTime")
|
||||
d2DumpTime = atof(sval.c_str());
|
||||
else if (skey == "CheckTime")
|
||||
CheckTime = atof(sval.c_str());
|
||||
else if (skey == "AnalysisTime")
|
||||
AnasTime = atof(sval.c_str());
|
||||
else if (skey == "Courant")
|
||||
Courant = atof(sval.c_str());
|
||||
else if (skey == "Symmetry")
|
||||
Symmetry = atoi(sval.c_str());
|
||||
else if (skey == "small dissipation")
|
||||
numepss = atof(sval.c_str());
|
||||
else if (skey == "big dissipation")
|
||||
numepsb = atof(sval.c_str());
|
||||
else if (skey == "shell dissipation")
|
||||
numepsh = atof(sval.c_str());
|
||||
else if (skey == "Analysis Level")
|
||||
a_lev = atoi(sval.c_str());
|
||||
else if (skey == "Max mode l")
|
||||
maxl = atoi(sval.c_str());
|
||||
else if (skey == "detector number")
|
||||
decn = atoi(sval.c_str());
|
||||
else if (skey == "farest detector position")
|
||||
maxrex = atof(sval.c_str());
|
||||
else if (skey == "detector distance")
|
||||
drex = atof(sval.c_str());
|
||||
}
|
||||
}
|
||||
inf.close();
|
||||
}
|
||||
// echo parameters
|
||||
if (myrank == 0)
|
||||
{
|
||||
cout << "///////////////////////////////////////////////////////////////" << endl;
|
||||
#ifdef Cell
|
||||
cout << "Cell center numerical grid structure" << endl;
|
||||
#endif
|
||||
#ifdef Vertex
|
||||
cout << "Vertex center numerical grid structure" << endl;
|
||||
#endif
|
||||
if (checkrun)
|
||||
cout << " checked run" << endl;
|
||||
else
|
||||
cout << " new run" << endl;
|
||||
cout << " simulation with cpu numbers = " << nprocs << endl;
|
||||
cout << " simulation time = (" << StartTime << ", " << TotalTime << ")" << endl;
|
||||
cout << "simulation steps for this run = " << Steps << endl;
|
||||
cout << " Courant number = " << Courant << endl;
|
||||
cout << " ghost zone = " << ghost_width << endl;
|
||||
cout << " buffer zone = " << buffer_width << endl;
|
||||
switch (Symmetry)
|
||||
{
|
||||
case 0:
|
||||
cout << " Symmetry setting: No_Symmetry" << endl;
|
||||
break;
|
||||
case 1:
|
||||
cout << " Symmetry setting: Equatorial" << endl;
|
||||
break;
|
||||
case 2:
|
||||
cout << " Symmetry setting: Octant" << endl;
|
||||
break;
|
||||
default:
|
||||
cout << "OOOOps, not supported Symmetry setting!" << endl;
|
||||
MPI_Abort(MPI_COMM_WORLD, 1);
|
||||
}
|
||||
cout << "Courant = " << Courant << endl;
|
||||
cout << "artificial dissipation for shell patches = " << numepsh << endl;
|
||||
cout << "artificial dissipation for fixed levels = " << numepsb << endl;
|
||||
cout << "artificial dissipation for moving levels = " << numepss << endl;
|
||||
cout << "Dumpt Time = " << DumpTime << endl;
|
||||
cout << "Check Time = " << CheckTime << endl;
|
||||
cout << "Analysis Time = " << AnasTime << endl;
|
||||
cout << "Analysis level = " << a_lev << endl;
|
||||
cout << "checkfile = " << checkfilename << endl;
|
||||
switch (ghost_width)
|
||||
{
|
||||
case 2:
|
||||
cout << "second order finite difference is used" << endl;
|
||||
break;
|
||||
case 3:
|
||||
cout << "fourth order finite difference is used" << endl;
|
||||
break;
|
||||
case 4:
|
||||
cout << "sixth order finite difference is used" << endl;
|
||||
break;
|
||||
case 5:
|
||||
cout << "eighth order finite difference is used" << endl;
|
||||
break;
|
||||
default:
|
||||
cout << "Why are you using ghost width = " << ghost_width << endl;
|
||||
MPI_Abort(MPI_COMM_WORLD, 1);
|
||||
}
|
||||
cout << "///////////////////////////////////////////////////////////////" << endl;
|
||||
}
|
||||
//===========================the computation body====================================================
|
||||
scalar_class *ADM;
|
||||
|
||||
ADM = new scalar_class(Courant, StartTime, TotalTime, DumpTime, CheckTime, AnasTime,
|
||||
Symmetry, checkrun, checkfilename, numepss, numepsb,
|
||||
a_lev);
|
||||
|
||||
ADM->Setup_Initial_Data();
|
||||
|
||||
ADM->Evolve(Steps);
|
||||
|
||||
delete ADM;
|
||||
//=======================caculation done=============================================================
|
||||
if (myrank == 0)
|
||||
cout << "===============================================================" << endl;
|
||||
if (myrank == 0)
|
||||
cout << "Simulation is successfully done!!" << endl;
|
||||
MPI_Finalize();
|
||||
|
||||
exit(0);
|
||||
}
|
||||
Reference in New Issue
Block a user